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

Version 2.1 #41

Merged
danieljsummers merged 123 commits from version-2.1 into main 2024-03-27 00:13:28 +00:00
Conversation 0 Commits 123 Files Changed 116 +481 -521
26 changed files with 481 additions and 521 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files
Showing only changes of commit c3d615d10a - Show all commits

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

@ -10,7 +10,6 @@
<PackageReference Include="Microsoft.Extensions.Caching.Abstractions" Version="8.0.0" /> <PackageReference Include="Microsoft.Extensions.Caching.Abstractions" Version="8.0.0" />
<PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="8.0.0" /> <PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="8.0.0" />
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" /> <PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.3" />
<PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.1.0" /> <PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.1.0" />
<PackageReference Include="Npgsql.NodaTime" Version="8.0.1" /> <PackageReference Include="Npgsql.NodaTime" Version="8.0.1" />
<PackageReference Include="RethinkDb.Driver" Version="2.3.150" /> <PackageReference Include="RethinkDb.Driver" Version="2.3.150" />

6
src/MyWebLog.Data/Postgres/PostgresCategoryData.fs
View File

@ -23,7 +23,7 @@ type PostgresCategoryData(log: ILogger) =
let findAllForView webLogId = backgroundTask { let findAllForView webLogId = backgroundTask {
log.LogTrace "Category.findAllForView" log.LogTrace "Category.findAllForView"
let! cats = let! cats =
Custom.list $"{selectWithCriteria Table.Category} ORDER BY LOWER(data ->> '{nameof Category.empty.Name}')" Custom.list $"{selectWithCriteria Table.Category} ORDER BY LOWER(data ->> '{nameof Category.Empty.Name}')"
[ webLogContains webLogId ] fromData<Category> [ webLogContains webLogId ] fromData<Category>
let ordered = Utils.orderByHierarchy cats None None [] let ordered = Utils.orderByHierarchy cats None None []
let counts = let counts =
@ -36,7 +36,7 @@ type PostgresCategoryData(log: ILogger) =
|> Seq.map _.Id |> Seq.map _.Id
|> Seq.append (Seq.singleton it.Id) |> Seq.append (Seq.singleton it.Id)
|> List.ofSeq |> List.ofSeq
|> arrayContains (nameof Post.empty.CategoryIds) id |> arrayContains (nameof Post.Empty.CategoryIds) id
let postCount = let postCount =
Custom.scalar Custom.scalar
$"""SELECT COUNT(DISTINCT id) AS {countName} $"""SELECT COUNT(DISTINCT id) AS {countName}
@ -97,7 +97,7 @@ type PostgresCategoryData(log: ILogger) =
() ()
// Delete the category off all posts where it is assigned // Delete the category off all posts where it is assigned
let! posts = let! posts =
Custom.list $"SELECT data FROM {Table.Post} WHERE data -> '{nameof Post.empty.CategoryIds}' @> @id" Custom.list $"SELECT data FROM {Table.Post} WHERE data -> '{nameof Post.Empty.CategoryIds}' @> @id"
[ "@id", Query.jsonbDocParam [| string catId |] ] fromData<Post> [ "@id", Query.jsonbDocParam [| string catId |] ] fromData<Post>
if not (List.isEmpty posts) then if not (List.isEmpty posts) then
let! _ = let! _ =

10
src/MyWebLog.Data/Postgres/PostgresPageData.fs
View File

@ -37,7 +37,7 @@ type PostgresPageData (log: ILogger) =
/// Get all pages for a web log (without text or revisions) /// Get all pages for a web log (without text or revisions)
let all webLogId = let all webLogId =
log.LogTrace "Page.all" log.LogTrace "Page.all"
Custom.list $"{selectWithCriteria Table.Page} ORDER BY LOWER(data ->> '{nameof Page.empty.Title}')" Custom.list $"{selectWithCriteria Table.Page} ORDER BY LOWER(data ->> '{nameof Page.Empty.Title}')"
[ webLogContains webLogId ] fromData<Page> [ webLogContains webLogId ] fromData<Page>
/// Count all pages for the given web log /// Count all pages for the given web log
@ -86,10 +86,10 @@ type PostgresPageData (log: ILogger) =
log.LogTrace "Page.findCurrentPermalink" log.LogTrace "Page.findCurrentPermalink"
if List.isEmpty permalinks then return None if List.isEmpty permalinks then return None
else else
let linkSql, linkParam = arrayContains (nameof Page.empty.PriorPermalinks) string permalinks let linkSql, linkParam = arrayContains (nameof Page.Empty.PriorPermalinks) string permalinks
return! return!
Custom.single Custom.single
$"""SELECT data ->> '{nameof Page.empty.Permalink}' AS permalink $"""SELECT data ->> '{nameof Page.Empty.Permalink}' AS permalink
FROM page FROM page
WHERE {Query.whereDataContains "@criteria"} WHERE {Query.whereDataContains "@criteria"}
AND {linkSql}""" [ webLogContains webLogId; linkParam ] Map.toPermalink AND {linkSql}""" [ webLogContains webLogId; linkParam ] Map.toPermalink
@ -109,7 +109,7 @@ type PostgresPageData (log: ILogger) =
/// Get all listed pages for the given web log (without revisions or text) /// Get all listed pages for the given web log (without revisions or text)
let findListed webLogId = let findListed webLogId =
log.LogTrace "Page.findListed" log.LogTrace "Page.findListed"
Custom.list $"{selectWithCriteria Table.Page} ORDER BY LOWER(data ->> '{nameof Page.empty.Title}')" Custom.list $"{selectWithCriteria Table.Page} ORDER BY LOWER(data ->> '{nameof Page.Empty.Title}')"
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with IsInPageList = true |} ] [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with IsInPageList = true |} ]
pageWithoutText pageWithoutText
@ -118,7 +118,7 @@ type PostgresPageData (log: ILogger) =
log.LogTrace "Page.findPageOfPages" log.LogTrace "Page.findPageOfPages"
Custom.list Custom.list
$"{selectWithCriteria Table.Page} $"{selectWithCriteria Table.Page}
ORDER BY LOWER(data->>'{nameof Page.empty.Title}') ORDER BY LOWER(data->>'{nameof Page.Empty.Title}')
LIMIT @pageSize OFFSET @toSkip" LIMIT @pageSize OFFSET @toSkip"
[ webLogContains webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ] [ webLogContains webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ]
fromData<Page> fromData<Page>

20
src/MyWebLog.Data/Postgres/PostgresPostData.fs
View File

@ -80,10 +80,10 @@ type PostgresPostData(log: ILogger) =
log.LogTrace "Post.findCurrentPermalink" log.LogTrace "Post.findCurrentPermalink"
if List.isEmpty permalinks then return None if List.isEmpty permalinks then return None
else else
let linkSql, linkParam = arrayContains (nameof Post.empty.PriorPermalinks) string permalinks let linkSql, linkParam = arrayContains (nameof Post.Empty.PriorPermalinks) string permalinks
return! return!
Custom.single Custom.single
$"""SELECT data ->> '{nameof Post.empty.Permalink}' AS permalink $"""SELECT data ->> '{nameof Post.Empty.Permalink}' AS permalink
FROM {Table.Post} FROM {Table.Post}
WHERE {Query.whereDataContains "@criteria"} WHERE {Query.whereDataContains "@criteria"}
AND {linkSql}""" [ webLogContains webLogId; linkParam ] Map.toPermalink AND {linkSql}""" [ webLogContains webLogId; linkParam ] Map.toPermalink
@ -103,11 +103,11 @@ type PostgresPostData(log: ILogger) =
/// Get a page of categorized posts for the given web log (excludes revisions) /// Get a page of categorized posts for the given web log (excludes revisions)
let findPageOfCategorizedPosts webLogId (categoryIds: CategoryId list) pageNbr postsPerPage = let findPageOfCategorizedPosts webLogId (categoryIds: CategoryId list) pageNbr postsPerPage =
log.LogTrace "Post.findPageOfCategorizedPosts" log.LogTrace "Post.findPageOfCategorizedPosts"
let catSql, catParam = arrayContains (nameof Post.empty.CategoryIds) string categoryIds let catSql, catParam = arrayContains (nameof Post.Empty.CategoryIds) string categoryIds
Custom.list Custom.list
$"{selectWithCriteria Table.Post} $"{selectWithCriteria Table.Post}
AND {catSql} AND {catSql}
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published |} [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published |}
catParam catParam
@ -118,8 +118,8 @@ type PostgresPostData(log: ILogger) =
log.LogTrace "Post.findPageOfPosts" log.LogTrace "Post.findPageOfPosts"
Custom.list Custom.list
$"{selectWithCriteria Table.Post} $"{selectWithCriteria Table.Post}
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC NULLS FIRST, ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' DESC NULLS FIRST,
data ->> '{nameof Post.empty.UpdatedOn}' data ->> '{nameof Post.Empty.UpdatedOn}'
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
[ webLogContains webLogId ] postWithoutText [ webLogContains webLogId ] postWithoutText
@ -128,7 +128,7 @@ type PostgresPostData(log: ILogger) =
log.LogTrace "Post.findPageOfPublishedPosts" log.LogTrace "Post.findPageOfPublishedPosts"
Custom.list Custom.list
$"{selectWithCriteria Table.Post} $"{selectWithCriteria Table.Post}
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published |} ] [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published |} ]
fromData<Post> fromData<Post>
@ -138,8 +138,8 @@ type PostgresPostData(log: ILogger) =
log.LogTrace "Post.findPageOfTaggedPosts" log.LogTrace "Post.findPageOfTaggedPosts"
Custom.list Custom.list
$"{selectWithCriteria Table.Post} $"{selectWithCriteria Table.Post}
AND data['{nameof Post.empty.Tags}'] @> @tag AND data['{nameof Post.Empty.Tags}'] @> @tag
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published |} [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published |}
"@tag", Query.jsonbDocParam [| tag |] "@tag", Query.jsonbDocParam [| tag |]
@ -152,7 +152,7 @@ type PostgresPostData(log: ILogger) =
"@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published |} "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published |}
"@publishedOn", Sql.string ((InstantPattern.General.Format publishedOn)[..19]) "@publishedOn", Sql.string ((InstantPattern.General.Format publishedOn)[..19])
] ]
let pubField = nameof Post.empty.PublishedOn let pubField = nameof Post.Empty.PublishedOn
let! older = let! older =
Custom.list Custom.list
$"{selectWithCriteria Table.Post} $"{selectWithCriteria Table.Post}

2
src/MyWebLog.Data/Postgres/PostgresTagMapData.fs
View File

@ -40,7 +40,7 @@ type PostgresTagMapData (log : ILogger) =
/// Find any tag mappings in a list of tags for the given web log /// Find any tag mappings in a list of tags for the given web log
let findMappingForTags tags webLogId = let findMappingForTags tags webLogId =
log.LogTrace "TagMap.findMappingForTags" log.LogTrace "TagMap.findMappingForTags"
let tagSql, tagParam = arrayContains (nameof TagMap.empty.Tag) id tags let tagSql, tagParam = arrayContains (nameof TagMap.Empty.Tag) id tags
Custom.list $"{selectWithCriteria Table.TagMap} AND {tagSql}" [ webLogContains webLogId; tagParam ] Custom.list $"{selectWithCriteria Table.TagMap} AND {tagSql}" [ webLogContains webLogId; tagParam ]
fromData<TagMap> fromData<TagMap>

2
src/MyWebLog.Data/Postgres/PostgresWebLogData.fs
View File

@ -23,7 +23,7 @@ type PostgresWebLogData (log : ILogger) =
log.LogTrace "WebLog.delete" log.LogTrace "WebLog.delete"
Custom.nonQuery Custom.nonQuery
$"""DELETE FROM {Table.PostComment} $"""DELETE FROM {Table.PostComment}
WHERE data ->> '{nameof Comment.empty.PostId}' IN WHERE data ->> '{nameof Comment.Empty.PostId}' IN
(SELECT id FROM {Table.Post} WHERE {Query.whereDataContains "@criteria"}); (SELECT id FROM {Table.Post} WHERE {Query.whereDataContains "@criteria"});
{Query.Delete.byContains Table.Post}; {Query.Delete.byContains Table.Post};
{Query.Delete.byContains Table.Page}; {Query.Delete.byContains Table.Page};

4
src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs
View File

@ -45,7 +45,7 @@ type PostgresWebLogUserData (log : ILogger) =
let findByWebLog webLogId = let findByWebLog webLogId =
log.LogTrace "WebLogUser.findByWebLog" log.LogTrace "WebLogUser.findByWebLog"
Custom.list Custom.list
$"{selectWithCriteria Table.WebLogUser} ORDER BY LOWER(data->>'{nameof WebLogUser.empty.PreferredName}')" $"{selectWithCriteria Table.WebLogUser} ORDER BY LOWER(data->>'{nameof WebLogUser.Empty.PreferredName}')"
[ webLogContains webLogId ] fromData<WebLogUser> [ webLogContains webLogId ] fromData<WebLogUser>
/// Find the names of users by their IDs for the given web log /// Find the names of users by their IDs for the given web log
@ -55,7 +55,7 @@ type PostgresWebLogUserData (log : ILogger) =
let! users = let! users =
Custom.list $"{selectWithCriteria Table.WebLogUser} {idSql}" (webLogContains webLogId :: idParams) Custom.list $"{selectWithCriteria Table.WebLogUser} {idSql}" (webLogContains webLogId :: idParams)
fromData<WebLogUser> fromData<WebLogUser>
return users |> List.map (fun u -> { Name = string u.Id; Value = WebLogUser.displayName u }) return users |> List.map (fun u -> { Name = string u.Id; Value = u.DisplayName })
} }
/// Restore users from a backup /// Restore users from a backup

22
src/MyWebLog.Data/PostgresData.fs
View File

