diff options
author | Andrew Cady <d@jerkface.net> | 2022-10-03 23:33:19 -0400 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2022-10-03 23:33:52 -0400 |
commit | 5857d01a6badd38f9a216d090b047474b19569c3 (patch) | |
tree | 30de41b1c6b40669c82746f3c12daac54e62fdf9 /repgoal.hs |
initial commit
Diffstat (limited to 'repgoal.hs')
-rwxr-xr-x | repgoal.hs | 145 |
1 files changed, 145 insertions, 0 deletions
diff --git a/repgoal.hs b/repgoal.hs new file mode 100755 index 0000000..b9c6df3 --- /dev/null +++ b/repgoal.hs | |||
@@ -0,0 +1,145 @@ | |||
1 | #!/usr/bin/env stack | ||
2 | {- stack script --resolver lts-19.23 --install-ghc -} | ||
3 | {-# OPTIONS_GHC | ||
4 | -Wall | ||
5 | -Wno-unused-imports | ||
6 | -Wno-unused-top-binds | ||
7 | -Wno-name-shadowing | ||
8 | #-} | ||
9 | {-# language NoImplicitPrelude #-} | ||
10 | {-# language RecordWildCards #-} | ||
11 | {-# language FlexibleContexts #-} | ||
12 | {-# language TemplateHaskell #-} | ||
13 | {-# language ViewPatterns #-} | ||
14 | {-# language OverloadedStrings #-} | ||
15 | import Rebase.Prelude hiding (toList, on, (<+>), Max) | ||
16 | import qualified Rebase.Prelude as Prelude | ||
17 | import Control.Lens hiding ((<|)) | ||
18 | import Data.Foldable (toList) | ||
19 | import Data.Ratio | ||
20 | import Text.Printf | ||
21 | import Graphics.Vty | ||
22 | import Data.Time.LocalTime | ||
23 | import Control.Monad.RWS | ||
24 | import Data.Time.Calendar.OrdinalDate | ||
25 | import qualified Data.Text as Text | ||
26 | import Data.Text.Format.Numbers | ||
27 | import Rebase.Data.Map.Strict (Map) | ||
28 | import qualified Rebase.Data.Map.Strict as Map | ||
29 | |||
30 | import Brick | ||
31 | import Brick.Types | ||
32 | import Data.Text (unpack) | ||
33 | import Control.Lens | ||
34 | import Control.Monad (void, forever) | ||
35 | import Control.Concurrent (threadDelay, forkIO) | ||
36 | import qualified Graphics.Vty as V | ||
37 | import Brick.Widgets.ProgressBar as P | ||
38 | import Brick.BChan | ||
39 | import Brick.Widgets.Center | ||
40 | import Brick.Widgets.Border | ||
41 | import Brick.Main | ||
42 | ( App(..) | ||
43 | , showFirstCursor | ||
44 | , customMain | ||
45 | , continue | ||
46 | , halt | ||
47 | ) | ||
48 | import Brick.AttrMap | ||
49 | ( attrMap | ||
50 | ) | ||
51 | import Brick.Types | ||
52 | ( Widget | ||
53 | , Next | ||
54 | , EventM | ||
55 | , BrickEvent(..) | ||
56 | ) | ||
57 | import Brick.Widgets.Core | ||
58 | ( (<=>) | ||
59 | , str | ||
60 | ) | ||
61 | import Brick.AttrMap as A | ||
62 | import Brick.Util (fg, bg, on, clamp) | ||
63 | import Brick.Widgets.Core | ||
64 | import Brick.Widgets.Table | ||
65 | |||
66 | data ExerciseStats = ExerciseStats { | ||
67 | exerciseName :: Text, | ||
68 | achievedReps :: Integer, | ||
69 | achievedWeight :: Rational | ||
70 | } | ||
71 | |||
72 | data ExerciseTarget = ExerciseTarget { | ||
73 | targetWeight :: Rational, | ||
74 | stats :: ExerciseStats | ||
75 | } | ||
76 | |||
77 | exercises :: [ExerciseTarget] | ||
78 | exercises = [ | ||
79 | ExerciseTarget 345 $ ExerciseStats "Deadlift" 9 315, | ||
80 | ExerciseTarget 130 $ ExerciseStats "Press" 9 120 | ||
81 | ] | ||
82 | |||
83 | computeRepGoal :: ExerciseTarget -> (Integer) | ||
84 | computeRepGoal ExerciseTarget{..} = head $ filter isPR [2..] | ||
85 | where | ||
86 | isPR n = let goal1rm = computeOneRepMax $ stats { achievedReps = n, achievedWeight = targetWeight } | ||
87 | in goal1rm > computeOneRepMax stats | ||
88 | |||
89 | -- The 1RM estimation formula from Jim Wendler's 5-3-1 Powerlifting | ||
90 | -- manual: | ||
91 | |||
92 | -- Estimated 1 RM = Weight x Reps x 0.0333 + Weight. | ||
93 | |||
94 | computeOneRepMax :: ExerciseStats -> Rational | ||
95 | computeOneRepMax ExerciseStats{..} = achievedWeight * (realToFrac achievedReps * 0.0333 + 1) | ||
96 | |||
97 | showRational :: Rational -> String | ||
98 | showRational = printf "%.3f" . (realToFrac :: Rational -> Float) | ||
99 | |||
100 | drawUI :: () -> [Widget ()] | ||
101 | drawUI () = [a] | ||
102 | where | ||
103 | a = hCenter $ renderTable $ table $ | ||
104 | [str "Exercise", str "Achieved Reps", str "Computed 1RM", str "Weight", str "Goal Reps", str "Goal 1RM"] : map toRow exercises | ||
105 | toRow x@ExerciseTarget{..} = | ||
106 | let ExerciseStats{..} = stats | ||
107 | repGoal = computeRepGoal x | ||
108 | oneRepMaxGoal = computeOneRepMax $ ExerciseStats exerciseName repGoal targetWeight | ||
109 | in | ||
110 | [ | ||
111 | txt exerciseName, | ||
112 | str $ printf "%d @ %s" achievedReps (showRational achievedWeight), | ||
113 | str $ showRational $ computeOneRepMax stats, | ||
114 | str $ showRational targetWeight, | ||
115 | str $ show repGoal, | ||
116 | str $ showRational oneRepMaxGoal | ||
117 | ] | ||
118 | where | ||
119 | |||
120 | type St = () | ||
121 | |||
122 | type CustomEvent = () | ||
123 | |||
124 | handleEvent :: St -> BrickEvent () CustomEvent -> EventM () (Next St) | ||
125 | handleEvent st e = case e of | ||
126 | VtyEvent (V.EvKey V.KEsc []) -> halt st | ||
127 | VtyEvent _ -> continue st | ||
128 | AppEvent _ -> continue st | ||
129 | _ -> continue st | ||
130 | |||
131 | theApp :: App St CustomEvent () | ||
132 | theApp = | ||
133 | App { appDraw = drawUI | ||
134 | , appChooseCursor = showFirstCursor | ||
135 | , appHandleEvent = handleEvent | ||
136 | , appStartEvent = return | ||
137 | , appAttrMap = const $ A.attrMap V.defAttr [] | ||
138 | } | ||
139 | |||
140 | main :: IO () | ||
141 | main = do | ||
142 | let buildVty = V.mkVty V.defaultConfig | ||
143 | initialVty <- buildVty | ||
144 | chan <- newBChan 10 | ||
145 | void $ customMain initialVty buildVty (Just chan) (theApp) () | ||