use Mustache objects for rendering, allow lambdas and manual URL rooting

2 files changed, 41 insertions, 16 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 -> FilePath -> FilePath
+rootUrl' root = (root </>) . unAbsolute
+
+-- | Same as `rootUrl'` but conveniently in the monad
 rootUrl :: FilePath -> Site FilePath
-rootUrl fp = (</> unAbsolute fp) <$> use urlBase
+rootUrl fp = flip rootUrl' fp <$> use urlBase
 
--- | Like `rootUrl` but also appends @index.html@ for systems that don't have
+-- | 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 @@
 <header>
+  Navigation:
+  <ul>
+    <li><a href="{{#pageLink}}/tag{{/pageLink}}">Tags</a></li>
+    <li><a href="{{#pageLink}}/list{{/pageLink}}">List</a></li>
+    <li><a href="{{#pageLink}}/search{{/pageLink}}">Search</a></li>
+  </ul>
+
   {{?htags}}
   Categories:
   <ul>
     {{#htags}}
-    <li class="sidebox-tag">{{#.}}<a href="{{href}}">{{^tag}}all{{/tag}}{{?tag}} » {{tag}}{{/tag}}{{/.}}</a></li>
+    <li>{{#.}}<a href="{{href}}">{{^tag}}all{{/tag}}{{?tag}} » {{tag}}{{/tag}}{{/.}}</a></li>
     {{/htags}}
   </ul>
   {{/htags}}