module Emanote.View.Template (emanoteSiteOutput, render) where

import Control.Monad.Logger (MonadLoggerIO)
import Data.Aeson.Types qualified as Aeson
import Data.List (partition)
import Data.List.NonEmpty qualified as NE
import Data.Map.Syntax ((##))
import Data.Text qualified as T
import Data.Tree.Path qualified as PathTree
import Ema qualified
import Emanote.Model (Model, ModelEma)
import Emanote.Model qualified as M
import Emanote.Model.Calendar qualified as Calendar
import Emanote.Model.Graph qualified as G
import Emanote.Model.Meta qualified as Meta
import Emanote.Model.Note qualified as MN
import Emanote.Model.SData qualified as SData
import Emanote.Model.Stork (renderStorkIndex)
import Emanote.Pandoc.BuiltinFilters (prepareNoteDoc, preparePandoc)
import Emanote.Route qualified as R
import Emanote.Route.SiteRoute (SiteRoute)
import Emanote.Route.SiteRoute qualified as SR
import Emanote.Route.SiteRoute.Class (indexRoute)
import Emanote.View.Common qualified as C
import Emanote.View.Export (renderGraphExport)
import Emanote.View.TagIndex qualified as TagIndex
import Emanote.View.TaskIndex qualified as TaskIndex
import Heist qualified as H
import Heist.Extra.Splices.List qualified as Splices
import Heist.Extra.Splices.Pandoc qualified as Splices
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 Optics.Core (Prism', review)
import Optics.Operators ((.~), (^.))
import Relude
import Text.Pandoc.Builder qualified as B
import Text.Pandoc.Definition (Pandoc (..))

emanoteSiteOutput :: (MonadIO m, MonadLoggerIO m) => Prism' FilePath SiteRoute -> ModelEma -> SR.SiteRoute -> m (Ema.Asset LByteString)
emanoteSiteOutput :: forall (m :: Type -> Type).
(MonadIO m, MonadLoggerIO m) =>
Prism' FilePath SiteRoute
-> ModelEma -> SiteRoute -> m (Asset LByteString)
emanoteSiteOutput Prism' FilePath SiteRoute
rp ModelEma
model' SiteRoute
r = do
  let model :: Model
model = Prism' FilePath SiteRoute -> ModelEma -> Model
M.withRoutePrism Prism' FilePath SiteRoute
rp ModelEma
model'
  forall (m :: Type -> Type).
(MonadIO m, MonadLoggerIO m) =>
Model -> SiteRoute -> m (Asset LByteString)
render Model
model SiteRoute
r forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap LByteString -> LByteString
fixStaticUrl
  where
    -- See the FIXME in more-head.tpl.
    fixStaticUrl :: LByteString -> LByteString
    fixStaticUrl :: LByteString -> LByteString
fixStaticUrl LByteString
s =
      case Maybe Text
findPrefix of
        Maybe Text
Nothing -> LByteString
s
        Just Text
prefix ->
          -- Patch the URL in CSS's "src" attribute.
          forall a b. ConvertUtf8 a b => a -> b
encodeUtf8
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
"src: url(_emanote-static/" (Text
"src: url(" forall a. Semigroup a => a -> a -> a
<> Text
prefix forall a. Semigroup a => a -> a -> a
<> Text
"_emanote-static/")
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertUtf8 a b => b -> a
decodeUtf8
            forall a b. (a -> b) -> a -> b
$ LByteString
s
      where
        -- Find the "prefix" in PrefixedRoute if Emanote is used as a library.
        findPrefix :: Maybe Text
        findPrefix :: Maybe Text
findPrefix = do
          let indexR :: Text
indexR = forall a. ToText a => a -> Text
toText forall a b. (a -> b) -> a -> b
$ forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Prism' FilePath SiteRoute
rp SiteRoute
indexRoute
          Text
prefix <- Text -> Text -> Maybe Text
T.stripSuffix Text
"-/all.html" Text
indexR
          forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
prefix
          forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Text
prefix

render :: (MonadIO m, MonadLoggerIO m) => Model -> SR.SiteRoute -> m (Ema.Asset LByteString)
render :: forall (m :: Type -> Type).
(MonadIO m, MonadLoggerIO m) =>
Model -> SiteRoute -> m (Asset LByteString)
render Model
m SiteRoute
sr =
  let setErrorPageMeta :: Note -> Note
setErrorPageMeta =
        Lens' Note Value
MN.noteMeta forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ NonEmpty Value -> Value
SData.mergeAesons (Text -> Value
withTemplateName Text
"/templates/error" forall a. a -> [a] -> NonEmpty a
:| [Text -> Value
withSiteTitle Text
"Emanote Error"])
   in case SiteRoute
sr of
        SR.SiteRoute_MissingR FilePath
urlPath -> do
          let hereRoute :: R @() 'Html
hereRoute = FilePath -> R @() 'Html
R.decodeHtmlRoute FilePath
urlPath
              note404 :: Note
note404 =
                forall {a} (ext :: FileType a). R @a ext -> Text -> Note
MN.missingNote R @() 'Html
hereRoute (forall a. ToText a => a -> Text
toText FilePath
urlPath)
                  forall a b. a -> (a -> b) -> b
& Note -> Note
setErrorPageMeta
                  forall a b. a -> (a -> b) -> b
& Lens' Note Title
MN.noteTitle forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Title
"! Missing link"
          forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Format -> a -> Asset a
Ema.AssetGenerated Format
Ema.Html forall a b. (a -> b) -> a -> b
$ Model -> Note -> LByteString
renderLmlHtml Model
m Note
note404
        SR.SiteRoute_AmbiguousR FilePath
urlPath NonEmpty LMLRoute
notes -> do
          let noteAmb :: Note
noteAmb =
                FilePath -> NonEmpty LMLRoute -> Note
MN.ambiguousNoteURL FilePath
urlPath NonEmpty LMLRoute
notes
                  forall a b. a -> (a -> b) -> b
& Note -> Note
setErrorPageMeta
                  forall a b. a -> (a -> b) -> b
& Lens' Note Title
MN.noteTitle forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Title
"! Ambiguous link"
          forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Format -> a -> Asset a
Ema.AssetGenerated Format
Ema.Html forall a b. (a -> b) -> a -> b
$ Model -> Note -> LByteString
renderLmlHtml Model
m Note
noteAmb
        SR.SiteRoute_ResourceRoute ResourceRoute
r -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Model -> ResourceRoute -> Asset LByteString
renderResourceRoute Model
m ResourceRoute
r
        SR.SiteRoute_VirtualRoute VirtualRoute
r -> forall (m :: Type -> Type).
(MonadIO m, MonadLoggerIO m) =>
Model -> VirtualRoute -> m (Asset LByteString)
renderVirtualRoute Model
m VirtualRoute
r

renderResourceRoute :: Model -> SR.ResourceRoute -> Ema.Asset LByteString
renderResourceRoute :: Model -> ResourceRoute -> Asset LByteString
renderResourceRoute Model
m = \case
  SR.ResourceRoute_LML LMLRoute
r -> do
    case forall (f :: Type -> Type). LMLRoute -> ModelT f -> Maybe Note
M.modelLookupNoteByRoute LMLRoute
r Model
m of
      Just Note
note ->
        forall a. Format -> a -> Asset a
Ema.AssetGenerated Format
Ema.Html forall a b. (a -> b) -> a -> b
$ Model -> Note -> LByteString
renderLmlHtml Model
m Note
note
      Maybe Note
Nothing ->
        -- This should never be reached because decodeRoute looks up the model.
        forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"Bad route: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show LMLRoute
r
  SR.ResourceRoute_StaticFile StaticFileRoute
_ FilePath
fpAbs ->
    forall a. FilePath -> Asset a
Ema.AssetStatic FilePath
fpAbs

renderVirtualRoute :: (MonadIO m, MonadLoggerIO m) => Model -> SR.VirtualRoute -> m (Ema.Asset LByteString)
renderVirtualRoute :: forall (m :: Type -> Type).
(MonadIO m, MonadLoggerIO m) =>
Model -> VirtualRoute -> m (Asset LByteString)
renderVirtualRoute Model
m = \case
  SR.VirtualRoute_TagIndex [TagNode]
mtag ->
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Format -> a -> Asset a
Ema.AssetGenerated Format
Ema.Html forall a b. (a -> b) -> a -> b
$ Model -> [TagNode] -> LByteString
TagIndex.renderTagIndex Model
m [TagNode]
mtag
  VirtualRoute
SR.VirtualRoute_Index ->
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Format -> a -> Asset a
Ema.AssetGenerated Format
Ema.Html forall a b. (a -> b) -> a -> b
$ Model -> LByteString
renderSRIndex Model
m
  VirtualRoute
SR.VirtualRoute_Export ->
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Format -> a -> Asset a
Ema.AssetGenerated Format
Ema.Other forall a b. (a -> b) -> a -> b
$ Model -> LByteString
renderGraphExport Model
m
  VirtualRoute
SR.VirtualRoute_StorkIndex ->
    forall a. Format -> a -> Asset a
Ema.AssetGenerated Format
Ema.Other forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: Type -> Type).
(MonadIO m, MonadLoggerIO m) =>
Model -> m LByteString
renderStorkIndex Model
m
  VirtualRoute
SR.VirtualRoute_TaskIndex ->
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Format -> a -> Asset a
Ema.AssetGenerated Format
Ema.Html forall a b. (a -> b) -> a -> b
$ Model -> LByteString
TaskIndex.renderTasks Model
m

renderSRIndex :: Model -> LByteString
renderSRIndex :: Model -> LByteString
renderSRIndex Model
model = do
  let (LMLRoute
r, Value
meta) = Model -> (LMLRoute, Value)
C.defaultRouteMeta Model
model
      tCtx :: TemplateRenderCtx @(Type -> Type) Identity
tCtx = Model
-> LMLRoute -> Value -> TemplateRenderCtx @(Type -> Type) Identity
C.mkTemplateRenderCtx Model
model LMLRoute
r Value
meta
  Model -> TemplateName -> Splices (Splice Identity) -> LByteString
C.renderModelTemplate Model
model TemplateName
"templates/special/index" forall a b. (a -> b) -> a -> b
$ do
    HasCallStack =>
((RenderCtx -> Splice Identity) -> Splice Identity)
-> Model -> Value -> Title -> Splices (Splice Identity)
C.commonSplices (forall a b. (a -> b) -> a -> b
$ RenderCtx
emptyRenderCtx) Model
model Value
meta Title
"Index"
    forall (n :: Type -> Type).
Monad n =>
TemplateRenderCtx @(Type -> Type) n
-> Maybe LMLRoute -> Model -> Splices (Splice Identity)
routeTreeSplice TemplateRenderCtx @(Type -> Type) Identity
tCtx forall a. Maybe a
Nothing Model
model

loaderHead :: LByteString
loaderHead :: LByteString
loaderHead =
  LByteString
"<em style='font-size: 400%; border-bottom: 1px solid; margin-bottom: 4em; '>Union mounting notebook layers; please wait ...</em>"

renderLmlHtml :: Model -> MN.Note -> LByteString
renderLmlHtml :: Model -> Note -> LByteString
renderLmlHtml Model
model Note
note = do
  let r :: LMLRoute
r = Note
note forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' Note LMLRoute
MN.noteRoute
      meta :: Value
meta = forall (f :: Type -> Type). Value -> LMLRoute -> ModelT f -> Value
Meta.getEffectiveRouteMetaWith (Note
note forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' Note Value
MN.noteMeta) LMLRoute
r Model
model
      ctx :: TemplateRenderCtx @(Type -> Type) Identity
ctx = Model
-> LMLRoute -> Value -> TemplateRenderCtx @(Type -> Type) Identity
C.mkTemplateRenderCtx Model
model LMLRoute
r Value
meta
      templateName :: TemplateName
templateName = forall b. ConvertUtf8 Text b => Value -> b
lookupTemplateName Value
meta
      -- Force a doctype into the generated HTML as a workaround for Heist
      -- discarding it. See: https://github.com/srid/emanote/issues/216
      withDoctype :: LByteString -> LByteString
withDoctype = (LByteString
"<!DOCTYPE html>\n" <>)
      withLoadingMessage :: LByteString -> LByteString
withLoadingMessage =
        if Model -> Bool
M.inLiveServer Model
model Bool -> Bool -> Bool
&& Model
model forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (encF :: Type -> Type). Lens' (ModelT encF) Status
M.modelStatus forall a. Eq a => a -> a -> Bool
== Status
M.Status_Loading
          then (LByteString
loaderHead <>)
          else forall a. a -> a
id
  LByteString -> LByteString
withDoctype forall b c a. (b -> c) -> (a -> b) -> a -> c
. LByteString -> LByteString
withLoadingMessage forall b c a. (b -> c) -> (a -> b) -> a -> c
. Model -> TemplateName -> Splices (Splice Identity) -> LByteString
C.renderModelTemplate Model
model TemplateName
templateName forall a b. (a -> b) -> a -> b
$ do
    HasCallStack =>
((RenderCtx -> Splice Identity) -> Splice Identity)
-> Model -> Value -> Title -> Splices (Splice Identity)
C.commonSplices (forall {k} (n :: k).
TemplateRenderCtx @k n
-> (RenderCtx -> Splice Identity) -> Splice Identity
C.withLinkInlineCtx TemplateRenderCtx @(Type -> Type) Identity
ctx) Model
model Value
meta (Note
note forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' Note Title
MN.noteTitle)
    let backlinksSplice :: [(LMLRoute, NonEmpty [Block])] -> Splice Identity
backlinksSplice ([(LMLRoute, NonEmpty [Block])]
bs :: [(R.LMLRoute, NonEmpty [B.Block])]) =
          forall a.
[a] -> Text -> (a -> Splices (Splice Identity)) -> Splice Identity
Splices.listSplice [(LMLRoute, NonEmpty [Block])]
bs Text
"backlink" forall a b. (a -> b) -> a -> b
$
            \(LMLRoute
source, NonEmpty [Block]
contexts) -> do
              let bnote :: Note
bnote = forall a. a -> Maybe a -> a
fromMaybe (forall a t. (HasCallStack, IsText t) => t -> a
error Text
"backlink note missing - impossible") forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type). LMLRoute -> ModelT f -> Maybe Note
M.modelLookupNoteByRoute LMLRoute
source Model
model
                  bmeta :: Value
bmeta = forall (f :: Type -> Type). Value -> LMLRoute -> ModelT f -> Value
Meta.getEffectiveRouteMetaWith (Note
bnote forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' Note Value
MN.noteMeta) LMLRoute
source Model
model
                  bctx :: TemplateRenderCtx @(Type -> Type) Identity
bctx = Model
-> LMLRoute -> Value -> TemplateRenderCtx @(Type -> Type) Identity
C.mkTemplateRenderCtx Model
model LMLRoute
source Value
bmeta
              -- TODO: reuse note splice
              Text
"backlink:note:title" forall k v. k -> v -> MapSyntax k v
## forall {k} (n :: k).
TemplateRenderCtx @k n -> Title -> Splice Identity
C.titleSplice TemplateRenderCtx @(Type -> Type) Identity
bctx (forall (f :: Type -> Type). LMLRoute -> ModelT f -> Title
M.modelLookupTitle LMLRoute
source Model
model)
              Text
"backlink:note: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
$ LMLRoute -> SiteRoute
SR.lmlSiteRoute LMLRoute
source)
              Text
