src/Common/Library.fs

@@ -119,6 +119,35 @@ module Query =
     let whereById paramName =
         whereByField (Configuration.idField ()) EQ paramName
     
+    /// 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
     [<CompiledName "Insert">]
     let insert tableName =

src/Sqlite/Library.fs

@@ -25,41 +25,23 @@ module Configuration =
         | None -> invalidOp "Please provide a connection string before attempting data access"
 
 
+[<RequireQualifiedAccess>]
+module Query =
+    
+    /// Data definition
+    module Definition =
+
+        /// SQL statement to create a document table
+        let ensureTable name =
+            Query.Definition.ensureTableFor name "TEXT"
+
+
 /// Execute a non-query command
 let internal write (cmd: SqliteCommand) = backgroundTask {
     let! _ = cmd.ExecuteNonQueryAsync()
     ()
 }
 
-/// Data definition
-[<RequireQualifiedAccess>]
-module Definition =
-
-    /// SQL statement to create a document table
-    let createTable name =
-        $"CREATE TABLE IF NOT EXISTS %s{name} (data TEXT NOT NULL)"
-    
-    /// SQL statement to create a key index for a document table
-    let createKey name =
-        $"CREATE UNIQUE INDEX IF NOT EXISTS idx_%s{name}_key ON {name} ((data ->> '{Configuration.idField ()}'))"
-        
-    /// Definitions that take a SqliteConnection as their last parameter
-    module WithConn =
-        
-        /// Create a document table
-        let ensureTable name (conn: SqliteConnection) = backgroundTask {
-            use cmd = conn.CreateCommand()
-            cmd.CommandText <- createTable name
-            do! write cmd
-            cmd.CommandText <- createKey name
-            do! write cmd
-        }
-    
-    /// Create a document table
-    let ensureTable name =
-        use conn = Configuration.dbConn ()
-        WithConn.ensureTable name conn
-
 
 /// Add a parameter to a SQLite command, ignoring the return value (can still be accessed on cmd via indexing)
 let addParam (cmd: SqliteCommand) name (value: obj) =
@@ -118,6 +100,26 @@ open System.Threading.Tasks
 /// Versions of queries that accept a SqliteConnection as the last parameter
 module WithConn =
     
+    /// Functions to create tables and indexes
+    [<RequireQualifiedAccess>]
+    module Definition =
+        
+        /// Create a document table
+        let ensureTable name (conn: SqliteConnection) = backgroundTask {
+            use cmd = conn.CreateCommand()
+            cmd.CommandText <- Query.Definition.ensureTable name
+            do! write cmd
+            cmd.CommandText <- Query.Definition.ensureKey name
+            do! write cmd
+        }
+        
+        /// Create an index on a document table
+        let ensureIndex tableName indexName fields (conn: SqliteConnection) = backgroundTask {
+            use cmd = conn.CreateCommand()
+            cmd.CommandText <- Query.Definition.ensureIndexOn tableName indexName fields
+            do! write cmd
+        }
+
     /// Insert a new document
     let insert<'TDoc> tableName (document: 'TDoc) conn =
         executeNonQuery (Query.insert tableName) document conn
@@ -280,6 +282,15 @@ module WithConn =
             return if isFound then mapFunc rdr else Unchecked.defaultof<'T>
         }
 
+/// Functions to create tables and indexes
+[<RequireQualifiedAccess>]
+module Definition =
+
+    /// Create a document table
+    let ensureTable name =
+        use conn = Configuration.dbConn ()
+        WithConn.Definition.ensureTable name conn
+
 /// Insert a new document
 let insert<'TDoc> tableName (document: 'TDoc) =
     use conn = Configuration.dbConn ()
@@ -411,7 +422,11 @@ module Extensions =
         
         /// Create a document table
         member conn.ensureTable name =
-            Definition.WithConn.ensureTable name conn
+            WithConn.Definition.ensureTable name conn
+        
+        /// Create an index on a document table
+        member conn.ensureIndex tableName indexName fields =
+            WithConn.Definition.ensureIndex tableName indexName fields conn
         
         /// Insert a new document
         member conn.insert<'TDoc> tableName (document: 'TDoc) =

src/Tests/CommonTests.fs

@@ -56,6 +56,36 @@ let all =
                         "WHERE clause not correct"
                 }
             ]
