namespace BitBadger.Documents /// The types of logical operations available for JSON fields [] type Op = /// Equals (=) | EQ /// Greater Than (>) | GT /// Greater Than or Equal To (>=) | GE /// Less Than (<) | LT /// Less Than or Equal To (<=) | LE /// Not Equal to (<>) | NE /// Between (BETWEEN) | BT /// Exists (IS NOT NULL) | EX /// Does Not Exist (IS NULL) | NEX override this.ToString() = match this with | EQ -> "=" | GT -> ">" | GE -> ">=" | LT -> "<" | LE -> "<=" | NE -> "<>" | BT -> "BETWEEN" | EX -> "IS NOT NULL" | NEX -> "IS NULL" /// Criteria for a field WHERE clause type Field = { /// The name of the field Name: string /// The operation by which the field will be compared Op: Op /// The value of the field Value: obj /// The name of the parameter for this field ParameterName: string option /// The table qualifier for this field Qualifier: string option } with /// Create an equals (=) field criterion static member EQ name (value: obj) = { Name = name; Op = EQ; Value = value; ParameterName = None; Qualifier = None } /// Create a greater than (>) field criterion static member GT name (value: obj) = { Name = name; Op = GT; Value = value; ParameterName = None; Qualifier = None } /// Create a greater than or equal to (>=) field criterion static member GE name (value: obj) = { Name = name; Op = GE; Value = value; ParameterName = None; Qualifier = None } /// Create a less than (<) field criterion static member LT name (value: obj) = { Name = name; Op = LT; Value = value; ParameterName = None; Qualifier = None } /// Create a less than or equal to (<=) field criterion static member LE name (value: obj) = { Name = name; Op = LE; Value = value; ParameterName = None; Qualifier = None } /// Create a not equals (<>) field criterion static member NE name (value: obj) = { Name = name; Op = NE; Value = value; ParameterName = None; Qualifier = None } /// Create a BETWEEN field criterion static member BT name (min: obj) (max: obj) = { Name = name; Op = BT; Value = [ min; max ]; ParameterName = None; Qualifier = None } /// Create an exists (IS NOT NULL) field criterion static member EX name = { Name = name; Op = EX; Value = obj (); ParameterName = None; Qualifier = None } /// Create a not exists (IS NULL) field criterion static member NEX name = { Name = name; Op = NEX; Value = obj (); ParameterName = None; Qualifier = None } /// Specify the name of the parameter for this field member this.WithParameterName name = { this with ParameterName = Some name } /// Specify a qualifier (alias) for the table from which this field will be referenced member this.WithQualifier alias = { this with Qualifier = Some alias } /// Get the path for this field in PostgreSQL's format member this.PgSqlPath = (this.Qualifier |> Option.map (fun q -> $"{q}.data") |> Option.defaultValue "data") + if this.Name.Contains '.' then "#>>'{" + String.concat "," (this.Name.Split '.') + "}'" else $"->>'{this.Name}'" /// Get the path for this field in SQLite's format member this.SqlitePath = (this.Qualifier |> Option.map (fun q -> $"{q}.data") |> Option.defaultValue "data") + if this.Name.Contains '.' then "->>'" + String.concat "'->>'" (this.Name.Split '.') + "'" else $"->>'{this.Name}'" /// How fields should be matched [] type FieldMatch = /// Any field matches (OR) | Any /// All fields match (AND) | All /// Derive parameter names (each instance wraps a counter to uniquely name anonymous fields) type ParameterName() = /// The counter for the next field value let mutable currentIdx = -1 /// Return the specified name for the parameter, or an anonymous parameter name if none is specified member this.Derive paramName = match paramName with | Some it -> it | None -> currentIdx <- currentIdx + 1 $"@field{currentIdx}" /// The required document serialization implementation type IDocumentSerializer = /// Serialize an object to a JSON string abstract Serialize<'T> : 'T -> string /// Deserialize a JSON string into an object abstract Deserialize<'T> : string -> 'T /// Document serializer defaults module DocumentSerializer = open System.Text.Json open System.Text.Json.Serialization /// The default JSON serializer options to use with the stock serializer let private jsonDefaultOpts = let o = JsonSerializerOptions() o.Converters.Add(JsonFSharpConverter()) o /// The default JSON serializer [] let ``default`` = { new IDocumentSerializer with member _.Serialize<'T>(it: 'T) : string = JsonSerializer.Serialize(it, jsonDefaultOpts) member _.Deserialize<'T>(it: string) : 'T = JsonSerializer.Deserialize<'T>(it, jsonDefaultOpts) } /// Configuration for document handling [] module Configuration = /// The serializer to use for document manipulation let mutable private serializerValue = DocumentSerializer.``default`` /// Register a serializer to use for translating documents to domain types [] let useSerializer ser = serializerValue <- ser /// Retrieve the currently configured serializer [] let serializer () = serializerValue /// The serialized name of the ID field for documents let mutable idFieldValue = "Id" /// Specify the name of the ID field for documents [] let useIdField it = idFieldValue <- it /// Retrieve the currently configured ID field for documents [] let idField () = idFieldValue /// Query construction functions [] module Query = /// Create a SELECT clause to retrieve the document data from the given table [] let selectFromTable tableName = $"SELECT data FROM %s{tableName}" /// Queries to define tables and indexes module Definition = /// SQL statement to create a document table [] let ensureTableFor name dataType = $"CREATE TABLE IF NOT EXISTS %s{name} (data %s{dataType} NOT NULL)" /// Split a schema and table name let private splitSchemaAndTable (tableName: string) = let parts = tableName.Split '.' if Array.length parts = 1 then "", tableName else parts[0], parts[1] /// SQL statement to create an index on one or more fields in a JSON document [] let ensureIndexOn tableName indexName (fields: string seq) = let _, tbl = splitSchemaAndTable tableName let jsonFields = fields |> Seq.map (fun it -> let parts = it.Split ' ' let fieldName = if Array.length parts = 1 then it else parts[0] let direction = if Array.length parts < 2 then "" else $" {parts[1]}" $"(data ->> '{fieldName}'){direction}") |> String.concat ", " $"CREATE INDEX IF NOT EXISTS idx_{tbl}_%s{indexName} ON {tableName} ({jsonFields})" /// SQL statement to create a key index for a document table [] let ensureKey tableName = (ensureIndexOn tableName "key" [ Configuration.idField () ]).Replace("INDEX", "UNIQUE INDEX") /// Query to insert a document [] let insert tableName = $"INSERT INTO %s{tableName} VALUES (@data)" /// Query to save a document, inserting it if it does not exist and updating it if it does (AKA "upsert") [] let save tableName = sprintf "INSERT INTO %s VALUES (@data) ON CONFLICT ((data->>'%s')) DO UPDATE SET data = EXCLUDED.data" tableName (Configuration.idField ())