bit-badger/myWebLog
1
0
Fork 0
Code Issues 2 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 +220 -596
14 changed files with 220 additions and 596 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files
Showing only changes of commit 3399a19ac8 - Show all commits

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

@ -2,10 +2,10 @@
<ItemGroup> <ItemGroup>
<ProjectReference Include="..\MyWebLog.Domain\MyWebLog.Domain.fsproj" /> <ProjectReference Include="..\MyWebLog.Domain\MyWebLog.Domain.fsproj" />
<ProjectReference Include="..\..\..\Npgsql.Documents\src\Npgsql.FSharp.Documents\Npgsql.FSharp.Documents.fsproj" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="BitBadger.Npgsql.FSharp.Documents" Version="1.0.0-beta" />
<PackageReference Include="Microsoft.Data.Sqlite" Version="6.0.8" /> <PackageReference Include="Microsoft.Data.Sqlite" Version="6.0.8" />
<PackageReference Include="Microsoft.Extensions.Caching.Abstractions" Version="6.0.0" /> <PackageReference Include="Microsoft.Extensions.Caching.Abstractions" Version="6.0.0" />
<PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="6.0.0" /> <PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="6.0.0" />

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

@ -1,14 +1,13 @@
namespace MyWebLog.Data.Postgres namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
open Npgsql.FSharp.Documents
/// PostgreSQL myWebLog category data implementation /// PostgreSQL myWebLog category data implementation
type PostgresCategoryData (source : NpgsqlDataSource, log : ILogger) = type PostgresCategoryData (log : ILogger) =
/// Count all categories for the given web log /// Count all categories for the given web log
let countAll webLogId = let countAll webLogId =
@ -24,10 +23,8 @@ type PostgresCategoryData (source : NpgsqlDataSource, log : ILogger) =
let findAllForView webLogId = backgroundTask { let findAllForView webLogId = backgroundTask {
log.LogTrace "Category.findAllForView" log.LogTrace "Category.findAllForView"
let! cats = let! cats =
Sql.fromDataSource source Custom.list $"{selectWithCriteria Table.Category} ORDER BY LOWER(data ->> '{nameof Category.empty.Name}')"
|> Sql.query $"{selectWithCriteria Table.Category} ORDER BY LOWER(data ->> '{nameof Category.empty.Name}')" [ webLogContains webLogId ] fromData<Category>
|> Sql.parameters [ 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
@ -41,7 +38,8 @@ type PostgresCategoryData (source : NpgsqlDataSource, log : ILogger) =
|> List.ofSeq |> List.ofSeq
|> arrayContains (nameof Post.empty.CategoryIds) id |> arrayContains (nameof Post.empty.CategoryIds) id
let postCount = let postCount =
Sql.fromDataSource source Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.query $""" |> Sql.query $"""
SELECT COUNT(DISTINCT id) AS {countName} SELECT COUNT(DISTINCT id) AS {countName}
FROM {Table.Post} FROM {Table.Post}
@ -71,7 +69,7 @@ type PostgresCategoryData (source : NpgsqlDataSource, log : ILogger) =
/// 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 =
log.LogTrace "Category.findById" log.LogTrace "Category.findById"
Document.findByIdAndWebLog<CategoryId, Category> source Table.Category catId CategoryId.toString webLogId Document.findByIdAndWebLog<CategoryId, Category> 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 =
@ -92,7 +90,8 @@ type PostgresCategoryData (source : NpgsqlDataSource, log : ILogger) =
let hasChildren = not (List.isEmpty children) let hasChildren = not (List.isEmpty children)
if hasChildren then if hasChildren then
let! _ = let! _ =
Sql.fromDataSource source Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
Query.Update.partialById Table.Category, Query.Update.partialById Table.Category,
children |> List.map (fun child -> [ children |> List.map (fun child -> [
@ -103,13 +102,12 @@ type PostgresCategoryData (source : NpgsqlDataSource, log : ILogger) =
() ()
// 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.fromDataSource source Custom.list $"SELECT data FROM {Table.Post} WHERE data -> '{nameof Post.empty.CategoryIds}' @> @id"
|> Sql.query $"SELECT data FROM {Table.Post} WHERE data -> '{nameof Post.empty.CategoryIds}' @> @id" [ "@id", Query.jsonbDocParam [| CategoryId.toString catId |] ] fromData<Post>
|> Sql.parameters [ "@id", Query.jsonbDocParam [| CategoryId.toString catId |] ]
|> Sql.executeAsync fromData<Post>
if not (List.isEmpty posts) then if not (List.isEmpty posts) then
let! _ = let! _ =
Sql.fromDataSource source Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
Query.Update.partialById Table.Post, Query.Update.partialById Table.Post,
posts |> List.map (fun post -> [ posts |> List.map (fun post -> [
@ -135,7 +133,8 @@ type PostgresCategoryData (source : NpgsqlDataSource, log : ILogger) =
let restore cats = backgroundTask { let restore cats = backgroundTask {
log.LogTrace "Category.restore" log.LogTrace "Category.restore"
let! _ = let! _ =
Sql.fromDataSource source Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
Query.insert Table.Category, cats |> List.map catParameters Query.insert Table.Category, cats |> List.map catParameters
] ]

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

@ -61,20 +61,20 @@ module Table =
open System open System
open System.Threading.Tasks open System.Threading.Tasks
open BitBadger.Npgsql.FSharp.Documents
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open NodaTime open NodaTime
open Npgsql open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
open Npgsql.FSharp.Documents
/// Create a SQL parameter for the web log ID /// Create a SQL parameter for the web log ID
let webLogIdParam webLogId = let webLogIdParam webLogId =
"@webLogId", Sql.string (WebLogId.toString webLogId) "@webLogId", Sql.string (WebLogId.toString webLogId)
/// Create an anonymous record with the given web log ID /// Create an anonymous record with the given web log ID
let webLogDoc webLogId = let webLogDoc (webLogId : WebLogId) =
{| WebLogId = WebLogId.toString webLogId |} {| WebLogId = webLogId |}
/// Create a parameter for a web log document-contains query /// Create a parameter for a web log document-contains query
let webLogContains webLogId = let webLogContains webLogId =
@ -167,8 +167,9 @@ module Map =
module Document = module Document =
/// 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> source table (key : 'TKey) (keyFunc : 'TKey -> string) webLogId = let existsByWebLog<'TKey> table (key : 'TKey) (keyFunc : 'TKey -> string) webLogId =
Sql.fromDataSource source Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.query $""" |> Sql.query $"""
SELECT EXISTS ( SELECT EXISTS (
SELECT 1 FROM %s{table} WHERE id = @id AND {Query.whereDataContains "@criteria"} SELECT 1 FROM %s{table} WHERE id = @id AND {Query.whereDataContains "@criteria"}
@ -177,12 +178,9 @@ module Document =
|> Sql.executeRowAsync Map.toExists |> Sql.executeRowAsync Map.toExists
/// 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> source table (key : 'TKey) (keyFunc : 'TKey -> string) webLogId = let findByIdAndWebLog<'TKey, 'TDoc> table (key : 'TKey) (keyFunc : 'TKey -> string) webLogId =
Sql.fromDataSource source Custom.single $"""{Query.selectFromTable table} WHERE id = @id AND {Query.whereDataContains "@criteria"}"""
|> Sql.query $"""{Query.selectFromTable table} WHERE id = @id AND {Query.whereDataContains "@criteria"}""" [ "@id", Sql.string (keyFunc key); webLogContains webLogId ] fromData<'TDoc>
|> Sql.parameters [ "@id", Sql.string (keyFunc key); webLogContains webLogId ]
|> Sql.executeAsync fromData<'TDoc>
|> tryHead
/// Find a document by its ID for the given web log /// Find a document by its ID for the given web log
let findByWebLog<'TDoc> table webLogId : Task<'TDoc list> = let findByWebLog<'TDoc> table webLogId : Task<'TDoc list> =
@ -193,23 +191,19 @@ module Document =
module Revisions = module Revisions =
/// Find all revisions for the given entity /// Find all revisions for the given entity
let findByEntityId<'TKey> source revTable entityTable (key : 'TKey) (keyFunc : 'TKey -> string) = let findByEntityId<'TKey> revTable entityTable (key : 'TKey) (keyFunc : 'TKey -> string) =
Sql.fromDataSource source Custom.list $"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" [ "@id", Sql.string (keyFunc key) ] Map.toRevision
|> Sql.parameters [ "@id", Sql.string (keyFunc key) ]
|> 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> source revTable entityTable (keyFunc : string -> 'TKey) webLogId = let findByWebLog<'TKey> revTable entityTable (keyFunc : string -> 'TKey) webLogId =
Sql.fromDataSource source Custom.list
|> Sql.query $""" $"""SELECT pr.*
SELECT pr.*
FROM %s{revTable} pr FROM %s{revTable} pr
INNER JOIN %s{entityTable} p ON p.id = pr.{entityTable}_id INNER JOIN %s{entityTable} p ON p.id = pr.{entityTable}_id
WHERE p.{Query.whereDataContains "@criteria"} WHERE p.{Query.whereDataContains "@criteria"}
ORDER BY as_of DESC""" ORDER BY as_of DESC"""
|> Sql.parameters [ webLogContains webLogId ] [ webLogContains webLogId ] (fun row -> keyFunc (row.string $"{entityTable}_id"), Map.toRevision row)
|> Sql.executeAsync (fun row -> keyFunc (row.string $"{entityTable}_id"), Map.toRevision row)
/// Parameters for a revision INSERT statement /// Parameters for a revision INSERT statement
let revParams<'TKey> (key : 'TKey) (keyFunc : 'TKey -> string) rev = [ let revParams<'TKey> (key : 'TKey) (keyFunc : 'TKey -> string) rev = [
@ -223,12 +217,12 @@ module Revisions =
$"INSERT INTO %s{table} VALUES (@id, @asOf, @text)" $"INSERT INTO %s{table} VALUES (@id, @asOf, @text)"
/// Update a page's revisions /// Update a page's revisions
let update<'TKey> let update<'TKey> 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.fromDataSource source Configuration.dataSource ()
|> Sql.fromDataSource
|> 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",

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

@ -1,21 +1,20 @@
namespace MyWebLog.Data.Postgres namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
open Npgsql.FSharp.Documents
/// PostgreSQL myWebLog page data implementation /// PostgreSQL myWebLog page data implementation
type PostgresPageData (source : NpgsqlDataSource, log : ILogger) = type PostgresPageData (log : ILogger) =
// SUPPORT FUNCTIONS // SUPPORT FUNCTIONS
/// Append revisions to a page /// Append revisions to a page
let appendPageRevisions (page : Page) = backgroundTask { let appendPageRevisions (page : Page) = backgroundTask {
log.LogTrace "Page.appendPageRevisions" log.LogTrace "Page.appendPageRevisions"
let! revisions = Revisions.findByEntityId source Table.PageRevision Table.Page page.Id PageId.toString let! revisions = Revisions.findByEntityId Table.PageRevision Table.Page page.Id PageId.toString
return { page with Revisions = revisions } return { page with Revisions = revisions }
} }
@ -26,22 +25,20 @@ type PostgresPageData (source : NpgsqlDataSource, log : ILogger) =
/// Update a page's revisions /// Update a page's revisions
let updatePageRevisions pageId oldRevs newRevs = let updatePageRevisions pageId oldRevs newRevs =
log.LogTrace "Page.updatePageRevisions" log.LogTrace "Page.updatePageRevisions"
Revisions.update source Table.PageRevision Table.Page pageId PageId.toString oldRevs newRevs Revisions.update 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 =
log.LogTrace "Page.pageExists" log.LogTrace "Page.pageExists"
Document.existsByWebLog source Table.Page pageId PageId.toString webLogId Document.existsByWebLog 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 =
log.LogTrace "Page.all" log.LogTrace "Page.all"
Sql.fromDataSource source Custom.list $"{selectWithCriteria Table.Page} ORDER BY LOWER(data ->> '{nameof Page.empty.Title}')"
|> Sql.query $"{selectWithCriteria Table.Page} ORDER BY LOWER(data ->> '{nameof Page.empty.Title}')" [ webLogContains webLogId ] fromData<Page>
|> Sql.parameters [ 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 =
@ -56,7 +53,7 @@ type PostgresPageData (source : NpgsqlDataSource, log : ILogger) =
/// Find a page by its ID (without revisions) /// Find a page by its ID (without revisions)
let findById pageId webLogId = let findById pageId webLogId =
log.LogTrace "Page.findById" log.LogTrace "Page.findById"
Document.findByIdAndWebLog<PageId, Page> source Table.Page pageId PageId.toString webLogId Document.findByIdAndWebLog<PageId, Page> 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 {
@ -92,22 +89,18 @@ type PostgresPageData (source : NpgsqlDataSource, log : ILogger) =
let linkSql, linkParam = let linkSql, linkParam =
arrayContains (nameof Page.empty.PriorPermalinks) Permalink.toString permalinks arrayContains (nameof Page.empty.PriorPermalinks) Permalink.toString permalinks
return! return!
Sql.fromDataSource source Custom.single
|> Sql.query $""" $"""SELECT data ->> '{nameof Page.empty.Permalink}' AS permalink
SELECT data ->> '{nameof Page.empty.Permalink}' AS permalink
FROM page FROM page
WHERE {Query.whereDataContains "@criteria"} WHERE {Query.whereDataContains "@criteria"}
AND {linkSql}""" AND {linkSql}""" [ webLogContains webLogId; linkParam ] Map.toPermalink
|> Sql.parameters [ webLogContains webLogId; linkParam ]
|> Sql.executeAsync Map.toPermalink
|> 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 {
log.LogTrace "Page.findFullByWebLog" log.LogTrace "Page.findFullByWebLog"
let! pages = Document.findByWebLog<Page> Table.Page webLogId let! pages = Document.findByWebLog<Page> Table.Page webLogId
let! revisions = Revisions.findByWebLog source Table.PageRevision Table.Page PageId webLogId let! revisions = Revisions.findByWebLog Table.PageRevision Table.Page PageId webLogId
return return
pages pages
|> List.map (fun it -> |> List.map (fun it ->
@ -117,28 +110,27 @@ type PostgresPageData (source : NpgsqlDataSource, log : ILogger) =
/// 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 =
log.LogTrace "Page.findListed" log.LogTrace "Page.findListed"
Sql.fromDataSource source Custom.list $"{selectWithCriteria Table.Page} ORDER BY LOWER(data ->> '{nameof Page.empty.Title}')"
|> Sql.query $"{selectWithCriteria Table.Page} ORDER BY LOWER(data ->> '{nameof Page.empty.Title}')" [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with IsInPageList = true |} ]
|> Sql.parameters [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with IsInPageList = true |} ] 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 =
log.LogTrace "Page.findPageOfPages" log.LogTrace "Page.findPageOfPages"
Sql.fromDataSource source Custom.list
|> Sql.query $" $"{selectWithCriteria Table.Page}
{selectWithCriteria Table.Page}
ORDER BY LOWER(data->>'{nameof Page.empty.Title}') ORDER BY LOWER(data->>'{nameof Page.empty.Title}')
LIMIT @pageSize OFFSET @toSkip" LIMIT @pageSize OFFSET @toSkip"
|> Sql.parameters [ webLogContains webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ] [ webLogContains webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ]
|> Sql.executeAsync fromData<Page> fromData<Page>
/// Restore pages from a backup /// Restore pages from a backup
let restore (pages : Page list) = backgroundTask { let restore (pages : Page list) = backgroundTask {
log.LogTrace "Page.restore" log.LogTrace "Page.restore"
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.fromDataSource source Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
Query.insert Table.Page, Query.insert Table.Page,
pages pages

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

@ -1,22 +1,21 @@
namespace MyWebLog.Data.Postgres namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open NodaTime.Text open NodaTime.Text
open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
open Npgsql.FSharp.Documents
/// PostgreSQL myWebLog post data implementation /// PostgreSQL myWebLog post data implementation
type PostgresPostData (source : NpgsqlDataSource, log : ILogger) = type PostgresPostData (log : ILogger) =
// SUPPORT FUNCTIONS // SUPPORT FUNCTIONS
/// Append revisions to a post /// Append revisions to a post
let appendPostRevisions (post : Post) = backgroundTask { let appendPostRevisions (post : Post) = backgroundTask {
log.LogTrace "Post.appendPostRevisions" log.LogTrace "Post.appendPostRevisions"
let! revisions = Revisions.findByEntityId source Table.PostRevision Table.Post post.Id PostId.toString let! revisions = Revisions.findByEntityId Table.PostRevision Table.Post post.Id PostId.toString
return { post with Revisions = revisions } return { post with Revisions = revisions }
} }
@ -27,19 +26,20 @@ type PostgresPostData (source : NpgsqlDataSource, log : ILogger) =
/// Update a post's revisions /// Update a post's revisions
let updatePostRevisions postId oldRevs newRevs = let updatePostRevisions postId oldRevs newRevs =
log.LogTrace "Post.updatePostRevisions" log.LogTrace "Post.updatePostRevisions"
Revisions.update source Table.PostRevision Table.Post postId PostId.toString oldRevs newRevs Revisions.update 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 =
log.LogTrace "Post.postExists" log.LogTrace "Post.postExists"
Document.existsByWebLog source Table.Post postId PostId.toString webLogId Document.existsByWebLog Table.Post postId PostId.toString webLogId
// 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 =
log.LogTrace "Post.countByStatus" log.LogTrace "Post.countByStatus"
Sql.fromDataSource source Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.query |> Sql.query
$"""SELECT COUNT(id) AS {countName} FROM {Table.Post} WHERE {Query.whereDataContains "@criteria"}""" $"""SELECT COUNT(id) AS {countName} FROM {Table.Post} WHERE {Query.whereDataContains "@criteria"}"""
|> Sql.parameters |> Sql.parameters
@ -49,17 +49,15 @@ type PostgresPostData (source : NpgsqlDataSource, log : ILogger) =
/// 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 =
log.LogTrace "Post.findById" log.LogTrace "Post.findById"
Document.findByIdAndWebLog<PostId, Post> source Table.Post postId PostId.toString webLogId Document.findByIdAndWebLog<PostId, Post> 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 =
log.LogTrace "Post.findByPermalink" log.LogTrace "Post.findByPermalink"
Sql.fromDataSource source Custom.single (selectWithCriteria Table.Post)
|> Sql.query (selectWithCriteria Table.Post) [ "@criteria",
|> Sql.parameters Query.jsonbDocParam {| webLogDoc webLogId with Permalink = Permalink.toString permalink |}
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Permalink = Permalink.toString permalink |} ] ] fromData<Post>
|> Sql.executeAsync fromData<Post>
|> 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
let findFullById postId webLogId = backgroundTask { let findFullById postId webLogId = backgroundTask {
@ -77,13 +75,10 @@ type PostgresPostData (source : NpgsqlDataSource, log : ILogger) =
match! postExists postId webLogId with match! postExists postId webLogId with
| true -> | true ->
let theId = PostId.toString postId let theId = PostId.toString postId
let! _ = do! Custom.nonQuery
Sql.fromDataSource source $"""DELETE FROM {Table.PostComment} WHERE {Query.whereDataContains "@criteria"};
|> Sql.query $"""
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 theId; "@criteria", Query.jsonbDocParam {| PostId = theId |} ] [ "@id", Sql.string theId; "@criteria", Query.jsonbDocParam {| PostId = theId |} ]
|> Sql.executeNonQueryAsync
return true return true
| false -> return false | false -> return false
} }
@ -96,22 +91,18 @@ type PostgresPostData (source : NpgsqlDataSource, log : ILogger) =
let linkSql, linkParam = let linkSql, linkParam =
arrayContains (nameof Post.empty.PriorPermalinks) Permalink.toString permalinks arrayContains (nameof Post.empty.PriorPermalinks) Permalink.toString permalinks
return! return!
Sql.fromDataSource source Custom.single
|> 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 {Query.whereDataContains "@criteria"} WHERE {Query.whereDataContains "@criteria"}
AND {linkSql}""" AND {linkSql}""" [ webLogContains webLogId; linkParam ] Map.toPermalink
|> Sql.parameters [ webLogContains webLogId; linkParam ]
|> Sql.executeAsync Map.toPermalink
|> 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 {
log.LogTrace "Post.findFullByWebLog" log.LogTrace "Post.findFullByWebLog"
let! posts = Document.findByWebLog<Post> Table.Post webLogId let! posts = Document.findByWebLog<Post> Table.Post webLogId
let! revisions = Revisions.findByWebLog source Table.PostRevision Table.Post PostId webLogId let! revisions = Revisions.findByWebLog Table.PostRevision Table.Post PostId webLogId
return return
posts posts
|> List.map (fun it -> |> List.map (fun it ->
@ -122,83 +113,67 @@ type PostgresPostData (source : NpgsqlDataSource, log : ILogger) =
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
log.LogTrace "Post.findPageOfCategorizedPosts" log.LogTrace "Post.findPageOfCategorizedPosts"
let catSql, catParam = arrayContains (nameof Post.empty.CategoryIds) CategoryId.toString categoryIds let catSql, catParam = arrayContains (nameof Post.empty.CategoryIds) CategoryId.toString categoryIds
Sql.fromDataSource source Custom.list
|> Sql.query $" $"{selectWithCriteria Table.Post}
{selectWithCriteria Table.Post}
AND {catSql} AND {catSql}
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
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |} [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |}
catParam catParam
] ] fromData<Post>
|> Sql.executeAsync fromData<Post>
/// 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 =
log.LogTrace "Post.findPageOfPosts" log.LogTrace "Post.findPageOfPosts"
Sql.fromDataSource source Custom.list
|> Sql.query $" $"{selectWithCriteria Table.Post}
{selectWithCriteria Table.Post}
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 [ webLogContains webLogId ] [ webLogContains webLogId ] 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 =
log.LogTrace "Post.findPageOfPublishedPosts" log.LogTrace "Post.findPageOfPublishedPosts"
Sql.fromDataSource source Custom.list
|> Sql.query $" $"{selectWithCriteria Table.Post}
{selectWithCriteria Table.Post}
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
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |} ] [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |} ]
|> Sql.executeAsync fromData<Post> 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 =
log.LogTrace "Post.findPageOfTaggedPosts" log.LogTrace "Post.findPageOfTaggedPosts"
Sql.fromDataSource source Custom.list
|> Sql.query $" $"{selectWithCriteria Table.Post}
{selectWithCriteria Table.Post}
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
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |} [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |}
"@tag", Query.jsonbDocParam [| tag |] "@tag", Query.jsonbDocParam [| tag |]
] ] fromData<Post>
|> 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 = backgroundTask { let findSurroundingPosts webLogId publishedOn = backgroundTask {
log.LogTrace "Post.findSurroundingPosts" log.LogTrace "Post.findSurroundingPosts"
let queryParams () = Sql.parameters [ let queryParams () = [
"@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |} "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |}
"@publishedOn", Sql.string ((InstantPattern.General.Format publishedOn).Substring (0, 19)) "@publishedOn", Sql.string ((InstantPattern.General.Format publishedOn).Substring (0, 19))
] ]
let pubField = nameof Post.empty.PublishedOn let pubField = nameof Post.empty.PublishedOn
let! older = let! older =
Sql.fromDataSource source Custom.list
|> Sql.query $" $"{selectWithCriteria Table.Post}
{selectWithCriteria Table.Post}
AND SUBSTR(data ->> '{pubField}', 1, 19) < @publishedOn AND SUBSTR(data ->> '{pubField}', 1, 19) < @publishedOn
ORDER BY data ->> '{pubField}' DESC ORDER BY data ->> '{pubField}' DESC
LIMIT 1" LIMIT 1" (queryParams ()) fromData<Post>
|> queryParams ()
|> Sql.executeAsync fromData<Post>
let! newer = let! newer =
Sql.fromDataSource source Custom.list
|> Sql.query $" $"{selectWithCriteria Table.Post}
{selectWithCriteria Table.Post}
AND SUBSTR(data ->> '{pubField}', 1, 19) > @publishedOn AND SUBSTR(data ->> '{pubField}', 1, 19) > @publishedOn
ORDER BY data ->> '{pubField}' ORDER BY data ->> '{pubField}'
LIMIT 1" LIMIT 1" (queryParams ()) fromData<Post>
|> queryParams ()
|> Sql.executeAsync fromData<Post>
return List.tryHead older, List.tryHead newer return List.tryHead older, List.tryHead newer
} }
@ -215,7 +190,8 @@ type PostgresPostData (source : NpgsqlDataSource, log : ILogger) =
log.LogTrace "Post.restore" log.LogTrace "Post.restore"
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.fromDataSource source Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
Query.insert Table.Post, Query.insert Table.Post,
posts posts

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

@ -1,24 +1,23 @@
namespace MyWebLog.Data.Postgres namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
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 (source : NpgsqlDataSource, log : ILogger) = type PostgresTagMapData (log : ILogger) =
/// 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 =
log.LogTrace "TagMap.findById" log.LogTrace "TagMap.findById"
Document.findByIdAndWebLog<TagMapId, TagMap> source Table.TagMap tagMapId TagMapId.toString webLogId Document.findByIdAndWebLog<TagMapId, TagMap> 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 {
log.LogTrace "TagMap.delete" log.LogTrace "TagMap.delete"
let! exists = Document.existsByWebLog source Table.TagMap tagMapId TagMapId.toString webLogId let! exists = Document.existsByWebLog Table.TagMap tagMapId TagMapId.toString webLogId
if exists then if exists then
do! Delete.byId Table.TagMap (TagMapId.toString tagMapId) do! Delete.byId Table.TagMap (TagMapId.toString tagMapId)
return true return true
@ -28,28 +27,22 @@ type PostgresTagMapData (source : NpgsqlDataSource, log : ILogger) =
/// 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 : string) webLogId = let findByUrlValue (urlValue : string) webLogId =
log.LogTrace "TagMap.findByUrlValue" log.LogTrace "TagMap.findByUrlValue"
Sql.fromDataSource source Custom.single (selectWithCriteria Table.TagMap)
|> Sql.query (selectWithCriteria Table.TagMap) [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with UrlValue = urlValue |} ]
|> Sql.parameters [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with UrlValue = urlValue |} ] fromData<TagMap>
|> Sql.executeAsync fromData<TagMap>
|> 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 =
log.LogTrace "TagMap.findByWebLog" log.LogTrace "TagMap.findByWebLog"
Sql.fromDataSource source Custom.list $"{selectWithCriteria Table.TagMap} ORDER BY data ->> 'tag'" [ webLogContains webLogId ]
|> Sql.query $"{selectWithCriteria Table.TagMap} ORDER BY data ->> 'tag'" fromData<TagMap>
|> Sql.parameters [ 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 =
log.LogTrace "TagMap.findMappingForTags" log.LogTrace "TagMap.findMappingForTags"
let tagSql, tagParam = arrayContains (nameof TagMap.empty.Tag) id tags let tagSql, tagParam = arrayContains (nameof TagMap.empty.Tag) id tags
Sql.fromDataSource source Custom.list $"{selectWithCriteria Table.TagMap} AND {tagSql}" [ webLogContains webLogId; tagParam ]
|> Sql.query $"{selectWithCriteria Table.TagMap} AND {tagSql}" fromData<TagMap>
|> Sql.parameters [ webLogContains webLogId; tagParam ]
|> Sql.executeAsync fromData<TagMap>
/// Save a tag mapping /// Save a tag mapping
let save (tagMap : TagMap) = let save (tagMap : TagMap) =
@ -58,7 +51,8 @@ type PostgresTagMapData (source : NpgsqlDataSource, log : ILogger) =
/// Restore tag mappings from a backup /// Restore tag mappings from a backup
let restore (tagMaps : TagMap list) = backgroundTask { let restore (tagMaps : TagMap list) = backgroundTask {
let! _ = let! _ =
Sql.fromDataSource source Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
Query.insert Table.TagMap, Query.insert Table.TagMap,
tagMaps |> List.map (fun tagMap -> Query.docParameters (TagMapId.toString tagMap.Id) tagMap) tagMaps |> List.map (fun tagMap -> Query.docParameters (TagMapId.toString tagMap.Id) tagMap)

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

@ -1,14 +1,13 @@
namespace MyWebLog.Data.Postgres namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
open Npgsql.FSharp.Documents
/// PostreSQL myWebLog theme data implementation /// PostreSQL myWebLog theme data implementation
type PostgresThemeData (source : NpgsqlDataSource, log : ILogger) = type PostgresThemeData (log : ILogger) =
/// Clear out the template text from a theme /// Clear out the template text from a theme
let withoutTemplateText row = let withoutTemplateText row =
@ -18,9 +17,7 @@ type PostgresThemeData (source : NpgsqlDataSource, log : ILogger) =
/// Retrieve all themes (except 'admin'; excludes template text) /// Retrieve all themes (except 'admin'; excludes template text)
let all () = let all () =
log.LogTrace "Theme.all" log.LogTrace "Theme.all"
Sql.fromDataSource source Custom.list $"{Query.selectFromTable Table.Theme} WHERE id <> 'admin' ORDER BY id" [] withoutTemplateText
|> Sql.query $"{Query.selectFromTable Table.Theme} WHERE id <> 'admin' ORDER BY id"
|> Sql.executeAsync withoutTemplateText
/// Does a given theme exist? /// Does a given theme exist?
let exists themeId = let exists themeId =
@ -35,11 +32,7 @@ type PostgresThemeData (source : NpgsqlDataSource, log : ILogger) =
/// 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 =
log.LogTrace "Theme.findByIdWithoutText" log.LogTrace "Theme.findByIdWithoutText"
Sql.fromDataSource source Custom.single (Query.Find.byId Table.Theme) [ "@id", Sql.string (ThemeId.toString themeId) ] withoutTemplateText
|> 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 {
@ -66,74 +59,54 @@ type PostgresThemeData (source : NpgsqlDataSource, log : ILogger) =
/// PostreSQL myWebLog theme data implementation /// PostreSQL myWebLog theme data implementation
type PostgresThemeAssetData (source : NpgsqlDataSource, log : ILogger) = type PostgresThemeAssetData (log : ILogger) =
/// Get all theme assets (excludes data) /// Get all theme assets (excludes data)
let all () = let all () =
log.LogTrace "ThemeAsset.all" log.LogTrace "ThemeAsset.all"
Sql.fromDataSource source Custom.list $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset}" [] (Map.toThemeAsset false)
|> Sql.query $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset}"
|> 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 =
log.LogTrace "ThemeAsset.deleteByTheme" log.LogTrace "ThemeAsset.deleteByTheme"
let! _ = Custom.nonQuery $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
Sql.fromDataSource source [ "@themeId", Sql.string (ThemeId.toString themeId) ]
|> Sql.query $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
|> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ]
|> Sql.executeNonQueryAsync
()
}
/// Find a theme asset by its ID /// Find a theme asset by its ID
let findById assetId = let findById assetId =
log.LogTrace "ThemeAsset.findById" log.LogTrace "ThemeAsset.findById"
let (ThemeAssetId (ThemeId themeId, path)) = assetId let (ThemeAssetId (ThemeId themeId, path)) = assetId
Sql.fromDataSource source Custom.single $"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @themeId AND path = @path"
|> Sql.query $"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @themeId AND path = @path" [ "@themeId", Sql.string themeId; "@path", Sql.string path ] (Map.toThemeAsset true)
|> Sql.parameters [ "@themeId", Sql.string themeId; "@path", Sql.string path ]
|> Sql.executeAsync (Map.toThemeAsset true)
|> tryHead
/// Get theme assets for the given theme (excludes data) /// Get theme assets for the given theme (excludes data)
let findByTheme themeId = let findByTheme themeId =
log.LogTrace "ThemeAsset.findByTheme" log.LogTrace "ThemeAsset.findByTheme"
Sql.fromDataSource source Custom.list $"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" [ "@themeId", Sql.string (ThemeId.toString themeId) ] (Map.toThemeAsset false)
|> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ]
|> 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 =
log.LogTrace "ThemeAsset.findByThemeWithData" log.LogTrace "ThemeAsset.findByThemeWithData"
Sql.fromDataSource source Custom.list $"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
|> Sql.query $"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @themeId" [ "@themeId", Sql.string (ThemeId.toString themeId) ] (Map.toThemeAsset true)
|> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ]
|> Sql.executeAsync (Map.toThemeAsset true)
/// Save a theme asset /// Save a theme asset
let save (asset : ThemeAsset) = backgroundTask { let save (asset : ThemeAsset) =
log.LogTrace "ThemeAsset.save" log.LogTrace "ThemeAsset.save"
let (ThemeAssetId (ThemeId themeId, path)) = asset.Id let (ThemeAssetId (ThemeId themeId, path)) = asset.Id
let! _ = Custom.nonQuery
Sql.fromDataSource source $"INSERT INTO {Table.ThemeAsset} (
|> Sql.query $"
INSERT INTO {Table.ThemeAsset} (
theme_id, path, updated_on, data theme_id, path, updated_on, data
) VALUES ( ) VALUES (
@themeId, @path, @updatedOn, @data @themeId, @path, @updatedOn, @data
) ON CONFLICT (theme_id, path) DO UPDATE ) ON CONFLICT (theme_id, path) DO UPDATE
SET updated_on = EXCLUDED.updated_on, SET updated_on = EXCLUDED.updated_on,
data = EXCLUDED.data" data = EXCLUDED.data"
|> Sql.parameters
[ "@themeId", Sql.string themeId [ "@themeId", Sql.string themeId
"@path", Sql.string path "@path", Sql.string path
"@data", Sql.bytea asset.Data "@data", Sql.bytea asset.Data
typedParam "updatedOn" asset.UpdatedOn ] typedParam "updatedOn" asset.UpdatedOn ]
|> Sql.executeNonQueryAsync
()
}
interface IThemeAssetData with interface IThemeAssetData with
member _.All () = all () member _.All () = all ()

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

@ -1,13 +1,13 @@
namespace MyWebLog.Data.Postgres namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
/// PostgreSQL myWebLog uploaded file data implementation /// PostgreSQL myWebLog uploaded file data implementation
type PostgresUploadData (source : NpgsqlDataSource, log : ILogger) = type PostgresUploadData (log : ILogger) =
/// The INSERT statement for an uploaded file /// The INSERT statement for an uploaded file
let upInsert = $" let upInsert = $"
@ -27,32 +27,19 @@ type PostgresUploadData (source : NpgsqlDataSource, log : ILogger) =
] ]
/// Save an uploaded file /// Save an uploaded file
let add upload = backgroundTask { let add upload =
log.LogTrace "Upload.add" log.LogTrace "Upload.add"
let! _ = Custom.nonQuery upInsert (upParams upload)
Sql.fromDataSource source
|> Sql.query upInsert
|> Sql.parameters (upParams upload)
|> Sql.executeNonQueryAsync
()
}
/// Delete an uploaded file by its ID /// Delete an uploaded file by its ID
let delete uploadId webLogId = backgroundTask { let delete uploadId webLogId = backgroundTask {
log.LogTrace "Upload.delete" log.LogTrace "Upload.delete"
let idParam = [ "@id", Sql.string (UploadId.toString uploadId) ] let idParam = [ "@id", Sql.string (UploadId.toString uploadId) ]
let! path = let! path =
Sql.fromDataSource source Custom.single $"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" (webLogIdParam webLogId :: idParam) (fun row -> row.string "path")
|> Sql.parameters (webLogIdParam webLogId :: idParam)
|> Sql.executeAsync (fun row -> row.string "path")
|> tryHead
if Option.isSome path then if Option.isSome path then
let! _ = do! Custom.nonQuery (Query.Delete.byId Table.Upload) idParam
Sql.fromDataSource source
|> Sql.query (Documents.Query.Delete.byId Table.Upload)
|> Sql.parameters idParam
|> Sql.executeNonQueryAsync
return Ok path.Value return Ok path.Value
else return Error $"""Upload ID {UploadId.toString uploadId} not found""" else return Error $"""Upload ID {UploadId.toString uploadId} not found"""
} }
@ -60,34 +47,28 @@ type PostgresUploadData (source : NpgsqlDataSource, log : ILogger) =
/// 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 =
log.LogTrace "Upload.findByPath" log.LogTrace "Upload.findByPath"
Sql.fromDataSource source Custom.single $"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" [ webLogIdParam webLogId; "@path", Sql.string path ] (Map.toUpload true)
|> Sql.parameters [ webLogIdParam webLogId; "@path", Sql.string path ]
|> Sql.executeAsync (Map.toUpload true)
|> tryHead
/// 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 =
log.LogTrace "Upload.findByWebLog" log.LogTrace "Upload.findByWebLog"
Sql.fromDataSource source Custom.list $"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" [ webLogIdParam webLogId ] (Map.toUpload false)
|> Sql.parameters [ webLogIdParam webLogId ]
|> 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 =
log.LogTrace "Upload.findByWebLogWithData" log.LogTrace "Upload.findByWebLogWithData"
Sql.fromDataSource source Custom.list $"SELECT * FROM {Table.Upload} WHERE web_log_id = @webLogId" [ webLogIdParam webLogId ]
|> Sql.query $"SELECT * FROM {Table.Upload} WHERE web_log_id = @webLogId" (Map.toUpload true)
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync (Map.toUpload true)
/// Restore uploads from a backup /// Restore uploads from a backup
let restore uploads = backgroundTask { let restore uploads = backgroundTask {
log.LogTrace "Upload.restore" log.LogTrace "Upload.restore"
for batch in uploads |> List.chunkBySize 5 do for batch in uploads |> List.chunkBySize 5 do
let! _ = let! _ =
Sql.fromDataSource source Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [ upInsert, batch |> List.map upParams ] |> Sql.executeTransactionAsync [ upInsert, batch |> List.map upParams ]
() ()
} }

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

@ -1,14 +1,12 @@
namespace MyWebLog.Data.Postgres namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Npgsql
open Npgsql.FSharp
open Npgsql.FSharp.Documents
/// PostgreSQL myWebLog web log data implementation /// PostgreSQL myWebLog web log data implementation
type PostgresWebLogData (source : NpgsqlDataSource, log : ILogger) = type PostgresWebLogData (log : ILogger) =
/// Add a web log /// Add a web log
let add (webLog : WebLog) = let add (webLog : WebLog) =
@ -18,15 +16,13 @@ type PostgresWebLogData (source : NpgsqlDataSource, log : ILogger) =
/// Retrieve all web logs /// Retrieve all web logs
let all () = let all () =
log.LogTrace "WebLog.all" log.LogTrace "WebLog.all"
all<WebLog> Table.WebLog Find.all<WebLog> Table.WebLog
/// Delete a web log by its ID /// Delete a web log by its ID
let delete webLogId = backgroundTask { let delete webLogId =
log.LogTrace "WebLog.delete" log.LogTrace "WebLog.delete"
let! _ = Custom.nonQuery
Sql.fromDataSource source $"""DELETE FROM {Table.PostComment}
|> Sql.query $"""
DELETE FROM {Table.PostComment}
WHERE data ->> '{nameof Comment.empty.PostId}' IN WHERE data ->> '{nameof Comment.empty.PostId}' IN
(SELECT id FROM {Table.Post} WHERE {Query.whereDataContains "@criteria"}); (SELECT id FROM {Table.Post} WHERE {Query.whereDataContains "@criteria"});
{Query.Delete.byContains Table.Post}; {Query.Delete.byContains Table.Post};
@ -36,19 +32,13 @@ type PostgresWebLogData (source : NpgsqlDataSource, log : ILogger) =
{Query.Delete.byContains Table.WebLogUser}; {Query.Delete.byContains Table.WebLogUser};
DELETE FROM {Table.Upload} WHERE web_log_id = @webLogId; DELETE FROM {Table.Upload} WHERE web_log_id = @webLogId;
DELETE FROM {Table.WebLog} WHERE id = @webLogId""" DELETE FROM {Table.WebLog} WHERE id = @webLogId"""
|> Sql.parameters [ webLogIdParam webLogId; webLogContains webLogId ] [ webLogIdParam webLogId; webLogContains webLogId ]
|> Sql.executeNonQueryAsync
()
}
/// Find a web log by its host (URL base) /// Find a web log by its host (URL base)
let findByHost (url : string) = let findByHost (url : string) =
log.LogTrace "WebLog.findByHost" log.LogTrace "WebLog.findByHost"
Sql.fromDataSource source Custom.single (selectWithCriteria Table.WebLog) [ "@criteria", Query.jsonbDocParam {| UrlBase = url |} ]
|> Sql.query (selectWithCriteria Table.WebLog) fromData<WebLog>
|> Sql.parameters [ "@criteria", Query.jsonbDocParam {| UrlBase = url |} ]
|> Sql.executeAsync fromData<WebLog>
|> tryHead
/// Find a web log by its ID /// Find a web log by its ID
let findById webLogId = let findById webLogId =

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

@ -1,20 +1,18 @@
namespace MyWebLog.Data.Postgres namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
open Npgsql.FSharp.Documents
/// PostgreSQL myWebLog user data implementation /// PostgreSQL myWebLog user data implementation
type PostgresWebLogUserData (source : NpgsqlDataSource, log : ILogger) = type PostgresWebLogUserData (log : ILogger) =
/// 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 =
log.LogTrace "WebLogUser.findById" log.LogTrace "WebLogUser.findById"
Document.findByIdAndWebLog<WebLogUserId, WebLogUser> Document.findByIdAndWebLog<WebLogUserId, WebLogUser> Table.WebLogUser userId WebLogUserId.toString webLogId
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 {
@ -22,19 +20,19 @@ type PostgresWebLogUserData (source : NpgsqlDataSource, log : ILogger) =
match! findById userId webLogId with match! findById userId webLogId with
| Some _ -> | Some _ ->
let criteria = Query.whereDataContains "@criteria" let criteria = Query.whereDataContains "@criteria"
let usrId = WebLogUserId.toString userId
let! isAuthor = let! isAuthor =
Sql.fromDataSource source Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.query $" |> Sql.query $"
SELECT ( EXISTS (SELECT 1 FROM {Table.Page} WHERE {criteria} SELECT ( EXISTS (SELECT 1 FROM {Table.Page} WHERE {criteria}
OR EXISTS (SELECT 1 FROM {Table.Post} WHERE {criteria})) OR EXISTS (SELECT 1 FROM {Table.Post} WHERE {criteria}))
AS {existsName}" AS {existsName}"
|> Sql.parameters [ "@criteria", Query.jsonbDocParam {| AuthorId = usrId |} ] |> Sql.parameters [ "@criteria", Query.jsonbDocParam {| AuthorId = userId |} ]
|> 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! Delete.byId Table.WebLogUser usrId do! Delete.byId Table.WebLogUser (WebLogUserId.toString userId)
return Ok true return Ok true
| None -> return Error "User does not exist" | None -> return Error "User does not exist"
} }
@ -42,30 +40,24 @@ type PostgresWebLogUserData (source : NpgsqlDataSource, log : ILogger) =
/// 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 : string) webLogId = let findByEmail (email : string) webLogId =
log.LogTrace "WebLogUser.findByEmail" log.LogTrace "WebLogUser.findByEmail"
Sql.fromDataSource source Custom.single (selectWithCriteria Table.WebLogUser)
|> Sql.query (selectWithCriteria Table.WebLogUser) [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Email = email |} ]
|> Sql.parameters [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Email = email |} ] fromData<WebLogUser>
|> Sql.executeAsync fromData<WebLogUser>
|> tryHead
/// Get all users for the given web log /// Get all users for the given web log
let findByWebLog webLogId = let findByWebLog webLogId =
log.LogTrace "WebLogUser.findByWebLog" log.LogTrace "WebLogUser.findByWebLog"
Sql.fromDataSource source Custom.list
|> Sql.query
$"{selectWithCriteria Table.WebLogUser} ORDER BY LOWER(data->>'{nameof WebLogUser.empty.PreferredName}')" $"{selectWithCriteria Table.WebLogUser} ORDER BY LOWER(data->>'{nameof WebLogUser.empty.PreferredName}')"
|> Sql.parameters [ webLogContains webLogId ] [ webLogContains webLogId ] fromData<WebLogUser>
|> 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 {
log.LogTrace "WebLogUser.findNames" log.LogTrace "WebLogUser.findNames"
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.fromDataSource source Custom.list $"{selectWithCriteria Table.WebLogUser} {idSql}" (webLogContains webLogId :: idParams)
|> Sql.query $"{selectWithCriteria Table.WebLogUser} {idSql}" fromData<WebLogUser>
|> Sql.parameters (webLogContains webLogId :: idParams)
|> 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 })
@ -75,7 +67,8 @@ type PostgresWebLogUserData (source : NpgsqlDataSource, log : ILogger) =
let restore (users : WebLogUser list) = backgroundTask { let restore (users : WebLogUser list) = backgroundTask {
log.LogTrace "WebLogUser.restore" log.LogTrace "WebLogUser.restore"
let! _ = let! _ =
Sql.fromDataSource source Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
Query.insert Table.WebLogUser, Query.insert Table.WebLogUser,
users |> List.map (fun user -> Query.docParameters (WebLogUserId.toString user.Id) user) users |> List.map (fun user -> Query.docParameters (WebLogUserId.toString user.Id) user)
@ -86,7 +79,7 @@ type PostgresWebLogUserData (source : NpgsqlDataSource, log : ILogger) =
/// 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 {
log.LogTrace "WebLogUser.setLastSeen" log.LogTrace "WebLogUser.setLastSeen"
match! Document.existsByWebLog source Table.WebLogUser userId WebLogUserId.toString webLogId with match! Document.existsByWebLog Table.WebLogUser userId WebLogUserId.toString webLogId with
| true -> | true ->
do! Update.partialById Table.WebLogUser (WebLogUserId.toString userId) {| LastSeenOn = Some (Noda.now ()) |} do! Update.partialById Table.WebLogUser (WebLogUserId.toString userId) {| LastSeenOn = Some (Noda.now ()) |}
| false -> () | false -> ()

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

@ -1,12 +1,13 @@
namespace MyWebLog.Data namespace MyWebLog.Data
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
open BitBadger.Npgsql.Documents
open BitBadger.Npgsql.FSharp.Documents
open MyWebLog open MyWebLog
open MyWebLog.Data.Postgres 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 (source : NpgsqlDataSource, log : ILogger<PostgresData>, ser : JsonSerializer) = type PostgresData (source : NpgsqlDataSource, log : ILogger<PostgresData>, ser : JsonSerializer) =
@ -16,7 +17,7 @@ type PostgresData (source : NpgsqlDataSource, log : ILogger<PostgresData>, ser :
// Set up the PostgreSQL document store // Set up the PostgreSQL document store
Configuration.useDataSource source Configuration.useDataSource source
Configuration.useSerializer Configuration.useSerializer
{ new Documents.IDocumentSerializer with { new IDocumentSerializer with
member _.Serialize<'T> (it : 'T) : string = Utils.serialize ser it member _.Serialize<'T> (it : 'T) : string = Utils.serialize ser it
member _.Deserialize<'T> (it : string) : 'T = Utils.deserialize ser it member _.Deserialize<'T> (it : string) : 'T = Utils.deserialize ser it
} }
@ -131,13 +132,8 @@ type PostgresData (source : NpgsqlDataSource, log : ILogger<PostgresData>, ser :
} }
/// Set a specific database version /// Set a specific database version
let setDbVersion version = backgroundTask { let setDbVersion version =
let! _ = Custom.nonQuery $"DELETE FROM db_version; INSERT INTO db_version VALUES ('%s{version}')" []
Sql.fromDataSource source
|> Sql.query $"DELETE FROM db_version; INSERT INTO db_version VALUES ('%s{version}')"
|> Sql.executeNonQueryAsync
()
}
/// Do required data migration between versions /// Do required data migration between versions
let migrate version = backgroundTask { let migrate version = backgroundTask {
@ -152,15 +148,15 @@ type PostgresData (source : NpgsqlDataSource, log : ILogger<PostgresData>, ser :
interface IData with interface IData with
member _.Category = PostgresCategoryData (source, log) member _.Category = PostgresCategoryData log
member _.Page = PostgresPageData (source, log) member _.Page = PostgresPageData log
member _.Post = PostgresPostData (source, log) member _.Post = PostgresPostData log
member _.TagMap = PostgresTagMapData (source, log) member _.TagMap = PostgresTagMapData log
member _.Theme = PostgresThemeData (source, log) member _.Theme = PostgresThemeData log
member _.ThemeAsset = PostgresThemeAssetData (source, log) member _.ThemeAsset = PostgresThemeAssetData log
member _.Upload = PostgresUploadData (source, log) member _.Upload = PostgresUploadData log
member _.WebLog = PostgresWebLogData (source, log) member _.WebLog = PostgresWebLogData log
member _.WebLogUser = PostgresWebLogUserData (source, log) member _.WebLogUser = PostgresWebLogUserData log
member _.Serializer = ser member _.Serializer = ser
@ -168,11 +164,7 @@ type PostgresData (source : NpgsqlDataSource, log : ILogger<PostgresData>, ser :
log.LogTrace "PostgresData.StartUp" log.LogTrace "PostgresData.StartUp"
do! ensureTables () do! ensureTables ()
let! version = let! version = Custom.single "SELECT id FROM db_version" [] (fun row -> row.string "id")
Sql.fromDataSource source
|> Sql.query "SELECT id FROM db_version"
|> Sql.executeAsync (fun row -> row.string "id")
|> tryHead
match version with match version with
| Some v when v = Utils.currentDbVersion -> () | Some v when v = Utils.currentDbVersion -> ()
| Some _ | Some _

6
src/MyWebLog.sln
View File

@ -9,8 +9,6 @@ Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "MyWebLog.Data", "MyWebLog.D
EndProject EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyWebLog", "MyWebLog\MyWebLog.fsproj", "{5655B63D-429F-4CCD-A14C-FBD74D987ECB}" Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyWebLog", "MyWebLog\MyWebLog.fsproj", "{5655B63D-429F-4CCD-A14C-FBD74D987ECB}"
EndProject EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Npgsql.FSharp.Documents", "Npgsql.FSharp.Documents\Npgsql.FSharp.Documents.fsproj", "{C5F5E68A-9C2E-4FC0-A8E3-D7A52CCE668F}"
EndProject
Global Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU Debug|Any CPU = Debug|Any CPU
@ -29,10 +27,6 @@ Global
{5655B63D-429F-4CCD-A14C-FBD74D987ECB}.Debug|Any CPU.Build.0 = Debug|Any CPU {5655B63D-429F-4CCD-A14C-FBD74D987ECB}.Debug|Any CPU.Build.0 = Debug|Any CPU
{5655B63D-429F-4CCD-A14C-FBD74D987ECB}.Release|Any CPU.ActiveCfg = Release|Any CPU {5655B63D-429F-4CCD-A14C-FBD74D987ECB}.Release|Any CPU.ActiveCfg = Release|Any CPU
{5655B63D-429F-4CCD-A14C-FBD74D987ECB}.Release|Any CPU.Build.0 = Release|Any CPU {5655B63D-429F-4CCD-A14C-FBD74D987ECB}.Release|Any CPU.Build.0 = Release|Any CPU
{C5F5E68A-9C2E-4FC0-A8E3-D7A52CCE668F}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{C5F5E68A-9C2E-4FC0-A8E3-D7A52CCE668F}.Debug|Any CPU.Build.0 = Debug|Any CPU
{C5F5E68A-9C2E-4FC0-A8E3-D7A52CCE668F}.Release|Any CPU.ActiveCfg = Release|Any CPU
{C5F5E68A-9C2E-4FC0-A8E3-D7A52CCE668F}.Release|Any CPU.Build.0 = Release|Any CPU
EndGlobalSection EndGlobalSection
GlobalSection(SolutionProperties) = preSolution GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE HideSolutionNode = FALSE

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

@ -1,242 +0,0 @@
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 =
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
()
}

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

@ -1,12 +0,0 @@
<Project Sdk="Microsoft.NET.Sdk">
<ItemGroup>
<Compile Include="Library.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="FSharp.SystemTextJson" Version="1.1.23" />
<PackageReference Include="Npgsql.FSharp" Version="5.6.0" />
</ItemGroup>
</Project>