split tags and ehtags, separate listings from hierarchical views

Types.hs

@@ -36,6 +36,9 @@ data SiteState =
     -- | Map of tags, assigning to each tag sequence a list of
     -- tagged page mounts
     , _htags :: M.Map [String] [FilePath]
+    -- | Map of tags, assigning to each tag sequence a list of tagged page
+    -- mounts. This one is expanded (tags imply parent categories).
+    , _ehtags :: M.Map [String] [FilePath]
     -- | List of installed files (enables sharing)
     , _installs :: S.Set (String, FilePath)
     -- | List of installed files (prevents overwriting)
@@ -50,7 +53,8 @@ data SiteState =
     , _templateDir :: FilePath -- ^ Path to template directory
     , _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
+    , _tagTemplate :: FilePath -- ^ Name of the template for category pages
+    , _listTemplate :: FilePath -- ^ Name of the template for listing pages
     , _urlBase :: FilePath -- ^ "Root route" to prepend to all absolute links.
     , _dumpFinalState :: Bool -- ^ Triggers printing out the structure when the processing finishes.
     }
@@ -105,8 +109,13 @@ siteOptions' = do
   _tagTemplate <-
     strOption $
     long "tag-template" <>
-    help "Template for making tag-listing pages" <>
+    help "Template for making category view pages" <>
     value "tag.html" <> showDefault
+  _listTemplate <-
+    strOption $
+    long "list-template" <>
+    help "Template for making tag-listing pages" <>
+    value "list.html" <> showDefault
   _urlBase <-
     strOption $
     long "url-base" <>
@@ -121,6 +130,7 @@ siteOptions' = do
       { _pages = M.empty
       , _redirects = M.empty
       , _htags = M.empty
+      , _ehtags = M.empty
       , _installs = S.empty
       , _targets = S.empty
       , _templates = M.empty

cards/codeCheck.md

@@ -13,9 +13,8 @@ redirects:
   - internal/internal/publication/codeCheck
 tags:
   - publication/ppc/code
-  - code/conventions
-  - code/licensing
-  - tto/code
+  - it/conventions
+  - it/licensing
 ---
 
 # How-to: Pass a PPC code check

cards/mypage/text.md

@@ -5,11 +5,10 @@ redirects:
   - mypage
   - old:mypage
 tags:
-  - yyy
-  - topic1/xxx
+  - about/test
 ---
 
-# My Page
+# My Testing Page
 
 something something
 

site.hs

@@ -91,7 +91,8 @@ pageTemplates :: Site [FilePath]
 pageTemplates = do
   rt <- use redirectTemplate
   tt <- use tagTemplate
-  nub . ([rt, tt] ++) <$>
+  lt <- use listTemplate
+  nub . ([rt, tt, lt] ++) <$>
     (gets (^.. pages . traverse) >>= traverse pageTemplate)
 
 -- | Compile a single template in a directory
@@ -166,7 +167,8 @@ addGlobalMeta (Y.Object m) = do
 addPageMeta :: PageInfo -> Y.Value -> Site Y.Value
 addPageMeta pi (Y.Object m) = do
   htagMeta <-
-    traverse makeHTagMeta . sort $ pi ^.. pageMeta . key "tags" . values .
+    traverse (makeHTagMeta tagLink) . sort $ pi ^.. pageMeta . key "tags" .
+    values .
     _String .
     to T.unpack .
     to splitDirectories
@@ -272,18 +274,27 @@ sourceTags = do
        (^.. pageMeta . key "tags" . values . _String . to T.unpack)) .
     M.assocs <$>
     use pages
+  ehtags .= M.fromList (invExpandTags sgat)
   htags .= M.fromList (invTags sgat)
 
 -- | Organize a list of pages with hierarchical tags to a list with
--- hierarchical tags with pages attached.
-invTags :: [(FilePath, [[String]])] -> [([String], [FilePath])]
-invTags x =
+-- hierarchical tags with pages attached; with tags implying parents.
+invExpandTags :: [(FilePath, [[String]])] -> [([String], [FilePath])]
+invExpandTags x =
   map (fmap nub) $ groupSort [(t, p) | (p, htl) <- x, ht <- htl, t <- inits ht]
 
