238 lines
11 KiB
Forth
238 lines
11 KiB
Forth
namespace MyWebLog.Data.Postgres
|
|
|
|
open BitBadger.Documents
|
|
open BitBadger.Documents.Postgres
|
|
open Microsoft.Extensions.Logging
|
|
open MyWebLog
|
|
open MyWebLog.Data
|
|
open NodaTime
|
|
open Npgsql.FSharp
|
|
|
|
/// PostgreSQL myWebLog post data implementation
|
|
type PostgresPostData(log: ILogger) =
|
|
|
|
// SUPPORT FUNCTIONS
|
|
|
|
/// Append revisions to a post
|
|
let appendPostRevisions (post: Post) = backgroundTask {
|
|
log.LogTrace "Post.appendPostRevisions"
|
|
let! revisions = Revisions.findByEntityId Table.PostRevision Table.Post post.Id
|
|
return { post with Revisions = revisions }
|
|
}
|
|
|
|
/// Return a post with no revisions or prior permalinks
|
|
let postWithoutLinks row =
|
|
{ fromData<Post> row with PriorPermalinks = [] }
|
|
|
|
/// Return a post with no revisions, prior permalinks, or text
|
|
let postWithoutText row =
|
|
{ postWithoutLinks row with Text = "" }
|
|
|
|
/// Update a post's revisions
|
|
let updatePostRevisions (postId: PostId) oldRevs newRevs =
|
|
log.LogTrace "Post.updatePostRevisions"
|
|
Revisions.update Table.PostRevision Table.Post postId oldRevs newRevs
|
|
|
|
/// Does the given post exist?
|
|
let postExists (postId: PostId) webLogId =
|
|
log.LogTrace "Post.postExists"
|
|
Document.existsByWebLog Table.Post postId webLogId
|
|
|
|
// IMPLEMENTATION FUNCTIONS
|
|
|
|
/// Add a post
|
|
let add (post : Post) = backgroundTask {
|
|
log.LogTrace "Post.add"
|
|
do! insert Table.Post { post with Revisions = [] }
|
|
do! updatePostRevisions post.Id [] post.Revisions
|
|
}
|
|
|
|
/// Count posts in a status for the given web log
|
|
let countByStatus (status: PostStatus) webLogId =
|
|
log.LogTrace "Post.countByStatus"
|
|
Count.byContains Table.Post {| webLogDoc webLogId with Status = status |}
|
|
|
|
/// Find a post by its ID for the given web log (excluding revisions)
|
|
let findById postId webLogId = backgroundTask {
|
|
log.LogTrace "Post.findById"
|
|
match! Document.findByIdAndWebLog<PostId, Post> Table.Post postId webLogId with
|
|
| Some post -> return Some { post with PriorPermalinks = [] }
|
|
| None -> return None
|
|
}
|
|
|
|
/// Find a post by its permalink for the given web log (excluding revisions)
|
|
let findByPermalink (permalink: Permalink) webLogId =
|
|
log.LogTrace "Post.findByPermalink"
|
|
Custom.single
|
|
(selectWithCriteria Table.Post)
|
|
[ jsonParam "@criteria" {| webLogDoc webLogId with Permalink = permalink |} ]
|
|
postWithoutLinks
|
|
|
|
/// Find a complete post by its ID for the given web log
|
|
let findFullById postId webLogId = backgroundTask {
|
|
log.LogTrace "Post.findFullById"
|
|
match! Document.findByIdAndWebLog<PostId, Post> Table.Post postId webLogId with
|
|
| Some post ->
|
|
let! withRevisions = appendPostRevisions post
|
|
return Some withRevisions
|
|
| None -> return None
|
|
}
|
|
|
|
/// Delete a post by its ID for the given web log
|
|
let delete postId webLogId = backgroundTask {
|
|
log.LogTrace "Post.delete"
|
|
match! postExists postId webLogId with
|
|
| true ->
|
|
do! Custom.nonQuery
|
|
$"""{Query.delete Table.PostComment} WHERE {Query.whereDataContains "@criteria"};
|
|
{Query.delete Table.PostRevision} WHERE post_id = @id;
|
|
{Query.delete Table.Post} WHERE {Query.whereById "@id"}"""
|
|
[ idParam postId; jsonParam "@criteria" {| PostId = postId |} ]
|
|
return true
|
|
| false -> return false
|
|
}
|
|
|
|
/// Find the current permalink from a list of potential prior permalinks for the given web log
|
|
let findCurrentPermalink (permalinks: Permalink list) webLogId = backgroundTask {
|
|
log.LogTrace "Post.findCurrentPermalink"
|
|
if List.isEmpty permalinks then return None
|
|
else
|
|
let linkField = Field.InArray (nameof Post.Empty.PriorPermalinks) Table.Post (List.map string permalinks)
|
|
let query =
|
|
(Query.statementWhere
|
|
(Query.find Table.Post)
|
|
$"""{Query.whereDataContains "@criteria"} AND {Query.whereByFields All [ linkField ]}""")
|
|
.Replace("SELECT data", $"SELECT data->>'{nameof Post.Empty.Permalink}' AS permalink")
|
|
return! Custom.single query (addFieldParams [ linkField ] [ webLogContains webLogId ]) Map.toPermalink
|
|
}
|
|
|
|
/// Get all complete posts for the given web log
|
|
let findFullByWebLog webLogId = backgroundTask {
|
|
log.LogTrace "Post.findFullByWebLog"
|
|
let! posts = Find.byContains<Post> Table.Post (webLogDoc webLogId)
|
|
let! revisions = Revisions.findByWebLog Table.PostRevision Table.Post PostId webLogId
|
|
return
|
|
posts
|
|
|> List.map (fun it ->
|
|
{ it with Revisions = revisions |> List.filter (fun r -> fst r = it.Id) |> List.map snd })
|
|
}
|
|
|
|
/// Get a page of categorized posts for the given web log (excludes revisions)
|
|
let findPageOfCategorizedPosts webLogId (categoryIds: CategoryId list) pageNbr postsPerPage =
|
|
log.LogTrace "Post.findPageOfCategorizedPosts"
|
|
let catIdField = Field.InArray (nameof Post.Empty.CategoryIds) Table.Post (List.map string categoryIds)
|
|
Custom.list
|
|
$"""{selectWithCriteria Table.Post}
|
|
AND {Query.whereByFields All [ catIdField ]}
|
|
{Query.orderBy [ Field.Named $"{nameof Post.Empty.PublishedOn} DESC" ] PostgreSQL}
|
|
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
|
|
(addFieldParams [ catIdField] [ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |} ])
|
|
postWithoutLinks
|
|
|
|
/// Get a page of posts for the given web log (excludes text and revisions)
|
|
let findPageOfPosts webLogId pageNbr postsPerPage =
|
|
log.LogTrace "Post.findPageOfPosts"
|
|
let order =
|
|
Query.orderBy
|
|
[ Field.Named $"{nameof Post.Empty.PublishedOn} DESC NULLS FIRST"
|
|
Field.Named (nameof Post.Empty.UpdatedOn) ]
|
|
PostgreSQL
|
|
Custom.list
|
|
$"{selectWithCriteria Table.Post}{order}
|
|
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|
|
[ webLogContains webLogId ]
|
|
postWithoutText
|
|
|
|
/// Get a page of published posts for the given web log (excludes revisions)
|
|
let findPageOfPublishedPosts webLogId pageNbr postsPerPage =
|
|
log.LogTrace "Post.findPageOfPublishedPosts"
|
|
Custom.list
|
|
$"""{selectWithCriteria Table.Post}
|
|
{Query.orderBy [ Field.Named $"{nameof Post.Empty.PublishedOn} DESC" ] PostgreSQL}
|
|
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
|
|
[ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |} ]
|
|
postWithoutLinks
|
|
|
|
/// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks)
|
|
let findPageOfTaggedPosts webLogId (tag: string) pageNbr postsPerPage =
|
|
log.LogTrace "Post.findPageOfTaggedPosts"
|
|
Custom.list
|
|
$"""{selectWithCriteria Table.Post}
|
|
AND data['{nameof Post.Empty.Tags}'] @> @tag
|
|
{Query.orderBy [ Field.Named $"{nameof Post.Empty.PublishedOn} DESC" ] PostgreSQL}
|
|
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
|
|
[ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |}; jsonParam "@tag" [| tag |] ]
|
|
postWithoutLinks
|
|
|
|
/// Find the next newest and oldest post from a publish date for the given web log
|
|
let findSurroundingPosts webLogId (publishedOn: Instant) = backgroundTask {
|
|
log.LogTrace "Post.findSurroundingPosts"
|
|
let queryParams () =
|
|
[ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |}
|
|
"@publishedOn", Sql.timestamptz (publishedOn.ToDateTimeOffset()) ]
|
|
let query op direction =
|
|
$"""{selectWithCriteria Table.Post}
|
|
AND (data->>'{nameof Post.Empty.PublishedOn}')::timestamp with time zone %s{op} @publishedOn
|
|
{Query.orderBy [ Field.Named $"{nameof Post.Empty.PublishedOn} %s{direction}" ] PostgreSQL}
|
|
LIMIT 1"""
|
|
let! older = Custom.list (query "<" "DESC") (queryParams ()) postWithoutLinks
|
|
let! newer = Custom.list (query ">" "") (queryParams ()) postWithoutLinks
|
|
return List.tryHead older, List.tryHead newer
|
|
}
|
|
|
|
/// Update a post
|
|
let update (post : Post) = backgroundTask {
|
|
log.LogTrace "Post.save"
|
|
match! findFullById post.Id post.WebLogId with
|
|
| Some oldPost ->
|
|
do! Update.byId Table.Post post.Id { post with Revisions = [] }
|
|
do! updatePostRevisions post.Id oldPost.Revisions post.Revisions
|
|
| None -> ()
|
|
}
|
|
|
|
/// Restore posts from a backup
|
|
let restore posts = backgroundTask {
|
|
log.LogTrace "Post.restore"
|
|
let revisions = posts |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r))
|
|
let! _ =
|
|
Configuration.dataSource ()
|
|
|> Sql.fromDataSource
|
|
|> Sql.executeTransactionAsync
|
|
[ Query.insert Table.Post,
|
|
posts |> List.map (fun post -> [ jsonParam "@data" { post with Revisions = [] } ])
|
|
Revisions.insertSql Table.PostRevision,
|
|
revisions |> List.map (fun (postId, rev) -> Revisions.revParams postId rev) ]
|
|
()
|
|
}
|
|
|
|
/// Update prior permalinks for a post
|
|
let updatePriorPermalinks postId webLogId (permalinks: Permalink list) = backgroundTask {
|
|
log.LogTrace "Post.updatePriorPermalinks"
|
|
match! postExists postId webLogId with
|
|
| true ->
|
|
do! Patch.byId Table.Post postId {| PriorPermalinks = permalinks |}
|
|
return true
|
|
| false -> return false
|
|
}
|
|
|
|
interface IPostData with
|
|
member _.Add post = add post
|
|
member _.CountByStatus status webLogId = countByStatus status webLogId
|
|
member _.Delete postId webLogId = delete postId webLogId
|
|
member _.FindById postId webLogId = findById postId webLogId
|
|
member _.FindByPermalink permalink webLogId = findByPermalink permalink webLogId
|
|
member _.FindCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId
|
|
member _.FindFullById postId webLogId = findFullById postId webLogId
|
|
member _.FindFullByWebLog webLogId = findFullByWebLog webLogId
|
|
member _.FindPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
|
|
findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage
|
|
member _.FindPageOfPosts webLogId pageNbr postsPerPage = findPageOfPosts webLogId pageNbr postsPerPage
|
|
member _.FindPageOfPublishedPosts webLogId pageNbr postsPerPage =
|
|
findPageOfPublishedPosts webLogId pageNbr postsPerPage
|
|
member _.FindPageOfTaggedPosts webLogId tag pageNbr postsPerPage =
|
|
findPageOfTaggedPosts webLogId tag pageNbr postsPerPage
|
|
member _.FindSurroundingPosts webLogId publishedOn = findSurroundingPosts webLogId publishedOn
|
|
member _.Restore posts = restore posts
|
|
member _.Update post = update post
|
|
member _.UpdatePriorPermalinks postId webLogId permalinks = updatePriorPermalinks postId webLogId permalinks
|