@ -58,10 +58,10 @@ type PostgresData (log : ILogger<PostgresData>, ser : JsonSerializer) =
// Page tables // Page tables
if needsTable Table.Page then if needsTable Table.Page then
Definition.createTable Table.Page Definition.createTable Table.Page
$"CREATE INDEX page_web_log_idx ON {Table.Page} ((data ->> '{nameof Page.empty.WebLogId}'))" $"CREATE INDEX page_web_log_idx ON {Table.Page} ((data ->> '{nameof Page.Empty.WebLogId}'))"
$"CREATE INDEX page_author_idx ON {Table.Page} ((data ->> '{nameof Page.empty.AuthorId}'))" $"CREATE INDEX page_author_idx ON {Table.Page} ((data ->> '{nameof Page.Empty.AuthorId}'))"
$"CREATE INDEX page_permalink_idx ON {Table.Page} $"CREATE INDEX page_permalink_idx ON {Table.Page}
((data ->> '{nameof Page.empty.WebLogId}'), (data ->> '{nameof Page.empty.Permalink}'))" ((data ->> '{nameof Page.Empty.WebLogId}'), (data ->> '{nameof Page.Empty.Permalink}'))"
if needsTable Table.PageRevision then if needsTable Table.PageRevision then
$"CREATE TABLE {Table.PageRevision} ( $"CREATE TABLE {Table.PageRevision} (
page_id TEXT NOT NULL REFERENCES {Table.Page} (id) ON DELETE CASCADE, page_id TEXT NOT NULL REFERENCES {Table.Page} (id) ON DELETE CASCADE,
@ -72,15 +72,15 @@ type PostgresData (log : ILogger<PostgresData>, ser : JsonSerializer) =
// Post tables // Post tables
if needsTable Table.Post then if needsTable Table.Post then
Definition.createTable Table.Post Definition.createTable Table.Post
$"CREATE INDEX post_web_log_idx ON {Table.Post} ((data ->> '{nameof Post.empty.WebLogId}'))" $"CREATE INDEX post_web_log_idx ON {Table.Post} ((data ->> '{nameof Post.Empty.WebLogId}'))"
$"CREATE INDEX post_author_idx ON {Table.Post} ((data ->> '{nameof Post.empty.AuthorId}'))" $"CREATE INDEX post_author_idx ON {Table.Post} ((data ->> '{nameof Post.Empty.AuthorId}'))"
$"CREATE INDEX post_status_idx ON {Table.Post} $"CREATE INDEX post_status_idx ON {Table.Post}
((data ->> '{nameof Post.empty.WebLogId}'), (data ->> '{nameof Post.empty.Status}'), ((data ->> '{nameof Post.Empty.WebLogId}'), (data ->> '{nameof Post.Empty.Status}'),
(data ->> '{nameof Post.empty.UpdatedOn}'))" (data ->> '{nameof Post.Empty.UpdatedOn}'))"
$"CREATE INDEX post_permalink_idx ON {Table.Post} $"CREATE INDEX post_permalink_idx ON {Table.Post}
((data ->> '{nameof Post.empty.WebLogId}'), (data ->> '{nameof Post.empty.Permalink}'))" ((data ->> '{nameof Post.Empty.WebLogId}'), (data ->> '{nameof Post.Empty.Permalink}'))"
$"CREATE INDEX post_category_idx ON {Table.Post} USING GIN ((data['{nameof Post.empty.CategoryIds}']))" $"CREATE INDEX post_category_idx ON {Table.Post} USING GIN ((data['{nameof Post.Empty.CategoryIds}']))"
$"CREATE INDEX post_tag_idx ON {Table.Post} USING GIN ((data['{nameof Post.empty.Tags}']))" $"CREATE INDEX post_tag_idx ON {Table.Post} USING GIN ((data['{nameof Post.Empty.Tags}']))"
if needsTable Table.PostRevision then if needsTable Table.PostRevision then
$"CREATE TABLE {Table.PostRevision} ( $"CREATE TABLE {Table.PostRevision} (
post_id TEXT NOT NULL REFERENCES {Table.Post} (id) ON DELETE CASCADE, post_id TEXT NOT NULL REFERENCES {Table.Post} (id) ON DELETE CASCADE,
@ -90,7 +90,7 @@ type PostgresData (log : ILogger<PostgresData>, ser : JsonSerializer) =
if needsTable Table.PostComment then if needsTable Table.PostComment then
Definition.createTable Table.PostComment Definition.createTable Table.PostComment
$"CREATE INDEX post_comment_post_idx ON {Table.PostComment} $"CREATE INDEX post_comment_post_idx ON {Table.PostComment}
((data ->> '{nameof Comment.empty.PostId}'))" ((data ->> '{nameof Comment.Empty.PostId}'))"
// Tag map table // Tag map table
if needsTable Table.TagMap then if needsTable Table.TagMap then

254
src/MyWebLog.Data/RethinkDbData.fs
View File

@ -97,11 +97,11 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
/// Match theme asset IDs by their prefix (the theme ID) /// Match theme asset IDs by their prefix (the theme ID)
let matchAssetByThemeId themeId = let matchAssetByThemeId themeId =
let keyPrefix = $"^{themeId}/" let keyPrefix = $"^{themeId}/"
fun (row : Ast.ReqlExpr) -> row[nameof ThemeAsset.empty.Id].Match keyPrefix :> obj fun (row : Ast.ReqlExpr) -> row[nameof ThemeAsset.Empty.Id].Match keyPrefix :> obj
/// Function to exclude template text from themes /// Function to exclude template text from themes
let withoutTemplateText (row : Ast.ReqlExpr) : obj = let withoutTemplateText (row : Ast.ReqlExpr) : obj =
{| Templates = row[nameof Theme.empty.Templates].Without [| nameof ThemeTemplate.Empty.Text |] |} {| Templates = row[nameof Theme.Empty.Templates].Without [| nameof ThemeTemplate.Empty.Text |] |}
/// Ensure field indexes exist, as well as special indexes for selected tables /// Ensure field indexes exist, as well as special indexes for selected tables
let ensureIndexes table fields = backgroundTask { let ensureIndexes table fields = backgroundTask {
@ -112,27 +112,27 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
do! rethink { withTable table; indexCreate field; write; withRetryOnce; ignoreResult conn } do! rethink { withTable table; indexCreate field; write; withRetryOnce; ignoreResult conn }
// Post and page need index by web log ID and permalink // Post and page need index by web log ID and permalink
if [ Table.Page; Table.Post ] |> List.contains table then if [ Table.Page; Table.Post ] |> List.contains table then
let permalinkIdx = nameof Page.empty.Permalink let permalinkIdx = nameof Page.Empty.Permalink
if not (indexes |> List.contains permalinkIdx) then if not (indexes |> List.contains permalinkIdx) then
log.LogInformation $"Creating index {table}.{permalinkIdx}..." log.LogInformation $"Creating index {table}.{permalinkIdx}..."
do! rethink { do! rethink {
withTable table withTable table
indexCreate permalinkIdx indexCreate permalinkIdx
(fun row -> r.Array (row[nameof Page.empty.WebLogId], row[permalinkIdx].Downcase ()) :> obj) (fun row -> r.Array(row[nameof Page.Empty.WebLogId], row[permalinkIdx].Downcase()) :> obj)
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
// Prior permalinks are searched when a post or page permalink do not match the current URL // Prior permalinks are searched when a post or page permalink do not match the current URL
let priorIdx = nameof Post.empty.PriorPermalinks let priorIdx = nameof Post.Empty.PriorPermalinks
if not (indexes |> List.contains priorIdx) then if not (indexes |> List.contains priorIdx) then
log.LogInformation $"Creating index {table}.{priorIdx}..." log.LogInformation $"Creating index {table}.{priorIdx}..."
do! rethink { do! rethink {
withTable table withTable table
indexCreate priorIdx (fun row -> row[priorIdx].Downcase () :> obj) [ Multi ] indexCreate priorIdx (fun row -> row[priorIdx].Downcase() :> obj) [ Multi ]
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
// Post needs indexes by category and tag (used for counting and retrieving posts) // Post needs indexes by category and tag (used for counting and retrieving posts)
if Table.Post = table then if Table.Post = table then
for idx in [ nameof Post.empty.CategoryIds; nameof Post.empty.Tags ] do for idx in [ nameof Post.Empty.CategoryIds; nameof Post.Empty.Tags ] do
if not (List.contains idx indexes) then if not (List.contains idx indexes) then
log.LogInformation $"Creating index {table}.{idx}..." log.LogInformation $"Creating index {table}.{idx}..."
do! rethink { do! rethink {
@ -147,7 +147,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
do! rethink { do! rethink {
withTable table withTable table
indexCreate Index.WebLogAndTag (fun row -> indexCreate Index.WebLogAndTag (fun row ->
[| row[nameof TagMap.empty.WebLogId]; row[nameof TagMap.empty.Tag] |] :> obj) [| row[nameof TagMap.Empty.WebLogId]; row[nameof TagMap.Empty.Tag] |] :> obj)
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
if not (indexes |> List.contains Index.WebLogAndUrl) then if not (indexes |> List.contains Index.WebLogAndUrl) then
@ -155,7 +155,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
do! rethink { do! rethink {
withTable table withTable table
indexCreate Index.WebLogAndUrl (fun row -> indexCreate Index.WebLogAndUrl (fun row ->
[| row[nameof TagMap.empty.WebLogId]; row[nameof TagMap.empty.UrlValue] |] :> obj) [| row[nameof TagMap.Empty.WebLogId]; row[nameof TagMap.Empty.UrlValue] |] :> obj)
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
// Uploaded files need an index by web log ID and path, as that is how they are retrieved // Uploaded files need an index by web log ID and path, as that is how they are retrieved
@ -165,7 +165,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
do! rethink { do! rethink {
withTable table withTable table
indexCreate Index.WebLogAndPath (fun row -> indexCreate Index.WebLogAndPath (fun row ->
[| row[nameof Upload.empty.WebLogId]; row[nameof Upload.empty.Path] |] :> obj) [| row[nameof Upload.Empty.WebLogId]; row[nameof Upload.Empty.Path] |] :> obj)
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
// Users log on with e-mail // Users log on with e-mail
@ -175,7 +175,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
do! rethink { do! rethink {
withTable table withTable table
indexCreate Index.LogOn (fun row -> indexCreate Index.LogOn (fun row ->
[| row[nameof WebLogUser.empty.WebLogId]; row[nameof WebLogUser.empty.Email] |] :> obj) [| row[nameof WebLogUser.Empty.WebLogId]; row[nameof WebLogUser.Empty.Email] |] :> obj)
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
} }
@ -226,7 +226,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
Utils.logMigrationStep log "v2 to v2.1" "Adding empty redirect rule set to all weblogs" Utils.logMigrationStep log "v2 to v2.1" "Adding empty redirect rule set to all weblogs"
do! rethink { do! rethink {
withTable Table.WebLog withTable Table.WebLog
update [ nameof WebLog.empty.RedirectRules, [] :> obj ] update [ nameof WebLog.Empty.RedirectRules, [] :> obj ]
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
@ -271,15 +271,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.CountAll webLogId = rethink<int> { member _.CountAll webLogId = rethink<int> {
withTable Table.Category withTable Table.Category
getAll [ webLogId ] (nameof Category.empty.WebLogId) getAll [ webLogId ] (nameof Category.Empty.WebLogId)
count count
result; withRetryDefault conn result; withRetryDefault conn
} }
member _.CountTopLevel webLogId = rethink<int> { member _.CountTopLevel webLogId = rethink<int> {
withTable Table.Category withTable Table.Category
getAll [ webLogId ] (nameof Category.empty.WebLogId) getAll [ webLogId ] (nameof Category.Empty.WebLogId)
filter (nameof Category.empty.ParentId) None filter (nameof Category.Empty.ParentId) None
count count
result; withRetryDefault conn result; withRetryDefault conn
} }
@ -287,8 +287,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindAllForView webLogId = backgroundTask { member _.FindAllForView webLogId = backgroundTask {
let! cats = rethink<Category list> { let! cats = rethink<Category list> {
withTable Table.Category withTable Table.Category
getAll [ webLogId ] (nameof Category.empty.WebLogId) getAll [ webLogId ] (nameof Category.Empty.WebLogId)
orderByFunc (fun it -> it[nameof Category.empty.Name].Downcase () :> obj) orderByFunc (fun it -> it[nameof Category.Empty.Name].Downcase() :> obj)
result; withRetryDefault conn result; withRetryDefault conn
} }
let ordered = Utils.orderByHierarchy cats None None [] let ordered = Utils.orderByHierarchy cats None None []
@ -304,8 +304,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
|> List.ofSeq |> List.ofSeq
let! count = rethink<int> { let! count = rethink<int> {
withTable Table.Post withTable Table.Post
getAll catIds (nameof Post.empty.CategoryIds) getAll catIds (nameof Post.Empty.CategoryIds)
filter (nameof Post.empty.Status) Published filter (nameof Post.Empty.Status) Published
distinct distinct
count count
result; withRetryDefault conn result; withRetryDefault conn
@ -335,7 +335,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByWebLog webLogId = rethink<Category list> { member _.FindByWebLog webLogId = rethink<Category list> {
withTable Table.Category withTable Table.Category
getAll [ webLogId ] (nameof Category.empty.WebLogId) getAll [ webLogId ] (nameof Category.Empty.WebLogId)
result; withRetryDefault conn result; withRetryDefault conn
} }
@ -345,24 +345,24 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
// Reassign any children to the category's parent category // Reassign any children to the category's parent category
let! children = rethink<int> { let! children = rethink<int> {
withTable Table.Category withTable Table.Category
filter (nameof Category.empty.ParentId) catId filter (nameof Category.Empty.ParentId) catId
count count
result; withRetryDefault conn result; withRetryDefault conn
} }
if children > 0 then if children > 0 then
do! rethink { do! rethink {
withTable Table.Category withTable Table.Category
filter (nameof Category.empty.ParentId) catId filter (nameof Category.Empty.ParentId) catId
update [ nameof Category.empty.ParentId, cat.ParentId :> obj ] update [ nameof Category.Empty.ParentId, cat.ParentId :> obj ]
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
// Delete the category off all posts where it is assigned // Delete the category off all posts where it is assigned
do! rethink { do! rethink {
withTable Table.Post withTable Table.Post
getAll [ webLogId ] (nameof Post.empty.WebLogId) getAll [ webLogId ] (nameof Post.Empty.WebLogId)
filter (fun row -> row[nameof Post.empty.CategoryIds].Contains catId :> obj) filter (fun row -> row[nameof Post.Empty.CategoryIds].Contains catId :> obj)
update (fun row -> update (fun row ->
{| CategoryIds = r.Array(row[nameof Post.empty.CategoryIds]).Remove catId |} :> obj) {| CategoryIds = r.Array(row[nameof Post.Empty.CategoryIds]).Remove catId |} :> obj)
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
// Delete the category itself // Delete the category itself
@ -408,26 +408,26 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.All webLogId = rethink<Page list> { member _.All webLogId = rethink<Page list> {
withTable Table.Page withTable Table.Page
getAll [ webLogId ] (nameof Page.empty.WebLogId) getAll [ webLogId ] (nameof Page.Empty.WebLogId)
without [ nameof Page.empty.Text without [ nameof Page.Empty.Text
nameof Page.empty.Metadata nameof Page.Empty.Metadata
nameof Page.empty.Revisions nameof Page.Empty.Revisions
nameof Page.empty.PriorPermalinks ] nameof Page.Empty.PriorPermalinks ]
orderByFunc (fun row -> row[nameof Page.empty.Title].Downcase () :> obj) orderByFunc (fun row -> row[nameof Page.Empty.Title].Downcase() :> obj)
result; withRetryDefault conn result; withRetryDefault conn
} }
member _.CountAll webLogId = rethink<int> { member _.CountAll webLogId = rethink<int> {
withTable Table.Page withTable Table.Page
getAll [ webLogId ] (nameof Page.empty.WebLogId) getAll [ webLogId ] (nameof Page.Empty.WebLogId)
count count
result; withRetryDefault conn result; withRetryDefault conn
} }
member _.CountListed webLogId = rethink<int> { member _.CountListed webLogId = rethink<int> {
withTable Table.Page withTable Table.Page
getAll [ webLogId ] (nameof Page.empty.WebLogId) getAll [ webLogId ] (nameof Page.Empty.WebLogId)
filter (nameof Page.empty.IsInPageList) true filter (nameof Page.Empty.IsInPageList) true
count count
result; withRetryDefault conn result; withRetryDefault conn
} }
@ -436,7 +436,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! result = rethink<Model.Result> { let! result = rethink<Model.Result> {
withTable Table.Page withTable Table.Page
getAll [ pageId ] getAll [ pageId ]
filter (fun row -> row[nameof Page.empty.WebLogId].Eq webLogId :> obj) filter (fun row -> row[nameof Page.Empty.WebLogId].Eq webLogId :> obj)
delete delete
write; withRetryDefault conn write; withRetryDefault conn
} }
@ -447,7 +447,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
rethink<Page> { rethink<Page> {
withTable Table.Page withTable Table.Page
get pageId get pageId
without [ nameof Page.empty.PriorPermalinks; nameof Page.empty.Revisions ] without [ nameof Page.Empty.PriorPermalinks; nameof Page.Empty.Revisions ]
resultOption; withRetryOptionDefault resultOption; withRetryOptionDefault
} }
|> verifyWebLog webLogId (fun it -> it.WebLogId) <| conn |> verifyWebLog webLogId (fun it -> it.WebLogId) <| conn
@ -455,8 +455,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByPermalink permalink webLogId = member _.FindByPermalink permalink webLogId =
rethink<Page list> { rethink<Page list> {
withTable Table.Page withTable Table.Page
getAll [ [| webLogId :> obj; permalink |] ] (nameof Page.empty.Permalink) getAll [ [| webLogId :> obj; permalink |] ] (nameof Page.Empty.Permalink)
without [ nameof Page.empty.PriorPermalinks; nameof Page.empty.Revisions ] without [ nameof Page.Empty.PriorPermalinks; nameof Page.Empty.Revisions ]
limit 1 limit 1
result; withRetryDefault result; withRetryDefault
} }
@ -466,9 +466,9 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! result = let! result =
(rethink<Page list> { (rethink<Page list> {
withTable Table.Page withTable Table.Page
getAll (objList permalinks) (nameof Page.empty.PriorPermalinks) getAll (objList permalinks) (nameof Page.Empty.PriorPermalinks)
filter (nameof Page.empty.WebLogId) webLogId filter (nameof Page.Empty.WebLogId) webLogId
without [ nameof Page.empty.Revisions; nameof Page.empty.Text ] without [ nameof Page.Empty.Revisions; nameof Page.Empty.Text ]
limit 1 limit 1
result; withRetryDefault result; withRetryDefault
} }
@ -486,26 +486,26 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindFullByWebLog webLogId = rethink<Page> { member _.FindFullByWebLog webLogId = rethink<Page> {
withTable Table.Page withTable Table.Page
getAll [ webLogId ] (nameof Page.empty.WebLogId) getAll [ webLogId ] (nameof Page.Empty.WebLogId)
resultCursor; withRetryCursorDefault; toList conn resultCursor; withRetryCursorDefault; toList conn
} }
member _.FindListed webLogId = rethink<Page list> { member _.FindListed webLogId = rethink<Page list> {
withTable Table.Page withTable Table.Page
getAll [ webLogId ] (nameof Page.empty.WebLogId) getAll [ webLogId ] (nameof Page.Empty.WebLogId)
filter [ nameof Page.empty.IsInPageList, true :> obj ] filter [ nameof Page.Empty.IsInPageList, true :> obj ]
without [ nameof Page.empty.Text; nameof Page.empty.PriorPermalinks; nameof Page.empty.Revisions ] without [ nameof Page.Empty.Text; nameof Page.Empty.PriorPermalinks; nameof Page.Empty.Revisions ]
orderBy (nameof Page.empty.Title) orderBy (nameof Page.Empty.Title)
result; withRetryDefault conn result; withRetryDefault conn
} }
member _.FindPageOfPages webLogId pageNbr = rethink<Page list> { member _.FindPageOfPages webLogId pageNbr = rethink<Page list> {
withTable Table.Page withTable Table.Page
getAll [ webLogId ] (nameof Page.empty.WebLogId) getAll [ webLogId ] (nameof Page.Empty.WebLogId)
without [ nameof Page.empty.Metadata without [ nameof Page.Empty.Metadata
nameof Page.empty.PriorPermalinks nameof Page.Empty.PriorPermalinks
nameof Page.empty.Revisions ] nameof Page.Empty.Revisions ]
orderByFunc (fun row -> row[nameof Page.empty.Title].Downcase ()) orderByFunc (fun row -> row[nameof Page.Empty.Title].Downcase())
skip ((pageNbr - 1) * 25) skip ((pageNbr - 1) * 25)
limit 25 limit 25
result; withRetryDefault conn result; withRetryDefault conn
@ -543,7 +543,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
do! rethink { do! rethink {
withTable Table.Page withTable Table.Page
get pageId get pageId
update [ nameof Page.empty.PriorPermalinks, permalinks :> obj ] update [ nameof Page.Empty.PriorPermalinks, permalinks :> obj ]
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
return true return true
@ -562,8 +562,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.CountByStatus status webLogId = rethink<int> { member _.CountByStatus status webLogId = rethink<int> {
withTable Table.Post withTable Table.Post
getAll [ webLogId ] (nameof Post.empty.WebLogId) getAll [ webLogId ] (nameof Post.Empty.WebLogId)
filter (nameof Post.empty.Status) status filter (nameof Post.Empty.Status) status
count count
result; withRetryDefault conn result; withRetryDefault conn
} }
@ -572,7 +572,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! result = rethink<Model.Result> { let! result = rethink<Model.Result> {
withTable Table.Post withTable Table.Post
getAll [ postId ] getAll [ postId ]
filter (fun row -> row[nameof Post.empty.WebLogId].Eq webLogId :> obj) filter (fun row -> row[nameof Post.Empty.WebLogId].Eq webLogId :> obj)
delete delete
write; withRetryDefault conn write; withRetryDefault conn
} }
@ -583,7 +583,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
rethink<Post> { rethink<Post> {
withTable Table.Post withTable Table.Post
get postId get postId
without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ] without [ nameof Post.Empty.PriorPermalinks; nameof Post.Empty.Revisions ]
resultOption; withRetryOptionDefault resultOption; withRetryOptionDefault
} }
|> verifyWebLog webLogId (fun p -> p.WebLogId) <| conn |> verifyWebLog webLogId (fun p -> p.WebLogId) <| conn
@ -591,8 +591,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByPermalink permalink webLogId = member _.FindByPermalink permalink webLogId =
rethink<Post list> { rethink<Post list> {
withTable Table.Post withTable Table.Post
getAll [ [| webLogId :> obj; permalink |] ] (nameof Post.empty.Permalink) getAll [ [| webLogId :> obj; permalink |] ] (nameof Post.Empty.Permalink)
without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ] without [ nameof Post.Empty.PriorPermalinks; nameof Post.Empty.Revisions ]
limit 1 limit 1
result; withRetryDefault result; withRetryDefault
} }
@ -610,9 +610,9 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! result = let! result =
(rethink<Post list> { (rethink<Post list> {
withTable Table.Post withTable Table.Post
getAll (objList permalinks) (nameof Post.empty.PriorPermalinks) getAll (objList permalinks) (nameof Post.Empty.PriorPermalinks)
filter (nameof Post.empty.WebLogId) webLogId filter (nameof Post.Empty.WebLogId) webLogId
without [ nameof Post.empty.Revisions; nameof Post.empty.Text ] without [ nameof Post.Empty.Revisions; nameof Post.Empty.Text ]
limit 1 limit 1
result; withRetryDefault result; withRetryDefault
} }
@ -622,18 +622,18 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindFullByWebLog webLogId = rethink<Post> { member _.FindFullByWebLog webLogId = rethink<Post> {
withTable Table.Post withTable Table.Post
getAll [ webLogId ] (nameof Post.empty.WebLogId) getAll [ webLogId ] (nameof Post.Empty.WebLogId)
resultCursor; withRetryCursorDefault; toList conn resultCursor; withRetryCursorDefault; toList conn
} }
member _.FindPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = rethink<Post list> { member _.FindPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = rethink<Post list> {
withTable Table.Post withTable Table.Post
getAll (objList categoryIds) (nameof Post.empty.CategoryIds) getAll (objList categoryIds) (nameof Post.Empty.CategoryIds)
filter [ nameof Post.empty.WebLogId, webLogId :> obj filter [ nameof Post.Empty.WebLogId, webLogId :> obj
nameof Post.empty.Status, Published ] nameof Post.Empty.Status, Published ]
without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ] without [ nameof Post.Empty.PriorPermalinks; nameof Post.Empty.Revisions ]
distinct distinct
orderByDescending (nameof Post.empty.PublishedOn) orderByDescending (nameof Post.Empty.PublishedOn)
skip ((pageNbr - 1) * postsPerPage) skip ((pageNbr - 1) * postsPerPage)
limit (postsPerPage + 1) limit (postsPerPage + 1)
result; withRetryDefault conn result; withRetryDefault conn
@ -641,10 +641,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindPageOfPosts webLogId pageNbr postsPerPage = rethink<Post list> { member _.FindPageOfPosts webLogId pageNbr postsPerPage = rethink<Post list> {
withTable Table.Post withTable Table.Post
getAll [ webLogId ] (nameof Post.empty.WebLogId) getAll [ webLogId ] (nameof Post.Empty.WebLogId)
without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ] without [ nameof Post.Empty.PriorPermalinks; nameof Post.Empty.Revisions ]
orderByFuncDescending (fun row -> orderByFuncDescending (fun row ->
row[nameof Post.empty.PublishedOn].Default_ (nameof Post.empty.UpdatedOn) :> obj) row[nameof Post.Empty.PublishedOn].Default_(nameof Post.Empty.UpdatedOn) :> obj)
skip ((pageNbr - 1) * postsPerPage) skip ((pageNbr - 1) * postsPerPage)
limit (postsPerPage + 1) limit (postsPerPage + 1)
result; withRetryDefault conn result; withRetryDefault conn
@ -652,10 +652,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindPageOfPublishedPosts webLogId pageNbr postsPerPage = rethink<Post list> { member _.FindPageOfPublishedPosts webLogId pageNbr postsPerPage = rethink<Post list> {
withTable Table.Post withTable Table.Post
getAll [ webLogId ] (nameof Post.empty.WebLogId) getAll [ webLogId ] (nameof Post.Empty.WebLogId)
filter (nameof Post.empty.Status) Published filter (nameof Post.Empty.Status) Published
without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ] without [ nameof Post.Empty.PriorPermalinks; nameof Post.Empty.Revisions ]
orderByDescending (nameof Post.empty.PublishedOn) orderByDescending (nameof Post.Empty.PublishedOn)
skip ((pageNbr - 1) * postsPerPage) skip ((pageNbr - 1) * postsPerPage)
limit (postsPerPage + 1) limit (postsPerPage + 1)
result; withRetryDefault conn result; withRetryDefault conn
@ -663,11 +663,11 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindPageOfTaggedPosts webLogId tag pageNbr postsPerPage = rethink<Post list> { member _.FindPageOfTaggedPosts webLogId tag pageNbr postsPerPage = rethink<Post list> {
withTable Table.Post withTable Table.Post
getAll [ tag ] (nameof Post.empty.Tags) getAll [ tag ] (nameof Post.Empty.Tags)
filter [ nameof Post.empty.WebLogId, webLogId :> obj filter [ nameof Post.Empty.WebLogId, webLogId :> obj
nameof Post.empty.Status, Published ] nameof Post.Empty.Status, Published ]
without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ] without [ nameof Post.Empty.PriorPermalinks; nameof Post.Empty.Revisions ]
orderByDescending (nameof Post.empty.PublishedOn) orderByDescending (nameof Post.Empty.PublishedOn)
skip ((pageNbr - 1) * postsPerPage) skip ((pageNbr - 1) * postsPerPage)
limit (postsPerPage + 1) limit (postsPerPage + 1)
result; withRetryDefault conn result; withRetryDefault conn
@ -677,10 +677,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! older = let! older =
rethink<Post list> { rethink<Post list> {
withTable Table.Post withTable Table.Post
getAll [ webLogId ] (nameof Post.empty.WebLogId) getAll [ webLogId ] (nameof Post.Empty.WebLogId)
filter (fun row -> row[nameof Post.empty.PublishedOn].Lt publishedOn :> obj) filter (fun row -> row[nameof Post.Empty.PublishedOn].Lt publishedOn :> obj)
without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ] without [ nameof Post.Empty.PriorPermalinks; nameof Post.Empty.Revisions ]
orderByDescending (nameof Post.empty.PublishedOn) orderByDescending (nameof Post.Empty.PublishedOn)
limit 1 limit 1
result; withRetryDefault result; withRetryDefault
} }
@ -688,10 +688,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! newer = let! newer =
rethink<Post list> { rethink<Post list> {
withTable Table.Post withTable Table.Post
getAll [ webLogId ] (nameof Post.empty.WebLogId) getAll [ webLogId ] (nameof Post.Empty.WebLogId)
filter (fun row -> row[nameof Post.empty.PublishedOn].Gt publishedOn :> obj) filter (fun row -> row[nameof Post.Empty.PublishedOn].Gt publishedOn :> obj)
without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ] without [ nameof Post.Empty.PriorPermalinks; nameof Post.Empty.Revisions ]
orderBy (nameof Post.empty.PublishedOn) orderBy (nameof Post.Empty.PublishedOn)
limit 1 limit 1
result; withRetryDefault result; withRetryDefault
} }
@ -720,15 +720,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
rethink<Post> { rethink<Post> {
withTable Table.Post withTable Table.Post
get postId get postId
without [ nameof Post.empty.Revisions; nameof Post.empty.PriorPermalinks ] without [ nameof Post.Empty.Revisions; nameof Post.Empty.PriorPermalinks ]
resultOption; withRetryOptionDefault resultOption; withRetryOptionDefault
} }
|> verifyWebLog webLogId (fun p -> p.WebLogId)) conn with |> verifyWebLog webLogId (_.WebLogId)) conn with
| Some _ -> | Some _ ->
do! rethink { do! rethink {
withTable Table.Post withTable Table.Post
get postId get postId
update [ nameof Post.empty.PriorPermalinks, permalinks :> obj ] update [ nameof Post.Empty.PriorPermalinks, permalinks :> obj ]
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
return true return true
@ -743,7 +743,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! result = rethink<Model.Result> { let! result = rethink<Model.Result> {
withTable Table.TagMap withTable Table.TagMap
getAll [ tagMapId ] getAll [ tagMapId ]
filter (fun row -> row[nameof TagMap.empty.WebLogId].Eq webLogId :> obj) filter (fun row -> row[nameof TagMap.Empty.WebLogId].Eq webLogId :> obj)
delete delete
write; withRetryDefault conn write; withRetryDefault conn
} }
@ -756,7 +756,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get tagMapId get tagMapId
resultOption; withRetryOptionDefault resultOption; withRetryOptionDefault
} }
|> verifyWebLog webLogId (fun tm -> tm.WebLogId) <| conn |> verifyWebLog webLogId (_.WebLogId) <| conn
member _.FindByUrlValue urlValue webLogId = member _.FindByUrlValue urlValue webLogId =
rethink<TagMap list> { rethink<TagMap list> {
@ -769,9 +769,9 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByWebLog webLogId = rethink<TagMap list> { member _.FindByWebLog webLogId = rethink<TagMap list> {
withTable Table.TagMap withTable Table.TagMap
between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |] between [| webLogId :> obj; r.Minval() |] [| webLogId :> obj; r.Maxval() |]
[ Index Index.WebLogAndTag ] [ Index Index.WebLogAndTag ]
orderBy (nameof TagMap.empty.Tag) orderBy (nameof TagMap.Empty.Tag)
result; withRetryDefault conn result; withRetryDefault conn
} }
@ -803,16 +803,16 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.All () = rethink<Theme list> { member _.All () = rethink<Theme list> {
withTable Table.Theme withTable Table.Theme
filter (fun row -> row[nameof Theme.empty.Id].Ne "admin" :> obj) filter (fun row -> row[nameof Theme.Empty.Id].Ne "admin" :> obj)
merge withoutTemplateText merge withoutTemplateText
orderBy (nameof Theme.empty.Id) orderBy (nameof Theme.Empty.Id)
result; withRetryDefault conn result; withRetryDefault conn
} }
member _.Exists themeId = backgroundTask { member _.Exists themeId = backgroundTask {
let! count = rethink<int> { let! count = rethink<int> {
withTable Table.Theme withTable Table.Theme
filter (nameof Theme.empty.Id) themeId filter (nameof Theme.Empty.Id) themeId
count count
result; withRetryDefault conn result; withRetryDefault conn
} }
@ -859,7 +859,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.All () = rethink<ThemeAsset list> { member _.All () = rethink<ThemeAsset list> {
withTable Table.ThemeAsset withTable Table.ThemeAsset
without [ nameof ThemeAsset.empty.Data ] without [ nameof ThemeAsset.Empty.Data ]
result; withRetryDefault conn result; withRetryDefault conn
} }
@ -874,7 +874,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByTheme themeId = rethink<ThemeAsset list> { member _.FindByTheme themeId = rethink<ThemeAsset list> {
withTable Table.ThemeAsset withTable Table.ThemeAsset
filter (matchAssetByThemeId themeId) filter (matchAssetByThemeId themeId)
without [ nameof ThemeAsset.empty.Data ] without [ nameof ThemeAsset.Empty.Data ]
result; withRetryDefault conn result; withRetryDefault conn
} }
@ -931,9 +931,9 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByWebLog webLogId = rethink<Upload> { member _.FindByWebLog webLogId = rethink<Upload> {
withTable Table.Upload withTable Table.Upload
between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |] between [| webLogId :> obj; r.Minval() |] [| webLogId :> obj; r.Maxval() |]
[ Index Index.WebLogAndPath ] [ Index Index.WebLogAndPath ]
without [ nameof Upload.empty.Data ] without [ nameof Upload.Empty.Data ]
resultCursor; withRetryCursorDefault; toList conn resultCursor; withRetryCursorDefault; toList conn
} }
@ -973,22 +973,22 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
// Comments should be deleted by post IDs // Comments should be deleted by post IDs
let! thePostIds = rethink<{| Id : string |} list> { let! thePostIds = rethink<{| Id : string |} list> {
withTable Table.Post withTable Table.Post
getAll [ webLogId ] (nameof Post.empty.WebLogId) getAll [ webLogId ] (nameof Post.Empty.WebLogId)
pluck [ nameof Post.empty.Id ] pluck [ nameof Post.Empty.Id ]
result; withRetryOnce conn result; withRetryOnce conn
} }
if not (List.isEmpty thePostIds) then if not (List.isEmpty thePostIds) then
let postIds = thePostIds |> List.map (fun it -> it.Id :> obj) let postIds = thePostIds |> List.map (fun it -> it.Id :> obj)
do! rethink { do! rethink {
withTable Table.Comment withTable Table.Comment
getAll postIds (nameof Comment.empty.PostId) getAll postIds (nameof Comment.Empty.PostId)
delete delete
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
// Tag mappings do not have a straightforward webLogId index // Tag mappings do not have a straightforward webLogId index
do! rethink { do! rethink {
withTable Table.TagMap withTable Table.TagMap
between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |] between [| webLogId :> obj; r.Minval() |] [| webLogId :> obj; r.Maxval() |]
[ Index Index.WebLogAndTag ] [ Index Index.WebLogAndTag ]
delete delete
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
@ -996,7 +996,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
// Uploaded files do not have a straightforward webLogId index // Uploaded files do not have a straightforward webLogId index
do! rethink { do! rethink {
withTable Table.Upload withTable Table.Upload
between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |] between [| webLogId :> obj; r.Minval() |] [| webLogId :> obj; r.Maxval() |]
[ Index Index.WebLogAndPath ] [ Index Index.WebLogAndPath ]
delete delete
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
@ -1004,7 +1004,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
for table in [ Table.Post; Table.Category; Table.Page; Table.WebLogUser ] do for table in [ Table.Post; Table.Category; Table.Page; Table.WebLogUser ] do
do! rethink { do! rethink {
withTable table withTable table
getAll [ webLogId ] (nameof Post.empty.WebLogId) getAll [ webLogId ] (nameof Post.Empty.WebLogId)
delete delete
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
@ -1019,7 +1019,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByHost url = member _.FindByHost url =
rethink<WebLog list> { rethink<WebLog list> {
withTable Table.WebLog withTable Table.WebLog
getAll [ url ] (nameof WebLog.empty.UrlBase) getAll [ url ] (nameof WebLog.Empty.UrlBase)
limit 1 limit 1
result; withRetryDefault result; withRetryDefault
} }
@ -1034,14 +1034,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.UpdateRedirectRules webLog = rethink { member _.UpdateRedirectRules webLog = rethink {
withTable Table.WebLog withTable Table.WebLog
get webLog.Id get webLog.Id
update [ nameof WebLog.empty.RedirectRules, webLog.RedirectRules :> obj ] update [ nameof WebLog.Empty.RedirectRules, webLog.RedirectRules :> obj ]
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
member _.UpdateRssOptions webLog = rethink { member _.UpdateRssOptions webLog = rethink {
withTable Table.WebLog withTable Table.WebLog
get webLog.Id get webLog.Id
update [ nameof WebLog.empty.Rss, webLog.Rss :> obj ] update [ nameof WebLog.Empty.Rss, webLog.Rss :> obj ]
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
@ -1085,15 +1085,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
| Some _ -> | Some _ ->
let! pageCount = rethink<int> { let! pageCount = rethink<int> {
withTable Table.Page withTable Table.Page
getAll [ webLogId ] (nameof Page.empty.WebLogId) getAll [ webLogId ] (nameof Page.Empty.WebLogId)
filter (nameof Page.empty.AuthorId) userId filter (nameof Page.Empty.AuthorId) userId
count count
result; withRetryDefault conn result; withRetryDefault conn
} }
let! postCount = rethink<int> { let! postCount = rethink<int> {
withTable Table.Post withTable Table.Post
getAll [ webLogId ] (nameof Post.empty.WebLogId) getAll [ webLogId ] (nameof Post.Empty.WebLogId)
filter (nameof Post.empty.AuthorId) userId filter (nameof Post.Empty.AuthorId) userId
count count
result; withRetryDefault conn result; withRetryDefault conn
} }
@ -1121,8 +1121,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByWebLog webLogId = rethink<WebLogUser list> { member _.FindByWebLog webLogId = rethink<WebLogUser list> {
withTable Table.WebLogUser withTable Table.WebLogUser
getAll [ webLogId ] (nameof WebLogUser.empty.WebLogId) getAll [ webLogId ] (nameof WebLogUser.Empty.WebLogId)
orderByFunc (fun row -> row[nameof WebLogUser.empty.PreferredName].Downcase ()) orderByFunc (fun row -> row[nameof WebLogUser.Empty.PreferredName].Downcase())
result; withRetryDefault conn result; withRetryDefault conn
} }
@ -1130,10 +1130,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! users = rethink<WebLogUser list> { let! users = rethink<WebLogUser list> {
withTable Table.WebLogUser withTable Table.WebLogUser
getAll (objList userIds) getAll (objList userIds)
filter (nameof WebLogUser.empty.WebLogId) webLogId filter (nameof WebLogUser.Empty.WebLogId) webLogId
result; withRetryDefault conn result; withRetryDefault conn
} }
return users |> List.map (fun u -> { Name = string u.Id; Value = WebLogUser.displayName u }) return users |> List.map (fun u -> { Name = string u.Id; Value = u.DisplayName })
} }
member _.Restore users = backgroundTask { member _.Restore users = backgroundTask {
@ -1151,7 +1151,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
do! rethink { do! rethink {
withTable Table.WebLogUser withTable Table.WebLogUser
get userId get userId
update [ nameof WebLogUser.empty.LastSeenOn, Noda.now () :> obj ] update [ nameof WebLogUser.Empty.LastSeenOn, Noda.now () :> obj ]
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
| None -> () | None -> ()
@ -1196,19 +1196,19 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
do! ensureIndexes Table.Category [ nameof Category.empty.WebLogId ] do! ensureIndexes Table.Category [ nameof Category.Empty.WebLogId ]
do! ensureIndexes Table.Comment [ nameof Comment.empty.PostId ] do! ensureIndexes Table.Comment [ nameof Comment.Empty.PostId ]
do! ensureIndexes Table.Page [ nameof Page.empty.WebLogId; nameof Page.empty.AuthorId ] do! ensureIndexes Table.Page [ nameof Page.Empty.WebLogId; nameof Page.Empty.AuthorId ]
do! ensureIndexes Table.Post [ nameof Post.empty.WebLogId; nameof Post.empty.AuthorId ] do! ensureIndexes Table.Post [ nameof Post.Empty.WebLogId; nameof Post.Empty.AuthorId ]
do! ensureIndexes Table.TagMap [] do! ensureIndexes Table.TagMap []
do! ensureIndexes Table.Upload [] do! ensureIndexes Table.Upload []
do! ensureIndexes Table.WebLog [ nameof WebLog.empty.UrlBase ] do! ensureIndexes Table.WebLog [ nameof WebLog.Empty.UrlBase ]
do! ensureIndexes Table.WebLogUser [ nameof WebLogUser.empty.WebLogId ] do! ensureIndexes Table.WebLogUser [ nameof WebLogUser.Empty.WebLogId ]
let! version = rethink<{| Id : string |} list> { let! version = rethink<{| Id : string |} list> {
withTable Table.DbVersion withTable Table.DbVersion
limit 1 limit 1
result; withRetryOnce conn result; withRetryOnce conn
} }
do! migrate (List.tryHead version |> Option.map (fun x -> x.Id)) do! migrate (List.tryHead version |> Option.map _.Id)
} }

6
src/MyWebLog.Data/SQLite/Helpers.fs
View File

@ -232,7 +232,7 @@ module Map =
/// Create a page from the current row in the given data reader /// Create a page from the current row in the given data reader
let toPage ser rdr : Page = let toPage ser rdr : Page =
{ Page.empty with { Page.Empty with
Id = getString "id" rdr |> PageId Id = getString "id" rdr |> PageId
WebLogId = getString "web_log_id" rdr |> WebLogId WebLogId = getString "web_log_id" rdr |> WebLogId
AuthorId = getString "author_id" rdr |> WebLogUserId AuthorId = getString "author_id" rdr |> WebLogUserId
@ -250,7 +250,7 @@ module Map =
/// Create a post from the current row in the given data reader /// Create a post from the current row in the given data reader
let toPost ser rdr : Post = let toPost ser rdr : Post =
{ Post.empty with { Post.Empty with
Id = getString "id" rdr |> PostId Id = getString "id" rdr |> PostId
WebLogId = getString "web_log_id" rdr |> WebLogId WebLogId = getString "web_log_id" rdr |> WebLogId
AuthorId = getString "author_id" rdr |> WebLogUserId AuthorId = getString "author_id" rdr |> WebLogUserId
@ -283,7 +283,7 @@ module Map =
/// Create a theme from the current row in the given data reader (excludes templates) /// Create a theme from the current row in the given data reader (excludes templates)
let toTheme rdr : Theme = let toTheme rdr : Theme =
{ Theme.empty with { Theme.Empty with
Id = getString "id" rdr |> ThemeId Id = getString "id" rdr |> ThemeId
Name = getString "name" rdr Name = getString "name" rdr
Version = getString "version" rdr Version = getString "version" rdr

3
src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs
View File

@ -96,8 +96,7 @@ type SQLiteWebLogUserData(conn: SqliteConnection) =
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddRange nameParams cmd.Parameters.AddRange nameParams
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return return toList Map.toWebLogUser rdr |> List.map (fun u -> { Name = string u.Id; Value = u.DisplayName })
toList Map.toWebLogUser rdr |> List.map (fun u -> { Name = string u.Id; Value = WebLogUser.displayName u })
} }
/// Restore users from a backup /// Restore users from a backup

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

@ -8,29 +8,26 @@ open NodaTime
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Category = { type Category = {
/// The ID of the category /// The ID of the category
Id : CategoryId Id: CategoryId
/// The ID of the web log to which the category belongs /// The ID of the web log to which the category belongs
WebLogId : WebLogId WebLogId: WebLogId
/// The displayed name /// The displayed name
Name : string Name: string
/// The slug (used in category URLs) /// The slug (used in category URLs)
Slug : string Slug: string
/// A longer description of the category /// A longer description of the category
Description : string option Description: string option
/// The parent ID of this category (if a subcategory) /// The parent ID of this category (if a subcategory)
ParentId : CategoryId option ParentId: CategoryId option
} } with
/// Functions to support categories
module Category =
/// An empty category /// An empty category
let empty = { static member Empty = {
Id = CategoryId.Empty Id = CategoryId.Empty
WebLogId = WebLogId.Empty WebLogId = WebLogId.Empty
Name = "" Name = ""
@ -44,38 +41,35 @@ module Category =
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Comment = { type Comment = {
/// The ID of the comment /// The ID of the comment
Id : CommentId Id: CommentId
/// The ID of the post to which this comment applies /// The ID of the post to which this comment applies
PostId : PostId PostId: PostId
/// The ID of the comment to which this comment is a reply /// The ID of the comment to which this comment is a reply
InReplyToId : CommentId option InReplyToId: CommentId option
/// The name of the commentor /// The name of the commentor
Name : string Name: string
/// The e-mail address of the commentor /// The e-mail address of the commentor
Email : string Email: string
/// The URL of the commentor's personal website /// The URL of the commentor's personal website
Url : string option Url: string option
/// The status of the comment /// The status of the comment
Status : CommentStatus Status: CommentStatus
/// When the comment was posted /// When the comment was posted
PostedOn : Instant PostedOn: Instant
/// The text of the comment /// The text of the comment
Text : string Text: string
} } with
/// Functions to support comments
module Comment =
/// An empty comment /// An empty comment
let empty = { static member Empty = {
Id = CommentId.Empty Id = CommentId.Empty
PostId = PostId.Empty PostId = PostId.Empty
InReplyToId = None InReplyToId = None
@ -92,50 +86,47 @@ module Comment =
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Page = { type Page = {
/// The ID of this page /// The ID of this page
Id : PageId Id: PageId
/// The ID of the web log to which this page belongs /// The ID of the web log to which this page belongs
WebLogId : WebLogId WebLogId: WebLogId
/// The ID of the author of this page /// The ID of the author of this page
AuthorId : WebLogUserId AuthorId: WebLogUserId
/// The title of the page /// The title of the page
Title : string Title: string
/// The link at which this page is displayed /// The link at which this page is displayed
Permalink : Permalink Permalink: Permalink
/// When this page was published /// When this page was published
PublishedOn : Instant PublishedOn: Instant
/// When this page was last updated /// When this page was last updated
UpdatedOn : Instant UpdatedOn: Instant
/// Whether this page shows as part of the web log's navigation /// Whether this page shows as part of the web log's navigation
IsInPageList : bool IsInPageList: bool
/// The template to use when rendering this page /// The template to use when rendering this page
Template : string option Template: string option
/// The current text of the page /// The current text of the page
Text : string Text: string
/// Metadata for this page /// Metadata for this page
Metadata : MetaItem list Metadata: MetaItem list
/// Permalinks at which this page may have been previously served (useful for migrated content) /// Permalinks at which this page may have been previously served (useful for migrated content)
PriorPermalinks : Permalink list PriorPermalinks: Permalink list
/// Revisions of this page /// Revisions of this page
Revisions : Revision list Revisions: Revision list
} } with
/// Functions to support pages
module Page =
/// An empty page /// An empty page
let empty = { static member Empty = {
Id = PageId.Empty Id = PageId.Empty
WebLogId = WebLogId.Empty WebLogId = WebLogId.Empty
AuthorId = WebLogUserId.Empty AuthorId = WebLogUserId.Empty
@ -156,59 +147,56 @@ module Page =
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Post = { type Post = {
/// The ID of this post /// The ID of this post
Id : PostId Id: PostId
/// The ID of the web log to which this post belongs /// The ID of the web log to which this post belongs
WebLogId : WebLogId WebLogId: WebLogId
/// The ID of the author of this post /// The ID of the author of this post
AuthorId : WebLogUserId AuthorId: WebLogUserId
/// The status /// The status
Status : PostStatus Status: PostStatus
/// The title /// The title
Title : string Title: string
/// The link at which the post resides /// The link at which the post resides
Permalink : Permalink Permalink: Permalink
/// The instant on which the post was originally published /// The instant on which the post was originally published
PublishedOn : Instant option PublishedOn: Instant option
/// The instant on which the post was last updated /// The instant on which the post was last updated
UpdatedOn : Instant UpdatedOn: Instant
/// The template to use in displaying the post /// The template to use in displaying the post
Template : string option Template: string option
/// The text of the post in HTML (ready to display) format /// The text of the post in HTML (ready to display) format
Text : string Text: string
/// The Ids of the categories to which this is assigned /// The Ids of the categories to which this is assigned
CategoryIds : CategoryId list CategoryIds: CategoryId list
/// The tags for the post /// The tags for the post
Tags : string list Tags: string list
/// Podcast episode information for this post /// Podcast episode information for this post
Episode : Episode option Episode: Episode option
/// Metadata for the post /// Metadata for the post
Metadata : MetaItem list Metadata: MetaItem list
/// Permalinks at which this post may have been previously served (useful for migrated content) /// Permalinks at which this post may have been previously served (useful for migrated content)
PriorPermalinks : Permalink list PriorPermalinks: Permalink list
/// The revisions for this post /// The revisions for this post
Revisions : Revision list Revisions: Revision list
} } with
/// Functions to support posts
module Post =
/// An empty post /// An empty post
let empty = { static member Empty = {
Id = PostId.Empty Id = PostId.Empty
WebLogId = WebLogId.Empty WebLogId = WebLogId.Empty
AuthorId = WebLogUserId.Empty AuthorId = WebLogUserId.Empty
@ -229,25 +217,23 @@ module Post =
/// A mapping between a tag and its URL value, used to translate restricted characters (ex. "#1" -> "number-1") /// A mapping between a tag and its URL value, used to translate restricted characters (ex. "#1" -> "number-1")
[<CLIMutable; NoComparison; NoEquality>]
type TagMap = { type TagMap = {
/// The ID of this tag mapping /// The ID of this tag mapping
Id : TagMapId Id: TagMapId
/// The ID of the web log to which this tag mapping belongs /// The ID of the web log to which this tag mapping belongs
WebLogId : WebLogId WebLogId: WebLogId
/// The tag which should be mapped to a different value in links /// The tag which should be mapped to a different value in links
Tag : string Tag: string
/// The value by which the tag should be linked /// The value by which the tag should be linked
UrlValue : string UrlValue: string
} } with
/// Functions to support tag mappings
module TagMap =
/// An empty tag mapping /// An empty tag mapping
let empty = { static member Empty = {
Id = TagMapId.Empty Id = TagMapId.Empty
WebLogId = WebLogId.Empty WebLogId = WebLogId.Empty
Tag = "" Tag = ""
@ -256,26 +242,24 @@ module TagMap =
/// A theme /// A theme
[<CLIMutable; NoComparison; NoEquality>]
type Theme = { type Theme = {
/// The ID / path of the theme /// The ID / path of the theme
Id : ThemeId Id: ThemeId
/// A long name of the theme /// A long name of the theme
Name : string Name: string
/// The version of the theme /// The version of the theme
Version : string Version: string
/// The templates for this theme /// The templates for this theme
Templates: ThemeTemplate list Templates: ThemeTemplate list
} } with
/// Functions to support themes
module Theme =
/// An empty theme /// An empty theme
let empty = { static member Empty = {
Id = ThemeId "" Id = ThemeId.Empty
Name = "" Name = ""
Version = "" Version = ""
Templates = [] Templates = []
@ -283,51 +267,47 @@ module Theme =
/// A theme asset (a file served as part of a theme, at /themes/[theme]/[asset-path]) /// A theme asset (a file served as part of a theme, at /themes/[theme]/[asset-path])
[<CLIMutable; NoComparison; NoEquality>]
type ThemeAsset = { type ThemeAsset = {
/// The ID of the asset (consists of theme and path) /// The ID of the asset (consists of theme and path)
Id : ThemeAssetId Id: ThemeAssetId
/// The updated date (set from the file date from the ZIP archive) /// The updated date (set from the file date from the ZIP archive)
UpdatedOn : Instant UpdatedOn: Instant
/// The data for the asset /// The data for the asset
Data : byte[] Data: byte array
} } with
/// Functions to support theme assets
module ThemeAsset =
/// An empty theme asset /// An empty theme asset
let empty = { static member Empty = {
Id = ThemeAssetId (ThemeId "", "") Id = ThemeAssetId.Empty
UpdatedOn = Noda.epoch UpdatedOn = Noda.epoch
Data = [||] Data = [||]
} }
/// An uploaded file /// An uploaded file
[<CLIMutable; NoComparison; NoEquality>]
type Upload = { type Upload = {
/// The ID of the upload /// The ID of the upload
Id : UploadId Id: UploadId
/// The ID of the web log to which this upload belongs /// The ID of the web log to which this upload belongs
WebLogId : WebLogId WebLogId: WebLogId
/// The link at which this upload is served /// The link at which this upload is served
Path : Permalink Path: Permalink
/// The updated date/time for this upload /// The updated date/time for this upload
UpdatedOn : Instant UpdatedOn: Instant
/// The data for the upload /// The data for the upload
Data : byte[] Data: byte array
} } with
/// Functions to support uploaded files
module Upload =
/// An empty upload /// An empty upload
let empty = { static member Empty = {
Id = UploadId.Empty Id = UploadId.Empty
WebLogId = WebLogId.Empty WebLogId = WebLogId.Empty
Path = Permalink.Empty Path = Permalink.Empty
@ -336,54 +316,53 @@ module Upload =
} }
open Newtonsoft.Json
/// A web log /// A web log
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type WebLog = { type WebLog = {
/// The ID of the web log /// The ID of the web log
Id : WebLogId Id: WebLogId
/// The name of the web log /// The name of the web log
Name : string Name: string
/// The slug of the web log /// The slug of the web log
Slug : string Slug: string
/// A subtitle for the web log /// A subtitle for the web log
Subtitle : string option Subtitle: string option
/// The default page ("posts" or a page Id) /// The default page ("posts" or a page Id)
DefaultPage : string DefaultPage: string
/// The number of posts to display on pages of posts /// The number of posts to display on pages of posts
PostsPerPage : int PostsPerPage: int
/// The ID of the theme (also the path within /themes) /// The ID of the theme (also the path within /themes)
ThemeId : ThemeId ThemeId: ThemeId
/// The URL base /// The URL base
UrlBase : string UrlBase: string
/// The time zone in which dates/times should be displayed /// The time zone in which dates/times should be displayed
TimeZone : string TimeZone: string
/// The RSS options for this web log /// The RSS options for this web log
Rss : RssOptions Rss: RssOptions
/// Whether to automatically load htmx /// Whether to automatically load htmx
AutoHtmx : bool AutoHtmx: bool
/// Where uploads are placed /// Where uploads are placed
Uploads : UploadDestination Uploads: UploadDestination
/// Redirect rules for this weblog /// Redirect rules for this weblog
RedirectRules : RedirectRule list RedirectRules: RedirectRule list
} } with
/// Functions to support web logs
module WebLog =
/// An empty web log /// An empty web log
let empty = { static member Empty = {
Id = WebLogId.Empty Id = WebLogId.Empty
Name = "" Name = ""
Slug = "" Slug = ""
@ -399,24 +378,23 @@ module WebLog =
RedirectRules = [] RedirectRules = []
} }
/// Get the host (including scheme) and extra path from the URL base /// Any extra path where this web log is hosted (blank if web log is hosted at the root of the domain)
let hostAndPath webLog = [<JsonIgnore>]
let scheme = webLog.UrlBase.Split "://" member this.ExtraPath =
let host = scheme[1].Split "/" let path = this.UrlBase.Split("://").[1].Split "/"
$"{scheme[0]}://{host[0]}", if host.Length > 1 then $"""/{String.Join("/", host |> Array.skip 1)}""" else "" if path.Length > 1 then $"""/{String.Join("/", path |> Array.skip 1)}""" else ""
/// Generate an absolute URL for the given link /// Generate an absolute URL for the given link
let absoluteUrl webLog (permalink: Permalink) = member this.AbsoluteUrl(permalink: Permalink) =
$"{webLog.UrlBase}/{permalink}" $"{this.UrlBase}/{permalink}"
/// Generate a relative URL for the given link /// Generate a relative URL for the given link
let relativeUrl webLog (permalink: Permalink) = member this.RelativeUrl(permalink: Permalink) =
let _, leadPath = hostAndPath webLog $"{this.ExtraPath}/{permalink}"
$"{leadPath}/{permalink}"
/// Convert an Instant (UTC reference) to the web log's local date/time /// Convert an Instant (UTC reference) to the web log's local date/time
let localTime webLog (date: Instant) = member this.LocalTime(date: Instant) =
match DateTimeZoneProviders.Tzdb[webLog.TimeZone] with match DateTimeZoneProviders.Tzdb[this.TimeZone] with
| null -> date.ToDateTimeUtc() | null -> date.ToDateTimeUtc()
| tz -> date.InZone(tz).ToDateTimeUnspecified() | tz -> date.InZone(tz).ToDateTimeUnspecified()
@ -425,44 +403,41 @@ module WebLog =
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type WebLogUser = { type WebLogUser = {
/// The ID of the user /// The ID of the user
Id : WebLogUserId Id: WebLogUserId
/// The ID of the web log to which this user belongs /// The ID of the web log to which this user belongs
WebLogId : WebLogId WebLogId: WebLogId
/// The user name (e-mail address) /// The user name (e-mail address)
Email : string Email: string
/// The user's first name /// The user's first name
FirstName : string FirstName: string
/// The user's last name /// The user's last name
LastName : string LastName: string
/// The user's preferred name /// The user's preferred name
PreferredName : string PreferredName: string
/// The hash of the user's password /// The hash of the user's password
PasswordHash : string PasswordHash: string
/// The URL of the user's personal site /// The URL of the user's personal site
Url : string option Url: string option
/// The user's access level /// The user's access level
AccessLevel : AccessLevel AccessLevel: AccessLevel
/// When the user was created /// When the user was created
CreatedOn : Instant CreatedOn: Instant
/// When the user last logged on /// When the user last logged on
LastSeenOn : Instant option LastSeenOn: Instant option
} } with
/// Functions to support web log users
module WebLogUser =
/// An empty web log user /// An empty web log user
let empty = { static member Empty = {
Id = WebLogUserId.Empty Id = WebLogUserId.Empty
WebLogId = WebLogId.Empty WebLogId = WebLogId.Empty
Email = "" Email = ""
@ -477,12 +452,7 @@ module WebLogUser =
} }
/// Get the user's displayed name /// Get the user's displayed name
let displayName user = [<JsonIgnore>]
let name = member this.DisplayName =
seq { match user.PreferredName with "" -> user.FirstName | n -> n; " "; user.LastName } (seq { match this.PreferredName with "" -> this.FirstName | n -> n; " "; this.LastName }
|> Seq.reduce (+) |> Seq.reduce (+)).Trim()
name.Trim()
/// Does a user have the required access level?
let hasAccess level user =
user.AccessLevel.HasAccess level

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

@ -9,6 +9,7 @@
<ItemGroup> <ItemGroup>
<PackageReference Include="Markdig" Version="0.31.0" /> <PackageReference Include="Markdig" Version="0.31.0" />
<PackageReference Include="Markdown.ColorCode" Version="1.0.4" /> <PackageReference Include="Markdown.ColorCode" Version="1.0.4" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.3" />
<PackageReference Include="NodaTime" Version="3.1.9" /> <PackageReference Include="NodaTime" Version="3.1.9" />
</ItemGroup> </ItemGroup>

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

@ -72,13 +72,11 @@ type AccessLevel =
/// Does a given access level allow an action that requires a certain access level? /// Does a given access level allow an action that requires a certain access level?
member this.HasAccess(needed: AccessLevel) = member this.HasAccess(needed: AccessLevel) =
// TODO: Move this to user where it seems to belong better...
let weights = let weights =
[ Author, 10 [ Author, 10
Editor, 20 Editor, 20
WebLogAdmin, 30 WebLogAdmin, 30
Administrator, 40 Administrator, 40 ]
]
|> Map.ofList |> Map.ofList
weights[needed] <= weights[this] weights[needed] <= weights[this]
@ -639,6 +637,9 @@ type TagMapId =
type ThemeId = type ThemeId =
| ThemeId of string | ThemeId of string
/// An empty theme ID
static member Empty = ThemeId ""
/// The string representation of a theme ID /// The string representation of a theme ID
override this.ToString() = override this.ToString() =
match this with ThemeId it -> it match this with ThemeId it -> it
@ -649,6 +650,9 @@ type ThemeId =
type ThemeAssetId = type ThemeAssetId =
| ThemeAssetId of ThemeId * string | ThemeAssetId of ThemeId * string
/// An empty theme asset ID
static member Empty = ThemeAssetId(ThemeId.Empty, "")
/// Convert a string into a theme asset ID /// Convert a string into a theme asset ID
static member Parse(it : string) = static member Parse(it : string) =
let themeIdx = it.IndexOf "/" let themeIdx = it.IndexOf "/"

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

@ -103,46 +103,46 @@ module DisplayCustomFeed =
/// Details about a page used to display page lists /// Details about a page used to display page lists
[<NoComparison; NoEquality>] [<NoComparison; NoEquality>]
type DisplayPage = type DisplayPage = {
{ /// The ID of this page /// The ID of this page
Id : string Id: string
/// The ID of the author of this page /// The ID of the author of this page
AuthorId : string AuthorId: string
/// The title of the page /// The title of the page
Title : string Title: string
/// The link at which this page is displayed /// The link at which this page is displayed
Permalink : string Permalink: string
/// When this page was published /// When this page was published
PublishedOn : DateTime PublishedOn: DateTime
/// When this page was last updated /// When this page was last updated
UpdatedOn : DateTime UpdatedOn: DateTime
/// Whether this page shows as part of the web log's navigation /// Whether this page shows as part of the web log's navigation
IsInPageList : bool IsInPageList: bool
/// Is this the default page? /// Is this the default page?
IsDefault : bool IsDefault: bool
/// The text of the page /// The text of the page
Text : string Text: string
/// The metadata for the page /// The metadata for the page
Metadata : MetaItem list Metadata: MetaItem list
} } with
/// Create a minimal display page (no text or metadata) from a database page /// Create a minimal display page (no text or metadata) from a database page
static member FromPageMinimal webLog (page: Page) = { static member FromPageMinimal (webLog: WebLog) (page: Page) = {
Id = string page.Id Id = string page.Id
AuthorId = string page.AuthorId AuthorId = string page.AuthorId
Title = page.Title Title = page.Title
Permalink = string page.Permalink Permalink = string page.Permalink
PublishedOn = WebLog.localTime webLog page.PublishedOn PublishedOn = webLog.LocalTime page.PublishedOn
UpdatedOn = WebLog.localTime webLog page.UpdatedOn UpdatedOn = webLog.LocalTime page.UpdatedOn
IsInPageList = page.IsInPageList IsInPageList = page.IsInPageList
IsDefault = string page.Id = webLog.DefaultPage IsDefault = string page.Id = webLog.DefaultPage
Text = "" Text = ""
@ -150,18 +150,10 @@ type DisplayPage =
} }
/// Create a display page from a database page /// Create a display page from a database page
static member FromPage webLog (page : Page) = static member FromPage webLog page =
let _, extra = WebLog.hostAndPath webLog { DisplayPage.FromPageMinimal webLog page with
{ Id = string page.Id Text = addBaseToRelativeUrls webLog.ExtraPath page.Text
AuthorId = string page.AuthorId Metadata = page.Metadata
Title = page.Title
Permalink = string page.Permalink
PublishedOn = WebLog.localTime webLog page.PublishedOn
UpdatedOn = WebLog.localTime webLog page.UpdatedOn
IsInPageList = page.IsInPageList
IsDefault = string page.Id = webLog.DefaultPage
Text = addBaseToRelativeUrls extra page.Text
Metadata = page.Metadata
} }
@ -169,22 +161,22 @@ type DisplayPage =
[<NoComparison; NoEquality>] [<NoComparison; NoEquality>]
type DisplayRevision = { type DisplayRevision = {
/// The as-of date/time for the revision /// The as-of date/time for the revision
AsOf : DateTime AsOf: DateTime
/// The as-of date/time for the revision in the web log's local time zone /// The as-of date/time for the revision in the web log's local time zone
AsOfLocal : DateTime AsOfLocal: DateTime
/// The format of the text of the revision /// The format of the text of the revision
Format : string Format: string
} }
/// Functions to support displaying revisions /// Functions to support displaying revisions
module DisplayRevision = module DisplayRevision =
/// Create a display revision from an actual revision /// Create a display revision from an actual revision
let fromRevision webLog (rev : Revision) = let fromRevision (webLog: WebLog) (rev : Revision) =
{ AsOf = rev.AsOf.ToDateTimeUtc () { AsOf = rev.AsOf.ToDateTimeUtc ()
AsOfLocal = WebLog.localTime webLog rev.AsOf AsOfLocal = webLog.LocalTime rev.AsOf
Format = rev.Text.SourceType Format = rev.Text.SourceType
} }
@ -250,13 +242,13 @@ type DisplayUpload = {
module DisplayUpload = module DisplayUpload =
/// Create a display uploaded file /// Create a display uploaded file
let fromUpload webLog (source: UploadDestination) (upload: Upload) = let fromUpload (webLog: WebLog) (source: UploadDestination) (upload: Upload) =
let path = string upload.Path let path = string upload.Path
let name = Path.GetFileName path let name = Path.GetFileName path
{ Id = string upload.Id { Id = string upload.Id
Name = name Name = name
Path = path.Replace(name, "") Path = path.Replace(name, "")
UpdatedOn = Some (WebLog.localTime webLog upload.UpdatedOn) UpdatedOn = Some (webLog.LocalTime upload.UpdatedOn)
Source = string source Source = string source
} }
@ -296,17 +288,17 @@ type DisplayUser = {
module DisplayUser = module DisplayUser =
/// Construct a displayed user from a web log user /// Construct a displayed user from a web log user
let fromUser webLog (user: WebLogUser) = let fromUser (webLog: WebLog) (user: WebLogUser) = {
{ Id = string user.Id Id = string user.Id
Email = user.Email Email = user.Email
FirstName = user.FirstName FirstName = user.FirstName
LastName = user.LastName LastName = user.LastName
PreferredName = user.PreferredName PreferredName = user.PreferredName
Url = defaultArg user.Url "" Url = defaultArg user.Url ""
AccessLevel = string user.AccessLevel AccessLevel = string user.AccessLevel
CreatedOn = WebLog.localTime webLog user.CreatedOn CreatedOn = webLog.LocalTime user.CreatedOn
LastSeenOn = user.LastSeenOn |> Option.map (WebLog.localTime webLog) |> Option.toNullable LastSeenOn = user.LastSeenOn |> Option.map webLog.LocalTime |> Option.toNullable
} }
/// View model for editing categories /// View model for editing categories
@ -708,7 +700,7 @@ type EditPostModel = {
} with } with
/// Create an edit model from an existing past /// Create an edit model from an existing past
static member fromPost webLog (post: Post) = static member fromPost (webLog: WebLog) (post: Post) =
let latest = let latest =
match post.Revisions |> List.sortByDescending _.AsOf |> List.tryHead with match post.Revisions |> List.sortByDescending _.AsOf |> List.tryHead with
| Some rev -> rev | Some rev -> rev
@ -728,7 +720,7 @@ type EditPostModel = {
MetaNames = post.Metadata |> List.map _.Name |> Array.ofList MetaNames = post.Metadata |> List.map _.Name |> Array.ofList
MetaValues = post.Metadata |> List.map _.Value |> Array.ofList MetaValues = post.Metadata |> List.map _.Value |> Array.ofList
SetPublished = false SetPublished = false
PubOverride = post.PublishedOn |> Option.map (WebLog.localTime webLog) |> Option.toNullable PubOverride = post.PublishedOn |> Option.map webLog.LocalTime |> Option.toNullable
SetUpdated = false SetUpdated = false
IsEpisode = Option.isSome post.Episode IsEpisode = Option.isSome post.Episode
Media = episode.Media Media = episode.Media
@ -1111,22 +1103,20 @@ type PostListItem = {
} with } with
/// Create a post list item from a post /// Create a post list item from a post
static member fromPost (webLog: WebLog) (post: Post) = static member fromPost (webLog: WebLog) (post: Post) = {
let _, extra = WebLog.hostAndPath webLog Id = string post.Id
let inTZ = WebLog.localTime webLog AuthorId = string post.AuthorId
{ Id = string post.Id Status = string post.Status
AuthorId = string post.AuthorId Title = post.Title
Status = string post.Status Permalink = string post.Permalink
Title = post.Title PublishedOn = post.PublishedOn |> Option.map webLog.LocalTime |> Option.toNullable
Permalink = string post.Permalink UpdatedOn = webLog.LocalTime post.UpdatedOn
PublishedOn = post.PublishedOn |> Option.map inTZ |> Option.toNullable Text = addBaseToRelativeUrls webLog.ExtraPath post.Text
UpdatedOn = inTZ post.UpdatedOn CategoryIds = post.CategoryIds |> List.map string
Text = addBaseToRelativeUrls extra post.Text Tags = post.Tags
CategoryIds = post.CategoryIds |> List.map string Episode = post.Episode
Tags = post.Tags Metadata = post.Metadata
Episode = post.Episode }
Metadata = post.Metadata
}
/// View model for displaying posts /// View model for displaying posts

10
src/MyWebLog/Caches.fs
View File

@ -53,7 +53,7 @@ module Extensions =
/// Does the current user have the requested level of access? /// Does the current user have the requested level of access?
member this.HasAccessLevel level = member this.HasAccessLevel level =
defaultArg (this.UserAccessLevel |> Option.map (fun it -> it.HasAccess level)) false defaultArg (this.UserAccessLevel |> Option.map _.HasAccess(level)) false
open System.Collections.Concurrent open System.Collections.Concurrent
@ -93,13 +93,13 @@ module WebLogCache =
_redirectCache[webLog.Id] <- _redirectCache[webLog.Id] <-
webLog.RedirectRules webLog.RedirectRules
|> List.map (fun it -> |> List.map (fun it ->
let relUrl = Permalink >> WebLog.relativeUrl webLog let relUrl = Permalink >> webLog.RelativeUrl
let urlTo = if it.To.Contains "://" then it.To else relUrl it.To let urlTo = if it.To.Contains "://" then it.To else relUrl it.To
if it.IsRegex then if it.IsRegex then
let pattern = if it.From.StartsWith "^" then $"^{relUrl (it.From.Substring 1)}" else it.From let pattern = if it.From.StartsWith "^" then $"^{relUrl it.From[1..]}" else it.From
RegEx (new Regex (pattern, RegexOptions.Compiled ||| RegexOptions.IgnoreCase), urlTo) RegEx(Regex(pattern, RegexOptions.Compiled ||| RegexOptions.IgnoreCase), urlTo)
else else
Text (relUrl it.From, urlTo)) Text(relUrl it.From, urlTo))
/// Get all cached web logs /// Get all cached web logs
let all () = let all () =

70
src/MyWebLog/DotLiquidBespoke.fs
View File

@ -21,7 +21,7 @@ let assetExists fileName (webLog : WebLog) =
ThemeAssetCache.get webLog.ThemeId |> List.exists (fun it -> it = fileName) ThemeAssetCache.get webLog.ThemeId |> List.exists (fun it -> it = fileName)
/// Obtain the link from known types /// Obtain the link from known types
let permalink (ctx : Context) (item : obj) (linkFunc : WebLog -> Permalink -> string) = let permalink (item: obj) (linkFunc: Permalink -> string) =
match item with match item with
| :? String as link -> Some link | :? String as link -> Some link
| :? DisplayPage as page -> Some page.Permalink | :? DisplayPage as page -> Some page.Permalink
@ -29,64 +29,64 @@ let permalink (ctx : Context) (item : obj) (linkFunc : WebLog -> Permalink -> st
| :? DropProxy as proxy -> Option.ofObj proxy["Permalink"] |> Option.map string | :? DropProxy as proxy -> Option.ofObj proxy["Permalink"] |> Option.map string
| _ -> None | _ -> None
|> function |> function
| Some link -> linkFunc ctx.WebLog (Permalink link) | Some link -> linkFunc (Permalink link)
| None -> $"alert('unknown item type {item.GetType().Name}')" | None -> $"alert('unknown item type {item.GetType().Name}')"
/// A filter to generate an absolute link /// A filter to generate an absolute link
type AbsoluteLinkFilter () = type AbsoluteLinkFilter() =
static member AbsoluteLink (ctx : Context, item : obj) = static member AbsoluteLink(ctx: Context, item: obj) =
permalink ctx item WebLog.absoluteUrl permalink item ctx.WebLog.AbsoluteUrl
/// A filter to generate a link with posts categorized under the given category /// A filter to generate a link with posts categorized under the given category
type CategoryLinkFilter () = type CategoryLinkFilter() =
static member CategoryLink (ctx : Context, catObj : obj) = static member CategoryLink(ctx: Context, catObj: obj) =
match catObj with match catObj with
| :? DisplayCategory as cat -> Some cat.Slug | :? DisplayCategory as cat -> Some cat.Slug
| :? DropProxy as proxy -> Option.ofObj proxy["Slug"] |> Option.map string | :? DropProxy as proxy -> Option.ofObj proxy["Slug"] |> Option.map string
| _ -> None | _ -> None
|> function |> function
| Some slug -> WebLog.relativeUrl ctx.WebLog (Permalink $"category/{slug}/") | Some slug -> ctx.WebLog.RelativeUrl(Permalink $"category/{slug}/")
| None -> $"alert('unknown category object type {catObj.GetType().Name}')" | None -> $"alert('unknown category object type {catObj.GetType().Name}')"
/// A filter to generate a link that will edit a page /// A filter to generate a link that will edit a page
type EditPageLinkFilter () = type EditPageLinkFilter() =
static member EditPageLink (ctx : Context, pageObj : obj) = static member EditPageLink(ctx: Context, pageObj: obj) =
match pageObj with match pageObj with
| :? DisplayPage as page -> Some page.Id | :? DisplayPage as page -> Some page.Id
| :? DropProxy as proxy -> Option.ofObj proxy["Id"] |> Option.map string | :? DropProxy as proxy -> Option.ofObj proxy["Id"] |> Option.map string
| :? String as theId -> Some theId | :? String as theId -> Some theId
| _ -> None | _ -> None
|> function |> function
| Some pageId -> WebLog.relativeUrl ctx.WebLog (Permalink $"admin/page/{pageId}/edit") | Some pageId -> ctx.WebLog.RelativeUrl(Permalink $"admin/page/{pageId}/edit")
| None -> $"alert('unknown page object type {pageObj.GetType().Name}')" | None -> $"alert('unknown page object type {pageObj.GetType().Name}')"
/// A filter to generate a link that will edit a post /// A filter to generate a link that will edit a post
type EditPostLinkFilter () = type EditPostLinkFilter() =
static member EditPostLink (ctx : Context, postObj : obj) = static member EditPostLink(ctx: Context, postObj: obj) =
match postObj with match postObj with
| :? PostListItem as post -> Some post.Id | :? PostListItem as post -> Some post.Id
| :? DropProxy as proxy -> Option.ofObj proxy["Id"] |> Option.map string | :? DropProxy as proxy -> Option.ofObj proxy["Id"] |> Option.map string
| :? String as theId -> Some theId | :? String as theId -> Some theId
| _ -> None | _ -> None
|> function |> function
| Some postId -> WebLog.relativeUrl ctx.WebLog (Permalink $"admin/post/{postId}/edit") | Some postId -> ctx.WebLog.RelativeUrl(Permalink $"admin/post/{postId}/edit")
| None -> $"alert('unknown post object type {postObj.GetType().Name}')" | None -> $"alert('unknown post object type {postObj.GetType().Name}')"
/// A filter to generate nav links, highlighting the active link (exact match) /// A filter to generate nav links, highlighting the active link (exact match)
type NavLinkFilter () = type NavLinkFilter() =
static member NavLink (ctx : Context, url : string, text : string) = static member NavLink(ctx: Context, url: string, text: string) =
let _, path = WebLog.hostAndPath ctx.WebLog let extraPath = ctx.WebLog.ExtraPath
let path = if path = "" then path else $"{path.Substring 1}/" let path = if extraPath = "" then "" else $"{extraPath[1..]}/"
seq { seq {
"<li class=\"nav-item\"><a class=\"nav-link" "<li class=\"nav-item\"><a class=\"nav-link"
if (string ctx.Environments[0].["current_page"]).StartsWith $"{path}{url}" then " active" if (string ctx.Environments[0].["current_page"]).StartsWith $"{path}{url}" then " active"
"\" href=\"" "\" href=\""
WebLog.relativeUrl ctx.WebLog (Permalink url) ctx.WebLog.RelativeUrl(Permalink url)
"\">" "\">"
text text
"</a></li>" "</a></li>"
@ -97,7 +97,7 @@ type NavLinkFilter () =
/// A filter to generate a link for theme asset (image, stylesheet, script, etc.) /// A filter to generate a link for theme asset (image, stylesheet, script, etc.)
type ThemeAssetFilter() = type ThemeAssetFilter() =
static member ThemeAsset(ctx: Context, asset: string) = static member ThemeAsset(ctx: Context, asset: string) =
WebLog.relativeUrl ctx.WebLog (Permalink $"themes/{ctx.WebLog.ThemeId}/{asset}") ctx.WebLog.RelativeUrl(Permalink $"themes/{ctx.WebLog.ThemeId}/{asset}")
/// Create various items in the page header based on the state of the page being generated /// Create various items in the page header based on the state of the page being generated
@ -122,12 +122,12 @@ type PageHeadTag() =
// RSS feeds and canonical URLs // RSS feeds and canonical URLs
let feedLink title url = let feedLink title url =
let escTitle = HttpUtility.HtmlAttributeEncode title let escTitle = HttpUtility.HtmlAttributeEncode title
let relUrl = WebLog.relativeUrl webLog (Permalink url) let relUrl = webLog.RelativeUrl(Permalink url)
$"""{s}<link rel="alternate" type="application/rss+xml" title="{escTitle}" href="{relUrl}">""" $"""{s}<link rel="alternate" type="application/rss+xml" title="{escTitle}" href="{relUrl}">"""
if webLog.Rss.IsFeedEnabled && getBool "is_home" then if webLog.Rss.IsFeedEnabled && getBool "is_home" then
result.WriteLine(feedLink webLog.Name webLog.Rss.FeedName) result.WriteLine(feedLink webLog.Name webLog.Rss.FeedName)
result.WriteLine $"""{s}<link rel="canonical" href="{WebLog.absoluteUrl webLog Permalink.Empty}">""" result.WriteLine $"""{s}<link rel="canonical" href="{webLog.AbsoluteUrl Permalink.Empty}">"""
if webLog.Rss.IsCategoryEnabled && getBool "is_category_home" then if webLog.Rss.IsCategoryEnabled && getBool "is_category_home" then
let slug = context.Environments[0].["slug"] :?> string let slug = context.Environments[0].["slug"] :?> string
@ -139,12 +139,12 @@ type PageHeadTag() =
if getBool "is_post" then if getBool "is_post" then
let post = context.Environments[0].["model"] :?> PostDisplay let post = context.Environments[0].["model"] :?> PostDisplay
let url = WebLog.absoluteUrl webLog (Permalink post.Posts[0].Permalink) let url = webLog.AbsoluteUrl (Permalink post.Posts[0].Permalink)
result.WriteLine $"""{s}<link rel="canonical" href="{url}">""" result.WriteLine $"""{s}<link rel="canonical" href="{url}">"""
if getBool "is_page" then if getBool "is_page" then
let page = context.Environments[0].["page"] :?> DisplayPage let page = context.Environments[0].["page"] :?> DisplayPage
let url = WebLog.absoluteUrl webLog (Permalink page.Permalink) let url = webLog.AbsoluteUrl (Permalink page.Permalink)
result.WriteLine $"""{s}<link rel="canonical" href="{url}">""" result.WriteLine $"""{s}<link rel="canonical" href="{url}">"""
@ -167,26 +167,26 @@ type PageFootTag () =
/// A filter to generate a relative link /// A filter to generate a relative link
type RelativeLinkFilter () = type RelativeLinkFilter () =
static member RelativeLink (ctx : Context, item : obj) = static member RelativeLink (ctx : Context, item : obj) =
permalink ctx item WebLog.relativeUrl permalink item ctx.WebLog.RelativeUrl
/// A filter to generate a link with posts tagged with the given tag /// A filter to generate a link with posts tagged with the given tag
type TagLinkFilter () = type TagLinkFilter() =
static member TagLink (ctx : Context, tag : string) = static member TagLink(ctx: Context, tag: string) =
ctx.Environments[0].["tag_mappings"] :?> TagMap list ctx.Environments[0].["tag_mappings"] :?> TagMap list
|> List.tryFind (fun it -> it.Tag = tag) |> List.tryFind (fun it -> it.Tag = tag)
|> function |> function
| Some tagMap -> tagMap.UrlValue | Some tagMap -> tagMap.UrlValue
| None -> tag.Replace (" ", "+") | None -> tag.Replace(" ", "+")
|> function tagUrl -> WebLog.relativeUrl ctx.WebLog (Permalink $"tag/{tagUrl}/") |> function tagUrl -> ctx.WebLog.RelativeUrl(Permalink $"tag/{tagUrl}/")
/// Create links for a user to log on or off, and a dashboard link if they are logged off /// Create links for a user to log on or off, and a dashboard link if they are logged off
type UserLinksTag () = type UserLinksTag() =
inherit Tag () inherit Tag()
override this.Render (context : Context, result : TextWriter) = override this.Render(context: Context, result: TextWriter) =
let link it = WebLog.relativeUrl context.WebLog (Permalink it) let link it = context.WebLog.RelativeUrl(Permalink it)
seq { seq {
"""<ul class="navbar-nav flex-grow-1 justify-content-end">""" """<ul class="navbar-nav flex-grow-1 justify-content-end">"""
match Convert.ToBoolean context.Environments[0].["is_logged_on"] with match Convert.ToBoolean context.Environments[0].["is_logged_on"] with
@ -201,8 +201,8 @@ type UserLinksTag () =
/// A filter to retrieve the value of a meta item from a list /// A filter to retrieve the value of a meta item from a list
// (shorter than `{% assign item = list | where: "Name", [name] | first %}{{ item.value }}`) // (shorter than `{% assign item = list | where: "Name", [name] | first %}{{ item.value }}`)
type ValueFilter () = type ValueFilter() =
static member Value (_ : Context, items : MetaItem list, name : string) = static member Value(_: Context, items: MetaItem list, name: string) =
match items |> List.tryFind (fun it -> it.Name = name) with match items |> List.tryFind (fun it -> it.Name = name) with
| Some item -> item.Value | Some item -> item.Value
| None -> $"-- {name} not found --" | None -> $"-- {name} not found --"

10
src/MyWebLog/Handlers/Admin.fs
View File

@ -156,7 +156,7 @@ module Category =
let edit catId : HttpHandler = fun next ctx -> task { let edit catId : HttpHandler = fun next ctx -> task {
let! result = task { let! result = task {
match catId with match catId with
| "new" -> return Some ("Add a New Category", { Category.empty with Id = CategoryId "new" }) | "new" -> return Some ("Add a New Category", { Category.Empty with Id = CategoryId "new" })
| _ -> | _ ->
match! ctx.Data.Category.FindById (CategoryId catId) ctx.WebLog.Id with match! ctx.Data.Category.FindById (CategoryId catId) ctx.WebLog.Id with
| Some cat -> return Some ("Edit Category", cat) | Some cat -> return Some ("Edit Category", cat)
@ -177,7 +177,7 @@ module Category =
let data = ctx.Data let data = ctx.Data
let! model = ctx.BindFormAsync<EditCategoryModel> () let! model = ctx.BindFormAsync<EditCategoryModel> ()
let category = let category =
if model.IsNew then someTask { Category.empty with Id = CategoryId.Create(); WebLogId = ctx.WebLog.Id } if model.IsNew then someTask { Category.Empty with Id = CategoryId.Create(); WebLogId = ctx.WebLog.Id }
else data.Category.FindById (CategoryId model.CategoryId) ctx.WebLog.Id else data.Category.FindById (CategoryId model.CategoryId) ctx.WebLog.Id
match! category with match! category with
| Some cat -> | Some cat ->
@ -333,7 +333,7 @@ module TagMapping =
let edit tagMapId : HttpHandler = fun next ctx -> task { let edit tagMapId : HttpHandler = fun next ctx -> task {
let isNew = tagMapId = "new" let isNew = tagMapId = "new"
let tagMap = let tagMap =
if isNew then someTask { TagMap.empty with Id = TagMapId "new" } if isNew then someTask { TagMap.Empty with Id = TagMapId "new" }
else ctx.Data.TagMap.FindById (TagMapId tagMapId) ctx.WebLog.Id else ctx.Data.TagMap.FindById (TagMapId tagMapId) ctx.WebLog.Id
match! tagMap with match! tagMap with
| Some tm -> | Some tm ->
@ -350,7 +350,7 @@ module TagMapping =
let data = ctx.Data let data = ctx.Data
let! model = ctx.BindFormAsync<EditTagMapModel>() let! model = ctx.BindFormAsync<EditTagMapModel>()
let tagMap = let tagMap =
if model.IsNew then someTask { TagMap.empty with Id = TagMapId.Create(); WebLogId = ctx.WebLog.Id } if model.IsNew then someTask { TagMap.Empty with Id = TagMapId.Create(); WebLogId = ctx.WebLog.Id }
else data.TagMap.FindById (TagMapId model.Id) ctx.WebLog.Id else data.TagMap.FindById (TagMapId model.Id) ctx.WebLog.Id
match! tagMap with match! tagMap with
| Some tm -> | Some tm ->
@ -455,7 +455,7 @@ module Theme =
let! isNew, theme = backgroundTask { let! isNew, theme = backgroundTask {
match! data.Theme.FindById themeId with match! data.Theme.FindById themeId with
| Some t -> return false, t | Some t -> return false, t
| None -> return true, { Theme.empty with Id = themeId } | None -> return true, { Theme.Empty with Id = themeId }
} }
use zip = new ZipArchive (file, ZipArchiveMode.Read) use zip = new ZipArchive (file, ZipArchiveMode.Read)
let! theme = updateNameAndVersion theme zip let! theme = updateNameAndVersion theme zip

73
src/MyWebLog/Handlers/Feed.fs
View File

@ -86,13 +86,13 @@ module private Namespace =
let rawVoice = "http://www.rawvoice.com/rawvoiceRssModule/" let rawVoice = "http://www.rawvoice.com/rawvoiceRssModule/"
/// Create a feed item from the given post /// Create a feed item from the given post
let private toFeedItem webLog (authors: MetaItem list) (cats: DisplayCategory array) (tagMaps: TagMap list) let private toFeedItem (webLog: WebLog) (authors: MetaItem list) (cats: DisplayCategory array) (tagMaps: TagMap list)
(post: Post) = (post: Post) =
let plainText = let plainText =
let endingP = post.Text.IndexOf "</p>" let endingP = post.Text.IndexOf "</p>"
stripHtml <| if endingP >= 0 then post.Text[..(endingP - 1)] else post.Text stripHtml <| if endingP >= 0 then post.Text[..(endingP - 1)] else post.Text
let item = SyndicationItem( let item = SyndicationItem(
Id = WebLog.absoluteUrl webLog post.Permalink, Id = webLog.AbsoluteUrl post.Permalink,
Title = TextSyndicationContent.CreateHtmlContent post.Title, Title = TextSyndicationContent.CreateHtmlContent post.Title,
PublishDate = post.PublishedOn.Value.ToDateTimeOffset(), PublishDate = post.PublishedOn.Value.ToDateTimeOffset(),
LastUpdatedTime = post.UpdatedOn.ToDateTimeOffset(), LastUpdatedTime = post.UpdatedOn.ToDateTimeOffset(),
@ -115,30 +115,31 @@ let private toFeedItem webLog (authors: MetaItem list) (cats: DisplayCategory ar
[ post.CategoryIds [ post.CategoryIds
|> List.map (fun catId -> |> List.map (fun catId ->
let cat = cats |> Array.find (fun c -> c.Id = string catId) let cat = cats |> Array.find (fun c -> c.Id = string catId)
SyndicationCategory(cat.Name, WebLog.absoluteUrl webLog (Permalink $"category/{cat.Slug}/"), cat.Name)) SyndicationCategory(cat.Name, webLog.AbsoluteUrl(Permalink $"category/{cat.Slug}/"), cat.Name))
post.Tags post.Tags
|> List.map (fun tag -> |> List.map (fun tag ->
let urlTag = let urlTag =
match tagMaps |> List.tryFind (fun tm -> tm.Tag = tag) with match tagMaps |> List.tryFind (fun tm -> tm.Tag = tag) with
| Some tm -> tm.UrlValue | Some tm -> tm.UrlValue
| None -> tag.Replace (" ", "+") | None -> tag.Replace (" ", "+")
SyndicationCategory(tag, WebLog.absoluteUrl webLog (Permalink $"tag/{urlTag}/"), $"{tag} (tag)")) SyndicationCategory(tag, webLog.AbsoluteUrl(Permalink $"tag/{urlTag}/"), $"{tag} (tag)"))
] ]
|> List.concat |> List.concat
|> List.iter item.Categories.Add |> List.iter item.Categories.Add
item item
/// Convert non-absolute URLs to an absolute URL for this web log /// Convert non-absolute URLs to an absolute URL for this web log
let toAbsolute webLog (link: string) = let toAbsolute (webLog: WebLog) (link: string) =
if link.StartsWith "http" then link else WebLog.absoluteUrl webLog (Permalink link) if link.StartsWith "http" then link else webLog.AbsoluteUrl(Permalink link)
/// Add episode information to a podcast feed item /// Add episode information to a podcast feed item
let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (post : Post) (item : SyndicationItem) = let private addEpisode (webLog: WebLog) (podcast: PodcastOptions) (episode: Episode) (post: Post)
(item: SyndicationItem) =
let epMediaUrl = let epMediaUrl =
match episode.Media with match episode.Media with
| link when link.StartsWith "http" -> link | link when link.StartsWith "http" -> link
| link when Option.isSome podcast.MediaBaseUrl -> $"{podcast.MediaBaseUrl.Value}{link}" | link when Option.isSome podcast.MediaBaseUrl -> $"{podcast.MediaBaseUrl.Value}{link}"
| link -> WebLog.absoluteUrl webLog (Permalink link) | link -> webLog.AbsoluteUrl(Permalink link)
let epMediaType = [ episode.MediaType; podcast.DefaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten let epMediaType = [ episode.MediaType; podcast.DefaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten
let epImageUrl = defaultArg episode.ImageUrl (string podcast.ImageUrl) |> toAbsolute webLog let epImageUrl = defaultArg episode.ImageUrl (string podcast.ImageUrl) |> toAbsolute webLog
let epExplicit = string (defaultArg episode.Explicit podcast.Explicit) let epExplicit = string (defaultArg episode.Explicit podcast.Explicit)
@ -234,22 +235,22 @@ let private addNamespace (feed : SyndicationFeed) alias nsUrl =
feed.AttributeExtensions.Add (XmlQualifiedName (alias, "http://www.w3.org/2000/xmlns/"), nsUrl) feed.AttributeExtensions.Add (XmlQualifiedName (alias, "http://www.w3.org/2000/xmlns/"), nsUrl)
/// Add items to the top of the feed required for podcasts /// Add items to the top of the feed required for podcasts
let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) = let private addPodcast (webLog: WebLog) (rssFeed: SyndicationFeed) (feed: CustomFeed) =
let addChild (doc : XmlDocument) ns prefix name value (elt : XmlElement) = let addChild (doc: XmlDocument) ns prefix name value (elt: XmlElement) =
let child = let child =
if ns = "" then doc.CreateElement name else doc.CreateElement (prefix, name, ns) if ns = "" then doc.CreateElement name else doc.CreateElement(prefix, name, ns)
|> elt.AppendChild |> elt.AppendChild
child.InnerText <- value child.InnerText <- value
elt elt
let podcast = Option.get feed.Podcast let podcast = Option.get feed.Podcast
let feedUrl = WebLog.absoluteUrl webLog feed.Path let feedUrl = webLog.AbsoluteUrl feed.Path
let imageUrl = let imageUrl =
match podcast.ImageUrl with match podcast.ImageUrl with
| Permalink link when link.StartsWith "http" -> link | Permalink link when link.StartsWith "http" -> link
| Permalink _ -> WebLog.absoluteUrl webLog podcast.ImageUrl | Permalink _ -> webLog.AbsoluteUrl podcast.ImageUrl
let xmlDoc = XmlDocument () let xmlDoc = XmlDocument()
[ "dc", Namespace.dc [ "dc", Namespace.dc
"itunes", Namespace.iTunes "itunes", Namespace.iTunes
@ -260,12 +261,12 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
|> List.iter (fun (alias, nsUrl) -> addNamespace rssFeed alias nsUrl) |> List.iter (fun (alias, nsUrl) -> addNamespace rssFeed alias nsUrl)
let categorization = let categorization =
let it = xmlDoc.CreateElement ("itunes", "category", Namespace.iTunes) let it = xmlDoc.CreateElement("itunes", "category", Namespace.iTunes)
it.SetAttribute ("text", podcast.AppleCategory) it.SetAttribute("text", podcast.AppleCategory)
podcast.AppleSubcategory podcast.AppleSubcategory
|> Option.iter (fun subCat -> |> Option.iter (fun subCat ->
let subCatElt = xmlDoc.CreateElement ("itunes", "category", Namespace.iTunes) let subCatElt = xmlDoc.CreateElement("itunes", "category", Namespace.iTunes)
subCatElt.SetAttribute ("text", subCat) subCatElt.SetAttribute("text", subCat)
it.AppendChild subCatElt |> ignore) it.AppendChild subCatElt |> ignore)
it it
let image = let image =
@ -275,19 +276,19 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
] ]
|> List.fold (fun elt (name, value) -> addChild xmlDoc "" "" name value elt) (xmlDoc.CreateElement "image") |> List.fold (fun elt (name, value) -> addChild xmlDoc "" "" name value elt) (xmlDoc.CreateElement "image")
let iTunesImage = let iTunesImage =
let it = xmlDoc.CreateElement ("itunes", "image", Namespace.iTunes) let it = xmlDoc.CreateElement("itunes", "image", Namespace.iTunes)
it.SetAttribute ("href", imageUrl) it.SetAttribute("href", imageUrl)
it it
let owner = let owner =
[ "name", podcast.DisplayedAuthor [ "name", podcast.DisplayedAuthor
"email", podcast.Email "email", podcast.Email
] ]
|> List.fold (fun elt (name, value) -> addChild xmlDoc Namespace.iTunes "itunes" name value elt) |> List.fold (fun elt (name, value) -> addChild xmlDoc Namespace.iTunes "itunes" name value elt)
(xmlDoc.CreateElement ("itunes", "owner", Namespace.iTunes)) (xmlDoc.CreateElement("itunes", "owner", Namespace.iTunes))
let rawVoice = let rawVoice =
let it = xmlDoc.CreateElement ("rawvoice", "subscribe", Namespace.rawVoice) let it = xmlDoc.CreateElement("rawvoice", "subscribe", Namespace.rawVoice)
it.SetAttribute ("feed", feedUrl) it.SetAttribute("feed", feedUrl)
it.SetAttribute ("itunes", "") it.SetAttribute("itunes", "")
it it
rssFeed.ElementExtensions.Add image rssFeed.ElementExtensions.Add image
@ -298,7 +299,7 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
rssFeed.ElementExtensions.Add("summary", Namespace.iTunes, podcast.Summary) rssFeed.ElementExtensions.Add("summary", Namespace.iTunes, podcast.Summary)
rssFeed.ElementExtensions.Add("author", Namespace.iTunes, podcast.DisplayedAuthor) rssFeed.ElementExtensions.Add("author", Namespace.iTunes, podcast.DisplayedAuthor)
rssFeed.ElementExtensions.Add("explicit", Namespace.iTunes, string podcast.Explicit) rssFeed.ElementExtensions.Add("explicit", Namespace.iTunes, string podcast.Explicit)
podcast.Subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add ("subtitle", Namespace.iTunes, sub)) podcast.Subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add("subtitle", Namespace.iTunes, sub))
podcast.FundingUrl podcast.FundingUrl
|> Option.iter (fun url -> |> Option.iter (fun url ->
let funding = xmlDoc.CreateElement("podcast", "funding", Namespace.podcast) let funding = xmlDoc.CreateElement("podcast", "funding", Namespace.podcast)
@ -353,7 +354,7 @@ let private setTitleAndDescription feedType (webLog : WebLog) (cats : DisplayCat
feed.Description <- cleanText None $"""Posts with the "{tag}" tag""" feed.Description <- cleanText None $"""Posts with the "{tag}" tag"""
/// Create a feed with a known non-zero-length list of posts /// Create a feed with a known non-zero-length list of posts
let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backgroundTask { let createFeed (feedType: FeedType) posts : HttpHandler = fun next ctx -> backgroundTask {
let webLog = ctx.WebLog let webLog = ctx.WebLog
let data = ctx.Data let data = ctx.Data
let! authors = getAuthors webLog posts data let! authors = getAuthors webLog posts data
@ -371,36 +372,36 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
item item
| _ -> item | _ -> item
let feed = SyndicationFeed () let feed = SyndicationFeed()
addNamespace feed "content" Namespace.content addNamespace feed "content" Namespace.content
setTitleAndDescription feedType webLog cats feed setTitleAndDescription feedType webLog cats feed
feed.LastUpdatedTime <- (List.head posts).UpdatedOn.ToDateTimeOffset () feed.LastUpdatedTime <- (List.head posts).UpdatedOn.ToDateTimeOffset()
feed.Generator <- ctx.Generator feed.Generator <- ctx.Generator
feed.Items <- posts |> Seq.ofList |> Seq.map toItem feed.Items <- posts |> Seq.ofList |> Seq.map toItem
feed.Language <- "en" feed.Language <- "en"
feed.Id <- WebLog.absoluteUrl webLog link feed.Id <- webLog.AbsoluteUrl link
webLog.Rss.Copyright |> Option.iter (fun copy -> feed.Copyright <- TextSyndicationContent copy) webLog.Rss.Copyright |> Option.iter (fun copy -> feed.Copyright <- TextSyndicationContent copy)
feed.Links.Add (SyndicationLink (Uri (WebLog.absoluteUrl webLog self), "self", "", "application/rss+xml", 0L)) feed.Links.Add(SyndicationLink(Uri(webLog.AbsoluteUrl self), "self", "", "application/rss+xml", 0L))
feed.ElementExtensions.Add ("link", "", WebLog.absoluteUrl webLog link) feed.ElementExtensions.Add("link", "", webLog.AbsoluteUrl link)
podcast |> Option.iter (addPodcast webLog feed) podcast |> Option.iter (addPodcast webLog feed)
use mem = new MemoryStream () use mem = new MemoryStream()
use xml = XmlWriter.Create mem use xml = XmlWriter.Create mem
feed.SaveAsRss20 xml feed.SaveAsRss20 xml
xml.Close () xml.Close()
let _ = mem.Seek (0L, SeekOrigin.Begin) let _ = mem.Seek(0L, SeekOrigin.Begin)
let rdr = new StreamReader(mem) let rdr = new StreamReader(mem)
let! output = rdr.ReadToEndAsync () let! output = rdr.ReadToEndAsync()
return! (setHttpHeader "Content-Type" "text/xml" >=> setStatusCode 200 >=> setBodyFromString output) next ctx return! (setHttpHeader "Content-Type" "text/xml" >=> setStatusCode 200 >=> setBodyFromString output) next ctx
} }
// GET {any-prescribed-feed} // GET {any-prescribed-feed}
let generate (feedType : FeedType) postCount : HttpHandler = fun next ctx -> backgroundTask { let generate (feedType: FeedType) postCount : HttpHandler = fun next ctx -> backgroundTask {
match! getFeedPosts ctx feedType postCount with match! getFeedPosts ctx feedType postCount with
| posts when List.length posts > 0 -> return! createFeed feedType posts next ctx | posts when List.length posts > 0 -> return! createFeed feedType posts next ctx
| _ -> return! Error.notFound next ctx | _ -> return! Error.notFound next ctx

2
src/MyWebLog/Handlers/Helpers.fs
View File

@ -234,7 +234,7 @@ let messagesToHeaders (messages : UserMessage array) : HttpHandler =
/// Redirect after doing some action; commits session and issues a temporary redirect /// Redirect after doing some action; commits session and issues a temporary redirect
let redirectToGet url : HttpHandler = fun _ ctx -> task { let redirectToGet url : HttpHandler = fun _ ctx -> task {
do! commitSession ctx do! commitSession ctx
return! redirectTo false (WebLog.relativeUrl ctx.WebLog (Permalink url)) earlyReturn ctx return! redirectTo false (ctx.WebLog.RelativeUrl(Permalink url)) earlyReturn ctx
} }

7
src/MyWebLog/Handlers/Page.fs
View File

@ -28,7 +28,7 @@ let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let edit pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task { let edit pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! result = task { let! result = task {
match pgId with match pgId with
| "new" -> return Some ("Add a New Page", { Page.empty with Id = PageId "new"; AuthorId = ctx.UserId }) | "new" -> return Some ("Add a New Page", { Page.Empty with Id = PageId "new"; AuthorId = ctx.UserId })
| _ -> | _ ->
match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some page -> return Some ("Edit Page", page) | Some page -> return Some ("Edit Page", page)
@ -129,11 +129,10 @@ let private findPageRevision pgId revDate (ctx : HttpContext) = task {
let previewRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task { let previewRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPageRevision pgId revDate ctx with match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.AuthorId ctx -> | Some pg, Some rev when canEdit pg.AuthorId ctx ->
let _, extra = WebLog.hostAndPath ctx.WebLog
return! {| return! {|
content = content =
[ """<div class="mwl-revision-preview mb-3">""" [ """<div class="mwl-revision-preview mb-3">"""
rev.Text.AsHtml() |> addBaseToRelativeUrls extra rev.Text.AsHtml() |> addBaseToRelativeUrls ctx.WebLog.ExtraPath
"</div>" "</div>"
] ]
|> String.concat "" |> String.concat ""
@ -179,7 +178,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let now = Noda.now () let now = Noda.now ()
let tryPage = let tryPage =
if model.IsNew then if model.IsNew then
{ Page.empty with { Page.Empty with
Id = PageId.Create() Id = PageId.Create()
WebLogId = ctx.WebLog.Id WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId AuthorId = ctx.UserId

13
src/MyWebLog/Handlers/Post.fs
View File

@ -42,7 +42,7 @@ open MyWebLog.ViewModels
let preparePostList webLog posts listType (url: string) pageNbr perPage (data: IData) = task { let preparePostList webLog posts listType (url: string) pageNbr perPage (data: IData) = task {
let! authors = getAuthors webLog posts data let! authors = getAuthors webLog posts data
let! tagMappings = getTagMappings webLog posts data let! tagMappings = getTagMappings webLog posts data
let relUrl it = Some <| WebLog.relativeUrl webLog (Permalink it) let relUrl it = Some <| webLog.RelativeUrl(Permalink it)
let postItems = let postItems =
posts posts
|> Seq.ofList |> Seq.ofList
@ -115,7 +115,7 @@ let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task {
// GET /page/{pageNbr}/ // GET /page/{pageNbr}/
let redirectToPageOfPosts (pageNbr : int) : HttpHandler = fun next ctx -> let redirectToPageOfPosts (pageNbr : int) : HttpHandler = fun next ctx ->
redirectTo true (WebLog.relativeUrl ctx.WebLog (Permalink $"page/{pageNbr}")) next ctx redirectTo true (ctx.WebLog.RelativeUrl(Permalink $"page/{pageNbr}")) next ctx
// GET /category/{slug}/ // GET /category/{slug}/
// GET /category/{slug}/page/{pageNbr} // GET /category/{slug}/page/{pageNbr}
@ -184,7 +184,7 @@ let pageOfTaggedPosts slugAndPage : HttpHandler = fun next ctx -> task {
let endUrl = if pageNbr = 1 then "" else $"page/{pageNbr}" let endUrl = if pageNbr = 1 then "" else $"page/{pageNbr}"
return! return!
redirectTo true redirectTo true
(WebLog.relativeUrl webLog (Permalink $"""tag/{spacedTag.Replace (" ", "+")}/{endUrl}""")) (webLog.RelativeUrl(Permalink $"""tag/{spacedTag.Replace (" ", "+")}/{endUrl}"""))
next ctx next ctx
| _ -> return! Error.notFound next ctx | _ -> return! Error.notFound next ctx
| None, _, _ -> return! Error.notFound next ctx | None, _, _ -> return! Error.notFound next ctx
@ -223,7 +223,7 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data let data = ctx.Data
let! result = task { let! result = task {
match postId with match postId with
| "new" -> return Some ("Write a New Post", { Post.empty with Id = PostId "new" }) | "new" -> return Some ("Write a New Post", { Post.Empty with Id = PostId "new" })
| _ -> | _ ->
match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post -> return Some ("Edit Post", post) | Some post -> return Some ("Edit Post", post)
@ -329,11 +329,10 @@ let private findPostRevision postId revDate (ctx : HttpContext) = task {
let previewRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task { let previewRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx -> | Some post, Some rev when canEdit post.AuthorId ctx ->
let _, extra = WebLog.hostAndPath ctx.WebLog
return! {| return! {|
content = content =
[ """<div class="mwl-revision-preview mb-3">""" [ """<div class="mwl-revision-preview mb-3">"""
rev.Text.AsHtml() |> addBaseToRelativeUrls extra rev.Text.AsHtml() |> addBaseToRelativeUrls ctx.WebLog.ExtraPath
"</div>" "</div>"
] ]
|> String.concat "" |> String.concat ""
@ -378,7 +377,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data let data = ctx.Data
let tryPost = let tryPost =
if model.IsNew then if model.IsNew then
{ Post.empty with { Post.Empty with
Id = PostId.Create() Id = PostId.Create()
WebLogId = ctx.WebLog.Id WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId AuthorId = ctx.UserId

18
src/MyWebLog/Handlers/Routes.fs
View File

@ -16,14 +16,14 @@ module CatchAll =
let data = ctx.Data let data = ctx.Data
let debug = debug "Routes.CatchAll" ctx let debug = debug "Routes.CatchAll" ctx
let textLink = let textLink =
let _, extra = WebLog.hostAndPath webLog let extra = webLog.ExtraPath
let url = string ctx.Request.Path let url = string ctx.Request.Path
(if extra = "" then url else url.Substring extra.Length).ToLowerInvariant() (if extra = "" then url else url[..extra.Length]).ToLowerInvariant()
let await it = (Async.AwaitTask >> Async.RunSynchronously) it let await it = (Async.AwaitTask >> Async.RunSynchronously) it
seq { seq {
debug (fun () -> $"Considering URL {textLink}") debug (fun () -> $"Considering URL {textLink}")
// Home page directory without the directory slash // Home page directory without the directory slash
if textLink = "" then yield redirectTo true (WebLog.relativeUrl webLog Permalink.Empty) if textLink = "" then yield redirectTo true (webLog.RelativeUrl Permalink.Empty)
let permalink = Permalink textLink[1..] let permalink = Permalink textLink[1..]
// Current post // Current post
match data.Post.FindByPermalink permalink webLog.Id |> await with match data.Post.FindByPermalink permalink webLog.Id |> await with
@ -56,25 +56,25 @@ module CatchAll =
match data.Post.FindByPermalink altLink webLog.Id |> await with match data.Post.FindByPermalink altLink webLog.Id |> await with
| Some post -> | Some post ->
debug (fun () -> "Found post by trailing-slash-agnostic permalink") debug (fun () -> "Found post by trailing-slash-agnostic permalink")
yield redirectTo true (WebLog.relativeUrl webLog post.Permalink) yield redirectTo true (webLog.RelativeUrl post.Permalink)
| None -> () | None -> ()
// Page differing only by trailing slash // Page differing only by trailing slash
match data.Page.FindByPermalink altLink webLog.Id |> await with match data.Page.FindByPermalink altLink webLog.Id |> await with
| Some page -> | Some page ->
debug (fun () -> "Found page by trailing-slash-agnostic permalink") debug (fun () -> "Found page by trailing-slash-agnostic permalink")
yield redirectTo true (WebLog.relativeUrl webLog page.Permalink) yield redirectTo true (webLog.RelativeUrl page.Permalink)
| None -> () | None -> ()
// Prior post // Prior post
match data.Post.FindCurrentPermalink [ permalink; altLink ] webLog.Id |> await with match data.Post.FindCurrentPermalink [ permalink; altLink ] webLog.Id |> await with
| Some link -> | Some link ->
debug (fun () -> "Found post by prior permalink") debug (fun () -> "Found post by prior permalink")
yield redirectTo true (WebLog.relativeUrl webLog link) yield redirectTo true (webLog.RelativeUrl link)
| None -> () | None -> ()
// Prior page // Prior page
match data.Page.FindCurrentPermalink [ permalink; altLink ] webLog.Id |> await with match data.Page.FindCurrentPermalink [ permalink; altLink ] webLog.Id |> await with
| Some link -> | Some link ->
debug (fun () -> "Found page by prior permalink") debug (fun () -> "Found page by prior permalink")
yield redirectTo true (WebLog.relativeUrl webLog link) yield redirectTo true (webLog.RelativeUrl link)
| None -> () | None -> ()
debug (fun () -> "No content found") debug (fun () -> "No content found")
} }
@ -239,7 +239,7 @@ let routerWithPath extraPath : HttpHandler =
/// Handler to apply Giraffe routing with a possible sub-route /// Handler to apply Giraffe routing with a possible sub-route
let handleRoute : HttpHandler = fun next ctx -> let handleRoute : HttpHandler = fun next ctx ->
let _, extraPath = WebLog.hostAndPath ctx.WebLog let extraPath = ctx.WebLog.ExtraPath
(if extraPath = "" then router else routerWithPath extraPath) next ctx (if extraPath = "" then router else routerWithPath extraPath) next ctx

2
src/MyWebLog/Handlers/Upload.fs
View File

@ -146,7 +146,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let fileName = String.Concat (makeSlug (Path.GetFileNameWithoutExtension upload.FileName), let fileName = String.Concat (makeSlug (Path.GetFileNameWithoutExtension upload.FileName),
Path.GetExtension(upload.FileName).ToLowerInvariant()) Path.GetExtension(upload.FileName).ToLowerInvariant())
let now = Noda.now () let now = Noda.now ()
let localNow = WebLog.localTime ctx.WebLog now let localNow = ctx.WebLog.LocalTime now
let year = localNow.ToString "yyyy" let year = localNow.ToString "yyyy"
let month = localNow.ToString "MM" let month = localNow.ToString "MM"
let! form = ctx.BindFormAsync<UploadFileModel>() let! form = ctx.BindFormAsync<UploadFileModel>()

16
src/MyWebLog/Handlers/User.fs
View File

@ -122,7 +122,7 @@ let edit usrId : HttpHandler = fun next ctx -> task {
let isNew = usrId = "new" let isNew = usrId = "new"
let userId = WebLogUserId usrId let userId = WebLogUserId usrId
let tryUser = let tryUser =
if isNew then someTask { WebLogUser.empty with Id = userId } if isNew then someTask { WebLogUser.Empty with Id = userId }
else ctx.Data.WebLogUser.FindById userId ctx.WebLog.Id else ctx.Data.WebLogUser.FindById userId ctx.WebLog.Id
match! tryUser with match! tryUser with
| Some user -> return! showEdit (EditUserModel.fromUser user) next ctx | Some user -> return! showEdit (EditUserModel.fromUser user) next ctx
@ -141,13 +141,13 @@ let delete userId : HttpHandler = fun next ctx -> task {
| Ok _ -> | Ok _ ->
do! addMessage ctx do! addMessage ctx
{ UserMessage.success with { UserMessage.success with
Message = $"User {WebLogUser.displayName user} deleted successfully" Message = $"User {user.DisplayName} deleted successfully"
} }
return! all next ctx return! all next ctx
| Error msg -> | Error msg ->
do! addMessage ctx do! addMessage ctx
{ UserMessage.error with { UserMessage.error with
Message = $"User {WebLogUser.displayName user} was not deleted" Message = $"User {user.DisplayName} was not deleted"
Detail = Some msg Detail = Some msg
} }
return! all next ctx return! all next ctx
@ -155,15 +155,13 @@ let delete userId : HttpHandler = fun next ctx -> task {
} }
/// Display the user "my info" page, with information possibly filled in /// Display the user "my info" page, with information possibly filled in
let private showMyInfo (model : EditMyInfoModel) (user : WebLogUser) : HttpHandler = fun next ctx -> let private showMyInfo (model: EditMyInfoModel) (user: WebLogUser) : HttpHandler = fun next ctx ->
hashForPage "Edit Your Information" hashForPage "Edit Your Information"
|> withAntiCsrf ctx |> withAntiCsrf ctx
|> addToHash ViewContext.Model model |> addToHash ViewContext.Model model
|> addToHash "access_level" (string user.AccessLevel) |> addToHash "access_level" (string user.AccessLevel)
|> addToHash "created_on" (WebLog.localTime ctx.WebLog user.CreatedOn) |> addToHash "created_on" (ctx.WebLog.LocalTime user.CreatedOn)
|> addToHash "last_seen_on" (WebLog.localTime ctx.WebLog |> addToHash "last_seen_on" (ctx.WebLog.LocalTime (defaultArg user.LastSeenOn (Instant.FromUnixTimeSeconds 0)))
(defaultArg user.LastSeenOn (Instant.FromUnixTimeSeconds 0)))
|> adminView "my-info" next ctx |> adminView "my-info" next ctx
@ -207,7 +205,7 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data let data = ctx.Data
let tryUser = let tryUser =
if model.IsNew then if model.IsNew then
{ WebLogUser.empty with { WebLogUser.Empty with
Id = WebLogUserId.Create() Id = WebLogUserId.Create()
WebLogId = ctx.WebLog.Id WebLogId = ctx.WebLog.Id
CreatedOn = Noda.now () CreatedOn = Noda.now ()

6
src/MyWebLog/Maintenance.fs
View File

@ -32,7 +32,7 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
let accessLevel = if List.isEmpty webLogs then Administrator else WebLogAdmin let accessLevel = if List.isEmpty webLogs then Administrator else WebLogAdmin
do! data.WebLog.Add do! data.WebLog.Add
{ WebLog.empty with { WebLog.Empty with
Id = webLogId Id = webLogId
Name = args[2] Name = args[2]
Slug = slug Slug = slug
@ -44,7 +44,7 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
// Create the admin user // Create the admin user
let now = Noda.now () let now = Noda.now ()
let user = let user =
{ WebLogUser.empty with { WebLogUser.Empty with
Id = userId Id = userId
WebLogId = webLogId WebLogId = webLogId
Email = args[3] Email = args[3]
@ -58,7 +58,7 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
// Create the default home page // Create the default home page
do! data.Page.Add do! data.Page.Add
{ Page.empty with { Page.Empty with
Id = homePageId Id = homePageId
WebLogId = webLogId WebLogId = webLogId
AuthorId = userId AuthorId = userId