support for tag metadata (title/sorting)

Fixes #3

package.yaml

@@ -32,3 +32,4 @@ executables:
       - yaml
       - containers
       - Glob
+      - transformers

src/Main.hs

@@ -6,6 +6,7 @@ import Hakyll
 
 import Data.List qualified as List
 import Data.Maybe
+
 import System.FilePath
 import System.FilePath.Glob qualified as Glob
 
@@ -15,6 +16,9 @@ import Data.Map (Map)
 import Data.Map qualified as Map
 
 import Control.Monad
+import Control.Monad.Trans.Maybe
+
+import Control.Applicative
 
 config :: Configuration
 config =
@@ -22,10 +26,12 @@ config =
     { destinationDirectory = "public"
     }
 
-stripPathPrefix :: FilePath -> Routes
+routeAsFilePath :: (FilePath -> FilePath) -> Routes
+routeAsFilePath f = customRoute $ f . toFilePath
+
+stripPathPrefix :: FilePath -> (FilePath -> FilePath)
 stripPathPrefix (splitDirectories -> prefix) =
-  customRoute $
+  joinPath . (\x -> fromMaybe x $ List.stripPrefix prefix x) . splitDirectories
-    joinPath . (\x -> fromMaybe x $ List.stripPrefix prefix x) . splitDirectories . toFilePath
 
 main :: IO ()
 main = hakyllWith config $ do
@@ -50,65 +56,79 @@ main = hakyllWith config $ do
               resources = filter (Glob.match p) $ frontendManifest Map.! entryPoint
           forM resources $ load . fromFilePath . ("frontend/dist" </>) . dropDrive
 
-  tags <- buildTags "content/**" $ fromCapture "*.html"
+  tags <- buildTags "content/**" $ fromCapture "tags/*.html"
 
   match "content/**" $ do
     compile $ do
       pandocCompiler
         >>= relativizeUrls
 
-  tagsRules tags $ \_tag posts -> do
+  forM_ (tagsMap tags) $ \(tag, fromList -> posts) ->
-    route idRoute
+    rulesExtraDependencies [tagsDependency tags] $ do
-    compile $ do
+      tagItems <- getMatches . fromGlob $ toFilePath (tagsMakeId tags tag) -<.> "*"
-      let
+      let tagItem = pandocCompiler <|> makeItem mempty
-        ctx =
+          rule
-          mconcat
+            | [] <- tagItems = create [tagsMakeId tags tag]
-            [ listField "tags-nav" defaultContext (mapM (uncurry renderTagNav) $ tagsMap tags)
+            | otherwise = match (fromList tagItems)
-            , listField "posts" postContext (postsSort =<< loadAll posts)
-            , frontendContext
-            , defaultContext
-            ]
 
-        renderTagNav tag ids = do
+      rule $ do
+        route . routeAsFilePath $ (-<.> "html") . stripPathPrefix "tags"
+        compile $ do
           let
-            navRoute
+            ctx =
-              | tag == "index" = "/"
-              | otherwise = "/" <> tag <> ".html"
-
-            tagNavCtx =
               mconcat
-                [ constField "tag" tag
+                [ listField "tags-nav" defaultContext (metadataSort <=< mapM (uncurry renderTagNav) $ tagsMap tags)
-                , constField "route" navRoute
+                , listField "posts" postContext (metadataSort =<< loadAll posts)
-                , listField "posts" (constField "tag" tag <> constField "route" navRoute <> postContext) (postsSort =<< mapM load ids)
+                , frontendContext
+                , defaultContext
                 ]
-          makeItem (mempty :: String)
+
-            >>= loadAndApplyTemplate "templates/tag-nav.html" tagNavCtx
+            renderTagNav tag' ids = do
+              tagItems' <- getMatches . fromGlob $ toFilePath (tagsMakeId tags tag') -<.> "*"
+              let
+                tagItem' = return $ Item (fromMaybe (tagsMakeId tags tag') $ listToMaybe tagItems') (mempty :: String)
+
+                navRoute
+                  | tag' == "index" = "/"
+                  | otherwise = "/" <> tag' <> ".html"
+
+                tagNavCtx =
+                  mconcat
+                    [ constField "tag" tag'
+                    , field "title" . const $
+                        fmap (fromMaybe tag') . runMaybeT . asum $
+                          map (\itemId -> MaybeT $ getMetadataField itemId "title") tagItems'
+                    , constField "route" navRoute
+                    , listField "posts" (constField "tag" tag' <> constField "route" navRoute <> postContext) (metadataSort =<< mapM load ids)
+                    ]
+              tagItem'
+                >>= loadAndApplyTemplate "templates/tag-nav.html" tagNavCtx
+                >>= relativizeUrls
+
+            postContext =
+              mconcat
+                [ field "identifier" (return . takeBaseName . toFilePath . itemIdentifier)
+                , defaultContext
+                ]
+
+            metadataSort :: [Item w] -> Compiler [Item w]
+            metadataSort = sortOnM $ \Item{itemIdentifier} -> maybe (0 :: Integer) read <$> getMetadataField itemIdentifier "sort"
+              where
+                sortOnM :: forall m a b. (Monad m, Ord b) => (a -> m b) -> [a] -> m [a]
+                sortOnM f = fmap (map snd . List.sortOn fst) . mapM (\x -> (,x) <$> f x)
+
+          tagItem
+            >>= loadAndApplyTemplate "templates/tag.html" ctx
+            >>= loadAndApplyTemplate "templates/site-layout.html" ctx
             >>= relativizeUrls
 
-        postContext =
-          mconcat
-            [ field "identifier" (return . takeBaseName . toFilePath . itemIdentifier)
-            , defaultContext
-            ]
-
-        postsSort :: [Item w] -> Compiler [Item w]
-        postsSort = sortOnM $ \Item{itemIdentifier} -> getMetadataField itemIdentifier "sort"
-          where
-            sortOnM :: forall m a b. (Monad m, Ord b) => (a -> m b) -> [a] -> m [a]
-            sortOnM f = fmap (map snd . List.sortOn fst) . mapM (\x -> (,x) <$> f x)
-
-      makeItem (mempty :: String)
-        >>= loadAndApplyTemplate "templates/tag.html" ctx
-        >>= loadAndApplyTemplate "templates/site-layout.html" ctx
-        >>= relativizeUrls
-
   match "frontend/dist/wp-*/**" $ do
-    route $ stripPathPrefix "frontend/dist"
+    route . routeAsFilePath $ stripPathPrefix "frontend/dist"
 
     compile copyFileCompiler
 
   match "templates/*" $ compile templateBodyCompiler
 
   match "static/**" $ do
-    route $ stripPathPrefix "static"
+    route . routeAsFilePath $ stripPathPrefix "static"
     compile copyFileCompiler

tags/meta.md

@@ -0,0 +1,4 @@
+---
+title: Meta-Informationen zur Webseite
+sort: -9001
+---

templates/tag-nav.html

@@ -1,5 +1,5 @@
 <li>
-  <a href="$route$">$tag$</a>
+  <a href="$route$">$title$</a>
 
   <ul>
     $for(posts)$