1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
#!/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 $
map str ["Exercise", "Achieved Reps", "Computed 1RM", "Goal Reps", "Goal+1"] : map toRow exercises
toRow x@ExerciseTarget{..} =
let ExerciseStats{..} = stats
repGoal = computeRepGoal x
goalTo1RM g = computeOneRepMax $ ExerciseStats exerciseName g targetWeight
in
[
txt exerciseName,
str $ printf "%d @ %s" achievedReps (showRational achievedWeight),
str $ showRational $ computeOneRepMax stats,
str $ printf "%d @ %s ≈ 1 @ %s" (repGoal) (showRational targetWeight) (showRational (goalTo1RM repGoal)),
str $ printf "%d @ %s ≈ 1 @ %s" (repGoal + 1) (showRational targetWeight) (showRational (goalTo1RM $ repGoal + 1))
]
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) ()
|