+            testList "Definition" [
+                test "ensureTableFor succeeds" {
+                    Expect.equal
+                        (Query.Definition.ensureTableFor "my.table" "JSONB")
+                        "CREATE TABLE IF NOT EXISTS my.table (data JSONB NOT NULL)"
+                        "CREATE TABLE statement not constructed correctly"
+                }
+                testList "ensureKey" [
+                    test "succeeds when a schema is present" {
+                        Expect.equal
+                            (Query.Definition.ensureKey "test.table")
+                            "CREATE UNIQUE INDEX IF NOT EXISTS idx_table_key ON test.table ((data ->> 'Id'))"
+                            "CREATE INDEX for key statement with schema not constructed correctly"
+                    }
+                    test "succeeds when a schema is not present" {
+                        Expect.equal
+                            (Query.Definition.ensureKey "table")
+                            "CREATE UNIQUE INDEX IF NOT EXISTS idx_table_key ON table ((data ->> 'Id'))"
+                            "CREATE INDEX for key statement without schema not constructed correctly"
+                    }
+                ]
+                test "ensureIndexOn succeeds for multiple fields and directions" {
+                    Expect.equal
+                        (Query.Definition.ensureIndexOn "test.table" "gibberish" [ "taco"; "guac DESC"; "salsa ASC" ])
+                        ([ "CREATE INDEX IF NOT EXISTS idx_table_gibberish ON test.table "
+                           "((data ->> 'taco'), (data ->> 'guac') DESC, (data ->> 'salsa') ASC)" ]
+                         |> String.concat "")
+                        "CREATE INDEX for multiple field statement incorrect"
+                }
+            ]
             test "insert succeeds" {
                 Expect.equal (Query.insert tbl) $"INSERT INTO {tbl} VALUES (@data)" "INSERT statement not correct"
             }

src/Tests/SqliteTests.fs

@@ -49,169 +49,16 @@ module Db =
     }
 
 
+/// A function that always returns true
+let isTrue<'T> (_ : 'T) = true
+
+
 open BitBadger.Documents
 open Expecto
 open Microsoft.Data.Sqlite
 
