support for tag metadata (title/sorting)

Fixes #3
This commit is contained in:
Gregor Kleen 2023-05-15 12:03:43 +02:00
parent 86800a404e
commit e2f8cf866d
4 changed files with 71 additions and 46 deletions

View File

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

View File

@ -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 . toFilePath
joinPath . (\x -> fromMaybe x $ List.stripPrefix prefix x) . splitDirectories
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
route idRoute
compile $ do
let
ctx =
mconcat
[ listField "tags-nav" defaultContext (mapM (uncurry renderTagNav) $ tagsMap tags)
, listField "posts" postContext (postsSort =<< loadAll posts)
, frontendContext
, defaultContext
]
forM_ (tagsMap tags) $ \(tag, fromList -> posts) ->
rulesExtraDependencies [tagsDependency tags] $ do
tagItems <- getMatches . fromGlob $ toFilePath (tagsMakeId tags tag) -<.> "*"
let tagItem = pandocCompiler <|> makeItem mempty
rule
| [] <- tagItems = create [tagsMakeId tags tag]
| otherwise = match (fromList tagItems)
renderTagNav tag ids = do
rule $ do
route . routeAsFilePath $ (-<.> "html") . stripPathPrefix "tags"
compile $ do
let
navRoute
| tag == "index" = "/"
| otherwise = "/" <> tag <> ".html"
tagNavCtx =
ctx =
mconcat
[ constField "tag" tag
, constField "route" navRoute
, listField "posts" (constField "tag" tag <> constField "route" navRoute <> postContext) (postsSort =<< mapM load ids)
[ listField "tags-nav" defaultContext (metadataSort <=< mapM (uncurry renderTagNav) $ tagsMap tags)
, listField "posts" postContext (metadataSort =<< loadAll posts)
, 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

4
tags/meta.md Normal file
View File

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

View File

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