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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
|
#!/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 Performance = Achieved {
-- achievedReps :: Integer,
-- achievedWeight :: Rational
-- }
data Performance = Achieved Integer Rational
achievedReps :: Performance -> Integer
achievedWeight :: Performance -> Rational
achievedReps (Achieved r _) = r
achievedWeight (Achieved _ w) = w
data LiftRecord = LiftRecord {
liftName :: Text,
stats :: [Performance]
}
initial :: [LiftRecord]
initial =
[
LiftRecord "Squat" [Achieved 6 270, Achieved 8 255, Achieved 5 285, Achieved 10 255, Achieved 7 280],
LiftRecord "Bench" [Achieved 7 190, Achieved 9 180, Achieved 4 205, Achieved 11 180, Achieved 8 200],
LiftRecord "Deadlift" [Achieved 5 360, Achieved 9 315, Achieved 8 345, Achieved 7 360, Achieved 10 340],
-- LiftRecord "Press" [Achieved 6 130, Achieved 9 120, Achieved 4 135]
LiftRecord "Press" [Achieved 5 120]
]
computeRepGoal :: Rational -> [Performance] -> (Integer)
computeRepGoal targetWeight stats = head $ filter isPR [2..]
where
isPR n = computeOneRepMax (Achieved n targetWeight) > computeOneRepMax (bestPerformance stats)
bestPerformance :: [Performance] -> Performance
bestPerformance = head . sortBy (flip $ comparing computeOneRepMax)
-- The formula from Jim Wendler's 5-3-1:
-- 1RM = Weight x Reps x 0.0333 + Weight.
computeOneRepMax :: Performance -> Rational
computeOneRepMax a = achievedWeight a * (realToFrac (achievedReps a) * 0.0333 + 1)
showRational :: Rational -> String
showRational n = printf format $ (realToFrac :: Rational -> Float) $ n
where
format = if floor (n * 10) `mod` 10 == (0 :: Integer) then "%.0f" else "%.2f"
drawUI :: St -> [Widget ()]
drawUI (St lifts) = [vCenter $ vBox [hCenter oneRepMaxTable, hCenter lastSetTable]]
where
lastSetTable = renderTable $ table $ map (padLeftRight 1 . str) ["Lift", "Week", "Last Set", "Goal", "Goal+1"] : concatMap toWeekRows lifts
oneRepMaxTable = renderTable $ table $ map (padLeftRight 1 . str) ["Lift", "Achieved Best", "Computed 1RM"] : map toRow lifts
toRow LiftRecord{..} =
let best = bestPerformance stats
in
map (padLeftRight 2)
[
txt $ liftName,
str $ printf "%d @ %s" (achievedReps best) (showRational $ achievedWeight best),
str $ showRational $ computeOneRepMax best
]
toWeekRows lift = (flip map) [1,2,3::Int] $ \week -> toWeekRow week lift
toWeekRow :: Int -> LiftRecord -> [Widget n]
toWeekRow week LiftRecord{..} =
let best = bestPerformance stats
targetReps = case week of 1 -> 5; 2 -> 3; 3 -> 1; _ -> undefined :: Int
targetPercentage = case week of 1 -> 85; 2 -> 90; 3 -> 95; _ -> undefined
computedTarget = (* (targetPercentage % 100)) $ (* (90 % 100)) $ computeOneRepMax best
targetWeight = ceilingN 5 computedTarget
repGoal = computeRepGoal (targetWeight % 1) stats
goalTo1RM g = computeOneRepMax $ Achieved g (targetWeight % 1)
showGoal g = printf "%2d @ %d ≈ 1 @ %s" g targetWeight (showRational (goalTo1RM g))
in
map (padLeftRight 2)
[
txt $ (if week == 1 then liftName else " "),
str $ show week,
str $ printf "%2d+ @ %d" targetReps targetWeight,
str $ showGoal repGoal,
str $ showGoal (repGoal + 1)
]
ceilingN :: Integer -> Rational -> Integer
ceilingN n x = ceiling (x / toRational n) * n
-- TODO: State contains chosen repmax formula
-- TODO: State contains performances
data St = St {
lifts :: [LiftRecord]
}
-- TODO: Event for inotify on edited text file (as input interface)
data CustomEvent = 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) (St initial)
|
