Migrate index and calendar templates to new renderer

3 files changed, 107 insertions, 56 deletions

diff --git a/pages/calendar.mustache b/pages/calendar.mustache
index b8a8b53..b9ffdec 100644
--- a/pages/calendar.mustache
+++ b/pages/calendar.mustache
@@ -24,13 +24,13 @@
             <tr>
               {{#months}}
                 <td class="calmonth">
-                  {{#monthname}}
+                  {{#display}}
                     <b>{{monthname}}</b><br>
                     <table class="calmonth"><tbody>
                       {{#weeks}}
                         <tr>
                           {{#days}}
-                            <td>{{#date}}<a href="/cal/{{alias}}/{{year}}-{{month00}}-{{date00}}">{{date}}</a>{{/date}}</td>
+                            <td>{{#date}}<a href="/cal/{{alias}}/{{year}}-{{month00}}-{{date00}}">{{.}}</a>{{/date}}</td>
                           {{/days}}
                           {{^days}}
                             <td>&nbsp;</td>
@@ -43,7 +43,7 @@
                         </tr>
                       {{/phantomweek}}
                     </tbody></table>
-                  {{/monthname}}
+                  {{/display}}
                 </td>
               {{/months}}
             </tr>
diff --git a/src/Main.hs b/src/Main.hs
index 433f6c6..77dfa29 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -63,18 +63,23 @@ sendPage200 pages name sub =
     [("Content-Type", "text/html")]
     (TE.encodeUtf8Builder (substituteValue (getPage pages name) sub))
 
-pageIndex :: Config -> Pages -> IO Response
-pageIndex conf pages =
-  return $ sendPage200 pages "index" $ M.object
-    ["networks" ~>
-      [M.object
-        ["name" ~> nw
-        ,"channels" ~>
-          [M.object ["name" ~> ch, "alias" ~> econfChan2Alias conf Map.! Channel nw ch]
-          | ch <- chs]]
-      | (nw, chs) <-
-          [(nw, ch : map chanChannel chs)
-          | Channel nw ch :| chs <- groupBy ((==) `on` chanNetwork) (econfChannels conf)]]]
+pageIndex :: Config -> IO Response
+pageIndex conf =
+  return $ responseBS
+    status200
+    [("Content-Type", "text/html")]
+    (renderPageIndex IndexData
+      { networks =
+          [IndexNetworkData
+            { name = nw
+            , channels =
+                [IndexChannelData
+                  { name = ch
+                  , alias = econfChan2Alias conf Map.! Channel nw ch }
+                | ch <- chs] }
+          | (nw, chs) <-
+              [(nw, ch : map chanChannel chs)
+              | Channel nw ch :| chs <- groupBy ((==) `on` chanNetwork) (econfChannels conf)]]})
 
 pageLog :: Config -> Index -> Request -> Text -> IO Response
 pageLog conf index req alias =
@@ -365,35 +370,50 @@ renderEvent = \case
   ParseError       -> (j "ev-parseerror", (no, "", no),  "<parse error>")
   where no = Nothing; j = Just
 
-pageCalendar :: Config -> Pages -> Index -> Text -> IO Response
-pageCalendar conf pages index alias =
+pageCalendar :: Config -> Index -> Text -> IO Response
+pageCalendar conf index alias =
   case econfAlias2Chan conf Map.!? alias of
     Nothing -> page404 "Channel not found"
     Just chan -> do
       ((startDay, endDay), counts) <- indexCalendar index chan
-      return $ sendPage200 pages "calendar" $ M.object
-        ["network" ~> chanNetwork chan
-        ,"channel" ~> chanChannel chan
-        ,"alias" ~> alias
-        ,"years" ~> flip map (reverse (calendarLayout startDay endDay counts)) (\(year, monrows) ->
-          M.object
-            ["year" ~> year
-            ,"monrows" ~> flip map monrows (\monrow ->
-              M.object
-                ["months" ~> flip map monrow (\mmonth ->
-                  case mmonth of
-                    Nothing -> M.object ["monthname" ~> Null]
-                    Just (month, weeks) ->
-                      M.object
-                        ["month" ~> month
-                        ,"month00" ~> pad '0' 2 month
-                        ,"monthname" ~> monthNames !! (month - 1)
-                        ,"weeks" ~> flip map weeks (\week ->
-                          M.object
-                            ["days" ~> flip map week (\mday ->
-                              fmap (\(d, _count) -> M.object ["date" ~> d, "date00" ~> pad '0' 2 d])
-                                   mday)])
-                        ,"phantomweek" ~> (length weeks <= 3)])])])]
+      return $ responseBS
+        status200
+        [("Content-Type", "text/html")]
+        (renderPageCalendar CalendarData
+          { network = chanNetwork chan
+          , channel = chanChannel chan
+          , alias = alias
+          , years = flip map (reverse (calendarLayout startDay endDay counts)) $ \(year, monrows) ->
+              CalendarYearData
+                { year = fromIntegral @Integer @Int year
+                , monrows = flip map monrows $ \monrow ->
+                    CalendarMonthRowData
+                      { months = flip map monrow $ \case
+                          Nothing ->
+                            CalendarMonthData
+                              { display = False
+                              , month = 0
+                              , month00 = ""
+                              , monthname = ""
+                              , weeks = []
+                              , phantomweek = False }
+                          Just (month, weeks) ->
+                            CalendarMonthData
+                              { display = True
+                              , month = month
+                              , month00 = T.pack (pad '0' 2 month)
+                              , monthname = monthNames !! (month - 1)
+                              , weeks = flip map weeks $ \week ->
+                                  CalendarWeekData
+                                    { days = flip map week $ \case
+                                        Nothing ->
+                                          CalendarDayData'
+                                            { date = Nothing, date00 = "" }
+                                        Just (d, _count) ->
+                                          CalendarDayData'
+                                            { date = Just d, date00 = T.pack (pad '0' 2 d) }}
+                              , phantomweek = False }
+                            }}})
   where
     monthNames :: [Text]
     monthNames = ["January", "February", "March", "April"
@@ -412,25 +432,18 @@ mainServe confpath = do
 
   index <- initIndex (confLogsDir config) (econfChannels config)
 
-  let templateFiles = ["index", "log", "calendar", "calendar-day"]
-      staticFiles = ["style.css", "robots.txt", "favicon.png"]
-
-  pages <- fmap (Pages . Map.fromList) . forM templateFiles $ \name -> do
-             src <- T.readFile ("pages/" ++ name ++ ".mustache")
-             case compileTemplate name src of
-               Right tpl -> return (name, tpl)
-               Left err -> die (show err)
+  let staticFiles = ["style.css", "robots.txt", "favicon.png"]
 
   let settings = defaultSettings { setPort = confPort config }
 
   atomicPrintS $ "Listening on port " ++ show (confPort config)
   run settings $ \req -> case reqPath req of
     [] ->
-      pageIndex config pages
+      pageIndex config
     ["log", TE.decodeUtf8' -> Right alias] ->
       pageLog config index req alias
     ["cal", TE.decodeUtf8' -> Right alias] ->
-      pageCalendar config pages index alias
+      pageCalendar config index alias
     ["cal", TE.decodeUtf8' -> Right alias, TE.decodeUtf8' -> Right date] ->
       pageCalendarDay config index req alias date
     [fname] | fname `elem` staticFiles ->
diff --git a/src/Pages.hs b/src/Pages.hs
index 4efd8fe..4e85cae 100644
--- a/src/Pages.hs
+++ b/src/Pages.hs
@@ -2,11 +2,7 @@
 {-# LANGUAGE NoFieldSelectors #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
-module Pages (
-  renderPageLog, LogData(..),
-  renderPageCalendarDay, CalendarDayData(..),
-  PickerData(..), EventData(..),
-) where
+module Pages where
 
 import Control.Monad.IO.Class (liftIO)
 import Data.Text (Text)
@@ -18,6 +14,46 @@ import Text.Mustache.Compile qualified as M
 import Pages.TH
 
 
+data IndexData = IndexData
+  { networks :: [IndexNetworkData] }
+
+data IndexNetworkData = IndexNetworkData
+  { name :: Text
+  , channels :: [IndexChannelData] }
+
+data IndexChannelData = IndexChannelData
+  { name :: Text
+  , alias :: Text }
+
+data CalendarData = CalendarData
+  { network :: Text
+  , channel :: Text
+  , alias :: Text
+  , years :: [CalendarYearData]
+  }
+
+data CalendarYearData = CalendarYearData
+  { year :: Int
+  , monrows :: [CalendarMonthRowData] }
+
+data CalendarMonthRowData = CalendarMonthRowData
+  { months :: [CalendarMonthData] }
+
+data CalendarMonthData = CalendarMonthData
+  { display :: Bool
+  , month :: Int
+  , month00 :: Text
+  , monthname :: Text
+  , weeks :: [CalendarWeekData]
+  , phantomweek :: Bool }
+
+data CalendarWeekData = CalendarWeekData
+  { days :: [CalendarDayData'] }
+
+data CalendarDayData' = CalendarDayData'
+  { date :: Maybe Int
+  , date00 :: Text }
+
 data LogData = LogData
   { network :: Text
   , channel :: Text
@@ -68,4 +104,6 @@ $(do let readTemplate name = do
              Left err -> fail $ "Reading " ++ path ++ ": " ++ show err
      concat <$> mapM (\(name, ty) -> (`makeRender` ty) =<< readTemplate name)
        [("log", ''LogData)
-       ,("calendar-day", ''CalendarDayData)])
+       ,("calendar-day", ''CalendarDayData)
+       ,("index", ''IndexData)
+       ,("calendar", ''CalendarData)])