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

Clean up database names (#21)

Browse Source 
- Moved user edit to "my info" (#19)
This commit is contained in:
Daniel J. Summers
2022-07-18 20:05:10 -04:00
parent 5fb3a73dcf
commit 7eaad4a076
36 changed files with 1993 additions and 1745 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -100,13 +100,6 @@ module Json =
override _.ReadJson (reader : JsonReader, _ : Type, _ : ThemeId, _ : bool, _ : JsonSerializer) =
(string >> ThemeId) reader.Value
type UploadDestinationConverter () =
inherit JsonConverter<UploadDestination> ()
override _.WriteJson (writer : JsonWriter, value : UploadDestination, _ : JsonSerializer) =
writer.WriteValue (UploadDestination.toString value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : UploadDestination, _ : bool, _ : JsonSerializer) =
(string >> UploadDestination.parse) reader.Value
type UploadIdConverter () =
inherit JsonConverter<UploadId> ()
override _.WriteJson (writer : JsonWriter, value : UploadId, _ : JsonSerializer) =
@@ -134,23 +127,22 @@ module Json =
let all () : JsonConverter seq =
seq {
// Our converters
CategoryIdConverter ()
CommentIdConverter ()
CustomFeedIdConverter ()
CustomFeedSourceConverter ()
ExplicitRatingConverter ()
MarkupTextConverter ()
PermalinkConverter ()
PageIdConverter ()
PodcastMediumConverter ()
PostIdConverter ()
TagMapIdConverter ()
ThemeAssetIdConverter ()
ThemeIdConverter ()
UploadDestinationConverter ()
UploadIdConverter ()
WebLogIdConverter ()
WebLogUserIdConverter ()
CategoryIdConverter ()
CommentIdConverter ()
CustomFeedIdConverter ()
CustomFeedSourceConverter ()
ExplicitRatingConverter ()
MarkupTextConverter ()
PermalinkConverter ()
PageIdConverter ()
PodcastMediumConverter ()
PostIdConverter ()
TagMapIdConverter ()
ThemeAssetIdConverter ()
ThemeIdConverter ()
UploadIdConverter ()
WebLogIdConverter ()
WebLogUserIdConverter ()
// Handles DUs with no associated data, as well as option fields
CompactUnionJsonConverter ()
CompactUnionJsonConverter ()
}

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

@@ -16,7 +16,7 @@
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
<PackageReference Include="RethinkDb.Driver" Version="2.3.150" />
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-05" />
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-06" />
<PackageReference Update="FSharp.Core" Version="6.0.5" />
</ItemGroup>

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

@@ -45,7 +45,24 @@ module private RethinkHelpers =
/// A list of all tables
let all = [ Category; Comment; Page; Post; TagMap; Theme; ThemeAsset; Upload; WebLog; WebLogUser ]
/// Index names for indexes not on a data item's name
[<RequireQualifiedAccess>]
module Index =
/// An index by web log ID and e-mail address
let LogOn = "LogOn"
/// An index by web log ID and uploaded file path
let WebLogAndPath = "WebLogAndPath"
/// An index by web log ID and mapped tag
let WebLogAndTag = "WebLogAndTag"
/// An index by web log ID and tag URL value
let WebLogAndUrl = "WebLogAndUrl"
/// Shorthand for the ReQL starting point
let r = RethinkDB.R
@@ -77,7 +94,7 @@ 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.toString themeId}/"
fun (row : Ast.ReqlExpr) -> row["id"].Match keyPrefix :> obj
fun (row : Ast.ReqlExpr) -> row[nameof ThemeAsset.empty.Id].Match keyPrefix :> obj
/// Ensure field indexes exist, as well as special indexes for selected tables
let ensureIndexes table fields = backgroundTask {
@@ -88,24 +105,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
if not (indexes |> List.contains "permalink") then
log.LogInformation $"Creating index {table}.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 "permalink" (fun row -> r.Array (row["webLogId"], row["permalink"].Downcase ()) :> obj)
indexCreate permalinkIdx
(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
if not (indexes |> List.contains "priorPermalinks") then
log.LogInformation $"Creating index {table}.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 "priorPermalinks" (fun row -> row["priorPermalinks"].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 [ "categoryIds"; "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 {
@@ -115,37 +135,42 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
}
// Tag mapping needs an index by web log ID and both tag and URL values
if Table.TagMap = table then
if not (indexes |> List.contains "webLogAndTag") then
log.LogInformation $"Creating index {table}.webLogAndTag..."
if not (indexes |> List.contains Index.WebLogAndTag) then
log.LogInformation $"Creating index {table}.{Index.WebLogAndTag}..."
do! rethink {
withTable table
indexCreate "webLogAndTag" (fun row -> r.Array (row["webLogId"], row["tag"]) :> obj)
indexCreate Index.WebLogAndTag (fun row ->
[| row[nameof TagMap.empty.WebLogId]; row[nameof TagMap.empty.Tag] |] :> obj)
write; withRetryOnce; ignoreResult conn
}
if not (indexes |> List.contains "webLogAndUrl") then
log.LogInformation $"Creating index {table}.webLogAndUrl..."
if not (indexes |> List.contains Index.WebLogAndUrl) then
log.LogInformation $"Creating index {table}.{Index.WebLogAndUrl}..."
do! rethink {
withTable table
indexCreate "webLogAndUrl" (fun row -> r.Array (row["webLogId"], row["urlValue"]) :> obj)
indexCreate Index.WebLogAndUrl (fun row ->
[| 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
if Table.Upload = table then
if not (indexes |> List.contains "webLogAndPath") then
log.LogInformation $"Creating index {table}.webLogAndPath..."
if not (indexes |> List.contains Index.WebLogAndPath) then
log.LogInformation $"Creating index {table}.{Index.WebLogAndPath}..."
do! rethink {
withTable table
indexCreate "webLogAndPath" (fun row -> r.Array (row["webLogId"], row["path"]) :> obj)
indexCreate Index.WebLogAndPath (fun row ->
[| row[nameof Upload.empty.WebLogId]; row[nameof Upload.empty.Path] |] :> obj)
write; withRetryOnce; ignoreResult conn
}
// Users log on with e-mail
if Table.WebLogUser = table && not (indexes |> List.contains "logOn") then
log.LogInformation $"Creating index {table}.logOn..."
do! rethink {
withTable table
indexCreate "logOn" (fun row -> r.Array (row["webLogId"], row["userName"]) :> obj)
write; withRetryOnce; ignoreResult conn
}
if Table.WebLogUser = table then
if not (indexes |> List.contains Index.LogOn) then
log.LogInformation $"Creating index {table}.{Index.LogOn}..."
do! rethink {
withTable table
indexCreate Index.LogOn (fun row ->
[| row[nameof WebLogUser.empty.WebLogId]; row[nameof WebLogUser.empty.Email] |] :> obj)
write; withRetryOnce; ignoreResult conn
}
}
/// The batch size for restoration methods
@@ -167,15 +192,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.CountAll webLogId = rethink<int> {
withTable Table.Category
getAll [ webLogId ] (nameof webLogId)
getAll [ webLogId ] (nameof Category.empty.WebLogId)
count
result; withRetryDefault conn
}
member _.CountTopLevel webLogId = rethink<int> {
withTable Table.Category
getAll [ webLogId ] (nameof webLogId)
filter "parentId" None
getAll [ webLogId ] (nameof Category.empty.WebLogId)
filter (nameof Category.empty.ParentId) None
count
result; withRetryDefault conn
}
@@ -183,8 +208,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 webLogId)
orderByFunc (fun it -> it["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 []
@@ -200,8 +225,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
|> List.ofSeq
let! count = rethink<int> {
withTable Table.Post
getAll catIds "categoryIds"
filter "status" Published
getAll catIds (nameof Post.empty.CategoryIds)
filter (nameof Post.empty.Status) Published
distinct
count
result; withRetryDefault conn
@@ -227,11 +252,11 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get catId
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId (fun c -> c.webLogId) <| conn
|> verifyWebLog webLogId (fun c -> c.WebLogId) <| conn
member _.FindByWebLog webLogId = rethink<Category list> {
withTable Table.Category
getAll [ webLogId ] (nameof webLogId)
getAll [ webLogId ] (nameof Category.empty.WebLogId)
result; withRetryDefault conn
}
@@ -241,9 +266,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
// Delete the category off all posts where it is assigned
do! rethink {
withTable Table.Post
getAll [ webLogId ] (nameof webLogId)
filter (fun row -> row["categoryIds"].Contains catId :> obj)
update (fun row -> r.HashMap ("categoryIds", r.Array(row["categoryIds"]).Remove 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)
write; withRetryDefault; ignoreResult conn
}
// Delete the category itself
@@ -268,11 +294,11 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.Update cat = rethink {
withTable Table.Category
get cat.id
update [ "name", cat.name :> obj
"slug", cat.slug
"description", cat.description
"parentId", cat.parentId
get cat.Id
update [ nameof cat.Name, cat.Name :> obj
nameof cat.Slug, cat.Slug
nameof cat.Description, cat.Description
nameof cat.ParentId, cat.ParentId
]
write; withRetryDefault; ignoreResult conn
}
@@ -289,23 +315,26 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.All webLogId = rethink<Page list> {
withTable Table.Page
getAll [ webLogId ] (nameof webLogId)
without [ "text"; "metadata"; "revisions"; "priorPermalinks" ]
orderByFunc (fun row -> row["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 webLogId)
getAll [ webLogId ] (nameof Page.empty.WebLogId)
count
result; withRetryDefault conn
}
member _.CountListed webLogId = rethink<int> {
withTable Table.Page
getAll [ webLogId ] (nameof webLogId)
filter "showInPageList" true
getAll [ webLogId ] (nameof Page.empty.WebLogId)
filter (nameof Page.empty.IsInPageList) true
count
result; withRetryDefault conn
}
@@ -314,7 +343,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["webLogId"].Eq webLogId :> obj)
filter (fun row -> row[nameof Page.empty.WebLogId].Eq webLogId :> obj)
delete
write; withRetryDefault conn
}
@@ -325,16 +354,16 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
rethink<Page> {
withTable Table.Page
get pageId
without [ "priorPermalinks"; "revisions" ]
without [ nameof Page.empty.PriorPermalinks; nameof Page.empty.Revisions ]
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId (fun it -> it.webLogId) <| conn
|> verifyWebLog webLogId (fun it -> it.WebLogId) <| conn
member _.FindByPermalink permalink webLogId =
rethink<Page list> {
withTable Table.Page
getAll [ r.Array (webLogId, permalink) ] (nameof permalink)
without [ "priorPermalinks"; "revisions" ]
getAll [ [| webLogId :> obj; permalink |] ] (nameof Page.empty.Permalink)
without [ nameof Page.empty.PriorPermalinks; nameof Page.empty.Revisions ]
limit 1
result; withRetryDefault
}
@@ -344,14 +373,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! result =
(rethink<Page list> {
withTable Table.Page
getAll (objList permalinks) "priorPermalinks"
filter "webLogId" webLogId
without [ "revisions"; "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
}
|> tryFirst) conn
return result |> Option.map (fun pg -> pg.permalink)
return result |> Option.map (fun pg -> pg.Permalink)
}
member _.FindFullById pageId webLogId =
@@ -360,28 +389,30 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get pageId
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId (fun it -> it.webLogId) <| conn
|> verifyWebLog webLogId (fun it -> it.WebLogId) <| conn
member _.FindFullByWebLog webLogId = rethink<Page> {
withTable Table.Page
getAll [ webLogId ] (nameof webLogId)
getAll [ webLogId ] (nameof Page.empty.WebLogId)
resultCursor; withRetryCursorDefault; toList conn
}
member _.FindListed webLogId = rethink<Page list> {
withTable Table.Page
getAll [ webLogId ] (nameof webLogId)
filter [ "showInPageList", true :> obj ]
without [ "text"; "priorPermalinks"; "revisions" ]
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 "title"
result; withRetryDefault conn
}
member _.FindPageOfPages webLogId pageNbr = rethink<Page list> {
withTable Table.Page
getAll [ webLogId ] (nameof webLogId)
without [ "metadata"; "priorPermalinks"; "revisions" ]
orderByFunc (fun row -> row["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
@@ -398,17 +429,17 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.Update page = rethink {
withTable Table.Page
get page.id
get page.Id
update [
"title", page.title :> obj
"permalink", page.permalink
"updatedOn", page.updatedOn
"showInPageList", page.showInPageList
"template", page.template
"text", page.text
"priorPermalinks", page.priorPermalinks
"metadata", page.metadata
"revisions", page.revisions
nameof page.Title, page.Title :> obj
nameof page.Permalink, page.Permalink
nameof page.UpdatedOn, page.UpdatedOn
nameof page.IsInPageList, page.IsInPageList
nameof page.Template, page.Template
nameof page.Text, page.Text
nameof page.PriorPermalinks, page.PriorPermalinks
nameof page.Metadata, page.Metadata
nameof page.Revisions, page.Revisions
]
write; withRetryDefault; ignoreResult conn
}
@@ -419,7 +450,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
do! rethink {
withTable Table.Page
get pageId
update [ "priorPermalinks", permalinks :> obj ]
update [ nameof Page.empty.PriorPermalinks, permalinks :> obj ]
write; withRetryDefault; ignoreResult conn
}
return true
@@ -438,8 +469,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.CountByStatus status webLogId = rethink<int> {
withTable Table.Post
getAll [ webLogId ] (nameof webLogId)
filter "status" status
getAll [ webLogId ] (nameof Post.empty.WebLogId)
filter (nameof Post.empty.Status) status
count
result; withRetryDefault conn
}
@@ -448,7 +479,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["webLogId"].Eq webLogId :> obj)
filter (fun row -> row[nameof Post.empty.WebLogId].Eq webLogId :> obj)
delete
write; withRetryDefault conn
}
@@ -459,16 +490,16 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
rethink<Post> {
withTable Table.Post
get postId
without [ "priorPermalinks"; "revisions" ]
without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId (fun p -> p.webLogId) <| conn
|> verifyWebLog webLogId (fun p -> p.WebLogId) <| conn
member _.FindByPermalink permalink webLogId =
rethink<Post list> {
withTable Table.Post
getAll [ r.Array (webLogId, permalink) ] (nameof permalink)
without [ "priorPermalinks"; "revisions" ]
getAll [ [| webLogId :> obj; permalink |] ] (nameof Post.empty.Permalink)
without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
limit 1
result; withRetryDefault
}
@@ -480,36 +511,36 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get postId
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId (fun p -> p.webLogId) <| conn
|> verifyWebLog webLogId (fun p -> p.WebLogId) <| conn
member _.FindCurrentPermalink permalinks webLogId = backgroundTask {
let! result =
(rethink<Post list> {
withTable Table.Post
getAll (objList permalinks) "priorPermalinks"
filter "webLogId" webLogId
without [ "revisions"; "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
}
|> tryFirst) conn
return result |> Option.map (fun post -> post.permalink)
return result |> Option.map (fun post -> post.Permalink)
}
member _.FindFullByWebLog webLogId = rethink<Post> {
withTable Table.Post
getAll [ webLogId ] (nameof 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) "categoryIds"
filter "webLogId" webLogId
filter "status" Published
without [ "priorPermalinks"; "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 "publishedOn"
orderByDescending (nameof Post.empty.PublishedOn)
skip ((pageNbr - 1) * postsPerPage)
limit (postsPerPage + 1)
result; withRetryDefault conn
@@ -517,9 +548,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 webLogId)
without [ "priorPermalinks"; "revisions" ]
orderByFuncDescending (fun row -> row["publishedOn"].Default_ "updatedOn" :> obj)
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)
skip ((pageNbr - 1) * postsPerPage)
limit (postsPerPage + 1)
result; withRetryDefault conn
@@ -527,10 +559,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 webLogId)
filter "status" Published
without [ "priorPermalinks"; "revisions" ]
orderByDescending "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
@@ -538,11 +570,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 ] "tags"
filter "webLogId" webLogId
filter "status" Published
without [ "priorPermalinks"; "revisions" ]
orderByDescending "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
@@ -552,10 +584,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! older =
rethink<Post list> {
withTable Table.Post
getAll [ webLogId ] (nameof webLogId)
filter (fun row -> row["publishedOn"].Lt publishedOn :> obj)
without [ "priorPermalinks"; "revisions" ]
orderByDescending "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
}
@@ -563,10 +595,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! newer =
rethink<Post list> {
withTable Table.Post
getAll [ webLogId ] (nameof webLogId)
filter (fun row -> row["publishedOn"].Gt publishedOn :> obj)
without [ "priorPermalinks"; "revisions" ]
orderBy "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
}
@@ -585,7 +617,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.Update post = rethink {
withTable Table.Post
get post.id
get post.Id
replace post
write; withRetryDefault; ignoreResult conn
}
@@ -595,15 +627,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
rethink<Post> {
withTable Table.Post
get postId
without [ "revisions"; "priorPermalinks" ]
without [ nameof Post.empty.Revisions; nameof Post.empty.PriorPermalinks ]
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId (fun p -> p.webLogId)) conn with
|> verifyWebLog webLogId (fun p -> p.WebLogId)) conn with
| Some _ ->
do! rethink {
withTable Table.Post
get postId
update [ "priorPermalinks", permalinks :> obj ]
update [ nameof Post.empty.PriorPermalinks, permalinks :> obj ]
write; withRetryDefault; ignoreResult conn
}
return true
@@ -618,7 +650,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["webLogId"].Eq webLogId :> obj)
filter (fun row -> row[nameof TagMap.empty.WebLogId].Eq webLogId :> obj)
delete
write; withRetryDefault conn
}
@@ -631,12 +663,12 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get tagMapId
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId (fun tm -> tm.webLogId) <| conn
|> verifyWebLog webLogId (fun tm -> tm.WebLogId) <| conn
member _.FindByUrlValue urlValue webLogId =
rethink<TagMap list> {
withTable Table.TagMap
getAll [ r.Array (webLogId, urlValue) ] "webLogAndUrl"
getAll [ [| webLogId :> obj; urlValue |] ] Index.WebLogAndUrl
limit 1
result; withRetryDefault
}
@@ -644,14 +676,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByWebLog webLogId = rethink<TagMap list> {
withTable Table.TagMap
between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ())) [ Index "webLogAndTag" ]
orderBy "tag"
between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj, r.Maxval () |]
[ Index Index.WebLogAndTag ]
orderBy (nameof TagMap.empty.Tag)
result; withRetryDefault conn
}
member _.FindMappingForTags tags webLogId = rethink<TagMap list> {
withTable Table.TagMap
getAll (tags |> List.map (fun tag -> r.Array (webLogId, tag) :> obj)) "webLogAndTag"
getAll (tags |> List.map (fun tag -> [| webLogId :> obj; tag |] :> obj)) Index.WebLogAndTag
result; withRetryDefault conn
}
@@ -666,7 +699,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.Save tagMap = rethink {
withTable Table.TagMap
get tagMap.id
get tagMap.Id
replace tagMap
write; withRetryDefault; ignoreResult conn
}
@@ -677,9 +710,9 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.All () = rethink<Theme list> {
withTable Table.Theme
filter (fun row -> row["id"].Ne "admin" :> obj)
without [ "templates" ]
orderBy "id"
filter (fun row -> row[nameof Theme.empty.Id].Ne "admin" :> obj)
without [ nameof Theme.empty.Templates ]
orderBy (nameof Theme.empty.Id)
result; withRetryDefault conn
}
@@ -692,13 +725,13 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByIdWithoutText themeId = rethink<Theme> {
withTable Table.Theme
get themeId
merge (fun row -> r.HashMap ("templates", row["templates"].Without [| "text" |]))
merge (fun row -> {| Templates = row[nameof Theme.empty.Templates].Without [| "Text" |] |})
resultOption; withRetryOptionDefault conn
}
member _.Save theme = rethink {
withTable Table.Theme
get theme.id
get theme.Id
replace theme
write; withRetryDefault; ignoreResult conn
}
@@ -709,7 +742,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.All () = rethink<ThemeAsset list> {
withTable Table.ThemeAsset
without [ "data" ]
without [ nameof ThemeAsset.empty.Data ]
result; withRetryDefault conn
}
@@ -729,7 +762,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByTheme themeId = rethink<ThemeAsset list> {
withTable Table.ThemeAsset
filter (matchAssetByThemeId themeId)
without [ "data" ]
without [ nameof ThemeAsset.empty.Data ]
result; withRetryDefault conn
}
@@ -741,7 +774,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.Save asset = rethink {
withTable Table.ThemeAsset
get asset.id
get asset.Id
replace asset
write; withRetryDefault; ignoreResult conn
}
@@ -763,7 +796,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get uploadId
resultOption; withRetryOptionDefault
}
|> verifyWebLog<Upload> webLogId (fun u -> u.webLogId) <| conn
|> verifyWebLog<Upload> webLogId (fun u -> u.WebLogId) <| conn
match upload with
| Some up ->
do! rethink {
@@ -772,30 +805,30 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
delete
write; withRetryDefault; ignoreResult conn
}
return Ok (Permalink.toString up.path)
return Ok (Permalink.toString up.Path)
| None -> return Result.Error $"Upload ID {UploadId.toString uploadId} not found"
}
member _.FindByPath path webLogId =
rethink<Upload> {
withTable Table.Upload
getAll [ r.Array (webLogId, path) ] "webLogAndPath"
getAll [ [| webLogId :> obj; path |] ] Index.WebLogAndPath
resultCursor; withRetryCursorDefault; toList
}
|> tryFirst <| conn
member _.FindByWebLog webLogId = rethink<Upload> {
withTable Table.Upload
between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ()))
[ Index "webLogAndPath" ]
without [ "data" ]
between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |]
[ Index Index.WebLogAndPath ]
without [ nameof Upload.empty.Data ]
resultCursor; withRetryCursorDefault; toList conn
}
member _.FindByWebLogWithData webLogId = rethink<Upload> {
withTable Table.Upload
between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ()))
[ Index "webLogAndPath" ]
between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |]
[ Index Index.WebLogAndPath ]
resultCursor; withRetryCursorDefault; toList conn
}
@@ -826,40 +859,40 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.Delete webLogId = backgroundTask {
// Comments should be deleted by post IDs
let! thePostIds = rethink<{| id : string |} list> {
let! thePostIds = rethink<{| Id : string |} list> {
withTable Table.Post
getAll [ webLogId ] (nameof webLogId)
pluck [ "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)
let postIds = thePostIds |> List.map (fun it -> it.Id :> obj)
do! rethink {
withTable Table.Comment
getAll postIds "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 (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ()))
[ Index "webLogAndTag" ]
between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |]
[ Index Index.WebLogAndTag ]
delete
write; withRetryOnce; ignoreResult conn
}
// Uploaded files do not have a straightforward webLogId index
do! rethink {
withTable Table.Upload
between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ()))
[ Index "webLogAndPath" ]
between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |]
[ Index Index.WebLogAndPath ]
delete
write; withRetryOnce; ignoreResult conn
}
for table in [ Table.Post; Table.Category; Table.Page; Table.WebLogUser ] do
do! rethink {
withTable table
getAll [ webLogId ] (nameof webLogId)
getAll [ webLogId ] (nameof Post.empty.WebLogId)
delete
write; withRetryOnce; ignoreResult conn
}
@@ -874,7 +907,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByHost url =
rethink<WebLog list> {
withTable Table.WebLog
getAll [ url ] "urlBase"
getAll [ url ] (nameof WebLog.empty.UrlBase)
limit 1
result; withRetryDefault
}
@@ -888,24 +921,24 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.UpdateRssOptions webLog = rethink {
withTable Table.WebLog
get webLog.id
update [ "rss", webLog.rss :> obj ]
get webLog.Id
update [ nameof WebLog.empty.Rss, webLog.Rss :> obj ]
write; withRetryDefault; ignoreResult conn
}
member _.UpdateSettings webLog = rethink {
withTable Table.WebLog
get webLog.id
get webLog.Id
update [
"name", webLog.name :> obj
"slug", webLog.slug
"subtitle", webLog.subtitle
"defaultPage", webLog.defaultPage
"postsPerPage", webLog.postsPerPage
"timeZone", webLog.timeZone
"themePath", webLog.themePath
"autoHtmx", webLog.autoHtmx
"uploads", webLog.uploads
nameof webLog.Name, webLog.Name :> obj
nameof webLog.Slug, webLog.Slug
nameof webLog.Subtitle, webLog.Subtitle
nameof webLog.DefaultPage, webLog.DefaultPage
nameof webLog.PostsPerPage, webLog.PostsPerPage
nameof webLog.TimeZone, webLog.TimeZone
nameof webLog.ThemeId, webLog.ThemeId
nameof webLog.AutoHtmx, webLog.AutoHtmx
nameof webLog.Uploads, webLog.Uploads
]
write; withRetryDefault; ignoreResult conn
}
@@ -923,7 +956,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByEmail email webLogId =
rethink<WebLogUser list> {
withTable Table.WebLogUser
getAll [ r.Array (webLogId, email) ] "logOn"
getAll [ [| webLogId :> obj; email |] ] Index.LogOn
limit 1
result; withRetryDefault
}
@@ -935,11 +968,11 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get userId
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId (fun u -> u.webLogId) <| conn
|> verifyWebLog webLogId (fun u -> u.WebLogId) <| conn
member _.FindByWebLog webLogId = rethink<WebLogUser list> {
withTable Table.WebLogUser
getAll [ webLogId ] (nameof webLogId)
getAll [ webLogId ] (nameof WebLogUser.empty.WebLogId)
result; withRetryDefault conn
}
@@ -947,12 +980,12 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! users = rethink<WebLogUser list> {
withTable Table.WebLogUser
getAll (objList userIds)
filter "webLogId" webLogId
filter (nameof WebLogUser.empty.WebLogId) webLogId
result; withRetryDefault conn
}
return
users
|> List.map (fun u -> { name = WebLogUserId.toString u.id; value = WebLogUser.displayName u })
|> List.map (fun u -> { Name = WebLogUserId.toString u.Id; Value = WebLogUser.displayName u })
}
member _.Restore users = backgroundTask {
@@ -970,7 +1003,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
do! rethink {
withTable Table.WebLogUser
get userId
update [ "lastSeenOn", DateTime.UtcNow :> obj ]
update [ nameof WebLogUser.empty.LastSeenOn, DateTime.UtcNow :> obj ]
write; withRetryOnce; ignoreResult conn
}
| None -> ()
@@ -978,14 +1011,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.Update user = rethink {
withTable Table.WebLogUser
get user.id
get user.Id
update [
"firstName", user.firstName :> obj
"lastName", user.lastName
"preferredName", user.preferredName
"passwordHash", user.passwordHash
"salt", user.salt
"accessLevel", user.accessLevel
nameof user.FirstName, user.FirstName :> obj
nameof user.LastName, user.LastName
nameof user.PreferredName, user.PreferredName
nameof user.PasswordHash, user.PasswordHash
nameof user.Salt, user.Salt
nameof user.AccessLevel, user.AccessLevel
]
write; withRetryDefault; ignoreResult conn
}
@@ -1001,14 +1034,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
for tbl in Table.all do
if not (tables |> List.contains tbl) then
log.LogInformation $"Creating table {tbl}..."
do! rethink { tableCreate tbl; write; withRetryOnce; ignoreResult conn }
do! rethink { tableCreate tbl [ PrimaryKey "Id" ]; write; withRetryOnce; ignoreResult conn }
do! ensureIndexes Table.Category [ "webLogId" ]
do! ensureIndexes Table.Comment [ "postId" ]
do! ensureIndexes Table.Page [ "webLogId"; "authorId" ]
do! ensureIndexes Table.Post [ "webLogId"; "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 [ "urlBase" ]
do! ensureIndexes Table.WebLogUser [ "webLogId" ]
do! ensureIndexes Table.WebLog [ nameof WebLog.empty.UrlBase ]
do! ensureIndexes Table.WebLogUser [ nameof WebLogUser.empty.WebLogId ]
}

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

@@ -19,7 +19,7 @@ let diffLists<'T, 'U when 'U : equality> oldItems newItems (f : 'T -> 'U) =
/// Find meta items added and removed
let diffMetaItems (oldItems : MetaItem list) newItems =
diffLists oldItems newItems (fun item -> $"{item.name}|{item.value}")
diffLists oldItems newItems (fun item -> $"{item.Name}|{item.Value}")
/// Find the permalinks added and removed
let diffPermalinks oldLinks newLinks =
@@ -27,7 +27,7 @@ let diffPermalinks oldLinks newLinks =
/// Find the revisions added and removed
let diffRevisions oldRevs newRevs =
diffLists oldRevs newRevs (fun (rev : Revision) -> $"{rev.asOf.Ticks}|{MarkupText.toString rev.text}")
diffLists oldRevs newRevs (fun (rev : Revision) -> $"{rev.AsOf.Ticks}|{MarkupText.toString rev.Text}")
/// Create a list of items from the given data reader
let toList<'T> (it : SqliteDataReader -> 'T) (rdr : SqliteDataReader) =
@@ -39,8 +39,7 @@ let verifyWebLog<'T> webLogId (prop : 'T -> WebLogId) (it : SqliteDataReader ->
if rdr.Read () then
let item = it rdr
if prop item = webLogId then Some item else None
else
None
else None
/// Execute a command that returns no data
let write (cmd : SqliteCommand) = backgroundTask {
@@ -101,134 +100,134 @@ module Map =
let tryTimeSpan col (rdr : SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getTimeSpan col rdr)
/// Create a category ID from the current row in the given data reader
let toCategoryId = getString "id" >> CategoryId
/// Map an id field to a category ID
let toCategoryId rdr = getString "id" rdr |> CategoryId
/// Create a category from the current row in the given data reader
let toCategory (rdr : SqliteDataReader) : Category =
{ id = toCategoryId rdr
webLogId = WebLogId (getString "web_log_id" rdr)
name = getString "name" rdr
slug = getString "slug" rdr
description = tryString "description" rdr
parentId = tryString "parent_id" rdr |> Option.map CategoryId
let toCategory rdr : Category =
{ Id = toCategoryId rdr
WebLogId = getString "web_log_id" rdr |> WebLogId
Name = getString "name" rdr
Slug = getString "slug" rdr
Description = tryString "description" rdr
ParentId = tryString "parent_id" rdr |> Option.map CategoryId
}
/// Create a custom feed from the current row in the given data reader
let toCustomFeed (rdr : SqliteDataReader) : CustomFeed =
{ id = CustomFeedId (getString "id" rdr)
source = CustomFeedSource.parse (getString "source" rdr)
path = Permalink (getString "path" rdr)
podcast =
let toCustomFeed rdr : CustomFeed =
{ Id = getString "id" rdr |> CustomFeedId
Source = getString "source" rdr |> CustomFeedSource.parse
Path = getString "path" rdr |> Permalink
Podcast =
if rdr.IsDBNull (rdr.GetOrdinal "title") then
None
else
Some {
title = getString "title" rdr
subtitle = tryString "subtitle" rdr
itemsInFeed = getInt "items_in_feed" rdr
summary = getString "summary" rdr
displayedAuthor = getString "displayed_author" rdr
email = getString "email" rdr
imageUrl = Permalink (getString "image_url" rdr)
iTunesCategory = getString "itunes_category" rdr
iTunesSubcategory = tryString "itunes_subcategory" rdr
explicit = ExplicitRating.parse (getString "explicit" rdr)
defaultMediaType = tryString "default_media_type" rdr
mediaBaseUrl = tryString "media_base_url" rdr
guid = tryGuid "guid" rdr
fundingUrl = tryString "funding_url" rdr
fundingText = tryString "funding_text" rdr
medium = tryString "medium" rdr |> Option.map PodcastMedium.parse
Title = getString "title" rdr
Subtitle = tryString "subtitle" rdr
ItemsInFeed = getInt "items_in_feed" rdr
Summary = getString "summary" rdr
DisplayedAuthor = getString "displayed_author" rdr
Email = getString "email" rdr
ImageUrl = getString "image_url" rdr |> Permalink
AppleCategory = getString "apple_category" rdr
AppleSubcategory = tryString "apple_subcategory" rdr
Explicit = getString "explicit" rdr |> ExplicitRating.parse
DefaultMediaType = tryString "default_media_type" rdr
MediaBaseUrl = tryString "media_base_url" rdr
PodcastGuid = tryGuid "podcast_guid" rdr
FundingUrl = tryString "funding_url" rdr
FundingText = tryString "funding_text" rdr
Medium = tryString "medium" rdr |> Option.map PodcastMedium.parse
}
}
/// Create a meta item from the current row in the given data reader
let toMetaItem (rdr : SqliteDataReader) : MetaItem =
{ name = getString "name" rdr
value = getString "value" rdr
let toMetaItem rdr : MetaItem =
{ Name = getString "name" rdr
Value = getString "value" rdr
}
/// Create a permalink from the current row in the given data reader
let toPermalink = getString "permalink" >> Permalink
let toPermalink rdr = getString "permalink" rdr |> Permalink
/// Create a page from the current row in the given data reader
let toPage (rdr : SqliteDataReader) : Page =
let toPage rdr : Page =
{ Page.empty with
id = PageId (getString "id" rdr)
webLogId = WebLogId (getString "web_log_id" rdr)
authorId = WebLogUserId (getString "author_id" rdr)
title = getString "title" rdr
permalink = toPermalink rdr
publishedOn = getDateTime "published_on" rdr
updatedOn = getDateTime "updated_on" rdr
showInPageList = getBoolean "show_in_page_list" rdr
template = tryString "template" rdr
text = getString "page_text" rdr
Id = getString "id" rdr |> PageId
WebLogId = getString "web_log_id" rdr |> WebLogId
AuthorId = getString "author_id" rdr |> WebLogUserId
Title = getString "title" rdr
Permalink = toPermalink rdr
PublishedOn = getDateTime "published_on" rdr
UpdatedOn = getDateTime "updated_on" rdr
IsInPageList = getBoolean "is_in_page_list" rdr
Template = tryString "template" rdr
Text = getString "page_text" rdr
}
/// Create a post from the current row in the given data reader
let toPost (rdr : SqliteDataReader) : Post =
let toPost rdr : Post =
{ Post.empty with
id = PostId (getString "id" rdr)
webLogId = WebLogId (getString "web_log_id" rdr)
authorId = WebLogUserId (getString "author_id" rdr)
status = PostStatus.parse (getString "status" rdr)
title = getString "title" rdr
permalink = toPermalink rdr
publishedOn = tryDateTime "published_on" rdr
updatedOn = getDateTime "updated_on" rdr
template = tryString "template" rdr
text = getString "post_text" rdr
episode =
Id = getString "id" rdr |> PostId
WebLogId = getString "web_log_id" rdr |> WebLogId
AuthorId = getString "author_id" rdr |> WebLogUserId
Status = getString "status" rdr |> PostStatus.parse
Title = getString "title" rdr
Permalink = toPermalink rdr
PublishedOn = tryDateTime "published_on" rdr
UpdatedOn = getDateTime "updated_on" rdr
Template = tryString "template" rdr
Text = getString "post_text" rdr
Episode =
match tryString "media" rdr with
| Some media ->
Some {
media = media
length = getLong "length" rdr
duration = tryTimeSpan "duration" rdr
mediaType = tryString "media_type" rdr
imageUrl = tryString "image_url" rdr
subtitle = tryString "subtitle" rdr
explicit = tryString "explicit" rdr |> Option.map ExplicitRating.parse
chapterFile = tryString "chapter_file" rdr
chapterType = tryString "chapter_type" rdr
transcriptUrl = tryString "transcript_url" rdr
transcriptType = tryString "transcript_type" rdr
transcriptLang = tryString "transcript_lang" rdr
transcriptCaptions = tryBoolean "transcript_captions" rdr
seasonNumber = tryInt "season_number" rdr
seasonDescription = tryString "season_description" rdr
episodeNumber = tryString "episode_number" rdr |> Option.map Double.Parse
episodeDescription = tryString "episode_description" rdr
Media = media
Length = getLong "length" rdr
Duration = tryTimeSpan "duration" rdr
MediaType = tryString "media_type" rdr
ImageUrl = tryString "image_url" rdr
Subtitle = tryString "subtitle" rdr
Explicit = tryString "explicit" rdr |> Option.map ExplicitRating.parse
ChapterFile = tryString "chapter_file" rdr
ChapterType = tryString "chapter_type" rdr
TranscriptUrl = tryString "transcript_url" rdr
TranscriptType = tryString "transcript_type" rdr
TranscriptLang = tryString "transcript_lang" rdr
TranscriptCaptions = tryBoolean "transcript_captions" rdr
SeasonNumber = tryInt "season_number" rdr
SeasonDescription = tryString "season_description" rdr
EpisodeNumber = tryString "episode_number" rdr |> Option.map Double.Parse
EpisodeDescription = tryString "episode_description" rdr
}
| None -> None
}
/// Create a revision from the current row in the given data reader
let toRevision (rdr : SqliteDataReader) : Revision =
{ asOf = getDateTime "as_of" rdr
text = MarkupText.parse (getString "revision_text" rdr)
let toRevision rdr : Revision =
{ AsOf = getDateTime "as_of" rdr
Text = getString "revision_text" rdr |> MarkupText.parse
}
/// Create a tag mapping from the current row in the given data reader
let toTagMap (rdr : SqliteDataReader) : TagMap =
{ id = TagMapId (getString "id" rdr)
webLogId = WebLogId (getString "web_log_id" rdr)
tag = getString "tag" rdr
urlValue = getString "url_value" rdr
let toTagMap rdr : TagMap =
{ Id = getString "id" rdr |> TagMapId
WebLogId = getString "web_log_id" rdr |> WebLogId
Tag = getString "tag" rdr
UrlValue = getString "url_value" rdr
}
/// Create a theme from the current row in the given data reader (excludes templates)
let toTheme (rdr : SqliteDataReader) : Theme =
let toTheme rdr : Theme =
{ Theme.empty with
id = ThemeId (getString "id" rdr)
name = getString "name" rdr
version = getString "version" rdr
Id = getString "id" rdr |> ThemeId
Name = getString "name" rdr
Version = getString "version" rdr
}
/// Create a theme asset from the current row in the given data reader
let toThemeAsset includeData (rdr : SqliteDataReader) : ThemeAsset =
let toThemeAsset includeData rdr : ThemeAsset =
let assetData =
if includeData then
use dataStream = new MemoryStream ()
@@ -237,19 +236,19 @@ module Map =
dataStream.ToArray ()
else
[||]
{ id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr)
updatedOn = getDateTime "updated_on" rdr
data = assetData
{ Id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr)
UpdatedOn = getDateTime "updated_on" rdr
Data = assetData
}
/// Create a theme template from the current row in the given data reader
let toThemeTemplate (rdr : SqliteDataReader) : ThemeTemplate =
{ name = getString "name" rdr
text = getString "template" rdr
let toThemeTemplate rdr : ThemeTemplate =
{ Name = getString "name" rdr
Text = getString "template" rdr
}
/// Create an uploaded file from the current row in the given data reader
let toUpload includeData (rdr : SqliteDataReader) : Upload =
let toUpload includeData rdr : Upload =
let data =
if includeData then
use dataStream = new MemoryStream ()
@@ -258,51 +257,51 @@ module Map =
dataStream.ToArray ()
else
[||]
{ id = UploadId (getString "id" rdr)
webLogId = WebLogId (getString "web_log_id" rdr)
path = Permalink (getString "path" rdr)
updatedOn = getDateTime "updated_on" rdr
data = data
{ Id = getString "id" rdr |> UploadId
WebLogId = getString "web_log_id" rdr |> WebLogId
Path = getString "path" rdr |> Permalink
UpdatedOn = getDateTime "updated_on" rdr
Data = data
}
/// Create a web log from the current row in the given data reader
let toWebLog (rdr : SqliteDataReader) : WebLog =
{ id = WebLogId (getString "id" rdr)
name = getString "name" rdr
slug = getString "slug" rdr
subtitle = tryString "subtitle" rdr
defaultPage = getString "default_page" rdr
postsPerPage = getInt "posts_per_page" rdr
themePath = getString "theme_id" rdr
urlBase = getString "url_base" rdr
timeZone = getString "time_zone" rdr
autoHtmx = getBoolean "auto_htmx" rdr
uploads = UploadDestination.parse (getString "uploads" rdr)
rss = {
feedEnabled = getBoolean "feed_enabled" rdr
feedName = getString "feed_name" rdr
itemsInFeed = tryInt "items_in_feed" rdr
categoryEnabled = getBoolean "category_enabled" rdr
tagEnabled = getBoolean "tag_enabled" rdr
copyright = tryString "copyright" rdr
customFeeds = []
let toWebLog rdr : WebLog =
{ Id = getString "id" rdr |> WebLogId
Name = getString "name" rdr
Slug = getString "slug" rdr
Subtitle = tryString "subtitle" rdr
DefaultPage = getString "default_page" rdr
PostsPerPage = getInt "posts_per_page" rdr
ThemeId = getString "theme_id" rdr |> ThemeId
UrlBase = getString "url_base" rdr
TimeZone = getString "time_zone" rdr
AutoHtmx = getBoolean "auto_htmx" rdr
Uploads = getString "uploads" rdr |> UploadDestination.parse
Rss = {
IsFeedEnabled = getBoolean "is_feed_enabled" rdr
FeedName = getString "feed_name" rdr
ItemsInFeed = tryInt "items_in_feed" rdr
IsCategoryEnabled = getBoolean "is_category_enabled" rdr
IsTagEnabled = getBoolean "is_tag_enabled" rdr
Copyright = tryString "copyright" rdr
CustomFeeds = []
}
}
/// Create a web log user from the current row in the given data reader
let toWebLogUser (rdr : SqliteDataReader) : WebLogUser =
{ id = WebLogUserId (getString "id" rdr)
webLogId = WebLogId (getString "web_log_id" rdr)
userName = getString "user_name" rdr
firstName = getString "first_name" rdr
lastName = getString "last_name" rdr
preferredName = getString "preferred_name" rdr
passwordHash = getString "password_hash" rdr
salt = getGuid "salt" rdr
url = tryString "url" rdr
accessLevel = AccessLevel.parse (getString "access_level" rdr)
createdOn = getDateTime "created_on" rdr
lastSeenOn = tryDateTime "last_seen_on" rdr
let toWebLogUser rdr : WebLogUser =
{ Id = getString "id" rdr |> WebLogUserId
WebLogId = getString "web_log_id" rdr |> WebLogId
Email = getString "email" rdr
FirstName = getString "first_name" rdr
LastName = getString "last_name" rdr
PreferredName = getString "preferred_name" rdr
PasswordHash = getString "password_hash" rdr
Salt = getGuid "salt" rdr
Url = tryString "url" rdr
AccessLevel = getString "access_level" rdr |> AccessLevel.parse
CreatedOn = getDateTime "created_on" rdr
LastSeenOn = tryDateTime "last_seen_on" rdr
}
/// Add a possibly-missing parameter, substituting null for None

16
src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs
View File

@@ -10,12 +10,12 @@ type SQLiteCategoryData (conn : SqliteConnection) =
/// Add parameters for category INSERT or UPDATE statements
let addCategoryParameters (cmd : SqliteCommand) (cat : Category) =
[ cmd.Parameters.AddWithValue ("@id", CategoryId.toString cat.id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString cat.webLogId)
cmd.Parameters.AddWithValue ("@name", cat.name)
cmd.Parameters.AddWithValue ("@slug", cat.slug)
cmd.Parameters.AddWithValue ("@description", maybe cat.description)
cmd.Parameters.AddWithValue ("@parentId", maybe (cat.parentId |> Option.map CategoryId.toString))
[ cmd.Parameters.AddWithValue ("@id", CategoryId.toString cat.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString cat.WebLogId)
cmd.Parameters.AddWithValue ("@name", cat.Name)
cmd.Parameters.AddWithValue ("@slug", cat.Slug)
cmd.Parameters.AddWithValue ("@description", maybe cat.Description)
cmd.Parameters.AddWithValue ("@parentId", maybe (cat.ParentId |> Option.map CategoryId.toString))
] |> ignore
/// Add a category
@@ -60,7 +60,7 @@ type SQLiteCategoryData (conn : SqliteConnection) =
while rdr.Read () do
Map.toCategory rdr
}
|> Seq.sortBy (fun cat -> cat.name.ToLowerInvariant ())
|> Seq.sortBy (fun cat -> cat.Name.ToLowerInvariant ())
|> List.ofSeq
do! rdr.CloseAsync ()
let ordered = Utils.orderByHierarchy cats None None []
@@ -107,7 +107,7 @@ type SQLiteCategoryData (conn : SqliteConnection) =
cmd.CommandText <- "SELECT * FROM category WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return Helpers.verifyWebLog<Category> webLogId (fun c -> c.webLogId) Map.toCategory rdr
return Helpers.verifyWebLog<Category> webLogId (fun c -> c.WebLogId) Map.toCategory rdr
}
/// Find all categories for the given web log

90
src/MyWebLog.Data/SQLite/SQLitePageData.fs
View File

@@ -12,45 +12,45 @@ type SQLitePageData (conn : SqliteConnection) =
/// Add parameters for page INSERT or UPDATE statements
let addPageParameters (cmd : SqliteCommand) (page : Page) =
[ cmd.Parameters.AddWithValue ("@id", PageId.toString page.id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString page.webLogId)
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString page.authorId)
cmd.Parameters.AddWithValue ("@title", page.title)
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString page.permalink)
cmd.Parameters.AddWithValue ("@publishedOn", page.publishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", page.updatedOn)
cmd.Parameters.AddWithValue ("@showInPageList", page.showInPageList)
cmd.Parameters.AddWithValue ("@template", maybe page.template)
cmd.Parameters.AddWithValue ("@text", page.text)
[ cmd.Parameters.AddWithValue ("@id", PageId.toString page.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString page.WebLogId)
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString page.AuthorId)
cmd.Parameters.AddWithValue ("@title", page.Title)
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString page.Permalink)
cmd.Parameters.AddWithValue ("@publishedOn", page.PublishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", page.UpdatedOn)
cmd.Parameters.AddWithValue ("@isInPageList", page.IsInPageList)
cmd.Parameters.AddWithValue ("@template", maybe page.Template)
cmd.Parameters.AddWithValue ("@text", page.Text)
] |> ignore
/// Append meta items to a page
let appendPageMeta (page : Page) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT name, value FROM page_meta WHERE page_id = @id"
cmd.Parameters.AddWithValue ("@id", PageId.toString page.id) |> ignore
cmd.Parameters.AddWithValue ("@id", PageId.toString page.Id) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return { page with metadata = toList Map.toMetaItem rdr }
return { page with Metadata = toList Map.toMetaItem rdr }
}
/// Append revisions and permalinks to a page
let appendPageRevisionsAndPermalinks (page : Page) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@pageId", PageId.toString page.id) |> ignore
cmd.Parameters.AddWithValue ("@pageId", PageId.toString page.Id) |> ignore
cmd.CommandText <- "SELECT permalink FROM page_permalink WHERE page_id = @pageId"
use! rdr = cmd.ExecuteReaderAsync ()
let page = { page with priorPermalinks = toList Map.toPermalink rdr }
let page = { page with PriorPermalinks = toList Map.toPermalink rdr }
do! rdr.CloseAsync ()
cmd.CommandText <- "SELECT as_of, revision_text FROM page_revision WHERE page_id = @pageId ORDER BY as_of DESC"
use! rdr = cmd.ExecuteReaderAsync ()
return { page with revisions = toList Map.toRevision rdr }
return { page with Revisions = toList Map.toRevision rdr }
}
/// Return a page with no text (or meta items, prior permalinks, or revisions)
let pageWithoutTextOrMeta rdr =
{ Map.toPage rdr with text = "" }
{ Map.toPage rdr with Text = "" }
/// Update a page's metadata items
let updatePageMeta pageId oldItems newItems = backgroundTask {
@@ -64,8 +64,8 @@ type SQLitePageData (conn : SqliteConnection) =
cmd.Parameters.Add ("@value", SqliteType.Text)
] |> ignore
let runCmd (item : MetaItem) = backgroundTask {
cmd.Parameters["@name" ].Value <- item.name
cmd.Parameters["@value"].Value <- item.value
cmd.Parameters["@name" ].Value <- item.Name
cmd.Parameters["@value"].Value <- item.Value
do! write cmd
}
cmd.CommandText <- "DELETE FROM page_meta WHERE page_id = @pageId AND name = @name AND value = @value"
@@ -116,9 +116,9 @@ type SQLitePageData (conn : SqliteConnection) =
let runCmd withText rev = backgroundTask {
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
cmd.Parameters.AddWithValue ("@asOf", rev.asOf)
cmd.Parameters.AddWithValue ("@asOf", rev.AsOf)
] |> ignore
if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.text) |> ignore
if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.Text) |> ignore
do! write cmd
}
cmd.CommandText <- "DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @asOf"
@@ -141,17 +141,17 @@ type SQLitePageData (conn : SqliteConnection) =
// The page itself
cmd.CommandText <- """
INSERT INTO page (
id, web_log_id, author_id, title, permalink, published_on, updated_on, show_in_page_list, template,
id, web_log_id, author_id, title, permalink, published_on, updated_on, is_in_page_list, template,
page_text
) VALUES (
@id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @showInPageList, @template,
@id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @isInPageList, @template,
@text
)"""
addPageParameters cmd page
do! write cmd
do! updatePageMeta page.id [] page.metadata
do! updatePagePermalinks page.id [] page.priorPermalinks
do! updatePageRevisions page.id [] page.revisions
do! updatePageMeta page.Id [] page.Metadata
do! updatePagePermalinks page.Id [] page.PriorPermalinks
do! updatePageRevisions page.Id [] page.Revisions
}
/// Get all pages for a web log (without text, revisions, prior permalinks, or metadata)
@@ -177,10 +177,10 @@ type SQLitePageData (conn : SqliteConnection) =
cmd.CommandText <- """
SELECT COUNT(id)
FROM page
WHERE web_log_id = @webLogId
AND show_in_page_list = @showInPageList"""
WHERE web_log_id = @webLogId
AND is_in_page_list = @isInPageList"""
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@showInPageList", true) |> ignore
cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore
return! count cmd
}
@@ -190,7 +190,7 @@ type SQLitePageData (conn : SqliteConnection) =
cmd.CommandText <- "SELECT * FROM page WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
match Helpers.verifyWebLog<Page> webLogId (fun it -> it.webLogId) Map.toPage rdr with
match Helpers.verifyWebLog<Page> webLogId (fun it -> it.WebLogId) Map.toPage rdr with
| Some page ->
let! page = appendPageMeta page
return Some page
@@ -277,11 +277,11 @@ type SQLitePageData (conn : SqliteConnection) =
cmd.CommandText <- """
SELECT *
FROM page
WHERE web_log_id = @webLogId
AND show_in_page_list = @showInPageList
WHERE web_log_id = @webLogId
AND is_in_page_list = @isInPageList
ORDER BY LOWER(title)"""
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@showInPageList", true) |> ignore
cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
let! pages =
toList pageWithoutTextOrMeta rdr
@@ -315,26 +315,26 @@ type SQLitePageData (conn : SqliteConnection) =
/// Update a page
let update (page : Page) = backgroundTask {
match! findFullById page.id page.webLogId with
match! findFullById page.Id page.WebLogId with
| Some oldPage ->
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
UPDATE page
SET author_id = @authorId,
title = @title,
permalink = @permalink,
published_on = @publishedOn,
updated_on = @updatedOn,
show_in_page_list = @showInPageList,
template = @template,
page_text = @text
SET author_id = @authorId,
title = @title,
permalink = @permalink,
published_on = @publishedOn,
updated_on = @updatedOn,
is_in_page_list = @isInPageList,
template = @template,
page_text = @text
WHERE id = @pageId
AND web_log_id = @webLogId"""
addPageParameters cmd page
do! write cmd
do! updatePageMeta page.id oldPage.metadata page.metadata
do! updatePagePermalinks page.id oldPage.priorPermalinks page.priorPermalinks
do! updatePageRevisions page.id oldPage.revisions page.revisions
do! updatePageMeta page.Id oldPage.Metadata page.Metadata
do! updatePagePermalinks page.Id oldPage.PriorPermalinks page.PriorPermalinks
do! updatePageRevisions page.Id oldPage.Revisions page.Revisions
return ()
| None -> return ()
}
@@ -343,7 +343,7 @@ type SQLitePageData (conn : SqliteConnection) =
let updatePriorPermalinks pageId webLogId permalinks = backgroundTask {
match! findFullById pageId webLogId with
| Some page ->
do! updatePagePermalinks pageId page.priorPermalinks permalinks
do! updatePagePermalinks pageId page.PriorPermalinks permalinks
return true
| None -> return false
}

110
src/MyWebLog.Data/SQLite/SQLitePostData.fs
View File

@@ -13,72 +13,72 @@ type SQLitePostData (conn : SqliteConnection) =
/// Add parameters for post INSERT or UPDATE statements
let addPostParameters (cmd : SqliteCommand) (post : Post) =
[ cmd.Parameters.AddWithValue ("@id", PostId.toString post.id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString post.webLogId)
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString post.authorId)
cmd.Parameters.AddWithValue ("@status", PostStatus.toString post.status)
cmd.Parameters.AddWithValue ("@title", post.title)
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString post.permalink)
cmd.Parameters.AddWithValue ("@publishedOn", maybe post.publishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", post.updatedOn)
cmd.Parameters.AddWithValue ("@template", maybe post.template)
cmd.Parameters.AddWithValue ("@text", post.text)
[ cmd.Parameters.AddWithValue ("@id", PostId.toString post.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString post.WebLogId)
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString post.AuthorId)
cmd.Parameters.AddWithValue ("@status", PostStatus.toString post.Status)
cmd.Parameters.AddWithValue ("@title", post.Title)
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString post.Permalink)
cmd.Parameters.AddWithValue ("@publishedOn", maybe post.PublishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", post.UpdatedOn)
cmd.Parameters.AddWithValue ("@template", maybe post.Template)
cmd.Parameters.AddWithValue ("@text", post.Text)
] |> ignore
/// Add parameters for episode INSERT or UPDATE statements
let addEpisodeParameters (cmd : SqliteCommand) (ep : Episode) =
[ cmd.Parameters.AddWithValue ("@media", ep.media)
cmd.Parameters.AddWithValue ("@length", ep.length)
cmd.Parameters.AddWithValue ("@duration", maybe ep.duration)
cmd.Parameters.AddWithValue ("@mediaType", maybe ep.mediaType)
cmd.Parameters.AddWithValue ("@imageUrl", maybe ep.imageUrl)
cmd.Parameters.AddWithValue ("@subtitle", maybe ep.subtitle)
cmd.Parameters.AddWithValue ("@explicit", maybe (ep.explicit |> Option.map ExplicitRating.toString))
cmd.Parameters.AddWithValue ("@chapterFile", maybe ep.chapterFile)
cmd.Parameters.AddWithValue ("@chapterType", maybe ep.chapterType)
cmd.Parameters.AddWithValue ("@transcriptUrl", maybe ep.transcriptUrl)
cmd.Parameters.AddWithValue ("@transcriptType", maybe ep.transcriptType)
cmd.Parameters.AddWithValue ("@transcriptLang", maybe ep.transcriptLang)
cmd.Parameters.AddWithValue ("@transcriptCaptions", maybe ep.transcriptCaptions)
cmd.Parameters.AddWithValue ("@seasonNumber", maybe ep.seasonNumber)
cmd.Parameters.AddWithValue ("@seasonDescription", maybe ep.seasonDescription)
cmd.Parameters.AddWithValue ("@episodeNumber", maybe (ep.episodeNumber |> Option.map string))
cmd.Parameters.AddWithValue ("@episodeDescription", maybe ep.episodeDescription)
[ cmd.Parameters.AddWithValue ("@media", ep.Media)
cmd.Parameters.AddWithValue ("@length", ep.Length)
cmd.Parameters.AddWithValue ("@duration", maybe ep.Duration)
cmd.Parameters.AddWithValue ("@mediaType", maybe ep.MediaType)
cmd.Parameters.AddWithValue ("@imageUrl", maybe ep.ImageUrl)
cmd.Parameters.AddWithValue ("@subtitle", maybe ep.Subtitle)
cmd.Parameters.AddWithValue ("@explicit", maybe (ep.Explicit |> Option.map ExplicitRating.toString))
cmd.Parameters.AddWithValue ("@chapterFile", maybe ep.ChapterFile)
cmd.Parameters.AddWithValue ("@chapterType", maybe ep.ChapterType)
cmd.Parameters.AddWithValue ("@transcriptUrl", maybe ep.TranscriptUrl)
cmd.Parameters.AddWithValue ("@transcriptType", maybe ep.TranscriptType)
cmd.Parameters.AddWithValue ("@transcriptLang", maybe ep.TranscriptLang)
cmd.Parameters.AddWithValue ("@transcriptCaptions", maybe ep.TranscriptCaptions)
cmd.Parameters.AddWithValue ("@seasonNumber", maybe ep.SeasonNumber)
cmd.Parameters.AddWithValue ("@seasonDescription", maybe ep.SeasonDescription)
cmd.Parameters.AddWithValue ("@episodeNumber", maybe (ep.EpisodeNumber |> Option.map string))
cmd.Parameters.AddWithValue ("@episodeDescription", maybe ep.EpisodeDescription)
] |> ignore
/// Append category IDs, tags, and meta items to a post
let appendPostCategoryTagAndMeta (post : Post) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", PostId.toString post.id) |> ignore
cmd.Parameters.AddWithValue ("@id", PostId.toString post.Id) |> ignore
cmd.CommandText <- "SELECT category_id AS id FROM post_category WHERE post_id = @id"
use! rdr = cmd.ExecuteReaderAsync ()
let post = { post with categoryIds = toList Map.toCategoryId rdr }
let post = { post with CategoryIds = toList Map.toCategoryId rdr }
do! rdr.CloseAsync ()
cmd.CommandText <- "SELECT tag FROM post_tag WHERE post_id = @id"
use! rdr = cmd.ExecuteReaderAsync ()
let post = { post with tags = toList (Map.getString "tag") rdr }
let post = { post with Tags = toList (Map.getString "tag") rdr }
do! rdr.CloseAsync ()
cmd.CommandText <- "SELECT name, value FROM post_meta WHERE post_id = @id"
use! rdr = cmd.ExecuteReaderAsync ()
return { post with metadata = toList Map.toMetaItem rdr }
return { post with Metadata = toList Map.toMetaItem rdr }
}
/// Append revisions and permalinks to a post
let appendPostRevisionsAndPermalinks (post : Post) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@postId", PostId.toString post.id) |> ignore
cmd.Parameters.AddWithValue ("@postId", PostId.toString post.Id) |> ignore
cmd.CommandText <- "SELECT permalink FROM post_permalink WHERE post_id = @postId"
use! rdr = cmd.ExecuteReaderAsync ()
let post = { post with priorPermalinks = toList Map.toPermalink rdr }
let post = { post with PriorPermalinks = toList Map.toPermalink rdr }
do! rdr.CloseAsync ()
cmd.CommandText <- "SELECT as_of, revision_text FROM post_revision WHERE post_id = @postId ORDER BY as_of DESC"
use! rdr = cmd.ExecuteReaderAsync ()
return { post with revisions = toList Map.toRevision rdr }
return { post with Revisions = toList Map.toRevision rdr }
}
/// The SELECT statement for a post that will include episode data, if it exists
@@ -90,12 +90,12 @@ type SQLitePostData (conn : SqliteConnection) =
cmd.CommandText <- $"{selectPost} WHERE p.id = @id"
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return Helpers.verifyWebLog<Post> webLogId (fun p -> p.webLogId) Map.toPost rdr
return Helpers.verifyWebLog<Post> webLogId (fun p -> p.WebLogId) Map.toPost rdr
}
/// Return a post with no revisions, prior permalinks, or text
let postWithoutText rdr =
{ Map.toPost rdr with text = "" }
{ Map.toPost rdr with Text = "" }
/// Update a post's assigned categories
let updatePostCategories postId oldCats newCats = backgroundTask {
@@ -153,10 +153,10 @@ type SQLitePostData (conn : SqliteConnection) =
let updatePostEpisode (post : Post) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT COUNT(post_id) FROM post_episode WHERE post_id = @postId"
cmd.Parameters.AddWithValue ("@postId", PostId.toString post.id) |> ignore
cmd.Parameters.AddWithValue ("@postId", PostId.toString post.Id) |> ignore
let! count = count cmd
if count = 1 then
match post.episode with
match post.Episode with
| Some ep ->
cmd.CommandText <- """
UPDATE post_episode
@@ -184,7 +184,7 @@ type SQLitePostData (conn : SqliteConnection) =
cmd.CommandText <- "DELETE FROM post_episode WHERE post_id = @postId"
do! write cmd
else
match post.episode with
match post.Episode with
| Some ep ->
cmd.CommandText <- """
INSERT INTO post_episode (
@@ -213,8 +213,8 @@ type SQLitePostData (conn : SqliteConnection) =
cmd.Parameters.Add ("@value", SqliteType.Text)
] |> ignore
let runCmd (item : MetaItem) = backgroundTask {
cmd.Parameters["@name" ].Value <- item.name
cmd.Parameters["@value"].Value <- item.value
cmd.Parameters["@name" ].Value <- item.Name
cmd.Parameters["@value"].Value <- item.Value
do! write cmd
}
cmd.CommandText <- "DELETE FROM post_meta WHERE post_id = @postId AND name = @name AND value = @value"
@@ -265,9 +265,9 @@ type SQLitePostData (conn : SqliteConnection) =
let runCmd withText rev = backgroundTask {
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
cmd.Parameters.AddWithValue ("@asOf", rev.asOf)
cmd.Parameters.AddWithValue ("@asOf", rev.AsOf)
] |> ignore
if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.text) |> ignore
if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.Text) |> ignore
do! write cmd
}
cmd.CommandText <- "DELETE FROM post_revision WHERE post_id = @postId AND as_of = @asOf"
@@ -295,12 +295,12 @@ type SQLitePostData (conn : SqliteConnection) =
)"""
addPostParameters cmd post
do! write cmd
do! updatePostCategories post.id [] post.categoryIds
do! updatePostTags post.id [] post.tags
do! updatePostCategories post.Id [] post.CategoryIds
do! updatePostTags post.Id [] post.Tags
do! updatePostEpisode post
do! updatePostMeta post.id [] post.metadata
do! updatePostPermalinks post.id [] post.priorPermalinks
do! updatePostRevisions post.id [] post.revisions
do! updatePostMeta post.Id [] post.Metadata
do! updatePostPermalinks post.Id [] post.PriorPermalinks
do! updatePostRevisions post.Id [] post.Revisions
}
/// Count posts in a status for the given web log
@@ -535,7 +535,7 @@ type SQLitePostData (conn : SqliteConnection) =
/// Update a post
let update (post : Post) = backgroundTask {
match! findFullById post.id post.webLogId with
match! findFullById post.Id post.WebLogId with
| Some oldPost ->
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
@@ -552,12 +552,12 @@ type SQLitePostData (conn : SqliteConnection) =
AND web_log_id = @webLogId"""
addPostParameters cmd post
do! write cmd
do! updatePostCategories post.id oldPost.categoryIds post.categoryIds
do! updatePostTags post.id oldPost.tags post.tags
do! updatePostCategories post.Id oldPost.CategoryIds post.CategoryIds
do! updatePostTags post.Id oldPost.Tags post.Tags
do! updatePostEpisode post
do! updatePostMeta post.id oldPost.metadata post.metadata
do! updatePostPermalinks post.id oldPost.priorPermalinks post.priorPermalinks
do! updatePostRevisions post.id oldPost.revisions post.revisions
do! updatePostMeta post.Id oldPost.Metadata post.Metadata
do! updatePostPermalinks post.Id oldPost.PriorPermalinks post.PriorPermalinks
do! updatePostRevisions post.Id oldPost.Revisions post.Revisions
| None -> return ()
}
@@ -565,7 +565,7 @@ type SQLitePostData (conn : SqliteConnection) =
let updatePriorPermalinks postId webLogId permalinks = backgroundTask {
match! findFullById postId webLogId with
| Some post ->
do! updatePostPermalinks postId post.priorPermalinks permalinks
do! updatePostPermalinks postId post.PriorPermalinks permalinks
return true
| None -> return false
}

