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="NodaTime" Version="3.1.2" />
<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="RethinkDb.Driver" Version="2.3.150" />
<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.Data
open Newtonsoft.Json
open Npgsql
open Npgsql.FSharp
open Npgsql.FSharp.Documents
/// PostgreSQL myWebLog category data implementation
type PostgresCategoryData (conn : NpgsqlConnection, ser : JsonSerializer) =
type PostgresCategoryData (source : NpgsqlDataSource) =
/// Convert a data row to a category
let toCategory = Map.fromDoc<Category> ser
/// 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<Category>
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<CategoryId, Category> 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<Category> 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<Post> ser)
|> Sql.executeAsync fromData<Post>
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
]
()
}

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

@ -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
()
}
/// 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
()
}
let findByWebLog<'TDoc> source table webLogId : Task<'TDoc list> =
Sql.fromDataSource source
|> Query.findByContains table {| WebLogId = WebLogId.toString webLogId |}
/// 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",

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

@ -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<Page> ser
/// Return a page with no text or revisions
let pageWithoutText row =
{ toPage row with Text = "" }
{ fromData<Page> 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<Page>
/// 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<PageId, Page> 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<Page> 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<Page> 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<Page>
/// 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
}

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

@ -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<Post> ser
/// Return a post with no revisions, prior permalinks, or text
let postWithoutText row =
{ toPost row with Text = "" }
{ fromData<Post> 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<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)
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<Post>
|> 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<Post> 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<Post>
/// 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<Post>
/// 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<Post>
/// 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<Post>
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<Post>
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
}

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

@ -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<TagMap> 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<TagMapId, TagMap> 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<TagMap>
|> 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<TagMap>
/// 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<TagMap>
/// 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
]
()
}

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

@ -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<Theme> ser
type PostgresThemeData (source : NpgsqlDataSource) =
/// Clear out the template text from a theme
let withoutTemplateText row =
let theme = toTheme row
let theme = fromData<Theme> 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<Theme> 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

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

@ -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
]

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

@ -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<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
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<WebLog> 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<WebLog>
|> 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<WebLog> 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 -> ()
}

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

@ -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<WebLogUser> 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<WebLogUserId, WebLogUser>
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<WebLogUser>
|> 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<WebLogUser>
/// 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<WebLogUser>
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

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

@ -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<PostgresData>, ser : JsonSerializer) =
type PostgresData (source : NpgsqlDataSource, log : ILogger<PostgresData>, 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<PostgresData>, 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<PostgresData>, 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<PostgresData>, 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<PostgresData>, 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<PostgresData>, 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<PostgresData>, 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<PostgresData>, 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

7
src/MyWebLog/Program.fs
View File

@ -64,9 +64,12 @@ module DataImplementation =
elif hasConnStr "PostgreSQL" then
let log = sp.GetRequiredService<ILogger<PostgresData>> ()
// 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"

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

@ -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
[<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
[<RequireQualifiedAccess>]
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<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>
<PackageReference Include="FSharp.SystemTextJson" Version="1.1.23" />
<PackageReference Include="Npgsql.FSharp" Version="5.6.0" />
</ItemGroup>