commit 37bc5a225fb35c7c12135a3625a8941188a9f1a4
Author: Coder Agent <coder@agents.omni>
Date: Mon Apr 20 12:14:01 2026
feat(cal): show brief weather for selected future day
Use NWS period startTime to pick periods for the /brief selected day.
Keep current conditions for today. Omit the weather card when no
forecast periods cover the selected day.
Task-Id: t-808
diff --git a/Omni/Cal/Weather.hs b/Omni/Cal/Weather.hs
index 7d403d29..d78266f8 100644
--- a/Omni/Cal/Weather.hs
+++ b/Omni/Cal/Weather.hs
@@ -71,7 +71,8 @@ data ForecastPeriod = ForecastPeriod
fpTempUnit :: Text,
fpIcon :: Text,
fpShortForecast :: Text,
- fpIsDaytime :: Bool
+ fpIsDaytime :: Bool,
+ fpStartTime :: Text
}
deriving (Show, Generics.Generic)
@@ -193,7 +194,7 @@ parseForecastData =
windDir <- first' Aeson..: "windDirection"
isDaytime <- first' Aeson..: "isDaytime"
let icon = forecastEmoji shortFc
- allPeriods = first' : take 5 rest
+ allPeriods = take 14 (first' : rest)
parsedPeriods <- traverse parsePeriod allPeriods
let highTemp = if isDaytime then Just temp else findTemp True parsedPeriods
lowTemp = if not isDaytime then Just temp else findTemp False parsedPeriods
@@ -220,6 +221,7 @@ parsePeriod p = do
tempUnit <- p Aeson..: "temperatureUnit"
shortFc <- p Aeson..: "shortForecast"
isDaytime <- p Aeson..: "isDaytime"
+ startTime <- p Aeson..: "startTime"
pure
ForecastPeriod
{ fpName = name,
@@ -227,7 +229,8 @@ parsePeriod p = do
fpTempUnit = tempUnit,
fpIcon = forecastEmoji shortFc,
fpShortForecast = shortFc,
- fpIsDaytime = isDaytime
+ fpIsDaytime = isDaytime,
+ fpStartTime = startTime
}
findTemp :: Bool -> [ForecastPeriod] -> Maybe Int
diff --git a/Omni/Cal/Web.hs b/Omni/Cal/Web.hs
index 43415efc..5348bb32 100644
--- a/Omni/Cal/Web.hs
+++ b/Omni/Cal/Web.hs
@@ -847,7 +847,11 @@ briefPage basePath sources now selectedDay events geoCache weatherCache = do
indexedLocs = zipWith (\i e -> (i, Parse.ceLocation e, Parse.ceDescription e)) [1 ..] sorted
isToday = selectedDay == Time.utctDay now
geoResults <- Geo.geocodeEvents geoCache indexedLocs
- weather <- if isToday then Weather.getWeather weatherCache else pure Nothing
+ weather <- Weather.getWeather weatherCache
+ let weatherCard =
+ case weather of
+ Nothing -> Nothing
+ Just current -> buildBriefWeatherCard selectedDay (Time.utctDay now) current
pure
<| calShell basePath "Brief"
<| do
@@ -856,8 +860,8 @@ briefPage basePath sources now selectedDay events geoCache weatherCache = do
L.div_ [L.class_ "cal-brief"] <| do
-- Next up (only when viewing today)
when isToday <| briefNextUp basePath now dayTimed
- -- Current weather (today only)
- when isToday <| briefWeather weather
+ -- Weather (current for today, forecast for future days)
+ briefWeather weatherCard
-- Day summary with geo data on each event row
briefDaySummary basePath now selectedDay dayEvents geoResults
-- Day map (container + Leaflet init; markers rebuilt by JS)
@@ -905,35 +909,105 @@ briefNextUp _basePath now timedEvents = do
L.div_ [L.class_ "cal-brief-next-loc"] (L.toHtml loc)
_ -> pure ()
--- | Current weather card for the brief view.
-briefWeather :: Maybe Weather.CurrentWeather -> L.Html ()
-briefWeather mWeather =
- L.div_ [L.class_ "cal-brief-section"] <| do
- L.div_ [L.class_ "cal-brief-label"] "Weather"
- case mWeather of
- Nothing ->
- L.div_ [L.class_ "cal-brief-empty"] "Weather unavailable"
- Just weather ->
+data BriefWeatherCard = BriefWeatherCard
+ { bwIcon :: Text,
+ bwTemp :: Int,
+ bwTempUnit :: Text,
+ bwSummary :: Text,
+ bwHigh :: Maybe Int,
+ bwLow :: Maybe Int,
+ bwMeta :: Maybe Text,
+ bwPeriods :: [Weather.ForecastPeriod]
+ }
+
+buildBriefWeatherCard :: Time.Day -> Time.Day -> Weather.CurrentWeather -> Maybe BriefWeatherCard
+buildBriefWeatherCard selectedDay today weather
+ | selectedDay < today = Nothing
+ | selectedDay == today =
+ Just
+ <| BriefWeatherCard
+ { bwIcon = Weather.cwIcon weather,
+ bwTemp = Weather.cwTemp weather,
+ bwTempUnit = Weather.cwTempUnit weather,
+ bwSummary = Weather.cwShortForecast weather,
+ bwHigh = Weather.cwHigh weather,
+ bwLow = Weather.cwLow weather,
+ bwMeta = Just <| "Wind " <> Weather.cwWindDirection weather <> " " <> Weather.cwWindSpeed weather,
+ bwPeriods = take 4 (Weather.cwPeriods weather)
+ }
+ | otherwise =
+ let dayPeriods = take 4 <| periodsForDay selectedDay (Weather.cwPeriods weather)
+ in case safeHead dayPeriods of
+ Nothing -> Nothing
+ Just fallback ->
+ let daytime = List.filter Weather.fpIsDaytime dayPeriods
+ nighttime = List.filter (not <. Weather.fpIsDaytime) dayPeriods
+ summaryPeriod = fromMaybe fallback (safeHead daytime)
+ high = maxTemp daytime <|> maxTemp dayPeriods
+ low = minTemp nighttime <|> minTemp dayPeriods
+ temp = fromMaybe (Weather.fpTemp summaryPeriod) high
+ in Just
+ <| BriefWeatherCard
+ { bwIcon = Weather.fpIcon summaryPeriod,
+ bwTemp = temp,
+ bwTempUnit = Weather.fpTempUnit summaryPeriod,
+ bwSummary = Weather.fpShortForecast summaryPeriod,
+ bwHigh = high,
+ bwLow = low,
+ bwMeta = Just <| "Forecast for " <> formatDayLabel selectedDay,
+ bwPeriods = dayPeriods
+ }
+
+periodsForDay :: Time.Day -> [Weather.ForecastPeriod] -> [Weather.ForecastPeriod]
+periodsForDay day = List.filter ((== Just day) <. forecastPeriodDay)
+
+forecastPeriodDay :: Weather.ForecastPeriod -> Maybe Time.Day
+forecastPeriodDay period =
+ TimeF.parseTimeM
+ True
+ TimeF.defaultTimeLocale
+ "%Y-%m-%d"
+ (Text.unpack (Text.take 10 (Weather.fpStartTime period)))
+
+maxTemp :: [Weather.ForecastPeriod] -> Maybe Int
+maxTemp periods =
+ case map Weather.fpTemp periods of
+ [] -> Nothing
+ xs -> Just (maximum xs)
+
+minTemp :: [Weather.ForecastPeriod] -> Maybe Int
+minTemp periods =
+ case map Weather.fpTemp periods of
+ [] -> Nothing
+ xs -> Just (minimum xs)
+
+-- | Weather card for the brief view. Renders nothing if no weather is available.
+briefWeather :: Maybe BriefWeatherCard -> L.Html ()
+briefWeather mCard =
+ case mCard of
+ Nothing -> pure ()
+ Just card ->
+ L.div_ [L.class_ "cal-brief-section"] <| do
+ L.div_ [L.class_ "cal-brief-label"] "Weather"
L.div_ [L.class_ "cal-brief-weather"] <| do
L.div_ [L.class_ "cal-brief-weather-now"] <| do
- L.span_ [L.class_ "cal-brief-weather-icon"] (L.toHtml (Weather.cwIcon weather))
+ L.span_ [L.class_ "cal-brief-weather-icon"] (L.toHtml (bwIcon card))
L.div_ [L.class_ "cal-brief-weather-main"] <| do
L.div_ [L.class_ "cal-brief-weather-temp"]
- <| L.toHtml (tshow (Weather.cwTemp weather) <> "°" <> Weather.cwTempUnit weather)
- L.div_ [L.class_ "cal-brief-weather-forecast"] (L.toHtml (Weather.cwShortForecast weather))
+ <| L.toHtml (tshow (bwTemp card) <> "°" <> bwTempUnit card)
+ L.div_ [L.class_ "cal-brief-weather-forecast"] (L.toHtml (bwSummary card))
L.div_ [L.class_ "cal-brief-weather-range"] <| do
- case Weather.cwHigh weather of
+ case bwHigh card of
Nothing -> pure ()
Just hi -> L.div_ [] (L.toHtml ("H " <> tshow hi <> "°"))
- case Weather.cwLow weather of
+ case bwLow card of
Nothing -> pure ()
Just lo -> L.div_ [] (L.toHtml ("L " <> tshow lo <> "°"))
- L.div_ [L.class_ "cal-brief-weather-meta"]
- <| L.toHtml ("Wind " <> Weather.cwWindDirection weather <> " " <> Weather.cwWindSpeed weather)
- let periods = take 4 (Weather.cwPeriods weather)
- when (not (null periods))
+ forM_ (bwMeta card) <| \meta ->
+ L.div_ [L.class_ "cal-brief-weather-meta"] (L.toHtml meta)
+ when (not (null (bwPeriods card)))
<| L.div_ [L.class_ "cal-brief-weather-periods"]
- <| mapM_ renderWeatherPeriod periods
+ <| mapM_ renderWeatherPeriod (bwPeriods card)
renderWeatherPeriod :: Weather.ForecastPeriod -> L.Html ()
renderWeatherPeriod period =