Version 2.1 #41

Merged
danieljsummers merged 123 commits from version-2.1 into main 2024-03-27 00:13:28 +00:00
6 changed files with 585 additions and 833 deletions
Showing only changes of commit 2062840a5e - Show all commits

View File

@ -108,6 +108,23 @@ let maybeDuration =
let maybeInstant =
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
let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items: 'T list) =
if List.isEmpty items then "", []
@ -209,16 +226,6 @@ module Map =
/// 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 : 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 ser rdr : CustomFeed =
{ Id = getString "id" rdr |> CustomFeedId
@ -230,48 +237,10 @@ module Map =
/// Create a permalink from the current row in the given data reader
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
let toRevision rdr : Revision =
{ 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
let toTagMap rdr : TagMap =
@ -301,8 +270,7 @@ module Map =
[||]
{ Id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr)
UpdatedOn = getInstant "updated_on" rdr
Data = assetData
}
Data = assetData }
/// Create a theme template from the current row in the given data reader
let toThemeTemplate includeText rdr : ThemeTemplate =
@ -324,8 +292,7 @@ module Map =
WebLogId = getString "web_log_id" rdr |> WebLogId
Path = getString "path" rdr |> Permalink
UpdatedOn = getInstant "updated_on" rdr
Data = data
}
Data = data }
/// Create a web log from the current row in the given data reader
let toWebLog ser rdr : WebLog =
@ -375,17 +342,170 @@ module Map =
let fromDoc<'T> ser rdr : 'T =
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
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 =
"data ->> 'Id' = @id"
/// Fragment to add a web log ID condition to a WHERE clause
let whereWebLogId =
/// Fragment to add a web log ID condition to a WHERE clause (parameter @webLogId)
let whereByWebLog =
"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
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
}

View File