14
src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs
View File

@@ -13,7 +13,7 @@ type SQLiteTagMapData (conn : SqliteConnection) =
cmd.CommandText <- "SELECT * FROM tag_map WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMapId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return Helpers.verifyWebLog<TagMap> webLogId (fun tm -> tm.webLogId) Map.toTagMap rdr
return Helpers.verifyWebLog<TagMap> webLogId (fun tm -> tm.WebLogId) Map.toTagMap rdr
}
/// Delete a tag mapping for the given web log
@@ -69,7 +69,7 @@ type SQLiteTagMapData (conn : SqliteConnection) =
/// Save a tag mapping
let save (tagMap : TagMap) = backgroundTask {
use cmd = conn.CreateCommand ()
match! findById tagMap.id tagMap.webLogId with
match! findById tagMap.Id tagMap.WebLogId with
| Some _ ->
cmd.CommandText <- """
UPDATE tag_map
@@ -84,10 +84,10 @@ type SQLiteTagMapData (conn : SqliteConnection) =
) VALUES (
@id, @webLogId, @tag, @urlValue
)"""
addWebLogId cmd tagMap.webLogId
[ cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMap.id)
cmd.Parameters.AddWithValue ("@tag", tagMap.tag)
cmd.Parameters.AddWithValue ("@urlValue", tagMap.urlValue)
addWebLogId cmd tagMap.WebLogId
[ cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMap.Id)
cmd.Parameters.AddWithValue ("@tag", tagMap.Tag)
cmd.Parameters.AddWithValue ("@urlValue", tagMap.UrlValue)
] |> ignore
do! write cmd
}
@@ -105,4 +105,4 @@ type SQLiteTagMapData (conn : SqliteConnection) =
member _.FindByWebLog webLogId = findByWebLog webLogId
member _.FindMappingForTags tags webLogId = findMappingForTags tags webLogId
member _.Save tagMap = save tagMap
member this.Restore tagMaps = restore tagMaps
member _.Restore tagMaps = restore tagMaps

