From 35837f5607986b18746590c1611927d59cbe8c87 Mon Sep 17 00:00:00 2001
From: Mirek Kratochvil <exa.exa@gmail.com>
Date: Sat, 27 May 2023 20:19:11 +0200
Subject: render tags, run head-first into template problems

---
 site.hs | 75 ++++++++++++++++++++++++++++++++++++++++++++++++++---------------
 1 file changed, 58 insertions(+), 17 deletions(-)

(limited to 'site.hs')

diff --git a/site.hs b/site.hs
index 3e822f7..31ac7ec 100644
--- a/site.hs
+++ b/site.hs
@@ -22,7 +22,13 @@ import Hakyll.Core.Util.File (getRecursiveContents, makeDirectories)
 import Lens.Micro
 import Lens.Micro.Aeson
 import Lens.Micro.Mtl
-import System.FilePath ((</>), splitDirectories, splitPath, takeFileName, isAbsolute)
+import System.FilePath
+  ( (</>)
+  , isAbsolute
+  , splitDirectories
+  , splitPath
+  , takeFileName
+  )
 import qualified Text.Mustache as Mu
 import Text.Pandoc.Class (runIOorExplode)
 import Text.Pandoc.Readers.Markdown (readMarkdown)
@@ -72,7 +78,9 @@ pageTemplate pi = do
 pageTemplates :: Site [FilePath]
 pageTemplates = do
   rt <- use redirectTemplate
-  nub . (rt :) <$> (gets (^.. pages . traverse) >>= traverse pageTemplate)
+  tt <- use tagTemplate
+  nub . ([rt, tt] ++) <$>
+    (gets (^.. pages . traverse) >>= traverse pageTemplate)
 
 compileTemplate ::
      FilePath
@@ -109,21 +117,28 @@ checkTarget fp = do
 -- | Process a single link pointing out from a page.
 processLink :: FilePath -> String -> Site String
 processLink base l = do
-  io $ putStrLn l
   if isAbsolute l
-  then
-    pure l
-  else (do
-    io $ putStrLn "rel"
-    pure $ '/':(base</>l)) -- TODO
+    then pure l
+    else (do io . putStrLn $ "rel:" ++ l
+             pure $ '/' : (base </> l) -- TODO
+          )
+
+-- | Get a mount point of the page into the correct location.
+pageFilename :: FilePath -> Site FilePath
+pageFilename p = indexFilename $ "page" </> p
+
+checkedSubstitute t v = do
+  let (es, txt) = Mu.checkedSubstitute t v
+  io $ traverse_ (putStrLn . ("Error: " ++) . show) es
+  --null es `unless` error "template substitution problems"
+  pure txt
 
 -- | Render a page using the current template.
 installPage :: FilePath -> PageInfo -> Site ()
-installPage mount pi
- = do
+installPage mount pi = do
   tname <- pageTemplate pi
   templ <- use $ templates . to (M.! fromString tname)
-  file <- indexFilename mount
+  file <- pageFilename mount
   fixedUrlDoc <- walkURLs (processLink mount) $ pi ^. pageDoc
   checkTarget file
   io $ do
@@ -132,7 +147,7 @@ installPage mount pi
     body <- runIOorExplode $ writeHtml5String htmlWriteOpts fixedUrlDoc
     let Y.Object meta' = pi ^. pageMeta
         meta = Y.Object $ KM.insert "body" (Y.String body) meta'
-    TIO.writeFile file $ Mu.substitute templ meta
+    checkedSubstitute templ meta >>= TIO.writeFile file
   installPageRedirects mount pi
 
 {- | Install a simple redirect handler page. -}
@@ -145,8 +160,8 @@ installRedirect target from = do
   io $ do
     putStrLn $ "@ -> " ++ file ++ " -> " ++ target
     makeDirectories file
-    TIO.writeFile file . Mu.substitute templ $
-      Y.object [("target", Y.String $ T.pack target)]
+    txt <- checkedSubstitute templ $ Y.object [("target", Y.String $ T.pack target)]
+    TIO.writeFile file txt
 
 -- | Install all redirects required by one page.
 installPageRedirects :: FilePath -> PageInfo -> Site ()
@@ -203,6 +218,7 @@ installAssets =
   use assetDir >>=
   (io . getRecursiveContents (pure . const False) >=> traverse_ installAsset)
 
+-- | Get all tags from the pages of the site.
 sourceTags :: Site ()
 sourceTags = do
   sgat <-
@@ -217,13 +233,35 @@ invTags :: [(FilePath, [[String]])] -> [([String], [FilePath])]
 invTags x =
   map (fmap nub) $ groupSort [(t, p) | (p, htl) <- x, ht <- htl, t <- inits ht]
 
+-- | Get the destination for the tag page.
+tagFilename :: FilePath -> Site FilePath
+tagFilename tag = indexFilename $ "tag" </> tag
+
 -- | Render a site for a given tag string.
-renderTag :: [String] -> Site ()
-renderTag = undefined
+renderTag :: [String] -> [FilePath] -> Site ()
+renderTag tag pages = do
+  tname <- use tagTemplate
+  templ <- use $ templates . to (M.! fromString tname)
+  let tagpath = foldr (</>) mempty tag
+  file <- tagFilename tagpath
+  checkTarget file
+  io $ do
+    putStrLn $ "# -> " ++ file
+    makeDirectories file
+    let str = fromString
+        arr = Y.array
+        meta =
+          Y.Object $
+          KM.fromList
+            [ ("tagpath", str tagpath)
+            , ("tag", arr $ map str tag)
+            , ("pages", arr $ map str pages)
+            ]
+    checkedSubstitute templ meta >>= TIO.writeFile file
 
 -- | Render all tag sites.
 renderTags :: Site ()
-renderTags = undefined
+renderTags = use (htags . to M.assocs) >>= traverse_ (uncurry renderTag)
 
 -- | Build the whole site.
 main =
@@ -233,6 +271,9 @@ main =
     sourceTags
     sourceTemplates "templates"
     use pages >>= traverse (uncurry installPage) . M.assocs
+    renderTags
+    -- testing part begin
     installFile "external/mypage/img/awesome.png"
+    -- testing part end
     io $ putStrLn "OK"
     get >>= io . print
-- 
cgit v1.2.3