better support for cycling through routines

2 files changed, 26 insertions, 10 deletions

diff --git a/package.yaml b/package.yaml
index 441c46e..70a66fd 100644
--- a/package.yaml
+++ b/package.yaml
@@ -15,6 +15,7 @@ dependencies:
 - text
 - generic-data
 - pretty-simple
+- nonempty-containers
 
 executables:
   repgoal:
diff --git a/repgoal.hs b/repgoal.hs
index be91712..51820fb 100755
--- a/repgoal.hs
+++ b/repgoal.hs
@@ -18,8 +18,10 @@
 import Rebase.Prelude hiding (toList, on, (<+>), Max)
 import qualified Rebase.Prelude as Prelude
 import qualified Data.Set as Set
-import qualified Data.List.NonEmpty as NonEmpty
-import Data.List.NonEmpty (NonEmpty)
+import qualified Data.Sequence as Seq
+import qualified Data.Sequence.NonEmpty as NESeq
+import Data.Sequence (Seq(..))
+import Data.Sequence.NonEmpty (NESeq(..))
 import Control.Lens hiding ((<|))
 import Data.Foldable (toList)
 import Data.Ratio
@@ -132,7 +134,8 @@ data WeekSelection = Week1 | Week2 | Week3 deriving (Enum, Bounded, Show, Eq)
 data St = St {
   _lifts :: [LiftRecord],
   _week :: WeekSelection,
-  _routines :: NonEmpty (Set Text)
+  _routines :: NESeq (Set Text),
+  _selectedRoutine :: Int
 }
 makeLenses ''St
 
@@ -166,10 +169,12 @@ annotatePosition :: [a] -> [(ListPosition, a)]
 annotatePosition [] = undefined
 annotatePosition (x:xs) = (FirstInList, x) : map (NotFirstInList,) xs
 
+lookup' i seq = fromJust $ NESeq.lookup (i `mod` NESeq.length seq) seq
+
 drawUI :: St -> [Widget ()]
 drawUI st = [vCenter $ vBox [hCenter oneRepMaxTable, header, withVScrollBarHandles $ withVScrollBars OnRight $ viewport () Vertical $ hCenter lastSetTable]]
   where
-    lifts' = filter ((flip Set.member $ view routines st & NonEmpty.head) . liftName) (view lifts st)
+    lifts' = filter ((flip Set.member $ view routines st & lookup' (view selectedRoutine st)) . liftName) (view lifts st)
     lastSetTable = renderTable $ table $ map (padLeftRight 1 . str) ["Lift", "Set", "Goal", "Done", "Rest"] : concatMap (toLiftRows (view week st)) lifts'
     header = str $ "Week " ++ case (view week st) of Week1 -> "1"; Week2 -> "2"; Week3 -> "3"
     oneRepMaxTable = renderTable $ table $ map (padLeftRight 1 . str) ["Lift", "Achieved Best", "Computed 1RM"] : map toRow lifts'
@@ -210,13 +215,22 @@ succ' :: (Enum a, Bounded a, Eq a) => a -> a
 succ' x | x == maxBound = minBound
 succ' x = succ x
 
+clipSelectedRoutine :: St -> St
+clipSelectedRoutine st = st & selectedRoutine %~ maybeReset
+  where
+    len = view (routines . to NESeq.length) st
+    maybeReset n | n < 0 = len
+    maybeReset n | n < len = n
+    maybeReset _ | otherwise = 0
+
 handleEvent :: St -> BrickEvent () CustomEvent -> EventM () (Next St)
 handleEvent st e = case e of
   VtyEvent (V.EvKey V.KEsc [])         -> halt st
   VtyEvent (V.EvKey V.KDown _)         -> M.vScrollBy (M.viewportScroll ()) 5    >> continue st
   VtyEvent (V.EvKey V.KUp _)           -> M.vScrollBy (M.viewportScroll ()) (-5) >> continue st
   VtyEvent (V.EvKey (V.KChar 'w') _)   -> continue $ st & week %~ succ'
-  VtyEvent (V.EvKey (V.KChar 'n') _)   -> continue $ st & routines %~ (NonEmpty.fromList . NonEmpty.tail)
+  VtyEvent (V.EvKey (V.KChar 'n') _)   -> continue $ st & selectedRoutine %~ (+1) & clipSelectedRoutine
+  VtyEvent (V.EvKey (V.KChar 'p') _)   -> continue $ st & selectedRoutine %~ (subtract 1) & clipSelectedRoutine
   VtyEvent _                           -> continue st
   AppEvent _                           -> continue st
   _ -> continue st
@@ -249,10 +263,11 @@ powerClean = clean * 80 / 100
 pushPress = press * 100 / 75
 jerk = pushPress / 100 * 85
 
-routine :: NonEmpty (Set Text)
-routine = NonEmpty.cycle $
-  Set.fromList ["Deadlift", "Press"] :|
-  [Set.fromList ["Front Squat"]
+routine :: NESeq (Set Text)
+routine =
+  Set.fromList ["Deadlift", "Press"] :<||
+  Seq.fromList
+  [ Set.fromList ["Front Squat"]
   , Set.fromList ["Left-Arm Snatch", "Right-Arm Snatch"]
   , Set.fromList ["Squat", "Bench"]
   , Set.fromList ["Push Press", "Power Clean"]
@@ -266,4 +281,4 @@ main = do
     -- liftIO $ setMode (outputIface vty) Mouse True
     chan <- newBChan 10
     initial <- read <$> readFile "lifts.dat" :: IO [LiftRecord]
-    void $ customMain vty buildVty (Just chan) (theApp) (St initial Week1 routine)
+    void $ customMain vty buildVty (Just chan) (theApp) (St initial Week1 routine 0)