Factor out common parts of templates into partials

2 files changed, 35 insertions, 5 deletions

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