diff --git a/hamming.cabal b/hamming.cabal
index a29def2..d30e9b9 100644
--- a/hamming.cabal
+++ b/hamming.cabal
@@ -23,6 +23,7 @@ library
exposed-modules:
Hamming
Hamming.App
+ Hamming.App.Actions
Hamming.App.Draw
Hamming.App.Events
Hamming.App.Types
@@ -68,6 +69,7 @@ test-suite hamming-test
type: exitcode-stdio-1.0
main-is: Spec.hs
other-modules:
+ Hamming.App.ActionsSpec
Hamming.App.UtilSpec
Hamming.App.Widgets.InternalSpec
Hamming.App.WidgetsSpec
diff --git a/src/Hamming/App/Actions.hs b/src/Hamming/App/Actions.hs
new file mode 100644
index 0000000..9265926
--- /dev/null
+++ b/src/Hamming/App/Actions.hs
@@ -0,0 +1,66 @@
+{-|
+
+Module : Hamming.App.Actions
+Description : Utilities for working with Hamming codes
+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
+.
+
+|-}
+
+module Hamming.App.Actions (
+ moveUp,
+ moveDown,
+ moveLeft,
+ moveRight
+ ) where
+
+import Lens.Micro ((%~))
+
+import Hamming.App.Types
+
+moveUp :: EditState -> EditState
+moveUp = rowNum %~
+ ( \n -> if n > 0
+ then pred n
+ else 0
+ )
+
+moveDown :: EditState -> EditState
+moveDown = rowNum %~
+ ( \n -> if n < 3
+ then succ n
+ else 3
+ )
+
+moveLeft :: EditState -> EditState
+moveLeft = colNum %~
+ ( \n -> if n > 0
+ then pred n
+ else 0
+ )
+
+moveRight :: EditState -> EditState
+moveRight = colNum %~
+ ( \n -> if n < 3
+ then succ n
+ else 3
+ )
+
+--jl
diff --git a/src/Hamming/App/Events.hs b/src/Hamming/App/Events.hs
index df45f11..b226fc7 100644
--- a/src/Hamming/App/Events.hs
+++ b/src/Hamming/App/Events.hs
@@ -32,11 +32,12 @@ import Brick.Main (halt)
import Brick.Types (BrickEvent (VtyEvent), gets, modify)
import Graphics.Vty.Input.Events
( Event (EvKey)
- , Key (KChar, KEsc)
+ , Key (..)
, Modifier (MCtrl)
)
-import Lens.Micro ((^.), (.~))
+import Lens.Micro ((^.), (.~), (%~))
+import Hamming.App.Actions
import Hamming.App.Types
-- | Handles an event
@@ -55,6 +56,22 @@ displayHandler _ = return ()
editHandler :: Handler
editHandler (VtyEvent (EvKey KEsc [])) =
modify $ appMode .~ DisplayMode
+editHandler (VtyEvent (EvKey KUp [])) =
+ modify $ appMode.editState %~ moveUp
+editHandler (VtyEvent (EvKey (KChar 'k') [])) =
+ modify $ appMode.editState %~ moveUp
+editHandler (VtyEvent (EvKey KDown [])) =
+ modify $ appMode.editState %~ moveDown
+editHandler (VtyEvent (EvKey (KChar 'j') [])) =
+ modify $ appMode.editState %~ moveDown
+editHandler (VtyEvent (EvKey KLeft [])) =
+ modify $ appMode.editState %~ moveLeft
+editHandler (VtyEvent (EvKey (KChar 'h') [])) =
+ modify $ appMode.editState %~ moveLeft
+editHandler (VtyEvent (EvKey KRight [])) =
+ modify $ appMode.editState %~ moveRight
+editHandler (VtyEvent (EvKey (KChar 'l') [])) =
+ modify $ appMode.editState %~ moveRight
editHandler _ = return ()
--jl
diff --git a/test/Hamming/App/ActionsSpec.hs b/test/Hamming/App/ActionsSpec.hs
new file mode 100644
index 0000000..7887ce5
--- /dev/null
+++ b/test/Hamming/App/ActionsSpec.hs
@@ -0,0 +1,105 @@
+{-
+
+hamming
+Copyright (C) Jonathan Lamothe
+
+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
+.
+
+-}
+
+module Hamming.App.ActionsSpec (spec) where
+
+import Lens.Micro ((&), (.~))
+import Test.Hspec (Spec, context, describe, it, shouldBe)
+
+import Hamming.App.Actions
+import Hamming.App.Types
+
+spec :: Spec
+spec = describe "Actions" $ do
+ moveUpSpec
+ moveDownSpec
+ moveLeftSpec
+ moveRightSpec
+
+moveUpSpec :: Spec
+moveUpSpec = describe "moveUp" $ mapM_
+ ( \(desc, state, expected) -> context desc $ let
+ actual = moveUp state
+ in it ("should be " ++ show expected) $
+ actual `shouldBe` expected
+ )
+ [ ( "at the top", atTop, atTop )
+ , ( "elsewhere", elsewhere, movedUp )
+ ] where
+ atTop = initialEditor & colNum .~ 1
+ elsewhere = atTop & rowNum .~ 2
+ movedUp = atTop & rowNum .~ 1
+
+moveDownSpec :: Spec
+moveDownSpec = describe "moveDown" $ mapM_
+ ( \(desc, state, expected) -> context desc $ let
+ actual = moveDown state
+ in it ("should be " ++ show expected) $
+ actual `shouldBe` expected
+ )
+ [ ( "at the bottom", atBottom, atBottom )
+ , ( "elsewhere", elsewhere, movedDown )
+ ] where
+ atBottom = initialEditor
+ & colNum .~ 1
+ & rowNum .~ 3
+ elsewhere = initialEditor
+ & colNum .~ 1
+ & rowNum .~ 1
+ movedDown = initialEditor
+ & colNum .~ 1
+ & rowNum .~ 2
+
+moveLeftSpec :: Spec
+moveLeftSpec = describe "moveLeft" $ mapM_
+ ( \(desc, state, expected) -> context desc $ let
+ actual = moveLeft state
+ in it ("should be " ++ show expected) $
+ actual `shouldBe` expected
+ )
+ [ ( "at left", atLeft, atLeft )
+ , ( "elsewhere", elsewhere, movedLeft )
+ ] where
+ atLeft = initialEditor & rowNum .~ 1
+ elsewhere = atLeft & colNum .~ 2
+ movedLeft = atLeft & colNum .~ 1
+
+moveRightSpec :: Spec
+moveRightSpec = describe "moveRight" $ mapM_
+ ( \(desc, state, expected) -> context desc $ let
+ actual = moveRight state
+ in it ("should be " ++ show expected) $
+ actual `shouldBe` expected
+ )
+ [ ( "at right", atRight, atRight )
+ , ( "elsewhere", elsewhere, movedRight )
+ ] where
+ atRight = initialEditor
+ & rowNum .~ 1
+ & colNum .~ 3
+ elsewhere = initialEditor
+ & rowNum .~ 1
+ & colNum .~ 1
+ movedRight = initialEditor
+ & rowNum .~ 1
+ & colNum .~ 2
+
+--jl
diff --git a/test/Hamming/AppSpec.hs b/test/Hamming/AppSpec.hs
index f9b56d0..3f2d67c 100644
--- a/test/Hamming/AppSpec.hs
+++ b/test/Hamming/AppSpec.hs
@@ -23,11 +23,13 @@ module Hamming.AppSpec (spec) where
import Test.Hspec (Spec, describe)
+import qualified Hamming.App.ActionsSpec as Actions
import qualified Hamming.App.UtilSpec as Util
import qualified Hamming.App.WidgetsSpec as Widgets
spec :: Spec
spec = describe "App" $ do
+ Actions.spec
Util.spec
Widgets.spec