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

WIP on SQLite JSON documents

Browse Source 
through TagMap done
This commit is contained in:
Daniel J. Summers 2023-12-17 21:17:46 -05:00
parent 58b83b8d28
commit 2062840a5e
6 changed files with 585 additions and 833 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -108,8 +108,25 @@ 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) =
let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items: 'T list) =
if List.isEmpty items then "", []
else
let mutable idx = 0
@ -131,25 +148,25 @@ module Map =
open System.IO
/// Get a boolean value from a data reader
let getBoolean col (rdr : SqliteDataReader) = rdr.GetBoolean (rdr.GetOrdinal col)
let getBoolean col (rdr: SqliteDataReader) = rdr.GetBoolean(rdr.GetOrdinal col)
/// Get a date/time value from a data reader
let getDateTime col (rdr : SqliteDataReader) = rdr.GetDateTime (rdr.GetOrdinal col)
let getDateTime col (rdr: SqliteDataReader) = rdr.GetDateTime(rdr.GetOrdinal col)
/// Get a Guid value from a data reader
let getGuid col (rdr : SqliteDataReader) = rdr.GetGuid (rdr.GetOrdinal col)
let getGuid col (rdr: SqliteDataReader) = rdr.GetGuid(rdr.GetOrdinal col)
/// Get an int value from a data reader
let getInt col (rdr : SqliteDataReader) = rdr.GetInt32 (rdr.GetOrdinal col)
let getInt col (rdr: SqliteDataReader) = rdr.GetInt32(rdr.GetOrdinal col)
/// Get a long (64-bit int) value from a data reader
let getLong col (rdr : SqliteDataReader) = rdr.GetInt64 (rdr.GetOrdinal col)
let getLong col (rdr: SqliteDataReader) = rdr.GetInt64(rdr.GetOrdinal col)
/// Get a BLOB stream value from a data reader
let getStream col (rdr : SqliteDataReader) = rdr.GetStream (rdr.GetOrdinal col)
let getStream col (rdr: SqliteDataReader) = rdr.GetStream(rdr.GetOrdinal col)
/// Get a string value from a data reader
let getString col (rdr : SqliteDataReader) = rdr.GetString (rdr.GetOrdinal col)
let getString col (rdr: SqliteDataReader) = rdr.GetString(rdr.GetOrdinal col)
/// Parse a Duration from the given value
let parseDuration value =
@ -172,27 +189,27 @@ module Map =
getString col rdr |> parseInstant
/// Get a timespan value from a data reader
let getTimeSpan col (rdr : SqliteDataReader) = rdr.GetTimeSpan (rdr.GetOrdinal col)
let getTimeSpan col (rdr: SqliteDataReader) = rdr.GetTimeSpan(rdr.GetOrdinal col)
/// Get a possibly null boolean value from a data reader
let tryBoolean col (rdr : SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getBoolean col rdr)
let tryBoolean col (rdr: SqliteDataReader) =
if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getBoolean col rdr)
/// Get a possibly null date/time value from a data reader
let tryDateTime col (rdr : SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getDateTime col rdr)
let tryDateTime col (rdr: SqliteDataReader) =
if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getDateTime col rdr)
/// Get a possibly null Guid value from a data reader
let tryGuid col (rdr : SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getGuid col rdr)
let tryGuid col (rdr: SqliteDataReader) =
if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getGuid col rdr)
/// Get a possibly null int value from a data reader
let tryInt col (rdr : SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getInt col rdr)
let tryInt col (rdr: SqliteDataReader) =
if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getInt col rdr)
/// Get a possibly null string value from a data reader
let tryString col (rdr : SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getString col rdr)
let tryString col (rdr: SqliteDataReader) =
if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getString col rdr)
/// Get a possibly null Duration value from a data reader
let tryDuration col rdr =
@ -203,22 +220,12 @@ module Map =
tryString col rdr |> Option.map parseInstant
/// Get a possibly null timespan value from a data reader
let tryTimeSpan col (rdr : SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getTimeSpan col rdr)
let tryTimeSpan col (rdr: SqliteDataReader) =
if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getTimeSpan col rdr)
/// 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
}
{ AsOf = getInstant "as_of" rdr
Text = getString "revision_text" rdr |> MarkupText.Parse }
/// Create a tag mapping from the current row in the given data reader
let toTagMap rdr : TagMap =
@ -293,16 +262,15 @@ module Map =
let toThemeAsset includeData rdr : ThemeAsset =
let assetData =
if includeData then
use dataStream = new MemoryStream ()
use dataStream = new MemoryStream()
use blobStream = getStream "data" rdr
blobStream.CopyTo dataStream
dataStream.ToArray ()
dataStream.ToArray()
else
[||]
{ Id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr)
UpdatedOn = getInstant "updated_on" rdr
Data = assetData
}
{ Id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr)
UpdatedOn = getInstant "updated_on" rdr
Data = assetData }
/// Create a theme template from the current row in the given data reader
let toThemeTemplate includeText rdr : ThemeTemplate =
@ -320,12 +288,11 @@ module Map =
dataStream.ToArray ()
else
[||]
{ Id = getString "id" rdr |> UploadId
WebLogId = getString "web_log_id" rdr |> WebLogId
Path = getString "path" rdr |> Permalink
UpdatedOn = getInstant "updated_on" rdr
Data = data
}
{ Id = getString "id" rdr |> UploadId
WebLogId = getString "web_log_id" rdr |> WebLogId
Path = getString "path" rdr |> Permalink
UpdatedOn = getInstant "updated_on" rdr
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 =
"data ->> 'WebLogId' = @webLogId"
/// 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
}

