diff --git a/src/MyWebLog.Data/SQLite/Helpers.fs b/src/MyWebLog.Data/SQLite/Helpers.fs index 70df4b3..9ebabeb 100644 --- a/src/MyWebLog.Data/SQLite/Helpers.fs +++ b/src/MyWebLog.Data/SQLite/Helpers.fs @@ -108,8 +108,25 @@ let maybeDuration = let maybeInstant = Option.map instantParam >> maybe +/// Create the SQL and parameters for an EXISTS applied to a JSON array +let inJsonArray<'T> table jsonField paramName (items: 'T list) = + if List.isEmpty items then "", [] + else + let mutable idx = 0 + items + |> List.skip 1 + |> List.fold (fun (itemS, itemP) it -> + idx <- idx + 1 + $"{itemS}, @%s{paramName}{idx}", (SqliteParameter($"@%s{paramName}{idx}", string it) :: itemP)) + (Seq.ofList items + |> Seq.map (fun it -> $"(@%s{paramName}0", [ SqliteParameter($"@%s{paramName}0", string it) ]) + |> Seq.head) + |> function + sql, ps -> + $"EXISTS (SELECT 1 FROM json_each(%s{table}.data, '$.%s{jsonField}') WHERE value IN {sql}))", ps + /// Create the SQL and parameters for an IN clause -let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items : 'T list) = +let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items: 'T list) = if List.isEmpty items then "", [] else let mutable idx = 0 @@ -131,25 +148,25 @@ module Map = open System.IO /// Get a boolean value from a data reader - let getBoolean col (rdr : SqliteDataReader) = rdr.GetBoolean (rdr.GetOrdinal col) + let getBoolean col (rdr: SqliteDataReader) = rdr.GetBoolean(rdr.GetOrdinal col) /// Get a date/time value from a data reader - let getDateTime col (rdr : SqliteDataReader) = rdr.GetDateTime (rdr.GetOrdinal col) + let getDateTime col (rdr: SqliteDataReader) = rdr.GetDateTime(rdr.GetOrdinal col) /// Get a Guid value from a data reader - let getGuid col (rdr : SqliteDataReader) = rdr.GetGuid (rdr.GetOrdinal col) + let getGuid col (rdr: SqliteDataReader) = rdr.GetGuid(rdr.GetOrdinal col) /// Get an int value from a data reader - let getInt col (rdr : SqliteDataReader) = rdr.GetInt32 (rdr.GetOrdinal col) + let getInt col (rdr: SqliteDataReader) = rdr.GetInt32(rdr.GetOrdinal col) /// Get a long (64-bit int) value from a data reader - let getLong col (rdr : SqliteDataReader) = rdr.GetInt64 (rdr.GetOrdinal col) + let getLong col (rdr: SqliteDataReader) = rdr.GetInt64(rdr.GetOrdinal col) /// Get a BLOB stream value from a data reader - let getStream col (rdr : SqliteDataReader) = rdr.GetStream (rdr.GetOrdinal col) + let getStream col (rdr: SqliteDataReader) = rdr.GetStream(rdr.GetOrdinal col) /// Get a string value from a data reader - let getString col (rdr : SqliteDataReader) = rdr.GetString (rdr.GetOrdinal col) + let getString col (rdr: SqliteDataReader) = rdr.GetString(rdr.GetOrdinal col) /// Parse a Duration from the given value let parseDuration value = @@ -172,27 +189,27 @@ module Map = getString col rdr |> parseInstant /// Get a timespan value from a data reader - let getTimeSpan col (rdr : SqliteDataReader) = rdr.GetTimeSpan (rdr.GetOrdinal col) + let getTimeSpan col (rdr: SqliteDataReader) = rdr.GetTimeSpan(rdr.GetOrdinal col) /// Get a possibly null boolean value from a data reader - let tryBoolean col (rdr : SqliteDataReader) = - if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getBoolean col rdr) + let tryBoolean col (rdr: SqliteDataReader) = + if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getBoolean col rdr) /// Get a possibly null date/time value from a data reader - let tryDateTime col (rdr : SqliteDataReader) = - if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getDateTime col rdr) + let tryDateTime col (rdr: SqliteDataReader) = + if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getDateTime col rdr) /// Get a possibly null Guid value from a data reader - let tryGuid col (rdr : SqliteDataReader) = - if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getGuid col rdr) + let tryGuid col (rdr: SqliteDataReader) = + if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getGuid col rdr) /// Get a possibly null int value from a data reader - let tryInt col (rdr : SqliteDataReader) = - if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getInt col rdr) + let tryInt col (rdr: SqliteDataReader) = + if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getInt col rdr) /// Get a possibly null string value from a data reader - let tryString col (rdr : SqliteDataReader) = - if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getString col rdr) + let tryString col (rdr: SqliteDataReader) = + if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getString col rdr) /// Get a possibly null Duration value from a data reader let tryDuration col rdr = @@ -203,22 +220,12 @@ module Map = tryString col rdr |> Option.map parseInstant /// Get a possibly null timespan value from a data reader - let tryTimeSpan col (rdr : SqliteDataReader) = - if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getTimeSpan col rdr) + let tryTimeSpan col (rdr: SqliteDataReader) = + if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getTimeSpan col rdr) /// Map an id field to a category ID let toCategoryId rdr = getString "id" rdr |> CategoryId - /// Create a category from the current row in the given data reader - let toCategory rdr : Category = - { Id = toCategoryId rdr - WebLogId = getString "web_log_id" rdr |> WebLogId - Name = getString "name" rdr - Slug = getString "slug" rdr - Description = tryString "description" rdr - ParentId = tryString "parent_id" rdr |> Option.map CategoryId - } - /// Create a custom feed from the current row in the given data reader let toCustomFeed ser rdr : CustomFeed = { Id = getString "id" rdr |> CustomFeedId @@ -230,48 +237,10 @@ module Map = /// Create a permalink from the current row in the given data reader let toPermalink rdr = getString "permalink" rdr |> Permalink - /// Create a page from the current row in the given data reader - let toPage ser rdr : Page = - { Page.Empty with - Id = getString "id" rdr |> PageId - WebLogId = getString "web_log_id" rdr |> WebLogId - AuthorId = getString "author_id" rdr |> WebLogUserId - Title = getString "title" rdr - Permalink = toPermalink rdr - PublishedOn = getInstant "published_on" rdr - UpdatedOn = getInstant "updated_on" rdr - IsInPageList = getBoolean "is_in_page_list" rdr - Template = tryString "template" rdr - Text = getString "page_text" rdr - Metadata = tryString "meta_items" rdr - |> Option.map (Utils.deserialize ser) - |> Option.defaultValue [] - } - - /// Create a post from the current row in the given data reader - let toPost ser rdr : Post = - { Post.Empty with - Id = getString "id" rdr |> PostId - WebLogId = getString "web_log_id" rdr |> WebLogId - AuthorId = getString "author_id" rdr |> WebLogUserId - Status = getString "status" rdr |> PostStatus.Parse - Title = getString "title" rdr - Permalink = toPermalink rdr - PublishedOn = tryInstant "published_on" rdr - UpdatedOn = getInstant "updated_on" rdr - Template = tryString "template" rdr - Text = getString "post_text" rdr - Episode = tryString "episode" rdr |> Option.map (Utils.deserialize ser) - Metadata = tryString "meta_items" rdr - |> Option.map (Utils.deserialize ser) - |> Option.defaultValue [] - } - /// Create a revision from the current row in the given data reader let toRevision rdr : Revision = - { AsOf = getInstant "as_of" rdr - Text = getString "revision_text" rdr |> MarkupText.Parse - } + { AsOf = getInstant "as_of" rdr + Text = getString "revision_text" rdr |> MarkupText.Parse } /// Create a tag mapping from the current row in the given data reader let toTagMap rdr : TagMap = @@ -293,16 +262,15 @@ module Map = let toThemeAsset includeData rdr : ThemeAsset = let assetData = if includeData then - use dataStream = new MemoryStream () + use dataStream = new MemoryStream() use blobStream = getStream "data" rdr blobStream.CopyTo dataStream - dataStream.ToArray () + dataStream.ToArray() else [||] - { Id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr) - UpdatedOn = getInstant "updated_on" rdr - Data = assetData - } + { Id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr) + UpdatedOn = getInstant "updated_on" rdr + Data = assetData } /// Create a theme template from the current row in the given data reader let toThemeTemplate includeText rdr : ThemeTemplate = @@ -320,12 +288,11 @@ module Map = dataStream.ToArray () else [||] - { Id = getString "id" rdr |> UploadId - WebLogId = getString "web_log_id" rdr |> WebLogId - Path = getString "path" rdr |> Permalink - UpdatedOn = getInstant "updated_on" rdr - Data = data - } + { Id = getString "id" rdr |> UploadId + WebLogId = getString "web_log_id" rdr |> WebLogId + Path = getString "path" rdr |> Permalink + UpdatedOn = getInstant "updated_on" rdr + Data = data } /// Create a web log from the current row in the given data reader let toWebLog ser rdr : WebLog = @@ -375,17 +342,170 @@ module Map = let fromDoc<'T> ser rdr : 'T = fromData<'T> ser rdr "data" +/// Create a list of items for the results of the given command +let cmdToList<'TDoc> (cmd: SqliteCommand) ser = backgroundTask { + use! rdr = cmd.ExecuteReaderAsync() + let mutable it: 'TDoc list = [] + while! rdr.ReadAsync() do + it <- Map.fromDoc ser rdr :: it + return List.rev it +} + /// Queries to assist with document manipulation module Query = - /// Fragment to add an ID condition to a WHERE clause + /// Fragment to add an ID condition to a WHERE clause (parameter @id) let whereById = "data ->> 'Id' = @id" -/// Fragment to add a web log ID condition to a WHERE clause -let whereWebLogId = - "data ->> 'WebLogId' = @webLogId" + /// Fragment to add a web log ID condition to a WHERE clause (parameter @webLogId) + let whereByWebLog = + "data ->> 'WebLogId' = @webLogId" + + /// A SELECT/FROM pair for the given table + let selectFromTable table = + $"SELECT data FROM %s{table}" + + /// An INSERT statement for a document (parameter @data) + let insert table = + $"INSERT INTO %s{table} VALUES (@data)" + + /// A SELECT query to count documents for a given web log ID + let countByWebLog table = + $"SELECT COUNT(*) FROM %s{table} WHERE {whereByWebLog}" + + /// An UPDATE query to update a full document by its ID (parameters @data and @id) + let updateById table = + $"UPDATE %s{table} SET data = @data WHERE {whereById}" + + /// A DELETE query to delete a document by its ID (parameter @id) + let deleteById table = + $"DELETE FROM %s{table} WHERE {whereById}" + + +let addParam (cmd: SqliteCommand) name (value: obj) = + cmd.Parameters.AddWithValue(name, value) |> ignore + +/// Add an ID parameter for a document +let addDocId<'TKey> (cmd: SqliteCommand) (id: 'TKey) = + addParam cmd "@id" (string id) + +/// Add a document parameter +let addDocParam<'TDoc> (cmd: SqliteCommand) (doc: 'TDoc) ser = + addParam cmd "@data" (Utils.serialize ser doc) /// Add a web log ID parameter let addWebLogId (cmd: SqliteCommand) (webLogId: WebLogId) = - cmd.Parameters.AddWithValue("@webLogId", string webLogId) |> ignore + addParam cmd "@webLogId" (string webLogId) + +/// Functions for manipulating documents +module Document = + + /// Count documents for the given web log ID + let countByWebLog (conn: SqliteConnection) table webLogId = backgroundTask { + use cmd = conn.CreateCommand() + cmd.CommandText <- Query.countByWebLog table + addWebLogId cmd webLogId + return! count cmd + } + + /// Find a document by its ID and web log ID + let findByIdAndWebLog<'TKey, 'TDoc> (conn: SqliteConnection) ser table (key: 'TKey) webLogId = backgroundTask { + use cmd = conn.CreateCommand() + cmd.CommandText <- $"{Query.selectFromTable table} WHERE {Query.whereById} AND {Query.whereByWebLog}" + addDocId cmd key + addWebLogId cmd webLogId + use! rdr = cmd.ExecuteReaderAsync() + let! isFound = rdr.ReadAsync() + return if isFound then Some (Map.fromDoc<'TDoc> ser rdr) else None + } + + /// Find documents for the given web log + let findByWebLog<'TDoc> (conn: SqliteConnection) ser table webLogId = + use cmd = conn.CreateCommand() + cmd.CommandText <- $"{Query.selectFromTable table} WHERE {Query.whereByWebLog}" + addWebLogId cmd webLogId + cmdToList<'TDoc> cmd ser + + /// Insert a document + let insert<'TDoc> (conn: SqliteConnection) ser table (doc: 'TDoc) = backgroundTask { + use cmd = conn.CreateCommand() + cmd.CommandText <- Query.insert table + addDocParam<'TDoc> cmd doc ser + do! write cmd + } + + /// Update (replace) a document by its ID + let update<'TKey, 'TDoc> (conn: SqliteConnection) ser table (key: 'TKey) (doc: 'TDoc) = backgroundTask { + use cmd = conn.CreateCommand() + cmd.CommandText <- Query.updateById table + addDocId cmd key + addDocParam<'TDoc> cmd doc ser + do! write cmd + } + + /// Delete a document by its ID + let delete<'TKey> (conn: SqliteConnection) table (key: 'TKey) = backgroundTask { + use cmd = conn.CreateCommand() + cmd.CommandText <- Query.deleteById table + addDocId cmd key + do! write cmd + } + +/// Functions to support revisions +module Revisions = + + /// Find all revisions for the given entity + let findByEntityId<'TKey> (conn: SqliteConnection) revTable entityTable (key: 'TKey) = backgroundTask { + use cmd = conn.CreateCommand() + cmd.CommandText <- + $"SELECT as_of, revision_text FROM %s{revTable} WHERE %s{entityTable}_id = @id ORDER BY as_of DESC" + addDocId cmd key + use! rdr = cmd.ExecuteReaderAsync() + return toList Map.toRevision rdr + } + + /// Find all revisions for all posts for the given web log + let findByWebLog<'TKey> (conn: SqliteConnection) revTable entityTable (keyFunc: string -> 'TKey) + webLogId = backgroundTask { + use cmd = conn.CreateCommand() + cmd.CommandText <- + $"SELECT pr.* + FROM %s{revTable} pr + INNER JOIN %s{entityTable} p ON p.data ->> 'Id' = pr.{entityTable}_id + WHERE p.{Query.whereByWebLog} + ORDER BY as_of DESC" + addWebLogId cmd webLogId + use! rdr = cmd.ExecuteReaderAsync() + return toList (fun rdr -> keyFunc (Map.getString $"{entityTable}_id" rdr), Map.toRevision rdr) rdr + } + + /// Parameters for a revision INSERT statement + let revParams<'TKey> (key: 'TKey) rev = + [ SqliteParameter("asOf", rev.AsOf) + SqliteParameter("@id", string key) + SqliteParameter("@text", rev.Text) ] + + /// The SQL statement to insert a revision + let insertSql table = + $"INSERT INTO %s{table} VALUES (@id, @asOf, @text)" + + /// Update a page or post's revisions + let update<'TKey> (conn: SqliteConnection) revTable entityTable (key: 'TKey) oldRevs newRevs = backgroundTask { + let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs + if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then + use cmd = conn.CreateCommand() + if not (List.isEmpty toDelete) then + cmd.CommandText <- $"DELETE FROM %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf" + for delRev in toDelete do + cmd.Parameters.Clear() + addDocId cmd key + addParam cmd "@asOf" delRev.AsOf + do! write cmd + if not (List.isEmpty toAdd) then + cmd.CommandText <- insertSql revTable + for addRev in toAdd do + cmd.Parameters.Clear() + cmd.Parameters.AddRange(revParams key addRev) + do! write cmd + } diff --git a/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs b/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs index 79c862b..3e892c2 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs @@ -2,71 +2,46 @@ namespace MyWebLog.Data.SQLite open System.Threading.Tasks open Microsoft.Data.Sqlite +open Microsoft.Extensions.Logging open MyWebLog open MyWebLog.Data open Newtonsoft.Json /// SQLite myWebLog category data implementation -type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer) = +type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) = - /// Add parameters for category INSERT or UPDATE statements - let addCategoryParameters (cmd: SqliteCommand) (cat: Category) = - [ cmd.Parameters.AddWithValue ("@id", string cat.Id) - cmd.Parameters.AddWithValue ("@webLogId", string cat.WebLogId) - cmd.Parameters.AddWithValue ("@name", cat.Name) - cmd.Parameters.AddWithValue ("@slug", cat.Slug) - cmd.Parameters.AddWithValue ("@description", maybe cat.Description) - cmd.Parameters.AddWithValue ("@parentId", maybe (cat.ParentId |> Option.map string)) - ] |> ignore + /// The name of the parent ID field + let parentIdField = nameof Category.Empty.ParentId /// Add a category - let add cat = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- - "INSERT INTO category ( - id, web_log_id, name, slug, description, parent_id - ) VALUES ( - @id, @webLogId, @name, @slug, @description, @parentId - )" - addCategoryParameters cmd cat - let! _ = cmd.ExecuteNonQueryAsync () - () - } + let add (cat: Category) = + log.LogTrace "Category.add" + Document.insert conn ser Table.Category cat /// Count all categories for the given web log - let countAll webLogId = backgroundTask { - use cmd = conn.CreateCommand() - cmd.CommandText <- $"SELECT COUNT(*) FROM {Table.Category} WHERE {whereWebLogId}" - addWebLogId cmd webLogId - return! count cmd - } + let countAll webLogId = + log.LogTrace "Category.countAll" + Document.countByWebLog conn Table.Category webLogId /// Count all top-level categories for the given web log let countTopLevel webLogId = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- - $"SELECT COUNT(*) FROM {Table.Category} - WHERE {whereWebLogId} AND data ->> '{nameof Category.Empty.ParentId}' IS NULL" + log.LogTrace "Category.countTopLevel" + use cmd = conn.CreateCommand() + cmd.CommandText <- $"{Query.countByWebLog} AND data ->> '{parentIdField}' IS NULL" addWebLogId cmd webLogId return! count cmd } - // TODO: need to get SQLite in clause format for JSON documents + /// Find all categories for the given web log + let findByWebLog webLogId = + log.LogTrace "Category.findByWebLog" + Document.findByWebLog 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 ser rdr - } - |> Seq.sortBy _.Name.ToLowerInvariant() - |> List.ofSeq - do! rdr.CloseAsync() - let ordered = Utils.orderByHierarchy cats None None [] + log.LogTrace "Category.findAllForView" + let! cats = findByWebLog webLogId + let ordered = Utils.orderByHierarchy (cats |> List.sortBy _.Name.ToLowerInvariant()) None None [] let! counts = ordered |> Seq.map (fun it -> backgroundTask { @@ -77,74 +52,83 @@ type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer) = |> Seq.map _.Id |> Seq.append (Seq.singleton it.Id) |> List.ofSeq - |> inClause "AND pc.category_id" "catId" id - cmd.Parameters.Clear () + |> inJsonArray Table.Post (nameof Post.Empty.CategoryIds) "catId" + use cmd = conn.CreateCommand() + cmd.CommandText <- $" + SELECT COUNT(DISTINCT data ->> '{nameof Post.Empty.Id}') + FROM {Table.Post} + WHERE {Query.whereByWebLog} + AND data ->> '{nameof Post.Empty.Status}' = '{string Published}' + AND {catSql}" addWebLogId cmd webLogId cmd.Parameters.AddRange catParams - cmd.CommandText <- $" - SELECT COUNT(DISTINCT p.id) - FROM post p - INNER JOIN post_category pc ON pc.post_id = p.id - WHERE p.web_log_id = @webLogId - AND p.status = 'Published' - {catSql}" let! postCount = count cmd return it.Id, postCount - }) + }) |> Task.WhenAll return ordered |> Seq.map (fun cat -> { cat with - PostCount = counts - |> Array.tryFind (fun c -> fst c = cat.Id) - |> Option.map snd - |> Option.defaultValue 0 - }) + PostCount = + counts + |> Array.tryFind (fun c -> fst c = cat.Id) + |> Option.map snd + |> Option.defaultValue 0 }) |> Array.ofSeq } + /// Find a category by its ID for the given web log - let findById (catId: CategoryId) webLogId = backgroundTask { - use cmd = conn.CreateCommand() - cmd.CommandText <- $"SELECT * FROM {Table.Category} WHERE {Query.whereById}" - cmd.Parameters.AddWithValue("@id", string catId) |> ignore - use! rdr = cmd.ExecuteReaderAsync() - return verifyWebLog 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 conn ser Table.Category catId webLogId /// Delete a category let delete catId webLogId = backgroundTask { + log.LogTrace "Category.delete" match! findById catId webLogId with | Some cat -> - use cmd = conn.CreateCommand () + use cmd = conn.CreateCommand() // Reassign any children to the category's parent category - cmd.CommandText <- "SELECT COUNT(id) FROM category WHERE parent_id = @parentId" - cmd.Parameters.AddWithValue ("@parentId", string catId) |> ignore + cmd.CommandText <- $"SELECT COUNT(*) FROM {Table.Category} WHERE data ->> '{parentIdField}' = @parentId" + addParam cmd "@parentId" (string catId) let! children = count cmd if children > 0 then - cmd.CommandText <- "UPDATE category SET parent_id = @newParentId WHERE parent_id = @parentId" - cmd.Parameters.AddWithValue ("@newParentId", maybe (cat.ParentId |> Option.map string)) - |> ignore + cmd.CommandText <- $" + UPDATE {Table.Category} + SET data = json_set(data, '$.{parentIdField}', @newParentId) + WHERE data ->> '{parentIdField}' = @parentId" + addParam cmd "@newParentId" (maybe (cat.ParentId |> Option.map string)) do! write cmd // Delete the category off all posts where it is assigned, and the category itself - cmd.CommandText <- - "DELETE FROM post_category - WHERE category_id = @id - AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId); - DELETE FROM category WHERE id = @id" - cmd.Parameters.Clear () - let _ = cmd.Parameters.AddWithValue ("@id", string catId) + let catIdField = Post.Empty.CategoryIds + cmd.CommandText <- $" + SELECT data ->> '{Post.Empty.Id}' AS id, data -> '{catIdField}' AS cat_ids + FROM {Table.Post} + WHERE {Query.whereByWebLog} + AND EXISTS + (SELECT 1 FROM json_each({Table.Post}.data -> '{catIdField}') WHERE json_each.value = @id)" + cmd.Parameters.Clear() + addDocId cmd catId addWebLogId cmd webLogId - do! write cmd + use! postRdr = cmd.ExecuteReaderAsync() + if postRdr.HasRows then + let postIdAndCats = + toList + (fun rdr -> + Map.getString "id" rdr, Utils.deserialize ser (Map.getString "cat_ids" rdr)) + postRdr + do! postRdr.CloseAsync() + for postId, cats in postIdAndCats do + cmd.CommandText <- $" + UPDATE {Table.Post} + SET data = json_set(data, '$.{catIdField}', json(@catIds)) + WHERE {Query.whereById}" + cmd.Parameters.Clear() + addDocId cmd postId + addParam cmd "@catIds" (cats |> List.filter (fun it -> it <> string catId) |> Utils.serialize ser) + do! write cmd + do! Document.delete conn Table.Category catId return if children = 0 then CategoryDeleted else ReassignedChildCategories | None -> return CategoryNotFound } @@ -156,17 +140,12 @@ type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer) = } /// Update a category - let update cat = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- - "UPDATE category - SET name = @name, - slug = @slug, - description = @description, - parent_id = @parentId - WHERE id = @id - AND web_log_id = @webLogId" - addCategoryParameters cmd cat + let update (cat: Category) = backgroundTask { + use cmd = conn.CreateCommand() + cmd.CommandText <- $"{Query.updateById} AND {Query.whereByWebLog}" + addDocId cmd cat.Id + addDocParam cmd cat ser + addWebLogId cmd cat.WebLogId do! write cmd } diff --git a/src/MyWebLog.Data/SQLite/SQLitePageData.fs b/src/MyWebLog.Data/SQLite/SQLitePageData.fs index c8ebd49..277e53f 100644 --- a/src/MyWebLog.Data/SQLite/SQLitePageData.fs +++ b/src/MyWebLog.Data/SQLite/SQLitePageData.fs @@ -2,184 +2,99 @@ namespace MyWebLog.Data.SQLite open System.Threading.Tasks open Microsoft.Data.Sqlite +open Microsoft.Extensions.Logging open MyWebLog open MyWebLog.Data open Newtonsoft.Json /// SQLite myWebLog page data implementation -type SQLitePageData(conn: SqliteConnection, ser: JsonSerializer) = +type SQLitePageData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) = + + /// The JSON field for the permalink + let linkField = $"data ->> '{nameof Page.Empty.Permalink}'" + + /// The JSON field for the "is in page list" flag + let pgListField = $"data ->> '{nameof Page.Empty.IsInPageList}'" + + /// The JSON field for the title of the page + let titleField = $"data ->> '{nameof Page.Empty.Title}'" // SUPPORT FUNCTIONS - /// Add parameters for page INSERT or UPDATE statements - let addPageParameters (cmd: SqliteCommand) (page: Page) = - [ cmd.Parameters.AddWithValue ("@id", string page.Id) - cmd.Parameters.AddWithValue ("@webLogId", string page.WebLogId) - cmd.Parameters.AddWithValue ("@authorId", string page.AuthorId) - cmd.Parameters.AddWithValue ("@title", page.Title) - cmd.Parameters.AddWithValue ("@permalink", string page.Permalink) - cmd.Parameters.AddWithValue ("@publishedOn", instantParam page.PublishedOn) - cmd.Parameters.AddWithValue ("@updatedOn", instantParam page.UpdatedOn) - cmd.Parameters.AddWithValue ("@isInPageList", page.IsInPageList) - cmd.Parameters.AddWithValue ("@template", maybe page.Template) - cmd.Parameters.AddWithValue ("@text", page.Text) - cmd.Parameters.AddWithValue ("@metaItems", maybe (if List.isEmpty page.Metadata then None - else Some (Utils.serialize ser page.Metadata))) - ] |> ignore - - /// Append revisions and permalinks to a page - let appendPageRevisionsAndPermalinks (page : Page) = backgroundTask { - use cmd = conn.CreateCommand () - cmd.Parameters.AddWithValue ("@pageId", string page.Id) |> ignore - - cmd.CommandText <- "SELECT permalink FROM page_permalink WHERE page_id = @pageId" - use! rdr = cmd.ExecuteReaderAsync () - let page = { page with PriorPermalinks = toList Map.toPermalink rdr } - do! rdr.CloseAsync () - - cmd.CommandText <- "SELECT as_of, revision_text FROM page_revision WHERE page_id = @pageId ORDER BY as_of DESC" - use! rdr = cmd.ExecuteReaderAsync () - return { page with Revisions = toList Map.toRevision rdr } + /// Append revisions to a page + let appendPageRevisions (page : Page) = backgroundTask { + log.LogTrace "Page.appendPageRevisions" + let! revisions = Revisions.findByEntityId conn Table.PageRevision Table.Page page.Id + return { page with Revisions = revisions } } - /// Shorthand for mapping a data reader to a page - let toPage = - Map.toPage ser - - /// Return a page with no text (or prior permalinks or revisions) - let pageWithoutText rdr = - { toPage rdr with Text = "" } - - /// Update a page's prior permalinks - let updatePagePermalinks (pageId: PageId) oldLinks newLinks = backgroundTask { - let toDelete, toAdd = Utils.diffPermalinks oldLinks newLinks - if List.isEmpty toDelete && List.isEmpty toAdd then - return () - else - use cmd = conn.CreateCommand () - [ cmd.Parameters.AddWithValue ("@pageId", string pageId) - cmd.Parameters.Add ("@link", SqliteType.Text) - ] |> ignore - let runCmd (link: Permalink) = backgroundTask { - cmd.Parameters["@link"].Value <- string link - do! write cmd - } - cmd.CommandText <- "DELETE FROM page_permalink WHERE page_id = @pageId AND permalink = @link" - toDelete - |> List.map runCmd - |> Task.WhenAll - |> ignore - cmd.CommandText <- "INSERT INTO page_permalink VALUES (@pageId, @link)" - toAdd - |> List.map runCmd - |> Task.WhenAll - |> ignore - } + /// Return a page with no text + let withoutText (page: Page) = + { page with Text = "" } /// Update a page's revisions - let updatePageRevisions (pageId: PageId) oldRevs newRevs = backgroundTask { - let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs - if List.isEmpty toDelete && List.isEmpty toAdd then - return () - else - use cmd = conn.CreateCommand () - let runCmd withText rev = backgroundTask { - cmd.Parameters.Clear () - [ cmd.Parameters.AddWithValue ("@pageId", string pageId) - cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf) - ] |> ignore - if withText then cmd.Parameters.AddWithValue ("@text", string rev.Text) |> ignore - do! write cmd - } - cmd.CommandText <- "DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @asOf" - toDelete - |> List.map (runCmd false) - |> Task.WhenAll - |> ignore - cmd.CommandText <- "INSERT INTO page_revision VALUES (@pageId, @asOf, @text)" - toAdd - |> List.map (runCmd true) - |> Task.WhenAll - |> ignore - } + let updatePageRevisions (pageId: PageId) oldRevs newRevs = + log.LogTrace "Page.updatePageRevisions" + Revisions.update conn Table.PageRevision Table.Page pageId oldRevs newRevs // IMPLEMENTATION FUNCTIONS /// Add a page let add page = backgroundTask { - use cmd = conn.CreateCommand () - // The page itself - cmd.CommandText <- - "INSERT INTO page ( - id, web_log_id, author_id, title, permalink, published_on, updated_on, is_in_page_list, template, - page_text, meta_items - ) VALUES ( - @id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @isInPageList, @template, - @text, @metaItems - )" - addPageParameters cmd page - do! write cmd - do! updatePagePermalinks page.Id [] page.PriorPermalinks - do! updatePageRevisions page.Id [] page.Revisions + log.LogTrace "Page.add" + do! Document.insert conn ser Table.Page { page with Revisions = [] } + do! updatePageRevisions page.Id [] page.Revisions } - /// Get all pages for a web log (without text, revisions, prior permalinks, or metadata) + /// Get all pages for a web log (without text or revisions) let all webLogId = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId ORDER BY LOWER(title)" + log.LogTrace "Page.all" + use cmd = conn.CreateCommand() + cmd.CommandText <- + $"{Query.selectFromTable Table.Page} WHERE {Query.whereByWebLog} ORDER BY LOWER({titleField})" addWebLogId cmd webLogId - use! rdr = cmd.ExecuteReaderAsync () - return toList pageWithoutText rdr + let! pages = cmdToList cmd ser + return pages |> List.map withoutText } /// Count all pages for the given web log - let countAll webLogId = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT COUNT(id) FROM page WHERE web_log_id = @webLogId" - addWebLogId cmd webLogId - return! count cmd - } + let countAll webLogId = + log.LogTrace "Page.countAll" + Document.countByWebLog conn Table.Page webLogId /// Count all pages shown in the page list for the given web log let countListed webLogId = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- - "SELECT COUNT(id) - FROM page - WHERE web_log_id = @webLogId - AND is_in_page_list = @isInPageList" + log.LogTrace "Page.countListed" + use cmd = conn.CreateCommand() + cmd.CommandText <- $"{Query.countByWebLog} AND {pgListField} = 'true'" addWebLogId cmd webLogId - cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore return! count cmd } - /// Find a page by its ID (without revisions and prior permalinks) - let findById (pageId: PageId) webLogId = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT * FROM page WHERE id = @id" - cmd.Parameters.AddWithValue ("@id", string pageId) |> ignore - use! rdr = cmd.ExecuteReaderAsync () - return verifyWebLog webLogId (_.WebLogId) (Map.toPage ser) rdr - } + /// Find a page by its ID (without revisions) + let findById pageId webLogId = + log.LogTrace "Page.findById" + Document.findByIdAndWebLog conn ser Table.Page pageId webLogId /// Find a complete page by its ID let findFullById pageId webLogId = backgroundTask { + log.LogTrace "Page.findFullById" match! findById pageId webLogId with | Some page -> - let! page = appendPageRevisionsAndPermalinks page + let! page = appendPageRevisions page return Some page | None -> return None } + // TODO: need to handle when the page being deleted is the home page + /// Delete a page by its ID let delete pageId webLogId = backgroundTask { + log.LogTrace "Page.delete" match! findById pageId webLogId with | Some _ -> - use cmd = conn.CreateCommand () - cmd.Parameters.AddWithValue ("@id", string pageId) |> ignore - cmd.CommandText <- - "DELETE FROM page_revision WHERE page_id = @id; - DELETE FROM page_permalink WHERE page_id = @id; - DELETE FROM page WHERE id = @id" + use cmd = conn.CreateCommand() + cmd.CommandText <- $"DELETE FROM {Table.PageRevision} WHERE page_id = @id; {Query.deleteById}" + addDocId cmd pageId do! write cmd return true | None -> return false @@ -187,112 +102,98 @@ type SQLitePageData(conn: SqliteConnection, ser: JsonSerializer) = /// Find a page by its permalink for the given web log let findByPermalink (permalink: Permalink) webLogId = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId AND permalink = @link" + log.LogTrace "Page.findByPermalink" + use cmd = conn.CreateCommand() + cmd.CommandText <- $" {Query.selectFromTable Table.Page} WHERE {Query.whereByWebLog} AND {linkField} = @link" addWebLogId cmd webLogId - cmd.Parameters.AddWithValue ("@link", string permalink) |> ignore - use! rdr = cmd.ExecuteReaderAsync () - return if rdr.Read () then Some (toPage rdr) else None + addParam cmd "@link" (string permalink) + use! rdr = cmd.ExecuteReaderAsync() + let! isFound = rdr.ReadAsync() + return if isFound then Some (Map.fromDoc ser rdr) else None } /// Find the current permalink within a set of potential prior permalinks for the given web log let findCurrentPermalink (permalinks: Permalink list) webLogId = backgroundTask { - use cmd = conn.CreateCommand () - let linkSql, linkParams = inClause "AND pp.permalink" "link" string permalinks - cmd.CommandText <- $" - SELECT p.permalink - FROM page p - INNER JOIN page_permalink pp ON pp.page_id = p.id - WHERE p.web_log_id = @webLogId - {linkSql}" + log.LogTrace "Page.findCurrentPermalink" + let linkSql, linkParams = inJsonArray Table.Page (nameof Page.Empty.PriorPermalinks) "link" permalinks + use cmd = conn.CreateCommand() + cmd.CommandText <- + $"SELECT {linkField} AS permalink FROM {Table.Page} WHERE {Query.whereByWebLog} AND {linkSql}" addWebLogId cmd webLogId cmd.Parameters.AddRange linkParams - use! rdr = cmd.ExecuteReaderAsync () - return if rdr.Read () then Some (Map.toPermalink rdr) else None + use! rdr = cmd.ExecuteReaderAsync() + let! isFound = rdr.ReadAsync() + return if isFound then Some (Map.toPermalink rdr) else None } /// Get all complete pages for the given web log let findFullByWebLog webLogId = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId" - addWebLogId cmd webLogId - use! rdr = cmd.ExecuteReaderAsync () - let! pages = - toList toPage rdr - |> List.map (fun page -> backgroundTask { return! appendPageRevisionsAndPermalinks page }) + log.LogTrace "Page.findFullByWebLog" + let! pages = Document.findByWebLog 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 cmd ser + return pages |> List.map withoutText } - /// Get a page of pages for the given web log (without revisions, prior permalinks, or metadata) - let findPageOfPages webLogId pageNbr = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- - "SELECT * - FROM page - WHERE web_log_id = @webLogId - ORDER BY LOWER(title) - LIMIT @pageSize OFFSET @toSkip" + /// Get a page of pages for the given web log (without revisions) + let findPageOfPages webLogId pageNbr = + log.LogTrace "Page.findPageOfPages" + use cmd = conn.CreateCommand() + cmd.CommandText <- $" + {Query.selectFromTable Table.Page} WHERE {Query.whereByWebLog} + ORDER BY LOWER({titleField}) + LIMIT @pageSize OFFSET @toSkip" addWebLogId cmd webLogId - [ cmd.Parameters.AddWithValue ("@pageSize", 26) - cmd.Parameters.AddWithValue ("@toSkip", (pageNbr - 1) * 25) - ] |> ignore - use! rdr = cmd.ExecuteReaderAsync () - return toList toPage rdr - } + addParam cmd "@pageSize" 26 + addParam cmd "@toSkip" ((pageNbr - 1) * 25) + cmdToList cmd ser /// Restore pages from a backup let restore pages = backgroundTask { + log.LogTrace "Page.restore" for page in pages do do! add page } /// Update a page - let update (page : Page) = backgroundTask { + let update (page: Page) = backgroundTask { + log.LogTrace "Page.update" match! findFullById page.Id page.WebLogId with | Some oldPage -> - use cmd = conn.CreateCommand () - cmd.CommandText <- - "UPDATE page - SET author_id = @authorId, - title = @title, - permalink = @permalink, - published_on = @publishedOn, - updated_on = @updatedOn, - is_in_page_list = @isInPageList, - template = @template, - page_text = @text, - meta_items = @metaItems - WHERE id = @id - AND web_log_id = @webLogId" - addPageParameters cmd page - do! write cmd - do! updatePagePermalinks page.Id oldPage.PriorPermalinks page.PriorPermalinks - do! updatePageRevisions page.Id oldPage.Revisions page.Revisions - return () - | None -> return () + do! Document.update conn ser Table.Page page.Id { page with Revisions = [] } + do! updatePageRevisions page.Id oldPage.Revisions page.Revisions + | None -> () } /// Update a page's prior permalinks - let updatePriorPermalinks pageId webLogId permalinks = backgroundTask { - match! findFullById pageId webLogId with - | Some page -> - do! updatePagePermalinks pageId page.PriorPermalinks permalinks + let updatePriorPermalinks pageId webLogId (permalinks: Permalink list) = backgroundTask { + log.LogTrace "Page.updatePriorPermalinks" + match! findById pageId webLogId with + | Some _ -> + use cmd = conn.CreateCommand() + cmd.CommandText <- $" + UPDATE {Table.Page} + SET data = json_set(data, '$.{nameof Page.Empty.PriorPermalinks}', json(@links)) + WHERE {Query.whereById}" + addDocId cmd pageId + addParam cmd "@links" (Utils.serialize ser permalinks) + do! write cmd return true | None -> return false } diff --git a/src/MyWebLog.Data/SQLite/SQLitePostData.fs b/src/MyWebLog.Data/SQLite/SQLitePostData.fs index 97c02b4..dc26393 100644 --- a/src/MyWebLog.Data/SQLite/SQLitePostData.fs +++ b/src/MyWebLog.Data/SQLite/SQLitePostData.fs @@ -2,265 +2,105 @@ namespace MyWebLog.Data.SQLite open System.Threading.Tasks open Microsoft.Data.Sqlite +open Microsoft.Extensions.Logging open MyWebLog open MyWebLog.Data open Newtonsoft.Json open NodaTime /// SQLite myWebLog post data implementation -type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) = - +type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) = + + /// The JSON field for the post's permalink + let linkField = $"data ->> '{nameof Post.Empty.Permalink}'" + + /// The JSON field for when the post was published + let publishField = $"data ->> '{nameof Post.Empty.PublishedOn}'" + + /// The JSON field for post status + let statField = $"data ->> '{nameof Post.Empty.Status}'" + // SUPPORT FUNCTIONS - /// Add parameters for post INSERT or UPDATE statements - let addPostParameters (cmd: SqliteCommand) (post: Post) = - [ cmd.Parameters.AddWithValue ("@id", string post.Id) - cmd.Parameters.AddWithValue ("@webLogId", string post.WebLogId) - cmd.Parameters.AddWithValue ("@authorId", string post.AuthorId) - cmd.Parameters.AddWithValue ("@status", string post.Status) - cmd.Parameters.AddWithValue ("@title", post.Title) - cmd.Parameters.AddWithValue ("@permalink", string post.Permalink) - cmd.Parameters.AddWithValue ("@publishedOn", maybeInstant post.PublishedOn) - cmd.Parameters.AddWithValue ("@updatedOn", instantParam post.UpdatedOn) - cmd.Parameters.AddWithValue ("@template", maybe post.Template) - cmd.Parameters.AddWithValue ("@text", post.Text) - cmd.Parameters.AddWithValue ("@episode", maybe (if Option.isSome post.Episode then - Some (Utils.serialize ser post.Episode) - else None)) - cmd.Parameters.AddWithValue ("@metaItems", maybe (if List.isEmpty post.Metadata then None - else Some (Utils.serialize ser post.Metadata))) - ] |> ignore - - /// Append category IDs and tags to a post - let appendPostCategoryAndTag (post: Post) = backgroundTask { - use cmd = conn.CreateCommand () - cmd.Parameters.AddWithValue ("@id", string post.Id) |> ignore - - cmd.CommandText <- "SELECT category_id AS id FROM post_category WHERE post_id = @id" - use! rdr = cmd.ExecuteReaderAsync () - let post = { post with CategoryIds = toList Map.toCategoryId rdr } - do! rdr.CloseAsync () - - cmd.CommandText <- "SELECT tag FROM post_tag WHERE post_id = @id" - use! rdr = cmd.ExecuteReaderAsync () - return { post with Tags = toList (Map.getString "tag") rdr } + /// Append revisions to a post + let appendPostRevisions (post: Post) = backgroundTask { + log.LogTrace "Post.appendPostRevisions" + let! revisions = Revisions.findByEntityId conn Table.PostRevision Table.Post post.Id + return { post with Revisions = revisions } } - /// Append revisions and permalinks to a post - let appendPostRevisionsAndPermalinks (post: Post) = backgroundTask { - use cmd = conn.CreateCommand () - cmd.Parameters.AddWithValue ("@postId", string post.Id) |> ignore - - cmd.CommandText <- "SELECT permalink FROM post_permalink WHERE post_id = @postId" - use! rdr = cmd.ExecuteReaderAsync () - let post = { post with PriorPermalinks = toList Map.toPermalink rdr } - do! rdr.CloseAsync () - - cmd.CommandText <- "SELECT as_of, revision_text FROM post_revision WHERE post_id = @postId ORDER BY as_of DESC" - use! rdr = cmd.ExecuteReaderAsync () - return { post with Revisions = toList Map.toRevision rdr } - } + /// The SELECT statement to retrieve posts with a web log ID parameter + let postByWebLog = $"{Query.selectFromTable Table.Post} WHERE {Query.whereByWebLog}" - /// The SELECT statement for a post that will include episode data, if it exists - let selectPost = "SELECT p.* FROM post p" + /// The SELECT statement to retrieve published posts with a web log ID parameter + let publishedPostByWebLog = $"{postByWebLog} AND {statField} = '{string Published}'" - /// Shorthand for mapping a data reader to a post - let toPost = - Map.toPost ser - - /// Find just-the-post by its ID for the given web log (excludes category, tag, meta, revisions, and permalinks) - let findPostById (postId: PostId) webLogId = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- $"{selectPost} WHERE p.id = @id" - cmd.Parameters.AddWithValue ("@id", string postId) |> ignore - use! rdr = cmd.ExecuteReaderAsync () - return verifyWebLog 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 oldCats newCats string - if List.isEmpty toDelete && List.isEmpty toAdd then - return () - else - use cmd = conn.CreateCommand () - [ cmd.Parameters.AddWithValue ("@postId", string postId) - cmd.Parameters.Add ("@categoryId", SqliteType.Text) - ] |> ignore - let runCmd (catId: CategoryId) = backgroundTask { - cmd.Parameters["@categoryId"].Value <- string catId - do! write cmd - } - cmd.CommandText <- "DELETE FROM post_category WHERE post_id = @postId AND category_id = @categoryId" - toDelete - |> List.map runCmd - |> Task.WhenAll - |> ignore - cmd.CommandText <- "INSERT INTO post_category VALUES (@postId, @categoryId)" - toAdd - |> List.map runCmd - |> Task.WhenAll - |> ignore - } - - /// Update a post's assigned categories - let updatePostTags (postId: PostId) (oldTags: string list) newTags = backgroundTask { - let toDelete, toAdd = Utils.diffLists oldTags newTags id - if List.isEmpty toDelete && List.isEmpty toAdd then - return () - else - use cmd = conn.CreateCommand () - [ cmd.Parameters.AddWithValue ("@postId", string postId) - cmd.Parameters.Add ("@tag", SqliteType.Text) - ] |> ignore - let runCmd (tag: string) = backgroundTask { - cmd.Parameters["@tag"].Value <- tag - do! write cmd - } - cmd.CommandText <- "DELETE FROM post_tag WHERE post_id = @postId AND tag = @tag" - toDelete - |> List.map runCmd - |> Task.WhenAll - |> ignore - cmd.CommandText <- "INSERT INTO post_tag VALUES (@postId, @tag)" - toAdd - |> List.map runCmd - |> Task.WhenAll - |> ignore - } - - /// Update a post's prior permalinks - let updatePostPermalinks (postId: PostId) oldLinks newLinks = backgroundTask { - let toDelete, toAdd = Utils.diffPermalinks oldLinks newLinks - if List.isEmpty toDelete && List.isEmpty toAdd then - return () - else - use cmd = conn.CreateCommand () - [ cmd.Parameters.AddWithValue ("@postId", string postId) - cmd.Parameters.Add ("@link", SqliteType.Text) - ] |> ignore - let runCmd (link: Permalink) = backgroundTask { - cmd.Parameters["@link"].Value <- string link - do! write cmd - } - cmd.CommandText <- "DELETE FROM post_permalink WHERE post_id = @postId AND permalink = @link" - toDelete - |> List.map runCmd - |> Task.WhenAll - |> ignore - cmd.CommandText <- "INSERT INTO post_permalink VALUES (@postId, @link)" - toAdd - |> List.map runCmd - |> Task.WhenAll - |> ignore - } + /// Remove the text from a post + let withoutText (post: Post) = + { post with Text = "" } /// Update a post's revisions - let updatePostRevisions (postId: PostId) oldRevs newRevs = backgroundTask { - let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs - if List.isEmpty toDelete && List.isEmpty toAdd then - return () - else - use cmd = conn.CreateCommand () - let runCmd withText rev = backgroundTask { - cmd.Parameters.Clear () - [ cmd.Parameters.AddWithValue ("@postId", string postId) - cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf) - ] |> ignore - if withText then cmd.Parameters.AddWithValue ("@text", string rev.Text) |> ignore - do! write cmd - } - cmd.CommandText <- "DELETE FROM post_revision WHERE post_id = @postId AND as_of = @asOf" - toDelete - |> List.map (runCmd false) - |> Task.WhenAll - |> ignore - cmd.CommandText <- "INSERT INTO post_revision VALUES (@postId, @asOf, @text)" - toAdd - |> List.map (runCmd true) - |> Task.WhenAll - |> ignore - } + let updatePostRevisions (postId: PostId) oldRevs newRevs = + log.LogTrace "Post.updatePostRevisions" + Revisions.update conn Table.PostRevision Table.Post postId oldRevs newRevs // IMPLEMENTATION FUNCTIONS /// Add a post - let add post = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- - "INSERT INTO post ( - id, web_log_id, author_id, status, title, permalink, published_on, updated_on, template, post_text, - episode, meta_items - ) VALUES ( - @id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn, @template, @text, - @episode, @metaItems - )" - addPostParameters cmd post - do! write cmd - do! updatePostCategories post.Id [] post.CategoryIds - do! updatePostTags post.Id [] post.Tags - do! updatePostPermalinks post.Id [] post.PriorPermalinks - do! updatePostRevisions post.Id [] post.Revisions + let add (post: Post) = backgroundTask { + log.LogTrace "Post.add" + do! Document.insert conn ser Table.Post { post with Revisions = [] } + do! updatePostRevisions post.Id [] post.Revisions } /// Count posts in a status for the given web log let countByStatus (status: PostStatus) webLogId = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT COUNT(id) FROM post WHERE web_log_id = @webLogId AND status = @status" + log.LogTrace "Post.countByStatus" + use cmd = conn.CreateCommand() + cmd.CommandText <- $"{Query.countByWebLog Table.Post} AND {statField} = @status" addWebLogId cmd webLogId - cmd.Parameters.AddWithValue ("@status", string status) |> ignore + addParam cmd "@status" (string status) return! count cmd } /// Find a post by its ID for the given web log (excluding revisions and prior permalinks - let findById postId webLogId = backgroundTask { - match! findPostById postId webLogId with - | Some post -> - let! post = appendPostCategoryAndTag post - return Some post - | None -> return None - } + let findById postId webLogId = + log.LogTrace "Post.findById" + Document.findByIdAndWebLog conn ser Table.Post postId webLogId /// Find a post by its permalink for the given web log (excluding revisions and prior permalinks) let findByPermalink (permalink: Permalink) webLogId = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- $"{selectPost} WHERE p.web_log_id = @webLogId AND p.permalink = @link" + log.LogTrace "Post.findByPermalink" + use cmd = conn.CreateCommand() + cmd.CommandText <- $"{Query.selectFromTable Table.Post} WHERE {Query.whereByWebLog} AND {linkField} = @link" addWebLogId cmd webLogId - cmd.Parameters.AddWithValue ("@link", string permalink) |> ignore - use! rdr = cmd.ExecuteReaderAsync () - if rdr.Read () then - let! post = appendPostCategoryAndTag (toPost rdr) - return Some post - else - return None + addParam cmd "@link" (string permalink) + use! rdr = cmd.ExecuteReaderAsync() + let! isFound = rdr.ReadAsync() + return if isFound then Some (Map.fromDoc ser rdr) else None } /// Find a complete post by its ID for the given web log let findFullById postId webLogId = backgroundTask { + log.LogTrace "Post.findFullById" match! findById postId webLogId with | Some post -> - let! post = appendPostRevisionsAndPermalinks post + let! post = appendPostRevisions post return Some post | None -> return None } /// Delete a post by its ID for the given web log let delete postId webLogId = backgroundTask { - match! findFullById postId webLogId with + log.LogTrace "Post.delete" + match! findById postId webLogId with | Some _ -> - use cmd = conn.CreateCommand () - cmd.Parameters.AddWithValue ("@id", string postId) |> ignore - cmd.CommandText <- - "DELETE FROM post_revision WHERE post_id = @id; - DELETE FROM post_permalink WHERE post_id = @id; - DELETE FROM post_tag WHERE post_id = @id; - DELETE FROM post_category WHERE post_id = @id; - DELETE FROM post_comment WHERE post_id = @id; - DELETE FROM post WHERE id = @id" + use cmd = conn.CreateCommand() + cmd.CommandText <- $" + DELETE FROM {Table.PostRevision} WHERE post_id = @id; + DELETE FROM {Table.PostComment} WHERE data ->> '{nameof Comment.Empty.PostId}' = @id; + DELETE FROM {Table.Post} WHERE {Query.whereById}" + addDocId cmd postId do! write cmd return true | None -> return false @@ -268,198 +108,130 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) = /// Find the current permalink from a list of potential prior permalinks for the given web log let findCurrentPermalink (permalinks: Permalink list) webLogId = backgroundTask { - use cmd = conn.CreateCommand () - let linkSql, linkParams = inClause "AND pp.permalink" "link" string permalinks - cmd.CommandText <- $" - SELECT p.permalink - FROM post p - INNER JOIN post_permalink pp ON pp.post_id = p.id - WHERE p.web_log_id = @webLogId - {linkSql}" + log.LogTrace "Post.findCurrentPermalink" + let linkSql, linkParams = inJsonArray Table.Post (nameof Post.Empty.PriorPermalinks) "link" permalinks + use cmd = conn.CreateCommand() + cmd.CommandText <- + $"SELECT {linkField} AS permalink FROM {Table.Post} WHERE {Query.whereByWebLog} AND {linkSql}" addWebLogId cmd webLogId cmd.Parameters.AddRange linkParams - use! rdr = cmd.ExecuteReaderAsync () - return if rdr.Read () then Some (Map.toPermalink rdr) else None + use! rdr = cmd.ExecuteReaderAsync() + let! isFound = rdr.ReadAsync() + return if isFound then Some (Map.toPermalink rdr) else None } /// Get all complete posts for the given web log let findFullByWebLog webLogId = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- $"{selectPost} WHERE p.web_log_id = @webLogId" - addWebLogId cmd webLogId - use! rdr = cmd.ExecuteReaderAsync () - let! posts = - toList toPost rdr - |> List.map (fun post -> backgroundTask { - let! post = appendPostCategoryAndTag post - return! appendPostRevisionsAndPermalinks post - }) + log.LogTrace "Post.findFullByWebLog" + let! posts = Document.findByWebLog 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 cmd ser - /// Get a page of posts for the given web log (excludes text, revisions, and prior permalinks) + /// Get a page of posts for the given web log (excludes revisions) let findPageOfPosts webLogId pageNbr postsPerPage = backgroundTask { - use cmd = conn.CreateCommand () + log.LogTrace "Post.findPageOfPosts" + use cmd = conn.CreateCommand() cmd.CommandText <- $" - {selectPost} - WHERE p.web_log_id = @webLogId - ORDER BY p.published_on DESC NULLS FIRST, p.updated_on + {postByWebLog} + ORDER BY {publishField} DESC NULLS FIRST, data ->> '{nameof Post.Empty.UpdatedOn}' LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" addWebLogId cmd webLogId - use! rdr = cmd.ExecuteReaderAsync () - let! posts = - toList postWithoutText rdr - |> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post }) - |> Task.WhenAll - return List.ofArray posts + let! posts = cmdToList cmd ser + return posts |> List.map withoutText } - /// Get a page of published posts for the given web log (excludes revisions and prior permalinks) - let findPageOfPublishedPosts webLogId pageNbr postsPerPage = backgroundTask { - use cmd = conn.CreateCommand () + /// Get a page of published posts for the given web log (excludes revisions) + let findPageOfPublishedPosts webLogId pageNbr postsPerPage = + log.LogTrace "Post.findPageOfPublishedPosts" + use cmd = conn.CreateCommand() cmd.CommandText <- $" - {selectPost} - WHERE p.web_log_id = @webLogId - AND p.status = @status + {publishedPostByWebLog} + ORDER BY {publishField} DESC + LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" + addWebLogId cmd webLogId + cmdToList 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 cmd ser /// Find the next newest and oldest post from a publish date for the given web log let findSurroundingPosts webLogId (publishedOn : Instant) = backgroundTask { + log.LogTrace "Post.findSurroundingPosts" use cmd = conn.CreateCommand () - cmd.CommandText <- $" - {selectPost} - WHERE p.web_log_id = @webLogId - AND p.status = @status - AND p.published_on < @publishedOn - ORDER BY p.published_on DESC - LIMIT 1" addWebLogId cmd webLogId - [ cmd.Parameters.AddWithValue ("@status", string Published) - cmd.Parameters.AddWithValue ("@publishedOn", instantParam publishedOn) - ] |> ignore - use! rdr = cmd.ExecuteReaderAsync () - let! older = backgroundTask { - if rdr.Read () then - let! post = appendPostCategoryAndTag (postWithoutText rdr) - return Some post - else - return None - } + addParam cmd "@publishedOn" (instantParam publishedOn) + + cmd.CommandText <- + $"{publishedPostByWebLog} AND {publishField} < @publishedOn ORDER BY {publishField} DESC LIMIT 1" + use! rdr = cmd.ExecuteReaderAsync() + let! isFound = rdr.ReadAsync() + let older = if isFound then Some (Map.fromDoc 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 ser rdr) else None + return older, newer } /// Restore posts from a backup let restore posts = backgroundTask { + log.LogTrace "Post.restore" for post in posts do do! add post } /// Update a post - let update (post : Post) = backgroundTask { + let update (post: Post) = backgroundTask { match! findFullById post.Id post.WebLogId with | Some oldPost -> - use cmd = conn.CreateCommand () - cmd.CommandText <- - "UPDATE post - SET author_id = @authorId, - status = @status, - title = @title, - permalink = @permalink, - published_on = @publishedOn, - updated_on = @updatedOn, - template = @template, - post_text = @text, - episode = @episode, - meta_items = @metaItems - WHERE id = @id - AND web_log_id = @webLogId" - addPostParameters cmd post - do! write cmd - do! updatePostCategories post.Id oldPost.CategoryIds post.CategoryIds - do! updatePostTags post.Id oldPost.Tags post.Tags - do! updatePostPermalinks post.Id oldPost.PriorPermalinks post.PriorPermalinks - do! updatePostRevisions post.Id oldPost.Revisions post.Revisions + do! Document.update conn ser Table.Post post.Id { post with Revisions = [] } + do! updatePostRevisions post.Id oldPost.Revisions post.Revisions | None -> return () } /// Update prior permalinks for a post - let updatePriorPermalinks postId webLogId permalinks = backgroundTask { - match! findFullById postId webLogId with - | Some post -> - do! updatePostPermalinks postId post.PriorPermalinks permalinks + let updatePriorPermalinks postId webLogId (permalinks: Permalink list) = backgroundTask { + match! findById postId webLogId with + | Some _ -> + use cmd = conn.CreateCommand() + cmd.CommandText <- $" + UPDATE {Table.Post} + SET data = json_set(data, '$.{nameof Post.Empty.PriorPermalinks}', json(@links)) + WHERE {Query.whereById}" + addDocId cmd postId + addParam cmd "@links" (Utils.serialize ser permalinks) + do! write cmd return true | None -> return false } diff --git a/src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs b/src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs index d17d203..64440ac 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs @@ -1,95 +1,70 @@ namespace MyWebLog.Data.SQLite open Microsoft.Data.Sqlite +open Microsoft.Extensions.Logging open MyWebLog open MyWebLog.Data +open Newtonsoft.Json -/// SQLite myWebLog tag mapping data implementation -type SQLiteTagMapData (conn : SqliteConnection) = +/// SQLite myWebLog tag mapping data implementation +type SQLiteTagMapData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) = /// Find a tag mapping by its ID for the given web log - let findById (tagMapId: TagMapId) webLogId = backgroundTask { - use cmd = conn.CreateCommand() - cmd.CommandText <- "SELECT * FROM tag_map WHERE id = @id" - cmd.Parameters.AddWithValue ("@id", string tagMapId) |> ignore - use! rdr = cmd.ExecuteReaderAsync() - return verifyWebLog webLogId (_.WebLogId) Map.toTagMap rdr - } + let findById tagMapId webLogId = + log.LogTrace "TagMap.findById" + Document.findByIdAndWebLog conn ser Table.TagMap tagMapId webLogId /// Delete a tag mapping for the given web log let delete tagMapId webLogId = backgroundTask { + log.LogTrace "TagMap.delete" match! findById tagMapId webLogId with | Some _ -> - use cmd = conn.CreateCommand () - cmd.CommandText <- "DELETE FROM tag_map WHERE id = @id" - cmd.Parameters.AddWithValue ("@id", string tagMapId) |> ignore - do! write cmd + do! Document.delete conn Table.TagMap tagMapId return true | None -> return false } /// Find a tag mapping by its URL value for the given web log - let findByUrlValue (urlValue : string) webLogId = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT * FROM tag_map WHERE web_log_id = @webLogId AND url_value = @urlValue" + let findByUrlValue (urlValue: string) webLogId = backgroundTask { + log.LogTrace "TagMap.findByUrlValue" + use cmd = conn.CreateCommand() + cmd.CommandText <- $" + {Query.selectFromTable Table.TagMap} + WHERE {Query.whereByWebLog} + AND data ->> '{nameof TagMap.Empty.UrlValue}' = @urlValue" addWebLogId cmd webLogId - cmd.Parameters.AddWithValue ("@urlValue", urlValue) |> ignore - use! rdr = cmd.ExecuteReaderAsync () - return if rdr.Read () then Some (Map.toTagMap rdr) else None + addParam cmd "@urlValue" urlValue + use! rdr = cmd.ExecuteReaderAsync() + let! isFound = rdr.ReadAsync() + return if isFound then Some (Map.fromDoc 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 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 cmd ser /// Save a tag mapping - let save (tagMap : TagMap) = backgroundTask { - use cmd = conn.CreateCommand () + let save (tagMap: TagMap) = backgroundTask { + log.LogTrace "TagMap.save" match! findById tagMap.Id tagMap.WebLogId with - | Some _ -> - cmd.CommandText <- - "UPDATE tag_map - SET tag = @tag, - url_value = @urlValue - WHERE id = @id - AND web_log_id = @webLogId" - | None -> - cmd.CommandText <- - "INSERT INTO tag_map ( - id, web_log_id, tag, url_value - ) VALUES ( - @id, @webLogId, @tag, @urlValue - )" - addWebLogId cmd tagMap.WebLogId - [ cmd.Parameters.AddWithValue ("@id", string tagMap.Id) - cmd.Parameters.AddWithValue ("@tag", tagMap.Tag) - cmd.Parameters.AddWithValue ("@urlValue", tagMap.UrlValue) - ] |> ignore - do! write cmd + | Some _ -> do! Document.update conn ser Table.TagMap tagMap.Id tagMap + | None -> do! Document.insert conn ser Table.TagMap tagMap } /// Restore tag mappings from a backup let restore tagMaps = backgroundTask { + log.LogTrace "TagMap.restore" for tagMap in tagMaps do do! save tagMap } diff --git a/src/MyWebLog.Data/SQLiteData.fs b/src/MyWebLog.Data/SQLiteData.fs index edb44ff..af84359 100644 --- a/src/MyWebLog.Data/SQLiteData.fs +++ b/src/MyWebLog.Data/SQLiteData.fs @@ -29,7 +29,7 @@ type SQLiteData(conn: SqliteConnection, log: ILogger, 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, 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, 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, ser: JsonSeria PRIMARY KEY (post_id, as_of))" if needsTable Table.PostComment then $"{jsonTable Table.PostComment}; - CREATE INDEX idx_{Table.PostComment}_post ON {Table.PostComment} (data ->> 'PostId')" + CREATE INDEX idx_{Table.PostComment}_post ON {Table.PostComment} ((data ->> 'PostId'))" // Tag map table if needsTable Table.TagMap then $"{jsonTable Table.TagMap}; - CREATE INDEX idx_{Table.TagMap}_tag ON {Table.TagMap} (data ->> 'WebLogId', data ->> 'UrlValue')"; + CREATE INDEX idx_{Table.TagMap}_tag ON {Table.TagMap} ((data ->> 'WebLogId'), (data ->> 'UrlValue'))" // Uploaded file table if needsTable Table.Upload then @@ -451,7 +455,7 @@ type SQLiteData(conn: SqliteConnection, log: ILogger, ser: JsonSeria log.LogWarning $"Unknown database version; assuming {Utils.currentDbVersion}" do! setDbVersion Utils.currentDbVersion } - + /// The connection for this instance member _.Conn = conn @@ -466,10 +470,10 @@ type SQLiteData(conn: SqliteConnection, log: ILogger, ser: JsonSeria interface IData with - member _.Category = SQLiteCategoryData (conn, ser) - member _.Page = SQLitePageData (conn, ser) - member _.Post = SQLitePostData (conn, ser) - member _.TagMap = SQLiteTagMapData conn + member _.Category = SQLiteCategoryData (conn, ser, log) + member _.Page = SQLitePageData (conn, ser, log) + member _.Post = SQLitePostData (conn, ser, log) + member _.TagMap = SQLiteTagMapData (conn, ser, log) member _.Theme = SQLiteThemeData conn member _.ThemeAsset = SQLiteThemeAssetData conn member _.Upload = SQLiteUploadData conn @@ -481,8 +485,9 @@ type SQLiteData(conn: SqliteConnection, log: ILogger, ser: JsonSeria member _.StartUp () = backgroundTask { do! ensureTables () - use cmd = conn.CreateCommand () + use cmd = conn.CreateCommand() cmd.CommandText <- $"SELECT id FROM {Table.DbVersion}" - use! rdr = cmd.ExecuteReaderAsync () - do! migrate (if rdr.Read () then Some (Map.getString "id" rdr) else None) + use! rdr = cmd.ExecuteReaderAsync() + let! isFound = rdr.ReadAsync() + do! migrate (if isFound then Some (Map.getString "id" rdr) else None) }