From b63146f517eb8ef1fb6da85e625de1d689d90eed Mon Sep 17 00:00:00 2001
From: Mirek Kratochvil <miroslav.kratochvil@uni.lu>
Date: Fri, 20 Oct 2023 09:23:06 +0200
Subject: [PATCH] provide a pageName lambda for templates

---
 reploy.hs | 10 ++++++++++
 1 file changed, 10 insertions(+)

diff --git a/reploy.hs b/reploy.hs
index 2b431ae..13dff27 100644
--- a/reploy.hs
+++ b/reploy.hs
@@ -185,6 +185,14 @@ processLink base l =
            then rootedPageLink l
            else installFile (base </> l) >>= rootedLink
 
+-- | Conjure a function that finds a displayable name for a page at a particular mount.
+pageName' :: Site (FilePath -> String)
+pageName' = do
+  ps <- use pages
+  pure $ \mnt' ->
+    just ("template looks for undefined page name : " ++ mnt')
+      $  ps M.!? unAbsolute mnt' >>= (^? pageMeta . key "template" . _String . to T.unpack)
+
 -- | Like `Mu.substitute` but writes (and eventually should throw) stuff on errors
 checkedSubstitute :: Mu.Template -> MT.Value -> IO T.Text
 checkedSubstitute t v = do
@@ -199,6 +207,7 @@ addGlobalMeta meta = do
   r <- use urlBase
   rt <- rootedLink'
   rtp <- rootedPageLink'
+  pn <- pageName'
   Y.Object m <- (`objMerge` meta) <$> use extraMeta
   let l = map (\(k, v) -> (K.toText k, Mu.toMustache v)) $ KM.toList m
   pure . Mu.object
@@ -206,6 +215,7 @@ addGlobalMeta meta = do
         ++ [ ("root", Mu.toMustache $ T.pack r)
            , ("rawRootUrl", Mu.overText $ T.pack . rt . T.unpack)
            , ("pageLink", Mu.overText $ T.pack . rtp . T.unpack)
+           , ("pageName", Mu.overText $ T.pack . pn . T.unpack)
            ]
 
 -- | Get the expected timestamp file for a given filepath