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

Version 2.1 (#41)

Browse Source 
- Add full chapter support (#6)
- Add built-in redirect functionality (#39)
- Support building Docker containers for release (#38)
- Support canonical domain configuration (#37)
- Add unit tests for domain/models and integration tests for all three data stores
- Convert SQLite storage to use JSON documents, similar to PostgreSQL
- Convert admin templates to Giraffe View Engine (from Liquid)
- Add .NET 8 support
This commit was merged in pull request #41.
This commit is contained in:
Daniel J. Summers
2024-03-26 20:13:28 -04:00
committed by GitHub
parent 7b325dc19e
commit f1a7e55f3e
116 changed files with 14807 additions and 8249 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -61,7 +61,8 @@ module Table =
open System
open System.Threading.Tasks
open BitBadger.Npgsql.FSharp.Documents
open BitBadger.Documents
open BitBadger.Documents.Postgres
open MyWebLog
open MyWebLog.Data
open NodaTime
@@ -69,29 +70,23 @@ open Npgsql
open Npgsql.FSharp
/// Create a SQL parameter for the web log ID
let webLogIdParam webLogId =
"@webLogId", Sql.string (WebLogId.toString webLogId)
let webLogIdParam (webLogId: WebLogId) =
"@webLogId", Sql.string (string webLogId)
/// Create an anonymous record with the given web log ID
let webLogDoc (webLogId : WebLogId) =
let webLogDoc (webLogId: WebLogId) =
{| WebLogId = webLogId |}
/// Create a parameter for a web log document-contains query
let webLogContains webLogId =
"@criteria", Query.jsonbDocParam (webLogDoc webLogId)
/// The name of the field to select to be able to use Map.toCount
let countName = "the_count"
/// The name of the field to select to be able to use Map.toExists
let existsName = "does_exist"
jsonParam "@criteria" (webLogDoc webLogId)
/// A SQL string to select data from a table with the given JSON document contains criteria
let selectWithCriteria tableName =
$"""{Query.selectFromTable tableName} WHERE {Query.whereDataContains "@criteria"}"""
/// Create the SQL and parameters for an IN clause
let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items : 'T list) =
let inClause<'T> colNameAndPrefix paramName (items: 'T list) =
if List.isEmpty items then "", []
else
let mutable idx = 0
@@ -99,114 +94,109 @@ let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items : '
|> List.skip 1
|> List.fold (fun (itemS, itemP) it ->
idx <- idx + 1
$"{itemS}, @%s{paramName}{idx}", ($"@%s{paramName}{idx}", Sql.string (valueFunc it)) :: itemP)
$"{itemS}, @%s{paramName}{idx}", ($"@%s{paramName}{idx}", Sql.string (string it)) :: itemP)
(Seq.ofList items
|> Seq.map (fun it ->
$"%s{colNameAndPrefix} IN (@%s{paramName}0", [ $"@%s{paramName}0", Sql.string (valueFunc it) ])
$"%s{colNameAndPrefix} IN (@%s{paramName}0", [ $"@%s{paramName}0", Sql.string (string it) ])
|> Seq.head)
|> function sql, ps -> $"{sql})", ps
/// Create the SQL and parameters for match-any array query
let arrayContains<'T> name (valueFunc : 'T -> string) (items : 'T list) =
let arrayContains<'T> name (valueFunc: 'T -> string) (items: 'T list) =
$"data['{name}'] ?| @{name}Values",
($"@{name}Values", Sql.stringArray (items |> List.map valueFunc |> Array.ofList))
/// Get the first result of the given query
let tryHead<'T> (query : Task<'T list>) = backgroundTask {
let tryHead<'T> (query: Task<'T list>) = backgroundTask {
let! results = query
return List.tryHead results
}
/// Create a parameter for a non-standard type
let typedParam<'T> name (it : 'T) =
$"@%s{name}", Sql.parameter (NpgsqlParameter ($"@{name}", it))
let typedParam<'T> name (it: 'T) =
$"@%s{name}", Sql.parameter (NpgsqlParameter($"@{name}", it))
/// Create a parameter for a possibly-missing non-standard type
let optParam<'T> name (it : 'T option) =
let p = NpgsqlParameter ($"@%s{name}", if Option.isSome it then box it.Value else DBNull.Value)
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
/// Mapping functions for SQL queries
module Map =
/// Get a count from a row
let toCount (row : RowReader) =
row.int countName
/// Get a true/false value as to whether an item exists
let toExists (row : RowReader) =
row.bool existsName
/// Create a permalink from the current row
let toPermalink (row : RowReader) =
let toPermalink (row: RowReader) =
Permalink (row.string "permalink")
/// Create a revision from the current row
let toRevision (row : RowReader) : Revision =
{ AsOf = row.fieldValue<Instant> "as_of"
Text = row.string "revision_text" |> MarkupText.parse
}
let toRevision (row: RowReader) : Revision =
{ AsOf = row.fieldValue<Instant> "as_of"
Text = row.string "revision_text" |> MarkupText.Parse }
/// Create a theme asset from the current row
let toThemeAsset includeData (row : RowReader) : ThemeAsset =
{ Id = ThemeAssetId (ThemeId (row.string "theme_id"), row.string "path")
UpdatedOn = row.fieldValue<Instant> "updated_on"
Data = if includeData then row.bytea "data" else [||]
}
let toThemeAsset includeData (row: RowReader) : ThemeAsset =
{ Id = ThemeAssetId (ThemeId (row.string "theme_id"), row.string "path")
UpdatedOn = row.fieldValue<Instant> "updated_on"
Data = if includeData then row.bytea "data" else [||] }
/// Create an uploaded file from the current row
let toUpload includeData (row : RowReader) : Upload =
{ Id = row.string "id" |> UploadId
WebLogId = row.string "web_log_id" |> WebLogId
Path = row.string "path" |> Permalink
UpdatedOn = row.fieldValue<Instant> "updated_on"
Data = if includeData then row.bytea "data" else [||]
}
let toUpload includeData (row: RowReader) : Upload =
{ Id = row.string "id" |> UploadId
WebLogId = row.string "web_log_id" |> WebLogId
Path = row.string "path" |> Permalink
UpdatedOn = row.fieldValue<Instant> "updated_on"
Data = if includeData then row.bytea "data" else [||] }
/// Document manipulation functions
module Document =
/// Determine whether a document exists with the given key for the given web log
let existsByWebLog<'TKey> table (key : 'TKey) (keyFunc : 'TKey -> string) webLogId =
let existsByWebLog<'TKey> table (key: 'TKey) webLogId =
Custom.scalar
$""" SELECT EXISTS (
SELECT 1 FROM %s{table} WHERE id = @id AND {Query.whereDataContains "@criteria"}
) AS {existsName}"""
[ "@id", Sql.string (keyFunc key); webLogContains webLogId ] Map.toExists
$"""SELECT EXISTS (
SELECT 1 FROM %s{table} WHERE {Query.whereById "@id"} AND {Query.whereDataContains "@criteria"}
) AS it"""
[ "@id", Sql.string (string key); webLogContains webLogId ]
toExists
/// Find a document by its ID for the given web log
let findByIdAndWebLog<'TKey, 'TDoc> table (key : 'TKey) (keyFunc : 'TKey -> string) webLogId =
Custom.single $"""{Query.selectFromTable table} WHERE id = @id AND {Query.whereDataContains "@criteria"}"""
[ "@id", Sql.string (keyFunc key); webLogContains webLogId ] fromData<'TDoc>
let findByIdAndWebLog<'TKey, 'TDoc> table (key: 'TKey) webLogId =
Custom.single
$"""{Query.selectFromTable table} WHERE {Query.whereById "@id"} AND {Query.whereDataContains "@criteria"}"""
[ "@id", Sql.string (string key); webLogContains webLogId ]
fromData<'TDoc>
/// Find a document by its ID for the given web log
/// Find documents for the given web log
let findByWebLog<'TDoc> table webLogId : Task<'TDoc list> =
Find.byContains table (webLogDoc webLogId)
/// Functions to support revisions
module Revisions =
/// Find all revisions for the given entity
let findByEntityId<'TKey> revTable entityTable (key : 'TKey) (keyFunc : 'TKey -> string) =
Custom.list $"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
let findByEntityId<'TKey> revTable entityTable (key: 'TKey) =
Custom.list
$"SELECT as_of, revision_text FROM %s{revTable} WHERE %s{entityTable}_id = @id ORDER BY as_of DESC"
[ "@id", Sql.string (string key) ]
Map.toRevision
/// Find all revisions for all posts for the given web log
let findByWebLog<'TKey> revTable entityTable (keyFunc : string -> 'TKey) webLogId =
let findByWebLog<'TKey> revTable entityTable (keyFunc: string -> 'TKey) webLogId =
Custom.list
$"""SELECT pr.*
FROM %s{revTable} pr
INNER JOIN %s{entityTable} p ON p.id = pr.{entityTable}_id
INNER JOIN %s{entityTable} p ON p.data ->> '{nameof Post.Empty.Id}' = pr.{entityTable}_id
WHERE p.{Query.whereDataContains "@criteria"}
ORDER BY as_of DESC"""
[ webLogContains webLogId ] (fun row -> keyFunc (row.string $"{entityTable}_id"), Map.toRevision row)
[ webLogContains webLogId ]
(fun row -> keyFunc (row.string $"{entityTable}_id"), Map.toRevision row)
/// Parameters for a revision INSERT statement
let revParams<'TKey> (key : 'TKey) (keyFunc : 'TKey -> string) rev = [
let revParams<'TKey> (key: 'TKey) rev = [
typedParam "asOf" rev.AsOf
"@id", Sql.string (keyFunc key)
"@text", Sql.string (MarkupText.toString rev.Text)
"@id", Sql.string (string key)
"@text", Sql.string (string rev.Text)
]
/// The SQL statement to insert a revision
@@ -214,23 +204,20 @@ module Revisions =
$"INSERT INTO %s{table} VALUES (@id, @asOf, @text)"
/// Update a page's revisions
let update<'TKey> revTable entityTable (key : 'TKey) (keyFunc : 'TKey -> string) oldRevs newRevs = backgroundTask {
let update<'TKey> revTable entityTable (key: 'TKey) oldRevs newRevs = backgroundTask {
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then
let! _ =
Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [
if not (List.isEmpty toDelete) then
|> Sql.executeTransactionAsync
[ if not (List.isEmpty toDelete) then
$"DELETE FROM %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf",
toDelete
|> List.map (fun it -> [
"@id", Sql.string (keyFunc key)
typedParam "asOf" it.AsOf
])
if not (List.isEmpty toAdd) then
insertSql revTable, toAdd |> List.map (revParams key keyFunc)
]
|> List.map (fun it ->
[ "@id", Sql.string (string key)
typedParam "asOf" it.AsOf ])
if not (List.isEmpty toAdd) then
insertSql revTable, toAdd |> List.map (revParams key) ]
()
}