378 lines
17 KiB
Forth
378 lines
17 KiB
Forth
/// <summary>Logic to work with Fluid templates</summary>
|
|
module MyWebLog.Template
|
|
|
|
open System
|
|
open System.Collections.Generic
|
|
open System.IO
|
|
open System.Text
|
|
open Fluid
|
|
open Fluid.Values
|
|
open Microsoft.AspNetCore.Antiforgery
|
|
open Microsoft.Extensions.FileProviders
|
|
open MyWebLog
|
|
open MyWebLog.ViewModels
|
|
|
|
/// Alias for ValueTask
|
|
type VTask<'T> = System.Threading.Tasks.ValueTask<'T>
|
|
|
|
|
|
/// <summary>Extensions on Fluid's TemplateContext object</summary>
|
|
type TemplateContext with
|
|
|
|
/// <summary>Get the model of the context as an <tt>AppViewContext</tt> instance</summary>
|
|
member this.App =
|
|
this.Model.ToObjectValue() :?> AppViewContext
|
|
|
|
|
|
/// <summary>Helper functions for filters and tags</summary>
|
|
[<AutoOpen>]
|
|
module private Helpers =
|
|
|
|
/// <summary>Does an asset exist for the current theme?</summary>
|
|
/// <param name="fileName">The name of the asset</param>
|
|
/// <param name="webLog">The current web log</param>
|
|
/// <returns>True if the theme has the requested asset name, false if not</returns>
|
|
let assetExists fileName (webLog: WebLog) =
|
|
ThemeAssetCache.get webLog.ThemeId |> List.exists (fun it -> it = fileName)
|
|
|
|
/// <summary>Obtain the link from known types</summary>
|
|
/// <param name="item">The <tt>FluidValue</tt> for the given parameter</param>
|
|
/// <param name="linkFunc">The function to extract the value of the link into a string</param>
|
|
/// <returns>The link as a string, or JavaScript to show an alert if a link cannot be determined</returns>
|
|
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}')"
|
|
|
|
/// <summary>Generate a link for theme asset (image, stylesheet, script, etc.)</summary>
|
|
/// <param name="input">The name of the theme asset</param>
|
|
/// <param name="ctx">The template context for the current template rendering</param>
|
|
/// <returns>A relative URL for the given theme asset</returns>
|
|
let themeAsset (input: FluidValue) (ctx: TemplateContext) =
|
|
let app = ctx.App
|
|
app.WebLog.RelativeUrl(Permalink $"themes/{app.WebLog.ThemeId}/{input.ToStringValue()}")
|
|
|
|
|
|
/// <summary>Fluid template options customized with myWebLog filters</summary>
|
|
/// <returns>A <tt>TemplateOptions</tt> instance with all myWebLog filters and types registered</returns>
|
|
let options () =
|
|
let sValue = StringValue >> VTask<FluidValue>
|
|
|
|
let it = TemplateOptions.Default
|
|
it.MemberAccessStrategy.MemberNameStrategy <- MemberNameStrategies.SnakeCase
|
|
[ // Domain types
|
|
typeof<CustomFeed>; typeof<Episode>; typeof<Episode option>; typeof<MetaItem>; typeof<Page>; typeof<RssOptions>
|
|
typeof<TagMap>; typeof<WebLog>
|
|
// View models
|
|
typeof<AppViewContext>; typeof<DisplayCategory>; typeof<DisplayPage>; typeof<EditPageModel>; typeof<PostDisplay>
|
|
typeof<PostListItem>; typeof<UserMessage>
|
|
// Framework types
|
|
typeof<AntiforgeryTokenSet>; typeof<DateTime option>; typeof<int option>; typeof<KeyValuePair>
|
|
typeof<MetaItem list>; typeof<string list>; typeof<string option>; typeof<TagMap list> ]
|
|
|> List.iter it.MemberAccessStrategy.Register
|
|
|
|
// 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 ctx ->
|
|
let name = args.At(0).ToStringValue()
|
|
let picker (value: FluidValue) =
|
|
let item = value.ToObjectValue() :?> MetaItem
|
|
if item.Name = name then Some item.Value else None
|
|
match input with
|
|
| :? NilValue -> $"-- {name} not found --"
|
|
| it ->
|
|
(it :?> ArrayValue).Values
|
|
|> Seq.tryPick picker
|
|
|> Option.defaultValue $"-- {name} not found --"
|
|
|> sValue)
|
|
|
|
it
|
|
|
|
|
|
/// <summary>Fluid parser customized with myWebLog filters and tags</summary>
|
|
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 attrEnc = System.Web.HttpUtility.HtmlAttributeEncode
|
|
|
|
// OpenGraph tags
|
|
let doOpenGraph =
|
|
(app.WebLog.AutoOpenGraph && (app.IsPage || app.IsPost))
|
|
|| (app.IsPage && Option.isSome app.Page.OpenGraph)
|
|
|| (app.IsPost && Option.isSome app.Posts.Posts[0].OpenGraph)
|
|
|
|
if doOpenGraph then
|
|
let writeOgProp (name, value) =
|
|
writer.WriteLine $"""{s}<meta property=%s{name} content="{attrEnc value}">"""
|
|
writeOgProp ("og:title", if app.IsPage then app.Page.Title else app.Posts.Posts[0].Title)
|
|
writeOgProp ("og:site_name", app.WebLog.Name)
|
|
if app.IsPage then app.Page.Permalink else app.Posts.Posts[0].Permalink
|
|
|> Permalink
|
|
|> app.WebLog.AbsoluteUrl
|
|
|> function url -> writeOgProp ("og:url", url)
|
|
match if app.IsPage then app.Page.OpenGraph else app.Posts.Posts[0].OpenGraph with
|
|
| Some props -> props.ToProperties app.WebLog.UrlToAbsolute |> Seq.iter writeOgProp
|
|
| None -> ()
|
|
|
|
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 url = app.WebLog.AbsoluteUrl(Permalink app.Posts.Posts[0].Permalink)
|
|
writer.WriteLine $"""{s}<link rel=canonical href="{url}">"""
|
|
|
|
if app.IsPage then
|
|
let url = app.WebLog.AbsoluteUrl(Permalink app.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
|
|
context.App.WebLog.RelativeUrl(Permalink "htmx.min.js")
|
|
|> sprintf "%s<script src=\"%s\"></script>" s
|
|
|> writer.WriteLine
|
|
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
|
|
|
|
|
|
open MyWebLog.Data
|
|
|
|
/// <summary>Cache for parsed templates</summary>
|
|
module Cache =
|
|
|
|
open System.Collections.Concurrent
|
|
|
|
/// Cache of parsed templates
|
|
let private _cache = ConcurrentDictionary<string, IFluidTemplate> ()
|
|
|
|
/// <summary>Get a template for the given theme and template name</summary>
|
|
/// <param name="themeId">The ID of the theme for which a template should be retrieved</param>
|
|
/// <param name="templateName">The name of the template to retrieve</param>
|
|
/// <param name="data">The data implementation from which the template should be retrieved (if not cached)</param>
|
|
/// <returns>
|
|
/// An <tt>Ok</tt> result with the template if it is found and valid, an <tt>Error</tt> result if not
|
|
/// </returns>
|
|
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"
|
|
}
|
|
|
|
/// <summary>Get all theme/template names currently cached</summary>
|
|
/// <returns>All theme/template names current cached</returns>
|
|
let allNames () =
|
|
_cache.Keys |> Seq.sort |> Seq.toList
|
|
|
|
/// <summary>Invalidate all template cache entries for the given theme ID</summary>
|
|
/// <param name="themeId">The ID of the theme whose cache should be invalidated</param>
|
|
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 _, _ -> ())
|
|
|
|
/// <summary>Remove all entries from the template cache</summary>
|
|
let empty () =
|
|
_cache.Clear()
|
|
|
|
|
|
/// <summary>A file provider to retrieve files by theme</summary>
|
|
type ThemeFileProvider(themeId: ThemeId, data: IData) =
|
|
|
|
interface IFileProvider with
|
|
|
|
member _.GetDirectoryContents _ =
|
|
raise <| NotImplementedException "The theme file provider does not support directory listings"
|
|
|
|
member _.GetFileInfo path =
|
|
match data.Theme.FindById themeId |> Async.AwaitTask |> Async.RunSynchronously with
|
|
| Some theme ->
|
|
match theme.Templates |> List.tryFind (fun t -> t.Name = path) with
|
|
| Some template ->
|
|
{ new IFileInfo with
|
|
member _.Exists = true
|
|
member _.IsDirectory = false
|
|
member _.LastModified = DateTimeOffset.Now
|
|
member _.Length = int64 template.Text.Length
|
|
member _.Name = template.Name.Split '/' |> Array.last
|
|
member _.PhysicalPath = null
|
|
member _.CreateReadStream() =
|
|
new MemoryStream(Encoding.UTF8.GetBytes template.Text) }
|
|
| None -> NotFoundFileInfo path
|
|
| None -> NotFoundFileInfo path
|
|
|
|
member _.Watch _ =
|
|
raise <| NotImplementedException "The theme file provider does not support watching for changes"
|
|
|
|
|
|
/// <summary>Render a template to a string</summary>
|
|
/// <param name="template">The template to be rendered</param>
|
|
/// <param name="viewCtx">The app context for rendering this template</param>
|
|
/// <param name="data">The data implementation to use if required</param>
|
|
/// <returns>The rendered template as a string</returns>
|
|
let render (template: IFluidTemplate) (viewCtx: AppViewContext) data =
|
|
let opts = options ()
|
|
opts.FileProvider <- ThemeFileProvider(viewCtx.WebLog.ThemeId, data)
|
|
template.Render(TemplateContext(viewCtx, opts, true))
|