diff options
Diffstat (limited to 'src/Pages.hs')
| -rw-r--r-- | src/Pages.hs | 38 |
1 files changed, 34 insertions, 4 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) |
