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

V2 #36

Merged
danieljsummers merged 17 commits from v2-out-the-door into main 2023-02-26 18:01:21 +00:00
Conversation 0 Commits 17 Files Changed 36 +612 -471
14 changed files with 612 additions and 471 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files
Showing only changes of commit cc6f444b5f - Show all commits

2
src/MyWebLog.Data/MyWebLog.Data.fsproj
View File

@ -13,8 +13,6 @@
<PackageReference Include="Newtonsoft.Json" Version="13.0.1" /> <PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
<PackageReference Include="NodaTime" Version="3.1.2" /> <PackageReference Include="NodaTime" Version="3.1.2" />
<PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.0.0" /> <PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.0.0" />
<PackageReference Include="Npgsql" Version="6.0.6" />
<PackageReference Include="Npgsql.FSharp" Version="5.3.0" />
<PackageReference Include="Npgsql.NodaTime" Version="6.0.6" /> <PackageReference Include="Npgsql.NodaTime" Version="6.0.6" />
<PackageReference Include="RethinkDb.Driver" Version="2.3.150" /> <PackageReference Include="RethinkDb.Driver" Version="2.3.150" />
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-07" /> <PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-07" />

88
src/MyWebLog.Data/Postgres/PostgresCategoryData.fs
View File

@ -2,30 +2,36 @@
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json
open Npgsql open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
open Npgsql.FSharp.Documents
/// PostgreSQL myWebLog category data implementation /// PostgreSQL myWebLog category data implementation
type PostgresCategoryData (conn : NpgsqlConnection, ser : JsonSerializer) = type PostgresCategoryData (source : NpgsqlDataSource) =
/// Convert a data row to a category /// Shorthand for turning a web log ID into a string
let toCategory = Map.fromDoc<Category> ser let wls = WebLogId.toString
/// Count all categories for the given web log /// Count all categories for the given web log
let countAll webLogId = 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 /// Count all top-level categories for the given web log
let countTopLevel webLogId = let countTopLevel webLogId =
Document.countByWebLog conn Table.Category webLogId Sql.fromDataSource source
(Some $"AND data -> '{nameof Category.empty.ParentId}' IS NULL") |> Query.countByContains Table.Category {| WebLogId = wls webLogId; ParentId = None |}
/// Retrieve all categories for the given web log in a DotLiquid-friendly format /// Retrieve all categories for the given web log in a DotLiquid-friendly format
let findAllForView webLogId = backgroundTask { let findAllForView webLogId = backgroundTask {
let! cats = let! cats =
Document.findByWebLog conn Table.Category webLogId toCategory Sql.fromDataSource source
(Some $"ORDER BY LOWER(data ->> '{nameof Category.empty.Name}')") |> 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<Category>
let ordered = Utils.orderByHierarchy cats None None [] let ordered = Utils.orderByHierarchy cats None None []
let counts = let counts =
ordered ordered
@ -39,14 +45,16 @@ type PostgresCategoryData (conn : NpgsqlConnection, ser : JsonSerializer) =
|> List.ofSeq |> List.ofSeq
|> jsonArrayInClause (nameof Post.empty.CategoryIds) id |> jsonArrayInClause (nameof Post.empty.CategoryIds) id
let postCount = let postCount =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $" |> Sql.query $"""
SELECT COUNT(DISTINCT id) AS {countName} SELECT COUNT(DISTINCT id) AS {countName}
FROM {Table.Post} FROM {Table.Post}
WHERE {webLogWhere} WHERE {Query.whereDataContains "@criteria"}
AND data ->> '{nameof Post.empty.Status}' = '{PostStatus.toString Published}' AND ({catIdSql})"""
AND ({catIdSql})" |> Sql.parameters (
|> Sql.parameters (webLogIdParam webLogId :: catIdParams) ("@criteria",
Query.jsonbDocParam {| WebLogId = wls webLogId; Status = PostStatus.toString Published |})
:: catIdParams)
|> Sql.executeRowAsync Map.toCount |> Sql.executeRowAsync Map.toCount
|> Async.AwaitTask |> Async.AwaitTask
|> Async.RunSynchronously |> Async.RunSynchronously
@ -65,76 +73,70 @@ type PostgresCategoryData (conn : NpgsqlConnection, ser : JsonSerializer) =
} }
/// Find a category by its ID for the given web log /// Find a category by its ID for the given web log
let findById catId webLogId = let findById catId webLogId =
Document.findByIdAndWebLog conn Table.Category catId CategoryId.toString webLogId toCategory Document.findByIdAndWebLog<CategoryId, Category> source Table.Category catId CategoryId.toString webLogId
/// Find all categories for the given web log /// Find all categories for the given web log
let findByWebLog webLogId = let findByWebLog webLogId =
Document.findByWebLog conn Table.Category webLogId toCategory None Document.findByWebLog<Category> source Table.Category webLogId
/// Create parameters for a category insert / update /// Create parameters for a category insert / update
let catParameters (cat : Category) = [ let catParameters (cat : Category) =
"@id", Sql.string (CategoryId.toString cat.Id) Query.docParameters (CategoryId.toString cat.Id) cat
"@data", Sql.jsonb (Utils.serialize ser cat)
]
/// Delete a category /// Delete a category
let delete catId webLogId = backgroundTask { let delete catId webLogId = backgroundTask {
match! findById catId webLogId with match! findById catId webLogId with
| Some cat -> | Some cat ->
// Reassign any children to the category's parent category // Reassign any children to the category's parent category
let parentParam = "@parentId", Sql.string (CategoryId.toString catId)
let! children = let! children =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query |> Query.findByContains Table.Category {| ParentId = CategoryId.toString catId |}
$"SELECT * FROM {Table.Category} WHERE data ->> '{nameof Category.empty.ParentId}' = @parentId"
|> Sql.parameters [ parentParam ]
|> Sql.executeAsync toCategory
let hasChildren = not (List.isEmpty children) let hasChildren = not (List.isEmpty children)
if hasChildren then if hasChildren then
let! _ = let! _ =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
docUpdateSql Table.Category, Query.updateQuery Table.Category,
children |> List.map (fun child -> catParameters { child with ParentId = cat.ParentId }) children |> List.map (fun child -> catParameters { child with ParentId = cat.ParentId })
] ]
() ()
// Delete the category off all posts where it is assigned // Delete the category off all posts where it is assigned
let! posts = let! posts =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $"SELECT * FROM {Table.Post} WHERE data -> '{nameof Post.empty.CategoryIds}' ? @id" |> Sql.query $"SELECT data FROM {Table.Post} WHERE data->'{nameof Post.empty.CategoryIds}' ? @id"
|> Sql.parameters [ "@id", Sql.jsonb (CategoryId.toString catId) ] |> Sql.parameters [ "@id", Sql.jsonb (CategoryId.toString catId) ]
|> Sql.executeAsync (Map.fromDoc<Post> ser) |> Sql.executeAsync fromData<Post>
if not (List.isEmpty posts) then if not (List.isEmpty posts) then
let! _ = let! _ =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
docUpdateSql Table.Post, Query.updateQuery Table.Post,
posts |> List.map (fun post -> [ posts |> List.map (fun post -> [
"@id", Sql.string (PostId.toString post.Id) "@id", Sql.string (PostId.toString post.Id)
"@data", Sql.jsonb (Utils.serialize ser { "@data", Query.jsonbDocParam
post with { post with
CategoryIds = post.CategoryIds |> List.filter (fun cat -> cat <> catId) CategoryIds = post.CategoryIds |> List.filter (fun cat -> cat <> catId)
}) }
]) ])
] ]
() ()
// Delete the category itself // 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 return if hasChildren then ReassignedChildCategories else CategoryDeleted
| None -> return CategoryNotFound | None -> return CategoryNotFound
} }
/// Save a category /// Save a category
let save cat = backgroundTask { let save (cat : Category) = backgroundTask {
do! Document.upsert conn Table.Category catParameters cat do! Sql.fromDataSource source |> Query.save Table.Category (CategoryId.toString cat.Id) cat
} }
/// Restore categories from a backup /// Restore categories from a backup
let restore cats = backgroundTask { let restore cats = backgroundTask {
let! _ = let! _ =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
docInsertSql Table.Category, cats |> List.map catParameters Query.insertQuery Table.Category, cats |> List.map catParameters
] ]
() ()
} }

152
src/MyWebLog.Data/Postgres/PostgresHelpers.fs
View File

@ -66,6 +66,7 @@ open MyWebLog.Data
open NodaTime open NodaTime
open Npgsql open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
open Npgsql.FSharp.Documents
/// Create a WHERE clause fragment for the web log ID /// Create a WHERE clause fragment for the web log ID
let webLogWhere = "data ->> 'WebLogId' = @webLogId" let webLogWhere = "data ->> 'WebLogId' = @webLogId"
@ -74,6 +75,10 @@ let webLogWhere = "data ->> 'WebLogId' = @webLogId"
let webLogIdParam webLogId = let webLogIdParam webLogId =
"@webLogId", Sql.string (WebLogId.toString 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 /// The name of the field to select to be able to use Map.toCount
let countName = "the_count" 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) let p = NpgsqlParameter ($"@%s{name}", if Option.isSome it then box it.Value else DBNull.Value)
p.ParameterName, Sql.parameter p 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 /// Mapping functions for SQL queries
module Map = 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 /// Get a count from a row
let toCount (row : RowReader) = let toCount (row : RowReader) =
row.int countName row.int countName
@ -203,112 +172,43 @@ module Map =
/// Document manipulation functions /// Document manipulation functions
module Document = 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 /// 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 = let existsByWebLog<'TKey> source table (key : 'TKey) (keyFunc : 'TKey -> string) webLogId =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query (docExistsForWebLogSql table) |> 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.parameters [ "@id", Sql.string (keyFunc key); webLogIdParam webLogId ]
|> Sql.executeRowAsync Map.toExists |> Sql.executeRowAsync Map.toExists
/// Find a document by its ID /// Find a document by its ID for the given web log
let findById<'TKey, 'TDoc> conn table (key : 'TKey) (keyFunc : 'TKey -> string) (docFunc : RowReader -> 'TDoc) = let findByIdAndWebLog<'TKey, 'TDoc> source table (key : 'TKey) (keyFunc : 'TKey -> string) webLogId =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query (docSelectSql table) |> Sql.query $"""{Query.selectFromTable table} WHERE id = @id AND {Query.whereDataContains "@criteria"}"""
|> Sql.parameters [ "@id", Sql.string (keyFunc key) ] |> Sql.parameters [ "@id", Sql.string (keyFunc key); "@criteria", webLogContains webLogId ]
|> Sql.executeAsync docFunc |> Sql.executeAsync fromData<'TDoc>
|> tryHead |> tryHead
/// Find a document by its ID for the given web log /// Find a document by its ID for the given web log
let findByIdAndWebLog<'TKey, 'TDoc> conn table (key : 'TKey) (keyFunc : 'TKey -> string) webLogId let findByWebLog<'TDoc> source table webLogId : Task<'TDoc list> =
(docFunc : RowReader -> 'TDoc) = Sql.fromDataSource source
Sql.existingConnection conn |> Query.findByContains table {| WebLogId = WebLogId.toString webLogId |}
|> 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
()
}
/// 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 /// Functions to support revisions
module Revisions = module Revisions =
/// Find all revisions for the given entity /// Find all revisions for the given entity
let findByEntityId<'TKey> conn revTable entityTable (key : 'TKey) (keyFunc : 'TKey -> string) = let findByEntityId<'TKey> source revTable entityTable (key : 'TKey) (keyFunc : 'TKey -> string) =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $"SELECT as_of, revision_text FROM %s{revTable} WHERE %s{entityTable}_id = @id ORDER BY as_of DESC" |> 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.parameters [ "@id", Sql.string (keyFunc key) ]
|> Sql.executeAsync Map.toRevision |> Sql.executeAsync Map.toRevision
/// Find all revisions for all posts for the given web log /// Find all revisions for all posts for the given web log
let findByWebLog<'TKey> conn revTable entityTable (keyFunc : string -> 'TKey) webLogId = let findByWebLog<'TKey> source revTable entityTable (keyFunc : string -> 'TKey) webLogId =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $" |> Sql.query $"
SELECT pr.* SELECT pr.*
FROM %s{revTable} pr FROM %s{revTable} pr
@ -331,11 +231,11 @@ module Revisions =
/// Update a page's revisions /// Update a page's revisions
let update<'TKey> 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 let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then
let! _ = let! _ =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
if not (List.isEmpty toDelete) then if not (List.isEmpty toDelete) then
$"DELETE FROM %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf", $"DELETE FROM %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf",

106
src/MyWebLog.Data/Postgres/PostgresPageData.fs
View File

@ -2,54 +2,61 @@ namespace MyWebLog.Data.Postgres
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json
open Npgsql open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
open Npgsql.FSharp.Documents
/// PostgreSQL myWebLog page data implementation /// PostgreSQL myWebLog page data implementation
type PostgresPageData (conn : NpgsqlConnection, ser : JsonSerializer) = type PostgresPageData (source : NpgsqlDataSource) =
// SUPPORT FUNCTIONS // SUPPORT FUNCTIONS
/// Shorthand for turning a web log ID into a string
let wls = WebLogId.toString
/// Append revisions to a page /// Append revisions to a page
let appendPageRevisions (page : Page) = backgroundTask { 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 } return { page with Revisions = revisions }
} }
/// Shorthand to map to a page
let toPage = Map.fromDoc<Page> ser
/// Return a page with no text or revisions /// Return a page with no text or revisions
let pageWithoutText row = let pageWithoutText row =
{ toPage row with Text = "" } { fromData<Page> row with Text = "" }
/// Update a page's revisions /// Update a page's revisions
let updatePageRevisions pageId oldRevs newRevs = 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? /// Does the given page exist?
let pageExists pageId webLogId = let pageExists pageId webLogId =
Document.existsByWebLog conn Table.Page pageId PageId.toString webLogId Document.existsByWebLog source Table.Page pageId PageId.toString webLogId
// IMPLEMENTATION FUNCTIONS // IMPLEMENTATION FUNCTIONS
/// Get all pages for a web log (without text or revisions) /// Get all pages for a web log (without text or revisions)
let all webLogId = let all webLogId =
Document.findByWebLog conn Table.Page webLogId pageWithoutText Sql.fromDataSource source
(Some $"ORDER BY LOWER(data ->> '{nameof Page.empty.Title}')") |> 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<Page>
/// Count all pages for the given web log /// Count all pages for the given web log
let countAll webLogId = 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 /// Count all pages shown in the page list for the given web log
let countListed webLogId = 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) /// Find a page by its ID (without revisions)
let findById pageId webLogId = let findById pageId webLogId =
Document.findByIdAndWebLog conn Table.Page pageId PageId.toString webLogId toPage Document.findByIdAndWebLog<PageId, Page> source Table.Page pageId PageId.toString webLogId
/// Find a complete page by its ID /// Find a complete page by its ID
let findFullById pageId webLogId = backgroundTask { let findFullById pageId webLogId = backgroundTask {
@ -64,17 +71,15 @@ type PostgresPageData (conn : NpgsqlConnection, ser : JsonSerializer) =
let delete pageId webLogId = backgroundTask { let delete pageId webLogId = backgroundTask {
match! pageExists pageId webLogId with match! pageExists pageId webLogId with
| true -> | true ->
do! Document.delete conn Table.Page (PageId.toString pageId) do! Sql.fromDataSource source |> Query.deleteById Table.Page (PageId.toString pageId)
return true return true
| false -> return false | false -> return false
} }
/// Find a page by its permalink for the given web log /// Find a page by its permalink for the given web log
let findByPermalink permalink webLogId = let findByPermalink permalink webLogId =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $"{docSelectForWebLogSql Table.Page} AND data ->> '{nameof Page.empty.Permalink}' = @link" |> Query.findByContains<Page> Table.Page {| WebLogId = wls webLogId; Permalink = Permalink.toString permalink |}
|> Sql.parameters [ webLogIdParam webLogId; "@link", Sql.string (Permalink.toString permalink) ]
|> Sql.executeAsync toPage
|> tryHead |> tryHead
/// Find the current permalink within a set of potential prior permalinks for the given web log /// Find the current permalink within a set of potential prior permalinks for the given web log
@ -84,21 +89,22 @@ type PostgresPageData (conn : NpgsqlConnection, ser : JsonSerializer) =
let linkSql, linkParams = let linkSql, linkParams =
jsonArrayInClause (nameof Page.empty.PriorPermalinks) Permalink.toString permalinks jsonArrayInClause (nameof Page.empty.PriorPermalinks) Permalink.toString permalinks
return! return!
Sql.existingConnection conn // TODO: stopped here
|> Sql.query $" Sql.fromDataSource source
SELECT data ->> '{nameof Page.empty.Permalink}' AS permalink |> Sql.query $"""
SELECT data->>'{nameof Page.empty.Permalink}' AS permalink
FROM page FROM page
WHERE {webLogWhere} WHERE {Query.whereDataContains "@criteria"}
AND ({linkSql})" AND ({linkSql})"""
|> Sql.parameters (webLogIdParam webLogId :: linkParams) |> Sql.parameters (("@criteria", webLogContains webLogId) :: linkParams)
|> Sql.executeAsync Map.toPermalink |> Sql.executeAsync Map.toPermalink
|> tryHead |> tryHead
} }
/// Get all complete pages for the given web log /// Get all complete pages for the given web log
let findFullByWebLog webLogId = backgroundTask { let findFullByWebLog webLogId = backgroundTask {
let! pages = Document.findByWebLog conn Table.Page webLogId toPage None let! pages = Document.findByWebLog<Page> source Table.Page webLogId
let! revisions = Revisions.findByWebLog conn Table.PageRevision Table.Page PageId webLogId let! revisions = Revisions.findByWebLog source Table.PageRevision Table.Page PageId webLogId
return return
pages pages
|> List.map (fun it -> |> 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) /// Get all listed pages for the given web log (without revisions or text)
let findListed webLogId = let findListed webLogId =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $" |> Sql.query $"""
{docSelectForWebLogSql Table.Page} {Query.selectFromTable Table.Page}
AND data -> '{nameof Page.empty.IsInPageList}' = TRUE WHERE {Query.whereDataContains "@criteria"}
ORDER BY LOWER(data ->> '{nameof Page.empty.Title}')" ORDER BY LOWER(data->>'{nameof Page.empty.Title}')"""
|> Sql.parameters [ webLogIdParam webLogId ] |> Sql.parameters [ "@criteria", Query.jsonbDocParam {| WebLogId = wls webLogId; IsInPageList = true |} ]
|> Sql.executeAsync pageWithoutText |> Sql.executeAsync pageWithoutText
/// Get a page of pages for the given web log (without revisions) /// Get a page of pages for the given web log (without revisions)
let findPageOfPages webLogId pageNbr = let findPageOfPages webLogId pageNbr =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $" |> Sql.query $"""
{docSelectForWebLogSql Table.Page} {Query.selectFromTable Table.Page}
ORDER BY LOWER(data ->> '{nameof Page.empty.Title}') WHERE {Query.whereDataContains "@criteria"}
LIMIT @pageSize OFFSET @toSkip" ORDER BY LOWER(data->>'{nameof Page.empty.Title}')
|> Sql.parameters [ webLogIdParam webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ] LIMIT @pageSize OFFSET @toSkip"""
|> Sql.executeAsync toPage |> Sql.parameters
[ "@criteria", webLogContains webLogId
"@pageSize", Sql.int 26
"@toSkip", Sql.int ((pageNbr - 1) * 25)
]
|> Sql.executeAsync fromData<Page>
/// The parameters for saving a page /// The parameters for saving a page
let pageParams (page : Page) = [ let pageParams (page : Page) =
"@id", Sql.string (PageId.toString page.Id) Query.docParameters (PageId.toString page.Id) page
"@data", Sql.jsonb (Utils.serialize ser page)
]
/// Restore pages from a backup /// Restore pages from a backup
let restore (pages : Page list) = backgroundTask { let restore (pages : Page list) = backgroundTask {
let revisions = pages |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r)) let revisions = pages |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r))
let! _ = let! _ =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
docInsertSql Table.Page, pages |> List.map pageParams Query.insertQuery Table.Page, pages |> List.map pageParams
Revisions.insertSql Table.PageRevision, Revisions.insertSql Table.PageRevision,
revisions |> List.map (fun (pageId, rev) -> Revisions.revParams pageId PageId.toString rev) 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 /// Save a page
let save (page : Page) = backgroundTask { let save (page : Page) = backgroundTask {
let! oldPage = findFullById page.Id page.WebLogId 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 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 { let updatePriorPermalinks pageId webLogId permalinks = backgroundTask {
match! findById pageId webLogId with match! findById pageId webLogId with
| Some page -> | 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 return true
| None -> return false | None -> return false
} }

159
src/MyWebLog.Data/Postgres/PostgresPostData.fs
View File

@ -2,60 +2,63 @@ namespace MyWebLog.Data.Postgres
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json
open NodaTime open NodaTime
open Npgsql open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
open Npgsql.FSharp.Documents
/// PostgreSQL myWebLog post data implementation /// PostgreSQL myWebLog post data implementation
type PostgresPostData (conn : NpgsqlConnection, ser : JsonSerializer) = type PostgresPostData (source : NpgsqlDataSource) =
// SUPPORT FUNCTIONS // SUPPORT FUNCTIONS
/// Shorthand for turning a web log ID into a string
let wls = WebLogId.toString
/// Append revisions to a post /// Append revisions to a post
let appendPostRevisions (post : Post) = backgroundTask { 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 } return { post with Revisions = revisions }
} }
/// Shorthand for mapping to a post
let toPost = Map.fromDoc<Post> ser
/// Return a post with no revisions, prior permalinks, or text /// Return a post with no revisions, prior permalinks, or text
let postWithoutText row = let postWithoutText row =
{ toPost row with Text = "" } { fromData<Post> row with Text = "" }
/// Update a post's revisions /// Update a post's revisions
let updatePostRevisions postId oldRevs newRevs = 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? /// Does the given post exist?
let postExists postId webLogId = 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 /// Query to select posts by JSON document containment criteria
let postsByWebLogAndStatus = let postsByCriteria =
$"{docSelectForWebLogSql Table.Post} AND data ->> '{nameof Post.empty.Status}' = @status" $"""{Query.selectFromTable Table.Post} WHERE {Query.whereDataContains "@criteria"}"""
// IMPLEMENTATION FUNCTIONS // IMPLEMENTATION FUNCTIONS
/// Count posts in a status for the given web log /// Count posts in a status for the given web log
let countByStatus status webLogId = let countByStatus status webLogId =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $"{docCountForWebLogSql Table.Post} AND data ->> '{nameof Post.empty.Status}' = @status" |> Sql.query
|> Sql.parameters [ webLogIdParam webLogId; "@status", Sql.string (PostStatus.toString status) ] $"""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 |> Sql.executeRowAsync Map.toCount
/// Find a post by its ID for the given web log (excluding revisions) /// Find a post by its ID for the given web log (excluding revisions)
let findById postId webLogId = let findById postId webLogId =
Document.findByIdAndWebLog conn Table.Post postId PostId.toString webLogId toPost Document.findByIdAndWebLog<PostId, Post> source Table.Post postId PostId.toString webLogId
/// Find a post by its permalink for the given web log (excluding revisions and prior permalinks) /// Find a post by its permalink for the given web log (excluding revisions and prior permalinks)
let findByPermalink permalink webLogId = let findByPermalink permalink webLogId =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $"{docSelectForWebLogSql Table.Post} AND data ->> '{nameof Post.empty.Permalink}' = @link" |> Sql.query postsByCriteria
|> Sql.parameters [ webLogIdParam webLogId; "@link", Sql.string (Permalink.toString permalink) ] |> Sql.parameters
|> Sql.executeAsync toPost [ "@criteria", Query.jsonbDocParam {| WebLogId = wls webLogId; Permalink = Permalink.toString permalink |} ]
|> Sql.executeAsync fromData<Post>
|> tryHead |> tryHead
/// Find a complete post by its ID for the given web log /// 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 { let delete postId webLogId = backgroundTask {
match! postExists postId webLogId with match! postExists postId webLogId with
| true -> | true ->
let theId = PostId.toString postId
let! _ = let! _ =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $" |> Sql.query $"""
DELETE FROM {Table.PostComment} WHERE data ->> '{nameof Comment.empty.PostId}' = @id; DELETE FROM {Table.PostComment} WHERE {Query.whereDataContains "@criteria"};
DELETE FROM {Table.Post} WHERE id = @id" DELETE FROM {Table.Post} WHERE id = @id"""
|> Sql.parameters [ "@id", Sql.string (PostId.toString postId) ] |> Sql.parameters [ "@id", Sql.string theId; "@criteria", Query.jsonbDocParam {| PostId = theId |} ]
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
return true return true
| false -> return false | false -> return false
@ -89,21 +93,21 @@ type PostgresPostData (conn : NpgsqlConnection, ser : JsonSerializer) =
let linkSql, linkParams = let linkSql, linkParams =
jsonArrayInClause (nameof Post.empty.PriorPermalinks) Permalink.toString permalinks jsonArrayInClause (nameof Post.empty.PriorPermalinks) Permalink.toString permalinks
return! return!
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $" |> Sql.query $"""
SELECT data ->> '{nameof Post.empty.Permalink}' AS permalink SELECT data->>'{nameof Post.empty.Permalink}' AS permalink
FROM {Table.Post} FROM {Table.Post}
WHERE {webLogWhere} WHERE {Query.whereDataContains "@criteria"}
AND ({linkSql})" AND ({linkSql})"""
|> Sql.parameters (webLogIdParam webLogId :: linkParams) |> Sql.parameters (("@criteria", webLogContains webLogId) :: linkParams)
|> Sql.executeAsync Map.toPermalink |> Sql.executeAsync Map.toPermalink
|> tryHead |> tryHead
} }
/// Get all complete posts for the given web log /// Get all complete posts for the given web log
let findFullByWebLog webLogId = backgroundTask { let findFullByWebLog webLogId = backgroundTask {
let! posts = Document.findByWebLog conn Table.Post webLogId toPost None let! posts = Document.findByWebLog<Post> source Table.Post webLogId
let! revisions = Revisions.findByWebLog conn Table.PostRevision Table.Post PostId webLogId let! revisions = Revisions.findByWebLog source Table.PostRevision Table.Post PostId webLogId
return return
posts posts
|> List.map (fun it -> |> 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) /// Get a page of categorized posts for the given web log (excludes revisions)
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
let catSql, catParams = jsonArrayInClause (nameof Post.empty.CategoryIds) CategoryId.toString categoryIds let catSql, catParams = jsonArrayInClause (nameof Post.empty.CategoryIds) CategoryId.toString categoryIds
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $" |> Sql.query $"
{postsByWebLogAndStatus} {postsByCriteria}
AND ({catSql}) AND ({catSql})
ORDER BY published_on DESC ORDER BY published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|> Sql.parameters |> Sql.parameters (
[ webLogIdParam webLogId ("@criteria", Query.jsonbDocParam {| WebLogId = wls webLogId; Status = PostStatus.toString Published |})
"@status", Sql.string (PostStatus.toString Published) :: catParams)
yield! catParams ] |> Sql.executeAsync fromData<Post>
|> Sql.executeAsync toPost
/// Get a page of posts for the given web log (excludes text and revisions) /// Get a page of posts for the given web log (excludes text and revisions)
let findPageOfPosts webLogId pageNbr postsPerPage = let findPageOfPosts webLogId pageNbr postsPerPage =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $" |> Sql.query $"
{docSelectForWebLogSql Table.Post} {postsByCriteria}
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC NULLS FIRST, ORDER BY data->>'{nameof Post.empty.PublishedOn}' DESC NULLS FIRST,
data ->> '{nameof Post.empty.UpdatedOn}' data->>'{nameof Post.empty.UpdatedOn}'
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|> Sql.parameters [ webLogIdParam webLogId ] |> Sql.parameters [ "@criteria", webLogContains webLogId ]
|> Sql.executeAsync postWithoutText |> Sql.executeAsync postWithoutText
/// Get a page of published posts for the given web log (excludes revisions) /// Get a page of published posts for the given web log (excludes revisions)
let findPageOfPublishedPosts webLogId pageNbr postsPerPage = let findPageOfPublishedPosts webLogId pageNbr postsPerPage =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $" |> Sql.query $"
{postsByWebLogAndStatus} {postsByCriteria}
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC ORDER BY data->>'{nameof Post.empty.PublishedOn}' DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|> Sql.parameters [ webLogIdParam webLogId; "@status", Sql.string (PostStatus.toString Published) ] |> Sql.parameters
|> Sql.executeAsync toPost [ "@criteria", Query.jsonbDocParam {| WebLogId = wls webLogId; Status = PostStatus.toString Published |} ]
|> Sql.executeAsync fromData<Post>
/// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks) /// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks)
let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage = let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $" |> Sql.query $"
{postsByWebLogAndStatus} {postsByCriteria}
AND data -> '{nameof Post.empty.Tags}' ? @tag AND data->'{nameof Post.empty.Tags}' ? @tag
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC ORDER BY data->>'{nameof Post.empty.PublishedOn}' DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|> Sql.parameters |> Sql.parameters
[ webLogIdParam webLogId [ "@criteria", Query.jsonbDocParam {| WebLogId = wls webLogId; Status = PostStatus.toString Published |}
"@status", Sql.string (PostStatus.toString Published) "@tag", Sql.jsonb tag
"@tag", Sql.jsonb tag
] ]
|> Sql.executeAsync toPost |> Sql.executeAsync fromData<Post>
/// Find the next newest and oldest post from a publish date for the given web log /// Find the next newest and oldest post from a publish date for the given web log
let findSurroundingPosts webLogId (publishedOn : Instant) = backgroundTask { let findSurroundingPosts webLogId (publishedOn : Instant) = backgroundTask {
let queryParams () = Sql.parameters [ let queryParams () = Sql.parameters [
webLogIdParam webLogId "@criteria", Query.jsonbDocParam {| WebLogId = wls webLogId; Status = PostStatus.toString Published |}
typedParam "publishedOn" publishedOn typedParam "publishedOn" publishedOn
"@status", Sql.string (PostStatus.toString Published)
] ]
let! older = let! older =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $" |> Sql.query $"
{postsByWebLogAndStatus} {postsByCriteria}
AND data ->> '{nameof Post.empty.PublishedOn}' < @publishedOn AND data->>'{nameof Post.empty.PublishedOn}' < @publishedOn
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC ORDER BY data->>'{nameof Post.empty.PublishedOn}' DESC
LIMIT 1" LIMIT 1"
|> queryParams () |> queryParams ()
|> Sql.executeAsync toPost |> Sql.executeAsync fromData<Post>
let! newer = let! newer =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $" |> Sql.query $"
{postsByWebLogAndStatus} {postsByCriteria}
AND data ->> '{nameof Post.empty.PublishedOn}' > @publishedOn AND data->>'{nameof Post.empty.PublishedOn}' > @publishedOn
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' ORDER BY data->>'{nameof Post.empty.PublishedOn}'
LIMIT 1" LIMIT 1"
|> queryParams () |> queryParams ()
|> Sql.executeAsync toPost |> Sql.executeAsync fromData<Post>
return List.tryHead older, List.tryHead newer return List.tryHead older, List.tryHead newer
} }
/// The parameters for saving a post /// The parameters for saving a post
let postParams (post : Post) = [ let postParams (post : Post) =
"@id", Sql.string (PostId.toString post.Id) Query.docParameters (PostId.toString post.Id) post
"@data", Sql.jsonb (Utils.serialize ser post)
]
/// Save a post /// Save a post
let save (post : Post) = backgroundTask { let save (post : Post) = backgroundTask {
let! oldPost = findFullById post.Id post.WebLogId 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 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 restore posts = backgroundTask {
let revisions = posts |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r)) let revisions = posts |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r))
let! _ = let! _ =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
docInsertSql Table.Post, posts |> List.map postParams Query.insertQuery Table.Post, posts |> List.map postParams
Revisions.insertSql Table.PostRevision, Revisions.insertSql Table.PostRevision,
revisions |> List.map (fun (postId, rev) -> Revisions.revParams postId PostId.toString rev) 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 /// Update prior permalinks for a post
let updatePriorPermalinks postId webLogId permalinks = backgroundTask { let updatePriorPermalinks postId webLogId permalinks = backgroundTask {
use! txn = conn.BeginTransactionAsync ()
match! findById postId webLogId with match! findById postId webLogId with
| Some post -> | Some post ->
do! Document.update conn Table.Post postParams { post with PriorPermalinks = permalinks } do! Sql.fromDataSource source
do! txn.CommitAsync () |> Query.update Table.Post (PostId.toString post.Id) { post with PriorPermalinks = permalinks }
return true return true
| None -> return false | None -> return false
} }

55
src/MyWebLog.Data/Postgres/PostgresTagMapData.fs
View File

@ -2,66 +2,71 @@ namespace MyWebLog.Data.Postgres
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json
open Npgsql open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
open Npgsql.FSharp.Documents
/// PostgreSQL myWebLog tag mapping data implementation /// PostgreSQL myWebLog tag mapping data implementation
type PostgresTagMapData (conn : NpgsqlConnection, ser : JsonSerializer) = type PostgresTagMapData (source : NpgsqlDataSource) =
/// Map a data row to a tag mapping /// Shorthand for turning a web log ID into a string
let toTagMap = Map.fromDoc<TagMap> ser 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 /// Find a tag mapping by its ID for the given web log
let findById tagMapId webLogId = let findById tagMapId webLogId =
Document.findByIdAndWebLog conn Table.TagMap tagMapId TagMapId.toString webLogId toTagMap Document.findByIdAndWebLog<TagMapId, TagMap> source Table.TagMap tagMapId TagMapId.toString webLogId
/// Delete a tag mapping for the given web log /// Delete a tag mapping for the given web log
let delete tagMapId webLogId = backgroundTask { let delete tagMapId webLogId = backgroundTask {
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 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 return true
else return false else return false
} }
/// Find a tag mapping by its URL value for the given web log /// Find a tag mapping by its URL value for the given web log
let findByUrlValue urlValue webLogId = let findByUrlValue (urlValue : string) webLogId =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $"{docSelectForWebLogSql Table.TagMap} AND data ->> '{nameof TagMap.empty.UrlValue}' = @urlValue" |> Sql.query tagMapByCriteria
|> Sql.parameters [ webLogIdParam webLogId; "@urlValue", Sql.string urlValue ] |> Sql.parameters [ "@criteria", Query.jsonbDocParam {| WebLogId = wls webLogId; UrlValue = urlValue |} ]
|> Sql.executeAsync toTagMap |> Sql.executeAsync fromData<TagMap>
|> tryHead |> tryHead
/// Get all tag mappings for the given web log /// Get all tag mappings for the given web log
let findByWebLog webLogId = 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<TagMap>
/// Find any tag mappings in a list of tags for the given web log /// Find any tag mappings in a list of tags for the given web log
let findMappingForTags tags webLogId = let findMappingForTags tags webLogId =
let tagSql, tagParams = jsonArrayInClause (nameof TagMap.empty.Tag) id tags let tagSql, tagParams = jsonArrayInClause (nameof TagMap.empty.Tag) id tags
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $"{docSelectForWebLogSql Table.TagMap} AND ({tagSql})" |> Sql.query $"{tagMapByCriteria} AND ({tagSql})"
|> Sql.parameters (webLogIdParam webLogId :: tagParams) |> Sql.parameters (("@criteria", webLogContains webLogId) :: tagParams)
|> Sql.executeAsync toTagMap |> Sql.executeAsync fromData<TagMap>
/// The parameters for saving a tag mapping /// The parameters for saving a tag mapping
let tagMapParams (tagMap : TagMap) = [ let tagMapParams (tagMap : TagMap) =
"@id", Sql.string (TagMapId.toString tagMap.Id) Query.docParameters (TagMapId.toString tagMap.Id) tagMap
"@data", Sql.jsonb (Utils.serialize ser tagMap)
]
/// Save a tag mapping /// Save a tag mapping
let save tagMap = backgroundTask { let save (tagMap : TagMap) = backgroundTask {
do! Document.upsert conn Table.TagMap tagMapParams tagMap do! Sql.fromDataSource source |> Query.save Table.TagMap (TagMapId.toString tagMap.Id) tagMap
} }
/// Restore tag mappings from a backup /// Restore tag mappings from a backup
let restore tagMaps = backgroundTask { let restore tagMaps = backgroundTask {
let! _ = let! _ =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
docInsertSql Table.TagMap, tagMaps |> List.map tagMapParams Query.insertQuery Table.TagMap, tagMaps |> List.map tagMapParams
] ]
() ()
} }

