/// Custom DotLiquid filters and tags
module MyWebLog.DotLiquidBespoke
open System
open System.IO
open System.Web
open DotLiquid
open Giraffe.ViewEngine
open MyWebLog.ViewModels
/// Get the current web log from the DotLiquid context
let webLog (ctx : Context) =
ctx.Environments[0].["web_log"] :?> WebLog
/// Does an asset exist for the current theme?
let assetExists fileName (webLog : WebLog) =
ThemeAssetCache.get (ThemeId webLog.themePath) |> List.exists (fun it -> it = fileName)
/// Obtain the link from known types
let permalink (ctx : Context) (item : obj) (linkFunc : WebLog -> Permalink -> string) =
match item with
| :? String as link -> Some link
| :? DisplayPage as page -> Some page.permalink
| :? PostListItem as post -> Some post.permalink
| :? DropProxy as proxy -> Option.ofObj proxy["permalink"] |> Option.map string
| _ -> None
|> function
| Some link -> linkFunc (webLog ctx) (Permalink link)
| None -> $"alert('unknown item type {item.GetType().Name}')"
/// A filter to generate an absolute link
type AbsoluteLinkFilter () =
static member AbsoluteLink (ctx : Context, item : obj) =
permalink ctx item WebLog.absoluteUrl
/// A filter to generate a link with posts categorized under the given category
type CategoryLinkFilter () =
static member CategoryLink (ctx : Context, catObj : obj) =
match catObj with
| :? DisplayCategory as cat -> Some cat.slug
| :? DropProxy as proxy -> Option.ofObj proxy["slug"] |> Option.map string
| _ -> None
|> function
| Some slug -> WebLog.relativeUrl (webLog ctx) (Permalink $"category/{slug}/")
| None -> $"alert('unknown category object type {catObj.GetType().Name}')"
/// A filter to generate a link that will edit a page
type EditPageLinkFilter () =
static member EditPageLink (ctx : Context, pageObj : obj) =
match pageObj with
| :? DisplayPage as page -> Some page.id
| :? DropProxy as proxy -> Option.ofObj proxy["id"] |> Option.map string
| :? String as theId -> Some theId
| _ -> None
|> function
| Some pageId -> WebLog.relativeUrl (webLog ctx) (Permalink $"admin/page/{pageId}/edit")
| None -> $"alert('unknown page object type {pageObj.GetType().Name}')"
/// A filter to generate a link that will edit a post
type EditPostLinkFilter () =
static member EditPostLink (ctx : Context, postObj : obj) =
match postObj with
| :? PostListItem as post -> Some post.id
| :? DropProxy as proxy -> Option.ofObj proxy["id"] |> Option.map string
| :? String as theId -> Some theId
| _ -> None
|> function
| Some postId -> WebLog.relativeUrl (webLog ctx) (Permalink $"admin/post/{postId}/edit")
| None -> $"alert('unknown post object type {postObj.GetType().Name}')"
/// A filter to generate nav links, highlighting the active link (exact match)
type NavLinkFilter () =
static member NavLink (ctx : Context, url : string, text : string) =
let webLog = webLog ctx
let _, path = WebLog.hostAndPath webLog
let path = if path = "" then path else $"{path.Substring 1}/"
seq {
"
"
}
|> Seq.fold (+) ""
/// A filter to generate a link for theme asset (image, stylesheet, script, etc.)
type ThemeAssetFilter () =
static member ThemeAsset (ctx : Context, asset : string) =
let webLog = webLog ctx
WebLog.relativeUrl webLog (Permalink $"themes/{webLog.themePath}/{asset}")
/// Create various items in the page header based on the state of the page being generated
type PageHeadTag () =
inherit Tag ()
override this.Render (context : Context, result : TextWriter) =
let webLog = webLog context
// spacer
let s = " "
let getBool name =
context.Environments[0].[name] |> Option.ofObj |> Option.map Convert.ToBoolean |> Option.defaultValue false
result.WriteLine $""""""
// Theme assets
if assetExists "style.css" webLog then
result.WriteLine $"""{s}"""
if assetExists "favicon.ico" webLog then
result.WriteLine $"""{s}"""
// RSS feeds and canonical URLs
let feedLink title url =
let escTitle = HttpUtility.HtmlAttributeEncode title
let relUrl = WebLog.relativeUrl webLog (Permalink url)
$"""{s}"""
if webLog.rss.feedEnabled && getBool "is_home" then
result.WriteLine (feedLink webLog.name webLog.rss.feedName)
result.WriteLine $"""{s}"""
if webLog.rss.categoryEnabled && getBool "is_category_home" then
let slug = context.Environments[0].["slug"] :?> string
result.WriteLine (feedLink webLog.name $"category/{slug}/{webLog.rss.feedName}")
if webLog.rss.tagEnabled && getBool "is_tag_home" then
let slug = context.Environments[0].["slug"] :?> string
result.WriteLine (feedLink webLog.name $"tag/{slug}/{webLog.rss.feedName}")
if getBool "is_post" then
let post = context.Environments[0].["model"] :?> PostDisplay
let url = WebLog.absoluteUrl webLog (Permalink post.posts[0].permalink)
result.WriteLine $"""{s}"""
if getBool "is_page" then
let page = context.Environments[0].["page"] :?> DisplayPage
let url = WebLog.absoluteUrl webLog (Permalink page.permalink)
result.WriteLine $"""{s}"""
/// Create various items in the page header based on the state of the page being generated
type PageFootTag () =
inherit Tag ()
override this.Render (context : Context, result : TextWriter) =
let webLog = webLog context
// spacer
let s = " "
if webLog.autoHtmx then
result.WriteLine $"{s}{RenderView.AsString.htmlNode Htmx.Script.minified}"
if assetExists "script.js" webLog then
result.WriteLine $"""{s}"""
/// A filter to generate a relative link
type RelativeLinkFilter () =
static member RelativeLink (ctx : Context, item : obj) =
permalink ctx item WebLog.relativeUrl
/// A filter to generate a link with posts tagged with the given tag
type TagLinkFilter () =
static member TagLink (ctx : Context, tag : string) =
ctx.Environments[0].["tag_mappings"] :?> TagMap list
|> List.tryFind (fun it -> it.tag = tag)
|> function
| Some tagMap -> tagMap.urlValue
| None -> tag.Replace (" ", "+")
|> function tagUrl -> WebLog.relativeUrl (webLog ctx) (Permalink $"tag/{tagUrl}/")
/// Create links for a user to log on or off, and a dashboard link if they are logged off
type UserLinksTag () =
inherit Tag ()
override this.Render (context : Context, result : TextWriter) =
let webLog = webLog context
let link it = WebLog.relativeUrl webLog (Permalink it)
seq {
"""
"""
match Convert.ToBoolean context.Environments[0].["logged_on"] with
| true ->
$"""