"backlink:note:contexts" forall k v. k -> v -> MapSyntax k v
## forall a.
[a] -> Text -> (a -> Splices (Splice Identity)) -> Splice Identity
Splices.listSplice (forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList NonEmpty [Block]
contexts) Text
"context" forall a b. (a -> b) -> a -> b
$ \[Block]
backlinkCtx -> do
                let Pandoc
ctxDoc :: Pandoc = forall b. Walkable Inline b => b -> b
preparePandoc forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$ Attr -> [Block] -> Block
B.Div Attr
B.nullAttr [Block]
backlinkCtx
                Text
"context:body" forall k v. k -> v -> MapSyntax k v
## forall {k} (n :: k).
TemplateRenderCtx @k n
-> (RenderCtx -> Splice Identity) -> Splice Identity
C.withInlineCtx TemplateRenderCtx @(Type -> Type) Identity
bctx forall a b. (a -> b) -> a -> b
$ \RenderCtx
ctx' ->
                  RenderCtx -> Pandoc -> Splice Identity
Splices.pandocSplice RenderCtx
ctx' Pandoc
ctxDoc
    -- Sidebar navigation
    forall (n :: Type -> Type).
Monad n =>
TemplateRenderCtx @(Type -> Type) n
-> Maybe LMLRoute -> Model -> Splices (Splice Identity)
routeTreeSplice TemplateRenderCtx @(Type -> Type) Identity
ctx (forall a. a -> Maybe a
Just LMLRoute
r) Model
model
    Text
