{-# LANGUAGE RecordWildCards #-}

module Emanote.View.Common
  ( commonSplices,
    renderModelTemplate,
    routeBreadcrumbs,
    generatedCssFile,

    -- * Render context
    TemplateRenderCtx (..),
    mkTemplateRenderCtx,
    defaultRouteMeta,
  )
where

import Data.Aeson.Types qualified as Aeson
import Data.Map.Syntax ((##))
import Data.Text qualified as T
import Data.Version (showVersion)
import Ema qualified
import Emanote.Model.Meta qualified as Meta
import Emanote.Model.SData qualified as SData
import Emanote.Model.Title qualified as Tit
import Emanote.Model.Type (Model)
import Emanote.Model.Type qualified as M
import Emanote.Pandoc.BuiltinFilters (preparePandoc)
import Emanote.Pandoc.Renderer (EmanotePandocRenderers (..), PandocRenderers (..))
import Emanote.Pandoc.Renderer qualified as Renderer
import Emanote.Route (LMLRoute)
import Emanote.Route qualified as R
import Emanote.Route.SiteRoute.Class qualified as SR
import Emanote.View.LiveServerFiles qualified as LiveServerFiles
import Heist qualified as H
import Heist.Extra.Splices.List qualified as Splices
import Heist.Extra.Splices.Pandoc.Ctx (RenderCtx)
import Heist.Extra.TemplateState qualified as Tmpl
import Heist.Interpreted qualified as HI
import Heist.Splices.Apply qualified as HA
import Heist.Splices.Bind qualified as HB
import Heist.Splices.Json qualified as HJ
import Optics.Operators ((^.))
import Paths_emanote qualified
import Relude
import System.FilePath ((</>))
import Text.Blaze.Html ((!))
import Text.Blaze.Html5 qualified as H
import Text.Blaze.Html5.Attributes qualified as A
import Text.Blaze.Renderer.XmlHtml qualified as RX

data TemplateRenderCtx n = TemplateRenderCtx
  { forall {k} (n :: k).
TemplateRenderCtx @k n
-> (RenderCtx -> Splice Identity) -> Splice Identity
withInlineCtx :: (RenderCtx -> HI.Splice Identity) -> HI.Splice Identity,
    forall {k} (n :: k).
TemplateRenderCtx @k n
-> (RenderCtx -> Splice Identity) -> Splice Identity
withBlockCtx :: (RenderCtx -> HI.Splice Identity) -> HI.Splice Identity,
    forall {k} (n :: k).
TemplateRenderCtx @k n
-> (RenderCtx -> Splice Identity) -> Splice Identity
withLinkInlineCtx :: (RenderCtx -> HI.Splice Identity) -> HI.Splice Identity,
    forall {k} (n :: k).
TemplateRenderCtx @k n -> Title -> Splice Identity
titleSplice :: Tit.Title -> HI.Splice Identity
  }

-- | Create the context in which Heist templates (notably `pandoc.tpl`) will be
-- rendered.
mkTemplateRenderCtx ::
  -- | Current model.
  Model ->
  -- | Current route.
  R.LMLRoute ->
  -- | Associated metadata.
  Aeson.Value ->
  TemplateRenderCtx Identity
mkTemplateRenderCtx :: Model
-> LMLRoute -> Value -> TemplateRenderCtx @(Type -> Type) Identity
mkTemplateRenderCtx Model
model LMLRoute
r Value
meta =
  let EmanotePandocRenderers {PandocRenderers Model LMLRoute
linkInlineRenderers :: forall a r. EmanotePandocRenderers a r -> PandocRenderers a r
inlineRenderers :: forall a r. EmanotePandocRenderers a r -> PandocRenderers a r
blockRenderers :: forall a r. EmanotePandocRenderers a r -> PandocRenderers a r
linkInlineRenderers :: PandocRenderers Model LMLRoute
inlineRenderers :: PandocRenderers Model LMLRoute
blockRenderers :: PandocRenderers Model LMLRoute
..} = Model -> EmanotePandocRenderers Model LMLRoute
forall (encF :: Type -> Type).
ModelT encF -> EmanotePandocRenderers Model LMLRoute
M._modelPandocRenderers Model
model
      withInlineCtx :: (RenderCtx -> Splice Identity) -> Splice Identity
withInlineCtx =
        PandocRenderers Model LMLRoute
-> (RenderCtx -> Splice Identity) -> Splice Identity
forall (m :: Type -> Type) x.
Monad m =>
PandocRenderers Model LMLRoute
-> (RenderCtx -> HeistT Identity m x) -> HeistT Identity m x
withRenderCtx PandocRenderers Model LMLRoute
inlineRenderers
      withLinkInlineCtx :: (RenderCtx -> Splice Identity) -> Splice Identity
withLinkInlineCtx =
        PandocRenderers Model LMLRoute
-> (RenderCtx -> Splice Identity) -> Splice Identity
forall (m :: Type -> Type) x.
Monad m =>
PandocRenderers Model LMLRoute
-> (RenderCtx -> HeistT Identity m x) -> HeistT Identity m x
withRenderCtx PandocRenderers Model LMLRoute
linkInlineRenderers
      withBlockCtx :: (RenderCtx -> Splice Identity) -> Splice Identity
withBlockCtx =
        PandocRenderers Model LMLRoute
-> (RenderCtx -> Splice Identity) -> Splice Identity
forall (m :: Type -> Type) x.
Monad m =>
PandocRenderers Model LMLRoute
-> (RenderCtx -> HeistT Identity m x) -> HeistT Identity m x
withRenderCtx PandocRenderers Model LMLRoute
blockRenderers
      -- TODO: We should be using withInlineCtx, so as to make the wikilink
      -- render in note title.
      titleSplice :: Title -> Splice Identity
titleSplice Title
titleDoc = (RenderCtx -> Splice Identity) -> Splice Identity
withLinkInlineCtx ((RenderCtx -> Splice Identity) -> Splice Identity)
-> (RenderCtx -> Splice Identity) -> Splice Identity
forall a b. (a -> b) -> a -> b
$ \RenderCtx
ctx ->
        RenderCtx -> ([Inline] -> [Inline]) -> Title -> Splice Identity
forall b.
(Walkable Inline b, (b :: Type) ~ ([Inline] :: Type)) =>
RenderCtx -> (b -> b) -> Title -> Splice Identity
Tit.titleSplice RenderCtx
ctx [Inline] -> [Inline]
forall b. Walkable Inline b => b -> b
preparePandoc Title
titleDoc
   in TemplateRenderCtx :: forall {k} (n :: k).
((RenderCtx -> Splice Identity) -> Splice Identity)
-> ((RenderCtx -> Splice Identity) -> Splice Identity)
-> ((RenderCtx -> Splice Identity) -> Splice Identity)
-> (Title -> Splice Identity)
-> TemplateRenderCtx @k n
TemplateRenderCtx {Title -> Splice Identity
(RenderCtx -> Splice Identity) -> Splice Identity
titleSplice :: Title -> Splice Identity
withBlockCtx :: (RenderCtx -> Splice Identity) -> Splice Identity
withLinkInlineCtx :: (RenderCtx -> Splice Identity) -> Splice Identity
withInlineCtx :: (RenderCtx -> Splice Identity) -> Splice Identity
titleSplice :: Title -> Splice Identity
withLinkInlineCtx :: (RenderCtx -> Splice Identity) -> Splice Identity
withBlockCtx :: (RenderCtx -> Splice Identity) -> Splice Identity
withInlineCtx :: (RenderCtx -> Splice Identity) -> Splice Identity
..}
  where
    withRenderCtx ::
      (Monad m) =>
      PandocRenderers Model LMLRoute ->
      (RenderCtx -> H.HeistT Identity m x) ->
      H.HeistT Identity m x
    withRenderCtx :: forall (m :: Type -> Type) x.
Monad m =>
PandocRenderers Model LMLRoute
-> (RenderCtx -> HeistT Identity m x) -> HeistT Identity m x
withRenderCtx PandocRenderers Model LMLRoute
pandocRenderers RenderCtx -> HeistT Identity m x
f =
      RenderCtx -> HeistT Identity m x
f
        (RenderCtx -> HeistT Identity m x)
-> HeistT Identity m RenderCtx -> HeistT Identity m x
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< PandocRenderers Model LMLRoute
-> Map Text Text
-> Model
-> LMLRoute
-> HeistT Identity m RenderCtx
forall model route (m :: Type -> Type).
Monad m =>
PandocRenderers model route
-> Map Text Text -> model -> route -> HeistT Identity m RenderCtx
Renderer.mkRenderCtxWithPandocRenderers
          PandocRenderers Model LMLRoute
pandocRenderers
          Map Text Text
classRules
          Model
model
          LMLRoute
r
    classRules :: Map Text Text
    classRules :: Map Text Text
classRules =
      Map Text Text -> NonEmpty Text -> Value -> Map Text Text
forall a. FromJSON a => a -> NonEmpty Text -> Value -> a
SData.lookupAeson Map Text Text
forall a. Monoid a => a
mempty (Text
"pandoc" Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text
"rewriteClass"]) Value
meta

defaultRouteMeta :: Model -> (LMLRoute, Aeson.Value)
defaultRouteMeta :: Model -> (LMLRoute, Value)
defaultRouteMeta Model
model =
  let r :: LMLRoute
r = Model -> LMLRoute
forall (f :: Type -> Type). ModelT f -> LMLRoute
M.modelIndexRoute Model
model
      meta :: Value
meta = LMLRoute -> Model -> Value
forall (f :: Type -> Type). LMLRoute -> ModelT f -> Value
Meta.getEffectiveRouteMeta LMLRoute
r Model
model
   in (LMLRoute
r, Value
meta)

generatedCssFile :: FilePath
generatedCssFile :: FilePath
generatedCssFile = FilePath
"tailwind.css"

commonSplices ::
  HasCallStack =>
  ((RenderCtx -> HI.Splice Identity) -> HI.Splice Identity) ->
  Model ->
  Aeson.Value ->
  Tit.Title ->
  H.Splices (HI.Splice Identity)
commonSplices :: HasCallStack =>
((RenderCtx -> Splice Identity) -> Splice Identity)
-> Model -> Value -> Title -> Splices (Splice Identity)
commonSplices (RenderCtx -> Splice Identity) -> Splice Identity
withCtx Model
model Value
meta Title
routeTitle = do
  let siteTitle :: Title
siteTitle = FilePath -> Title
forall a. IsString a => FilePath -> a
fromString (FilePath -> Title) -> (Text -> FilePath) -> Text -> Title
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
forall a. ToString a => a -> FilePath
toString (Text -> Title) -> Text -> Title
forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => a -> NonEmpty Text -> Value -> a
SData.lookupAeson @Text Text
"Emanote Site" (Text
"page" Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text
"siteTitle"]) Value
meta
      routeTitleFull :: Title
routeTitleFull =
        if Title
routeTitle Title -> Title -> Bool
forall a. Eq a => a -> a -> Bool
== Title
siteTitle
          then Title
siteTitle
          else Title
routeTitle Title -> Title -> Title
forall a. Semigroup a => a -> a -> a
<> Title
" – " Title -> Title -> Title
forall a. Semigroup a => a -> a -> a
<> Title
siteTitle
  -- Heist helpers
  Text
"bind" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
## Splice Identity
forall (n :: Type -> Type). Monad n => Splice n
HB.bindImpl
  Text
"apply" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
## Splice Identity
forall (n :: Type -> Type). Monad n => Splice n
HA.applyImpl
  -- Add tailwind css shim
  Text
"tailwindCssShim" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
##
    do
      [Node] -> Splice Identity
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([Node] -> Splice Identity)
-> (Html -> [Node]) -> Html -> Splice Identity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> [Node]
RX.renderHtmlNodes (Html -> Splice Identity) -> Html -> Splice Identity
forall a b. (a -> b) -> a -> b
$
        if Model -> Bool
M.inLiveServer Model
model Bool -> Bool -> Bool
|| Bool -> Bool
not (Model
model Model -> Optic' A_Lens NoIx Model Bool -> Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Model Bool
forall (encF :: Type -> Type). Lens' (ModelT encF) Bool
M.modelCompileTailwind)
          then do
            -- Twind shim doesn't reliably work in dev server mode. Let's just use the
            -- tailwind CDN.
            Html
cachedTailwindCdn
          else do
            Html
H.link
              -- TODO: Use ?md5 to prevent stale browser caching of CSS.
              -- TODO: This should go through Ema route encoder!
              Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (FilePath -> AttributeValue
forall a. ToValue a => a -> AttributeValue
H.toValue (FilePath -> AttributeValue) -> FilePath -> AttributeValue
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
cannotBeCached FilePath
generatedCssFile)
              Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.rel AttributeValue
"stylesheet"
              Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.type_ AttributeValue
"text/css"
  Text
"ema:version" 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 [Node]
HI.textSplice (FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Version -> FilePath
showVersion Version
Paths_emanote.version)
  Text
"ema:metadata" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
##
    Value -> Splice Identity
forall a (n :: Type -> Type). (ToJSON a, Monad n) => a -> Splice n
HJ.bindJson Value
meta
  Text
"ema:title" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
## (RenderCtx -> Splice Identity) -> Splice Identity
withCtx ((RenderCtx -> Splice Identity) -> Splice Identity)
-> (RenderCtx -> Splice Identity) -> Splice Identity
forall a b. (a -> b) -> a -> b
$ \RenderCtx
ctx ->
    RenderCtx -> ([Inline] -> [Inline]) -> Title -> Splice Identity
forall b.
(Walkable Inline b, (b :: Type) ~ ([Inline] :: Type)) =>
RenderCtx -> (b -> b) -> Title -> Splice Identity
Tit.titleSplice RenderCtx
ctx [Inline] -> [Inline]
forall b. Walkable Inline b => b -> b
preparePandoc Title
routeTitle
  -- <head>'s <title> cannot contain HTML
  Text
"ema:titleFull" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
##
    Title -> Splice Identity
Tit.titleSpliceNoHtml Title
routeTitleFull
  -- `ema:homeUrl` is normally `""`; but if Emanote is being served from an URL
  -- prefix, it would be "/foo/" (with a slash at the end). This allows you to
  -- just concatanate homeUrl with a relative URL path (no slash in between), to
  -- get the full URL. The reason there is no slash in between is to account for
  -- the usual case of homeUrl being an empty string.
  Text
"ema:homeUrl" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
##
    ( let homeR :: SiteRoute
homeR = LMLRoute -> SiteRoute
SR.lmlSiteRoute (Model -> LMLRoute
forall (f :: Type -> Type). ModelT f -> LMLRoute
M.modelIndexRoute Model
model)
          homeUrl' :: Text
homeUrl' = HasCallStack => Model -> SiteRoute -> Text
Model -> SiteRoute -> Text
SR.siteRouteUrl Model
model SiteRoute
homeR
          homeUrl :: Text
homeUrl = if Text
homeUrl' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"" then Text
homeUrl' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" else Text
homeUrl'
       in Text -> Splice Identity
forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m [Node]
HI.textSplice Text
homeUrl
    )
  Text
"ema:indexUrl" 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 [Node]
HI.textSplice (HasCallStack => Model -> SiteRoute -> Text
Model -> SiteRoute -> Text
SR.siteRouteUrl Model
model SiteRoute
SR.indexRoute)
  Text
"ema:tagIndexUrl" 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 [Node]
HI.textSplice (HasCallStack => Model -> SiteRoute -> Text
Model -> SiteRoute -> Text
SR.siteRouteUrl Model
model (SiteRoute -> Text) -> SiteRoute -> Text
forall a b. (a -> b) -> a -> b
$ [TagNode] -> SiteRoute
SR.tagIndexRoute [])
  Text
"ema:taskIndexUrl" 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 [Node]
HI.textSplice (HasCallStack => Model -> SiteRoute -> Text
Model -> SiteRoute -> Text
SR.siteRouteUrl Model
model SiteRoute
SR.taskIndexRoute)
  Text
"ema:emanoteStaticLayerUrl" 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 [Node]
HI.textSplice
      ( -- HACK
        -- Also: more-head.tpl is the one place where this is hardcoded.
        let staticFolder :: FilePath
staticFolder = FilePath
"_emanote-static"
            itUrl :: Text
itUrl =
              HasCallStack => Model -> SiteRoute -> Text
Model -> SiteRoute -> Text
SR.siteRouteUrl Model
model (SiteRoute -> Text) -> SiteRoute -> Text
forall a b. (a -> b) -> a -> b
$
                StaticFile -> SiteRoute
SR.staticFileSiteRoute (StaticFile -> SiteRoute) -> StaticFile -> SiteRoute
forall a b. (a -> b) -> a -> b
$
                  StaticFile -> Maybe StaticFile -> StaticFile
forall a. a -> Maybe a -> a
fromMaybe (Text -> StaticFile
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"no _emanote-static?") (Maybe StaticFile -> StaticFile) -> Maybe StaticFile -> StaticFile
forall a b. (a -> b) -> a -> b
$
                    FilePath -> Model -> Maybe StaticFile
forall (f :: Type -> Type).
FilePath -> ModelT f -> Maybe StaticFile
M.modelLookupStaticFile (FilePath
staticFolder FilePath -> FilePath -> FilePath
</> FilePath
"inverted-tree.css") Model
model
            staticFolderUrl :: Text
staticFolderUrl = (Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Text) -> (Text, Text) -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> (Text, Text)
T.breakOn Text
"/inverted-tree.css" Text
itUrl
            -- Deal with a silly Firefox bug https://github.com/EmaApps/emanote/issues/340
            --
            -- Firefox deduces an incorrect <base> after doing morphdom
            -- patching, unless the <base> is absolute (i.e., starts with a '/').
            patchForFirefoxBug :: FilePath -> Text -> Text
patchForFirefoxBug FilePath
folder Text
url =
              if Model -> Bool
M.inLiveServer Model
model Bool -> Bool -> Bool
&& Text
url Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
folder
                then Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
url
                else Text
url
         in FilePath -> Text -> Text
patchForFirefoxBug FilePath
staticFolder Text
staticFolderUrl
      )
  -- For those cases the user really wants to hardcode the URL
  Text
"ema:urlStrategySuffix" 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 [Node]
HI.textSplice (Model -> Text
SR.urlStrategySuffix Model
model)
  where
    -- A hack to force the browser not to cache the CSS, because we are not md5
    -- hashing the CSS yet (because the CSS is generated *after* the HTML files
    -- are generated.)
    -- For a proper way to do this, see: https://github.com/srid/ema/issues/20
    cannotBeCached :: FilePath -> FilePath
cannotBeCached FilePath
url = FilePath
url FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"?instanceId=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> UUID -> FilePath
forall b a. (Show a, IsString b) => a -> b
show (Model
model Model -> Optic' A_Lens NoIx Model UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Model UUID
forall (encF :: Type -> Type). Lens' (ModelT encF) UUID
M.modelInstanceID)
    cachedTailwindCdn :: Html
cachedTailwindCdn = do
      let localCdnUrl :: Text
localCdnUrl =
            HasCallStack => Model -> SiteRoute -> Text
Model -> SiteRoute -> Text
SR.siteRouteUrl Model
model (SiteRoute -> Text) -> SiteRoute -> Text
forall a b. (a -> b) -> a -> b
$
              StaticFile -> SiteRoute
SR.staticFileSiteRoute (StaticFile -> SiteRoute) -> StaticFile -> SiteRoute
forall a b. (a -> b) -> a -> b
$
                Model -> StaticFile
LiveServerFiles.tailwindCssFile Model
model
      Html
H.link
        Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
H.toValue Text
localCdnUrl)
        Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.rel AttributeValue
