bit-badger/myWebLog
1
0
Fork 0
Code Issues 2 Pull Requests Packages Projects Releases 11 Activity

Update deps; WIP on comments

Browse Source
This commit is contained in:
Daniel J. Summers
2025-01-23 22:11:12 -05:00
parent 88841fd3f8
commit dc30716b83
15 changed files with 1454 additions and 1110 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/MyWebLog/Caches.fs
+70 -43
View File
@@ -3,7 +3,7 @@
open Microsoft.AspNetCore.Http
open MyWebLog.Data
/// Extension properties on HTTP context for web log
/// <summary>Extension properties on HTTP context for web log</summary>
[<AutoOpen>]
module Extensions =
@@ -17,16 +17,16 @@ module Extensions =
type HttpContext with
/// The anti-CSRF service
/// <summary>The anti-CSRF service</summary>
member this.AntiForgery = this.RequestServices.GetRequiredService<IAntiforgery>()
/// The cross-site request forgery token set for this request
/// <summary>The cross-site request forgery token set for this request</summary>
member this.CsrfTokenSet = this.AntiForgery.GetAndStoreTokens this
/// The data implementation
/// <summary>The data implementation</summary>
member this.Data = this.RequestServices.GetRequiredService<IData>()
/// The generator string
/// <summary>The generator string</summary>
member this.Generator =
match generatorString with
| Some gen -> gen
@@ -38,20 +38,22 @@ module Extensions =
| None -> Some "generator not configured"
generatorString.Value
/// The access level for the current user
/// <summary>The access level for the current user</summary>
member this.UserAccessLevel =
this.User.Claims
|> Seq.tryFind (fun claim -> claim.Type = ClaimTypes.Role)
|> Option.map (fun claim -> AccessLevel.Parse claim.Value)
/// The user ID for the current request
/// <summary>The user ID for the current request</summary>
member this.UserId =
WebLogUserId (this.User.Claims |> Seq.find (fun c -> c.Type = ClaimTypes.NameIdentifier)).Value
/// The web log for the current request
/// <summary>The web log for the current request</summary>
member this.WebLog = this.Items["webLog"] :?> WebLog
/// Does the current user have the requested level of access?
/// <summary>Does the current user have the required level of access?</summary>
/// <param name="level">The required level of access</param>
/// <returns>True if the user has the required access, false if not</returns>
member this.HasAccessLevel level =
defaultArg (this.UserAccessLevel |> Option.map _.HasAccess(level)) false
@@ -67,11 +69,11 @@ module WebLogCache =
open System.Text.RegularExpressions
/// A redirect rule that caches compiled regular expression rules
/// <summary>A redirect rule that caches compiled regular expression rules</summary>
type CachedRedirectRule =
/// A straight text match rule
/// <summary>A straight text match rule</summary>
| Text of string * string
/// A regular expression match rule
/// <summary>A regular expression match rule</summary>
| RegEx of Regex * string
/// The cache of web log details
@@ -80,14 +82,17 @@ module WebLogCache =
/// Redirect rules with compiled regular expressions
let mutable private _redirectCache = ConcurrentDictionary<WebLogId, CachedRedirectRule list>()
/// Try to get the web log for the current request (longest matching URL base wins)
let tryGet (path : string) =
/// <summary>Try to get the web log for the current request (longest matching URL base wins)</summary>
/// <param name="path">The path for the current request</param>
/// <returns>Some with the web log matching the URL, or None if none is found</returns>
let tryGet (path: string) =
_cache
|> List.filter (fun wl -> path.StartsWith wl.UrlBase)
|> List.sortByDescending _.UrlBase.Length
|> List.tryHead
/// Cache the web log for a particular host
/// <summary>Cache the web log for a particular host</summary>
/// <param name="webLog">The web log to be cached</param>
let set webLog =
_cache <- webLog :: (_cache |> List.filter (fun wl -> wl.Id <> webLog.Id))
_redirectCache[webLog.Id] <-
@@ -101,26 +106,32 @@ module WebLogCache =
else
Text(relUrl it.From, urlTo))
/// Get all cached web logs
/// <summary>Get all cached web logs</summary>
/// <returns>All cached web logs</returns>
let all () =
_cache
/// Fill the web log cache from the database
/// <summary>Fill the web log cache from the database</summary>
/// <param name="data">The data implementation from which web logs will be retrieved</param>
let fill (data: IData) = backgroundTask {
let! webLogs = data.WebLog.All()
webLogs |> List.iter set
}
/// Get the cached redirect rules for the given web log
/// <summary>Get the cached redirect rules for the given web log</summary>
/// <param name="webLogId">The ID of the web log for which rules should be retrieved</param>
/// <returns>The redirect rules for the given web log ID</returns>
let redirectRules webLogId =
_redirectCache[webLogId]
/// Is the given theme in use by any web logs?
/// <summary>Is the given theme in use by any web logs?</summary>
/// <param name="themeId">The ID of the theme whose use should be checked</param>
/// <returns>True if any web logs are using the given theme, false if not</returns>
let isThemeInUse themeId =
_cache |> List.exists (fun wl -> wl.ThemeId = themeId)
/// A cache of page information needed to display the page list in templates
/// <summary>A cache of page information needed to display the page list in templates</summary>
module PageListCache =
open MyWebLog.ViewModels
@@ -128,32 +139,38 @@ module PageListCache =
/// Cache of displayed pages
let private _cache = ConcurrentDictionary<WebLogId, DisplayPage array>()
/// Fill the page list for the given web log
let private fillPages (webLog: WebLog) pages =
_cache[webLog.Id] <-
pages
|> List.map (fun pg -> DisplayPage.FromPage webLog { pg with Text = "" })
|> Array.ofList
/// Are there pages cached for this web log?
/// <summary>Are there pages cached for this web log?</summary>
/// <param name="ctx">The <c>HttpContext</c> for the current request</param>
/// <returns>True if the current web log has any pages cached, false if not</returns>
let exists (ctx: HttpContext) = _cache.ContainsKey ctx.WebLog.Id
/// Get the pages for the web log for this request
/// <summary>Get the pages for the web log for this request</summary>
/// <param name="ctx">The <c>HttpContext</c> for the current request</param>
/// <returns>The page list for the current web log</returns>
let get (ctx: HttpContext) = _cache[ctx.WebLog.Id]
/// Update the pages for the current web log
let update (ctx: HttpContext) = backgroundTask {
let! pages = ctx.Data.Page.FindListed ctx.WebLog.Id
fillPages ctx.WebLog pages
}
/// Refresh the pages for the given web log
/// <summary>Refresh the pages for the given web log</summary>
/// <param name="webLog">The web log for which pages should be refreshed</param>
/// <param name="data">The data implementation from which pages should be retrieved</param>
let refresh (webLog: WebLog) (data: IData) = backgroundTask {
let! pages = data.Page.FindListed webLog.Id
fillPages webLog pages
}
/// <summary>Update the pages for the current web log</summary>
/// <param name="ctx">The <c>HttpContext</c> for the current request</param>
let update (ctx: HttpContext) =
refresh ctx.WebLog ctx.Data
/// Cache of all categories, indexed by web log
/// <summary>Cache of all categories, indexed by web log</summary>
module CategoryCache =
open MyWebLog.ViewModels
@@ -161,41 +178,51 @@ module CategoryCache =
/// The cache itself
let private _cache = ConcurrentDictionary<WebLogId, DisplayCategory array>()
/// Are there categories cached for this web log?
/// <summary>Are there categories cached for this web log?</summary>
/// <param name="ctx">The <c>HttpContext</c> for the current request</param>
/// <returns>True if the current web logs has any categories cached, false if not</returns>
let exists (ctx: HttpContext) = _cache.ContainsKey ctx.WebLog.Id
/// Get the categories for the web log for this request
/// <summary>Get the categories for the web log for this request</summary>
/// <param name="ctx">The <c>HttpContext</c> for the current request</param>
/// <returns>The categories for the current web log</returns>
let get (ctx: HttpContext) = _cache[ctx.WebLog.Id]
/// Update the cache with fresh data
let update (ctx: HttpContext) = backgroundTask {
let! cats = ctx.Data.Category.FindAllForView ctx.WebLog.Id
_cache[ctx.WebLog.Id] <- cats
}
/// Refresh the category cache for the given web log
/// <summary>Refresh the category cache for the given web log</summary>
/// <param name="webLogId">The ID of the web log for which the cache should be refreshed</param>
/// <param name="data">The data implementation from which categories should be retrieved</param>
let refresh webLogId (data: IData) = backgroundTask {
let! cats = data.Category.FindAllForView webLogId
_cache[webLogId] <- cats
}
/// <summary>Update the cache with fresh data for the current web log</summary>
/// <param name="ctx">The <c>HttpContext</c> for the current request</param>
let update (ctx: HttpContext) =
refresh ctx.WebLog.Id ctx.Data
/// A cache of asset names by themes
/// <summary>A cache of asset names by themes</summary>
module ThemeAssetCache =
/// A list of asset names for each theme
let private _cache = ConcurrentDictionary<ThemeId, string list>()
/// Retrieve the assets for the given theme ID
/// <summary>Retrieve the assets for the given theme ID</summary>
/// <param name="themeId">The ID of the theme whose assets should be returned</param>
/// <returns>The assets for the given theme</returns>
let get themeId = _cache[themeId]
/// Refresh the list of assets for the given theme
/// <summary>Refresh the list of assets for the given theme</summary>
/// <param name="themeId">The ID of the theme whose assets should be refreshed</param>
/// <param name="data">The data implementation from which assets should be retrieved</param>
let refreshTheme themeId (data: IData) = backgroundTask {
let! assets = data.ThemeAsset.FindByTheme themeId
_cache[themeId] <- assets |> List.map (fun a -> match a.Id with ThemeAssetId (_, path) -> path)
}
/// Fill the theme asset cache
/// <summary>Fill the theme asset cache</summary>
/// <param name="data">The data implementation from which assets should be retrieved</param>
let fill (data: IData) = backgroundTask {
let! assets = data.ThemeAsset.All()
for asset in assets do
src/MyWebLog/MyWebLog.fsproj
+3 -3
View File
@@ -33,14 +33,14 @@
<ItemGroup>
<PackageReference Include="BitBadger.AspNetCore.CanonicalDomains" Version="1.1.0" />
<PackageReference Include="DotLiquid" Version="2.2.692" />
<PackageReference Include="Fluid.Core" Version="2.16.0" />
<PackageReference Include="Fluid.Core" Version="2.19.0" />
<PackageReference Include="Giraffe" Version="7.0.2" />
<PackageReference Include="Giraffe.Htmx" Version="2.0.4" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="2.0.4" />
<PackageReference Include="NeoSmart.Caching.Sqlite.AspNetCore" Version="9.0.0" />
<PackageReference Include="RethinkDB.DistributedCache" Version="1.0.0-rc1" />
<PackageReference Include="System.ServiceModel.Syndication" Version="9.0.0" />
<PackageReference Update="FSharp.Core" Version="9.0.100" />
<PackageReference Include="System.ServiceModel.Syndication" Version="9.0.1" />
<PackageReference Update="FSharp.Core" Version="9.0.101" />
</ItemGroup>
<ItemGroup>
src/MyWebLog/Template.fs
+78 -55
View File
@@ -1,3 +1,4 @@
/// <summary>Logic to work with Fluid templates</summary>
module MyWebLog.Template
open System
@@ -16,23 +17,29 @@ open MyWebLog.ViewModels
type VTask<'T> = System.Threading.Tasks.ValueTask<'T>
/// Extensions on Fluid's TemplateContext object
/// <summary>Extensions on Fluid's TemplateContext object</summary>
type TemplateContext with
/// Get the model of the context as an AppViewContext instance
/// <summary>Get the model of the context as an <tt>AppViewContext</tt> instance</summary>
member this.App =
this.Model.ToObjectValue() :?> AppViewContext
/// Helper functions for filters and tags
/// <summary>Helper functions for filters and tags</summary>
[<AutoOpen>]
module private Helpers =
/// Does an asset exist for the current theme?
/// <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)
/// Obtain the link from known types
/// <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())
@@ -47,16 +54,20 @@ module private Helpers =
| Some link -> linkFunc (Permalink link)
| None -> $"alert('unknown item type {item.Type}')"
/// Generate a link for theme asset (image, stylesheet, script, etc.)
/// <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()}")
/// Fluid template options customized with myWebLog filters
/// <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
@@ -69,10 +80,10 @@ let options () =
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 ->
@@ -84,7 +95,7 @@ let options () =
| 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 ->
@@ -96,7 +107,7 @@ let options () =
| 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 ->
@@ -108,7 +119,7 @@ let options () =
| 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 ->
@@ -127,10 +138,10 @@ let options () =
}
|> 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 ->
@@ -142,10 +153,10 @@ let options () =
| 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",
@@ -153,34 +164,34 @@ let options () =
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
if item.Name = name then Some item.Value else None
(input :?> ArrayValue).Values
|> Seq.tryPick picker
|> Option.defaultValue $"-- {name} not found --"
|> sValue)
it
/// Fluid parser customized with myWebLog filters and tags
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 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
@@ -190,37 +201,37 @@ let parser =
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 ->
@@ -232,7 +243,7 @@ let parser =
|> 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 ->
@@ -250,21 +261,27 @@ let parser =
}
|> Seq.iter writer.WriteLine
ok())
it
open MyWebLog.Data
/// Cache for parsed templates
/// <summary>Cache for parsed templates</summary>
module Cache =
open System.Collections.Concurrent
/// Cache of parsed templates
let private _cache = ConcurrentDictionary<string, IFluidTemplate> ()
/// Get a template for the given theme and template name
/// <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
@@ -280,32 +297,34 @@ module Cache =
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
/// <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
/// Invalidate all template cache entries for the given theme ID
/// <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 _, _ -> ())
/// Remove all entries from the template cache
/// <summary>Remove all entries from the template cache</summary>
let empty () =
_cache.Clear()
/// A file provider to retrieve files by theme
/// <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 ->
@@ -322,12 +341,16 @@ type ThemeFileProvider(themeId: ThemeId, data: IData) =
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"
/// Render a template to a string
/// <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)
src/MyWebLog/ViewContext.fs
+68 -66
View File
@@ -1,102 +1,104 @@
/// View rendering context for myWebLog
/// <summary>View rendering context for myWebLog</summary>
[<AutoOpen>]
module MyWebLog.ViewContext
open Microsoft.AspNetCore.Antiforgery
open MyWebLog.ViewModels
/// The rendering context for this application
/// <summary>The rendering context for this application</summary>
[<NoComparison; NoEquality>]
type AppViewContext = {
/// The web log for this request
/// <summary>The web log for this request</summary>
WebLog: WebLog
/// The ID of the current user
/// <summary>The ID of the current user</summary>
UserId: WebLogUserId option
/// The title of the page being rendered
/// <summary>The title of the page being rendered</summary>
PageTitle: string
/// The subtitle for the page
/// <summary>The subtitle for the page</summary>
Subtitle: string option
/// The anti-Cross Site Request Forgery (CSRF) token set to use when rendering a form
/// <summary>The anti-Cross Site Request Forgery (CSRF) token set to use when rendering a form</summary>
Csrf: AntiforgeryTokenSet option
/// The page list for the web log
/// <summary>The page list for the web log</summary>
PageList: DisplayPage array
/// Categories and post counts for the web log
/// <summary>Categories and post counts for the web log</summary>
Categories: DisplayCategory array
/// Tag mappings
/// <summary>Tag mappings</summary>
TagMappings: TagMap array
/// The URL of the page being rendered
/// <summary>The URL of the page being rendered</summary>
CurrentPage: string
/// User messages
/// <summary>User messages</summary>
Messages: UserMessage array
/// The generator string for the rendered page
/// <summary>The generator string for the rendered page</summary>
Generator: string
/// The payload for this page (see other properties that wrap this one)
/// <summary>The payload for this page (see other properties that wrap this one)</summary>
Payload: obj
/// The content of a page (wrapped when rendering the layout)
/// <summary>The content of a page (wrapped when rendering the layout)</summary>
Content: string
/// A string to load the minified htmx script
/// <summary>A string to load the minified htmx script</summary>
HtmxScript: string
/// Whether the current user is an author
/// <summary>Whether the current user is an author</summary>
IsAuthor: bool
/// Whether the current user is an editor (implies author)
/// <summary>Whether the current user is an editor (implies author)</summary>
IsEditor: bool
/// Whether the current user is a web log administrator (implies author and editor)
/// <summary>Whether the current user is a web log administrator (implies author and editor)</summary>
IsWebLogAdmin: bool
/// Whether the current user is an installation administrator (implies all web log rights)
/// <summary>Whether the current user is an installation administrator (implies all web log rights)</summary>
IsAdministrator: bool
/// Whether the current page is the home page of the web log
/// <summary>Whether the current page is the home page of the web log</summary>
IsHome: bool
/// Whether the current page is a category archive page
/// <summary>Whether the current page is a category archive page</summary>
IsCategory: bool
/// Whether the current page is a category archive home page
/// <summary>Whether the current page is a category archive home page</summary>
IsCategoryHome: bool
/// Whether the current page is a tag archive page
/// <summary>Whether the current page is a tag archive page</summary>
IsTag: bool
/// Whether the current page is a tag archive home page
/// <summary>Whether the current page is a tag archive home page</summary>
IsTagHome: bool
/// Whether the current page is a single post
/// <summary>Whether the current page is a single post</summary>
IsPost: bool
/// Whether the current page is a static page
/// <summary>Whether the current page is a static page</summary>
IsPage: bool
/// The slug for a category or tag
Slug: string option }
with
/// Whether there is a user logged on
/// <summary>The slug for a category or tag</summary>
Slug: string option
} with
/// <summary>Whether there is a user logged on</summary>
member this.IsLoggedOn = Option.isSome this.UserId
/// <summary>The payload for this page as a <c>DisplayPage</c></summary>
member this.Page =
this.Payload :?> DisplayPage
/// <summary>The payload for this page as a <c>PostDisplay</c></summary>
member this.Posts =
this.Payload :?> PostDisplay
/// An empty view context
/// <summary>An empty view context</summary>
static member Empty =
{ WebLog = WebLog.Empty
UserId = None
@@ -105,21 +107,21 @@ with
Csrf = None
PageList = [||]
Categories = [||]
TagMappings = [||]
TagMappings = [||]
CurrentPage = ""
Messages = [||]
Generator = ""
Payload = obj ()
Content = ""
Payload = obj ()
Content = ""
HtmxScript = ""
IsAuthor = false
IsEditor = false
IsWebLogAdmin = false
IsAdministrator = false
IsHome = false
IsCategory = false
IsCategory = false
IsCategoryHome = false
IsTag = false
IsTag = false
IsTagHome = false
IsPost = false
IsPage = false
src/MyWebLog/Views/Admin.fs
+5 -2
View File
@@ -6,7 +6,10 @@ open Giraffe.ViewEngine.Htmx
open MyWebLog
open MyWebLog.ViewModels
/// The administrator dashboard
/// <summary>The administrator dashboard</summary>
/// <param name="themes">The themes to display</param>
/// <param name="app">The view context</param>
/// <returns>The admin dashboard view</returns>
let dashboard (themes: Theme list) app = [
let templates = Template.Cache.allNames ()
let cacheBaseUrl = relUrl app "admin/cache/"
@@ -55,7 +58,7 @@ let dashboard (themes: Theme list) app = [
]
div [ _class "row" ] [
div [ _class "col-12 col-lg-6 pb-3" ] [
div [ _class "card" ] [
div [ _class "card" ] [
header [ _class "card-header text-white bg-secondary" ] [ raw "Web Logs" ]
div [ _class "card-body pb-0" ] [
h6 [ _class "card-subtitle text-muted pb-3" ] [
src/MyWebLog/Views/Helpers.fs
+131 -38
View File
@@ -1,3 +1,4 @@
/// <summary>Helpers available for all myWebLog views</summary>
[<AutoOpen>]
module MyWebLog.Views.Helpers
@@ -9,28 +10,35 @@ open MyWebLog.ViewModels
open NodaTime
open NodaTime.Text
/// Create a relative URL for the current web log
/// <summary>Create a relative URL for the current web log</summary>
/// <param name="app">The app view context for the current view</param>
/// <returns>A function that, given a string, will construct a relative URL</returns>
let relUrl app =
Permalink >> app.WebLog.RelativeUrl
/// Add a hidden input with the anti-Cross Site Request Forgery (CSRF) token
/// <summary>Create a hidden input with the anti-Cross Site Request Forgery (CSRF) token</summary>
/// <param name="app">The app view context for the current view</param>
/// <returns>A hidden input with the CSRF token value</returns>
let antiCsrf app =
input [ _type "hidden"; _name app.Csrf.Value.FormFieldName; _value app.Csrf.Value.RequestToken ]
/// Shorthand for encoded text in a template
/// <summary>Shorthand for encoded text in a template</summary>
let txt = encodedText
/// Shorthand for raw text in a template
/// <summary>Shorthand for raw text in a template</summary>
let raw = rawText
/// Rel attribute to prevent opener information from being provided to the new window
/// <summary><c>rel</c> attribute to prevent opener information from being provided to the new window</summary>
let _relNoOpener = _rel "noopener"
/// The pattern for a long date
/// <summary>The pattern for a long date</summary>
let longDatePattern =
ZonedDateTimePattern.CreateWithInvariantCulture("MMMM d, yyyy", DateTimeZoneProviders.Tzdb)
/// Create a long date
/// <summary>Create a long date</summary>
/// <param name="app">The app view context for the current view</param>
/// <param name="instant">The instant from which a localized long date should be produced</param>
/// <returns>A text node with the long date</returns>
let longDate app (instant: Instant) =
DateTimeZoneProviders.Tzdb[app.WebLog.TimeZone]
|> Option.ofObj
@@ -38,11 +46,14 @@ let longDate app (instant: Instant) =
|> Option.defaultValue "--"
|> txt
/// The pattern for a short time
/// <summary>The pattern for a short time</summary>
let shortTimePattern =
ZonedDateTimePattern.CreateWithInvariantCulture("h:mmtt", DateTimeZoneProviders.Tzdb)
/// Create a short time
/// <summary>Create a short time</summary>
/// <param name="app">The app view context for the current view</param>
/// <param name="instant">The instant from which a localized short date should be produced</param>
/// <returns>A text node with the short date</returns>
let shortTime app (instant: Instant) =
DateTimeZoneProviders.Tzdb[app.WebLog.TimeZone]
|> Option.ofObj
@@ -50,11 +61,19 @@ let shortTime app (instant: Instant) =
|> Option.defaultValue "--"
|> txt
/// Display "Yes" or "No" based on the state of a boolean value
/// <summary>Display "Yes" or "No" based on the state of a boolean value</summary>
/// <param name="value">The true/false value</param>
/// <returns>A text node with <c>Yes</c> if true, <c>No</c> if false</returns>
let yesOrNo value =
raw (if value then "Yes" else "No")
/// Extract an attribute value from a list of attributes, remove that attribute if it is found
/// <summary>Extract an attribute value from a list of attributes, remove that attribute if it is found</summary>
/// <param name="name">The name of the attribute to be extracted and removed</param>
/// <param name="attrs">The list of attributes to be searched</param>
/// <returns>
/// A tuple with <c>fst</c> being <c>Some</c> with the attribute if found, <c>None</c> if not; and <c>snd</c>
/// being the list of attributes with the extracted one removed
/// </returns>
let extractAttrValue name attrs =
let valueAttr = attrs |> List.tryFind (fun x -> match x with KeyValue (key, _) when key = name -> true | _ -> false)
match valueAttr with
@@ -62,8 +81,15 @@ let extractAttrValue name attrs =
Some value,
attrs |> List.filter (fun x -> match x with KeyValue (key, _) when key = name -> false | _ -> true)
| Some _ | None -> None, attrs
/// Create a text input field
/// <summary>Create a text input field</summary>
/// <param name="fieldType">The <c>input</c> field type</param>
/// <param name="attrs">Attributes for the field</param>
/// <param name="name">The name of the input field</param>
/// <param name="labelText">The text of the <c>label</c> element associated with this <c>input</c></param>
/// <param name="value">The value of the <c>input</c> field</param>
/// <param name="extra">Any extra elements to include after the <c>input</c> and <c>label</c></param>
/// <returns>A <c>div</c> element with the <c>input</c> field constructed</returns>
let inputField fieldType attrs name labelText value extra =
let fieldId, attrs = extractAttrValue "id" attrs
let cssClass, attrs = extractAttrValue "class" attrs
@@ -76,23 +102,58 @@ let inputField fieldType attrs name labelText value extra =
yield! extra
]
/// Create a text input field
/// <summary>Create a text input field</summary>
/// <param name="attrs">Attributes for the field</param>
/// <param name="name">The name of the input field</param>
/// <param name="labelText">The text of the <c>label</c> element associated with this <c>input</c></param>
/// <param name="value">The value of the <c>input</c> field</param>
/// <param name="extra">Any extra elements to include after the <c>input</c> and <c>label</c></param>
/// <returns>A <c>div</c> element with the &lt;input type=text&gt; field constructed</returns>
let textField attrs name labelText value extra =
inputField "text" attrs name labelText value extra
/// Create a number input field
/// <summary>Create a number input field</summary>
/// <param name="attrs">Attributes for the field</param>
/// <param name="name">The name of the input field</param>
/// <param name="labelText">The text of the <c>label</c> element associated with this <c>input</c></param>
/// <param name="value">The value of the <c>input</c> field</param>
/// <param name="extra">Any extra elements to include after the <c>input</c> and <c>label</c></param>
/// <returns>A <c>div</c> element with the &lt;input type=number&gt; field constructed</returns>
let numberField attrs name labelText value extra =
inputField "number" attrs name labelText value extra
/// Create an e-mail input field
/// <summary>Create an e-mail input field</summary>
/// <param name="attrs">Attributes for the field</param>
/// <param name="name">The name of the input field</param>
/// <param name="labelText">The text of the <c>label</c> element associated with this <c>input</c></param>
/// <param name="value">The value of the <c>input</c> field</param>
/// <param name="extra">Any extra elements to include after the <c>input</c> and <c>label</c></param>
/// <returns>A <c>div</c> element with the &lt;input type=email&gt; field constructed</returns>
let emailField attrs name labelText value extra =
inputField "email" attrs name labelText value extra
/// Create a password input field
/// <summary>Create a password input field</summary>
/// <param name="attrs">Attributes for the field</param>
/// <param name="name">The name of the input field</param>
/// <param name="labelText">The text of the <c>label</c> element associated with this <c>input</c></param>
/// <param name="value">The value of the <c>input</c> field</param>
/// <param name="extra">Any extra elements to include after the <c>input</c> and <c>label</c></param>
/// <returns>A <c>div</c> element with the &lt;input type=password&gt; field constructed</returns>
let passwordField attrs name labelText value extra =
inputField "password" attrs name labelText value extra
/// Create a select (dropdown) field
/// <summary>Create a select (dropdown) field</summary>
/// <typeparam name="T">The type of value in the backing list</typeparam>
/// <typeparam name="a">The type of the <c>value</c> attribute</typeparam>
/// <param name="attrs">Attributes for the field</param>
/// <param name="name">The name of the input field</param>
/// <param name="labelText">The text of the <c>label</c> element associated with this <c>input</c></param>
/// <param name="value">The value of the <c>input</c> field</param>
/// <param name="values">The backing list for this dropdown</param>
/// <param name="idFunc">The function to extract the ID (<c>value</c> attribute)</param>
/// <param name="displayFunc">The function to extract the displayed version of the item</param>
/// <param name="extra">Any extra elements to include after the <c>input</c> and <c>label</c></param>
/// <returns>A <c>div</c> element with the &lt;select&gt; field constructed</returns>
let selectField<'T, 'a>
attrs name labelText value (values: 'T seq) (idFunc: 'T -> 'a) (displayFunc: 'T -> string) extra =
let cssClass, attrs = extractAttrValue "class" attrs
@@ -106,7 +167,13 @@ let selectField<'T, 'a>
yield! extra
]
/// Create a checkbox input styled as a switch
/// <summary>Create a checkbox input styled as a switch</summary>
/// <param name="attrs">Attributes for the field</param>
/// <param name="name">The name of the input field</param>
/// <param name="labelText">The text of the <c>label</c> element associated with this <c>input</c></param>
/// <param name="value">Whether the checkbox should be checked or not</param>
/// <param name="extra">Any extra elements to include after the <c>input</c> and <c>label</c></param>
/// <returns>A <c>div</c> element with the switch-style &lt;input type=checkbox&gt; field constructed</returns>
let checkboxSwitch attrs name labelText (value: bool) extra =
let cssClass, attrs = extractAttrValue "class" attrs
div [ _class $"""form-check form-switch {defaultArg cssClass ""}""" ] [
@@ -117,17 +184,17 @@ let checkboxSwitch attrs name labelText (value: bool) extra =
yield! extra
]
/// A standard save button
/// <summary>A standard save button</summary>
let saveButton =
button [ _type "submit"; _class "btn btn-sm btn-primary" ] [ raw "Save Changes" ]
/// A spacer bullet to use between action links
/// <summary>A spacer bullet to use between action links</summary>
let actionSpacer =
span [ _class "text-muted" ] [ raw " &bull; " ]
/// Functions for generating content in varying layouts
/// <summary>Functions for generating content in varying layouts</summary>
module Layout =
/// Generate the title tag for a page
let private titleTag (app: AppViewContext) =
title [] [ txt app.PageTitle; raw " &laquo; Admin &laquo; "; txt app.WebLog.Name ]
@@ -221,15 +288,21 @@ module Layout =
]
]
]
/// Render a page with a partial layout (htmx request)
/// <summary>Render a page with a partial layout (htmx request)</summary>
/// <param name="content">A function that, when given a view context, will return a view</param>
/// <param name="app">The app view context to use when rendering the view</param>
/// <returns>A constructed Giraffe View Engine view</returns>
let partial content app =
html [ _lang "en" ] [
titleTag app
yield! pageView content app
]
/// Render a page with a full layout
/// <summary>Render a page with a full layout</summary>
/// <param name="content">A function that, when given a view context, will return a view</param>
/// <param name="app">The app view context to use when rendering the view</param>
/// <returns>A constructed Giraffe View Engine view</returns>
let full content app =
html [ _lang "en" ] [
meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ]
@@ -248,8 +321,11 @@ module Layout =
script [ _src (relUrl app "themes/admin/admin.js") ] []
]
]
/// Render a bare layout
/// <summary>Render a bare layout</summary>
/// <param name="content">A function that, when given a view context, will return a view</param>
/// <param name="app">The app view context to use when rendering the view</param>
/// <returns>A constructed Giraffe View Engine view</returns>
let bare (content: AppViewContext -> XmlNode list) app =
html [ _lang "en" ] [
title [] []
@@ -260,14 +336,17 @@ module Layout =
// ~~ SHARED TEMPLATES BETWEEN POSTS AND PAGES
open Giraffe.Htmx.Common
/// The round-trip instant pattern
/// <summary>The round-trip instant pattern</summary>
let roundTrip = InstantPattern.CreateWithInvariantCulture "uuuu'-'MM'-'dd'T'HH':'mm':'ss'.'fffffff"
/// Capitalize the first letter in the given string
let private capitalize (it: string) =
$"{(string it[0]).ToUpper()}{it[1..]}"
/// The common edit form shared by pages and posts
/// <summary>The common edit form shared by pages and posts</summary>
/// <param name="model">The model to use to render this view</param>
/// <param name="app">The app view context to use to render this view</param>
/// <returns>A common edit view</returns>
let commonEdit (model: EditCommonModel) app = [
textField [ _class "mb-3"; _required; _autofocus ] (nameof model.Title) "Title" model.Title []
textField [ _class "mb-3"; _required ] (nameof model.Permalink) "Permalink" model.Permalink [
@@ -301,13 +380,18 @@ let commonEdit (model: EditCommonModel) app = [
]
/// Display a common template list
/// <summary>Display a common template list</summary>
/// <param name="model">The edit model</param>
/// <param name="templates">A list of available templates for this page or post</param>
/// <returns>A &lt;select&gt; element to allow a template to be selected</returns>
let commonTemplates (model: EditCommonModel) (templates: MetaItem seq) =
selectField [ _class "mb-3" ] (nameof model.Template) $"{capitalize model.Entity} Template" model.Template templates
(_.Name) (_.Value) []
_.Name _.Value []
/// Display the metadata item edit form
/// <summary>Display the metadata item edit form</summary>
/// <param name="model">The edit model</param>
/// <returns>A form for editing metadata</returns>
let commonMetaItems (model: EditCommonModel) =
let items = Array.zip model.MetaNames model.MetaValues
let metaDetail idx (name, value) =
@@ -320,7 +404,7 @@ let commonMetaItems (model: EditCommonModel) =
div [ _class "col-3" ] [ textField [ _id $"MetaNames_{idx}" ] (nameof model.MetaNames) "Name" name [] ]
div [ _class "col-8" ] [ textField [ _id $"MetaValues_{idx}" ] (nameof model.MetaValues) "Value" value [] ]
]
fieldset [] [
legend [] [
raw "Metadata "
@@ -342,7 +426,10 @@ let commonMetaItems (model: EditCommonModel) =
]
/// Revision preview template
/// <summary>Revision preview template</summary>
/// <param name="rev">The revision to preview</param>
/// <param name="app">The app view context to use when rendering the preview</param>
/// <returns>A view with a revision preview</returns>
let commonPreview (rev: Revision) app =
div [ _class "mwl-revision-preview mb-3" ] [
rev.Text.AsHtml() |> addBaseToRelativeUrls app.WebLog.ExtraPath |> raw
@@ -350,7 +437,10 @@ let commonPreview (rev: Revision) app =
|> List.singleton
/// Form to manage permalinks for pages or posts
/// <summary>Form to manage permalinks for pages or posts</summary>
/// <param name="model">The manage permalinks model to be rendered</param>
/// <param name="app">The app view context to use when rendering this view</param>
/// <returns>A view for managing permalinks for a page or post</returns>
let managePermalinks (model: ManagePermalinksModel) app = [
let baseUrl = relUrl app $"admin/{model.Entity}/"
let linkDetail idx link =
@@ -414,7 +504,10 @@ let managePermalinks (model: ManagePermalinksModel) app = [
]
]
/// Form to manage revisions for pages or posts
/// <summary>Form to manage revisions for pages or posts</summary>
/// <param name="model">The manage revisions model to be rendered</param>
/// <param name="app">The app view context to use when rendering this view</param>
/// <returns>A view for managing revisions for a page or post</returns>
let manageRevisions (model: ManageRevisionsModel) app = [
let revUrlBase = relUrl app $"admin/{model.Entity}/{model.Id}/revision"
let revDetail idx (rev: Revision) =