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

Version 2.1 #41

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

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

@ -108,6 +108,23 @@ let maybeDuration =
let maybeInstant = let maybeInstant =
Option.map instantParam >> maybe Option.map instantParam >> maybe
/// Create the SQL and parameters for an EXISTS applied to a JSON array
let inJsonArray<'T> table jsonField paramName (items: 'T list) =
if List.isEmpty items then "", []
else
let mutable idx = 0
items
|> List.skip 1
|> List.fold (fun (itemS, itemP) it ->
idx <- idx + 1
$"{itemS}, @%s{paramName}{idx}", (SqliteParameter($"@%s{paramName}{idx}", string it) :: itemP))
(Seq.ofList items
|> Seq.map (fun it -> $"(@%s{paramName}0", [ SqliteParameter($"@%s{paramName}0", string it) ])
|> Seq.head)
|> function
sql, ps ->
$"EXISTS (SELECT 1 FROM json_each(%s{table}.data, '$.%s{jsonField}') WHERE value IN {sql}))", ps
/// Create the SQL and parameters for an IN clause /// Create the SQL and parameters for an IN clause
let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items: 'T list) = let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items: 'T list) =
if List.isEmpty items then "", [] if List.isEmpty items then "", []
@ -209,16 +226,6 @@ module Map =
/// Map an id field to a category ID /// Map an id field to a category ID
let toCategoryId rdr = getString "id" rdr |> CategoryId let toCategoryId rdr = getString "id" rdr |> CategoryId
/// Create a category from the current row in the given data reader
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 /// Create a custom feed from the current row in the given data reader
let toCustomFeed ser rdr : CustomFeed = let toCustomFeed ser rdr : CustomFeed =
{ Id = getString "id" rdr |> CustomFeedId { Id = getString "id" rdr |> CustomFeedId
@ -230,48 +237,10 @@ module Map =
/// Create a permalink from the current row in the given data reader /// Create a permalink from the current row in the given data reader
let toPermalink rdr = getString "permalink" rdr |> Permalink let toPermalink rdr = getString "permalink" rdr |> Permalink
/// Create a page from the current row in the given data reader
let toPage ser rdr : Page =
{ Page.Empty with
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 = getInstant "published_on" rdr
UpdatedOn = getInstant "updated_on" rdr
IsInPageList = getBoolean "is_in_page_list" rdr
Template = tryString "template" rdr
Text = getString "page_text" rdr
Metadata = tryString "meta_items" rdr
|> Option.map (Utils.deserialize ser)
|> Option.defaultValue []
}
/// Create a post from the current row in the given data reader
let toPost ser rdr : Post =
{ Post.Empty with
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 = tryInstant "published_on" rdr
UpdatedOn = getInstant "updated_on" rdr
Template = tryString "template" rdr
Text = getString "post_text" rdr
Episode = tryString "episode" rdr |> Option.map (Utils.deserialize ser)
Metadata = tryString "meta_items" rdr
|> Option.map (Utils.deserialize ser)
|> Option.defaultValue []
}
/// Create a revision from the current row in the given data reader /// Create a revision from the current row in the given data reader
let toRevision rdr : Revision = let toRevision rdr : Revision =
{ AsOf = getInstant "as_of" rdr { AsOf = getInstant "as_of" rdr
Text = getString "revision_text" rdr |> MarkupText.Parse Text = getString "revision_text" rdr |> MarkupText.Parse }
}
/// Create a tag mapping from the current row in the given data reader /// Create a tag mapping from the current row in the given data reader
let toTagMap rdr : TagMap = let toTagMap rdr : TagMap =
@ -301,8 +270,7 @@ module Map =
[||] [||]
{ Id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr) { Id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr)
UpdatedOn = getInstant "updated_on" rdr UpdatedOn = getInstant "updated_on" rdr
Data = assetData Data = assetData }
}
/// Create a theme template from the current row in the given data reader /// Create a theme template from the current row in the given data reader
let toThemeTemplate includeText rdr : ThemeTemplate = let toThemeTemplate includeText rdr : ThemeTemplate =
@ -324,8 +292,7 @@ module Map =
WebLogId = getString "web_log_id" rdr |> WebLogId WebLogId = getString "web_log_id" rdr |> WebLogId
Path = getString "path" rdr |> Permalink Path = getString "path" rdr |> Permalink
UpdatedOn = getInstant "updated_on" rdr UpdatedOn = getInstant "updated_on" rdr
Data = data Data = data }
}
/// Create a web log from the current row in the given data reader /// Create a web log from the current row in the given data reader
let toWebLog ser rdr : WebLog = let toWebLog ser rdr : WebLog =
@ -375,17 +342,170 @@ module Map =
let fromDoc<'T> ser rdr : 'T = let fromDoc<'T> ser rdr : 'T =
fromData<'T> ser rdr "data" fromData<'T> ser rdr "data"
/// Create a list of items for the results of the given command
let cmdToList<'TDoc> (cmd: SqliteCommand) ser = backgroundTask {
use! rdr = cmd.ExecuteReaderAsync()
let mutable it: 'TDoc list = []
while! rdr.ReadAsync() do
it <- Map.fromDoc ser rdr :: it
return List.rev it
}
/// Queries to assist with document manipulation /// Queries to assist with document manipulation
module Query = module Query =
/// Fragment to add an ID condition to a WHERE clause /// Fragment to add an ID condition to a WHERE clause (parameter @id)
let whereById = let whereById =
"data ->> 'Id' = @id" "data ->> 'Id' = @id"
/// Fragment to add a web log ID condition to a WHERE clause /// Fragment to add a web log ID condition to a WHERE clause (parameter @webLogId)
let whereWebLogId = let whereByWebLog =
"data ->> 'WebLogId' = @webLogId" "data ->> 'WebLogId' = @webLogId"
/// A SELECT/FROM pair for the given table
let selectFromTable table =
$"SELECT data FROM %s{table}"
/// An INSERT statement for a document (parameter @data)
let insert table =
$"INSERT INTO %s{table} VALUES (@data)"
/// A SELECT query to count documents for a given web log ID
let countByWebLog table =
$"SELECT COUNT(*) FROM %s{table} WHERE {whereByWebLog}"
/// An UPDATE query to update a full document by its ID (parameters @data and @id)
let updateById table =
$"UPDATE %s{table} SET data = @data WHERE {whereById}"
/// A DELETE query to delete a document by its ID (parameter @id)
let deleteById table =
$"DELETE FROM %s{table} WHERE {whereById}"
let addParam (cmd: SqliteCommand) name (value: obj) =
cmd.Parameters.AddWithValue(name, value) |> ignore
/// Add an ID parameter for a document
let addDocId<'TKey> (cmd: SqliteCommand) (id: 'TKey) =
addParam cmd "@id" (string id)
/// Add a document parameter
let addDocParam<'TDoc> (cmd: SqliteCommand) (doc: 'TDoc) ser =
addParam cmd "@data" (Utils.serialize ser doc)
/// Add a web log ID parameter /// Add a web log ID parameter
let addWebLogId (cmd: SqliteCommand) (webLogId: WebLogId) = let addWebLogId (cmd: SqliteCommand) (webLogId: WebLogId) =
cmd.Parameters.AddWithValue("@webLogId", string webLogId) |> ignore addParam cmd "@webLogId" (string webLogId)
/// Functions for manipulating documents
module Document =
/// Count documents for the given web log ID
let countByWebLog (conn: SqliteConnection) table webLogId = backgroundTask {
use cmd = conn.CreateCommand()
cmd.CommandText <- Query.countByWebLog table
addWebLogId cmd webLogId
return! count cmd
}
/// Find a document by its ID and web log ID
let findByIdAndWebLog<'TKey, 'TDoc> (conn: SqliteConnection) ser table (key: 'TKey) webLogId = backgroundTask {
use cmd = conn.CreateCommand()
cmd.CommandText <- $"{Query.selectFromTable table} WHERE {Query.whereById} AND {Query.whereByWebLog}"
addDocId cmd key
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync()
let! isFound = rdr.ReadAsync()
return if isFound then Some (Map.fromDoc<'TDoc> ser rdr) else None
}
/// Find documents for the given web log
let findByWebLog<'TDoc> (conn: SqliteConnection) ser table webLogId =
use cmd = conn.CreateCommand()
cmd.CommandText <- $"{Query.selectFromTable table} WHERE {Query.whereByWebLog}"
addWebLogId cmd webLogId
cmdToList<'TDoc> cmd ser
/// Insert a document
let insert<'TDoc> (conn: SqliteConnection) ser table (doc: 'TDoc) = backgroundTask {
use cmd = conn.CreateCommand()
cmd.CommandText <- Query.insert table
addDocParam<'TDoc> cmd doc ser
do! write cmd
}
/// Update (replace) a document by its ID
let update<'TKey, 'TDoc> (conn: SqliteConnection) ser table (key: 'TKey) (doc: 'TDoc) = backgroundTask {
use cmd = conn.CreateCommand()
cmd.CommandText <- Query.updateById table
addDocId cmd key
addDocParam<'TDoc> cmd doc ser
do! write cmd
}
/// Delete a document by its ID
let delete<'TKey> (conn: SqliteConnection) table (key: 'TKey) = backgroundTask {
use cmd = conn.CreateCommand()
cmd.CommandText <- Query.deleteById table
addDocId cmd key
do! write cmd
}
/// Functions to support revisions
module Revisions =
/// Find all revisions for the given entity
let findByEntityId<'TKey> (conn: SqliteConnection) revTable entityTable (key: 'TKey) = backgroundTask {
use cmd = conn.CreateCommand()
cmd.CommandText <-
$"SELECT as_of, revision_text FROM %s{revTable} WHERE %s{entityTable}_id = @id ORDER BY as_of DESC"
addDocId cmd key
use! rdr = cmd.ExecuteReaderAsync()
return toList Map.toRevision rdr
}
/// Find all revisions for all posts for the given web log
let findByWebLog<'TKey> (conn: SqliteConnection) revTable entityTable (keyFunc: string -> 'TKey)
webLogId = backgroundTask {
use cmd = conn.CreateCommand()
cmd.CommandText <-
$"SELECT pr.*
FROM %s{revTable} pr
INNER JOIN %s{entityTable} p ON p.data ->> 'Id' = pr.{entityTable}_id
WHERE p.{Query.whereByWebLog}
ORDER BY as_of DESC"
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync()
return toList (fun rdr -> keyFunc (Map.getString $"{entityTable}_id" rdr), Map.toRevision rdr) rdr
}
/// Parameters for a revision INSERT statement
let revParams<'TKey> (key: 'TKey) rev =
[ SqliteParameter("asOf", rev.AsOf)
SqliteParameter("@id", string key)
SqliteParameter("@text", rev.Text) ]
/// The SQL statement to insert a revision
let insertSql table =
$"INSERT INTO %s{table} VALUES (@id, @asOf, @text)"
/// Update a page or post's revisions
let update<'TKey> (conn: SqliteConnection) revTable entityTable (key: 'TKey) oldRevs newRevs = backgroundTask {
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then
use cmd = conn.CreateCommand()
if not (List.isEmpty toDelete) then
cmd.CommandText <- $"DELETE FROM %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf"
for delRev in toDelete do
cmd.Parameters.Clear()
addDocId cmd key
addParam cmd "@asOf" delRev.AsOf
do! write cmd
if not (List.isEmpty toAdd) then
cmd.CommandText <- insertSql revTable
for addRev in toAdd do
cmd.Parameters.Clear()
cmd.Parameters.AddRange(revParams key addRev)
do! write cmd
}

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

