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
  { TagIndex -> [TagNode]
tagIndexPath :: [HT.TagNode]
  -- ^ The tag path under which this index is creatd
  , TagIndex -> Text
tagIndexTitle :: Text
  -- ^ User descriptive title of this index
  , TagIndex -> [Note]
tagIndexNotes :: [MN.Note]
  -- ^ All notes tagged precisely with this tag path
  , TagIndex -> [(NonEmpty TagNode, [Note])]
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 (TagIndex -> TagIndex -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagIndex -> TagIndex -> Bool
$c/= :: TagIndex -> TagIndex -> Bool
== :: TagIndex -> TagIndex -> Bool
$c== :: TagIndex -> TagIndex -> Bool
Eq)

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

renderTagIndex :: Model -> [HT.TagNode] -> LByteString
renderTagIndex :: Model -> [TagNode] -> LByteString
renderTagIndex Model
model [TagNode]
tagPath = do
  let (LMLRoute
r, Value
meta) = Model -> (LMLRoute, Value)
defaultRouteMeta Model
model
      tCtx :: TemplateRenderCtx @(Type -> Type) Identity
tCtx = Model
-> LMLRoute -> Value -> TemplateRenderCtx @(Type -> Type) Identity
mkTemplateRenderCtx Model
model LMLRoute
r Value
meta
      tagIdx :: TagIndex
tagIdx = Model -> [TagNode] -> TagIndex
mkTagIndex Model
model [TagNode]
tagPath
  Model -> TemplateName -> Splices (Splice Identity) -> LByteString
renderModelTemplate Model
model TemplateName
"templates/special/tagindex" forall a b. (a -> b) -> a -> b
$ do
    HasCallStack =>
((RenderCtx -> Splice Identity) -> Splice Identity)
-> Model -> Value -> Title -> Splices (Splice Identity)
commonSplices (forall a b. (a -> b) -> a -> b
$ RenderCtx
emptyRenderCtx) Model
model Value
meta forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToString a => a -> String
toString forall a b. (a -> b) -> a -> b
$ TagIndex -> Text
tagIndexTitle TagIndex
tagIdx
    Text
"ema:tag:title" forall k v. k -> v -> MapSyntax k v
## forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m Template
HI.textSplice (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"/" (TagNode -> Text
HT.unTagNode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: Type -> Type) a. IsNonEmpty f a a "last" => f a -> a
last) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [TagNode]
tagPath)
    Text
"ema:tag:url" forall k v. k -> v -> MapSyntax k v
## forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m Template
HI.textSplice (HasCallStack => Model -> SiteRoute -> Text
SR.siteRouteUrl Model
model forall a b. (a -> b) -> a -> b
$ [TagNode] -> SiteRoute
SR.tagIndexRoute [TagNode]
tagPath)
    let parents :: [[TagNode]]
parents = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a. [a] -> [[a]]
inits forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: Type -> Type) a.
IsNonEmpty f a [a] "init" =>
f a -> [a]
init) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (TagIndex -> [TagNode]
tagIndexPath TagIndex
tagIdx)
    Text
"ema:tagcrumbs" forall k v. k -> v -> MapSyntax k v
##
      forall a.
[a] -> Text -> (a -> Splices (Splice Identity)) -> Splice Identity
Splices.listSplice [[TagNode]]
parents Text
"ema:each-crumb" forall a b. (a -> b) -> a -> b
$
        \[TagNode]
crumb -> do
          let crumbTitle :: Text
crumbTitle = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"/" (TagNode -> Text
HT.unTagNode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: Type -> Type) a. IsNonEmpty f a a "last" => f a -> a
last) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (NonEmpty a)
nonEmpty forall a b. (a -> b) -> a -> b
$ [TagNode]
crumb
              crumbUrl :: Text
crumbUrl = HasCallStack => Model -> SiteRoute -> Text
SR.siteRouteUrl Model
model forall a b. (a -> b) -> a -> b
$ [TagNode] -> SiteRoute
SR.tagIndexRoute [TagNode]
crumb
          Text
"ema:tagcrumb:title" forall k v. k -> v -> MapSyntax k v
## forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m Template
HI.textSplice Text
crumbTitle
          Text
"ema:tagcrumb:url" forall k v. k -> v -> MapSyntax k v
## forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m Template
HI.textSplice Text
crumbUrl
    Text
"ema:childTags" forall k v. k -> v -> MapSyntax k v
##
      forall a.
[a] -> Text -> (a -> Splices (Splice Identity)) -> Splice Identity
Splices.listSplice (TagIndex -> [(NonEmpty TagNode, [Note])]
tagIndexChildren TagIndex
tagIdx) Text
"ema:each-childTag" forall a b. (a -> b) -> a -> b
$
        \(NonEmpty TagNode, [Note])
childTag -> do
          let childIndex :: TagIndex
childIndex = Model -> [TagNode] -> TagIndex
mkTagIndex Model
model (forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ (NonEmpty TagNode, [Note])
childTag)
          Text
"ema:childTag:title" forall k v. k -> v -> MapSyntax k v
## forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m Template
HI.textSplice (NonEmpty TagNode -> Text
tagNodesText forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (NonEmpty TagNode, [Note])
childTag)
          Text
"ema:childTag:url" forall k v. k -> v -> MapSyntax k v
## forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m Template
HI.textSplice (HasCallStack => Model -> SiteRoute -> Text
SR.siteRouteUrl Model
model forall a b. (a -> b) -> a -> b
$ [TagNode] -> SiteRoute
SR.tagIndexRoute (forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (NonEmpty TagNode, [Note])
childTag))
          Text
"ema:childTag:count-note" forall k v. k -> v -> MapSyntax k v
## forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m Template
HI.textSplice (forall b a. (Show a, IsString b) => a -> b
show (forall (t :: Type -> Type) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd (NonEmpty TagNode, [Note])
childTag))
          Text
"ema:childTag:count-tag" forall k v. k -> v -> MapSyntax k v
## forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m Template
HI.textSplice (forall b a. (Show a, IsString b) => a -> b
show (forall (t :: Type -> Type) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ TagIndex -> [(NonEmpty TagNode, [Note])]
tagIndexChildren TagIndex
childIndex))
    Text
"ema:notes" forall k v. k -> v -> MapSyntax k v
##
      forall a.
[a] -> Text -> (a -> Splices (Splice Identity)) -> Splice Identity
Splices.listSplice (TagIndex -> [Note]
tagIndexNotes TagIndex
tagIdx) Text
"ema:each-note" forall a b. (a -> b) -> a -> b
$
        \Note
note ->
          ((RenderCtx -> Splice Identity) -> Splice Identity)
-> Model -> Note -> Splices (Splice Identity)
PF.noteSpliceMap (forall {k} (n :: k).
TemplateRenderCtx @k n
-> (RenderCtx -> Splice Identity) -> Splice Identity
withInlineCtx TemplateRenderCtx @(Type -> Type) Identity
tCtx) Model
model Note
note

tagNodesText :: NonEmpty HT.TagNode -> Text
tagNodesText :: NonEmpty TagNode -> Text
tagNodesText =
  Tag -> Text
HT.unTag forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty TagNode -> Tag
HT.constructTag