stabilize and parametrize sorting of stuff, get rid of "title"

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

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.)

pages/index.md

@@ -2,7 +2,7 @@
 mount: /
 redirects:
   - also_index
-title: Home
+name: Home
 toc: off
 timestamp: null
 ---

pages/search.md

@@ -1,6 +1,6 @@
 ---
 mount: /search
-title: Search
+name: Search
 template: search.html
 search: off
 toc: off

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)
              ]

templates/head.html

@@ -1,12 +1,13 @@
 <head>
   <meta charset="UTF-8" />
   <title>
-  {{?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}}
   </title>

templates/header.html

@@ -10,7 +10,7 @@
   Categories:
   <ul>
     {{#htags}}
-    <li>{{#.}}<a href="{{href}}">{{^tag}}all{{/tag}}{{?tag}} » {{tag}}{{/tag}}{{/.}}</a></li>
+    <li><a href="{{href}}">{{#htag}} » {{name}}{{/htag}}</a></li>
     {{/htags}}
   </ul>
   {{/htags}}

templates/list.html

@@ -23,7 +23,7 @@
   <h3>Pages</h3>
   <ul>
   {{#pages}}
-  <li><a href="{{href}}">{{meta.title}}</a></li>
+  <li><a href="{{href}}">{{meta.name}}</a></li>
   {{/pages}}
   </ul>
 {{/pages}}

templates/tag.html

@@ -15,7 +15,7 @@
 <ul>
 {{?pages}}
   {{#pages}}
-  <li><a href="{{href}}">{{meta.title}}</a></li>
+  <li><a href="{{href}}">{{meta.name}}</a></li>
   {{/pages}}
 {{/pages}}
 {{?subtags}}
@@ -26,7 +26,7 @@
     <ul>
     {{?pages}}
       {{#pages}}
-      <li><a href="{{href}}">{{meta.title}}</a></li>
+      <li><a href="{{href}}">{{meta.name}}</a></li>
       {{/pages}}
     {{/pages}}
     {{?subtags}}
@@ -37,7 +37,7 @@
         <ul>
         {{?pages}}
           {{#pages}}
-          <li><a href="{{href}}">{{meta.title}}</a></li>
+          <li><a href="{{href}}">{{meta.name}}</a></li>
           {{/pages}}
         {{/pages}}
         {{?subtags}}