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

Version 2.1 #41

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

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

@ -108,8 +108,25 @@ let maybeDuration =
let maybeInstant = let maybeInstant =
Option.map instantParam >> maybe Option.map instantParam >> maybe
/// Create the SQL and parameters for an EXISTS applied to a JSON array
let inJsonArray<'T> table jsonField paramName (items: 'T list) =
if List.isEmpty items then "", []
else
let mutable idx = 0
items
|> List.skip 1
|> List.fold (fun (itemS, itemP) it ->
idx <- idx + 1
$"{itemS}, @%s{paramName}{idx}", (SqliteParameter($"@%s{paramName}{idx}", string it) :: itemP))
(Seq.ofList items
|> Seq.map (fun it -> $"(@%s{paramName}0", [ SqliteParameter($"@%s{paramName}0", string it) ])
|> Seq.head)
|> function
sql, ps ->
$"EXISTS (SELECT 1 FROM json_each(%s{table}.data, '$.%s{jsonField}') WHERE value IN {sql}))", ps
/// Create the SQL and parameters for an IN clause /// Create the SQL and parameters for an IN clause
let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items : 'T list) = let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items: 'T list) =
if List.isEmpty items then "", [] if List.isEmpty items then "", []
else else
let mutable idx = 0 let mutable idx = 0
@ -131,25 +148,25 @@ module Map =
open System.IO open System.IO
/// Get a boolean value from a data reader /// 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 /// 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 /// 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 /// 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 /// 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 /// 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 /// 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 /// Parse a Duration from the given value
let parseDuration value = let parseDuration value =
@ -172,27 +189,27 @@ module Map =
getString col rdr |> parseInstant getString col rdr |> parseInstant
/// Get a timespan value from a data reader /// 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 /// Get a possibly null boolean value from a data reader
let tryBoolean col (rdr : SqliteDataReader) = let tryBoolean col (rdr: SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getBoolean col rdr) if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getBoolean col rdr)
/// Get a possibly null date/time value from a data reader /// Get a possibly null date/time value from a data reader
let tryDateTime col (rdr : SqliteDataReader) = let tryDateTime col (rdr: SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getDateTime col rdr) if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getDateTime col rdr)
/// Get a possibly null Guid value from a data reader /// Get a possibly null Guid value from a data reader
let tryGuid col (rdr : SqliteDataReader) = let tryGuid col (rdr: SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getGuid col rdr) if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getGuid col rdr)
/// Get a possibly null int value from a data reader /// Get a possibly null int value from a data reader
let tryInt col (rdr : SqliteDataReader) = let tryInt col (rdr: SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getInt col rdr) if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getInt col rdr)
/// Get a possibly null string value from a data reader /// Get a possibly null string value from a data reader
let tryString col (rdr : SqliteDataReader) = let tryString col (rdr: SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getString col rdr) if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getString col rdr)
/// Get a possibly null Duration value from a data reader /// Get a possibly null Duration value from a data reader
let tryDuration col rdr = let tryDuration col rdr =
@ -203,22 +220,12 @@ module Map =
tryString col rdr |> Option.map parseInstant tryString col rdr |> Option.map parseInstant
/// Get a possibly null timespan value from a data reader /// Get a possibly null timespan value from a data reader
let tryTimeSpan col (rdr : SqliteDataReader) = let tryTimeSpan col (rdr: SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getTimeSpan col rdr) if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getTimeSpan col rdr)
/// Map an id field to a category ID /// Map an id field to a category ID
let toCategoryId rdr = getString "id" rdr |> CategoryId let toCategoryId rdr = getString "id" rdr |> CategoryId
/// Create a category from the current row in the given data reader
let toCategory rdr : Category =
{ Id = toCategoryId rdr
WebLogId = getString "web_log_id" rdr |> WebLogId
Name = getString "name" rdr
Slug = getString "slug" rdr
Description = tryString "description" rdr
ParentId = tryString "parent_id" rdr |> Option.map CategoryId
}
/// Create a custom feed from the current row in the given data reader /// Create a custom feed from the current row in the given data reader
let toCustomFeed ser rdr : CustomFeed = let toCustomFeed ser rdr : CustomFeed =
{ Id = getString "id" rdr |> CustomFeedId { Id = getString "id" rdr |> CustomFeedId
@ -230,48 +237,10 @@ module Map =
/// Create a permalink from the current row in the given data reader /// Create a permalink from the current row in the given data reader
let toPermalink rdr = getString "permalink" rdr |> Permalink let toPermalink rdr = getString "permalink" rdr |> Permalink
/// Create a page from the current row in the given data reader
let toPage ser rdr : Page =
{ Page.Empty with
Id = getString "id" rdr |> PageId
WebLogId = getString "web_log_id" rdr |> WebLogId
AuthorId = getString "author_id" rdr |> WebLogUserId
Title = getString "title" rdr
Permalink = toPermalink rdr
PublishedOn = getInstant "published_on" rdr
UpdatedOn = getInstant "updated_on" rdr
IsInPageList = getBoolean "is_in_page_list" rdr
Template = tryString "template" rdr
Text = getString "page_text" rdr
Metadata = tryString "meta_items" rdr
|> Option.map (Utils.deserialize ser)
|> Option.defaultValue []
}
/// Create a post from the current row in the given data reader
let toPost ser rdr : Post =
{ Post.Empty with
Id = getString "id" rdr |> PostId
WebLogId = getString "web_log_id" rdr |> WebLogId
AuthorId = getString "author_id" rdr |> WebLogUserId
Status = getString "status" rdr |> PostStatus.Parse
Title = getString "title" rdr
Permalink = toPermalink rdr
PublishedOn = tryInstant "published_on" rdr
UpdatedOn = getInstant "updated_on" rdr
Template = tryString "template" rdr
Text = getString "post_text" rdr
Episode = tryString "episode" rdr |> Option.map (Utils.deserialize ser)
Metadata = tryString "meta_items" rdr
|> Option.map (Utils.deserialize ser)
|> Option.defaultValue []
}
/// Create a revision from the current row in the given data reader /// Create a revision from the current row in the given data reader
let toRevision rdr : Revision = let toRevision rdr : Revision =
{ AsOf = getInstant "as_of" rdr { AsOf = getInstant "as_of" rdr
Text = getString "revision_text" rdr |> MarkupText.Parse Text = getString "revision_text" rdr |> MarkupText.Parse }
}
/// Create a tag mapping from the current row in the given data reader /// Create a tag mapping from the current row in the given data reader
let toTagMap rdr : TagMap = let toTagMap rdr : TagMap =
@ -293,16 +262,15 @@ module Map =
let toThemeAsset includeData rdr : ThemeAsset = let toThemeAsset includeData rdr : ThemeAsset =
let assetData = let assetData =
if includeData then if includeData then
use dataStream = new MemoryStream () use dataStream = new MemoryStream()
use blobStream = getStream "data" rdr use blobStream = getStream "data" rdr
blobStream.CopyTo dataStream blobStream.CopyTo dataStream
dataStream.ToArray () dataStream.ToArray()
else else
[||] [||]
{ Id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr) { Id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr)
UpdatedOn = getInstant "updated_on" rdr UpdatedOn = getInstant "updated_on" rdr
Data = assetData Data = assetData }
}
/// Create a theme template from the current row in the given data reader /// Create a theme template from the current row in the given data reader
let toThemeTemplate includeText rdr : ThemeTemplate = let toThemeTemplate includeText rdr : ThemeTemplate =
@ -320,12 +288,11 @@ module Map =
dataStream.ToArray () dataStream.ToArray ()
else else
[||] [||]
{ Id = getString "id" rdr |> UploadId { Id = getString "id" rdr |> UploadId
WebLogId = getString "web_log_id" rdr |> WebLogId WebLogId = getString "web_log_id" rdr |> WebLogId
Path = getString "path" rdr |> Permalink Path = getString "path" rdr |> Permalink
UpdatedOn = getInstant "updated_on" rdr UpdatedOn = getInstant "updated_on" rdr
Data = data Data = data }
}
/// Create a web log from the current row in the given data reader /// Create a web log from the current row in the given data reader
let toWebLog ser rdr : WebLog = let toWebLog ser rdr : WebLog =
@ -375,17 +342,170 @@ module Map =
let fromDoc<'T> ser rdr : 'T = let fromDoc<'T> ser rdr : 'T =
fromData<'T> ser rdr "data" fromData<'T> ser rdr "data"
/// Create a list of items for the results of the given command
let cmdToList<'TDoc> (cmd: SqliteCommand) ser = backgroundTask {
use! rdr = cmd.ExecuteReaderAsync()
let mutable it: 'TDoc list = []
while! rdr.ReadAsync() do
it <- Map.fromDoc ser rdr :: it
return List.rev it
}
/// Queries to assist with document manipulation /// Queries to assist with document manipulation
module Query = module Query =
/// Fragment to add an ID condition to a WHERE clause /// Fragment to add an ID condition to a WHERE clause (parameter @id)
let whereById = let whereById =
"data ->> 'Id' = @id" "data ->> 'Id' = @id"
/// Fragment to add a web log ID condition to a WHERE clause /// Fragment to add a web log ID condition to a WHERE clause (parameter @webLogId)
let whereWebLogId = let whereByWebLog =
"data ->> 'WebLogId' = @webLogId" "data ->> 'WebLogId' = @webLogId"
/// A SELECT/FROM pair for the given table
let selectFromTable table =
$"SELECT data FROM %s{table}"
/// An INSERT statement for a document (parameter @data)
let insert table =
$"INSERT INTO %s{table} VALUES (@data)"
/// A SELECT query to count documents for a given web log ID
let countByWebLog table =
$"SELECT COUNT(*) FROM %s{table} WHERE {whereByWebLog}"
/// An UPDATE query to update a full document by its ID (parameters @data and @id)
let updateById table =
$"UPDATE %s{table} SET data = @data WHERE {whereById}"
/// A DELETE query to delete a document by its ID (parameter @id)
let deleteById table =
$"DELETE FROM %s{table} WHERE {whereById}"
let addParam (cmd: SqliteCommand) name (value: obj) =
cmd.Parameters.AddWithValue(name, value) |> ignore
/// Add an ID parameter for a document
let addDocId<'TKey> (cmd: SqliteCommand) (id: 'TKey) =
addParam cmd "@id" (string id)
/// Add a document parameter
let addDocParam<'TDoc> (cmd: SqliteCommand) (doc: 'TDoc) ser =
addParam cmd "@data" (Utils.serialize ser doc)
/// Add a web log ID parameter /// Add a web log ID parameter
let addWebLogId (cmd: SqliteCommand) (webLogId: WebLogId) = let addWebLogId (cmd: SqliteCommand) (webLogId: WebLogId) =
cmd.Parameters.AddWithValue("@webLogId", string webLogId) |> ignore addParam cmd "@webLogId" (string webLogId)
/// Functions for manipulating documents
module Document =
/// Count documents for the given web log ID
let countByWebLog (conn: SqliteConnection) table webLogId = backgroundTask {
use cmd = conn.CreateCommand()
cmd.CommandText <- Query.countByWebLog table
addWebLogId cmd webLogId
return! count cmd
}
/// Find a document by its ID and web log ID
let findByIdAndWebLog<'TKey, 'TDoc> (conn: SqliteConnection) ser table (key: 'TKey) webLogId = backgroundTask {
use cmd = conn.CreateCommand()
cmd.CommandText <- $"{Query.selectFromTable table} WHERE {Query.whereById} AND {Query.whereByWebLog}"
addDocId cmd key
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync()
let! isFound = rdr.ReadAsync()
return if isFound then Some (Map.fromDoc<'TDoc> ser rdr) else None
}
/// Find documents for the given web log
let findByWebLog<'TDoc> (conn: SqliteConnection) ser table webLogId =
use cmd = conn.CreateCommand()
cmd.CommandText <- $"{Query.selectFromTable table} WHERE {Query.whereByWebLog}"
addWebLogId cmd webLogId
cmdToList<'TDoc> cmd ser
/// Insert a document
let insert<'TDoc> (conn: SqliteConnection) ser table (doc: 'TDoc) = backgroundTask {
use cmd = conn.CreateCommand()
cmd.CommandText <- Query.insert table
addDocParam<'TDoc> cmd doc ser
do! write cmd
}
/// Update (replace) a document by its ID
let update<'TKey, 'TDoc> (conn: SqliteConnection) ser table (key: 'TKey) (doc: 'TDoc) = backgroundTask {
use cmd = conn.CreateCommand()
cmd.CommandText <- Query.updateById table
addDocId cmd key
addDocParam<'TDoc> cmd doc ser
do! write cmd
}
/// Delete a document by its ID
let delete<'TKey> (conn: SqliteConnection) table (key: 'TKey) = backgroundTask {
use cmd = conn.CreateCommand()
cmd.CommandText <- Query.deleteById table
addDocId cmd key
do! write cmd
}
/// Functions to support revisions
module Revisions =
/// Find all revisions for the given entity
let findByEntityId<'TKey> (conn: SqliteConnection) revTable entityTable (key: 'TKey) = backgroundTask {
use cmd = conn.CreateCommand()
cmd.CommandText <-
$"SELECT as_of, revision_text FROM %s{revTable} WHERE %s{entityTable}_id = @id ORDER BY as_of DESC"
addDocId cmd key
use! rdr = cmd.ExecuteReaderAsync()
return toList Map.toRevision rdr
}
/// Find all revisions for all posts for the given web log
let findByWebLog<'TKey> (conn: SqliteConnection) revTable entityTable (keyFunc: string -> 'TKey)
webLogId = backgroundTask {
use cmd = conn.CreateCommand()
cmd.CommandText <-
$"SELECT pr.*
FROM %s{revTable} pr
INNER JOIN %s{entityTable} p ON p.data ->> 'Id' = pr.{entityTable}_id
WHERE p.{Query.whereByWebLog}
ORDER BY as_of DESC"
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync()
return toList (fun rdr -> keyFunc (Map.getString $"{entityTable}_id" rdr), Map.toRevision rdr) rdr
}
/// Parameters for a revision INSERT statement
let revParams<'TKey> (key: 'TKey) rev =
[ SqliteParameter("asOf", rev.AsOf)
SqliteParameter("@id", string key)
SqliteParameter("@text", rev.Text) ]
/// The SQL statement to insert a revision
let insertSql table =
$"INSERT INTO %s{table} VALUES (@id, @asOf, @text)"
/// Update a page or post's revisions
let update<'TKey> (conn: SqliteConnection) revTable entityTable (key: 'TKey) oldRevs newRevs = backgroundTask {
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then
use cmd = conn.CreateCommand()
if not (List.isEmpty toDelete) then
cmd.CommandText <- $"DELETE FROM %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf"
for delRev in toDelete do
cmd.Parameters.Clear()
addDocId cmd key
addParam cmd "@asOf" delRev.AsOf
do! write cmd
if not (List.isEmpty toAdd) then
cmd.CommandText <- insertSql revTable
for addRev in toAdd do
cmd.Parameters.Clear()
cmd.Parameters.AddRange(revParams key addRev)
do! write cmd
}

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

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

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

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

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

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

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

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

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

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