From 6412601c368d88aa0e8611ecdeea474946cd6d37 Mon Sep 17 00:00:00 2001 From: Tom Smeding Date: Sun, 2 Aug 2026 23:16:11 +0100 Subject: Factor out common parts of templates into partials --- pages/calendar-day.mustache | 17 +++-------------- pages/calendar.mustache | 17 +++-------------- pages/index.mustache | 10 ++-------- pages/log.mustache | 17 +++-------------- pages/partials/footer.mustache | 4 ++++ pages/partials/header.mustache | 6 ++++++ pages/partials/headmeta.mustache | 4 ++++ src/Pages.hs | 38 ++++++++++++++++++++++++++++++++++---- src/Pages/TH.hs | 2 +- 9 files changed, 60 insertions(+), 55 deletions(-) create mode 100644 pages/partials/footer.mustache create mode 100644 pages/partials/header.mustache create mode 100644 pages/partials/headmeta.mustache diff --git a/pages/calendar-day.mustache b/pages/calendar-day.mustache index f47a41b..5cf8078 100644 --- a/pages/calendar-day.mustache +++ b/pages/calendar-day.mustache @@ -1,21 +1,13 @@ - + {{> headmeta}} {{channel}} {{date}} ({{network}}) - tirclogv - - -
-
- Home - {{network}}/{{channel}}: - Logs - Calendar -
+ {{> header}}

Logs on {{date}} ({{network}}/{{channel}})

@@ -40,10 +32,7 @@

All times are in UTC on {{date}}.

- + {{> footer}}
diff --git a/pages/calendar.mustache b/pages/calendar.mustache index c65849d..2ea5ca4 100644 --- a/pages/calendar.mustache +++ b/pages/calendar.mustache @@ -1,20 +1,12 @@ - + {{> headmeta}} Calendar {{channel}} ({{network}}) - tirclogv - - -
-
- Home - {{network}}/{{channel}}: - Logs - Calendar -
+ {{> header}}

Calendar: {{network}}/{{channel}}

{{#years}} @@ -51,10 +43,7 @@ {{/years}}
- + {{> footer}}
diff --git a/pages/index.mustache b/pages/index.mustache index 8811d7f..4e461c0 100644 --- a/pages/index.mustache +++ b/pages/index.mustache @@ -1,11 +1,8 @@ - + {{> headmeta}} tirclogv - - -
@@ -18,10 +15,7 @@ {{/channels}} {{/networks}} - + {{> footer}}
diff --git a/pages/log.mustache b/pages/log.mustache index 10a99cf..8e3d800 100644 --- a/pages/log.mustache +++ b/pages/log.mustache @@ -1,21 +1,13 @@ - + {{> headmeta}} {{channel}} ({{network}}) - tirclogv - - -
-
- Home - {{network}}/{{channel}}: - Logs - Calendar -
+ {{> header}}

Logs: {{network}}/{{channel}}

@@ -92,10 +84,7 @@

All times are in UTC.

- + {{> footer}}
diff --git a/pages/partials/footer.mustache b/pages/partials/footer.mustache new file mode 100644 index 0000000..2f3a6a4 --- /dev/null +++ b/pages/partials/footer.mustache @@ -0,0 +1,4 @@ + diff --git a/pages/partials/header.mustache b/pages/partials/header.mustache new file mode 100644 index 0000000..af71312 --- /dev/null +++ b/pages/partials/header.mustache @@ -0,0 +1,6 @@ +
+ Home + {{network}}/{{channel}}: + Logs + Calendar +
diff --git a/pages/partials/headmeta.mustache b/pages/partials/headmeta.mustache new file mode 100644 index 0000000..425084a --- /dev/null +++ b/pages/partials/headmeta.mustache @@ -0,0 +1,4 @@ + + + + diff --git a/src/Pages.hs b/src/Pages.hs index 8bd7514..fa7660b 100644 --- a/src/Pages.hs +++ b/src/Pages.hs @@ -4,12 +4,15 @@ {-# LANGUAGE TemplateHaskell #-} module Pages where +import Control.Monad (forM) import Control.Monad.IO.Class (liftIO) +import Data.List (find) import Data.Text (Text) import Data.Text.IO qualified as T import Language.Haskell.TH.Syntax (addDependentFile) -import System.Directory (makeAbsolute) +import System.Directory (makeAbsolute, listDirectory) import Text.Mustache.Compile qualified as M +import Text.Mustache.Types qualified as M import Pages.TH @@ -104,14 +107,41 @@ data EventData tm dttm = EventData , message :: Text } -$(do let readTemplate name = do +$(do let dropSuffix suf str = + let (actualSuf, rstr) = splitAt (length suf) (reverse str) + in if actualSuf == reverse suf then reverse rstr else str + let inlinePartials :: [M.Template] -> M.Template -> M.Template + inlinePartials ps (M.Template topname ast _) = M.Template topname (concatMap go ast) mempty + where + go :: M.Node Text -> [M.Node Text] + go n@M.TextBlock{} = [n] + go (M.Section named nodes) = [M.Section named (concatMap go nodes)] + go (M.InvertedSection named nodes) = [M.InvertedSection named (concatMap go nodes)] + go n@M.Variable{} = [n] + -- sorry for the lost indent + go (M.Partial _indent partialname) = + case find ((== partialname) . M.name) ps of + Just (M.Template _ ast' _) -> concatMap go ast' + Nothing -> error $ "Partial not found: " ++ partialname + partialFiles <- liftIO $ listDirectory "pages/partials" + partials <- forM partialFiles $ \fname -> do + path <- liftIO $ makeAbsolute ("pages/partials/" ++ fname) + tplSrc <- liftIO $ T.readFile path + addDependentFile path + let name = dropSuffix ".mustache" fname + case M.compileTemplate name tplSrc of + Right tpl -> return tpl + Left err -> fail $ "Reading " ++ path ++ ": " ++ show err + let makeDecs name dataname = do path <- liftIO $ makeAbsolute ("pages/" ++ name ++ ".mustache") tplSrc <- liftIO $ T.readFile path addDependentFile path - case M.compileTemplate name tplSrc of + tpl <- case M.compileTemplate name tplSrc of Right tpl -> return tpl Left err -> fail $ "Reading " ++ path ++ ": " ++ show err - concat <$> mapM (\(name, ty) -> (`makeRender` ty) =<< readTemplate name) + let tpl' = inlinePartials partials tpl + makeRender tpl' dataname + concat <$> mapM (uncurry makeDecs) [("log", ''LogData) ,("calendar-day", ''CalendarDayData) ,("index", ''IndexData) diff --git a/src/Pages/TH.hs b/src/Pages/TH.hs index 2967761..c16075b 100644 --- a/src/Pages/TH.hs +++ b/src/Pages/TH.hs @@ -194,7 +194,7 @@ renderNodes dats buf (node : nodes) = do Just (VQInt, _) -> fail $ "Int value in inverted section scrutinee " ++ show named Just (VQUnit, _) -> fail $ "() value in inverted section scrutinee " ++ show named Nothing -> fail $ "Inverted section scrutinee not found: " ++ show named - M.Partial _ _ -> fail "TODO partials" + M.Partial _ _ -> fail $ "Unresolved partial in template: " ++ show node renderNodes dats (ExpensiveExp buf') nodes -- cgit v1.3.1