move cursor in edit mode

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

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
+<https://www.gnu.org/licenses/>.
+
+|-}
+
+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

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

test/Hamming/App/ActionsSpec.hs

@@ -0,0 +1,105 @@
+{-
+
+hamming
+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 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

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