@ -2,71 +2,46 @@ namespace MyWebLog.Data.SQLite
open System.Threading.Tasks open System.Threading.Tasks
open Microsoft.Data.Sqlite open Microsoft.Data.Sqlite
open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json open Newtonsoft.Json
/// SQLite myWebLog category data implementation /// SQLite myWebLog category data implementation
type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer) = type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) =
/// Add parameters for category INSERT or UPDATE statements /// The name of the parent ID field
let addCategoryParameters (cmd: SqliteCommand) (cat: Category) = let parentIdField = nameof Category.Empty.ParentId
[ cmd.Parameters.AddWithValue ("@id", string cat.Id)
cmd.Parameters.AddWithValue ("@webLogId", string 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 string))
] |> ignore
/// Add a category /// Add a category
let add cat = backgroundTask { let add (cat: Category) =
use cmd = conn.CreateCommand () log.LogTrace "Category.add"
cmd.CommandText <- Document.insert conn ser Table.Category cat
"INSERT INTO category (
id, web_log_id, name, slug, description, parent_id
) VALUES (
@id, @webLogId, @name, @slug, @description, @parentId
)"
addCategoryParameters cmd cat
let! _ = cmd.ExecuteNonQueryAsync ()
()
}
/// Count all categories for the given web log /// Count all categories for the given web log
let countAll webLogId = backgroundTask { let countAll webLogId =
use cmd = conn.CreateCommand() log.LogTrace "Category.countAll"
cmd.CommandText <- $"SELECT COUNT(*) FROM {Table.Category} WHERE {whereWebLogId}" Document.countByWebLog conn Table.Category webLogId
addWebLogId cmd webLogId
return! count cmd
}
/// Count all top-level categories for the given web log /// Count all top-level categories for the given web log
let countTopLevel webLogId = backgroundTask { let countTopLevel webLogId = backgroundTask {
log.LogTrace "Category.countTopLevel"
use cmd = conn.CreateCommand() use cmd = conn.CreateCommand()
cmd.CommandText <- cmd.CommandText <- $"{Query.countByWebLog} AND data ->> '{parentIdField}' IS NULL"
$"SELECT COUNT(*) FROM {Table.Category}
WHERE {whereWebLogId} AND data ->> '{nameof Category.Empty.ParentId}' IS NULL"
addWebLogId cmd webLogId addWebLogId cmd webLogId
return! count cmd return! count cmd
} }
// TODO: need to get SQLite in clause format for JSON documents /// Find all categories for the given web log
let findByWebLog webLogId =
log.LogTrace "Category.findByWebLog"
Document.findByWebLog<Category> conn ser Table.Category webLogId
/// Retrieve all categories for the given web log in a DotLiquid-friendly format /// Retrieve all categories for the given web log in a DotLiquid-friendly format
let findAllForView webLogId = backgroundTask { let findAllForView webLogId = backgroundTask {
use cmd = conn.CreateCommand() log.LogTrace "Category.findAllForView"
cmd.CommandText <- $"SELECT data FROM {Table.Category} WHERE {whereWebLogId}" let! cats = findByWebLog webLogId
addWebLogId cmd webLogId let ordered = Utils.orderByHierarchy (cats |> List.sortBy _.Name.ToLowerInvariant()) None None []
use! rdr = cmd.ExecuteReaderAsync()
let cats =
seq {
while rdr.Read() do
Map.fromDoc<Category> ser rdr
}
|> Seq.sortBy _.Name.ToLowerInvariant()
|> List.ofSeq
do! rdr.CloseAsync()
let ordered = Utils.orderByHierarchy cats None None []
let! counts = let! counts =
ordered ordered
|> Seq.map (fun it -> backgroundTask { |> Seq.map (fun it -> backgroundTask {
@ -77,17 +52,16 @@ type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer) =
|> Seq.map _.Id |> Seq.map _.Id
|> Seq.append (Seq.singleton it.Id) |> Seq.append (Seq.singleton it.Id)
|> List.ofSeq |> List.ofSeq
|> inClause "AND pc.category_id" "catId" id |> inJsonArray Table.Post (nameof Post.Empty.CategoryIds) "catId"
cmd.Parameters.Clear () use cmd = conn.CreateCommand()
cmd.CommandText <- $"
SELECT COUNT(DISTINCT data ->> '{nameof Post.Empty.Id}')
FROM {Table.Post}
WHERE {Query.whereByWebLog}
AND data ->> '{nameof Post.Empty.Status}' = '{string Published}'
AND {catSql}"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddRange catParams cmd.Parameters.AddRange catParams
cmd.CommandText <- $"
SELECT COUNT(DISTINCT p.id)
FROM post p
INNER JOIN post_category pc ON pc.post_id = p.id
WHERE p.web_log_id = @webLogId
AND p.status = 'Published'
{catSql}"
let! postCount = count cmd let! postCount = count cmd
return it.Id, postCount return it.Id, postCount
}) })
@ -96,55 +70,65 @@ type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer) =
ordered ordered
|> Seq.map (fun cat -> |> Seq.map (fun cat ->
{ cat with { cat with
PostCount = counts PostCount =
counts
|> Array.tryFind (fun c -> fst c = cat.Id) |> Array.tryFind (fun c -> fst c = cat.Id)
|> Option.map snd |> Option.map snd
|> Option.defaultValue 0 |> Option.defaultValue 0 })
})
|> Array.ofSeq |> Array.ofSeq
} }
/// Find a category by its ID for the given web log /// Find a category by its ID for the given web log
let findById (catId: CategoryId) webLogId = backgroundTask { let findById catId webLogId =
use cmd = conn.CreateCommand() log.LogTrace "Category.findById"
cmd.CommandText <- $"SELECT * FROM {Table.Category} WHERE {Query.whereById}" Document.findByIdAndWebLog<CategoryId, Category> conn ser Table.Category catId webLogId
cmd.Parameters.AddWithValue("@id", string catId) |> ignore
use! rdr = cmd.ExecuteReaderAsync()
return verifyWebLog<Category> webLogId (_.WebLogId) (Map.fromDoc ser) rdr
}
// TODO: stopped here
/// Find all categories for the given web log
let findByWebLog (webLogId: WebLogId) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM category WHERE web_log_id = @webLogId"
cmd.Parameters.AddWithValue ("@webLogId", string webLogId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toCategory rdr
}
/// Delete a category /// Delete a category
let delete catId webLogId = backgroundTask { let delete catId webLogId = backgroundTask {
log.LogTrace "Category.delete"
match! findById catId webLogId with match! findById catId webLogId with
| Some cat -> | Some cat ->
use cmd = conn.CreateCommand() use cmd = conn.CreateCommand()
// Reassign any children to the category's parent category // Reassign any children to the category's parent category
cmd.CommandText <- "SELECT COUNT(id) FROM category WHERE parent_id = @parentId" cmd.CommandText <- $"SELECT COUNT(*) FROM {Table.Category} WHERE data ->> '{parentIdField}' = @parentId"
cmd.Parameters.AddWithValue ("@parentId", string catId) |> ignore addParam cmd "@parentId" (string catId)
let! children = count cmd let! children = count cmd
if children > 0 then if children > 0 then
cmd.CommandText <- "UPDATE category SET parent_id = @newParentId WHERE parent_id = @parentId" cmd.CommandText <- $"
cmd.Parameters.AddWithValue ("@newParentId", maybe (cat.ParentId |> Option.map string)) UPDATE {Table.Category}
|> ignore SET data = json_set(data, '$.{parentIdField}', @newParentId)
WHERE data ->> '{parentIdField}' = @parentId"
addParam cmd "@newParentId" (maybe (cat.ParentId |> Option.map string))
do! write cmd do! write cmd
// Delete the category off all posts where it is assigned, and the category itself // Delete the category off all posts where it is assigned, and the category itself
cmd.CommandText <- let catIdField = Post.Empty.CategoryIds
"DELETE FROM post_category cmd.CommandText <- $"
WHERE category_id = @id SELECT data ->> '{Post.Empty.Id}' AS id, data -> '{catIdField}' AS cat_ids
AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId); FROM {Table.Post}
DELETE FROM category WHERE id = @id" WHERE {Query.whereByWebLog}
AND EXISTS
(SELECT 1 FROM json_each({Table.Post}.data -> '{catIdField}') WHERE json_each.value = @id)"
cmd.Parameters.Clear() cmd.Parameters.Clear()
let _ = cmd.Parameters.AddWithValue ("@id", string catId) addDocId cmd catId
addWebLogId cmd webLogId addWebLogId cmd webLogId
use! postRdr = cmd.ExecuteReaderAsync()
if postRdr.HasRows then
let postIdAndCats =
toList
(fun rdr ->
Map.getString "id" rdr, Utils.deserialize<string list> ser (Map.getString "cat_ids" rdr))
postRdr
do! postRdr.CloseAsync()
for postId, cats in postIdAndCats do
cmd.CommandText <- $"
UPDATE {Table.Post}
SET data = json_set(data, '$.{catIdField}', json(@catIds))
WHERE {Query.whereById}"
cmd.Parameters.Clear()
addDocId cmd postId
addParam cmd "@catIds" (cats |> List.filter (fun it -> it <> string catId) |> Utils.serialize ser)
do! write cmd do! write cmd
do! Document.delete conn Table.Category catId
return if children = 0 then CategoryDeleted else ReassignedChildCategories return if children = 0 then CategoryDeleted else ReassignedChildCategories
| None -> return CategoryNotFound | None -> return CategoryNotFound
} }
@ -156,17 +140,12 @@ type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer) =
} }
/// Update a category /// Update a category
let update cat = backgroundTask { let update (cat: Category) = backgroundTask {
use cmd = conn.CreateCommand() use cmd = conn.CreateCommand()
cmd.CommandText <- cmd.CommandText <- $"{Query.updateById} AND {Query.whereByWebLog}"
"UPDATE category addDocId cmd cat.Id
SET name = @name, addDocParam cmd cat ser
slug = @slug, addWebLogId cmd cat.WebLogId
description = @description,
parent_id = @parentId
WHERE id = @id
AND web_log_id = @webLogId"
addCategoryParameters cmd cat
do! write cmd do! write cmd
} }

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