"stylesheet"
        Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.type_ AttributeValue
"text/css"

renderModelTemplate :: Model -> Tmpl.TemplateName -> H.Splices (HI.Splice Identity) -> LByteString
renderModelTemplate :: Model -> TemplateName -> Splices (Splice Identity) -> LByteString
renderModelTemplate Model
model TemplateName
templateName =
  let handleErr :: Text -> LByteString
handleErr =
        if Model -> Bool
M.inLiveServer Model
model
          then Text -> LByteString
Ema.emaErrorHtmlResponse
          else -- When staticaly generating, we must fail asap on template errors.
            Text -> LByteString
forall a t. (HasCallStack, IsText t) => t -> a
error
   in -- Until Ema's error handling improves ...
      (Text -> LByteString)
-> (LByteString -> LByteString)
-> Either Text LByteString
-> LByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> LByteString
handleErr LByteString -> LByteString
forall a. a -> a
id
        (Either Text LByteString -> LByteString)
-> (Splices (Splice Identity) -> Either Text LByteString)
-> Splices (Splice Identity)
-> LByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Splices (Splice Identity)
 -> TemplateState -> Either Text LByteString)
-> TemplateState
-> Splices (Splice Identity)
-> Either Text LByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip (HasCallStack =>
TemplateName
-> Splices (Splice Identity)
-> TemplateState
-> Either Text LByteString
TemplateName
-> Splices (Splice Identity)
-> TemplateState
-> Either Text LByteString
Tmpl.renderHeistTemplate TemplateName
templateName) (Model
model Model -> Optic' A_Lens NoIx Model TemplateState -> TemplateState
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Model TemplateState
forall (encF :: Type -> Type). Lens' (ModelT encF) TemplateState
M.modelHeistTemplate)