@ -2,71 +2,46 @@ namespace MyWebLog.Data.SQLite
open System.Threading.Tasks
open Microsoft.Data.Sqlite
open Microsoft.Extensions.Logging
open MyWebLog
open MyWebLog.Data
open Newtonsoft.Json
/// 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
let addCategoryParameters (cmd: SqliteCommand) (cat: Category) =
[ 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
/// The name of the parent ID field
let parentIdField = nameof Category.Empty.ParentId
/// Add a category
let add cat = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"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 ()
()
}
let add (cat: Category) =
log.LogTrace "Category.add"
Document.insert conn ser Table.Category cat
/// Count all categories for the given web log
let countAll webLogId = backgroundTask {
use cmd = conn.CreateCommand()
cmd.CommandText <- $"SELECT COUNT(*) FROM {Table.Category} WHERE {whereWebLogId}"
addWebLogId cmd webLogId
return! count cmd
}
let countAll webLogId =
log.LogTrace "Category.countAll"
Document.countByWebLog conn Table.Category webLogId
/// Count all top-level categories for the given web log
let countTopLevel webLogId = backgroundTask {
log.LogTrace "Category.countTopLevel"
use cmd = conn.CreateCommand()
cmd.CommandText <-
$"SELECT COUNT(*) FROM {Table.Category}
WHERE {whereWebLogId} AND data ->> '{nameof Category.Empty.ParentId}' IS NULL"
cmd.CommandText <- $"{Query.countByWebLog} AND data ->> '{parentIdField}' IS NULL"
addWebLogId cmd webLogId
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
let findAllForView webLogId = backgroundTask {
use cmd = conn.CreateCommand()
cmd.CommandText <- $"SELECT data FROM {Table.Category} WHERE {whereWebLogId}"
addWebLogId cmd webLogId
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 []
log.LogTrace "Category.findAllForView"
let! cats = findByWebLog webLogId
let ordered = Utils.orderByHierarchy (cats |> List.sortBy _.Name.ToLowerInvariant()) None None []
let! counts =
ordered
|> Seq.map (fun it -> backgroundTask {
@ -77,17 +52,16 @@ type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer) =
|> Seq.map _.Id
|> Seq.append (Seq.singleton it.Id)
|> List.ofSeq
|> inClause "AND pc.category_id" "catId" id
cmd.Parameters.Clear ()
|> inJsonArray Table.Post (nameof Post.Empty.CategoryIds) "catId"
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
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
return it.Id, postCount
})
@ -96,55 +70,65 @@ type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer) =
ordered
|> Seq.map (fun cat ->
{ cat with
PostCount = counts
PostCount =
counts
|> Array.tryFind (fun c -> fst c = cat.Id)
|> Option.map snd
|> Option.defaultValue 0
})
|> Option.defaultValue 0 })
|> Array.ofSeq
}
/// Find a category by its ID for the given web log
let findById (catId: CategoryId) webLogId = backgroundTask {
use cmd = conn.CreateCommand()
cmd.CommandText <- $"SELECT * FROM {Table.Category} WHERE {Query.whereById}"
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
}
let findById catId webLogId =
log.LogTrace "Category.findById"
Document.findByIdAndWebLog<CategoryId, Category> conn ser Table.Category catId webLogId
/// Delete a category
let delete catId webLogId = backgroundTask {
log.LogTrace "Category.delete"
match! findById catId webLogId with
| Some cat ->
use cmd = conn.CreateCommand()
// Reassign any children to the category's parent category
cmd.CommandText <- "SELECT COUNT(id) FROM category WHERE parent_id = @parentId"
cmd.Parameters.AddWithValue ("@parentId", string catId) |> ignore
cmd.CommandText <- $"SELECT COUNT(*) FROM {Table.Category} WHERE data ->> '{parentIdField}' = @parentId"
addParam cmd "@parentId" (string catId)
let! children = count cmd
if children > 0 then
cmd.CommandText <- "UPDATE category SET parent_id = @newParentId WHERE parent_id = @parentId"
cmd.Parameters.AddWithValue ("@newParentId", maybe (cat.ParentId |> Option.map string))
|> ignore
cmd.CommandText <- $"
UPDATE {Table.Category}
SET data = json_set(data, '$.{parentIdField}', @newParentId)
WHERE data ->> '{parentIdField}' = @parentId"
addParam cmd "@newParentId" (maybe (cat.ParentId |> Option.map string))
do! write cmd
// Delete the category off all posts where it is assigned, and the category itself
cmd.CommandText <-
"DELETE FROM post_category
WHERE category_id = @id
AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId);
DELETE FROM category WHERE id = @id"
let catIdField = Post.Empty.CategoryIds
cmd.CommandText <- $"
SELECT data ->> '{Post.Empty.Id}' AS id, data -> '{catIdField}' AS cat_ids
FROM {Table.Post}
WHERE {Query.whereByWebLog}
AND EXISTS
(SELECT 1 FROM json_each({Table.Post}.data -> '{catIdField}') WHERE json_each.value = @id)"
cmd.Parameters.Clear()
let _ = cmd.Parameters.AddWithValue ("@id", string catId)
addDocId cmd catId
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! Document.delete conn Table.Category catId
return if children = 0 then CategoryDeleted else ReassignedChildCategories
| None -> return CategoryNotFound
}
@ -156,17 +140,12 @@ type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer) =
}
/// Update a category
let update cat = backgroundTask {
let update (cat: Category) = backgroundTask {
use cmd = conn.CreateCommand()
cmd.CommandText <-
"UPDATE category
SET name = @name,
slug = @slug,
description = @description,
parent_id = @parentId
WHERE id = @id
AND web_log_id = @webLogId"
addCategoryParameters cmd cat
cmd.CommandText <- $"{Query.updateById} AND {Query.whereByWebLog}"
addDocId cmd cat.Id
addDocParam cmd cat ser
addWebLogId cmd cat.WebLogId
do! write cmd
}

View File

@ -2,184 +2,99 @@ namespace MyWebLog.Data.SQLite
open System.Threading.Tasks
open Microsoft.Data.Sqlite
open Microsoft.Extensions.Logging
open MyWebLog
open MyWebLog.Data
open Newtonsoft.Json
/// 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
/// Add parameters for page INSERT or UPDATE statements
let addPageParameters (cmd: SqliteCommand) (page: Page) =
[ cmd.Parameters.AddWithValue ("@id", string page.Id)
cmd.Parameters.AddWithValue ("@webLogId", string page.WebLogId)
cmd.Parameters.AddWithValue ("@authorId", string page.AuthorId)
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 }
/// Append revisions to a page
let appendPageRevisions (page : Page) = backgroundTask {
log.LogTrace "Page.appendPageRevisions"
let! revisions = Revisions.findByEntityId conn Table.PageRevision Table.Page page.Id
return { page with Revisions = revisions }
}
/// Shorthand for mapping a data reader to a page
let toPage =
Map.toPage ser
/// 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
}
/// Return a page with no text
let withoutText (page: Page) =
{ page with Text = "" }
/// Update a page's revisions
let updatePageRevisions (pageId: PageId) oldRevs newRevs = backgroundTask {
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
if List.isEmpty toDelete && List.isEmpty toAdd then
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
}
let updatePageRevisions (pageId: PageId) oldRevs newRevs =
log.LogTrace "Page.updatePageRevisions"
Revisions.update conn Table.PageRevision Table.Page pageId oldRevs newRevs
// IMPLEMENTATION FUNCTIONS
/// Add a page
let add page = backgroundTask {
use cmd = conn.CreateCommand ()
// The page itself
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
log.LogTrace "Page.add"
do! Document.insert<Page> conn ser Table.Page { page with 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 {
log.LogTrace "Page.all"
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
use! rdr = cmd.ExecuteReaderAsync ()
return toList pageWithoutText rdr
let! pages = cmdToList<Page> cmd ser
return pages |> List.map withoutText
}
/// Count all pages for the given web log
let countAll webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT COUNT(id) FROM page WHERE web_log_id = @webLogId"
addWebLogId cmd webLogId
return! count cmd
}
let countAll webLogId =
log.LogTrace "Page.countAll"
Document.countByWebLog conn Table.Page webLogId
/// Count all pages shown in the page list for the given web log
let countListed webLogId = backgroundTask {
log.LogTrace "Page.countListed"
use cmd = conn.CreateCommand()
cmd.CommandText <-
"SELECT COUNT(id)
FROM page
WHERE web_log_id = @webLogId
AND is_in_page_list = @isInPageList"
cmd.CommandText <- $"{Query.countByWebLog} AND {pgListField} = 'true'"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore
return! count cmd
}
/// Find a page by its ID (without revisions and prior permalinks)
let findById (pageId: PageId) webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM page WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", string pageId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return verifyWebLog<Page> webLogId (_.WebLogId) (Map.toPage ser) rdr
}
/// Find a page by its ID (without revisions)
let findById pageId webLogId =
log.LogTrace "Page.findById"
Document.findByIdAndWebLog<PageId, Page> conn ser Table.Page pageId webLogId
/// Find a complete page by its ID
let findFullById pageId webLogId = backgroundTask {
log.LogTrace "Page.findFullById"
match! findById pageId webLogId with
| Some page ->
let! page = appendPageRevisionsAndPermalinks page
let! page = appendPageRevisions page
return Some page
| 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 {
log.LogTrace "Page.delete"
match! findById pageId webLogId with
| Some _ ->
use cmd = conn.CreateCommand()
cmd.Parameters.AddWithValue ("@id", string pageId) |> ignore
cmd.CommandText <-
"DELETE FROM page_revision WHERE page_id = @id;
DELETE FROM page_permalink WHERE page_id = @id;
DELETE FROM page WHERE id = @id"
cmd.CommandText <- $"DELETE FROM {Table.PageRevision} WHERE page_id = @id; {Query.deleteById}"
addDocId cmd pageId
do! write cmd
return true
| None -> return false
@ -187,112 +102,98 @@ type SQLitePageData(conn: SqliteConnection, ser: JsonSerializer) =
/// Find a page by its permalink for the given web log
let findByPermalink (permalink: Permalink) webLogId = backgroundTask {
log.LogTrace "Page.findByPermalink"
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
cmd.Parameters.AddWithValue ("@link", string permalink) |> ignore
addParam cmd "@link" (string permalink)
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
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()
let linkSql, linkParams = inClause "AND pp.permalink" "link" string permalinks
cmd.CommandText <- $"
SELECT p.permalink
FROM page p
INNER JOIN page_permalink pp ON pp.page_id = p.id
WHERE p.web_log_id = @webLogId
{linkSql}"
cmd.CommandText <-
$"SELECT {linkField} AS permalink FROM {Table.Page} WHERE {Query.whereByWebLog} AND {linkSql}"
addWebLogId cmd webLogId
cmd.Parameters.AddRange linkParams
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
let findFullByWebLog webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId"
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync ()
let! pages =
toList toPage rdr
|> List.map (fun page -> backgroundTask { return! appendPageRevisionsAndPermalinks page })
log.LogTrace "Page.findFullByWebLog"
let! pages = Document.findByWebLog<Page> conn ser Table.Page webLogId
let! withRevs =
pages
|> List.map (fun page -> backgroundTask { return! appendPageRevisions page })
|> 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 {
log.LogTrace "Page.findListed"
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"SELECT *
FROM page
WHERE web_log_id = @webLogId
AND is_in_page_list = @isInPageList
ORDER BY LOWER(title)"
cmd.CommandText <- $"
{Query.selectFromTable Table.Page}
WHERE {Query.whereByWebLog}
AND {pgListField} = 'true'
ORDER BY LOWER({titleField})"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return toList pageWithoutText rdr
let! pages = cmdToList<Page> cmd ser
return pages |> List.map withoutText
}
/// Get a page of pages for the given web log (without revisions, prior permalinks, or metadata)
let findPageOfPages webLogId pageNbr = backgroundTask {
/// Get a page of pages for the given web log (without revisions)
let findPageOfPages webLogId pageNbr =
log.LogTrace "Page.findPageOfPages"
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})
LIMIT @pageSize OFFSET @toSkip"
addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@pageSize", 26)
cmd.Parameters.AddWithValue ("@toSkip", (pageNbr - 1) * 25)
] |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return toList toPage rdr
}
addParam cmd "@pageSize" 26
addParam cmd "@toSkip" ((pageNbr - 1) * 25)
cmdToList<Page> cmd ser
/// Restore pages from a backup
let restore pages = backgroundTask {
log.LogTrace "Page.restore"
for page in pages do
do! add page
}
/// Update a page
let update (page: Page) = backgroundTask {
log.LogTrace "Page.update"
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,
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! Document.update conn ser Table.Page page.Id { page with Revisions = [] }
do! updatePageRevisions page.Id oldPage.Revisions page.Revisions
return ()
| None -> return ()
| None -> ()
}
/// Update a page's prior permalinks
let updatePriorPermalinks pageId webLogId permalinks = backgroundTask {
match! findFullById pageId webLogId with
| Some page ->
do! updatePagePermalinks pageId page.PriorPermalinks permalinks
let updatePriorPermalinks pageId webLogId (permalinks: Permalink list) = backgroundTask {
log.LogTrace "Page.updatePriorPermalinks"
match! findById pageId webLogId with
| 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
| None -> return false
}

View File

@ -2,265 +2,105 @@ namespace MyWebLog.Data.SQLite
open System.Threading.Tasks
open Microsoft.Data.Sqlite
open Microsoft.Extensions.Logging
open MyWebLog
open MyWebLog.Data
open Newtonsoft.Json
open NodaTime
/// 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
/// Add parameters for post INSERT or UPDATE statements
let addPostParameters (cmd: SqliteCommand) (post: Post) =
[ cmd.Parameters.AddWithValue ("@id", string post.Id)
cmd.Parameters.AddWithValue ("@webLogId", string post.WebLogId)
cmd.Parameters.AddWithValue ("@authorId", string post.AuthorId)
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 to a post
let appendPostRevisions (post: Post) = backgroundTask {
log.LogTrace "Post.appendPostRevisions"
let! revisions = Revisions.findByEntityId conn Table.PostRevision Table.Post post.Id
return { post with Revisions = revisions }
}
/// Append revisions and permalinks to a post
let appendPostRevisionsAndPermalinks (post: Post) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@postId", string post.Id) |> ignore
/// The SELECT statement to retrieve posts with a web log ID parameter
let postByWebLog = $"{Query.selectFromTable Table.Post} WHERE {Query.whereByWebLog}"
cmd.CommandText <- "SELECT permalink FROM post_permalink WHERE post_id = @postId"
use! rdr = cmd.ExecuteReaderAsync ()
let post = { post with PriorPermalinks = toList Map.toPermalink rdr }
do! rdr.CloseAsync ()
/// The SELECT statement to retrieve published posts with a web log ID parameter
let publishedPostByWebLog = $"{postByWebLog} AND {statField} = '{string Published}'"
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 }
}
/// 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
}
/// Remove the text from a post
let withoutText (post: Post) =
{ post with Text = "" }
/// Update a post's revisions
let updatePostRevisions (postId: PostId) oldRevs newRevs = backgroundTask {
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
if List.isEmpty toDelete && List.isEmpty toAdd then
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
}
let updatePostRevisions (postId: PostId) oldRevs newRevs =
log.LogTrace "Post.updatePostRevisions"
Revisions.update conn Table.PostRevision Table.Post postId oldRevs newRevs
// IMPLEMENTATION FUNCTIONS
/// Add a post
let add post = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"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
let add (post: Post) = backgroundTask {
log.LogTrace "Post.add"
do! Document.insert conn ser Table.Post { post with Revisions = [] }
do! updatePostRevisions post.Id [] post.Revisions
}
/// Count posts in a status for the given web log
let countByStatus (status: PostStatus) webLogId = backgroundTask {
log.LogTrace "Post.countByStatus"
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
cmd.Parameters.AddWithValue ("@status", string status) |> ignore
addParam cmd "@status" (string status)
return! count cmd
}
/// Find a post by its ID for the given web log (excluding revisions and prior permalinks
let findById postId webLogId = backgroundTask {
match! findPostById postId webLogId with
| Some post ->
let! post = appendPostCategoryAndTag post
return Some post
| None -> return None
}
let findById postId webLogId =
log.LogTrace "Post.findById"
Document.findByIdAndWebLog<PostId, Post> conn ser Table.Post postId webLogId
/// Find a post by its permalink for the given web log (excluding revisions and prior permalinks)
let findByPermalink (permalink: Permalink) webLogId = backgroundTask {
log.LogTrace "Post.findByPermalink"
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
cmd.Parameters.AddWithValue ("@link", string permalink) |> ignore
addParam cmd "@link" (string permalink)
use! rdr = cmd.ExecuteReaderAsync()
if rdr.Read () then
let! post = appendPostCategoryAndTag (toPost rdr)
return Some post
else
return None
let! isFound = rdr.ReadAsync()
return if isFound then Some (Map.fromDoc<Post> ser rdr) else None
}
/// Find a complete post by its ID for the given web log
let findFullById postId webLogId = backgroundTask {
log.LogTrace "Post.findFullById"
match! findById postId webLogId with
| Some post ->
let! post = appendPostRevisionsAndPermalinks post
let! post = appendPostRevisions post
return Some post
| None -> return None
}
/// Delete a post by its ID for the given web log
let delete postId webLogId = backgroundTask {
match! findFullById postId webLogId with
log.LogTrace "Post.delete"
match! findById postId webLogId with
| Some _ ->
use cmd = conn.CreateCommand()
cmd.Parameters.AddWithValue ("@id", string postId) |> ignore
cmd.CommandText <-
"DELETE FROM post_revision WHERE post_id = @id;
DELETE FROM post_permalink WHERE post_id = @id;
DELETE FROM post_tag WHERE post_id = @id;
DELETE FROM post_category WHERE post_id = @id;
DELETE FROM post_comment WHERE post_id = @id;
DELETE FROM post WHERE id = @id"
cmd.CommandText <- $"
DELETE FROM {Table.PostRevision} WHERE post_id = @id;
DELETE FROM {Table.PostComment} WHERE data ->> '{nameof Comment.Empty.PostId}' = @id;
DELETE FROM {Table.Post} WHERE {Query.whereById}"
addDocId cmd postId
do! write cmd
return true
| 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
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()
let linkSql, linkParams = inClause "AND pp.permalink" "link" string permalinks
cmd.CommandText <- $"
SELECT p.permalink
FROM post p
INNER JOIN post_permalink pp ON pp.post_id = p.id
WHERE p.web_log_id = @webLogId
{linkSql}"
cmd.CommandText <-
$"SELECT {linkField} AS permalink FROM {Table.Post} WHERE {Query.whereByWebLog} AND {linkSql}"
addWebLogId cmd webLogId
cmd.Parameters.AddRange linkParams
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
let findFullByWebLog webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- $"{selectPost} WHERE p.web_log_id = @webLogId"
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync ()
let! posts =
toList toPost rdr
|> List.map (fun post -> backgroundTask {
let! post = appendPostCategoryAndTag post
return! appendPostRevisionsAndPermalinks post
})
log.LogTrace "Post.findFullByWebLog"
let! posts = Document.findByWebLog<Post> conn ser Table.Post webLogId
let! withRevs =
posts
|> List.map (fun post -> backgroundTask { return! appendPostRevisions post })
|> 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)
let findPageOfCategorizedPosts webLogId (categoryIds: CategoryId list) pageNbr postsPerPage = backgroundTask {
/// Get a page of categorized posts for the given web log (excludes revisions)
let findPageOfCategorizedPosts webLogId (categoryIds: CategoryId list) pageNbr postsPerPage =
log.LogTrace "Post.findPageOfCategorizedPosts"
let catSql, catParams = inJsonArray Table.Post (nameof Post.Empty.CategoryIds) "catId" categoryIds
use cmd = conn.CreateCommand ()
let catSql, catParams = inClause "AND pc.category_id" "catId" string categoryIds
cmd.CommandText <- $"
{selectPost}
INNER JOIN post_category pc ON pc.post_id = p.id
WHERE p.web_log_id = @webLogId
AND p.status = @status
{catSql}
ORDER BY published_on DESC
{publishedPostByWebLog} AND {catSql}
ORDER BY {publishField} DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", string Published) |> ignore
cmd.Parameters.AddRange catParams
use! rdr = cmd.ExecuteReaderAsync ()
let! posts =
toList toPost rdr
|> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post })
|> Task.WhenAll
return List.ofArray posts
}
cmdToList<Post> cmd ser
/// 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 {
log.LogTrace "Post.findPageOfPosts"
use cmd = conn.CreateCommand()
cmd.CommandText <- $"
{selectPost}
WHERE p.web_log_id = @webLogId
ORDER BY p.published_on DESC NULLS FIRST, p.updated_on
{postByWebLog}
ORDER BY {publishField} DESC NULLS FIRST, data ->> '{nameof Post.Empty.UpdatedOn}'
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync ()
let! posts =
toList postWithoutText rdr
|> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post })
|> Task.WhenAll
return List.ofArray posts
let! posts = cmdToList<Post> cmd ser
return posts |> List.map withoutText
}
/// Get a page of published posts for the given web log (excludes revisions and prior permalinks)
let findPageOfPublishedPosts webLogId pageNbr postsPerPage = backgroundTask {
/// Get a page of published posts for the given web log (excludes revisions)
let findPageOfPublishedPosts webLogId pageNbr postsPerPage =
log.LogTrace "Post.findPageOfPublishedPosts"
use cmd = conn.CreateCommand()
cmd.CommandText <- $"
{selectPost}
WHERE p.web_log_id = @webLogId
AND p.status = @status
{publishedPostByWebLog}
ORDER BY {publishField} DESC
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
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", string Published) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
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
}
cmd.Parameters.AddRange tagParams
cmdToList<Post> cmd ser
/// Find the next newest and oldest post from a publish date for the given web log
let findSurroundingPosts webLogId (publishedOn : Instant) = backgroundTask {
log.LogTrace "Post.findSurroundingPosts"
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
[ cmd.Parameters.AddWithValue ("@status", string Published)
cmd.Parameters.AddWithValue ("@publishedOn", instantParam publishedOn)
] |> ignore
addParam cmd "@publishedOn" (instantParam publishedOn)
cmd.CommandText <-
$"{publishedPostByWebLog} AND {publishField} < @publishedOn ORDER BY {publishField} DESC LIMIT 1"
use! rdr = cmd.ExecuteReaderAsync()
let! older = backgroundTask {
if rdr.Read () then
let! post = appendPostCategoryAndTag (postWithoutText rdr)
return Some post
else
return None
}
let! isFound = rdr.ReadAsync()
let older = if isFound then Some (Map.fromDoc<Post> ser rdr) else None
do! rdr.CloseAsync ()
cmd.CommandText <- $"
{selectPost}
WHERE p.web_log_id = @webLogId
AND p.status = @status
AND p.published_on > @publishedOn
ORDER BY p.published_on
LIMIT 1"
cmd.CommandText <-
$"{publishedPostByWebLog} AND {publishField} > @publishedOn ORDER BY {publishField} LIMIT 1"
use! rdr = cmd.ExecuteReaderAsync ()
let! newer = backgroundTask {
if rdr.Read () then
let! post = appendPostCategoryAndTag (postWithoutText rdr)
return Some post
else
return None
}
let! isFound = rdr.ReadAsync()
let newer = if isFound then Some (Map.fromDoc<Post> ser rdr) else None
return older, newer
}
/// Restore posts from a backup
let restore posts = backgroundTask {
log.LogTrace "Post.restore"
for post in posts do
do! add post
}
@ -431,35 +215,23 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
let update (post: Post) = backgroundTask {
match! findFullById post.Id post.WebLogId with
| Some oldPost ->
use cmd = conn.CreateCommand ()
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! Document.update conn ser Table.Post post.Id { post with Revisions = [] }
do! updatePostRevisions post.Id oldPost.Revisions post.Revisions
| None -> return ()
}
/// Update prior permalinks for a post
let updatePriorPermalinks postId webLogId permalinks = backgroundTask {
match! findFullById postId webLogId with
| Some post ->
do! updatePostPermalinks postId post.PriorPermalinks permalinks
let updatePriorPermalinks postId webLogId (permalinks: Permalink list) = backgroundTask {
match! findById postId webLogId with
| Some _ ->
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
| None -> return false
}

View File

@ -1,95 +1,70 @@
namespace MyWebLog.Data.SQLite
open Microsoft.Data.Sqlite
open Microsoft.Extensions.Logging
open MyWebLog
open MyWebLog.Data
open Newtonsoft.Json
/// 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
let findById (tagMapId: TagMapId) webLogId = backgroundTask {
use cmd = conn.CreateCommand()
cmd.CommandText <- "SELECT * FROM tag_map WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", string tagMapId) |> ignore
use! rdr = cmd.ExecuteReaderAsync()
return verifyWebLog<TagMap> webLogId (_.WebLogId) Map.toTagMap rdr
}
let findById tagMapId webLogId =
log.LogTrace "TagMap.findById"
Document.findByIdAndWebLog<TagMapId, TagMap> conn ser Table.TagMap tagMapId webLogId
/// Delete a tag mapping for the given web log
let delete tagMapId webLogId = backgroundTask {
log.LogTrace "TagMap.delete"
match! findById tagMapId webLogId with
| Some _ ->
use cmd = conn.CreateCommand ()
cmd.CommandText <- "DELETE FROM tag_map WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", string tagMapId) |> ignore
do! write cmd
do! Document.delete conn Table.TagMap tagMapId
return true
| None -> return false
}
/// Find a tag mapping by its URL value for the given web log
let findByUrlValue (urlValue: string) webLogId = backgroundTask {
log.LogTrace "TagMap.findByUrlValue"
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
cmd.Parameters.AddWithValue ("@urlValue", urlValue) |> ignore
addParam cmd "@urlValue" urlValue
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
let findByWebLog webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM tag_map WHERE web_log_id = @webLogId ORDER BY tag"
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toTagMap rdr
}
let findByWebLog webLogId =
log.LogTrace "TagMap.findByWebLog"
Document.findByWebLog<TagMap> conn ser Table.TagMap webLogId
/// 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 ()
let mapSql, mapParams = inClause "AND tag" "tag" id tags
cmd.CommandText <- $"
SELECT *
FROM tag_map
WHERE web_log_id = @webLogId
{mapSql}"
let mapSql, mapParams = inClause $"AND data ->> '{nameof TagMap.Empty.Tag}'" "tag" id tags
cmd.CommandText <- $"{Query.selectFromTable Table.TagMap} WHERE {Query.whereByWebLog} {mapSql}"
addWebLogId cmd webLogId
cmd.Parameters.AddRange mapParams
use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toTagMap rdr
}
cmdToList<TagMap> cmd ser
/// Save a tag mapping
let save (tagMap: TagMap) = backgroundTask {
use cmd = conn.CreateCommand ()
log.LogTrace "TagMap.save"
match! findById tagMap.Id tagMap.WebLogId with
| Some _ ->
cmd.CommandText <-
"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
| Some _ -> do! Document.update conn ser Table.TagMap tagMap.Id tagMap
| None -> do! Document.insert conn ser Table.TagMap tagMap
}
/// Restore tag mappings from a backup
let restore tagMaps = backgroundTask {
log.LogTrace "TagMap.restore"
for tagMap in tagMaps do
do! save tagMap
}

