bit-badger/myWebLog
1
0
Fork 0
Code Issues 4 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/Directory.Build.props
View File

@ -2,6 +2,7 @@
<PropertyGroup>
<TargetFrameworks>net8.0;net9.0</TargetFrameworks>
<DebugType>embedded</DebugType>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
<AssemblyVersion>3.0.0.0</AssemblyVersion>
<FileVersion>3.0.0.0</FileVersion>
<Version>3.0.0</Version>

31
src/MyWebLog.Data/Converters.fs
View File

@ -1,14 +1,15 @@
/// Converters for discriminated union types
/// <summary>Converters for discriminated union types</summary>
module MyWebLog.Converters
open MyWebLog
open System
/// JSON.NET converters for discriminated union types
/// <summary>JSON.NET converters for discriminated union types</summary>
module Json =
open Newtonsoft.Json
/// <summary>Converter for the <see cref="CategoryId" /> type</summary>
type CategoryIdConverter() =
inherit JsonConverter<CategoryId>()
override _.WriteJson(writer: JsonWriter, value: CategoryId, _: JsonSerializer) =
@ -16,6 +17,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: CategoryId, _: bool, _: JsonSerializer) =
(string >> CategoryId) reader.Value
/// <summary>Converter for the <see cref="CommentId" /> type</summary>
type CommentIdConverter() =
inherit JsonConverter<CommentId>()
override _.WriteJson(writer: JsonWriter, value: CommentId, _: JsonSerializer) =
@ -23,6 +25,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: CommentId, _: bool, _: JsonSerializer) =
(string >> CommentId) reader.Value
/// <summary>Converter for the <see cref="CommentStatus" /> type</summary>
type CommentStatusConverter() =
inherit JsonConverter<CommentStatus>()
override _.WriteJson(writer: JsonWriter, value: CommentStatus, _: JsonSerializer) =
@ -30,6 +33,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: CommentStatus, _: bool, _: JsonSerializer) =
(string >> CommentStatus.Parse) reader.Value
/// <summary>Converter for the <see cref="CustomFeedId" /> type</summary>
type CustomFeedIdConverter() =
inherit JsonConverter<CustomFeedId>()
override _.WriteJson(writer: JsonWriter, value: CustomFeedId, _: JsonSerializer) =
@ -37,6 +41,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: CustomFeedId, _: bool, _: JsonSerializer) =
(string >> CustomFeedId) reader.Value
/// <summary>Converter for the <see cref="CustomFeedSource" /> type</summary>
type CustomFeedSourceConverter() =
inherit JsonConverter<CustomFeedSource>()
override _.WriteJson(writer: JsonWriter, value: CustomFeedSource, _: JsonSerializer) =
@ -44,6 +49,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: CustomFeedSource, _: bool, _: JsonSerializer) =
(string >> CustomFeedSource.Parse) reader.Value
/// <summary>Converter for the <see cref="ExplicitRating" /> type</summary>
type ExplicitRatingConverter() =
inherit JsonConverter<ExplicitRating>()
override _.WriteJson(writer: JsonWriter, value: ExplicitRating, _: JsonSerializer) =
@ -51,6 +57,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: ExplicitRating, _: bool, _: JsonSerializer) =
(string >> ExplicitRating.Parse) reader.Value
/// <summary>Converter for the <see cref="MarkupText" /> type</summary>
type MarkupTextConverter() =
inherit JsonConverter<MarkupText>()
override _.WriteJson(writer: JsonWriter, value: MarkupText, _: JsonSerializer) =
@ -58,6 +65,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: MarkupText, _: bool, _: JsonSerializer) =
(string >> MarkupText.Parse) reader.Value
/// <summary>Converter for the <see cref="Permalink" /> type</summary>
type PermalinkConverter() =
inherit JsonConverter<Permalink>()
override _.WriteJson(writer: JsonWriter, value: Permalink, _: JsonSerializer) =
@ -65,6 +73,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: Permalink, _: bool, _: JsonSerializer) =
(string >> Permalink) reader.Value
/// <summary>Converter for the <see cref="PageId" /> type</summary>
type PageIdConverter() =
inherit JsonConverter<PageId>()
override _.WriteJson(writer: JsonWriter, value: PageId, _: JsonSerializer) =
@ -72,6 +81,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: PageId, _: bool, _: JsonSerializer) =
(string >> PageId) reader.Value
/// <summary>Converter for the <see cref="PodcastMedium" /> type</summary>
type PodcastMediumConverter() =
inherit JsonConverter<PodcastMedium>()
override _.WriteJson(writer: JsonWriter, value: PodcastMedium, _: JsonSerializer) =
@ -79,6 +89,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: PodcastMedium, _: bool, _: JsonSerializer) =
(string >> PodcastMedium.Parse) reader.Value
/// <summary>Converter for the <see cref="PostId" /> type</summary>
type PostIdConverter() =
inherit JsonConverter<PostId>()
override _.WriteJson(writer: JsonWriter, value: PostId, _: JsonSerializer) =
@ -86,6 +97,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: PostId, _: bool, _: JsonSerializer) =
(string >> PostId) reader.Value
/// <summary>Converter for the <see cref="TagMapId" /> type</summary>
type TagMapIdConverter() =
inherit JsonConverter<TagMapId>()
override _.WriteJson(writer: JsonWriter, value: TagMapId, _: JsonSerializer) =
@ -93,6 +105,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: TagMapId, _: bool, _: JsonSerializer) =
(string >> TagMapId) reader.Value
/// <summary>Converter for the <see cref="ThemeAssetId" /> type</summary>
type ThemeAssetIdConverter() =
inherit JsonConverter<ThemeAssetId>()
override _.WriteJson(writer: JsonWriter, value: ThemeAssetId, _: JsonSerializer) =
@ -100,6 +113,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: ThemeAssetId, _: bool, _: JsonSerializer) =
(string >> ThemeAssetId.Parse) reader.Value
/// <summary>Converter for the <see cref="ThemeId" /> type</summary>
type ThemeIdConverter() =
inherit JsonConverter<ThemeId>()
override _.WriteJson(writer: JsonWriter, value: ThemeId, _: JsonSerializer) =
@ -107,6 +121,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: ThemeId, _: bool, _: JsonSerializer) =
(string >> ThemeId) reader.Value
/// <summary>Converter for the <see cref="UploadId" /> type</summary>
type UploadIdConverter() =
inherit JsonConverter<UploadId>()
override _.WriteJson(writer: JsonWriter, value: UploadId, _: JsonSerializer) =
@ -114,6 +129,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: UploadId, _: bool, _: JsonSerializer) =
(string >> UploadId) reader.Value
/// <summary>Converter for the <see cref="WebLogId" /> type</summary>
type WebLogIdConverter() =
inherit JsonConverter<WebLogId>()
override _.WriteJson(writer: JsonWriter, value: WebLogId, _: JsonSerializer) =
@ -121,6 +137,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: WebLogId, _: bool, _: JsonSerializer) =
(string >> WebLogId) reader.Value
/// <summary>Converter for the <see cref="WebLogUserId" /> type</summary>
type WebLogUserIdConverter() =
inherit JsonConverter<WebLogUserId> ()
override _.WriteJson(writer: JsonWriter, value: WebLogUserId, _: JsonSerializer) =
@ -132,8 +149,8 @@ module Json =
open NodaTime
open NodaTime.Serialization.JsonNet
/// Configure a serializer to use these converters
let configure (ser : JsonSerializer) =
/// <summary>Configure a serializer to use these converters (and other settings)</summary>
let configure (ser: JsonSerializer) =
// Our converters
[ CategoryIdConverter() :> JsonConverter
CommentIdConverter()
@ -164,8 +181,10 @@ module Json =
/// Serializer settings extracted from a JsonSerializer (a property sure would be nice...)
let mutable private serializerSettings : JsonSerializerSettings option = None
/// Extract settings from the serializer to be used in JsonConvert calls
let settings (ser : JsonSerializer) =
/// <summary>Extract settings from the serializer to be used in <c>JsonConvert</c> calls</summary>
/// <param name="ser">The serializer from which settings will be extracted if required</param>
/// <returns>The serializer settings to use for <c>JsonConvert</c> calls</returns>
let settings (ser: JsonSerializer) =
if Option.isNone serializerSettings then
serializerSettings <- JsonSerializerSettings (
ConstructorHandling = ser.ConstructorHandling,

14
src/MyWebLog.Data/MyWebLog.Data.fsproj
View File

@ -5,17 +5,17 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="BitBadger.Documents.Postgres" Version="4.0.0" />
<PackageReference Include="BitBadger.Documents.Sqlite" Version="4.0.0" />
<PackageReference Include="Microsoft.Data.Sqlite" Version="9.0.0" />
<PackageReference Include="Microsoft.Extensions.Caching.Abstractions" Version="9.0.0" />
<PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="9.0.0" />
<PackageReference Include="BitBadger.Documents.Postgres" Version="4.0.1" />
<PackageReference Include="BitBadger.Documents.Sqlite" Version="4.0.1" />
<PackageReference Include="Microsoft.Data.Sqlite" Version="9.0.1" />
<PackageReference Include="Microsoft.Extensions.Caching.Abstractions" Version="9.0.1" />
<PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="9.0.1" />
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
<PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.1.0" />
<PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.2.0" />
<PackageReference Include="Npgsql.NodaTime" Version="9.0.2" />
<PackageReference Include="RethinkDb.Driver" Version="2.3.150" />
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-07" />
<PackageReference Update="FSharp.Core" Version="9.0.100" />
<PackageReference Update="FSharp.Core" Version="9.0.101" />
</ItemGroup>
<ItemGroup>

55
src/MyWebLog.Data/Utils.fs
View File

@ -1,11 +1,16 @@
/// Utility functions for manipulating data
/// <summary>Utility functions for manipulating data</summary>
[<RequireQualifiedAccess>]
module internal MyWebLog.Data.Utils
open MyWebLog
open MyWebLog.ViewModels
/// Create a category hierarchy from the given list of categories
/// <summary>Create a category hierarchy from the given list of categories</summary>
/// <param name="cats">The categories from which the list should be generated</param>
/// <param name="parentId">The ID of the parent category for this list</param>
/// <param name="slugBase">The base URL to use in slugs for categories at this level</param>
/// <param name="parentNames">The names of parent categories for this level</param>
/// <returns>An array of <c>DisplayCategory</c> instances sorted alphabetically by parent category</returns>
let rec orderByHierarchy (cats: Category list) parentId slugBase parentNames = seq {
for cat in cats |> List.filter (fun c -> c.ParentId = parentId) do
let fullSlug = (match slugBase with Some it -> $"{it}/" | None -> "") + cat.Slug
@ -19,48 +24,75 @@ let rec orderByHierarchy (cats: Category list) parentId slugBase parentNames = s
yield! orderByHierarchy cats (Some cat.Id) (Some fullSlug) ([ cat.Name ] |> List.append parentNames)
}
/// Get lists of items removed from and added to the given lists
/// <summary>Get lists of items removed from and added to the given lists</summary>
/// <typeparam name="T">The type of items in the list</typeparam>
/// <typeparam name="U">The return type of the comparision function</typeparam>
/// <param name="oldItems">The prior list</param>
/// <param name="newItems">The current list</param>
/// <param name="f">The function to use when comparing items in the list</param>
/// <returns>A tuple with <c>fst</c> being added items and <c>snd</c> being removed items</returns>
let diffLists<'T, 'U when 'U: equality> oldItems newItems (f: 'T -> 'U) =
let diff compList = fun item -> not (compList |> List.exists (fun other -> f item = f other))
List.filter (diff newItems) oldItems, List.filter (diff oldItems) newItems
/// Find the revisions added and removed
/// <summary>Find the revisions added and removed</summary>
/// <param name="oldRevs">The previous revisions</param>
/// <param name="newRevs">The current revisions</param>
/// <returns>A tuple with <c>fst</c> being added revisions and <c>snd</c> being removed revisions</returns>
let diffRevisions (oldRevs: Revision list) newRevs =
diffLists oldRevs newRevs (fun rev -> $"{rev.AsOf.ToUnixTimeTicks()}|{rev.Text}")
open MyWebLog.Converters
open Newtonsoft.Json
/// Serialize an object to JSON
/// <summary>Serialize an object to JSON</summary>
/// <typeparam name="T">The type of the item being serialized</typeparam>
/// <param name="ser">The JSON serializer whose settings should be used</param>
/// <param name="item">The item to be serialized</param>
/// <returns>A string with the given object serialized to JSON</returns>
let serialize<'T> ser (item: 'T) =
JsonConvert.SerializeObject(item, Json.settings ser)
/// Deserialize a JSON string
/// <summary>Deserialize a JSON string</summary>
/// <typeparam name="T">The type of the item being deserialized</typeparam>
/// <param name="ser">The JSON serializer whose settings should be used</param>
/// <param name="value">The string with the JSON representation of the item</param>
/// <returns>The item deserialized from JSON</returns>
let deserialize<'T> (ser: JsonSerializer) value =
JsonConvert.DeserializeObject<'T>(value, Json.settings ser)
open BitBadger.Documents
/// Create a document serializer using the given JsonSerializer
/// <summary>Create a document serializer using the given JsonSerializer</summary>
/// <param name="ser">The JSON.NET serializer on which the document serializer should be based</param>
/// <returns>A document serializer instance</returns>
let createDocumentSerializer ser =
{ new IDocumentSerializer with
member _.Serialize<'T>(it: 'T) : string = serialize ser it
member _.Deserialize<'T>(it: string) : 'T = deserialize ser it
}
/// Data migration utilities
/// <summary>Data migration utilities</summary>
module Migration =
open Microsoft.Extensions.Logging
/// The current database version
/// <summary>The current database version</summary>
let currentDbVersion = "v2.2"
/// Log a migration step
/// <summary>Log a migration step</summary>
/// <param name="log">The logger to which the message should be logged</param>
/// <param name="migration">The migration being run</param>
/// <param name="message">The log message</param>
let logStep<'T> (log: ILogger<'T>) migration message =
log.LogInformation $"Migrating %s{migration}: %s{message}"
/// Notify the user that a backup/restore
/// <summary>Notify the user that a backup/restore is required to migrate</summary>
/// <param name="log">The logger to which the message should be logged</param>
/// <param name="oldVersion">The old (current) version of the database</param>
/// <param name="newVersion">The new (application) version required</param>
/// <param name="webLogs">All web logs contained in the database</param>
let backupAndRestoreRequired log oldVersion newVersion webLogs =
logStep log $"%s{oldVersion} to %s{newVersion}" "Requires Using Action"
@ -77,4 +109,3 @@ module Migration =
log.LogCritical "myWebLog will now exit"
exit 1 |> ignore