+-- | Like `invExpandTags` but without the expansion.
+invTags :: [(FilePath, [[String]])] -> [([String], [FilePath])]
+invTags x = map (fmap nub) $ groupSort [(t, p) | (p, htl) <- x, t <- htl]
+
 -- | Get the destination for the tag page.
 tagFilename :: FilePath -> Site FilePath
 tagFilename tag = indexFilename $ "tag" </> tag
 
+-- | Get the destination for the tag page.
+listFilename :: FilePath -> Site FilePath
+listFilename tag = indexFilename $ "list" </> tag
+
 -- | Fold the hierarchical tag bits to a slashed path.
 tagPath :: [String] -> FilePath
 tagPath = foldr (</>) ""
@@ -292,21 +303,22 @@ tagPath = foldr (</>) ""
 tagLink :: [String] -> Site FilePath
 tagLink = rootUrl . ("tag" </>) . tagPath
 
+-- | Fold the hierarchical tag bits to a slashed path.
+listPath :: [String] -> FilePath
+listPath = foldr (</>) ""
+
+-- | Make a link to the tag page
+listLink :: [String] -> Site FilePath
+listLink = rootUrl . ("list" </>) . tagPath
+
 -- | Make metadata for printing out a single hierarchical tag (all levels clickable)
-makeHTagMeta :: [String] -> Site Y.Value
-makeHTagMeta tag = do
+makeHTagMeta :: ([String] -> Site FilePath) -> [String] -> Site Y.Value
+makeHTagMeta lf tag = do
   links <-
     zip (Y.Null : map fromString tag) . map fromString <$>
-    traverse tagLink (inits tag)
+    traverse lf (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)]
-
 -- | Make metadata for printing out a link to a page
 makePageLinkMeta :: FilePath -> Site Y.Value
 makePageLinkMeta mount = do
@@ -314,20 +326,55 @@ makePageLinkMeta mount = do
   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
+-- | Create the complete metadata structure for the template that renders a given categorical tag pages
 makeTagMeta :: [String] -> Site Y.Value
 makeTagMeta tag = do
-  taggedPages <- use $ htags . to (M.! tag)
+  taggedPages <- use $ htags . to (M.!? tag) . to (maybe [] id)
   subtags <-
     gets
