implemented row selection

abacus.cabal

@@ -21,6 +21,7 @@ library
   exposed-modules:
       Abacus
       Abacus.App
+      Abacus.App.Actions
       Abacus.App.Events
       Abacus.App.Types
       Abacus.App.Widgets
@@ -37,6 +38,7 @@ library
       base >=4.7 && <5
     , brick >=2.1.1 && <2.2
     , microlens-platform >=0.4.3.5 && <0.5
+    , mtl >=2.3.1 && <2.4
     , vty ==6.1.*
   default-language: Haskell2010
 
@@ -54,6 +56,7 @@ executable abacus
     , base >=4.7 && <5
     , brick >=2.1.1 && <2.2
     , microlens-platform >=0.4.3.5 && <0.5
+    , mtl >=2.3.1 && <2.4
     , vty ==6.1.*
   default-language: Haskell2010
 
@@ -61,6 +64,7 @@ test-suite abacus-test
   type: exitcode-stdio-1.0
   main-is: Spec.hs
   other-modules:
+      Abacus.App.ActionsSpec
       Abacus.App.Widgets.InternalSpec
       Abacus.App.WidgetsSpec
       Abacus.AppSpec
@@ -77,5 +81,6 @@ test-suite abacus-test
     , brick >=2.1.1 && <2.2
     , hspec >=2.11.9 && <2.12
     , microlens-platform >=0.4.3.5 && <0.5
+    , mtl >=2.3.1 && <2.4
     , vty ==6.1.*
   default-language: Haskell2010

package.yaml

@@ -22,6 +22,7 @@ dependencies:
 - base >= 4.7 && < 5
 - brick >= 2.1.1 && < 2.2
 - microlens-platform >= 0.4.3.5 && < 0.5
+- mtl >= 2.3.1 && < 2.4
 - vty >= 6.1 && < 6.2
 
 ghc-options:

src/Abacus/App/Actions.hs

@@ -0,0 +1,43 @@
+{-|
+
+Module      : Abacus.App.Actions
+Description : Transformations on the applicaiton state
+Copyright   : (C) Jonathan Lamothe
+License     : AGPL-3.0-or-later
+Maintainer  : jonathan@jlamothe.net
+Stability   : experimental
+Portability : POSIX
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU Affero General Public License as
+published by the Free Software Foundation, either version 3 of the
+License, or (at your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+Affero General Public License for more details.
+
+You should have received a copy of the GNU Affero General Public
+License along with this program.  If not, see
+<https://www.gnu.org/licenses/>.
+
+-}
+
+module Abacus.App.Actions (moveUp, moveDown) where
+
+import Lens.Micro.Platform ((^.), (&), (%~))
+
+import Abacus
+import Abacus.App.Types
+
+-- Moves the cursor up
+moveUp :: AppState -> AppState
+moveUp = rungNum %~ (max 0 . pred)
+
+-- Moves the cursor down
+moveDown :: AppState -> AppState
+moveDown s = s & rungNum %~
+  (min (pred $ getNumRungs $ s^.abacus) . succ)
+
+--jl

src/Abacus/App/Events.hs

@@ -42,8 +42,11 @@ import Brick.Keybindings
   , newKeyConfig
   , onEvent
   )
+import Control.Monad.State.Class (modify)
 import Data.Either (fromRight)
+import Graphics.Vty.Input.Events (Key (KUp, KDown))
 
+import Abacus.App.Actions
 import Abacus.App.Types
 
 -- | Application keyboard configuration
@@ -57,7 +60,13 @@ keyConfig = newKeyConfig appKeyEvents keyBindings []
 
 -- | Binds a "KeyEventID" to its associated action
 eventBindings :: [KeyEventHandler KeyEventID (EventM () AppState)]
-eventBindings = [onEvent QuitE "Quits the program" halt]
+eventBindings =
+  [ onEvent QuitE "Quits the program" halt
+  , onEvent MoveUpE "Moves the cursor up" $
+    modify moveUp
+  , onEvent MoveDownE "Moves the cursor down" $
+    modify moveDown
+  ]
 
 -- | Names the individual key events
 appKeyEvents :: KeyEvents KeyEventID
@@ -71,6 +80,16 @@ keyBindings =
       , bind 'q'
       ]
     )
+  , ( MoveUpE
+    , [ bind KUp
+      , bind 'k'
+      ]
+    )
+  , ( MoveDownE
+    , [ bind KDown
+      , bind 'j'
+      ]
+    )
   ]
 
 --jl

src/Abacus/App/Types.hs

@@ -50,7 +50,11 @@ data AppState = AppState
   } deriving (Eq, Show)
 
 -- | Identifiers for various key events
-data KeyEventID = QuitE deriving (Eq, Ord, Show)
+data KeyEventID
+  = QuitE
+  | MoveUpE
+  | MoveDownE
+  deriving (Eq, Ord, Show)
 
 makeLenses ''AppState
 

test/Abacus/App/ActionsSpec.hs

@@ -0,0 +1,65 @@
+{-
+
+abacus
+Copyright (C) Jonathan Lamothe <jonathan@jlamothe.net>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU Affero General Public License as
+published by the Free Software Foundation, either version 3 of the
+License, or (at your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+Affero General Public License for more details.
+
+You should have received a copy of the GNU Affero General Public
+License along with this program.  If not, see
+<https://www.gnu.org/licenses/>.
+
+-}
+
+module Abacus.App.ActionsSpec (spec) where
+
+import Lens.Micro.Platform ((&), (.~))
+import Test.Hspec (Spec, context, describe, it, shouldBe)
+
+import Abacus.App.Actions
+import Abacus.App.Types
+
+spec :: Spec
+spec = describe "Actions" $ do
+  moveUpSpec
+  moveDownSpec
+
+moveUpSpec :: Spec
+moveUpSpec = describe "moveUp" $ mapM_
+  ( \(desc, state, expected) -> context desc $
+    it ("should be " ++ show expected) $
+      moveUp state `shouldBe` expected
+  )
+  [ ( "at the top",     initialState, initialState )
+  , ( "at the bottom",  atBottom,     movedUp      )
+  , ( "somewhere else", elsewhere,    initialState )
+  ]
+  where
+    atBottom  = initialState & rungNum .~ 9
+    elsewhere = initialState & rungNum .~ 1
+    movedUp   = initialState & rungNum .~ 8
+
+moveDownSpec :: Spec
+moveDownSpec = describe "moveDown" $ mapM_
+  ( \(desc, state, expected) -> context desc $
+    it ("should be " ++ show expected) $
+      moveDown state `shouldBe` expected
+  )
+  [ ( "at the top",     initialState, movedDown )
+  , ( "at the bottom",  atBottom,     atBottom  )
+  , ( "somewhere else", elsewhere,    atBottom  )
+  ]
+  where
+    atBottom  = initialState & rungNum .~ 9
+    elsewhere = initialState & rungNum .~ 8
+    movedDown = initialState & rungNum .~ 1
+
+--jl

test/Abacus/AppSpec.hs

@@ -23,10 +23,12 @@ module Abacus.AppSpec (spec) where
 
 import Test.Hspec (Spec, describe)
 
+import qualified Abacus.App.ActionsSpec as Actions
 import qualified Abacus.App.WidgetsSpec as Widgets
 
 spec :: Spec
-spec = describe "App"
+spec = describe "App" $ do
   Widgets.spec
+  Actions.spec
 
 --jl