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

WIP on module/member conversion

Browse Source 
Data types complete
This commit is contained in:
Daniel J. Summers 2023-12-16 14:05:45 -05:00
parent d8ce59a6cd
commit c3d615d10a
26 changed files with 481 additions and 521 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

244
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,17 +112,17 @@ 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 {
@ -132,7 +132,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
}
// 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> {
@ -771,7 +771,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
withTable Table.TagMap
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
}
@ -933,7 +933,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
withTable Table.Upload
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,15 +973,15 @@ 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
}
@ -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

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

@ -24,13 +24,10 @@ type Category = {
/// The parent ID of this category (if a subcategory)
ParentId: CategoryId option
}
/// Functions to support categories
module Category =
} with
/// An empty category
let empty = {
static member Empty = {
Id = CategoryId.Empty
WebLogId = WebLogId.Empty
Name = ""
@ -69,13 +66,10 @@ type Comment = {
/// The text of the comment
Text: string
}
/// Functions to support comments
module Comment =
} with
/// An empty comment
let empty = {
static member Empty = {
Id = CommentId.Empty
PostId = PostId.Empty
InReplyToId = None
@ -129,13 +123,10 @@ type Page = {
/// Revisions of this page
Revisions: Revision list
}
/// Functions to support pages
module Page =
} with
/// An empty page
let empty = {
static member Empty = {
Id = PageId.Empty
WebLogId = WebLogId.Empty
AuthorId = WebLogUserId.Empty
@ -202,13 +193,10 @@ type Post = {
/// The revisions for this post
Revisions: Revision list
}
/// Functions to support posts
module Post =
} with
/// An empty post
let empty = {
static member Empty = {
Id = PostId.Empty
WebLogId = WebLogId.Empty
AuthorId = WebLogUserId.Empty
@ -229,6 +217,7 @@ 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
@ -241,13 +230,10 @@ type TagMap = {
/// The value by which the tag should be linked
UrlValue: string
}
/// Functions to support tag mappings
module TagMap =
} with
/// An empty tag mapping
let empty = {
static member Empty = {
Id = TagMapId.Empty
WebLogId = WebLogId.Empty
Tag = ""
@ -256,6 +242,7 @@ module TagMap =
/// A theme
[<CLIMutable; NoComparison; NoEquality>]
type Theme = {
/// The ID / path of the theme
Id: ThemeId
@ -268,14 +255,11 @@ type Theme = {
/// 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,6 +267,7 @@ 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
@ -291,21 +276,19 @@ type ThemeAsset = {
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
@ -320,14 +303,11 @@ type Upload = {
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,6 +316,8 @@ module Upload =
}
open Newtonsoft.Json
/// A web log
[<CLIMutable; NoComparison; NoEquality>]
type WebLog = {
@ -377,13 +359,10 @@ type WebLog = {
/// Redirect rules for this weblog
RedirectRules: RedirectRule list
}
/// Functions to support web logs
module WebLog =
} 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()
@ -456,13 +434,10 @@ type WebLogUser = {
/// When the user last logged on
LastSeenOn: Instant option
}
/// Functions to support web log users
module WebLogUser =
} 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 "/"

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

@ -103,8 +103,8 @@ module DisplayCustomFeed =
/// Details about a page used to display page lists
[<NoComparison; NoEquality>]
type DisplayPage =
{ /// The ID of this page
type DisplayPage = {
/// The ID of this page
Id: string
/// The ID of the author of this page
@ -133,16 +133,16 @@ type DisplayPage =
/// 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,17 +150,9 @@ 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
static member FromPage webLog page =
{ DisplayPage.FromPageMinimal webLog page with
Text = addBaseToRelativeUrls webLog.ExtraPath page.Text
Metadata = page.Metadata
}
@ -182,9 +174,9 @@ type DisplayRevision = {
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,16 +288,16 @@ type DisplayUser = {
module DisplayUser =
/// Construct a displayed user from a web log user
let fromUser webLog (user: WebLogUser) =
{ Id = string user.Id
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 webLog user.CreatedOn
LastSeenOn = user.LastSeenOn |> Option.map (WebLog.localTime webLog) |> Option.toNullable
CreatedOn = webLog.LocalTime user.CreatedOn
LastSeenOn = user.LastSeenOn |> Option.map webLog.LocalTime |> Option.toNullable
}
@ -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,17 +1103,15 @@ 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
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 inTZ |> Option.toNullable
UpdatedOn = inTZ post.UpdatedOn
Text = addBaseToRelativeUrls extra post.Text
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

8
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,11 +93,11 @@ 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))

34
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,14 +29,14 @@ 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
permalink item ctx.WebLog.AbsoluteUrl
/// A filter to generate a link with posts categorized under the given category
@ -47,7 +47,7 @@ type CategoryLinkFilter () =
| :? 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}')"
@ -60,7 +60,7 @@ type EditPageLinkFilter () =
| :? 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}')"
@ -73,20 +73,20 @@ type EditPostLinkFilter () =
| :? 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}/"
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,7 +167,7 @@ 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
@ -178,7 +178,7 @@ type TagLinkFilter () =
|> function
| Some tagMap -> tagMap.UrlValue
| None -> tag.Replace(" ", "+")
|> function tagUrl -> WebLog.relativeUrl ctx.WebLog (Permalink $"tag/{tagUrl}/")
|> function tagUrl -> ctx.WebLog.RelativeUrl(Permalink $"tag/{tagUrl}/")
/// Create links for a user to log on or off, and a dashboard link if they are logged off
@ -186,7 +186,7 @@ type UserLinksTag () =
inherit Tag()
override this.Render(context: Context, result: TextWriter) =
let link it = WebLog.relativeUrl context.WebLog (Permalink it)
let link it = context.WebLog.RelativeUrl(Permalink it)
seq {
"""<ul class="navbar-nav flex-grow-1 justify-content-end">"""
match Convert.ToBoolean context.Environments[0].["is_logged_on"] with

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

29
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,7 +235,7 @@ 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 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)
@ -243,11 +244,11 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
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()
@ -379,11 +380,11 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
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)

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

16
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 extra = webLog.ExtraPath
let url = string ctx.Request.Path
(if extra = "" then url else url.Substring extra.Length).ToLowerInvariant()
(if extra = "" then url else url[..extra.Length]).ToLowerInvariant()
let await it = (Async.AwaitTask >> Async.RunSynchronously) it
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>()

14
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
@ -160,10 +160,8 @@ let private showMyInfo (model : EditMyInfoModel) (user : WebLogUser) : HttpHandl
|> 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