implemented setRung

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

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  )
+  [ ( "first rung",     0, Just 2  )
   , ( "last rung",      2, Just 5  )
   , ( "negative rung", -1, 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