tagges

external/mypage/text.md

@@ -0,0 +1,23 @@
+---
+title: My Page
+mount: ext/mypage
+redirects:
+  - mypage
+  - old:mypage
+tags:
+  - yyy
+  - topic1/xxx
+---
+
+# My Page
+
+something something
+
+```
+this that
+```
+
+## Something else
+
+more nonsense
+haha

pagedeploy.cabal

@@ -8,5 +8,6 @@ executable site
   build-depends:    base == 4.*
                   , hakyll == 4.16.*
                   , filepath
+                  , extra
   ghc-options:      -threaded -rtsopts -with-rtsopts=-N
   default-language: Haskell2010

site.hs

@@ -2,29 +2,30 @@
 
 import Hakyll
 
-import Control.Monad ((>=>))
+import Control.Monad ((>=>), when)
 import Data.Foldable (traverse_)
+import Data.List (inits, nub)
+import Data.List.Extra (groupSort)
 import Data.Maybe (fromMaybe)
-import System.FilePath ((</>), dropTrailingPathSeparator, normalise)
+import System.FilePath
+  ( (</>)
+  , dropTrailingPathSeparator
+  , joinPath
+  , normalise
+  , splitDirectories
+  )
 
 import Debug.Trace
 
+getMount' :: a -> (String -> a) -> Metadata -> a
+getMount' a b = maybe a b . lookupString "mount"
+
 getMount :: Metadata -> Routes
-getMount = maybe idRoute constRoute . lookupString "mount"
+getMount = getMount' idRoute constRoute
 
 indexInDir :: Routes -> Routes
 indexInDir = flip composeRoutes . customRoute $ (</> "index.html") . toFilePath
 
-extractRedirs :: Identifier -> Rules (Identifier, [Identifier])
-extractRedirs ident = do
-  md <- getMetadata ident
-  let to = fromMaybe ident $ fromFilePath <$> lookupString "mount" md
-      froms =
-        fromMaybe [] $
-        map (fromFilePath . dropTrailingPathSeparator . normalise) <$>
-        lookupStringList "redirects" md
-  pure (to, froms)
-
 makePage :: Rules ()
 makePage = do
   route $ indexInDir (metadataRoute getMount)
@@ -33,6 +34,16 @@ makePage = do
     loadAndApplyTemplate "templates/default.html" pageCtx >>=
     relativizeUrls
 
+extractRedirs :: Identifier -> Rules (Identifier, [Identifier])
+extractRedirs ident = do
+  md <- getMetadata ident
+  let to = getMount' ident fromFilePath md
+      froms =
+        fromMaybe [] $
+        map (fromFilePath . dropTrailingPathSeparator . normalise) <$>
+        lookupStringList "redirects" md
+  pure (to, froms)
+
 makeRedirects :: Identifier -> [Identifier] -> Rules ()
 makeRedirects to froms =
   create froms $ do
@@ -42,6 +53,36 @@ makeRedirects to froms =
 spawnRedirects :: [Identifier] -> Rules ()
 spawnRedirects = traverse_ (extractRedirs >=> uncurry makeRedirects)
 
+extractHTagLinks :: Identifier -> Rules (Identifier, [[String]])
+extractHTagLinks ident = do
+  md <- getMetadata ident
+  let to = getMount' ident fromFilePath md
+      htags = maybe [] (map splitDirectories) $ lookupStringList "tags" md
+  when (null htags) . fail $ "Uncategorized: " ++ show ident
+  pure (to, htags)
+
+invTags :: [(Identifier, [[String]])] -> [([String], [String])]
+invTags x = map (fmap (map ('/':) . nub . map toFilePath)) $ groupSort [(t, p) | (p, htl) <- x, ht <- htl, t <- inits ht]
+
+makeTag :: [FilePath] -> [String] -> Rules ()
+makeTag htag pages =
+  create [fromFilePath $ joinPath ("tags" : htag)] $ do
+    route (indexInDir idRoute)
+    compile $ do
+      let ctx =
+            mconcat
+              [ constField "title" ("Pages tagged " ++ joinPath htag)
+              , listField "htags" (field "htag" (return . itemBody)) (traverse makeItem htag)
+              , listField "pages" (field "page" (return . itemBody)) (traverse makeItem pages)
+              , defaultContext
+              ]
+      makeItem "" >>= loadAndApplyTemplate "templates/tag.html" ctx >>=
+        loadAndApplyTemplate "templates/default.html" ctx >>=
+        relativizeUrls
+
+spawnTags =
+  traverse extractHTagLinks >=> pure . invTags >=> traverse_ (uncurry makeTag)
+
 main :: IO ()
 main =
   hakyll $
@@ -50,6 +91,8 @@ main =
     match "external/**/*.md" makePage
     {- Source and process the redirects -}
     getMatches "external/**/*.md" >>= spawnRedirects
+    {- Source and process the tags -}
+    getMatches "external/**/*.md" >>= spawnTags
     {- Compile the templates (no routing, cache-only) -}
     match "templates/*" $ compile templateBodyCompiler
 

templates/default.html

@@ -0,0 +1,12 @@
+<!doctype html>
+<html lang="en">
+    <head>
+        <meta charset="utf-8">
+        <meta name="viewport" content="width=device-width, initial-scale=1">
+        <title>My Stuffs - $title$</title>
+    </head>
+    <body>
+        <h1>$title$</h1>
+        $body$
+    </body>
+</html>

templates/page.html

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

templates/tag.html

@@ -0,0 +1,14 @@
+<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>