diff options
-rw-r--r-- | .gitignore | 4 | ||||
-rw-r--r-- | Makefile | 36 | ||||
-rw-r--r-- | package.yaml | 24 | ||||
-rwxr-xr-x | repgoal.hs | 145 | ||||
-rw-r--r-- | stack.yaml | 6 |
5 files changed, 215 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..8e9be6a --- /dev/null +++ b/.gitignore | |||
@@ -0,0 +1,4 @@ | |||
1 | .stack-work/ | ||
2 | bin | ||
3 | rep-goal-calc.cabal | ||
4 | stack.yaml.lock | ||
diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..92becce --- /dev/null +++ b/Makefile | |||
@@ -0,0 +1,36 @@ | |||
1 | stack_path != which stack | ||
2 | |||
3 | all: $(if $(stack_path),,install-stack) | ||
4 | stack build | ||
5 | ln -sfT $$(stack path --local-install-root)/bin ./bin | ||
6 | |||
7 | .PHONY: all run install install-dev-tools | ||
8 | |||
9 | run: all | ||
10 | ./bin/repgoal | ||
11 | |||
12 | install: | ||
13 | stack install | ||
14 | |||
15 | install-dev-tools: | ||
16 | stack install apply-refact hlint stylish-haskell hasktags hoogle | ||
17 | |||
18 | become_root != [ "$$(id -u)" = 0 ] || echo sudo | ||
19 | install-stack: | ||
20 | ifneq (,$(shell which curl)) | ||
21 | curl -sSL https://get.haskellstack.org/ | sh | ||
22 | else | ||
23 | ifneq (,$(shell which wget)) | ||
24 | wget -qO- https://get.haskellstack.org/ | sh | ||
25 | else | ||
26 | ifneq (,$(shell which apt)) | ||
27 | $(become_root) apt install haskell-stack | ||
28 | else | ||
29 | $(error No stack binary found; and no known means of installing (no curl, wget, or apt).\ | ||
30 | Follow instructions at <https://haskellstack.org>) | ||
31 | endif | ||
32 | endif | ||
33 | endif | ||
34 | |||
35 | %.html: %.md | ||
36 | pandoc -f markdown -t html -o $@ $^ | ||
diff --git a/package.yaml b/package.yaml new file mode 100644 index 0000000..8fe8bbc --- /dev/null +++ b/package.yaml | |||
@@ -0,0 +1,24 @@ | |||
1 | name: rep-goal-calc | ||
2 | version: 0.1.0.0 | ||
3 | |||
4 | dependencies: | ||
5 | - base | ||
6 | - rebase | ||
7 | - lens | ||
8 | - vty | ||
9 | - time | ||
10 | - mtl | ||
11 | - data-default | ||
12 | - containers | ||
13 | - brick | ||
14 | - format-numbers | ||
15 | - text | ||
16 | |||
17 | executables: | ||
18 | repgoal: | ||
19 | main: repgoal.hs | ||
20 | ghc-options: | ||
21 | - -threaded | ||
22 | - -rtsopts | ||
23 | - -with-rtsopts=-N | ||
24 | |||
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) () | ||
diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..86de4af --- /dev/null +++ b/stack.yaml | |||
@@ -0,0 +1,6 @@ | |||
1 | resolver: | ||
2 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/23.yaml | ||
3 | packages: | ||
4 | - . | ||
5 | compiler-check: newer-minor | ||
6 | extra-deps: | ||