TagIndex.hs

module Emanote.View.TagIndex (renderTagIndex) where

import Data.List qualified as List
import Data.List.NonEmpty qualified as NE
import Data.Map.Strict qualified as Map
import Data.Map.Syntax ((##))
import Data.Tree (Forest, Tree)
import Data.Tree qualified as Tree
import Emanote.Model (Model)
import Emanote.Model qualified as M
import Emanote.Model.Note qualified as MN
import Emanote.Pandoc.Markdown.Syntax.HashTag qualified as HT
import Emanote.Pandoc.Renderer.Query qualified as PF
import Emanote.Route.SiteRoute.Class qualified as SR
import Emanote.View.Common (
  TemplateRenderCtx (withInlineCtx),
  commonSplices,
  defaultRouteMeta,
  mkTemplateRenderCtx,
  renderModelTemplate,
 )
import Heist.Extra.Splices.List qualified as Splices
import Heist.Extra.Splices.Pandoc.Ctx (emptyRenderCtx)
import Heist.Interpreted qualified as HI
import Relude

-- An index view into the notebook indexed by the given tag path.
data TagIndex = TagIndex
  { tagIndexPath :: [HT.TagNode]
  -- ^ The tag path under which this index is creatd
  , tagIndexTitle :: Text
  -- ^ User descriptive title of this index
  , tagIndexNotes :: [MN.Note]
  -- ^ All notes tagged precisely with this tag path
  , tagIndexChildren :: [(NonEmpty HT.TagNode, [MN.Note])]
  -- ^ Tags immediately under this tag path.
  --
  -- If the tag path being index is "foo/bar", this will contain "foo/bar/qux".
  }
  deriving stock (Eq)

mkTagIndex :: Model -> [HT.TagNode] -> TagIndex
mkTagIndex model tagPath' =
  let mTagPath = nonEmpty tagPath'
      tagMap = Map.fromList $ M.modelTags model
      tagForest = HT.tagTree tagMap
      childNodes =
        maybe
          (fst . Tree.rootLabel <$> tagForest)
          (fmap (fst . Tree.rootLabel) . Tree.subForest . flip lookupForestMust tagForest)
          mTagPath
      childTags =
        childNodes <&> \childNode ->
          let t = NE.reverse $ childNode :| reverse tagPath'
           in (t, maybeToMonoid $ Map.lookup (HT.constructTag t) tagMap)
   in case mTagPath of
        Nothing ->
          -- The root index displays all top-level tags (no notes)
          TagIndex [] "Tag Index" [] childTags
        Just tagPath ->
          let notes =
                snd . Tree.rootLabel $ lookupForestMust tagPath tagForest
              viewTitle = "#" <> tagNodesText tagPath <> " - Tag Index"
           in TagIndex (toList tagPath) viewTitle notes childTags
  where
    lookupForestMust :: (Show k, Eq k) => NonEmpty k -> Forest (k, a) -> Tree (k, a)
    lookupForestMust path =
      fromMaybe (error $ "Tag not found in forest: " <> show path)
        . lookupForest path
    lookupForest :: (Eq k) => NonEmpty k -> Forest (k, a) -> Maybe (Tree (k, a))
    lookupForest (k :| ks') trees =
      case nonEmpty ks' of
        Nothing ->
          List.find (\(Tree.Node lbl _) -> fst lbl == k) trees
        Just ks -> do
          subForest <- Tree.subForest <$> List.find (\(Tree.Node lbl _) -> fst lbl == k) trees
          lookupForest ks subForest

renderTagIndex :: Model -> [HT.TagNode] -> LByteString
renderTagIndex model tagPath = do
  let (r, meta) = defaultRouteMeta model
      tCtx = mkTemplateRenderCtx model r meta
      tagIdx = mkTagIndex model tagPath
  renderModelTemplate model "templates/special/tagindex" $ do
    commonSplices ($ emptyRenderCtx) model meta $ fromString . toString $ tagIndexTitle tagIdx
    "ema:tag:title" ## HI.textSplice (maybe "/" (HT.unTagNode . last) $ nonEmpty tagPath)
    "ema:tag:url" ## HI.textSplice (SR.siteRouteUrl model $ SR.tagIndexRoute tagPath)
    let parents = maybe [] (inits . init) $ nonEmpty (tagIndexPath tagIdx)
    "ema:tagcrumbs" ##
      Splices.listSplice parents "ema:each-crumb" $
        \crumb -> do
          let crumbTitle = maybe "/" (HT.unTagNode . last) . nonEmpty $ crumb
              crumbUrl = SR.siteRouteUrl model $ SR.tagIndexRoute crumb
          "ema:tagcrumb:title" ## HI.textSplice crumbTitle
          "ema:tagcrumb:url" ## HI.textSplice crumbUrl
    "ema:childTags" ##
      Splices.listSplice (tagIndexChildren tagIdx) "ema:each-childTag" $
        \childTag -> do
          let childIndex = mkTagIndex model (toList . fst $ childTag)
          "ema:childTag:title" ## HI.textSplice (tagNodesText $ fst childTag)
          "ema:childTag:url" ## HI.textSplice (SR.siteRouteUrl model $ SR.tagIndexRoute (toList $ fst childTag))
          "ema:childTag:count-note" ## HI.textSplice (show (length $ snd childTag))
          "ema:childTag:count-tag" ## HI.textSplice (show (length $ tagIndexChildren childIndex))
    "ema:notes" ##
      Splices.listSplice (tagIndexNotes tagIdx) "ema:each-note" $
        \note ->
          PF.noteSpliceMap (withInlineCtx tCtx) model note

tagNodesText :: NonEmpty HT.TagNode -> Text
tagNodesText =
  HT.unTag . HT.constructTag