360 lines
17 KiB
Forth
360 lines
17 KiB
Forth
namespace BitBadger.Documents.Postgres
|
|
|
|
open System.IO
|
|
open System.Text
|
|
|
|
/// <summary>The type of index to generate for the document</summary>
|
|
[<Struct>]
|
|
type DocumentIndex =
|
|
|
|
/// <summary>A <c>GIN</c> index with standard operations (all operators supported)</summary>
|
|
| Full
|
|
|
|
/// <summary>
|
|
/// A <c>GIN</c> index with JSON Path operations (optimized for <c>@></c>, <c>@?</c>, <c>@@</c> operators)
|
|
/// </summary>
|
|
| Optimized
|
|
|
|
|
|
open Npgsql
|
|
|
|
/// <summary>Configuration for document handling</summary>
|
|
module Configuration =
|
|
|
|
/// The data source to use for query execution
|
|
let mutable private dataSourceValue : NpgsqlDataSource option = None
|
|
|
|
/// <summary>Register a data source to use for query execution (disposes the current one if it exists)</summary>
|
|
/// <param name="source">The data source to use</param>
|
|
[<CompiledName "UseDataSource">]
|
|
let useDataSource source =
|
|
if Option.isSome dataSourceValue then dataSourceValue.Value.Dispose()
|
|
dataSourceValue <- Some source
|
|
|
|
/// <summary>Retrieve the currently configured data source</summary>
|
|
/// <returns>The current data source</returns>
|
|
/// <exception cref="T:System.InvalidOperationException">If no data source has been configured</exception>
|
|
[<CompiledName "DataSource">]
|
|
let dataSource () =
|
|
match dataSourceValue with
|
|
| Some source -> source
|
|
| None -> invalidOp "Please provide a data source before attempting data access"
|
|
|
|
|
|
open Npgsql.FSharp
|
|
|
|
/// Helper functions
|
|
[<AutoOpen>]
|
|
module private Helpers =
|
|
|
|
/// Shorthand to retrieve the data source as SqlProps
|
|
let internal fromDataSource () =
|
|
Configuration.dataSource () |> Sql.fromDataSource
|
|
|
|
/// Execute a task and ignore the result
|
|
let internal ignoreTask<'T> (it : System.Threading.Tasks.Task<'T>) = backgroundTask {
|
|
let! _ = it
|
|
()
|
|
}
|
|
|
|
/// Create a number or string parameter, or use the given parameter derivation function if non-(numeric or string)
|
|
let internal parameterFor<'T> (value: 'T) (catchAllFunc: 'T -> SqlValue) =
|
|
match box value with
|
|
| :? int8 as it -> Sql.int8 it
|
|
| :? uint8 as it -> Sql.int8 (int8 it)
|
|
| :? int16 as it -> Sql.int16 it
|
|
| :? uint16 as it -> Sql.int16 (int16 it)
|
|
| :? int as it -> Sql.int it
|
|
| :? uint32 as it -> Sql.int (int it)
|
|
| :? int64 as it -> Sql.int64 it
|
|
| :? uint64 as it -> Sql.int64 (int64 it)
|
|
| :? decimal as it -> Sql.decimal it
|
|
| :? single as it -> Sql.double (double it)
|
|
| :? double as it -> Sql.double it
|
|
| :? string as it -> Sql.string it
|
|
| _ -> catchAllFunc value
|
|
|
|
|
|
open BitBadger.Documents
|
|
|
|
/// <summary>Functions for creating parameters</summary>
|
|
[<AutoOpen>]
|
|
module Parameters =
|
|
|
|
/// <summary>Create an ID parameter (name "@id")</summary>
|
|
/// <param name="key">The key value for the ID parameter</param>
|
|
/// <returns>The name and parameter value for the ID</returns>
|
|
[<CompiledName "Id">]
|
|
let idParam (key: 'TKey) =
|
|
"@id", parameterFor key (fun it -> Sql.string (string it))
|
|
|
|
/// <summary>Create a parameter with a JSON value</summary>
|
|
/// <param name="name">The name of the parameter to create</param>
|
|
/// <param name="it">The criteria to provide as JSON</param>
|
|
/// <returns>The name and parameter value for the JSON field</returns>
|
|
[<CompiledName "Json">]
|
|
let jsonParam (name: string) (it: 'TJson) =
|
|
name, Sql.jsonb (Configuration.serializer().Serialize it)
|
|
|
|
/// <summary>Create JSON field parameters</summary>
|
|
/// <param name="fields">The <c>Field</c>s to convert to parameters</param>
|
|
/// <param name="parameters">The current parameters for the query</param>
|
|
/// <returns>A unified sequence of parameter names and values</returns>
|
|
[<CompiledName "AddFields">]
|
|
let addFieldParams fields parameters =
|
|
let name = ParameterName()
|
|
fields
|
|
|> Seq.map (fun it ->
|
|
seq {
|
|
match it.Comparison with
|
|
| Exists | NotExists -> ()
|
|
| Between (min, max) ->
|
|
let p = name.Derive it.ParameterName
|
|
yield ($"{p}min", parameterFor min (fun v -> Sql.parameter (NpgsqlParameter($"{p}min", v))))
|
|
yield ($"{p}max", parameterFor max (fun v -> Sql.parameter (NpgsqlParameter($"{p}max", v))))
|
|
| In values ->
|
|
let p = name.Derive it.ParameterName
|
|
yield!
|
|
values
|
|
|> Seq.mapi (fun idx v ->
|
|
let paramName = $"{p}_{idx}"
|
|
paramName, Sql.parameter (NpgsqlParameter(paramName, v)))
|
|
| InArray (_, values) ->
|
|
let p = name.Derive it.ParameterName
|
|
yield (p, Sql.stringArray (values |> Seq.map string |> Array.ofSeq))
|
|
| Equal v | Greater v | GreaterOrEqual v | Less v | LessOrEqual v | NotEqual v ->
|
|
let p = name.Derive it.ParameterName
|
|
yield (p, parameterFor v (fun l -> Sql.parameter (NpgsqlParameter(p, l)))) })
|
|
|> Seq.collect id
|
|
|> Seq.append parameters
|
|
|> Seq.toList
|
|
|> Seq.ofList
|
|
|
|
/// <summary>Append JSON field name parameters for the given field names to the given parameters</summary>
|
|
/// <param name="fieldNames">The names of fields to be addressed</param>
|
|
/// <returns>The name (<c>@name</c>) and parameter value for the field names</returns>
|
|
[<CompiledName "FieldNames">]
|
|
let fieldNameParams (fieldNames: string seq) =
|
|
if Seq.length fieldNames = 1 then "@name", Sql.string (Seq.head fieldNames)
|
|
else "@name", Sql.stringArray (Array.ofSeq fieldNames)
|
|
|
|
/// <summary>An empty parameter sequence</summary>
|
|
[<CompiledName "None">]
|
|
let noParams =
|
|
Seq.empty<string * SqlValue>
|
|
|
|
|
|
/// <summary>Query construction functions</summary>
|
|
[<RequireQualifiedAccess>]
|
|
module Query =
|
|
|
|
/// <summary>Create a <c>WHERE</c> clause fragment to implement a comparison on fields in a JSON document</summary>
|
|
/// <param name="howMatched">How the fields should be matched</param>
|
|
/// <param name="fields">The fields for the comparisons</param>
|
|
/// <returns>A <c>WHERE</c> clause implementing the comparisons for the given fields</returns>
|
|
[<CompiledName "WhereByFields">]
|
|
let whereByFields (howMatched: FieldMatch) fields =
|
|
let name = ParameterName()
|
|
let isNumeric (it: obj) =
|
|
match it with
|
|
| :? int8 | :? uint8 | :? int16 | :? uint16 | :? int | :? uint32 | :? int64 | :? uint64
|
|
| :? decimal | :? single | :? double -> true
|
|
| _ -> false
|
|
fields
|
|
|> Seq.map (fun it ->
|
|
match it.Comparison with
|
|
| Exists | NotExists -> $"{it.Path PostgreSQL AsSql} {it.Comparison.OpSql}"
|
|
| InArray _ -> $"{it.Path PostgreSQL AsJson} {it.Comparison.OpSql} {name.Derive it.ParameterName}"
|
|
| _ ->
|
|
let p = name.Derive it.ParameterName
|
|
let param, value =
|
|
match it.Comparison with
|
|
| Between (min, _) -> $"{p}min AND {p}max", min
|
|
| In values ->
|
|
let paramNames = values |> Seq.mapi (fun idx _ -> $"{p}_{idx}") |> String.concat ", "
|
|
$"({paramNames})", defaultArg (Seq.tryHead values) (obj ())
|
|
| Equal v | Greater v | GreaterOrEqual v | Less v | LessOrEqual v | NotEqual v -> p, v
|
|
| _ -> p, ""
|
|
if isNumeric value then
|
|
$"({it.Path PostgreSQL AsSql})::numeric {it.Comparison.OpSql} {param}"
|
|
else $"{it.Path PostgreSQL AsSql} {it.Comparison.OpSql} {param}")
|
|
|> String.concat $" {howMatched} "
|
|
|
|
/// <summary>Create a <c>WHERE</c> clause fragment to implement an ID-based query</summary>
|
|
/// <param name="docId">The ID of the document</param>
|
|
/// <returns>A <c>WHERE</c> clause fragment identifying a document by its ID</returns>
|
|
[<CompiledName "WhereById">]
|
|
let whereById<'TKey> (docId: 'TKey) =
|
|
whereByFields Any [ { Field.Equal (Configuration.idField ()) docId with ParameterName = Some "@id" } ]
|
|
|
|
/// <summary>Table and index definition queries</summary>
|
|
module Definition =
|
|
|
|
/// <summary>SQL statement to create a document table</summary>
|
|
/// <param name="name">The name of the table (may include schema)</param>
|
|
/// <returns>A query to create the table if it does not exist</returns>
|
|
[<CompiledName "EnsureTable">]
|
|
let ensureTable name =
|
|
Query.Definition.ensureTableFor name "JSONB"
|
|
|
|
/// <summary>SQL statement to create an index on JSON documents in the specified table</summary>
|
|
/// <param name="name">The name of the table to be indexed (may include schema)</param>
|
|
/// <param name="idxType">The type of document index to create</param>
|
|
/// <returns>A query to create the index if it does not exist</returns>
|
|
[<CompiledName "EnsureDocumentIndex">]
|
|
let ensureDocumentIndex (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}_document ON {name} USING GIN (data{extraOps})"
|
|
|
|
/// <summary>Create a <c>WHERE</c> clause fragment to implement a <c>@></c> (JSON contains) condition</summary>
|
|
/// <param name="paramName">The parameter name for the query</param>
|
|
/// <returns>A <c>WHERE</c> clause fragment for the contains condition</returns>
|
|
[<CompiledName "WhereDataContains">]
|
|
let whereDataContains paramName =
|
|
$"data @> %s{paramName}"
|
|
|
|
/// <summary>Create a <c>WHERE</c> clause fragment to implement a <c>@?</c> (JSON Path match) condition</summary>
|
|
/// <param name="paramName">The parameter name for the query</param>
|
|
/// <returns>A <c>WHERE</c> clause fragment for the JSON Path match condition</returns>
|
|
[<CompiledName "WhereJsonPathMatches">]
|
|
let whereJsonPathMatches paramName =
|
|
$"data @? %s{paramName}::jsonpath"
|
|
|
|
/// <summary>Create an <c>UPDATE</c> statement to patch documents</summary>
|
|
/// <param name="tableName">The table to be updated</param>
|
|
/// <returns>A query to patch documents</returns>
|
|
[<CompiledName "Patch">]
|
|
let patch tableName =
|
|
$"UPDATE %s{tableName} SET data = data || @data"
|
|
|
|
/// <summary>Create an <c>UPDATE</c> statement to remove fields from documents</summary>
|
|
/// <param name="tableName">The table to be updated</param>
|
|
/// <returns>A query to remove fields from documents</returns>
|
|
[<CompiledName "RemoveFields">]
|
|
let removeFields tableName =
|
|
$"UPDATE %s{tableName} SET data = data - @name"
|
|
|
|
/// <summary>Create a query by a document's ID</summary>
|
|
/// <param name="statement">The SQL statement to be run against a document by its ID</param>
|
|
/// <param name="docId">The ID of the document targeted</param>
|
|
/// <returns>A query addressing a document by its ID</returns>
|
|
[<CompiledName "ById">]
|
|
let byId<'TKey> statement (docId: 'TKey) =
|
|
Query.statementWhere statement (whereById docId)
|
|
|
|
/// <summary>Create a query on JSON fields</summary>
|
|
/// <param name="statement">The SQL statement to be run against matching fields</param>
|
|
/// <param name="howMatched">Whether to match any or all of the field conditions</param>
|
|
/// <param name="fields">The field conditions to be matched</param>
|
|
/// <returns>A query addressing documents by field matching conditions</returns>
|
|
[<CompiledName "ByFields">]
|
|
let byFields statement howMatched fields =
|
|
Query.statementWhere statement (whereByFields howMatched fields)
|
|
|
|
/// <summary>Create a JSON containment query</summary>
|
|
/// <param name="statement">The SQL statement to be run against the containment query</param>
|
|
/// <returns>A query addressing documents by a JSON containment query</returns>
|
|
[<CompiledName "ByContains">]
|
|
let byContains statement =
|
|
Query.statementWhere statement (whereDataContains "@criteria")
|
|
|
|
/// <summary>Create a JSON Path match query</summary>
|
|
/// <param name="statement">The SQL statement to run against the JSON Path match</param>
|
|
/// <returns>A query addressing documents by a JSON Path match</returns>
|
|
[<CompiledName "ByPathMatch">]
|
|
let byPathMatch statement =
|
|
Query.statementWhere statement (whereJsonPathMatches "@path")
|
|
|
|
|
|
/// <summary>Functions for dealing with results</summary>
|
|
[<AutoOpen>]
|
|
module Results =
|
|
|
|
/// <summary>Create a domain item from a document, specifying the field in which the document is found</summary>
|
|
/// <param name="field">The field name containing the JSON document</param>
|
|
/// <param name="row">A row reader set to the row with the document to be constructed</param>
|
|
/// <returns>The constructed domain item</returns>
|
|
[<CompiledName "FromDocument">]
|
|
let fromDocument<'T> field (row: RowReader) : 'T =
|
|
Configuration.serializer().Deserialize<'T>(row.string field)
|
|
|
|
/// <summary>Create a domain item from a document</summary>
|
|
/// <param name="row">A row reader set to the row with the document to be constructed</param>
|
|
/// <returns>The constructed domain item</returns>
|
|
[<CompiledName "FromData">]
|
|
let fromData<'T> row : 'T =
|
|
fromDocument "data" row
|
|
|
|
/// <summary>Extract a count from the column <c>it</c></summary>
|
|
/// <param name="row">A row reader set to the row with the count to retrieve</param>
|
|
/// <returns>The count from the row</returns>
|
|
[<CompiledName "ToCount">]
|
|
let toCount (row: RowReader) =
|
|
row.int "it"
|
|
|
|
/// <summary>Extract a true/false value from the column <c>it</c></summary>
|
|
/// <param name="row">A row reader set to the row with the true/false value to retrieve</param>
|
|
/// <returns>The true/false value from the row</returns>
|
|
[<CompiledName "ToExists">]
|
|
let toExists (row: RowReader) =
|
|
row.bool "it"
|
|
|
|
/// <summary>Extract a JSON document, specifying the field in which the document is found</summary>
|
|
/// <param name="field">The field name containing the JSON document</param>
|
|
/// <param name="row">A row reader set to the row with the document to be extracted</param>
|
|
/// <returns>The JSON from the given field (an empty object if no field exists)</returns>
|
|
[<CompiledName "JsonFromDocument">]
|
|
let jsonFromDocument field (row: RowReader) =
|
|
row.stringOrNone field |> Option.defaultValue "{}"
|
|
|
|
/// <summary>Extract a JSON document</summary>
|
|
/// <param name="row">A row reader set to the row with the document to be extracted</param>
|
|
/// <returns>The JSON from the row (an empty object if no field exists)</returns>
|
|
[<CompiledName "JsonFromData">]
|
|
let jsonFromData row =
|
|
jsonFromDocument "data" row
|
|
|
|
/// <summary>Create a JSON array of items for the results of a query</summary>
|
|
/// <param name="mapFunc">The mapping function to extract JSON from the query's results</param>
|
|
/// <param name="sqlProps">The query from which JSON should be extracted</param>
|
|
/// <returns>A JSON array as a string; no results will produce an empty array (<c>"[]"</c>)</returns>
|
|
[<CompiledName "FSharpToJsonArray">]
|
|
let toJsonArray (mapFunc: RowReader -> string) sqlProps = backgroundTask {
|
|
let output = StringBuilder("[")
|
|
do! sqlProps
|
|
|> Sql.iterAsync (fun it ->
|
|
if output.Length > 2 then ignore (output.Append ",")
|
|
mapFunc it |> output.Append |> ignore)
|
|
return output.Append("]").ToString()
|
|
}
|
|
|
|
/// <summary>Create a JSON array of items for the results of a query</summary>
|
|
/// <param name="mapFunc">The mapping function to extract JSON from the query's results</param>
|
|
/// <param name="sqlProps">The query from which JSON should be extracted</param>
|
|
/// <returns>A JSON array as a string; no results will produce an empty array (<c>"[]"</c>)</returns>
|
|
let ToJsonArray(mapFunc: System.Func<RowReader, string>, sqlProps) =
|
|
toJsonArray mapFunc.Invoke sqlProps
|
|
|
|
/// <summary>Write a JSON array of items for the results of a query to the given <c>StreamWriter</c></summary>
|
|
/// <param name="writer">The StreamWriter to which results should be written</param>
|
|
/// <param name="mapFunc">The mapping function to extract JSON from the query's results</param>
|
|
/// <param name="sqlProps">The query from which JSON should be extracted</param>
|
|
[<CompiledName "FSharpWriteJsonArray">]
|
|
let writeJsonArray (writer: StreamWriter) (mapFunc: RowReader -> string) sqlProps = backgroundTask {
|
|
do! writer.WriteAsync "["
|
|
let mutable isFirst = true
|
|
do! sqlProps
|
|
|> Sql.iterAsync (fun it ->
|
|
if isFirst then isFirst <- false else writer.Write ","
|
|
writer.WriteAsync(mapFunc it).ConfigureAwait(false).GetAwaiter().GetResult())
|
|
do! writer.WriteAsync "]"
|
|
}
|
|
|
|
/// <summary>Write a JSON array of items for the results of a query to the given <c>StreamWriter</c></summary>
|
|
/// <param name="writer">The StreamWriter to which results should be written</param>
|
|
/// <param name="mapFunc">The mapping function to extract JSON from the query's results</param>
|
|
/// <param name="sqlProps">The query from which JSON should be extracted</param>
|
|
let WriteJsonArray(writer, mapFunc: System.Func<RowReader, string>, sqlProps) =
|
|
writeJsonArray writer mapFunc.Invoke sqlProps
|