routeBreadcrumbs :: TemplateRenderCtx n -> Model -> LMLRoute -> HI.Splice Identity
routeBreadcrumbs :: forall {k} (n :: k).
TemplateRenderCtx @k n -> Model -> LMLRoute -> Splice Identity
routeBreadcrumbs TemplateRenderCtx {Title -> Splice Identity
(RenderCtx -> Splice Identity) -> Splice Identity
titleSplice :: Title -> Splice Identity
withLinkInlineCtx :: (RenderCtx -> Splice Identity) -> Splice Identity
withBlockCtx :: (RenderCtx -> Splice Identity) -> Splice Identity
withInlineCtx :: (RenderCtx -> Splice Identity) -> Splice Identity
titleSplice :: forall {k} (n :: k).
TemplateRenderCtx @k n -> Title -> Splice Identity
withLinkInlineCtx :: forall {k} (n :: k).
TemplateRenderCtx @k n
-> (RenderCtx -> Splice Identity) -> Splice Identity
withBlockCtx :: forall {k} (n :: k).
TemplateRenderCtx @k n
-> (RenderCtx -> Splice Identity) -> Splice Identity
withInlineCtx :: forall {k} (n :: k).
TemplateRenderCtx @k n
-> (RenderCtx -> Splice Identity) -> Splice Identity
..} Model
model LMLRoute
r = do
  let breadcrumbs :: [LMLRoute]
