diff --git a/Types.hs b/Types.hs index e6455d5..beb008d 100644 --- a/Types.hs +++ b/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 diff --git a/cards/codeCheck.md b/cards/codeCheck.md index ffa6b1c..9dd8352 100644 --- a/cards/codeCheck.md +++ b/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 diff --git a/cards/mypage/text.md b/cards/mypage/text.md index bcc7945..32a7a13 100644 --- a/cards/mypage/text.md +++ b/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 diff --git a/site.hs b/site.hs index 6c6e895..21d4fd2 100644 --- a/site.hs +++ b/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 diff --git a/templates/footer.html b/templates/footer.html index 445b639..6aff097 100644 --- a/templates/footer.html +++ b/templates/footer.html @@ -4,10 +4,10 @@
- The contents are available under the Creative Commons Attribution-ShareAlike License (CC-BY-SA 4.0). + The contents are available under the Creative Commons Attribution-ShareAlike License (CC-BY-SA 4.0).
- Privacy Policy (Only necessary cookies accepted — change) + Privacy Policy (Only necessary cookies accepted — change)
diff --git a/templates/tag.html b/templates/tag.html index b617996..f17e669 100644 --- a/templates/tag.html +++ b/templates/tag.html @@ -4,32 +4,55 @@ {{> header.html}}

-{{?htag}} - Category: - {{#htag}} - - {{^tag}}all{{/tag}} - {{?tag}}» {{tag}}{{/tag}} - - {{/htag}} +Cards in category: +{{#htag}} + + {{^tag}}all{{/tag}} + {{?tag}}» {{tag}}{{/tag}} + {{/htag}} -{{^htag}}All cards{{/htag}}

-{{?subtags}}

Sub-categories

- -{{/subtags}} +

See the complete listing of all pages in this category.

+ {{> footer.html}}