Version 2.1 #41
@ -108,6 +108,23 @@ let maybeDuration =
|
||||
let maybeInstant =
|
||||
Option.map instantParam >> maybe
|
||||
|
||||
/// Create the SQL and parameters for an EXISTS applied to a JSON array
|
||||
let inJsonArray<'T> table jsonField paramName (items: 'T list) =
|
||||
if List.isEmpty items then "", []
|
||||
else
|
||||
let mutable idx = 0
|
||||
items
|
||||
|> List.skip 1
|
||||
|> List.fold (fun (itemS, itemP) it ->
|
||||
idx <- idx + 1
|
||||
$"{itemS}, @%s{paramName}{idx}", (SqliteParameter($"@%s{paramName}{idx}", string it) :: itemP))
|
||||
(Seq.ofList items
|
||||
|> Seq.map (fun it -> $"(@%s{paramName}0", [ SqliteParameter($"@%s{paramName}0", string it) ])
|
||||
|> Seq.head)
|
||||
|> function
|
||||
sql, ps ->
|
||||
$"EXISTS (SELECT 1 FROM json_each(%s{table}.data, '$.%s{jsonField}') WHERE value IN {sql}))", ps
|
||||
|
||||
/// Create the SQL and parameters for an IN clause
|
||||
let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items: 'T list) =
|
||||
if List.isEmpty items then "", []
|
||||
@ -209,16 +226,6 @@ module Map =
|
||||
/// Map an id field to a category ID
|
||||
let toCategoryId rdr = getString "id" rdr |> CategoryId
|
||||
|
||||
/// Create a category from the current row in the given data reader
|
||||
let toCategory rdr : Category =
|
||||
{ Id = toCategoryId rdr
|
||||
WebLogId = getString "web_log_id" rdr |> WebLogId
|
||||
Name = getString "name" rdr
|
||||
Slug = getString "slug" rdr
|
||||
Description = tryString "description" rdr
|
||||
ParentId = tryString "parent_id" rdr |> Option.map CategoryId
|
||||
}
|
||||
|
||||
/// Create a custom feed from the current row in the given data reader
|
||||
let toCustomFeed ser rdr : CustomFeed =
|
||||
{ Id = getString "id" rdr |> CustomFeedId
|
||||
@ -230,48 +237,10 @@ module Map =
|
||||
/// Create a permalink from the current row in the given data reader
|
||||
let toPermalink rdr = getString "permalink" rdr |> Permalink
|
||||
|
||||
/// Create a page from the current row in the given data reader
|
||||
let toPage ser rdr : Page =
|
||||
{ Page.Empty with
|
||||
Id = getString "id" rdr |> PageId
|
||||
WebLogId = getString "web_log_id" rdr |> WebLogId
|
||||
AuthorId = getString "author_id" rdr |> WebLogUserId
|
||||
Title = getString "title" rdr
|
||||
Permalink = toPermalink rdr
|
||||
PublishedOn = getInstant "published_on" rdr
|
||||
UpdatedOn = getInstant "updated_on" rdr
|
||||
IsInPageList = getBoolean "is_in_page_list" rdr
|
||||
Template = tryString "template" rdr
|
||||
Text = getString "page_text" rdr
|
||||
Metadata = tryString "meta_items" rdr
|
||||
|> Option.map (Utils.deserialize ser)
|
||||
|> Option.defaultValue []
|
||||
}
|
||||
|
||||
/// Create a post from the current row in the given data reader
|
||||
let toPost ser rdr : Post =
|
||||
{ Post.Empty with
|
||||
Id = getString "id" rdr |> PostId
|
||||
WebLogId = getString "web_log_id" rdr |> WebLogId
|
||||
AuthorId = getString "author_id" rdr |> WebLogUserId
|
||||
Status = getString "status" rdr |> PostStatus.Parse
|
||||
Title = getString "title" rdr
|
||||
Permalink = toPermalink rdr
|
||||
PublishedOn = tryInstant "published_on" rdr
|
||||
UpdatedOn = getInstant "updated_on" rdr
|
||||
Template = tryString "template" rdr
|
||||
Text = getString "post_text" rdr
|
||||
Episode = tryString "episode" rdr |> Option.map (Utils.deserialize ser)
|
||||
Metadata = tryString "meta_items" rdr
|
||||
|> Option.map (Utils.deserialize ser)
|
||||
|> Option.defaultValue []
|
||||
}
|
||||
|
||||
/// Create a revision from the current row in the given data reader
|
||||
let toRevision rdr : Revision =
|
||||
{ AsOf = getInstant "as_of" rdr
|
||||
Text = getString "revision_text" rdr |> MarkupText.Parse
|
||||
}
|
||||
Text = getString "revision_text" rdr |> MarkupText.Parse }
|
||||
|
||||
/// Create a tag mapping from the current row in the given data reader
|
||||
let toTagMap rdr : TagMap =
|
||||
@ -301,8 +270,7 @@ module Map =
|
||||
[||]
|
||||
{ Id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr)
|
||||
UpdatedOn = getInstant "updated_on" rdr
|
||||
Data = assetData
|
||||
}
|
||||
Data = assetData }
|
||||
|
||||
/// Create a theme template from the current row in the given data reader
|
||||
let toThemeTemplate includeText rdr : ThemeTemplate =
|
||||
@ -324,8 +292,7 @@ module Map =
|
||||
WebLogId = getString "web_log_id" rdr |> WebLogId
|
||||
Path = getString "path" rdr |> Permalink
|
||||
UpdatedOn = getInstant "updated_on" rdr
|
||||
Data = data
|
||||
}
|
||||
Data = data }
|
||||
|
||||
/// Create a web log from the current row in the given data reader
|
||||
let toWebLog ser rdr : WebLog =
|
||||
@ -375,17 +342,170 @@ module Map =
|
||||
let fromDoc<'T> ser rdr : 'T =
|
||||
fromData<'T> ser rdr "data"
|
||||
|
||||
/// Create a list of items for the results of the given command
|
||||
let cmdToList<'TDoc> (cmd: SqliteCommand) ser = backgroundTask {
|
||||
use! rdr = cmd.ExecuteReaderAsync()
|
||||
let mutable it: 'TDoc list = []
|
||||
while! rdr.ReadAsync() do
|
||||
it <- Map.fromDoc ser rdr :: it
|
||||
return List.rev it
|
||||
}
|
||||
|
||||
/// Queries to assist with document manipulation
|
||||
module Query =
|
||||
|
||||
/// Fragment to add an ID condition to a WHERE clause
|
||||
/// Fragment to add an ID condition to a WHERE clause (parameter @id)
|
||||
let whereById =
|
||||
"data ->> 'Id' = @id"
|
||||
|
||||
/// Fragment to add a web log ID condition to a WHERE clause
|
||||
let whereWebLogId =
|
||||
/// Fragment to add a web log ID condition to a WHERE clause (parameter @webLogId)
|
||||
let whereByWebLog =
|
||||
"data ->> 'WebLogId' = @webLogId"
|
||||
|
||||
/// A SELECT/FROM pair for the given table
|
||||
let selectFromTable table =
|
||||
$"SELECT data FROM %s{table}"
|
||||
|
||||
/// An INSERT statement for a document (parameter @data)
|
||||
let insert table =
|
||||
$"INSERT INTO %s{table} VALUES (@data)"
|
||||
|
||||
/// A SELECT query to count documents for a given web log ID
|
||||
let countByWebLog table =
|
||||
$"SELECT COUNT(*) FROM %s{table} WHERE {whereByWebLog}"
|
||||
|
||||
/// An UPDATE query to update a full document by its ID (parameters @data and @id)
|
||||
let updateById table =
|
||||
$"UPDATE %s{table} SET data = @data WHERE {whereById}"
|
||||
|
||||
/// A DELETE query to delete a document by its ID (parameter @id)
|
||||
let deleteById table =
|
||||
$"DELETE FROM %s{table} WHERE {whereById}"
|
||||
|
||||
|
||||
let addParam (cmd: SqliteCommand) name (value: obj) =
|
||||
cmd.Parameters.AddWithValue(name, value) |> ignore
|
||||
|
||||
/// Add an ID parameter for a document
|
||||
let addDocId<'TKey> (cmd: SqliteCommand) (id: 'TKey) =
|
||||
addParam cmd "@id" (string id)
|
||||
|
||||
/// Add a document parameter
|
||||
let addDocParam<'TDoc> (cmd: SqliteCommand) (doc: 'TDoc) ser =
|
||||
addParam cmd "@data" (Utils.serialize ser doc)
|
||||
|
||||
/// Add a web log ID parameter
|
||||
let addWebLogId (cmd: SqliteCommand) (webLogId: WebLogId) =
|
||||
cmd.Parameters.AddWithValue("@webLogId", string webLogId) |> ignore
|
||||
addParam cmd "@webLogId" (string webLogId)
|
||||
|
||||
/// Functions for manipulating documents
|
||||
module Document =
|
||||
|
||||
/// Count documents for the given web log ID
|
||||
let countByWebLog (conn: SqliteConnection) table webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- Query.countByWebLog table
|
||||
addWebLogId cmd webLogId
|
||||
return! count cmd
|
||||
}
|
||||
|
||||
/// Find a document by its ID and web log ID
|
||||
let findByIdAndWebLog<'TKey, 'TDoc> (conn: SqliteConnection) ser table (key: 'TKey) webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- $"{Query.selectFromTable table} WHERE {Query.whereById} AND {Query.whereByWebLog}"
|
||||
addDocId cmd key
|
||||
addWebLogId cmd webLogId
|
||||
use! rdr = cmd.ExecuteReaderAsync()
|
||||
let! isFound = rdr.ReadAsync()
|
||||
return if isFound then Some (Map.fromDoc<'TDoc> ser rdr) else None
|
||||
}
|
||||
|
||||
/// Find documents for the given web log
|
||||
let findByWebLog<'TDoc> (conn: SqliteConnection) ser table webLogId =
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- $"{Query.selectFromTable table} WHERE {Query.whereByWebLog}"
|
||||
addWebLogId cmd webLogId
|
||||
cmdToList<'TDoc> cmd ser
|
||||
|
||||
/// Insert a document
|
||||
let insert<'TDoc> (conn: SqliteConnection) ser table (doc: 'TDoc) = backgroundTask {
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- Query.insert table
|
||||
addDocParam<'TDoc> cmd doc ser
|
||||
do! write cmd
|
||||
}
|
||||
|
||||
/// Update (replace) a document by its ID
|
||||
let update<'TKey, 'TDoc> (conn: SqliteConnection) ser table (key: 'TKey) (doc: 'TDoc) = backgroundTask {
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- Query.updateById table
|
||||
addDocId cmd key
|
||||
addDocParam<'TDoc> cmd doc ser
|
||||
do! write cmd
|
||||
}
|
||||
|
||||
/// Delete a document by its ID
|
||||
let delete<'TKey> (conn: SqliteConnection) table (key: 'TKey) = backgroundTask {
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- Query.deleteById table
|
||||
addDocId cmd key
|
||||
do! write cmd
|
||||
}
|
||||
|
||||
/// Functions to support revisions
|
||||
module Revisions =
|
||||
|
||||
/// Find all revisions for the given entity
|
||||
let findByEntityId<'TKey> (conn: SqliteConnection) revTable entityTable (key: 'TKey) = backgroundTask {
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <-
|
||||
$"SELECT as_of, revision_text FROM %s{revTable} WHERE %s{entityTable}_id = @id ORDER BY as_of DESC"
|
||||
addDocId cmd key
|
||||
use! rdr = cmd.ExecuteReaderAsync()
|
||||
return toList Map.toRevision rdr
|
||||
}
|
||||
|
||||
/// Find all revisions for all posts for the given web log
|
||||
let findByWebLog<'TKey> (conn: SqliteConnection) revTable entityTable (keyFunc: string -> 'TKey)
|
||||
webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <-
|
||||
$"SELECT pr.*
|
||||
FROM %s{revTable} pr
|
||||
INNER JOIN %s{entityTable} p ON p.data ->> 'Id' = pr.{entityTable}_id
|
||||
WHERE p.{Query.whereByWebLog}
|
||||
ORDER BY as_of DESC"
|
||||
addWebLogId cmd webLogId
|
||||
use! rdr = cmd.ExecuteReaderAsync()
|
||||
return toList (fun rdr -> keyFunc (Map.getString $"{entityTable}_id" rdr), Map.toRevision rdr) rdr
|
||||
}
|
||||
|
||||
/// Parameters for a revision INSERT statement
|
||||
let revParams<'TKey> (key: 'TKey) rev =
|
||||
[ SqliteParameter("asOf", rev.AsOf)
|
||||
SqliteParameter("@id", string key)
|
||||
SqliteParameter("@text", rev.Text) ]
|
||||
|
||||
/// The SQL statement to insert a revision
|
||||
let insertSql table =
|
||||
$"INSERT INTO %s{table} VALUES (@id, @asOf, @text)"
|
||||
|
||||
/// Update a page or post's revisions
|
||||
let update<'TKey> (conn: SqliteConnection) revTable entityTable (key: 'TKey) oldRevs newRevs = backgroundTask {
|
||||
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
|
||||
if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then
|
||||
use cmd = conn.CreateCommand()
|
||||
if not (List.isEmpty toDelete) then
|
||||
cmd.CommandText <- $"DELETE FROM %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf"
|
||||
for delRev in toDelete do
|
||||
cmd.Parameters.Clear()
|
||||
addDocId cmd key
|
||||
addParam cmd "@asOf" delRev.AsOf
|
||||
do! write cmd
|
||||
if not (List.isEmpty toAdd) then
|
||||
cmd.CommandText <- insertSql revTable
|
||||
for addRev in toAdd do
|
||||
cmd.Parameters.Clear()
|
||||
cmd.Parameters.AddRange(revParams key addRev)
|
||||
do! write cmd
|
||||
}
|
||||
|
||||
@ -2,71 +2,46 @@ namespace MyWebLog.Data.SQLite
|
||||
|
||||
open System.Threading.Tasks
|
||||
open Microsoft.Data.Sqlite
|
||||
open Microsoft.Extensions.Logging
|
||||
open MyWebLog
|
||||
open MyWebLog.Data
|
||||
open Newtonsoft.Json
|
||||
|
||||
/// SQLite myWebLog category data implementation
|
||||
type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer) =
|
||||
type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) =
|
||||
|
||||
/// Add parameters for category INSERT or UPDATE statements
|
||||
let addCategoryParameters (cmd: SqliteCommand) (cat: Category) =
|
||||
[ cmd.Parameters.AddWithValue ("@id", string cat.Id)
|
||||
cmd.Parameters.AddWithValue ("@webLogId", string cat.WebLogId)
|
||||
cmd.Parameters.AddWithValue ("@name", cat.Name)
|
||||
cmd.Parameters.AddWithValue ("@slug", cat.Slug)
|
||||
cmd.Parameters.AddWithValue ("@description", maybe cat.Description)
|
||||
cmd.Parameters.AddWithValue ("@parentId", maybe (cat.ParentId |> Option.map string))
|
||||
] |> ignore
|
||||
/// The name of the parent ID field
|
||||
let parentIdField = nameof Category.Empty.ParentId
|
||||
|
||||
/// Add a category
|
||||
let add cat = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"INSERT INTO category (
|
||||
id, web_log_id, name, slug, description, parent_id
|
||||
) VALUES (
|
||||
@id, @webLogId, @name, @slug, @description, @parentId
|
||||
)"
|
||||
addCategoryParameters cmd cat
|
||||
let! _ = cmd.ExecuteNonQueryAsync ()
|
||||
()
|
||||
}
|
||||
let add (cat: Category) =
|
||||
log.LogTrace "Category.add"
|
||||
Document.insert conn ser Table.Category cat
|
||||
|
||||
/// Count all categories for the given web log
|
||||
let countAll webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- $"SELECT COUNT(*) FROM {Table.Category} WHERE {whereWebLogId}"
|
||||
addWebLogId cmd webLogId
|
||||
return! count cmd
|
||||
}
|
||||
let countAll webLogId =
|
||||
log.LogTrace "Category.countAll"
|
||||
Document.countByWebLog conn Table.Category webLogId
|
||||
|
||||
/// Count all top-level categories for the given web log
|
||||
let countTopLevel webLogId = backgroundTask {
|
||||
log.LogTrace "Category.countTopLevel"
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <-
|
||||
$"SELECT COUNT(*) FROM {Table.Category}
|
||||
WHERE {whereWebLogId} AND data ->> '{nameof Category.Empty.ParentId}' IS NULL"
|
||||
cmd.CommandText <- $"{Query.countByWebLog} AND data ->> '{parentIdField}' IS NULL"
|
||||
addWebLogId cmd webLogId
|
||||
return! count cmd
|
||||
}
|
||||
|
||||
// TODO: need to get SQLite in clause format for JSON documents
|
||||
/// Find all categories for the given web log
|
||||
let findByWebLog webLogId =
|
||||
log.LogTrace "Category.findByWebLog"
|
||||
Document.findByWebLog<Category> conn ser Table.Category webLogId
|
||||
|
||||
/// Retrieve all categories for the given web log in a DotLiquid-friendly format
|
||||
let findAllForView webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- $"SELECT data FROM {Table.Category} WHERE {whereWebLogId}"
|
||||
addWebLogId cmd webLogId
|
||||
use! rdr = cmd.ExecuteReaderAsync()
|
||||
let cats =
|
||||
seq {
|
||||
while rdr.Read() do
|
||||
Map.fromDoc<Category> ser rdr
|
||||
}
|
||||
|> Seq.sortBy _.Name.ToLowerInvariant()
|
||||
|> List.ofSeq
|
||||
do! rdr.CloseAsync()
|
||||
let ordered = Utils.orderByHierarchy cats None None []
|
||||
log.LogTrace "Category.findAllForView"
|
||||
let! cats = findByWebLog webLogId
|
||||
let ordered = Utils.orderByHierarchy (cats |> List.sortBy _.Name.ToLowerInvariant()) None None []
|
||||
let! counts =
|
||||
ordered
|
||||
|> Seq.map (fun it -> backgroundTask {
|
||||
@ -77,17 +52,16 @@ type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer) =
|
||||
|> Seq.map _.Id
|
||||
|> Seq.append (Seq.singleton it.Id)
|
||||
|> List.ofSeq
|
||||
|> inClause "AND pc.category_id" "catId" id
|
||||
cmd.Parameters.Clear ()
|
||||
|> inJsonArray Table.Post (nameof Post.Empty.CategoryIds) "catId"
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- $"
|
||||
SELECT COUNT(DISTINCT data ->> '{nameof Post.Empty.Id}')
|
||||
FROM {Table.Post}
|
||||
WHERE {Query.whereByWebLog}
|
||||
AND data ->> '{nameof Post.Empty.Status}' = '{string Published}'
|
||||
AND {catSql}"
|
||||
addWebLogId cmd webLogId
|
||||
cmd.Parameters.AddRange catParams
|
||||
cmd.CommandText <- $"
|
||||
SELECT COUNT(DISTINCT p.id)
|
||||
FROM post p
|
||||
INNER JOIN post_category pc ON pc.post_id = p.id
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND p.status = 'Published'
|
||||
{catSql}"
|
||||
let! postCount = count cmd
|
||||
return it.Id, postCount
|
||||
})
|
||||
@ -96,55 +70,65 @@ type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer) =
|
||||
ordered
|
||||
|> Seq.map (fun cat ->
|
||||
{ cat with
|
||||
PostCount = counts
|
||||
PostCount =
|
||||
counts
|
||||
|> Array.tryFind (fun c -> fst c = cat.Id)
|
||||
|> Option.map snd
|
||||
|> Option.defaultValue 0
|
||||
})
|
||||
|> Option.defaultValue 0 })
|
||||
|> Array.ofSeq
|
||||
}
|
||||
|
||||
/// Find a category by its ID for the given web log
|
||||
let findById (catId: CategoryId) webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- $"SELECT * FROM {Table.Category} WHERE {Query.whereById}"
|
||||
cmd.Parameters.AddWithValue("@id", string catId) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync()
|
||||
return verifyWebLog<Category> webLogId (_.WebLogId) (Map.fromDoc ser) rdr
|
||||
}
|
||||
// TODO: stopped here
|
||||
/// Find all categories for the given web log
|
||||
let findByWebLog (webLogId: WebLogId) = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM category WHERE web_log_id = @webLogId"
|
||||
cmd.Parameters.AddWithValue ("@webLogId", string webLogId) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return toList Map.toCategory rdr
|
||||
}
|
||||
let findById catId webLogId =
|
||||
log.LogTrace "Category.findById"
|
||||
Document.findByIdAndWebLog<CategoryId, Category> conn ser Table.Category catId webLogId
|
||||
|
||||
/// Delete a category
|
||||
let delete catId webLogId = backgroundTask {
|
||||
log.LogTrace "Category.delete"
|
||||
match! findById catId webLogId with
|
||||
| Some cat ->
|
||||
use cmd = conn.CreateCommand()
|
||||
// Reassign any children to the category's parent category
|
||||
cmd.CommandText <- "SELECT COUNT(id) FROM category WHERE parent_id = @parentId"
|
||||
cmd.Parameters.AddWithValue ("@parentId", string catId) |> ignore
|
||||
cmd.CommandText <- $"SELECT COUNT(*) FROM {Table.Category} WHERE data ->> '{parentIdField}' = @parentId"
|
||||
addParam cmd "@parentId" (string catId)
|
||||
let! children = count cmd
|
||||
if children > 0 then
|
||||
cmd.CommandText <- "UPDATE category SET parent_id = @newParentId WHERE parent_id = @parentId"
|
||||
cmd.Parameters.AddWithValue ("@newParentId", maybe (cat.ParentId |> Option.map string))
|
||||
|> ignore
|
||||
cmd.CommandText <- $"
|
||||
UPDATE {Table.Category}
|
||||
SET data = json_set(data, '$.{parentIdField}', @newParentId)
|
||||
WHERE data ->> '{parentIdField}' = @parentId"
|
||||
addParam cmd "@newParentId" (maybe (cat.ParentId |> Option.map string))
|
||||
do! write cmd
|
||||
// Delete the category off all posts where it is assigned, and the category itself
|
||||
cmd.CommandText <-
|
||||
"DELETE FROM post_category
|
||||
WHERE category_id = @id
|
||||
AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId);
|
||||
DELETE FROM category WHERE id = @id"
|
||||
let catIdField = Post.Empty.CategoryIds
|
||||
cmd.CommandText <- $"
|
||||
SELECT data ->> '{Post.Empty.Id}' AS id, data -> '{catIdField}' AS cat_ids
|
||||
FROM {Table.Post}
|
||||
WHERE {Query.whereByWebLog}
|
||||
AND EXISTS
|
||||
(SELECT 1 FROM json_each({Table.Post}.data -> '{catIdField}') WHERE json_each.value = @id)"
|
||||
cmd.Parameters.Clear()
|
||||
let _ = cmd.Parameters.AddWithValue ("@id", string catId)
|
||||
addDocId cmd catId
|
||||
addWebLogId cmd webLogId
|
||||
use! postRdr = cmd.ExecuteReaderAsync()
|
||||
if postRdr.HasRows then
|
||||
let postIdAndCats =
|
||||
toList
|
||||
(fun rdr ->
|
||||
Map.getString "id" rdr, Utils.deserialize<string list> ser (Map.getString "cat_ids" rdr))
|
||||
postRdr
|
||||
do! postRdr.CloseAsync()
|
||||
for postId, cats in postIdAndCats do
|
||||
cmd.CommandText <- $"
|
||||
UPDATE {Table.Post}
|
||||
SET data = json_set(data, '$.{catIdField}', json(@catIds))
|
||||
WHERE {Query.whereById}"
|
||||
cmd.Parameters.Clear()
|
||||
addDocId cmd postId
|
||||
addParam cmd "@catIds" (cats |> List.filter (fun it -> it <> string catId) |> Utils.serialize ser)
|
||||
do! write cmd
|
||||
do! Document.delete conn Table.Category catId
|
||||
return if children = 0 then CategoryDeleted else ReassignedChildCategories
|
||||
| None -> return CategoryNotFound
|
||||
}
|
||||
@ -156,17 +140,12 @@ type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer) =
|
||||
}
|
||||
|
||||
/// Update a category
|
||||
let update cat = backgroundTask {
|
||||
let update (cat: Category) = backgroundTask {
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <-
|
||||
"UPDATE category
|
||||
SET name = @name,
|
||||
slug = @slug,
|
||||
description = @description,
|
||||
parent_id = @parentId
|
||||
WHERE id = @id
|
||||
AND web_log_id = @webLogId"
|
||||
addCategoryParameters cmd cat
|
||||
cmd.CommandText <- $"{Query.updateById} AND {Query.whereByWebLog}"
|
||||
addDocId cmd cat.Id
|
||||
addDocParam cmd cat ser
|
||||
addWebLogId cmd cat.WebLogId
|
||||
do! write cmd
|
||||
}
|
||||
|
||||
|
||||
@ -2,184 +2,99 @@ namespace MyWebLog.Data.SQLite
|
||||
|
||||
open System.Threading.Tasks
|
||||
open Microsoft.Data.Sqlite
|
||||
open Microsoft.Extensions.Logging
|
||||
open MyWebLog
|
||||
open MyWebLog.Data
|
||||
open Newtonsoft.Json
|
||||
|
||||
/// SQLite myWebLog page data implementation
|
||||
type SQLitePageData(conn: SqliteConnection, ser: JsonSerializer) =
|
||||
type SQLitePageData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) =
|
||||
|
||||
/// The JSON field for the permalink
|
||||
let linkField = $"data ->> '{nameof Page.Empty.Permalink}'"
|
||||
|
||||
/// The JSON field for the "is in page list" flag
|
||||
let pgListField = $"data ->> '{nameof Page.Empty.IsInPageList}'"
|
||||
|
||||
/// The JSON field for the title of the page
|
||||
let titleField = $"data ->> '{nameof Page.Empty.Title}'"
|
||||
|
||||
// SUPPORT FUNCTIONS
|
||||
|
||||
/// Add parameters for page INSERT or UPDATE statements
|
||||
let addPageParameters (cmd: SqliteCommand) (page: Page) =
|
||||
[ cmd.Parameters.AddWithValue ("@id", string page.Id)
|
||||
cmd.Parameters.AddWithValue ("@webLogId", string page.WebLogId)
|
||||
cmd.Parameters.AddWithValue ("@authorId", string page.AuthorId)
|
||||
cmd.Parameters.AddWithValue ("@title", page.Title)
|
||||
cmd.Parameters.AddWithValue ("@permalink", string page.Permalink)
|
||||
cmd.Parameters.AddWithValue ("@publishedOn", instantParam page.PublishedOn)
|
||||
cmd.Parameters.AddWithValue ("@updatedOn", instantParam page.UpdatedOn)
|
||||
cmd.Parameters.AddWithValue ("@isInPageList", page.IsInPageList)
|
||||
cmd.Parameters.AddWithValue ("@template", maybe page.Template)
|
||||
cmd.Parameters.AddWithValue ("@text", page.Text)
|
||||
cmd.Parameters.AddWithValue ("@metaItems", maybe (if List.isEmpty page.Metadata then None
|
||||
else Some (Utils.serialize ser page.Metadata)))
|
||||
] |> ignore
|
||||
|
||||
/// Append revisions and permalinks to a page
|
||||
let appendPageRevisionsAndPermalinks (page : Page) = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.Parameters.AddWithValue ("@pageId", string page.Id) |> ignore
|
||||
|
||||
cmd.CommandText <- "SELECT permalink FROM page_permalink WHERE page_id = @pageId"
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let page = { page with PriorPermalinks = toList Map.toPermalink rdr }
|
||||
do! rdr.CloseAsync ()
|
||||
|
||||
cmd.CommandText <- "SELECT as_of, revision_text FROM page_revision WHERE page_id = @pageId ORDER BY as_of DESC"
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return { page with Revisions = toList Map.toRevision rdr }
|
||||
/// Append revisions to a page
|
||||
let appendPageRevisions (page : Page) = backgroundTask {
|
||||
log.LogTrace "Page.appendPageRevisions"
|
||||
let! revisions = Revisions.findByEntityId conn Table.PageRevision Table.Page page.Id
|
||||
return { page with Revisions = revisions }
|
||||
}
|
||||
|
||||
/// Shorthand for mapping a data reader to a page
|
||||
let toPage =
|
||||
Map.toPage ser
|
||||
|
||||
/// Return a page with no text (or prior permalinks or revisions)
|
||||
let pageWithoutText rdr =
|
||||
{ toPage rdr with Text = "" }
|
||||
|
||||
/// Update a page's prior permalinks
|
||||
let updatePagePermalinks (pageId: PageId) oldLinks newLinks = backgroundTask {
|
||||
let toDelete, toAdd = Utils.diffPermalinks oldLinks newLinks
|
||||
if List.isEmpty toDelete && List.isEmpty toAdd then
|
||||
return ()
|
||||
else
|
||||
use cmd = conn.CreateCommand ()
|
||||
[ cmd.Parameters.AddWithValue ("@pageId", string pageId)
|
||||
cmd.Parameters.Add ("@link", SqliteType.Text)
|
||||
] |> ignore
|
||||
let runCmd (link: Permalink) = backgroundTask {
|
||||
cmd.Parameters["@link"].Value <- string link
|
||||
do! write cmd
|
||||
}
|
||||
cmd.CommandText <- "DELETE FROM page_permalink WHERE page_id = @pageId AND permalink = @link"
|
||||
toDelete
|
||||
|> List.map runCmd
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
cmd.CommandText <- "INSERT INTO page_permalink VALUES (@pageId, @link)"
|
||||
toAdd
|
||||
|> List.map runCmd
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
}
|
||||
/// Return a page with no text
|
||||
let withoutText (page: Page) =
|
||||
{ page with Text = "" }
|
||||
|
||||
/// Update a page's revisions
|
||||
let updatePageRevisions (pageId: PageId) oldRevs newRevs = backgroundTask {
|
||||
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
|
||||
if List.isEmpty toDelete && List.isEmpty toAdd then
|
||||
return ()
|
||||
else
|
||||
use cmd = conn.CreateCommand ()
|
||||
let runCmd withText rev = backgroundTask {
|
||||
cmd.Parameters.Clear ()
|
||||
[ cmd.Parameters.AddWithValue ("@pageId", string pageId)
|
||||
cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf)
|
||||
] |> ignore
|
||||
if withText then cmd.Parameters.AddWithValue ("@text", string rev.Text) |> ignore
|
||||
do! write cmd
|
||||
}
|
||||
cmd.CommandText <- "DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @asOf"
|
||||
toDelete
|
||||
|> List.map (runCmd false)
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
cmd.CommandText <- "INSERT INTO page_revision VALUES (@pageId, @asOf, @text)"
|
||||
toAdd
|
||||
|> List.map (runCmd true)
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
}
|
||||
let updatePageRevisions (pageId: PageId) oldRevs newRevs =
|
||||
log.LogTrace "Page.updatePageRevisions"
|
||||
Revisions.update conn Table.PageRevision Table.Page pageId oldRevs newRevs
|
||||
|
||||
// IMPLEMENTATION FUNCTIONS
|
||||
|
||||
/// Add a page
|
||||
let add page = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
// The page itself
|
||||
cmd.CommandText <-
|
||||
"INSERT INTO page (
|
||||
id, web_log_id, author_id, title, permalink, published_on, updated_on, is_in_page_list, template,
|
||||
page_text, meta_items
|
||||
) VALUES (
|
||||
@id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @isInPageList, @template,
|
||||
@text, @metaItems
|
||||
)"
|
||||
addPageParameters cmd page
|
||||
do! write cmd
|
||||
do! updatePagePermalinks page.Id [] page.PriorPermalinks
|
||||
log.LogTrace "Page.add"
|
||||
do! Document.insert<Page> conn ser Table.Page { page with Revisions = [] }
|
||||
do! updatePageRevisions page.Id [] page.Revisions
|
||||
}
|
||||
|
||||
/// Get all pages for a web log (without text, revisions, prior permalinks, or metadata)
|
||||
/// Get all pages for a web log (without text or revisions)
|
||||
let all webLogId = backgroundTask {
|
||||
log.LogTrace "Page.all"
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId ORDER BY LOWER(title)"
|
||||
cmd.CommandText <-
|
||||
$"{Query.selectFromTable Table.Page} WHERE {Query.whereByWebLog} ORDER BY LOWER({titleField})"
|
||||
addWebLogId cmd webLogId
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return toList pageWithoutText rdr
|
||||
let! pages = cmdToList<Page> cmd ser
|
||||
return pages |> List.map withoutText
|
||||
}
|
||||
|
||||
/// Count all pages for the given web log
|
||||
let countAll webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT COUNT(id) FROM page WHERE web_log_id = @webLogId"
|
||||
addWebLogId cmd webLogId
|
||||
return! count cmd
|
||||
}
|
||||
let countAll webLogId =
|
||||
log.LogTrace "Page.countAll"
|
||||
Document.countByWebLog conn Table.Page webLogId
|
||||
|
||||
/// Count all pages shown in the page list for the given web log
|
||||
let countListed webLogId = backgroundTask {
|
||||
log.LogTrace "Page.countListed"
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <-
|
||||
"SELECT COUNT(id)
|
||||
FROM page
|
||||
WHERE web_log_id = @webLogId
|
||||
AND is_in_page_list = @isInPageList"
|
||||
cmd.CommandText <- $"{Query.countByWebLog} AND {pgListField} = 'true'"
|
||||
addWebLogId cmd webLogId
|
||||
cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore
|
||||
return! count cmd
|
||||
}
|
||||
|
||||
/// Find a page by its ID (without revisions and prior permalinks)
|
||||
let findById (pageId: PageId) webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM page WHERE id = @id"
|
||||
cmd.Parameters.AddWithValue ("@id", string pageId) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return verifyWebLog<Page> webLogId (_.WebLogId) (Map.toPage ser) rdr
|
||||
}
|
||||
/// Find a page by its ID (without revisions)
|
||||
let findById pageId webLogId =
|
||||
log.LogTrace "Page.findById"
|
||||
Document.findByIdAndWebLog<PageId, Page> conn ser Table.Page pageId webLogId
|
||||
|
||||
/// Find a complete page by its ID
|
||||
let findFullById pageId webLogId = backgroundTask {
|
||||
log.LogTrace "Page.findFullById"
|
||||
match! findById pageId webLogId with
|
||||
| Some page ->
|
||||
let! page = appendPageRevisionsAndPermalinks page
|
||||
let! page = appendPageRevisions page
|
||||
return Some page
|
||||
| None -> return None
|
||||
}
|
||||
|
||||
// TODO: need to handle when the page being deleted is the home page
|
||||
/// Delete a page by its ID
|
||||
let delete pageId webLogId = backgroundTask {
|
||||
log.LogTrace "Page.delete"
|
||||
match! findById pageId webLogId with
|
||||
| Some _ ->
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.Parameters.AddWithValue ("@id", string pageId) |> ignore
|
||||
cmd.CommandText <-
|
||||
"DELETE FROM page_revision WHERE page_id = @id;
|
||||
DELETE FROM page_permalink WHERE page_id = @id;
|
||||
DELETE FROM page WHERE id = @id"
|
||||
cmd.CommandText <- $"DELETE FROM {Table.PageRevision} WHERE page_id = @id; {Query.deleteById}"
|
||||
addDocId cmd pageId
|
||||
do! write cmd
|
||||
return true
|
||||
| None -> return false
|
||||
@ -187,112 +102,98 @@ type SQLitePageData(conn: SqliteConnection, ser: JsonSerializer) =
|
||||
|
||||
/// Find a page by its permalink for the given web log
|
||||
let findByPermalink (permalink: Permalink) webLogId = backgroundTask {
|
||||
log.LogTrace "Page.findByPermalink"
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId AND permalink = @link"
|
||||
cmd.CommandText <- $" {Query.selectFromTable Table.Page} WHERE {Query.whereByWebLog} AND {linkField} = @link"
|
||||
addWebLogId cmd webLogId
|
||||
cmd.Parameters.AddWithValue ("@link", string permalink) |> ignore
|
||||
addParam cmd "@link" (string permalink)
|
||||
use! rdr = cmd.ExecuteReaderAsync()
|
||||
return if rdr.Read () then Some (toPage rdr) else None
|
||||
let! isFound = rdr.ReadAsync()
|
||||
return if isFound then Some (Map.fromDoc<Page> ser rdr) else None
|
||||
}
|
||||
|
||||
/// Find the current permalink within a set of potential prior permalinks for the given web log
|
||||
let findCurrentPermalink (permalinks: Permalink list) webLogId = backgroundTask {
|
||||
log.LogTrace "Page.findCurrentPermalink"
|
||||
let linkSql, linkParams = inJsonArray Table.Page (nameof Page.Empty.PriorPermalinks) "link" permalinks
|
||||
use cmd = conn.CreateCommand()
|
||||
let linkSql, linkParams = inClause "AND pp.permalink" "link" string permalinks
|
||||
cmd.CommandText <- $"
|
||||
SELECT p.permalink
|
||||
FROM page p
|
||||
INNER JOIN page_permalink pp ON pp.page_id = p.id
|
||||
WHERE p.web_log_id = @webLogId
|
||||
{linkSql}"
|
||||
cmd.CommandText <-
|
||||
$"SELECT {linkField} AS permalink FROM {Table.Page} WHERE {Query.whereByWebLog} AND {linkSql}"
|
||||
addWebLogId cmd webLogId
|
||||
cmd.Parameters.AddRange linkParams
|
||||
use! rdr = cmd.ExecuteReaderAsync()
|
||||
return if rdr.Read () then Some (Map.toPermalink rdr) else None
|
||||
let! isFound = rdr.ReadAsync()
|
||||
return if isFound then Some (Map.toPermalink rdr) else None
|
||||
}
|
||||
|
||||
/// Get all complete pages for the given web log
|
||||
let findFullByWebLog webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId"
|
||||
addWebLogId cmd webLogId
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let! pages =
|
||||
toList toPage rdr
|
||||
|> List.map (fun page -> backgroundTask { return! appendPageRevisionsAndPermalinks page })
|
||||
log.LogTrace "Page.findFullByWebLog"
|
||||
let! pages = Document.findByWebLog<Page> conn ser Table.Page webLogId
|
||||
let! withRevs =
|
||||
pages
|
||||
|> List.map (fun page -> backgroundTask { return! appendPageRevisions page })
|
||||
|> Task.WhenAll
|
||||
return List.ofArray pages
|
||||
return List.ofArray withRevs
|
||||
}
|
||||
|
||||
/// Get all listed pages for the given web log (without revisions, prior permalinks, or text)
|
||||
/// Get all listed pages for the given web log (without revisions or text)
|
||||
let findListed webLogId = backgroundTask {
|
||||
log.LogTrace "Page.findListed"
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"SELECT *
|
||||
FROM page
|
||||
WHERE web_log_id = @webLogId
|
||||
AND is_in_page_list = @isInPageList
|
||||
ORDER BY LOWER(title)"
|
||||
cmd.CommandText <- $"
|
||||
{Query.selectFromTable Table.Page}
|
||||
WHERE {Query.whereByWebLog}
|
||||
AND {pgListField} = 'true'
|
||||
ORDER BY LOWER({titleField})"
|
||||
addWebLogId cmd webLogId
|
||||
cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return toList pageWithoutText rdr
|
||||
let! pages = cmdToList<Page> cmd ser
|
||||
return pages |> List.map withoutText
|
||||
}
|
||||
|
||||
/// Get a page of pages for the given web log (without revisions, prior permalinks, or metadata)
|
||||
let findPageOfPages webLogId pageNbr = backgroundTask {
|
||||
/// Get a page of pages for the given web log (without revisions)
|
||||
let findPageOfPages webLogId pageNbr =
|
||||
log.LogTrace "Page.findPageOfPages"
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <-
|
||||
"SELECT *
|
||||
FROM page
|
||||
WHERE web_log_id = @webLogId
|
||||
ORDER BY LOWER(title)
|
||||
cmd.CommandText <- $"
|
||||
{Query.selectFromTable Table.Page} WHERE {Query.whereByWebLog}
|
||||
ORDER BY LOWER({titleField})
|
||||
LIMIT @pageSize OFFSET @toSkip"
|
||||
addWebLogId cmd webLogId
|
||||
[ cmd.Parameters.AddWithValue ("@pageSize", 26)
|
||||
cmd.Parameters.AddWithValue ("@toSkip", (pageNbr - 1) * 25)
|
||||
] |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return toList toPage rdr
|
||||
}
|
||||
addParam cmd "@pageSize" 26
|
||||
addParam cmd "@toSkip" ((pageNbr - 1) * 25)
|
||||
cmdToList<Page> cmd ser
|
||||
|
||||
/// Restore pages from a backup
|
||||
let restore pages = backgroundTask {
|
||||
log.LogTrace "Page.restore"
|
||||
for page in pages do
|
||||
do! add page
|
||||
}
|
||||
|
||||
/// Update a page
|
||||
let update (page: Page) = backgroundTask {
|
||||
log.LogTrace "Page.update"
|
||||
match! findFullById page.Id page.WebLogId with
|
||||
| Some oldPage ->
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"UPDATE page
|
||||
SET author_id = @authorId,
|
||||
title = @title,
|
||||
permalink = @permalink,
|
||||
published_on = @publishedOn,
|
||||
updated_on = @updatedOn,
|
||||
is_in_page_list = @isInPageList,
|
||||
template = @template,
|
||||
page_text = @text,
|
||||
meta_items = @metaItems
|
||||
WHERE id = @id
|
||||
AND web_log_id = @webLogId"
|
||||
addPageParameters cmd page
|
||||
do! write cmd
|
||||
do! updatePagePermalinks page.Id oldPage.PriorPermalinks page.PriorPermalinks
|
||||
do! Document.update conn ser Table.Page page.Id { page with Revisions = [] }
|
||||
do! updatePageRevisions page.Id oldPage.Revisions page.Revisions
|
||||
return ()
|
||||
| None -> return ()
|
||||
| None -> ()
|
||||
}
|
||||
|
||||
/// Update a page's prior permalinks
|
||||
let updatePriorPermalinks pageId webLogId permalinks = backgroundTask {
|
||||
match! findFullById pageId webLogId with
|
||||
| Some page ->
|
||||
do! updatePagePermalinks pageId page.PriorPermalinks permalinks
|
||||
let updatePriorPermalinks pageId webLogId (permalinks: Permalink list) = backgroundTask {
|
||||
log.LogTrace "Page.updatePriorPermalinks"
|
||||
match! findById pageId webLogId with
|
||||
| Some _ ->
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- $"
|
||||
UPDATE {Table.Page}
|
||||
SET data = json_set(data, '$.{nameof Page.Empty.PriorPermalinks}', json(@links))
|
||||
WHERE {Query.whereById}"
|
||||
addDocId cmd pageId
|
||||
addParam cmd "@links" (Utils.serialize ser permalinks)
|
||||
do! write cmd
|
||||
return true
|
||||
| None -> return false
|
||||
}
|
||||
|
||||
@ -2,265 +2,105 @@ namespace MyWebLog.Data.SQLite
|
||||
|
||||
open System.Threading.Tasks
|
||||
open Microsoft.Data.Sqlite
|
||||
open Microsoft.Extensions.Logging
|
||||
open MyWebLog
|
||||
open MyWebLog.Data
|
||||
open Newtonsoft.Json
|
||||
open NodaTime
|
||||
|
||||
/// SQLite myWebLog post data implementation
|
||||
type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
|
||||
type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) =
|
||||
|
||||
/// The JSON field for the post's permalink
|
||||
let linkField = $"data ->> '{nameof Post.Empty.Permalink}'"
|
||||
|
||||
/// The JSON field for when the post was published
|
||||
let publishField = $"data ->> '{nameof Post.Empty.PublishedOn}'"
|
||||
|
||||
/// The JSON field for post status
|
||||
let statField = $"data ->> '{nameof Post.Empty.Status}'"
|
||||
|
||||
// SUPPORT FUNCTIONS
|
||||
|
||||
/// Add parameters for post INSERT or UPDATE statements
|
||||
let addPostParameters (cmd: SqliteCommand) (post: Post) =
|
||||
[ cmd.Parameters.AddWithValue ("@id", string post.Id)
|
||||
cmd.Parameters.AddWithValue ("@webLogId", string post.WebLogId)
|
||||
cmd.Parameters.AddWithValue ("@authorId", string post.AuthorId)
|
||||
cmd.Parameters.AddWithValue ("@status", string post.Status)
|
||||
cmd.Parameters.AddWithValue ("@title", post.Title)
|
||||
cmd.Parameters.AddWithValue ("@permalink", string post.Permalink)
|
||||
cmd.Parameters.AddWithValue ("@publishedOn", maybeInstant post.PublishedOn)
|
||||
cmd.Parameters.AddWithValue ("@updatedOn", instantParam post.UpdatedOn)
|
||||
cmd.Parameters.AddWithValue ("@template", maybe post.Template)
|
||||
cmd.Parameters.AddWithValue ("@text", post.Text)
|
||||
cmd.Parameters.AddWithValue ("@episode", maybe (if Option.isSome post.Episode then
|
||||
Some (Utils.serialize ser post.Episode)
|
||||
else None))
|
||||
cmd.Parameters.AddWithValue ("@metaItems", maybe (if List.isEmpty post.Metadata then None
|
||||
else Some (Utils.serialize ser post.Metadata)))
|
||||
] |> ignore
|
||||
|
||||
/// Append category IDs and tags to a post
|
||||
let appendPostCategoryAndTag (post: Post) = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.Parameters.AddWithValue ("@id", string post.Id) |> ignore
|
||||
|
||||
cmd.CommandText <- "SELECT category_id AS id FROM post_category WHERE post_id = @id"
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let post = { post with CategoryIds = toList Map.toCategoryId rdr }
|
||||
do! rdr.CloseAsync ()
|
||||
|
||||
cmd.CommandText <- "SELECT tag FROM post_tag WHERE post_id = @id"
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return { post with Tags = toList (Map.getString "tag") rdr }
|
||||
/// Append revisions to a post
|
||||
let appendPostRevisions (post: Post) = backgroundTask {
|
||||
log.LogTrace "Post.appendPostRevisions"
|
||||
let! revisions = Revisions.findByEntityId conn Table.PostRevision Table.Post post.Id
|
||||
return { post with Revisions = revisions }
|
||||
}
|
||||
|
||||
/// Append revisions and permalinks to a post
|
||||
let appendPostRevisionsAndPermalinks (post: Post) = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.Parameters.AddWithValue ("@postId", string post.Id) |> ignore
|
||||
/// The SELECT statement to retrieve posts with a web log ID parameter
|
||||
let postByWebLog = $"{Query.selectFromTable Table.Post} WHERE {Query.whereByWebLog}"
|
||||
|
||||
cmd.CommandText <- "SELECT permalink FROM post_permalink WHERE post_id = @postId"
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let post = { post with PriorPermalinks = toList Map.toPermalink rdr }
|
||||
do! rdr.CloseAsync ()
|
||||
/// The SELECT statement to retrieve published posts with a web log ID parameter
|
||||
let publishedPostByWebLog = $"{postByWebLog} AND {statField} = '{string Published}'"
|
||||
|
||||
cmd.CommandText <- "SELECT as_of, revision_text FROM post_revision WHERE post_id = @postId ORDER BY as_of DESC"
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return { post with Revisions = toList Map.toRevision rdr }
|
||||
}
|
||||
|
||||
/// The SELECT statement for a post that will include episode data, if it exists
|
||||
let selectPost = "SELECT p.* FROM post p"
|
||||
|
||||
/// Shorthand for mapping a data reader to a post
|
||||
let toPost =
|
||||
Map.toPost ser
|
||||
|
||||
/// Find just-the-post by its ID for the given web log (excludes category, tag, meta, revisions, and permalinks)
|
||||
let findPostById (postId: PostId) webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- $"{selectPost} WHERE p.id = @id"
|
||||
cmd.Parameters.AddWithValue ("@id", string postId) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return verifyWebLog<Post> webLogId (_.WebLogId) toPost rdr
|
||||
}
|
||||
|
||||
/// Return a post with no revisions, prior permalinks, or text
|
||||
let postWithoutText rdr =
|
||||
{ toPost rdr with Text = "" }
|
||||
|
||||
/// Update a post's assigned categories
|
||||
let updatePostCategories (postId: PostId) oldCats newCats = backgroundTask {
|
||||
let toDelete, toAdd = Utils.diffLists<CategoryId, string> oldCats newCats string
|
||||
if List.isEmpty toDelete && List.isEmpty toAdd then
|
||||
return ()
|
||||
else
|
||||
use cmd = conn.CreateCommand ()
|
||||
[ cmd.Parameters.AddWithValue ("@postId", string postId)
|
||||
cmd.Parameters.Add ("@categoryId", SqliteType.Text)
|
||||
] |> ignore
|
||||
let runCmd (catId: CategoryId) = backgroundTask {
|
||||
cmd.Parameters["@categoryId"].Value <- string catId
|
||||
do! write cmd
|
||||
}
|
||||
cmd.CommandText <- "DELETE FROM post_category WHERE post_id = @postId AND category_id = @categoryId"
|
||||
toDelete
|
||||
|> List.map runCmd
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
cmd.CommandText <- "INSERT INTO post_category VALUES (@postId, @categoryId)"
|
||||
toAdd
|
||||
|> List.map runCmd
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
}
|
||||
|
||||
/// Update a post's assigned categories
|
||||
let updatePostTags (postId: PostId) (oldTags: string list) newTags = backgroundTask {
|
||||
let toDelete, toAdd = Utils.diffLists oldTags newTags id
|
||||
if List.isEmpty toDelete && List.isEmpty toAdd then
|
||||
return ()
|
||||
else
|
||||
use cmd = conn.CreateCommand ()
|
||||
[ cmd.Parameters.AddWithValue ("@postId", string postId)
|
||||
cmd.Parameters.Add ("@tag", SqliteType.Text)
|
||||
] |> ignore
|
||||
let runCmd (tag: string) = backgroundTask {
|
||||
cmd.Parameters["@tag"].Value <- tag
|
||||
do! write cmd
|
||||
}
|
||||
cmd.CommandText <- "DELETE FROM post_tag WHERE post_id = @postId AND tag = @tag"
|
||||
toDelete
|
||||
|> List.map runCmd
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
cmd.CommandText <- "INSERT INTO post_tag VALUES (@postId, @tag)"
|
||||
toAdd
|
||||
|> List.map runCmd
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
}
|
||||
|
||||
/// Update a post's prior permalinks
|
||||
let updatePostPermalinks (postId: PostId) oldLinks newLinks = backgroundTask {
|
||||
let toDelete, toAdd = Utils.diffPermalinks oldLinks newLinks
|
||||
if List.isEmpty toDelete && List.isEmpty toAdd then
|
||||
return ()
|
||||
else
|
||||
use cmd = conn.CreateCommand ()
|
||||
[ cmd.Parameters.AddWithValue ("@postId", string postId)
|
||||
cmd.Parameters.Add ("@link", SqliteType.Text)
|
||||
] |> ignore
|
||||
let runCmd (link: Permalink) = backgroundTask {
|
||||
cmd.Parameters["@link"].Value <- string link
|
||||
do! write cmd
|
||||
}
|
||||
cmd.CommandText <- "DELETE FROM post_permalink WHERE post_id = @postId AND permalink = @link"
|
||||
toDelete
|
||||
|> List.map runCmd
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
cmd.CommandText <- "INSERT INTO post_permalink VALUES (@postId, @link)"
|
||||
toAdd
|
||||
|> List.map runCmd
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
}
|
||||
/// Remove the text from a post
|
||||
let withoutText (post: Post) =
|
||||
{ post with Text = "" }
|
||||
|
||||
/// Update a post's revisions
|
||||
let updatePostRevisions (postId: PostId) oldRevs newRevs = backgroundTask {
|
||||
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
|
||||
if List.isEmpty toDelete && List.isEmpty toAdd then
|
||||
return ()
|
||||
else
|
||||
use cmd = conn.CreateCommand ()
|
||||
let runCmd withText rev = backgroundTask {
|
||||
cmd.Parameters.Clear ()
|
||||
[ cmd.Parameters.AddWithValue ("@postId", string postId)
|
||||
cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf)
|
||||
] |> ignore
|
||||
if withText then cmd.Parameters.AddWithValue ("@text", string rev.Text) |> ignore
|
||||
do! write cmd
|
||||
}
|
||||
cmd.CommandText <- "DELETE FROM post_revision WHERE post_id = @postId AND as_of = @asOf"
|
||||
toDelete
|
||||
|> List.map (runCmd false)
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
cmd.CommandText <- "INSERT INTO post_revision VALUES (@postId, @asOf, @text)"
|
||||
toAdd
|
||||
|> List.map (runCmd true)
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
}
|
||||
let updatePostRevisions (postId: PostId) oldRevs newRevs =
|
||||
log.LogTrace "Post.updatePostRevisions"
|
||||
Revisions.update conn Table.PostRevision Table.Post postId oldRevs newRevs
|
||||
|
||||
// IMPLEMENTATION FUNCTIONS
|
||||
|
||||
/// Add a post
|
||||
let add post = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"INSERT INTO post (
|
||||
id, web_log_id, author_id, status, title, permalink, published_on, updated_on, template, post_text,
|
||||
episode, meta_items
|
||||
) VALUES (
|
||||
@id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn, @template, @text,
|
||||
@episode, @metaItems
|
||||
)"
|
||||
addPostParameters cmd post
|
||||
do! write cmd
|
||||
do! updatePostCategories post.Id [] post.CategoryIds
|
||||
do! updatePostTags post.Id [] post.Tags
|
||||
do! updatePostPermalinks post.Id [] post.PriorPermalinks
|
||||
let add (post: Post) = backgroundTask {
|
||||
log.LogTrace "Post.add"
|
||||
do! Document.insert conn ser Table.Post { post with Revisions = [] }
|
||||
do! updatePostRevisions post.Id [] post.Revisions
|
||||
}
|
||||
|
||||
/// Count posts in a status for the given web log
|
||||
let countByStatus (status: PostStatus) webLogId = backgroundTask {
|
||||
log.LogTrace "Post.countByStatus"
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- "SELECT COUNT(id) FROM post WHERE web_log_id = @webLogId AND status = @status"
|
||||
cmd.CommandText <- $"{Query.countByWebLog Table.Post} AND {statField} = @status"
|
||||
addWebLogId cmd webLogId
|
||||
cmd.Parameters.AddWithValue ("@status", string status) |> ignore
|
||||
addParam cmd "@status" (string status)
|
||||
return! count cmd
|
||||
}
|
||||
|
||||
/// Find a post by its ID for the given web log (excluding revisions and prior permalinks
|
||||
let findById postId webLogId = backgroundTask {
|
||||
match! findPostById postId webLogId with
|
||||
| Some post ->
|
||||
let! post = appendPostCategoryAndTag post
|
||||
return Some post
|
||||
| None -> return None
|
||||
}
|
||||
let findById postId webLogId =
|
||||
log.LogTrace "Post.findById"
|
||||
Document.findByIdAndWebLog<PostId, Post> conn ser Table.Post postId webLogId
|
||||
|
||||
/// Find a post by its permalink for the given web log (excluding revisions and prior permalinks)
|
||||
let findByPermalink (permalink: Permalink) webLogId = backgroundTask {
|
||||
log.LogTrace "Post.findByPermalink"
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- $"{selectPost} WHERE p.web_log_id = @webLogId AND p.permalink = @link"
|
||||
cmd.CommandText <- $"{Query.selectFromTable Table.Post} WHERE {Query.whereByWebLog} AND {linkField} = @link"
|
||||
addWebLogId cmd webLogId
|
||||
cmd.Parameters.AddWithValue ("@link", string permalink) |> ignore
|
||||
addParam cmd "@link" (string permalink)
|
||||
use! rdr = cmd.ExecuteReaderAsync()
|
||||
if rdr.Read () then
|
||||
let! post = appendPostCategoryAndTag (toPost rdr)
|
||||
return Some post
|
||||
else
|
||||
return None
|
||||
let! isFound = rdr.ReadAsync()
|
||||
return if isFound then Some (Map.fromDoc<Post> ser rdr) else None
|
||||
}
|
||||
|
||||
/// Find a complete post by its ID for the given web log
|
||||
let findFullById postId webLogId = backgroundTask {
|
||||
log.LogTrace "Post.findFullById"
|
||||
match! findById postId webLogId with
|
||||
| Some post ->
|
||||
let! post = appendPostRevisionsAndPermalinks post
|
||||
let! post = appendPostRevisions post
|
||||
return Some post
|
||||
| None -> return None
|
||||
}
|
||||
|
||||
/// Delete a post by its ID for the given web log
|
||||
let delete postId webLogId = backgroundTask {
|
||||
match! findFullById postId webLogId with
|
||||
log.LogTrace "Post.delete"
|
||||
match! findById postId webLogId with
|
||||
| Some _ ->
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.Parameters.AddWithValue ("@id", string postId) |> ignore
|
||||
cmd.CommandText <-
|
||||
"DELETE FROM post_revision WHERE post_id = @id;
|
||||
DELETE FROM post_permalink WHERE post_id = @id;
|
||||
DELETE FROM post_tag WHERE post_id = @id;
|
||||
DELETE FROM post_category WHERE post_id = @id;
|
||||
DELETE FROM post_comment WHERE post_id = @id;
|
||||
DELETE FROM post WHERE id = @id"
|
||||
cmd.CommandText <- $"
|
||||
DELETE FROM {Table.PostRevision} WHERE post_id = @id;
|
||||
DELETE FROM {Table.PostComment} WHERE data ->> '{nameof Comment.Empty.PostId}' = @id;
|
||||
DELETE FROM {Table.Post} WHERE {Query.whereById}"
|
||||
addDocId cmd postId
|
||||
do! write cmd
|
||||
return true
|
||||
| None -> return false
|
||||
@ -268,161 +108,105 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
|
||||
|
||||
/// Find the current permalink from a list of potential prior permalinks for the given web log
|
||||
let findCurrentPermalink (permalinks: Permalink list) webLogId = backgroundTask {
|
||||
log.LogTrace "Post.findCurrentPermalink"
|
||||
let linkSql, linkParams = inJsonArray Table.Post (nameof Post.Empty.PriorPermalinks) "link" permalinks
|
||||
use cmd = conn.CreateCommand()
|
||||
let linkSql, linkParams = inClause "AND pp.permalink" "link" string permalinks
|
||||
cmd.CommandText <- $"
|
||||
SELECT p.permalink
|
||||
FROM post p
|
||||
INNER JOIN post_permalink pp ON pp.post_id = p.id
|
||||
WHERE p.web_log_id = @webLogId
|
||||
{linkSql}"
|
||||
cmd.CommandText <-
|
||||
$"SELECT {linkField} AS permalink FROM {Table.Post} WHERE {Query.whereByWebLog} AND {linkSql}"
|
||||
addWebLogId cmd webLogId
|
||||
cmd.Parameters.AddRange linkParams
|
||||
use! rdr = cmd.ExecuteReaderAsync()
|
||||
return if rdr.Read () then Some (Map.toPermalink rdr) else None
|
||||
let! isFound = rdr.ReadAsync()
|
||||
return if isFound then Some (Map.toPermalink rdr) else None
|
||||
}
|
||||
|
||||
/// Get all complete posts for the given web log
|
||||
let findFullByWebLog webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- $"{selectPost} WHERE p.web_log_id = @webLogId"
|
||||
addWebLogId cmd webLogId
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let! posts =
|
||||
toList toPost rdr
|
||||
|> List.map (fun post -> backgroundTask {
|
||||
let! post = appendPostCategoryAndTag post
|
||||
return! appendPostRevisionsAndPermalinks post
|
||||
})
|
||||
log.LogTrace "Post.findFullByWebLog"
|
||||
let! posts = Document.findByWebLog<Post> conn ser Table.Post webLogId
|
||||
let! withRevs =
|
||||
posts
|
||||
|> List.map (fun post -> backgroundTask { return! appendPostRevisions post })
|
||||
|> Task.WhenAll
|
||||
return List.ofArray posts
|
||||
return List.ofArray withRevs
|
||||
}
|
||||
|
||||
/// Get a page of categorized posts for the given web log (excludes revisions and prior permalinks)
|
||||
let findPageOfCategorizedPosts webLogId (categoryIds: CategoryId list) pageNbr postsPerPage = backgroundTask {
|
||||
/// Get a page of categorized posts for the given web log (excludes revisions)
|
||||
let findPageOfCategorizedPosts webLogId (categoryIds: CategoryId list) pageNbr postsPerPage =
|
||||
log.LogTrace "Post.findPageOfCategorizedPosts"
|
||||
let catSql, catParams = inJsonArray Table.Post (nameof Post.Empty.CategoryIds) "catId" categoryIds
|
||||
use cmd = conn.CreateCommand ()
|
||||
let catSql, catParams = inClause "AND pc.category_id" "catId" string categoryIds
|
||||
cmd.CommandText <- $"
|
||||
{selectPost}
|
||||
INNER JOIN post_category pc ON pc.post_id = p.id
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND p.status = @status
|
||||
{catSql}
|
||||
ORDER BY published_on DESC
|
||||
{publishedPostByWebLog} AND {catSql}
|
||||
ORDER BY {publishField} DESC
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|
||||
addWebLogId cmd webLogId
|
||||
cmd.Parameters.AddWithValue ("@status", string Published) |> ignore
|
||||
cmd.Parameters.AddRange catParams
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let! posts =
|
||||
toList toPost rdr
|
||||
|> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post })
|
||||
|> Task.WhenAll
|
||||
return List.ofArray posts
|
||||
}
|
||||
cmdToList<Post> cmd ser
|
||||
|
||||
/// Get a page of posts for the given web log (excludes text, revisions, and prior permalinks)
|
||||
/// Get a page of posts for the given web log (excludes revisions)
|
||||
let findPageOfPosts webLogId pageNbr postsPerPage = backgroundTask {
|
||||
log.LogTrace "Post.findPageOfPosts"
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- $"
|
||||
{selectPost}
|
||||
WHERE p.web_log_id = @webLogId
|
||||
ORDER BY p.published_on DESC NULLS FIRST, p.updated_on
|
||||
{postByWebLog}
|
||||
ORDER BY {publishField} DESC NULLS FIRST, data ->> '{nameof Post.Empty.UpdatedOn}'
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|
||||
addWebLogId cmd webLogId
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let! posts =
|
||||
toList postWithoutText rdr
|
||||
|> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post })
|
||||
|> Task.WhenAll
|
||||
return List.ofArray posts
|
||||
let! posts = cmdToList<Post> cmd ser
|
||||
return posts |> List.map withoutText
|
||||
}
|
||||
|
||||
/// Get a page of published posts for the given web log (excludes revisions and prior permalinks)
|
||||
let findPageOfPublishedPosts webLogId pageNbr postsPerPage = backgroundTask {
|
||||
/// Get a page of published posts for the given web log (excludes revisions)
|
||||
let findPageOfPublishedPosts webLogId pageNbr postsPerPage =
|
||||
log.LogTrace "Post.findPageOfPublishedPosts"
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- $"
|
||||
{selectPost}
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND p.status = @status
|
||||
{publishedPostByWebLog}
|
||||
ORDER BY {publishField} DESC
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|
||||
addWebLogId cmd webLogId
|
||||
cmdToList<Post> cmd ser
|
||||
|
||||
/// Get a page of tagged posts for the given web log (excludes revisions)
|
||||
let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage =
|
||||
log.LogTrace "Post.findPageOfTaggedPosts"
|
||||
let tagSql, tagParams = inJsonArray Table.Post (nameof Post.Empty.Tags) "tag" [ tag ]
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- $"
|
||||
{publishedPostByWebLog} AND {tagSql}
|
||||
ORDER BY p.published_on DESC
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|
||||
addWebLogId cmd webLogId
|
||||
cmd.Parameters.AddWithValue ("@status", string Published) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let! posts =
|
||||
toList toPost rdr
|
||||
|> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post })
|
||||
|> Task.WhenAll
|
||||
return List.ofArray posts
|
||||
}
|
||||
|
||||
/// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks)
|
||||
let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- $"
|
||||
{selectPost}
|
||||
INNER JOIN post_tag pt ON pt.post_id = p.id
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND p.status = @status
|
||||
AND pt.tag = @tag
|
||||
ORDER BY p.published_on DESC
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|
||||
addWebLogId cmd webLogId
|
||||
[ cmd.Parameters.AddWithValue ("@status", string Published)
|
||||
cmd.Parameters.AddWithValue ("@tag", tag)
|
||||
] |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let! posts =
|
||||
toList toPost rdr
|
||||
|> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post })
|
||||
|> Task.WhenAll
|
||||
return List.ofArray posts
|
||||
}
|
||||
cmd.Parameters.AddRange tagParams
|
||||
cmdToList<Post> cmd ser
|
||||
|
||||
/// Find the next newest and oldest post from a publish date for the given web log
|
||||
let findSurroundingPosts webLogId (publishedOn : Instant) = backgroundTask {
|
||||
log.LogTrace "Post.findSurroundingPosts"
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- $"
|
||||
{selectPost}
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND p.status = @status
|
||||
AND p.published_on < @publishedOn
|
||||
ORDER BY p.published_on DESC
|
||||
LIMIT 1"
|
||||
addWebLogId cmd webLogId
|
||||
[ cmd.Parameters.AddWithValue ("@status", string Published)
|
||||
cmd.Parameters.AddWithValue ("@publishedOn", instantParam publishedOn)
|
||||
] |> ignore
|
||||
addParam cmd "@publishedOn" (instantParam publishedOn)
|
||||
|
||||
cmd.CommandText <-
|
||||
$"{publishedPostByWebLog} AND {publishField} < @publishedOn ORDER BY {publishField} DESC LIMIT 1"
|
||||
use! rdr = cmd.ExecuteReaderAsync()
|
||||
let! older = backgroundTask {
|
||||
if rdr.Read () then
|
||||
let! post = appendPostCategoryAndTag (postWithoutText rdr)
|
||||
return Some post
|
||||
else
|
||||
return None
|
||||
}
|
||||
let! isFound = rdr.ReadAsync()
|
||||
let older = if isFound then Some (Map.fromDoc<Post> ser rdr) else None
|
||||
do! rdr.CloseAsync ()
|
||||
cmd.CommandText <- $"
|
||||
{selectPost}
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND p.status = @status
|
||||
AND p.published_on > @publishedOn
|
||||
ORDER BY p.published_on
|
||||
LIMIT 1"
|
||||
|
||||
cmd.CommandText <-
|
||||
$"{publishedPostByWebLog} AND {publishField} > @publishedOn ORDER BY {publishField} LIMIT 1"
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let! newer = backgroundTask {
|
||||
if rdr.Read () then
|
||||
let! post = appendPostCategoryAndTag (postWithoutText rdr)
|
||||
return Some post
|
||||
else
|
||||
return None
|
||||
}
|
||||
let! isFound = rdr.ReadAsync()
|
||||
let newer = if isFound then Some (Map.fromDoc<Post> ser rdr) else None
|
||||
|
||||
return older, newer
|
||||
}
|
||||
|
||||
/// Restore posts from a backup
|
||||
let restore posts = backgroundTask {
|
||||
log.LogTrace "Post.restore"
|
||||
for post in posts do
|
||||
do! add post
|
||||
}
|
||||
@ -431,35 +215,23 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
|
||||
let update (post: Post) = backgroundTask {
|
||||
match! findFullById post.Id post.WebLogId with
|
||||
| Some oldPost ->
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"UPDATE post
|
||||
SET author_id = @authorId,
|
||||
status = @status,
|
||||
title = @title,
|
||||
permalink = @permalink,
|
||||
published_on = @publishedOn,
|
||||
updated_on = @updatedOn,
|
||||
template = @template,
|
||||
post_text = @text,
|
||||
episode = @episode,
|
||||
meta_items = @metaItems
|
||||
WHERE id = @id
|
||||
AND web_log_id = @webLogId"
|
||||
addPostParameters cmd post
|
||||
do! write cmd
|
||||
do! updatePostCategories post.Id oldPost.CategoryIds post.CategoryIds
|
||||
do! updatePostTags post.Id oldPost.Tags post.Tags
|
||||
do! updatePostPermalinks post.Id oldPost.PriorPermalinks post.PriorPermalinks
|
||||
do! Document.update conn ser Table.Post post.Id { post with Revisions = [] }
|
||||
do! updatePostRevisions post.Id oldPost.Revisions post.Revisions
|
||||
| None -> return ()
|
||||
}
|
||||
|
||||
/// Update prior permalinks for a post
|
||||
let updatePriorPermalinks postId webLogId permalinks = backgroundTask {
|
||||
match! findFullById postId webLogId with
|
||||
| Some post ->
|
||||
do! updatePostPermalinks postId post.PriorPermalinks permalinks
|
||||
let updatePriorPermalinks postId webLogId (permalinks: Permalink list) = backgroundTask {
|
||||
match! findById postId webLogId with
|
||||
| Some _ ->
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- $"
|
||||
UPDATE {Table.Post}
|
||||
SET data = json_set(data, '$.{nameof Post.Empty.PriorPermalinks}', json(@links))
|
||||
WHERE {Query.whereById}"
|
||||
addDocId cmd postId
|
||||
addParam cmd "@links" (Utils.serialize ser permalinks)
|
||||
do! write cmd
|
||||
return true
|
||||
| None -> return false
|
||||
}
|
||||
|
||||
@ -1,95 +1,70 @@
|
||||
namespace MyWebLog.Data.SQLite
|
||||
|
||||
open Microsoft.Data.Sqlite
|
||||
open Microsoft.Extensions.Logging
|
||||
open MyWebLog
|
||||
open MyWebLog.Data
|
||||
open Newtonsoft.Json
|
||||
|
||||
/// SQLite myWebLog tag mapping data implementation
|
||||
type SQLiteTagMapData (conn : SqliteConnection) =
|
||||
type SQLiteTagMapData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) =
|
||||
|
||||
/// Find a tag mapping by its ID for the given web log
|
||||
let findById (tagMapId: TagMapId) webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- "SELECT * FROM tag_map WHERE id = @id"
|
||||
cmd.Parameters.AddWithValue ("@id", string tagMapId) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync()
|
||||
return verifyWebLog<TagMap> webLogId (_.WebLogId) Map.toTagMap rdr
|
||||
}
|
||||
let findById tagMapId webLogId =
|
||||
log.LogTrace "TagMap.findById"
|
||||
Document.findByIdAndWebLog<TagMapId, TagMap> conn ser Table.TagMap tagMapId webLogId
|
||||
|
||||
/// Delete a tag mapping for the given web log
|
||||
let delete tagMapId webLogId = backgroundTask {
|
||||
log.LogTrace "TagMap.delete"
|
||||
match! findById tagMapId webLogId with
|
||||
| Some _ ->
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "DELETE FROM tag_map WHERE id = @id"
|
||||
cmd.Parameters.AddWithValue ("@id", string tagMapId) |> ignore
|
||||
do! write cmd
|
||||
do! Document.delete conn Table.TagMap tagMapId
|
||||
return true
|
||||
| None -> return false
|
||||
}
|
||||
|
||||
/// Find a tag mapping by its URL value for the given web log
|
||||
let findByUrlValue (urlValue: string) webLogId = backgroundTask {
|
||||
log.LogTrace "TagMap.findByUrlValue"
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- "SELECT * FROM tag_map WHERE web_log_id = @webLogId AND url_value = @urlValue"
|
||||
cmd.CommandText <- $"
|
||||
{Query.selectFromTable Table.TagMap}
|
||||
WHERE {Query.whereByWebLog}
|
||||
AND data ->> '{nameof TagMap.Empty.UrlValue}' = @urlValue"
|
||||
addWebLogId cmd webLogId
|
||||
cmd.Parameters.AddWithValue ("@urlValue", urlValue) |> ignore
|
||||
addParam cmd "@urlValue" urlValue
|
||||
use! rdr = cmd.ExecuteReaderAsync()
|
||||
return if rdr.Read () then Some (Map.toTagMap rdr) else None
|
||||
let! isFound = rdr.ReadAsync()
|
||||
return if isFound then Some (Map.fromDoc<TagMap> ser rdr) else None
|
||||
}
|
||||
|
||||
/// Get all tag mappings for the given web log
|
||||
let findByWebLog webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM tag_map WHERE web_log_id = @webLogId ORDER BY tag"
|
||||
addWebLogId cmd webLogId
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return toList Map.toTagMap rdr
|
||||
}
|
||||
let findByWebLog webLogId =
|
||||
log.LogTrace "TagMap.findByWebLog"
|
||||
Document.findByWebLog<TagMap> conn ser Table.TagMap webLogId
|
||||
|
||||
/// Find any tag mappings in a list of tags for the given web log
|
||||
let findMappingForTags (tags : string list) webLogId = backgroundTask {
|
||||
let findMappingForTags (tags: string list) webLogId =
|
||||
log.LogTrace "TagMap.findMappingForTags"
|
||||
use cmd = conn.CreateCommand ()
|
||||
let mapSql, mapParams = inClause "AND tag" "tag" id tags
|
||||
cmd.CommandText <- $"
|
||||
SELECT *
|
||||
FROM tag_map
|
||||
WHERE web_log_id = @webLogId
|
||||
{mapSql}"
|
||||
let mapSql, mapParams = inClause $"AND data ->> '{nameof TagMap.Empty.Tag}'" "tag" id tags
|
||||
cmd.CommandText <- $"{Query.selectFromTable Table.TagMap} WHERE {Query.whereByWebLog} {mapSql}"
|
||||
addWebLogId cmd webLogId
|
||||
cmd.Parameters.AddRange mapParams
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return toList Map.toTagMap rdr
|
||||
}
|
||||
cmdToList<TagMap> cmd ser
|
||||
|
||||
/// Save a tag mapping
|
||||
let save (tagMap: TagMap) = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
log.LogTrace "TagMap.save"
|
||||
match! findById tagMap.Id tagMap.WebLogId with
|
||||
| Some _ ->
|
||||
cmd.CommandText <-
|
||||
"UPDATE tag_map
|
||||
SET tag = @tag,
|
||||
url_value = @urlValue
|
||||
WHERE id = @id
|
||||
AND web_log_id = @webLogId"
|
||||
| None ->
|
||||
cmd.CommandText <-
|
||||
"INSERT INTO tag_map (
|
||||
id, web_log_id, tag, url_value
|
||||
) VALUES (
|
||||
@id, @webLogId, @tag, @urlValue
|
||||
)"
|
||||
addWebLogId cmd tagMap.WebLogId
|
||||
[ cmd.Parameters.AddWithValue ("@id", string tagMap.Id)
|
||||
cmd.Parameters.AddWithValue ("@tag", tagMap.Tag)
|
||||
cmd.Parameters.AddWithValue ("@urlValue", tagMap.UrlValue)
|
||||
] |> ignore
|
||||
do! write cmd
|
||||
| Some _ -> do! Document.update conn ser Table.TagMap tagMap.Id tagMap
|
||||
| None -> do! Document.insert conn ser Table.TagMap tagMap
|
||||
}
|
||||
|
||||
/// Restore tag mappings from a backup
|
||||
let restore tagMaps = backgroundTask {
|
||||
log.LogTrace "TagMap.restore"
|
||||
for tagMap in tagMaps do
|
||||
do! save tagMap
|
||||
}
|
||||
|
||||
@ -29,7 +29,7 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
|
||||
|
||||
let jsonTable table =
|
||||
$"CREATE TABLE {table} (data TEXT NOT NULL);
|
||||
CREATE UNIQUE INDEX idx_{table}_key ON {table} (data ->> 'Id')"
|
||||
CREATE UNIQUE INDEX idx_{table}_key ON {table} ((data ->> 'Id'))"
|
||||
|
||||
seq {
|
||||
// Theme tables
|
||||
@ -48,18 +48,20 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
|
||||
// Category table
|
||||
if needsTable Table.Category then
|
||||
$"{jsonTable Table.Category};
|
||||
CREATE INDEX idx_{Table.Category}_web_log ON {Table.Category} (data ->> 'WebLogId')"
|
||||
CREATE INDEX idx_{Table.Category}_web_log ON {Table.Category} ((data ->> 'WebLogId'))"
|
||||
|
||||
// Web log user table
|
||||
if needsTable Table.WebLogUser then
|
||||
$"{jsonTable Table.WebLogUser};
|
||||
CREATE INDEX idx_{Table.WebLogUser}_email ON {Table.WebLogUser} (data ->> 'WebLogId', data ->> 'Email')"
|
||||
CREATE INDEX idx_{Table.WebLogUser}_email
|
||||
ON {Table.WebLogUser} ((data ->> 'WebLogId'), (data ->> 'Email'))"
|
||||
|
||||
// Page tables
|
||||
if needsTable Table.Page then
|
||||
$"{jsonTable Table.Page};
|
||||
CREATE INDEX idx_{Table.Page}_author ON {Table.Page} (data ->> 'AuthorId');
|
||||
CREATE INDEX idx_{Table.Page}_permalink ON {Table.Page} (data ->> 'WebLogId', data ->> 'Permalink')"
|
||||
CREATE INDEX idx_{Table.Page}_author ON {Table.Page} ((data ->> 'AuthorId'));
|
||||
CREATE INDEX idx_{Table.Page}_permalink
|
||||
ON {Table.Page} ((data ->> 'WebLogId'), (data ->> 'Permalink'))"
|
||||
if needsTable Table.PageRevision then
|
||||
"CREATE TABLE page_revision (
|
||||
page_id TEXT NOT NULL,
|
||||
@ -70,9 +72,11 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
|
||||
// Post tables
|
||||
if needsTable Table.Post then
|
||||
$"{jsonTable Table.Post};
|
||||
CREATE INDEX idx_{Table.Post}_author ON {Table.Post} (data ->> 'AuthorId');
|
||||
CREATE INDEX idx_{Table.Post}_status ON {Table.Post} (data ->> 'WebLogId', data ->> 'Status', data ->> 'UpdatedOn');
|
||||
CREATE INDEX idx_{Table.Post}_permalink ON {Table.Post} (data ->> 'WebLogId', data ->> 'Permalink')"
|
||||
CREATE INDEX idx_{Table.Post}_author ON {Table.Post} ((data ->> 'AuthorId'));
|
||||
CREATE INDEX idx_{Table.Post}_status
|
||||
ON {Table.Post} ((data ->> 'WebLogId'), (data ->> 'Status'), (data ->> 'UpdatedOn'));
|
||||
CREATE INDEX idx_{Table.Post}_permalink
|
||||
ON {Table.Post} ((data ->> 'WebLogId'), (data ->> 'Permalink'))"
|
||||
// TODO: index categories by post?
|
||||
if needsTable Table.PostRevision then
|
||||
$"CREATE TABLE {Table.PostRevision} (
|
||||
@ -82,12 +86,12 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
|
||||
PRIMARY KEY (post_id, as_of))"
|
||||
if needsTable Table.PostComment then
|
||||
$"{jsonTable Table.PostComment};
|
||||
CREATE INDEX idx_{Table.PostComment}_post ON {Table.PostComment} (data ->> 'PostId')"
|
||||
CREATE INDEX idx_{Table.PostComment}_post ON {Table.PostComment} ((data ->> 'PostId'))"
|
||||
|
||||
// Tag map table
|
||||
if needsTable Table.TagMap then
|
||||
$"{jsonTable Table.TagMap};
|
||||
CREATE INDEX idx_{Table.TagMap}_tag ON {Table.TagMap} (data ->> 'WebLogId', data ->> 'UrlValue')";
|
||||
CREATE INDEX idx_{Table.TagMap}_tag ON {Table.TagMap} ((data ->> 'WebLogId'), (data ->> 'UrlValue'))"
|
||||
|
||||
// Uploaded file table
|
||||
if needsTable Table.Upload then
|
||||
@ -466,10 +470,10 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
|
||||
|
||||
interface IData with
|
||||
|
||||
member _.Category = SQLiteCategoryData (conn, ser)
|
||||
member _.Page = SQLitePageData (conn, ser)
|
||||
member _.Post = SQLitePostData (conn, ser)
|
||||
member _.TagMap = SQLiteTagMapData conn
|
||||
member _.Category = SQLiteCategoryData (conn, ser, log)
|
||||
member _.Page = SQLitePageData (conn, ser, log)
|
||||
member _.Post = SQLitePostData (conn, ser, log)
|
||||
member _.TagMap = SQLiteTagMapData (conn, ser, log)
|
||||
member _.Theme = SQLiteThemeData conn
|
||||
member _.ThemeAsset = SQLiteThemeAssetData conn
|
||||
member _.Upload = SQLiteUploadData conn
|
||||
@ -484,5 +488,6 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- $"SELECT id FROM {Table.DbVersion}"
|
||||
use! rdr = cmd.ExecuteReaderAsync()
|
||||
do! migrate (if rdr.Read () then Some (Map.getString "id" rdr) else None)
|
||||
let! isFound = rdr.ReadAsync()
|
||||
do! migrate (if isFound then Some (Map.getString "id" rdr) else None)
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user