From 5857d01a6badd38f9a216d090b047474b19569c3 Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Mon, 3 Oct 2022 23:33:19 -0400 Subject: initial commit --- .gitignore | 4 ++ Makefile | 36 +++++++++++++++ package.yaml | 24 ++++++++++ repgoal.hs | 145 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stack.yaml | 6 +++ 5 files changed, 215 insertions(+) create mode 100644 .gitignore create mode 100644 Makefile create mode 100644 package.yaml create mode 100755 repgoal.hs create mode 100644 stack.yaml 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 ) +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: -- cgit v1.2.3