@ -2,184 +2,99 @@ namespace MyWebLog.Data.SQLite
open System.Threading.Tasks open System.Threading.Tasks
open Microsoft.Data.Sqlite open Microsoft.Data.Sqlite
open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json open Newtonsoft.Json
/// SQLite myWebLog page data implementation /// SQLite myWebLog page data implementation
type SQLitePageData(conn: SqliteConnection, ser: JsonSerializer) = type SQLitePageData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) =
/// The JSON field for the permalink
let linkField = $"data ->> '{nameof Page.Empty.Permalink}'"
/// The JSON field for the "is in page list" flag
let pgListField = $"data ->> '{nameof Page.Empty.IsInPageList}'"
/// The JSON field for the title of the page
let titleField = $"data ->> '{nameof Page.Empty.Title}'"
// SUPPORT FUNCTIONS // SUPPORT FUNCTIONS
/// Add parameters for page INSERT or UPDATE statements /// Append revisions to a page
let addPageParameters (cmd: SqliteCommand) (page: Page) = let appendPageRevisions (page : Page) = backgroundTask {
[ cmd.Parameters.AddWithValue ("@id", string page.Id) log.LogTrace "Page.appendPageRevisions"
cmd.Parameters.AddWithValue ("@webLogId", string page.WebLogId) let! revisions = Revisions.findByEntityId conn Table.PageRevision Table.Page page.Id
cmd.Parameters.AddWithValue ("@authorId", string page.AuthorId) return { page with Revisions = revisions }
cmd.Parameters.AddWithValue ("@title", page.Title)
cmd.Parameters.AddWithValue ("@permalink", string page.Permalink)
cmd.Parameters.AddWithValue ("@publishedOn", instantParam page.PublishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", instantParam page.UpdatedOn)
cmd.Parameters.AddWithValue ("@isInPageList", page.IsInPageList)
cmd.Parameters.AddWithValue ("@template", maybe page.Template)
cmd.Parameters.AddWithValue ("@text", page.Text)
cmd.Parameters.AddWithValue ("@metaItems", maybe (if List.isEmpty page.Metadata then None
else Some (Utils.serialize ser page.Metadata)))
] |> ignore
/// Append revisions and permalinks to a page
let appendPageRevisionsAndPermalinks (page : Page) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@pageId", string 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 }
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 }
} }
/// Shorthand for mapping a data reader to a page /// Return a page with no text
let toPage = let withoutText (page: Page) =
Map.toPage ser { page with Text = "" }
/// Return a page with no text (or prior permalinks or revisions)
let pageWithoutText rdr =
{ toPage rdr with Text = "" }
/// Update a page's prior permalinks
let updatePagePermalinks (pageId: PageId) oldLinks newLinks = backgroundTask {
let toDelete, toAdd = Utils.diffPermalinks oldLinks newLinks
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@pageId", string pageId)
cmd.Parameters.Add ("@link", SqliteType.Text)
] |> ignore
let runCmd (link: Permalink) = backgroundTask {
cmd.Parameters["@link"].Value <- string link
do! write cmd
}
cmd.CommandText <- "DELETE FROM page_permalink WHERE page_id = @pageId AND permalink = @link"
toDelete
|> List.map runCmd
|> Task.WhenAll
|> ignore
cmd.CommandText <- "INSERT INTO page_permalink VALUES (@pageId, @link)"
toAdd
|> List.map runCmd
|> Task.WhenAll
|> ignore
}
/// Update a page's revisions /// Update a page's revisions
let updatePageRevisions (pageId: PageId) oldRevs newRevs = backgroundTask { let updatePageRevisions (pageId: PageId) oldRevs newRevs =
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs log.LogTrace "Page.updatePageRevisions"
if List.isEmpty toDelete && List.isEmpty toAdd then Revisions.update conn Table.PageRevision Table.Page pageId oldRevs newRevs
return ()
else
use cmd = conn.CreateCommand ()
let runCmd withText rev = backgroundTask {
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@pageId", string pageId)
cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf)
] |> ignore
if withText then cmd.Parameters.AddWithValue ("@text", string rev.Text) |> ignore
do! write cmd
}
cmd.CommandText <- "DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @asOf"
toDelete
|> List.map (runCmd false)
|> Task.WhenAll
|> ignore
cmd.CommandText <- "INSERT INTO page_revision VALUES (@pageId, @asOf, @text)"
toAdd
|> List.map (runCmd true)
|> Task.WhenAll
|> ignore
}
// IMPLEMENTATION FUNCTIONS // IMPLEMENTATION FUNCTIONS
/// Add a page /// Add a page
let add page = backgroundTask { let add page = backgroundTask {
use cmd = conn.CreateCommand () log.LogTrace "Page.add"
// The page itself do! Document.insert<Page> conn ser Table.Page { page with Revisions = [] }
cmd.CommandText <-
"INSERT INTO page (
id, web_log_id, author_id, title, permalink, published_on, updated_on, is_in_page_list, template,
page_text, meta_items
) VALUES (
@id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @isInPageList, @template,
@text, @metaItems
)"
addPageParameters cmd page
do! write cmd
do! updatePagePermalinks page.Id [] page.PriorPermalinks
do! updatePageRevisions page.Id [] page.Revisions do! updatePageRevisions page.Id [] page.Revisions
} }
/// Get all pages for a web log (without text, revisions, prior permalinks, or metadata) /// Get all pages for a web log (without text or revisions)
let all webLogId = backgroundTask { let all webLogId = backgroundTask {
log.LogTrace "Page.all"
use cmd = conn.CreateCommand() use cmd = conn.CreateCommand()
cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId ORDER BY LOWER(title)" cmd.CommandText <-
$"{Query.selectFromTable Table.Page} WHERE {Query.whereByWebLog} ORDER BY LOWER({titleField})"
addWebLogId cmd webLogId addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync () let! pages = cmdToList<Page> cmd ser
return toList pageWithoutText rdr return pages |> List.map withoutText
} }
/// Count all pages for the given web log /// Count all pages for the given web log
let countAll webLogId = backgroundTask { let countAll webLogId =
use cmd = conn.CreateCommand () log.LogTrace "Page.countAll"
cmd.CommandText <- "SELECT COUNT(id) FROM page WHERE web_log_id = @webLogId" Document.countByWebLog conn Table.Page webLogId
addWebLogId cmd webLogId
return! count cmd
}
/// Count all pages shown in the page list for the given web log /// Count all pages shown in the page list for the given web log
let countListed webLogId = backgroundTask { let countListed webLogId = backgroundTask {
log.LogTrace "Page.countListed"
use cmd = conn.CreateCommand() use cmd = conn.CreateCommand()
cmd.CommandText <- cmd.CommandText <- $"{Query.countByWebLog} AND {pgListField} = 'true'"
"SELECT COUNT(id)
FROM page
WHERE web_log_id = @webLogId
AND is_in_page_list = @isInPageList"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore
return! count cmd return! count cmd
} }
/// Find a page by its ID (without revisions and prior permalinks) /// Find a page by its ID (without revisions)
let findById (pageId: PageId) webLogId = backgroundTask { let findById pageId webLogId =
use cmd = conn.CreateCommand () log.LogTrace "Page.findById"
cmd.CommandText <- "SELECT * FROM page WHERE id = @id" Document.findByIdAndWebLog<PageId, Page> conn ser Table.Page pageId webLogId
cmd.Parameters.AddWithValue ("@id", string pageId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return verifyWebLog<Page> webLogId (_.WebLogId) (Map.toPage ser) rdr
}
/// Find a complete page by its ID /// Find a complete page by its ID
let findFullById pageId webLogId = backgroundTask { let findFullById pageId webLogId = backgroundTask {
log.LogTrace "Page.findFullById"
match! findById pageId webLogId with match! findById pageId webLogId with
| Some page -> | Some page ->
let! page = appendPageRevisionsAndPermalinks page let! page = appendPageRevisions page
return Some page return Some page
| None -> return None | None -> return None
} }
// TODO: need to handle when the page being deleted is the home page
/// Delete a page by its ID
let delete pageId webLogId = backgroundTask { let delete pageId webLogId = backgroundTask {
log.LogTrace "Page.delete"
match! findById pageId webLogId with match! findById pageId webLogId with
| Some _ -> | Some _ ->
use cmd = conn.CreateCommand() use cmd = conn.CreateCommand()
cmd.Parameters.AddWithValue ("@id", string pageId) |> ignore cmd.CommandText <- $"DELETE FROM {Table.PageRevision} WHERE page_id = @id; {Query.deleteById}"
cmd.CommandText <- addDocId cmd pageId
"DELETE FROM page_revision WHERE page_id = @id;
DELETE FROM page_permalink WHERE page_id = @id;
DELETE FROM page WHERE id = @id"
do! write cmd do! write cmd
return true return true
| None -> return false | None -> return false
@ -187,112 +102,98 @@ type SQLitePageData(conn: SqliteConnection, ser: JsonSerializer) =
/// Find a page by its permalink for the given web log /// Find a page by its permalink for the given web log
let findByPermalink (permalink: Permalink) webLogId = backgroundTask { let findByPermalink (permalink: Permalink) webLogId = backgroundTask {
log.LogTrace "Page.findByPermalink"
use cmd = conn.CreateCommand() use cmd = conn.CreateCommand()
cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId AND permalink = @link" cmd.CommandText <- $" {Query.selectFromTable Table.Page} WHERE {Query.whereByWebLog} AND {linkField} = @link"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@link", string permalink) |> ignore addParam cmd "@link" (string permalink)
use! rdr = cmd.ExecuteReaderAsync() use! rdr = cmd.ExecuteReaderAsync()
return if rdr.Read () then Some (toPage rdr) else None let! isFound = rdr.ReadAsync()
return if isFound then Some (Map.fromDoc<Page> ser rdr) else None
} }
/// Find the current permalink within a set of potential prior permalinks for the given web log /// Find the current permalink within a set of potential prior permalinks for the given web log
let findCurrentPermalink (permalinks: Permalink list) webLogId = backgroundTask { let findCurrentPermalink (permalinks: Permalink list) webLogId = backgroundTask {
log.LogTrace "Page.findCurrentPermalink"
let linkSql, linkParams = inJsonArray Table.Page (nameof Page.Empty.PriorPermalinks) "link" permalinks
use cmd = conn.CreateCommand() use cmd = conn.CreateCommand()
let linkSql, linkParams = inClause "AND pp.permalink" "link" string permalinks cmd.CommandText <-
cmd.CommandText <- $" $"SELECT {linkField} AS permalink FROM {Table.Page} WHERE {Query.whereByWebLog} AND {linkSql}"
SELECT p.permalink
FROM page p
INNER JOIN page_permalink pp ON pp.page_id = p.id
WHERE p.web_log_id = @webLogId
{linkSql}"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddRange linkParams cmd.Parameters.AddRange linkParams
use! rdr = cmd.ExecuteReaderAsync() use! rdr = cmd.ExecuteReaderAsync()
return if rdr.Read () then Some (Map.toPermalink rdr) else None let! isFound = rdr.ReadAsync()
return if isFound then Some (Map.toPermalink rdr) else None
} }
/// Get all complete pages for the given web log /// Get all complete pages for the given web log
let findFullByWebLog webLogId = backgroundTask { let findFullByWebLog webLogId = backgroundTask {
use cmd = conn.CreateCommand () log.LogTrace "Page.findFullByWebLog"
cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId" let! pages = Document.findByWebLog<Page> conn ser Table.Page webLogId
addWebLogId cmd webLogId let! withRevs =
use! rdr = cmd.ExecuteReaderAsync () pages
let! pages = |> List.map (fun page -> backgroundTask { return! appendPageRevisions page })
toList toPage rdr
|> List.map (fun page -> backgroundTask { return! appendPageRevisionsAndPermalinks page })
|> Task.WhenAll |> Task.WhenAll
return List.ofArray pages return List.ofArray withRevs
} }
/// Get all listed pages for the given web log (without revisions, prior permalinks, or text) /// Get all listed pages for the given web log (without revisions or text)
let findListed webLogId = backgroundTask { let findListed webLogId = backgroundTask {
log.LogTrace "Page.findListed"
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <- $"
"SELECT * {Query.selectFromTable Table.Page}
FROM page WHERE {Query.whereByWebLog}
WHERE web_log_id = @webLogId AND {pgListField} = 'true'
AND is_in_page_list = @isInPageList ORDER BY LOWER({titleField})"
ORDER BY LOWER(title)"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore let! pages = cmdToList<Page> cmd ser
use! rdr = cmd.ExecuteReaderAsync () return pages |> List.map withoutText
return toList pageWithoutText rdr
} }
/// Get a page of pages for the given web log (without revisions, prior permalinks, or metadata) /// Get a page of pages for the given web log (without revisions)
let findPageOfPages webLogId pageNbr = backgroundTask { let findPageOfPages webLogId pageNbr =
log.LogTrace "Page.findPageOfPages"
use cmd = conn.CreateCommand() use cmd = conn.CreateCommand()
cmd.CommandText <- cmd.CommandText <- $"
"SELECT * {Query.selectFromTable Table.Page} WHERE {Query.whereByWebLog}
FROM page ORDER BY LOWER({titleField})
WHERE web_log_id = @webLogId
ORDER BY LOWER(title)
LIMIT @pageSize OFFSET @toSkip" LIMIT @pageSize OFFSET @toSkip"
addWebLogId cmd webLogId addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@pageSize", 26) addParam cmd "@pageSize" 26
cmd.Parameters.AddWithValue ("@toSkip", (pageNbr - 1) * 25) addParam cmd "@toSkip" ((pageNbr - 1) * 25)
] |> ignore cmdToList<Page> cmd ser
use! rdr = cmd.ExecuteReaderAsync ()
return toList toPage rdr
}
/// Restore pages from a backup /// Restore pages from a backup
let restore pages = backgroundTask { let restore pages = backgroundTask {
log.LogTrace "Page.restore"
for page in pages do for page in pages do
do! add page do! add page
} }
/// Update a page /// Update a page
let update (page: Page) = backgroundTask { let update (page: Page) = backgroundTask {
log.LogTrace "Page.update"
match! findFullById page.Id page.WebLogId with match! findFullById page.Id page.WebLogId with
| Some oldPage -> | Some oldPage ->
use cmd = conn.CreateCommand () do! Document.update conn ser Table.Page page.Id { page with Revisions = [] }
cmd.CommandText <-
"UPDATE page
SET author_id = @authorId,
title = @title,
permalink = @permalink,
published_on = @publishedOn,
updated_on = @updatedOn,
is_in_page_list = @isInPageList,
template = @template,
page_text = @text,
meta_items = @metaItems
WHERE id = @id
AND web_log_id = @webLogId"
addPageParameters cmd page
do! write cmd
do! updatePagePermalinks page.Id oldPage.PriorPermalinks page.PriorPermalinks
do! updatePageRevisions page.Id oldPage.Revisions page.Revisions do! updatePageRevisions page.Id oldPage.Revisions page.Revisions
return () | None -> ()
| None -> return ()
} }
/// Update a page's prior permalinks /// Update a page's prior permalinks
let updatePriorPermalinks pageId webLogId permalinks = backgroundTask { let updatePriorPermalinks pageId webLogId (permalinks: Permalink list) = backgroundTask {
match! findFullById pageId webLogId with log.LogTrace "Page.updatePriorPermalinks"
| Some page -> match! findById pageId webLogId with
do! updatePagePermalinks pageId page.PriorPermalinks permalinks | Some _ ->
use cmd = conn.CreateCommand()
cmd.CommandText <- $"
UPDATE {Table.Page}
SET data = json_set(data, '$.{nameof Page.Empty.PriorPermalinks}', json(@links))
WHERE {Query.whereById}"
addDocId cmd pageId
addParam cmd "@links" (Utils.serialize ser permalinks)
do! write cmd
return true return true
| None -> return false | None -> return false
} }

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

@ -2,265 +2,105 @@ namespace MyWebLog.Data.SQLite
open System.Threading.Tasks open System.Threading.Tasks
open Microsoft.Data.Sqlite open Microsoft.Data.Sqlite
open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json open Newtonsoft.Json
open NodaTime open NodaTime
/// SQLite myWebLog post data implementation /// SQLite myWebLog post data implementation
type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) = type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) =
/// The JSON field for the post's permalink
let linkField = $"data ->> '{nameof Post.Empty.Permalink}'"
/// The JSON field for when the post was published
let publishField = $"data ->> '{nameof Post.Empty.PublishedOn}'"
/// The JSON field for post status
let statField = $"data ->> '{nameof Post.Empty.Status}'"
// SUPPORT FUNCTIONS // SUPPORT FUNCTIONS
/// Add parameters for post INSERT or UPDATE statements /// Append revisions to a post
let addPostParameters (cmd: SqliteCommand) (post: Post) = let appendPostRevisions (post: Post) = backgroundTask {
[ cmd.Parameters.AddWithValue ("@id", string post.Id) log.LogTrace "Post.appendPostRevisions"
cmd.Parameters.AddWithValue ("@webLogId", string post.WebLogId) let! revisions = Revisions.findByEntityId conn Table.PostRevision Table.Post post.Id
cmd.Parameters.AddWithValue ("@authorId", string post.AuthorId) return { post with Revisions = revisions }
cmd.Parameters.AddWithValue ("@status", string post.Status)
cmd.Parameters.AddWithValue ("@title", post.Title)
cmd.Parameters.AddWithValue ("@permalink", string post.Permalink)
cmd.Parameters.AddWithValue ("@publishedOn", maybeInstant post.PublishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", instantParam post.UpdatedOn)
cmd.Parameters.AddWithValue ("@template", maybe post.Template)
cmd.Parameters.AddWithValue ("@text", post.Text)
cmd.Parameters.AddWithValue ("@episode", maybe (if Option.isSome post.Episode then
Some (Utils.serialize ser post.Episode)
else None))
cmd.Parameters.AddWithValue ("@metaItems", maybe (if List.isEmpty post.Metadata then None
else Some (Utils.serialize ser post.Metadata)))
] |> ignore
/// Append category IDs and tags to a post
let appendPostCategoryAndTag (post: Post) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", string 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 }
do! rdr.CloseAsync ()
cmd.CommandText <- "SELECT tag FROM post_tag WHERE post_id = @id"
use! rdr = cmd.ExecuteReaderAsync ()
return { post with Tags = toList (Map.getString "tag") rdr }
} }
/// Append revisions and permalinks to a post /// The SELECT statement to retrieve posts with a web log ID parameter
let appendPostRevisionsAndPermalinks (post: Post) = backgroundTask { let postByWebLog = $"{Query.selectFromTable Table.Post} WHERE {Query.whereByWebLog}"
use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@postId", string post.Id) |> ignore
cmd.CommandText <- "SELECT permalink FROM post_permalink WHERE post_id = @postId" /// The SELECT statement to retrieve published posts with a web log ID parameter
use! rdr = cmd.ExecuteReaderAsync () let publishedPostByWebLog = $"{postByWebLog} AND {statField} = '{string Published}'"
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" /// Remove the text from a post
use! rdr = cmd.ExecuteReaderAsync () let withoutText (post: Post) =
return { post with Revisions = toList Map.toRevision rdr } { post with Text = "" }
}
/// The SELECT statement for a post that will include episode data, if it exists
let selectPost = "SELECT p.* FROM post p"
/// Shorthand for mapping a data reader to a post
let toPost =
Map.toPost ser
/// Find just-the-post by its ID for the given web log (excludes category, tag, meta, revisions, and permalinks)
let findPostById (postId: PostId) webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- $"{selectPost} WHERE p.id = @id"
cmd.Parameters.AddWithValue ("@id", string postId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return verifyWebLog<Post> webLogId (_.WebLogId) toPost rdr
}
/// Return a post with no revisions, prior permalinks, or text
let postWithoutText rdr =
{ toPost rdr with Text = "" }
/// Update a post's assigned categories
let updatePostCategories (postId: PostId) oldCats newCats = backgroundTask {
let toDelete, toAdd = Utils.diffLists<CategoryId, string> oldCats newCats string
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@postId", string postId)
cmd.Parameters.Add ("@categoryId", SqliteType.Text)
] |> ignore
let runCmd (catId: CategoryId) = backgroundTask {
cmd.Parameters["@categoryId"].Value <- string catId
do! write cmd
}
cmd.CommandText <- "DELETE FROM post_category WHERE post_id = @postId AND category_id = @categoryId"
toDelete
|> List.map runCmd
|> Task.WhenAll
|> ignore
cmd.CommandText <- "INSERT INTO post_category VALUES (@postId, @categoryId)"
toAdd
|> List.map runCmd
|> Task.WhenAll
|> ignore
}
/// Update a post's assigned categories
let updatePostTags (postId: PostId) (oldTags: string list) newTags = backgroundTask {
let toDelete, toAdd = Utils.diffLists oldTags newTags id
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@postId", string postId)
cmd.Parameters.Add ("@tag", SqliteType.Text)
] |> ignore
let runCmd (tag: string) = backgroundTask {
cmd.Parameters["@tag"].Value <- tag
do! write cmd
}
cmd.CommandText <- "DELETE FROM post_tag WHERE post_id = @postId AND tag = @tag"
toDelete
|> List.map runCmd
|> Task.WhenAll
|> ignore
cmd.CommandText <- "INSERT INTO post_tag VALUES (@postId, @tag)"
toAdd
|> List.map runCmd
|> Task.WhenAll
|> ignore
}
/// Update a post's prior permalinks
let updatePostPermalinks (postId: PostId) oldLinks newLinks = backgroundTask {
let toDelete, toAdd = Utils.diffPermalinks oldLinks newLinks
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@postId", string postId)
cmd.Parameters.Add ("@link", SqliteType.Text)
] |> ignore
let runCmd (link: Permalink) = backgroundTask {
cmd.Parameters["@link"].Value <- string link
do! write cmd
}
cmd.CommandText <- "DELETE FROM post_permalink WHERE post_id = @postId AND permalink = @link"
toDelete
|> List.map runCmd
|> Task.WhenAll
|> ignore
cmd.CommandText <- "INSERT INTO post_permalink VALUES (@postId, @link)"
toAdd
|> List.map runCmd
|> Task.WhenAll
|> ignore
}
/// Update a post's revisions /// Update a post's revisions
let updatePostRevisions (postId: PostId) oldRevs newRevs = backgroundTask { let updatePostRevisions (postId: PostId) oldRevs newRevs =
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs log.LogTrace "Post.updatePostRevisions"
if List.isEmpty toDelete && List.isEmpty toAdd then Revisions.update conn Table.PostRevision Table.Post postId oldRevs newRevs
return ()
else
use cmd = conn.CreateCommand ()
let runCmd withText rev = backgroundTask {
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@postId", string postId)
cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf)
] |> ignore
if withText then cmd.Parameters.AddWithValue ("@text", string rev.Text) |> ignore
do! write cmd
}
cmd.CommandText <- "DELETE FROM post_revision WHERE post_id = @postId AND as_of = @asOf"
toDelete
|> List.map (runCmd false)
|> Task.WhenAll
|> ignore
cmd.CommandText <- "INSERT INTO post_revision VALUES (@postId, @asOf, @text)"
toAdd
|> List.map (runCmd true)
|> Task.WhenAll
|> ignore
}
// IMPLEMENTATION FUNCTIONS // IMPLEMENTATION FUNCTIONS
/// Add a post /// Add a post
let add post = backgroundTask { let add (post: Post) = backgroundTask {
use cmd = conn.CreateCommand () log.LogTrace "Post.add"
cmd.CommandText <- do! Document.insert conn ser Table.Post { post with Revisions = [] }
"INSERT INTO post (
id, web_log_id, author_id, status, title, permalink, published_on, updated_on, template, post_text,
episode, meta_items
) VALUES (
@id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn, @template, @text,
@episode, @metaItems
)"
addPostParameters cmd post
do! write cmd
do! updatePostCategories post.Id [] post.CategoryIds
do! updatePostTags post.Id [] post.Tags
do! updatePostPermalinks post.Id [] post.PriorPermalinks
do! updatePostRevisions post.Id [] post.Revisions do! updatePostRevisions post.Id [] post.Revisions
} }
/// Count posts in a status for the given web log /// Count posts in a status for the given web log
let countByStatus (status: PostStatus) webLogId = backgroundTask { let countByStatus (status: PostStatus) webLogId = backgroundTask {
log.LogTrace "Post.countByStatus"
use cmd = conn.CreateCommand() use cmd = conn.CreateCommand()
cmd.CommandText <- "SELECT COUNT(id) FROM post WHERE web_log_id = @webLogId AND status = @status" cmd.CommandText <- $"{Query.countByWebLog Table.Post} AND {statField} = @status"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", string status) |> ignore addParam cmd "@status" (string status)
return! count cmd return! count cmd
} }
/// Find a post by its ID for the given web log (excluding revisions and prior permalinks /// Find a post by its ID for the given web log (excluding revisions and prior permalinks
let findById postId webLogId = backgroundTask { let findById postId webLogId =
match! findPostById postId webLogId with log.LogTrace "Post.findById"
| Some post -> Document.findByIdAndWebLog<PostId, Post> conn ser Table.Post postId webLogId
let! post = appendPostCategoryAndTag post
return Some post
| None -> return None
}
/// Find a post by its permalink for the given web log (excluding revisions and prior permalinks) /// Find a post by its permalink for the given web log (excluding revisions and prior permalinks)
let findByPermalink (permalink: Permalink) webLogId = backgroundTask { let findByPermalink (permalink: Permalink) webLogId = backgroundTask {
log.LogTrace "Post.findByPermalink"
use cmd = conn.CreateCommand() use cmd = conn.CreateCommand()
cmd.CommandText <- $"{selectPost} WHERE p.web_log_id = @webLogId AND p.permalink = @link" cmd.CommandText <- $"{Query.selectFromTable Table.Post} WHERE {Query.whereByWebLog} AND {linkField} = @link"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@link", string permalink) |> ignore addParam cmd "@link" (string permalink)
use! rdr = cmd.ExecuteReaderAsync() use! rdr = cmd.ExecuteReaderAsync()
if rdr.Read () then let! isFound = rdr.ReadAsync()
let! post = appendPostCategoryAndTag (toPost rdr) return if isFound then Some (Map.fromDoc<Post> ser rdr) else None
return Some post
else
return None
} }
/// Find a complete post by its ID for the given web log /// Find a complete post by its ID for the given web log
let findFullById postId webLogId = backgroundTask { let findFullById postId webLogId = backgroundTask {
log.LogTrace "Post.findFullById"
match! findById postId webLogId with match! findById postId webLogId with
| Some post -> | Some post ->
let! post = appendPostRevisionsAndPermalinks post let! post = appendPostRevisions post
return Some post return Some post
| None -> return None | None -> return None
} }
/// Delete a post by its ID for the given web log /// Delete a post by its ID for the given web log
let delete postId webLogId = backgroundTask { let delete postId webLogId = backgroundTask {
match! findFullById postId webLogId with log.LogTrace "Post.delete"
match! findById postId webLogId with
| Some _ -> | Some _ ->
use cmd = conn.CreateCommand() use cmd = conn.CreateCommand()
cmd.Parameters.AddWithValue ("@id", string postId) |> ignore cmd.CommandText <- $"
cmd.CommandText <- DELETE FROM {Table.PostRevision} WHERE post_id = @id;
"DELETE FROM post_revision WHERE post_id = @id; DELETE FROM {Table.PostComment} WHERE data ->> '{nameof Comment.Empty.PostId}' = @id;
DELETE FROM post_permalink WHERE post_id = @id; DELETE FROM {Table.Post} WHERE {Query.whereById}"
DELETE FROM post_tag WHERE post_id = @id; addDocId cmd postId
DELETE FROM post_category WHERE post_id = @id;
DELETE FROM post_comment WHERE post_id = @id;
DELETE FROM post WHERE id = @id"
do! write cmd do! write cmd
return true return true
| None -> return false | None -> return false
@ -268,161 +108,105 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
/// Find the current permalink from a list of potential prior permalinks for the given web log /// Find the current permalink from a list of potential prior permalinks for the given web log
let findCurrentPermalink (permalinks: Permalink list) webLogId = backgroundTask { let findCurrentPermalink (permalinks: Permalink list) webLogId = backgroundTask {
log.LogTrace "Post.findCurrentPermalink"
let linkSql, linkParams = inJsonArray Table.Post (nameof Post.Empty.PriorPermalinks) "link" permalinks
use cmd = conn.CreateCommand() use cmd = conn.CreateCommand()
let linkSql, linkParams = inClause "AND pp.permalink" "link" string permalinks cmd.CommandText <-
cmd.CommandText <- $" $"SELECT {linkField} AS permalink FROM {Table.Post} WHERE {Query.whereByWebLog} AND {linkSql}"
SELECT p.permalink
FROM post p
INNER JOIN post_permalink pp ON pp.post_id = p.id
WHERE p.web_log_id = @webLogId
{linkSql}"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddRange linkParams cmd.Parameters.AddRange linkParams
use! rdr = cmd.ExecuteReaderAsync() use! rdr = cmd.ExecuteReaderAsync()
return if rdr.Read () then Some (Map.toPermalink rdr) else None let! isFound = rdr.ReadAsync()
return if isFound then Some (Map.toPermalink rdr) else None
} }
/// Get all complete posts for the given web log /// Get all complete posts for the given web log
let findFullByWebLog webLogId = backgroundTask { let findFullByWebLog webLogId = backgroundTask {
use cmd = conn.CreateCommand () log.LogTrace "Post.findFullByWebLog"
cmd.CommandText <- $"{selectPost} WHERE p.web_log_id = @webLogId" let! posts = Document.findByWebLog<Post> conn ser Table.Post webLogId
addWebLogId cmd webLogId let! withRevs =
use! rdr = cmd.ExecuteReaderAsync () posts
let! posts = |> List.map (fun post -> backgroundTask { return! appendPostRevisions post })
toList toPost rdr
|> List.map (fun post -> backgroundTask {
let! post = appendPostCategoryAndTag post
return! appendPostRevisionsAndPermalinks post
})
|> Task.WhenAll |> Task.WhenAll
return List.ofArray posts return List.ofArray withRevs
} }
/// Get a page of categorized posts for the given web log (excludes revisions and prior permalinks) /// Get a page of categorized posts for the given web log (excludes revisions)
let findPageOfCategorizedPosts webLogId (categoryIds: CategoryId list) pageNbr postsPerPage = backgroundTask { let findPageOfCategorizedPosts webLogId (categoryIds: CategoryId list) pageNbr postsPerPage =
log.LogTrace "Post.findPageOfCategorizedPosts"
let catSql, catParams = inJsonArray Table.Post (nameof Post.Empty.CategoryIds) "catId" categoryIds
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
let catSql, catParams = inClause "AND pc.category_id" "catId" string categoryIds
cmd.CommandText <- $" cmd.CommandText <- $"
{selectPost} {publishedPostByWebLog} AND {catSql}
INNER JOIN post_category pc ON pc.post_id = p.id ORDER BY {publishField} DESC
WHERE p.web_log_id = @webLogId
AND p.status = @status
{catSql}
ORDER BY published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", string Published) |> ignore
cmd.Parameters.AddRange catParams cmd.Parameters.AddRange catParams
use! rdr = cmd.ExecuteReaderAsync () cmdToList<Post> cmd ser
let! posts =
toList toPost rdr
|> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post })
|> Task.WhenAll
return List.ofArray posts
}
/// Get a page of posts for the given web log (excludes text, revisions, and prior permalinks) /// Get a page of posts for the given web log (excludes revisions)
let findPageOfPosts webLogId pageNbr postsPerPage = backgroundTask { let findPageOfPosts webLogId pageNbr postsPerPage = backgroundTask {
log.LogTrace "Post.findPageOfPosts"
use cmd = conn.CreateCommand() use cmd = conn.CreateCommand()
cmd.CommandText <- $" cmd.CommandText <- $"
{selectPost} {postByWebLog}
WHERE p.web_log_id = @webLogId ORDER BY {publishField} DESC NULLS FIRST, data ->> '{nameof Post.Empty.UpdatedOn}'
ORDER BY p.published_on DESC NULLS FIRST, p.updated_on
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync () let! posts = cmdToList<Post> cmd ser
let! posts = return posts |> List.map withoutText
toList postWithoutText rdr
|> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post })
|> Task.WhenAll
return List.ofArray posts
} }
/// Get a page of published posts for the given web log (excludes revisions and prior permalinks) /// Get a page of published posts for the given web log (excludes revisions)
let findPageOfPublishedPosts webLogId pageNbr postsPerPage = backgroundTask { let findPageOfPublishedPosts webLogId pageNbr postsPerPage =
log.LogTrace "Post.findPageOfPublishedPosts"
use cmd = conn.CreateCommand() use cmd = conn.CreateCommand()
cmd.CommandText <- $" cmd.CommandText <- $"
{selectPost} {publishedPostByWebLog}
WHERE p.web_log_id = @webLogId ORDER BY {publishField} DESC
AND p.status = @status LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId
cmdToList<Post> cmd ser
/// Get a page of tagged posts for the given web log (excludes revisions)
let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage =
log.LogTrace "Post.findPageOfTaggedPosts"
let tagSql, tagParams = inJsonArray Table.Post (nameof Post.Empty.Tags) "tag" [ tag ]
use cmd = conn.CreateCommand()
cmd.CommandText <- $"
{publishedPostByWebLog} AND {tagSql}
ORDER BY p.published_on DESC ORDER BY p.published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", string Published) |> ignore cmd.Parameters.AddRange tagParams
use! rdr = cmd.ExecuteReaderAsync () cmdToList<Post> cmd ser
let! posts =
toList toPost rdr
|> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post })
|> Task.WhenAll
return List.ofArray posts
}
/// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks)
let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- $"
{selectPost}
INNER JOIN post_tag pt ON pt.post_id = p.id
WHERE p.web_log_id = @webLogId
AND p.status = @status
AND pt.tag = @tag
ORDER BY p.published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@status", string Published)
cmd.Parameters.AddWithValue ("@tag", tag)
] |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
let! posts =
toList toPost rdr
|> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post })
|> Task.WhenAll
return List.ofArray posts
}
/// Find the next newest and oldest post from a publish date for the given web log /// Find the next newest and oldest post from a publish date for the given web log
let findSurroundingPosts webLogId (publishedOn : Instant) = backgroundTask { let findSurroundingPosts webLogId (publishedOn : Instant) = backgroundTask {
log.LogTrace "Post.findSurroundingPosts"
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- $"
{selectPost}
WHERE p.web_log_id = @webLogId
AND p.status = @status
AND p.published_on < @publishedOn
ORDER BY p.published_on DESC
LIMIT 1"
addWebLogId cmd webLogId addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@status", string Published) addParam cmd "@publishedOn" (instantParam publishedOn)
cmd.Parameters.AddWithValue ("@publishedOn", instantParam publishedOn)
] |> ignore cmd.CommandText <-
$"{publishedPostByWebLog} AND {publishField} < @publishedOn ORDER BY {publishField} DESC LIMIT 1"
use! rdr = cmd.ExecuteReaderAsync() use! rdr = cmd.ExecuteReaderAsync()
let! older = backgroundTask { let! isFound = rdr.ReadAsync()
if rdr.Read () then let older = if isFound then Some (Map.fromDoc<Post> ser rdr) else None
let! post = appendPostCategoryAndTag (postWithoutText rdr)
return Some post
else
return None
}
do! rdr.CloseAsync () do! rdr.CloseAsync ()
cmd.CommandText <- $"
{selectPost} cmd.CommandText <-
WHERE p.web_log_id = @webLogId $"{publishedPostByWebLog} AND {publishField} > @publishedOn ORDER BY {publishField} LIMIT 1"
AND p.status = @status
AND p.published_on > @publishedOn
ORDER BY p.published_on
LIMIT 1"
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
let! newer = backgroundTask { let! isFound = rdr.ReadAsync()
if rdr.Read () then let newer = if isFound then Some (Map.fromDoc<Post> ser rdr) else None
let! post = appendPostCategoryAndTag (postWithoutText rdr)
return Some post
else
return None
}
return older, newer return older, newer
} }
/// Restore posts from a backup /// Restore posts from a backup
let restore posts = backgroundTask { let restore posts = backgroundTask {
log.LogTrace "Post.restore"
for post in posts do for post in posts do
do! add post do! add post
} }
@ -431,35 +215,23 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
let update (post: Post) = backgroundTask { let update (post: Post) = backgroundTask {
match! findFullById post.Id post.WebLogId with match! findFullById post.Id post.WebLogId with
| Some oldPost -> | Some oldPost ->
use cmd = conn.CreateCommand () do! Document.update conn ser Table.Post post.Id { post with Revisions = [] }
cmd.CommandText <-
"UPDATE post
SET author_id = @authorId,
status = @status,
title = @title,
permalink = @permalink,
published_on = @publishedOn,
updated_on = @updatedOn,
template = @template,
post_text = @text,
episode = @episode,
meta_items = @metaItems
WHERE id = @id
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! updatePostPermalinks post.Id oldPost.PriorPermalinks post.PriorPermalinks
do! updatePostRevisions post.Id oldPost.Revisions post.Revisions do! updatePostRevisions post.Id oldPost.Revisions post.Revisions
| None -> return () | None -> return ()
} }
/// Update prior permalinks for a post /// Update prior permalinks for a post
let updatePriorPermalinks postId webLogId permalinks = backgroundTask { let updatePriorPermalinks postId webLogId (permalinks: Permalink list) = backgroundTask {
match! findFullById postId webLogId with match! findById postId webLogId with
| Some post -> | Some _ ->
do! updatePostPermalinks postId post.PriorPermalinks permalinks use cmd = conn.CreateCommand()
cmd.CommandText <- $"
UPDATE {Table.Post}
SET data = json_set(data, '$.{nameof Post.Empty.PriorPermalinks}', json(@links))
WHERE {Query.whereById}"
addDocId cmd postId
addParam cmd "@links" (Utils.serialize ser permalinks)
do! write cmd
return true return true
| None -> return false | None -> return false
} }

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

