render tags, run head-first into template problems

Types.hs

@@ -43,6 +43,7 @@ data SiteState =
     , _assetDir :: FilePath -- ^ Directory for output
     , _defaultTemplate :: FilePath -- ^ Name of the default template
     , _redirectTemplate :: FilePath -- ^ Name of the template for redirect pages
+    , _tagTemplate :: FilePath -- ^ Name of the template for tag listing pages
     }
   deriving (Show)
 
@@ -61,6 +62,7 @@ emptySiteState =
     , _assetDir = "assets"
     , _defaultTemplate = "default.html"
     , _redirectTemplate = "redirect.html"
+    , _tagTemplate = "tag.html"
     }
 
 -- | Monad for running the site generator.

Utils.hs

@@ -26,7 +26,7 @@ hasSuffix s = isJust . stripSuffix s
 second :: (a -> b) -> (c, a) -> (c, b)
 second f (a, b) = (a, f b)
 
--- | A pandoc walker for printing the URLs.
+-- | A pandoc walker for modifying the URLs.
 walkURLs :: (FilePath -> Site FilePath) -> Text.Pandoc.Definition.Pandoc -> Site Text.Pandoc.Definition.Pandoc
 walkURLs f = Text.Pandoc.Walk.walkM go
   where

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

templates/page.html

@@ -1,3 +0,0 @@
-<section>
-  $body$
-</section>

templates/tag.html

@@ -1,14 +1,13 @@
-<section>
-  <h2>Tag</h2>
-  <ul>
-  $for(htags)$
-    <li>$htag$</li>
-  $endfor$
-  </ul>
-  <h2>Pages</h2>
-  <ul>
-  $for(pages)$
-    <li><a href="$page$">$page$</a></li>
-  $endfor$
-  </ul>
-</section>
+<!doctype html5>
+<html>
+{{> head.html}}
+<body>
+<h2>{{?tag}}Tag: {{tagpath}}{{/tag}}{{^tag}}All pages{{/tag}}</h2>
+Path: (root){{#tag}} / #{{.}}{{/tag}}
+<ul>
+{{#pages}}
+<li>{{#anchor}}{{name}}{{/anchor}}</li>
+{{/pages}}
+</ul>
+</body>
+</html>