WIP: conversion to Fluid (#47)

This commit is contained in:
2024-08-24 20:47:23 -04:00
parent cc3e41ddc5
commit d047035173
14 changed files with 553 additions and 393 deletions
+282
View File
@@ -0,0 +1,282 @@
module MyWebLog.Template
open Fluid
open Fluid.Values
open Giraffe.ViewEngine
open MyWebLog
open MyWebLog.ViewModels
/// Alias for ValueTask
type VTask<'T> = System.Threading.Tasks.ValueTask<'T>
/// Extensions on Fluid's TemplateContext object
type TemplateContext with
/// Get the model of the context as an AppViewContext instance
member this.App =
this.Model.ToObjectValue() :?> AppViewContext
/// Helper functions for filters and tags
[<AutoOpen>]
module private Helpers =
/// Does an asset exist for the current theme?
let assetExists fileName (webLog: WebLog) =
ThemeAssetCache.get webLog.ThemeId |> List.exists (fun it -> it = fileName)
/// Obtain the link from known types
let permalink (item: FluidValue) (linkFunc: Permalink -> string) =
match item.Type with
| FluidValues.String -> Some (item.ToStringValue())
| FluidValues.Object ->
match item.ToObjectValue() with
| :? DisplayPage as page -> Some page.Permalink
| :? PostListItem as post -> Some post.Permalink
| :? Permalink as link -> Some (string link)
| _ -> None
| _ -> None
|> function
| Some link -> linkFunc (Permalink link)
| None -> $"alert('unknown item type {item.Type}')"
/// Generate a link for theme asset (image, stylesheet, script, etc.)
let themeAsset (input: FluidValue) (ctx: TemplateContext) =
let app = ctx.App
app.WebLog.RelativeUrl(Permalink $"themes/{app.WebLog.ThemeId}/{input.ToStringValue()}")
/// Fluid template options customized with myWebLog filters
let options =
let sValue = StringValue >> VTask<FluidValue>
let it = TemplateOptions.Default
it.MemberAccessStrategy.MemberNameStrategy <- MemberNameStrategies.SnakeCase
// A filter to generate an absolute link
it.Filters.AddFilter("absolute_link", fun input _ ctx -> sValue (permalink input ctx.App.WebLog.AbsoluteUrl))
// A filter to generate a link with posts categorized under the given category
it.Filters.AddFilter("category_link",
fun input _ ctx ->
match input.ToObjectValue() with
| :? DisplayCategory as cat -> Some cat.Slug
| :? string as slug -> Some slug
| _ -> None
|> function
| Some slug -> ctx.App.WebLog.RelativeUrl(Permalink $"category/{slug}/")
| None -> $"alert('unknown category object type {input.Type}')"
|> sValue)
// A filter to generate a link that will edit a page
it.Filters.AddFilter("edit_page_link",
fun input _ ctx ->
match input.ToObjectValue() with
| :? DisplayPage as page -> Some page.Id
| :? string as theId -> Some theId
| _ -> None
|> function
| Some pageId -> ctx.App.WebLog.RelativeUrl(Permalink $"admin/page/{pageId}/edit")
| None -> $"alert('unknown page object type {input.Type}')"
|> sValue)
// A filter to generate a link that will edit a post
it.Filters.AddFilter("edit_post_link",
fun input _ ctx ->
match input.ToObjectValue() with
| :? PostListItem as post -> Some post.Id
| :? string as theId -> Some theId
| _ -> None
|> function
| Some postId -> ctx.App.WebLog.RelativeUrl(Permalink $"admin/post/{postId}/edit")
| None -> $"alert('unknown post object type {input.Type}')"
|> sValue)
// A filter to generate nav links, highlighting the active link (starts-with match)
it.Filters.AddFilter("nav_link",
fun input args ctx ->
let app = ctx.App
let extraPath = app.WebLog.ExtraPath
let path = if extraPath = "" then "" else $"{extraPath[1..]}/"
let url = input.ToStringValue()
seq {
"<li class=nav-item><a class=\"nav-link"
if app.CurrentPage.StartsWith $"{path}{url}" then " active"
"\" href=\""
app.WebLog.RelativeUrl(Permalink url)
"\">"
args.At(0).ToStringValue()
"</a>"
}
|> String.concat ""
|> sValue)
// A filter to generate a relative link
it.Filters.AddFilter("relative_link", fun input _ ctx -> sValue (permalink input ctx.App.WebLog.RelativeUrl))
// A filter to generate a link with posts tagged with the given tag
it.Filters.AddFilter("tag_link",
fun input _ ctx ->
let tag = input.ToStringValue()
ctx.App.TagMappings
|> Array.tryFind (fun it -> it.Tag = tag)
|> function
| Some tagMap -> tagMap.UrlValue
| None -> tag.Replace(" ", "+")
|> function tagUrl -> ctx.App.WebLog.RelativeUrl(Permalink $"tag/{tagUrl}/")
|> sValue)
// A filter to generate a link for theme asset (image, stylesheet, script, etc.)
it.Filters.AddFilter("theme_asset", fun input _ ctx -> sValue (themeAsset input ctx))
// A filter to retrieve the value of a meta item from a list
// (shorter than `{% assign item = list | where: "Name", [name] | first %}{{ item.value }}`)
it.Filters.AddFilter("value",
fun input args _ ->
let items = input.ToObjectValue() :?> MetaItem list
let name = args.At(0).ToStringValue()
match items |> List.tryFind (fun it -> it.Name = name) with
| Some item -> item.Value
| None -> $"-- {name} not found --"
|> sValue)
it
/// Fluid parser customized with myWebLog filters and tags
let parser =
// spacer
let s = " "
// Required return for tag delegates
let ok () =
VTask<Fluid.Ast.Completion> Fluid.Ast.Completion.Normal
let it = FluidParser()
// Create various items in the page header based on the state of the page being generated
it.RegisterEmptyTag("page_head",
fun writer encoder context ->
let app = context.App
// let getBool name =
// defaultArg (context.Environments[0].[name] |> Option.ofObj |> Option.map Convert.ToBoolean) false
writer.WriteLine $"""{s}<meta name=generator content="{app.Generator}">"""
// Theme assets
if assetExists "style.css" app.WebLog then
themeAsset (StringValue "style.css") context
|> sprintf "%s<link rel=stylesheet href=\"%s\">" s
|> writer.WriteLine
if assetExists "favicon.ico" app.WebLog then
themeAsset (StringValue "favicon.ico") context
|> sprintf "%s<link rel=icon href=\"%s\">" s
|> writer.WriteLine
// RSS feeds and canonical URLs
let feedLink title url =
let escTitle = System.Web.HttpUtility.HtmlAttributeEncode title
let relUrl = app.WebLog.RelativeUrl(Permalink url)
$"""{s}<link rel=alternate type="application/rss+xml" title="{escTitle}" href="{relUrl}">"""
if app.WebLog.Rss.IsFeedEnabled && app.IsHome then
writer.WriteLine(feedLink app.WebLog.Name app.WebLog.Rss.FeedName)
writer.WriteLine $"""{s}<link rel=canonical href="{app.WebLog.AbsoluteUrl Permalink.Empty}">"""
if app.WebLog.Rss.IsCategoryEnabled && app.IsCategoryHome then
let slug = context.AmbientValues["slug"] :?> string
writer.WriteLine(feedLink app.WebLog.Name $"category/{slug}/{app.WebLog.Rss.FeedName}")
if app.WebLog.Rss.IsTagEnabled && app.IsTagHome then
let slug = context.AmbientValues["slug"] :?> string
writer.WriteLine(feedLink app.WebLog.Name $"tag/{slug}/{app.WebLog.Rss.FeedName}")
if app.IsPost then
let post = (* context.Environments[0].["model"] *) obj() :?> PostDisplay
let url = app.WebLog.AbsoluteUrl(Permalink post.Posts[0].Permalink)
writer.WriteLine $"""{s}<link rel=canonical href="{url}">"""
if app.IsPage then
let page = (* context.Environments[0].["page"] *) obj() :?> DisplayPage
let url = app.WebLog.AbsoluteUrl(Permalink page.Permalink)
writer.WriteLine $"""{s}<link rel=canonical href="{url}">"""
ok ())
// Create various items in the page footer based on the state of the page being generated
it.RegisterEmptyTag("page_foot",
fun writer encoder context ->
let webLog = context.App.WebLog
if webLog.AutoHtmx then
writer.WriteLine $"{s}{RenderView.AsString.htmlNode Htmx.Script.minified}"
if assetExists "script.js" webLog then
themeAsset (StringValue "script.js") context
|> sprintf "%s<script src=\"%s\"></script>" s
|> writer.WriteLine
ok ())
// Create links for a user to log on or off, and a dashboard link if they are logged off
it.RegisterEmptyTag("user_links",
fun writer encoder ctx ->
let app = ctx.App
let link it = app.WebLog.RelativeUrl(Permalink it)
seq {
"""<ul class="navbar-nav flex-grow-1 justify-content-end">"""
match app.IsLoggedOn with
| true ->
$"""<li class=nav-item><a class=nav-link href="{link "admin/dashboard"}">Dashboard</a>"""
$"""<li class=nav-item><a class=nav-link href="{link "user/log-off"}">Log Off</a>"""
| false ->
$"""<li class=nav-item><a class=nav-link href="{link "user/log-on"}">Log On</a>"""
"</ul>"
}
|> Seq.iter writer.WriteLine
ok())
it
/// Cache for parsed templates
module Cache =
open System.Collections.Concurrent
open MyWebLog.Data
/// Cache of parsed templates
let private _cache = ConcurrentDictionary<string, IFluidTemplate> ()
/// Get a template for the given theme and template name
let get (themeId: ThemeId) (templateName: string) (data: IData) = backgroundTask {
let templatePath = $"{themeId}/{templateName}"
match _cache.ContainsKey templatePath with
| true -> return Ok _cache[templatePath]
| false ->
match! data.Theme.FindById themeId with
| Some theme ->
match theme.Templates |> List.tryFind (fun t -> t.Name = templateName) with
| Some template ->
_cache[templatePath] <- parser.Parse(template.Text)
return Ok _cache[templatePath]
| None ->
return Error $"Theme ID {themeId} does not have a template named {templateName}"
| None -> return Error $"Theme ID {themeId} does not exist"
}
/// Get all theme/template names currently cached
let allNames () =
_cache.Keys |> Seq.sort |> Seq.toList
/// Invalidate all template cache entries for the given theme ID
let invalidateTheme (themeId: ThemeId) =
let keyPrefix = string themeId
_cache.Keys
|> Seq.filter _.StartsWith(keyPrefix)
|> List.ofSeq
|> List.iter (fun key -> match _cache.TryRemove key with _, _ -> ())
/// Remove all entries from the template cache
let empty () =
_cache.Clear()
/// Render a template to a string
let render (template: IFluidTemplate) (viewCtx: AppViewContext) =
template.Render(TemplateContext(viewCtx, options, true))