42
src/MyWebLog.Data/SQLite/SQLiteThemeData.fs
View File

@@ -28,7 +28,7 @@ type SQLiteThemeData (conn : SqliteConnection) =
templateCmd.CommandText <- "SELECT * FROM theme_template WHERE theme_id = @id"
templateCmd.Parameters.Add cmd.Parameters["@id"] |> ignore
use! templateRdr = templateCmd.ExecuteReaderAsync ()
return Some { theme with templates = toList Map.toThemeTemplate templateRdr }
return Some { theme with Templates = toList Map.toThemeTemplate templateRdr }
else
return None
}
@@ -38,7 +38,7 @@ type SQLiteThemeData (conn : SqliteConnection) =
match! findById themeId with
| Some theme ->
return Some {
theme with templates = theme.templates |> List.map (fun t -> { t with text = "" })
theme with Templates = theme.Templates |> List.map (fun t -> { t with Text = "" })
}
| None -> return None
}
@@ -46,36 +46,36 @@ type SQLiteThemeData (conn : SqliteConnection) =
/// Save a theme
let save (theme : Theme) = backgroundTask {
use cmd = conn.CreateCommand ()
let! oldTheme = findById theme.id
let! oldTheme = findById theme.Id
cmd.CommandText <-
match oldTheme with
| Some _ -> "UPDATE theme SET name = @name, version = @version WHERE id = @id"
| None -> "INSERT INTO theme VALUES (@id, @name, @version)"
[ cmd.Parameters.AddWithValue ("@id", ThemeId.toString theme.id)
cmd.Parameters.AddWithValue ("@name", theme.name)
cmd.Parameters.AddWithValue ("@version", theme.version)
[ cmd.Parameters.AddWithValue ("@id", ThemeId.toString theme.Id)
cmd.Parameters.AddWithValue ("@name", theme.Name)
cmd.Parameters.AddWithValue ("@version", theme.Version)
] |> ignore
do! write cmd
let toDelete, toAdd =
diffLists (oldTheme |> Option.map (fun t -> t.templates) |> Option.defaultValue [])
theme.templates (fun t -> t.name)
diffLists (oldTheme |> Option.map (fun t -> t.Templates) |> Option.defaultValue [])
theme.Templates (fun t -> t.Name)
let toUpdate =
theme.templates
theme.Templates
|> List.filter (fun t ->
not (toDelete |> List.exists (fun d -> d.name = t.name))
&& not (toAdd |> List.exists (fun a -> a.name = t.name)))
not (toDelete |> List.exists (fun d -> d.Name = t.Name))
&& not (toAdd |> List.exists (fun a -> a.Name = t.Name)))
cmd.CommandText <-
"UPDATE theme_template SET template = @template WHERE theme_id = @themeId AND name = @name"
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString theme.id)
[ cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString theme.Id)
cmd.Parameters.Add ("@name", SqliteType.Text)
cmd.Parameters.Add ("@template", SqliteType.Text)
] |> ignore
toUpdate
|> List.map (fun template -> backgroundTask {
cmd.Parameters["@name" ].Value <- template.name
cmd.Parameters["@template"].Value <- template.text
cmd.Parameters["@name" ].Value <- template.Name
cmd.Parameters["@template"].Value <- template.Text
do! write cmd
})
|> Task.WhenAll
@@ -83,8 +83,8 @@ type SQLiteThemeData (conn : SqliteConnection) =
cmd.CommandText <- "INSERT INTO theme_template VALUES (@themeId, @name, @template)"
toAdd
|> List.map (fun template -> backgroundTask {
cmd.Parameters["@name" ].Value <- template.name
cmd.Parameters["@template"].Value <- template.text
cmd.Parameters["@name" ].Value <- template.Name
cmd.Parameters["@template"].Value <- template.Text
do! write cmd
})
|> Task.WhenAll
@@ -93,7 +93,7 @@ type SQLiteThemeData (conn : SqliteConnection) =
cmd.Parameters.Remove cmd.Parameters["@template"]
toDelete
|> List.map (fun template -> backgroundTask {
cmd.Parameters["@name"].Value <- template.name
cmd.Parameters["@name"].Value <- template.Name
do! write cmd
})
|> Task.WhenAll
@@ -163,7 +163,7 @@ type SQLiteThemeAssetData (conn : SqliteConnection) =
use sideCmd = conn.CreateCommand ()
sideCmd.CommandText <-
"SELECT COUNT(path) FROM theme_asset WHERE theme_id = @themeId AND path = @path"
let (ThemeAssetId (ThemeId themeId, path)) = asset.id
let (ThemeAssetId (ThemeId themeId, path)) = asset.Id
[ sideCmd.Parameters.AddWithValue ("@themeId", themeId)
sideCmd.Parameters.AddWithValue ("@path", path)
] |> ignore
@@ -185,15 +185,15 @@ type SQLiteThemeAssetData (conn : SqliteConnection) =
)"""
[ cmd.Parameters.AddWithValue ("@themeId", themeId)
cmd.Parameters.AddWithValue ("@path", path)
cmd.Parameters.AddWithValue ("@updatedOn", asset.updatedOn)
cmd.Parameters.AddWithValue ("@dataLength", asset.data.Length)
cmd.Parameters.AddWithValue ("@updatedOn", asset.UpdatedOn)
cmd.Parameters.AddWithValue ("@dataLength", asset.Data.Length)
] |> ignore
do! write cmd
sideCmd.CommandText <- "SELECT ROWID FROM theme_asset WHERE theme_id = @themeId AND path = @path"
let! rowId = sideCmd.ExecuteScalarAsync ()
use dataStream = new MemoryStream (asset.data)
use dataStream = new MemoryStream (asset.Data)
use blobStream = new SqliteBlob (conn, "theme_asset", "data", rowId :?> int64)
do! dataStream.CopyToAsync blobStream
}

14
src/MyWebLog.Data/SQLite/SQLiteUploadData.fs
View File

@@ -10,11 +10,11 @@ type SQLiteUploadData (conn : SqliteConnection) =
/// Add parameters for uploaded file INSERT and UPDATE statements
let addUploadParameters (cmd : SqliteCommand) (upload : Upload) =
[ cmd.Parameters.AddWithValue ("@id", UploadId.toString upload.id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString upload.webLogId)
cmd.Parameters.AddWithValue ("@path", Permalink.toString upload.path)
cmd.Parameters.AddWithValue ("@updatedOn", upload.updatedOn)
cmd.Parameters.AddWithValue ("@dataLength", upload.data.Length)
[ cmd.Parameters.AddWithValue ("@id", UploadId.toString upload.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString upload.WebLogId)
cmd.Parameters.AddWithValue ("@path", Permalink.toString upload.Path)
cmd.Parameters.AddWithValue ("@updatedOn", upload.UpdatedOn)
cmd.Parameters.AddWithValue ("@dataLength", upload.Data.Length)
] |> ignore
/// Save an uploaded file
@@ -32,7 +32,7 @@ type SQLiteUploadData (conn : SqliteConnection) =
cmd.CommandText <- "SELECT ROWID FROM upload WHERE id = @id"
let! rowId = cmd.ExecuteScalarAsync ()
use dataStream = new MemoryStream (upload.data)
use dataStream = new MemoryStream (upload.Data)
use blobStream = new SqliteBlob (conn, "upload", "data", rowId :?> int64)
do! dataStream.CopyToAsync blobStream
}
@@ -53,7 +53,7 @@ type SQLiteUploadData (conn : SqliteConnection) =
do! rdr.CloseAsync ()
cmd.CommandText <- "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId"
do! write cmd
return Ok (Permalink.toString upload.path)
return Ok (Permalink.toString upload.Path)
else
return Error $"""Upload ID {cmd.Parameters["@id"]} not found"""
}

166
src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs
View File

@@ -15,57 +15,57 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Add parameters for web log INSERT or web log/RSS options UPDATE statements
let addWebLogRssParameters (cmd : SqliteCommand) (webLog : WebLog) =
[ cmd.Parameters.AddWithValue ("@feedEnabled", webLog.rss.feedEnabled)
cmd.Parameters.AddWithValue ("@feedName", webLog.rss.feedName)
cmd.Parameters.AddWithValue ("@itemsInFeed", maybe webLog.rss.itemsInFeed)
cmd.Parameters.AddWithValue ("@categoryEnabled", webLog.rss.categoryEnabled)
cmd.Parameters.AddWithValue ("@tagEnabled", webLog.rss.tagEnabled)
cmd.Parameters.AddWithValue ("@copyright", maybe webLog.rss.copyright)
[ cmd.Parameters.AddWithValue ("@isFeedEnabled", webLog.Rss.IsFeedEnabled)
cmd.Parameters.AddWithValue ("@feedName", webLog.Rss.FeedName)
cmd.Parameters.AddWithValue ("@itemsInFeed", maybe webLog.Rss.ItemsInFeed)
cmd.Parameters.AddWithValue ("@isCategoryEnabled", webLog.Rss.IsCategoryEnabled)
cmd.Parameters.AddWithValue ("@isTagEnabled", webLog.Rss.IsTagEnabled)
cmd.Parameters.AddWithValue ("@copyright", maybe webLog.Rss.Copyright)
] |> ignore
/// Add parameters for web log INSERT or UPDATE statements
let addWebLogParameters (cmd : SqliteCommand) (webLog : WebLog) =
[ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.id)
cmd.Parameters.AddWithValue ("@name", webLog.name)
cmd.Parameters.AddWithValue ("@slug", webLog.slug)
cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.subtitle)
cmd.Parameters.AddWithValue ("@defaultPage", webLog.defaultPage)
cmd.Parameters.AddWithValue ("@postsPerPage", webLog.postsPerPage)
cmd.Parameters.AddWithValue ("@themeId", webLog.themePath)
cmd.Parameters.AddWithValue ("@urlBase", webLog.urlBase)
cmd.Parameters.AddWithValue ("@timeZone", webLog.timeZone)
cmd.Parameters.AddWithValue ("@autoHtmx", webLog.autoHtmx)
cmd.Parameters.AddWithValue ("@uploads", UploadDestination.toString webLog.uploads)
[ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id)
cmd.Parameters.AddWithValue ("@name", webLog.Name)
cmd.Parameters.AddWithValue ("@slug", webLog.Slug)
cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.Subtitle)
cmd.Parameters.AddWithValue ("@defaultPage", webLog.DefaultPage)
cmd.Parameters.AddWithValue ("@postsPerPage", webLog.PostsPerPage)
cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString webLog.ThemeId)
cmd.Parameters.AddWithValue ("@urlBase", webLog.UrlBase)
cmd.Parameters.AddWithValue ("@timeZone", webLog.TimeZone)
cmd.Parameters.AddWithValue ("@autoHtmx", webLog.AutoHtmx)
cmd.Parameters.AddWithValue ("@uploads", UploadDestination.toString webLog.Uploads)
] |> ignore
addWebLogRssParameters cmd webLog
/// Add parameters for custom feed INSERT or UPDATE statements
let addCustomFeedParameters (cmd : SqliteCommand) webLogId (feed : CustomFeed) =
[ cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString feed.id)
[ cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString feed.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId)
cmd.Parameters.AddWithValue ("@source", CustomFeedSource.toString feed.source)
cmd.Parameters.AddWithValue ("@path", Permalink.toString feed.path)
cmd.Parameters.AddWithValue ("@source", CustomFeedSource.toString feed.Source)
cmd.Parameters.AddWithValue ("@path", Permalink.toString feed.Path)
] |> ignore
/// Add parameters for podcast INSERT or UPDATE statements
let addPodcastParameters (cmd : SqliteCommand) feedId (podcast : PodcastOptions) =
[ cmd.Parameters.AddWithValue ("@feedId", CustomFeedId.toString feedId)
cmd.Parameters.AddWithValue ("@title", podcast.title)
cmd.Parameters.AddWithValue ("@subtitle", maybe podcast.subtitle)
cmd.Parameters.AddWithValue ("@itemsInFeed", podcast.itemsInFeed)
cmd.Parameters.AddWithValue ("@summary", podcast.summary)
cmd.Parameters.AddWithValue ("@displayedAuthor", podcast.displayedAuthor)
cmd.Parameters.AddWithValue ("@email", podcast.email)
cmd.Parameters.AddWithValue ("@imageUrl", Permalink.toString podcast.imageUrl)
cmd.Parameters.AddWithValue ("@iTunesCategory", podcast.iTunesCategory)
cmd.Parameters.AddWithValue ("@iTunesSubcategory", maybe podcast.iTunesSubcategory)
cmd.Parameters.AddWithValue ("@explicit", ExplicitRating.toString podcast.explicit)
cmd.Parameters.AddWithValue ("@defaultMediaType", maybe podcast.defaultMediaType)
cmd.Parameters.AddWithValue ("@mediaBaseUrl", maybe podcast.mediaBaseUrl)
cmd.Parameters.AddWithValue ("@guid", maybe podcast.guid)
cmd.Parameters.AddWithValue ("@fundingUrl", maybe podcast.fundingUrl)
cmd.Parameters.AddWithValue ("@fundingText", maybe podcast.fundingText)
cmd.Parameters.AddWithValue ("@medium", maybe (podcast.medium |> Option.map PodcastMedium.toString))
cmd.Parameters.AddWithValue ("@title", podcast.Title)
cmd.Parameters.AddWithValue ("@subtitle", maybe podcast.Subtitle)
cmd.Parameters.AddWithValue ("@itemsInFeed", podcast.ItemsInFeed)
cmd.Parameters.AddWithValue ("@summary", podcast.Summary)
cmd.Parameters.AddWithValue ("@displayedAuthor", podcast.DisplayedAuthor)
cmd.Parameters.AddWithValue ("@email", podcast.Email)
cmd.Parameters.AddWithValue ("@imageUrl", Permalink.toString podcast.ImageUrl)
cmd.Parameters.AddWithValue ("@appleCategory", podcast.AppleCategory)
cmd.Parameters.AddWithValue ("@appleSubcategory", maybe podcast.AppleSubcategory)
cmd.Parameters.AddWithValue ("@explicit", ExplicitRating.toString podcast.Explicit)
cmd.Parameters.AddWithValue ("@defaultMediaType", maybe podcast.DefaultMediaType)
cmd.Parameters.AddWithValue ("@mediaBaseUrl", maybe podcast.MediaBaseUrl)
cmd.Parameters.AddWithValue ("@podcastGuid", maybe podcast.PodcastGuid)
cmd.Parameters.AddWithValue ("@fundingUrl", maybe podcast.FundingUrl)
cmd.Parameters.AddWithValue ("@fundingText", maybe podcast.FundingText)
cmd.Parameters.AddWithValue ("@medium", maybe (podcast.Medium |> Option.map PodcastMedium.toString))
] |> ignore
/// Get the current custom feeds for a web log
@@ -76,7 +76,7 @@ type SQLiteWebLogData (conn : SqliteConnection) =
FROM web_log_feed f
LEFT JOIN web_log_feed_podcast p ON p.feed_id = f.id
WHERE f.web_log_id = @webLogId"""
addWebLogId cmd webLog.id
addWebLogId cmd webLog.Id
use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toCustomFeed rdr
}
@@ -84,7 +84,7 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Append custom feeds to a web log
let appendCustomFeeds (webLog : WebLog) = backgroundTask {
let! feeds = getCustomFeeds webLog
return { webLog with rss = { webLog.rss with customFeeds = feeds } }
return { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } }
}
/// Add a podcast to a custom feed
@@ -93,12 +93,12 @@ type SQLiteWebLogData (conn : SqliteConnection) =
cmd.CommandText <- """
INSERT INTO web_log_feed_podcast (
feed_id, title, subtitle, items_in_feed, summary, displayed_author, email, image_url,
itunes_category, itunes_subcategory, explicit, default_media_type, media_base_url, guid, funding_url,
funding_text, medium
apple_category, apple_subcategory, explicit, default_media_type, media_base_url, podcast_guid,
funding_url, funding_text, medium
) VALUES (
@feedId, @title, @subtitle, @itemsInFeed, @summary, @displayedAuthor, @email, @imageUrl,
@iTunesCategory, @iTunesSubcategory, @explicit, @defaultMediaType, @mediaBaseUrl, @guid, @fundingUrl,
@fundingText, @medium
@appleCategory, @appleSubcategory, @explicit, @defaultMediaType, @mediaBaseUrl, @podcastGuid,
@fundingUrl, @fundingText, @medium
)"""
addPodcastParameters cmd feedId podcast
do! write cmd
@@ -107,12 +107,12 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Update the custom feeds for a web log
let updateCustomFeeds (webLog : WebLog) = backgroundTask {
let! feeds = getCustomFeeds webLog
let toDelete, toAdd = diffLists feeds webLog.rss.customFeeds (fun it -> $"{CustomFeedId.toString it.id}")
let toId (feed : CustomFeed) = feed.id
let toDelete, toAdd = diffLists feeds webLog.Rss.CustomFeeds (fun it -> $"{CustomFeedId.toString it.Id}")
let toId (feed : CustomFeed) = feed.Id
let toUpdate =
webLog.rss.customFeeds
webLog.Rss.CustomFeeds
|> List.filter (fun f ->
not (toDelete |> List.map toId |> List.append (toAdd |> List.map toId) |> List.contains f.id))
not (toDelete |> List.map toId |> List.append (toAdd |> List.map toId) |> List.contains f.Id))
use cmd = conn.CreateCommand ()
cmd.Parameters.Add ("@id", SqliteType.Text) |> ignore
toDelete
@@ -120,7 +120,7 @@ type SQLiteWebLogData (conn : SqliteConnection) =
cmd.CommandText <- """
DELETE FROM web_log_feed_podcast WHERE feed_id = @id;
DELETE FROM web_log_feed WHERE id = @id"""
cmd.Parameters["@id"].Value <- CustomFeedId.toString it.id
cmd.Parameters["@id"].Value <- CustomFeedId.toString it.Id
do! write cmd
})
|> Task.WhenAll
@@ -135,10 +135,10 @@ type SQLiteWebLogData (conn : SqliteConnection) =
@id, @webLogId, @source, @path
)"""
cmd.Parameters.Clear ()
addCustomFeedParameters cmd webLog.id it
addCustomFeedParameters cmd webLog.Id it
do! write cmd
match it.podcast with
| Some podcast -> do! addPodcast it.id podcast
match it.Podcast with
| Some podcast -> do! addPodcast it.Id podcast
| None -> ()
})
|> Task.WhenAll
@@ -152,10 +152,10 @@ type SQLiteWebLogData (conn : SqliteConnection) =
WHERE id = @id
AND web_log_id = @webLogId"""
cmd.Parameters.Clear ()
addCustomFeedParameters cmd webLog.id it
addCustomFeedParameters cmd webLog.Id it
do! write cmd
let hadPodcast = Option.isSome (feeds |> List.find (fun f -> f.id = it.id)).podcast
match it.podcast with
let hadPodcast = Option.isSome (feeds |> List.find (fun f -> f.Id = it.Id)).Podcast
match it.Podcast with
| Some podcast ->
if hadPodcast then
cmd.CommandText <- """
@@ -167,26 +167,26 @@ type SQLiteWebLogData (conn : SqliteConnection) =
displayed_author = @displayedAuthor,
email = @email,
image_url = @imageUrl,
itunes_category = @iTunesCategory,
itunes_subcategory = @iTunesSubcategory,
apple_category = @appleCategory,
apple_subcategory = @appleSubcategory,
explicit = @explicit,
default_media_type = @defaultMediaType,
media_base_url = @mediaBaseUrl,
guid = @guid,
podcast_guid = @podcastGuid,
funding_url = @fundingUrl,
funding_text = @fundingText,
medium = @medium
WHERE feed_id = @feedId"""
cmd.Parameters.Clear ()
addPodcastParameters cmd it.id podcast
addPodcastParameters cmd it.Id podcast
do! write cmd
else
do! addPodcast it.id podcast
do! addPodcast it.Id podcast
| None ->
if hadPodcast then
cmd.CommandText <- "DELETE FROM web_log_feed_podcast WHERE feed_id = @id"
cmd.Parameters.Clear ()
cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString it.id) |> ignore
cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString it.Id) |> ignore
do! write cmd
else
()
@@ -203,10 +203,10 @@ type SQLiteWebLogData (conn : SqliteConnection) =
cmd.CommandText <- """
INSERT INTO web_log (
id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx,
uploads, feed_enabled, feed_name, items_in_feed, category_enabled, tag_enabled, copyright
uploads, is_feed_enabled, feed_name, items_in_feed, is_category_enabled, is_tag_enabled, copyright
) VALUES (
@id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx,
@uploads, @feedEnabled, @feedName, @itemsInFeed, @categoryEnabled, @tagEnabled, @copyright
@uploads, @isFeedEnabled, @feedName, @itemsInFeed, @isCategoryEnabled, @isTagEnabled, @copyright
)"""
addWebLogParameters cmd webLog
do! write cmd
@@ -286,22 +286,22 @@ type SQLiteWebLogData (conn : SqliteConnection) =
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
UPDATE web_log
SET name = @name,
slug = @slug,
subtitle = @subtitle,
default_page = @defaultPage,
posts_per_page = @postsPerPage,
theme_id = @themeId,
url_base = @urlBase,
time_zone = @timeZone,
auto_htmx = @autoHtmx,
uploads = @uploads,
feed_enabled = @feedEnabled,
feed_name = @feedName,
items_in_feed = @itemsInFeed,
category_enabled = @categoryEnabled,
tag_enabled = @tagEnabled,
copyright = @copyright
SET name = @name,
slug = @slug,
subtitle = @subtitle,
default_page = @defaultPage,
posts_per_page = @postsPerPage,
theme_id = @themeId,
url_base = @urlBase,
time_zone = @timeZone,
auto_htmx = @autoHtmx,
uploads = @uploads,
is_feed_enabled = @isFeedEnabled,
feed_name = @feedName,
items_in_feed = @itemsInFeed,
is_category_enabled = @isCategoryEnabled,
is_tag_enabled = @isTagEnabled,
copyright = @copyright
WHERE id = @id"""
addWebLogParameters cmd webLog
do! write cmd
@@ -312,12 +312,12 @@ type SQLiteWebLogData (conn : SqliteConnection) =
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
UPDATE web_log
SET feed_enabled = @feedEnabled,
feed_name = @feedName,
items_in_feed = @itemsInFeed,
category_enabled = @categoryEnabled,
tag_enabled = @tagEnabled,
copyright = @copyright
SET is_feed_enabled = @isFeedEnabled,
feed_name = @feedName,
items_in_feed = @itemsInFeed,
is_category_enabled = @isCategoryEnabled,
is_tag_enabled = @isTagEnabled,
copyright = @copyright
WHERE id = @id"""
addWebLogRssParameters cmd webLog
do! write cmd

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

