322 lines
15 KiB
Forth
322 lines
15 KiB
Forth
namespace BitBadger.Documents.Sqlite
|
|
|
|
open Microsoft.Data.Sqlite
|
|
|
|
/// <summary>Configuration for document handling</summary>
|
|
module Configuration =
|
|
|
|
/// The connection string to use for query execution
|
|
let mutable internal connectionString: string option = None
|
|
|
|
/// <summary>Register a connection string to use for query execution</summary>
|
|
/// <param name="connStr">The connection string to use for connections from this library</param>
|
|
/// <remarks>This also enables foreign keys</remarks>
|
|
[<CompiledName "UseConnectionString">]
|
|
let useConnectionString connStr =
|
|
let builder = SqliteConnectionStringBuilder connStr
|
|
builder.ForeignKeys <- Option.toNullable (Some true)
|
|
connectionString <- Some (string builder)
|
|
|
|
/// <summary>Retrieve a new connection using currently configured connection string</summary>
|
|
/// <returns>A new database connection</returns>
|
|
/// <exception cref="T:System.InvalidOperationException">If no data source has been configured</exception>
|
|
/// <exception cref="SqliteException">If the connection cannot be opened</exception>
|
|
[<CompiledName "DbConn">]
|
|
let dbConn () =
|
|
match connectionString with
|
|
| Some connStr ->
|
|
let conn = new SqliteConnection(connStr)
|
|
conn.Open()
|
|
conn
|
|
| None -> invalidOp "Please provide a connection string before attempting data access"
|
|
|
|
|
|
open BitBadger.Documents
|
|
|
|
/// <summary>Query definitions</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()
|
|
fields
|
|
|> Seq.map (fun it ->
|
|
match it.Comparison with
|
|
| Exists | NotExists -> $"{it.Path SQLite AsSql} {it.Comparison.OpSql}"
|
|
| Between _ ->
|
|
let p = name.Derive it.ParameterName
|
|
$"{it.Path SQLite AsSql} {it.Comparison.OpSql} {p}min AND {p}max"
|
|
| In values ->
|
|
let p = name.Derive it.ParameterName
|
|
let paramNames = values |> Seq.mapi (fun idx _ -> $"{p}_{idx}") |> String.concat ", "
|
|
$"{it.Path SQLite AsSql} {it.Comparison.OpSql} ({paramNames})"
|
|
| InArray (table, values) ->
|
|
let p = name.Derive it.ParameterName
|
|
let paramNames = values |> Seq.mapi (fun idx _ -> $"{p}_{idx}") |> String.concat ", "
|
|
$"EXISTS (SELECT 1 FROM json_each({table}.data, '$.{it.Name}') WHERE value IN ({paramNames}))"
|
|
| _ -> $"{it.Path SQLite AsSql} {it.Comparison.OpSql} {name.Derive it.ParameterName}")
|
|
|> 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 (docId: 'TKey) =
|
|
whereByFields Any [ { Field.Equal (Configuration.idField ()) docId with ParameterName = Some "@id" } ]
|
|
|
|
/// <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 = json_patch(data, json(@data))"
|
|
|
|
/// <summary>Create an <c>UPDATE</c> statement to remove fields from documents</summary>
|
|
/// <param name="tableName">The table to be updated</param>
|
|
/// <param name="parameters">The parameters with the field names to be removed</param>
|
|
/// <returns>A query to remove fields from documents</returns>
|
|
[<CompiledName "RemoveFields">]
|
|
let removeFields tableName (parameters: SqliteParameter seq) =
|
|
let paramNames = parameters |> Seq.map _.ParameterName |> String.concat ", "
|
|
$"UPDATE %s{tableName} SET data = json_remove(data, {paramNames})"
|
|
|
|
/// <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
|
|
(whereByFields Any [ { Field.Equal (Configuration.idField ()) docId with ParameterName = Some "@id" } ])
|
|
|
|
/// <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>Data definition</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 "TEXT"
|
|
|
|
|
|
/// <summary>Parameter handling helpers</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) =
|
|
SqliteParameter("@id", string key)
|
|
|
|
/// <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 (it: 'TJson) =
|
|
SqliteParameter(name, 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! [ SqliteParameter($"{p}min", min); SqliteParameter($"{p}max", max) ]
|
|
| In values | InArray (_, values) ->
|
|
let p = name.Derive it.ParameterName
|
|
yield! values |> Seq.mapi (fun idx v -> SqliteParameter($"{p}_{idx}", v))
|
|
| Equal v | Greater v | GreaterOrEqual v | Less v | LessOrEqual v | NotEqual v ->
|
|
yield SqliteParameter(name.Derive it.ParameterName, v) })
|
|
|> Seq.collect id
|
|
|> Seq.append parameters
|
|
|> Seq.toList
|
|
|> Seq.ofList
|
|
|
|
/// Create a JSON field parameter (name "@field")
|
|
[<CompiledName "AddField">]
|
|
[<System.Obsolete "Use addFieldParams instead; will be removed in v4">]
|
|
let addFieldParam name field parameters =
|
|
addFieldParams [ { field with ParameterName = Some name } ] parameters
|
|
|
|
/// <summary>Append JSON field name parameters for the given field names to the given parameters</summary>
|
|
/// <param name="paramName">The name of the parameter to use for each field</param>
|
|
/// <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 paramName fieldNames =
|
|
fieldNames
|
|
|> Seq.mapi (fun idx name -> SqliteParameter($"%s{paramName}{idx}", $"$.%s{name}"))
|
|
|> Seq.toList
|
|
|> Seq.ofList
|
|
|
|
/// <summary>An empty parameter sequence</summary>
|
|
[<CompiledName "None">]
|
|
let noParams =
|
|
Seq.empty<SqliteParameter>
|
|
|
|
|
|
open System.Text
|
|
|
|
/// <summary>Helper functions for handling 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="rdr">A <c>SqliteDataReader</c> set to the row with the document to be constructed</param>
|
|
/// <returns>The constructed domain item</returns>
|
|
[<CompiledName "FromDocument">]
|
|
let fromDocument<'TDoc> field (rdr: SqliteDataReader) : 'TDoc =
|
|
Configuration.serializer().Deserialize<'TDoc>(rdr.GetString(rdr.GetOrdinal field))
|
|
|
|
/// <summary>Create a domain item from a document</summary>
|
|
/// <param name="rdr">A <c>SqliteDataReader</c> set to the row with the document to be constructed</param>
|
|
/// <returns>The constructed domain item</returns>
|
|
[<CompiledName "FromData">]
|
|
let fromData<'TDoc> rdr =
|
|
fromDocument<'TDoc> "data" rdr
|
|
|
|
/// <summary>
|
|
/// Create a list of items for the results of the given command, using the specified mapping function
|
|
/// </summary>
|
|
/// <param name="cmd">The command to execute</param>
|
|
/// <param name="mapFunc">The mapping function from data reader to domain class instance</param>
|
|
/// <returns>A list of items from the reader</returns>
|
|
[<CompiledName "FSharpToCustomList">]
|
|
let toCustomList<'TDoc> (cmd: SqliteCommand) (mapFunc: SqliteDataReader -> 'TDoc) = backgroundTask {
|
|
use! rdr = cmd.ExecuteReaderAsync()
|
|
let mutable it = Seq.empty<'TDoc>
|
|
while! rdr.ReadAsync() do
|
|
it <- Seq.append it (Seq.singleton (mapFunc rdr))
|
|
return List.ofSeq it
|
|
}
|
|
|
|
/// <summary>
|
|
/// Create a list of items for the results of the given command, using the specified mapping function
|
|
/// </summary>
|
|
/// <param name="cmd">The command to execute</param>
|
|
/// <param name="mapFunc">The mapping function from data reader to domain class instance</param>
|
|
/// <returns>A list of items from the reader</returns>
|
|
let ToCustomList<'TDoc>(cmd: SqliteCommand, mapFunc: System.Func<SqliteDataReader, 'TDoc>) = backgroundTask {
|
|
use! rdr = cmd.ExecuteReaderAsync()
|
|
let it = ResizeArray<'TDoc>()
|
|
while! rdr.ReadAsync() do
|
|
it.Add(mapFunc.Invoke rdr)
|
|
return it
|
|
}
|
|
|
|
/// <summary>Extract a count from the first column</summary>
|
|
/// <param name="rdr">A <c>SqliteDataReader</c> set to the row with the count to retrieve</param>
|
|
/// <returns>The count from the row</returns>
|
|
[<CompiledName "ToCount">]
|
|
let toCount (rdr: SqliteDataReader) =
|
|
rdr.GetInt64 0
|
|
|
|
/// <summary>Extract a true/false value from the first column</summary>
|
|
/// <param name="rdr">A <c>SqliteDataReader</c> set to the row with the true/false value to retrieve</param>
|
|
/// <returns>The true/false value from the row</returns>
|
|
/// <remarks>SQLite implements boolean as 1 = true, 0 = false</remarks>
|
|
[<CompiledName "ToExists">]
|
|
let toExists rdr =
|
|
toCount rdr > 0L
|
|
|
|
/// <summary>Retrieve 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="rdr">A <c>SqliteDataReader</c> set to the row with the document to be constructed</param>
|
|
/// <returns>The JSON document (an empty JSON document if not found)</returns>
|
|
[<CompiledName "JsonFromDocument">]
|
|
let jsonFromDocument field (rdr: SqliteDataReader) =
|
|
try
|
|
let idx = rdr.GetOrdinal field
|
|
if rdr.IsDBNull idx then "{}" else rdr.GetString idx
|
|
with :? System.IndexOutOfRangeException -> "{}"
|
|
|
|
/// <summary>Retrieve a JSON document</summary>
|
|
/// <param name="rdr">A <c>SqliteDataReader</c> set to the row with the document to be constructed</param>
|
|
/// <returns>The JSON document (an empty JSON document if not found)</returns>
|
|
[<CompiledName "JsonFromData">]
|
|
let jsonFromData rdr =
|
|
jsonFromDocument "data" rdr
|
|
|
|
/// <summary>
|
|
/// Create a JSON array for the results of the given command, using the specified mapping function
|
|
/// </summary>
|
|
/// <param name="cmd">The command to execute</param>
|
|
/// <param name="mapFunc">The mapping function to extract JSON from the query's results</param>
|
|
/// <returns>A JSON array of items from the reader</returns>
|
|
[<CompiledName "FSharpToJsonArray">]
|
|
let toJsonArray (cmd: SqliteCommand) (mapFunc: SqliteDataReader -> string) = backgroundTask {
|
|
use! rdr = cmd.ExecuteReaderAsync()
|
|
let it = StringBuilder "["
|
|
while! rdr.ReadAsync() do
|
|
if it.Length > 2 then ignore (it.Append ",")
|
|
it.Append(mapFunc rdr) |> ignore
|
|
return it.Append("]").ToString()
|
|
}
|
|
|
|
/// <summary>
|
|
/// Create a JSON array for the results of the given command, using the specified mapping function
|
|
/// </summary>
|
|
/// <param name="cmd">The command to execute</param>
|
|
/// <param name="mapFunc">The mapping function to extract JSON from the query's results</param>
|
|
/// <returns>A JSON array of items from the reader</returns>
|
|
let ToJsonArray (cmd: SqliteCommand) (mapFunc: System.Func<SqliteDataReader, string>) =
|
|
toJsonArray cmd mapFunc.Invoke
|
|
|
|
/// <summary>Write a JSON array of items for the results of a query to the given <c>StreamWriter</c></summary>
|
|
/// <param name="cmd">The command to execute</param>
|
|
/// <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>
|
|
[<CompiledName "FSharpWriteJsonArray">]
|
|
let writeJsonArray (cmd: SqliteCommand) writer (mapFunc: SqliteDataReader -> string) = backgroundTask {
|
|
use! rdr = cmd.ExecuteReaderAsync()
|
|
return
|
|
seq { while rdr.Read() do yield mapFunc rdr }
|
|
|> PipeWriter.writeStrings writer
|
|
}
|
|
|
|
/// <summary>Write a JSON array of items for the results of a query to the given <c>StreamWriter</c></summary>
|
|
/// <param name="cmd">The command to execute</param>
|
|
/// <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>
|
|
let WriteJsonArray (cmd: SqliteCommand) writer (mapFunc: System.Func<SqliteDataReader, string>) =
|
|
writeJsonArray cmd writer mapFunc.Invoke
|
|
|
|
|
|
[<AutoOpen>]
|
|
module internal Helpers =
|
|
|
|
/// <summary>Execute a non-query command</summary>
|
|
/// <param name="cmd">The command to be executed</param>
|
|
let internal write (cmd: SqliteCommand) = backgroundTask {
|
|
let! _ = cmd.ExecuteNonQueryAsync()
|
|
()
|
|
}
|