-      (^.. htags . to M.keys . each . filtered (not . null) .
+      (^.. ehtags . to M.keys . each . filtered (not . null) .
            filtered ((== tag) . init))
-  htagMeta <- makeHTagMeta tag
-  subtagsMeta <- Y.array <$> traverse makeHTagLinkMeta subtags
+  htagMeta <- makeHTagMeta tagLink tag
+  subtagsMeta <- Y.array <$> traverse makeTagMeta subtags
   pagesMeta <- Y.array <$> traverse makePageLinkMeta taggedPages
+  link <- tagLink tag
+  listlink <- listLink tag
   addGlobalMeta $
     Y.object
-      [("htag", htagMeta), ("subtags", subtagsMeta), ("pages", pagesMeta)]
+      [ ("href", fromString link)
+      , ("tags", Y.array $ map fromString tag)
+      , ("htag", htagMeta)
+      , ("subtags", subtagsMeta)
+      , ("pages", pagesMeta)
+      , ("listhref", fromString listlink)
+      ]
+
+-- | Make metadata for printing out a single tag as-is, without levels
+makeHTagLinkMeta :: [String] -> Site Y.Value
+makeHTagLinkMeta tag = do
+  link <- listLink tag
+  pure $
+    Y.object [("href", fromString link), ("tags", Y.array $ map fromString tag)]
+
+-- | Create the structure for rendering a complete listing of one hierarchical tag.
+makeListMeta :: [String] -> Site Y.Value
+makeListMeta tag = do
+  taggedPages <- use $ ehtags . to (M.! tag)
+  subtags <-
+    gets
+      (^.. ehtags . to M.keys . each . filtered (not . null) .
+           filtered ((== tag) . init))
+  htagMeta <- makeHTagMeta listLink tag
+  subtagsMeta <- Y.array <$> traverse makeHTagLinkMeta subtags
+  pagesMeta <- Y.array <$> traverse makePageLinkMeta taggedPages
+  tl <- tagLink tag
+  addGlobalMeta $
+    Y.object
+      [ ("htag", htagMeta)
+      , ("subtags", subtagsMeta)
+      , ("pages", pagesMeta)
+      , ("taghref", fromString tl)
+      ]
 
 -- | Render a site for a given tag string.
 renderTag :: [String] -> Site ()
@@ -344,7 +391,24 @@ renderTag tag = do
 
 -- | Render all tag sites.
 renderTags :: Site ()
-renderTags = use (htags . to M.keys) >>= traverse_ renderTag
+renderTags = use (ehtags . to M.keys) >>= traverse_ renderTag
+
+-- | Render a site for a given tag string.
+renderList :: [String] -> Site ()
+renderList tag = do
+  tname <- use listTemplate
+  templ <- use $ templates . to (M.! fromString tname)
+  file <- listFilename (listPath tag)
+  checkTarget file
+  meta <- makeListMeta tag
+  io $ do
+    putStrLn $ "* -> " ++ file
+    makeDirectories file
+    checkedSubstitute templ meta >>= TIO.writeFile file
+
+-- | Render all tag sites.
+renderLists :: Site ()
+renderLists = use (ehtags . to M.keys) >>= traverse_ renderList
 
 -- | Transform one mounted PageInfo to the base search data
 mkSearchData :: FilePath -> PageInfo -> Site [Y.Value]
@@ -388,6 +452,7 @@ main = do
     use templateDir >>= sourceTemplates
     use pages >>= traverse (uncurry installPage) . M.assocs
     renderTags
+    renderLists
     renderSearchData
     io $ putStrLn "OK"
     whenM (use dumpFinalState) $ get >>= io . print

templates/footer.html

@@ -4,10 +4,10 @@
         <div class="footer-lcsb"></div>
         <div class="footer-text">
           <div>
-            The contents are available under the <a href="{root}license">Creative Commons Attribution-ShareAlike License (CC-BY-SA 4.0)</a>.
+            The contents are available under the <a href="{{root}}license">Creative Commons Attribution-ShareAlike License (CC-BY-SA 4.0)</a>.
           </div>
           <div>
-            <a href="{root}privacy-policy">Privacy Policy</a> (Only necessary cookies accepted — <a href="#">change</a>)
+            <a href="{{root}}privacy-policy">Privacy Policy</a> (Only necessary cookies accepted — <a href="#">change</a>)
           </div>
         </div>
         <div class="flex-fill"></div>

templates/tag.html

@@ -4,32 +4,55 @@
 <body>
 {{> header.html}}
 <h1>
-{{?htag}}
-  Category:
-  {{#htag}}
-  <a class="cards-tagpiece" href="{{href}}">
+Cards in category:
+{{#htag}}
+<a class="cards-tagpiece" href="{{href}}">
   {{^tag}}all{{/tag}}
   {{?tag}}» {{tag}}{{/tag}}
-  </a>
-  {{/htag}}
+</a>
 {{/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}}
+<p>See the <a href="{{listhref}}">complete listing of all pages in this category</a>.</p>
+<ul class="cards-list">
 {{?pages}}
-  <h2>Cards</h2>
-  <ul class="cards-list">
   {{#pages}}
   <li><a href="{{href}}">{{meta.title}}</a></li>
   {{/pages}}
-  </ul>
 {{/pages}}
+{{?subtags}}
+  {{#subtags}}
+  <li>
+    <a href="{{href}}">{{#tags}} » {{.}} {{/tags}}</a>
+    <ul>
+    {{?pages}}
+      {{#pages}}
+      <li><a href="{{href}}">{{meta.title}}</a></li>
+      {{/pages}}
+    {{/pages}}
+    {{?subtags}}
+      {{#subtags}}
+      <li>
+        <a href="{{href}}">{{#tags}} » {{.}} {{/tags}}</a>
+        <ul>
+        {{?pages}}
+          {{#pages}}
+          <li><a href="{{href}}">{{meta.title}}</a></li>
+          {{/pages}}
+        {{/pages}}
+        {{?subtags}}
+          {{#subtags}}
+          <li><a href="{{href}}">{{#tags}} » {{.}} {{/tags}}</a> (click to expand)</li>
+          {{/subtags}}
+        {{/subtags}}
+        </ul>
+      </li>
+      {{/subtags}}
+    {{/subtags}}
+    </ul>
+  </li>
+  {{/subtags}}
+{{/subtags}}
+</ul>
 {{> footer.html}}
 </body>
 </html>