namespace BitBadger.Documents.Postgres
open System.IO
open System.Text
/// 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
open Npgsql
/// Configuration for document handling
module Configuration =
/// The data source to use for query execution
let mutable private dataSourceValue : NpgsqlDataSource option = None
/// Register a data source to use for query execution (disposes the current one if it exists)
/// The data source to use
[]
let useDataSource source =
if Option.isSome dataSourceValue then dataSourceValue.Value.Dispose()
dataSourceValue <- Some source
/// Retrieve the currently configured data source
/// The current data source
/// If no data source has been configured
[]
let dataSource () =
match dataSourceValue with
| Some source -> source
| None -> invalidOp "Please provide a data source before attempting data access"
open Npgsql.FSharp
/// Helper functions
[]
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
/// Functions for creating parameters
[]
module Parameters =
/// Create an ID parameter (name "@id")
/// The key value for the ID parameter
/// The name and parameter value for the ID
[]
let idParam (key: 'TKey) =
"@id", parameterFor key (fun it -> Sql.string (string it))
/// Create a parameter with a JSON value
/// The name of the parameter to create
/// The criteria to provide as JSON
/// The name and parameter value for the JSON field
[]
let jsonParam (name: string) (it: 'TJson) =
name, Sql.jsonb (Configuration.serializer().Serialize it)
/// Create JSON field parameters
/// The Fields to convert to parameters
/// The current parameters for the query
/// A unified sequence of parameter names and values
[]
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
/// Append JSON field name parameters for the given field names to the given parameters
/// The names of fields to be addressed
/// The name (@name) and parameter value for the field names
[]
let fieldNameParams (fieldNames: string seq) =
if Seq.length fieldNames = 1 then "@name", Sql.string (Seq.head fieldNames)
else "@name", Sql.stringArray (Array.ofSeq fieldNames)
/// An empty parameter sequence
[]
let noParams =
Seq.empty
/// Query construction functions
[]
module Query =
///
/// Create a WHERE clause fragment to implement a comparison on fields in a JSON document
///
/// How the fields should be matched
/// The fields for the comparisons
/// A WHERE clause implementing the comparisons for the given fields
[]
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} "
/// Create a WHERE clause fragment to implement an ID-based query
/// The ID of the document
/// A WHERE clause fragment identifying a document by its ID
[]
let whereById<'TKey> (docId: 'TKey) =
whereByFields Any [ { Field.Equal (Configuration.idField ()) docId with ParameterName = Some "@id" } ]
/// Table and index definition queries
module Definition =
/// SQL statement to create a document table
/// The name of the table (may include schema)
/// A query to create the table if it does not exist
[]
let ensureTable name =
Query.Definition.ensureTableFor name "JSONB"
/// SQL statement to create an index on JSON documents in the specified table
/// The name of the table to be indexed (may include schema)
/// The type of document index to create
/// A query to create the index if it does not exist
[]
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})"
///
/// Create a WHERE clause fragment to implement a @> (JSON contains) condition
///
/// The parameter name for the query
/// A WHERE clause fragment for the contains condition
[]
let whereDataContains paramName =
$"data @> %s{paramName}"
///
/// Create a WHERE clause fragment to implement a @? (JSON Path match) condition
///
/// The parameter name for the query
/// A WHERE clause fragment for the JSON Path match condition
[]
let whereJsonPathMatches paramName =
$"data @? %s{paramName}::jsonpath"
/// Create an UPDATE statement to patch documents
/// The table to be updated
/// A query to patch documents
[]
let patch tableName =
$"UPDATE %s{tableName} SET data = data || @data"
/// Create an UPDATE statement to remove fields from documents
/// The table to be updated
/// A query to remove fields from documents
[]
let removeFields tableName =
$"UPDATE %s{tableName} SET data = data - @name"
/// Create a query by a document's ID
/// The SQL statement to be run against a document by its ID
/// The ID of the document targeted
/// A query addressing a document by its ID
[]
let byId<'TKey> statement (docId: 'TKey) =
Query.statementWhere statement (whereById docId)
/// Create a query on JSON fields
/// The SQL statement to be run against matching fields
/// Whether to match any or all of the field conditions
/// The field conditions to be matched
/// A query addressing documents by field matching conditions
[]
let byFields statement howMatched fields =
Query.statementWhere statement (whereByFields howMatched fields)
/// Create a JSON containment query
/// The SQL statement to be run against the containment query
/// A query addressing documents by a JSON containment query
[]
let byContains statement =
Query.statementWhere statement (whereDataContains "@criteria")
/// Create a JSON Path match query
/// The SQL statement to run against the JSON Path match
/// A query addressing documents by a JSON Path match
[]
let byPathMatch statement =
Query.statementWhere statement (whereJsonPathMatches "@path")
/// Functions for dealing with results
[]
module Results =
/// Create a domain item from a document, specifying the field in which the document is found
/// The field name containing the JSON document
/// A row reader set to the row with the document to be constructed
/// The constructed domain item
[]
let fromDocument<'T> field (row: RowReader) : 'T =
Configuration.serializer().Deserialize<'T>(row.string field)
/// Create a domain item from a document
/// A row reader set to the row with the document to be constructed
/// The constructed domain item
[]
let fromData<'T> row : 'T =
fromDocument "data" row
/// Extract a count from the column it
/// A row reader set to the row with the count to retrieve
/// The count from the row
[]
let toCount (row: RowReader) =
row.int "it"
/// Extract a true/false value from the column it
/// A row reader set to the row with the true/false value to retrieve
/// The true/false value from the row
[]
let toExists (row: RowReader) =
row.bool "it"
/// Extract a JSON document, specifying the field in which the document is found
/// The field name containing the JSON document
/// A row reader set to the row with the document to be extracted
/// The JSON from the given field (an empty object if no field exists)
[]
let jsonFromDocument field (row: RowReader) =
row.stringOrNone field |> Option.defaultValue "{}"
/// Extract a JSON document
/// A row reader set to the row with the document to be extracted
/// The JSON from the row (an empty object if no field exists)
[]
let jsonFromData row =
jsonFromDocument "data" row
/// Create a JSON array of items for the results of a query
/// The mapping function to extract JSON from the query's results
/// The query from which JSON should be extracted
/// A JSON array as a string; no results will produce an empty array ("[]")
[]
let toJsonArray (mapFunc: RowReader -> string) sqlProps =
let output = StringBuilder("[")
sqlProps
|> Sql.iter (fun it ->
if output.Length > 2 then ignore (output.Append ",")
mapFunc it |> output.Append |> ignore)
output.Append("]").ToString()
/// Create a JSON array of items for the results of a query
/// The mapping function to extract JSON from the query's results
/// The query from which JSON should be extracted
/// A JSON array as a string; no results will produce an empty array ("[]")
let ToJsonArray(mapFunc: System.Func, sqlProps) =
toJsonArray mapFunc.Invoke sqlProps
/// Write a JSON array of items for the results of a query to the given StreamWriter
/// The StreamWriter to which results should be written
/// The mapping function to extract JSON from the query's results
/// The query from which JSON should be extracted
[]
let writeJsonArray (writer: StreamWriter) (mapFunc: RowReader -> string) sqlProps =
writer.Write "["
let mutable isFirst = true
sqlProps
|> Sql.iter (fun it ->
if isFirst then isFirst <- false else writer.Write ","
mapFunc it |> writer.Write)
writer.Write "]"
/// Write a JSON array of items for the results of a query to the given StreamWriter
/// The StreamWriter to which results should be written
/// The mapping function to extract JSON from the query's results
/// The query from which JSON should be extracted
let WriteJsonArray(writer, mapFunc: System.Func, sqlProps) =
writeJsonArray writer mapFunc.Invoke sqlProps