bit-badger/myWebLog
1
0
Fork 0
Code Issues 4 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.Configuration.Abstractions" Version="8.0.0" />
<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="Npgsql.NodaTime" Version="8.0.1" />
<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 {
log.LogTrace "Category.findAllForView"
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>
let ordered = Utils.orderByHierarchy cats None None []
let counts =
@ -36,7 +36,7 @@ type PostgresCategoryData(log: ILogger) =
|> Seq.map _.Id
|> Seq.append (Seq.singleton it.Id)
|> List.ofSeq
|> arrayContains (nameof Post.empty.CategoryIds) id
|> arrayContains (nameof Post.Empty.CategoryIds) id
let postCount =
Custom.scalar
$"""SELECT COUNT(DISTINCT id) AS {countName}
@ -97,7 +97,7 @@ type PostgresCategoryData(log: ILogger) =
()
// Delete the category off all posts where it is assigned
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>
if not (List.isEmpty posts) then
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)
let all webLogId =
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>
/// Count all pages for the given web log
@ -86,10 +86,10 @@ type PostgresPageData (log: ILogger) =
log.LogTrace "Page.findCurrentPermalink"
if List.isEmpty permalinks then return None
else
let linkSql, linkParam = arrayContains (nameof Page.empty.PriorPermalinks) string permalinks
let linkSql, linkParam = arrayContains (nameof Page.Empty.PriorPermalinks) string permalinks
return!
Custom.single
$"""SELECT data ->> '{nameof Page.empty.Permalink}' AS permalink
$"""SELECT data ->> '{nameof Page.Empty.Permalink}' AS permalink
FROM page
WHERE {Query.whereDataContains "@criteria"}
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)
let findListed webLogId =
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 |} ]
pageWithoutText
@ -118,7 +118,7 @@ type PostgresPageData (log: ILogger) =
log.LogTrace "Page.findPageOfPages"
Custom.list
$"{selectWithCriteria Table.Page}
ORDER BY LOWER(data->>'{nameof Page.empty.Title}')
ORDER BY LOWER(data->>'{nameof Page.Empty.Title}')
LIMIT @pageSize OFFSET @toSkip"
[ webLogContains webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ]
fromData<Page>

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

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

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

@ -23,7 +23,7 @@ type PostgresWebLogData (log : ILogger) =
log.LogTrace "WebLog.delete"
Custom.nonQuery
$"""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"});
{Query.Delete.byContains Table.Post};
{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 =
log.LogTrace "WebLogUser.findByWebLog"
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>
/// Find the names of users by their IDs for the given web log
@ -55,7 +55,7 @@ type PostgresWebLogUserData (log : ILogger) =
let! users =
Custom.list $"{selectWithCriteria Table.WebLogUser} {idSql}" (webLogContains webLogId :: idParams)
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

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

@ -58,10 +58,10 @@ type PostgresData (log : ILogger<PostgresData>, ser : JsonSerializer) =
// Page tables
if needsTable Table.Page then
Definition.createTable Table.Page
$"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_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_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
$"CREATE TABLE {Table.PageRevision} (
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
if needsTable Table.Post then
Definition.createTable Table.Post
$"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_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_status_idx ON {Table.Post}
((data ->> '{nameof Post.empty.WebLogId}'), (data ->> '{nameof Post.empty.Status}'),
(data ->> '{nameof Post.empty.UpdatedOn}'))"
((data ->> '{nameof Post.Empty.WebLogId}'), (data ->> '{nameof Post.Empty.Status}'),
(data ->> '{nameof Post.Empty.UpdatedOn}'))"
$"CREATE INDEX post_permalink_idx ON {Table.Post}
((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_tag_idx ON {Table.Post} USING GIN ((data['{nameof Post.empty.Tags}']))"
((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_tag_idx ON {Table.Post} USING GIN ((data['{nameof Post.Empty.Tags}']))"
if needsTable Table.PostRevision then
$"CREATE TABLE {Table.PostRevision} (
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
Definition.createTable Table.PostComment
$"CREATE INDEX post_comment_post_idx ON {Table.PostComment}
((data ->> '{nameof Comment.empty.PostId}'))"
((data ->> '{nameof Comment.Empty.PostId}'))"
// Tag map table
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)
let matchAssetByThemeId 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
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
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 }
// Post and page need index by web log ID and permalink
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
log.LogInformation $"Creating index {table}.{permalinkIdx}..."
do! rethink {
withTable table
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
}
// 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
log.LogInformation $"Creating index {table}.{priorIdx}..."
do! rethink {
withTable table
indexCreate priorIdx (fun row -> row[priorIdx].Downcase () :> obj) [ Multi ]
indexCreate priorIdx (fun row -> row[priorIdx].Downcase() :> obj) [ Multi ]
write; withRetryOnce; ignoreResult conn
}
// Post needs indexes by category and tag (used for counting and retrieving posts)
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
log.LogInformation $"Creating index {table}.{idx}..."
do! rethink {
@ -147,7 +147,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
do! rethink {
withTable table
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
}
if not (indexes |> List.contains Index.WebLogAndUrl) then
@ -155,7 +155,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
do! rethink {
withTable table
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
}
// 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 {
withTable table
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
}
// Users log on with e-mail
@ -175,7 +175,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
do! rethink {
withTable table
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
}
}
@ -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"
do! rethink {
withTable Table.WebLog
update [ nameof WebLog.empty.RedirectRules, [] :> obj ]
update [ nameof WebLog.Empty.RedirectRules, [] :> obj ]
write; withRetryOnce; ignoreResult conn
}
@ -271,15 +271,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.CountAll webLogId = rethink<int> {
withTable Table.Category
getAll [ webLogId ] (nameof Category.empty.WebLogId)
getAll [ webLogId ] (nameof Category.Empty.WebLogId)
count
result; withRetryDefault conn
}
member _.CountTopLevel webLogId = rethink<int> {
withTable Table.Category
getAll [ webLogId ] (nameof Category.empty.WebLogId)
filter (nameof Category.empty.ParentId) None
getAll [ webLogId ] (nameof Category.Empty.WebLogId)
filter (nameof Category.Empty.ParentId) None
count
result; withRetryDefault conn
}
@ -287,8 +287,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindAllForView webLogId = backgroundTask {
let! cats = rethink<Category list> {
withTable Table.Category
getAll [ webLogId ] (nameof Category.empty.WebLogId)
orderByFunc (fun it -> it[nameof Category.empty.Name].Downcase () :> obj)
getAll [ webLogId ] (nameof Category.Empty.WebLogId)
orderByFunc (fun it -> it[nameof Category.Empty.Name].Downcase() :> obj)
result; withRetryDefault conn
}
let ordered = Utils.orderByHierarchy cats None None []
@ -304,8 +304,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
|> List.ofSeq
let! count = rethink<int> {
withTable Table.Post
getAll catIds (nameof Post.empty.CategoryIds)
filter (nameof Post.empty.Status) Published
getAll catIds (nameof Post.Empty.CategoryIds)
filter (nameof Post.Empty.Status) Published
distinct
count
result; withRetryDefault conn
@ -335,7 +335,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByWebLog webLogId = rethink<Category list> {
withTable Table.Category
getAll [ webLogId ] (nameof Category.empty.WebLogId)
getAll [ webLogId ] (nameof Category.Empty.WebLogId)
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
let! children = rethink<int> {
withTable Table.Category
filter (nameof Category.empty.ParentId) catId
filter (nameof Category.Empty.ParentId) catId
count
result; withRetryDefault conn
}
if children > 0 then
do! rethink {
withTable Table.Category
filter (nameof Category.empty.ParentId) catId
update [ nameof Category.empty.ParentId, cat.ParentId :> obj ]
filter (nameof Category.Empty.ParentId) catId
update [ nameof Category.Empty.ParentId, cat.ParentId :> obj ]
write; withRetryDefault; ignoreResult conn
}
// Delete the category off all posts where it is assigned
do! rethink {
withTable Table.Post
getAll [ webLogId ] (nameof Post.empty.WebLogId)
filter (fun row -> row[nameof Post.empty.CategoryIds].Contains catId :> obj)
getAll [ webLogId ] (nameof Post.Empty.WebLogId)
filter (fun row -> row[nameof Post.Empty.CategoryIds].Contains catId :> obj)
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
}
// Delete the category itself
@ -408,26 +408,26 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.All webLogId = rethink<Page list> {
withTable Table.Page
getAll [ webLogId ] (nameof Page.empty.WebLogId)
without [ nameof Page.empty.Text
nameof Page.empty.Metadata
nameof Page.empty.Revisions
nameof Page.empty.PriorPermalinks ]
orderByFunc (fun row -> row[nameof Page.empty.Title].Downcase () :> obj)
getAll [ webLogId ] (nameof Page.Empty.WebLogId)
without [ nameof Page.Empty.Text
nameof Page.Empty.Metadata
nameof Page.Empty.Revisions
nameof Page.Empty.PriorPermalinks ]
orderByFunc (fun row -> row[nameof Page.Empty.Title].Downcase() :> obj)
result; withRetryDefault conn
}
member _.CountAll webLogId = rethink<int> {
withTable Table.Page
getAll [ webLogId ] (nameof Page.empty.WebLogId)
getAll [ webLogId ] (nameof Page.Empty.WebLogId)
count
result; withRetryDefault conn
}
member _.CountListed webLogId = rethink<int> {
withTable Table.Page
getAll [ webLogId ] (nameof Page.empty.WebLogId)
filter (nameof Page.empty.IsInPageList) true
getAll [ webLogId ] (nameof Page.Empty.WebLogId)
filter (nameof Page.Empty.IsInPageList) true
count
result; withRetryDefault conn
}
@ -436,7 +436,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! result = rethink<Model.Result> {
withTable Table.Page
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
write; withRetryDefault conn
}
@ -447,7 +447,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
rethink<Page> {
withTable Table.Page
get pageId
without [ nameof Page.empty.PriorPermalinks; nameof Page.empty.Revisions ]
without [ nameof Page.Empty.PriorPermalinks; nameof Page.Empty.Revisions ]
resultOption; withRetryOptionDefault
}
|> 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 =
rethink<Page list> {
withTable Table.Page
getAll [ [| webLogId :> obj; permalink |] ] (nameof Page.empty.Permalink)
without [ nameof Page.empty.PriorPermalinks; nameof Page.empty.Revisions ]
getAll [ [| webLogId :> obj; permalink |] ] (nameof Page.Empty.Permalink)
without [ nameof Page.Empty.PriorPermalinks; nameof Page.Empty.Revisions ]
limit 1
result; withRetryDefault
}
@ -466,9 +466,9 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! result =
(rethink<Page list> {
withTable Table.Page
getAll (objList permalinks) (nameof Page.empty.PriorPermalinks)
filter (nameof Page.empty.WebLogId) webLogId
without [ nameof Page.empty.Revisions; nameof Page.empty.Text ]
getAll (objList permalinks) (nameof Page.Empty.PriorPermalinks)
filter (nameof Page.Empty.WebLogId) webLogId
without [ nameof Page.Empty.Revisions; nameof Page.Empty.Text ]
limit 1
result; withRetryDefault
}
@ -486,26 +486,26 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindFullByWebLog webLogId = rethink<Page> {
withTable Table.Page
getAll [ webLogId ] (nameof Page.empty.WebLogId)
getAll [ webLogId ] (nameof Page.Empty.WebLogId)
resultCursor; withRetryCursorDefault; toList conn
}
member _.FindListed webLogId = rethink<Page list> {
withTable Table.Page
getAll [ webLogId ] (nameof Page.empty.WebLogId)
filter [ nameof Page.empty.IsInPageList, true :> obj ]
without [ nameof Page.empty.Text; nameof Page.empty.PriorPermalinks; nameof Page.empty.Revisions ]
orderBy (nameof Page.empty.Title)
getAll [ webLogId ] (nameof Page.Empty.WebLogId)
filter [ nameof Page.Empty.IsInPageList, true :> obj ]
without [ nameof Page.Empty.Text; nameof Page.Empty.PriorPermalinks; nameof Page.Empty.Revisions ]
orderBy (nameof Page.Empty.Title)
result; withRetryDefault conn
}
member _.FindPageOfPages webLogId pageNbr = rethink<Page list> {
withTable Table.Page
getAll [ webLogId ] (nameof Page.empty.WebLogId)
without [ nameof Page.empty.Metadata
nameof Page.empty.PriorPermalinks
nameof Page.empty.Revisions ]
orderByFunc (fun row -> row[nameof Page.empty.Title].Downcase ())
getAll [ webLogId ] (nameof Page.Empty.WebLogId)
without [ nameof Page.Empty.Metadata
nameof Page.Empty.PriorPermalinks
nameof Page.Empty.Revisions ]
orderByFunc (fun row -> row[nameof Page.Empty.Title].Downcase())
skip ((pageNbr - 1) * 25)
limit 25
result; withRetryDefault conn
@ -543,7 +543,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
do! rethink {
withTable Table.Page
get pageId
update [ nameof Page.empty.PriorPermalinks, permalinks :> obj ]
update [ nameof Page.Empty.PriorPermalinks, permalinks :> obj ]
write; withRetryDefault; ignoreResult conn
}
return true
@ -562,8 +562,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.CountByStatus status webLogId = rethink<int> {
withTable Table.Post
getAll [ webLogId ] (nameof Post.empty.WebLogId)
filter (nameof Post.empty.Status) status
getAll [ webLogId ] (nameof Post.Empty.WebLogId)
filter (nameof Post.Empty.Status) status
count
result; withRetryDefault conn
}
@ -572,7 +572,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! result = rethink<Model.Result> {
withTable Table.Post
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
write; withRetryDefault conn
}
@ -583,7 +583,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
rethink<Post> {
withTable Table.Post
get postId
without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
without [ nameof Post.Empty.PriorPermalinks; nameof Post.Empty.Revisions ]
resultOption; withRetryOptionDefault
}
|> 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 =
rethink<Post list> {
withTable Table.Post
getAll [ [| webLogId :> obj; permalink |] ] (nameof Post.empty.Permalink)
without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
getAll [ [| webLogId :> obj; permalink |] ] (nameof Post.Empty.Permalink)
without [ nameof Post.Empty.PriorPermalinks; nameof Post.Empty.Revisions ]
limit 1
result; withRetryDefault
}
@ -610,9 +610,9 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! result =
(rethink<Post list> {
withTable Table.Post
getAll (objList permalinks) (nameof Post.empty.PriorPermalinks)
filter (nameof Post.empty.WebLogId) webLogId
without [ nameof Post.empty.Revisions; nameof Post.empty.Text ]
getAll (objList permalinks) (nameof Post.Empty.PriorPermalinks)
filter (nameof Post.Empty.WebLogId) webLogId
without [ nameof Post.Empty.Revisions; nameof Post.Empty.Text ]
limit 1
result; withRetryDefault
}
@ -622,18 +622,18 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindFullByWebLog webLogId = rethink<Post> {
withTable Table.Post
getAll [ webLogId ] (nameof Post.empty.WebLogId)
getAll [ webLogId ] (nameof Post.Empty.WebLogId)
resultCursor; withRetryCursorDefault; toList conn
}
member _.FindPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = rethink<Post list> {
withTable Table.Post
getAll (objList categoryIds) (nameof Post.empty.CategoryIds)
filter [ nameof Post.empty.WebLogId, webLogId :> obj
nameof Post.empty.Status, Published ]
without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
getAll (objList categoryIds) (nameof Post.Empty.CategoryIds)
filter [ nameof Post.Empty.WebLogId, webLogId :> obj
nameof Post.Empty.Status, Published ]
without [ nameof Post.Empty.PriorPermalinks; nameof Post.Empty.Revisions ]
distinct
orderByDescending (nameof Post.empty.PublishedOn)
orderByDescending (nameof Post.Empty.PublishedOn)
skip ((pageNbr - 1) * postsPerPage)
limit (postsPerPage + 1)
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> {
withTable Table.Post
getAll [ webLogId ] (nameof Post.empty.WebLogId)
without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
getAll [ webLogId ] (nameof Post.Empty.WebLogId)
without [ nameof Post.Empty.PriorPermalinks; nameof Post.Empty.Revisions ]
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)
limit (postsPerPage + 1)
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> {
withTable Table.Post
getAll [ webLogId ] (nameof Post.empty.WebLogId)
filter (nameof Post.empty.Status) Published
without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
orderByDescending (nameof Post.empty.PublishedOn)
getAll [ webLogId ] (nameof Post.Empty.WebLogId)
filter (nameof Post.Empty.Status) Published
without [ nameof Post.Empty.PriorPermalinks; nameof Post.Empty.Revisions ]
orderByDescending (nameof Post.Empty.PublishedOn)
skip ((pageNbr - 1) * postsPerPage)
limit (postsPerPage + 1)
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> {
withTable Table.Post
getAll [ tag ] (nameof Post.empty.Tags)
filter [ nameof Post.empty.WebLogId, webLogId :> obj
nameof Post.empty.Status, Published ]
without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
orderByDescending (nameof Post.empty.PublishedOn)
getAll [ tag ] (nameof Post.Empty.Tags)
filter [ nameof Post.Empty.WebLogId, webLogId :> obj
nameof Post.Empty.Status, Published ]
without [ nameof Post.Empty.PriorPermalinks; nameof Post.Empty.Revisions ]
orderByDescending (nameof Post.Empty.PublishedOn)
skip ((pageNbr - 1) * postsPerPage)
limit (postsPerPage + 1)
result; withRetryDefault conn
@ -677,10 +677,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! older =
rethink<Post list> {
withTable Table.Post
getAll [ webLogId ] (nameof Post.empty.WebLogId)
filter (fun row -> row[nameof Post.empty.PublishedOn].Lt publishedOn :> obj)
without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
orderByDescending (nameof Post.empty.PublishedOn)
getAll [ webLogId ] (nameof Post.Empty.WebLogId)
filter (fun row -> row[nameof Post.Empty.PublishedOn].Lt publishedOn :> obj)
without [ nameof Post.Empty.PriorPermalinks; nameof Post.Empty.Revisions ]
orderByDescending (nameof Post.Empty.PublishedOn)
limit 1
result; withRetryDefault
}
@ -688,10 +688,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! newer =
rethink<Post list> {
withTable Table.Post
getAll [ webLogId ] (nameof Post.empty.WebLogId)
filter (fun row -> row[nameof Post.empty.PublishedOn].Gt publishedOn :> obj)
without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
orderBy (nameof Post.empty.PublishedOn)
getAll [ webLogId ] (nameof Post.Empty.WebLogId)
filter (fun row -> row[nameof Post.Empty.PublishedOn].Gt publishedOn :> obj)
without [ nameof Post.Empty.PriorPermalinks; nameof Post.Empty.Revisions ]
orderBy (nameof Post.Empty.PublishedOn)
limit 1
result; withRetryDefault
}
@ -720,15 +720,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
rethink<Post> {
withTable Table.Post
get postId
without [ nameof Post.empty.Revisions; nameof Post.empty.PriorPermalinks ]
without [ nameof Post.Empty.Revisions; nameof Post.Empty.PriorPermalinks ]
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId (fun p -> p.WebLogId)) conn with
|> verifyWebLog webLogId (_.WebLogId)) conn with
| Some _ ->
do! rethink {
withTable Table.Post
get postId
update [ nameof Post.empty.PriorPermalinks, permalinks :> obj ]
update [ nameof Post.Empty.PriorPermalinks, permalinks :> obj ]
write; withRetryDefault; ignoreResult conn
}
return true
@ -743,7 +743,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! result = rethink<Model.Result> {
withTable Table.TagMap
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
write; withRetryDefault conn
}
@ -756,7 +756,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get tagMapId
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId (fun tm -> tm.WebLogId) <| conn
|> verifyWebLog webLogId (_.WebLogId) <| conn
member _.FindByUrlValue urlValue webLogId =
rethink<TagMap list> {
@ -769,9 +769,9 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByWebLog webLogId = rethink<TagMap list> {
withTable Table.TagMap
between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |]
between [| webLogId :> obj; r.Minval() |] [| webLogId :> obj; r.Maxval() |]
[ Index Index.WebLogAndTag ]
orderBy (nameof TagMap.empty.Tag)
orderBy (nameof TagMap.Empty.Tag)
result; withRetryDefault conn
}
@ -803,16 +803,16 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.All () = rethink<Theme list> {
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
orderBy (nameof Theme.empty.Id)
orderBy (nameof Theme.Empty.Id)
result; withRetryDefault conn
}
member _.Exists themeId = backgroundTask {
let! count = rethink<int> {
withTable Table.Theme
filter (nameof Theme.empty.Id) themeId
filter (nameof Theme.Empty.Id) themeId
count
result; withRetryDefault conn
}
@ -859,7 +859,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.All () = rethink<ThemeAsset list> {
withTable Table.ThemeAsset
without [ nameof ThemeAsset.empty.Data ]
without [ nameof ThemeAsset.Empty.Data ]
result; withRetryDefault conn
}
@ -874,7 +874,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByTheme themeId = rethink<ThemeAsset list> {
withTable Table.ThemeAsset
filter (matchAssetByThemeId themeId)
without [ nameof ThemeAsset.empty.Data ]
without [ nameof ThemeAsset.Empty.Data ]
result; withRetryDefault conn
}
@ -931,9 +931,9 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByWebLog webLogId = rethink<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 ]
without [ nameof Upload.empty.Data ]
without [ nameof Upload.Empty.Data ]
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
let! thePostIds = rethink<{| Id : string |} list> {
withTable Table.Post
getAll [ webLogId ] (nameof Post.empty.WebLogId)
pluck [ nameof Post.empty.Id ]
getAll [ webLogId ] (nameof Post.Empty.WebLogId)
pluck [ nameof Post.Empty.Id ]
result; withRetryOnce conn
}
if not (List.isEmpty thePostIds) then
let postIds = thePostIds |> List.map (fun it -> it.Id :> obj)
do! rethink {
withTable Table.Comment
getAll postIds (nameof Comment.empty.PostId)
getAll postIds (nameof Comment.Empty.PostId)
delete
write; withRetryOnce; ignoreResult conn
}
// Tag mappings do not have a straightforward webLogId index
do! rethink {
withTable Table.TagMap
between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |]
between [| webLogId :> obj; r.Minval() |] [| webLogId :> obj; r.Maxval() |]
[ Index Index.WebLogAndTag ]
delete
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
do! rethink {
withTable Table.Upload
between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |]
between [| webLogId :> obj; r.Minval() |] [| webLogId :> obj; r.Maxval() |]
[ Index Index.WebLogAndPath ]
delete
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
do! rethink {
withTable table
getAll [ webLogId ] (nameof Post.empty.WebLogId)
getAll [ webLogId ] (nameof Post.Empty.WebLogId)
delete
write; withRetryOnce; ignoreResult conn
}
@ -1019,7 +1019,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByHost url =
rethink<WebLog list> {
withTable Table.WebLog
getAll [ url ] (nameof WebLog.empty.UrlBase)
getAll [ url ] (nameof WebLog.Empty.UrlBase)
limit 1
result; withRetryDefault
}
@ -1034,14 +1034,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.UpdateRedirectRules webLog = rethink {
withTable Table.WebLog
get webLog.Id
update [ nameof WebLog.empty.RedirectRules, webLog.RedirectRules :> obj ]
update [ nameof WebLog.Empty.RedirectRules, webLog.RedirectRules :> obj ]
write; withRetryDefault; ignoreResult conn
}
member _.UpdateRssOptions webLog = rethink {
withTable Table.WebLog
get webLog.Id
update [ nameof WebLog.empty.Rss, webLog.Rss :> obj ]
update [ nameof WebLog.Empty.Rss, webLog.Rss :> obj ]
write; withRetryDefault; ignoreResult conn
}
@ -1085,15 +1085,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
| Some _ ->
let! pageCount = rethink<int> {
withTable Table.Page
getAll [ webLogId ] (nameof Page.empty.WebLogId)
filter (nameof Page.empty.AuthorId) userId
getAll [ webLogId ] (nameof Page.Empty.WebLogId)
filter (nameof Page.Empty.AuthorId) userId
count
result; withRetryDefault conn
}
let! postCount = rethink<int> {
withTable Table.Post
getAll [ webLogId ] (nameof Post.empty.WebLogId)
filter (nameof Post.empty.AuthorId) userId
getAll [ webLogId ] (nameof Post.Empty.WebLogId)
filter (nameof Post.Empty.AuthorId) userId
count
result; withRetryDefault conn
}
@ -1121,8 +1121,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByWebLog webLogId = rethink<WebLogUser list> {
withTable Table.WebLogUser
getAll [ webLogId ] (nameof WebLogUser.empty.WebLogId)
orderByFunc (fun row -> row[nameof WebLogUser.empty.PreferredName].Downcase ())
getAll [ webLogId ] (nameof WebLogUser.Empty.WebLogId)
orderByFunc (fun row -> row[nameof WebLogUser.Empty.PreferredName].Downcase())
result; withRetryDefault conn
}
@ -1130,10 +1130,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! users = rethink<WebLogUser list> {
withTable Table.WebLogUser
getAll (objList userIds)
filter (nameof WebLogUser.empty.WebLogId) webLogId
filter (nameof WebLogUser.Empty.WebLogId) webLogId
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 {
@ -1151,7 +1151,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
do! rethink {
withTable Table.WebLogUser
get userId
update [ nameof WebLogUser.empty.LastSeenOn, Noda.now () :> obj ]
update [ nameof WebLogUser.Empty.LastSeenOn, Noda.now () :> obj ]
write; withRetryOnce; ignoreResult conn
}
| None -> ()
@ -1196,19 +1196,19 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
write; withRetryOnce; ignoreResult conn
}
do! ensureIndexes Table.Category [ nameof Category.empty.WebLogId ]
do! ensureIndexes Table.Comment [ nameof Comment.empty.PostId ]
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.Category [ nameof Category.Empty.WebLogId ]
do! ensureIndexes Table.Comment [ nameof Comment.Empty.PostId ]
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.TagMap []
do! ensureIndexes Table.Upload []
do! ensureIndexes Table.WebLog [ nameof WebLog.empty.UrlBase ]
do! ensureIndexes Table.WebLogUser [ nameof WebLogUser.empty.WebLogId ]
do! ensureIndexes Table.WebLog [ nameof WebLog.Empty.UrlBase ]
do! ensureIndexes Table.WebLogUser [ nameof WebLogUser.Empty.WebLogId ]
let! version = rethink<{| Id : string |} list> {
withTable Table.DbVersion
limit 1
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
let toPage ser rdr : Page =
{ Page.empty with
{ Page.Empty with
Id = getString "id" rdr |> PageId
WebLogId = getString "web_log_id" rdr |> WebLogId
AuthorId = getString "author_id" rdr |> WebLogUserId
@ -250,7 +250,7 @@ module Map =
/// Create a post from the current row in the given data reader
let toPost ser rdr : Post =
{ Post.empty with
{ Post.Empty with
Id = getString "id" rdr |> PostId
WebLogId = getString "web_log_id" rdr |> WebLogId
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)
let toTheme rdr : Theme =
{ Theme.empty with
{ Theme.Empty with
Id = getString "id" rdr |> ThemeId
Name = getString "name" 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
cmd.Parameters.AddRange nameParams
use! rdr = cmd.ExecuteReaderAsync ()
return
toList Map.toWebLogUser rdr |> List.map (fun u -> { Name = string u.Id; Value = WebLogUser.displayName u })
return toList Map.toWebLogUser rdr |> List.map (fun u -> { Name = string u.Id; Value = u.DisplayName })
}
/// Restore users from a backup

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

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

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

@ -9,6 +9,7 @@
<ItemGroup>
<PackageReference Include="Markdig" Version="0.31.0" />
<PackageReference Include="Markdown.ColorCode" Version="1.0.4" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.3" />
<PackageReference Include="NodaTime" Version="3.1.9" />
</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?
member this.HasAccess(needed: AccessLevel) =
// TODO: Move this to user where it seems to belong better...
let weights =
[ Author, 10
Editor, 20
WebLogAdmin, 30
Administrator, 40
]
Administrator, 40 ]
|> Map.ofList
weights[needed] <= weights[this]
@ -639,6 +637,9 @@ type TagMapId =
type ThemeId =
| ThemeId of string
/// An empty theme ID
static member Empty = ThemeId ""
/// The string representation of a theme ID
override this.ToString() =
match this with ThemeId it -> it
@ -649,6 +650,9 @@ type ThemeId =
type ThemeAssetId =
| ThemeAssetId of ThemeId * string
/// An empty theme asset ID
static member Empty = ThemeAssetId(ThemeId.Empty, "")
/// Convert a string into a theme asset ID
static member Parse(it : string) =
let themeIdx = it.IndexOf "/"

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

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

76
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)
/// 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
| :? String as link -> Some link
| :? 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
| _ -> None
|> function
| Some link -> linkFunc ctx.WebLog (Permalink link)
| Some link -> linkFunc (Permalink link)
| None -> $"alert('unknown item type {item.GetType().Name}')"
/// A filter to generate an absolute link
type AbsoluteLinkFilter () =
static member AbsoluteLink (ctx : Context, item : obj) =
permalink ctx item WebLog.absoluteUrl
type AbsoluteLinkFilter() =
static member AbsoluteLink(ctx: Context, item: obj) =
permalink item ctx.WebLog.AbsoluteUrl
/// A filter to generate a link with posts categorized under the given category
type CategoryLinkFilter () =
static member CategoryLink (ctx : Context, catObj : obj) =
type CategoryLinkFilter() =
static member CategoryLink(ctx: Context, catObj: obj) =
match catObj with
| :? DisplayCategory as cat -> Some cat.Slug
| :? DropProxy as proxy -> Option.ofObj proxy["Slug"] |> Option.map string
| _ -> None
|> function
| Some slug -> WebLog.relativeUrl ctx.WebLog (Permalink $"category/{slug}/")
| Some slug -> ctx.WebLog.RelativeUrl(Permalink $"category/{slug}/")
| None -> $"alert('unknown category object type {catObj.GetType().Name}')"
/// A filter to generate a link that will edit a page
type EditPageLinkFilter () =
static member EditPageLink (ctx : Context, pageObj : obj) =
type EditPageLinkFilter() =
static member EditPageLink(ctx: Context, pageObj: obj) =
match pageObj with
| :? DisplayPage as page -> Some page.Id
| :? DropProxy as proxy -> Option.ofObj proxy["Id"] |> Option.map string
| :? String as theId -> Some theId
| _ -> None
|> function
| Some pageId -> WebLog.relativeUrl 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}')"
/// A filter to generate a link that will edit a post
type EditPostLinkFilter () =
static member EditPostLink (ctx : Context, postObj : obj) =
type EditPostLinkFilter() =
static member EditPostLink(ctx: Context, postObj: obj) =
match postObj with
| :? PostListItem as post -> Some post.Id
| :? DropProxy as proxy -> Option.ofObj proxy["Id"] |> Option.map string
| :? String as theId -> Some theId
| _ -> None
|> function
| Some postId -> WebLog.relativeUrl 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}')"
/// A filter to generate nav links, highlighting the active link (exact match)
type NavLinkFilter () =
static member NavLink (ctx : Context, url : string, text : string) =
let _, path = WebLog.hostAndPath ctx.WebLog
let path = if path = "" then path else $"{path.Substring 1}/"
type NavLinkFilter() =
static member NavLink(ctx: Context, url: string, text: string) =
let extraPath = ctx.WebLog.ExtraPath
let path = if extraPath = "" then "" else $"{extraPath[1..]}/"
seq {
"<li class=\"nav-item\"><a class=\"nav-link"
if (string ctx.Environments[0].["current_page"]).StartsWith $"{path}{url}" then " active"
"\" href=\""
WebLog.relativeUrl ctx.WebLog (Permalink url)
ctx.WebLog.RelativeUrl(Permalink url)
"\">"
text
"</a></li>"
@ -97,7 +97,7 @@ type NavLinkFilter () =
/// A filter to generate a link for theme asset (image, stylesheet, script, etc.)
type ThemeAssetFilter() =
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
@ -122,12 +122,12 @@ type PageHeadTag() =
// RSS feeds and canonical URLs
let feedLink title url =
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}">"""
if webLog.Rss.IsFeedEnabled && getBool "is_home" then
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
let slug = context.Environments[0].["slug"] :?> string
@ -139,12 +139,12 @@ type PageHeadTag() =
if getBool "is_post" then
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}">"""
if getBool "is_page" then
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}">"""
@ -167,26 +167,26 @@ type PageFootTag () =
/// A filter to generate a relative link
type RelativeLinkFilter () =
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
type TagLinkFilter () =
static member TagLink (ctx : Context, tag : string) =
type TagLinkFilter() =
static member TagLink(ctx: Context, tag: string) =
ctx.Environments[0].["tag_mappings"] :?> TagMap list
|> List.tryFind (fun it -> it.Tag = tag)
|> function
| Some tagMap -> tagMap.UrlValue
| None -> tag.Replace (" ", "+")
|> function tagUrl -> WebLog.relativeUrl ctx.WebLog (Permalink $"tag/{tagUrl}/")
| None -> tag.Replace(" ", "+")
|> 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
type UserLinksTag () =
inherit Tag ()
type UserLinksTag() =
inherit Tag()
override this.Render (context : Context, result : TextWriter) =
let link it = WebLog.relativeUrl context.WebLog (Permalink it)
override this.Render(context: Context, result: TextWriter) =
let link it = context.WebLog.RelativeUrl(Permalink it)
seq {
"""<ul class="navbar-nav flex-grow-1 justify-content-end">"""
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
// (shorter than `{% assign item = list | where: "Name", [name] | first %}{{ item.value }}`)
type ValueFilter () =
static member Value (_ : Context, items : MetaItem list, name : string) =
type ValueFilter() =
static member Value(_: Context, items: MetaItem list, name: string) =
match items |> List.tryFind (fun it -> it.Name = name) with
| Some item -> item.Value
| 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! result = task {
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
| Some cat -> return Some ("Edit Category", cat)
@ -177,7 +177,7 @@ module Category =
let data = ctx.Data
let! model = ctx.BindFormAsync<EditCategoryModel> ()
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
match! category with
| Some cat ->
@ -333,7 +333,7 @@ module TagMapping =
let edit tagMapId : HttpHandler = fun next ctx -> task {
let isNew = tagMapId = "new"
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
match! tagMap with
| Some tm ->
@ -350,7 +350,7 @@ module TagMapping =
let data = ctx.Data
let! model = ctx.BindFormAsync<EditTagMapModel>()
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
match! tagMap with
| Some tm ->
@ -455,7 +455,7 @@ module Theme =
let! isNew, theme = backgroundTask {
match! data.Theme.FindById themeId with
| 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)
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/"
/// 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) =
let plainText =
let endingP = post.Text.IndexOf "</p>"
stripHtml <| if endingP >= 0 then post.Text[..(endingP - 1)] else post.Text
let item = SyndicationItem(
Id = WebLog.absoluteUrl webLog post.Permalink,
Id = webLog.AbsoluteUrl post.Permalink,
Title = TextSyndicationContent.CreateHtmlContent post.Title,
PublishDate = post.PublishedOn.Value.ToDateTimeOffset(),
LastUpdatedTime = post.UpdatedOn.ToDateTimeOffset(),
@ -115,30 +115,31 @@ let private toFeedItem webLog (authors: MetaItem list) (cats: DisplayCategory ar
[ post.CategoryIds
|> List.map (fun 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
|> List.map (fun tag ->
let urlTag =
match tagMaps |> List.tryFind (fun tm -> tm.Tag = tag) with
| Some tm -> tm.UrlValue
| 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.iter item.Categories.Add
item
/// Convert non-absolute URLs to an absolute URL for this web log
let toAbsolute webLog (link: string) =
if link.StartsWith "http" then link else WebLog.absoluteUrl webLog (Permalink link)
let toAbsolute (webLog: WebLog) (link: string) =
if link.StartsWith "http" then link else webLog.AbsoluteUrl(Permalink link)
/// 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 =
match episode.Media with
| link when link.StartsWith "http" -> 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 epImageUrl = defaultArg episode.ImageUrl (string podcast.ImageUrl) |> toAbsolute webLog
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)
/// Add items to the top of the feed required for podcasts
let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
let addChild (doc : XmlDocument) ns prefix name value (elt : XmlElement) =
let private addPodcast (webLog: WebLog) (rssFeed: SyndicationFeed) (feed: CustomFeed) =
let addChild (doc: XmlDocument) ns prefix name value (elt: XmlElement) =
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
child.InnerText <- value
elt
let podcast = Option.get feed.Podcast
let feedUrl = WebLog.absoluteUrl webLog feed.Path
let feedUrl = webLog.AbsoluteUrl feed.Path
let imageUrl =
match podcast.ImageUrl with
| 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
"itunes", Namespace.iTunes
@ -260,12 +261,12 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
|> List.iter (fun (alias, nsUrl) -> addNamespace rssFeed alias nsUrl)
let categorization =
let it = xmlDoc.CreateElement ("itunes", "category", Namespace.iTunes)
it.SetAttribute ("text", podcast.AppleCategory)
let it = xmlDoc.CreateElement("itunes", "category", Namespace.iTunes)
it.SetAttribute("text", podcast.AppleCategory)
podcast.AppleSubcategory
|> Option.iter (fun subCat ->
let subCatElt = xmlDoc.CreateElement ("itunes", "category", Namespace.iTunes)
subCatElt.SetAttribute ("text", subCat)
let subCatElt = xmlDoc.CreateElement("itunes", "category", Namespace.iTunes)
subCatElt.SetAttribute("text", subCat)
it.AppendChild subCatElt |> ignore)
it
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")
let iTunesImage =
let it = xmlDoc.CreateElement ("itunes", "image", Namespace.iTunes)
it.SetAttribute ("href", imageUrl)
let it = xmlDoc.CreateElement("itunes", "image", Namespace.iTunes)
it.SetAttribute("href", imageUrl)
it
let owner =
[ "name", podcast.DisplayedAuthor
"email", podcast.Email
]
|> 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 it = xmlDoc.CreateElement ("rawvoice", "subscribe", Namespace.rawVoice)
it.SetAttribute ("feed", feedUrl)
it.SetAttribute ("itunes", "")
let it = xmlDoc.CreateElement("rawvoice", "subscribe", Namespace.rawVoice)
it.SetAttribute("feed", feedUrl)
it.SetAttribute("itunes", "")
it
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("author", Namespace.iTunes, podcast.DisplayedAuthor)
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
|> Option.iter (fun url ->
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"""
/// 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 data = ctx.Data
let! authors = getAuthors webLog posts data
@ -371,36 +372,36 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
item
| _ -> item
let feed = SyndicationFeed ()
let feed = SyndicationFeed()
addNamespace feed "content" Namespace.content
setTitleAndDescription feedType webLog cats feed
feed.LastUpdatedTime <- (List.head posts).UpdatedOn.ToDateTimeOffset ()
feed.LastUpdatedTime <- (List.head posts).UpdatedOn.ToDateTimeOffset()
feed.Generator <- ctx.Generator
feed.Items <- posts |> Seq.ofList |> Seq.map toItem
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)
feed.Links.Add (SyndicationLink (Uri (WebLog.absoluteUrl webLog self), "self", "", "application/rss+xml", 0L))
feed.ElementExtensions.Add ("link", "", WebLog.absoluteUrl webLog link)
feed.Links.Add(SyndicationLink(Uri(webLog.AbsoluteUrl self), "self", "", "application/rss+xml", 0L))
feed.ElementExtensions.Add("link", "", webLog.AbsoluteUrl link)
podcast |> Option.iter (addPodcast webLog feed)
use mem = new MemoryStream ()
use mem = new MemoryStream()
use xml = XmlWriter.Create mem
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! output = rdr.ReadToEndAsync ()
let! output = rdr.ReadToEndAsync()
return! (setHttpHeader "Content-Type" "text/xml" >=> setStatusCode 200 >=> setBodyFromString output) next ctx
}
// 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
| posts when List.length posts > 0 -> return! createFeed feedType posts 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
let redirectToGet url : HttpHandler = fun _ ctx -> task {
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! result = task {
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
| 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 {
match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.AuthorId ctx ->
let _, extra = WebLog.hostAndPath ctx.WebLog
return! {|
content =
[ """<div class="mwl-revision-preview mb-3">"""
rev.Text.AsHtml() |> addBaseToRelativeUrls extra
rev.Text.AsHtml() |> addBaseToRelativeUrls ctx.WebLog.ExtraPath
"</div>"
]
|> String.concat ""
@ -179,7 +178,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let now = Noda.now ()
let tryPage =
if model.IsNew then
{ Page.empty with
{ Page.Empty with
Id = PageId.Create()
WebLogId = ctx.WebLog.Id
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! authors = getAuthors 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 =
posts
|> Seq.ofList
@ -115,7 +115,7 @@ let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task {
// GET /page/{pageNbr}/
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}/page/{pageNbr}
@ -184,7 +184,7 @@ let pageOfTaggedPosts slugAndPage : HttpHandler = fun next ctx -> task {
let endUrl = if pageNbr = 1 then "" else $"page/{pageNbr}"
return!
redirectTo true
(WebLog.relativeUrl webLog (Permalink $"""tag/{spacedTag.Replace (" ", "+")}/{endUrl}"""))
(webLog.RelativeUrl(Permalink $"""tag/{spacedTag.Replace (" ", "+")}/{endUrl}"""))
next ctx
| _ -> 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! result = task {
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
| 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 {
match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx ->
let _, extra = WebLog.hostAndPath ctx.WebLog
return! {|
content =
[ """<div class="mwl-revision-preview mb-3">"""
rev.Text.AsHtml() |> addBaseToRelativeUrls extra
rev.Text.AsHtml() |> addBaseToRelativeUrls ctx.WebLog.ExtraPath
"</div>"
]
|> String.concat ""
@ -378,7 +377,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
let tryPost =
if model.IsNew then
{ Post.empty with
{ Post.Empty with
Id = PostId.Create()
WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId

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

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

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),
Path.GetExtension(upload.FileName).ToLowerInvariant())
let now = Noda.now ()
let localNow = WebLog.localTime ctx.WebLog now
let localNow = ctx.WebLog.LocalTime now
let year = localNow.ToString "yyyy"
let month = localNow.ToString "MM"
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 userId = WebLogUserId usrId
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
match! tryUser with
| Some user -> return! showEdit (EditUserModel.fromUser user) next ctx
@ -141,13 +141,13 @@ let delete userId : HttpHandler = fun next ctx -> task {
| Ok _ ->
do! addMessage ctx
{ UserMessage.success with
Message = $"User {WebLogUser.displayName user} deleted successfully"
Message = $"User {user.DisplayName} deleted successfully"
}
return! all next ctx
| Error msg ->
do! addMessage ctx
{ UserMessage.error with
Message = $"User {WebLogUser.displayName user} was not deleted"
Message = $"User {user.DisplayName} was not deleted"
Detail = Some msg
}
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
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"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model model
|> addToHash "access_level" (string user.AccessLevel)
|> addToHash "created_on" (WebLog.localTime ctx.WebLog user.CreatedOn)
|> addToHash "last_seen_on" (WebLog.localTime ctx.WebLog
(defaultArg user.LastSeenOn (Instant.FromUnixTimeSeconds 0)))
|> addToHash "created_on" (ctx.WebLog.LocalTime user.CreatedOn)
|> addToHash "last_seen_on" (ctx.WebLog.LocalTime (defaultArg user.LastSeenOn (Instant.FromUnixTimeSeconds 0)))
|> adminView "my-info" next ctx
@ -207,7 +205,7 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
let tryUser =
if model.IsNew then
{ WebLogUser.empty with
{ WebLogUser.Empty with
Id = WebLogUserId.Create()
WebLogId = ctx.WebLog.Id
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
do! data.WebLog.Add
{ WebLog.empty with
{ WebLog.Empty with
Id = webLogId
Name = args[2]
Slug = slug
@ -44,7 +44,7 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
// Create the admin user
let now = Noda.now ()
let user =
{ WebLogUser.empty with
{ WebLogUser.Empty with
Id = userId
WebLogId = webLogId
Email = args[3]
@ -58,7 +58,7 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
// Create the default home page
do! data.Page.Add
{ Page.empty with
{ Page.Empty with
Id = homePageId
WebLogId = webLogId
AuthorId = userId