@@ -12,18 +12,18 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
/// Add parameters for web log user INSERT or UPDATE statements
let addWebLogUserParameters (cmd : SqliteCommand) (user : WebLogUser) =
[ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString user.id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString user.webLogId)
cmd.Parameters.AddWithValue ("@userName", user.userName)
cmd.Parameters.AddWithValue ("@firstName", user.firstName)
cmd.Parameters.AddWithValue ("@lastName", user.lastName)
cmd.Parameters.AddWithValue ("@preferredName", user.preferredName)
cmd.Parameters.AddWithValue ("@passwordHash", user.passwordHash)
cmd.Parameters.AddWithValue ("@salt", user.salt)
cmd.Parameters.AddWithValue ("@url", maybe user.url)
cmd.Parameters.AddWithValue ("@accessLevel", AccessLevel.toString user.accessLevel)
cmd.Parameters.AddWithValue ("@createdOn", user.createdOn)
cmd.Parameters.AddWithValue ("@lastSeenOn", maybe user.lastSeenOn)
[ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString user.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString user.WebLogId)
cmd.Parameters.AddWithValue ("@email", user.Email)
cmd.Parameters.AddWithValue ("@firstName", user.FirstName)
cmd.Parameters.AddWithValue ("@lastName", user.LastName)
cmd.Parameters.AddWithValue ("@preferredName", user.PreferredName)
cmd.Parameters.AddWithValue ("@passwordHash", user.PasswordHash)
cmd.Parameters.AddWithValue ("@salt", user.Salt)
cmd.Parameters.AddWithValue ("@url", maybe user.Url)
cmd.Parameters.AddWithValue ("@accessLevel", AccessLevel.toString user.AccessLevel)
cmd.Parameters.AddWithValue ("@createdOn", user.CreatedOn)
cmd.Parameters.AddWithValue ("@lastSeenOn", maybe user.LastSeenOn)
] |> ignore
// IMPLEMENTATION FUNCTIONS
@@ -33,11 +33,11 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
INSERT INTO web_log_user (
id, web_log_id, user_name, first_name, last_name, preferred_name, password_hash, salt, url,
access_level, created_on, last_seen_on
id, web_log_id, email, first_name, last_name, preferred_name, password_hash, salt, url, access_level,
created_on, last_seen_on
) VALUES (
@id, @webLogId, @userName, @firstName, @lastName, @preferredName, @passwordHash, @salt, @url,
@accessLevel, @createdOn, @lastSeenOn
@id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @salt, @url, @accessLevel,
@createdOn, @lastSeenOn
)"""
addWebLogUserParameters cmd user
do! write cmd
@@ -46,9 +46,9 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
/// Find a user by their e-mail address for the given web log
let findByEmail (email : string) webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND user_name = @userName"
cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND email = @email"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@userName", email) |> ignore
cmd.Parameters.AddWithValue ("@email", email) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return if rdr.Read () then Some (Map.toWebLogUser rdr) else None
}
@@ -59,7 +59,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
cmd.CommandText <- "SELECT * FROM web_log_user WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return Helpers.verifyWebLog<WebLogUser> webLogId (fun u -> u.webLogId) Map.toWebLogUser rdr
return Helpers.verifyWebLog<WebLogUser> webLogId (fun u -> u.WebLogId) Map.toWebLogUser rdr
}
/// Get all users for the given web log
@@ -85,7 +85,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
use! rdr = cmd.ExecuteReaderAsync ()
return
toList Map.toWebLogUser rdr
|> List.map (fun u -> { name = WebLogUserId.toString u.id; value = WebLogUser.displayName u })
|> List.map (fun u -> { Name = WebLogUserId.toString u.Id; Value = WebLogUser.displayName u })
}
/// Restore users from a backup
@@ -115,7 +115,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
UPDATE web_log_user
SET user_name = @userName,
SET email = @email,
first_name = @firstName,
last_name = @lastName,
preferred_name = @preferredName,

100
src/MyWebLog.Data/SQLiteData.fs
View File

@@ -86,23 +86,23 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
log.LogInformation "Creating web_log table..."
cmd.CommandText <- """
CREATE TABLE web_log (
id TEXT PRIMARY KEY,
name TEXT NOT NULL,
slug TEXT NOT NULL,
subtitle TEXT,
default_page TEXT NOT NULL,
posts_per_page INTEGER NOT NULL,
theme_id TEXT NOT NULL REFERENCES theme (id),
url_base TEXT NOT NULL,
time_zone TEXT NOT NULL,
auto_htmx INTEGER NOT NULL DEFAULT 0,
uploads TEXT NOT NULL,
feed_enabled INTEGER NOT NULL DEFAULT 0,
feed_name TEXT NOT NULL,
items_in_feed INTEGER,
category_enabled INTEGER NOT NULL DEFAULT 0,
tag_enabled INTEGER NOT NULL DEFAULT 0,
copyright TEXT);
id TEXT PRIMARY KEY,
name TEXT NOT NULL,
slug TEXT NOT NULL,
subtitle TEXT,
default_page TEXT NOT NULL,
posts_per_page INTEGER NOT NULL,
theme_id TEXT NOT NULL REFERENCES theme (id),
url_base TEXT NOT NULL,
time_zone TEXT NOT NULL,
auto_htmx INTEGER NOT NULL DEFAULT 0,
uploads TEXT NOT NULL,
is_feed_enabled INTEGER NOT NULL DEFAULT 0,
feed_name TEXT NOT NULL,
items_in_feed INTEGER,
is_category_enabled INTEGER NOT NULL DEFAULT 0,
is_tag_enabled INTEGER NOT NULL DEFAULT 0,
copyright TEXT);
CREATE INDEX web_log_theme_idx ON web_log (theme_id)"""
do! write cmd
match! tableExists "web_log_feed" with
@@ -131,12 +131,12 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
displayed_author TEXT NOT NULL,
email TEXT NOT NULL,
image_url TEXT NOT NULL,
itunes_category TEXT NOT NULL,
itunes_subcategory TEXT,
apple_category TEXT NOT NULL,
apple_subcategory TEXT,
explicit TEXT NOT NULL,
default_media_type TEXT,
media_base_url TEXT,
guid TEXT,
podcast_guid TEXT,
funding_url TEXT,
funding_text TEXT,
medium TEXT)"""
@@ -149,12 +149,12 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
log.LogInformation "Creating category table..."
cmd.CommandText <- """
CREATE TABLE category (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
name TEXT NOT NULL,
slug TEXT NOT NULL,
description TEXT,
parent_id TEXT);
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
name TEXT NOT NULL,
slug TEXT NOT NULL,
description TEXT,
parent_id TEXT);
CREATE INDEX category_web_log_idx ON category (web_log_id)"""
do! write cmd
@@ -165,20 +165,20 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
log.LogInformation "Creating web_log_user table..."
cmd.CommandText <- """
CREATE TABLE web_log_user (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
user_name TEXT NOT NULL,
first_name TEXT NOT NULL,
last_name TEXT NOT NULL,
preferred_name TEXT NOT NULL,
password_hash TEXT NOT NULL,
salt TEXT NOT NULL,
url TEXT,
access_level TEXT NOT NULL,
created_on TEXT NOT NULL,
last_seen_on TEXT NOT NULL);
CREATE INDEX web_log_user_web_log_idx ON web_log_user (web_log_id);
CREATE INDEX web_log_user_user_name_idx ON web_log_user (web_log_id, user_name)"""
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
email TEXT NOT NULL,
first_name TEXT NOT NULL,
last_name TEXT NOT NULL,
preferred_name TEXT NOT NULL,
password_hash TEXT NOT NULL,
salt TEXT NOT NULL,
url TEXT,
access_level TEXT NOT NULL,
created_on TEXT NOT NULL,
last_seen_on TEXT);
CREATE INDEX web_log_user_web_log_idx ON web_log_user (web_log_id);
CREATE INDEX web_log_user_email_idx ON web_log_user (web_log_id, email)"""
do! write cmd
// Page tables
@@ -188,16 +188,16 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
log.LogInformation "Creating page table..."
cmd.CommandText <- """
CREATE TABLE page (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
author_id TEXT NOT NULL REFERENCES web_log_user (id),
title TEXT NOT NULL,
permalink TEXT NOT NULL,
published_on TEXT NOT NULL,
updated_on TEXT NOT NULL,
show_in_page_list INTEGER NOT NULL DEFAULT 0,
template TEXT,
page_text TEXT NOT NULL);
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
author_id TEXT NOT NULL REFERENCES web_log_user (id),
title TEXT NOT NULL,
permalink TEXT NOT NULL,
published_on TEXT NOT NULL,
updated_on TEXT NOT NULL,
is_in_page_list INTEGER NOT NULL DEFAULT 0,
template TEXT,
page_text TEXT NOT NULL);
CREATE INDEX page_web_log_idx ON page (web_log_id);
CREATE INDEX page_author_idx ON page (author_id);
CREATE INDEX page_permalink_idx ON page (web_log_id, permalink)"""

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

@@ -7,16 +7,16 @@ open MyWebLog.ViewModels
/// Create a category hierarchy from the given list of categories
let rec orderByHierarchy (cats : Category list) parentId slugBase parentNames = seq {
for cat in cats |> List.filter (fun c -> c.parentId = parentId) do
let fullSlug = (match slugBase with Some it -> $"{it}/" | None -> "") + cat.slug
{ Id = CategoryId.toString cat.id
for cat in cats |> List.filter (fun c -> c.ParentId = parentId) do
let fullSlug = (match slugBase with Some it -> $"{it}/" | None -> "") + cat.Slug
{ Id = CategoryId.toString cat.Id
Slug = fullSlug
Name = cat.name
Description = cat.description
Name = cat.Name
Description = cat.Description
ParentNames = Array.ofList parentNames
// Post counts are filled on a second pass
PostCount = 0
}
yield! orderByHierarchy cats (Some cat.id) (Some fullSlug) ([ cat.name ] |> List.append parentNames)
yield! orderByHierarchy cats (Some cat.Id) (Some fullSlug) ([ cat.Name ] |> List.append parentNames)
}