From cc6f444b5f82ef7cc35719ec9751c17a00488036 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Mon, 6 Feb 2023 23:20:43 -0500 Subject: [PATCH] Convert from conn to data source - First cut of doc library implementation --- src/MyWebLog.Data/MyWebLog.Data.fsproj | 2 - .../Postgres/PostgresCategoryData.fs | 90 +++---- src/MyWebLog.Data/Postgres/PostgresHelpers.fs | 152 ++--------- .../Postgres/PostgresPageData.fs | 106 ++++---- .../Postgres/PostgresPostData.fs | 159 ++++++------ .../Postgres/PostgresTagMapData.fs | 55 ++-- .../Postgres/PostgresThemeData.fs | 51 ++-- .../Postgres/PostgresUploadData.fs | 18 +- .../Postgres/PostgresWebLogData.fs | 67 ++--- .../Postgres/PostgresWebLogUserData.fs | 72 +++--- src/MyWebLog.Data/PostgresData.fs | 65 ++--- src/MyWebLog/Program.fs | 7 +- src/Npgsql.FSharp.Documents/Library.fs | 238 +++++++++++++++++- .../Npgsql.FSharp.Documents.fsproj | 1 + 14 files changed, 612 insertions(+), 471 deletions(-) diff --git a/src/MyWebLog.Data/MyWebLog.Data.fsproj b/src/MyWebLog.Data/MyWebLog.Data.fsproj index eed7751..a788fee 100644 --- a/src/MyWebLog.Data/MyWebLog.Data.fsproj +++ b/src/MyWebLog.Data/MyWebLog.Data.fsproj @@ -13,8 +13,6 @@ - - diff --git a/src/MyWebLog.Data/Postgres/PostgresCategoryData.fs b/src/MyWebLog.Data/Postgres/PostgresCategoryData.fs index c84ac76..16bc955 100644 --- a/src/MyWebLog.Data/Postgres/PostgresCategoryData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresCategoryData.fs @@ -2,30 +2,36 @@ open MyWebLog open MyWebLog.Data -open Newtonsoft.Json open Npgsql open Npgsql.FSharp +open Npgsql.FSharp.Documents /// PostgreSQL myWebLog category data implementation -type PostgresCategoryData (conn : NpgsqlConnection, ser : JsonSerializer) = - - /// Convert a data row to a category - let toCategory = Map.fromDoc ser +type PostgresCategoryData (source : NpgsqlDataSource) = + /// Shorthand for turning a web log ID into a string + let wls = WebLogId.toString + /// Count all categories for the given web log let countAll webLogId = - Document.countByWebLog conn Table.Category webLogId None + Sql.fromDataSource source + |> Query.countByContains Table.Category {| WebLogId = wls webLogId |} /// Count all top-level categories for the given web log let countTopLevel webLogId = - Document.countByWebLog conn Table.Category webLogId - (Some $"AND data -> '{nameof Category.empty.ParentId}' IS NULL") + Sql.fromDataSource source + |> Query.countByContains Table.Category {| WebLogId = wls webLogId; ParentId = None |} /// Retrieve all categories for the given web log in a DotLiquid-friendly format let findAllForView webLogId = backgroundTask { let! cats = - Document.findByWebLog conn Table.Category webLogId toCategory - (Some $"ORDER BY LOWER(data ->> '{nameof Category.empty.Name}')") + Sql.fromDataSource source + |> Sql.query $""" + {Query.selectFromTable Table.Category} + WHERE {Query.whereDataContains "@criteria"} + ORDER BY LOWER(data->>'{nameof Category.empty.Name}')""" + |> Sql.parameters [ "@criteria", webLogContains webLogId ] + |> Sql.executeAsync fromData let ordered = Utils.orderByHierarchy cats None None [] let counts = ordered @@ -39,14 +45,16 @@ type PostgresCategoryData (conn : NpgsqlConnection, ser : JsonSerializer) = |> List.ofSeq |> jsonArrayInClause (nameof Post.empty.CategoryIds) id let postCount = - Sql.existingConnection conn - |> Sql.query $" + Sql.fromDataSource source + |> Sql.query $""" SELECT COUNT(DISTINCT id) AS {countName} FROM {Table.Post} - WHERE {webLogWhere} - AND data ->> '{nameof Post.empty.Status}' = '{PostStatus.toString Published}' - AND ({catIdSql})" - |> Sql.parameters (webLogIdParam webLogId :: catIdParams) + WHERE {Query.whereDataContains "@criteria"} + AND ({catIdSql})""" + |> Sql.parameters ( + ("@criteria", + Query.jsonbDocParam {| WebLogId = wls webLogId; Status = PostStatus.toString Published |}) + :: catIdParams) |> Sql.executeRowAsync Map.toCount |> Async.AwaitTask |> Async.RunSynchronously @@ -65,76 +73,70 @@ type PostgresCategoryData (conn : NpgsqlConnection, ser : JsonSerializer) = } /// Find a category by its ID for the given web log let findById catId webLogId = - Document.findByIdAndWebLog conn Table.Category catId CategoryId.toString webLogId toCategory + Document.findByIdAndWebLog source Table.Category catId CategoryId.toString webLogId /// Find all categories for the given web log let findByWebLog webLogId = - Document.findByWebLog conn Table.Category webLogId toCategory None + Document.findByWebLog source Table.Category webLogId /// Create parameters for a category insert / update - let catParameters (cat : Category) = [ - "@id", Sql.string (CategoryId.toString cat.Id) - "@data", Sql.jsonb (Utils.serialize ser cat) - ] + let catParameters (cat : Category) = + Query.docParameters (CategoryId.toString cat.Id) cat /// Delete a category let delete catId webLogId = backgroundTask { match! findById catId webLogId with | Some cat -> // Reassign any children to the category's parent category - let parentParam = "@parentId", Sql.string (CategoryId.toString catId) let! children = - Sql.existingConnection conn - |> Sql.query - $"SELECT * FROM {Table.Category} WHERE data ->> '{nameof Category.empty.ParentId}' = @parentId" - |> Sql.parameters [ parentParam ] - |> Sql.executeAsync toCategory + Sql.fromDataSource source + |> Query.findByContains Table.Category {| ParentId = CategoryId.toString catId |} let hasChildren = not (List.isEmpty children) if hasChildren then let! _ = - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.executeTransactionAsync [ - docUpdateSql Table.Category, + Query.updateQuery Table.Category, children |> List.map (fun child -> catParameters { child with ParentId = cat.ParentId }) ] () // Delete the category off all posts where it is assigned let! posts = - Sql.existingConnection conn - |> Sql.query $"SELECT * FROM {Table.Post} WHERE data -> '{nameof Post.empty.CategoryIds}' ? @id" + Sql.fromDataSource source + |> Sql.query $"SELECT data FROM {Table.Post} WHERE data->'{nameof Post.empty.CategoryIds}' ? @id" |> Sql.parameters [ "@id", Sql.jsonb (CategoryId.toString catId) ] - |> Sql.executeAsync (Map.fromDoc ser) + |> Sql.executeAsync fromData if not (List.isEmpty posts) then let! _ = - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.executeTransactionAsync [ - docUpdateSql Table.Post, + Query.updateQuery Table.Post, posts |> List.map (fun post -> [ "@id", Sql.string (PostId.toString post.Id) - "@data", Sql.jsonb (Utils.serialize ser { - post with - CategoryIds = post.CategoryIds |> List.filter (fun cat -> cat <> catId) - }) + "@data", Query.jsonbDocParam + { post with + CategoryIds = post.CategoryIds |> List.filter (fun cat -> cat <> catId) + } ]) ] () // Delete the category itself - do! Document.delete conn Table.Category (CategoryId.toString catId) + do! Sql.fromDataSource source |> Query.deleteById Table.Category (CategoryId.toString catId) return if hasChildren then ReassignedChildCategories else CategoryDeleted | None -> return CategoryNotFound } /// Save a category - let save cat = backgroundTask { - do! Document.upsert conn Table.Category catParameters cat + let save (cat : Category) = backgroundTask { + do! Sql.fromDataSource source |> Query.save Table.Category (CategoryId.toString cat.Id) cat } /// Restore categories from a backup let restore cats = backgroundTask { let! _ = - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.executeTransactionAsync [ - docInsertSql Table.Category, cats |> List.map catParameters + Query.insertQuery Table.Category, cats |> List.map catParameters ] () } diff --git a/src/MyWebLog.Data/Postgres/PostgresHelpers.fs b/src/MyWebLog.Data/Postgres/PostgresHelpers.fs index 3d3ba63..5f06f5f 100644 --- a/src/MyWebLog.Data/Postgres/PostgresHelpers.fs +++ b/src/MyWebLog.Data/Postgres/PostgresHelpers.fs @@ -66,6 +66,7 @@ open MyWebLog.Data open NodaTime open Npgsql open Npgsql.FSharp +open Npgsql.FSharp.Documents /// Create a WHERE clause fragment for the web log ID let webLogWhere = "data ->> 'WebLogId' = @webLogId" @@ -74,6 +75,10 @@ let webLogWhere = "data ->> 'WebLogId' = @webLogId" let webLogIdParam webLogId = "@webLogId", Sql.string (WebLogId.toString webLogId) +/// Create a parameter for a web log document-contains query +let webLogContains webLogId = + Query.jsonbDocParam {| WebLogId = WebLogId.toString webLogId |} + /// The name of the field to select to be able to use Map.toCount let countName = "the_count" @@ -127,45 +132,9 @@ let optParam<'T> name (it : 'T option) = let p = NpgsqlParameter ($"@%s{name}", if Option.isSome it then box it.Value else DBNull.Value) p.ParameterName, Sql.parameter p -/// SQL statement to insert into a document table -let docInsertSql table = - $"INSERT INTO %s{table} VALUES (@id, @data)" - -/// SQL statement to select a document by its ID -let docSelectSql table = - $"SELECT * FROM %s{table} WHERE id = @id" - -/// SQL statement to select documents by their web log IDs -let docSelectForWebLogSql table = - $"SELECT * FROM %s{table} WHERE {webLogWhere}" - -/// SQL statement to update a document in a document table -let docUpdateSql table = - $"UPDATE %s{table} SET data = @data WHERE id = @id" - -/// SQL statement to insert or update a document in a document table -let docUpsertSql table = - $"{docInsertSql table} ON CONFLICT (id) DO UPDATE SET data = EXCLUDED.data" - -/// SQL statement to delete a document from a document table by its ID -let docDeleteSql table = - $"DELETE FROM %s{table} WHERE id = @id" - -/// SQL statement to count documents for a web log -let docCountForWebLogSql table = - $"SELECT COUNT(id) AS {countName} FROM %s{table} WHERE {webLogWhere}" - -/// SQL statement to determine if a document exists for a web log -let docExistsForWebLogSql table = - $"SELECT EXISTS (SELECT 1 FROM %s{table} WHERE id = @id AND {webLogWhere}) AS {existsName}" - /// Mapping functions for SQL queries module Map = - /// Map an item by deserializing the document - let fromDoc<'T> ser (row : RowReader) = - Utils.deserialize<'T> ser (row.string "data") - /// Get a count from a row let toCount (row : RowReader) = row.int countName @@ -203,112 +172,43 @@ module Map = /// Document manipulation functions module Document = - /// Convert extra SQL to a for that can be appended to a query - let private moreSql sql = sql |> Option.map (fun it -> $" %s{it}") |> Option.defaultValue "" - - /// Create a parameter for a @> (contains) query - let contains<'T> (name : string) ser (value : 'T) = - name, Sql.jsonb (Utils.serialize ser value) - - /// Count documents for a web log - let countByWebLog conn table webLogId extraSql = - Sql.existingConnection conn - |> Sql.query $"{docCountForWebLogSql table}{moreSql extraSql}" - |> Sql.parameters [ webLogIdParam webLogId ] - |> Sql.executeRowAsync Map.toCount - - /// Delete a document - let delete conn table idParam = backgroundTask { - let! _ = - Sql.existingConnection conn - |> Sql.query (docDeleteSql table) - |> Sql.parameters [ "@id", Sql.string idParam ] - |> Sql.executeNonQueryAsync - () - } - - /// Determine if a document with the given ID exists - let exists<'TKey> conn table (key : 'TKey) (keyFunc : 'TKey -> string) = - Sql.existingConnection conn - |> Sql.query $"SELECT EXISTS (SELECT 1 FROM %s{table} WHERE id = @id) AS {existsName}" - |> Sql.parameters [ "@id", Sql.string (keyFunc key) ] - |> Sql.executeRowAsync Map.toExists - /// Determine whether a document exists with the given key for the given web log - let existsByWebLog<'TKey> conn table (key : 'TKey) (keyFunc : 'TKey -> string) webLogId = - Sql.existingConnection conn - |> Sql.query (docExistsForWebLogSql table) + let existsByWebLog<'TKey> source table (key : 'TKey) (keyFunc : 'TKey -> string) webLogId = + Sql.fromDataSource source + |> Sql.query $""" + SELECT EXISTS ( + SELECT 1 FROM %s{table} WHERE id = @id AND {Query.whereDataContains "@criteria"} + ) AS {existsName}""" |> Sql.parameters [ "@id", Sql.string (keyFunc key); webLogIdParam webLogId ] |> Sql.executeRowAsync Map.toExists - /// Find a document by its ID - let findById<'TKey, 'TDoc> conn table (key : 'TKey) (keyFunc : 'TKey -> string) (docFunc : RowReader -> 'TDoc) = - Sql.existingConnection conn - |> Sql.query (docSelectSql table) - |> Sql.parameters [ "@id", Sql.string (keyFunc key) ] - |> Sql.executeAsync docFunc + /// Find a document by its ID for the given web log + let findByIdAndWebLog<'TKey, 'TDoc> source table (key : 'TKey) (keyFunc : 'TKey -> string) webLogId = + Sql.fromDataSource source + |> Sql.query $"""{Query.selectFromTable table} WHERE id = @id AND {Query.whereDataContains "@criteria"}""" + |> Sql.parameters [ "@id", Sql.string (keyFunc key); "@criteria", webLogContains webLogId ] + |> Sql.executeAsync fromData<'TDoc> |> tryHead /// Find a document by its ID for the given web log - let findByIdAndWebLog<'TKey, 'TDoc> conn table (key : 'TKey) (keyFunc : 'TKey -> string) webLogId - (docFunc : RowReader -> 'TDoc) = - Sql.existingConnection conn - |> Sql.query $"{docSelectSql table} AND {webLogWhere}" - |> Sql.parameters [ "@id", Sql.string (keyFunc key); webLogIdParam webLogId ] - |> Sql.executeAsync docFunc - |> tryHead - - /// Find all documents for the given web log - let findByWebLog<'TDoc> conn table webLogId (docFunc : RowReader -> 'TDoc) extraSql = - Sql.existingConnection conn - |> Sql.query $"{docSelectForWebLogSql table}{moreSql extraSql}" - |> Sql.parameters [ webLogIdParam webLogId ] - |> Sql.executeAsync docFunc - - /// Insert a new document - let insert<'T> conn table (paramFunc : 'T -> (string * SqlValue) list) (doc : 'T) = task { - let! _ = - Sql.existingConnection conn - |> Sql.query (docInsertSql table) - |> Sql.parameters (paramFunc doc) - |> Sql.executeNonQueryAsync - () - } + let findByWebLog<'TDoc> source table webLogId : Task<'TDoc list> = + Sql.fromDataSource source + |> Query.findByContains table {| WebLogId = WebLogId.toString webLogId |} - /// Update an existing document - let update<'T> conn table (paramFunc : 'T -> (string * SqlValue) list) (doc : 'T) = task { - let! _ = - Sql.existingConnection conn - |> Sql.query (docUpdateSql table) - |> Sql.parameters (paramFunc doc) - |> Sql.executeNonQueryAsync - () - } - - /// Insert or update a document - let upsert<'T> conn table (paramFunc : 'T -> (string * SqlValue) list) (doc : 'T) = task { - let! _ = - Sql.existingConnection conn - |> Sql.query (docUpsertSql table) - |> Sql.parameters (paramFunc doc) - |> Sql.executeNonQueryAsync - () - } - /// Functions to support revisions module Revisions = /// Find all revisions for the given entity - let findByEntityId<'TKey> conn revTable entityTable (key : 'TKey) (keyFunc : 'TKey -> string) = - Sql.existingConnection conn + let findByEntityId<'TKey> source revTable entityTable (key : 'TKey) (keyFunc : 'TKey -> string) = + Sql.fromDataSource source |> Sql.query $"SELECT as_of, revision_text FROM %s{revTable} WHERE %s{entityTable}_id = @id ORDER BY as_of DESC" |> Sql.parameters [ "@id", Sql.string (keyFunc key) ] |> Sql.executeAsync Map.toRevision /// Find all revisions for all posts for the given web log - let findByWebLog<'TKey> conn revTable entityTable (keyFunc : string -> 'TKey) webLogId = - Sql.existingConnection conn + let findByWebLog<'TKey> source revTable entityTable (keyFunc : string -> 'TKey) webLogId = + Sql.fromDataSource source |> Sql.query $" SELECT pr.* FROM %s{revTable} pr @@ -331,11 +231,11 @@ module Revisions = /// Update a page's revisions let update<'TKey> - conn revTable entityTable (key : 'TKey) (keyFunc : 'TKey -> string) oldRevs newRevs = backgroundTask { + source revTable entityTable (key : 'TKey) (keyFunc : 'TKey -> string) 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.fromDataSource source |> Sql.executeTransactionAsync [ if not (List.isEmpty toDelete) then $"DELETE FROM %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf", diff --git a/src/MyWebLog.Data/Postgres/PostgresPageData.fs b/src/MyWebLog.Data/Postgres/PostgresPageData.fs index 3a82203..29e1bf7 100644 --- a/src/MyWebLog.Data/Postgres/PostgresPageData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresPageData.fs @@ -2,54 +2,61 @@ namespace MyWebLog.Data.Postgres open MyWebLog open MyWebLog.Data -open Newtonsoft.Json open Npgsql open Npgsql.FSharp +open Npgsql.FSharp.Documents /// PostgreSQL myWebLog page data implementation -type PostgresPageData (conn : NpgsqlConnection, ser : JsonSerializer) = +type PostgresPageData (source : NpgsqlDataSource) = // SUPPORT FUNCTIONS + /// Shorthand for turning a web log ID into a string + let wls = WebLogId.toString + /// Append revisions to a page let appendPageRevisions (page : Page) = backgroundTask { - let! revisions = Revisions.findByEntityId conn Table.PageRevision Table.Page page.Id PageId.toString + let! revisions = Revisions.findByEntityId source Table.PageRevision Table.Page page.Id PageId.toString return { page with Revisions = revisions } } - /// Shorthand to map to a page - let toPage = Map.fromDoc ser - /// Return a page with no text or revisions let pageWithoutText row = - { toPage row with Text = "" } + { fromData row with Text = "" } /// Update a page's revisions let updatePageRevisions pageId oldRevs newRevs = - Revisions.update conn Table.PageRevision Table.Page pageId PageId.toString oldRevs newRevs + Revisions.update source Table.PageRevision Table.Page pageId PageId.toString oldRevs newRevs /// Does the given page exist? let pageExists pageId webLogId = - Document.existsByWebLog conn Table.Page pageId PageId.toString webLogId + Document.existsByWebLog source Table.Page pageId PageId.toString webLogId // IMPLEMENTATION FUNCTIONS /// Get all pages for a web log (without text or revisions) let all webLogId = - Document.findByWebLog conn Table.Page webLogId pageWithoutText - (Some $"ORDER BY LOWER(data ->> '{nameof Page.empty.Title}')") + Sql.fromDataSource source + |> Sql.query $""" + {Query.selectFromTable Table.Page} + WHERE {Query.whereDataContains "@criteria"} + ORDER BY LOWER(data->>'{nameof Page.empty.Title}')""" + |> Sql.parameters [ "@criteria", webLogContains webLogId ] + |> Sql.executeAsync fromData /// Count all pages for the given web log let countAll webLogId = - Document.countByWebLog conn Table.Page webLogId None + Sql.fromDataSource source + |> Query.countByContains Table.Page {| WebLogId = wls webLogId |} /// Count all pages shown in the page list for the given web log let countListed webLogId = - Document.countByWebLog conn Table.Page webLogId (Some $"AND data -> '{nameof Page.empty.IsInPageList}' = TRUE") + Sql.fromDataSource source + |> Query.countByContains Table.Page {| WebLogId = wls webLogId; IsInPageList = true |} /// Find a page by its ID (without revisions) let findById pageId webLogId = - Document.findByIdAndWebLog conn Table.Page pageId PageId.toString webLogId toPage + Document.findByIdAndWebLog source Table.Page pageId PageId.toString webLogId /// Find a complete page by its ID let findFullById pageId webLogId = backgroundTask { @@ -64,17 +71,15 @@ type PostgresPageData (conn : NpgsqlConnection, ser : JsonSerializer) = let delete pageId webLogId = backgroundTask { match! pageExists pageId webLogId with | true -> - do! Document.delete conn Table.Page (PageId.toString pageId) + do! Sql.fromDataSource source |> Query.deleteById Table.Page (PageId.toString pageId) return true | false -> return false } /// Find a page by its permalink for the given web log let findByPermalink permalink webLogId = - Sql.existingConnection conn - |> Sql.query $"{docSelectForWebLogSql Table.Page} AND data ->> '{nameof Page.empty.Permalink}' = @link" - |> Sql.parameters [ webLogIdParam webLogId; "@link", Sql.string (Permalink.toString permalink) ] - |> Sql.executeAsync toPage + Sql.fromDataSource source + |> Query.findByContains Table.Page {| WebLogId = wls webLogId; Permalink = Permalink.toString permalink |} |> tryHead /// Find the current permalink within a set of potential prior permalinks for the given web log @@ -84,21 +89,22 @@ type PostgresPageData (conn : NpgsqlConnection, ser : JsonSerializer) = let linkSql, linkParams = jsonArrayInClause (nameof Page.empty.PriorPermalinks) Permalink.toString permalinks return! - Sql.existingConnection conn - |> Sql.query $" - SELECT data ->> '{nameof Page.empty.Permalink}' AS permalink + // TODO: stopped here + Sql.fromDataSource source + |> Sql.query $""" + SELECT data->>'{nameof Page.empty.Permalink}' AS permalink FROM page - WHERE {webLogWhere} - AND ({linkSql})" - |> Sql.parameters (webLogIdParam webLogId :: linkParams) + WHERE {Query.whereDataContains "@criteria"} + AND ({linkSql})""" + |> Sql.parameters (("@criteria", webLogContains webLogId) :: linkParams) |> Sql.executeAsync Map.toPermalink |> tryHead } /// Get all complete pages for the given web log let findFullByWebLog webLogId = backgroundTask { - let! pages = Document.findByWebLog conn Table.Page webLogId toPage None - let! revisions = Revisions.findByWebLog conn Table.PageRevision Table.Page PageId webLogId + let! pages = Document.findByWebLog source Table.Page webLogId + let! revisions = Revisions.findByWebLog source Table.PageRevision Table.Page PageId webLogId return pages |> List.map (fun it -> @@ -107,37 +113,40 @@ type PostgresPageData (conn : NpgsqlConnection, ser : JsonSerializer) = /// Get all listed pages for the given web log (without revisions or text) let findListed webLogId = - Sql.existingConnection conn - |> Sql.query $" - {docSelectForWebLogSql Table.Page} - AND data -> '{nameof Page.empty.IsInPageList}' = TRUE - ORDER BY LOWER(data ->> '{nameof Page.empty.Title}')" - |> Sql.parameters [ webLogIdParam webLogId ] + Sql.fromDataSource source + |> Sql.query $""" + {Query.selectFromTable Table.Page} + WHERE {Query.whereDataContains "@criteria"} + ORDER BY LOWER(data->>'{nameof Page.empty.Title}')""" + |> Sql.parameters [ "@criteria", Query.jsonbDocParam {| WebLogId = wls webLogId; IsInPageList = true |} ] |> Sql.executeAsync pageWithoutText /// Get a page of pages for the given web log (without revisions) let findPageOfPages webLogId pageNbr = - Sql.existingConnection conn - |> Sql.query $" - {docSelectForWebLogSql Table.Page} - ORDER BY LOWER(data ->> '{nameof Page.empty.Title}') - LIMIT @pageSize OFFSET @toSkip" - |> Sql.parameters [ webLogIdParam webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ] - |> Sql.executeAsync toPage + Sql.fromDataSource source + |> Sql.query $""" + {Query.selectFromTable Table.Page} + WHERE {Query.whereDataContains "@criteria"} + ORDER BY LOWER(data->>'{nameof Page.empty.Title}') + LIMIT @pageSize OFFSET @toSkip""" + |> Sql.parameters + [ "@criteria", webLogContains webLogId + "@pageSize", Sql.int 26 + "@toSkip", Sql.int ((pageNbr - 1) * 25) + ] + |> Sql.executeAsync fromData /// The parameters for saving a page - let pageParams (page : Page) = [ - "@id", Sql.string (PageId.toString page.Id) - "@data", Sql.jsonb (Utils.serialize ser page) - ] + let pageParams (page : Page) = + Query.docParameters (PageId.toString page.Id) page /// Restore pages from a backup let restore (pages : Page list) = backgroundTask { let revisions = pages |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r)) let! _ = - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.executeTransactionAsync [ - docInsertSql Table.Page, pages |> List.map pageParams + Query.insertQuery Table.Page, pages |> List.map pageParams Revisions.insertSql Table.PageRevision, revisions |> List.map (fun (pageId, rev) -> Revisions.revParams pageId PageId.toString rev) ] @@ -147,7 +156,7 @@ type PostgresPageData (conn : NpgsqlConnection, ser : JsonSerializer) = /// Save a page let save (page : Page) = backgroundTask { let! oldPage = findFullById page.Id page.WebLogId - do! Document.upsert conn Table.Page pageParams page + do! Sql.fromDataSource source |> Query.save Table.Page (PageId.toString page.Id) page do! updatePageRevisions page.Id (match oldPage with Some p -> p.Revisions | None -> []) page.Revisions () } @@ -156,7 +165,8 @@ type PostgresPageData (conn : NpgsqlConnection, ser : JsonSerializer) = let updatePriorPermalinks pageId webLogId permalinks = backgroundTask { match! findById pageId webLogId with | Some page -> - do! Document.update conn Table.Page pageParams { page with PriorPermalinks = permalinks } + do! Sql.fromDataSource source + |> Query.update Table.Page (PageId.toString page.Id) { page with PriorPermalinks = permalinks } return true | None -> return false } diff --git a/src/MyWebLog.Data/Postgres/PostgresPostData.fs b/src/MyWebLog.Data/Postgres/PostgresPostData.fs index c001442..f3cca98 100644 --- a/src/MyWebLog.Data/Postgres/PostgresPostData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresPostData.fs @@ -2,60 +2,63 @@ namespace MyWebLog.Data.Postgres open MyWebLog open MyWebLog.Data -open Newtonsoft.Json open NodaTime open Npgsql open Npgsql.FSharp +open Npgsql.FSharp.Documents /// PostgreSQL myWebLog post data implementation -type PostgresPostData (conn : NpgsqlConnection, ser : JsonSerializer) = +type PostgresPostData (source : NpgsqlDataSource) = // SUPPORT FUNCTIONS + /// Shorthand for turning a web log ID into a string + let wls = WebLogId.toString + /// Append revisions to a post let appendPostRevisions (post : Post) = backgroundTask { - let! revisions = Revisions.findByEntityId conn Table.PostRevision Table.Post post.Id PostId.toString + let! revisions = Revisions.findByEntityId source Table.PostRevision Table.Post post.Id PostId.toString return { post with Revisions = revisions } } - /// Shorthand for mapping to a post - let toPost = Map.fromDoc ser - /// Return a post with no revisions, prior permalinks, or text let postWithoutText row = - { toPost row with Text = "" } + { fromData row with Text = "" } /// Update a post's revisions let updatePostRevisions postId oldRevs newRevs = - Revisions.update conn Table.PostRevision Table.Post postId PostId.toString oldRevs newRevs + Revisions.update source Table.PostRevision Table.Post postId PostId.toString oldRevs newRevs /// Does the given post exist? let postExists postId webLogId = - Document.existsByWebLog conn Table.Post postId PostId.toString webLogId + Document.existsByWebLog source Table.Post postId PostId.toString webLogId - /// Query to select posts by web log ID and status - let postsByWebLogAndStatus = - $"{docSelectForWebLogSql Table.Post} AND data ->> '{nameof Post.empty.Status}' = @status" + /// Query to select posts by JSON document containment criteria + let postsByCriteria = + $"""{Query.selectFromTable Table.Post} WHERE {Query.whereDataContains "@criteria"}""" // IMPLEMENTATION FUNCTIONS /// Count posts in a status for the given web log let countByStatus status webLogId = - Sql.existingConnection conn - |> Sql.query $"{docCountForWebLogSql Table.Post} AND data ->> '{nameof Post.empty.Status}' = @status" - |> Sql.parameters [ webLogIdParam webLogId; "@status", Sql.string (PostStatus.toString status) ] + Sql.fromDataSource source + |> Sql.query + $"""SELECT COUNT(id) AS {countName} FROM {Table.Post} WHERE {Query.whereDataContains "@criteria"}""" + |> Sql.parameters + [ "@criteria", Query.jsonbDocParam {| WebLogId = wls webLogId; Status = PostStatus.toString status |} ] |> Sql.executeRowAsync Map.toCount /// Find a post by its ID for the given web log (excluding revisions) let findById postId webLogId = - Document.findByIdAndWebLog conn Table.Post postId PostId.toString webLogId toPost + Document.findByIdAndWebLog source Table.Post postId PostId.toString webLogId /// Find a post by its permalink for the given web log (excluding revisions and prior permalinks) let findByPermalink permalink webLogId = - Sql.existingConnection conn - |> Sql.query $"{docSelectForWebLogSql Table.Post} AND data ->> '{nameof Post.empty.Permalink}' = @link" - |> Sql.parameters [ webLogIdParam webLogId; "@link", Sql.string (Permalink.toString permalink) ] - |> Sql.executeAsync toPost + Sql.fromDataSource source + |> Sql.query postsByCriteria + |> Sql.parameters + [ "@criteria", Query.jsonbDocParam {| WebLogId = wls webLogId; Permalink = Permalink.toString permalink |} ] + |> Sql.executeAsync fromData |> tryHead /// Find a complete post by its ID for the given web log @@ -71,12 +74,13 @@ type PostgresPostData (conn : NpgsqlConnection, ser : JsonSerializer) = let delete postId webLogId = backgroundTask { match! postExists postId webLogId with | true -> + let theId = PostId.toString postId let! _ = - Sql.existingConnection conn - |> Sql.query $" - DELETE FROM {Table.PostComment} WHERE data ->> '{nameof Comment.empty.PostId}' = @id; - DELETE FROM {Table.Post} WHERE id = @id" - |> Sql.parameters [ "@id", Sql.string (PostId.toString postId) ] + Sql.fromDataSource source + |> Sql.query $""" + DELETE FROM {Table.PostComment} WHERE {Query.whereDataContains "@criteria"}; + DELETE FROM {Table.Post} WHERE id = @id""" + |> Sql.parameters [ "@id", Sql.string theId; "@criteria", Query.jsonbDocParam {| PostId = theId |} ] |> Sql.executeNonQueryAsync return true | false -> return false @@ -89,21 +93,21 @@ type PostgresPostData (conn : NpgsqlConnection, ser : JsonSerializer) = let linkSql, linkParams = jsonArrayInClause (nameof Post.empty.PriorPermalinks) Permalink.toString permalinks return! - Sql.existingConnection conn - |> Sql.query $" - SELECT data ->> '{nameof Post.empty.Permalink}' AS permalink + Sql.fromDataSource source + |> Sql.query $""" + SELECT data->>'{nameof Post.empty.Permalink}' AS permalink FROM {Table.Post} - WHERE {webLogWhere} - AND ({linkSql})" - |> Sql.parameters (webLogIdParam webLogId :: linkParams) + WHERE {Query.whereDataContains "@criteria"} + AND ({linkSql})""" + |> Sql.parameters (("@criteria", webLogContains webLogId) :: linkParams) |> Sql.executeAsync Map.toPermalink |> tryHead } /// Get all complete posts for the given web log let findFullByWebLog webLogId = backgroundTask { - let! posts = Document.findByWebLog conn Table.Post webLogId toPost None - let! revisions = Revisions.findByWebLog conn Table.PostRevision Table.Post PostId webLogId + let! posts = Document.findByWebLog source Table.Post webLogId + let! revisions = Revisions.findByWebLog source Table.PostRevision Table.Post PostId webLogId return posts |> List.map (fun it -> @@ -113,92 +117,88 @@ type PostgresPostData (conn : NpgsqlConnection, ser : JsonSerializer) = /// Get a page of categorized posts for the given web log (excludes revisions) let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = let catSql, catParams = jsonArrayInClause (nameof Post.empty.CategoryIds) CategoryId.toString categoryIds - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.query $" - {postsByWebLogAndStatus} + {postsByCriteria} AND ({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 toPost + |> Sql.parameters ( + ("@criteria", Query.jsonbDocParam {| WebLogId = wls webLogId; Status = PostStatus.toString Published |}) + :: catParams) + |> Sql.executeAsync fromData /// Get a page of posts for the given web log (excludes text and revisions) let findPageOfPosts webLogId pageNbr postsPerPage = - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.query $" - {docSelectForWebLogSql Table.Post} - ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC NULLS FIRST, - data ->> '{nameof Post.empty.UpdatedOn}' + {postsByCriteria} + ORDER BY data->>'{nameof Post.empty.PublishedOn}' DESC NULLS FIRST, + data->>'{nameof Post.empty.UpdatedOn}' LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" - |> Sql.parameters [ webLogIdParam webLogId ] + |> Sql.parameters [ "@criteria", webLogContains 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.fromDataSource source |> Sql.query $" - {postsByWebLogAndStatus} - ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC + {postsByCriteria} + ORDER BY data->>'{nameof Post.empty.PublishedOn}' DESC LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" - |> Sql.parameters [ webLogIdParam webLogId; "@status", Sql.string (PostStatus.toString Published) ] - |> Sql.executeAsync toPost + |> Sql.parameters + [ "@criteria", Query.jsonbDocParam {| WebLogId = wls webLogId; Status = PostStatus.toString Published |} ] + |> Sql.executeAsync fromData /// 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.fromDataSource source |> Sql.query $" - {postsByWebLogAndStatus} - AND data -> '{nameof Post.empty.Tags}' ? @tag - ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC + {postsByCriteria} + AND data->'{nameof Post.empty.Tags}' ? @tag + ORDER BY data->>'{nameof Post.empty.PublishedOn}' DESC LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" |> Sql.parameters - [ webLogIdParam webLogId - "@status", Sql.string (PostStatus.toString Published) - "@tag", Sql.jsonb tag + [ "@criteria", Query.jsonbDocParam {| WebLogId = wls webLogId; Status = PostStatus.toString Published |} + "@tag", Sql.jsonb tag ] - |> Sql.executeAsync toPost + |> Sql.executeAsync fromData /// Find the next newest and oldest post from a publish date for the given web log let findSurroundingPosts webLogId (publishedOn : Instant) = backgroundTask { let queryParams () = Sql.parameters [ - webLogIdParam webLogId + "@criteria", Query.jsonbDocParam {| WebLogId = wls webLogId; Status = PostStatus.toString Published |} typedParam "publishedOn" publishedOn - "@status", Sql.string (PostStatus.toString Published) ] let! older = - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.query $" - {postsByWebLogAndStatus} - AND data ->> '{nameof Post.empty.PublishedOn}' < @publishedOn - ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC + {postsByCriteria} + AND data->>'{nameof Post.empty.PublishedOn}' < @publishedOn + ORDER BY data->>'{nameof Post.empty.PublishedOn}' DESC LIMIT 1" |> queryParams () - |> Sql.executeAsync toPost + |> Sql.executeAsync fromData let! newer = - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.query $" - {postsByWebLogAndStatus} - AND data ->> '{nameof Post.empty.PublishedOn}' > @publishedOn - ORDER BY data ->> '{nameof Post.empty.PublishedOn}' + {postsByCriteria} + AND data->>'{nameof Post.empty.PublishedOn}' > @publishedOn + ORDER BY data->>'{nameof Post.empty.PublishedOn}' LIMIT 1" |> queryParams () - |> Sql.executeAsync toPost + |> Sql.executeAsync fromData return List.tryHead older, List.tryHead newer } /// The parameters for saving a post - let postParams (post : Post) = [ - "@id", Sql.string (PostId.toString post.Id) - "@data", Sql.jsonb (Utils.serialize ser post) - ] + let postParams (post : Post) = + Query.docParameters (PostId.toString post.Id) post /// Save a post let save (post : Post) = backgroundTask { let! oldPost = findFullById post.Id post.WebLogId - do! Document.upsert conn Table.Post postParams post + do! Sql.fromDataSource source |> Query.save Table.Post (PostId.toString post.Id) post do! updatePostRevisions post.Id (match oldPost with Some p -> p.Revisions | None -> []) post.Revisions } @@ -206,9 +206,9 @@ type PostgresPostData (conn : NpgsqlConnection, ser : JsonSerializer) = let restore posts = backgroundTask { let revisions = posts |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r)) let! _ = - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.executeTransactionAsync [ - docInsertSql Table.Post, posts |> List.map postParams + Query.insertQuery Table.Post, posts |> List.map postParams Revisions.insertSql Table.PostRevision, revisions |> List.map (fun (postId, rev) -> Revisions.revParams postId PostId.toString rev) ] @@ -217,11 +217,10 @@ type PostgresPostData (conn : NpgsqlConnection, ser : JsonSerializer) = /// Update prior permalinks for a post let updatePriorPermalinks postId webLogId permalinks = backgroundTask { - use! txn = conn.BeginTransactionAsync () match! findById postId webLogId with | Some post -> - do! Document.update conn Table.Post postParams { post with PriorPermalinks = permalinks } - do! txn.CommitAsync () + do! Sql.fromDataSource source + |> Query.update Table.Post (PostId.toString post.Id) { post with PriorPermalinks = permalinks } return true | None -> return false } diff --git a/src/MyWebLog.Data/Postgres/PostgresTagMapData.fs b/src/MyWebLog.Data/Postgres/PostgresTagMapData.fs index a04c7fb..a576924 100644 --- a/src/MyWebLog.Data/Postgres/PostgresTagMapData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresTagMapData.fs @@ -2,66 +2,71 @@ namespace MyWebLog.Data.Postgres open MyWebLog open MyWebLog.Data -open Newtonsoft.Json open Npgsql open Npgsql.FSharp +open Npgsql.FSharp.Documents /// PostgreSQL myWebLog tag mapping data implementation -type PostgresTagMapData (conn : NpgsqlConnection, ser : JsonSerializer) = +type PostgresTagMapData (source : NpgsqlDataSource) = - /// Map a data row to a tag mapping - let toTagMap = Map.fromDoc ser + /// Shorthand for turning a web log ID into a string + let wls = WebLogId.toString + + /// A query to select tag map(s) by JSON document containment criteria + let tagMapByCriteria = + $"""{Query.selectFromTable Table.TagMap} WHERE {Query.whereDataContains "@criteria"}""" /// Find a tag mapping by its ID for the given web log let findById tagMapId webLogId = - Document.findByIdAndWebLog conn Table.TagMap tagMapId TagMapId.toString webLogId toTagMap + Document.findByIdAndWebLog source Table.TagMap tagMapId TagMapId.toString webLogId /// Delete a tag mapping for the given web log let delete tagMapId webLogId = backgroundTask { - let! exists = Document.existsByWebLog conn Table.TagMap tagMapId TagMapId.toString webLogId + let! exists = Document.existsByWebLog source Table.TagMap tagMapId TagMapId.toString webLogId if exists then - do! Document.delete conn Table.TagMap (TagMapId.toString tagMapId) + do! Sql.fromDataSource source |> Query.deleteById Table.TagMap (TagMapId.toString tagMapId) return true else return false } /// Find a tag mapping by its URL value for the given web log - let findByUrlValue urlValue webLogId = - Sql.existingConnection conn - |> Sql.query $"{docSelectForWebLogSql Table.TagMap} AND data ->> '{nameof TagMap.empty.UrlValue}' = @urlValue" - |> Sql.parameters [ webLogIdParam webLogId; "@urlValue", Sql.string urlValue ] - |> Sql.executeAsync toTagMap + let findByUrlValue (urlValue : string) webLogId = + Sql.fromDataSource source + |> Sql.query tagMapByCriteria + |> Sql.parameters [ "@criteria", Query.jsonbDocParam {| WebLogId = wls webLogId; UrlValue = urlValue |} ] + |> Sql.executeAsync fromData |> tryHead /// Get all tag mappings for the given web log let findByWebLog webLogId = - Document.findByWebLog conn Table.TagMap webLogId toTagMap (Some "ORDER BY tag") + Sql.fromDataSource source + |> Sql.query $"{tagMapByCriteria} ORDER BY data->>'tag'" + |> Sql.parameters [ "@criteria", webLogContains webLogId ] + |> Sql.executeAsync fromData /// Find any tag mappings in a list of tags for the given web log let findMappingForTags tags webLogId = let tagSql, tagParams = jsonArrayInClause (nameof TagMap.empty.Tag) id tags - Sql.existingConnection conn - |> Sql.query $"{docSelectForWebLogSql Table.TagMap} AND ({tagSql})" - |> Sql.parameters (webLogIdParam webLogId :: tagParams) - |> Sql.executeAsync toTagMap + Sql.fromDataSource source + |> Sql.query $"{tagMapByCriteria} AND ({tagSql})" + |> Sql.parameters (("@criteria", webLogContains webLogId) :: tagParams) + |> Sql.executeAsync fromData /// The parameters for saving a tag mapping - let tagMapParams (tagMap : TagMap) = [ - "@id", Sql.string (TagMapId.toString tagMap.Id) - "@data", Sql.jsonb (Utils.serialize ser tagMap) - ] + let tagMapParams (tagMap : TagMap) = + Query.docParameters (TagMapId.toString tagMap.Id) tagMap /// Save a tag mapping - let save tagMap = backgroundTask { - do! Document.upsert conn Table.TagMap tagMapParams tagMap + let save (tagMap : TagMap) = backgroundTask { + do! Sql.fromDataSource source |> Query.save Table.TagMap (TagMapId.toString tagMap.Id) tagMap } /// Restore tag mappings from a backup let restore tagMaps = backgroundTask { let! _ = - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.executeTransactionAsync [ - docInsertSql Table.TagMap, tagMaps |> List.map tagMapParams + Query.insertQuery Table.TagMap, tagMaps |> List.map tagMapParams ] () } diff --git a/src/MyWebLog.Data/Postgres/PostgresThemeData.fs b/src/MyWebLog.Data/Postgres/PostgresThemeData.fs index 2e3bacf..1c56fca 100644 --- a/src/MyWebLog.Data/Postgres/PostgresThemeData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresThemeData.fs @@ -5,55 +5,52 @@ open MyWebLog.Data open Newtonsoft.Json open Npgsql open Npgsql.FSharp +open Npgsql.FSharp.Documents /// PostreSQL myWebLog theme data implementation -type PostgresThemeData (conn : NpgsqlConnection, ser : JsonSerializer) = - - /// Map a data row to a theme - let toTheme = Map.fromDoc ser +type PostgresThemeData (source : NpgsqlDataSource) = /// Clear out the template text from a theme let withoutTemplateText row = - let theme = toTheme row + let theme = fromData row { theme with Templates = theme.Templates |> List.map (fun template -> { template with Text = "" }) } /// Retrieve all themes (except 'admin'; excludes template text) let all () = - Sql.existingConnection conn - |> Sql.query $"SELECT * FROM {Table.Theme} WHERE id <> 'admin' ORDER BY id" + Sql.fromDataSource source + |> Sql.query $"{Query.selectFromTable Table.Theme} WHERE id <> 'admin' ORDER BY id" |> Sql.executeAsync withoutTemplateText /// Does a given theme exist? let exists themeId = - Document.exists conn Table.Theme themeId ThemeId.toString + Sql.fromDataSource source + |> Query.existsById Table.Theme (ThemeId.toString themeId) /// Find a theme by its ID let findById themeId = - Document.findById conn Table.Theme themeId ThemeId.toString toTheme + Sql.fromDataSource source + |> Query.tryById Table.Theme (ThemeId.toString themeId) /// Find a theme by its ID (excludes the text of templates) let findByIdWithoutText themeId = - Document.findById conn Table.Theme themeId ThemeId.toString withoutTemplateText + Sql.fromDataSource source + |> Sql.query $"{Query.selectFromTable Table.Theme} WHERE id = @id" + |> Sql.parameters [ "@id", Sql.string (ThemeId.toString themeId) ] + |> Sql.executeAsync withoutTemplateText + |> tryHead /// Delete a theme by its ID let delete themeId = backgroundTask { match! exists themeId with | true -> - do! Document.delete conn Table.Theme (ThemeId.toString themeId) + do! Sql.fromDataSource source |> Query.deleteById Table.Theme (ThemeId.toString themeId) return true | false -> return false } - /// Create theme save parameters - let themeParams (theme : Theme) = [ - "@id", Sql.string (ThemeId.toString theme.Id) - "@data", Sql.jsonb (Utils.serialize ser theme) - ] - /// Save a theme - let save (theme : Theme) = backgroundTask { - do! Document.upsert conn Table.Theme themeParams theme - } + let save (theme : Theme) = + Sql.fromDataSource source |> Query.save Table.Theme (ThemeId.toString theme.Id) theme interface IThemeData with member _.All () = all () @@ -65,18 +62,18 @@ type PostgresThemeData (conn : NpgsqlConnection, ser : JsonSerializer) = /// PostreSQL myWebLog theme data implementation -type PostgresThemeAssetData (conn : NpgsqlConnection) = +type PostgresThemeAssetData (source : NpgsqlDataSource) = /// Get all theme assets (excludes data) let all () = - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.query $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset}" |> Sql.executeAsync (Map.toThemeAsset false) /// Delete all assets for the given theme let deleteByTheme themeId = backgroundTask { let! _ = - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.query $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @themeId" |> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ] |> Sql.executeNonQueryAsync @@ -86,7 +83,7 @@ type PostgresThemeAssetData (conn : NpgsqlConnection) = /// Find a theme asset by its ID let findById assetId = let (ThemeAssetId (ThemeId themeId, path)) = assetId - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.query $"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @themeId AND path = @path" |> Sql.parameters [ "@themeId", Sql.string themeId; "@path", Sql.string path ] |> Sql.executeAsync (Map.toThemeAsset true) @@ -94,14 +91,14 @@ type PostgresThemeAssetData (conn : NpgsqlConnection) = /// Get theme assets for the given theme (excludes data) let findByTheme themeId = - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.query $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset} WHERE theme_id = @themeId" |> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ] |> Sql.executeAsync (Map.toThemeAsset false) /// Get theme assets for the given theme let findByThemeWithData themeId = - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.query $"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @themeId" |> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ] |> Sql.executeAsync (Map.toThemeAsset true) @@ -110,7 +107,7 @@ type PostgresThemeAssetData (conn : NpgsqlConnection) = let save (asset : ThemeAsset) = backgroundTask { let (ThemeAssetId (ThemeId themeId, path)) = asset.Id let! _ = - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.query $" INSERT INTO {Table.ThemeAsset} ( theme_id, path, updated_on, data diff --git a/src/MyWebLog.Data/Postgres/PostgresUploadData.fs b/src/MyWebLog.Data/Postgres/PostgresUploadData.fs index 65802b6..08f2f2f 100644 --- a/src/MyWebLog.Data/Postgres/PostgresUploadData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresUploadData.fs @@ -6,7 +6,7 @@ open Npgsql open Npgsql.FSharp /// PostgreSQL myWebLog uploaded file data implementation -type PostgresUploadData (conn : NpgsqlConnection) = +type PostgresUploadData (source : NpgsqlDataSource) = /// The INSERT statement for an uploaded file let upInsert = $" @@ -28,7 +28,7 @@ type PostgresUploadData (conn : NpgsqlConnection) = /// Save an uploaded file let add upload = backgroundTask { let! _ = - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.query upInsert |> Sql.parameters (upParams upload) |> Sql.executeNonQueryAsync @@ -39,15 +39,15 @@ type PostgresUploadData (conn : NpgsqlConnection) = let delete uploadId webLogId = backgroundTask { let idParam = [ "@id", Sql.string (UploadId.toString uploadId) ] let! path = - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.query $"SELECT path FROM {Table.Upload} WHERE id = @id AND web_log_id = @webLogId" |> Sql.parameters (webLogIdParam webLogId :: idParam) |> Sql.executeAsync (fun row -> row.string "path") |> tryHead if Option.isSome path then let! _ = - Sql.existingConnection conn - |> Sql.query (docDeleteSql Table.Upload) + Sql.fromDataSource source + |> Sql.query $"DELETE FROM {Table.Upload} WHERE id = @id" |> Sql.parameters idParam |> Sql.executeNonQueryAsync return Ok path.Value @@ -56,7 +56,7 @@ type PostgresUploadData (conn : NpgsqlConnection) = /// Find an uploaded file by its path for the given web log let findByPath path webLogId = - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.query $"SELECT * FROM {Table.Upload} WHERE web_log_id = @webLogId AND path = @path" |> Sql.parameters [ webLogIdParam webLogId; "@path", Sql.string path ] |> Sql.executeAsync (Map.toUpload true) @@ -64,14 +64,14 @@ type PostgresUploadData (conn : NpgsqlConnection) = /// Find all uploaded files for the given web log (excludes data) let findByWebLog webLogId = - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.query $"SELECT id, web_log_id, path, updated_on FROM {Table.Upload} WHERE web_log_id = @webLogId" |> Sql.parameters [ webLogIdParam webLogId ] |> Sql.executeAsync (Map.toUpload false) /// Find all uploaded files for the given web log let findByWebLogWithData webLogId = - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.query $"SELECT * FROM {Table.Upload} WHERE web_log_id = @webLogId" |> Sql.parameters [ webLogIdParam webLogId ] |> Sql.executeAsync (Map.toUpload true) @@ -80,7 +80,7 @@ type PostgresUploadData (conn : NpgsqlConnection) = let restore uploads = backgroundTask { for batch in uploads |> List.chunkBySize 5 do let! _ = - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.executeTransactionAsync [ upInsert, batch |> List.map upParams ] diff --git a/src/MyWebLog.Data/Postgres/PostgresWebLogData.fs b/src/MyWebLog.Data/Postgres/PostgresWebLogData.fs index e3f26b9..25a14ed 100644 --- a/src/MyWebLog.Data/Postgres/PostgresWebLogData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresWebLogData.fs @@ -2,80 +2,65 @@ open MyWebLog open MyWebLog.Data -open Newtonsoft.Json open Npgsql open Npgsql.FSharp +open Npgsql.FSharp.Documents /// PostgreSQL myWebLog web log data implementation -type PostgresWebLogData (conn : NpgsqlConnection, ser : JsonSerializer) = - - // SUPPORT FUNCTIONS - - /// Map a data row to a web log - let toWebLog = Map.fromDoc ser - - /// The parameters for web log INSERT or UPDATE statements - let webLogParams (webLog : WebLog) = [ - "@id", Sql.string (WebLogId.toString webLog.Id) - "@data", Sql.jsonb (Utils.serialize ser webLog) - ] - - // IMPLEMENTATION FUNCTIONS +type PostgresWebLogData (source : NpgsqlDataSource) = /// Add a web log - let add webLog = backgroundTask { - do! Document.insert conn Table.WebLog webLogParams webLog - } + let add (webLog : WebLog) = + Sql.fromDataSource source |> Query.insert Table.WebLog (WebLogId.toString webLog.Id) webLog /// Retrieve all web logs let all () = - Sql.existingConnection conn - |> Sql.query $"SELECT * FROM {Table.WebLog}" - |> Sql.executeAsync toWebLog + Sql.fromDataSource source + |> Query.all Table.WebLog /// Delete a web log by its ID let delete webLogId = backgroundTask { + let criteria = Query.whereDataContains "@criteria" let! _ = - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.query $" DELETE FROM {Table.PostComment} - WHERE data ->> '{nameof Comment.empty.PostId}' IN (SELECT id FROM {Table.Post} WHERE {webLogWhere}); - DELETE FROM {Table.Post} WHERE {webLogWhere}; - DELETE FROM {Table.Page} WHERE {webLogWhere}; - DELETE FROM {Table.Category} WHERE {webLogWhere}; - DELETE FROM {Table.TagMap} WHERE {webLogWhere}; + WHERE data->>'{nameof Comment.empty.PostId}' IN (SELECT id FROM {Table.Post} WHERE {criteria}); + DELETE FROM {Table.Post} WHERE {criteria}; + DELETE FROM {Table.Page} WHERE {criteria}; + DELETE FROM {Table.Category} WHERE {criteria}; + DELETE FROM {Table.TagMap} WHERE {criteria}; DELETE FROM {Table.Upload} WHERE web_log_id = @webLogId; - DELETE FROM {Table.WebLogUser} WHERE {webLogWhere}; + DELETE FROM {Table.WebLogUser} WHERE {criteria}; DELETE FROM {Table.WebLog} WHERE id = @webLogId" - |> Sql.parameters [ webLogIdParam webLogId ] + |> Sql.parameters [ webLogIdParam webLogId; "@criteria", webLogContains webLogId ] |> Sql.executeNonQueryAsync () } /// Find a web log by its host (URL base) - let findByHost url = - Sql.existingConnection conn - |> Sql.query $"SELECT * FROM {Table.WebLog} WHERE data ->> '{nameof WebLog.empty.UrlBase}' = @urlBase" - |> Sql.parameters [ "@urlBase", Sql.string url ] - |> Sql.executeAsync toWebLog + let findByHost (url : string) = + Sql.fromDataSource source + |> Sql.query $"""{Query.selectFromTable Table.WebLog} WHERE {Query.whereDataContains "@criteria"}""" + |> Sql.parameters [ "@criteria", Query.jsonbDocParam {| UrlBase = url |} ] + |> Sql.executeAsync fromData |> tryHead /// Find a web log by its ID let findById webLogId = - Document.findById conn Table.WebLog webLogId WebLogId.toString toWebLog + Sql.fromDataSource source + |> Query.tryById Table.WebLog (WebLogId.toString webLogId) /// Update settings for a web log - let updateSettings webLog = backgroundTask { - do! Document.update conn Table.WebLog webLogParams webLog - } + let updateSettings (webLog : WebLog) = + Sql.fromDataSource source |> Query.update Table.WebLog (WebLogId.toString webLog.Id) webLog /// Update RSS options for a web log let updateRssOptions (webLog : WebLog) = backgroundTask { - use! txn = conn.BeginTransactionAsync () match! findById webLog.Id with | Some blog -> - do! Document.update conn Table.WebLog webLogParams { blog with Rss = webLog.Rss } - do! txn.CommitAsync () + do! Sql.fromDataSource source + |> Query.update Table.WebLog (WebLogId.toString webLog.Id) { blog with Rss = webLog.Rss } | None -> () } diff --git a/src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs b/src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs index 787c42f..68a29d9 100644 --- a/src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs @@ -2,67 +2,74 @@ namespace MyWebLog.Data.Postgres open MyWebLog open MyWebLog.Data -open Newtonsoft.Json open Npgsql open Npgsql.FSharp +open Npgsql.FSharp.Documents /// PostgreSQL myWebLog user data implementation -type PostgresWebLogUserData (conn : NpgsqlConnection, ser : JsonSerializer) = +type PostgresWebLogUserData (source : NpgsqlDataSource) = - /// Map a data row to a user - let toWebLogUser = Map.fromDoc ser + /// Shorthand for making a web log ID into a string + let wls = WebLogId.toString + + /// Query to get users by JSON document containment criteria + let userByCriteria = + $"""{Query.selectFromTable Table.WebLogUser} WHERE {Query.whereDataContains "@criteria"}""" /// Parameters for saving web log users - let userParams (user : WebLogUser) = [ - "@id", Sql.string (WebLogUserId.toString user.Id) - "@data", Sql.jsonb (Utils.serialize ser user) - ] + let userParams (user : WebLogUser) = + Query.docParameters (WebLogUserId.toString user.Id) user /// Find a user by their ID for the given web log let findById userId webLogId = - Document.findByIdAndWebLog conn Table.WebLogUser userId WebLogUserId.toString webLogId toWebLogUser + Document.findByIdAndWebLog + source Table.WebLogUser userId WebLogUserId.toString webLogId /// Delete a user if they have no posts or pages let delete userId webLogId = backgroundTask { match! findById userId webLogId with | Some _ -> + let criteria = Query.whereDataContains "@criteria" + let usrId = WebLogUserId.toString userId let! isAuthor = - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.query $" - SELECT ( EXISTS (SELECT 1 FROM {Table.Page} WHERE data ->> '{nameof Page.empty.AuthorId}' = @id - OR EXISTS (SELECT 1 FROM {Table.Post} WHERE data ->> '{nameof Post.empty.AuthorId}' = @id)) + SELECT ( EXISTS (SELECT 1 FROM {Table.Page} WHERE {criteria} + OR EXISTS (SELECT 1 FROM {Table.Post} WHERE {criteria})) AS {existsName}" - |> Sql.parameters [ "@id", Sql.string (WebLogUserId.toString userId) ] + |> Sql.parameters [ "@criteria", Query.jsonbDocParam {| AuthorId = usrId |} ] |> Sql.executeRowAsync Map.toExists if isAuthor then return Error "User has pages or posts; cannot delete" else - do! Document.delete conn Table.WebLogUser (WebLogUserId.toString userId) + do! Sql.fromDataSource source |> Query.deleteById Table.WebLogUser usrId return Ok true | None -> return Error "User does not exist" } /// Find a user by their e-mail address for the given web log - let findByEmail email webLogId = - Sql.existingConnection conn - |> Sql.query $"{docSelectForWebLogSql Table.WebLogUser} AND data ->> '{nameof WebLogUser.empty.Email}' = @email" - |> Sql.parameters [ webLogIdParam webLogId; "@email", Sql.string email ] - |> Sql.executeAsync toWebLogUser + let findByEmail (email : string) webLogId = + Sql.fromDataSource source + |> Sql.query userByCriteria + |> Sql.parameters [ "@criteria", Query.jsonbDocParam {| WebLogId = wls webLogId; Email = email |} ] + |> Sql.executeAsync fromData |> tryHead /// Get all users for the given web log let findByWebLog webLogId = - Document.findByWebLog conn Table.WebLogUser webLogId toWebLogUser - (Some $"ORDER BY LOWER(data ->> '{nameof WebLogUser.empty.PreferredName}')") + Sql.fromDataSource source + |> Sql.query $"{userByCriteria} ORDER BY LOWER(data->>'{nameof WebLogUser.empty.PreferredName}')" + |> Sql.parameters [ "@criteria", webLogContains webLogId ] + |> Sql.executeAsync fromData /// Find the names of users by their IDs for the given web log let findNames webLogId userIds = backgroundTask { let idSql, idParams = inClause "AND id" "id" WebLogUserId.toString userIds let! users = - Sql.existingConnection conn - |> Sql.query $"{docSelectForWebLogSql Table.WebLogUser} {idSql}" - |> Sql.parameters (webLogIdParam webLogId :: idParams) - |> Sql.executeAsync toWebLogUser + Sql.fromDataSource source + |> Sql.query $"{userByCriteria} {idSql}" + |> Sql.parameters (("@criteria", webLogContains webLogId) :: idParams) + |> Sql.executeAsync fromData return users |> List.map (fun u -> { Name = WebLogUserId.toString u.Id; Value = WebLogUser.displayName u }) @@ -71,27 +78,26 @@ type PostgresWebLogUserData (conn : NpgsqlConnection, ser : JsonSerializer) = /// Restore users from a backup let restore users = backgroundTask { let! _ = - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.executeTransactionAsync [ - docInsertSql Table.WebLogUser, users |> List.map userParams + Query.insertQuery Table.WebLogUser, users |> List.map userParams ] () } /// Set a user's last seen date/time to now let setLastSeen userId webLogId = backgroundTask { - use! txn = conn.BeginTransactionAsync () match! findById userId webLogId with | Some user -> - do! Document.update conn Table.WebLogUser userParams { user with LastSeenOn = Some (Noda.now ()) } - do! txn.CommitAsync () + do! Sql.fromDataSource source + |> Query.update Table.WebLogUser (WebLogUserId.toString userId) + { user with LastSeenOn = Some (Noda.now ()) } | None -> () } /// Save a user - let save user = backgroundTask { - do! Document.upsert conn Table.WebLogUser userParams user - } + let save (user : WebLogUser) = + Sql.fromDataSource source |> Query.save Table.WebLogUser (WebLogUserId.toString user.Id) user interface IWebLogUserData with member _.Add user = save user diff --git a/src/MyWebLog.Data/PostgresData.fs b/src/MyWebLog.Data/PostgresData.fs index ef41747..932a80a 100644 --- a/src/MyWebLog.Data/PostgresData.fs +++ b/src/MyWebLog.Data/PostgresData.fs @@ -6,28 +6,34 @@ open MyWebLog.Data.Postgres open Newtonsoft.Json open Npgsql open Npgsql.FSharp +open Npgsql.FSharp.Documents /// Data implementation for PostgreSQL -type PostgresData (conn : NpgsqlConnection, log : ILogger, ser : JsonSerializer) = +type PostgresData (source : NpgsqlDataSource, log : ILogger, ser : JsonSerializer) = /// Create any needed tables let ensureTables () = backgroundTask { - let _ = NpgsqlConnection.GlobalTypeMapper.UseNodaTime () + // Set up the PostgreSQL document store + Configuration.useDataSource source + Configuration.useSerializer + { new IDocumentSerializer with + member _.Serialize<'T> (it : 'T) : string = Utils.serialize ser it + member _.Deserialize<'T> (it : string) : 'T = Utils.deserialize ser it + } let! tables = - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.query "SELECT tablename FROM pg_tables WHERE schemaname = 'public'" |> Sql.executeAsync (fun row -> row.string "tablename") let needsTable table = not (List.contains table tables) // Create a document table - let docTable table = $"CREATE TABLE %s{table} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL)" let mutable isNew = false let sql = seq { // Theme tables if needsTable Table.Theme then isNew <- true - docTable Table.Theme + Definition.createTable Table.Theme if needsTable Table.ThemeAsset then $"CREATE TABLE {Table.ThemeAsset} ( theme_id TEXT NOT NULL REFERENCES {Table.Theme} (id) ON DELETE CASCADE, @@ -38,25 +44,22 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger, ser : J // Web log table if needsTable Table.WebLog then - docTable Table.WebLog - $"CREATE INDEX web_log_theme_idx ON {Table.WebLog} (data ->> '{nameof WebLog.empty.ThemeId}')" + Definition.createTable Table.WebLog + Definition.createIndex Table.WebLog Optimized // Category table if needsTable Table.Category then - docTable Table.Category - $"CREATE INDEX category_web_log_idx ON {Table.Category} (data ->> '{nameof Category.empty.WebLogId}')" + Definition.createTable Table.Category + Definition.createIndex Table.Category Optimized // Web log user table if needsTable Table.WebLogUser then - docTable Table.WebLogUser - $"CREATE INDEX web_log_user_web_log_idx ON {Table.WebLogUser} - (data ->> '{nameof WebLogUser.empty.WebLogId}')" - $"CREATE INDEX web_log_user_email_idx ON {Table.WebLogUser} - (data ->> '{nameof WebLogUser.empty.WebLogId}', data ->> '{nameof WebLogUser.empty.Email}')" + Definition.createTable Table.WebLogUser + Definition.createIndex Table.WebLogUser Optimized // Page tables if needsTable Table.Page then - docTable Table.Page + Definition.createTable Table.Page $"CREATE INDEX page_web_log_idx ON {Table.Page} (data ->> '{nameof Page.empty.WebLogId}')" $"CREATE INDEX page_author_idx ON {Table.Page} (data ->> '{nameof Page.empty.AuthorId}')" $"CREATE INDEX page_permalink_idx ON {Table.Page} @@ -70,7 +73,7 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger, ser : J // Post tables if needsTable Table.Post then - docTable Table.Post + Definition.createTable Table.Post $"CREATE INDEX post_web_log_idx ON {Table.Post} (data ->> '{nameof Post.empty.WebLogId}')" $"CREATE INDEX post_author_idx ON {Table.Post} (data ->> '{nameof Post.empty.AuthorId}')" $"CREATE INDEX post_status_idx ON {Table.Post} @@ -88,13 +91,13 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger, ser : J revision_text TEXT NOT NULL, PRIMARY KEY (post_id, as_of))" if needsTable Table.PostComment then - docTable Table.PostComment + Definition.createTable Table.PostComment $"CREATE INDEX post_comment_post_idx ON {Table.PostComment} (data ->> '{nameof Comment.empty.PostId}')" // Tag map table if needsTable Table.TagMap then - docTable Table.TagMap - $"CREATE INDEX tag_map_web_log_idx ON {Table.TagMap} (data ->> '{nameof TagMap.empty.WebLogId}')" + Definition.createTable Table.TagMap + Definition.createIndex Table.TagMap Optimized // Uploaded file table if needsTable Table.Upload then @@ -113,7 +116,7 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger, ser : J $"INSERT INTO {Table.DbVersion} VALUES ('{Utils.currentDbVersion}')" } - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.executeTransactionAsync (sql |> Seq.map (fun s -> @@ -130,7 +133,7 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger, ser : J /// Set a specific database version let setDbVersion version = backgroundTask { let! _ = - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.query $"DELETE FROM db_version; INSERT INTO db_version VALUES ('%s{version}')" |> Sql.executeNonQueryAsync () @@ -149,15 +152,15 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger, ser : J interface IData with - member _.Category = PostgresCategoryData (conn, ser) - member _.Page = PostgresPageData (conn, ser) - member _.Post = PostgresPostData (conn, ser) - member _.TagMap = PostgresTagMapData (conn, ser) - member _.Theme = PostgresThemeData (conn, ser) - member _.ThemeAsset = PostgresThemeAssetData conn - member _.Upload = PostgresUploadData conn - member _.WebLog = PostgresWebLogData (conn, ser) - member _.WebLogUser = PostgresWebLogUserData (conn, ser) + member _.Category = PostgresCategoryData source + member _.Page = PostgresPageData source + member _.Post = PostgresPostData source + member _.TagMap = PostgresTagMapData source + member _.Theme = PostgresThemeData source + member _.ThemeAsset = PostgresThemeAssetData source + member _.Upload = PostgresUploadData source + member _.WebLog = PostgresWebLogData source + member _.WebLogUser = PostgresWebLogUserData source member _.Serializer = ser @@ -165,7 +168,7 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger, ser : J do! ensureTables () let! version = - Sql.existingConnection conn + Sql.fromDataSource source |> Sql.query "SELECT id FROM db_version" |> Sql.executeAsync (fun row -> row.string "id") |> tryHead diff --git a/src/MyWebLog/Program.fs b/src/MyWebLog/Program.fs index a9fecf4..7ae623d 100644 --- a/src/MyWebLog/Program.fs +++ b/src/MyWebLog/Program.fs @@ -64,9 +64,12 @@ module DataImplementation = elif hasConnStr "PostgreSQL" then let log = sp.GetRequiredService> () // NpgsqlLogManager.Provider <- ConsoleLoggingProvider NpgsqlLogLevel.Debug - let conn = new NpgsqlConnection (connStr "PostgreSQL") + let builder = NpgsqlDataSourceBuilder (connStr "PostgreSQL") + let _ = builder.UseNodaTime () + let source = builder.Build () + use conn = source.CreateConnection () log.LogInformation $"Using PostgreSQL database {conn.Host}:{conn.Port}/{conn.Database}" - PostgresData (conn, log, Json.configure (JsonSerializer.CreateDefault ())) + PostgresData (source, log, Json.configure (JsonSerializer.CreateDefault ())) else createSQLite "Data Source=./myweblog.db;Cache=Shared" diff --git a/src/Npgsql.FSharp.Documents/Library.fs b/src/Npgsql.FSharp.Documents/Library.fs index cbbbe00..db3c624 100644 --- a/src/Npgsql.FSharp.Documents/Library.fs +++ b/src/Npgsql.FSharp.Documents/Library.fs @@ -1,10 +1,242 @@ module Npgsql.FSharp.Documents +/// The required document serialization implementation +type IDocumentSerializer = + + /// Serialize an object to a JSON string + abstract Serialize<'T> : 'T -> string + + /// Deserialize a JSON string into an object + abstract Deserialize<'T> : string -> 'T + + +/// The type of index to generate for the document +type DocumentIndex = + /// A GIN index with standard operations (all operators supported) + | Full + /// A GIN index with JSONPath operations (optimized for @>, @?, @@ operators) + | Optimized + + +/// Configuration for document handling +module Configuration = + + open System.Text.Json + open System.Text.Json.Serialization + + /// The default JSON serializer options to use with the stock serializer + let private jsonDefaultOpts = + let o = JsonSerializerOptions () + o.Converters.Add (JsonFSharpConverter ()) + o + + /// The serializer to use for document manipulation + let mutable internal serializer = + { new IDocumentSerializer with + member _.Serialize<'T> (it : 'T) : string = + JsonSerializer.Serialize (it, jsonDefaultOpts) + member _.Deserialize<'T> (it : string) : 'T = + JsonSerializer.Deserialize<'T> (it, jsonDefaultOpts) + } + + /// Register a serializer to use for translating documents to domain types + let useSerializer ser = + serializer <- ser + + /// The data source to use for query execution + let mutable private dataSourceValue : Npgsql.NpgsqlDataSource option = None + + /// Register a data source to use for query execution + let useDataSource source = + dataSourceValue <- Some source + + let internal dataSource () = + match dataSourceValue with + | Some source -> source + | None -> invalidOp "Please provide a data source before attempting data access" + + +/// Data definition +[] +module Definition = + + /// SQL statement to create a document table + let createTable name = + $"CREATE TABLE IF NOT EXISTS %s{name} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL)" + + /// Create a document table + let ensureTable name sqlProps = backgroundTask { + let! _ = sqlProps |> Sql.query (createTable name) |> Sql.executeNonQueryAsync + () + } + + /// SQL statement to create an index on documents in the specified table + let createIndex (name : string) idxType = + let extraOps = match idxType with Full -> "" | Optimized -> " jsonb_path_ops" + let tableName = name.Split(".") |> Array.last + $"CREATE INDEX IF NOT EXISTS idx_{tableName} ON {name} USING GIN (data{extraOps})" + + /// Create an index on documents in the specified table + let ensureIndex (name : string) idxType sqlProps = backgroundTask { + let! _ = sqlProps |> Sql.query (createIndex name idxType) |> Sql.executeNonQueryAsync + () + } + +/// Create a domain item from a document, specifying the field in which the document is found +let fromDocument<'T> field (row : RowReader) : 'T = + Configuration.serializer.Deserialize<'T> (row.string field) + +/// Create a domain item from a document +let fromData<'T> row : 'T = + fromDocument "data" row /// Query construction functions +[] module Query = - /// Create a parameter for a @> (contains) query - let contains<'T> (name : string) (value : 'T) = - name, Sql.jsonb (string value) // FIXME: need a serializer + open System.Threading.Tasks + + // ~~ BUILDING BLOCKS ~~ + + /// Create a SELECT clause to retrieve the document data from the given table + let selectFromTable tableName = + $"SELECT data FROM %s{tableName}" + /// Create a WHERE clause fragment to implement a @> (JSON contains) condition + let whereDataContains paramName = + $"data @> %s{paramName}" + + /// Create a WHERE clause fragment to implement a @? (JSON Path match) condition + let whereJsonPathMatches paramName = + $"data @? %s{paramName}" + + /// Create a JSONB document parameter + let jsonbDocParam (it : obj) = + Sql.jsonb (Configuration.serializer.Serialize it) + + /// Create ID and data parameters for a query + let docParameters<'T> docId (doc : 'T) = + [ "@id", Sql.string docId; "@data", jsonbDocParam doc ] + + // ~~ DOCUMENT RETRIEVAL QUERIES ~~ + + /// Retrieve all documents in the given table + let all<'T> tableName sqlProps : Task<'T list> = + sqlProps + |> Sql.query $"SELECT data FROM %s{tableName}" + |> Sql.executeAsync fromData<'T> + + /// Count matching documents using @> (JSON contains) + let countByContains tableName (criteria : obj) sqlProps : Task = + sqlProps + |> Sql.query $"""SELECT COUNT(id) AS row_count FROM %s{tableName} WHERE {whereDataContains "@criteria"}""" + |> Sql.parameters [ "@criteria", jsonbDocParam criteria ] + |> Sql.executeRowAsync (fun row -> row.int "row_count") + + /// Count matching documents using @? (JSON Path match) + let countByJsonPath tableName jsonPath sqlProps : Task = + sqlProps + |> Sql.query $"""SELECT COUNT(id) AS row_count FROM %s{tableName} WHERE {whereJsonPathMatches "@jsonPath"}""" + |> Sql.parameters [ "@jsonPath", Sql.string jsonPath ] + |> Sql.executeRowAsync (fun row -> row.int "row_count") + + /// Determine if a document exists for the given ID + let existsById tableName docId sqlProps : Task = + sqlProps + |> Sql.query $"SELECT EXISTS (SELECT 1 FROM %s{tableName} WHERE id = @id) AS xist" + |> Sql.parameters [ "@id", Sql.string docId ] + |> Sql.executeRowAsync (fun row -> row.bool "xist") + + /// Determine if a document exists using @> (JSON contains) + let existsByContains tableName (criteria : obj) sqlProps : Task = + sqlProps + |> Sql.query $"""SELECT EXISTS (SELECT 1 FROM %s{tableName} WHERE {whereDataContains "@criteria"}) AS xist""" + |> Sql.parameters [ "@criteria", jsonbDocParam criteria ] + |> Sql.executeRowAsync (fun row -> row.bool "xist") + + /// Determine if a document exists using @? (JSON Path match) + let existsByJsonPath tableName jsonPath sqlProps : Task = + sqlProps + |> Sql.query $"""SELECT EXISTS (SELECT 1 FROM %s{tableName} WHERE {whereJsonPathMatches "@jsonPath"}) AS xist""" + |> Sql.parameters [ "@criteria", Sql.string jsonPath ] + |> Sql.executeRowAsync (fun row -> row.bool "xist") + + /// Execute a @> (JSON contains) query + let findByContains<'T> tableName value sqlProps : Task<'T list> = + sqlProps + |> Sql.query $"""{selectFromTable tableName} WHERE {whereDataContains "@criteria"}""" + |> Sql.parameters [ "@criteria", jsonbDocParam value ] + |> Sql.executeAsync fromData<'T> + + /// Execute a @? (JSON Path match) query + let findByJsonPath<'T> tableName jsonPath sqlProps : Task<'T list> = + sqlProps + |> Sql.query $"""{selectFromTable tableName} WHERE {whereJsonPathMatches "@jsonPath"}""" + |> Sql.parameters [ "@jsonPath", Sql.string jsonPath ] + |> Sql.executeAsync fromData<'T> + + /// Retrieve a document by its ID + let tryById<'T> tableName idValue sqlProps : Task<'T option> = backgroundTask { + let! results = + sqlProps + |> Sql.query $"{selectFromTable tableName} WHERE id = @id" + |> Sql.parameters [ "@id", Sql.string idValue ] + |> Sql.executeAsync fromData<'T> + return List.tryHead results + } + + // ~~ DOCUMENT MANIPULATION QUERIES ~~ + + /// Query to insert a document + let insertQuery tableName = + $"INSERT INTO %s{tableName} (id, data) VALUES (@id, @data)" + + /// Insert a new document + let insert<'T> tableName docId (document : 'T) sqlProps = backgroundTask { + let! _ = + sqlProps + |> Sql.query $"INSERT INTO %s{tableName} (id, data) VALUES (@id, @data)" + |> Sql.parameters (docParameters docId document) + |> Sql.executeNonQueryAsync + () + } + + /// Query to update a document + let updateQuery tableName = + $"UPDATE %s{tableName} SET data = @data WHERE id = @id" + + /// Update new document + let update<'T> tableName docId (document : 'T) sqlProps = backgroundTask { + let! _ = + sqlProps + |> Sql.query (updateQuery tableName) + |> Sql.parameters (docParameters docId document) + |> Sql.executeNonQueryAsync + () + } + + /// Query to save a document, inserting it if it does not exist and updating it if it does (AKA "upsert") + let saveQuery tableName = + $"INSERT INTO %s{tableName} (id, data) VALUES (@id, @data) ON CONFLICT (id) DO UPDATE SET data = EXCLUDED.data" + + /// Save a document, inserting it if it does not exist and updating it if it does (AKA "upsert") + let save<'T> tableName docId (document : 'T) sqlProps = backgroundTask { + let! _ = + sqlProps + |> Sql.query $" + INSERT INTO %s{tableName} (id, data) VALUES (@id, @data) + ON CONFLICT (id) DO UPDATE SET data = EXCLUDED.data" + |> Sql.parameters (docParameters docId document) + |> Sql.executeNonQueryAsync + () + } + + /// Delete a document by its ID + let deleteById tableName docId sqlProps = backgroundTask { + let _ = + sqlProps + |> Sql.query $"DELETE FROM %s{tableName} WHERE id = @id" + |> Sql.parameters [ "@id", Sql.string docId ] + |> Sql.executeNonQueryAsync + () + } diff --git a/src/Npgsql.FSharp.Documents/Npgsql.FSharp.Documents.fsproj b/src/Npgsql.FSharp.Documents/Npgsql.FSharp.Documents.fsproj index 9f4040e..795d55c 100644 --- a/src/Npgsql.FSharp.Documents/Npgsql.FSharp.Documents.fsproj +++ b/src/Npgsql.FSharp.Documents/Npgsql.FSharp.Documents.fsproj @@ -5,6 +5,7 @@ +