From d4e1fdeaeb898b1686e5831a15ce6e968e66bd7b Mon Sep 17 00:00:00 2001 From: Mirek Kratochvil Date: Wed, 2 Aug 2023 13:51:14 +0200 Subject: [PATCH] use Mustache objects for rendering, allow lambdas and manual URL rooting --- reploy.hs | 50 +++++++++++++++++++++++++++++-------------- templates/header.html | 9 +++++++- 2 files changed, 42 insertions(+), 17 deletions(-) diff --git a/reploy.hs b/reploy.hs index d959ed2..e3ec004 100644 --- a/reploy.hs +++ b/reploy.hs @@ -54,6 +54,7 @@ import System.FilePath , takeFileName ) import qualified Text.Mustache as Mu +import qualified Text.Mustache.Types as MT import Text.Pandoc.Class (runIOorExplode) import qualified Text.Pandoc.Definition import Text.Pandoc.Readers.Markdown (readMarkdown) @@ -157,14 +158,21 @@ checkTarget fp = do else targets %= S.insert fp -- | Prepend the root path to the given link -rootUrl :: FilePath -> Site FilePath -rootUrl fp = ( unAbsolute fp) <$> use urlBase +rootUrl' :: FilePath -> FilePath -> FilePath +rootUrl' root = (root ) . unAbsolute --- | Like `rootUrl` but also appends @index.html@ for systems that don't have +-- | Same as `rootUrl'` but conveniently in the monad +rootUrl :: FilePath -> Site FilePath +rootUrl fp = flip rootUrl' fp <$> use urlBase + +-- | Like `rootUrl'` but also appends @index.html@ for systems that don't have -- working directory indexes. +rootPageUrl' :: FilePath -> Bool -> FilePath -> FilePath +rootPageUrl' root index fp = bool id ( "index.html") index $ rootUrl' root fp + +-- | Convenient version of `rootPageUrl'` rootPageUrl :: FilePath -> Site FilePath -rootPageUrl fp = - bool id ( "index.html") <$> use appendUrlIndex <*> rootUrl fp +rootPageUrl fp = rootPageUrl' <$> use urlBase <*> use appendUrlIndex <*> pure fp -- | Process a single link pointing out from a page. processLink :: FilePath -> FilePath -> Site String @@ -182,7 +190,7 @@ pageFilename :: FilePath -> Site FilePath pageFilename = indexFilename -- | Like `Mu.substitute` but writes (and eventually should throw) stuff on errors -checkedSubstitute :: Mu.Template -> Y.Value -> IO T.Text +checkedSubstitute :: Mu.Template -> MT.Value -> IO T.Text checkedSubstitute t v = do let (es, txt) = Mu.checkedSubstitute t v traverse_ (putStrLn . ("Error: " ++) . show) es @@ -190,10 +198,16 @@ checkedSubstitute t v = do pure txt -- | Add global information to page metadata for rendering (at this point just the url base) -addGlobalMeta :: Y.Value -> Site Y.Value +addGlobalMeta :: Y.Value -> Site MT.Value addGlobalMeta (Y.Object m) = do - r <- fromString <$> use urlBase - pure . Y.Object $ KM.insert "root" r m + r <- use urlBase + i <- use appendUrlIndex + let l = map (\(k, v) -> (K.toText k, Mu.toMustache v)) $ KM.toList m + pure . Mu.object $ l ++ + [ ("root", Mu.toMustache $ T.pack r) + , ("rawRootUrl", Mu.overText $ T.pack . rootUrl' r . T.unpack) + , ("pageLink", Mu.overText $ T.pack . rootPageUrl' r i . T.unpack) + ] -- | Get the expected timestamp file for a given filepath timestampFile :: FilePath -> Site FilePath @@ -257,7 +271,7 @@ installPage mount pi = do addHeadingLinks "header-local-anchor" fixedUrlDoc let Y.Object meta' = pi ^. pageMeta meta = Y.Object $ KM.insert "body" (Y.String body) meta' - meta <- addGlobalMeta meta >>= addTOC pi fixedUrlDoc >>= addPageMeta pi + meta <- addTOC pi fixedUrlDoc meta >>= addPageMeta pi >>= addGlobalMeta io $ do putStrLn $ "P -> " ++ file makeDirectories file @@ -275,7 +289,8 @@ installRedirect target from = do putStrLn $ "@ -> " ++ file ++ " -> " ++ target makeDirectories file txt <- - checkedSubstitute templ $ Y.object [("target", Y.String $ T.pack target)] + checkedSubstitute templ $ + Mu.object [("target", Mu.toMustache $ T.pack target)] TIO.writeFile file txt -- | Install all redirects required by one page. @@ -435,20 +450,20 @@ makePageLinkMeta mount = do pure $ Y.object [("href", fromString link), ("meta", meta)] -- | Create the complete metadata structure for the template that renders a given categorical tag pages -makeTagMeta :: [String] -> Site Y.Value -makeTagMeta tag = do +makeTagMeta' :: [String] -> Site Y.Value +makeTagMeta' tag = do taggedPages <- use $ htags . to (M.!? tag) . to (maybe [] id) subtags <- gets (^.. ehtags . to M.keys . each . filtered (not . null) . filtered ((== tag) . init)) htagMeta <- makeHTagMeta tagLink tag - subtagsMeta <- Y.array <$> traverse makeTagMeta subtags + subtagsMeta <- Y.array <$> traverse makeTagMeta' subtags pagesMeta <- Y.array <$> traverse makePageLinkMeta taggedPages link <- tagLink tag listlink <- listLink tag tags <- Y.array . map fromString <$> traverse getTagName tag - addGlobalMeta $ + pure $ Y.object [ ("href", fromString link) , ("tags", tags) @@ -458,6 +473,9 @@ makeTagMeta tag = do , ("listhref", fromString listlink) ] +makeTagMeta :: [String] -> Site MT.Value +makeTagMeta tag = makeTagMeta' tag >>= addGlobalMeta + -- | Make metadata for printing out a single tag as-is, without levels makeHTagLinkMeta :: [String] -> Site Y.Value makeHTagLinkMeta tag = do @@ -466,7 +484,7 @@ makeHTagLinkMeta tag = do pure $ Y.object [("href", fromString link), ("tags", tags)] -- | Create the structure for rendering a complete listing of one hierarchical tag. -makeListMeta :: [String] -> Site Y.Value +makeListMeta :: [String] -> Site MT.Value makeListMeta tag = do taggedPages <- use $ ehtags . to (M.! tag) subtags <- diff --git a/templates/header.html b/templates/header.html index 8640fc6..8fa2cc6 100644 --- a/templates/header.html +++ b/templates/header.html @@ -1,9 +1,16 @@
+ Navigation: + + {{?htags}} Categories: {{/htags}}