implemented row selection
This commit is contained in:
parent
6a4a1fda82
commit
014ca39103
|
@ -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
|
||||
|
|
|
@ -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:
|
||||
|
|
|
@ -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
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user