implemented row selection

This commit is contained in:
Jonathan Lamothe 2024-08-22 16:14:23 -04:00
parent 6a4a1fda82
commit 014ca39103
7 changed files with 142 additions and 3 deletions

View File

@ -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

View File

@ -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:

43
src/Abacus/App/Actions.hs Normal file
View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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