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
fixStaticUrl :: LByteString -> LByteString
fixStaticUrl :: LByteString -> LByteString
fixStaticUrl LByteString
s =
case Maybe Text
findPrefix of
Maybe Text
Nothing -> LByteString
s
Just Text
prefix ->
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
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 ->
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
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
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
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
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)
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 =
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
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"])