implemented arbitrary rung selection

src/Abacus/App/Actions.hs

@@ -28,6 +28,7 @@ module Abacus.App.Actions (
   -- * Rung Selection
   moveUp,
   moveDown,
+  selRung,
   -- * Bead Movement
   beadLeft,
   beadRight,
@@ -49,6 +50,13 @@ moveDown :: AppState -> AppState
 moveDown s = s & rungNum %~
   (min (pred $ getNumRungs $ s^.abacus) . succ)
 
+-- | Selectes a specified rung
+selRung :: Int -> AppState -> AppState
+selRung n s = s & rungNum .~ n' where
+  n' = if n < 0
+    then 0
+    else min n $ pred $ getNumRungs $ s^.abacus
+
 -- | Moves a bead on the selected row to the left
 beadLeft :: AppState -> AppState
 beadLeft s = s & abacus.rungL (s^.rungNum) %~ pred

src/Abacus/App/Events.hs

@@ -43,6 +43,7 @@ import Brick.Keybindings
   , shift
   )
 import Control.Monad.State.Class (modify)
+import Data.Char (chr, ord)
 import Data.Either (fromRight)
 import Graphics.Vty.Input.Events
   (Key (KUp, KDown, KLeft, KRight, KHome, KEnd))
@@ -75,7 +76,11 @@ eventBindings =
     modify rungLeft
   , onEvent RungRightE "Moves all beads to the right of the rung" $
     modify rungRight
-  ]
+  ] ++ map
+    ( \n -> onEvent (SelRungE n) "Moves to a numbered rung" $
+      modify $ selRung n
+    )
+    [0..9]
 
 -- | Key bindings
 keyBindings :: [(KeyEventID, [Binding])]
@@ -117,6 +122,12 @@ keyBindings =
       , bind 'L'
       ]
     )
-  ]
+  ] ++ map
+    ( \n ->
+      ( SelRungE n
+      , [bind $ chr $ ord '0' + n]
+      )
+    )
+    [0..9]
 
 --jl

src/Abacus/App/Types.hs

@@ -58,6 +58,7 @@ data KeyEventID
   | BeadRightE
   | RungLeftE
   | RungRightE
+  | SelRungE Int
   deriving (Eq, Ord, Show)
 
 makeLenses ''AppState

test/Abacus/App/ActionsSpec.hs

@@ -33,6 +33,7 @@ spec :: Spec
 spec = describe "Actions" $ do
   moveUpSpec
   moveDownSpec
+  selRungSpec
   beadLeftSpec
   beadRightSpec
   rungLeftSpec
@@ -68,6 +69,20 @@ moveDownSpec = describe "moveDown" $ mapM_
     elsewhere = initialState & rungNum .~ 8
     movedDown = initialState & rungNum .~ 1
 
+selRungSpec :: Spec
+selRungSpec = describe "selRung" $ mapM_
+  ( \(desc, rung, expected) -> context desc $
+    it ("should be " ++ show expected) $
+      selRung rung initialState `shouldBe` expected
+  )
+  [ ( "negative rung", -1, initialState )
+  , ( "valid rung",     5, rung5        )
+  , ( "large rung",    11, rung9        )
+  ]
+  where
+    rung5 = initialState & rungNum .~ 5
+    rung9 = initialState & rungNum .~ 9
+
 beadLeftSpec :: Spec
 beadLeftSpec = describe "beadLeft" $ let
   state = initialState