render tag pages

3 files changed, 91 insertions, 23 deletions

diff --git a/site.hs b/site.hs
index ab0af28..1a88da7 100644
--- a/site.hs
+++ b/site.hs
@@ -119,20 +119,24 @@ checkTarget fp = do
     then error $ "colliding renders for page: " ++ fp
     else targets %= S.insert fp
 
+-- | Prepend the root path to the given link
+rootUrl :: FilePath -> Site FilePath
+rootUrl = pure . ('/' :)
+
 -- | Process a single link pointing out from a page.
 processLink :: FilePath -> String -> Site String
 processLink base l = do
   if isAbsolute l
-    then pure l
+    then pure l -- TODO prepend the root url
     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
+pageFilename = indexFilename
 
--- | Like `Mu.substitute` but writes and throws stuff on errors
+-- | Like `Mu.substitute` but writes (and eventually should throw) stuff on errors
 checkedSubstitute :: Mu.Template -> Y.Value -> IO T.Text
 checkedSubstitute t v = do
   let (es, txt) = Mu.checkedSubstitute t v
@@ -183,7 +187,7 @@ dataFilename :: String -> FilePath -> Site (FilePath, FilePath)
 dataFilename hash basename = do
   od <- use outputDir
   let (h1, h2) = splitAt 3 hash
-      loc = "data" </> h1 </> h2 </> basename
+      loc = "files" </> h1 </> h2 </> basename
   pure (od </> loc, loc)
 
 -- | Copy a source file to the destination, making the necessary directories in the process.
@@ -247,31 +251,67 @@ invTags x =
 tagFilename :: FilePath -> Site FilePath
 tagFilename tag = indexFilename $ "tag" </> tag
 
+-- | Fold the hierarchical tag bits to a slashed path.
+tagPath :: [String] -> FilePath
+tagPath = foldr (</>) ""
+
+-- | Make a link to the tag page
+tagLink :: [String] -> Site FilePath
+tagLink = rootUrl . ("tag" </>) . tagPath
+
+-- | Make metadata for printing out a single hierarchical tag (all levels clickable)
+makeHTagMeta :: [String] -> Site Y.Value
+makeHTagMeta tag = do
+  links <- zip (Y.Null:map fromString tag) . map fromString <$> traverse tagLink (inits tag)
+  pure . Y.array $
+    map
+      (\(t, p) -> Y.object [("tag", t), ("href", p)])
+      links
+
+-- | Make metadata for printing out a single tag as-is, without levels
+makeHTagLinkMeta :: [String] -> Site Y.Value
+makeHTagLinkMeta tag = do
+  link <- tagLink tag
+  pure $
+    Y.object [("href", fromString link), ("tags", Y.array $ map fromString tag)]
+
+makePageLinkMeta :: FilePath -> Site Y.Value
+makePageLinkMeta mount = do
+  link <- rootUrl mount
+  meta <- use $ pages . to (M.! mount) . pageMeta
+  pure $ Y.object [("href", fromString link), ("meta", meta)]
+
+-- | Create the complete metadata structure for the template that renders a given tag page
+makeTagMeta :: [String] -> Site Y.Value
+makeTagMeta tag = do
+  taggedPages <- use $ htags . to (M.! tag)
+  subtags <-
+    gets
+      (^.. htags . to M.keys . each . filtered (not . null) .
+           filtered ((== tag) . init))
+  htagMeta <- makeHTagMeta tag
+  subtagsMeta <- Y.array <$> traverse makeHTagLinkMeta subtags
+  pagesMeta <- Y.array <$> traverse makePageLinkMeta taggedPages
+  pure $
+    Y.object
+      [("htag", htagMeta), ("subtags", subtagsMeta), ("pages", pagesMeta)]
+
 -- | Render a site for a given tag string.
-renderTag :: [String] -> [FilePath] -> Site ()
-renderTag tag pages = do
+renderTag :: [String] -> Site ()
+renderTag tag = do
   tname <- use tagTemplate
   templ <- use $ templates . to (M.! fromString tname)
-  let tagpath = foldr (</>) mempty tag
-  file <- tagFilename tagpath
+  file <- tagFilename (tagPath tag)
   checkTarget file
+  meta <- makeTagMeta tag
   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 = use (htags . to M.assocs) >>= traverse_ (uncurry renderTag)
+renderTags = use (htags . to M.keys) >>= traverse_ renderTag
 
 -- | Build the whole site.
 main =
diff --git a/templates/head.html b/templates/head.html
index 1bc1509..c267616 100644
--- a/templates/head.html
+++ b/templates/head.html
@@ -1 +1,9 @@
-<title>{{title}}</title>
+<head>
+  <meta charset="UTF-8" />
+  <title>
+  {{?title}}{{title}}{{/title}}
+  {{?htag}}
+    All cards {{#htag}} » {{tag}}{{/htag}}
+  {{/htag}}
+  </title>
+</head>
diff --git a/templates/tag.html b/templates/tag.html
index c706469..ccb3e84 100644
--- a/templates/tag.html
+++ b/templates/tag.html
@@ -2,12 +2,32 @@
 <html>
 {{> head.html}}
 <body>
-<h2>{{?tag}}Tag: {{tagpath}}{{/tag}}{{^tag}}All pages{{/tag}}</h2>
-Path: (root){{#tag}} / #{{.}}{{/tag}}
-<ul>
+<h1>
+{{?htag}}
+  Category:
+  {{#htag}}
+  <a class="cards-tagpiece" href="{{href}}">
+    {{^tag}}all{{/tag}}
+    {{?tag}}» {{tag}}{{/tag}}
+  </a>
+  {{/htag}}
+{{/htag}}
+{{^htag}}All cards{{/htag}}
+</h1>
+{{?subtags}}<h2>Sub-categories</h2>
+<ul class="cards-subcategories">
+{{#subtags}}
+<li><a href="{{href}}">{{#tags}} » {{.}} {{/tags}}</a></li>
+{{/subtags}}
+</ul>
+{{/subtags}}
+{{?pages}}
+<h2>Cards</h2>
+<ul class="cards-list">
 {{#pages}}
-<li>{{#anchor}}{{name}}{{/anchor}}</li>
+<li><a href="{{href}}">{{meta.title}}</a></li>
 {{/pages}}
 </ul>
+{{/pages}}
 </body>
 </html>