From e2f8cf866d3d7771f4fadc048604fa923a32b65f Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 15 May 2023 12:03:43 +0200 Subject: [PATCH] support for tag metadata (title/sorting) Fixes #3 --- package.yaml | 1 + src/Main.hs | 110 ++++++++++++++++++++++++----------------- tags/meta.md | 4 ++ templates/tag-nav.html | 2 +- 4 files changed, 71 insertions(+), 46 deletions(-) create mode 100644 tags/meta.md diff --git a/package.yaml b/package.yaml index 66ecb90..79abdd2 100644 --- a/package.yaml +++ b/package.yaml @@ -32,3 +32,4 @@ executables: - yaml - containers - Glob + - transformers diff --git a/src/Main.hs b/src/Main.hs index 70f9caa..8c6590d 100644 --- a/src/Main.hs +++ b/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 . 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 diff --git a/tags/meta.md b/tags/meta.md new file mode 100644 index 0000000..27d5337 --- /dev/null +++ b/tags/meta.md @@ -0,0 +1,4 @@ +--- +title: Meta-Informationen zur Webseite +sort: -9001 +--- diff --git a/templates/tag-nav.html b/templates/tag-nav.html index 303dee4..3a964c9 100644 --- a/templates/tag-nav.html +++ b/templates/tag-nav.html @@ -1,5 +1,5 @@
  • - $tag$ + $title$