From efe0dfaf8d22caa0bb59cbd66b6eb969a7ea0464 Mon Sep 17 00:00:00 2001
From: Tristan Cacqueray <tdecacqu@redhat.com>
Date: Mon, 30 Sep 2024 17:49:44 -0400
Subject: [PATCH] Add support for extra navigation with next/prev links

This change enables setting ema:note:next and ema:note:prev template to
insert extra navigation link in the page from the metadata.
---
 docs/guide/yaml-config.md            | 17 ++++++++++++
 emanote/src/Emanote/View/Template.hs | 40 +++++++++++++++++++++++++++-
 2 files changed, 56 insertions(+), 1 deletion(-)

diff --git a/docs/guide/yaml-config.md b/docs/guide/yaml-config.md
index 5695c1cb5..9551a0dad 100644
--- a/docs/guide/yaml-config.md
+++ b/docs/guide/yaml-config.md
@@ -22,6 +22,23 @@ Notice how this page's sidebar colorscheme has [changed to green]{.greenery}? Vi
 - `page.image`: The image to use for the page. This is used for the [[ogp]] meta tag `og:image` meta tag. If not specified, the first image in the page is used. Relative URLs are automatically rewritten to absolute URLs if `page.siteUrl` is non-empty.
 
 
+- `next`, `prev`: Lists of wikilinks to be used for custom navigation. When set, the following template is available:
+
+```
+<ema:has:prev>
+  <div class="flex-1 p-4 mt-8 bg-gray-100 rounded">
+    <span class="mb-2 text-xl font-semibold text-gray-500">Next:
+      <ema:note:prev>
+        <a class="text-${theme}-600 mavenLinkBold hover:bg-${theme}-50 mr-2"
+           href="${nav:url}">
+          <nav:title />
+        </a>
+      </ema:note:prev>
+    </span>
+  </div>
+</ema:has:prev>
+```
+
 ## Examples
 
 - https://github.com/srid/srid/blob/master/index.yaml
diff --git a/emanote/src/Emanote/View/Template.hs b/emanote/src/Emanote/View/Template.hs
index 454829c45..780af17d4 100644
--- a/emanote/src/Emanote/View/Template.hs
+++ b/emanote/src/Emanote/View/Template.hs
@@ -1,6 +1,8 @@
 module Emanote.View.Template (emanoteSiteOutput, render) where
 
+import Commonmark.Extensions.WikiLink qualified as WikiLink
 import Control.Monad.Logger (MonadLoggerIO)
+import Data.Aeson.Optics (key, _String)
 import Data.Aeson.Types qualified as Aeson
 import Data.List (partition)
 import Data.Map.Syntax ((##))
@@ -33,8 +35,9 @@ import Heist.Extra.Splices.Pandoc.Ctx (emptyRenderCtx)
 import Heist.Extra.Splices.Tree qualified as Splices
 import Heist.Interpreted qualified as HI
 import Heist.Splices qualified as Heist
+import Network.URI.Slug qualified as Slug
 import Optics.Core (Prism', review)
-import Optics.Operators ((.~), (^.))
+import Optics.Operators ((.~), (^.), (^?))
 import Relude
 import Text.Blaze.Renderer.XmlHtml qualified as RX
 import Text.Pandoc.Builder qualified as B
@@ -185,6 +188,17 @@ renderLmlHtml model note = do
         $ if MN.noteHasFeed note
           then feedDiscoveryLink model note
           else mempty
+
+    let mNext = getMetaList note "next"
+    forM_ mNext $ \nexts ->
+      "ema:note:next" ## navSplice model note nexts
+    "ema:has:next" ## Heist.ifElseISplice (isJust mNext)
+    let mPrev = getMetaList note "prev"
+    traceShowM (MN._noteMeta note)
+    forM_ mPrev $ \prevs ->
+      "ema:note:prev" ## navSplice model note prevs
+    "ema:has:prev" ## Heist.ifElseISplice (isJust mPrev)
+
     "ema:note:backlinks" ##
       backlinksSplice model (G.modelLookupBacklinks r model)
     let (backlinksDaily, backlinksNoDaily) = partition (Calendar.isDailyNote . fst) $ G.modelLookupBacklinks r model
@@ -209,6 +223,30 @@ renderLmlHtml model note = do
         $ \ctx' ->
           renderToc ctx' toc
 
+-- | Return a meta top attribute as a single elem or a list of elem
+getMetaList :: MN.Note -> Aeson.Key -> Maybe [Text]
+getMetaList note k =
+  MN._noteMeta note
+    ^? key k >>= \v ->
+      let singleValue = (: []) <$> (v ^? _String)
+          listValue = Aeson.parseMaybe Aeson.parseJSON v -- Q: how to do that with aeson-optics?
+       in singleValue <|> listValue
+
+navSplice :: Model -> MN.Note -> [Text] -> HI.Splice Identity
+navSplice model note links = (HI.runChildrenWith . (navSplices model)) `foldMapM` routes
+  where
+    mkWikiLink = WikiLink.mkWikiLinkFromSlugs . pure . Slug.decodeSlug
+    routes = mapMaybe (G.lookupNoteByWikiLink model (note ^. MN.noteRoute) . mkWikiLink) links
+
+navSplices :: Model -> R.LMLRoute -> H.Splices (HI.Splice Identity)
+navSplices model source = do
+  "nav:title" ## C.titleSplice ctx (M.modelLookupTitle source model)
+  "nav:url" ## HI.textSplice (SR.siteRouteUrl model $ SR.lmlSiteRoute (R.LMLView_Html, source))
+  where
+    note = fromMaybe (error "backlink note missing - impossible") $ M.modelLookupNoteByRoute' source model
+    meta = Meta.getEffectiveRouteMetaWith (note ^. MN.noteMeta) source model
+    ctx = C.mkTemplateRenderCtx model source meta
+
 backlinksSplice :: Model -> [(R.LMLRoute, NonEmpty [B.Block])] -> HI.Splice Identity
 backlinksSplice model (bs :: [(R.LMLRoute, NonEmpty [B.Block])]) =
   Splices.listSplice bs "backlink"