View File

@ -29,7 +29,7 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
let jsonTable table =
$"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 {
// Theme tables
@ -48,18 +48,20 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
// Category table
if needsTable Table.Category then
$"{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
if needsTable Table.WebLogUser then
$"{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
if needsTable Table.Page then
$"{jsonTable Table.Page};
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}_author ON {Table.Page} ((data ->> 'AuthorId'));
CREATE INDEX idx_{Table.Page}_permalink
ON {Table.Page} ((data ->> 'WebLogId'), (data ->> 'Permalink'))"
if needsTable Table.PageRevision then
"CREATE TABLE page_revision (
page_id TEXT NOT NULL,
@ -70,9 +72,11 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
// Post tables
if needsTable Table.Post then
$"{jsonTable Table.Post};
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}_permalink ON {Table.Post} (data ->> 'WebLogId', data ->> 'Permalink')"
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}_permalink
ON {Table.Post} ((data ->> 'WebLogId'), (data ->> 'Permalink'))"
// TODO: index categories by post?
if needsTable Table.PostRevision then
$"CREATE TABLE {Table.PostRevision} (
@ -82,12 +86,12 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
PRIMARY KEY (post_id, as_of))"
if needsTable Table.PostComment then
$"{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
if needsTable Table.TagMap then
$"{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
if needsTable Table.Upload then
@ -466,10 +470,10 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
interface IData with
member _.Category = SQLiteCategoryData (conn, ser)
member _.Page = SQLitePageData (conn, ser)
member _.Post = SQLitePostData (conn, ser)
member _.TagMap = SQLiteTagMapData conn
member _.Category = SQLiteCategoryData (conn, ser, log)
member _.Page = SQLitePageData (conn, ser, log)
member _.Post = SQLitePostData (conn, ser, log)
member _.TagMap = SQLiteTagMapData (conn, ser, log)
member _.Theme = SQLiteThemeData conn
member _.ThemeAsset = SQLiteThemeAssetData conn
member _.Upload = SQLiteUploadData conn
@ -484,5 +488,6 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
use cmd = conn.CreateCommand()
cmd.CommandText <- $"SELECT id FROM {Table.DbVersion}"
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)
}