breadcrumbs =
        LMLRoute
r
          LMLRoute
-> (LMLRoute
    -> Either
         (R @SourceExt ('LMLType 'Md)) (R @SourceExt ('LMLType 'Org)))
-> Either
     (R @SourceExt ('LMLType 'Md)) (R @SourceExt ('LMLType 'Org))
forall a b. a -> (a -> b) -> b
& LMLRoute
-> Either
     (R @SourceExt ('LMLType 'Md)) (R @SourceExt ('LMLType 'Org))
R.lmlRouteCase
          -- Hardcode to 'Md, and resolve using resolveLmlRoute latter.
          Either (R @SourceExt ('LMLType 'Md)) (R @SourceExt ('LMLType 'Org))
-> (Either
      (R @SourceExt ('LMLType 'Md)) (R @SourceExt ('LMLType 'Org))
    -> NonEmpty (R @SourceExt ('LMLType 'Md)))
-> NonEmpty (R @SourceExt ('LMLType 'Md))
forall a b. a -> (a -> b) -> b
& (R @SourceExt ('LMLType 'Md)
 -> NonEmpty (R @SourceExt ('LMLType 'Md)))
-> (R @SourceExt ('LMLType 'Org)
    -> NonEmpty (R @SourceExt ('LMLType 'Md)))
