From 402107a237a7039b0aa2028f6c21939e53c98dc4 Mon Sep 17 00:00:00 2001 From: Mirek Kratochvil Date: Sun, 15 Oct 2023 22:22:18 +0200 Subject: support tag metadata, make much everything nicer --- templates/tag.html | 25 +++++++++++++++---------- 1 file changed, 15 insertions(+), 10 deletions(-) (limited to 'templates/tag.html') diff --git a/templates/tag.html b/templates/tag.html index cb79591..8e8fb09 100644 --- a/templates/tag.html +++ b/templates/tag.html @@ -4,13 +4,12 @@ {{> header.html}}

htag}}

See the complete listing of all pages in this category.

- {{#tags}} » {{.}} {{/tags}} + {{name}} + ({{#htag}} » {{name}} {{/htag}})
- - {{#tags}} » {{.}} {{/tags}} + {{name}} + ({{#htag}} » {{name}} {{/htag}})
  - {{#tags}} » {{.}} {{/tags}} (click to expand)
  - + {{name}} + ({{#htag}} » {{name}} {{/htag}}, + click to expand) +
  -- cgit v1.2.3 From 1f2ab58478925481d5cf273d38e30fc06e96e69e Mon Sep 17 00:00:00 2001 From: Mirek Kratochvil
  Date: Sun, 15 Oct 2023 23:06:59 +0200 Subject: stabilize and parametrize sorting of stuff, get rid of "title" --- Tags.hs | 44 ++++++++++++++++++++++++++++++++++---------- Utils.hs | 5 +++-- pages/index.md | 2 +- pages/search.md | 2 +- reploy.hs | 6 +++--- templates/head.html | 7 ++++--- templates/header.html | 2 +- templates/list.html | 2 +- templates/tag.html | 6 +++--- 9 files changed, 51 insertions(+), 25 deletions(-) (limited to 'templates/tag.html') diff --git a/Tags.hs b/Tags.hs index 15d4b89..1a55453 100644 --- a/Tags.hs +++ b/Tags.hs @@ -5,7 +5,7 @@ module Tags where import qualified Data.Aeson.Key as K import qualified Data.Aeson.KeyMap as KM import Data.Foldable (traverse_) -import Data.List (inits, nub) +import Data.List (inits, nub, sortOn) import Data.List.Extra (groupSort) import qualified Data.Map as M import Data.String (fromString) @@ -14,7 +14,7 @@ import qualified Data.Yaml as Y import Lens.Micro import Lens.Micro.Aeson import Lens.Micro.Mtl -import System.FilePath ((), splitDirectories, takeFileName) +import System.FilePath ((), joinPath, splitDirectories, takeFileName) import AesonUtils import Types @@ -53,7 +53,7 @@ sourceTagMetaFile fp = do kx = splitTag ks v | Y.String t <- v' = - Y.Object $ KM.fromList [("title", Y.String t)] + Y.Object $ KM.fromList [("name", Y.String t)] | Y.Object _ <- v' = v' | otherwise = error ("invalid definition of tag " ++ ks ++ " in " ++ fp) @@ -69,10 +69,10 @@ sourceTagMetaFile fp = do -- | Find a good display name for the _last_ hierarchical part of the htag. getTagGroupName :: [String] -> Site String getTagGroupName htag = - handleEmpty . maybe backup id . (>>= title) . (M.!? htag) <$> use tagMeta + handleEmpty . maybe backup id . (>>= name) . (M.!? htag) <$> use tagMeta where - title :: Y.Value -> Maybe String - title obj = obj ^? key "title" . _String . to T.unpack + name :: Y.Value -> Maybe String + name obj = obj ^? key "name" . _String . to T.unpack backup | null htag = "" | null (last htag) = "(unnamed)" @@ -129,6 +129,21 @@ htagRenderMeta makeLink htag = do metas) ] +data SortKey num + = Negative num + | Stringy String + | Positive num + deriving (Show, Eq, Ord) + +toSortKey ident x + | Just i <- x ^? key "meta" . key "order" . _Number = + if i <= 0 + then Negative i + else Positive i + | Just s <- x ^? key "meta" . key "order" . _String = Stringy (T.unpack s) + | Just n <- x ^? key "name" . _String = Stringy (T.unpack n) + | otherwise = Stringy ident + -- | A generic helper for rendering metadata for tagged pages. genericTaggedPagesRenderMeta :: (FilePath -> Site Y.Value) @@ -136,7 +151,12 @@ genericTaggedPagesRenderMeta :: -> M.Map [String] [FilePath] -> Site Y.Value genericTaggedPagesRenderMeta makePageMeta htag tagmap = - Y.array <$> traverse makePageMeta (maybe [] id $ tagmap M.!? htag) -- TODO sort page listings here + Y.array . map snd . sortOn (uncurry toSortKey) <$> + traverse metaPair (maybe [] id $ tagmap M.!? htag) + where + metaPair x = do + m <- makePageMeta x + pure (x, m) -- | Render metadata for all precisely tagged pages (not considering the -- inheritance of tags following the hierarchy). @@ -163,9 +183,13 @@ htagRenderMetaWithSubtags :: -> Site Y.Value htagRenderMetaWithSubtags makeLink extraMeta subtagMeta htag = do meta <- htagRenderMeta makeLink htag + em <- extraMeta htag subtags <- filter ((== htag) . init) . filter (not . null) . M.keys <$> use ehtags - {- TODO sort tag listings here -} - em <- extraMeta htag - subtagMetas <- Y.array . filter (/= Y.Null) <$> traverse subtagMeta subtags + let metaPair x = do + m <- subtagMeta x + pure (joinPath x, m) + subtagMetas <- + Y.array . filter (/= Y.Null) . map snd . sortOn (uncurry toSortKey) <$> + traverse metaPair subtags pure $ meta `objMerge` Y.object [("subtags", subtagMetas)] `objMerge` em diff --git a/Utils.hs b/Utils.hs index 07cc7b2..9c901cc 100644 --- a/Utils.hs +++ b/Utils.hs @@ -28,7 +28,7 @@ import System.Directory , doesDirectoryExist , getDirectoryContents ) -import System.FilePath ((), takeDirectory, splitDirectories) +import System.FilePath ((), splitDirectories, takeDirectory) import Text.Pandoc.Definition import qualified Text.Pandoc.Walk import Types @@ -132,7 +132,8 @@ sourcePaths fp process = do | null ds = False | last ds `elem` notSource = True | otherwise = False - io (getRecursiveContents (pure . ignoreDir . splitDirectories) fp) >>= foldMapM process + io (getRecursiveContents (pure . ignoreDir . splitDirectories) fp) >>= + foldMapM process -- | Given a path to a file, try to make the path writable by making all -- directories on the path. (Interned from Hakyll.) diff --git a/pages/index.md b/pages/index.md index 38a87df..5fedf2c 100644 --- a/pages/index.md +++ b/pages/index.md @@ -2,7 +2,7 @@ mount: / redirects: - also_index -title: Home +name: Home toc: off timestamp: null --- diff --git a/pages/search.md b/pages/search.md index 42713f0..9214e51 100644 --- a/pages/search.md +++ b/pages/search.md @@ -1,6 +1,6 @@ --- mount: /search -title: Search +name: Search template: search.html search: off toc: off diff --git a/reploy.hs b/reploy.hs index 12d7a57..8f1cd73 100644 --- a/reploy.hs +++ b/reploy.hs @@ -439,8 +439,8 @@ makeSearchData :: FilePath -> PageInfo -> Site [Y.Value] makeSearchData mount pi = do link <- rootedPageLink mount text <- io . runIOorExplode $ writePlain plainWriteOpts (pi ^. pageDoc) - let title = pi ^? pageMeta . key "title" . _String - -- TODO: unify retrieval of tags + let name = pi ^? pageMeta . key "name" . _String + -- TODO: unify retrieval of tags? let tags = sort $ pi ^.. pageMeta . key "tags" . values . _String . to T.unpack tagnames <- traverse (traverse getTagGroupName . inits . splitTag) tags @@ -450,7 +450,7 @@ makeSearchData mount pi = do else pure $ [ Y.object [ ("link", fromString link) - , ("title", maybe (fromString mount) Y.String title) + , ("name", maybe (fromString mount) Y.String name) , ("tags", tagarray) , ("text", Y.String text) ] diff --git a/templates/head.html b/templates/head.html index 59bbfa0..17fe88d 100644 --- a/templates/head.html +++ b/templates/head.html @@ -1,12 +1,13 @@ - {{?title}}Page: {{title}}{{/title}} + {{^htag}} + {{?name}}Page: {{name}}{{/name}} + {{/htag}} {{?htag}} Category: {{#htag}} - {{?tag}} » {{tag}}{{/tag}} - {{^tag}}All pages{{/tag}} + {{?name}} » {{name}}{{/name}} {{/htag}} {{/htag}} diff --git a/templates/header.html b/templates/header.html index 8fa2cc6..1afc80e 100644 --- a/templates/header.html +++ b/templates/header.html @@ -10,7 +10,7 @@ Categories:
  - {{#.}}{{^tag}}all{{/tag}}{{?tag}} » {{tag}}{{/tag}}{{/.}}
  - {{#htag}} » {{name}}{{/htag}}
  {{/htags}} diff --git a/templates/list.html b/templates/list.html index 8fe58e4..4c173f5 100644 --- a/templates/list.html +++ b/templates/list.html @@ -23,7 +23,7 @@
  Pages
  - {{meta.title}}
  - {{meta.name}}
  {{/pages}} diff --git a/templates/tag.html b/templates/tag.html index 8e8fb09..600e050 100644 --- a/templates/tag.html +++ b/templates/tag.html @@ -15,7 +15,7 @@
  - {{meta.title}}
  - {{meta.name}}