From 5857d01a6badd38f9a216d090b047474b19569c3 Mon Sep 17 00:00:00 2001
From: Andrew Cady <d@jerkface.net>
Date: Mon, 3 Oct 2022 23:33:19 -0400
Subject: initial commit

---
 repgoal.hs | 145 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 145 insertions(+)
 create mode 100755 repgoal.hs

(limited to 'repgoal.hs')

diff --git a/repgoal.hs b/repgoal.hs
new file mode 100755
index 0000000..b9c6df3
--- /dev/null
+++ b/repgoal.hs
@@ -0,0 +1,145 @@
+#!/usr/bin/env stack
+{- stack script --resolver lts-19.23 --install-ghc -}
+{-# OPTIONS_GHC
+  -Wall
+  -Wno-unused-imports
+  -Wno-unused-top-binds
+  -Wno-name-shadowing
+#-}
+{-# language NoImplicitPrelude #-}
+{-# language RecordWildCards #-}
+{-# language FlexibleContexts #-}
+{-# language TemplateHaskell #-}
+{-# language ViewPatterns #-}
+{-# language OverloadedStrings #-}
+import Rebase.Prelude hiding (toList, on, (<+>), Max)
+import qualified Rebase.Prelude as Prelude
+import Control.Lens hiding ((<|))
+import Data.Foldable (toList)
+import Data.Ratio
+import Text.Printf
+import Graphics.Vty
+import Data.Time.LocalTime
+import Control.Monad.RWS
+import Data.Time.Calendar.OrdinalDate
+import qualified Data.Text as Text
+import Data.Text.Format.Numbers
+import Rebase.Data.Map.Strict (Map)
+import qualified Rebase.Data.Map.Strict as Map
+
+import Brick
+import Brick.Types
+import Data.Text (unpack)
+import Control.Lens
+import Control.Monad (void, forever)
+import Control.Concurrent (threadDelay, forkIO)
+import qualified Graphics.Vty as V
+import Brick.Widgets.ProgressBar as P
+import Brick.BChan
+import Brick.Widgets.Center
+import Brick.Widgets.Border
+import Brick.Main
+  ( App(..)
+  , showFirstCursor
+  , customMain
+  , continue
+  , halt
+  )
+import Brick.AttrMap
+  ( attrMap
+  )
+import Brick.Types
+  ( Widget
+  , Next
+  , EventM
+  , BrickEvent(..)
+  )
+import Brick.Widgets.Core
+  ( (<=>)
+  , str
+  )
+import Brick.AttrMap as A
+import Brick.Util (fg, bg, on, clamp)
+import Brick.Widgets.Core
+import Brick.Widgets.Table
+
+data ExerciseStats = ExerciseStats {
+  exerciseName :: Text,
+  achievedReps :: Integer,
+  achievedWeight :: Rational
+}
+
+data ExerciseTarget = ExerciseTarget {
+  targetWeight :: Rational,
+  stats :: ExerciseStats
+}
+
+exercises :: [ExerciseTarget]
+exercises = [
+              ExerciseTarget 345 $ ExerciseStats "Deadlift" 9 315,
+              ExerciseTarget 130 $ ExerciseStats "Press" 9 120
+            ]
+
+computeRepGoal :: ExerciseTarget -> (Integer)
+computeRepGoal ExerciseTarget{..} = head $ filter isPR [2..]
+  where
+    isPR n = let goal1rm = computeOneRepMax $ stats { achievedReps = n, achievedWeight = targetWeight }
+             in goal1rm > computeOneRepMax stats
+
+-- The 1RM estimation formula from Jim Wendler's 5-3-1 Powerlifting
+-- manual:
+
+-- Estimated 1 RM = Weight x Reps x 0.0333 + Weight.
+
+computeOneRepMax :: ExerciseStats -> Rational
+computeOneRepMax ExerciseStats{..} = achievedWeight * (realToFrac achievedReps * 0.0333 + 1)
+
+showRational :: Rational -> String
+showRational = printf "%.3f" . (realToFrac :: Rational -> Float)
+
+drawUI :: () -> [Widget ()]
+drawUI () = [a]
+  where
+    a = hCenter $ renderTable $ table $
+        [str "Exercise", str "Achieved Reps", str "Computed 1RM", str "Weight", str "Goal Reps", str "Goal 1RM"] : map toRow exercises
+    toRow x@ExerciseTarget{..} =
+      let ExerciseStats{..} = stats
+          repGoal = computeRepGoal x
+          oneRepMaxGoal = computeOneRepMax $ ExerciseStats exerciseName repGoal targetWeight
+      in
+      [
+        txt exerciseName,
+        str $ printf "%d @ %s" achievedReps (showRational achievedWeight),
+        str $ showRational $ computeOneRepMax stats,
+        str $ showRational targetWeight,
+        str $ show repGoal,
+        str $ showRational oneRepMaxGoal
+      ]
+      where
+
+type St = ()
+
+type CustomEvent = ()
+
+handleEvent :: St -> BrickEvent () CustomEvent -> EventM () (Next St)
+handleEvent st e = case e of
+  VtyEvent (V.EvKey V.KEsc [])         -> halt st
+  VtyEvent _                           -> continue st
+  AppEvent _                           -> continue st
+  _ -> continue st
+
+theApp :: App St CustomEvent ()
+theApp =
+    App { appDraw = drawUI
+        , appChooseCursor = showFirstCursor
+        , appHandleEvent = handleEvent
+        , appStartEvent = return
+        , appAttrMap = const $ A.attrMap V.defAttr []
+        }
+
+main :: IO ()
+main = do
+    let buildVty = V.mkVty V.defaultConfig
+    initialVty <- buildVty
+    chan <- newBChan 10
+    void $ customMain initialVty buildVty (Just chan) (theApp) ()
-- 
cgit v1.2.3