"ema:breadcrumbs" forall k v. k -> v -> MapSyntax k v
##
      forall {k} (n :: k).
TemplateRenderCtx @k n -> Model -> LMLRoute -> Splice Identity
C.routeBreadcrumbs TemplateRenderCtx @(Type -> Type) Identity
ctx Model
model LMLRoute
r
    -- Note stuff
    Text
"ema:note:title" forall k v. k -> v -> MapSyntax k v
##
      forall {k} (n :: k).
TemplateRenderCtx @k n -> Title -> Splice Identity
C.titleSplice TemplateRenderCtx @(Type -> Type) Identity
ctx (Note
note forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' Note Title
MN.noteTitle)
    let modelRoute :: ModelRoute
modelRoute = LMLRoute -> ModelRoute
R.ModelRoute_LML LMLRoute
r
    Text
"ema:note:source-path" 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 a. ToText a => a -> Text
toText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r.
(forall (lmlType :: LML).
 HasExt @SourceExt ('LMLType lmlType) =>
 R @SourceExt ('LMLType lmlType) -> r)
-> LMLRoute -> r
R.withLmlRoute forall a (ft :: FileType a). HasExt @a ft => R @a ft -> FilePath
R.encodeRoute forall a b. (a -> b) -> a -> b
$ LMLRoute
r)
    Text
"ema:note: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 b c a. (b -> c) -> (a -> b) -> a -> c
. LMLRoute -> SiteRoute
SR.lmlSiteRoute forall a b. (a -> b) -> a -> b
$ LMLRoute
r)
    Text
"ema:note:backlinks" forall k v. k -> v -> MapSyntax k v
##
      [(LMLRoute, NonEmpty [Block])] -> Splice Identity
backlinksSplice (ModelRoute -> Model -> [(LMLRoute, NonEmpty [Block])]
G.modelLookupBacklinks ModelRoute
modelRoute Model
model)
    let ([(LMLRoute, NonEmpty [Block])]
backlinksDaily, [(LMLRoute, NonEmpty [Block])]
backlinksNoDaily) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (LMLRoute -> Bool
Calendar.isDailyNote forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ ModelRoute -> Model -> [(LMLRoute, NonEmpty [Block])]
G.modelLookupBacklinks ModelRoute
modelRoute Model
model
    Text
"ema:note:backlinks:daily" forall k v. k -> v -> MapSyntax k v
##
      [(LMLRoute, NonEmpty [Block])] -> Splice Identity
backlinksSplice [(LMLRoute, NonEmpty [Block])]
backlinksDaily
    Text
"ema:note:backlinks:nodaily" forall k v. k -> v -> MapSyntax k v
##
      [(LMLRoute, NonEmpty [Block])] -> Splice Identity
backlinksSplice [(LMLRoute, NonEmpty [Block])]
backlinksNoDaily
    let folgeAnc :: Forest LMLRoute
folgeAnc = ModelRoute -> Model -> Forest LMLRoute
G.modelFolgezettelAncestorTree ModelRoute
modelRoute Model
model
    Text
"ema:note:uptree" forall k v. k -> v -> MapSyntax k v
##
      forall a sortKey.
Ord sortKey =>
(NonEmpty a -> sortKey)
-> [Tree a]
-> (NonEmpty a -> [Tree a] -> Splices (Splice Identity))
-> Splice Identity
Splices.treeSplice (forall a b. a -> b -> a
const ()) Forest LMLRoute
folgeAnc forall a b. (a -> b) -> a -> b
$
        \(forall (f :: Type -> Type) a. IsNonEmpty f a a "last" => f a -> a
last -> LMLRoute
nodeRoute) Forest LMLRoute
children -> do
          Text
"node:text" forall k v. k -> v -> MapSyntax k v
## forall {k} (n :: k).
TemplateRenderCtx @k n -> Title -> Splice Identity
C.titleSplice TemplateRenderCtx @(Type -> Type) Identity
ctx forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type). LMLRoute -> ModelT f -> Title
M.modelLookupTitle LMLRoute
nodeRoute Model
model
          Text
"node: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 forall a b. (a -> b) -> a -> b
$ HasCallStack => Model -> SiteRoute -> Text
SR.siteRouteUrl Model
model forall a b. (a -> b) -> a -> b
$ LMLRoute -> SiteRoute
SR.lmlSiteRoute LMLRoute
nodeRoute
          Text
"tree:open" forall k v. k -> v -> MapSyntax k v
## forall (m :: Type -> Type). Monad m => Bool -> Splice m
Heist.ifElseISplice (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ Forest LMLRoute
children)
    Text
"ema:note:uptree:nonempty" forall k v. k -> v -> MapSyntax k v
## forall (m :: Type -> Type). Monad m => Bool -> Splice m
Heist.ifElseISplice (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ Forest LMLRoute
folgeAnc)
    Text
"ema:note:pandoc" forall k v. k -> v -> MapSyntax k v
##
      forall {k} (n :: k).
TemplateRenderCtx @k n
-> (RenderCtx -> Splice Identity) -> Splice Identity
C.withBlockCtx TemplateRenderCtx @(Type -> Type) Identity
ctx forall a b. (a -> b) -> a -> b
$
        \RenderCtx
ctx' ->
          RenderCtx -> Pandoc -> Splice Identity
Splices.pandocSplice RenderCtx
ctx' (Note -> Pandoc
prepareNoteDoc Note
note)

