log.hs

{-# LANGUAGE TypeApplications, GADTs, FlexibleInstances, OverloadedLists #-}

module History where

import Lib
import Control.Monad (join)
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.List.NonEmpty as NEL
import Data.List.NonEmpty (NonEmpty(..))
import Data.Time (Day, fromGregorian)
import qualified Data.List as List

history :: NonEmpty Session
history =
    [ 2019 05 07 #:
        [ bench press %:
            155 x 5 x 5
        , deadlift %:
            [ 225 x 5
            , 275 x 3
            ] <>
            315 x 1 x 3
        , db rows %:
            45 x 12 x 6
        ]
    , 2019 04 15 #:
        [ press %:
            100 x 5 x 5
        , deadlift %:
            225 x 5 x 3
        , bb curl %:
            45 x 20 x 4
        ]

    , 2019 04 11 #:
        [ bench press %:
            [ 155 x 5
            , 165 x 3
            , 175 x 2
            , 185 x 1
            , 195 x 1
            , 205 x 1
            , 185 x 3
            , 155 x 5
            , 155 x 5
            , 155 x 5
            , 135 x 10
            ]
        , squat %:
            [ 155 x 5
            , 185 x 3
            , 195 x 1
            , 205 x 1
            , 215 x 1
            , 225 x 1
            , 235 x 1
            ]
        , bb curls %:
            45 x 15 x 3
        ]

    , 2019 04 08 #:
        [ press %:
            100 x 5 x 3
            <>
            [ 115 x 3
            , 125 x 3
            , 135 x 2
            , 115 x 3
            , 95 x 5
            ]
        , deadlift %:
            [ 135 x 5
            , 185 x 5
            , 225 x 5
            , 245 x 2
            , 265 x 2
            , 275 x 1
            , 295 x 1
            , 315 x 1
            ]
        , bb curls %:
            45 x 20 x 3

    , 2019 04 01 #:
        [ bench press %:
            [ 135 x 5
            , 145 x 5
            , 155 x 5
            ] <> 165 x 5 x 3 <>
            [ 155 x 5
            , 135 x 5
            ]
        , squat %:
            185 x 5 x 3
        ]

    , 2019 03 30 #:
        [ press %:
            95 x 5 x 2
            <>
            [ 95 x 8
            , 105 x 3
            , 115 x 3
            , 125 x 1
            , 135 x 1
            ]
        , squat %:
            [ 150 x 5
            , 165 x 5
            , 185 x 5
            , 205 x 5
            , 225 x 5
            ]
        , db curl %:
            20 x 15 x 4
        ]

    , 2019 03 27 #:
        [ bench press %:
            125 x 5 x 2
            <>
            125 x 8 x 1
        , deadlift %:
            [ 145 x 5
            , 155 x 5
            , 165 x 5
            , 175 x 5
            ]
        , db press %:
            30 x 12 x 4
        , db row %:
            50 x 12 x 4
        , latPull %:
            [ 60 x 10
            , 70 x 10
            , 80 x 10
            , 90 x 10
            , 100 x 10
            ]
        ]

    , 2019 03 25 #:
        [ squat %:
            145 x 5 x 2
            <>
            145 x 8 x 1
        , press %:
            90 x 5 x 2
            <>
            90 x 9 x 1
        , curl %:
            55 x 12 x 4
        , press %:
            55 x 12 x 4
        ]

    , 2019 03 23 #:
        [ squat %:
            140 x 5 x 2
            <>
            140 x 8 x 1
        , bench press %:
            120 x 5 x 2
            <>
            120 x 8 x 1
        , db row %:
            50 x 12 x 4
        , db press %:
            25 x 12 x 4
        ]

    , 2019 03 19 #:
        [ press %:
            85 x 5 x 2
            <>
            85 x 12 x 1
        , deadlift %:
            135 x 5 x 1
        , reverseHyper %:
            20 x 12 x 3
        ]

    , 2019 03 17 #:
        [ squat %:
            135 x 5 x 3
        , bench press %:
            [ 115 x 5
            , 115 x 5
            , 115 x 12
            ]
        , db row %:
            60 x 12 x 4
        ]
    ]

unspeakable-horror.hs

{-# LANGUAGE TypeApplications, GADTs, FlexibleInstances, OverloadedLists #-}

module Lib where

import Control.Monad (join)
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.List.NonEmpty as NEL
import Data.List.NonEmpty (NonEmpty(..))
import Data.Time (Day, fromGregorian)
import qualified Data.List as List

data Lift = Lift { liftName :: String, liftSets :: NonEmpty Set }

(%:) :: String -> NonEmpty Set -> Lift
name %: lifts = Lift name lifts

(#:) :: Day -> NonEmpty Lift -> Session
(#:) = flip Session

(*:) :: Set -> Int -> NonEmpty Set
(*:) w i = w :| replicate (i-1) w

infixr 4 *:

infixr 3 %:


lift :: String -> NonEmpty Set -> Lift
lift = Lift

x :: ()
x = ()

instance (a ~ Int) => Num (() -> a -> Set) where
    fromInteger i =  \_ r -> Set (Weight (fromInteger i)) (Reps r)
    (+) = undefined
    (*) = undefined
    abs = undefined
    signum = undefined
    negate = undefined

instance (a ~ Int, b ~ Int) => Num (() -> a -> () -> b -> NonEmpty Set) where
    fromInteger i = \() r () s -> fromInteger i x r *: s
    (+) = undefined
    (*) = undefined
    abs = undefined
    signum = undefined
    negate = undefined

instance (a ~ Int, b ~ Int) => Num (a -> b -> Day) where
    fromInteger y m d = fromGregorian y m d
    (+) = undefined
    (*) = undefined
    abs = undefined
    signum = undefined
    negate = undefined

foo :: Set
foo = 60 x 5

newtype Reps = Reps { unReps :: Int }
    deriving (Eq, Ord)

newtype Weight = Weight { weightAmount :: Double }

data Set = Set
    { setWeight :: Weight
    , setReps :: Reps
    }

data Session = Session
    { sessionLifts :: NonEmpty Lift
    , sessionDate :: Day
    -- ^ If the date is 'Nothing', then this is a planned workout and not
    -- one that has actually occurred yet.
    }

data Entry = Entry Day (Either Bodyweight Session)

type History = NonEmpty Entry

newtype Bodyweight = Bodyweight { unBodyweight :: Weight }

greyskullStep :: Set -> Set
greyskullStep (Set weight reps) =
    Set newWeight (Reps 5)
  where
    newWeight
        | Reps 10 >= reps =
            Weight (weightAmount weight + 10)
        | Reps 5 >= reps =
            Weight (weightAmount weight + 5)
        | otherwise =
            Weight
                . fromInteger . (* 5) . floor . (/ 5) . (* 0.9)
                . weightAmount $ weight

wilksFormula :: Bodyweight -> Weight -> Double
wilksFormula bw (Weight total) = (total *) $
    500
    /
    sum ([a, b * x, c * x ^ 2, d * x ^ 3, e * x ^ 4, f * x ^ 5] :: [Double])
  where
    a = -216.0475144
    b = 16.260339
    c = -0.002388645
    d = -0.00113732
    e = 7.01863E-06
    f = -1.291E-08
    Bodyweight (Weight x) = bw

dateLifts :: NonEmpty Session -> Map Day (NonEmpty Lift)
dateLifts = foldr (\s -> Map.insert (sessionDate s) (sessionLifts s)) Map.empty

-- | Property:
--
-- >>> all (all ((str ==) . liftName)) (onlyLiftsOf str)
-- True
onlyLiftsOf :: String -> Map Day (NonEmpty Lift) -> Map Day (NonEmpty Lift)
onlyLiftsOf str = Map.mapMaybe (NEL.nonEmpty . NEL.filter p) . Map.filter (any p)
  where
    p = (str ==) . liftName

bestSet :: NonEmpty Set -> Set
bestSet = id
    . head
    . List.sortOn e1rm
    . NEL.toList

--
findLast :: String -> NonEmpty Session -> Maybe Session
findLast lift = id
    . fmap (\(a, b) -> Session b a)
    . Map.lookupMax
    . onlyLiftsOf lift
    . dateLifts

currentWilks :: NonEmpty Session -> Bodyweight -> Maybe Double
currentWilks sess bw =
    wilksFormula <$> pure bw <*> liftSessions
  where
    liftSessions :: Maybe Weight
    liftSessions = case (,,) <$> msq <*> mdl <*> mbp of
        Nothing -> Nothing
        Just (sq, dl, bp) -> Just $
           Weight $ sum @[] [f sq, f dl, f bp]

    f :: Session -> Double
    f = weightAmount . setWeight . bestSet . join . fmap liftSets . sessionLifts

    msq = findLast squat sess
    mdl = findLast deadlift sess
    mbp = findLast (bench press) sess

squat, press, row, deadlift, curl, reverseHyper, latPull :: String
squat = "Squat"
press = "Press"
row = "Row"
deadlift = "Deadlift"
curl = "Curl"
reverseHyper = "Reverse Hyper"
latPull = "Lat Pull"

pf :: String -> String -> String
pf i a = (i ++ " " ++ a)

bench, db, romanian :: String -> String
bench = pf "Bench "
db = pf "DB "
romanian = pf "Romanian "

e1rm :: Set -> Double
e1rm (Set (Weight w) (Reps i)) =
    (100 * w) / (101.3 - (2.67123 * fromIntegral i))