From 1f2ab58478925481d5cf273d38e30fc06e96e69e Mon Sep 17 00:00:00 2001
From: Mirek Kratochvil <exa.exa@gmail.com>
Date: Sun, 15 Oct 2023 23:06:59 +0200
Subject: stabilize and parametrize sorting of stuff, get rid of "title"

---
 Tags.hs | 44 ++++++++++++++++++++++++++++++++++----------
 1 file changed, 34 insertions(+), 10 deletions(-)

(limited to 'Tags.hs')

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
-- 
cgit v1.2.3