From 4c0efd5c0e0237facd6c754667c97b4ce7aa3506 Mon Sep 17 00:00:00 2001 From: Mirek Kratochvil Date: Thu, 15 Jun 2023 14:39:15 +0200 Subject: make the tagging work properly --- site.hs | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) (limited to 'site.hs') diff --git a/site.hs b/site.hs index 95a2f9f..8626fa3 100644 --- a/site.hs +++ b/site.hs @@ -10,7 +10,7 @@ import qualified Data.Aeson.KeyMap as KM import qualified Data.ByteString.Lazy as B import Data.Digest.Pure.SHA (sha256, showDigest) import Data.Foldable (traverse_) -import Data.List (inits, nub) +import Data.List (inits, nub, sort) import Data.List.Extra (groupSort) import qualified Data.Map as M import qualified Data.Set as S @@ -157,6 +157,18 @@ addGlobalMeta (Y.Object m) = do r <- fromString <$> use urlBase pure . Y.Object $ KM.insert "root" r m +-- | Add page-specific information to the metadata. In this instance, this just +-- expands the tags for rendering. Eventually would be nice to have the timestamps +-- and possibly other info sourced right here. +addPageMeta :: PageInfo -> Y.Value -> Site Y.Value +addPageMeta pi (Y.Object m) = do + htagMeta <- + traverse makeHTagMeta . sort $ pi ^.. pageMeta . key "tags" . values . + _String . + to T.unpack . + to splitDirectories + pure . Y.Object $ KM.insert "htags" (Y.array htagMeta) m + -- | Render a page using the current template. installPage :: FilePath -> PageInfo -> Site () installPage mount pi = do @@ -169,7 +181,7 @@ installPage mount pi = do body <- io . runIOorExplode $ writeHtml5String htmlWriteOpts fixedUrlDoc let Y.Object meta' = pi ^. pageMeta meta = Y.Object $ KM.insert "body" (Y.String body) meta' - meta <- addGlobalMeta meta + meta <- addGlobalMeta meta >>= addPageMeta pi io $ do putStrLn $ "P -> " ++ file makeDirectories file -- cgit v1.2.3