@ -1,95 +1,70 @@
namespace MyWebLog.Data.SQLite namespace MyWebLog.Data.SQLite
open Microsoft.Data.Sqlite open Microsoft.Data.Sqlite
open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json
/// SQLite myWebLog tag mapping data implementation /// SQLite myWebLog tag mapping data implementation
type SQLiteTagMapData (conn : SqliteConnection) = type SQLiteTagMapData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) =
/// Find a tag mapping by its ID for the given web log /// Find a tag mapping by its ID for the given web log
let findById (tagMapId: TagMapId) webLogId = backgroundTask { let findById tagMapId webLogId =
use cmd = conn.CreateCommand() log.LogTrace "TagMap.findById"
cmd.CommandText <- "SELECT * FROM tag_map WHERE id = @id" Document.findByIdAndWebLog<TagMapId, TagMap> conn ser Table.TagMap tagMapId webLogId
cmd.Parameters.AddWithValue ("@id", string tagMapId) |> ignore
use! rdr = cmd.ExecuteReaderAsync()
return verifyWebLog<TagMap> webLogId (_.WebLogId) Map.toTagMap rdr
}
/// Delete a tag mapping for the given web log /// Delete a tag mapping for the given web log
let delete tagMapId webLogId = backgroundTask { let delete tagMapId webLogId = backgroundTask {
log.LogTrace "TagMap.delete"
match! findById tagMapId webLogId with match! findById tagMapId webLogId with
| Some _ -> | Some _ ->
use cmd = conn.CreateCommand () do! Document.delete conn Table.TagMap tagMapId
cmd.CommandText <- "DELETE FROM tag_map WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", string tagMapId) |> ignore
do! write cmd
return true return true
| None -> return false | None -> return false
} }
/// Find a tag mapping by its URL value for the given web log /// Find a tag mapping by its URL value for the given web log
let findByUrlValue (urlValue: string) webLogId = backgroundTask { let findByUrlValue (urlValue: string) webLogId = backgroundTask {
log.LogTrace "TagMap.findByUrlValue"
use cmd = conn.CreateCommand() use cmd = conn.CreateCommand()
cmd.CommandText <- "SELECT * FROM tag_map WHERE web_log_id = @webLogId AND url_value = @urlValue" cmd.CommandText <- $"
{Query.selectFromTable Table.TagMap}
WHERE {Query.whereByWebLog}
AND data ->> '{nameof TagMap.Empty.UrlValue}' = @urlValue"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@urlValue", urlValue) |> ignore addParam cmd "@urlValue" urlValue
use! rdr = cmd.ExecuteReaderAsync() use! rdr = cmd.ExecuteReaderAsync()
return if rdr.Read () then Some (Map.toTagMap rdr) else None let! isFound = rdr.ReadAsync()
return if isFound then Some (Map.fromDoc<TagMap> ser rdr) else None
} }
/// Get all tag mappings for the given web log /// Get all tag mappings for the given web log
let findByWebLog webLogId = backgroundTask { let findByWebLog webLogId =
use cmd = conn.CreateCommand () log.LogTrace "TagMap.findByWebLog"
cmd.CommandText <- "SELECT * FROM tag_map WHERE web_log_id = @webLogId ORDER BY tag" Document.findByWebLog<TagMap> conn ser Table.TagMap webLogId
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toTagMap rdr
}
/// Find any tag mappings in a list of tags for the given web log /// Find any tag mappings in a list of tags for the given web log
let findMappingForTags (tags : string list) webLogId = backgroundTask { let findMappingForTags (tags: string list) webLogId =
log.LogTrace "TagMap.findMappingForTags"
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
let mapSql, mapParams = inClause "AND tag" "tag" id tags let mapSql, mapParams = inClause $"AND data ->> '{nameof TagMap.Empty.Tag}'" "tag" id tags
cmd.CommandText <- $" cmd.CommandText <- $"{Query.selectFromTable Table.TagMap} WHERE {Query.whereByWebLog} {mapSql}"
SELECT *
FROM tag_map
WHERE web_log_id = @webLogId
{mapSql}"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddRange mapParams cmd.Parameters.AddRange mapParams
use! rdr = cmd.ExecuteReaderAsync () cmdToList<TagMap> cmd ser
return toList Map.toTagMap rdr
}
/// Save a tag mapping /// Save a tag mapping
let save (tagMap: TagMap) = backgroundTask { let save (tagMap: TagMap) = backgroundTask {
use cmd = conn.CreateCommand () log.LogTrace "TagMap.save"
match! findById tagMap.Id tagMap.WebLogId with match! findById tagMap.Id tagMap.WebLogId with
| Some _ -> | Some _ -> do! Document.update conn ser Table.TagMap tagMap.Id tagMap
cmd.CommandText <- | None -> do! Document.insert conn ser Table.TagMap tagMap
"UPDATE tag_map
SET tag = @tag,
url_value = @urlValue
WHERE id = @id
AND web_log_id = @webLogId"
| None ->
cmd.CommandText <-
"INSERT INTO tag_map (
id, web_log_id, tag, url_value
) VALUES (
@id, @webLogId, @tag, @urlValue
)"
addWebLogId cmd tagMap.WebLogId
[ cmd.Parameters.AddWithValue ("@id", string tagMap.Id)
cmd.Parameters.AddWithValue ("@tag", tagMap.Tag)
cmd.Parameters.AddWithValue ("@urlValue", tagMap.UrlValue)
] |> ignore
do! write cmd
} }
/// Restore tag mappings from a backup /// Restore tag mappings from a backup
let restore tagMaps = backgroundTask { let restore tagMaps = backgroundTask {
log.LogTrace "TagMap.restore"
for tagMap in tagMaps do for tagMap in tagMaps do
do! save tagMap do! save tagMap
} }

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

