commit 28d635fc001acb30b7680ebaf34f47910fbf3d31
Author: Coder Agent <coder@agents.omni>
Date: Fri Apr 10 12:14:50 2026
health: split dashboard into sub-pages and add training analytics
- Split /health into overview, nutrition, training, and labs sub-pages
with shared shell and a health subnav.
- Add /health/training with:
- CTL/ATL/TSB chart
- bike EF chart (easy/Z2 rides + 7-session rolling mean)
- run EF chart (computed speed/HR*1000 for easy runs + rolling mean)
- all-time bests table for running, cycling, and general metrics.
- Add full intervals.icu payload caching to training-cache.json with:
- first-run backfill from 2025-01-01 (monthly batches)
- stale-cache incremental updates from latest cached day
- dedupe/merge by activity key.
- Keep legacy exercise-cache.json + Exercise flow working for nutrition
by deriving exercise cache from full training payloads.
- Add training analysis types/functions in Omni.Health.Analyze and lab
results table rendering for /health/labs.
Task-Id: t-770
diff --git a/Omni/Health/Analyze.hs b/Omni/Health/Analyze.hs
index af3859d4..6c5cd724 100644
--- a/Omni/Health/Analyze.hs
+++ b/Omni/Health/Analyze.hs
@@ -43,6 +43,16 @@ module Omni.Health.Analyze
exercisesForDay,
isFastedExercise,
+ -- * Training
+ TrainingActivity (..),
+ parseTrainingActivities,
+ trainingCtlAtlTsbSeries,
+ bikeEfEasySeries,
+ runEfEasySeries,
+ rollingMeanSeries,
+ TrainingBestEntry (..),
+ computeTrainingBests,
+
-- * Food Rankings
FoodRanking (..),
computeFoodRankings,
@@ -77,6 +87,7 @@ where
import Alpha
import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.Key as AesonKey
import qualified Data.Aeson.Types as AesonTypes
import qualified Data.ByteString.Lazy as BL
import qualified Data.List as List
@@ -395,6 +406,390 @@ isFastedExercise ex dayMeals =
[] -> True -- no meals = fasted
times -> exStartTime ex < minimum times
+-- ---------------------------------------------------------------------
+-- Training
+-- ---------------------------------------------------------------------
+
+data TrainingActivity = TrainingActivity
+ { taId :: Text,
+ taDate :: Time.Day,
+ taType :: Text,
+ taName :: Text,
+ taMovingTime :: Int,
+ taDistance :: Maybe Double,
+ taCalories :: Maybe Int,
+ taAvgHR :: Maybe Int,
+ taMaxHR :: Maybe Int,
+ taAvgWatts :: Maybe Int,
+ taNormalizedPower :: Maybe Int,
+ taAvgSpeed :: Maybe Double,
+ taPace :: Maybe Double,
+ taAvgCadence :: Maybe Double,
+ taEF :: Maybe Double,
+ taTrainingLoad :: Maybe Int,
+ taCTL :: Maybe Double,
+ taATL :: Maybe Double,
+ taHRZones :: Maybe [Int],
+ taHRZoneTimes :: Maybe [Int],
+ taTrimp :: Maybe Double,
+ taIntensity :: Maybe Double
+ }
+ deriving (Show, Eq, Generic)
+
+parseTrainingActivities :: [Aeson.Value] -> [TrainingActivity]
+parseTrainingActivities = mapMaybe parseTrainingActivity
+
+parseTrainingActivity :: Aeson.Value -> Maybe TrainingActivity
+parseTrainingActivity = AesonTypes.parseMaybe parseTrainingActivityParser
+
+parseTrainingActivityParser :: Aeson.Value -> AesonTypes.Parser TrainingActivity
+parseTrainingActivityParser =
+ Aeson.withObject "TrainingActivity" <| \v -> do
+ rawId <- v Aeson..: "id"
+ activityId <- case trainingIdFromValue rawId of
+ Just ident -> pure ident
+ Nothing -> AesonTypes.parseFail "bad activity id"
+ startDateLocal <- v Aeson..: "start_date_local"
+ (day, _timeStr) <- case parseIntervalsLocalDateTime startDateLocal of
+ Just parts -> pure parts
+ Nothing -> AesonTypes.parseFail "bad start_date_local"
+
+ type_ <- fromMaybe "" </ (v Aeson..:? "type" :: AesonTypes.Parser (Maybe Text))
+ name <- fromMaybe "" </ (v Aeson..:? "name" :: AesonTypes.Parser (Maybe Text))
+ movingTime <- fromMaybe 0 </ parseIntField v "moving_time"
+ calories <- parseIntField v "calories"
+ avgHr <- parseIntField v "average_heartrate"
+ maxHr <- parseIntField v "max_heartrate"
+ avgWatts <- parseIntField v "icu_average_watts"
+ normalizedPower <- parseIntField v "icu_weighted_avg_watts"
+ distance <- v Aeson..:? "distance"
+ avgSpeed <- v Aeson..:? "average_speed"
+ pace <- v Aeson..:? "pace"
+ avgCadence <- v Aeson..:? "average_cadence"
+ ef <- v Aeson..:? "icu_efficiency_factor"
+ trainingLoad <- parseIntField v "icu_training_load"
+ ctl <- v Aeson..:? "icu_ctl"
+ atl <- v Aeson..:? "icu_atl"
+ hrZones <- parseIntListField v "icu_hr_zones"
+ hrZoneTimes <- parseIntListField v "icu_hr_zone_times"
+ trimp <- v Aeson..:? "trimp"
+ intensity <- v Aeson..:? "icu_intensity"
+
+ pure
+ TrainingActivity
+ { taId = activityId,
+ taDate = day,
+ taType = type_,
+ taName = name,
+ taMovingTime = movingTime,
+ taDistance = distance,
+ taCalories = calories,
+ taAvgHR = avgHr,
+ taMaxHR = maxHr,
+ taAvgWatts = avgWatts,
+ taNormalizedPower = normalizedPower,
+ taAvgSpeed = avgSpeed,
+ taPace = pace,
+ taAvgCadence = avgCadence,
+ taEF = ef,
+ taTrainingLoad = trainingLoad,
+ taCTL = ctl,
+ taATL = atl,
+ taHRZones = hrZones,
+ taHRZoneTimes = hrZoneTimes,
+ taTrimp = trimp,
+ taIntensity = intensity
+ }
+
+trainingIdFromValue :: Aeson.Value -> Maybe Text
+trainingIdFromValue value =
+ case value of
+ Aeson.String t -> Just t
+ Aeson.Number n -> Just (Text.pack (show n :: String))
+ _ -> Nothing
+
+parseIntField :: Aeson.Object -> AesonKey.Key -> AesonTypes.Parser (Maybe Int)
+parseIntField obj key =
+ ((obj Aeson..:? key) :: AesonTypes.Parser (Maybe Int))
+ <|> (fmap (fmap round) ((obj Aeson..:? key) :: AesonTypes.Parser (Maybe Double)))
+
+parseIntListField :: Aeson.Object -> AesonKey.Key -> AesonTypes.Parser (Maybe [Int])
+parseIntListField obj key =
+ ((obj Aeson..:? key) :: AesonTypes.Parser (Maybe [Int]))
+ <|> (fmap (fmap (map round)) ((obj Aeson..:? key) :: AesonTypes.Parser (Maybe [Double])))
+
+parseIntervalsLocalDateTime :: Text -> Maybe (Time.Day, Text)
+parseIntervalsLocalDateTime txt = do
+ local <-
+ TimeFormat.parseTimeM True TimeFormat.defaultTimeLocale "%Y-%m-%dT%H:%M:%S" (Text.unpack txt)
+ <|> TimeFormat.parseTimeM True TimeFormat.defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Q" (Text.unpack txt)
+ let day = Time.localDay (local :: Time.LocalTime)
+ tod = Time.localTimeOfDay local
+ hr = Time.todHour tod
+ mn = Time.todMin tod
+ timeStr = Text.pack (padTwo hr <> ":" <> padTwo mn)
+ pure (day, timeStr)
+ where
+ padTwo :: Int -> String
+ padTwo n = if n < 10 then "0" <> (show n :: String) else (show n :: String)
+
+trainingCtlAtlTsbSeries :: [TrainingActivity] -> [(Time.Day, Double, Double, Double)]
+trainingCtlAtlTsbSeries activities =
+ mapMaybe toPoint (List.sortOn taDate activities)
+ where
+ toPoint a = do
+ ctl <- taCTL a
+ atl <- taATL a
+ pure (taDate a, ctl, atl, ctl - atl)
+
+bikeEfEasySeries :: [TrainingActivity] -> [(Time.Day, Double)]
+bikeEfEasySeries activities =
+ List.sortOn fst
+ <| mapMaybe
+ ( \a -> do
+ ef <- taEF a
+ if isBikeActivity a && isEasyBikeEffort a
+ then Just (taDate a, ef)
+ else Nothing
+ )
+ activities
+
+runEfEasySeries :: [TrainingActivity] -> [(Time.Day, Double)]
+runEfEasySeries activities =
+ List.sortOn fst
+ <| mapMaybe
+ ( \a -> do
+ ef <- runEfficiencyFactor a
+ if isRunActivity a && isEasyRunEffort a
+ then Just (taDate a, ef)
+ else Nothing
+ )
+ activities
+
+rollingMeanSeries :: Int -> [(Time.Day, Double)] -> [(Time.Day, Double)]
+rollingMeanSeries _ [] = []
+rollingMeanSeries win xs =
+ let indexed = zip [0 :: Int ..] xs
+ in map
+ ( \(i, (day, _)) ->
+ let startIx = max 0 (i - win + 1)
+ windowVals = map (snd <. snd) (filter (\(j, _) -> j >= startIx && j <= i) indexed)
+ avg = if null windowVals then 0 else sum windowVals / fromIntegral (length windowVals)
+ in (day, avg)
+ )
+ indexed
+
+data TrainingBestEntry = TrainingBestEntry
+ { tbeGroup :: Text,
+ tbeLabel :: Text,
+ tbeValue :: Text,
+ tbeDate :: Maybe Time.Day
+ }
+ deriving (Show, Eq)
+
+computeTrainingBests :: [TrainingActivity] -> [TrainingBestEntry]
+computeTrainingBests activities =
+ [ fromMetric "Running" "Best run EF (easy)" (bestRunEf activities) (formatFixed 3),
+ fromMetric "Running" "Fastest 5K pace" (fastest5kSpeed activities) formatPacePerKm,
+ fromMetric "Running" "Lowest avg HR at conversational pace" (lowestEasyRunHr activities) (\x -> tshow (round x :: Int) <> " bpm"),
+ fromMetric "Running" "Longest run" (longestRunDistance activities) (\x -> formatFixed 1 (x / 1000) <> " km"),
+ fromMetric "Cycling" "Best bike EF (easy/Z2)" (bestBikeEf activities) (formatFixed 3),
+ fromMetric "Cycling" "Highest normalized power" (highestNormalizedPower activities) (\x -> tshow (round x :: Int) <> " W"),
+ fromMetric "Cycling" "Best 7-session rolling bike EF" (bestRollingBikeEf activities) (formatFixed 3),
+ fromMetric "Cycling" "Longest ride" (longestRideDistance activities) (\x -> formatFixed 1 (x / 1000) <> " km"),
+ fromMetric "General" "Highest CTL" (highestCtl activities) (formatFixed 1),
+ fromMetric "General" "Longest training streak" (longestTrainingStreak activities) (\x -> tshow (round x :: Int) <> " days"),
+ fromMetric "General" "Highest single-session training load" (highestTrainingLoad activities) (\x -> tshow (round x :: Int))
+ ]
+
+fromMetric :: Text -> Text -> Maybe (Time.Day, Double) -> (Double -> Text) -> TrainingBestEntry
+fromMetric group_ label mMetric formatValue =
+ case mMetric of
+ Nothing -> TrainingBestEntry group_ label "—" Nothing
+ Just (day, value) ->
+ TrainingBestEntry
+ { tbeGroup = group_,
+ tbeLabel = label,
+ tbeValue = formatValue value,
+ tbeDate = Just day
+ }
+
+isBikeActivity :: TrainingActivity -> Bool
+isBikeActivity a = taType a `elem` ["Ride", "VirtualRide", "EBikeRide", "MountainBikeRide", "GravelRide"]
+
+isRunActivity :: TrainingActivity -> Bool
+isRunActivity a = "run" `Text.isInfixOf` Text.toLower (taType a)
+
+isEasyBikeEffort :: TrainingActivity -> Bool
+isEasyBikeEffort a =
+ let nameLower = Text.toLower (taName a)
+ in ("z2" `Text.isInfixOf` nameLower) || isBelowEasyHrThreshold a
+
+isEasyRunEffort :: TrainingActivity -> Bool
+isEasyRunEffort a =
+ let nameLower = Text.toLower (taName a)
+ in ("easy" `Text.isInfixOf` nameLower) || isBelowEasyHrThreshold a
+
+isBelowEasyHrThreshold :: TrainingActivity -> Bool
+isBelowEasyHrThreshold a =
+ case (taAvgHR a, taHRZones a) of
+ (Just hr, Just (z2Upper : _)) -> hr <= z2Upper
+ _ -> False
+
+runEfficiencyFactor :: TrainingActivity -> Maybe Double
+runEfficiencyFactor a = do
+ speed <- taAvgSpeed a
+ hr <- taAvgHR a
+ if hr <= 0
+ then Nothing
+ else Just (speed / fromIntegral hr * 1000.0)
+
+bestRunEf :: [TrainingActivity] -> Maybe (Time.Day, Double)
+bestRunEf activities =
+ maxMetric
+ <| mapMaybe
+ ( \a -> do
+ ef <- runEfficiencyFactor a
+ if isRunActivity a && isEasyRunEffort a
+ then Just (taDate a, ef)
+ else Nothing
+ )
+ activities
+
+fastest5kSpeed :: [TrainingActivity] -> Maybe (Time.Day, Double)
+fastest5kSpeed activities =
+ maxMetric
+ <| mapMaybe
+ ( \a -> do
+ dist <- taDistance a
+ speed <- taAvgSpeed a
+ if isRunActivity a && dist >= 5000.0
+ then Just (taDate a, speed)
+ else Nothing
+ )
+ activities
+
+lowestEasyRunHr :: [TrainingActivity] -> Maybe (Time.Day, Double)
+lowestEasyRunHr activities =
+ let vals =
+ mapMaybe
+ ( \a -> do
+ hr <- taAvgHR a
+ if isRunActivity a && isEasyRunEffort a
+ then Just (taDate a, fromIntegral hr)
+ else Nothing
+ )
+ activities
+ in minMetric vals
+
+longestRunDistance :: [TrainingActivity] -> Maybe (Time.Day, Double)
+longestRunDistance activities =
+ maxMetric
+ <| mapMaybe
+ ( \a -> do
+ dist <- taDistance a
+ if isRunActivity a
+ then Just (taDate a, dist)
+ else Nothing
+ )
+ activities
+
+bestBikeEf :: [TrainingActivity] -> Maybe (Time.Day, Double)
+bestBikeEf = maxMetric <. bikeEfEasySeries
+
+highestNormalizedPower :: [TrainingActivity] -> Maybe (Time.Day, Double)
+highestNormalizedPower activities =
+ maxMetric
+ <| mapMaybe
+ ( \a -> do
+ np <- taNormalizedPower a
+ if isBikeActivity a
+ then Just (taDate a, fromIntegral np)
+ else Nothing
+ )
+ activities
+
+bestRollingBikeEf :: [TrainingActivity] -> Maybe (Time.Day, Double)
+bestRollingBikeEf activities =
+ maxMetric (rollingMeanSeries 7 (bikeEfEasySeries activities))
+
+longestRideDistance :: [TrainingActivity] -> Maybe (Time.Day, Double)
+longestRideDistance activities =
+ maxMetric
+ <| mapMaybe
+ ( \a -> do
+ dist <- taDistance a
+ if isBikeActivity a
+ then Just (taDate a, dist)
+ else Nothing
+ )
+ activities
+
+highestCtl :: [TrainingActivity] -> Maybe (Time.Day, Double)
+highestCtl activities =
+ maxMetric
+ <| mapMaybe
+ ( \a -> do
+ ctl <- taCTL a
+ pure (taDate a, ctl)
+ )
+ activities
+
+highestTrainingLoad :: [TrainingActivity] -> Maybe (Time.Day, Double)
+highestTrainingLoad activities =
+ maxMetric
+ <| mapMaybe
+ ( \a -> do
+ tl <- taTrainingLoad a
+ pure (taDate a, fromIntegral tl)
+ )
+ activities
+
+longestTrainingStreak :: [TrainingActivity] -> Maybe (Time.Day, Double)
+longestTrainingStreak activities =
+ let uniqueDays = List.nub (List.sort (map taDate activities))
+ in case uniqueDays of
+ [] -> Nothing
+ (firstDay : rest) ->
+ let (bestLen, bestEnd, _, _) =
+ foldl'
+ ( \(bestSoFar, bestEndSoFar, currLen, prevDay) day ->
+ let nextLen =
+ if Time.diffDays day prevDay == 1
+ then currLen + 1
+ else 1
+ in if nextLen > bestSoFar
+ then (nextLen, day, nextLen, day)
+ else (bestSoFar, bestEndSoFar, nextLen, day)
+ )
+ (1 :: Int, firstDay, 1 :: Int, firstDay)
+ rest
+ in Just (bestEnd, fromIntegral bestLen)
+
+maxMetric :: [(Time.Day, Double)] -> Maybe (Time.Day, Double)
+maxMetric [] = Nothing
+maxMetric xs = Just (List.maximumBy (comparing snd) xs)
+
+minMetric :: [(Time.Day, Double)] -> Maybe (Time.Day, Double)
+minMetric [] = Nothing
+minMetric xs = Just (List.minimumBy (comparing snd) xs)
+
+formatFixed :: Int -> Double -> Text
+formatFixed decimals value =
+ let scale = 10 ^ decimals
+ scaled = fromIntegral (round (value * fromIntegral scale) :: Int) / fromIntegral scale :: Double
+ in tshow scaled
+
+formatPacePerKm :: Double -> Text
+formatPacePerKm speedMps
+ | speedMps <= 0 = "—"
+ | otherwise =
+ let totalSec = round (1000.0 / speedMps) :: Int
+ mins = totalSec `div` 60
+ secs = totalSec `mod` 60
+ secText = if secs < 10 then "0" <> tshow secs else tshow secs
+ in tshow mins <> ":" <> secText <> " /km"
+
-- ---------------------------------------------------------------------
-- Food Rankings
-- ---------------------------------------------------------------------
diff --git a/Omni/Health/Intervals.hs b/Omni/Health/Intervals.hs
index 2fda41e5..d9afda73 100644
--- a/Omni/Health/Intervals.hs
+++ b/Omni/Health/Intervals.hs
@@ -1,10 +1,10 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
--- | Intervals.icu API client for exercise data.
+-- | Intervals.icu API client for exercise and training data.
--
--- Fetches activities and converts to the Health Exercise type.
--- Caches results to JSON with a 1h TTL.
+-- - Keeps legacy exercise-cache.json for nutrition analysis.
+-- - Stores full activity payloads in training-cache.json for training analytics.
--
-- Env vars: INTERVALS_API_KEY, INTERVALS_ATHLETE_ID
--
@@ -16,17 +16,22 @@
-- : dep http-types
-- : dep text
-- : dep time
+-- : dep containers
module Omni.Health.Intervals
( fetchAndCacheExercises,
refreshExerciseCache,
+ fetchAndCacheTraining,
)
where
import Alpha
import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.Key as AesonKey
import qualified Data.Aeson.Types as AesonTypes
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Lazy as BL
+import qualified Data.List as List
+import qualified Data.Map.Strict as Map
import qualified Data.Text as Text
import qualified Data.Text.Encoding as TE
import qualified Data.Time as Time
@@ -37,45 +42,108 @@ import qualified Omni.Health.Analyze as A
import qualified System.Directory as Dir
import qualified System.Environment as Env
--- | Fetch exercises from intervals.icu and update the cache file.
--- Returns the exercise list. Skips fetch if cache is fresh (< 1h old).
+cacheTtlSeconds :: Int
+cacheTtlSeconds = 3600
+
+trainingBackfillStart :: Time.Day
+trainingBackfillStart = Time.fromGregorian 2025 1 1
+
+-- | Fetch exercises for legacy nutrition analysis and refresh exercise-cache.json.
+-- Uses training-cache.json as source of truth when stale.
fetchAndCacheExercises :: FilePath -> IO [A.Exercise]
fetchAndCacheExercises dataDir = do
let cachePath = dataDir <> "/exercise-cache.json"
- fresh <- isCacheFresh cachePath 3600
+ fresh <- isCacheFresh cachePath cacheTtlSeconds
if fresh
- then loadCached cachePath
+ then loadCachedExercises cachePath
else refreshExerciseCache dataDir
--- | Force-refresh the exercise cache from intervals.icu.
+-- | Force-refresh the exercise cache from full activity data.
refreshExerciseCache :: FilePath -> IO [A.Exercise]
refreshExerciseCache dataDir = do
let cachePath = dataDir <> "/exercise-cache.json"
+ rawActivities <- fetchAndCacheTrainingRaw dataDir
+ let exercises = mapMaybe parseActivity rawActivities
+ if null exercises
+ then loadCachedExercises cachePath
+ else do
+ Dir.createDirectoryIfMissing True dataDir
+ BL.writeFile cachePath (Aeson.encode exercises)
+ pure exercises
+
+-- | Fetch full training activities from intervals.icu.
+-- Caches full payloads to training-cache.json.
+fetchAndCacheTraining :: FilePath -> IO [A.TrainingActivity]
+fetchAndCacheTraining dataDir = do
+ rawActivities <- fetchAndCacheTrainingRaw dataDir
+ pure (A.parseTrainingActivities rawActivities)
+
+fetchAndCacheTrainingRaw :: FilePath -> IO [Aeson.Value]
+fetchAndCacheTrainingRaw dataDir = do
+ let cachePath = dataDir <> "/training-cache.json"
+ cached <- loadCachedRawActivities cachePath
+ fresh <- isCacheFresh cachePath cacheTtlSeconds
+ if fresh && not (null cached)
+ then pure cached
+ else refreshTrainingCacheRaw dataDir cached
+
+refreshTrainingCacheRaw :: FilePath -> [Aeson.Value] -> IO [Aeson.Value]
+refreshTrainingCacheRaw dataDir existing = do
+ Dir.createDirectoryIfMissing True dataDir
+ let cachePath = dataDir <> "/training-cache.json"
mApiKey <- Env.lookupEnv "INTERVALS_API_KEY"
mAthleteId <- Env.lookupEnv "INTERVALS_ATHLETE_ID"
case (mApiKey, mAthleteId) of
(Just key, Just aid) -> do
- exercises <- fetchActivities (Text.pack key) (Text.pack aid)
- let json = Aeson.encode exercises
- BL.writeFile cachePath json
- pure exercises
- _ ->
- -- No credentials, return cached data if available
- loadCached cachePath
-
--- | Fetch activities from the last 60 days from intervals.icu.
-fetchActivities :: Text -> Text -> IO [A.Exercise]
-fetchActivities apiKey athleteId = do
- now <- Time.getCurrentTime
- let today = Time.utctDay now
- oldest = Time.addDays (-60) today
- url =
+ now <- Time.getCurrentTime
+ let today = Time.utctDay now
+ fetched <-
+ if null existing
+ then fetchBackfill (Text.pack key) (Text.pack aid) trainingBackfillStart today
+ else do
+ let nextStart = Time.addDays 1 (fromMaybe trainingBackfillStart (maxCachedDay existing))
+ if nextStart > today
+ then pure []
+ else fetchActivitiesRange (Text.pack key) (Text.pack aid) nextStart today
+ let merged = mergeRawActivities existing fetched
+ if null merged
+ then pure existing
+ else do
+ BL.writeFile cachePath (Aeson.encode merged)
+ pure merged
+ _ -> pure existing
+
+fetchBackfill :: Text -> Text -> Time.Day -> Time.Day -> IO [Aeson.Value]
+fetchBackfill apiKey athleteId startDay endDay = do
+ let ranges = monthlyRanges startDay endDay
+ chunks <- mapM (\(oldest, newest) -> fetchActivitiesRange apiKey athleteId oldest newest) ranges
+ pure (concat chunks)
+
+monthlyRanges :: Time.Day -> Time.Day -> [(Time.Day, Time.Day)]
+monthlyRanges startDay endDay
+ | startDay > endDay = []
+ | otherwise =
+ let endOfMonth = min endDay (monthEnd startDay)
+ in (startDay, endOfMonth) : monthlyRanges (Time.addDays 1 endOfMonth) endDay
+
+monthEnd :: Time.Day -> Time.Day
+monthEnd day =
+ let (y, m, _) = Time.toGregorian day
+ firstNext =
+ if m == 12
+ then Time.fromGregorian (y + 1) 1 1
+ else Time.fromGregorian y (m + 1) 1
+ in Time.addDays (-1) firstNext
+
+fetchActivitiesRange :: Text -> Text -> Time.Day -> Time.Day -> IO [Aeson.Value]
+fetchActivitiesRange apiKey athleteId oldest newest = do
+ let url =
"https://intervals.icu/api/v1/athlete/"
<> Text.unpack athleteId
<> "/activities?oldest="
<> Time.showGregorian oldest
<> "&newest="
- <> Time.showGregorian today
+ <> Time.showGregorian newest
req <- HTTP.parseRequest url
let creds = TE.encodeUtf8 ("API_KEY:" <> apiKey)
authVal = "Basic " <> B64.encode creds
@@ -89,9 +157,60 @@ fetchActivities apiKey athleteId = do
Right resp ->
let body = HTTP.getResponseBody resp
in case Aeson.decode body of
- Just activities -> pure (mapMaybe parseActivity activities)
+ Just activities -> pure activities
Nothing -> pure []
+mergeRawActivities :: [Aeson.Value] -> [Aeson.Value] -> [Aeson.Value]
+mergeRawActivities existing incoming =
+ let mergedMap = foldl' insertActivity Map.empty (existing <> incoming)
+ merged = Map.elems mergedMap
+ in List.sortOn sortKey merged
+ where
+ insertActivity acc activity =
+ case rawActivityKey activity of
+ Nothing -> acc
+ Just key -> Map.insert key activity acc
+
+ sortKey activity =
+ ( fromMaybe trainingBackfillStart (rawActivityDay activity),
+ fromMaybe "" (rawActivityKey activity)
+ )
+
+rawActivityKey :: Aeson.Value -> Maybe Text
+rawActivityKey value =
+ rawActivityId value
+ <|> rawActivityCompositeKey value
+
+rawActivityId :: Aeson.Value -> Maybe Text
+rawActivityId =
+ AesonTypes.parseMaybe <| Aeson.withObject "Activity" <| \o -> do
+ rawId <- o Aeson..: "id"
+ case rawId of
+ Aeson.String t -> pure t
+ Aeson.Number n -> pure (Text.pack (show n :: String))
+ _ -> AesonTypes.parseFail "bad id"
+
+rawActivityCompositeKey :: Aeson.Value -> Maybe Text
+rawActivityCompositeKey =
+ AesonTypes.parseMaybe <| Aeson.withObject "Activity" <| \o -> do
+ mStart <- o Aeson..:? AesonKey.fromText "start_date_local" :: AesonTypes.Parser (Maybe Text)
+ mName <- o Aeson..:? AesonKey.fromText "name" :: AesonTypes.Parser (Maybe Text)
+ mType <- o Aeson..:? AesonKey.fromText "type" :: AesonTypes.Parser (Maybe Text)
+ case liftA3 (\a b c -> a <> ":" <> b <> ":" <> c) mStart mName mType of
+ Just key -> pure key
+ Nothing -> AesonTypes.parseFail "missing composite key fields"
+
+maxCachedDay :: [Aeson.Value] -> Maybe Time.Day
+maxCachedDay = maximumMay <. mapMaybe rawActivityDay
+
+rawActivityDay :: Aeson.Value -> Maybe Time.Day
+rawActivityDay =
+ AesonTypes.parseMaybe <| Aeson.withObject "Activity" <| \o -> do
+ startDateLocal <- o Aeson..: "start_date_local"
+ case parseLocalDateTime startDateLocal of
+ Just (day, _) -> pure day
+ Nothing -> AesonTypes.parseFail "bad start_date_local"
+
-- | Parse a single intervals.icu activity JSON object into our Exercise type.
parseActivity :: Aeson.Value -> Maybe A.Exercise
parseActivity = AesonTypes.parseMaybe parseActivityParser
@@ -120,16 +239,13 @@ parseActivityParser =
-- | Parse "2026-03-14T10:10:07" into (Day, "HH:MM").
parseLocalDateTime :: Text -> Maybe (Time.Day, Text)
parseLocalDateTime txt = do
- utc <-
- TimeFormat.parseTimeM
- True
- TimeFormat.defaultTimeLocale
- "%Y-%m-%dT%H:%M:%S"
- (Text.unpack txt)
- let day = Time.utctDay (utc :: Time.UTCTime)
- totalSecs = floor (Time.utctDayTime utc) :: Int
- hr = totalSecs `div` 3600
- mn = (totalSecs `mod` 3600) `div` 60
+ local <-
+ TimeFormat.parseTimeM True TimeFormat.defaultTimeLocale "%Y-%m-%dT%H:%M:%S" (Text.unpack txt)
+ <|> TimeFormat.parseTimeM True TimeFormat.defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Q" (Text.unpack txt)
+ let day = Time.localDay (local :: Time.LocalTime)
+ tod = Time.localTimeOfDay local
+ hr = Time.todHour tod
+ mn = Time.todMin tod
timeStr = Text.pack (padTwo hr <> ":" <> padTwo mn)
pure (day, timeStr)
where
@@ -148,9 +264,19 @@ isCacheFresh path maxAgeSecs = do
let age = Time.diffUTCTime now modTime
pure (age < fromIntegral maxAgeSecs)
--- | Load exercises from cache file, returning empty list on any error.
-loadCached :: FilePath -> IO [A.Exercise]
-loadCached path = do
+loadCachedExercises :: FilePath -> IO [A.Exercise]
+loadCachedExercises path = do
+ exists <- Dir.doesFileExist path
+ if not exists
+ then pure []
+ else do
+ result <- try (BL.readFile path)
+ case result of
+ Left (_ :: SomeException) -> pure []
+ Right bs -> pure (fromMaybe [] (Aeson.decode bs))
+
+loadCachedRawActivities :: FilePath -> IO [Aeson.Value]
+loadCachedRawActivities path = do
exists <- Dir.doesFileExist path
if not exists
then pure []
diff --git a/Omni/Health/Style.hs b/Omni/Health/Style.hs
index 390b478d..a513b0dd 100644
--- a/Omni/Health/Style.hs
+++ b/Omni/Health/Style.hs
@@ -244,6 +244,28 @@ healthStyles = do
Clay.marginBottom (Clay.px 16)
Clay.fontSize (Clay.px 14)
+ -- Sub-page nav
+ ".health-subnav" Clay.? do
+ Clay.display Clay.flex
+ Stylesheet.key "gap" ("8px" :: Text)
+ Stylesheet.key "flex-wrap" ("wrap" :: Text)
+ Clay.marginBottom (Clay.px 16)
+
+ ".health-subnav-link" Clay.? do
+ Clay.padding (Clay.px 6) (Clay.px 10) (Clay.px 6) (Clay.px 10)
+ Clay.borderRadius (Clay.px 6) (Clay.px 6) (Clay.px 6) (Clay.px 6)
+ Clay.color (Clay.other "var(--c-fg-dim)")
+ Stylesheet.key "text-decoration" ("none" :: Text)
+ Stylesheet.key "border" ("1px solid var(--c-border)" :: Text)
+ Clay.fontSize (Clay.px 13)
+
+ "a.health-subnav-link:visited" Clay.? do
+ Clay.color (Clay.other "var(--c-fg-dim)")
+
+ ".health-subnav-link.active" Clay.? do
+ Clay.color (Clay.other "var(--c-fg)")
+ Clay.backgroundColor (Clay.rgba 255 255 255 0.06)
+
-- Post-Workout Nutrition
".pw-list" Clay.? do
Clay.display Clay.flex
diff --git a/Omni/Health/Web.hs b/Omni/Health/Web.hs
index 724ae5fa..5cd0aa03 100644
--- a/Omni/Health/Web.hs
+++ b/Omni/Health/Web.hs
@@ -48,14 +48,15 @@ import qualified System.Directory as Dir
app :: FilePath -> Wai.Request -> (Wai.Response -> IO Wai.ResponseReceived) -> IO Wai.ResponseReceived
app dataDir req respond = case (Wai.requestMethod req, Wai.pathInfo req) of
("POST", ["upload", "cgm"]) -> handleCgmUpload dataDir req respond
- ("GET", _) -> handleDashboard dataDir req respond
+ ("GET", []) -> handleOverview dataDir respond
+ ("GET", ["nutrition"]) -> handleNutrition dataDir respond
+ ("GET", ["training"]) -> handleTraining dataDir respond
+ ("GET", ["labs"]) -> handleLabs dataDir respond
_ -> respond <| Wai.responseLBS HTTP.status404 [] "not found"
--- | Main dashboard page.
-handleDashboard :: FilePath -> Wai.Request -> (Wai.Response -> IO Wai.ResponseReceived) -> IO Wai.ResponseReceived
-handleDashboard dataDir _req respond = do
+handleOverview :: FilePath -> (Wai.Response -> IO Wai.ResponseReceived) -> IO Wai.ResponseReceived
+handleOverview dataDir respond = do
now <- Time.getCurrentTime
- -- Load data
cgmData <- loadFile (dataDir <> "/cgm.csv")
mealData <- loadFile (dataDir <> "/meals.jsonl")
bwData <- loadFile (dataDir <> "/bloodwork.csv")
@@ -64,42 +65,78 @@ handleDashboard dataDir _req respond = do
let readings = A.parseCgmCsv cgmData
meals = A.parseMealsJsonl mealData
bloodwork = A.parseBloodworkCsv bwData
-
allDayStats = A.dailyCgmStatsWithMeals meals readings
scoreDays = map A.dcsDay allDayStats
dailyScores = map (\d -> Score.computeDailyScore d readings meals exercises) scoreDays
weeklyStats = Score.computeWeeklyStats allDayStats dailyScores
streak = Score.currentStreak weeklyStats
milestones = Score.earnedMilestones weeklyStats
-
latestReading = case List.sortOn (Down <. A.cgmTime) readings of
(r : _) -> Just r
[] -> Nothing
-
latestMeal = case List.sortOn (\m -> (Down (A.mealDate m), Down (A.mealTime m))) meals of
(m : _) -> Just m
[] -> Nothing
+ latestWeek = case reverse weeklyStats of
+ (w : _) -> Just w
+ [] -> Nothing
+ prevWeek = case reverse weeklyStats of
+ (_ : w : _) -> Just w
+ _ -> Nothing
+
+ respond
+ <| Wai.responseLBS HTTP.status200 [("Content-Type", "text/html; charset=utf-8")]
+ <| L.renderBS
+ <| overviewPage now latestReading latestMeal streak milestones latestWeek prevWeek allDayStats dailyScores weeklyStats bloodwork
+
+handleNutrition :: FilePath -> (Wai.Response -> IO Wai.ResponseReceived) -> IO Wai.ResponseReceived
+handleNutrition dataDir respond = do
+ now <- Time.getCurrentTime
+ cgmData <- loadFile (dataDir <> "/cgm.csv")
+ mealData <- loadFile (dataDir <> "/meals.jsonl")
+ exercises <- Intervals.fetchAndCacheExercises dataDir
+ let readings = A.parseCgmCsv cgmData
+ meals = A.parseMealsJsonl mealData
+ allDayStats = A.dailyCgmStats readings
+ latestReading = case List.sortOn (Down <. A.cgmTime) readings of
+ (r : _) -> Just r
+ [] -> Nothing
+ latestMeal = case List.sortOn (\m -> (Down (A.mealDate m), Down (A.mealTime m))) meals of
+ (m : _) -> Just m
+ [] -> Nothing
foodRankings = A.computeFoodRankings meals readings
mealSpikeRankings = A.computeMealSpikeRankings meals readings
+ hypoCrashRankings = A.computeHypoCrashRankings meals readings
+ hypoCategorySummary = A.computeHypoCategorySummary hypoCrashRankings
correlations = A.computeCorrelations allDayStats meals exercises
postWorkout = A.computePostWorkoutRecords exercises meals readings
postWorkoutComparison = A.computePostWorkoutComparison exercises meals readings
postWorkoutMealSpikes = A.computePostWorkoutMealSpikes exercises meals readings
- hypoCrashRankings = A.computeHypoCrashRankings meals readings
- hypoCategorySummary = A.computeHypoCategorySummary hypoCrashRankings
- latestWeek = case reverse weeklyStats of
- (w : _) -> Just w
- [] -> Nothing
- prevWeek = case reverse weeklyStats of
- (_ : w : _) -> Just w
- _ -> Nothing
+ respond
+ <| Wai.responseLBS HTTP.status200 [("Content-Type", "text/html; charset=utf-8")]
+ <| L.renderBS
+ <| nutritionPage now latestReading latestMeal foodRankings mealSpikeRankings hypoCrashRankings hypoCategorySummary correlations postWorkout postWorkoutComparison postWorkoutMealSpikes
+
+handleTraining :: FilePath -> (Wai.Response -> IO Wai.ResponseReceived) -> IO Wai.ResponseReceived
+handleTraining dataDir respond = do
+ now <- Time.getCurrentTime
+ activities <- Intervals.fetchAndCacheTraining dataDir
+ respond
+ <| Wai.responseLBS HTTP.status200 [("Content-Type", "text/html; charset=utf-8")]
+ <| L.renderBS
+ <| trainingPage now activities
+handleLabs :: FilePath -> (Wai.Response -> IO Wai.ResponseReceived) -> IO Wai.ResponseReceived
+handleLabs dataDir respond = do
+ now <- Time.getCurrentTime
+ bwData <- loadFile (dataDir <> "/bloodwork.csv")
+ let bloodwork = A.parseBloodworkCsv bwData
respond
<| Wai.responseLBS HTTP.status200 [("Content-Type", "text/html; charset=utf-8")]
<| L.renderBS
- <| healthPage now streak milestones latestReading latestMeal latestWeek prevWeek allDayStats dailyScores weeklyStats foodRankings mealSpikeRankings correlations bloodwork postWorkout postWorkoutComparison postWorkoutMealSpikes hypoCrashRankings hypoCategorySummary
+ <| labsPage now bloodwork
-- | Handle CGM CSV upload.
handleCgmUpload :: FilePath -> Wai.Request -> (Wai.Response -> IO Wai.ResponseReceived) -> IO Wai.ResponseReceived
@@ -141,68 +178,84 @@ loadFile path = do
-- Page rendering
-- ============================================================================
-healthPage ::
+renderHealthPage :: Text -> Text -> Bool -> L.Html () -> L.Html ()
+renderHealthPage title activePage includeCharts body =
+ WebStyle.sharedShell title "health" <| do
+ L.main_ [L.class_ "container"] <| do
+ L.style_ (TL.toStrict FundStyle.sharedCss <> Style.healthCss)
+ when includeCharts <| L.script_ [L.src_ "https://cdn.jsdelivr.net/npm/chart.js@4"] ("" :: Text)
+ renderHealthNav activePage
+ body
+
+overviewPage ::
Time.UTCTime ->
- Int ->
- [Score.Milestone] ->
Maybe A.CgmReading ->
Maybe A.Meal ->
+ Int ->
+ [Score.Milestone] ->
Maybe Score.WeeklyStats ->
Maybe Score.WeeklyStats ->
[A.DailyCgmStats] ->
[Score.DailyScore] ->
[Score.WeeklyStats] ->
+ [A.BloodworkResult] ->
+ L.Html ()
+overviewPage now latestReading latestMeal streak milestones latestWeek prevWeek allDayStats dailyScores weeklyStats bloodwork =
+ renderHealthPage "Health Overview" "overview" True <| do
+ renderStaleWarning now latestReading
+ renderStaleMealWarning now latestMeal
+ renderRecentDays (Time.utctDay now) dailyScores streak milestones latestWeek prevWeek
+ renderWeeklyChart allDayStats dailyScores
+ renderStreakHistory weeklyStats
+ renderKeyMetrics allDayStats bloodwork
+ renderUpload
+
+nutritionPage ::
+ Time.UTCTime ->
+ Maybe A.CgmReading ->
+ Maybe A.Meal ->
[A.FoodRanking] ->
[A.MealSpikeRecord] ->
+ [A.HypoCrashRecord] ->
+ [A.HypoCategorySummary] ->
[A.Correlation] ->
- [A.BloodworkResult] ->
[A.PostWorkoutRecord] ->
[A.PostWorkoutComparison] ->
[A.PostWorkoutMealSpike] ->
- [A.HypoCrashRecord] ->
- [A.HypoCategorySummary] ->
L.Html ()
-healthPage now streak milestones latestReading latestMeal latestWeek prevWeek allDayStats dailyScores weeklyStats foodRankings mealSpikeRankings correlations bloodwork postWorkout postWorkoutComparison postWorkoutMealSpikes hypoCrashRankings hypoCategorySummary =
- WebStyle.sharedShell "Health" "health" <| do
- L.main_ [L.class_ "container"] <| do
- L.style_ (TL.toStrict FundStyle.sharedCss <> Style.healthCss)
- L.script_ [L.src_ "https://cdn.jsdelivr.net/npm/chart.js@4"] ("" :: Text)
-
- -- Stale data warnings
- renderStaleWarning now latestReading
- renderStaleMealWarning now latestMeal
-
- -- 1. Recent Days + Streak (primary view)
- renderRecentDays (Time.utctDay now) dailyScores streak milestones latestWeek prevWeek
-
- -- 2. Score Breakdown (inline in table, toggled by click)
-
- -- 3. Weekly Trend Chart
- renderWeeklyChart allDayStats dailyScores
-
- -- 4. Streak History
- renderStreakHistory weeklyStats
-
- -- 5. Food Rankings (by category)
- renderFoodRankings foodRankings
-
- -- 6. Worst & Best Foods (individual meals)
- renderMealRankings mealSpikeRankings hypoCrashRankings
-
- -- 6b. Reactive Hypo Risk Rankings
- renderHypoRankings hypoCrashRankings hypoCategorySummary
-
- -- 7. Correlations
- renderCorrelations correlations
-
- -- 8. Post-Workout Nutrition
- renderPostWorkout postWorkout postWorkoutComparison postWorkoutMealSpikes
-
- -- 9. Key Metrics
- renderKeyMetrics allDayStats bloodwork
-
- -- CGM Upload
- renderUpload
+nutritionPage now latestReading latestMeal foodRankings mealSpikeRankings hypoCrashRankings hypoCategorySummary correlations postWorkout postWorkoutComparison postWorkoutMealSpikes =
+ renderHealthPage "Health Nutrition" "nutrition" False <| do
+ renderStaleWarning now latestReading
+ renderStaleMealWarning now latestMeal
+ renderFoodRankings foodRankings
+ renderMealRankings mealSpikeRankings hypoCrashRankings
+ renderHypoRankings hypoCrashRankings hypoCategorySummary
+ renderCorrelations correlations
+ renderPostWorkout postWorkout postWorkoutComparison postWorkoutMealSpikes
+
+trainingPage :: Time.UTCTime -> [A.TrainingActivity] -> L.Html ()
+trainingPage _now activities =
+ renderHealthPage "Health Training" "training" True <| do
+ renderTrainingCharts activities
+ renderAllTimeBests (A.computeTrainingBests activities)
+
+labsPage :: Time.UTCTime -> [A.BloodworkResult] -> L.Html ()
+labsPage _now bloodwork =
+ renderHealthPage "Health Labs" "labs" False <| do
+ renderLabResults bloodwork
+
+renderHealthNav :: Text -> L.Html ()
+renderHealthNav activePage =
+ L.nav_ [L.class_ "health-subnav"] <| do
+ navLink "overview" "/health" "overview"
+ navLink "nutrition" "/health/nutrition" "nutrition"
+ navLink "training" "/health/training" "training"
+ navLink "labs" "/health/labs" "labs"
+ where
+ navLink :: Text -> Text -> Text -> L.Html ()
+ navLink label href target =
+ let classes = if activePage == target then "health-subnav-link active" else "health-subnav-link"
+ in L.a_ [L.href_ href, L.class_ classes] (L.toHtml label)
-- ============================================================================
-- Sections
@@ -865,6 +918,146 @@ renderKeyMetrics dayStats bloodwork = do
Just r -> kpi "ALT (liver)" (tshow (round (A.bwValue r) :: Int) <> " " <> A.bwUnit r) (flagNote (A.bwFlag r))
Nothing -> pure ()
+renderTrainingCharts :: [A.TrainingActivity] -> L.Html ()
+renderTrainingCharts activities = do
+ let ctlSeries = A.trainingCtlAtlTsbSeries activities
+ ctlLabels = map (Text.pack <. Time.showGregorian <. fst4) ctlSeries
+ ctlVals = map snd4 ctlSeries
+ atlVals = map trd4 ctlSeries
+ tsbVals = map fth4 ctlSeries
+
+ bikeSeries = A.bikeEfEasySeries activities
+ bikeRolling = A.rollingMeanSeries 7 bikeSeries
+ bikeLabels = map (Text.pack <. Time.showGregorian <. fst) bikeSeries
+ bikeVals = map snd bikeSeries
+ bikeRollVals = map snd bikeRolling
+
+ runSeries = A.runEfEasySeries activities
+ runRolling = A.rollingMeanSeries 7 runSeries
+ runLabels = map (Text.pack <. Time.showGregorian <. fst) runSeries
+ runVals = map snd runSeries
+ runRollVals = map snd runRolling
+
+ L.section_ [L.class_ "fund-section-block"] <| do
+ L.h2_ [L.class_ "fund-section-title-h2"] "training load (ctl / atl / tsb)"
+ if null ctlSeries
+ then L.p_ [L.class_ "fund-section-desc"] "No CTL/ATL points in cached activities yet."
+ else L.div_ [L.class_ "fund-chart-container"] <| L.canvas_ [L.id_ "ctlAtlChart"] ""
+
+ when (not (null ctlSeries)) <| do
+ L.script_ <| chartScript "ctlAtlChart" ctlLabels ctlVals atlVals tsbVals
+
+ L.section_ [L.class_ "fund-section-block"] <| do
+ L.h2_ [L.class_ "fund-section-title-h2"] "bike efficiency factor (easy / z2)"
+ if null bikeSeries
+ then L.p_ [L.class_ "fund-section-desc"] "No easy/Z2 rides with EF found yet."
+ else L.div_ [L.class_ "fund-chart-container"] <| L.canvas_ [L.id_ "bikeEfChart"] ""
+
+ when (not (null bikeSeries)) <| do
+ L.script_ <| efChartScript "bikeEfChart" bikeLabels bikeVals bikeRollVals "Bike EF"
+
+ L.section_ [L.class_ "fund-section-block"] <| do
+ L.h2_ [L.class_ "fund-section-title-h2"] "run efficiency factor (speed / hr x 1000, easy)"
+ if null runSeries
+ then L.p_ [L.class_ "fund-section-desc"] "No easy runs with HR+speed found yet."
+ else L.div_ [L.class_ "fund-chart-container"] <| L.canvas_ [L.id_ "runEfChart"] ""
+
+ when (not (null runSeries)) <| do
+ L.script_ <| efChartScript "runEfChart" runLabels runVals runRollVals "Run EF"
+
+renderAllTimeBests :: [A.TrainingBestEntry] -> L.Html ()
+renderAllTimeBests bests =
+ L.section_ [L.class_ "fund-section-block"] <| do
+ L.h2_ [L.class_ "fund-section-title-h2"] "all-time bests"
+ let grouped = Map.fromListWith (<>) <| map (\b -> (A.tbeGroup b, [b])) bests
+ mapM_ (renderBestGroup grouped) ["Running", "Cycling", "General"]
+
+renderBestGroup :: Map.Map Text [A.TrainingBestEntry] -> Text -> L.Html ()
+renderBestGroup grouped groupName =
+ forM_ (Map.lookup groupName grouped) <| \entries -> do
+ L.h3_ [L.class_ "meal-rank-heading"] (L.toHtml groupName)
+ L.table_ [L.class_ "food-table"] <| do
+ L.thead_ <| L.tr_ <| do
+ L.th_ "Metric"
+ L.th_ "Value"
+ L.th_ "Date"
+ L.tbody_ <| mapM_ renderBestRow entries
+
+renderBestRow :: A.TrainingBestEntry -> L.Html ()
+renderBestRow entry =
+ L.tr_ <| do
+ L.td_ (L.toHtml (A.tbeLabel entry))
+ L.td_ (L.toHtml (A.tbeValue entry))
+ L.td_ (L.toHtml (maybe "—" (Text.pack <. Time.showGregorian) (A.tbeDate entry)))
+
+renderLabResults :: [A.BloodworkResult] -> L.Html ()
+renderLabResults results =
+ L.section_ [L.class_ "fund-section-block"] <| do
+ L.h2_ [L.class_ "fund-section-title-h2"] "lab results"
+ if null results
+ then L.p_ [L.class_ "fund-section-desc"] "No bloodwork data found."
+ else
+ L.table_ [L.class_ "food-table"] <| do
+ L.thead_ <| L.tr_ <| do
+ L.th_ "Date"
+ L.th_ "Test"
+ L.th_ "Value"
+ L.th_ "Ref"
+ L.th_ "Flag"
+ L.th_ "Lab"
+ L.tbody_ <| mapM_ renderLabRow (List.sortOn (Down <. A.bwDate) results)
+
+renderLabRow :: A.BloodworkResult -> L.Html ()
+renderLabRow r =
+ L.tr_ <| do
+ L.td_ (L.toHtml (Text.pack (Time.showGregorian (A.bwDate r))))
+ L.td_ (L.toHtml (A.bwTest r))
+ L.td_ (L.toHtml (tshow (A.bwValue r) <> " " <> A.bwUnit r))
+ L.td_ (L.toHtml (A.bwRefRange r))
+ L.td_ (L.toHtml (A.bwFlag r))
+ L.td_ (L.toHtml (A.bwLab r))
+
+chartScript :: Text -> [Text] -> [Double] -> [Double] -> [Double] -> Text
+chartScript chartId labels ctlVals atlVals tsbVals =
+ Text.unlines
+ [ "new Chart(document.getElementById('" <> chartId <> "'), {",
+ " type: 'bar',",
+ " data: {",
+ " labels: " <> toJsonArray labels <> ",",
+ " datasets: [{ type: 'line', label: 'CTL (42d)', data: " <> toJsonDoubles ctlVals <> ", borderColor: '" <> P.cyan <> "', backgroundColor: 'transparent', yAxisID: 'y', tension: 0.25 },",
+ " { type: 'line', label: 'ATL (7d)', data: " <> toJsonDoubles atlVals <> ", borderColor: '" <> P.magentaCooler <> "', backgroundColor: 'transparent', yAxisID: 'y', tension: 0.25 },",
+ " { type: 'bar', label: 'TSB', data: " <> toJsonDoubles tsbVals <> ", backgroundColor: '" <> P.green <> "33', borderColor: '" <> P.green <> "', yAxisID: 'y' }]",
+ " },",
+ " options: { animation: false, responsive: true, maintainAspectRatio: false, scales: { y: { ticks: { color: '" <> P.fgDim <> "' }, grid: { color: '" <> P.fgDim <> "20' } }, x: { ticks: { color: '" <> P.fgDim <> "', maxRotation: 45 }, grid: { color: '" <> P.fgDim <> "20' } } }, plugins: { legend: { labels: { color: '" <> P.fgDim <> "' } } } }",
+ "});"
+ ]
+
+efChartScript :: Text -> [Text] -> [Double] -> [Double] -> Text -> Text
+efChartScript chartId labels vals rollingVals label =
+ Text.unlines
+ [ "new Chart(document.getElementById('" <> chartId <> "'), {",
+ " type: 'line',",
+ " data: {",
+ " labels: " <> toJsonArray labels <> ",",
+ " datasets: [{ label: '" <> label <> " points', data: " <> toJsonDoubles vals <> ", borderColor: '" <> P.cyan <> "55', backgroundColor: '" <> P.cyan <> "', pointRadius: 3, tension: 0.0 },",
+ " { label: '7-session rolling mean', data: " <> toJsonDoubles rollingVals <> ", borderColor: '" <> P.green <> "', backgroundColor: 'transparent', pointRadius: 0, tension: 0.25 }]",
+ " },",
+ " options: { animation: false, responsive: true, maintainAspectRatio: false, scales: { y: { ticks: { color: '" <> P.fgDim <> "' }, grid: { color: '" <> P.fgDim <> "20' } }, x: { ticks: { color: '" <> P.fgDim <> "', maxRotation: 45 }, grid: { color: '" <> P.fgDim <> "20' } } }, plugins: { legend: { labels: { color: '" <> P.fgDim <> "' } } } }",
+ "});"
+ ]
+
+fst4 :: (a, b, c, d) -> a
+fst4 (a, _, _, _) = a
+
+snd4 :: (a, b, c, d) -> b
+snd4 (_, b, _, _) = b
+
+trd4 :: (a, b, c, d) -> c
+trd4 (_, _, c, _) = c
+
+fth4 :: (a, b, c, d) -> d
+fth4 (_, _, _, d) = d
+
-- | Render a KPI card using the shared fund-kpi pattern.
kpi :: Text -> Text -> Text -> L.Html ()
kpi label value noteText = do