-> Either
     (R @SourceExt ('LMLType 'Md)) (R @SourceExt ('LMLType 'Org))
-> NonEmpty (R @SourceExt ('LMLType 'Md))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either R @SourceExt ('LMLType 'Md)
-> NonEmpty (R @SourceExt ('LMLType 'Md))
forall {a} (ext :: FileType a). R @a ext -> NonEmpty (R @a ext)
R.routeInits (R @SourceExt ('LMLType 'Md)
-> NonEmpty (R @SourceExt ('LMLType 'Md))
forall {a} (ext :: FileType a). R @a ext -> NonEmpty (R @a ext)
R.routeInits (R @SourceExt ('LMLType 'Md)
 -> NonEmpty (R @SourceExt ('LMLType 'Md)))
-> (R @SourceExt ('LMLType 'Org) -> R @SourceExt ('LMLType 'Md))
-> R @SourceExt ('LMLType 'Org)
-> NonEmpty (R @SourceExt ('LMLType 'Md))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R @SourceExt ('LMLType 'Org) -> R @SourceExt ('LMLType 'Md)
coerce)
          NonEmpty (R @SourceExt ('LMLType 'Md))
-> (NonEmpty (R @SourceExt ('LMLType 'Md))
    -> [R @SourceExt ('LMLType 'Md)])