183
src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs
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 {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
$"SELECT COUNT(*) FROM {Table.Category}
WHERE {whereWebLogId} AND data ->> '{nameof Category.Empty.ParentId}' IS NULL"
log.LogTrace "Category.countTopLevel"
use cmd = conn.CreateCommand()
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,74 +52,83 @@ 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
})
})
|> Task.WhenAll
return
ordered
|> Seq.map (fun cat ->
{ cat with
PostCount = counts
|> Array.tryFind (fun c -> fst c = cat.Id)
|> Option.map snd
|> Option.defaultValue 0
})
PostCount =
counts
|> Array.tryFind (fun c -> fst c = cat.Id)
|> Option.map snd
|> 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 ()
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"
cmd.Parameters.Clear ()
let _ = cmd.Parameters.AddWithValue ("@id", string catId)
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()
addDocId cmd catId
addWebLogId cmd webLogId
do! write cmd
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 {
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
let update (cat: Category) = backgroundTask {
use cmd = conn.CreateCommand()
cmd.CommandText <- $"{Query.updateById} AND {Query.whereByWebLog}"
addDocId cmd cat.Id
addDocParam cmd cat ser
addWebLogId cmd cat.WebLogId
do! write cmd
}

317
src/MyWebLog.Data/SQLite/SQLitePageData.fs
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
do! updatePageRevisions page.Id [] page.Revisions
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 {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId ORDER BY LOWER(title)"
log.LogTrace "Page.all"
use cmd = conn.CreateCommand()
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 {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"SELECT COUNT(id)
FROM page
WHERE web_log_id = @webLogId
AND is_in_page_list = @isInPageList"
log.LogTrace "Page.countListed"
use cmd = conn.CreateCommand()
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"
use cmd = conn.CreateCommand()
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 {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId AND permalink = @link"
log.LogTrace "Page.findByPermalink"
use cmd = conn.CreateCommand()
cmd.CommandText <- $" {Query.selectFromTable Table.Page} WHERE {Query.whereByWebLog} AND {linkField} = @link"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@link", string permalink) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return if rdr.Read () then Some (toPage rdr) else None
addParam cmd "@link" (string permalink)
use! rdr = cmd.ExecuteReaderAsync()
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 {
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}"
log.LogTrace "Page.findCurrentPermalink"
let linkSql, linkParams = inJsonArray Table.Page (nameof Page.Empty.PriorPermalinks) "link" permalinks
use cmd = conn.CreateCommand()
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
use! rdr = cmd.ExecuteReaderAsync()
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 {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"SELECT *
FROM page
WHERE web_log_id = @webLogId
ORDER BY LOWER(title)
LIMIT @pageSize OFFSET @toSkip"
/// 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 <- $"
{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 {
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! updatePageRevisions page.Id oldPage.Revisions page.Revisions
return ()
| None -> return ()
do! Document.update conn ser Table.Page page.Id { page with Revisions = [] }
do! updatePageRevisions page.Id oldPage.Revisions page.Revisions
| 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
}

490
src/MyWebLog.Data/SQLite/SQLitePostData.fs
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
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 ()
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 to retrieve posts with a web log ID parameter
let postByWebLog = $"{Query.selectFromTable Table.Post} WHERE {Query.whereByWebLog}"
/// The SELECT statement for a post that will include episode data, if it exists
let selectPost = "SELECT p.* FROM post p"
/// The SELECT statement to retrieve published posts with a web log ID parameter
let publishedPostByWebLog = $"{postByWebLog} AND {statField} = '{string Published}'"
/// 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
do! updatePostRevisions post.Id [] post.Revisions
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 {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT COUNT(id) FROM post WHERE web_log_id = @webLogId AND status = @status"
log.LogTrace "Post.countByStatus"
use cmd = conn.CreateCommand()
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 {
use cmd = conn.CreateCommand ()
cmd.CommandText <- $"{selectPost} WHERE p.web_log_id = @webLogId AND p.permalink = @link"
log.LogTrace "Post.findByPermalink"
use cmd = conn.CreateCommand()
cmd.CommandText <- $"{Query.selectFromTable Table.Post} WHERE {Query.whereByWebLog} AND {linkField} = @link"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@link", string permalink) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
if rdr.Read () then
let! post = appendPostCategoryAndTag (toPost rdr)
return Some post
else
return None
addParam cmd "@link" (string permalink)
use! rdr = cmd.ExecuteReaderAsync()
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"
use cmd = conn.CreateCommand()
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,198 +108,130 @@ 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 {
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}"
log.LogTrace "Post.findCurrentPermalink"
let linkSql, linkParams = inJsonArray Table.Post (nameof Post.Empty.PriorPermalinks) "link" permalinks
use cmd = conn.CreateCommand()
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
use! rdr = cmd.ExecuteReaderAsync()
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 {
use cmd = conn.CreateCommand ()
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 {
use cmd = conn.CreateCommand ()
/// 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
use! rdr = cmd.ExecuteReaderAsync ()
let! older = backgroundTask {
if rdr.Read () then
let! post = appendPostCategoryAndTag (postWithoutText rdr)
return Some post
else
return None
}
addParam cmd "@publishedOn" (instantParam publishedOn)
cmd.CommandText <-
$"{publishedPostByWebLog} AND {publishField} < @publishedOn ORDER BY {publishField} DESC LIMIT 1"
use! rdr = cmd.ExecuteReaderAsync()
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
}
/// Update a post
let update (post : Post) = backgroundTask {
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! updatePostRevisions post.Id oldPost.Revisions post.Revisions
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
}

91
src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs
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) =
/// SQLite myWebLog tag mapping data implementation
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 {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM tag_map WHERE web_log_id = @webLogId AND url_value = @urlValue"
let findByUrlValue (urlValue: string) webLogId = backgroundTask {
log.LogTrace "TagMap.findByUrlValue"
use cmd = conn.CreateCommand()
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
use! rdr = cmd.ExecuteReaderAsync ()
return if rdr.Read () then Some (Map.toTagMap rdr) else None
addParam cmd "@urlValue" urlValue
use! rdr = cmd.ExecuteReaderAsync()
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 ()
let save (tagMap: TagMap) = backgroundTask {
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
}

41
src/MyWebLog.Data/SQLiteData.fs
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
@ -451,7 +455,7 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
log.LogWarning $"Unknown database version; assuming {Utils.currentDbVersion}"
do! setDbVersion Utils.currentDbVersion
}
/// The connection for this instance
member _.Conn = conn
@ -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
@ -481,8 +485,9 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
member _.StartUp () = backgroundTask {
do! ensureTables ()
use cmd = conn.CreateCommand ()
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)
use! rdr = cmd.ExecuteReaderAsync()
let! isFound = rdr.ReadAsync()
do! migrate (if isFound then Some (Map.getString "id" rdr) else None)
}