224
src/MyWebLog.Domain/DataTypes.fs
View File

@ -3,29 +3,29 @@
open MyWebLog
open NodaTime
/// A category under which a post may be identified
/// <summary>A category under which a post may be identified</summary>
[<CLIMutable; NoComparison; NoEquality>]
type Category = {
/// The ID of the category
/// <summary>The ID of the category</summary>
Id: CategoryId
/// The ID of the web log to which the category belongs
/// <summary>The ID of the web log to which the category belongs</summary>
WebLogId: WebLogId
/// The displayed name
/// <summary>The displayed name</summary>
Name: string
/// The slug (used in category URLs)
/// <summary>The slug (used in category URLs)</summary>
Slug: string
/// A longer description of the category
/// <summary>A longer description of the category</summary>
Description: string option
/// The parent ID of this category (if a subcategory)
/// <summary>The parent ID of this category (if a subcategory)</summary>
ParentId: CategoryId option
} with
/// An empty category
/// <summary>An empty category</summary>
static member Empty =
{ Id = CategoryId.Empty
WebLogId = WebLogId.Empty
@ -35,38 +35,38 @@ type Category = {
ParentId = None }
/// A comment on a post
/// <summary>A comment on a post</summary>
[<CLIMutable; NoComparison; NoEquality>]
type Comment = {
/// The ID of the comment
/// <summary>The ID of the comment</summary>
Id: CommentId
/// The ID of the post to which this comment applies
/// <summary>The ID of the post to which this comment applies</summary>
PostId: PostId
/// The ID of the comment to which this comment is a reply
/// <summary>The ID of the comment to which this comment is a reply</summary>
InReplyToId: CommentId option
/// The name of the commentor
/// <summary>The name of the commentor</summary>
Name: string
/// The e-mail address of the commentor
/// <summary>The e-mail address of the commentor</summary>
Email: string
/// The URL of the commentor's personal website
/// <summary>The URL of the commentor's personal website</summary>
Url: string option
/// The status of the comment
/// <summary>The status of the comment</summary>
Status: CommentStatus
/// When the comment was posted
/// <summary>When the comment was posted</summary>
PostedOn: Instant
/// The text of the comment
/// <summary>The text of the comment</summary>
Text: string
} with
/// An empty comment
/// <summary>An empty comment</summary>
static member Empty =
{ Id = CommentId.Empty
PostId = PostId.Empty
@ -79,50 +79,50 @@ type Comment = {
Text = "" }
/// A page (text not associated with a date/time)
/// <summary>A page (text not associated with a date/time)</summary>
[<CLIMutable; NoComparison; NoEquality>]
type Page = {
/// The ID of this page
/// <summary>The ID of this page</summary>
Id: PageId
/// The ID of the web log to which this page belongs
/// <summary>The ID of the web log to which this page belongs</summary>
WebLogId: WebLogId
/// The ID of the author of this page
/// <summary>The ID of the author of this page</summary>
AuthorId: WebLogUserId
/// The title of the page
/// <summary>The title of the page</summary>
Title: string
/// The link at which this page is displayed
/// <summary>The link at which this page is displayed</summary>
Permalink: Permalink
/// When this page was published
/// <summary>When this page was published</summary>
PublishedOn: Instant
/// When this page was last updated
/// <summary>When this page was last updated</summary>
UpdatedOn: Instant
/// Whether this page shows as part of the web log's navigation
/// <summary>Whether this page shows as part of the web log's navigation</summary>
IsInPageList: bool
/// The template to use when rendering this page
/// <summary>The template to use when rendering this page</summary>
Template: string option
/// The current text of the page
/// <summary>The current text of the page</summary>
Text: string
/// Metadata for this page
/// <summary>Metadata for this page</summary>
Metadata: MetaItem list
/// Permalinks at which this page may have been previously served (useful for migrated content)
/// <summary>Permalinks at which this page may have been previously served (useful for migrated content)</summary>
PriorPermalinks: Permalink list
/// Revisions of this page
/// <summary>Revisions of this page</summary>
Revisions: Revision list
} with
/// An empty page
/// <summary>An empty page</summary>
static member Empty =
{ Id = PageId.Empty
WebLogId = WebLogId.Empty
@ -139,59 +139,59 @@ type Page = {
Revisions = [] }
/// A web log post
/// <summary>A web log post</summary>
[<CLIMutable; NoComparison; NoEquality>]
type Post = {
/// The ID of this post
/// <summary>The ID of this post</summary>
Id: PostId
/// The ID of the web log to which this post belongs
/// <summary>The ID of the web log to which this post belongs</summary>
WebLogId: WebLogId
/// The ID of the author of this post
/// <summary>The ID of the author of this post</summary>
AuthorId: WebLogUserId
/// The status
/// <summary>The status</summary>
Status: PostStatus
/// The title
/// <summary>The title</summary>
Title: string
/// The link at which the post resides
/// <summary>The link at which the post resides</summary>
Permalink: Permalink
/// The instant on which the post was originally published
/// <summary>The instant on which the post was originally published</summary>
PublishedOn: Instant option
/// The instant on which the post was last updated
/// <summary>The instant on which the post was last updated</summary>
UpdatedOn: Instant
/// The template to use in displaying the post
/// <summary>The template to use in displaying the post</summary>
Template: string option
/// The text of the post in HTML (ready to display) format
/// <summary>The text of the post in HTML (ready to display) format</summary>
Text: string
/// The Ids of the categories to which this is assigned
/// <summary>The Ids of the categories to which this is assigned</summary>
CategoryIds: CategoryId list
/// The tags for the post
/// <summary>The tags for the post</summary>
Tags: string list
/// Podcast episode information for this post
/// <summary>Podcast episode information for this post</summary>
Episode: Episode option
/// Metadata for the post
/// <summary>Metadata for the post</summary>
Metadata: MetaItem list
/// Permalinks at which this post may have been previously served (useful for migrated content)
/// <summary>Permalinks at which this post may have been previously served (useful for migrated content)</summary>
PriorPermalinks: Permalink list
/// The revisions for this post
/// <summary>The revisions for this post</summary>
Revisions: Revision list
} with
/// An empty post
/// <summary>An empty post</summary>
static member Empty =
{ Id = PostId.Empty
WebLogId = WebLogId.Empty
@ -211,136 +211,138 @@ type Post = {
Revisions = [] }
/// <summary>
/// A mapping between a tag and its URL value, used to translate restricted characters (ex. "#1" -> "number-1")
/// </summary>
[<CLIMutable; NoComparison; NoEquality>]
type TagMap = {
/// The ID of this tag mapping
/// <summary>The ID of this tag mapping</summary>
Id: TagMapId
/// The ID of the web log to which this tag mapping belongs
/// <summary>The ID of the web log to which this tag mapping belongs</summary>
WebLogId: WebLogId
/// The tag which should be mapped to a different value in links
/// <summary>The tag which should be mapped to a different value in links</summary>
Tag: string
/// The value by which the tag should be linked
/// <summary>The value by which the tag should be linked</summary>
UrlValue: string
} with
/// An empty tag mapping
/// <summary>An empty tag mapping</summary>
static member Empty =
{ Id = TagMapId.Empty; WebLogId = WebLogId.Empty; Tag = ""; UrlValue = "" }
/// A theme
/// <summary>A theme</summary>
[<CLIMutable; NoComparison; NoEquality>]
type Theme = {
/// The ID / path of the theme
/// <summary>The ID / path of the theme</summary>
Id: ThemeId
/// A long name of the theme
/// <summary>A long name of the theme</summary>
Name: string
/// The version of the theme
/// <summary>The version of the theme</summary>
Version: string
/// The templates for this theme
/// <summary>The templates for this theme</summary>
Templates: ThemeTemplate list
} with
/// An empty theme
/// <summary>An empty theme</summary>
static member Empty =
{ Id = ThemeId.Empty; Name = ""; Version = ""; Templates = [] }
/// A theme asset (a file served as part of a theme, at /themes/[theme]/[asset-path])
/// <summary>A theme asset (a file served as part of a theme, at /themes/[theme]/[asset-path])</summary>
[<CLIMutable; NoComparison; NoEquality>]
type ThemeAsset = {
/// The ID of the asset (consists of theme and path)
/// <summary>The ID of the asset (consists of theme and path)</summary>
Id: ThemeAssetId
/// The updated date (set from the file date from the ZIP archive)
/// <summary>The updated date (set from the file date from the ZIP archive)</summary>
UpdatedOn: Instant
/// The data for the asset
/// <summary>The data for the asset</summary>
Data: byte array
} with
/// An empty theme asset
/// <summary>An empty theme asset</summary>
static member Empty =
{ Id = ThemeAssetId.Empty; UpdatedOn = Noda.epoch; Data = [||] }
/// An uploaded file
/// <summary>An uploaded file</summary>
[<CLIMutable; NoComparison; NoEquality>]
type Upload = {
/// The ID of the upload
/// <summary>The ID of the upload</summary>
Id: UploadId
/// The ID of the web log to which this upload belongs
/// <summary>The ID of the web log to which this upload belongs</summary>
WebLogId: WebLogId
/// The link at which this upload is served
/// <summary>The link at which this upload is served</summary>
Path: Permalink
/// The updated date/time for this upload
/// <summary>The updated date/time for this upload</summary>
UpdatedOn: Instant
/// The data for the upload
/// <summary>The data for the upload</summary>
Data: byte array
} with
/// An empty upload
/// <summary>An empty upload</summary>
static member Empty =
{ Id = UploadId.Empty; WebLogId = WebLogId.Empty; Path = Permalink.Empty; UpdatedOn = Noda.epoch; Data = [||] }
open Newtonsoft.Json
/// A web log
/// <summary>A web log</summary>
[<CLIMutable; NoComparison; NoEquality>]
type WebLog = {
/// The ID of the web log
/// <summary>The ID of the web log</summary>
Id: WebLogId
/// The name of the web log
/// <summary>The name of the web log</summary>
Name: string
/// The slug of the web log
/// <summary>The slug of the web log</summary>
Slug: string
/// A subtitle for the web log
/// <summary>A subtitle for the web log</summary>
Subtitle: string option
/// The default page ("posts" or a page Id)
/// <summary>The default page ("posts" or a page Id)</summary>
DefaultPage: string
/// The number of posts to display on pages of posts
/// <summary>The number of posts to display on pages of posts</summary>
PostsPerPage: int
/// The ID of the theme (also the path within /themes)
/// <summary>The ID of the theme (also the path within /themes)</summary>
ThemeId: ThemeId
/// The URL base
/// <summary>The URL base</summary>
UrlBase: string
/// The time zone in which dates/times should be displayed
/// <summary>The time zone in which dates/times should be displayed</summary>
TimeZone: string
/// The RSS options for this web log
/// <summary>The RSS options for this web log</summary>
Rss: RssOptions
/// Whether to automatically load htmx
/// <summary>Whether to automatically load htmx</summary>
AutoHtmx: bool
/// Where uploads are placed
/// <summary>Where uploads are placed</summary>
Uploads: UploadDestination
/// Redirect rules for this weblog
/// <summary>Redirect rules for this weblog</summary>
RedirectRules: RedirectRule list
} with
/// An empty web log
/// <summary>An empty web log</summary>
static member Empty =
{ Id = WebLogId.Empty
Name = ""
@ -356,7 +358,9 @@ type WebLog = {
Uploads = Database
RedirectRules = [] }
/// <summary>
/// Any extra path where this web log is hosted (blank if web log is hosted at the root of the domain)
/// </summary>
[<JsonIgnore>]
member this.ExtraPath =
let pathParts = this.UrlBase.Split "://"
@ -366,15 +370,21 @@ type WebLog = {
let path = pathParts[1].Split "/"
if path.Length > 1 then $"""/{path |> Array.skip 1 |> String.concat "/"}""" else ""
/// Generate an absolute URL for the given link
/// <summary>Generate an absolute URL for the given link</summary>
/// <param name="permalink">The permalink for which an absolute URL should be generated</param>
/// <returns>An absolute URL for the given link</returns>
member this.AbsoluteUrl(permalink: Permalink) =
$"{this.UrlBase}/{permalink}"
/// Generate a relative URL for the given link
/// <summary>Generate a relative URL for the given link</summary>
/// <param name="permalink">The permalink for which a relative URL should be generated</param>
/// <returns>A relative URL for the given link</returns>
member this.RelativeUrl(permalink: Permalink) =
$"{this.ExtraPath}/{permalink}"
/// Convert an Instant (UTC reference) to the web log's local date/time
/// <summary>Convert an Instant (UTC reference) to the web log's local date/time</summary>
/// <param name="date">The UTC <c>Instant</c> to be converted</param>
/// <returns>The local date/time for this web log</returns>
member this.LocalTime(date: Instant) =
DateTimeZoneProviders.Tzdb.GetZoneOrNull this.TimeZone
|> Option.ofObj
@ -382,44 +392,44 @@ type WebLog = {
|> Option.defaultValue (date.ToDateTimeUtc())
/// A user of the web log
/// <summary>A user of the web log</summary>
[<CLIMutable; NoComparison; NoEquality>]
type WebLogUser = {
/// The ID of the user
/// <summary>The ID of the user</summary>
Id: WebLogUserId
/// The ID of the web log to which this user belongs
/// <summary>The ID of the web log to which this user belongs</summary>
WebLogId: WebLogId
/// The user name (e-mail address)
/// <summary>The user name (e-mail address)</summary>
Email: string
/// The user's first name
/// <summary>The user's first name</summary>
FirstName: string
/// The user's last name
/// <summary>The user's last name</summary>
LastName: string
/// The user's preferred name
/// <summary>The user's preferred name</summary>
PreferredName: string
/// The hash of the user's password
/// <summary>The hash of the user's password</summary>
PasswordHash: string
/// The URL of the user's personal site
/// <summary>The URL of the user's personal site</summary>
Url: string option
/// The user's access level
/// <summary>The user's access level</summary>
AccessLevel: AccessLevel
/// When the user was created
/// <summary>When the user was created</summary>
CreatedOn: Instant
/// When the user last logged on
/// <summary>When the user last logged on</summary>
LastSeenOn: Instant option
} with
/// An empty web log user
/// <summary>An empty web log user</summary>
static member Empty =
{ Id = WebLogUserId.Empty
WebLogId = WebLogId.Empty
@ -433,7 +443,7 @@ type WebLogUser = {
CreatedOn = Noda.epoch
LastSeenOn = None }
/// Get the user's displayed name
/// <summary>Get the user's displayed name</summary>
[<JsonIgnore>]
member this.DisplayName =
(seq { (match this.PreferredName with "" -> this.FirstName | n -> n); " "; this.LastName }

6
src/MyWebLog.Domain/MyWebLog.Domain.fsproj
View File

@ -7,11 +7,11 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="Markdig" Version="0.39.1" />
<PackageReference Include="Markdig" Version="0.40.0" />
<PackageReference Include="Markdown.ColorCode" Version="2.3.0" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.3" />
<PackageReference Include="NodaTime" Version="3.2.0" />
<PackageReference Update="FSharp.Core" Version="9.0.100" />
<PackageReference Include="NodaTime" Version="3.2.1" />
<PackageReference Update="FSharp.Core" Version="9.0.101" />
</ItemGroup>
</Project>

426
src/MyWebLog.Domain/SupportTypes.fs
View File

@ -4,56 +4,73 @@ open System
open Markdig
open NodaTime
/// Support functions for domain definition
/// <summary>Support functions for domain definition</summary>
[<AutoOpen>]
module private Helpers =
open Markdown.ColorCode
/// Create a new ID (short GUID)
// https://www.madskristensen.net/blog/A-shorter-and-URL-friendly-GUID
/// <summary>Create a new ID (short GUID)</summary>
/// <returns>A 21-character URL-friendly string representing a GUID</returns>
/// <remarks>https://www.madskristensen.net/blog/A-shorter-and-URL-friendly-GUID</remarks>
let newId () =
Convert.ToBase64String(Guid.NewGuid().ToByteArray()).Replace('/', '_').Replace('+', '-')[..21]
/// Pipeline with most extensions enabled
/// <summary>Pipeline with most extensions enabled</summary>
let markdownPipeline = MarkdownPipelineBuilder().UseSmartyPants().UseAdvancedExtensions().UseColorCode().Build()
/// Functions to support NodaTime manipulation
/// <summary>Functions to support NodaTime manipulation</summary>
module Noda =
/// The clock to use when getting "now" (will make mutable for testing)
/// <summary>The clock to use when getting "now" (will make mutable for testing)</summary>
let clock: IClock = SystemClock.Instance
/// The Unix epoch
/// <summary>The Unix epoch</summary>
let epoch = Instant.FromUnixTimeSeconds 0L
/// Truncate an instant to remove fractional seconds
/// <summary>Truncate an instant to remove fractional seconds</summary>
/// <param name="value">The value from which fractional seconds should be removed</param>
/// <returns>The <c>Instant</c> value with no fractional seconds</returns>
let toSecondsPrecision (value: Instant) =
Instant.FromUnixTimeSeconds(value.ToUnixTimeSeconds())
/// The current Instant, with fractional seconds truncated
/// <summary>The current <c>Instant</c>, with fractional seconds truncated</summary>
/// <returns>The current <c>Instant</c> with no fractional seconds</returns>
let now =
clock.GetCurrentInstant >> toSecondsPrecision
/// Convert a date/time to an Instant with whole seconds
/// <summary>Convert a date/time to an <c>Instant</c> with whole seconds</summary>
/// <param name="dt">The date/time to convert</param>
/// <returns>An <c>Instant</c> with no fractional seconds</returns>
let fromDateTime (dt: DateTime) =
Instant.FromDateTimeUtc(DateTime(dt.Ticks, DateTimeKind.Utc)) |> toSecondsPrecision
/// A user's access level
/// <summary>A user's access level</summary>
[<Struct>]
type AccessLevel =
/// The user may create and publish posts and edit the ones they have created
/// <summary>The user may create and publish posts and edit the ones they have created</summary>
| Author
/// The user may edit posts they did not create, but may not delete them
/// <summary>The user may edit posts they did not create, but may not delete them</summary>
| Editor
/// The user may delete posts and configure web log settings
/// <summary>The user may delete posts and configure web log settings</summary>
| WebLogAdmin
/// The user may manage themes (which affects all web logs for an installation)
/// <summary>The user may manage themes (which affects all web logs for an installation)</summary>
| Administrator
/// Parse an access level from its string representation
/// <summary>Weights applied to each access level</summary>
static member private Weights =
[ Author, 10
Editor, 20
WebLogAdmin, 30
Administrator, 40 ]
|> Map.ofList
/// <summary>Parse an access level from its string representation</summary>
/// <param name="level">The string representation to be parsed</param>
/// <returns>The <c>AccessLevel</c> instance parsed from the string</returns>
/// <exception cref="InvalidArgumentException">If the string is not valid</exception>
static member Parse level =
match level with
| "Author" -> Author
@ -62,7 +79,7 @@ type AccessLevel =
| "Administrator" -> Administrator
| _ -> invalidArg (nameof level) $"{level} is not a valid access level"
/// The string representation of this access level
/// <inheritdoc />
override this.ToString() =
match this with
| Author -> "Author"
@ -70,62 +87,63 @@ type AccessLevel =
| WebLogAdmin -> "WebLogAdmin"
| Administrator -> "Administrator"
/// Does a given access level allow an action that requires a certain access level?
/// <summary>Does a given access level allow an action that requires a certain access level?</summary>
/// <param name="needed">The minimum level of access needed</param>
/// <returns>True if this level satisfies the given level, false if not</returns>
member this.HasAccess(needed: AccessLevel) =
let weights =
[ Author, 10
Editor, 20
WebLogAdmin, 30
Administrator, 40 ]
|> Map.ofList
weights[needed] <= weights[this]
AccessLevel.Weights[needed] <= AccessLevel.Weights[this]
/// An identifier for a category
/// <summary>An identifier for a category</summary>
[<Struct>]
type CategoryId =
| CategoryId of string
/// An empty category ID
/// <summary>An empty category ID</summary>
static member Empty = CategoryId ""
/// Create a new category ID
/// <summary>Create a new category ID</summary>
/// <returns>A new category ID</returns>
static member Create =
newId >> CategoryId
/// The string representation of this category ID
/// <inheritdoc />
override this.ToString() =
match this with CategoryId it -> it
/// An identifier for a comment
/// <summary>An identifier for a comment</summary>
[<Struct>]
type CommentId =
| CommentId of string
/// An empty comment ID
/// <summary>An empty comment ID</summary>
static member Empty = CommentId ""
/// Create a new comment ID
/// <summary>Create a new comment ID</summary>
/// <returns>A new commend ID</returns>
static member Create =
newId >> CommentId
/// The string representation of this comment ID
/// <inheritdoc />
override this.ToString() =
match this with CommentId it -> it
/// Statuses for post comments
/// <summary>Statuses for post comments</summary>
[<Struct>]
type CommentStatus =
/// The comment is approved
/// <summary>The comment is approved</summary>
| Approved
/// The comment has yet to be approved
/// <summary>The comment has yet to be approved</summary>
| Pending
/// The comment was unsolicited and unwelcome
/// <summary>The comment was unsolicited and unwelcome</summary>
| Spam
/// Parse a string into a comment status
/// <summary>Parse a string into a comment status</summary>
/// <param name="status">The string representation of the status</param>
/// <returns>The <c>CommentStatus</c> instance parsed from the string</returns>
/// <exception cref="InvalidArgumentException">If the string is not valid</exception>
static member Parse status =
match status with
| "Approved" -> Approved
@ -133,19 +151,22 @@ type CommentStatus =
| "Spam" -> Spam
| _ -> invalidArg (nameof status) $"{status} is not a valid comment status"
/// Convert a comment status to a string
/// <inheritdoc />
override this.ToString() =
match this with Approved -> "Approved" | Pending -> "Pending" | Spam -> "Spam"
/// Valid values for the iTunes explicit rating
/// <summary>Valid values for the iTunes explicit rating</summary>
[<Struct>]
type ExplicitRating =
| Yes
| No
| Clean
/// Parse a string into an explicit rating
/// <summary>Parse a string into an explicit rating</summary>
/// <param name="rating">The string representation of the rating</param>
/// <returns>The <c>ExplicitRating</c> parsed from the string</returns>
/// <exception cref="InvalidArgumentException">If the string is not valid</exception>
static member Parse rating =
match rating with
| "yes" -> Yes
@ -153,49 +174,49 @@ type ExplicitRating =
| "clean" -> Clean
| _ -> invalidArg (nameof rating) $"{rating} is not a valid explicit rating"
/// The string value of this rating
/// <inheritdoc />
override this.ToString() =
match this with Yes -> "yes" | No -> "no" | Clean -> "clean"
/// A location (specified by Podcast Index)
/// <summary>A location (specified by Podcast Index)</summary>
type Location = {
/// The name of the location (free-form text)
/// <summary>The name of the location (free-form text)</summary>
Name: string
/// A geographic coordinate string (RFC 5870)
/// <summary>A geographic coordinate string (RFC 5870)</summary>
Geo: string
/// An OpenStreetMap query
/// <summary>An OpenStreetMap query</summary>
Osm: string option
}
/// A chapter in a podcast episode
/// <summary>A chapter in a podcast episode</summary>
type Chapter = {
/// The start time for the chapter
/// <summary>The start time for the chapter</summary>
StartTime: Duration
/// The title for this chapter
/// <summary>The title for this chapter</summary>
Title: string option
/// A URL for an image for this chapter
/// <summary>A URL for an image for this chapter</summary>
ImageUrl: string option
/// A URL with information pertaining to this chapter
/// <summary>A URL with information pertaining to this chapter</summary>
Url: string option
/// Whether this chapter is hidden
/// <summary>Whether this chapter is hidden</summary>
IsHidden: bool option
/// The episode end time for the chapter
/// <summary>The episode end time for the chapter</summary>
EndTime: Duration option
/// A location that applies to a chapter
/// <summary>A location that applies to a chapter</summary>
Location: Location option
} with
/// An empty chapter
/// <summary>An empty chapter</summary>
static member Empty =
{ StartTime = Duration.Zero
Title = None
@ -208,67 +229,67 @@ type Chapter = {
open NodaTime.Text
/// A podcast episode
/// <summary>A podcast episode</summary>
type Episode = {
/// The URL to the media file for the episode (may be permalink)
/// <summary>The URL to the media file for the episode (may be permalink)</summary>
Media: string
/// The length of the media file, in bytes
/// <summary>The length of the media file, in bytes</summary>
Length: int64
/// The duration of the episode
/// <summary>The duration of the episode</summary>
Duration: Duration option
/// The media type of the file (overrides podcast default if present)
/// <summary>The media type of the file (overrides podcast default if present)</summary>
MediaType: string option
/// The URL to the image file for this episode (overrides podcast image if present, may be permalink)
/// <summary>The URL to the image file for this episode (overrides podcast image if present, may be permalink)</summary>
ImageUrl: string option
/// A subtitle for this episode
/// <summary>A subtitle for this episode</summary>
Subtitle: string option
/// This episode's explicit rating (overrides podcast rating if present)
/// <summary>This episode's explicit rating (overrides podcast rating if present)</summary>
Explicit: ExplicitRating option
/// Chapters for this episode
/// <summary>Chapters for this episode</summary>
Chapters: Chapter list option
/// A link to a chapter file
/// <summary>A link to a chapter file</summary>
ChapterFile: string option
/// The MIME type for the chapter file
/// <summary>The MIME type for the chapter file</summary>
ChapterType: string option
/// Whether the chapters have locations that should be displayed as waypoints
/// <summary>Whether the chapters have locations that should be displayed as waypoints</summary>
ChapterWaypoints: bool option
/// The URL for the transcript of the episode (may be permalink)
/// <summary>The URL for the transcript of the episode (may be permalink)</summary>
TranscriptUrl: string option
/// The MIME type of the transcript
/// <summary>The MIME type of the transcript</summary>
TranscriptType: string option
/// The language in which the transcript is written
/// <summary>The language in which the transcript is written</summary>
TranscriptLang: string option
/// If true, the transcript will be declared (in the feed) to be a captions file
/// <summary>If true, the transcript will be declared (in the feed) to be a captions file</summary>
TranscriptCaptions: bool option
/// The season number (for serialized podcasts)
/// <summary>The season number (for serialized podcasts)</summary>
SeasonNumber: int option
/// A description of the season
/// <summary>A description of the season</summary>
SeasonDescription: string option
/// The episode number
/// <summary>The episode number</summary>
EpisodeNumber: double option
/// A description of the episode
/// <summary>A description of the episode</summary>
EpisodeDescription: string option
} with
/// An empty episode
/// <summary>An empty episode</summary>
static member Empty =
{ Media = ""
Length = 0L
@ -290,103 +311,109 @@ type Episode = {
EpisodeNumber = None
EpisodeDescription = None }
/// Format a duration for an episode
/// <summary>Format a duration for an episode</summary>
/// <returns>A duration formatted in hours, minutes, and seconds</returns>
member this.FormatDuration() =
this.Duration |> Option.map (DurationPattern.CreateWithInvariantCulture("H:mm:ss").Format)
/// Types of markup text
/// <summary>Types of markup text</summary>
type MarkupText =
/// Markdown text
/// <summary>Markdown text</summary>
| Markdown of string
/// HTML text
/// <summary>HTML text</summary>
| Html of string
/// Parse a string into a MarkupText instance
/// <summary>Parse a string into a MarkupText instance</summary>
/// <param name="text">The string to be parsed</param>
/// <returns>The <c>MarkupText</c> parsed from the string</returns>
/// <exception cref="InvalidArgumentException">If the string is not valid</exception>
static member Parse(text: string) =
match text with
| _ when text.StartsWith "Markdown: " -> Markdown text[10..]
| _ when text.StartsWith "HTML: " -> Html text[6..]
| _ -> invalidArg (nameof text) $"Cannot derive type of text ({text})"
/// The source type for the markup text
/// <summary>The source type for the markup text</summary>
member this.SourceType =
match this with Markdown _ -> "Markdown" | Html _ -> "HTML"
/// The raw text, regardless of type
/// <summary>The raw text, regardless of type</summary>
member this.Text =
match this with Markdown text -> text | Html text -> text
/// The string representation of the markup text
/// <inheritdoc />
override this.ToString() =
$"{this.SourceType}: {this.Text}"
/// The HTML representation of the markup text
/// <summary>The HTML representation of the markup text</summary>
/// <returns>An HTML representation of the markup text</returns>
member this.AsHtml() =
match this with Markdown text -> Markdown.ToHtml(text, markdownPipeline) | Html text -> text
/// An item of metadata
/// <summary>An item of metadata</summary>
[<CLIMutable>]
type MetaItem = {
/// The name of the metadata value
/// <summary>The name of the metadata value</summary>
Name: string
/// The metadata value
/// <summary>The metadata value</summary>
Value: string
} with
/// An empty metadata item
/// <summary>An empty metadata item</summary>
static member Empty =
{ Name = ""; Value = "" }
/// A revision of a page or post
/// <summary>A revision of a page or post</summary>
[<CLIMutable>]
type Revision = {
/// When this revision was saved
/// <summary>When this revision was saved</summary>
AsOf: Instant
/// The text of the revision
/// <summary>The text of the revision</summary>
Text: MarkupText
} with
/// An empty revision
/// <summary>An empty revision</summary>
static member Empty =
{ AsOf = Noda.epoch; Text = Html "" }
/// A permanent link
/// <summary>A permanent link</summary>
[<Struct>]
type Permalink =
| Permalink of string
/// An empty permalink
/// <summary>An empty permalink</summary>
static member Empty = Permalink ""
/// The string value of this permalink
/// <inheritdoc />
override this.ToString() =
match this with Permalink it -> it
/// An identifier for a page
/// <summary>An identifier for a page</summary>
[<Struct>]
type PageId =
| PageId of string
/// An empty page ID
/// <summary>An empty page ID</summary>
static member Empty = PageId ""
/// Create a new page ID
/// <summary>Create a new page ID</summary>
/// <returns>A new page ID</returns>
static member Create =
newId >> PageId
/// The string value of this page ID
/// <inheritdoc />
override this.ToString() =
match this with PageId it -> it
/// PodcastIndex.org podcast:medium allowed values
/// <summary>PodcastIndex.org podcast:medium allowed values</summary>
[<Struct>]
type PodcastMedium =
| Podcast
@ -397,7 +424,10 @@ type PodcastMedium =
| Newsletter
| Blog
/// Parse a string into a podcast medium
/// <summary>Parse a string into a podcast medium</summary>
/// <param name="medium">The string to be parsed</param>
/// <returns>The <c>PodcastMedium</c> parsed from the string</returns>
/// <exception cref="InvalidArgumentException">If the string is not valid</exception>
static member Parse medium =
match medium with
| "podcast" -> Podcast
@ -409,7 +439,7 @@ type PodcastMedium =
| "blog" -> Blog
| _ -> invalidArg (nameof medium) $"{medium} is not a valid podcast medium"
/// The string value of this podcast medium
/// <inheritdoc />
override this.ToString() =
match this with
| Podcast -> "podcast"
@ -421,86 +451,94 @@ type PodcastMedium =
| Blog -> "blog"
/// Statuses for posts
/// <summary>Statuses for posts</summary>
[<Struct>]
type PostStatus =
/// The post should not be publicly available
/// <summary>The post should not be publicly available</summary>
| Draft
/// The post is publicly viewable
/// <summary>The post is publicly viewable</summary>
| Published
/// Parse a string into a post status
/// <summary>Parse a string into a post status</summary>
/// <param name="status">The string to be parsed</param>
/// <returns>The <c>PostStatus</c> parsed from the string</returns>
/// <exception cref="InvalidArgumentException">If the string is not valid</exception>
static member Parse status =
match status with
| "Draft" -> Draft
| "Published" -> Published
| _ -> invalidArg (nameof status) $"{status} is not a valid post status"
/// The string representation of this post status
/// <summary>The string representation of this post status</summary>
override this.ToString() =
match this with Draft -> "Draft" | Published -> "Published"
/// An identifier for a post
/// <summary>An identifier for a post</summary>
[<Struct>]
type PostId =
| PostId of string
/// An empty post ID
/// <summary>An empty post ID</summary>
static member Empty = PostId ""
/// Create a new post ID
/// <summary>Create a new post ID</summary>
/// <returns>A new post ID</returns>
static member Create =
newId >> PostId
/// Convert a post ID to a string
/// <inheritdoc />
override this.ToString() =
match this with PostId it -> it
/// A redirection for a previously valid URL
/// <summary>A redirection for a previously valid URL</summary>
[<CLIMutable>]
type RedirectRule = {
/// The From string or pattern
/// <summary>The From string or pattern</summary>
From: string
/// The To string or pattern
/// <summary>The To string or pattern</summary>
To: string
/// Whether to use regular expressions on this rule
/// <summary>Whether to use regular expressions on this rule</summary>
IsRegex: bool
} with
/// An empty redirect rule
/// <summary>An empty redirect rule</summary>
static member Empty =
{ From = ""; To = ""; IsRegex = false }
/// An identifier for a custom feed
/// <summary>An identifier for a custom feed</summary>
[<Struct>]
type CustomFeedId =
| CustomFeedId of string
/// An empty custom feed ID
/// <summary>An empty custom feed ID</summary>
static member Empty = CustomFeedId ""
/// Create a new custom feed ID
/// <summary>Create a new custom feed ID</summary>
/// <returns>A new custom feed ID</returns>
static member Create =
newId >> CustomFeedId
/// Convert a custom feed ID to a string
/// <inheritdoc />
override this.ToString() =
match this with CustomFeedId it -> it
/// The source for a custom feed
/// <summary>The source for a custom feed</summary>
type CustomFeedSource =
/// A feed based on a particular category
/// <summary>A feed based on a particular category</summary>
| Category of CategoryId
/// A feed based on a particular tag
/// <summary>A feed based on a particular tag</summary>
| Tag of string
/// Parse a feed source from its string version
/// <summary>Parse a feed source from its string version</summary>
/// <param name="source">The string to be parsed</param>
/// <returns>The <c>CustomFeedSource</c> parsed from the string</returns>
/// <exception cref="InvalidArgumentException">If the string is not valid</exception>
static member Parse(source: string) =
let value (it : string) = it.Split(":").[1]
match source with
@ -508,64 +546,68 @@ type CustomFeedSource =
| _ when source.StartsWith "tag:" -> (value >> Tag) source
| _ -> invalidArg (nameof source) $"{source} is not a valid feed source"
/// Create a string version of a feed source
/// <inheritdoc />
override this.ToString() =
match this with | Category (CategoryId catId) -> $"category:{catId}" | Tag tag -> $"tag:{tag}"
/// Options for a feed that describes a podcast
/// <summary>Options for a feed that describes a podcast</summary>
[<CLIMutable; NoComparison; NoEquality>]
type PodcastOptions = {
/// The title of the podcast
/// <summary>The title of the podcast</summary>
Title: string
/// A subtitle for the podcast
/// <summary>A subtitle for the podcast</summary>
Subtitle: string option
/// The number of items in the podcast feed
/// <summary>The number of items in the podcast feed</summary>
ItemsInFeed: int
/// A summary of the podcast (iTunes field)
/// <summary>A summary of the podcast (iTunes field)</summary>
Summary: string
/// The display name of the podcast author (iTunes field)
/// <summary>The display name of the podcast author (iTunes field)</summary>
DisplayedAuthor: string
/// The e-mail address of the user who registered the podcast at iTunes
/// <summary>The e-mail address of the user who registered the podcast at iTunes</summary>
Email: string
/// The link to the image for the podcast
/// <summary>The link to the image for the podcast</summary>
ImageUrl: Permalink
/// The category from Apple Podcasts (iTunes) under which this podcast is categorized
/// <summary>The category from Apple Podcasts (iTunes) under which this podcast is categorized</summary>
AppleCategory: string
/// <summary>
/// A further refinement of the categorization of this podcast (Apple Podcasts/iTunes field / values)
/// </summary>
AppleSubcategory: string option
/// The explictness rating (iTunes field)
/// <summary>The explictness rating (iTunes field)</summary>
Explicit: ExplicitRating
/// The default media type for files in this podcast
/// <summary>The default media type for files in this podcast</summary>
DefaultMediaType: string option
/// <summary>
/// The base URL for relative URL media files for this podcast (optional; defaults to web log base)
/// </summary>
MediaBaseUrl: string option
/// A GUID for this podcast
/// <summary>A GUID for this podcast</summary>
PodcastGuid: Guid option
/// A URL at which information on supporting the podcast may be found (supports permalinks)
/// <summary>A URL at which information on supporting the podcast may be found (supports permalinks)</summary>
FundingUrl: string option
/// The text to be displayed in the funding item within the feed
/// <summary>The text to be displayed in the funding item within the feed</summary>
FundingText: string option
/// The medium (what the podcast IS, not what it is ABOUT)
/// <summary>The medium (what the podcast IS, not what it is ABOUT)</summary>
Medium: PodcastMedium option
} with
/// A default set of podcast options
/// <summary>A default set of podcast options</summary>
static member Empty =
{ Title = ""
Subtitle = None
@ -585,23 +627,23 @@ type PodcastOptions = {
Medium = None }
/// A custom feed
/// <summary>A custom feed</summary>
[<CLIMutable; NoComparison; NoEquality>]
type CustomFeed = {
/// The ID of the custom feed
/// <summary>The ID of the custom feed</summary>
Id: CustomFeedId
/// The source for the custom feed
/// <summary>The source for the custom feed</summary>
Source: CustomFeedSource
/// The path for the custom feed
/// <summary>The path for the custom feed</summary>
Path: Permalink
/// Podcast options, if the feed defines a podcast
/// <summary>Podcast options, if the feed defines a podcast</summary>
Podcast: PodcastOptions option
} with
/// An empty custom feed
/// <summary>An empty custom feed</summary>
static member Empty =
{ Id = CustomFeedId.Empty
Source = Category CategoryId.Empty
@ -609,32 +651,32 @@ type CustomFeed = {
Podcast = None }
/// Really Simple Syndication (RSS) options for this web log
/// <summary>Really Simple Syndication (RSS) options for this web log</summary>
[<CLIMutable; NoComparison; NoEquality>]
type RssOptions = {
/// Whether the site feed of posts is enabled
/// <summary>Whether the site feed of posts is enabled</summary>
IsFeedEnabled: bool
/// The name of the file generated for the site feed
/// <summary>The name of the file generated for the site feed</summary>
FeedName: string
/// Override the "posts per page" setting for the site feed
/// <summary>Override the "posts per page" setting for the site feed</summary>
ItemsInFeed: int option
/// Whether feeds are enabled for all categories
/// <summary>Whether feeds are enabled for all categories</summary>
IsCategoryEnabled: bool
/// Whether feeds are enabled for all tags
/// <summary>Whether feeds are enabled for all tags</summary>
IsTagEnabled: bool
/// A copyright string to be placed in all feeds
/// <summary>A copyright string to be placed in all feeds</summary>
Copyright: string option
/// Custom feeds for this web log
/// <summary>Custom feeds for this web log</summary>
CustomFeeds: CustomFeed list
} with
/// An empty set of RSS options
/// <summary>An empty set of RSS options</summary>
static member Empty =
{ IsFeedEnabled = true
FeedName = "feed.xml"
@ -645,45 +687,49 @@ type RssOptions = {
CustomFeeds = [] }
/// An identifier for a tag mapping
/// <summary>An identifier for a tag mapping</summary>
[<Struct>]
type TagMapId =
| TagMapId of string
/// An empty tag mapping ID
/// <summary>An empty tag mapping ID</summary>
static member Empty = TagMapId ""
/// Create a new tag mapping ID
/// <summary>Create a new tag mapping ID</summary>
/// <returns>A new tag mapping ID</returns>
static member Create =
newId >> TagMapId
/// Convert a tag mapping ID to a string
/// <inheritdoc />
override this.ToString() =
match this with TagMapId it -> it
/// An identifier for a theme (represents its path)
/// <summary>An identifier for a theme (represents its path)</summary>
[<Struct>]
type ThemeId =
| ThemeId of string
/// An empty theme ID
/// <summary>An empty theme ID</summary>
static member Empty = ThemeId ""
/// The string representation of a theme ID
/// <inheritdoc />
override this.ToString() =
match this with ThemeId it -> it
/// An identifier for a theme asset
/// <summary>An identifier for a theme asset</summary>
[<Struct>]
type ThemeAssetId =
| ThemeAssetId of ThemeId * string
/// An empty theme asset ID
/// <summary>An empty theme asset ID</summary>
static member Empty = ThemeAssetId(ThemeId.Empty, "")
/// Convert a string into a theme asset ID
/// <summary>Convert a string into a theme asset ID</summary>
/// <param name="it">The string to be parsed</param>
/// <returns>The <c>ThemeAssetId</c> parsed from the string</returns>
/// <exception cref="InvalidArgumentException">If the string is not valid</exception>
static member Parse(it : string) =
let themeIdx = it.IndexOf "/"
if themeIdx < 0 then
@ -691,90 +737,96 @@ type ThemeAssetId =
else
ThemeAssetId(ThemeId it[..(themeIdx - 1)], it[(themeIdx + 1)..])
/// Convert a theme asset ID into a path string
/// <inheritdoc />
override this.ToString() =
match this with ThemeAssetId (ThemeId theme, asset) -> $"{theme}/{asset}"
/// A template for a theme
/// <summary>A template for a theme</summary>
[<CLIMutable; NoComparison; NoEquality>]
type ThemeTemplate = {
/// The name of the template
/// <summary>The name of the template</summary>
Name: string
/// The text of the template
/// <summary>The text of the template</summary>
Text: string
} with
/// An empty theme template
/// <summary>An empty theme template</summary>
static member Empty =
{ Name = ""; Text = "" }
/// Where uploads should be placed
/// <summary>Where uploads should be placed</summary>
[<Struct>]
type UploadDestination =
| Database
| Disk
/// Parse an upload destination from its string representation
/// <summary>Parse an upload destination from its string representation</summary>
/// <param name="destination">The string to be parsed</param>
/// <returns>The <c>UploadDestination</c> parsed from the string</returns>
/// <exception cref="InvalidArgumentException">If the string is not valid</exception>
static member Parse destination =
match destination with
| "Database" -> Database
| "Disk" -> Disk
| _ -> invalidArg (nameof destination) $"{destination} is not a valid upload destination"
/// The string representation of an upload destination
/// <inheritdoc />
override this.ToString() =
match this with Database -> "Database" | Disk -> "Disk"
/// An identifier for an upload
/// <summary>An identifier for an upload</summary>
[<Struct>]
type UploadId =
| UploadId of string
/// An empty upload ID
/// <summary>An empty upload ID</summary>
static member Empty = UploadId ""
/// Create a new upload ID
/// <summary>Create a new upload ID</summary>
/// <returns>A new upload ID</returns>
static member Create =
newId >> UploadId
/// The string representation of an upload ID
/// <inheritdoc />
override this.ToString() =
match this with UploadId it -> it
/// An identifier for a web log
/// <summary>An identifier for a web log</summary>
[<Struct>]
type WebLogId =
| WebLogId of string
/// An empty web log ID
/// <summary>An empty web log ID</summary>
static member Empty = WebLogId ""
/// Create a new web log ID
/// <summary>Create a new web log ID</summary>
/// <returns>A new web log ID</returns>
static member Create =
newId >> WebLogId
/// Convert a web log ID to a string
/// <inheritdoc />
override this.ToString() =
match this with WebLogId it -> it
/// An identifier for a web log user
/// <summary>An identifier for a web log user</summary>
[<Struct>]
type WebLogUserId =
| WebLogUserId of string
/// An empty web log user ID
/// <summary>An empty web log user ID</summary>
static member Empty = WebLogUserId ""
/// Create a new web log user ID
/// <summary>Create a new web log user ID</summary>
/// <returns>A new web log user ID</returns>
static member Create =
newId >> WebLogUserId
/// The string representation of a web log user ID
/// <inheritdoc />
override this.ToString() =
match this with WebLogUserId it -> it

591
src/MyWebLog.Domain/ViewModels.fs
View File

File diff suppressed because it is too large Load Diff

2
src/MyWebLog.Tests/MyWebLog.Tests.fsproj
View File

@ -28,7 +28,7 @@
<ItemGroup>
<PackageReference Include="Expecto" Version="10.2.1" />
<PackageReference Include="ThrowawayDb.Postgres" Version="1.4.0" />
<PackageReference Update="FSharp.Core" Version="9.0.100" />
<PackageReference Update="FSharp.Core" Version="9.0.101" />
</ItemGroup>
<ItemGroup>

113
src/MyWebLog/Caches.fs
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

6
src/MyWebLog/MyWebLog.fsproj
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>

53
src/MyWebLog/Template.fs
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,13 +54,17 @@ 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>
@ -162,7 +173,7 @@ let options () =
it
/// Fluid parser customized with myWebLog filters and tags
/// <summary>Fluid parser customized with myWebLog filters and tags</summary>
let parser =
// spacer
let s = " "
@ -256,7 +267,7 @@ let parser =
open MyWebLog.Data
/// Cache for parsed templates
/// <summary>Cache for parsed templates</summary>
module Cache =
open System.Collections.Concurrent
@ -264,7 +275,13 @@ module Cache =
/// 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
@ -281,11 +298,13 @@ module Cache =
| 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
@ -293,12 +312,12 @@ module Cache =
|> 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
@ -327,7 +346,11 @@ type ThemeFileProvider(themeId: ThemeId, data: IData) =
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)

66
src/MyWebLog/ViewContext.fs
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
/// <summary>The slug for a category or tag</summary>
Slug: string option
} with
/// Whether there is a user logged on
/// <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

5
src/MyWebLog/Views/Admin.fs
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/"

157
src/MyWebLog/Views/Helpers.fs
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
@ -63,7 +82,14 @@ let extractAttrValue name attrs =
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,15 +184,15 @@ 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
@ -222,14 +289,20 @@ 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" ]
@ -249,7 +322,10 @@ module Layout =
]
]
/// 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) =
@ -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) =