implemented moving to top and bottom rungs

src/Abacus/App/Actions.hs

@@ -28,6 +28,8 @@ module Abacus.App.Actions (
   -- * Rung Selection
   moveUp,
   moveDown,
+  topRung,
+  bottomRung,
   selRung,
   -- * Bead Movement
   beadLeft,
@@ -50,6 +52,14 @@ moveDown :: AppState -> AppState
 moveDown s = s & rungNum %~
   (min (pred $ getNumRungs $ s^.abacus) . succ)
 
+-- | Selects the top rung
+topRung :: AppState -> AppState
+topRung = rungNum .~ 0
+
+-- | Selects the bottom rung
+bottomRung :: AppState -> AppState
+bottomRung s = s & rungNum .~ pred (getNumRungs $ s^.abacus)
+
 -- | Selectes a specified rung
 selRung :: Int -> AppState -> AppState
 selRung n s = s & rungNum .~ n' where

src/Abacus/App/Events.hs

@@ -46,7 +46,17 @@ 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))
+  ( Key
+    ( KUp
+    , KDown
+    , KLeft
+    , KRight
+    , KHome
+    , KEnd
+    , KPageUp
+    , KPageDown
+    )
+  )
 
 import Abacus.App.Actions
 import Abacus.App.Types
@@ -68,6 +78,10 @@ eventBindings =
     modify moveUp
   , onEvent MoveDownE "Moves the cursor down" $
     modify moveDown
+  , onEvent TopRungE "Selects the top rung" $
+    modify topRung
+  , onEvent BottomRungE "Selects the bottom rung" $
+    modify bottomRung
   , onEvent BeadLeftE "Moves a bead to the left" $
     modify beadLeft
   , onEvent BeadRightE "Moves a bead to the right" $
@@ -105,6 +119,18 @@ keyBindings =
       , bind 'h'
       ]
     )
+  , ( TopRungE
+    , [ shift KUp
+      , bind KPageUp
+      , bind 'K'
+      ]
+    )
+  , ( BottomRungE
+    , [ shift KDown
+      , bind KPageDown
+      , bind 'J'
+      ]
+    )
   , ( BeadRightE
     , [ bind KRight
       , bind 'l'

src/Abacus/App/Types.hs

@@ -54,6 +54,8 @@ data KeyEventID
   = QuitE
   | MoveUpE
   | MoveDownE
+  | TopRungE
+  | BottomRungE
   | BeadLeftE
   | BeadRightE
   | RungLeftE

test/Abacus/App/ActionsSpec.hs

@@ -33,6 +33,8 @@ spec :: Spec
 spec = describe "Actions" $ do
   moveUpSpec
   moveDownSpec
+  topRungSpec
+  bottomRungSpec
   selRungSpec
   beadLeftSpec
   beadRightSpec
@@ -69,6 +71,18 @@ moveDownSpec = describe "moveDown" $ mapM_
     elsewhere = initialState & rungNum .~ 8
     movedDown = initialState & rungNum .~ 1
 
+topRungSpec :: Spec
+topRungSpec = describe "topRung" $ let
+  state = initialState & rungNum .~ 5
+  in it ("should be " ++ show initialState) $
+    topRung state `shouldBe` initialState
+
+bottomRungSpec :: Spec
+bottomRungSpec = describe "bottomRung" $ let
+  expected = initialState & rungNum .~ 9
+  in it ("should be " ++ show expected) $
+    bottomRung initialState `shouldBe` expected
+
 selRungSpec :: Spec
 selRungSpec = describe "selRung" $ mapM_
   ( \(desc, rung, expected) -> context desc $