From 2a46e085d5885bb25aa1ab18e86329b84b35f721 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Thu, 1 Aug 2024 19:26:22 -0400 Subject: [PATCH] move cursor in edit mode --- hamming.cabal | 2 + src/Hamming/App/Actions.hs | 66 ++++++++++++++++++++ src/Hamming/App/Events.hs | 21 ++++++- test/Hamming/App/ActionsSpec.hs | 105 ++++++++++++++++++++++++++++++++ test/Hamming/AppSpec.hs | 2 + 5 files changed, 194 insertions(+), 2 deletions(-) create mode 100644 src/Hamming/App/Actions.hs create mode 100644 test/Hamming/App/ActionsSpec.hs 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