make the tagging work properly

1 files changed, 14 insertions, 2 deletions

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