From a3259f3b7d9d3c1978134912359a3e4550295107 Mon Sep 17 00:00:00 2001
From: Jonathan Lamothe <jonathan@jlamothe.net>
Date: Thu, 22 Aug 2024 18:21:07 -0400
Subject: [PATCH] implemented shifting of entire rung

---
 src/Abacus/App/Actions.hs      | 13 ++++++++++++-
 src/Abacus/App/Events.hs       | 20 +++++++++++++++++++-
 src/Abacus/App/Types.hs        |  2 ++
 test/Abacus/App/ActionsSpec.hs | 20 ++++++++++++++++++++
 4 files changed, 53 insertions(+), 2 deletions(-)

diff --git a/src/Abacus/App/Actions.hs b/src/Abacus/App/Actions.hs
index e1bc2aa..ff5cc37 100644
--- a/src/Abacus/App/Actions.hs
+++ b/src/Abacus/App/Actions.hs
@@ -31,9 +31,11 @@ module Abacus.App.Actions (
   -- * Bead Movement
   beadLeft,
   beadRight,
+  rungLeft,
+  rungRight,
   ) where
 
-import Lens.Micro.Platform ((^.), (&), (%~))
+import Lens.Micro.Platform ((^.), (&), (.~), (%~))
 
 import Abacus
 import Abacus.App.Types
@@ -55,4 +57,13 @@ beadLeft s = s & abacus.rungL (s^.rungNum) %~ pred
 beadRight :: AppState -> AppState
 beadRight s = s & abacus.rungL (s^.rungNum) %~ succ
 
+-- | Moves all beads to the left of the rung
+rungLeft :: AppState -> AppState
+rungLeft s = s & abacus.rungL (s^.rungNum) .~ 0
+
+-- | Moves all beads to the right of the rung
+rungRight :: AppState -> AppState
+rungRight s =
+  s & abacus.rungL (s^.rungNum) .~ getNumBeads (s^.abacus)
+
 --jl
diff --git a/src/Abacus/App/Events.hs b/src/Abacus/App/Events.hs
index b5e5127..1a2ff87 100644
--- a/src/Abacus/App/Events.hs
+++ b/src/Abacus/App/Events.hs
@@ -40,10 +40,12 @@ import Brick.Keybindings
   , keyEvents
   , newKeyConfig
   , onEvent
+  , shift
   )
 import Control.Monad.State.Class (modify)
 import Data.Either (fromRight)
-import Graphics.Vty.Input.Events (Key (KUp, KDown, KLeft, KRight))
+import Graphics.Vty.Input.Events
+  (Key (KUp, KDown, KLeft, KRight, KHome, KEnd))
 
 import Abacus.App.Actions
 import Abacus.App.Types
@@ -69,6 +71,10 @@ eventBindings =
     modify beadLeft
   , onEvent BeadRightE "Moves a bead to the right" $
     modify beadRight
+  , onEvent RungLeftE "Moves all beads to the left of the rung" $
+    modify rungLeft
+  , onEvent RungRightE "Moves all beads to the right of the rung" $
+    modify rungRight
   ]
 
 -- | Key bindings
@@ -99,6 +105,18 @@ keyBindings =
       , bind 'l'
       ]
     )
+  , ( RungLeftE
+    , [ shift KLeft
+      , bind KHome
+      , bind 'H'
+      ]
+    )
+  , ( RungRightE
+    , [ shift KRight
+      , bind KEnd
+      , bind 'L'
+      ]
+    )
   ]
 
 --jl
diff --git a/src/Abacus/App/Types.hs b/src/Abacus/App/Types.hs
index 6455c6c..a580b18 100644
--- a/src/Abacus/App/Types.hs
+++ b/src/Abacus/App/Types.hs
@@ -56,6 +56,8 @@ data KeyEventID
   | MoveDownE
   | BeadLeftE
   | BeadRightE
+  | RungLeftE
+  | RungRightE
   deriving (Eq, Ord, Show)
 
 makeLenses ''AppState
diff --git a/test/Abacus/App/ActionsSpec.hs b/test/Abacus/App/ActionsSpec.hs
index b1023a9..e42d454 100644
--- a/test/Abacus/App/ActionsSpec.hs
+++ b/test/Abacus/App/ActionsSpec.hs
@@ -35,6 +35,8 @@ spec = describe "Actions" $ do
   moveDownSpec
   beadLeftSpec
   beadRightSpec
+  rungLeftSpec
+  rungRightSpec
 
 moveUpSpec :: Spec
 moveUpSpec = describe "moveUp" $ mapM_
@@ -84,4 +86,22 @@ beadRightSpec = describe "beadRight" $ let
   in it ("should be " ++ show expected) $
     beadRight state `shouldBe` expected
 
+rungLeftSpec :: Spec
+rungLeftSpec = describe "rungLeft" $ let
+  state = initialState
+    & rungNum .~ 5
+    & abacus .~ Abacus 10 [1..10]
+  expected = state & abacus.rungL 5 .~ 0
+  in it ("should be " ++ show expected) $
+    rungLeft state `shouldBe` expected
+
+rungRightSpec :: Spec
+rungRightSpec = describe "rungRight" $ let
+  state = initialState
+    & rungNum .~ 5
+    & abacus .~ Abacus 10 [1..10]
+  expected = state & abacus.rungL 5 .~ 10
+  in it ("should be " ++ show expected) $
+    rungRight state `shouldBe` expected
+
 --jl