-/// Tests which do not hit the database
-let unitTests =
-    testList "Unit" [
-        testList "Definition" [
-            test "createTable succeeds" {
-                Expect.equal (Definition.createTable Db.tableName)
-                    $"CREATE TABLE IF NOT EXISTS {Db.tableName} (data TEXT NOT NULL)"
-                    "CREATE TABLE statement not constructed correctly"
-            }
-            test "createKey succeeds" {
-                Expect.equal (Definition.createKey Db.tableName)
-                    $"CREATE UNIQUE INDEX IF NOT EXISTS idx_{Db.tableName}_key ON {Db.tableName} ((data ->> 'Id'))"
-                    "CREATE INDEX for key statement not constructed correctly"
-            }
-        ]
-        testList "Op" [
-            test "EQ succeeds" {
-                Expect.equal (string EQ) "=" "The equals operator was not correct"
-            }
-            test "GT succeeds" {
-                Expect.equal (string GT) ">" "The greater than operator was not correct"
-            }
-            test "GE succeeds" {
-                Expect.equal (string GE) ">=" "The greater than or equal to operator was not correct"
-            }
-            test "LT succeeds" {
-                Expect.equal (string LT) "<" "The less than operator was not correct"
-            }
-            test "LE succeeds" {
-                Expect.equal (string LE) "<=" "The less than or equal to operator was not correct"
-            }
-            test "NE succeeds" {
-                Expect.equal (string NE) "<>" "The not equal to operator was not correct"
-            }
-            test "EX succeeds" {
-                Expect.equal (string EX) "IS NOT NULL" """The "exists" operator ws not correct"""
-            }
-            test "NEX succeeds" {
-                Expect.equal (string NEX) "IS NULL" """The "not exists" operator ws not correct"""
-            }
-        ]
-        testList "Query" [
-            test "selectFromTable succeeds" {
-                Expect.equal
-                    (Query.selectFromTable Db.tableName)
-                    $"SELECT data FROM {Db.tableName}"
-                    "SELECT statement not correct"
-            }
-            test "whereById succeeds" {
-                Expect.equal (Query.whereById "@id") "data ->> 'Id' = @id" "WHERE clause not correct"
-            }
-            testList "whereByField" [
-                test "succeeds when a logical operator is passed" {
-                    Expect.equal
-                        (Query.whereByField "theField" GT "@test")
-                        "data ->> 'theField' > @test"
-                        "WHERE clause not correct"
-                }
-                test "succeeds when an existence operator is passed" {
-                    Expect.equal
-                        (Query.whereByField "thatField" NEX "")
-                        "data ->> 'thatField' IS NULL"
-                        "WHERE clause not correct"
-                }
-            ]
-            test "insert succeeds" {
-                Expect.equal
-                    (Query.insert Db.tableName)
-                    $"INSERT INTO {Db.tableName} VALUES (@data)"
-                    "INSERT statement not correct"
-            }
-            test "save succeeds" {
-                Expect.equal
-                    (Query.save Db.tableName)
-                    $"INSERT INTO {Db.tableName} VALUES (@data) ON CONFLICT ((data ->> 'Id')) DO UPDATE SET data = EXCLUDED.data"
-                    "INSERT ON CONFLICT UPDATE statement not correct"
-            }
-            testList "Count" [
-                test "all succeeds" {
-                    Expect.equal
-                        (Query.Count.all Db.tableName)
-                        $"SELECT COUNT(*) AS it FROM {Db.tableName}"
-                        "Count query not correct"
-                }
-                test "byField succeeds" {
-                    Expect.equal
-                        (Query.Count.byField Db.tableName "thatField" EQ)
-                        $"SELECT COUNT(*) AS it FROM {Db.tableName} WHERE data ->> 'thatField' = @field"
-                        "JSON field text comparison count query not correct"
-                }
-            ]
-            testList "Exists" [
-                test "byId succeeds" {
-                    Expect.equal
-                        (Query.Exists.byId Db.tableName)
-                        $"SELECT EXISTS (SELECT 1 FROM {Db.tableName} WHERE data ->> 'Id' = @id) AS it"
-                        "ID existence query not correct"
-                }
-                test "byField succeeds" {
-                    Expect.equal
-                        (Query.Exists.byField Db.tableName "Test" LT)
-                        $"SELECT EXISTS (SELECT 1 FROM {Db.tableName} WHERE data ->> 'Test' < @field) AS it"
-                        "JSON field text comparison exists query not correct"
-                }
-            ]
-            testList "Find" [
-                test "byId succeeds" {
-                    Expect.equal
-                        (Query.Find.byId Db.tableName)
-                        $"SELECT data FROM {Db.tableName} WHERE data ->> 'Id' = @id"
-                        "SELECT by ID query not correct"
-                }
-                test "byField succeeds" {
-                    Expect.equal
-                        (Query.Find.byField Db.tableName "Golf" GE)
-                        $"SELECT data FROM {Db.tableName} WHERE data ->> 'Golf' >= @field"
-                        "SELECT by JSON text comparison query not correct"
-                }
-            ]
-            testList "Update" [
-                test "full succeeds" {
-                    Expect.equal
-                        (Query.Update.full Db.tableName)
-                        $"UPDATE {Db.tableName} SET data = @data WHERE data ->> 'Id' = @id"
-                        "UPDATE full statement not correct"
-                }
-                test "partialById succeeds" {
-                    Expect.equal
-                        (Query.Update.partialById Db.tableName)
-                        $"UPDATE {Db.tableName} SET data = json_patch(data, json(@data)) WHERE data ->> 'Id' = @id"
-                        "UPDATE partial by ID statement not correct"
-                }
-                test "partialByField succeeds" {
-                    Expect.equal
-                        (Query.Update.partialByField Db.tableName "Part" NE)
-                        $"UPDATE {Db.tableName} SET data = json_patch(data, json(@data)) WHERE data ->> 'Part' <> @field"
-                        "UPDATE partial by JSON containment statement not correct"
-                }
-            ]
-            testList "Delete" [
-                test "byId succeeds" {
-                    Expect.equal
-                        (Query.Delete.byId Db.tableName)
-                        $"DELETE FROM {Db.tableName} WHERE data ->> 'Id' = @id"
-                        "DELETE by ID query not correct"
-                }
-                test "byField succeeds" {
-                    Expect.equal
-                        (Query.Delete.byField Db.tableName "gone" EQ)
-                        $"DELETE FROM {Db.tableName} WHERE data ->> 'gone' = @field"
-                        "DELETE by JSON containment query not correct"
-                }
-            ]
-        ]
-    ]
-
-let isTrue<'T> (_ : 'T) = true
-
-let integrationTests =
+/// These tests each use a fresh copy of a SQLite database
+let all =
     let documents = [
         { Id = "one"; Value = "FIRST!"; NumValue = 0; Sub = None }
         { Id = "two"; Value = "another"; NumValue = 10; Sub = Some { Foo = "green"; Bar = "blue" } }
@@ -1116,5 +963,3 @@ let integrationTests =
         }
     ]
     |> testSequenced
-
-let all = testList "Sqlite" [ unitTests; integrationTests ]