aboutsummaryrefslogtreecommitdiff
path: root/reploy.hs
diff options
context:
space:
mode:
authorMirek Kratochvil <miroslav.kratochvil@uni.lu>2023-10-20 09:23:06 +0200
committerMirek Kratochvil <miroslav.kratochvil@uni.lu>2023-10-20 09:23:06 +0200
commitb63146f517eb8ef1fb6da85e625de1d689d90eed (patch)
tree8bda49fcac5e7a832c2116827f4773a7a555cbe2 /reploy.hs
parent22cee7eeeaeddc623defd3307f1c8e41a8fc90c9 (diff)
downloadreploy-b63146f517eb8ef1fb6da85e625de1d689d90eed.tar.gz
reploy-b63146f517eb8ef1fb6da85e625de1d689d90eed.tar.bz2
provide a pageName lambda for templates
Diffstat (limited to 'reploy.hs')
-rw-r--r--reploy.hs10
1 files changed, 10 insertions, 0 deletions
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