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
|
#!/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 LiftTarget = LiftTarget {
liftName :: Text,
targetWeight :: Rational,
stats :: [Performance]
}
initial :: [LiftTarget]
initial =
[
LiftTarget "Deadlift" 360 $ [Achieved 5 360, Achieved 9 315, Achieved 8 345],
LiftTarget "Press" 135 $ [Achieved 6 130, Achieved 9 120],
LiftTarget "Squat" 285 $ [Achieved 6 270, Achieved 8 255, Achieved 5 285],
LiftTarget "Bench" 205 $ [Achieved 7 190, Achieved 9 180, Achieved 4 205]
]
computeRepGoal :: LiftTarget -> (Integer)
computeRepGoal LiftTarget{..} = 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 Achieved{..} = achievedWeight * (realToFrac achievedReps * 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) = [a]
where
a = vCenter $ hCenter $ renderTable $ table $
map (padLeftRight 1 . str) ["Lift", "Achieved Best", "Computed 1RM", "Goal Reps", "Goal+1"] : map toRow lifts
toRow target@LiftTarget{..} =
let best@Achieved{..} = bestPerformance stats
repGoal = computeRepGoal target
goalTo1RM g = computeOneRepMax $ Achieved g targetWeight
showGoal g = printf "%d @ %s ≈ 1 @ %s" g (showRational targetWeight) (showRational (goalTo1RM g))
in
map (padLeftRight 2)
[
txt $ liftName,
str $ printf "%d @ %s" achievedReps (showRational achievedWeight),
str $ showRational $ computeOneRepMax best,
str $ showGoal repGoal,
str $ showGoal (repGoal + 1)
]
-- TODO: State contains chosen repmax formula
-- TODO: State contains performances
data St = St {
lifts :: [LiftTarget]
}
-- 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)
|
