diff --git a/src/Abacus.hs b/src/Abacus.hs index bad1d70..7edceec 100644 --- a/src/Abacus.hs +++ b/src/Abacus.hs @@ -30,6 +30,7 @@ module Abacus ( getNumBeads, getNumRungs, getRung, + setRung, ) where import Data.List (find) @@ -68,4 +69,26 @@ getRung r a = snd <$> find (\(n, _) -> n == r) (zip [0..] $ abacusRungs a) +-- | Sets the number of beads slid across a given rung +setRung + :: Int + -- ^ The rung number + -> Int + -- ^ The value being set + -> Abacus + -- ^ The original state + -> Abacus + -- ^ The new state +setRung r v a = a + { abacusRungs = zipWith + (\n x -> if n == r then v' else x) + [0..] + (abacusRungs a) + } + where + v' + | v < 0 = 0 + | v > getNumBeads a = getNumBeads a + | otherwise = v + --jl diff --git a/test/AbacusSpec.hs b/test/AbacusSpec.hs index 2240b68..21dfe0d 100644 --- a/test/AbacusSpec.hs +++ b/test/AbacusSpec.hs @@ -33,6 +33,7 @@ spec = describe "Abacus" $ do getNumBeadsSpec getNumRungsSpec getRungSpec + setRungSpec newAbacusSpec :: Spec newAbacusSpec = describe "newAbacusSpec" $ mapM_ @@ -81,11 +82,27 @@ getRungSpec = describe "getRung" $ mapM_ in it ("should be " ++ show expected) $ actual `shouldBe` expected ) - [ ( "0th rung", 0, Just 2 ) - , ( "last rung", 2, Just 5 ) + [ ( "first rung", 0, Just 2 ) + , ( "last rung", 2, Just 5 ) , ( "negative rung", -1, Nothing ) - , ( "too large", 3, Nothing ) + , ( "too large", 3, Nothing ) ] where abacus = Abacus 10 [2, 3, 5] +setRungSpec :: Spec +setRungSpec = describe "setRung" $ mapM_ + ( \(desc, rung, val, expected) -> context desc $ let + actual = setRung rung val $ mkA [2, 3, 5] + in it ("should be " ++ show expected) $ + actual `shouldBe` expected + ) + [ ( "first rung", 0, 10, mkA [10, 3, 5] ) + , ( "last rung", 2, 10, mkA [ 2, 3, 10] ) + , ( "negative rung", -1, 10, mkA [ 2, 3, 5] ) + , ( "large rung", 3, 10, mkA [ 2, 3, 5] ) + , ( "negative value", 1, -1, mkA [ 2, 0, 5] ) + , ( "large value", 1, 11, mkA [ 2, 10, 5] ) + ] where + mkA = Abacus 10 + --jl