summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Pages.hs38
-rw-r--r--src/Pages/TH.hs2
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