-> [R @SourceExt ('LMLType 'Md)]
forall a b. a -> (a -> b) -> b
& NonEmpty (R @SourceExt ('LMLType 'Md))
-> [R @SourceExt ('LMLType 'Md)]
forall (f :: Type -> Type) a.
IsNonEmpty f a [a] "init" =>
f a -> [a]
init
          [R @SourceExt ('LMLType 'Md)]
-> ([R @SourceExt ('LMLType 'Md)] -> [LMLRoute]) -> [LMLRoute]
forall a b. a -> (a -> b) -> b
& (R @SourceExt ('LMLType 'Md) -> LMLRoute)
-> [R @SourceExt ('LMLType 'Md)] -> [LMLRoute]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Model -> R @SourceExt ('LMLType 'Md) -> LMLRoute
forall (lmlType :: LML) (f :: Type -> Type).
ModelT f -> R @SourceExt ('LMLType lmlType) -> LMLRoute
M.resolveLmlRoute Model
model)
  [LMLRoute]
-> Text
-> (LMLRoute -> Splices (Splice Identity))
-> Splice Identity
forall a.
[a] -> Text -> (a -> Splices (Splice Identity)) -> Splice Identity
Splices.listSplice [LMLRoute]
breadcrumbs Text
"each-crumb" ((LMLRoute -> Splices (Splice Identity)) -> Splice Identity)
-> (LMLRoute -> Splices (Splice Identity)) -> Splice Identity
forall a b. (a -> b) -> a -> b
$ \LMLRoute
crumbR -> do
    Text
"crumb: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 [Node]
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
crumbR)
    Text
"crumb:title" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
## Title -> Splice Identity
titleSplice (LMLRoute -> Model -> Title
forall (f :: Type -> Type). LMLRoute -> ModelT f -> Title
M.modelLookupTitle LMLRoute
crumbR Model
model)