-- | If there is no 'current route', all sub-trees are marked as active/open.
routeTreeSplice ::
  Monad n =>
  C.TemplateRenderCtx n ->
  Maybe R.LMLRoute ->
  Model ->
  H.Splices (HI.Splice Identity)
routeTreeSplice :: forall (n :: Type -> Type).
Monad n =>
TemplateRenderCtx @(Type -> Type) n
-> Maybe LMLRoute -> Model -> Splices (Splice Identity)
routeTreeSplice TemplateRenderCtx @(Type -> Type) n
tCtx Maybe LMLRoute
mr Model
model = do
  Text
"ema:route-tree" forall k v. k -> v -> MapSyntax k v
##
    ( let tree :: [Tree Slug]
tree = forall a. Eq a => a -> [Tree a] -> [Tree a]
PathTree.treeDeleteChild Slug
"index" forall a b. (a -> b) -> a -> b
$ Model
model forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (encF :: Type -> Type). Lens' (ModelT encF) [Tree Slug]
M.modelNav
          getOrder :: LMLRoute -> (Int, LMLRoute)
getOrder LMLRoute
tr =
            ( forall a (f :: Type -> Type).
FromJSON a =>
a -> NonEmpty Text -> LMLRoute -> ModelT f -> a
Meta.lookupRouteMeta @Int Int
0 (forall x. One x => OneItem x -> x
one Text
"order") LMLRoute
tr Model
model
            , LMLRoute
tr
            )
          getCollapsed :: LMLRoute -> Bool
getCollapsed LMLRoute
tr =
            forall a (f :: Type -> Type).
FromJSON a =>
a -> NonEmpty Text -> LMLRoute -> ModelT f -> a
Meta.lookupRouteMeta @Bool Bool
True (Text
"template" forall a. a -> [a] -> NonEmpty a
:| [Text
"sidebar", Text
"collapsed"]) LMLRoute
tr Model
model
          mkLmlRoute :: NonEmpty Slug -> LMLRoute
mkLmlRoute =
            forall (lmlType :: LML) (f :: Type -> Type).
ModelT f -> R @SourceExt ('LMLType lmlType) -> LMLRoute
M.resolveLmlRoute Model
model forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} (ext :: FileType a). NonEmpty Slug -> R @a ext
R.mkRouteFromSlugs
          lmlRouteSlugs :: LMLRoute -> NonEmpty Slug
lmlRouteSlugs = forall r.
(forall (lmlType :: LML).
 HasExt @SourceExt ('LMLType lmlType) =>
 R @SourceExt ('LMLType lmlType) -> r)
-> LMLRoute -> r
R.withLmlRoute forall a (ext :: FileType a). R @a ext -> NonEmpty Slug
R.unRoute
       in forall a sortKey.
Ord sortKey =>
(NonEmpty a -> sortKey)
-> [Tree a]
-> (NonEmpty a -> [Tree a] -> Splices (Splice Identity))
-> Splice Identity
Splices.treeSplice (LMLRoute -> (Int, LMLRoute)
getOrder forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Slug -> LMLRoute
mkLmlRoute) [Tree Slug]
tree forall a b. (a -> b) -> a -> b
$ \(NonEmpty Slug -> LMLRoute
mkLmlRoute -> LMLRoute
nodeRoute) [Tree Slug]
children -> do
            Text
"node:text" forall k v. k -> v -> MapSyntax k v
## forall {k} (n :: k).
TemplateRenderCtx @k n -> Title -> Splice Identity
C.titleSplice TemplateRenderCtx @(Type -> Type) n
tCtx forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type). LMLRoute -> ModelT f -> Title
M.modelLookupTitle LMLRoute
nodeRoute Model
model
            Text
"node: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 forall a b. (a -> b) -> a -> b
$ HasCallStack => Model -> SiteRoute -> Text
SR.siteRouteUrl Model
model forall a b. (a -> b) -> a -> b
$ LMLRoute -> SiteRoute
SR.lmlSiteRoute LMLRoute
nodeRoute
            let isActiveNode :: Bool
isActiveNode = forall a. a -> Maybe a
Just LMLRoute
nodeRoute forall a. Eq a => a -> a -> Bool
== Maybe LMLRoute
mr
                isActiveTree :: Bool
isActiveTree =
                  -- Active tree checking is applicable only when there is an
                  -- active route (i.e., mr is a Just)
                  forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True) Maybe LMLRoute
mr forall a b. (a -> b) -> a -> b
$ \LMLRoute
r ->
                    forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList (LMLRoute -> NonEmpty Slug
lmlRouteSlugs LMLRoute
nodeRoute) forall a. Eq a => [a] -> NonEmpty a -> Bool
`NE.isPrefixOf` LMLRoute -> NonEmpty Slug
lmlRouteSlugs LMLRoute
r
                openTree :: Bool
openTree =
                  Bool
isActiveTree -- Active tree is always open
                    Bool -> Bool -> Bool
|| Bool -> Bool
not (LMLRoute -> Bool
getCollapsed LMLRoute
nodeRoute)
            Text
"node:active" forall k v. k -> v -> MapSyntax k v
## forall (m :: Type -> Type). Monad m => Bool -> Splice m
Heist.ifElseISplice Bool
isActiveNode
            Text
"node:terminal" forall k v. k -> v -> MapSyntax k v
## forall (m :: Type -> Type). Monad m => Bool -> Splice m
Heist.ifElseISplice (forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Tree Slug]
children)
            Text
"tree:childrenCount" 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 a b. (a -> b) -> a -> b
$ forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Tree Slug]
children)
            Text
"tree:open" forall k v. k -> v -> MapSyntax k v
## forall (m :: Type -> Type). Monad m => Bool -> Splice m
Heist.ifElseISplice Bool
openTree
    )

lookupTemplateName :: ConvertUtf8 Text b => Aeson.Value -> b
lookupTemplateName :: forall b. ConvertUtf8 Text b => Value -> b
lookupTemplateName Value
meta =
  forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => a -> NonEmpty Text -> Value -> a
SData.lookupAeson @Text Text
defaultTemplate (Text
"template" forall a. a -> [a] -> NonEmpty a
:| [Text
"name"]) Value
meta
  where
    defaultTemplate :: Text
defaultTemplate = Text
"templates/layouts/book"

withTemplateName :: Text -> Aeson.Value
withTemplateName :: Text -> Value
withTemplateName =
  [Text] -> Text -> Value
SData.oneAesonText (forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ Text
"template" forall a. a -> [a] -> NonEmpty a
:| [Text
"name"])

withSiteTitle :: Text -> Aeson.Value
withSiteTitle :: Text -> Value
withSiteTitle =
  [Text] -> Text -> Value
SData.oneAesonText (forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ Text
"page" forall a. a -> [a] -> NonEmpty a
:| [Text
"siteTitle"])