initial commit

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 @@
+.stack-work/
+bin
+rep-goal-calc.cabal
+stack.yaml.lock
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..92becce
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,36 @@
+stack_path != which stack
+
+all: $(if $(stack_path),,install-stack)
+        stack build
+        ln -sfT $$(stack path --local-install-root)/bin ./bin
+
+.PHONY: all run install install-dev-tools
+
+run: all
+        ./bin/repgoal
+
+install:
+        stack install
+
+install-dev-tools:
+        stack install apply-refact hlint stylish-haskell hasktags hoogle
+
+become_root != [ "$$(id -u)" = 0 ] || echo sudo
+install-stack:
+ifneq (,$(shell which curl))
+        curl -sSL https://get.haskellstack.org/ | sh
+else
+ifneq (,$(shell which wget))
+        wget -qO- https://get.haskellstack.org/ | sh
+else
+ifneq (,$(shell which apt))
+        $(become_root) apt install haskell-stack
+else
+        $(error No stack binary found; and no known means of installing (no curl, wget, or apt).\
+        Follow instructions at <https://haskellstack.org>)
+endif
+endif
+endif
+
+%.html: %.md
+        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 @@
+name:                rep-goal-calc
+version:             0.1.0.0
+
+dependencies:
+- base
+- rebase
+- lens
+- vty
+- time
+- mtl
+- data-default
+- containers
+- brick
+- format-numbers
+- text
+
+executables:
+  repgoal:
+    main:                repgoal.hs
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+
diff --git a/repgoal.hs b/repgoal.hs
new file mode 100755
index 0000000..b9c6df3
--- /dev/null
+++ b/repgoal.hs
@@ -0,0 +1,145 @@
+#!/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 $
+        [str "Exercise", str "Achieved Reps", str "Computed 1RM", str "Weight", str "Goal Reps", str "Goal 1RM"] : map toRow exercises
+    toRow x@ExerciseTarget{..} =
+      let ExerciseStats{..} = stats
+          repGoal = computeRepGoal x
+          oneRepMaxGoal = computeOneRepMax $ ExerciseStats exerciseName repGoal targetWeight
+      in
+      [
+        txt exerciseName,
+        str $ printf "%d @ %s" achievedReps (showRational achievedWeight),
+        str $ showRational $ computeOneRepMax stats,
+        str $ showRational targetWeight,
+        str $ show repGoal,
+        str $ showRational oneRepMaxGoal
+      ]
+      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) ()
diff --git a/stack.yaml b/stack.yaml
new file mode 100644
index 0000000..86de4af
--- /dev/null
+++ b/stack.yaml
@@ -0,0 +1,6 @@
+resolver:
+  url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/23.yaml
+packages:
+- .
+compiler-check: newer-minor
+extra-deps: