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'
  Model -> SiteRoute -> m (Asset LByteString)
forall (m :: Type -> Type).
(MonadIO m, MonadLoggerIO m) =>
Model -> SiteRoute -> m (Asset LByteString)
render Model
model SiteRoute
r m (Asset LByteString)
-> (Asset LByteString -> Asset LByteString)
-> m (Asset LByteString)
forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> (LByteString -> LByteString)
-> Asset LByteString -> Asset LByteString
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.
          Text -> LByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8
            (Text -> LByteString)
-> (LByteString -> Text) -> LByteString -> LByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
"src: url(_emanote-static/" (Text
"src: url(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_emanote-static/")
            (Text -> Text) -> (LByteString -> Text) -> LByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8
            (LByteString -> LByteString) -> LByteString -> LByteString
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 = FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Prism' FilePath SiteRoute -> SiteRoute -> FilePath
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
          Bool -> Maybe ()
forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
prefix
          Text -> Maybe Text
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 Lens' Note Value -> Value -> Note -> Note
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" Value -> [Value] -> NonEmpty Value
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 =
                R @() 'Html -> Text -> Note
forall {a} (ext :: FileType a). R @a ext -> Text -> Note
MN.missingNote R @() 'Html
hereRoute (FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
urlPath)
                  Note -> (Note -> Note) -> Note
forall a b. a -> (a -> b) -> b
& Note -> Note
setErrorPageMeta
                  Note -> (Note -> Note) -> Note
forall a b. a -> (a -> b) -> b
& Lens' Note Title
MN.noteTitle Lens' Note Title -> Title -> Note -> Note
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"
          Asset LByteString -> m (Asset LByteString)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Asset LByteString -> m (Asset LByteString))
-> Asset LByteString -> m (Asset LByteString)
forall a b. (a -> b) -> a -> b
$ Format -> LByteString -> Asset LByteString
forall a. Format -> a -> Asset a
Ema.AssetGenerated Format
Ema.Html (LByteString -> Asset LByteString)
-> LByteString -> Asset LByteString
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
                  Note -> (Note -> Note) -> Note
forall a b. a -> (a -> b) -> b
& Note -> Note
setErrorPageMeta
                  Note -> (Note -> Note) -> Note
forall a b. a -> (a -> b) -> b
& Lens' Note Title
MN.noteTitle Lens' Note Title -> Title -> Note -> Note
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"
          Asset LByteString -> m (Asset LByteString)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Asset LByteString -> m (Asset LByteString))
-> Asset LByteString -> m (Asset LByteString)
forall a b. (a -> b) -> a -> b
$ Format -> LByteString -> Asset LByteString
forall a. Format -> a -> Asset a
Ema.AssetGenerated Format
Ema.Html (LByteString -> Asset LByteString)
-> LByteString -> Asset LByteString
forall a b. (a -> b) -> a -> b
$ Model -> Note -> LByteString
renderLmlHtml Model
m Note
noteAmb
        SR.SiteRoute_ResourceRoute ResourceRoute
r -> Asset LByteString -> m (Asset LByteString)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Asset LByteString -> m (Asset LByteString))
-> Asset LByteString -> m (Asset LByteString)
forall a b. (a -> b) -> a -> b
$ Model -> ResourceRoute -> Asset LByteString
renderResourceRoute Model
m ResourceRoute
r
        SR.SiteRoute_VirtualRoute VirtualRoute
r -> Model -> VirtualRoute -> m (Asset LByteString)
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 LMLRoute -> Model -> Maybe Note
forall (f :: Type -> Type). LMLRoute -> ModelT f -> Maybe Note
M.modelLookupNoteByRoute LMLRoute
r Model
m of
      Just Note
note ->
        Format -> LByteString -> Asset LByteString
forall a. Format -> a -> Asset a
Ema.AssetGenerated Format
Ema.Html (LByteString -> Asset LByteString)
-> LByteString -> Asset LByteString
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.
        Text -> Asset LByteString
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> Asset LByteString) -> Text -> Asset LByteString
forall a b. (a -> b) -> a -> b
$ Text
"Bad route: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LMLRoute -> Text
forall b a. (Show a, IsString b) => a -> b
show LMLRoute
r
  SR.ResourceRoute_StaticFile StaticFileRoute
_ FilePath
fpAbs ->
    FilePath -> Asset LByteString
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 ->
    Asset LByteString -> m (Asset LByteString)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Asset LByteString -> m (Asset LByteString))
-> Asset LByteString -> m (Asset LByteString)
forall a b. (a -> b) -> a -> b
$ Format -> LByteString -> Asset LByteString
forall a. Format -> a -> Asset a
Ema.AssetGenerated Format
Ema.Html (LByteString -> Asset LByteString)
-> LByteString -> Asset LByteString
forall a b. (a -> b) -> a -> b
$ Model -> [TagNode] -> LByteString
TagIndex.renderTagIndex Model
m [TagNode]
mtag
  VirtualRoute
SR.VirtualRoute_Index ->
    Asset LByteString -> m (Asset LByteString)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Asset LByteString -> m (Asset LByteString))
-> Asset LByteString -> m (Asset LByteString)
forall a b. (a -> b) -> a -> b
$ Format -> LByteString -> Asset LByteString
forall a. Format -> a -> Asset a
Ema.AssetGenerated Format
Ema.Html (LByteString -> Asset LByteString)
-> LByteString -> Asset LByteString
forall a b. (a -> b) -> a -> b
$ Model -> LByteString
renderSRIndex Model
m
  VirtualRoute
SR.VirtualRoute_Export ->
    Asset LByteString -> m (Asset LByteString)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Asset LByteString -> m (Asset LByteString))
-> Asset LByteString -> m (Asset LByteString)
forall a b. (a -> b) -> a -> b
$ Format -> LByteString -> Asset LByteString
forall a. Format -> a -> Asset a
Ema.AssetGenerated Format
Ema.Other (LByteString -> Asset LByteString)
-> LByteString -> Asset LByteString
forall a b. (a -> b) -> a -> b
$ Model -> LByteString
renderGraphExport Model
m
  VirtualRoute
SR.VirtualRoute_StorkIndex ->
    Format -> LByteString -> Asset LByteString
forall a. Format -> a -> Asset a
Ema.AssetGenerated Format
Ema.Other (LByteString -> Asset LByteString)
-> m LByteString -> m (Asset LByteString)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Model -> m LByteString
forall (m :: Type -> Type).
(MonadIO m, MonadLoggerIO m) =>
Model -> m LByteString
renderStorkIndex Model
m
  VirtualRoute
SR.VirtualRoute_TaskIndex ->
    Asset LByteString -> m (Asset LByteString)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Asset LByteString -> m (Asset LByteString))
-> Asset LByteString -> m (Asset LByteString)
forall a b. (a -> b) -> a -> b
$ Format -> LByteString -> Asset LByteString
forall a. Format -> a -> Asset a
Ema.AssetGenerated Format
Ema.Html (LByteString -> Asset LByteString)
-> LByteString -> Asset LByteString
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" (Splices (Splice Identity) -> LByteString)
-> Splices (Splice Identity) -> LByteString
forall a b. (a -> b) -> a -> b
$ do
    HasCallStack =>
((RenderCtx -> Splice Identity) -> Splice Identity)
-> Model -> Value -> Title -> Splices (Splice Identity)
((RenderCtx -> Splice Identity) -> Splice Identity)
-> Model -> Value -> Title -> Splices (Splice Identity)
C.commonSplices ((RenderCtx -> Splice Identity) -> RenderCtx -> Splice Identity
forall a b. (a -> b) -> a -> b
$ RenderCtx
emptyRenderCtx) Model
model Value
meta Title
"Index"
    TemplateRenderCtx @(Type -> Type) Identity
-> Maybe LMLRoute -> Model -> Splices (Splice Identity)
forall (n :: Type -> Type).
Monad n =>
TemplateRenderCtx @(Type -> Type) n
-> Maybe LMLRoute -> Model -> Splices (Splice Identity)
routeTreeSplice TemplateRenderCtx @(Type -> Type) Identity
tCtx Maybe LMLRoute
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 Note -> Optic' A_Lens NoIx Note LMLRoute -> LMLRoute
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Note LMLRoute
MN.noteRoute
      meta :: Value
meta = Value -> LMLRoute -> Model -> Value
forall (f :: Type -> Type). Value -> LMLRoute -> ModelT f -> Value
Meta.getEffectiveRouteMetaWith (Note
note Note -> Lens' Note Value -> Value
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 = Value -> 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" LByteString -> LByteString -> LByteString
forall a. Semigroup a => a -> a -> a
<>)
      withLoadingMessage :: LByteString -> LByteString
withLoadingMessage =
        if Model -> Bool
M.inLiveServer Model
model Bool -> Bool -> Bool
&& Model
model Model -> Optic' A_Lens NoIx Model Status -> Status
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Model Status
forall (encF :: Type -> Type). Lens' (ModelT encF) Status
M.modelStatus Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
M.Status_Loading
          then (LByteString
loaderHead LByteString -> LByteString -> LByteString
forall a. Semigroup a => a -> a -> a
<>)
          else LByteString -> LByteString
forall a. a -> a
id
  LByteString -> LByteString
withDoctype (LByteString -> LByteString)
-> (Splices (Splice Identity) -> LByteString)
-> Splices (Splice Identity)
-> LByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LByteString -> LByteString
withLoadingMessage (LByteString -> LByteString)
-> (Splices (Splice Identity) -> LByteString)
-> Splices (Splice Identity)
-> LByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Model -> TemplateName -> Splices (Splice Identity) -> LByteString
C.renderModelTemplate Model
model TemplateName
templateName (Splices (Splice Identity) -> LByteString)
-> Splices (Splice Identity) -> LByteString
forall a b. (a -> b) -> a -> b
$ do
    HasCallStack =>
((RenderCtx -> Splice Identity) -> Splice Identity)
-> Model -> Value -> Title -> Splices (Splice Identity)
((RenderCtx -> Splice Identity) -> Splice Identity)
-> Model -> Value -> Title -> Splices (Splice Identity)
C.commonSplices (TemplateRenderCtx @(Type -> Type) Identity
-> (RenderCtx -> Splice Identity) -> Splice Identity
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 Note -> Lens' Note Title -> Title
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])]) =
          [(LMLRoute, NonEmpty [Block])]
-> Text
-> ((LMLRoute, NonEmpty [Block]) -> Splices (Splice Identity))
-> Splice Identity
forall a.
[a] -> Text -> (a -> Splices (Splice Identity)) -> Splice Identity
Splices.listSplice [(LMLRoute, NonEmpty [Block])]
bs Text
"backlink" (((LMLRoute, NonEmpty [Block]) -> Splices (Splice Identity))
 -> Splice Identity)
-> ((LMLRoute, NonEmpty [Block]) -> Splices (Splice Identity))
-> Splice Identity
forall a b. (a -> b) -> a -> b
$
            \(LMLRoute
source, NonEmpty [Block]
contexts) -> do
              let bnote :: Note
bnote = Note -> Maybe Note -> Note
forall a. a -> Maybe a -> a
fromMaybe (Text -> Note
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"backlink note missing - impossible") (Maybe Note -> Note) -> Maybe Note -> Note
forall a b. (a -> b) -> a -> b
$ LMLRoute -> Model -> Maybe Note
forall (f :: Type -> Type). LMLRoute -> ModelT f -> Maybe Note
M.modelLookupNoteByRoute LMLRoute
source Model
model
                  bmeta :: Value
bmeta = Value -> LMLRoute -> Model -> Value
forall (f :: Type -> Type). Value -> LMLRoute -> ModelT f -> Value
Meta.getEffectiveRouteMetaWith (Note
bnote Note -> Lens' Note Value -> Value
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" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
## TemplateRenderCtx @(Type -> Type) Identity
-> Title -> Splice Identity
forall {k} (n :: k).
TemplateRenderCtx @k n -> Title -> Splice Identity
C.titleSplice TemplateRenderCtx @(Type -> Type) Identity
bctx (LMLRoute -> Model -> Title
forall (f :: Type -> Type). LMLRoute -> ModelT f -> Title
M.modelLookupTitle LMLRoute
source Model
model)
              Text
"backlink:note:url" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
## Text -> Splice Identity
forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m Template
HI.textSplice (HasCallStack => Model -> SiteRoute -> Text
Model -> SiteRoute -> Text
SR.siteRouteUrl Model
model (SiteRoute -> Text) -> SiteRoute -> Text
forall a b. (a -> b) -> a -> b
$ LMLRoute -> SiteRoute
SR.lmlSiteRoute LMLRoute
source)
              Text
"backlink:note:contexts" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
## [[Block]]
-> Text
-> ([Block] -> Splices (Splice Identity))
-> Splice Identity
forall a.
[a] -> Text -> (a -> Splices (Splice Identity)) -> Splice Identity
Splices.listSplice (NonEmpty [Block] -> [[Block]]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList NonEmpty [Block]
contexts) Text
"context" (([Block] -> Splices (Splice Identity)) -> Splice Identity)
-> ([Block] -> Splices (Splice Identity)) -> Splice Identity
forall a b. (a -> b) -> a -> b
$ \[Block]
backlinkCtx -> do
                let Pandoc
ctxDoc :: Pandoc = Pandoc -> Pandoc
forall b. Walkable Inline b => b -> b
preparePandoc (Pandoc -> Pandoc) -> Pandoc -> Pandoc
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc Meta
forall a. Monoid a => a
mempty ([Block] -> Pandoc) -> [Block] -> Pandoc
forall a b. (a -> b) -> a -> b
$ OneItem [Block] -> [Block]
forall x. One x => OneItem x -> x
one (OneItem [Block] -> [Block]) -> OneItem [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ Attr -> [Block] -> Block
B.Div Attr
B.nullAttr [Block]
backlinkCtx
                Text
"context:body" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
## TemplateRenderCtx @(Type -> Type) Identity
-> (RenderCtx -> Splice Identity) -> Splice Identity
forall {k} (n :: k).
TemplateRenderCtx @k n
-> (RenderCtx -> Splice Identity) -> Splice Identity
C.withInlineCtx TemplateRenderCtx @(Type -> Type) Identity
bctx ((RenderCtx -> Splice Identity) -> Splice Identity)
-> (RenderCtx -> Splice Identity) -> Splice Identity
forall a b. (a -> b) -> a -> b
$ \RenderCtx
ctx' ->
                  RenderCtx -> Pandoc -> Splice Identity
Splices.pandocSplice RenderCtx
ctx' Pandoc
ctxDoc
    -- Sidebar navigation
    TemplateRenderCtx @(Type -> Type) Identity
-> Maybe LMLRoute -> Model -> Splices (Splice Identity)
forall (n :: Type -> Type).
Monad n =>
TemplateRenderCtx @(Type -> Type) n
-> Maybe LMLRoute -> Model -> Splices (Splice Identity)
routeTreeSplice TemplateRenderCtx @(Type -> Type) Identity
ctx (LMLRoute -> Maybe LMLRoute
forall a. a -> Maybe a
Just LMLRoute
r) Model
model
    Text
"ema:breadcrumbs" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
##
      TemplateRenderCtx @(Type -> Type) Identity
-> Model -> LMLRoute -> Splice Identity
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" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
##
      TemplateRenderCtx @(Type -> Type) Identity
-> Title -> Splice Identity
forall {k} (n :: k).
TemplateRenderCtx @k n -> Title -> Splice Identity
C.titleSplice TemplateRenderCtx @(Type -> Type) Identity
ctx (Note
note Note -> Lens' Note Title -> Title
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" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
##
      Text -> Splice Identity
forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m Template
HI.textSplice (FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Text) -> (LMLRoute -> FilePath) -> LMLRoute -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (lmlType :: LML).
 HasExt @SourceExt ('LMLType lmlType) =>
 R @SourceExt ('LMLType lmlType) -> FilePath)
-> LMLRoute -> FilePath
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
forall (lmlType :: LML).
HasExt @SourceExt ('LMLType lmlType) =>
R @SourceExt ('LMLType lmlType) -> FilePath
R.encodeRoute (LMLRoute -> Text) -> LMLRoute -> Text
forall a b. (a -> b) -> a -> b
$ LMLRoute
r)
    Text
"ema:note:url" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
##
      Text -> Splice Identity
forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m Template
HI.textSplice (HasCallStack => Model -> SiteRoute -> Text
Model -> SiteRoute -> Text
SR.siteRouteUrl Model
model (SiteRoute -> Text) -> (LMLRoute -> SiteRoute) -> LMLRoute -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LMLRoute -> SiteRoute
SR.lmlSiteRoute (LMLRoute -> Text) -> LMLRoute -> Text
forall a b. (a -> b) -> a -> b
$ LMLRoute
r)
    Text
"ema:note:backlinks" Text -> Splice Identity -> Splices (Splice Identity)
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) = ((LMLRoute, NonEmpty [Block]) -> Bool)
-> [(LMLRoute, NonEmpty [Block])]
-> ([(LMLRoute, NonEmpty [Block])], [(LMLRoute, NonEmpty [Block])])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (LMLRoute -> Bool
Calendar.isDailyNote (LMLRoute -> Bool)
-> ((LMLRoute, NonEmpty [Block]) -> LMLRoute)
-> (LMLRoute, NonEmpty [Block])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LMLRoute, NonEmpty [Block]) -> LMLRoute
forall a b. (a, b) -> a
fst) ([(LMLRoute, NonEmpty [Block])]
 -> ([(LMLRoute, NonEmpty [Block])],
     [(LMLRoute, NonEmpty [Block])]))
-> [(LMLRoute, NonEmpty [Block])]
-> ([(LMLRoute, NonEmpty [Block])], [(LMLRoute, NonEmpty [Block])])
forall a b. (a -> b) -> a -> b
$ ModelRoute -> Model -> [(LMLRoute, NonEmpty [Block])]
G.modelLookupBacklinks ModelRoute
modelRoute Model
model
    Text
"ema:note:backlinks:daily" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
##
      [(LMLRoute, NonEmpty [Block])] -> Splice Identity
backlinksSplice [(LMLRoute, NonEmpty [Block])]
backlinksDaily
    Text
"ema:note:backlinks:nodaily" Text -> Splice Identity -> Splices (Splice Identity)
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" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
##
      (NonEmpty LMLRoute -> ())
-> Forest LMLRoute
-> (NonEmpty LMLRoute
    -> Forest LMLRoute -> Splices (Splice Identity))
-> Splice Identity
forall a sortKey.
Ord sortKey =>
(NonEmpty a -> sortKey)
-> [Tree a]
-> (NonEmpty a -> [Tree a] -> Splices (Splice Identity))
-> Splice Identity
Splices.treeSplice (() -> NonEmpty LMLRoute -> ()
forall a b. a -> b -> a
const ()) Forest LMLRoute
folgeAnc ((NonEmpty LMLRoute
  -> Forest LMLRoute -> Splices (Splice Identity))
 -> Splice Identity)
-> (NonEmpty LMLRoute
    -> Forest LMLRoute -> Splices (Splice Identity))
-> Splice Identity
forall a b. (a -> b) -> a -> b
$
        \(NonEmpty LMLRoute -> LMLRoute
forall (f :: Type -> Type) a. IsNonEmpty f a a "last" => f a -> a
last -> LMLRoute
nodeRoute) Forest LMLRoute
children -> do
          Text
"node:text" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
## TemplateRenderCtx @(Type -> Type) Identity
-> Title -> Splice Identity
forall {k} (n :: k).
TemplateRenderCtx @k n -> Title -> Splice Identity
C.titleSplice TemplateRenderCtx @(Type -> Type) Identity
ctx (Title -> Splice Identity) -> Title -> Splice Identity
forall a b. (a -> b) -> a -> b
$ LMLRoute -> Model -> Title
forall (f :: Type -> Type). LMLRoute -> ModelT f -> Title
M.modelLookupTitle LMLRoute
nodeRoute Model
model
          Text
"node:url" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
## Text -> Splice Identity
forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m Template
HI.textSplice (Text -> Splice Identity) -> Text -> Splice Identity
forall a b. (a -> b) -> a -> b
$ HasCallStack => Model -> SiteRoute -> Text
Model -> SiteRoute -> Text
SR.siteRouteUrl Model
model (SiteRoute -> Text) -> SiteRoute -> Text
forall a b. (a -> b) -> a -> b
$ LMLRoute -> SiteRoute
SR.lmlSiteRoute LMLRoute
nodeRoute
          Text
"tree:open" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
## Bool -> Splice Identity
forall (m :: Type -> Type). Monad m => Bool -> Splice m
Heist.ifElseISplice (Bool -> Bool
not (Bool -> Bool)
-> (Forest LMLRoute -> Bool) -> Forest LMLRoute -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Forest LMLRoute -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null (Forest LMLRoute -> Bool) -> Forest LMLRoute -> Bool
forall a b. (a -> b) -> a -> b
$ Forest LMLRoute
children)
    Text
"ema:note:uptree:nonempty" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
## Bool -> Splice Identity
forall (m :: Type -> Type). Monad m => Bool -> Splice m
Heist.ifElseISplice (Bool -> Bool
not (Bool -> Bool)
-> (Forest LMLRoute -> Bool) -> Forest LMLRoute -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Forest LMLRoute -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null (Forest LMLRoute -> Bool) -> Forest LMLRoute -> Bool
forall a b. (a -> b) -> a -> b
$ Forest LMLRoute
folgeAnc)
    Text
"ema:note:pandoc" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
##
      TemplateRenderCtx @(Type -> Type) Identity
-> (RenderCtx -> Splice Identity) -> Splice Identity
forall {k} (n :: k).
TemplateRenderCtx @k n
-> (RenderCtx -> Splice Identity) -> Splice Identity
C.withBlockCtx TemplateRenderCtx @(Type -> Type) Identity
ctx ((RenderCtx -> Splice Identity) -> Splice Identity)
-> (RenderCtx -> Splice Identity) -> Splice Identity
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" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
##
    ( let tree :: [Tree Slug]
tree = Slug -> [Tree Slug] -> [Tree Slug]
forall a. Eq a => a -> [Tree a] -> [Tree a]
PathTree.treeDeleteChild Slug
"index" ([Tree Slug] -> [Tree Slug]) -> [Tree Slug] -> [Tree Slug]
forall a b. (a -> b) -> a -> b
$ Model
model Model -> Optic' A_Lens NoIx Model [Tree Slug] -> [Tree Slug]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Model [Tree Slug]
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 (OneItem (NonEmpty Text) -> NonEmpty Text
forall x. One x => OneItem x -> x
one OneItem (NonEmpty 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" Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text
"sidebar", Text
"collapsed"]) LMLRoute
tr Model
model
          mkLmlRoute :: NonEmpty Slug -> LMLRoute
mkLmlRoute =
            Model -> R @SourceExt ('LMLType (Any @LML)) -> LMLRoute
forall (lmlType :: LML) (f :: Type -> Type).
ModelT f -> R @SourceExt ('LMLType lmlType) -> LMLRoute
M.resolveLmlRoute Model
model (R @SourceExt ('LMLType (Any @LML)) -> LMLRoute)
-> (NonEmpty Slug -> R @SourceExt ('LMLType (Any @LML)))
-> NonEmpty Slug
-> LMLRoute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Slug -> R @SourceExt ('LMLType (Any @LML))
forall {a} (ext :: FileType a). NonEmpty Slug -> R @a ext
R.mkRouteFromSlugs
          lmlRouteSlugs :: LMLRoute -> NonEmpty Slug
lmlRouteSlugs = (forall (lmlType :: LML).
 HasExt @SourceExt ('LMLType lmlType) =>
 R @SourceExt ('LMLType lmlType) -> NonEmpty Slug)
-> LMLRoute -> NonEmpty Slug
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
forall (lmlType :: LML).
HasExt @SourceExt ('LMLType lmlType) =>
R @SourceExt ('LMLType lmlType) -> NonEmpty Slug
R.unRoute
       in (NonEmpty Slug -> (Int, LMLRoute))
-> [Tree Slug]
-> (NonEmpty Slug -> [Tree Slug] -> Splices (Splice Identity))
-> Splice Identity
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 (LMLRoute -> (Int, LMLRoute))
-> (NonEmpty Slug -> LMLRoute) -> NonEmpty Slug -> (Int, LMLRoute)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Slug -> LMLRoute
mkLmlRoute) [Tree Slug]
tree ((NonEmpty Slug -> [Tree Slug] -> Splices (Splice Identity))
 -> Splice Identity)
-> (NonEmpty Slug -> [Tree Slug] -> Splices (Splice Identity))
-> Splice Identity
forall a b. (a -> b) -> a -> b
$ \(NonEmpty Slug -> LMLRoute
mkLmlRoute -> LMLRoute
nodeRoute) [Tree Slug]
children -> do
            Text
"node:text" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
## TemplateRenderCtx @(Type -> Type) n -> Title -> Splice Identity
forall {k} (n :: k).
TemplateRenderCtx @k n -> Title -> Splice Identity
C.titleSplice TemplateRenderCtx @(Type -> Type) n
tCtx (Title -> Splice Identity) -> Title -> Splice Identity
forall a b. (a -> b) -> a -> b
$ LMLRoute -> Model -> Title
forall (f :: Type -> Type). LMLRoute -> ModelT f -> Title
M.modelLookupTitle LMLRoute
nodeRoute Model
model
            Text
"node:url" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
## Text -> Splice Identity
forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m Template
HI.textSplice (Text -> Splice Identity) -> Text -> Splice Identity
forall a b. (a -> b) -> a -> b
$ HasCallStack => Model -> SiteRoute -> Text
Model -> SiteRoute -> Text
SR.siteRouteUrl Model
model (SiteRoute -> Text) -> SiteRoute -> Text
forall a b. (a -> b) -> a -> b
$ LMLRoute -> SiteRoute
SR.lmlSiteRoute LMLRoute
nodeRoute
            let isActiveNode :: Bool
isActiveNode = LMLRoute -> Maybe LMLRoute
forall a. a -> Maybe a
Just LMLRoute
nodeRoute Maybe LMLRoute -> Maybe LMLRoute -> Bool
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)
                  ((LMLRoute -> Bool) -> Maybe LMLRoute -> Bool)
-> Maybe LMLRoute -> (LMLRoute -> Bool) -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Bool -> (LMLRoute -> Bool) -> Maybe LMLRoute -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True) Maybe LMLRoute
mr ((LMLRoute -> Bool) -> Bool) -> (LMLRoute -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ \LMLRoute
r ->
                    NonEmpty Slug -> [Slug]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList (LMLRoute -> NonEmpty Slug
lmlRouteSlugs LMLRoute
nodeRoute) [Slug] -> NonEmpty Slug -> Bool
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" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
## Bool -> Splice Identity
forall (m :: Type -> Type). Monad m => Bool -> Splice m
Heist.ifElseISplice Bool
isActiveNode
            Text
"node:terminal" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
## Bool -> Splice Identity
forall (m :: Type -> Type). Monad m => Bool -> Splice m
Heist.ifElseISplice ([Tree Slug] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Tree Slug]
children)
            Text
"tree:childrenCount" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
## Text -> Splice Identity
forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m Template
HI.textSplice (Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ [Tree Slug] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Tree Slug]
children)
            Text
"tree:open" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
## Bool -> Splice Identity
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 =
  Text -> b
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> b) -> Text -> b
forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => a -> NonEmpty Text -> Value -> a
SData.lookupAeson @Text Text
defaultTemplate (Text
"template" Text -> [Text] -> NonEmpty Text
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 (NonEmpty Text -> [Text]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList (NonEmpty Text -> [Text]) -> NonEmpty Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
"template" Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text
"name"])

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