{-# 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.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 { withInlineCtx :: (RenderCtx -> HI.Splice Identity) -> HI.Splice Identity , withBlockCtx :: (RenderCtx -> HI.Splice Identity) -> HI.Splice Identity , withLinkInlineCtx :: (RenderCtx -> HI.Splice Identity) -> HI.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 r meta = let EmanotePandocRenderers {..} = M._modelPandocRenderers model withInlineCtx = withRenderCtx inlineRenderers withLinkInlineCtx = withRenderCtx linkInlineRenderers withBlockCtx = withRenderCtx blockRenderers -- TODO: We should be using withInlineCtx, so as to make the wikilink -- render in note title. titleSplice titleDoc = withLinkInlineCtx $ \ctx -> Tit.titleSplice ctx id titleDoc in TemplateRenderCtx {..} where withRenderCtx :: (Monad m) => PandocRenderers Model LMLRoute -> (RenderCtx -> H.HeistT Identity m x) -> H.HeistT Identity m x withRenderCtx pandocRenderers f = f =<< Renderer.mkRenderCtxWithPandocRenderers pandocRenderers classRules model r classRules :: Map Text Text classRules = SData.lookupAeson mempty ("pandoc" :| ["rewriteClass"]) meta defaultRouteMeta :: Model -> (LMLRoute, Aeson.Value) defaultRouteMeta model = let r = M.modelIndexRoute model meta = Meta.getEffectiveRouteMeta r model in (r, meta) generatedCssFile :: FilePath generatedCssFile = "tailwind.css" commonSplices :: (HasCallStack) => ((RenderCtx -> HI.Splice Identity) -> HI.Splice Identity) -> Model -> Aeson.Value -> Tit.Title -> H.Splices (HI.Splice Identity) commonSplices withCtx model meta routeTitle = do let siteTitle = fromString . toString $ SData.lookupAeson @Text "Emanote Site" ("page" :| ["siteTitle"]) meta routeTitleFull = if routeTitle == siteTitle then siteTitle else routeTitle <> " – " <> siteTitle -- Heist helpers "bind" ## HB.bindImpl "apply" ## HA.applyImpl -- Add tailwind css shim "tailwindCssShim" ## do pure . RX.renderHtmlNodes $ if M.inLiveServer model || not (model ^. M.modelCompileTailwind) then do -- Twind shim doesn't reliably work in dev server mode. Let's just use the -- tailwind CDN. cachedTailwindCdn else do H.link -- TODO: Use ?md5 to prevent stale browser caching of CSS. -- TODO: This should go through Ema route encoder! ! A.href (H.toValue $ cannotBeCached generatedCssFile) ! A.rel "stylesheet" ! A.type_ "text/css" "ema:version" ## HI.textSplice (toText $ showVersion Paths_emanote.version) "ema:metadata" ## HJ.bindJson meta "ema:title" ## withCtx $ \ctx -> Tit.titleSplice ctx id routeTitle --
's