diff options
Diffstat (limited to 'Tags.hs')
| -rw-r--r-- | Tags.hs | 44 |
1 files changed, 34 insertions, 10 deletions
@@ -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 |