@ -29,7 +29,7 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
let jsonTable table = let jsonTable table =
$"CREATE TABLE {table} (data TEXT NOT NULL); $"CREATE TABLE {table} (data TEXT NOT NULL);
CREATE UNIQUE INDEX idx_{table}_key ON {table} (data ->> 'Id')" CREATE UNIQUE INDEX idx_{table}_key ON {table} ((data ->> 'Id'))"
seq { seq {
// Theme tables // Theme tables
@ -48,18 +48,20 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
// Category table // Category table
if needsTable Table.Category then if needsTable Table.Category then
$"{jsonTable Table.Category}; $"{jsonTable Table.Category};
CREATE INDEX idx_{Table.Category}_web_log ON {Table.Category} (data ->> 'WebLogId')" CREATE INDEX idx_{Table.Category}_web_log ON {Table.Category} ((data ->> 'WebLogId'))"
// Web log user table // Web log user table
if needsTable Table.WebLogUser then if needsTable Table.WebLogUser then
$"{jsonTable Table.WebLogUser}; $"{jsonTable Table.WebLogUser};
CREATE INDEX idx_{Table.WebLogUser}_email ON {Table.WebLogUser} (data ->> 'WebLogId', data ->> 'Email')" CREATE INDEX idx_{Table.WebLogUser}_email
ON {Table.WebLogUser} ((data ->> 'WebLogId'), (data ->> 'Email'))"
// Page tables // Page tables
if needsTable Table.Page then if needsTable Table.Page then
$"{jsonTable Table.Page}; $"{jsonTable Table.Page};
CREATE INDEX idx_{Table.Page}_author ON {Table.Page} (data ->> 'AuthorId'); CREATE INDEX idx_{Table.Page}_author ON {Table.Page} ((data ->> 'AuthorId'));
CREATE INDEX idx_{Table.Page}_permalink ON {Table.Page} (data ->> 'WebLogId', data ->> 'Permalink')" CREATE INDEX idx_{Table.Page}_permalink
ON {Table.Page} ((data ->> 'WebLogId'), (data ->> 'Permalink'))"
if needsTable Table.PageRevision then if needsTable Table.PageRevision then
"CREATE TABLE page_revision ( "CREATE TABLE page_revision (
page_id TEXT NOT NULL, page_id TEXT NOT NULL,
@ -70,9 +72,11 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
// Post tables // Post tables
if needsTable Table.Post then if needsTable Table.Post then
$"{jsonTable Table.Post}; $"{jsonTable Table.Post};
CREATE INDEX idx_{Table.Post}_author ON {Table.Post} (data ->> 'AuthorId'); CREATE INDEX idx_{Table.Post}_author ON {Table.Post} ((data ->> 'AuthorId'));
CREATE INDEX idx_{Table.Post}_status ON {Table.Post} (data ->> 'WebLogId', data ->> 'Status', data ->> 'UpdatedOn'); CREATE INDEX idx_{Table.Post}_status
CREATE INDEX idx_{Table.Post}_permalink ON {Table.Post} (data ->> 'WebLogId', data ->> 'Permalink')" ON {Table.Post} ((data ->> 'WebLogId'), (data ->> 'Status'), (data ->> 'UpdatedOn'));
CREATE INDEX idx_{Table.Post}_permalink
ON {Table.Post} ((data ->> 'WebLogId'), (data ->> 'Permalink'))"
// TODO: index categories by post? // TODO: index categories by post?
if needsTable Table.PostRevision then if needsTable Table.PostRevision then
$"CREATE TABLE {Table.PostRevision} ( $"CREATE TABLE {Table.PostRevision} (
@ -82,12 +86,12 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
PRIMARY KEY (post_id, as_of))" PRIMARY KEY (post_id, as_of))"
if needsTable Table.PostComment then if needsTable Table.PostComment then
$"{jsonTable Table.PostComment}; $"{jsonTable Table.PostComment};
CREATE INDEX idx_{Table.PostComment}_post ON {Table.PostComment} (data ->> 'PostId')" CREATE INDEX idx_{Table.PostComment}_post ON {Table.PostComment} ((data ->> 'PostId'))"
// Tag map table // Tag map table
if needsTable Table.TagMap then if needsTable Table.TagMap then
$"{jsonTable Table.TagMap}; $"{jsonTable Table.TagMap};
CREATE INDEX idx_{Table.TagMap}_tag ON {Table.TagMap} (data ->> 'WebLogId', data ->> 'UrlValue')"; CREATE INDEX idx_{Table.TagMap}_tag ON {Table.TagMap} ((data ->> 'WebLogId'), (data ->> 'UrlValue'))"
// Uploaded file table // Uploaded file table
if needsTable Table.Upload then if needsTable Table.Upload then
@ -466,10 +470,10 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
interface IData with interface IData with
member _.Category = SQLiteCategoryData (conn, ser) member _.Category = SQLiteCategoryData (conn, ser, log)
member _.Page = SQLitePageData (conn, ser) member _.Page = SQLitePageData (conn, ser, log)
member _.Post = SQLitePostData (conn, ser) member _.Post = SQLitePostData (conn, ser, log)
member _.TagMap = SQLiteTagMapData conn member _.TagMap = SQLiteTagMapData (conn, ser, log)
member _.Theme = SQLiteThemeData conn member _.Theme = SQLiteThemeData conn
member _.ThemeAsset = SQLiteThemeAssetData conn member _.ThemeAsset = SQLiteThemeAssetData conn
member _.Upload = SQLiteUploadData conn member _.Upload = SQLiteUploadData conn
@ -484,5 +488,6 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
use cmd = conn.CreateCommand() use cmd = conn.CreateCommand()
cmd.CommandText <- $"SELECT id FROM {Table.DbVersion}" cmd.CommandText <- $"SELECT id FROM {Table.DbVersion}"
use! rdr = cmd.ExecuteReaderAsync() use! rdr = cmd.ExecuteReaderAsync()
do! migrate (if rdr.Read () then Some (Map.getString "id" rdr) else None) let! isFound = rdr.ReadAsync()
do! migrate (if isFound then Some (Map.getString "id" rdr) else None)
} }