51
src/MyWebLog.Data/Postgres/PostgresThemeData.fs
View File

@ -5,55 +5,52 @@ open MyWebLog.Data
open Newtonsoft.Json open Newtonsoft.Json
open Npgsql open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
open Npgsql.FSharp.Documents
/// PostreSQL myWebLog theme data implementation /// PostreSQL myWebLog theme data implementation
type PostgresThemeData (conn : NpgsqlConnection, ser : JsonSerializer) = type PostgresThemeData (source : NpgsqlDataSource) =
/// Map a data row to a theme
let toTheme = Map.fromDoc<Theme> ser
/// Clear out the template text from a theme /// Clear out the template text from a theme
let withoutTemplateText row = let withoutTemplateText row =
let theme = toTheme row let theme = fromData<Theme> row
{ theme with Templates = theme.Templates |> List.map (fun template -> { template with Text = "" }) } { theme with Templates = theme.Templates |> List.map (fun template -> { template with Text = "" }) }
/// Retrieve all themes (except 'admin'; excludes template text) /// Retrieve all themes (except 'admin'; excludes template text)
let all () = let all () =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $"SELECT * FROM {Table.Theme} WHERE id <> 'admin' ORDER BY id" |> Sql.query $"{Query.selectFromTable Table.Theme} WHERE id <> 'admin' ORDER BY id"
|> Sql.executeAsync withoutTemplateText |> Sql.executeAsync withoutTemplateText
/// Does a given theme exist? /// Does a given theme exist?
let exists themeId = 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 /// Find a theme by its ID
let findById themeId = let findById themeId =
Document.findById conn Table.Theme themeId ThemeId.toString toTheme Sql.fromDataSource source
|> Query.tryById<Theme> Table.Theme (ThemeId.toString themeId)
/// Find a theme by its ID (excludes the text of templates) /// Find a theme by its ID (excludes the text of templates)
let findByIdWithoutText themeId = 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 /// Delete a theme by its ID
let delete themeId = backgroundTask { let delete themeId = backgroundTask {
match! exists themeId with match! exists themeId with
| true -> | true ->
do! Document.delete conn Table.Theme (ThemeId.toString themeId) do! Sql.fromDataSource source |> Query.deleteById Table.Theme (ThemeId.toString themeId)
return true return true
| false -> return false | 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 /// Save a theme
let save (theme : Theme) = backgroundTask { let save (theme : Theme) =
do! Document.upsert conn Table.Theme themeParams theme Sql.fromDataSource source |> Query.save Table.Theme (ThemeId.toString theme.Id) theme
}
interface IThemeData with interface IThemeData with
member _.All () = all () member _.All () = all ()
@ -65,18 +62,18 @@ type PostgresThemeData (conn : NpgsqlConnection, ser : JsonSerializer) =
/// PostreSQL myWebLog theme data implementation /// PostreSQL myWebLog theme data implementation
type PostgresThemeAssetData (conn : NpgsqlConnection) = type PostgresThemeAssetData (source : NpgsqlDataSource) =
/// Get all theme assets (excludes data) /// Get all theme assets (excludes data)
let all () = let all () =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset}" |> Sql.query $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset}"
|> Sql.executeAsync (Map.toThemeAsset false) |> Sql.executeAsync (Map.toThemeAsset false)
/// Delete all assets for the given theme /// Delete all assets for the given theme
let deleteByTheme themeId = backgroundTask { let deleteByTheme themeId = backgroundTask {
let! _ = let! _ =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @themeId" |> Sql.query $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
|> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ] |> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ]
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
@ -86,7 +83,7 @@ type PostgresThemeAssetData (conn : NpgsqlConnection) =
/// Find a theme asset by its ID /// Find a theme asset by its ID
let findById assetId = let findById assetId =
let (ThemeAssetId (ThemeId themeId, path)) = 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.query $"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @themeId AND path = @path"
|> Sql.parameters [ "@themeId", Sql.string themeId; "@path", Sql.string path ] |> Sql.parameters [ "@themeId", Sql.string themeId; "@path", Sql.string path ]
|> Sql.executeAsync (Map.toThemeAsset true) |> Sql.executeAsync (Map.toThemeAsset true)
@ -94,14 +91,14 @@ type PostgresThemeAssetData (conn : NpgsqlConnection) =
/// Get theme assets for the given theme (excludes data) /// Get theme assets for the given theme (excludes data)
let findByTheme themeId = 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.query $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
|> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ] |> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ]
|> Sql.executeAsync (Map.toThemeAsset false) |> Sql.executeAsync (Map.toThemeAsset false)
/// Get theme assets for the given theme /// Get theme assets for the given theme
let findByThemeWithData themeId = let findByThemeWithData themeId =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @themeId" |> Sql.query $"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
|> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ] |> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ]
|> Sql.executeAsync (Map.toThemeAsset true) |> Sql.executeAsync (Map.toThemeAsset true)
@ -110,7 +107,7 @@ type PostgresThemeAssetData (conn : NpgsqlConnection) =
let save (asset : ThemeAsset) = backgroundTask { let save (asset : ThemeAsset) = backgroundTask {
let (ThemeAssetId (ThemeId themeId, path)) = asset.Id let (ThemeAssetId (ThemeId themeId, path)) = asset.Id
let! _ = let! _ =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $" |> Sql.query $"
INSERT INTO {Table.ThemeAsset} ( INSERT INTO {Table.ThemeAsset} (
theme_id, path, updated_on, data theme_id, path, updated_on, data

18
src/MyWebLog.Data/Postgres/PostgresUploadData.fs
View File

@ -6,7 +6,7 @@ open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
/// PostgreSQL myWebLog uploaded file data implementation /// PostgreSQL myWebLog uploaded file data implementation
type PostgresUploadData (conn : NpgsqlConnection) = type PostgresUploadData (source : NpgsqlDataSource) =
/// The INSERT statement for an uploaded file /// The INSERT statement for an uploaded file
let upInsert = $" let upInsert = $"
@ -28,7 +28,7 @@ type PostgresUploadData (conn : NpgsqlConnection) =
/// Save an uploaded file /// Save an uploaded file
let add upload = backgroundTask { let add upload = backgroundTask {
let! _ = let! _ =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query upInsert |> Sql.query upInsert
|> Sql.parameters (upParams upload) |> Sql.parameters (upParams upload)
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
@ -39,15 +39,15 @@ type PostgresUploadData (conn : NpgsqlConnection) =
let delete uploadId webLogId = backgroundTask { let delete uploadId webLogId = backgroundTask {
let idParam = [ "@id", Sql.string (UploadId.toString uploadId) ] let idParam = [ "@id", Sql.string (UploadId.toString uploadId) ]
let! path = let! path =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $"SELECT path FROM {Table.Upload} WHERE id = @id AND web_log_id = @webLogId" |> Sql.query $"SELECT path FROM {Table.Upload} WHERE id = @id AND web_log_id = @webLogId"
|> Sql.parameters (webLogIdParam webLogId :: idParam) |> Sql.parameters (webLogIdParam webLogId :: idParam)
|> Sql.executeAsync (fun row -> row.string "path") |> Sql.executeAsync (fun row -> row.string "path")
|> tryHead |> tryHead
if Option.isSome path then if Option.isSome path then
let! _ = let! _ =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query (docDeleteSql Table.Upload) |> Sql.query $"DELETE FROM {Table.Upload} WHERE id = @id"
|> Sql.parameters idParam |> Sql.parameters idParam
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
return Ok path.Value return Ok path.Value
@ -56,7 +56,7 @@ type PostgresUploadData (conn : NpgsqlConnection) =
/// Find an uploaded file by its path for the given web log /// Find an uploaded file by its path for the given web log
let findByPath path webLogId = 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.query $"SELECT * FROM {Table.Upload} WHERE web_log_id = @webLogId AND path = @path"
|> Sql.parameters [ webLogIdParam webLogId; "@path", Sql.string path ] |> Sql.parameters [ webLogIdParam webLogId; "@path", Sql.string path ]
|> Sql.executeAsync (Map.toUpload true) |> Sql.executeAsync (Map.toUpload true)
@ -64,14 +64,14 @@ type PostgresUploadData (conn : NpgsqlConnection) =
/// Find all uploaded files for the given web log (excludes data) /// Find all uploaded files for the given web log (excludes data)
let findByWebLog webLogId = 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.query $"SELECT id, web_log_id, path, updated_on FROM {Table.Upload} WHERE web_log_id = @webLogId"
|> Sql.parameters [ webLogIdParam webLogId ] |> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync (Map.toUpload false) |> Sql.executeAsync (Map.toUpload false)
/// Find all uploaded files for the given web log /// Find all uploaded files for the given web log
let findByWebLogWithData webLogId = let findByWebLogWithData webLogId =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $"SELECT * FROM {Table.Upload} WHERE web_log_id = @webLogId" |> Sql.query $"SELECT * FROM {Table.Upload} WHERE web_log_id = @webLogId"
|> Sql.parameters [ webLogIdParam webLogId ] |> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync (Map.toUpload true) |> Sql.executeAsync (Map.toUpload true)
@ -80,7 +80,7 @@ type PostgresUploadData (conn : NpgsqlConnection) =
let restore uploads = backgroundTask { let restore uploads = backgroundTask {
for batch in uploads |> List.chunkBySize 5 do for batch in uploads |> List.chunkBySize 5 do
let! _ = let! _ =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
upInsert, batch |> List.map upParams upInsert, batch |> List.map upParams
] ]

67
src/MyWebLog.Data/Postgres/PostgresWebLogData.fs
View File

@ -2,80 +2,65 @@
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json
open Npgsql open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
open Npgsql.FSharp.Documents
/// PostgreSQL myWebLog web log data implementation /// PostgreSQL myWebLog web log data implementation
type PostgresWebLogData (conn : NpgsqlConnection, ser : JsonSerializer) = type PostgresWebLogData (source : NpgsqlDataSource) =
// SUPPORT FUNCTIONS
/// Map a data row to a web log
let toWebLog = Map.fromDoc<WebLog> 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
/// Add a web log /// Add a web log
let add webLog = backgroundTask { let add (webLog : WebLog) =
do! Document.insert conn Table.WebLog webLogParams webLog Sql.fromDataSource source |> Query.insert Table.WebLog (WebLogId.toString webLog.Id) webLog
}
/// Retrieve all web logs /// Retrieve all web logs
let all () = let all () =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $"SELECT * FROM {Table.WebLog}" |> Query.all<WebLog> Table.WebLog
|> Sql.executeAsync toWebLog
/// Delete a web log by its ID /// Delete a web log by its ID
let delete webLogId = backgroundTask { let delete webLogId = backgroundTask {
let criteria = Query.whereDataContains "@criteria"
let! _ = let! _ =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $" |> Sql.query $"
DELETE FROM {Table.PostComment} DELETE FROM {Table.PostComment}
WHERE data ->> '{nameof Comment.empty.PostId}' IN (SELECT id FROM {Table.Post} WHERE {webLogWhere}); WHERE data->>'{nameof Comment.empty.PostId}' IN (SELECT id FROM {Table.Post} WHERE {criteria});
DELETE FROM {Table.Post} WHERE {webLogWhere}; DELETE FROM {Table.Post} WHERE {criteria};
DELETE FROM {Table.Page} WHERE {webLogWhere}; DELETE FROM {Table.Page} WHERE {criteria};
DELETE FROM {Table.Category} WHERE {webLogWhere}; DELETE FROM {Table.Category} WHERE {criteria};
DELETE FROM {Table.TagMap} WHERE {webLogWhere}; DELETE FROM {Table.TagMap} WHERE {criteria};
DELETE FROM {Table.Upload} WHERE web_log_id = @webLogId; 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" DELETE FROM {Table.WebLog} WHERE id = @webLogId"
|> Sql.parameters [ webLogIdParam webLogId ] |> Sql.parameters [ webLogIdParam webLogId; "@criteria", webLogContains webLogId ]
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
() ()
} }
/// Find a web log by its host (URL base) /// Find a web log by its host (URL base)
let findByHost url = let findByHost (url : string) =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $"SELECT * FROM {Table.WebLog} WHERE data ->> '{nameof WebLog.empty.UrlBase}' = @urlBase" |> Sql.query $"""{Query.selectFromTable Table.WebLog} WHERE {Query.whereDataContains "@criteria"}"""
|> Sql.parameters [ "@urlBase", Sql.string url ] |> Sql.parameters [ "@criteria", Query.jsonbDocParam {| UrlBase = url |} ]
|> Sql.executeAsync toWebLog |> Sql.executeAsync fromData<WebLog>
|> tryHead |> tryHead
/// Find a web log by its ID /// Find a web log by its ID
let findById webLogId = let findById webLogId =
Document.findById conn Table.WebLog webLogId WebLogId.toString toWebLog Sql.fromDataSource source
|> Query.tryById<WebLog> Table.WebLog (WebLogId.toString webLogId)
/// Update settings for a web log /// Update settings for a web log
let updateSettings webLog = backgroundTask { let updateSettings (webLog : WebLog) =
do! Document.update conn Table.WebLog webLogParams webLog Sql.fromDataSource source |> Query.update Table.WebLog (WebLogId.toString webLog.Id) webLog
}
/// Update RSS options for a web log /// Update RSS options for a web log
let updateRssOptions (webLog : WebLog) = backgroundTask { let updateRssOptions (webLog : WebLog) = backgroundTask {
use! txn = conn.BeginTransactionAsync ()
match! findById webLog.Id with match! findById webLog.Id with
| Some blog -> | Some blog ->
do! Document.update conn Table.WebLog webLogParams { blog with Rss = webLog.Rss } do! Sql.fromDataSource source
do! txn.CommitAsync () |> Query.update Table.WebLog (WebLogId.toString webLog.Id) { blog with Rss = webLog.Rss }
| None -> () | None -> ()
} }

72
src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs
View File

@ -2,67 +2,74 @@ namespace MyWebLog.Data.Postgres
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json
open Npgsql open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
open Npgsql.FSharp.Documents
/// PostgreSQL myWebLog user data implementation /// PostgreSQL myWebLog user data implementation
type PostgresWebLogUserData (conn : NpgsqlConnection, ser : JsonSerializer) = type PostgresWebLogUserData (source : NpgsqlDataSource) =
/// Map a data row to a user /// Shorthand for making a web log ID into a string
let toWebLogUser = Map.fromDoc<WebLogUser> ser 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 /// Parameters for saving web log users
let userParams (user : WebLogUser) = [ let userParams (user : WebLogUser) =
"@id", Sql.string (WebLogUserId.toString user.Id) Query.docParameters (WebLogUserId.toString user.Id) user
"@data", Sql.jsonb (Utils.serialize ser user)
]
/// Find a user by their ID for the given web log /// Find a user by their ID for the given web log
let findById userId webLogId = let findById userId webLogId =
Document.findByIdAndWebLog conn Table.WebLogUser userId WebLogUserId.toString webLogId toWebLogUser Document.findByIdAndWebLog<WebLogUserId, WebLogUser>
source Table.WebLogUser userId WebLogUserId.toString webLogId
/// Delete a user if they have no posts or pages /// Delete a user if they have no posts or pages
let delete userId webLogId = backgroundTask { let delete userId webLogId = backgroundTask {
match! findById userId webLogId with match! findById userId webLogId with
| Some _ -> | Some _ ->
let criteria = Query.whereDataContains "@criteria"
let usrId = WebLogUserId.toString userId
let! isAuthor = let! isAuthor =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $" |> Sql.query $"
SELECT ( EXISTS (SELECT 1 FROM {Table.Page} WHERE data ->> '{nameof Page.empty.AuthorId}' = @id SELECT ( EXISTS (SELECT 1 FROM {Table.Page} WHERE {criteria}
OR EXISTS (SELECT 1 FROM {Table.Post} WHERE data ->> '{nameof Post.empty.AuthorId}' = @id)) OR EXISTS (SELECT 1 FROM {Table.Post} WHERE {criteria}))
AS {existsName}" AS {existsName}"
|> Sql.parameters [ "@id", Sql.string (WebLogUserId.toString userId) ] |> Sql.parameters [ "@criteria", Query.jsonbDocParam {| AuthorId = usrId |} ]
|> Sql.executeRowAsync Map.toExists |> Sql.executeRowAsync Map.toExists
if isAuthor then if isAuthor then
return Error "User has pages or posts; cannot delete" return Error "User has pages or posts; cannot delete"
else else
do! Document.delete conn Table.WebLogUser (WebLogUserId.toString userId) do! Sql.fromDataSource source |> Query.deleteById Table.WebLogUser usrId
return Ok true return Ok true
| None -> return Error "User does not exist" | None -> return Error "User does not exist"
} }
/// Find a user by their e-mail address for the given web log /// Find a user by their e-mail address for the given web log
let findByEmail email webLogId = let findByEmail (email : string) webLogId =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $"{docSelectForWebLogSql Table.WebLogUser} AND data ->> '{nameof WebLogUser.empty.Email}' = @email" |> Sql.query userByCriteria
|> Sql.parameters [ webLogIdParam webLogId; "@email", Sql.string email ] |> Sql.parameters [ "@criteria", Query.jsonbDocParam {| WebLogId = wls webLogId; Email = email |} ]
|> Sql.executeAsync toWebLogUser |> Sql.executeAsync fromData<WebLogUser>
|> tryHead |> tryHead
/// Get all users for the given web log /// Get all users for the given web log
let findByWebLog webLogId = let findByWebLog webLogId =
Document.findByWebLog conn Table.WebLogUser webLogId toWebLogUser Sql.fromDataSource source
(Some $"ORDER BY LOWER(data ->> '{nameof WebLogUser.empty.PreferredName}')") |> Sql.query $"{userByCriteria} ORDER BY LOWER(data->>'{nameof WebLogUser.empty.PreferredName}')"
|> Sql.parameters [ "@criteria", webLogContains webLogId ]
|> Sql.executeAsync fromData<WebLogUser>
/// Find the names of users by their IDs for the given web log /// Find the names of users by their IDs for the given web log
let findNames webLogId userIds = backgroundTask { let findNames webLogId userIds = backgroundTask {
let idSql, idParams = inClause "AND id" "id" WebLogUserId.toString userIds let idSql, idParams = inClause "AND id" "id" WebLogUserId.toString userIds
let! users = let! users =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $"{docSelectForWebLogSql Table.WebLogUser} {idSql}" |> Sql.query $"{userByCriteria} {idSql}"
|> Sql.parameters (webLogIdParam webLogId :: idParams) |> Sql.parameters (("@criteria", webLogContains webLogId) :: idParams)
|> Sql.executeAsync toWebLogUser |> Sql.executeAsync fromData<WebLogUser>
return return
users users
|> List.map (fun u -> { Name = WebLogUserId.toString u.Id; Value = WebLogUser.displayName u }) |> 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 /// Restore users from a backup
let restore users = backgroundTask { let restore users = backgroundTask {
let! _ = let! _ =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.executeTransactionAsync [ |> 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 /// Set a user's last seen date/time to now
let setLastSeen userId webLogId = backgroundTask { let setLastSeen userId webLogId = backgroundTask {
use! txn = conn.BeginTransactionAsync ()
match! findById userId webLogId with match! findById userId webLogId with
| Some user -> | Some user ->
do! Document.update conn Table.WebLogUser userParams { user with LastSeenOn = Some (Noda.now ()) } do! Sql.fromDataSource source
do! txn.CommitAsync () |> Query.update Table.WebLogUser (WebLogUserId.toString userId)
{ user with LastSeenOn = Some (Noda.now ()) }
| None -> () | None -> ()
} }
/// Save a user /// Save a user
let save user = backgroundTask { let save (user : WebLogUser) =
do! Document.upsert conn Table.WebLogUser userParams user Sql.fromDataSource source |> Query.save Table.WebLogUser (WebLogUserId.toString user.Id) user
}
interface IWebLogUserData with interface IWebLogUserData with
member _.Add user = save user member _.Add user = save user

65
src/MyWebLog.Data/PostgresData.fs
View File

@ -6,28 +6,34 @@ open MyWebLog.Data.Postgres
open Newtonsoft.Json open Newtonsoft.Json
open Npgsql open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
open Npgsql.FSharp.Documents
/// Data implementation for PostgreSQL /// Data implementation for PostgreSQL
type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>, ser : JsonSerializer) = type PostgresData (source : NpgsqlDataSource, log : ILogger<PostgresData>, ser : JsonSerializer) =
/// Create any needed tables /// Create any needed tables
let ensureTables () = backgroundTask { 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 = let! tables =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query "SELECT tablename FROM pg_tables WHERE schemaname = 'public'" |> Sql.query "SELECT tablename FROM pg_tables WHERE schemaname = 'public'"
|> Sql.executeAsync (fun row -> row.string "tablename") |> Sql.executeAsync (fun row -> row.string "tablename")
let needsTable table = not (List.contains table tables) let needsTable table = not (List.contains table tables)
// Create a document table // 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 mutable isNew = false
let sql = seq { let sql = seq {
// Theme tables // Theme tables
if needsTable Table.Theme then if needsTable Table.Theme then
isNew <- true isNew <- true
docTable Table.Theme Definition.createTable Table.Theme
if needsTable Table.ThemeAsset then if needsTable Table.ThemeAsset then
$"CREATE TABLE {Table.ThemeAsset} ( $"CREATE TABLE {Table.ThemeAsset} (
theme_id TEXT NOT NULL REFERENCES {Table.Theme} (id) ON DELETE CASCADE, theme_id TEXT NOT NULL REFERENCES {Table.Theme} (id) ON DELETE CASCADE,
@ -38,25 +44,22 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>, ser : J
// Web log table // Web log table
if needsTable Table.WebLog then if needsTable Table.WebLog then
docTable Table.WebLog Definition.createTable Table.WebLog
$"CREATE INDEX web_log_theme_idx ON {Table.WebLog} (data ->> '{nameof WebLog.empty.ThemeId}')" Definition.createIndex Table.WebLog Optimized
// Category table // Category table
if needsTable Table.Category then if needsTable Table.Category then
docTable Table.Category Definition.createTable Table.Category
$"CREATE INDEX category_web_log_idx ON {Table.Category} (data ->> '{nameof Category.empty.WebLogId}')" Definition.createIndex Table.Category Optimized
// Web log user table // Web log user table
if needsTable Table.WebLogUser then if needsTable Table.WebLogUser then
docTable Table.WebLogUser Definition.createTable Table.WebLogUser
$"CREATE INDEX web_log_user_web_log_idx ON {Table.WebLogUser} Definition.createIndex Table.WebLogUser Optimized
(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}')"
// Page tables // Page tables
if needsTable Table.Page then 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_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_author_idx ON {Table.Page} (data ->> '{nameof Page.empty.AuthorId}')"
$"CREATE INDEX page_permalink_idx ON {Table.Page} $"CREATE INDEX page_permalink_idx ON {Table.Page}
@ -70,7 +73,7 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>, ser : J
// Post tables // Post tables
if needsTable Table.Post then 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_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_author_idx ON {Table.Post} (data ->> '{nameof Post.empty.AuthorId}')"
$"CREATE INDEX post_status_idx ON {Table.Post} $"CREATE INDEX post_status_idx ON {Table.Post}
@ -88,13 +91,13 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>, ser : J
revision_text TEXT NOT NULL, revision_text TEXT NOT NULL,
PRIMARY KEY (post_id, as_of))" PRIMARY KEY (post_id, as_of))"
if needsTable Table.PostComment then 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}')" $"CREATE INDEX post_comment_post_idx ON {Table.PostComment} (data ->> '{nameof Comment.empty.PostId}')"
// Tag map table // Tag map table
if needsTable Table.TagMap then if needsTable Table.TagMap then
docTable Table.TagMap Definition.createTable Table.TagMap
$"CREATE INDEX tag_map_web_log_idx ON {Table.TagMap} (data ->> '{nameof TagMap.empty.WebLogId}')" Definition.createIndex Table.TagMap Optimized
// Uploaded file table // Uploaded file table
if needsTable Table.Upload then if needsTable Table.Upload then
@ -113,7 +116,7 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>, ser : J
$"INSERT INTO {Table.DbVersion} VALUES ('{Utils.currentDbVersion}')" $"INSERT INTO {Table.DbVersion} VALUES ('{Utils.currentDbVersion}')"
} }
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.executeTransactionAsync |> Sql.executeTransactionAsync
(sql (sql
|> Seq.map (fun s -> |> Seq.map (fun s ->
@ -130,7 +133,7 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>, ser : J
/// Set a specific database version /// Set a specific database version
let setDbVersion version = backgroundTask { let setDbVersion version = backgroundTask {
let! _ = let! _ =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query $"DELETE FROM db_version; INSERT INTO db_version VALUES ('%s{version}')" |> Sql.query $"DELETE FROM db_version; INSERT INTO db_version VALUES ('%s{version}')"
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
() ()
@ -149,15 +152,15 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>, ser : J
interface IData with interface IData with
member _.Category = PostgresCategoryData (conn, ser) member _.Category = PostgresCategoryData source
member _.Page = PostgresPageData (conn, ser) member _.Page = PostgresPageData source
member _.Post = PostgresPostData (conn, ser) member _.Post = PostgresPostData source
member _.TagMap = PostgresTagMapData (conn, ser) member _.TagMap = PostgresTagMapData source
member _.Theme = PostgresThemeData (conn, ser) member _.Theme = PostgresThemeData source
member _.ThemeAsset = PostgresThemeAssetData conn member _.ThemeAsset = PostgresThemeAssetData source
member _.Upload = PostgresUploadData conn member _.Upload = PostgresUploadData source
member _.WebLog = PostgresWebLogData (conn, ser) member _.WebLog = PostgresWebLogData source
member _.WebLogUser = PostgresWebLogUserData (conn, ser) member _.WebLogUser = PostgresWebLogUserData source
member _.Serializer = ser member _.Serializer = ser
@ -165,7 +168,7 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>, ser : J
do! ensureTables () do! ensureTables ()
let! version = let! version =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query "SELECT id FROM db_version" |> Sql.query "SELECT id FROM db_version"
|> Sql.executeAsync (fun row -> row.string "id") |> Sql.executeAsync (fun row -> row.string "id")
|> tryHead |> tryHead

7
src/MyWebLog/Program.fs
View File

@ -64,9 +64,12 @@ module DataImplementation =
elif hasConnStr "PostgreSQL" then elif hasConnStr "PostgreSQL" then
let log = sp.GetRequiredService<ILogger<PostgresData>> () let log = sp.GetRequiredService<ILogger<PostgresData>> ()
// NpgsqlLogManager.Provider <- ConsoleLoggingProvider NpgsqlLogLevel.Debug // 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}" 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 else
createSQLite "Data Source=./myweblog.db;Cache=Shared" createSQLite "Data Source=./myweblog.db;Cache=Shared"

238
src/Npgsql.FSharp.Documents/Library.fs
View File

@ -1,10 +1,242 @@
module Npgsql.FSharp.Documents 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
[<RequireQualifiedAccess>]
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 /// Query construction functions
[<RequireQualifiedAccess>]
module Query = module Query =
/// Create a parameter for a @> (contains) query open System.Threading.Tasks
let contains<'T> (name : string) (value : 'T) =
name, Sql.jsonb (string value) // FIXME: need a serializer
// ~~ 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<int> =
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<int> =
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<bool> =
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<bool> =
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<bool> =
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
()
}

1
src/Npgsql.FSharp.Documents/Npgsql.FSharp.Documents.fsproj
View File

@ -5,6 +5,7 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="FSharp.SystemTextJson" Version="1.1.23" />
<PackageReference Include="Npgsql.FSharp" Version="5.6.0" /> <PackageReference Include="Npgsql.FSharp" Version="5.6.0" />
</ItemGroup> </ItemGroup>