From 5829d1cb9940b2d32d54fa6a3850bd2221f29e60 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Wed, 17 Aug 2022 20:07:20 -0400 Subject: [PATCH] WIP on PostgreSQL impl --- src/MyWebLog.Data/MyWebLog.Data.fsproj | 3 + .../PostgreSql/PostgreSqlCategoryData.fs | 133 +++---- .../PostgreSql/PostgreSqlHelpers.fs | 104 +++++- .../PostgreSql/PostgreSqlPageData.fs | 254 +++++++++++++ .../PostgreSql/PostgreSqlPostData.fs | 352 ++++++++++++++++++ .../PostgreSql/PostgreSqlTagMapData.fs | 94 +++++ src/MyWebLog.Data/PostgreSqlData.fs | 77 +--- src/MyWebLog.Data/SQLite/Helpers.fs | 17 - src/MyWebLog.Data/SQLite/SQLitePageData.fs | 6 +- src/MyWebLog.Data/SQLite/SQLitePostData.fs | 10 +- src/MyWebLog.Data/SQLite/SQLiteThemeData.fs | 4 +- src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs | 2 +- src/MyWebLog.Data/Utils.fs | 17 + 13 files changed, 906 insertions(+), 167 deletions(-) create mode 100644 src/MyWebLog.Data/PostgreSql/PostgreSqlPageData.fs create mode 100644 src/MyWebLog.Data/PostgreSql/PostgreSqlPostData.fs create mode 100644 src/MyWebLog.Data/PostgreSql/PostgreSqlTagMapData.fs diff --git a/src/MyWebLog.Data/MyWebLog.Data.fsproj b/src/MyWebLog.Data/MyWebLog.Data.fsproj index 3014d6d..090e70e 100644 --- a/src/MyWebLog.Data/MyWebLog.Data.fsproj +++ b/src/MyWebLog.Data/MyWebLog.Data.fsproj @@ -33,6 +33,9 @@ + + + diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs index 8783c9d..e0d7c9c 100644 --- a/src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs @@ -7,32 +7,6 @@ open Npgsql.FSharp type PostgreSqlCategoryData (conn : NpgsqlConnection) = - /// Add parameters for category INSERT or UPDATE statements - let addCategoryParameters (cat : Category) = - Sql.parameters [ - webLogIdParam cat.WebLogId - "@id", Sql.string (CategoryId.toString cat.Id) - "@name", Sql.string cat.Name - "@slug", Sql.string cat.Slug - "@description", Sql.stringOrNone cat.Description - "@parentId", Sql.stringOrNone (cat.ParentId |> Option.map CategoryId.toString) - ] - - /// Add a category - let add cat = backgroundTask { - let! _ = - Sql.existingConnection conn - |> Sql.query """ - INSERT INTO category ( - id, web_log_id, name, slug, description, parent_id - ) VALUES ( - @id, @webLogId, @name, @slug, @description, @parentId - )""" - |> addCategoryParameters cat - |> Sql.executeNonQueryAsync - () - } - /// Count all categories for the given web log let countAll webLogId = Sql.existingConnection conn @@ -54,39 +28,38 @@ type PostgreSqlCategoryData (conn : NpgsqlConnection) = |> Sql.query "SELECT * FROM category WHERE web_log_id = @webLogId ORDER BY LOWER(name)" |> Sql.parameters [ webLogIdParam webLogId ] |> Sql.executeAsync Map.toCategory - let ordered = Utils.orderByHierarchy cats None None [] + let ordered = Utils.orderByHierarchy cats None None [] let counts = ordered - // |> Seq.map (fun it -> backgroundTask { - // // Parent category post counts include posts in subcategories - // cmd.Parameters.Clear () - // addWebLogId cmd webLogId - // 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' - // AND pc.category_id IN (""" - // ordered - // |> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name) - // |> Seq.map (fun cat -> cat.Id) - // |> Seq.append (Seq.singleton it.Id) - // |> Seq.iteri (fun idx item -> - // if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, " - // cmd.CommandText <- $"{cmd.CommandText}@catId{idx}" - // cmd.Parameters.AddWithValue ($"@catId{idx}", item) |> ignore) - // cmd.CommandText <- $"{cmd.CommandText})" - // let! postCount = count cmd - // return it.Id, postCount - // }) - // |> Task.WhenAll + |> Seq.map (fun it -> + // Parent category post counts include posts in subcategories + let catIdSql, catIdParams = + ordered + |> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name) + |> Seq.map (fun cat -> cat.Id) + |> List.ofSeq + |> inClause "id" id + let postCount = + Sql.existingConnection conn + |> Sql.query $""" + SELECT COUNT(DISTINCT p.id) AS the_count + FROM post p + INNER JOIN post_category pc ON pc.post_id = p.id + WHERE p.web_log_id = @webLogId + AND p.status = 'Published' + AND pc.category_id IN ({catIdSql})""" + |> Sql.parameters (webLogIdParam webLogId :: catIdParams) + |> Sql.executeRowAsync Map.toCount + |> Async.AwaitTask + |> Async.RunSynchronously + it.Id, postCount) + |> List.ofSeq return ordered |> Seq.map (fun cat -> { cat with PostCount = counts - |> Array.tryFind (fun c -> fst c = cat.Id) + |> List.tryFind (fun c -> fst c = cat.Id) |> Option.map snd |> Option.defaultValue 0 }) @@ -130,51 +103,53 @@ type PostgreSqlCategoryData (conn : NpgsqlConnection) = "@newParentId", Sql.stringOrNone (cat.ParentId |> Option.map CategoryId.toString) ] |> Sql.executeNonQueryAsync () - // Delete the category off all posts where it is assigned - let catIdParam = "@id", Sql.string (CategoryId.toString catId) + // Delete the category off all posts where it is assigned, and the category itself let! _ = Sql.existingConnection conn |> Sql.query """ DELETE FROM post_category WHERE category_id = @id - AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId)""" - |> Sql.parameters [ catIdParam; webLogIdParam webLogId ] - |> Sql.executeNonQueryAsync - // Delete the category itself - let! _ = - Sql.existingConnection conn - |> Sql.query "DELETE FROM category WHERE id = @id" - |> Sql.parameters [ catIdParam ] + AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId); + DELETE FROM category WHERE id = @id""" + |> Sql.parameters [ "@id", Sql.string (CategoryId.toString catId); webLogIdParam webLogId ] |> Sql.executeNonQueryAsync return if children = 0 then CategoryDeleted else ReassignedChildCategories | None -> return CategoryNotFound } - /// Restore categories from a backup - let restore cats = backgroundTask { - for cat in cats do - do! add cat - } - /// Update a category - let update cat = backgroundTask { + let save (cat : Category) = backgroundTask { let! _ = Sql.existingConnection conn |> Sql.query """ - UPDATE category - SET name = @name, - slug = @slug, - description = @description, - parent_id = @parentId - WHERE id = @id - AND web_log_id = @webLogId""" - |> addCategoryParameters cat + INSERT INTO category ( + id, web_log_id, name, slug, description, parent_id + ) VALUES ( + @id, @webLogId, @name, @slug, @description, @parentId + ) ON CONFLICT (id) DO UPDATE + SET name = EXCLUDED.name, + slug = EXCLUDED.slug, + description = EXCLUDED.description, + parent_id = EXCLUDED.parent_id""" + |> Sql.parameters + [ webLogIdParam cat.WebLogId + "@id", Sql.string (CategoryId.toString cat.Id) + "@name", Sql.string cat.Name + "@slug", Sql.string cat.Slug + "@description", Sql.stringOrNone cat.Description + "@parentId", Sql.stringOrNone (cat.ParentId |> Option.map CategoryId.toString) ] |> Sql.executeNonQueryAsync () } + /// Restore categories from a backup + let restore cats = backgroundTask { + for cat in cats do + do! save cat + } + interface ICategoryData with - member _.Add cat = add cat + member _.Add cat = save cat member _.CountAll webLogId = countAll webLogId member _.CountTopLevel webLogId = countTopLevel webLogId member _.FindAllForView webLogId = findAllForView webLogId @@ -182,4 +157,4 @@ type PostgreSqlCategoryData (conn : NpgsqlConnection) = member _.FindByWebLog webLogId = findByWebLog webLogId member _.Delete catId webLogId = delete catId webLogId member _.Restore cats = restore cats - member _.Update cat = update cat + member _.Update cat = save cat diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs index ed8ee91..8004f45 100644 --- a/src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs @@ -3,18 +3,49 @@ module MyWebLog.Data.PostgreSql.PostgreSqlHelpers open MyWebLog +open Newtonsoft.Json open Npgsql.FSharp /// Create a SQL parameter for the web log ID let webLogIdParam webLogId = "@webLogId", Sql.string (WebLogId.toString webLogId) +/// Create the SQL and parameters to find a page or post by one or more prior permalinks +let priorPermalinkSql permalinks = + let mutable idx = 0 + permalinks + |> List.skip 1 + |> List.fold (fun (linkSql, linkParams) it -> + idx <- idx + 1 + $"{linkSql} OR prior_permalinks && ARRAY[@link{idx}]", + ($"@link{idx}", Sql.string (Permalink.toString it)) :: linkParams) + (Seq.ofList permalinks + |> Seq.map (fun it -> + "prior_permalinks && ARRAY[@link0]", [ "@link0", Sql.string (Permalink.toString it) ]) + |> Seq.head) + +/// Create the SQL and parameters for an IN clause +let inClause<'T> name (valueFunc: 'T -> string) (items : 'T list) = + let mutable idx = 0 + items + |> List.skip 1 + |> List.fold (fun (itemS, itemP) it -> + idx <- idx + 1 + $"{itemS}, @%s{name}{idx}", ($"@%s{name}{idx}", Sql.string (valueFunc it)) :: itemP) + (Seq.ofList items + |> Seq.map (fun it -> $"@%s{name}0", [ $"@%s{name}0", Sql.string (valueFunc it) ]) + |> Seq.head) + /// Mapping functions for SQL queries module Map = - /// Create a category from the current row in the given data reader + /// Map an id field to a category ID + let toCategoryId (row : RowReader) = + CategoryId (row.string "id") + + /// Create a category from the current row let toCategory (row : RowReader) : Category = - { Id = row.string "id" |> CategoryId + { Id = toCategoryId row WebLogId = row.string "web_log_id" |> WebLogId Name = row.string "name" Slug = row.string "slug" @@ -25,3 +56,72 @@ module Map = /// Get a count from a row let toCount (row : RowReader) = row.int "the_count" + + /// Create a meta item from the current row + let toMetaItem (row : RowReader) : MetaItem = + { Name = row.string "name" + Value = row.string "value" + } + + /// Create a permalink from the current row + let toPermalink (row : RowReader) = + Permalink (row.string "permalink") + + /// Create a page from the current row + let toPage (row : RowReader) : Page = + { Page.empty with + Id = row.string "id" |> PageId + WebLogId = row.string "web_log_id" |> WebLogId + AuthorId = row.string "author_id" |> WebLogUserId + Title = row.string "title" + Permalink = toPermalink row + PriorPermalinks = row.stringArray "prior_permalinks" |> Array.map Permalink |> List.ofArray + PublishedOn = row.dateTime "published_on" + UpdatedOn = row.dateTime "updated_on" + IsInPageList = row.bool "is_in_page_list" + Template = row.stringOrNone "template" + Text = row.string "page_text" + Metadata = row.stringOrNone "meta_items" + |> Option.map JsonConvert.DeserializeObject + |> Option.defaultValue [] + } + + /// Create a post from the current row + let toPost (row : RowReader) : Post = + { Post.empty with + Id = row.string "id" |> PostId + WebLogId = row.string "web_log_id" |> WebLogId + AuthorId = row.string "author_id" |> WebLogUserId + Status = row.string "status" |> PostStatus.parse + Title = row.string "title" + Permalink = toPermalink row + PriorPermalinks = row.stringArray "prior_permalinks" |> Array.map Permalink |> List.ofArray + PublishedOn = row.dateTimeOrNone "published_on" + UpdatedOn = row.dateTime "updated_on" + Template = row.stringOrNone "template" + Text = row.string "post_text" + CategoryIds = row.stringArrayOrNone "category_ids" + |> Option.map (Array.map CategoryId >> List.ofArray) + |> Option.defaultValue [] + Tags = row.stringArrayOrNone "tags" + |> Option.map List.ofArray + |> Option.defaultValue [] + Metadata = row.stringOrNone "meta_items" + |> Option.map JsonConvert.DeserializeObject + |> Option.defaultValue [] + Episode = row.stringOrNone "episode" |> Option.map JsonConvert.DeserializeObject + } + + /// Create a revision from the current row + let toRevision (row : RowReader) : Revision = + { AsOf = row.dateTime "as_of" + Text = row.string "revision_text" |> MarkupText.parse + } + + /// Create a tag mapping from the current row in the given data reader + let toTagMap (row : RowReader) : TagMap = + { Id = row.string "id" |> TagMapId + WebLogId = row.string "web_log_id" |> WebLogId + Tag = row.string "tag" + UrlValue = row.string "url_value" + } diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlPageData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlPageData.fs new file mode 100644 index 0000000..0fd42ee --- /dev/null +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlPageData.fs @@ -0,0 +1,254 @@ +namespace MyWebLog.Data.PostgreSql + +open MyWebLog +open MyWebLog.Data +open Newtonsoft.Json +open Npgsql +open Npgsql.FSharp + +/// PostgreSQL myWebLog page data implementation +type PostgreSqlPageData (conn : NpgsqlConnection) = + + // SUPPORT FUNCTIONS + + /// Append revisions and permalinks to a page + let appendPageRevisions (page : Page) = backgroundTask { + let! revisions = + Sql.existingConnection conn + |> Sql.query "SELECT as_of, revision_text FROM page_revision WHERE page_id = @pageId ORDER BY as_of DESC" + |> Sql.parameters [ "@pageId", Sql.string (PageId.toString page.Id) ] + |> Sql.executeAsync Map.toRevision + return { page with Revisions = revisions } + } + + /// Return a page with no text or revisions + let pageWithoutText row = + { Map.toPage row with Text = "" } + + /// Update a page's revisions + let updatePageRevisions pageId oldRevs newRevs = backgroundTask { + let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs + if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then + let! _ = + Sql.existingConnection conn + |> Sql.executeTransactionAsync [ + if not (List.isEmpty toDelete) then + "DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @asOf", + toDelete + |> List.map (fun it -> [ + "@pageId", Sql.string (PageId.toString pageId) + "@asOf", Sql.timestamptz it.AsOf + ]) + if not (List.isEmpty toAdd) then + "INSERT INTO page_revision VALUES (@pageId, @asOf, @text)", + toAdd + |> List.map (fun it -> [ + "@pageId", Sql.string (PageId.toString pageId) + "@asOf", Sql.timestamptz it.AsOf + "@text", Sql.string (MarkupText.toString it.Text) + ]) + ] + () + } + + // IMPLEMENTATION FUNCTIONS + + /// Get all pages for a web log (without text, revisions, prior permalinks, or metadata) + let all webLogId = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId ORDER BY LOWER(title)" + |> Sql.parameters [ webLogIdParam webLogId ] + |> Sql.executeAsync pageWithoutText + + /// Count all pages for the given web log + let countAll webLogId = + Sql.existingConnection conn + |> Sql.query "SELECT COUNT(id) AS the_count FROM page WHERE web_log_id = @webLogId" + |> Sql.parameters [ webLogIdParam webLogId ] + |> Sql.executeRowAsync Map.toCount + + /// Count all pages shown in the page list for the given web log + let countListed webLogId = + Sql.existingConnection conn + |> Sql.query "SELECT COUNT(id) AS the_count FROM page WHERE web_log_id = @webLogId AND is_in_page_list = TRUE" + |> Sql.parameters [ webLogIdParam webLogId ] + |> Sql.executeRowAsync Map.toCount + + /// Find a page by its ID (without revisions) + let findById pageId webLogId = backgroundTask { + let! page = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM page WHERE id = @id AND web_log_id = @webLogId" + |> Sql.parameters [ "@id", Sql.string (PageId.toString pageId); webLogIdParam webLogId ] + |> Sql.executeAsync Map.toPage + return List.tryHead page + } + + /// Find a complete page by its ID + let findFullById pageId webLogId = backgroundTask { + match! findById pageId webLogId with + | Some page -> + let! withMore = appendPageRevisions page + return Some withMore + | None -> return None + } + + /// Delete a page by its ID + let delete pageId webLogId = backgroundTask { + match! findById pageId webLogId with + | Some _ -> + let! _ = + Sql.existingConnection conn + |> Sql.query """ + DELETE FROM page_revision WHERE page_id = @id; + DELETE FROM page WHERE id = @id""" + |> Sql.parameters [ "@id", Sql.string (PageId.toString pageId) ] + |> Sql.executeNonQueryAsync + return true + | None -> return false + } + + /// Find a page by its permalink for the given web log + let findByPermalink permalink webLogId = backgroundTask { + let! page = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId AND permalink = @link" + |> Sql.parameters [ webLogIdParam webLogId; "@link", Sql.string (Permalink.toString permalink) ] + |> Sql.executeAsync Map.toPage + return List.tryHead page + } + + /// Find the current permalink within a set of potential prior permalinks for the given web log + let findCurrentPermalink permalinks webLogId = backgroundTask { + if List.isEmpty permalinks then return None + else + let linkSql, linkParams = priorPermalinkSql permalinks + let! links = + Sql.existingConnection conn + |> Sql.query $"SELECT permalink FROM page WHERE web_log_id = @webLogId AND ({linkSql})" + |> Sql.parameters (webLogIdParam webLogId :: linkParams) + |> Sql.executeAsync Map.toPermalink + return List.tryHead links + } + + /// Get all complete pages for the given web log + let findFullByWebLog webLogId = backgroundTask { + let! pages = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId" + |> Sql.parameters [ webLogIdParam webLogId ] + |> Sql.executeAsync Map.toPage + let! revisions = + Sql.existingConnection conn + |> Sql.query """ + SELECT * + FROM page_revision pr + INNER JOIN page p ON p.id = pr.page_id + WHERE p.web_log_id = @webLogId + ORDER BY pr.as_of DESC""" + |> Sql.parameters [ webLogIdParam webLogId ] + |> Sql.executeAsync (fun row -> PageId (row.string "page_id"), Map.toRevision row) + return + pages + |> List.map (fun it -> + { it with Revisions = revisions |> List.filter (fun r -> fst r = it.Id) |> List.map snd }) + } + + /// Get all listed pages for the given web log (without revisions or text) + let findListed webLogId = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId AND is_in_page_list = TRUE ORDER BY LOWER(title)" + |> Sql.parameters [ webLogIdParam webLogId ] + |> Sql.executeAsync pageWithoutText + + /// Get a page of pages for the given web log (without revisions) + let findPageOfPages webLogId pageNbr = + Sql.existingConnection conn + |> Sql.query""" + SELECT * + FROM page + WHERE web_log_id = @webLogId + ORDER BY LOWER(title) + LIMIT @pageSize OFFSET @toSkip""" + |> Sql.parameters [ webLogIdParam webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ] + |> Sql.executeAsync Map.toPage + + /// Save a page + let save (page : Page) = backgroundTask { + let! oldPage = findFullById page.Id page.WebLogId + let! _ = + Sql.existingConnection conn + |> Sql.query """ + INSERT INTO page ( + id, web_log_id, author_id, title, permalink, prior_permalinks, published_on, updated_on, + is_in_page_list, template, page_text, meta_items + ) VALUES ( + @id, @webLogId, @authorId, @title, @permalink, @priorPermalinks, @publishedOn, @updatedOn, + @isInPageList, @template, @text, @metaItems + ) ON CONFLICT (id) DO UPDATE + SET author_id = EXCLUDED.author_id, + title = EXCLUDED.title, + permalink = EXCLUDED.permalink, + prior_permalinks = EXCLUDED.prior_permalinks, + published_on = EXCLUDED.published_on, + updated_on = EXCLUDED.updated_on, + is_in_page_list = EXCLUDED.is_in_page_list, + template = EXCLUDED.template, + page_text = EXCLUDED.text, + meta_items = EXCLUDED.meta_items""" + |> Sql.parameters + [ webLogIdParam page.WebLogId + "@id", Sql.string (PageId.toString page.Id) + "@authorId", Sql.string (WebLogUserId.toString page.AuthorId) + "@title", Sql.string page.Title + "@permalink", Sql.string (Permalink.toString page.Permalink) + "@publishedOn", Sql.timestamptz page.PublishedOn + "@updatedOn", Sql.timestamptz page.UpdatedOn + "@isInPageList", Sql.bool page.IsInPageList + "@template", Sql.stringOrNone page.Template + "@text", Sql.string page.Text + "@metaItems", Sql.jsonb (JsonConvert.SerializeObject page.Metadata) + "@priorPermalinks", + Sql.stringArray (page.PriorPermalinks |> List.map Permalink.toString |> Array.ofList) ] + |> Sql.executeNonQueryAsync + do! updatePageRevisions page.Id (match oldPage with Some p -> p.Revisions | None -> []) page.Revisions + () + } + + /// Restore pages from a backup + let restore pages = backgroundTask { + for page in pages do + do! save page + } + + /// Update a page's prior permalinks + let updatePriorPermalinks pageId webLogId permalinks = backgroundTask { + match! findById pageId webLogId with + | Some _ -> + let! _ = + Sql.existingConnection conn + |> Sql.query "UPDATE page SET prior_permalinks = @prior WHERE id = @id" + |> Sql.parameters + [ "@id", Sql.string (PageId.toString pageId) + "@prior", Sql.stringArray (permalinks |> List.map Permalink.toString |> Array.ofList) ] + |> Sql.executeNonQueryAsync + return true + | None -> return false + } + + interface IPageData with + member _.Add page = save page + member _.All webLogId = all webLogId + member _.CountAll webLogId = countAll webLogId + member _.CountListed webLogId = countListed webLogId + member _.Delete pageId webLogId = delete pageId webLogId + member _.FindById pageId webLogId = findById pageId webLogId + member _.FindByPermalink permalink webLogId = findByPermalink permalink webLogId + member _.FindCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId + member _.FindFullById pageId webLogId = findFullById pageId webLogId + member _.FindFullByWebLog webLogId = findFullByWebLog webLogId + member _.FindListed webLogId = findListed webLogId + member _.FindPageOfPages webLogId pageNbr = findPageOfPages webLogId pageNbr + member _.Restore pages = restore pages + member _.Update page = save page + member _.UpdatePriorPermalinks pageId webLogId permalinks = updatePriorPermalinks pageId webLogId permalinks diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlPostData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlPostData.fs new file mode 100644 index 0000000..4679ab9 --- /dev/null +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlPostData.fs @@ -0,0 +1,352 @@ +namespace MyWebLog.Data.PostgreSql + +open System +open MyWebLog +open MyWebLog.Data +open Newtonsoft.Json +open Npgsql +open Npgsql.FSharp + +/// PostgreSQL myWebLog post data implementation +type PostgreSqlPostData (conn : NpgsqlConnection) = + + // SUPPORT FUNCTIONS + + /// Append revisions to a post + let appendPostRevisions (post : Post) = backgroundTask { + let! revisions = + Sql.existingConnection conn + |> Sql.query "SELECT as_of, revision_text FROM post_revision WHERE post_id = @id ORDER BY as_of DESC" + |> Sql.parameters [ "@id", Sql.string (PostId.toString post.Id) ] + |> Sql.executeAsync Map.toRevision + return { post with Revisions = revisions } + } + + /// The SELECT statement for a post that will include category IDs + let selectPost = + """SELECT *, ARRAY(SELECT cat.category_id FROM post_category cat WHERE cat.post_id = p.id) AS category_ids + FROM post""" + + /// Return a post with no revisions, prior permalinks, or text + let postWithoutText row = + { Map.toPost row with Text = "" } + + /// Update a post's assigned categories + let updatePostCategories postId oldCats newCats = backgroundTask { + let toDelete, toAdd = Utils.diffLists oldCats newCats CategoryId.toString + if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then + let catParams cats = + cats + |> List.map (fun it -> [ + "@postId", Sql.string (PostId.toString postId) + "categoryId", Sql.string (CategoryId.toString it) + ]) + let! _ = + Sql.existingConnection conn + |> Sql.executeTransactionAsync [ + if not (List.isEmpty toDelete) then + "DELETE FROM post_category WHERE post_id = @postId AND category_id = @categoryId", + catParams toDelete + if not (List.isEmpty toAdd) then + "INSERT INTO post_category VALUES (@postId, @categoryId)", catParams toAdd + ] + () + } + + /// Update a post's revisions + let updatePostRevisions postId oldRevs newRevs = backgroundTask { + let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs + if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then + let! _ = + Sql.existingConnection conn + |> Sql.executeTransactionAsync [ + if not (List.isEmpty toDelete) then + "DELETE FROM post_revision WHERE post_id = @postId AND as_of = @asOf", + toDelete + |> List.map (fun it -> [ + "@postId", Sql.string (PostId.toString postId) + "@asOf", Sql.timestamptz it.AsOf + ]) + if not (List.isEmpty toAdd) then + "INSERT INTO post_revision VALUES (@postId, @asOf, @text)", + toAdd + |> List.map (fun it -> [ + "@postId", Sql.string (PostId.toString postId) + "@asOf", Sql.timestamptz it.AsOf + "@text", Sql.string (MarkupText.toString it.Text) + ]) + ] + () + } + + // IMPLEMENTATION FUNCTIONS + + /// Count posts in a status for the given web log + let countByStatus status webLogId = + Sql.existingConnection conn + |> Sql.query "SELECT COUNT(id) AS the_count FROM post WHERE web_log_id = @webLogId AND status = @status" + |> Sql.parameters [ webLogIdParam webLogId; "@status", Sql.string (PostStatus.toString status) ] + |> Sql.executeRowAsync Map.toCount + + /// Find a post by its ID for the given web log (excluding revisions) + let findById postId webLogId = backgroundTask { + let! post = + Sql.existingConnection conn + |> Sql.query $"{selectPost} WHERE id = @id AND web_log_id = @webLogId" + |> Sql.parameters [ "@id", Sql.string (PostId.toString postId); webLogIdParam webLogId ] + |> Sql.executeAsync Map.toPost + return List.tryHead post + } + + /// Find a post by its permalink for the given web log (excluding revisions and prior permalinks) + let findByPermalink permalink webLogId = backgroundTask { + let! post = + Sql.existingConnection conn + |> Sql.query $"{selectPost} WHERE web_log_id = @webLogId AND permalink = @link" + |> Sql.parameters [ webLogIdParam webLogId; "@link", Sql.string (Permalink.toString permalink) ] + |> Sql.executeAsync Map.toPost + return List.tryHead post + } + + /// Find a complete post by its ID for the given web log + let findFullById postId webLogId = backgroundTask { + match! findById postId webLogId with + | Some post -> + let! withRevisions = appendPostRevisions post + return Some withRevisions + | None -> return None + } + + /// Delete a post by its ID for the given web log + let delete postId webLogId = backgroundTask { + match! findById postId webLogId with + | Some _ -> + let! _ = + Sql.existingConnection conn + |> Sql.query """ + DELETE FROM post_revision WHERE post_id = @id; + DELETE FROM post_category WHERE post_id = @id; + DELETE FROM post WHERE id = @id""" + |> Sql.parameters [ "@id", Sql.string (PostId.toString postId) ] + |> Sql.executeNonQueryAsync + return true + | None -> return false + } + + /// Find the current permalink from a list of potential prior permalinks for the given web log + let findCurrentPermalink permalinks webLogId = backgroundTask { + if List.isEmpty permalinks then return None + else + let linkSql, linkParams = priorPermalinkSql permalinks + let! links = + Sql.existingConnection conn + |> Sql.query $"SELECT permalink FROM post WHERE web_log_id = @webLogId AND ({linkSql}" + |> Sql.parameters (webLogIdParam webLogId :: linkParams) + |> Sql.executeAsync Map.toPermalink + return List.tryHead links + } + + /// Get all complete posts for the given web log + let findFullByWebLog webLogId = backgroundTask { + let! posts = + Sql.existingConnection conn + |> Sql.query $"{selectPost} WHERE web_log_id = @webLogId" + |> Sql.parameters [ webLogIdParam webLogId ] + |> Sql.executeAsync Map.toPost + let! revisions = + Sql.existingConnection conn + |> Sql.query """ + SELECT * + FROM post_revision pr + INNER JOIN post p ON p.id = pr.post_id + WHERE p.web_log_id = @webLogId + ORDER BY as_of DESC""" + |> Sql.parameters [ webLogIdParam webLogId ] + |> Sql.executeAsync (fun row -> PostId (row.string "post_id"), Map.toRevision row) + return + posts + |> List.map (fun it -> + { it with Revisions = revisions |> List.filter (fun r -> fst r = it.Id) |> List.map snd }) + } + + /// Get a page of categorized posts for the given web log (excludes revisions) + let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = + let catSql, catParams = inClause "catId" CategoryId.toString categoryIds + Sql.existingConnection conn + |> Sql.query $""" + {selectPost} p + INNER JOIN post_category pc ON pc.post_id = p.id + WHERE p.web_log_id = @webLogId + AND p.status = @status + AND pc.category_id IN ({catSql}) + ORDER BY published_on DESC + LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}""" + |> Sql.parameters + [ webLogIdParam webLogId + "@status", Sql.string (PostStatus.toString Published) + yield! catParams ] + |> Sql.executeAsync Map.toPost + + /// Get a page of posts for the given web log (excludes text and revisions) + let findPageOfPosts webLogId pageNbr postsPerPage = + Sql.existingConnection conn + |> Sql.query $""" + {selectPost} + WHERE web_log_id = @webLogId + ORDER BY published_on DESC NULLS FIRST, updated_on + LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}""" + |> Sql.parameters [ webLogIdParam webLogId ] + |> Sql.executeAsync postWithoutText + + /// Get a page of published posts for the given web log (excludes revisions) + let findPageOfPublishedPosts webLogId pageNbr postsPerPage = + Sql.existingConnection conn + |> Sql.query $""" + {selectPost} + WHERE web_log_id = @webLogId + AND status = @status + ORDER BY published_on DESC + LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}""" + |> Sql.parameters [ webLogIdParam webLogId; "@status", Sql.string (PostStatus.toString Published) ] + |> Sql.executeAsync Map.toPost + + /// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks) + let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage = + Sql.existingConnection conn + |> Sql.query $""" + {selectPost} + WHERE web_log_id = @webLogId + AND status = @status + AND tag && ARRAY[@tag] + ORDER BY published_on DESC + LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}""" + |> Sql.parameters + [ webLogIdParam webLogId + "@status", Sql.string (PostStatus.toString Published) + "@tag", Sql.string tag + ] + |> Sql.executeAsync Map.toPost + + /// Find the next newest and oldest post from a publish date for the given web log + let findSurroundingPosts webLogId (publishedOn : DateTime) = backgroundTask { + let queryParams = Sql.parameters [ + webLogIdParam webLogId + "@status", Sql.string (PostStatus.toString Published) + "@publishedOn", Sql.timestamptz publishedOn + ] + let! older = + Sql.existingConnection conn + |> Sql.query $""" + {selectPost} + WHERE web_log_id = @webLogId + AND status = @status + AND published_on < @publishedOn + ORDER BY published_on DESC + LIMIT 1""" + |> queryParams + |> Sql.executeAsync Map.toPost + let! newer = + Sql.existingConnection conn + |> Sql.query $""" + {selectPost} + WHERE web_log_id = @webLogId + AND status = @status + AND published_on > @publishedOn + ORDER BY published_on + LIMIT 1""" + |> queryParams + |> Sql.executeAsync Map.toPost + return List.tryHead older, List.tryHead newer + } + + /// Save a post + let save (post : Post) = backgroundTask { + let! oldPost = findFullById post.Id post.WebLogId + let! _ = + Sql.existingConnection conn + |> Sql.query """ + INSERT INTO post ( + id, web_log_id, author_id, status, title, permalink, prior_permalinks, published_on, updated_on, + template, post_text, tags, meta_items, episode + ) VALUES ( + @id, @webLogId, @authorId, @status, @title, @permalink, @priorPermalinks, @publishedOn, @updatedOn, + @template, @text, @tags, @metaItems, @episode + ) ON CONFLICT (id) DO UPDATE + SET author_id = EXCLUDED.author_id, + status = EXCLUDED.status, + title = EXCLUDED.title, + permalink = EXCLUDED.permalink, + prior_permalinks = EXCLUDED.prior_permalinks, + published_on = EXCLUDED.published_on, + updated_on = EXCLUDED.updated_on, + template = EXCLUDED.template, + post_text = EXCLUDED.text, + tags = EXCLUDED.tags, + meta_items = EXCLUDED.meta_items, + episode = EXCLUDED.episode""" + |> Sql.parameters + [ webLogIdParam post.WebLogId + "@id", Sql.string (PostId.toString post.Id) + "@authorId", Sql.string (WebLogUserId.toString post.AuthorId) + "@status", Sql.string (PostStatus.toString post.Status) + "@title", Sql.string post.Title + "@permalink", Sql.string (Permalink.toString post.Permalink) + "@publishedOn", Sql.timestamptzOrNone post.PublishedOn + "@updatedOn", Sql.timestamptz post.UpdatedOn + "@template", Sql.stringOrNone post.Template + "@text", Sql.string post.Text + "@episode", Sql.jsonbOrNone (post.Episode |> Option.map JsonConvert.SerializeObject) + "@priorPermalinks", + Sql.stringArray (post.PriorPermalinks |> List.map Permalink.toString |> Array.ofList) + "@tags", + Sql.stringArrayOrNone (if List.isEmpty post.Tags then None else Some (Array.ofList post.Tags)) + "@metaItems", + if List.isEmpty post.Metadata then None else Some (JsonConvert.SerializeObject post.Metadata) + |> Sql.jsonbOrNone + ] + |> Sql.executeNonQueryAsync + do! updatePostCategories post.Id (match oldPost with Some p -> p.CategoryIds | None -> []) post.CategoryIds + do! updatePostRevisions post.Id (match oldPost with Some p -> p.Revisions | None -> []) post.Revisions + } + + /// Restore posts from a backup + let restore posts = backgroundTask { + for post in posts do + do! save post + } + + /// Update prior permalinks for a post + let updatePriorPermalinks postId webLogId permalinks = backgroundTask { + match! findById postId webLogId with + | Some _ -> + let! _ = + Sql.existingConnection conn + |> Sql.query "UPDATE post SET prior_permalinks = @prior WHERE id = @id" + |> Sql.parameters + [ "@id", Sql.string (PostId.toString postId) + "@prior", Sql.stringArray (permalinks |> List.map Permalink.toString |> Array.ofList) ] + |> Sql.executeNonQueryAsync + return true + | None -> return false + } + + interface IPostData with + member _.Add post = save post + member _.CountByStatus status webLogId = countByStatus status webLogId + member _.Delete postId webLogId = delete postId webLogId + member _.FindById postId webLogId = findById postId webLogId + member _.FindByPermalink permalink webLogId = findByPermalink permalink webLogId + member _.FindCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId + member _.FindFullById postId webLogId = findFullById postId webLogId + member _.FindFullByWebLog webLogId = findFullByWebLog webLogId + member _.FindPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = + findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage + member _.FindPageOfPosts webLogId pageNbr postsPerPage = findPageOfPosts webLogId pageNbr postsPerPage + member _.FindPageOfPublishedPosts webLogId pageNbr postsPerPage = + findPageOfPublishedPosts webLogId pageNbr postsPerPage + member _.FindPageOfTaggedPosts webLogId tag pageNbr postsPerPage = + findPageOfTaggedPosts webLogId tag pageNbr postsPerPage + member _.FindSurroundingPosts webLogId publishedOn = findSurroundingPosts webLogId publishedOn + member _.Restore posts = restore posts + member _.Update post = save post + member _.UpdatePriorPermalinks postId webLogId permalinks = updatePriorPermalinks postId webLogId permalinks diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlTagMapData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlTagMapData.fs new file mode 100644 index 0000000..52e9cb6 --- /dev/null +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlTagMapData.fs @@ -0,0 +1,94 @@ +namespace MyWebLog.Data.PostgreSql + +open MyWebLog +open MyWebLog.Data +open Npgsql +open Npgsql.FSharp + +/// PostgreSQL myWebLog tag mapping data implementation +type PostgreSqlTagMapData (conn : NpgsqlConnection) = + + /// Find a tag mapping by its ID for the given web log + let findById tagMapId webLogId = backgroundTask { + let! tagMap = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM tag_map WHERE id = @id AND web_log_id = @webLogId" + |> Sql.parameters [ "@id", Sql.string (TagMapId.toString tagMapId); webLogIdParam webLogId ] + |> Sql.executeAsync Map.toTagMap + return List.tryHead tagMap + } + + /// Delete a tag mapping for the given web log + let delete tagMapId webLogId = backgroundTask { + match! findById tagMapId webLogId with + | Some _ -> + let! _ = + Sql.existingConnection conn + |> Sql.query "DELETE FROM tag_map WHERE id = @id" + |> Sql.parameters [ "@id", Sql.string (TagMapId.toString tagMapId) ] + |> Sql.executeNonQueryAsync + return true + | None -> return false + } + + /// Find a tag mapping by its URL value for the given web log + let findByUrlValue urlValue webLogId = backgroundTask { + let! tagMap = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM tag_map WHERE web_log_id = @webLogId AND url_value = @urlValue" + |> Sql.parameters [ webLogIdParam webLogId; "@urlValue", Sql.string urlValue ] + |> Sql.executeAsync Map.toTagMap + return List.tryHead tagMap + } + + /// Get all tag mappings for the given web log + let findByWebLog webLogId = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM tag_map WHERE web_log_id = @webLogId ORDER BY tag" + |> Sql.parameters [ webLogIdParam webLogId ] + |> Sql.executeAsync Map.toTagMap + + /// Find any tag mappings in a list of tags for the given web log + let findMappingForTags tags webLogId = + let tagSql, tagParams = inClause "tag" id tags + Sql.existingConnection conn + |> Sql.query $"SELECT * FROM tag_map WHERE web_log_id = @webLogId AND tag IN ({tagSql}" + |> Sql.parameters (webLogIdParam webLogId :: tagParams) + |> Sql.executeAsync Map.toTagMap + + /// Save a tag mapping + let save (tagMap : TagMap) = backgroundTask { + let! _ = + Sql.existingConnection conn + |> Sql.query """ + INSERT INTO tag_map ( + id, web_log_id, tag, url_value + ) VALUES ( + @id, @webLogId, @tag, @urlValue + ) ON CONFLICT (id) DO UPDATE + SET tag = EXCLUDED.tag, + url_value = EXCLUDED.url_value""" + |> Sql.parameters + [ webLogIdParam tagMap.WebLogId + "@id", Sql.string (TagMapId.toString tagMap.Id) + "@tag", Sql.string tagMap.Tag + "@urlValue", Sql.string tagMap.UrlValue + ] + |> Sql.executeNonQueryAsync + () + } + + /// Restore tag mappings from a backup + let restore tagMaps = backgroundTask { + for tagMap in tagMaps do + do! save tagMap + } + + interface ITagMapData with + member _.Delete tagMapId webLogId = delete tagMapId webLogId + member _.FindById tagMapId webLogId = findById tagMapId webLogId + member _.FindByUrlValue urlValue webLogId = findByUrlValue urlValue webLogId + member _.FindByWebLog webLogId = findByWebLog webLogId + member _.FindMappingForTags tags webLogId = findMappingForTags tags webLogId + member _.Save tagMap = save tagMap + member _.Restore tagMaps = restore tagMaps diff --git a/src/MyWebLog.Data/PostgreSqlData.fs b/src/MyWebLog.Data/PostgreSqlData.fs index 230966d..a121728 100644 --- a/src/MyWebLog.Data/PostgreSqlData.fs +++ b/src/MyWebLog.Data/PostgreSqlData.fs @@ -12,6 +12,8 @@ type PostgreSqlData (conn : NpgsqlConnection, log : ILogger) = interface IData with member _.Category = PostgreSqlCategoryData conn + member _.Page = PostgreSqlPageData conn + member _.Post = PostgreSqlPostData conn member _.StartUp () = backgroundTask { @@ -127,25 +129,16 @@ type PostgreSqlData (conn : NpgsqlConnection, log : ILogger) = author_id TEXT NOT NULL REFERENCES web_log_user (id), title TEXT NOT NULL, permalink TEXT NOT NULL, + prior_permalinks TEXT[] NOT NULL DEFAULT '{}', published_on TIMESTAMPTZ NOT NULL, updated_on TIMESTAMPTZ NOT NULL, is_in_page_list BOOLEAN NOT NULL DEFAULT FALSE, template TEXT, - page_text TEXT NOT NULL); + page_text TEXT NOT NULL + meta_items JSONB); CREATE INDEX page_web_log_idx ON page (web_log_id); CREATE INDEX page_author_idx ON page (author_id); CREATE INDEX page_permalink_idx ON page (web_log_id, permalink)""" - if needsTable "page_meta" then - """CREATE TABLE page_meta ( - page_id TEXT NOT NULL REFERENCES page (id), - name TEXT NOT NULL, - value TEXT NOT NULL, - PRIMARY KEY (page_id, name, value))""" - if needsTable "page_permalink" then - """CREATE TABLE page_permalink ( - page_id TEXT NOT NULL REFERENCES page (id), - permalink TEXT NOT NULL, - PRIMARY KEY (page_id, permalink))""" if needsTable "page_revision" then """CREATE TABLE page_revision ( page_id TEXT NOT NULL REFERENCES page (id), @@ -156,16 +149,20 @@ type PostgreSqlData (conn : NpgsqlConnection, log : ILogger) = // Post tables if needsTable "post" then """CREATE TABLE post ( - id TEXT NOT NULL PRIMARY KEY, - web_log_id TEXT NOT NULL REFERENCES web_log (id), - author_id TEXT NOT NULL REFERENCES web_log_user (id), - status TEXT NOT NULL, - title TEXT NOT NULL, - permalink TEXT NOT NULL, - published_on TIMESTAMPTZ, - updated_on TIMESTAMPTZ NOT NULL, - template TEXT, - post_text TEXT NOT NULL); + id TEXT NOT NULL PRIMARY KEY, + web_log_id TEXT NOT NULL REFERENCES web_log (id), + author_id TEXT NOT NULL REFERENCES web_log_user (id), + status TEXT NOT NULL, + title TEXT NOT NULL, + permalink TEXT NOT NULL, + prior_permalinks TEXT[] NOT NULL DEFAULT '{}', + published_on TIMESTAMPTZ, + updated_on TIMESTAMPTZ NOT NULL, + template TEXT, + post_text TEXT NOT NULL, + tags TEXT[], + meta_items JSONB, + episode JSONB); CREATE INDEX post_web_log_idx ON post (web_log_id); CREATE INDEX post_author_idx ON post (author_id); CREATE INDEX post_status_idx ON post (web_log_id, status, updated_on); @@ -176,42 +173,6 @@ type PostgreSqlData (conn : NpgsqlConnection, log : ILogger) = category_id TEXT NOT NULL REFERENCES category (id), PRIMARY KEY (post_id, category_id)); CREATE INDEX post_category_category_idx ON post_category (category_id)""" - if needsTable "post_episode" then - """CREATE TABLE post_episode ( - post_id TEXT NOT NULL PRIMARY KEY REFERENCES post(id), - media TEXT NOT NULL, - length INTEGER NOT NULL, - duration TEXT, - media_type TEXT, - image_url TEXT, - subtitle TEXT, - explicit TEXT, - chapter_file TEXT, - chapter_type TEXT, - transcript_url TEXT, - transcript_type TEXT, - transcript_lang TEXT, - transcript_captions INTEGER, - season_number INTEGER, - season_description TEXT, - episode_number TEXT, - episode_description TEXT)""" - if needsTable "post_tag" then - """CREATE TABLE post_tag ( - post_id TEXT NOT NULL REFERENCES post (id), - tag TEXT NOT NULL, - PRIMARY KEY (post_id, tag))""" - if needsTable "post_meta" then - """CREATE TABLE post_meta ( - post_id TEXT NOT NULL REFERENCES post (id), - name TEXT NOT NULL, - value TEXT NOT NULL, - PRIMARY KEY (post_id, name, value))""" - if needsTable "post_permalink" then - """CREATE TABLE post_permalink ( - post_id TEXT NOT NULL REFERENCES post (id), - permalink TEXT NOT NULL, - PRIMARY KEY (post_id, permalink))""" if needsTable "post_revision" then """CREATE TABLE post_revision ( post_id TEXT NOT NULL REFERENCES post (id), diff --git a/src/MyWebLog.Data/SQLite/Helpers.fs b/src/MyWebLog.Data/SQLite/Helpers.fs index 88955d6..f35fa70 100644 --- a/src/MyWebLog.Data/SQLite/Helpers.fs +++ b/src/MyWebLog.Data/SQLite/Helpers.fs @@ -12,23 +12,6 @@ let count (cmd : SqliteCommand) = backgroundTask { return int (it :?> int64) } -/// Get lists of items removed from and added to the given lists -let diffLists<'T, 'U when 'U : equality> oldItems newItems (f : 'T -> 'U) = - let diff compList = fun item -> not (compList |> List.exists (fun other -> f item = f other)) - List.filter (diff newItems) oldItems, List.filter (diff oldItems) newItems - -/// Find meta items added and removed -let diffMetaItems (oldItems : MetaItem list) newItems = - diffLists oldItems newItems (fun item -> $"{item.Name}|{item.Value}") - -/// Find the permalinks added and removed -let diffPermalinks oldLinks newLinks = - diffLists oldLinks newLinks Permalink.toString - -/// Find the revisions added and removed -let diffRevisions oldRevs newRevs = - diffLists oldRevs newRevs (fun (rev : Revision) -> $"{rev.AsOf.Ticks}|{MarkupText.toString rev.Text}") - /// Create a list of items from the given data reader let toList<'T> (it : SqliteDataReader -> 'T) (rdr : SqliteDataReader) = seq { while rdr.Read () do it rdr } diff --git a/src/MyWebLog.Data/SQLite/SQLitePageData.fs b/src/MyWebLog.Data/SQLite/SQLitePageData.fs index 5dbb71e..7ca61fc 100644 --- a/src/MyWebLog.Data/SQLite/SQLitePageData.fs +++ b/src/MyWebLog.Data/SQLite/SQLitePageData.fs @@ -54,7 +54,7 @@ type SQLitePageData (conn : SqliteConnection) = /// Update a page's metadata items let updatePageMeta pageId oldItems newItems = backgroundTask { - let toDelete, toAdd = diffMetaItems oldItems newItems + let toDelete, toAdd = Utils.diffMetaItems oldItems newItems if List.isEmpty toDelete && List.isEmpty toAdd then return () else @@ -82,7 +82,7 @@ type SQLitePageData (conn : SqliteConnection) = /// Update a page's prior permalinks let updatePagePermalinks pageId oldLinks newLinks = backgroundTask { - let toDelete, toAdd = diffPermalinks oldLinks newLinks + let toDelete, toAdd = Utils.diffPermalinks oldLinks newLinks if List.isEmpty toDelete && List.isEmpty toAdd then return () else @@ -108,7 +108,7 @@ type SQLitePageData (conn : SqliteConnection) = /// Update a page's revisions let updatePageRevisions pageId oldRevs newRevs = backgroundTask { - let toDelete, toAdd = diffRevisions oldRevs newRevs + let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs if List.isEmpty toDelete && List.isEmpty toAdd then return () else diff --git a/src/MyWebLog.Data/SQLite/SQLitePostData.fs b/src/MyWebLog.Data/SQLite/SQLitePostData.fs index fdfa1e9..5de370b 100644 --- a/src/MyWebLog.Data/SQLite/SQLitePostData.fs +++ b/src/MyWebLog.Data/SQLite/SQLitePostData.fs @@ -99,7 +99,7 @@ type SQLitePostData (conn : SqliteConnection) = /// Update a post's assigned categories let updatePostCategories postId oldCats newCats = backgroundTask { - let toDelete, toAdd = diffLists oldCats newCats CategoryId.toString + let toDelete, toAdd = Utils.diffLists oldCats newCats CategoryId.toString if List.isEmpty toDelete && List.isEmpty toAdd then return () else @@ -125,7 +125,7 @@ type SQLitePostData (conn : SqliteConnection) = /// Update a post's assigned categories let updatePostTags postId (oldTags : string list) newTags = backgroundTask { - let toDelete, toAdd = diffLists oldTags newTags id + let toDelete, toAdd = Utils.diffLists oldTags newTags id if List.isEmpty toDelete && List.isEmpty toAdd then return () else @@ -203,7 +203,7 @@ type SQLitePostData (conn : SqliteConnection) = /// Update a post's metadata items let updatePostMeta postId oldItems newItems = backgroundTask { - let toDelete, toAdd = diffMetaItems oldItems newItems + let toDelete, toAdd = Utils.diffMetaItems oldItems newItems if List.isEmpty toDelete && List.isEmpty toAdd then return () else @@ -231,7 +231,7 @@ type SQLitePostData (conn : SqliteConnection) = /// Update a post's prior permalinks let updatePostPermalinks postId oldLinks newLinks = backgroundTask { - let toDelete, toAdd = diffPermalinks oldLinks newLinks + let toDelete, toAdd = Utils.diffPermalinks oldLinks newLinks if List.isEmpty toDelete && List.isEmpty toAdd then return () else @@ -257,7 +257,7 @@ type SQLitePostData (conn : SqliteConnection) = /// Update a post's revisions let updatePostRevisions postId oldRevs newRevs = backgroundTask { - let toDelete, toAdd = diffRevisions oldRevs newRevs + let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs if List.isEmpty toDelete && List.isEmpty toAdd then return () else diff --git a/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs b/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs index 53c4204..7a0182d 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs @@ -92,8 +92,8 @@ type SQLiteThemeData (conn : SqliteConnection) = do! write cmd let toDelete, toAdd = - diffLists (oldTheme |> Option.map (fun t -> t.Templates) |> Option.defaultValue []) - theme.Templates (fun t -> t.Name) + Utils.diffLists (oldTheme |> Option.map (fun t -> t.Templates) |> Option.defaultValue []) + theme.Templates (fun t -> t.Name) let toUpdate = theme.Templates |> List.filter (fun t -> diff --git a/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs b/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs index 7013583..c498c13 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs @@ -107,7 +107,7 @@ type SQLiteWebLogData (conn : SqliteConnection) = /// Update the custom feeds for a web log let updateCustomFeeds (webLog : WebLog) = backgroundTask { let! feeds = getCustomFeeds webLog - let toDelete, toAdd = diffLists feeds webLog.Rss.CustomFeeds (fun it -> $"{CustomFeedId.toString it.Id}") + let toDelete, toAdd = Utils.diffLists feeds webLog.Rss.CustomFeeds (fun it -> $"{CustomFeedId.toString it.Id}") let toId (feed : CustomFeed) = feed.Id let toUpdate = webLog.Rss.CustomFeeds diff --git a/src/MyWebLog.Data/Utils.fs b/src/MyWebLog.Data/Utils.fs index f225a49..cc06d9b 100644 --- a/src/MyWebLog.Data/Utils.fs +++ b/src/MyWebLog.Data/Utils.fs @@ -20,3 +20,20 @@ let rec orderByHierarchy (cats : Category list) parentId slugBase parentNames = yield! orderByHierarchy cats (Some cat.Id) (Some fullSlug) ([ cat.Name ] |> List.append parentNames) } +/// Get lists of items removed from and added to the given lists +let diffLists<'T, 'U when 'U : equality> oldItems newItems (f : 'T -> 'U) = + let diff compList = fun item -> not (compList |> List.exists (fun other -> f item = f other)) + List.filter (diff newItems) oldItems, List.filter (diff oldItems) newItems + +/// Find meta items added and removed +let diffMetaItems (oldItems : MetaItem list) newItems = + diffLists oldItems newItems (fun item -> $"{item.Name}|{item.Value}") + +/// Find the permalinks added and removed +let diffPermalinks oldLinks newLinks = + diffLists oldLinks newLinks Permalink.toString + +/// Find the revisions added and removed +let diffRevisions oldRevs newRevs = + diffLists oldRevs newRevs (fun (rev : Revision) -> $"{rev.AsOf.Ticks}|{MarkupText.toString rev.Text}") +