├── .gitignore ├── LICENSE.md ├── README.md ├── __tests__ ├── BuilderTests.re ├── RenderQueryTests.re ├── RowDecodeTests.re ├── ToolsTests.re ├── UtilsTests.re ├── __snapshots__ │ ├── BuilderTests.bs.js.snap │ └── RenderQueryTests.bs.js.snap ├── postgres │ ├── PostgresTests.re │ └── __snapshots__ │ │ └── PostgresTests.bs.js.snap └── test_data │ └── user_rows.json ├── bsconfig.json ├── build_examples.sh ├── hooks ├── post-checkout └── pre-commit ├── package.json ├── src ├── Client.re ├── QueryBuilder.re ├── QueryBuilder.rei ├── QueryDecode.re ├── RenderQuery.re ├── RowDecode.re ├── RowEncode.re ├── Sql.re ├── ToJson.re ├── Tools.re ├── examples │ └── BooksExample.re ├── postgres │ ├── Postgres.re │ ├── PostgresClient.re │ ├── PostgresQueryBuilder.re │ ├── PostgresRender.re │ └── PostgresSyntax.re └── utils │ ├── ArrayUtils.re │ ├── CallbackUtils.re │ ├── DictUtils.re │ ├── FsUtils.re │ ├── JsMap.re │ ├── JsSet.re │ ├── JsonUtils.re │ ├── ListUtils.re │ ├── MapUtils.re │ ├── OptionUtils.re │ ├── PromiseUtils.re │ ├── ResultUtils.re │ ├── StringUtils.re │ ├── Utils.re │ └── UtilsPrelude.re └── yarn.lock /.gitignore: -------------------------------------------------------------------------------- 1 | .merlin 2 | lib 3 | **/*.bs.js 4 | .bsb.lock 5 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright 2019 Allen Daniel Nelson 2 | 3 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 4 | 5 | 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 6 | 7 | 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 8 | 9 | 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. 10 | 11 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # requery 2 | 3 | `requery` is a library for interacting with a SQL database from a ReasonML/Ocaml application. It includes a generic SQL AST and combinators for constructing queries and parsing the results of these queries into domain objects. It is inspired by [`knex.js`](http://knexjs.org/), but leveraging the type system of ML for correctness and expressiveness. 4 | 5 | `requery` is currently dependent on being built with `bucklescript` and the javascript ecosystem. Future work might enable it to be used in other ecosystems as well. 6 | 7 | ```reason 8 | let (then_, resolve) = Js.Promise.(then_, resolve); 9 | let client = RequerySqlite.Sqlite3.(makeClient(Memory)); 10 | let authors = QueryBuilder.tname("authors"); 11 | RowEncode.( 12 | [("Stephen", "King"), ("Jane", "Austen"), ("Kurt", "Vonnegut")] 13 | |> insertMany(columns2("first", string, "last", string)) 14 | |> into(authors) 15 | ) 16 | |> Client.insert(client) 17 | |> then_(_ => 18 | QueryBuilder.(select([e(col("first")), e(col("last"))] |> from(table(authors)))) 19 | |> Client.select( 20 | client, 21 | RowDecode.(decodeEach(columns2("first", string, "last", string))), 22 | ) 23 | ) 24 | |> then_(authors => authors |> Js.log |> resolve); 25 | ``` 26 | 27 | ### Features 28 | 29 | - A generic SQL abstract syntax tree as a suite of ReasonML types 30 | - Functions and other tools for: 31 | - Building queries programmatically and composably 32 | - Decoding rows returned from a query into domain objects 33 | - Encoding domain objects into rows for database insertion 34 | - Orchestrating query execution with a database 35 | 36 | ### Goals 37 | 38 | - Queries will always render into valid SQL, modulo bugs and unsupported databases. 39 | - Query generation, query execution, and query result parsing are clearly separated at the type level. 40 | - Modular abstractions which compose correctly, allowing you to avoid gotchas and write DRY code. 41 | 42 | ### Modular Design 43 | 44 | The components of `requery` are designed to be modular and each can be used in whatever capacity you need. You might use it to: 45 | 46 | - script out table and/or view creation in code, but write your queries by hand. 47 | - automate your infrastructure tests for some existing database. 48 | - seed tables for a unit or integration test suite. 49 | - create a REST API or CLI to which is backed by a database. 50 | - use the `RowDecode` library to unpack the results of queries you've written by hand 51 | - set up a web app that can be configured to work with different databases (currently sqlite or postgres). 52 | 53 | Note that while an ORM could be written using `requery` to structure queries, `requery` itself is not an ORM. It does not enforce or encourage any particular framework for how you structure your tables or do migrations; instead it (hopefully) provides you with the ability to build SQL however you'd like. 54 | 55 | ## Modules 56 | 57 | - A non-exhaustive list of modules to be found in the library: 58 | - `Sql`: contains an abstact syntax tree for SQL. The AST is polymorphic to support DB-specific syntax. The types here are generally not used directly; instead use the functions in `QueryBuilder`. 59 | - `QueryBuilder`: functions for building SQL queries in a more ergonomic way than directly constructing an AST (although you can if you want). See the interface file `QueryBuilder.rei` for documentation on the various builder functions. 60 | - `RenderQuery`: Code to render the AST objects into actual SQL strings. You can use this library directly if you need access to the SQL, but if you're using the `Client` this will probably be abstracted away. 61 | - `RowEncode`: functions to serialize domain objects into "rows", that is, the data that goes into an `INSERT INTO` query. 62 | - `RowDecode`: functions to deserialize information returned by a query (e.g. a `SELECT` or an `INSERT` which returns data) into domain objects. 63 | - `Client`: an abstraction of the actual database object. This allows you to interact with your database using the `requery` abstractions. 64 | - `PostgresSyntax`: type-safe AST for PostgresQL. Very much a WIP. 65 | - `PostgresClient`: functionality to connect to a postgres database. 66 | 67 | ## Examples 68 | 69 | Let's say you have a Postgres database of books and authors, with the following tables and data. Note that we can use `requery` to create the table and insert rows, but since we're focusing on SELECT queries, we'll save that for later: 70 | 71 | ```sql 72 | CREATE TABLE authors (id SERIAL PRIMARY KEY, first_name TEXT, last_name TEXT); 73 | CREATE TABLE books ( 74 | id SERIAL PRIMARY KEY, 75 | author_id INT NOT NULL, 76 | title TEXT NOT NULL, 77 | FOREIGN KEY (author_id) REFERENCES authors(id) 78 | ); 79 | 80 | INSERT INTO authors (first_name, last_name) VALUES ('Stephen', 'King'); 81 | INSERT INTO books (author_id, title) VALUES (1, 'The Shining'), (1, 'Carrie'); 82 | ``` 83 | 84 | Start off by adding `@adnelson/requery` as a dependency. Don't forget to update your `bsconfig.json` as well by putting `"@adnelson/requery"` under `bs-dependencies`. 85 | 86 | One thing you might want to do is find all of the books that an author wrote. Here's an example of how that might look: 87 | 88 | ```reason 89 | let booksByAuthor = (authorId: int): select => Requery.QueryBuilder.( 90 | select([ 91 | e(tcol("authors", "first_name") ++ string(" ") ++ tcol("authors", "last_name"), ~a="name"), 92 | e(tcol("books", "title")), 93 | ]) 94 | |> from( 95 | tableNamed("authors") 96 | |> innerJoin(tableNamed("books"), 97 | tcol("authors", "id") == tcol("books", "author_id")) 98 | ) 99 | |> where(tcol("authors", "id") == int(authorId)) 100 | ); 101 | 102 | Js.log(Requery.Postgres.Render.select(booksByAuthor(1))); 103 | ``` 104 | 105 | Output: 106 | 107 | ```sql 108 | SELECT "authors"."first_name" || ' ' || "authors"."last_name" AS name, "books"."title" 109 | FROM authors INNER JOIN books ON "authors"."id" = "books"."author_id" 110 | WHERE "authors"."id" = 1 111 | ``` 112 | 113 | If I pipe this into `psql`: 114 | 115 | ``` 116 | ⇒ node example/Books.bs.js | psql requery-example 117 | name | title 118 | --------------+------------- 119 | Stephen King | The Shining 120 | Stephen King | Carrie 121 | (2 rows) 122 | ``` 123 | 124 | Now of course, for a query like this the Reason code is considerably more verbose than the query which is generated at the end. But the advantage is that this query can be reused! Maybe all you need to know is the _number_ of books the author wrote. We can leverage the query we wrote before: 125 | 126 | ```reason 127 | let bookCountByAuthor = (authorId: int): select => Requery.QueryBuilder.( 128 | select([e(col("name")), e(count(all))]) 129 | |> from(booksByAuthor(authorId) |> selectAs("t")) 130 | |> groupBy1(column("name")) 131 | ); 132 | 133 | Js.log(Requery.Postgres.Render.select(bookCountByAuthor(1))); 134 | ``` 135 | 136 | Output: 137 | 138 | ```sql 139 | SELECT "name", COUNT(*) FROM ( 140 | SELECT "authors"."first_name" || ' ' || "authors"."last_name" AS name, "books"."title" 141 | FROM authors INNER JOIN books ON "authors"."id" = "books"."author_id" 142 | WHERE "authors"."id" = 1 143 | ) AS t 144 | GROUP BY "name" 145 | ``` 146 | 147 | Result: 148 | 149 | ``` 150 | ⇒ node example/Books.bs.js | psql requery-example 151 | name | count 152 | --------------+------- 153 | Stephen King | 2 154 | (1 row) 155 | ``` 156 | 157 | The `QueryBuilder` library will ensure that whatever logic you follow to construct a query, the end result will be syntactically valid SQL. Of course, it does _not_ ensure that the query will return the data you expect, or any data at all -- that's still up to you. 158 | 159 | For a more complete example, which includes table creation, insertion and selection, see `examples/Books.re`, `examples/SqliteBooks.re` and `examples.PostgresBooks.re`. 160 | 161 | ## Supported queries 162 | 163 | At present, the following query types have been implemented, with the following components. This list will be updated over time. 164 | 165 | ### SELECT 166 | 167 | - Expressions 168 | - Primitives like ints, floats, strings, booleans, tuples 169 | - Combinators for operators like `&&`, `||`, `LIKE` `IS NOT NULL`, etc 170 | - Function calls, e.g. `COUNT(*)` 171 | - Encoders to translate your domain objects into SQL expressions 172 | - `FROM` clauses 173 | - Tables 174 | - Subqueries (`SELECT * FROM (SELECT ...) AS t`) 175 | - `JOIN` clauses 176 | - `INNER JOIN`, `LEFT JOIN`, `RIGHT JOIN`, `FULL JOIN` and `CROSS JOIN` 177 | - `GROUP BY` one or more columns 178 | - `ORDER BY` one or more columns (with optional `DESC`/`ASC`) 179 | - `LIMIT` clauses 180 | - `WHERE` clauses 181 | 182 | ### INSERT 183 | 184 | - `VALUES`, organized as one or more tuples of `(column, expression)` 185 | - Inserting an inner `SELECT` query 186 | 187 | ### CREATE TABLE 188 | 189 | - `IF NOT EXISTS` 190 | - Per-column `PRIMARY KEY`, `UNIQUE`, `NOT NULL`, `CHECK` and `DEFAULT` constraints 191 | - Per-table `PRIMARY KEY`, `FOREIGN KEY`, `UNIQUE`, and `CHECK` constraints 192 | 193 | ### CREATE VIEW 194 | 195 | - Using a `SELECT` query 196 | - `IF NOT EXISTS` 197 | 198 | ## Supported databases 199 | 200 | PostgresQL. At one point SQLite had support and that might return, but I don't use it, the package doesn't build out of the box on nixos and I just haven't figured out how to get around it yet. Of course anyone can write their own library around it. 201 | 202 | ## Status and future work 203 | 204 | **_NOTE: Requery's API is unstable and subject to change without notice._** This doesn't mean that the code is expected to be of poor quality, just that there may be any number of breaking changes until a hypothetical 1.0 release. 205 | 206 | There's plenty left to do, and much will likely change, but at this point the library is at least worthy of playing around with for personal projects. The `QueryBuilder` library can be used to build useful queries of pretty sophiticated complexity, the `RenderQuery` library can render these into valid SQL, and functions exist for basic database interaction including object serialization/deserialization. 207 | 208 | Planned upcoming work includes: 209 | 210 | - Improving the abstraction of the database backend to provide an ergonomic interface, make it easy to extend, and avoid code duplication between different DBs. 211 | - A richer set of tools for composing database actions. For example: 212 | - Higher-level abstractions for query building, enabling complex queries to be generated correctly 213 | - Query orchestration tools, enabling database interactions to be scripted for things like inserting objects which are stored across multiple tables. 214 | - A test suite. Query generation, object encoding/decoding, SQL rendering (per DB), and query execution (per DB) should all be backed by tests. 215 | - `DELETE FROM` and `DROP TABLE` queries. 216 | - `WITH`, `UNION` and `UNION ALL` syntax for `SELECT` queries. 217 | - Configurable pretty-printing of rendered SQL. 218 | - Error handling for when queries fail. 219 | 220 | Contributions and issue reports are very much welcome! 221 | -------------------------------------------------------------------------------- /__tests__/BuilderTests.re: -------------------------------------------------------------------------------- 1 | open QueryBuilder; 2 | open Jest; 3 | open Expect; 4 | 5 | module OperatorTests = { 6 | describe("boolean operator tests", () => { 7 | test("xor", () => { 8 | expect(bool(true)->xor(bool(false))->RenderQuery.Default.Expression.render) 9 | ->toMatchSnapshot(); 10 | expect(col(cname("foobar"))->xor(bool(false))->RenderQuery.Default.Expression.render) 11 | ->toMatchSnapshot(); 12 | }) 13 | }); 14 | }; 15 | -------------------------------------------------------------------------------- /__tests__/RenderQueryTests.re: -------------------------------------------------------------------------------- 1 | open Jest; 2 | open Expect; 3 | module QB = QueryBuilder; 4 | module R = RenderQuery.Default; 5 | 6 | module SnapshotTests = { 7 | describe("type names", () => { 8 | test("char", () => 9 | expect(QB.Types.char(10)->R.TypeName.render)->toEqual("CHAR(10)") 10 | ) 11 | }); 12 | 13 | describe("createTable", () => { 14 | test("author", () => 15 | expect(BooksExample.Author.createTable(QB.Types.int)->R.CreateTable.render) 16 | ->toMatchSnapshot() 17 | ); 18 | test("book", () => 19 | expect(BooksExample.Book.createTable(QB.Types.int)->R.CreateTable.render) 20 | ->toMatchSnapshot() 21 | ); 22 | }); 23 | describe("select", () => { 24 | test("author books", () => 25 | expect(BooksExample.authorBooksSelect->R.Select.render)->toMatchSnapshot() 26 | ); 27 | test("author books CTE", () => 28 | expect(BooksExample.getAuthorIdsCTE->R.Select.render)->toMatchSnapshot() 29 | ); 30 | }); 31 | describe("insert", () => { 32 | test("authors", () => { 33 | expect(R.Insert.render(~onConflict=string_of_int, BooksExample.insertAuthors)) 34 | ->toMatchSnapshot() 35 | }); 36 | test("authors with fake on conflict", () => { 37 | let insert = BooksExample.insertAuthors; 38 | let withOnConflict = insert |> QB.onConflict(1234); 39 | let renderOnConflict = n => "ON CONFLICT " ++ string_of_int(n); 40 | let rendered = R.Insert.render(~onConflict=renderOnConflict, withOnConflict); 41 | expect(rendered)->toMatchSnapshot(); 42 | expect(rendered)->toEqual(stringContaining("ON CONFLICT 1234")); 43 | }); 44 | }); 45 | }; 46 | -------------------------------------------------------------------------------- /__tests__/RowDecodeTests.re: -------------------------------------------------------------------------------- 1 | open Jest; 2 | open Expect; 3 | open Utils.Abbreviations; 4 | module RD = RowDecode; 5 | 6 | // Test decoding dictionaries 7 | module Dict = { 8 | let jsonRows: array(Js.Json.t) = [%bs.raw {|require('./test_data/user_rows.json')|}]; 9 | let rows = RD.toRows(jsonRows); 10 | 11 | describe("dictOf", () => { 12 | describe("one-dimensional dictionary", () => { 13 | let byFirstName: D.t(array(string)) = 14 | rows |> RD.(dictOf(~keyField="first_name", decodeEach(field("last_name", string)))); 15 | test("Bob", () => 16 | expect(D.get(byFirstName, "Bob"))->toEqual(Some([|"Blooperman"|])) 17 | ); 18 | }); 19 | 20 | describe("nested dictionary", () => { 21 | let firstLastId: D.t(D.t(int)) = 22 | rows 23 | |> RD.( 24 | dictOf( 25 | ~keyField="last_name", 26 | dictOf(~keyField="first_name", decodeOne(field("id", int))), 27 | ) 28 | ); 29 | test("Blooperman", () => 30 | expect(D.get(firstLastId, "Blooperman")) 31 | ->toEqual(Some(D.fromArray([|("Bob", 1), ("Billy", 5)|]))) 32 | ); 33 | }); 34 | }); 35 | 36 | describe("tuples", () => 37 | describe("one-dimensional", () => { 38 | let keyField = "first_name"; 39 | let inner = RD.(decodeEach(field("last_name", string))); 40 | let tuples: array((string, array(string))) = 41 | rows |> RD.tuples(keyField, RD.string, s => s, inner); 42 | let (byFirstName: D.t(array(string)), firstNames) = ( 43 | D.fromArray(tuples), 44 | A.firsts(tuples), 45 | ); 46 | 47 | test("Bob", () => 48 | expect(D.get(byFirstName, "Bob"))->toEqual(Some([|"Blooperman"|])) 49 | ); 50 | test("names", () => 51 | expect(firstNames)->toEqual([|"Bob", "Biff", "Barnabus", "Bertrand", "Billy"|]) 52 | ); 53 | }) 54 | ); 55 | 56 | describe("flat dict", () => { 57 | describe("unordered", () => { 58 | describe("ID => first name", () => { 59 | let dict = 60 | rows 61 | |> RD.dict( 62 | ~keyField="id", 63 | ~keyDecode=j => j |> RD.int |> string_of_int, 64 | ~valueField="first_name", 65 | ~valueDecode=RD.string, 66 | (), 67 | ); 68 | test("ID 1 is Bob", () => 69 | expect(D.get(dict, "1"))->toEqual(Some("Bob")) 70 | ); 71 | test("ID 2 is Biff", () => 72 | expect(D.get(dict, "2"))->toEqual(Some("Biff")) 73 | ); 74 | }); 75 | 76 | describe("last name => first name => ID", () => { 77 | let dict = 78 | rows 79 | |> RD.dict2d( 80 | ~outerKeyField="last_name", 81 | ~innerKeyField="first_name", 82 | ~valueField="id", 83 | ~valueDecode=RD.int, 84 | (), 85 | ); 86 | test("Bob's ID", () => 87 | expect(D.get(D.getExn(dict, "Blooperman"), "Bob"))->toEqual(Some(1)) 88 | ); 89 | test("Biff's ID", () => 90 | expect(D.get(D.getExn(dict, "Bofferton"), "Biff"))->toEqual(Some(2)) 91 | ); 92 | describe("the Boffertons", () => { 93 | let boffertons = D.getExn(dict, "Bofferton"); 94 | A.forEach([|"Biff", "Barnabus", "Bertrand"|], name => 95 | test(name, () => 96 | expect(O.isSome(D.get(boffertons, name)))->toEqual(true) 97 | ) 98 | ); 99 | }); 100 | }); 101 | }); 102 | 103 | describe("ordered", () => 104 | describe("ID => first name", () => { 105 | let (dict, ordering) = 106 | rows 107 | |> RD.dictWithOrder( 108 | ~keyField="id", 109 | ~keyDecode=j => j |> RD.int |> string_of_int, 110 | ~valueField="first_name", 111 | ~valueDecode=RD.string, 112 | (), 113 | ); 114 | test("ID 1 is Bob", () => 115 | expect(D.get(dict, "1"))->toEqual(Some("Bob")) 116 | ); 117 | test("ID 2 is Biff", () => 118 | expect(D.get(dict, "2"))->toEqual(Some("Biff")) 119 | ); 120 | test("ordering contains all IDs in order", () => 121 | expect(ordering)->toEqual(A.map([|1, 2, 3, 4, 5|], string_of_int)) 122 | ); 123 | }) 124 | ); 125 | }); 126 | }; 127 | -------------------------------------------------------------------------------- /__tests__/ToolsTests.re: -------------------------------------------------------------------------------- 1 | open Tools; 2 | open Jest; 3 | open Expect; 4 | open BooksExample; 5 | open Sql; 6 | open Utils.Abbreviations; 7 | module QB = QueryBuilder; 8 | 9 | module TableToolsTests = { 10 | describe("table tools", () => { 11 | let authors = Author.createTable(QueryBuilder.Types.int); 12 | let books = Book.createTable(QueryBuilder.Types.int); 13 | test("name", () => 14 | expect(authors->TableTools.name)->toEqual(Author.tableName) 15 | ); 16 | test("columns", () => 17 | expect(authors->TableTools.columnNames) 18 | ->toEqual([|"id", "first", "last"|]->A.map(QB.cname)) 19 | ); 20 | test("columnDefMap", () => { 21 | let defMap = authors->TableTools.columnDefMap; 22 | expect(defMap->M.get("first"->QB.cname)->O.map(CreateTable.defType)) 23 | ->toBe(Some(QB.Types.text)); 24 | expect(defMap->M.has("blabla"->QB.cname))->toBe(false); 25 | }); 26 | test("getCol", () => { 27 | expect(authors->TableTools.getCol("id"->QB.cname))->toEqual("id"->QB.cname); 28 | expect(() => 29 | authors->TableTools.getCol("not a real column"->QB.cname) 30 | )->toThrowSomething; 31 | }); 32 | test("primaryKeyColumn", () => 33 | expect(authors->TableTools.primaryKeyColumnDef->O.map(({name}) => name)) 34 | ->toEqual(Some("id"->QB.cname)) 35 | ); 36 | test("foreignKeyColumns", () => { 37 | let fkColumns = books->TableTools.foreignKeyColumns; 38 | expect(fkColumns->M.keysArray)->toEqual([|"author id"->QB.cname|]); 39 | expect(fkColumns->M.get("author id"->QB.cname)) 40 | ->toEqual(Some(("author"->QB.tname, "id"->QB.cname))); 41 | }); 42 | }); 43 | }; 44 | -------------------------------------------------------------------------------- /__tests__/UtilsTests.re: -------------------------------------------------------------------------------- 1 | open Jest; 2 | open Expect; 3 | 4 | module String = { 5 | open StringUtils; 6 | describe("dedupe", () => { 7 | let input = [|"a", "b", "b", "a", "c"|]; 8 | test("array", () => 9 | expect(dedupeArray(input))->toEqual([|"a", "b", "c"|]) 10 | ); 11 | test("list", () => 12 | expect(dedupeList(Belt.List.fromArray(input)))->toEqual(["a", "b", "c"]) 13 | ); 14 | }); 15 | }; 16 | 17 | module Map = { 18 | open MapUtils; 19 | describe("maps", () => { 20 | test("string", () => { 21 | let map = fromArray([|("foo", "bar")|]); 22 | expect(map->get("foo"))->toEqual(Some("bar")); 23 | }); 24 | test("int", () => { 25 | let map = fromArray([|(123, "bar")|]); 26 | expect(map->get(123))->toEqual(Some("bar")); 27 | }); 28 | test("string-like", () => { 29 | module MyString = 30 | Opaque.String.Make( 31 | Opaque.String.Validation.NoValidation, 32 | {}, 33 | ); 34 | let map = fromArray([|(MyString.fromString("foo"), "bar")|]); 35 | expect(map->get(MyString.fromString("foo")))->toEqual(Some("bar")); 36 | }); 37 | 38 | test("group by", () => { 39 | let strings = [|"apple", "cat", "bag", "hello", "world"|]; 40 | let grouped: t(int, array(string)) = strings->groupBy(Js.String.length); 41 | expect(grouped->get(5))->toEqual(Some([|"apple", "hello", "world"|])); 42 | expect(grouped->get(3))->toEqual(Some([|"cat", "bag"|])); 43 | expect(grouped->get(8))->toEqual(None); 44 | }); 45 | }); 46 | }; 47 | -------------------------------------------------------------------------------- /__tests__/__snapshots__/BuilderTests.bs.js.snap: -------------------------------------------------------------------------------- 1 | // Jest Snapshot v1, https://goo.gl/fbAQLP 2 | 3 | exports[`boolean operator tests xor 1`] = `"((NOT TRUE) AND FALSE) OR ((NOT FALSE) AND TRUE)"`; 4 | 5 | exports[`boolean operator tests xor 2`] = `"((NOT foobar) AND FALSE) OR ((NOT FALSE) AND foobar)"`; 6 | -------------------------------------------------------------------------------- /__tests__/__snapshots__/RenderQueryTests.bs.js.snap: -------------------------------------------------------------------------------- 1 | // Jest Snapshot v1, https://goo.gl/fbAQLP 2 | 3 | exports[`createTable author 1`] = `"CREATE TABLE IF NOT EXISTS author (id INTEGER PRIMARY KEY NOT NULL, first TEXT NOT NULL, last TEXT NOT NULL, UNIQUE (first,last))"`; 4 | 5 | exports[`createTable book 1`] = `"CREATE TABLE IF NOT EXISTS book (id INTEGER PRIMARY KEY NOT NULL, \\"author id\\" INTEGER NOT NULL, title TEXT NOT NULL, FOREIGN KEY (\\"author id\\") REFERENCES author (id) ON DELETE CASCADE)"`; 6 | 7 | exports[`insert authors 1`] = `"INSERT INTO author (first, last) VALUES ('Stephen', 'King'), ('Jane', 'Austen')"`; 8 | 9 | exports[`insert authors with fake on conflict 1`] = `"INSERT INTO author (first, last) VALUES ('Stephen', 'King'), ('Jane', 'Austen') ON CONFLICT 1234"`; 10 | 11 | exports[`select author books 1`] = `"SELECT a.id AS \\"author id\\" FROM author AS a INNER JOIN book AS b ON a.id = b.\\"author id\\""`; 12 | 13 | exports[`select author books CTE 1`] = `" WITH author_ids(id) AS (SELECT a.id AS \\"author id\\" FROM author AS a INNER JOIN book AS b ON a.id = b.\\"author id\\")SELECT * FROM author_ids"`; 14 | -------------------------------------------------------------------------------- /__tests__/postgres/PostgresTests.re: -------------------------------------------------------------------------------- 1 | open Jest; 2 | open Expect; 3 | module RE = Requery.RowEncode; 4 | 5 | module PQB = PostgresQueryBuilder; 6 | 7 | module CustomSyntaxTests = { 8 | open PostgresQueryBuilder; 9 | 10 | let scaryConstraint = 11 | pgMakeOnConflict(~target=pgOnConstraint("scary_constraint"->constraintName), DoNothing); 12 | 13 | test("rendering an on conflict clause", () => 14 | expect(scaryConstraint->PostgresRender.OnConflict.render)->toMatchSnapshot() 15 | ); 16 | describe("rendering an insert", () => { 17 | test("no on conflict", () => 18 | expect(Sql.Insert(BooksExample.insertAuthors) |> PostgresRender.pgRender) 19 | ->toMatchSnapshot() 20 | ); 21 | describe("with on conflict", () => { 22 | test("on a constraint", () => { 23 | let insert = Sql.Insert(BooksExample.insertAuthors |> onConflict(scaryConstraint)); 24 | let rendered = insert |> PostgresRender.pgRender; 25 | expect(rendered)->toMatchSnapshot(); 26 | expect(rendered)->toEqual(stringContaining("ON CONFLICT ON CONSTRAINT")); 27 | expect(rendered)->toEqual(stringContaining("scary_constraint")); 28 | }); 29 | test("do nothing", () => { 30 | let insert = Sql.Insert(BooksExample.insertAuthors |> pgOnConflictNothing); 31 | let rendered = insert |> PostgresRender.pgRender; 32 | expect(rendered)->toMatchSnapshot(); 33 | expect(rendered)->toEqual(stringContaining("ON CONFLICT")); 34 | expect(rendered)->toEqual(stringContaining("DO NOTHING")); 35 | }); 36 | }); 37 | }); 38 | 39 | describe("create type", () => { 40 | open PostgresQueryBuilder; 41 | test("enum type", () => { 42 | let ct = pgCreateEnumType(typeName("color"), ["red", "green", "blue"]->pgEnumValues); 43 | let rendered = CreateCustom(ct)->PostgresRender.pgRender; 44 | expect(rendered)->toMatchSnapshot(); 45 | expect(rendered)->toEqual(stringContaining("AS ENUM")); 46 | }); 47 | test("enum type with invalid characters in value", () => { 48 | expect(() => 49 | pgCreateEnumType(typeName("color"), ["it's bad"->pgEnumValue]) 50 | ) 51 | ->toThrowSomething 52 | }); 53 | 54 | test("enum type with no values defined", () => { 55 | expect(() => 56 | pgCreateEnumType(typeName("color"), []) 57 | )->toThrowSomething 58 | }); 59 | }); 60 | }; 61 | -------------------------------------------------------------------------------- /__tests__/postgres/__snapshots__/PostgresTests.bs.js.snap: -------------------------------------------------------------------------------- 1 | // Jest Snapshot v1, https://goo.gl/fbAQLP 2 | 3 | exports[`create type enum type 1`] = `"CREATE TYPE color AS ENUM ('red','green','blue')"`; 4 | 5 | exports[`rendering an insert no on conflict 1`] = `"INSERT INTO author (first, last) VALUES ('Stephen', 'King'), ('Jane', 'Austen')"`; 6 | 7 | exports[`rendering an insert with on conflict do nothing 1`] = `"INSERT INTO author (first, last) VALUES ('Stephen', 'King'), ('Jane', 'Austen') ON CONFLICT DO NOTHING"`; 8 | 9 | exports[`rendering an insert with on conflict on a constraint 1`] = `"INSERT INTO author (first, last) VALUES ('Stephen', 'King'), ('Jane', 'Austen') ON CONFLICT ON CONSTRAINT scary_constraint DO NOTHING"`; 10 | 11 | exports[`rendering an on conflict clause 1`] = `"ON CONFLICT ON CONSTRAINT scary_constraint DO NOTHING"`; 12 | -------------------------------------------------------------------------------- /__tests__/test_data/user_rows.json: -------------------------------------------------------------------------------- 1 | [ 2 | { 3 | "id": 1, 4 | "first_name": "Bob", 5 | "last_name": "Blooperman" 6 | }, 7 | { 8 | "id": 2, 9 | "first_name": "Biff", 10 | "last_name": "Bofferton" 11 | }, 12 | { 13 | "id": 3, 14 | "first_name": "Barnabus", 15 | "last_name": "Bofferton" 16 | }, 17 | { 18 | "id": 4, 19 | "first_name": "Bertrand", 20 | "last_name": "Bofferton" 21 | }, 22 | { 23 | "id": 5, 24 | "first_name": "Billy", 25 | "last_name": "Blooperman" 26 | } 27 | ] 28 | -------------------------------------------------------------------------------- /bsconfig.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "@adnelson/requery", 3 | "bs-dependencies": ["@glennsl/bs-json", "re-opaque", "bs-postgres"], 4 | "bs-dev-dependencies": ["reason-jest"], 5 | "namespace": "Requery", 6 | "package-specs": { 7 | "in-source": true, 8 | "module": "commonjs" 9 | }, 10 | "reason": { 11 | "react-jsx": 3 12 | }, 13 | "refmt": 3, 14 | "sources": [ 15 | { "dir": "src", "subdirs": true }, 16 | { 17 | "dir": "__tests__", 18 | "type": "dev", 19 | "subdirs": true 20 | } 21 | ], 22 | "suffix": ".bs.js", 23 | "warnings": { 24 | "number": "-23-44+60", 25 | "error": "+8+6+60+49" 26 | } 27 | } 28 | -------------------------------------------------------------------------------- /build_examples.sh: -------------------------------------------------------------------------------- 1 | set -ex 2 | for pkg in abstract postgres sqlite; do 3 | ( 4 | set -e 5 | cd packages/$pkg/example 6 | yarn 7 | yarn clean 8 | yarn build 9 | ) 10 | done 11 | -------------------------------------------------------------------------------- /hooks/post-checkout: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | prev_ref=$1 3 | next_ref=$2 4 | 5 | diff="$(git diff --name-only $prev_ref $next_ref)" 6 | if grep -Pq 'builder/yarn.lock' <<< "$diff"; then 7 | (set -x; cd builder && yarn) 8 | fi 9 | 10 | if grep -Pq 'server/yarn.lock' <<< "$diff" ; then 11 | (set -x; cd server && yarn) 12 | fi 13 | -------------------------------------------------------------------------------- /hooks/pre-commit: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | set -ex 3 | 4 | # This is due to some of the hacks required to get bs-platform working with nixos. 5 | function fix_bs_platform() { 6 | node <", 7 | "license": "MIT", 8 | "lint-staged": { 9 | "*.{md,scss,css,js,json}": [ 10 | "prettier --write" 11 | ], 12 | "*.{re,rei}": [ 13 | "bsrefmt --in-place -w 100" 14 | ] 15 | }, 16 | "prettier": { 17 | "semi": false, 18 | "trailingComma": "es5", 19 | "printWidth": 100, 20 | "singleQuote": true 21 | }, 22 | "peerDependencies": { 23 | "@glennsl/bs-json": ">=5", 24 | "bs-platform": "^5 || ^7" 25 | }, 26 | "devDependencies": { 27 | "@glennsl/bs-jest": "^0.4.9", 28 | "@glennsl/bs-json": "^5.0.2", 29 | "bs-platform": "7.3.1", 30 | "lint-staged": "^10.2.11", 31 | "onchange": "^6.1.0", 32 | "prettier": "^1.18.2" 33 | }, 34 | "husky": { 35 | "hooks": { 36 | "pre-commit": "lint-staged" 37 | } 38 | }, 39 | "scripts": { 40 | "build": "sh -c 'NINJA_ANSI_FORCED=1 bsb -make-world'", 41 | "clean": "bsb -clean-world", 42 | "cleanbuild": "yarn clean && yarn build", 43 | "watch": "yarn clean && onchange -k -i -d 500 '**/*.{re,rei}' bsconfig.json -- sh -c 'yarn build'", 44 | "watch:run": "onchange -k -i -d 500 '**/*.{re,rei}' bsconfig.json -- sh -c 'yarn build && yarn testquery'", 45 | "test": "jest __tests__ __tests__/postgres", 46 | "test:generic": "jest __tests__", 47 | "test:pg": "jest __tests__/postgres", 48 | "format": "bsrefmt --in-place --print-width 100 src/*.{re,rei} __tests__/*.re example/*.re", 49 | "re:clean": "bsb -clean-world", 50 | "re:build": "bsb -make-world", 51 | "re:watch": "bsb -make-world -w", 52 | "re:formatall": "find src __tests__ -name '*.re' | xargs npx bsrefmt --in-place", 53 | "re:formatchanged": "git diff --name-only --diff-filter=d HEAD -- '*.re' | xargs -I{} realpath --relative-to=. $(git rev-parse --show-toplevel)/'{}' | while read f; do npx bsrefmt --print-width 100 --in-place \"$f\"; done", 54 | "prepare": "mkdir -p ./.git/hooks && cp ./hooks/* ./.git/hooks" 55 | }, 56 | "gitHead": "070a1c35478946515074fe0286b47121b4bbfac7", 57 | "publishConfig": { 58 | "access": "public" 59 | }, 60 | "dependencies": { 61 | "bs-postgres": "^0.2.0", 62 | "re-opaque": "^1.1.0", 63 | "reason-jest": "^2.2.0" 64 | }, 65 | "resolutions": { 66 | "dot-prop": ">=5.1.1", 67 | "minimist": ">=0.2.1", 68 | "acorn": ">=6.4.1", 69 | "kind-of": ">=6.0.3" 70 | } 71 | } 72 | -------------------------------------------------------------------------------- /src/Client.re: -------------------------------------------------------------------------------- 1 | module O = OptionUtils; 2 | module R = ResultUtils; 3 | module P = PromiseUtils; 4 | module Fs = FsUtils; 5 | let (resolve, then_, reject) = Js.Promise.(resolve, then_, reject); 6 | 7 | module QueryResult = { 8 | // Various errors that can occur. TODO add a connection error type 9 | type error = 10 | | RowDecodeError(RowDecode.error); 11 | 12 | let errorToExn: error => exn = 13 | fun 14 | | RowDecodeError(e) => RowDecode.Error(e); 15 | 16 | let errorToJson: JsonUtils.toJson(error) = 17 | JsonUtils.Encode.( 18 | fun 19 | | RowDecodeError(e) => e |> object1("RowDecodeError", RowDecode.errorToJson) 20 | ); 21 | 22 | exception Error(error); 23 | 24 | type t('a) = R.t('a, error); 25 | 26 | let ok: 'a => t('a) = res => R.Ok(res); 27 | let error: error => t('a) = err => R.Error(err); 28 | 29 | module Enc = JsonUtils.Encode; 30 | 31 | let encode: JsonUtils.toJson('a) => JsonUtils.toJson(t('a)) = 32 | Enc.( 33 | encodeSuccess => 34 | fun 35 | | Error(e) => e |> object1("Error", errorToJson) 36 | | R.Ok(x) => x |> object1("Success", encodeSuccess) 37 | ); 38 | 39 | let unwrap: t('a) => 'a = r => r |> R.mapError(errorToExn) |> R.unwrap; 40 | let unwrapPromise: t('a) => Js.Promise.t('a) = 41 | r => r |> R.mapError(errorToExn) |> R.unwrapPromise; 42 | }; 43 | 44 | type rows = array(RowDecode.Row.t(Js.Json.t)); 45 | 46 | // The most general client, parameterized by: 47 | // 'handle: DB abstraction (e.g. a Sqlite3 connection), 48 | // 'result: the type of objects the database returns on success. These 49 | // will be converted to the `rows` type above, via the `resultToRows` function. 50 | // 'query: The specific SQL query type being used, rendered into a raw 51 | // SQL via the `queryToSql` function. 52 | type t('handle, 'result, 'query) = { 53 | // Handle to the object that allows us to communicate with the database. 54 | handle: 'handle, 55 | // Render a query into SQL. 56 | queryToSql: 'query => string, 57 | // Run a raw query that returns rows. 58 | queryRaw: ('handle, string) => Js.Promise.t('result), 59 | // Run a raw query that doesn't return information. 60 | execRaw: ('handle, string) => Js.Promise.t('result), 61 | // Translate a result into an array of rows. 62 | resultToRows: 'result => rows, 63 | // Function to run on the query before it's executed. 64 | onQuery: option((t('handle, 'result, 'query), 'query) => unit), 65 | // Function to run after the result is received. 66 | onResult: option((t('handle, 'result, 'query), option('query), 'result) => unit), 67 | }; 68 | 69 | // Can be passed to a `onQuery` argument, given some string conversion. Invokes 70 | // `f` on each query before it's executed. 71 | let logQueryWith: (string => unit, t('h, 'r, 'q), 'q) => unit = 72 | (f, {queryToSql}, q) => f(queryToSql(q) ++ ";"); 73 | 74 | // Logs a query to stdout via Js.log. 75 | // TODO add a ~color parameter to this? 76 | let logQuery: (t('h, 'r, 'q), 'q) => unit = (c, q) => logQueryWith(Js.log, c, q); 77 | 78 | // Create a client. 79 | let make = (~handle, ~queryToSql, ~resultToRows, ~queryRaw, ~execRaw, ~onQuery=?, ~onResult=?, ()) => { 80 | handle, 81 | queryToSql, 82 | queryRaw, 83 | resultToRows, 84 | execRaw, 85 | onQuery, 86 | onResult, 87 | }; 88 | 89 | let renderQuery = ({queryToSql}, query) => queryToSql(query); 90 | let handle = ({handle}) => handle; 91 | 92 | let query: (t('h, 'r, 'q), 'q) => Js.Promise.t(rows) = 93 | ({onQuery, onResult, handle, queryToSql, queryRaw, resultToRows} as client, query) => { 94 | let _ = O.map(onQuery, f => f(client, query)); 95 | queryRaw(handle, queryToSql(query)) 96 | |> then_(result => { 97 | let _ = O.map(onResult, f => f(client, Some(query), result)); 98 | result |> resultToRows |> resolve; 99 | }); 100 | }; 101 | 102 | let exec: (t('h, 'r, 'q), 'q) => Js.Promise.t(rows) = 103 | ({onQuery, onResult, handle, queryToSql, execRaw, resultToRows} as client, query) => { 104 | let _ = O.map(onQuery, f => f(client, query)); 105 | execRaw(handle, queryToSql(query)) 106 | |> then_(result => { 107 | let _ = O.map(onResult, f => f(client, Some(query), result)); 108 | result |> resultToRows |> resolve; 109 | }); 110 | }; 111 | 112 | let decodeResult: (RowDecode.fromRows('a), rows) => QueryResult.t('a) = 113 | (fromRows, rows) => 114 | try(Belt.Result.Ok(fromRows(rows))) { 115 | | RowDecode.Error(e) => Belt.Result.Error(RowDecodeError(e)) 116 | }; 117 | 118 | //////////////////////////////////////////////////////////////////////////////// 119 | ///// Selects 120 | 121 | let select = 122 | (cli: t(_), fromRows: RowDecode.fromRows('a), select): Js.Promise.t(QueryResult.t('a)) => 123 | query(cli, Sql.Select(select))->P.map(decodeResult(fromRows)); 124 | 125 | let selectUnwrap = (cli, fromRows, select_) => 126 | select(cli, fromRows, select_) |> then_(QueryResult.unwrapPromise); 127 | 128 | //////////////////////////////////////////////////////////////////////////////// 129 | ///// Inserts 130 | 131 | let insert: 132 | 'h 'r 'q. 133 | ( 134 | t('h, 'r, Sql.query('returning, 'onConflict, _, _)), 135 | Sql.Insert.t('returning, 'onConflict) 136 | ) => 137 | Js.Promise.t(_) 138 | = 139 | (cli, insert) => exec(cli, Sql.Insert(insert)); 140 | 141 | let insertReturn = (cli, fromRows, insert) => 142 | query(cli, Sql.Insert(insert))->P.map(decodeResult(fromRows)); 143 | 144 | let insertReturnUnwrap = (cli, fromRows, insert) => 145 | insertReturn(cli, fromRows, insert) |> then_(QueryResult.unwrapPromise); 146 | 147 | //////////////////////////////////////////////////////////////////////////////// 148 | ///// Creation 149 | 150 | let createTable = (cli, ct) => exec(cli, Sql.CreateTable(ct)); 151 | 152 | let createView = (cli, cv) => exec(cli, Sql.CreateView(cv)); 153 | 154 | //////////////////////////////////////////////////////////////////////////////// 155 | ///// Raw SQL 156 | 157 | // Execute a query and throw away the result 158 | let execRaw: 'h 'r 'q. (t('h, 'r, 'q), string) => P.t(unit) = 159 | ({handle, execRaw, onResult} as client, sql) => 160 | execRaw(handle, sql) 161 | ->P.map(res => { 162 | onResult->O.forEach(f => f(client, None, res)); 163 | (); 164 | }); 165 | 166 | // Execute a query with raw SQL and convert the result to rows 167 | let queryRawRows: 'h 'r 'q. (t('h, 'r, 'q), string) => P.t(rows) = 168 | ({handle, queryRaw, onResult, resultToRows} as client, rawSql) => 169 | queryRaw(handle, rawSql) 170 | ->P.map(res => { 171 | onResult->O.forEach(f => f(client, None, res)); 172 | res->resultToRows; 173 | }); 174 | 175 | // Execute a query with raw SQL and parse the resulting rows. 176 | let queryRawDecode: 177 | 'h 'r 'q 'a. 178 | (t('h, 'r, 'q), RowDecode.fromRows('a), string) => P.t(QueryResult.t('a)) 179 | = 180 | (client, fromRows, rawSql) => client->queryRawRows(rawSql)->P.map(decodeResult(fromRows)); 181 | 182 | // Execute a file containing SQL. 183 | let execFile: 'h 'r 'q. (t('h, 'r, 'q), ~encoding: Fs.stringEncoding=?, string) => P.t(unit) = 184 | (client, ~encoding=?, path) => { 185 | // TODO implement promisify readFile 186 | Fs.readFileAsync(~encoding?, path) 187 | ->P.flatMap(contents => client->execRaw(contents)); 188 | }; 189 | 190 | // Execute a query with SQL from a file and convert the result to rows. 191 | let queryFileRows: 'h 'r 'q. (t('h, 'r, 'q), ~encoding: Fs.stringEncoding=?, string) => P.t(rows) = 192 | (client, ~encoding=?, path) => 193 | Fs.readFileAsync(~encoding?, path)->P.flatMap(rawSql => client->queryRawRows(rawSql)); 194 | 195 | /* // Execute a query with raw SQL and parse the resulting rows. */ 196 | let queryFileDecode: 197 | 'a 'h 'r 'q. 198 | (t('h, 'r, 'q), ~encoding: Fs.stringEncoding=?, RowDecode.fromRows('a), string) => 199 | P.t(QueryResult.t('a)) 200 | = 201 | (client, ~encoding=?, fromRows, path) => 202 | Fs.readFileAsync(~encoding?, path) 203 | ->P.flatMap(rawSql => client->queryRawDecode(fromRows, rawSql)); 204 | -------------------------------------------------------------------------------- /src/QueryBuilder.re: -------------------------------------------------------------------------------- 1 | open Sql; 2 | module E = Expression; 3 | module L = ListUtils; 4 | 5 | type columnName = ColumnName.t; 6 | type functionName = FunctionName.t; 7 | type column = Column.t; 8 | type tableName = TableName.t; 9 | type aliased('t) = Aliased.t('t); 10 | type constraintName = ConstraintName.t; 11 | type databaseName = DatabaseName.t; 12 | type tableConstraint('tr) = CreateTable.tableConstraint('tr); 13 | type typeName = TypeName.t; 14 | type target = Select.target; 15 | type selectInUnion = Select.selectInUnion; 16 | type selectVariant = Select.selectVariant; 17 | type select = Select.select; 18 | 19 | type expr = Expression.t; 20 | type direction = Select.direction; 21 | type insert('r, 'oc) = Insert.t('r, 'oc); 22 | type tableStatement('tr) = CreateTable.statement('tr); 23 | type onDelete = CreateTable.onDelete; 24 | type createTable('tr) = CreateTable.t('tr); 25 | type createView = CreateView.t; 26 | type whereClause = Select.whereClause; 27 | type row = list((columnName, expr)); 28 | type toSelect('t) = 't => select; 29 | type toInsert('r, 'oc, 't) = ('t, tableName) => insert('r, 'oc); 30 | type toColumnName('t) = 't => columnName; 31 | type columnDef = CreateTable.columnDef; 32 | type toColumnDef('t) = 't => columnDef; 33 | type toColumnDefs('a) = 'a => list(columnDef); 34 | type toTableStatement('tr, 't) = 't => tableStatement('tr); 35 | type toExpr('t) = 't => expr; 36 | type toRow('t) = 't => row; 37 | 38 | let typeName = TypeName.fromString; 39 | let typed = (e, t) => E.Typed(e, t); 40 | type toTypeName('a) = 'a => typeName; 41 | 42 | let null = E.Atom(E.Null); 43 | let nullable = (toExpr, opt) => O.mapWithDefault(opt, null, toExpr); 44 | let int = i => E.Atom(E.Int(i)); 45 | let bool = b => E.Atom(E.Bool(b)); 46 | let float = f => E.Atom(E.Float(f)); 47 | let string = s => E.Atom(E.String(s)); 48 | let bigint = i => typed(int(i), typeName("BigInt")); 49 | let tuple = exprs => E.Tuple(L.toArray(exprs)); 50 | let tuple2 = (f, g, (a, b)) => tuple([f(a), g(b)]); 51 | let tupleOf = (toExpr: toExpr('a), xs) => tuple(L.map(xs, toExpr)); 52 | 53 | let tname = TableName.fromString; 54 | let cname = ColumnName.fromString; 55 | let cnames = l => L.map(l, ColumnName.fromString); 56 | let fname = FunctionName.fromString; 57 | let column = Column.fromString; 58 | let columnFromName: columnName => column = cn => cn->ColumnName.toString->column; 59 | let tcolumn = (t, c) => Column.fromColumnNameWithTable(t, c); 60 | let columns = Column.fromStringList; 61 | let tcolumns = l => Column.fromTupleList(L.map(l, ((t, c)) => (tname(t), c))); 62 | let col_ = c => E.Atom(E.Column(c)); 63 | let col = c => E.Atom(E.Column(columnFromName(c))); 64 | let cols = cs => L.map(cs, col); 65 | let tcol = (t, c) => E.Atom(E.Column(tcolumn(t, c))); 66 | let all = E.(Atom(Column(Column.all))); 67 | let allFrom = t => E.Atom(Column(Column.allFrom(tname(t)))); 68 | 69 | let between = (e, lo, hi) => E.Between(e, lo, hi); 70 | let in_ = (e1, e2) => E.In(e1, e2); 71 | let concat = (e1, e2) => E.Concat(e1, e2); 72 | let add = (e1, e2) => E.Add(e1, e2); 73 | let subtract = (e1, e2) => E.Subtract(e1, e2); 74 | let multiply = (e1, e2) => E.Multiply(e1, e2); 75 | let divide = (e1, e2) => E.Divide(e1, e2); 76 | 77 | let eq = (e1, e2) => E.Eq(e1, e2); 78 | let neq = (e1, e2) => E.Neq(e1, e2); 79 | let lt = (e1, e2) => E.Lt(e1, e2); 80 | let leq = (e1, e2) => E.Leq(e1, e2); 81 | let gt = (e1, e2) => E.Gt(e1, e2); 82 | let geq = (e1, e2) => E.Geq(e1, e2); 83 | let like = (e1, e2) => E.Like(e1, e2); 84 | let and_ = (e1, e2) => E.And(e1, e2); 85 | let or_ = (e1, e2) => E.Or(e1, e2); 86 | let not = e => E.Not(e); 87 | let xor = (e1, e2) => e1 |> and_(not(e2)) |> or_(e2 |> and_(not(e1))); 88 | let ands = 89 | fun 90 | | [] => bool(true) 91 | | [expr, ...exprs] => L.reduce(exprs, expr, and_); 92 | let ors = 93 | fun 94 | | [] => bool(false) 95 | | [expr, ...exprs] => L.reduce(exprs, expr, or_); 96 | let xors = 97 | fun 98 | | [] => bool(false) 99 | | [expr, ...exprs] => L.reduce(exprs, expr, xor); 100 | let isNotNull = e => E.IsNotNull(e); 101 | let isNull = e => E.IsNull(e); 102 | 103 | module Op = { 104 | let (++) = concat; 105 | let (+) = add; 106 | let (-) = subtract; 107 | let ( * ) = multiply; 108 | let (/) = divide; 109 | let (==) = eq; 110 | let (!=) = neq; 111 | let (<) = lt; 112 | let (<=) = leq; 113 | let (>) = gt; 114 | let (>=) = geq; 115 | let (&&) = and_; 116 | let (||) = or_; 117 | }; 118 | 119 | let count = e => E.Call(fname("COUNT"), [|e|]); 120 | let distinct = e => E.Call(fname("DISTINCT"), [|e|]); 121 | let max = e => E.Call(fname("MAX"), [|e|]); 122 | let min = e => E.Call(fname("MIN"), [|e|]); 123 | let avg = e => E.Call(fname("AVG"), [|e|]); 124 | let sum = e => E.Call(fname("SUM"), [|e|]); 125 | let coalesce = (e1, e2) => E.Call(fname("COALESCE"), [|e1, e2|]); 126 | let call = (name, args) => E.Call(name, L.toArray(args)); 127 | let inTuple = (e, es) => in_(e, tuple(es)); 128 | let inTupleOf = (e, toExpr, items) => inTuple(e, L.map(items, toExpr)); 129 | 130 | let e = (~a=?, expr): aliased(expr) => Aliased.make(expr, ~a?); 131 | 132 | let table = (~a=?, t) => Select.Table(Aliased.make(t, ~a?)); 133 | let tableNamed = (~a=?, name) => Select.Table(Aliased.make(tname(name), ~a?)); 134 | let innerJoin = (t1, on, t2) => Select.(Join(Inner(on), t2, t1)); 135 | let leftJoin = (t1, on, t2) => Select.(Join(Left(on), t2, t1)); 136 | let rightJoin = (t1, on, t2) => Select.(Join(Right(on), t2, t1)); 137 | let fullJoin = (t1, on, t2) => Select.(Join(Full(on), t2, t1)); 138 | let crossJoin = (t1, t2) => Select.(Join(Cross, t2, t1)); 139 | // TODO this can inspect the type of the select to collapse unnecessary aliases 140 | let selectAs = (alias, select) => Select.SubSelect(select, alias); 141 | 142 | let (asc, desc) = Select.(ASC, DESC); 143 | 144 | let from: (target, list(aliased(expr))) => selectInUnion = 145 | (target, exprs) => { 146 | selections: L.toArray(exprs), 147 | into: None, 148 | from: Some(target), 149 | groupBy: None, 150 | where: None, 151 | }; 152 | 153 | let fromNone = exprs => { 154 | Select.selections: L.toArray(exprs), 155 | into: None, 156 | from: None, 157 | groupBy: None, 158 | where: None, 159 | }; 160 | 161 | let selectInto: (tableName, selectInUnion) => selectInUnion = 162 | (t, sel) => {...sel, into: Some((t, None))}; 163 | 164 | let selectIntoIn: (tableName, databaseName, selectInUnion) => selectInUnion = 165 | (t, db, sel) => {...sel, into: Some((t, Some(db)))}; 166 | 167 | let where: (expr, selectInUnion) => selectInUnion = 168 | (expr, sel) => {...sel, where: Some(Where(expr))}; 169 | 170 | let andWhere: (expr, selectInUnion) => selectInUnion = 171 | (expr, sel) => 172 | sel 173 | |> ( 174 | switch (sel.where) { 175 | | Some(Where(cond)) => where(Op.(expr && cond)) 176 | | _ => where(expr) 177 | } 178 | ); 179 | 180 | let orWhere: (expr, selectInUnion) => selectInUnion = 181 | (expr, sel) => 182 | sel 183 | |> ( 184 | switch (sel.where) { 185 | | Some(Where(cond)) => where(Op.(expr || cond)) 186 | | _ => where(expr) 187 | } 188 | ); 189 | 190 | let whereExists: (select, selectInUnion) => selectInUnion = 191 | (exists, sel) => {...sel, where: Some(WhereExists(exists))}; 192 | 193 | let select = s => {Select.with_: None, select: Select(s), orderBy: None, limit: None}; 194 | 195 | let selectN = (n, s) => { 196 | Select.with_: None, 197 | select: Select(s), 198 | orderBy: None, 199 | limit: Some(int(n)), 200 | }; 201 | 202 | let select1 = selectN(1); 203 | 204 | //let union_: (selectInUnion, selectInUnion) => select = 205 | // (s1, s2) => {with_: None, select: Union(s1, s2) 206 | // 207 | let as_ = alias => 208 | Select.( 209 | fun 210 | | Table(tname) => Table(Aliased.as_(tname, alias)) 211 | | SubSelect(q, _) => SubSelect(q, alias) 212 | | target => SubSelect(select([e(all)] |> from(target)), alias) 213 | ); 214 | 215 | // Still figuring out the ideal api for this... 216 | let union1: (selectInUnion, select) => select = 217 | (siu, sel) => {...sel, select: Union(sel.select, Select(siu))}; 218 | 219 | let union: (selectVariant, select) => select = 220 | (s, sel) => {...sel, select: Union(sel.select, s)}; 221 | 222 | let unionAll: (selectVariant, select) => select = 223 | (s, sel) => {...sel, select: UnionAll(sel.select, s)}; 224 | 225 | let with_: (TableName.t, list(ColumnName.t), select, select) => select = 226 | (alias, colNames, aliasedSel, sel) => { 227 | ...sel, 228 | with_: Some((alias, L.toArray(colNames), aliasedSel)), 229 | }; 230 | 231 | // TODO rewrite tail-recursive 232 | let rec withs = defs => 233 | switch (defs) { 234 | | [] => (select => select) 235 | | [(t, cols, sel), ...defs] => (select => with_(t, cols, sel, withs(defs, select))) 236 | }; 237 | 238 | let orderBy = (exs, s) => 239 | Select.{...s, orderBy: Some(L.mapToArray(exs, ((c, dir)) => (c, Some(dir))))}; 240 | let orderBy_ = (exs, s) => Select.{...s, orderBy: Some(L.mapToArray(exs, c => (c, None)))}; 241 | let orderBy1 = (ex, dir, s) => Select.{...s, orderBy: Some([|(ex, Some(dir))|])}; 242 | let orderBy1_ = (ex, s) => Select.{...s, orderBy: Some([|(ex, None)|])}; 243 | let orderBy2 = (ex1, dir1, ex2, dir2, s) => 244 | Select.{...s, orderBy: Some([|(ex1, Some(dir1)), (ex2, Some(dir2))|])}; 245 | let orderBy2_ = (ex1, ex2, s) => Select.{...s, orderBy: Some([|(ex1, None), (ex2, None)|])}; 246 | let limit = (n, s) => Select.{...s, limit: Some(n)}; 247 | let limit1 = s => Select.{...s, limit: Some(int(1))}; 248 | 249 | //let orderByCols = orderBy_(column); 250 | let groupBy = (~having=?, cols, s) => Select.{...s, groupBy: Some((L.toArray(cols), having))}; 251 | let groupBy1 = (~having=?, col, s) => Select.{...s, groupBy: Some(([|col|], having))}; 252 | let groupByColumn = (~having=?, c, s) => Select.{...s, groupBy: Some(([|col(c)|], having))}; 253 | let groupByCol = groupByColumn; 254 | let groupByColumns = (~having=?, cols, s) => 255 | Select.{...s, groupBy: Some((L.mapToArray(cols, col), having))}; 256 | let groupByCols = groupByColumns; 257 | 258 | let convertRow = (toC, toE, (k, v)) => (toC(k), toE(v)); 259 | let convertColumn = (toC, toE, (k, vs)) => (toC(k), A.map(L.toArray(vs), toE)); 260 | 261 | let insertColumns = cols => 262 | Insert.make(Values(L.toArray(L.map(cols, ((c, exprs)) => (c, L.toArray(exprs)))))); 263 | 264 | let insertColumnsWith = (toColumnName, toExpr, cols) => 265 | Insert.make(Values(L.toArray(L.map(cols, convertColumn(toColumnName, toExpr))))); 266 | 267 | let insertRows = rows => 268 | Insert.(make(Values(rowsToColumns(L.toArray(L.map(rows, L.toArray)))))); 269 | 270 | let insertRowsWith = (toColumnName, toExpr, rows) => 271 | Insert.( 272 | make( 273 | Values( 274 | rowsToColumns( 275 | A.map(L.toArray(rows), row => 276 | A.map(L.toArray(row), convertRow(toColumnName, toExpr)) 277 | ), 278 | ), 279 | ), 280 | ) 281 | ); 282 | 283 | let insertRow = row => insertRows([row]); 284 | let insertRowWith = (toC, toE, row) => insertRow(L.map(row, convertRow(toC, toE))); 285 | let insertOne = (toRow, obj) => insertRow(toRow(obj)); 286 | let insertMany = (toRow, objects) => insertRows(L.map(objects, toRow)); 287 | let insertSelect = select => Insert.make(Insert.Select(select)); 288 | 289 | let returning = (returning, insert) => Insert.{...insert, returning: Some(returning)}; 290 | 291 | let onConflict = (onConflict, insert) => Insert.{...insert, onConflict: Some(onConflict)}; 292 | 293 | let into = (t, f) => f(t); 294 | 295 | let cdef = 296 | (~primaryKey=false, ~notNull=true, ~unique=false, ~check=?, ~default=?, name, type_) 297 | : tableStatement('tr) => 298 | ColumnDef({ 299 | CreateTable.name, 300 | type_, 301 | constraints: { 302 | primaryKey, 303 | notNull, 304 | unique, 305 | check, 306 | default, 307 | }, 308 | }); 309 | 310 | let nullableCol = (~unique=?, ~check=?, ~default=?) => 311 | cdef(~primaryKey=false, ~notNull=false, ~unique?, ~check?, ~default?); 312 | 313 | let notNullCol = (~unique=?, ~check=?, ~default=?) => 314 | cdef(~primaryKey=false, ~notNull=true, ~unique?, ~check?, ~default?); 315 | 316 | let primaryKeyCol = (~check=?, ~default=?) => 317 | cdef(~primaryKey=false, ~notNull=true, ~unique=false, ~check?, ~default?); 318 | 319 | let constraintName = ConstraintName.fromString; 320 | 321 | let constraint_ = (~a=?, c) => CreateTable.(Constraint(a, c)); 322 | let primaryKey = cols => CreateTable.PrimaryKey(L.toArray(cols)); 323 | let foreignKey = (~onDelete=?, col, (refTbl: 'tr, refCol)): tableConstraint('tr) => 324 | CreateTable.ForeignKey(col, (refTbl, refCol), onDelete); 325 | let unique = cols => CreateTable.Unique(L.toArray(cols)); 326 | let check = expr => CreateTable.Check(expr); 327 | 328 | let primaryKey1 = name => primaryKey([name]); 329 | 330 | let createTable = 331 | (~ifNotExists=true, name, statements: list(tableStatement(tableName))) 332 | : createTable(tableName) => { 333 | CreateTable.name, 334 | statements: L.toArray(statements), 335 | ifNotExists, 336 | }; 337 | 338 | let createTableWith = (~ifNotExists=true, name, statements) => { 339 | CreateTable.name, 340 | statements: L.toArray(statements), 341 | ifNotExists, 342 | }; 343 | 344 | let createView = (~ifNotExists=true, name, query) => CreateView.{name, query, ifNotExists}; 345 | 346 | module Types = { 347 | let int = typeName("INTEGER"); 348 | let text = typeName("TEXT"); 349 | let char = len => typeName("CHAR(" ++ string_of_int(len) ++ ")"); 350 | }; 351 | -------------------------------------------------------------------------------- /src/QueryBuilder.rei: -------------------------------------------------------------------------------- 1 | type columnName = Sql.ColumnName.t; 2 | type databaseName = Sql.DatabaseName.t; 3 | type tableName = Sql.TableName.t; 4 | type functionName = Sql.FunctionName.t; 5 | type aliased('t) = Sql.Aliased.t('t); 6 | type constraintName = Sql.ConstraintName.t; 7 | type tableConstraint('tr) = Sql.CreateTable.tableConstraint('tr); 8 | type column = Sql.Column.t; 9 | type typeName = Sql.TypeName.t; 10 | type target = Sql.Select.target; 11 | type selectInUnion = Sql.Select.selectInUnion; 12 | type selectVariant = Sql.Select.selectVariant; 13 | type select = Sql.Select.select; 14 | type expr = Sql.Expression.t; 15 | type direction = Sql.Select.direction; 16 | type insert('r, 'oc) = Sql.Insert.t('r, 'oc); 17 | type tableStatement('tr) = Sql.CreateTable.statement('tr); 18 | type createTable('tr) = Sql.CreateTable.t('tr); 19 | type createView = Sql.CreateView.t; 20 | type whereClause = Sql.Select.whereClause; 21 | type onDelete = Sql.CreateTable.onDelete; 22 | type columnDef = Sql.CreateTable.columnDef; 23 | 24 | /**************************** 25 | * Encoder types 26 | ***************************/ 27 | 28 | type row = list((columnName, expr)); 29 | type toSelect('t) = 't => select; 30 | type toInsert('r, 'oc, 't) = ('t, tableName) => insert('r, 'oc); 31 | type toColumnName('t) = 't => columnName; 32 | type toExpr('t) = 't => expr; 33 | type toRow('t) = 't => row; 34 | type toColumnDef('t) = 't => columnDef; 35 | type toColumnDefs('a) = 'a => list(columnDef); 36 | type toTableStatement('tr, 't) = 't => tableStatement('tr); 37 | type toTypeName('a) = 'a => typeName; 38 | 39 | /*************************** 40 | * Expressions 41 | ****************************/ 42 | 43 | // Literals 44 | let int: int => expr; 45 | let bigint: int => expr; 46 | let float: float => expr; 47 | let string: string => expr; 48 | let bool: bool => expr; 49 | let tuple: list(expr) => expr; 50 | 51 | /************************ 52 | * Dealing with nulls 53 | ***********************/ 54 | 55 | let null: expr; 56 | let isNull: expr => expr; 57 | let isNotNull: expr => expr; 58 | 59 | /************************ 60 | * Dealing with types 61 | ***********************/ 62 | 63 | // Add an explicit type cast to an expression 64 | let typed: (expr, typeName) => expr; 65 | 66 | /********************************************** 67 | * Dealing with specialized name types 68 | **********************************************/ 69 | 70 | // A single column, from a columnName. Recall that columns and columnNames 71 | // differ in that the former can be `*` and can be prefixed with a table 72 | // name, while columnNames are just wrapped strings. 73 | let col: columnName => expr; 74 | 75 | // Multiple columns 76 | let cols: list(columnName) => list(expr); 77 | 78 | // A single column, from a column name 79 | let col_: column => expr; 80 | 81 | // A single column from a table name and column name 82 | let tcol: (tableName, columnName) => expr; 83 | 84 | // Make a `tableName` from a string 85 | let tname: string => tableName; 86 | 87 | // Make a `column` from a string 88 | let cname: string => columnName; 89 | 90 | // Make multiple `columnNames` from strings 91 | let cnames: list(string) => list(columnName); 92 | 93 | // Make a type name from a string. 94 | let typeName: string => typeName; 95 | 96 | // Make a `column` from a string, without a table name. 97 | // Remember the difference between the `column` and `columnName` types 98 | // is that the former can include a table name prefix (see `tcolumn`). 99 | // To make a `columnName` use `cname`. 100 | let column: string => column; 101 | 102 | // Make a `column` object from a table name and column name. 103 | let tcolumn: (tableName, columnName) => column; 104 | 105 | // Make multiple `column`s from strings. 106 | let columns: list(string) => list(column); 107 | 108 | // Make multiple `table`.`column`s from string pairs. 109 | let tcolumns: list((string, string)) => list(column); 110 | 111 | // All columns (*) 112 | let all: expr; 113 | 114 | // All columns from a particular table (foo.*) 115 | let allFrom: string => expr; 116 | 117 | // Operators 118 | let between: (expr, expr, expr) => expr; 119 | let in_: (expr, expr) => expr; 120 | let concat: (expr, expr) => expr; 121 | let add: (expr, expr) => expr; 122 | let subtract: (expr, expr) => expr; 123 | let multiply: (expr, expr) => expr; 124 | let divide: (expr, expr) => expr; 125 | let eq: (expr, expr) => expr; 126 | let neq: (expr, expr) => expr; 127 | let lt: (expr, expr) => expr; 128 | let gt: (expr, expr) => expr; 129 | let leq: (expr, expr) => expr; 130 | let geq: (expr, expr) => expr; 131 | let like: (expr, expr) => expr; 132 | 133 | // Boolean operators 134 | let and_: (expr, expr) => expr; 135 | let or_: (expr, expr) => expr; 136 | let xor: (expr, expr) => expr; 137 | 138 | // AND all of the expressions in the list (true if empty) 139 | let ands: list(expr) => expr; 140 | 141 | // OR all of the expressions in the list (false if empty) 142 | let ors: list(expr) => expr; 143 | 144 | // XOR all of the expressions in the list (false if empty) 145 | let xors: list(expr) => expr; 146 | 147 | let not: expr => expr; 148 | 149 | // Symbolic versions of binary operators. Put into their own module 150 | // because they clash with operators from pervasives. 151 | module Op: { 152 | let (++): (expr, expr) => expr; 153 | let (+): (expr, expr) => expr; 154 | let (-): (expr, expr) => expr; 155 | let ( * ): (expr, expr) => expr; 156 | let (/): (expr, expr) => expr; 157 | let (==): (expr, expr) => expr; 158 | let (!=): (expr, expr) => expr; 159 | let (<): (expr, expr) => expr; 160 | let (<=): (expr, expr) => expr; 161 | let (>): (expr, expr) => expr; 162 | let (>=): (expr, expr) => expr; 163 | let (&&): (expr, expr) => expr; 164 | let (||): (expr, expr) => expr; 165 | }; 166 | 167 | // Functions 168 | let fname: string => functionName; 169 | let count: expr => expr; 170 | let distinct: expr => expr; 171 | let max: expr => expr; 172 | let min: expr => expr; 173 | let sum: expr => expr; 174 | let avg: expr => expr; 175 | let coalesce: (expr, expr) => expr; 176 | let call: (functionName, list(expr)) => expr; 177 | 178 | /*********** Higher order functions **********/ 179 | 180 | // null if the value is None, else convert the Some value. 181 | let nullable: ('t => expr, option('t)) => expr; 182 | 183 | // Convert to a tuple. 184 | let tuple2: (toExpr('a), toExpr('b)) => toExpr(('a, 'b)); 185 | 186 | // Convert a list to a tuple, given a way to convert each item in the list. 187 | let tupleOf: toExpr('a) => toExpr(list('a)); 188 | 189 | // Check if the first argument is a member of the second argument tuple. 190 | let inTuple: (expr, list(expr)) => expr; 191 | 192 | // Check if the first argument is a member of the second argument tuple, after converting the tuple. 193 | let inTupleOf: (expr, toExpr('a), list('a)) => expr; 194 | 195 | /*********************************************/ 196 | 197 | // Aliased expressions (appear after a SELECT, can have an alias) 198 | let e: (~a: string=?, expr) => aliased(expr); 199 | 200 | /*************************** 201 | * Targets 202 | ****************************/ 203 | 204 | // A table target 205 | let table: (~a: string=?, tableName) => target; 206 | 207 | // A table target, via a string. 208 | let tableNamed: (~a: string=?, string) => target; 209 | 210 | // Joins 211 | let innerJoin: (target, expr, target) => target; 212 | let leftJoin: (target, expr, target) => target; 213 | let rightJoin: (target, expr, target) => target; 214 | let fullJoin: (target, expr, target) => target; 215 | let crossJoin: (target, target) => target; 216 | 217 | // An inner SELECT query. Requires an alias: 218 | // `SELECT * FROM (SELECT ..) AS alias` 219 | let selectAs: (string, select) => target; 220 | 221 | /*************************** 222 | * SELECT Queries 223 | ****************************/ 224 | 225 | // For ORDER BY clauses 226 | let asc: direction; 227 | let desc: direction; 228 | 229 | // Modify or add an alias to a target. 230 | let as_: (string, target) => target; 231 | 232 | // Creates a top-level select statement. 233 | let select: selectInUnion => select; 234 | 235 | // Creates a top-level select statement with a limit of N. 236 | let selectN: (int, selectInUnion) => select; 237 | 238 | // Shorthand: creates a top-level select statement, with a limit of 1. 239 | let select1: selectInUnion => select; 240 | 241 | // Used to select from a table or another target. 242 | // 243 | // For example: 244 | // 245 | // select([e(col("x")), e(col("y"))] |> from(tableNamed(tname("points")))) 246 | // 247 | // ==> SELECT x, y FROM points; 248 | // 249 | let from: (target, list(aliased(expr))) => selectInUnion; 250 | 251 | // Used to select static values or constants. For example 252 | // select([e(int(1) + int(2))] |> fromNone) 253 | // ==> SELECT 1 + 2; 254 | let fromNone: list(aliased(expr)) => selectInUnion; 255 | 256 | // Adds an `INTO` clause to the select, inserting the result into another table 257 | // within the same database. To specify a different database, use `selectIntoIn`. 258 | let selectInto: (tableName, selectInUnion) => selectInUnion; 259 | 260 | // Like `selectInto` but specifies a different database to put the table in. 261 | let selectIntoIn: (tableName, databaseName, selectInUnion) => selectInUnion; 262 | 263 | // Add a WHERE clause to a selectInUnion. 264 | let where: (expr, selectInUnion) => selectInUnion; 265 | 266 | // Add an additional condition to a WHERE. If no WHERE is present on the input 267 | // this alone will be set. 268 | // NOTE: this stomps on a WHERE EXISTS. This may change in the future. 269 | let andWhere: (expr, selectInUnion) => selectInUnion; 270 | 271 | // Add an alternative condition to a WHERE. If no WHERE is present on the input 272 | // this alone will be set. 273 | // NOTE: this stomps on a WHERE EXISTS. This may change in the future. 274 | let orWhere: (expr, selectInUnion) => selectInUnion; 275 | 276 | let whereExists: (select, selectInUnion) => selectInUnion; 277 | 278 | let groupBy: (~having: expr=?, list(expr), selectInUnion) => selectInUnion; 279 | let groupBy1: (~having: expr=?, expr, selectInUnion) => selectInUnion; 280 | let groupByColumn: (~having: expr=?, columnName, selectInUnion) => selectInUnion; 281 | let groupByCol: (~having: expr=?, columnName, selectInUnion) => selectInUnion; // alias 282 | let groupByColumns: (~having: expr=?, list(columnName), selectInUnion) => selectInUnion; 283 | let groupByCols: (~having: expr=?, list(columnName), selectInUnion) => selectInUnion; // alias 284 | 285 | let union1: (selectInUnion, select) => select; 286 | let union: (selectVariant, select) => select; 287 | let unionAll: (selectVariant, select) => select; 288 | let with_: (tableName, list(columnName), select, select) => select; 289 | let withs: (list((tableName, list(columnName), select)), select) => select; 290 | 291 | // Apply a limit 292 | let limit: (expr, select) => select; 293 | // Limit to 1 (shorthand) 294 | let limit1: select => select; 295 | 296 | // Order by using default direction 297 | let orderBy_: (list(expr), select) => select; 298 | 299 | // Order using specific direction(s) 300 | let orderBy: (list((expr, direction)), select) => select; 301 | 302 | // Shorthand: Order by a single expression 303 | let orderBy1_: (expr, select) => select; 304 | 305 | // Shorthand: Order by a single expression with a direction 306 | let orderBy1: (expr, direction, select) => select; 307 | 308 | // Shorthand: Order by two expressions 309 | let orderBy2_: (expr, expr, select) => select; 310 | 311 | // Shorthand: Order by two expressions with two directions 312 | let orderBy2: (expr, direction, expr, direction, select) => select; 313 | 314 | /*************************** 315 | * INSERT Queries 316 | ****************************/ 317 | 318 | // Inserting literal columns/expressions. 319 | let insertColumns: toInsert('r, 'oc, list((columnName, list(expr)))); 320 | let insertRows: toInsert('r, 'oc, list(list((columnName, expr)))); 321 | let insertRow: toInsert('r, 'oc, list((columnName, expr))); 322 | 323 | // Apply a conversion function to create columns and expressions. 324 | let insertRowsWith: 325 | (toColumnName('a), toExpr('b)) => toInsert('r, 'oc, list(list(('a, 'b)))); 326 | let insertRowWith: (toColumnName('a), 'b => expr) => toInsert('r, 'oc, list(('a, 'b))); 327 | let insertColumnsWith: 328 | (toColumnName('a), toExpr('b)) => toInsert('r, 'oc, list(('a, list('b)))); 329 | 330 | // Given a function to convert an object to a row, insert one or more objects. 331 | let insertOne: toRow('t) => toInsert('r, 'oc, 't); 332 | let insertMany: toRow('t) => toInsert('r, 'oc, list('t)); 333 | 334 | // Add a `RETURNING` clause to an `INSERT` statement (for supported syntax) 335 | let returning: ('r, insert('r, 'oc)) => insert('r, 'oc); 336 | 337 | // Add an `ON CONFLICT` clause to an `INSERT` statement (for supported syntax) 338 | let onConflict: ('oc, insert('r, 'oc)) => insert('r, 'oc); 339 | 340 | // Insert with a SELECT query. 341 | let insertSelect: toInsert('r, 'oc, select); 342 | 343 | /******************************************************************************* 344 | Apply a table-to-query conversion. 345 | 346 | let insertAuthors = 347 | [("Stephen", "King"), ("Jane", "Austen")] 348 | |> insertMany(RE.columns2("first", string, "last", string)) 349 | |> into(tname("authors")); 350 | ********************************************************************************/ 351 | let into: (tableName, tableName => insert('r, 'oc)) => insert('r, 'oc); 352 | 353 | /*************************** 354 | * CREATE TABLE Queries 355 | * 356 | * Made up of some number of "statements", including 357 | * Column definitions (`cdef`) 358 | * Constraint definitions (`constraint_`) 359 | 360 | [ 361 | cdef(cname("id"), Types.int, ~primaryKey=true), 362 | cdef(cname("first"), Types.text), 363 | cdef(cname("last"), Types.text), 364 | ] 365 | |> createTable(tname("author"), ~ifNotExists=true) 366 | ****************************/ 367 | 368 | // Defining a column 369 | let cdef: 370 | ( 371 | ~primaryKey: bool=?, 372 | ~notNull: bool=?, 373 | ~unique: bool=?, 374 | ~check: expr=?, 375 | ~default: expr=?, 376 | columnName, 377 | typeName 378 | ) => 379 | tableStatement('tr); 380 | 381 | let nullableCol: 382 | (~unique: bool=?, ~check: expr=?, ~default: expr=?, columnName, typeName) => tableStatement('tr); 383 | 384 | let notNullCol: 385 | (~unique: bool=?, ~check: expr=?, ~default: expr=?, columnName, typeName) => tableStatement('tr); 386 | 387 | let primaryKeyCol: 388 | (~check: expr=?, ~default: expr=?, columnName, typeName) => tableStatement('tr); 389 | 390 | let constraintName: string => constraintName; 391 | 392 | // Define a single constraint as a statement. 393 | let constraint_: (~a: constraintName=?, tableConstraint('tr)) => tableStatement('tr); 394 | 395 | // Table-level constraints 396 | let primaryKey: list(columnName) => tableConstraint('tr); 397 | 398 | let primaryKey1: columnName => tableConstraint('tr); 399 | 400 | let foreignKey: (~onDelete: onDelete=?, columnName, ('tr, columnName)) => tableConstraint('tr); 401 | 402 | let unique: list(columnName) => tableConstraint('tr); 403 | let check: expr => tableConstraint('tr); 404 | 405 | // Creating a table 406 | let createTable: 407 | (~ifNotExists: bool=?, tableName, list(tableStatement(tableName))) => createTable(tableName); 408 | 409 | // Creating a table with a custom reference type 410 | let createTableWith: 411 | (~ifNotExists: bool=?, tableName, list(tableStatement('tr))) => createTable('tr); 412 | 413 | // Creating a view 414 | let createView: (~ifNotExists: bool=?, tableName, select) => createView; 415 | 416 | /************************************ 417 | * Commonly used sql type names 418 | ***********************************/ 419 | 420 | module Types: { 421 | let int: typeName; 422 | let text: typeName; 423 | let char: int => typeName; 424 | }; 425 | -------------------------------------------------------------------------------- /src/QueryDecode.re: -------------------------------------------------------------------------------- 1 | // Tools to combine an abstract type which can be rendered into a 2 | // query with a decoder of the result. This can be thought of as an alternate 3 | // API to running the individual query functions in `Client`: instead construct 4 | // query/decoder pairs and use the functions in this module to operate on them. 5 | module P = PromiseUtils; 6 | module M = JsMap; 7 | 8 | module SelectDecode = { 9 | type t('sel, 'output) = { 10 | toSelect: QueryBuilder.toSelect('sel), 11 | fromRows: RowDecode.fromRows('output), 12 | }; 13 | 14 | let make = (~toSelect, ~fromRows) => {toSelect, fromRows}; 15 | let toSelect = ({toSelect}) => toSelect; 16 | let fromRows = ({fromRows}) => fromRows; 17 | 18 | // Run a select object on a given client, returning 19 | let run: (Client.t('h, 'r, 'q), t('s, 'o), 's) => P.t(Client.QueryResult.t('o)) = 20 | (cli, {toSelect, fromRows}, sel) => cli->Client.select(fromRows, sel->toSelect); 21 | }; 22 | 23 | // Adds caching capabilities to a select. Very basic for now. Might be better 24 | // to make into an independent composable abstraction to avoid code duplication... 25 | module CachedSelectDecode = { 26 | type t('a, 'result) = { 27 | // Mutable map 28 | cache: M.t(string, P.t(Client.QueryResult.t('result))), 29 | toCacheKey: 'a => string, 30 | removeErrorsFromCache: bool, 31 | selectDecode: SelectDecode.t('a, 'result), 32 | }; 33 | 34 | let make = (~toCacheKey, ~removeErrorsFromCache=true, selectDecode) => { 35 | cache: M.empty(), 36 | toCacheKey, 37 | removeErrorsFromCache, 38 | selectDecode, 39 | }; 40 | 41 | // Run a query, caching the selection to avoid repeated queries. 42 | let run: (Client.t('h, 'r, 'q), t('a, 'r), 'a) => P.t(Client.QueryResult.t('r)) = 43 | (cli, {cache, toCacheKey, removeErrorsFromCache, selectDecode}, sel) => { 44 | let key = sel->toCacheKey; 45 | switch (cache->M.get(key)) { 46 | | None => 47 | let prom_ = cli->SelectDecode.run(selectDecode, sel); 48 | let prom = 49 | !removeErrorsFromCache 50 | ? prom_ 51 | : prom_ 52 | |> P.catch(err => { 53 | cache->M.deleteMut(key)->ignore; 54 | P.rejectError(err); 55 | }); 56 | cache->M.setMut(key, prom)->ignore; 57 | prom; 58 | | Some(resultProm) => resultProm 59 | }; 60 | }; 61 | }; 62 | -------------------------------------------------------------------------------- /src/RenderQuery.re: -------------------------------------------------------------------------------- 1 | open UtilsPrelude; 2 | module A = ArrayUtils; 3 | module L = ListUtils; 4 | module O = OptionUtils; 5 | module J = JsonUtils; 6 | module S = StringUtils; 7 | 8 | let map: 'a 'b. (array('a), 'a => 'b) => array('b) = Belt.Array.map; 9 | let join: array(string) => string = Js.Array.joinWith(""); 10 | let rmEmpty: array(string) => array(string) = strs => strs->A.keep(s => s->S.length > 0); 11 | let spaces: array(string) => string = strs => strs->rmEmpty |> Js.Array.joinWith(" "); 12 | let commas: array(string) => string = Js.Array.joinWith(","); 13 | let semis: array(string) => string = Js.Array.joinWith(";"); 14 | let parens: string => string = s => "(" ++ s ++ ")"; 15 | let brackets: string => string = s => "[" ++ s ++ "]"; 16 | let curlies: string => string = s => "{" ++ s ++ "}"; 17 | 18 | module type SqlRenderingRules = { 19 | // How to render TRUE and FALSE constants 20 | let _TRUE: string; 21 | let _FALSE: string; 22 | // How to escape a column/table/constraint/etc name to ensure it renders correctly 23 | let escapeName: string => string; 24 | }; 25 | 26 | module DefaultRules: SqlRenderingRules = { 27 | let _TRUE = "TRUE"; 28 | let _FALSE = "FALSE"; 29 | let validReg = { 30 | let first = "[a-zA-Z_#@]"; 31 | let rest = "[a-zA-Z0-9_$#]*"; 32 | Js.Re.fromString("^" ++ first ++ rest ++ "$"); 33 | }; 34 | let requiresEscape = n => !S.isMatch(n, validReg); 35 | // Escape double quotes by turning them into double-double quotes. 36 | let escapeName = n => 37 | !requiresEscape(n) ? n : "\"" ++ S.replace(~old="\"", ~new_="\"\"", n) ++ "\""; 38 | }; 39 | 40 | module WithRenderingRules = (S: SqlRenderingRules) => { 41 | // Wrap a table/column/etc name in quotes 42 | module RenderWrapped = (String: Opaque.String.StringType) => { 43 | include String; 44 | let render = s => S.escapeName(String.toString(s)); 45 | }; 46 | 47 | module FunctionName = RenderWrapped(Sql.FunctionName); 48 | module TableName = RenderWrapped(Sql.TableName); 49 | module ColumnName = RenderWrapped(Sql.ColumnName); 50 | module ConstraintName = RenderWrapped(Sql.ConstraintName); 51 | 52 | module RenderString = (String: Opaque.String.StringType) => { 53 | type t = String.t; 54 | let render = s => String.toString(s); 55 | }; 56 | 57 | module TypeName = RenderString(Sql.TypeName); 58 | 59 | module Column = { 60 | open Sql.Column; 61 | let render = c => 62 | switch (toTuple(c)) { 63 | | (None, Named(c)) => ColumnName.render(c) 64 | | (None, All) => "*" 65 | | (Some(t), Named(c)) => TableName.render(t) ++ "." ++ ColumnName.render(c) 66 | | (Some(t), All) => TableName.render(t) ++ ".*" 67 | }; 68 | }; 69 | 70 | module Aliased = { 71 | open Sql.Aliased; 72 | let render: ('a => string, t('a)) => string = 73 | (renderInner, aliased) => 74 | switch (toTuple(aliased)) { 75 | | (x, None) => renderInner(x) 76 | // TODO eventually aliases should be typed. For now just wrap 77 | // them as if they were column names 78 | | (x, Some(alias)) => 79 | renderInner(x) ++ " AS " ++ ColumnName.(render(fromString(alias))) 80 | }; 81 | }; 82 | 83 | module Expression = { 84 | open Sql.Expression; 85 | let renderAtom: atom => string = 86 | fun 87 | | Null => "NULL" 88 | | Column(col) => Column.render(col) 89 | | Int(i) => string_of_int(i) 90 | | Float(f) => Js.Float.toString(f) 91 | // Escape single quotes by replacing them with single quote pairs. 92 | | String(s) => "'" ++ StringUtils.replace(~old="'", ~new_="''", s) ++ "'" 93 | | Bool(b) => b ? S._TRUE : S._FALSE; 94 | 95 | // TODO right now we're parenthesizing more than we need to. We could be 96 | // smarter about this 97 | let rec render: t => string = 98 | fun 99 | | Atom(atom) => renderAtom(atom) 100 | | Typed(e, t) => renderP(e) ++ "::" ++ TypeName.render(t) 101 | | Concat(ex1, ex2) => renderP(ex1) ++ " || " ++ renderP(ex2) 102 | | Between(e, lo, hi) => 103 | renderP(e) ++ " BETWEEN " ++ renderP(lo) ++ " AND " ++ renderP(hi) 104 | | In(ex1, ex2) => renderP(ex1) ++ " IN " ++ renderP(ex2) 105 | | Add(ex1, ex2) => renderP(ex1) ++ " + " ++ renderP(ex2) 106 | | Subtract(ex1, ex2) => renderP(ex1) ++ " - " ++ renderP(ex2) 107 | | Multiply(ex1, ex2) => renderP(ex1) ++ " * " ++ renderP(ex2) 108 | | Divide(ex1, ex2) => renderP(ex1) ++ " / " ++ renderP(ex2) 109 | | Eq(ex1, ex2) => renderP(ex1) ++ " = " ++ renderP(ex2) 110 | | Neq(ex1, ex2) => renderP(ex1) ++ " <> " ++ renderP(ex2) 111 | | Lt(ex1, ex2) => renderP(ex1) ++ " < " ++ renderP(ex2) 112 | | Leq(ex1, ex2) => renderP(ex1) ++ " <= " ++ renderP(ex2) 113 | | Gt(ex1, ex2) => renderP(ex1) ++ " > " ++ renderP(ex2) 114 | | Geq(ex1, ex2) => renderP(ex1) ++ " >= " ++ renderP(ex2) 115 | | Like(ex1, ex2) => renderP(ex1) ++ " LIKE " ++ renderP(ex2) 116 | | And(ex1, ex2) => renderP(ex1) ++ " AND " ++ renderP(ex2) 117 | | Or(ex1, ex2) => renderP(ex1) ++ " OR " ++ renderP(ex2) 118 | | IsNull(e) => renderP(e) ++ " IS NULL" 119 | | IsNotNull(e) => renderP(e) ++ " IS NOT NULL" 120 | // A few tricks to simplify generated output 121 | | Not(IsNotNull(e)) => render(IsNull(e)) 122 | | Not(IsNull(e)) => render(IsNotNull(e)) 123 | | Not(e) => "NOT " ++ renderP(e) 124 | | Call(fnName, args) => 125 | fnName->FunctionName.render ++ A.mapJoinCommas(args, render)->parens 126 | | Tuple(exprs) => A.mapJoinCommas(exprs, render)->parens 127 | and renderP = 128 | fun 129 | | Atom(_) as e 130 | | Tuple(_) as e 131 | | Call(_) as e => render(e) 132 | | e => "(" ++ render(e) ++ ")"; 133 | }; 134 | 135 | module Select = { 136 | open Sql.Select; 137 | let renderJoinType: joinType => (string, option(string)) = 138 | fun 139 | | Inner(on) => ("INNER JOIN", Some(Expression.render(on))) 140 | | Left(on) => ("LEFT OUTER JOIN", Some(Expression.render(on))) 141 | | Right(on) => ("RIGHT OUTER JOIN", Some(Expression.render(on))) 142 | | Full(on) => ("FULL JOIN", Some(Expression.render(on))) 143 | | Cross => ("CROSS JOIN", None); 144 | 145 | let renderDirection: direction => string = 146 | fun 147 | | ASC => "ASC" 148 | | DESC => "DESC"; 149 | 150 | let rec renderTarget: target => string = 151 | fun 152 | | Table(tname) => Aliased.render(Sql.TableName.toString, tname) 153 | | SubSelect(q, alias) => render(q)->parens ++ " AS " ++ alias 154 | | Join(join, t1, t2) => 155 | switch (renderJoinType(join)) { 156 | | (keyword, None) => renderTarget(t1) ++ " " ++ keyword ++ " " ++ renderTarget(t2) 157 | | (keyword, Some(on)) => 158 | renderTarget(t1) ++ " " ++ keyword ++ " " ++ renderTarget(t2) ++ " ON " ++ on 159 | } 160 | 161 | and renderSelectInUnion: selectInUnion => string = 162 | ({selections, from, groupBy, where}) => { 163 | let selections' = A.mapJoinCommas(selections, Aliased.render(Expression.render)); 164 | let from' = O.mapString(from, t => " FROM " ++ renderTarget(t)); 165 | let groupBy' = 166 | switch (groupBy) { 167 | | Some((exprs, having)) when A.length(exprs) > 0 => 168 | let gb = " GROUP BY " ++ A.mapJoinCommas(exprs, Expression.render); 169 | gb ++ having->O.mapString(h => " HAVING " ++ Expression.render(h)); 170 | | _ => "" 171 | }; 172 | let where' = 173 | O.mapString( 174 | where, 175 | fun 176 | | Where(e) => " WHERE " ++ Expression.render(e) 177 | | WhereExists(select) => " WHERE EXISTS " ++ render(select)->parens, 178 | ); 179 | "SELECT " ++ selections' ++ from' ++ where' ++ groupBy'; 180 | } 181 | 182 | and renderSelectVariant = 183 | fun 184 | | Select(siu) => renderSelectInUnion(siu) 185 | | Union(s1, s2) => renderSelectVariant(s1) ++ " UNION " ++ renderSelectVariant(s2) 186 | | UnionAll(s1, s2) => renderSelectVariant(s1) ++ " UNION ALL " ++ renderSelectVariant(s2) 187 | 188 | and render: t => string = 189 | ({with_, select, orderBy, limit}) => { 190 | let with_' = 191 | O.mapString(with_, ((table_, columns_, innerSelect)) => 192 | " WITH " 193 | ++ TableName.render(table_) 194 | ++ A.mapJoinCommasParens(columns_, ColumnName.render) 195 | ++ " AS " 196 | ++ render(innerSelect)->parens 197 | ); 198 | let orderBy' = 199 | switch (orderBy) { 200 | | Some(cols) => 201 | A.mapJoinIfNonEmpty(cols, ~prefix=" ORDER BY ", ", ", ((c, optDir)) => 202 | Expression.render(c) ++ O.mapString(optDir, dir => " " ++ renderDirection(dir)) 203 | ) 204 | | _ => "" 205 | }; 206 | let limit' = O.mapString(limit, n => " LIMIT " ++ Expression.render(n)); 207 | 208 | with_' ++ renderSelectVariant(select) ++ orderBy' ++ limit'; 209 | }; 210 | }; 211 | 212 | module Insert = { 213 | open Sql.Insert; 214 | exception UnequalNumberOfExpressions(list(int)); 215 | 216 | let render = 217 | ( 218 | ~returning as renderReturning: 'returning => string=_ => "", 219 | ~onConflict as renderOnConflict: 'onConflict => string=_ => "", 220 | {data, into, returning, onConflict}, 221 | ) 222 | : string => 223 | [| 224 | "INSERT INTO", 225 | TableName.render(into), 226 | switch (data) { 227 | | Values(values) => 228 | let cols = A.mapJoinCommasParens(values, v => ColumnName.render(fst(v))); 229 | let numsOfExprs = ISet.fromArray(A.map(values, ((_, exprs)) => A.length(exprs))); 230 | switch (ISet.toList(numsOfExprs)) { 231 | // They must all have the same number of expressions. 232 | | [count] => 233 | // Convert expressions to comma-separated tuples 234 | let tuples = A.makeBy(count, n => A.map(values, ((_, exprs)) => exprs[n])); 235 | let valuesStr = 236 | A.mapJoinCommas(tuples, exprs => A.mapJoinCommasParens(exprs, Expression.render)); 237 | cols ++ " VALUES " ++ valuesStr; 238 | | counts => raise(UnequalNumberOfExpressions(counts)) 239 | }; 240 | | Select(sel) => Select.render(sel) 241 | }, 242 | onConflict->O.mapString(renderOnConflict), 243 | returning->O.mapString(renderReturning), 244 | |] 245 | ->spaces; 246 | }; 247 | 248 | module CreateTable = { 249 | open Sql.CreateTable; 250 | let renderColumnConstraint = c => { 251 | let {primaryKey, notNull, unique, check, default} = c; 252 | StringUtils.( 253 | joinSpaces( 254 | A.keepSome( 255 | OptionUtils.( 256 | [| 257 | someIf(primaryKey, "PRIMARY KEY"), 258 | someIf(notNull, "NOT NULL"), 259 | someIf(unique, "UNIQUE"), 260 | map(check, e => "CHECK " ++ Expression.render(e)), 261 | map(default, e => "DEFAULT " ++ Expression.render(e)), 262 | |] 263 | ), 264 | ), 265 | ) 266 | ); 267 | }; 268 | 269 | let renderColumnDef = ({name, type_, constraints}) => 270 | [|ColumnName.render(name), TypeName.render(type_), constraints |> renderColumnConstraint|] 271 | |> StringUtils.joinSpaces; 272 | 273 | let renderOnDelete = 274 | fun 275 | | Cascade => "CASCADE" 276 | | SetNull => "SET NULL"; 277 | 278 | let renderConstraint: ('tr => string, tableConstraint('tr)) => string = 279 | renderTableRef => 280 | fun 281 | | PrimaryKey(columns) => 282 | "PRIMARY KEY " ++ A.mapJoinCommasParens(columns, ColumnName.render) 283 | | ForeignKey(col, (refTable, refCol), onDelete) => 284 | [| 285 | "FOREIGN KEY", 286 | ColumnName.render(col)->parens, 287 | "REFERENCES", 288 | refTable->renderTableRef, 289 | ColumnName.render(refCol)->parens, 290 | onDelete->O.mapString(od => "ON DELETE " ++ od->renderOnDelete), 291 | |] 292 | ->spaces 293 | | Unique(columns) => "UNIQUE " ++ columns->A.map(ColumnName.render)->commas->parens 294 | | Check(expr) => "CHECK " ++ expr->Expression.render->parens; 295 | 296 | let renderStatement: ('tr => string, statement('tr)) => string = 297 | renderTableRef => 298 | fun 299 | | ColumnDef(cdef) => renderColumnDef(cdef) 300 | | Constraint(None, constraint_) => constraint_ |> renderConstraint(renderTableRef) 301 | | Constraint(Some(n), constraint_) => 302 | [| 303 | "CONSTRAINT", 304 | ConstraintName.render(n), 305 | constraint_ |> renderConstraint(renderTableRef), 306 | |] 307 | ->spaces; 308 | 309 | let renderWith: ('tr => string, t('tr)) => string = 310 | (renderTableRef, {name, statements, ifNotExists}) => 311 | [| 312 | "CREATE TABLE", 313 | ifNotExists ? "IF NOT EXISTS" : "", 314 | TableName.render(name), 315 | " ", 316 | A.mapJoinCommasParens(statements, renderStatement(renderTableRef)), 317 | |] 318 | ->spaces; 319 | 320 | // Common case: referencing tables by name 321 | let render: t(TableName.t) => string = renderWith(TableName.toString); 322 | }; 323 | 324 | module CreateView = { 325 | open Sql.CreateView; 326 | let render = ({name, query}) => 327 | "CREATE VIEW " 328 | // TODO sqlite and postgres have different ways of rendering this. 329 | // SQLite uses `IF NOT EXISTS` while postgres uses `OR REPLACE` 330 | // ++ (ifNotExists ? "IF NOT EXISTS " : "") 331 | ++ TableName.render(name) 332 | ++ " AS " 333 | ++ Select.render(query); 334 | }; 335 | 336 | let select: Sql.Select.t => string = Select.render; 337 | let insert: 338 | (~returning: 'r => string=?, ~onConflict: 'oc => string=?, Sql.Insert.t('r, 'oc)) => string = Insert.render; 339 | // Supply a custom renderer to 340 | let createTableWith: 'tr. (~tableRef: 'tr => string, Sql.CreateTable.t('tr)) => string = 341 | (~tableRef) => CreateTable.renderWith(tableRef); 342 | let createTable: Sql.CreateTable.t(TableName.t) => string = 343 | createTableWith(~tableRef=TableName.render); 344 | let createView: Sql.CreateView.t => string = CreateView.render; 345 | let renderGeneric: 346 | 'r 'c 'c 'tr. 347 | ( 348 | ~returning: 'r => string, 349 | ~onConflict: 'oc => string, 350 | ~createCustom: 'c => string, 351 | ~tableRef: 'tr => string, 352 | Sql.query('r, 'oc, 'c, 'tr) 353 | ) => 354 | string 355 | = 356 | (~returning, ~onConflict, ~createCustom, ~tableRef) => 357 | fun 358 | | Select(s) => s |> select 359 | | Insert(i) => i |> insert(~returning, ~onConflict) 360 | | CreateTable(ct) => ct |> createTableWith(~tableRef) 361 | | CreateView(cv) => cv |> createView 362 | | CreateCustom(c) => c |> createCustom; 363 | }; 364 | 365 | module Default = WithRenderingRules(DefaultRules); 366 | 367 | let renderDefault: Sql.queryRenderer(Sql.defaultQuery) = 368 | Default.renderGeneric( 369 | ~returning=_ => "", 370 | ~onConflict=_ => "", 371 | ~createCustom=_ => "", 372 | ~tableRef=_ => "", 373 | ); 374 | -------------------------------------------------------------------------------- /src/RowDecode.re: -------------------------------------------------------------------------------- 1 | include JsonUtils.Decode; 2 | module A = ArrayUtils; 3 | module D = DictUtils; 4 | module O = OptionUtils; 5 | module S = StringUtils; 6 | module ColumnName = Sql.ColumnName; 7 | type dict('a) = D.t('a); 8 | 9 | type error = 10 | | RowDecodeError(int, Js.Json.t, string) 11 | | EmptyRows; 12 | 13 | exception Error(error); 14 | 15 | module Row = { 16 | type t('a) = { 17 | index: int, 18 | contents: 'a, 19 | }; 20 | let make = (index: int, contents: 'a) => {index, contents}; 21 | let map = (row, f) => {...row, contents: f(row.contents)}; 22 | let mapGet = (row, f) => f(row.contents); 23 | 24 | let decodeJson: (fromJson('a), t(Js.Json.t)) => 'a = 25 | (decode, row) => 26 | try(mapGet(row, decode)) { 27 | | DecodeError(err) => raise(Error(RowDecodeError(row.index, row.contents, err))) 28 | }; 29 | }; 30 | 31 | // Something which can translate rows of Json objects. 32 | type fromRows('t) = array(Row.t(Js.Json.t)) => 't; 33 | 34 | // A do-nothing decoder, used for queries which don't return information. 35 | let unit: fromRows(unit) = _ => (); 36 | 37 | let errorToJson = 38 | JsonUtils.Encode.( 39 | fun 40 | | RowDecodeError(num, rowJson, message) => 41 | object_([ 42 | ("number", num |> int), 43 | ("rowJson", rowJson |> json), 44 | ("message", message |> string), 45 | ]) 46 | | EmptyRows => "EmptyRows" |> string 47 | ); 48 | 49 | let errorToString: error => string = 50 | fun 51 | | RowDecodeError(n, _, str) => 52 | "Error occurred when parsing row " ++ string_of_int(n) ++ ": " ++ str 53 | | EmptyRows => "No rows to parse"; 54 | 55 | let toRows: array('a) => array(Row.t('a)) = rs => A.mapWithIndex(rs, Row.make); 56 | 57 | // Apply two rows decoders to the same rows to parse multiple things. 58 | let two: (fromRows('a), fromRows('b)) => fromRows(('a, 'b)) = 59 | (rd1, rd2, rows) => { 60 | let res1 = rows |> rd1; 61 | let res2 = rows |> rd2; 62 | (res1, res2); 63 | }; 64 | 65 | // Apply three rows decoders to the same rows to parse multiple things. 66 | let three: (fromRows('a), fromRows('b), fromRows('c)) => fromRows(('a, 'b, 'c)) = 67 | (rd1, rd2, rd3, rows) => { 68 | let res1 = rows |> rd1; 69 | let res2 = rows |> rd2; 70 | let res3 = rows |> rd3; 71 | (res1, res2, res3); 72 | }; 73 | 74 | let getFirst: array(Row.t('a)) => Row.t('a) = 75 | fun 76 | | [||] => raise(Error(EmptyRows)) 77 | | rows => rows[0]; 78 | 79 | // Decode the first row with the given JSON decoder. 80 | let decodeOne: fromJson('t) => fromRows('t) = 81 | (decode, rows) => rows |> getFirst |> Row.decodeJson(decode); 82 | 83 | // Map a JSON decoder over the rows, collecting the result for each row. 84 | let decodeEach: (fromJson('a), array(Row.t(Js.Json.t))) => array('a) = 85 | (d, arr) => A.map(arr, Row.decodeJson(d)); 86 | 87 | // A decoder which just returns the json rows. 88 | let jsonRows: fromRows(array(Js.Json.t)) = decodeEach(j => j); 89 | 90 | // Decode each row and reduce the result to some value. 91 | let decodeReduce: (fromJson('a), 'b, ('a, 'b) => 'b) => fromRows('b) = 92 | (dec, start, f, rows) => A.reduce(decodeEach(dec, rows), start, f); 93 | 94 | let optColumn: (ColumnName.t, fromJson('t)) => fromRows(option('t)) = 95 | (col, dec, rows) => 96 | O.map(A.head(rows), Row.decodeJson(field(col->ColumnName.toString, dec))); 97 | 98 | // Get one column, with the given name and with the given decoder. 99 | // Uses `Json.Decode.field` under the hood 100 | let column1: (ColumnName.t, fromJson('t)) => fromJson('t) = 101 | (col, fj) => field(col->ColumnName.toString, fj); 102 | 103 | let columns2: (ColumnName.t, fromJson('a), ColumnName.t, fromJson('b)) => fromJson(('a, 'b)) = 104 | (columnA, decodeA, columnB, decodeB, j) => ( 105 | j |> column1(columnA, decodeA), 106 | j |> column1(columnB, decodeB), 107 | ); 108 | 109 | let columns3: 110 | (ColumnName.t, fromJson('a), ColumnName.t, fromJson('b), ColumnName.t, fromJson('c)) => 111 | fromJson(('a, 'b, 'c)) = 112 | (columnA, decodeA, columnB, decodeB, columnC, decodeC, j) => ( 113 | j |> column1(columnA, decodeA), 114 | j |> column1(columnB, decodeB), 115 | j |> column1(columnC, decodeC), 116 | ); 117 | 118 | // Given a row where one of the fields is an ID, a decoder for 119 | // the ID and another decoder to get the rest of the object, decodes 120 | // the row into the object. 121 | let withId = 122 | (~idField: string, ~idDecode: fromJson('id), decode: fromJson('t)): fromJson(('id, 't)) => 123 | tup2(field(idField, idDecode), decode); 124 | 125 | // Decode a row into a 3-tuple. 126 | let tuple3Row: 127 | (string, fromJson('a), string, fromJson('b), string, fromJson('c)) => fromJson(('a, 'b, 'c)) = 128 | (columnA, decodeA, columnB, decodeB, columnC, decodeC, j) => ( 129 | j |> field(columnA, decodeA), 130 | j |> field(columnB, decodeB), 131 | j |> field(columnC, decodeC), 132 | ); 133 | 134 | // Given a way to get a (key, value) pair from a row, produce a 135 | // dictionary with those keys/values. 136 | let dict = 137 | ( 138 | ~keyField: string, 139 | ~keyDecode: fromJson(string)=string, 140 | ~valueField: string, 141 | ~valueDecode: fromJson('a), 142 | (), 143 | ) 144 | : fromRows(D.t('a)) => 145 | jsonRows => { 146 | jsonRows 147 | |> decodeEach(tup2(field(keyField, keyDecode), field(valueField, valueDecode))) 148 | |> D.fromArray; 149 | }; 150 | 151 | let dict2d = 152 | ( 153 | ~outerKeyField: string, 154 | ~outerKeyDecode: fromJson(string)=string, 155 | ~innerKeyField: string, 156 | ~innerKeyDecode: fromJson(string)=string, 157 | ~valueField: string, 158 | ~valueDecode: fromJson('a), 159 | (), 160 | ) 161 | : fromRows(D.t(D.t('a))) => 162 | jsonRows => 163 | jsonRows 164 | |> decodeEach( 165 | tup3( 166 | field(innerKeyField, innerKeyDecode), 167 | field(outerKeyField, outerKeyDecode), 168 | field(valueField, valueDecode), 169 | ), 170 | ) 171 | |> ( 172 | decoded => { 173 | let result = D.empty(); 174 | A.forEach(decoded, ((inner, outer, value)) => 175 | switch (D.get(result, outer)) { 176 | | None => D.set(result, outer, D.fromArray([|(inner, value)|])) 177 | | Some(values) => D.set(values, inner, value) 178 | } 179 | ); 180 | result; 181 | } 182 | ); 183 | 184 | let dict3d = 185 | ( 186 | ~keyField1: string, 187 | ~keyDecode1: fromJson(string)=string, 188 | ~keyField2: string, 189 | ~keyDecode2: fromJson(string)=string, 190 | ~keyField3: string, 191 | ~keyDecode3: fromJson(string)=string, 192 | ~valueField: string, 193 | ~valueDecode: fromJson('a), 194 | (), 195 | ) 196 | : fromRows(dict(dict(dict('a)))) => 197 | jsonRows => 198 | jsonRows 199 | |> decodeEach( 200 | tup4( 201 | field(keyField1, keyDecode1), 202 | field(keyField2, keyDecode2), 203 | field(keyField3, keyDecode3), 204 | field(valueField, valueDecode), 205 | ), 206 | ) 207 | |> ( 208 | decoded => { 209 | let result: dict(dict(dict('a))) = D.empty(); 210 | A.forEach(decoded, ((x, y, z, value)) => 211 | switch (D.get(result, x)) { 212 | | None => D.set(result, x, D.singleton(y, D.singleton(z, value))) 213 | | Some(xValues) => 214 | switch (D.get(xValues, y)) { 215 | | None => D.set(xValues, y, D.singleton(z, value)) 216 | | Some(yValues) => D.set(yValues, z, value) 217 | } 218 | } 219 | ); 220 | result; 221 | } 222 | ); 223 | 224 | // TODO there might be a way to DRY this up 225 | let dict4d = 226 | ( 227 | ~keyField1: string, 228 | ~keyDecode1: fromJson(string)=string, 229 | ~keyField2: string, 230 | ~keyDecode2: fromJson(string)=string, 231 | ~keyField3: string, 232 | ~keyDecode3: fromJson(string)=string, 233 | ~keyField4: string, 234 | ~keyDecode4: fromJson(string)=string, 235 | ~valueField: string, 236 | ~valueDecode: fromJson('a), 237 | (), 238 | ) 239 | : fromRows(dict(dict(dict(dict('a))))) => 240 | jsonRows => 241 | jsonRows 242 | |> decodeEach( 243 | tup5( 244 | field(keyField1, keyDecode1), 245 | field(keyField2, keyDecode2), 246 | field(keyField3, keyDecode3), 247 | field(keyField4, keyDecode4), 248 | field(valueField, valueDecode), 249 | ), 250 | ) 251 | |> ( 252 | decoded => { 253 | let result: dict(dict(dict(dict('a)))) = D.empty(); 254 | A.forEach(decoded, ((k1, k2, k3, k4, value)) => 255 | switch (D.get(result, k1)) { 256 | | None => D.set(result, k1, D.singleton(k2, D.singleton(k3, D.singleton(k4, value)))) 257 | | Some(values1) => 258 | switch (D.get(values1, k2)) { 259 | | None => D.set(values1, k2, D.singleton(k3, D.singleton(k4, value))) 260 | | Some(values2) => 261 | switch (D.get(values2, k3)) { 262 | | None => D.set(values2, k3, D.singleton(k4, value)) 263 | | Some(values3) => D.set(values3, k4, value) 264 | } 265 | } 266 | } 267 | ); 268 | result; 269 | } 270 | ); 271 | 272 | // Given a way to get a (key, value) pair from a row, produce a dictionary 273 | // with those keys/values and an array of keys in the order encountered. 274 | let dictWithOrder = 275 | ( 276 | ~keyField: string, 277 | ~keyDecode: fromJson(string)=string, 278 | ~valueField: string, 279 | ~valueDecode: fromJson('a), 280 | (), 281 | ) 282 | : fromRows((D.t('a), array(string))) => 283 | jsonRows => { 284 | jsonRows 285 | |> decodeEach(tup2(field(keyField, keyDecode), field(valueField, valueDecode))) 286 | |> (entries => (D.fromArray(entries), S.dedupeArray(A.map(entries, fst)))); 287 | }; 288 | 289 | // Aggregate all rows by a particular field, and apply the inner 290 | // decoder to each resulting row array, returning a dictionary. 291 | // This can be nested, although it's not particularly efficient 292 | // since each nested call will need to iterate over all rows. 293 | let dictOf = 294 | (~keyField: string, ~keyDecode: fromJson(string)=string, inner: fromRows('a)) 295 | : fromRows(D.t('a)) => 296 | rows => { 297 | let agg = D.empty(); 298 | A.forEach( 299 | rows, 300 | row => { 301 | let key = row |> Row.decodeJson(field(keyField, keyDecode)); 302 | switch (D.get(agg, key)) { 303 | | None => D.set(agg, key, [|row|]) |> ignore 304 | | Some(rows') => A.pushMut(rows', row) 305 | }; 306 | }, 307 | ); 308 | D.map(agg, inner); 309 | }; 310 | 311 | // Similar to dictOf, but returns ordered key/value pairs. The restriction is that 312 | // the key must be able to be converted to a string (to achieve the aggregation) 313 | let tuples = 314 | (keyField: string, keyDecode: fromJson('k), keyToString: 'k => string, inner: fromRows('v)) 315 | : fromRows(array(('k, 'v))) => 316 | rows => { 317 | let agg = D.empty(); 318 | let keys = [||]; 319 | A.forEach( 320 | rows, 321 | row => { 322 | let key = row |> Row.decodeJson(field(keyField, keyDecode)); 323 | let keyString = key |> keyToString; 324 | switch (D.get(agg, keyString)) { 325 | | None => 326 | D.set(agg, keyString, [|row|]) |> ignore; 327 | A.pushMut(keys, key); 328 | | Some(rows') => A.pushMut(rows', row) 329 | }; 330 | }, 331 | ); 332 | // Get the values from the dictionary and apply the inner decoder 333 | A.map(keys, k => (k, D.getExn(agg, k |> keyToString) |> inner)); 334 | }; 335 | -------------------------------------------------------------------------------- /src/RowEncode.re: -------------------------------------------------------------------------------- 1 | // Tools for encoding into rows 2 | include QueryBuilder; 3 | module L = Utils.List; 4 | module O = Utils.Option; 5 | 6 | let convertRow = (toC, toE, (k, v)) => (toC(k), toE(v)); 7 | let convertColumn = (toC, toE, (k, vs)) => (toC(k), (L.mapToArray(vs), toE)); 8 | let stringRowWith = (toExpr, row) => L.map(row, convertRow(cname, toExpr)); 9 | let stringRow = stringRowWith(Utils.id); 10 | let rowFromFields = (fields, obj) => 11 | stringRow(L.map(fields, ((field, fn)) => (field, fn(obj)))); 12 | 13 | // Make a row from a 2-tuple. 14 | let columns2: (string, toExpr('a), string, toExpr('b)) => toRow(('a, 'b)) = 15 | (columnA, encodeA, columnB, encodeB, (a, b)) => 16 | stringRow([(columnA, a |> encodeA), (columnB, b |> encodeB)]); 17 | 18 | // Make a row from a 3-tuple. 19 | let columns3: 20 | (string, toExpr('a), string, toExpr('b), string, toExpr('c)) => toRow(('a, 'b, 'c)) = 21 | (columnA, encodeA, columnB, encodeB, columnC, encodeC, (a, b, c)) => 22 | stringRow([(columnA, a |> encodeA), (columnB, b |> encodeB), (columnC, c |> encodeC)]); 23 | 24 | let nullable = (toExpr, opt) => O.mapWithDefault(opt, null, toExpr); 25 | -------------------------------------------------------------------------------- /src/Sql.re: -------------------------------------------------------------------------------- 1 | module A = ArrayUtils; 2 | module L = ListUtils; 3 | module O = OptionUtils; 4 | module SMap = Belt.Map.String; 5 | 6 | // Provides basic validation for SQL identifiers. 7 | // Right now this is overly strict. In reality many more things can be valid 8 | // SQL identifiers, they just might need to be quoted (which RenderQuery 9 | // takes care of) 10 | module IdentifierValidation = 11 | Opaque.String.Validation.MatchRegex({ 12 | // TODO expand this 13 | let regex = [%re {|/^[\w\- _#@]+$/|}]; 14 | }); 15 | 16 | // TODO validation 17 | module DatabaseName = 18 | Opaque.String.Make( 19 | IdentifierValidation, 20 | {}, 21 | ); 22 | 23 | module TableName = 24 | Opaque.String.Make( 25 | IdentifierValidation, 26 | {}, 27 | ); 28 | 29 | module ColumnName = 30 | Opaque.String.Make( 31 | IdentifierValidation, 32 | {}, 33 | ); 34 | 35 | module TypeName = 36 | Opaque.String.Make( 37 | ( 38 | Opaque.String.Validation.MatchRegex({ 39 | // TODO expand this 40 | let regex = [%re {|/^[\w\- _#@]+(\(\d+\))?$/|}]; 41 | }) 42 | ), 43 | {}, 44 | ); 45 | 46 | module ConstraintName = 47 | Opaque.String.Make( 48 | IdentifierValidation, 49 | {}, 50 | ); 51 | 52 | module FunctionName = 53 | Opaque.String.Make( 54 | IdentifierValidation, 55 | {}, 56 | ); 57 | 58 | module type ColumnType = { 59 | type col = 60 | | All 61 | | Named(ColumnName.t); 62 | type t; 63 | let fromString: string => t; 64 | let fromColumnName: ColumnName.t => t; 65 | let fromStringWithTable: (TableName.t, string) => t; 66 | let fromColumnNameWithTable: (TableName.t, ColumnName.t) => t; 67 | let all: t; 68 | let allFrom: TableName.t => t; 69 | let fromTuples: array((TableName.t, string)) => array(t); 70 | let fromTupleList: list((TableName.t, string)) => list(t); 71 | let fromStringArray: array(string) => array(t); 72 | let fromStringList: list(string) => list(t); 73 | let toTuple: t => (option(TableName.t), col); 74 | let colEq: (col, col) => bool; 75 | let eq: (t, t) => bool; 76 | }; 77 | 78 | module Column: ColumnType = { 79 | // `*` or `some_column` 80 | type col = 81 | | All 82 | | Named(ColumnName.t); 83 | 84 | let named: string => col = s => Named(ColumnName.fromString(s)); 85 | let colFromString: string => col = 86 | fun 87 | | "*" => All 88 | | c => named(c); 89 | 90 | // e.g. 'foo' or 'mytable.foo' 91 | type t = (option(TableName.t), col); 92 | let fromString: string => t = c => (None, colFromString(c)); 93 | let fromColumnName = cn => (None, Named(cn)); 94 | let fromStringWithTable: (TableName.t, string) => t = (t, c) => (Some(t), colFromString(c)); 95 | let all: t = (None, All); 96 | let allFrom: TableName.t => t = t => (Some(t), All); 97 | let fromTuples: array((TableName.t, string)) => array(t) = 98 | a => A.map(a, Utils.uncurry(fromStringWithTable)); 99 | let fromTupleList: list((TableName.t, string)) => list(t) = 100 | l => L.map(l, Utils.uncurry(fromStringWithTable)); 101 | let fromStringArray: array(string) => array(t) = a => A.map(a, fromString); 102 | let fromStringList: list(string) => list(t) = l => L.map(l, fromString); 103 | external toTuple: t => (option(TableName.t), col) = "%identity"; 104 | let fromColumnNameWithTable = (tn, cn) => (Some(tn), Named(cn)); 105 | 106 | let colEq = (c1, c2) => 107 | switch (c1, c2) { 108 | | (All, All) => true 109 | | (Named(cn1), Named(cn2)) => cn1 == cn2 110 | | _ => false 111 | }; 112 | 113 | let eq = ((t1, c1), (t2, c2)) => t1 == t2 && colEq(c1, c2); 114 | }; 115 | 116 | module type AliasedType = { 117 | type t('a); 118 | let make: (~a: string=?, 'a) => t('a); 119 | let as_: (t('a), string) => t('a); 120 | let toTuple: t('a) => ('a, option(string)); 121 | let eq: (('a, 'a) => bool, t('a), t('a)) => bool; 122 | }; 123 | 124 | module Aliased: AliasedType = { 125 | // TODO the alias should also be polymorphic. E.g. aliases on expressions 126 | // become column names, aliases on tables become other table names, etc 127 | type t('a) = ('a, option(string)); 128 | let as_ = ((x, _), alias) => (x, Some(alias)); 129 | external toTuple: t('a) => ('a, option(string)) = "%identity"; 130 | let make = (~a=?, x) => (x, a); 131 | let eq = (inner, (x, a), (y, b)) => a == b && inner(x) == inner(y); 132 | }; 133 | 134 | module Expression = { 135 | type atom = 136 | | Null 137 | | Column(Column.t) 138 | | Int(int) 139 | | Float(float) 140 | | String(string) 141 | | Bool(bool); 142 | 143 | let atomEq: (atom, atom) => bool = 144 | (a1, a2) => 145 | switch (a1, a2) { 146 | | (Null, Null) => true 147 | | (Column(a), Column(b)) => Column.eq(a, b) 148 | | (Int(a), Int(b)) => a == b 149 | | (Float(a), Float(b)) => a == b 150 | | (String(a), String(b)) => a == b 151 | | (Bool(a), Bool(b)) => a == b 152 | | _ => false 153 | }; 154 | 155 | type t = 156 | | Atom(atom) 157 | | Typed(t, TypeName.t) 158 | | Between(t, t, t) 159 | | In(t, t) 160 | | Concat(t, t) 161 | | Add(t, t) 162 | | Subtract(t, t) 163 | | Multiply(t, t) 164 | | Divide(t, t) 165 | | Eq(t, t) 166 | | Neq(t, t) 167 | | And(t, t) 168 | | Leq(t, t) 169 | | Gt(t, t) 170 | | Geq(t, t) 171 | | Or(t, t) 172 | | Lt(t, t) 173 | | Like(t, t) 174 | | IsNull(t) 175 | | IsNotNull(t) 176 | | Not(t) 177 | | Call(FunctionName.t, array(t)) 178 | | Tuple(array(t)); 179 | }; 180 | 181 | module Select = { 182 | type direction = 183 | | ASC 184 | | DESC; 185 | type joinType = 186 | | Inner(Expression.t) 187 | | Left(Expression.t) 188 | | Right(Expression.t) 189 | | Full(Expression.t) 190 | | Cross; 191 | // What comes after the FROM of a select. 192 | type target = 193 | | Table(Aliased.t(TableName.t)) 194 | | SubSelect(select, string) 195 | | Join(joinType, target, target) 196 | 197 | and whereClause = 198 | | Where(Expression.t) 199 | | WhereExists(select) // confirm this shouldn't be selectInUnion 200 | 201 | // The parts of a SELECT query which can appear in a UNION. 202 | and selectInUnion = { 203 | selections: array(Aliased.t(Expression.t)), 204 | into: option((TableName.t, option(DatabaseName.t))), 205 | from: option(target), 206 | groupBy: option((array(Expression.t), option(Expression.t))), 207 | where: option(whereClause), 208 | } 209 | 210 | // Encapsulates SELECTs, WITH clauses, and UNIONs. 211 | and selectVariant = 212 | | Select(selectInUnion) 213 | | Union(selectVariant, selectVariant) 214 | | UnionAll(selectVariant, selectVariant) 215 | 216 | // Renders into a SELECT query. 217 | and select = { 218 | with_: option((TableName.t, array(ColumnName.t), select)), 219 | select: selectVariant, 220 | orderBy: option(array((Expression.t, option(direction)))), 221 | limit: option(Expression.t), 222 | }; 223 | 224 | type t = select; 225 | }; 226 | 227 | module Insert = { 228 | type row = array((ColumnName.t, Expression.t)); 229 | type error = 230 | | EmptyValues 231 | | MissingColumn(Column.t) 232 | | RowIsMissingColumn(int, row, int, ColumnName.t); 233 | 234 | exception Error(error); 235 | 236 | // There are two isomorphic representations of values to insert. 237 | // Row-based values: a nested array of tuples. 238 | type rowValues = array(row); 239 | // Column-based values: an array of expressions for each column. 240 | type columnValues = array((ColumnName.t, array(Expression.t))); 241 | 242 | // Since either representation equivalent information, we can 243 | // translate from one to another. 244 | let rowsToColumns: rowValues => columnValues = 245 | rows => { 246 | switch (A.head(rows)) { 247 | // Rows can't be empty. 248 | | None 249 | | Some([||]) => raise(Error(EmptyValues)) 250 | | Some(row) => 251 | // Take each column's value from each row. 252 | A.mapWithIndex(row, (colIndex, (col, _)) => 253 | ( 254 | col, 255 | A.mapWithIndex(rows, (rowIndex, row) => 256 | switch (A.get(row, colIndex)) { 257 | | Some((c, e)) when c == col => e 258 | | _ => raise(Error(RowIsMissingColumn(rowIndex, row, colIndex, col))) 259 | } 260 | ), 261 | ) 262 | ) 263 | }; 264 | }; 265 | 266 | type data = 267 | | Values(columnValues) 268 | | Select(Select.t); 269 | 270 | type t('returning, 'onConflict) = { 271 | into: TableName.t, 272 | data, 273 | returning: option('returning), 274 | onConflict: option('onConflict), 275 | }; 276 | 277 | let make = (~returning=?, ~onConflict=?, data, into) => {into, data, returning, onConflict}; 278 | }; 279 | 280 | // CREATE TABLE query 281 | module CreateTable = { 282 | type columnConstraints = { 283 | primaryKey: bool, 284 | notNull: bool, 285 | unique: bool, 286 | check: option(Expression.t), 287 | default: option(Expression.t), 288 | }; 289 | 290 | type columnDef = { 291 | name: ColumnName.t, 292 | type_: TypeName.t, 293 | constraints: columnConstraints, 294 | }; 295 | 296 | let defName = ({name}) => name; 297 | let defType = ({type_}) => type_; 298 | let defConstraints = ({constraints}) => constraints; 299 | 300 | let makeColumnDefWithConstraints = (~name, type_, constraints) => {name, type_, constraints}; 301 | 302 | let makeColumnDef = 303 | (~primaryKey, ~notNull=false, ~unique=false, ~check=?, ~default=?, name, type_) => { 304 | name, 305 | type_, 306 | constraints: { 307 | primaryKey, 308 | notNull, 309 | unique, 310 | check, 311 | default, 312 | }, 313 | }; 314 | 315 | // TODO this is only a prototype 316 | type onDelete = 317 | | Cascade 318 | | SetNull; 319 | 320 | type tableConstraint('tableRef) = 321 | | PrimaryKey(array(ColumnName.t)) 322 | | ForeignKey(ColumnName.t, ('tableRef, ColumnName.t), option(onDelete)) 323 | | Unique(array(ColumnName.t)) 324 | | Check(Expression.t); 325 | 326 | type statement('tableRef) = 327 | | ColumnDef(columnDef) 328 | | Constraint(option(ConstraintName.t), tableConstraint('tableRef)); 329 | 330 | // Generic to any table reference 331 | type t('tableRef) = { 332 | name: TableName.t, 333 | statements: array(statement('tableRef)), 334 | ifNotExists: bool, 335 | }; 336 | }; 337 | 338 | module CreateView = { 339 | type t = { 340 | // Since views act like tables, reuse this type. Eventually we 341 | // might want to separate them 342 | name: TableName.t, 343 | query: Select.t, 344 | ifNotExists: bool, 345 | }; 346 | }; 347 | 348 | type query('returning, 'onConflict, 'createCustom, 'tableRef) = 349 | | Select(Select.t) 350 | | Insert(Insert.t('returning, 'onConflict)) 351 | | CreateTable(CreateTable.t('tableRef)) 352 | | CreateView(CreateView.t) 353 | | CreateCustom('createCustom); 354 | 355 | type queryRenderer('q) = 'q => string; 356 | 357 | // A generic query, should be mostly portable across databases. 358 | type defaultQuery = query(unit, unit, unit, TableName.t); 359 | -------------------------------------------------------------------------------- /src/ToJson.re: -------------------------------------------------------------------------------- 1 | // Convert SQL AST to JSON 2 | // TODO much more to go here!! 3 | open JsonUtils.Encode; 4 | 5 | let rowToJson: toJson(QueryBuilder.row) = 6 | l => 7 | l->ListUtils.toArray->ArrayUtils.mapFst(Sql.ColumnName.toString)->Js.Dict.fromArray 8 | |> dict(e => e->RenderQuery.Default.Expression.render->string); 9 | -------------------------------------------------------------------------------- /src/Tools.re: -------------------------------------------------------------------------------- 1 | module A = ArrayUtils; 2 | module M = MapUtils; 3 | open Sql; 4 | module QB = QueryBuilder; 5 | 6 | exception NoSuchColumn(ColumnName.t); 7 | 8 | // TODO any nontrivial function should probably be memoized 9 | module TableTools = { 10 | include CreateTable; 11 | let name: t('a) => TableName.t = ({name}) => name; 12 | 13 | // Get the statements of a table 14 | let statements: CreateTable.t('a) => array(CreateTable.statement('a)) = 15 | ({statements}) => statements; 16 | 17 | // Get the constraints from a table 18 | let constraints: 19 | CreateTable.t('a) => array((option(ConstraintName.t), CreateTable.tableConstraint('a))) = 20 | tbl => 21 | tbl 22 | ->statements 23 | ->A.keepMap( 24 | fun 25 | | Constraint(name, constraint_) => Some((name, constraint_)) 26 | | _ => None, 27 | ); 28 | 29 | // Get the column definitions from a table 30 | let columnDefs: t('a) => array(columnDef) = 31 | ({statements}) => 32 | statements->A.keepMap( 33 | fun 34 | | ColumnDef(def) => Some(def) 35 | | _ => None, 36 | ); 37 | 38 | // Get an array of all the column names 39 | let columnNames: t('a) => array(ColumnName.t) = 40 | tbl => tbl->columnDefs->A.map(({name}) => name); 41 | 42 | // Get column definitions as a map keyed on column name 43 | let columnDefMap: t('a) => M.t(ColumnName.t, columnDef) = 44 | tbl => tbl->columnDefs->A.map(cd => (cd.name, cd))->M.fromArray; 45 | 46 | // Resolve a column name on this table to its definition, returning option 47 | let getColDef: (t('a), ColumnName.t) => option(CreateTable.columnDef) = 48 | (t, colName) => t->columnDefMap->M.get(colName); 49 | 50 | // Look up a column on this table by string. If it exists, it's turned into 51 | // a column name. If not, an exception is raised. This allows a safer way to 52 | // refer to the column of a table. 53 | let getCol: (t('a), ColumnName.t) => ColumnName.t = 54 | (t, colName) => { 55 | t->columnDefMap->M.has(colName) ? colName : raise(NoSuchColumn(colName)); 56 | }; 57 | 58 | // Look up a column on this table by string. If it exists, it's turned into 59 | // a column name. If not, an exception is raised. This allows a safer way to 60 | // refer to the column of a table. 61 | let getColString: (t('a), string) => ColumnName.t = 62 | (t, name) => { 63 | let colName = name->ColumnName.fromString; 64 | t->columnDefMap->M.has(colName) ? colName : raise(NoSuchColumn(colName)); 65 | }; 66 | 67 | // Return definitions of the column which forms the primary key. 68 | // TODO for now, this only works if the table has a single column which has 69 | // `primaryKey: true`. It does not work with multiple primary keys, or ones 70 | // created by a standalone `PRIMARY KEY` constraint statement. 71 | let primaryKeyColumnDef: CreateTable.t(_) => option(CreateTable.columnDef) = 72 | tbl => 73 | switch (tbl->columnDefs->A.keep(cdef => cdef.constraints.primaryKey)) { 74 | | [|def|] => Some(def) 75 | | _ => None 76 | }; 77 | 78 | // If there's a single column which is a primary key, return it. 79 | // Doesn't handle compound keys. 80 | let primaryKeyColumnDef: t('a) => option(CreateTable.columnDef) = 81 | tbl => 82 | switch ( 83 | tbl->primaryKeyColumnDef, 84 | tbl 85 | ->constraints 86 | ->A.keepMap( 87 | fun 88 | | (_, PrimaryKey([|col|])) => tbl->getColDef(col) 89 | | _ => None, 90 | ), 91 | ) { 92 | | (Some(def), [||]) => Some(def) 93 | | (None, [|def|]) => Some(def) 94 | | _ => None 95 | }; 96 | 97 | // Find all of the columns in the table which refer to a foreign key. 98 | let foreignKeyColumns: t('tref) => M.t(ColumnName.t, ('tref, ColumnName.t)) = 99 | ({statements}) => 100 | statements 101 | ->A.keepMap( 102 | fun 103 | | Constraint(_, ForeignKey(cn, (tref, otherCol), _)) => Some((cn, (tref, otherCol))) 104 | | _ => None, 105 | ) 106 | ->M.fromArray; 107 | }; 108 | 109 | module StatementBuilders = { 110 | // Given a CreateTable object and a column name, creates a pair of statements, 111 | // one creating a column of the given name of the type which is the ID type of 112 | // the foreign table, and another which sets up a foreign key constraint with the 113 | // given onDelete behavior. The column can be nullable or not. 114 | let foreignKeyOn = (~notNull=true, ~onDelete=CreateTable.Cascade, ~localColumn, table) => { 115 | let tableName = table->TableTools.name; 116 | switch (table->TableTools.primaryKeyColumnDef) { 117 | | None => 118 | Error( 119 | "Foreign ID column could not be determined on table " ++ tableName->TableName.toString, 120 | ) 121 | | Some(foreignColumnDef) => 122 | Ok( 123 | QB.[ 124 | cdef(~notNull, localColumn, foreignColumnDef.type_), 125 | foreignKey(~onDelete, localColumn, (tableName, foreignColumnDef.name))->constraint_, 126 | ], 127 | ) 128 | }; 129 | }; 130 | }; 131 | -------------------------------------------------------------------------------- /src/examples/BooksExample.re: -------------------------------------------------------------------------------- 1 | module QB = QueryBuilder; 2 | module RE = RowEncode; 3 | module Rules = RenderQuery.DefaultRules; 4 | module Render = RenderQuery.WithRenderingRules(Rules); 5 | open Utils.Abbreviations; 6 | let (then_, then2, resolve, catch, rLog, finally, all2, rLog2) = 7 | P.(then_, then2, resolve, catch, rLog, finally, all2, rLog2); 8 | 9 | // It's not necessary to pre-define your column names but it can help 10 | // reduce the chance of typos. 11 | let idCol = QB.cname("id"); 12 | let firstCol = QB.cname("first"); 13 | let lastCol = QB.cname("last"); 14 | 15 | module Author = { 16 | let tableName = QB.tname("author"); 17 | type t('id) = { 18 | id: 'id, 19 | first: string, 20 | last: string, 21 | }; 22 | let make = (first, last) => {id: (), first, last}; 23 | let toRow = ({first, last}) => RE.[(firstCol, first |> string), (lastCol, last |> string)]; 24 | let toJson = author => 25 | JE.( 26 | object_([ 27 | ("id", author.id |> int), 28 | ("first", author.first |> string), 29 | ("last", author.last |> string), 30 | ]) 31 | ); 32 | 33 | let fromJson = j => 34 | JD.{ 35 | id: j |> field("id", int), 36 | first: j |> field("first", string), 37 | last: j |> field("last", string), 38 | }; 39 | 40 | let createTable = idType => 41 | QueryBuilder.( 42 | [ 43 | cdef(cname("id"), idType, ~primaryKey=true), 44 | cdef(cname("first"), Types.text), 45 | cdef(cname("last"), Types.text), 46 | constraint_(unique([cname("first"), cname("last")])), 47 | ] 48 | |> createTable(tableName, ~ifNotExists=true) 49 | ); 50 | }; 51 | 52 | module Book = { 53 | let tableName = QB.tname("book"); 54 | type t('id, 'author) = { 55 | id: 'id, 56 | author: 'author, 57 | title: string, 58 | }; 59 | let make = (author, title) => {id: (), author, title}; 60 | let toRow = ({author, title}) => 61 | RE.(stringRow([("author id", author |> int), ("title", title |> string)])); 62 | let fromJson = j => 63 | JD.{ 64 | id: j |> field("id", int), 65 | author: j |> field("author id", int), 66 | title: j |> field("title", string), 67 | }; 68 | 69 | // Note: this demonstrates a column name with a space in it -- this will be 70 | // appear quoted in the output SQL. 71 | let createTable = idType => 72 | QueryBuilder.( 73 | [ 74 | cdef(cname("id"), idType, ~primaryKey=true), 75 | // Note: can have spaces in column name 76 | cdef(cname("author id"), idType), 77 | cdef(cname("title"), Types.text), 78 | constraint_( 79 | foreignKey(~onDelete=Cascade, cname("author id"), (tname("author"), cname("id"))), 80 | ), 81 | ] 82 | |> createTable(tname("book"), ~ifNotExists=true) 83 | ); 84 | }; 85 | 86 | let authorBooksSelect = 87 | QueryBuilder.( 88 | select( 89 | [e(tcol(tname("a"), cname("id")), ~a="author id")] 90 | |> from( 91 | table(Author.tableName, ~a="a") 92 | |> innerJoin( 93 | table(Book.tableName, ~a="b"), 94 | QB.Op.( 95 | tcol(tname("a"), cname("id")) == tcol(tname("b"), cname("author id")) 96 | ), 97 | ), 98 | ), 99 | ) 100 | ); 101 | 102 | let insertAuthors = 103 | QB.( 104 | [("Stephen", "King"), ("Jane", "Austen")] 105 | |> insertMany(RE.columns2("first", string, "last", string)) 106 | |> into(tname("author")) 107 | ); 108 | 109 | let getAuthorIdsCTE = 110 | QB.( 111 | with_( 112 | tname("author_ids"), 113 | [cname("id")], 114 | authorBooksSelect, 115 | select([e(all)] |> from(table(tname("author_ids")))), 116 | ) 117 | ); 118 | 119 | let run = (client, idType) => { 120 | client->Client.createTable(Author.createTable(idType)) 121 | |> then_(_ => client->Client.createTable(Book.createTable(idType))) 122 | // TODO when figure out ifNotExists problem 123 | // |> then_(_ => Client.createView(client, authorBooksSelect |> createView(tname("author_books")))) 124 | |> then_(_ 125 | // Inserting with an explicit query, using columns2 to define the 126 | // encoding on the fly 127 | => 128 | insertAuthors 129 | |> Client.insert(client) 130 | // Inserting using the Author-specific functions 131 | |> then_(_ => 132 | QB.( 133 | Author.[ 134 | make("Anne", "Rice"), 135 | make("J.K.", "Rowling"), 136 | make("Jonathan", "Irving"), 137 | ] 138 | |> insertMany(Author.toRow) 139 | |> into(Author.tableName) 140 | ) 141 | |> Client.insert(client) 142 | ) 143 | // Selecting author rows, decoding as tuples 144 | |> then_(_ => 145 | QB.(select([e(all)] |> from(table(Author.tableName)))) 146 | |> Client.select( 147 | client, 148 | RowDecode.( 149 | decodeEach(columns3(idCol, int, firstCol, string, lastCol, string)) 150 | ), 151 | ) 152 | ) 153 | // Log them to console 154 | |> then_(rows => rLog(rows)) 155 | // Selecting author rows, decoding as Author objects 156 | |> then_(_ => 157 | QB.(select([e(all)] |> from(table(Author.tableName)))) 158 | |> Client.select(client, RowDecode.(decodeEach(Author.fromJson))) 159 | ) 160 | |> then_(rows => rLog(rows)) 161 | // Use a WITH query (CTE) 162 | |> then_(_ => 163 | QB.( 164 | with_( 165 | tname("author_ids"), 166 | [cname("id")], 167 | authorBooksSelect, 168 | select([e(all)] |> from(table(tname("author_ids")))), 169 | ) 170 | ) 171 | |> Client.select(client, RowDecode.(decodeEach(field("id", int)))) 172 | ) 173 | |> then_(rows => rLog(rows)) 174 | ); 175 | }; 176 | -------------------------------------------------------------------------------- /src/postgres/Postgres.re: -------------------------------------------------------------------------------- 1 | module Syntax = PostgresSyntax; 2 | module QueryBuilder = PostgresQueryBuilder; 3 | module Client = PostgresClient; 4 | module Render = PostgresRender; 5 | -------------------------------------------------------------------------------- /src/postgres/PostgresClient.re: -------------------------------------------------------------------------------- 1 | open Utils.Abbreviations; 2 | module Pg = BsPostgres; 3 | module Rules = RenderQuery.DefaultRules; 4 | module Render = RenderQuery.WithRenderingRules(Rules); 5 | let (then_, then2, resolve, catch, rLog, finally, all2, rLog2) = 6 | PromiseUtils.(then_, then2, resolve, catch, rLog, finally, all2, rLog2); 7 | 8 | // Connection config. TODO many more options to support 9 | module Config = { 10 | type t = { 11 | host: string, 12 | database: string, 13 | port: int, 14 | user: option(string), 15 | password: option(string), 16 | }; 17 | 18 | let toJson: JE.encoder(t) = 19 | ({host, database, port, user}) => 20 | JE.( 21 | object_([ 22 | ("host", host |> string), 23 | ("database", database |> string), 24 | ("port", port |> int), 25 | ("user", user |> nullable(string)), 26 | // err on the side of caution, not rendering password 27 | ]) 28 | ); 29 | 30 | let make = (~host, ~database, ~port, ~user=?, ~password=?, ()) => { 31 | host, 32 | database, 33 | port, 34 | user, 35 | password, 36 | }; 37 | }; 38 | 39 | // Postgres doesn't know about nested tables :) 40 | type query = PostgresSyntax.pgQuery; 41 | 42 | // Postgres results are wrapped in this type 43 | type result = BsPostgres.Result.t(Js.Json.t); 44 | 45 | // Type alias for the abstract client paramaterized for postgres 46 | type client = Client.t(BsPostgres.Client.t, result, query); 47 | 48 | type onQuery = (client, query) => unit; 49 | 50 | type onResult = (client, option(query), result) => unit; 51 | 52 | let runRaw = (client, text) => 53 | BsPostgres.Client.Promise.query'(BsPostgres.Query.make(~text, ()), client); 54 | 55 | // Convert a node-postgres handle to a requery client 56 | let fromPgClient = (~onQuery=?, ~onResult=?, client: BsPostgres.Client.t) => 57 | Client.make( 58 | ~execRaw=runRaw, 59 | ~handle=client, 60 | ~onQuery?, 61 | ~onResult?, 62 | ~queryRaw=runRaw, 63 | ~queryToSql=PostgresRender.pgRender, 64 | ~resultToRows=(result: result) => RowDecode.toRows(result##rows), 65 | (), 66 | ); 67 | 68 | // Pooled connections 69 | module Pool = { 70 | let makePool = ({Config.host, database, port, user, password}): BsPostgres.Pool.t => 71 | BsPostgres.Pool.make(~host, ~database, ~port, ~user?, ~password?, ()); 72 | 73 | let makeClient = 74 | (~onQuery: option(onQuery)=?, ~onResult: option(onResult)=?, pool: BsPostgres.Pool.t) => 75 | BsPostgres.Pool.Promise.connect(pool)->P.map(h => fromPgClient(~onQuery?, ~onResult?, h)); 76 | 77 | let releaseClient = ({Client.handle}) => handle->BsPostgres.Pool.Pool_Client.release; 78 | let releasePool = BsPostgres.Pool.Promise.end_; 79 | 80 | // Abstracts setup/teardown of a postgres connection pool. 81 | let runPool: (Config.t, BsPostgres.Pool.t => Js.Promise.t('a)) => Js.Promise.t('a) = 82 | (config, action) => { 83 | let pool = makePool(config); 84 | action(pool)->finally(() => releasePool(pool)->ignore); 85 | }; 86 | 87 | // Create a client from a pool and then run an action with it. The 88 | // client is automatically released afterwards. 89 | // If you don't want to manage the setup/teardown of the pool, you can 90 | // use `runPoolClient`. 91 | let runClientInPool: 92 | 'a. 93 | ( 94 | ~onQuery: (client, query) => unit=?, 95 | ~onResult: (client, option(query), result) => unit=?, 96 | BsPostgres.Pool.t, 97 | client => Js.Promise.t('a) 98 | ) => 99 | Js.Promise.t('a) 100 | = 101 | (~onQuery=?, ~onResult=?, pool, action) => 102 | makeClient(~onQuery?, ~onResult?, pool) 103 | ->P.flatMap(client => 104 | action(client) 105 | ->P.flatMap(r => client->releaseClient->P.map(_ => r)) 106 | ->P.catchF(e => client->releaseClient->P.flatMap(_ => P.rejectError(e))) 107 | ); 108 | 109 | // Abstracts setup/teardown of both a connection pool, and a client within 110 | // that pool. 111 | let runPoolClient: 112 | 'a. 113 | ( 114 | ~onQuery: (client, query) => unit=?, 115 | ~onResult: (client, option(query), result) => unit=?, 116 | Config.t, 117 | client => Js.Promise.t('a) 118 | ) => 119 | Js.Promise.t('a) 120 | = 121 | (~onQuery=?, ~onResult=?, config, action) => 122 | runPool(config, pool => runClientInPool(~onQuery?, ~onResult?, pool, action)); 123 | }; 124 | -------------------------------------------------------------------------------- /src/postgres/PostgresQueryBuilder.re: -------------------------------------------------------------------------------- 1 | // Extending the generic query builder with postgres-specific syntax 2 | include Requery.QueryBuilder; 3 | include PostgresSyntax; 4 | 5 | let pgReturning: (array(column), insert(pgReturning, 'a)) => insert(pgReturning, 'a) = 6 | columns => QB.returning(Returning.Columns(columns)); 7 | 8 | let pgReturning1: (column, insert(pgReturning, 'a)) => insert(pgReturning, 'a) = 9 | col => QB.returning(Returning.Columns([|col|])); 10 | 11 | let pgEnumValue: string => pgEnumValue = CreateType.EnumValue.fromString; 12 | let pgEnumValues: list(string) => list(pgEnumValue) = vs => vs->Belt.List.map(pgEnumValue); 13 | let pgEnumValuesArray: array(string) => array(pgEnumValue) = 14 | vs => vs->Belt.Array.map(pgEnumValue); 15 | let pgCreateEnumType: (typeName, list(pgEnumValue)) => pgCreateType = 16 | (name, values) => CreateType.makeEnum(name, values->Belt.List.toArray); 17 | 18 | let pgOnConstraint = cname => OnConflict.{index: None, onConstraint: Some(cname), where: None}; 19 | 20 | let pgMakeOnConflict = OnConflict.make; 21 | 22 | // Attaches `ON CONFLICT DO NOTHING` to an insert 23 | let pgOnConflictNothing: 'r. insert('r, pgOnConflict) => insert('r, pgOnConflict) = 24 | ins => ins |> onConflict(OnConflict.make(DoNothing)); 25 | -------------------------------------------------------------------------------- /src/postgres/PostgresRender.re: -------------------------------------------------------------------------------- 1 | // Rendering custom postgres syntax 2 | include RenderQuery; 3 | 4 | // TODO reexamine this whole rules thing 5 | module Rules = Requery.RenderQuery.DefaultRules; 6 | module Render = Requery.RenderQuery.WithRenderingRules(Rules); 7 | 8 | include Render; 9 | 10 | open PostgresSyntax; 11 | 12 | module Returning = { 13 | let render: Returning.t => string = 14 | fun 15 | | Columns(columns) => " RETURNING " ++ A.mapJoinCommasParens(columns, Render.Column.render); 16 | }; 17 | 18 | module OnConflict = { 19 | open OnConflict; 20 | let renderIndex = 21 | fun 22 | | IndexColumn(cn) => cn->ColumnName.render 23 | | IndexExpression(e) => "(" ++ e->Render.Expression.render ++ ")"; 24 | let renderTarget = ({index, where, onConstraint}) => 25 | StringUtils.joinSpaces([| 26 | onConstraint->O.mapString(cn => "ON CONSTRAINT " ++ cn->Render.ConstraintName.render), 27 | index->O.mapString(renderIndex), 28 | where->O.mapString(e => "WHERE " ++ e->Render.Expression.render), 29 | |]); 30 | let renderAction = 31 | fun 32 | | DoNothing => "DO NOTHING"; 33 | let render: t => string = 34 | ({target, action}) => 35 | S.joinSpaces([|"ON CONFLICT", target->O.mapString(renderTarget), action->renderAction|]); 36 | }; 37 | 38 | module CreateType = { 39 | open CreateType; 40 | module EnumValue = { 41 | include EnumValue; 42 | // This should be safe because the enum value regex prevents quotes, 43 | // but if that changes this will need to be revisited. 44 | let render = ev => "'" ++ ev->EnumValue.toString ++ "'"; 45 | }; 46 | 47 | let renderVariant = 48 | fun 49 | | Enum(values) => "AS ENUM " ++ values->map(EnumValue.render)->commas->parens; 50 | 51 | let render = ({name, variant}) => 52 | [|"CREATE TYPE", name->TypeName.render, variant->renderVariant|]->spaces; 53 | }; 54 | 55 | let pgRender: Sql.queryRenderer(pgQuery) = 56 | renderGeneric( 57 | ~returning=Returning.render, 58 | ~onConflict=OnConflict.render, 59 | ~createCustom=CreateType.render, 60 | ~tableRef=TableName.render, 61 | ); 62 | 63 | let pgRenderWithTable: ('t => string) => Sql.queryRenderer(pgQueryOf('t)) = 64 | tableRef => 65 | renderGeneric( 66 | ~returning=Returning.render, 67 | ~onConflict=OnConflict.render, 68 | ~createCustom=CreateType.render, 69 | ~tableRef, 70 | ); 71 | -------------------------------------------------------------------------------- /src/postgres/PostgresSyntax.re: -------------------------------------------------------------------------------- 1 | // Postgres-specific syntax 2 | module A = ArrayUtils; 3 | module O = OptionUtils; 4 | module S = StringUtils; 5 | module QB = QueryBuilder; 6 | 7 | open Sql; 8 | 9 | // Expresses the `RETURNING` clause for inserts 10 | module Returning = { 11 | type t = 12 | | Columns(array(Column.t)); 13 | }; 14 | 15 | // What do do if there's a conflict while inserting rows 16 | // Subset of the syntax described here: 17 | // https://www.postgresql.org/docs/12/sql-insert.html 18 | module OnConflict = { 19 | type conflictIndex = 20 | | IndexColumn(QB.columnName) 21 | | IndexExpression(QB.expr); 22 | 23 | type conflictTarget = { 24 | index: option(conflictIndex), 25 | where: option(QB.expr), 26 | onConstraint: option(QB.constraintName), 27 | }; 28 | 29 | let makeTarget = (~index=?, ~where=?, ~onConstraint=?, ()) => {index, where, onConstraint}; 30 | 31 | // TODO `DO UPDATE` syntax 32 | type conflictAction = 33 | | DoNothing; 34 | 35 | type t = { 36 | target: option(conflictTarget), 37 | action: conflictAction, 38 | }; 39 | 40 | let make = (~target=?, action) => {target, action}; 41 | }; 42 | 43 | module CreateType = { 44 | module EnumValue = 45 | Opaque.String.Make( 46 | ( 47 | Opaque.String.Validation.MatchRegex({ 48 | let regex = [%re {|/^\w+$/|}]; 49 | }) 50 | ), 51 | {}, 52 | ); 53 | 54 | // Raised by `makeEnum` if there are no values in the enum 55 | exception NoValuesInEnum(TypeName.t); 56 | 57 | type typeVariant = 58 | | Enum(array(EnumValue.t)); 59 | 60 | type t = { 61 | name: TypeName.t, 62 | variant: typeVariant, 63 | }; 64 | 65 | let makeEnum = (name, values) => { 66 | switch (values) { 67 | | [||] => raise(NoValuesInEnum(name)) 68 | | _ => {name, variant: Enum(values)} 69 | }; 70 | }; 71 | }; 72 | 73 | // Type aliases for postgres-specific queries 74 | type pgEnumValue = CreateType.EnumValue.t; 75 | type pgCreateType = CreateType.t; 76 | type pgReturning = Returning.t; 77 | type pgOnConflict = OnConflict.t; 78 | type pgCreateCustom = CreateType.t; 79 | type pgInsert = Sql.Insert.t(pgReturning, pgOnConflict); 80 | type pgQueryOf('t) = Sql.query(pgReturning, pgOnConflict, pgCreateCustom, 't); 81 | type pgQuery = Sql.query(pgReturning, pgOnConflict, pgCreateCustom, Sql.TableName.t); 82 | -------------------------------------------------------------------------------- /src/utils/ArrayUtils.re: -------------------------------------------------------------------------------- 1 | // Extra functions on arrays 2 | open UtilsPrelude; 3 | module O = Belt.Option; 4 | 5 | include Belt.Array; 6 | 7 | let toList = Belt.List.fromArray; 8 | let mapToList = (arr, f) => arr->map(f)->toList; 9 | 10 | [@bs.val] [@bs.variadic] external maxFloat: array(float) => float = "Math.max"; 11 | 12 | [@bs.val] [@bs.variadic] external maxInt: array(int) => int = "Math.max"; 13 | 14 | [@bs.val] [@bs.variadic] external minFloat: array(float) => float = "Math.min"; 15 | 16 | [@bs.val] [@bs.variadic] external minInt: array(int) => int = "Math.min"; 17 | 18 | // Returns true if the given element exists in the array (using primitive equality) 19 | let contains: (array('a), 'a) => bool = (arr, elem) => some(arr, e => e == elem); 20 | 21 | let joinWith: (array(string), string) => string = (arr, sep) => Js.Array.joinWith(sep, arr); 22 | 23 | let joinSpaces: array(string) => string = arr => joinWith(arr, " "); 24 | 25 | // Map a function over an array, producing strings, and joining those strings 26 | let mapJoin: (array('a), ~prefix: string=?, ~suffix: string=?, string, 'a => string) => string = 27 | (arr, ~prefix="", ~suffix="", sep, f) => prefix ++ joinWith(map(arr, f), sep) ++ suffix; 28 | 29 | let mapJoinWith: (array('a), string, 'a => string) => string = 30 | (arr, sep, f) => joinWith(map(arr, f), sep); 31 | 32 | let mapJoinCommas = (arr, ~prefix=?, ~suffix=?, f) => mapJoin(arr, ~prefix?, ~suffix?, ", ", f); 33 | 34 | let mapJoinSpaces = (arr, ~prefix=?, ~suffix=?, f) => mapJoin(arr, ~prefix?, ~suffix?, " ", f); 35 | 36 | let mapJoinCommasParens = (arr, f) => mapJoin(arr, ~prefix="(", ~suffix=")", ", ", f); 37 | 38 | let mapJoinIfNonEmpty: 39 | (array('a), ~onEmpty: string=?, ~prefix: string=?, ~suffix: string=?, string, 'a => string) => 40 | string = 41 | (arr, ~onEmpty="", ~prefix="", ~suffix="", sep, f) => 42 | switch (arr) { 43 | | [||] => onEmpty 44 | | _ => mapJoin(arr, ~prefix, ~suffix, sep, f) 45 | }; 46 | 47 | // Find the first item in the array which matches a predicate, or return None. 48 | let find: (array('a), 'a => bool) => option('a) = 49 | (arr, test) => 50 | switch (keep(arr, test)) { 51 | | [||] => None 52 | | matches => Some(matches[0]) 53 | }; 54 | 55 | // Find the first item in the array which matches a predicate, or raise an error. 56 | let findExn: (array('a), 'a => bool) => 'a = 57 | (arr, test) => 58 | switch (find(arr, test)) { 59 | | None => throw("No matching element in array") 60 | | Some(m) => m 61 | }; 62 | 63 | // Push to the end of the array, mutating the array 64 | let pushMut = (arr: array('a), elem: 'a): unit => Js.Array.push(elem, arr) |> ignore; 65 | 66 | // Push to the end of the array, producing a new array 67 | let push = (arr: array('a), elem: 'a): array('a) => arr->Belt.Array.concat([|elem|]); 68 | 69 | // Mutates arr, adding each element of arr' to it. 70 | let extend = (arr: array('a), arr': array('a)): unit => 71 | forEach(arr', elem => Js.Array.push(elem, arr) |> ignore); 72 | 73 | // Flatten an array of arrays. 74 | let flatten = (arr: array(array('a))): array('a) => { 75 | let res: array('a) = [||]; 76 | forEach(arr, innerArr => extend(res, innerArr)); 77 | res; 78 | }; 79 | 80 | // Get the first element of an array. 81 | let head = (arr: array('a)): option('a) => get(arr, 0); 82 | 83 | // Get the first element of the first array in a nested array. 84 | let nestedHead = (arr: array(array('a))): option('a) => O.flatMap(head(arr), a => get(a, 0)); 85 | 86 | // Map a function producing an array and then flatten the result. 87 | let flatMap = (arr: array('a), f: 'a => array('b)): array('b) => flatten(map(arr, f)); 88 | 89 | // Add up an array of integers 90 | let sumInts = (arr: array(int)): int => reduce(arr, 0, (+)); 91 | 92 | // Add up an array of floats 93 | let sumFloats = (arr: array(float)): float => reduce(arr, 0.0, (+.)); 94 | 95 | // Cross-product two arrays, applying a function to each pair. 96 | let cross = (arr1: array('a), arr2: array('b), f: ('a, 'b) => 'c): array('c) => 97 | flatMap(arr1, a => map(arr2, b => f(a, b))); 98 | 99 | // Same as cross but operating on three arrays. 100 | let cross3 = 101 | (arr1: array('a), arr2: array('b), arr3: array('c), f: ('a, 'b, 'c) => 'd): array('d) => 102 | flatMap(arr1, a => flatMap(arr2, b => map(arr3, c => f(a, b, c)))); 103 | 104 | // Get the values of all of the `Some()` variants in an array of options. 105 | let keepSome = (arr: array(option('a))): array('a) => keepMap(arr, x => x); 106 | 107 | // Create a singleton array. 108 | let singleton: 'a. 'a => array('a) = x => [|x|]; 109 | 110 | // Return a new array with the given index set to the given value. 111 | let setPure: 'a. (array('a), int, 'a) => array('a) = 112 | (arr, i, x) => { 113 | let arr' = copy(arr); 114 | let _ = set(arr', i, x); 115 | arr'; 116 | }; 117 | 118 | // Modify an element at a given index, returning a new array. 119 | // If the index is invalid, the original array is returned. 120 | let updateAt: 'a. (array('a), int, 'a => 'a) => array('a) = 121 | (arr, index, f) => 122 | switch (arr->get(index)) { 123 | | None => arr 124 | | Some(elem) => arr->setPure(index, f(elem)) 125 | }; 126 | 127 | // Convenient alias, get first elements from a tuple array 128 | let firsts: array(('a, 'b)) => array('a) = arr => map(arr, fst); 129 | 130 | // Convenient alias, get second elements from a tuple array 131 | let seconds: array(('a, 'b)) => array('b) = arr => map(arr, snd); 132 | 133 | // Map a function over the first element of each tuple in an array. 134 | let mapFst: 'a1 'a2 'b. (array(('a1, 'b)), 'a1 => 'a2) => array(('a2, 'b)) = 135 | (arr, f) => arr->map(((x, y)) => (f(x), y)); 136 | 137 | // Map a function over the second element of each tuple in an array. 138 | let mapSnd: 'a 'b1 'b2. (array(('a, 'b1)), 'b1 => 'b2) => array(('a, 'b2)) = 139 | (arr, f) => arr->map(((x, y)) => (x, f(y))); 140 | 141 | // Sort an array using the default comparator. Only works for types 142 | // which have a primitive runtime representation (string, int, etc). 143 | let sort: 'a. array('a) => array('a) = 144 | arr => arr->Belt.SortArray.stableSortBy(Pervasives.compare); 145 | 146 | // Sort an array using a custom comparator. 147 | let sortBy: 'a. (array('a), ('a, 'a) => int) => array('a) = Belt.SortArray.stableSortBy; 148 | 149 | type array_like('a) = Js.Array.array_like('a); 150 | 151 | module ArrayLike = { 152 | type t('a) = array_like('a); 153 | 154 | external fromArray: array('a) => t('a) = "%identity"; 155 | let toArray: t('a) => array('a) = Js.Array.from; 156 | 157 | [@bs.send] external map: (t('a), 'a => 'b) => t('b) = "map"; 158 | 159 | [@bs.send] external filter: (t('a), 'a => bool) => t('a) = "filter"; 160 | 161 | [@bs.send] external concat: (t('a), t('a)) => t('a) = "concat"; 162 | [@bs.send] external concatArray: (t('a), array('a)) => t('a) = "concat"; 163 | 164 | // Run an array function on an array_like 165 | let onArray: 'a 'b. (t('a), array('a) => array('b)) => t('b) = 166 | (al, f) => al->toArray->f->fromArray; 167 | }; 168 | -------------------------------------------------------------------------------- /src/utils/CallbackUtils.re: -------------------------------------------------------------------------------- 1 | type callback('error, 'result) = (. Js.Nullable.t('error), Js.Undefined.t('result)) => unit; 2 | 3 | type t('error, 'result) = callback('error, 'result); 4 | 5 | exception CannotDecodeCallbackArguments(string); 6 | 7 | // Raises an exception if the error is not null. 8 | let raiseOnErrorCallback: 'e 'r. ('r => unit) => t('e, 'r) = 9 | onResult => 10 | (. nullableError, possiblyUndefinedData) => 11 | switch (Js.Nullable.toOption(nullableError), Js.Undefined.toOption(possiblyUndefinedData)) { 12 | | (Some(err), _) => raise(Obj.magic(err)) 13 | | (None, Some(data)) => onResult(data) 14 | // TODO should this return unit instead? 15 | | _ => raise(CannotDecodeCallbackArguments("callback was called with no arguments")) 16 | }; 17 | 18 | // Provides a `result` interface to callback handling. 19 | let resultCallback: (result('r, 'e) => unit) => t('e, 'r) = 20 | onResult => 21 | (. nullableError, possiblyUndefinedData) => 22 | switch (Js.Nullable.toOption(nullableError), Js.Undefined.toOption(possiblyUndefinedData)) { 23 | | (Some(err), _) => onResult(Error(err)) 24 | | (None, Some(data)) => onResult(Ok(data)) 25 | // TODO should this return unit instead? 26 | | _ => raise(CannotDecodeCallbackArguments("callback was called with no arguments")) 27 | }; 28 | -------------------------------------------------------------------------------- /src/utils/DictUtils.re: -------------------------------------------------------------------------------- 1 | open UtilsPrelude; 2 | 3 | include Js.Dict; 4 | module A = ArrayUtils; 5 | 6 | // Map a function over the values in a dict. 7 | let map: (t('a), 'a => 'b) => t('b) = 8 | (dict, f) => { 9 | let entries = entries(dict); 10 | fromArray(A.map(entries, ((k, v)) => (k, f(v)))); 11 | }; 12 | 13 | // Map a function over the key/value pairs in a dict. 14 | let mapWithKey: (t('a), (string, 'a) => 'b) => t('b) = 15 | (dict, f) => { 16 | let entries = entries(dict); 17 | fromArray(A.map(entries, ((k, v)) => (k, f(k, v)))); 18 | }; 19 | 20 | let fromMap: SMap.t('a) => t('a) = map => fromArray(SMap.toArray(map)); 21 | let toMap: t('a) => SMap.t('a) = dict => SMap.fromArray(entries(dict)); 22 | 23 | // Set a key in a dictionary, producing a new dictionary. 24 | let setPure: (t('a), string, 'a) => t('a) = 25 | (dict, k, v) => { 26 | fromArray(A.concat(entries(dict), [|(k, v)|])); 27 | }; 28 | 29 | let singleton: (string, 'a) => t('a) = (k, v) => fromArray([|(k, v)|]); 30 | 31 | let getExn = (d, k) => 32 | switch (Js.Dict.get(d, k)) { 33 | | None => throw("No such key '" ++ k ++ "' in ") 34 | | Some(v) => v 35 | }; 36 | 37 | // Construct from an array of keys, applying a function to each key. 38 | let fromKeys = (ks: array(string), f: string => 'a): Js.Dict.t('a) => 39 | Js.Dict.fromArray(A.map(ks, k => (k, f(k)))); 40 | 41 | // I really shouldn't have to be implementing this myself but ohhhh wellll 42 | let has = (dict, key) => Belt.Option.isSome(get(dict, key)); 43 | 44 | // Traverse over dictionary entries with a function 45 | let reduce: 'a 'b. (t('a), 'b, ('b, 'a) => 'b) => 'b = 46 | (dict, start, f) => dict->values->A.reduce(start, f); 47 | -------------------------------------------------------------------------------- /src/utils/FsUtils.re: -------------------------------------------------------------------------------- 1 | include Node.Fs; 2 | module P = PromiseUtils; 3 | 4 | module Error = { 5 | type t; 6 | 7 | [@bs.get] external message: t => string = "message"; 8 | [@bs.get] external path: t => string = "path"; 9 | [@bs.get] external code: t => string = "code"; 10 | [@bs.get] external syscall: t => string = "syscall"; 11 | [@bs.get] external errno: t => int = "errno"; 12 | }; 13 | 14 | type stringEncoding = [ | `utf8 | `ascii]; 15 | 16 | // Read a file expecting a string back. 17 | [@bs.module "fs"] 18 | external readStringFile: 19 | ( 20 | ~path: string, 21 | ~encoding: [@bs.string] [ | `utf8 | [@bs.as "ascii"] `ascii], 22 | ~cb: CallbackUtils.t(Error.t, string) 23 | ) => 24 | unit = 25 | "readFile"; 26 | 27 | // Read a file, return the result as a promise. 28 | let readFileAsync: (~encoding: stringEncoding=?, string) => Js.Promise.t(string) = 29 | (~encoding=`utf8, path) => 30 | P.makeWithError((~resolve, ~reject) => 31 | readStringFile( 32 | ~path, 33 | ~encoding, 34 | ~cb= 35 | CallbackUtils.resultCallback(res => 36 | switch (res) { 37 | | Ok(data) => resolve(. data) 38 | | Error(error) => reject(. error) 39 | } 40 | ), 41 | ) 42 | ); 43 | -------------------------------------------------------------------------------- /src/utils/JsMap.re: -------------------------------------------------------------------------------- 1 | // Interface to the primitive Map type in JS. In practice, 'k 2 | // must be a type that JavaScript is able to handle, so use carefully. 3 | type t('k, 'v); 4 | 5 | [@bs.new] external empty: unit => t('k, 'v) = "Map"; 6 | [@bs.new] external fromArray: array(('k, 'v)) => t('k, 'v) = "Map"; 7 | [@bs.val] external toArray: t('k, 'v) => array(('k, 'v)) = "Array.from"; 8 | [@bs.send] external has: (t('k, 'v), 'k) => bool = "has"; 9 | [@bs.send] [@bs.return nullable] external get: (t('k, 'v), 'k) => option('v) = "get"; 10 | [@bs.send] external setMut: (t('k, 'v), 'k, 'v) => t('k, 'v) = "set"; 11 | [@bs.send] external deleteMut: (t('k, 'v), 'k) => bool = "delete"; 12 | 13 | // Key/value pairs of a map. 14 | type entries('k, 'a) = Js.Array.array_like(('k, 'a)); 15 | 16 | [@bs.new] external fromEntries: entries('k, 'a) => t('k, 'a) = "Map"; 17 | [@bs.send] external entries: t('k, 'a) => entries('k, 'a) = "entries"; 18 | 19 | [@bs.send] external keys: t('k, 'a) => Js.Array.array_like('k) = "keys"; 20 | [@bs.send] external values: t('k, 'a) => Js.Array.array_like('a) = "values"; 21 | -------------------------------------------------------------------------------- /src/utils/JsSet.re: -------------------------------------------------------------------------------- 1 | // Interface to the primitive Set type in JS. In practice, 'a 2 | // must be a type that JavaScript is able to handle, so use carefully. 3 | type t('a); 4 | 5 | [@bs.new] external empty: unit => t('a) = "Set"; 6 | [@bs.new] external fromArray: array('a) => t('a) = "Set"; 7 | [@bs.val] external toArray: t('a) => array('a) = "Array.from"; 8 | [@bs.send] external has: (t('a), 'a) => bool = "has"; 9 | [@bs.send] external addMut: (t('a), 'a) => t('a) = "add"; 10 | [@bs.send] external deleteMut: (t('a), 'a) => bool = "delete"; 11 | -------------------------------------------------------------------------------- /src/utils/JsonUtils.re: -------------------------------------------------------------------------------- 1 | open UtilsPrelude; 2 | include Js.Json; 3 | module A = ArrayUtils; 4 | module D = DictUtils; 5 | module P = PromiseUtils; 6 | 7 | type fromJson('a) = Js.Json.t => 'a; 8 | type toJson('a) = 'a => Js.Json.t; 9 | 10 | let parseJsonAsResult: string => result(t, string) = 11 | s => 12 | try(Ok(parseExn(s))) { 13 | | _ => Error(s) 14 | }; 15 | 16 | let parseJsonAsOption: string => option(t) = 17 | s => 18 | switch (s->parseJsonAsResult) { 19 | | Error(_) => None 20 | | Ok(json) => Some(json) 21 | }; 22 | 23 | [@bs.val] 24 | external jsonStringify: (t, Js.Nullable.t(unit), option(int)) => string = "JSON.stringify"; 25 | 26 | let stringify = (~indent=?, json) => json->jsonStringify(Js.Nullable.null, indent); 27 | let stringifyWith = (~indent=?, toJson, obj) => 28 | obj->toJson->jsonStringify(Js.Nullable.null, indent); 29 | 30 | let logAsJson = (~indent=?, enc: toJson('a), obj: 'a) => 31 | Js.Console.log(stringify(~indent?, enc(obj))); 32 | 33 | let logJson = (~indent=?, json) => json |> logAsJson(~indent?, j => j); 34 | 35 | let logAsJson2 = (~indent=?, encA: toJson('a), encB: toJson('b), a: 'a, b: 'b) => 36 | Js.Console.log2(stringify(~indent?, encA(a)), stringify(~indent?, encB(b))); 37 | 38 | let logAsJson3 = 39 | (~indent=?, encA: toJson('a), encB: toJson('b), encC: toJson('c), a: 'a, b: 'b, c: 'c) => 40 | Js.Console.log3( 41 | stringify(~indent?, encA(a)), 42 | stringify(~indent?, encB(b)), 43 | stringify(~indent?, encC(c)), 44 | ); 45 | 46 | let logAsJson4 = 47 | ( 48 | ~indent=?, 49 | encA: toJson('a), 50 | encB: toJson('b), 51 | encC: toJson('c), 52 | encD: toJson('d), 53 | a: 'a, 54 | b: 'b, 55 | c: 'c, 56 | d: 'd, 57 | ) => 58 | Js.Console.log4( 59 | stringify(~indent?, encA(a)), 60 | stringify(~indent?, encB(b)), 61 | stringify(~indent?, encC(c)), 62 | stringify(~indent?, encD(d)), 63 | ); 64 | 65 | // Traverse a JSON structure with a function 66 | let rec reduce: 'a. (Js.Json.t, 'a, ('a, Js.Json.t) => 'a) => 'a = 67 | (json, result, f) => { 68 | let newResult = f(result, json); 69 | switch (json->classify) { 70 | | JSONFalse 71 | | JSONTrue 72 | | JSONNull 73 | | JSONString(_) 74 | | JSONNumber(_) => newResult 75 | | JSONArray(arr) => arr->A.reduce(newResult, (r, j) => j->reduce(r, f)) 76 | | JSONObject(obj) => obj->D.reduce(newResult, (r, j) => j->reduce(r, f)) 77 | }; 78 | }; 79 | 80 | module Decode = { 81 | include Json.Decode; 82 | type fromJson('a) = decoder('a); 83 | external json: Js.Json.t => Js.Json.t = "%identity"; 84 | 85 | // Parse a string containing JSON 86 | let jsonString: fromJson(t) = 87 | j => 88 | switch (j->string->parseJsonAsResult) { 89 | | Ok(json) => json 90 | | Error(e) => raise(DecodeError(e)) 91 | }; 92 | 93 | let embedded: 'a. fromJson('a) => fromJson('a) = (dec, j) => j |> jsonString |> dec; 94 | 95 | let strMap: fromJson('a) => fromJson(SMap.t('a)) = 96 | (inner, obj) => obj |> dict(inner) |> D.entries |> SMap.fromArray; 97 | 98 | // Run two decoders on the same input 99 | let tup2: (fromJson('a), fromJson('b)) => fromJson(('a, 'b)) = 100 | (first, second, obj) => (obj |> first, obj |> second); 101 | 102 | let tup3: (fromJson('a), fromJson('b), fromJson('c)) => fromJson(('a, 'b, 'c)) = 103 | (f1, f2, f3, obj) => (obj |> f1, obj |> f2, obj |> f3); 104 | 105 | let tup4: 106 | (fromJson('a), fromJson('b), fromJson('c), fromJson('d)) => fromJson(('a, 'b, 'c, 'd)) = 107 | (f1, f2, f3, f4, obj) => (obj |> f1, obj |> f2, obj |> f3, obj |> f4); 108 | 109 | let tup5: 110 | (fromJson('a), fromJson('b), fromJson('c), fromJson('d), fromJson('e)) => 111 | fromJson(('a, 'b, 'c, 'd, 'e)) = 112 | (f1, f2, f3, f4, f5, obj) => (obj |> f1, obj |> f2, obj |> f3, obj |> f4, obj |> f5); 113 | 114 | // Passes the key as a first argument to the decoder, allowing you to 115 | // customize decoder behavior based on key 116 | let dictWithKey: (string => fromJson('a)) => fromJson(D.t('a)) = 117 | (inner, obj) => dict(json, obj)->D.mapWithKey(inner); 118 | 119 | // Passes the key as a first argument to the decoder, allowing you to 120 | // customize decoder behavior based on key 121 | let strMapWithKey: (string => fromJson('a)) => fromJson(SMap.t('a)) = 122 | (inner, obj) => { 123 | let entries = obj |> dict(x => x) |> D.entries; 124 | SMap.fromArray(ArrayUtils.map(entries, ((k, v)) => (k, inner(k, v)))); 125 | }; 126 | 127 | // Can parse either a JSON float, or a float-like string. 128 | let floatString: fromJson(float) = oneOf([float, obj => obj |> string |> float_of_string]); 129 | 130 | // Can parse either a JSON int, or a int-like string. 131 | let intString: fromJson(int) = oneOf([int, obj => obj |> string |> int_of_string]); 132 | 133 | let numberOrString: fromJson(string) = 134 | oneOf([string, obj => obj |> int |> string_of_int, obj => obj |> float |> Js.Float.toString]); 135 | 136 | // Given an optional value, fail with a DecodeError if it's None. 137 | let getSome: (decoder('a), option('a)) => 'a = 138 | (dec, opt) => 139 | switch (opt) { 140 | | Some(inner) => inner |> dec 141 | | None => raise(DecodeError("Option contained `None` when `Some` es expected")) 142 | }; 143 | 144 | // Given a function which parses a string into a value, produce 145 | // a decoder. 146 | let stringWithParse: 'a. (string => option('a)) => decoder('a) = 147 | (parse, j) => { 148 | let s = j |> string; 149 | switch (s |> parse) { 150 | | None => raise(DecodeError("String '" ++ s ++ "' failed to parse")) 151 | | Some(obj) => obj 152 | }; 153 | }; 154 | }; 155 | 156 | module Encode = { 157 | include Json.Encode; 158 | type toJson('a) = encoder('a); 159 | external json: Js.Json.t => Js.Json.t = "%identity"; 160 | let strMap: toJson('t) => toJson(SMap.t('t)) = (enc, map) => dict(enc, D.fromMap(map)); 161 | let object1: (string, toJson('a)) => toJson('a) = 162 | (key, encodeInner, inner) => object_([(key, encodeInner(inner))]); 163 | }; 164 | -------------------------------------------------------------------------------- /src/utils/ListUtils.re: -------------------------------------------------------------------------------- 1 | include Belt.List; 2 | 3 | let mapToArray: (list('a), 'a => 'b) => array('b) = (l, f) => toArray(map(l, f)); 4 | //let amap = mapToArray; 5 | //let mapa: (array('a), 'a => 'b) => list('b) = (a, f) => a->Belt.Array.map(f)->fromArray; 6 | //let mapa = fromArrayMap; 7 | -------------------------------------------------------------------------------- /src/utils/MapUtils.re: -------------------------------------------------------------------------------- 1 | // Extensions to the bare bindings to the built-in Map type in JavaScript. 2 | open UtilsPrelude; 3 | module A = ArrayUtils; 4 | module D = DictUtils; 5 | include JsMap; 6 | 7 | // Key/value pairs of a map as an array. 8 | let entriesArray: t('k, 'a) => array(('k, 'a)) = m => m->entries->Js.Array.from; 9 | 10 | // Keys of a map as an array. 11 | let keysArray: t('k, 'a) => array('k) = m => m->keys->Js.Array.from; 12 | 13 | // Values of a map as an array. 14 | let valuesArray: t('k, 'a) => array('a) = m => m->values->Js.Array.from; 15 | 16 | // Map a function over the values in a map. 17 | let map: (t('k, 'a), 'a => 'b) => t('k, 'b) = 18 | (m, f) => m->entries->A.ArrayLike.map(((k, v)) => (k, f(v)))->fromEntries; 19 | 20 | // Map a function over the key/value pairs in a dict. 21 | let mapWithKey: (t('k, 'a), (string, 'a) => 'b) => t('k, 'b) = 22 | (m, f) => m->entries->A.ArrayLike.map(((k, v)) => (k, f(k, v)))->fromEntries; 23 | 24 | let keep: (t('k, 'a), 'a => bool) => t('k, 'a) = 25 | (m, f) => m->entries->A.ArrayLike.filter(((_, v)) => f(v))->fromEntries; 26 | 27 | let keepWithKey: (t('k, 'a), ('k, 'a) => bool) => t('k, 'a) = 28 | (m, f) => m->entries->A.ArrayLike.filter(((k, v)) => f(k, v))->fromEntries; 29 | 30 | let keepMap: (t('k, 'a), 'a => option('b)) => t('k, 'b) = 31 | (m, f) => 32 | m 33 | ->entries 34 | ->A.ArrayLike.onArray(arr => 35 | arr->Belt.Array.keepMap(((k, v)) => f(v)->Belt.Option.map(v' => (k, v'))) 36 | ) 37 | ->fromEntries; 38 | 39 | let keepMapWithKey: (t('k, 'a), ('k, 'a) => option('b)) => t('k, 'b) = 40 | (m, f) => 41 | m 42 | ->entries 43 | ->A.ArrayLike.onArray(arr => 44 | arr->Belt.Array.keepMap(((k, v)) => f(k, v)->Belt.Option.map(v' => (k, v'))) 45 | ) 46 | ->fromEntries; 47 | 48 | // Set a key in a dictionary, producing a new dictionary. 49 | let setPure: (t('k, 'a), string, 'a) => t('k, 'a) = 50 | (m, k, v) => fromEntries(m->entries->A.ArrayLike.concatArray([|(k, v)|])); 51 | 52 | // Create a map with a single key and value 53 | let singleton: (string, 'a) => t('k, 'a) = 54 | (k, v) => fromEntries(A.(singleton((k, v))->ArrayLike.fromArray)); 55 | 56 | // Get or throw an exception if the key is not found. 57 | let getOrRaise: (t('k, 'v), 'k, 'k => exn) => 'v = 58 | (m, k, toExn) => 59 | switch (get(m, k)) { 60 | | None => raise(k->toExn) 61 | | Some(v) => v 62 | }; 63 | 64 | // Look up the key in the dictionary; if it's not in it, add the 65 | // given default to the map and then return it. 66 | let getOrSetDefaultMut: (t('k, 'v), 'k, 'v) => 'v = 67 | (m, k, default) => 68 | switch (m->get(k)) { 69 | | None => 70 | m->setMut(k, default)->ignore; 71 | default; 72 | | Some(v) => v 73 | }; 74 | 75 | // Group items in an array by a common result to a function. The key 76 | // type must be hashable by javascript -- the type system can't guarantee this. 77 | let groupBy: (array('a), 'a => 'k) => t('k, array('a)) = 78 | (arr, f) => { 79 | let result = empty(); 80 | arr->A.forEach(item => { 81 | let key = item->f; 82 | let group = result->getOrSetDefaultMut(key, [||]); 83 | group->A.pushMut(item); 84 | }); 85 | result; 86 | }; 87 | 88 | // Group an array of tuples. Each first element is a key in the resulting 89 | // map, and each second element appears in an array with other values 90 | // sharing the same key. 91 | let groupTuples: array(('k, 'v)) => t('k, array('v)) = 92 | arr => { 93 | let result = empty(); 94 | arr->A.forEach(((key, item)) => { 95 | let group = result->getOrSetDefaultMut(key, [||]); 96 | group->A.pushMut(item); 97 | }); 98 | result; 99 | }; 100 | 101 | // Convert string maps to/from their equivalents in Belt 102 | module String = { 103 | let fromBeltMap: SMap.t('a) => t(string, 'a) = map => fromArray(SMap.toArray(map)); 104 | let toBeltMap: t(string, 'a) => SMap.t('a) = m => SMap.fromArray(toArray(m)); 105 | let fromDict: D.t('a) => t(string, 'a) = map => fromArray(D.entries(map)); 106 | let toDict: t(string, 'a) => D.t('a) = m => D.fromArray(toArray(m)); 107 | }; 108 | 109 | // Convert int maps to/from equivalents in Belt 110 | module Int = { 111 | let fromBeltMap: IMap.t('a) => t(int, 'a) = map => fromArray(IMap.toArray(map)); 112 | let toBeltMap: t(int, 'a) => IMap.t('a) = m => IMap.fromArray(toArray(m)); 113 | }; 114 | -------------------------------------------------------------------------------- /src/utils/OptionUtils.re: -------------------------------------------------------------------------------- 1 | include Belt.Option; 2 | 3 | let someIf: (bool, 'a) => option('a) = (cond, x) => cond ? Some(x) : None; 4 | 5 | // like getWithDefault, but obtains its default thru a lazily-evaluated function. 6 | let getWithDefaultLazy: (option('a), unit => 'a) => 'a = 7 | (opt, make) => 8 | switch (opt) { 9 | | Some(x) => x 10 | | None => make() 11 | }; 12 | 13 | let mapString: (option('a), 'a => string) => string = 14 | (opt, f) => 15 | switch (opt) { 16 | | None => "" 17 | | Some(x) => f(x) 18 | }; 19 | -------------------------------------------------------------------------------- /src/utils/PromiseUtils.re: -------------------------------------------------------------------------------- 1 | include Js.Promise; 2 | 3 | [@bs.send] external flatMap: (t('a), 'a => t('b)) => t('b) = "then"; 4 | 5 | [@bs.send] external map: (t('a), 'a => 'b) => t('b) = "then"; 6 | 7 | // Like Js.Promise.make but doesn't require that the error is an `exn 8 | [@bs.new] 9 | external makeWithError: ((~resolve: (. 'a) => unit, ~reject: (. 'e) => unit) => unit) => t('a) = 10 | "Promise"; 11 | 12 | // Fire off a promise and ignore its result 13 | let fireOff: 'a. (unit => t(unit)) => unit = makePromise => makePromise()->ignore; 14 | 15 | // Treat a promise as an applicative functor. 16 | let apply: 'a 'b. (t('a => 'b), t('a)) => t('b) = 17 | (funcPromise, nextPromise) => 18 | funcPromise->flatMap(f => nextPromise->flatMap(x => x->f->resolve)); 19 | 20 | // Like apply, but computes the promises in parallel. 21 | let applyParallel: 'a 'b. (t('a => 'b), t('a)) => t('b) = 22 | (funcPromise, nextPromise) => all2((funcPromise, nextPromise))->map(((f, x)) => f(x)); 23 | 24 | // Annoyingly Js.Promise requires that you reject with an exn 25 | [@bs.val] [@bs.scope "Promise"] external rejectError: 'a => t('b) = "reject"; 26 | 27 | let tap: 'a. (t('a), 'a => unit) => t('a) = 28 | (prom, f) => 29 | prom->map(x => { 30 | f(x); 31 | x; 32 | }); 33 | 34 | let then2: (('a, 'b) => t('c), t(('a, 'b))) => t('c) = 35 | (f, prom) => prom |> then_(((a, b)) => f(a, b)); 36 | let then3: (('a, 'b, 'c) => t('d), t(('a, 'b, 'c))) => t('d) = 37 | (f, prom) => prom |> then_(((a, b, c)) => f(a, b, c)); 38 | let rLog: 'a => t(unit) = x => resolve(Js.log(x)); 39 | let rLog2: ('a, 'b) => t(unit) = (a, b) => resolve(Js.log2(a, b)); 40 | let rLog3: ('a, 'b, 'c) => t(unit) = (a, b, c) => resolve(Js.log3(a, b, c)); 41 | let rLog4: ('a, 'b, 'c, 'd) => t(unit) = (a, b, c, d) => resolve(Js.log4(a, b, c, d)); 42 | let rLogReturn: ('a => 'b, 'a) => t('a) = 43 | (toLog, x) => { 44 | Js.log(toLog(x)); 45 | resolve(x); 46 | }; 47 | exception Error(error); 48 | 49 | [@bs.send] external catchMap: (t('a), error => 'a) => t('a) = "catch"; 50 | 51 | // Catch in significant-data-first order (hence `F`) 52 | [@bs.send] external catchF: (t('a), error => t('a)) => t('a) = "catch"; 53 | 54 | [@bs.send] external finally: (t('a), unit => unit) => t('a) = "finally"; 55 | 56 | // Run a list of promises in sequence. 57 | let allSequentiallyList: 'a. list(unit => t('a)) => t(list('a)) = 58 | inputProms => { 59 | let rec loop = (proms, results) => 60 | switch (proms) { 61 | | [] => resolve(results) 62 | | [prom, ...rest] => prom()->flatMap(result => loop(rest, [result, ...results])) 63 | }; 64 | loop(inputProms, []); 65 | }; 66 | 67 | // Run an array of promises in sequence. 68 | let allSequentially: array(unit => t('a)) => t(array('a)) = 69 | arr => arr->Belt.List.fromArray->allSequentiallyList->map(Belt.List.toArray); 70 | -------------------------------------------------------------------------------- /src/utils/ResultUtils.re: -------------------------------------------------------------------------------- 1 | include Belt.Result; 2 | 3 | // Map a function over a result, if it's a success. 4 | let map: ('a => 'b, t('a, 'err)) => t('b, 'err) = 5 | f => 6 | fun 7 | | Ok(x) => Ok(f(x)) 8 | | Error(e) => Error(e); 9 | 10 | let unwrap: t('a, exn) => 'a = 11 | fun 12 | | Ok(x) => x 13 | | Error(err) => raise(err); 14 | 15 | let unwrapPromise: t('a, exn) => Js.Promise.t('a) = 16 | fun 17 | | Ok(x) => Js.Promise.resolve(x) 18 | | Error(err) => Js.Promise.reject(err); 19 | 20 | let unwrapPromise2: ((t('a, exn), t('b, exn))) => Js.Promise.t(('a, 'b)) = 21 | fun 22 | | (Ok(x), Ok(y)) => Js.Promise.resolve((x, y)) 23 | | (Error(err), _) => Js.Promise.reject(err) 24 | | (_, Error(err)) => Js.Promise.reject(err); 25 | 26 | let mapError = f => 27 | fun 28 | | Ok(_) as result => result 29 | | Error(e) => Error(f(e)); 30 | 31 | // Apply a function, returning Ok(result). If an exception is 32 | // thrown by the function, return Error(exception). This can be 33 | // used to build an error boundary around code which might fail. 34 | // 35 | // exception BadNumber(int) 36 | // let badFunction = n => n == 3 ? raise(BadNumber(n)) : n + 1 37 | // expect(12->catchExn(badFunction)).toEqual(Ok(13)) 38 | // expect(3->catchExn(badFunction)).toEqual(Error(BadNumber(3))) 39 | // 40 | let catchExn: ('a, 'a => 'b) => t('b, exn) = 41 | (x, f) => 42 | try(Ok(x->f)) { 43 | | e => Error(e) 44 | }; 45 | -------------------------------------------------------------------------------- /src/utils/StringUtils.re: -------------------------------------------------------------------------------- 1 | include UtilsPrelude; 2 | include Js.String; 3 | module O = Belt.Option; 4 | module A = ArrayUtils; 5 | 6 | let length = Js.String.length; 7 | let contains = (~substring, str) => Js.String.indexOf(substring, str) >= 0; 8 | let replace = (~old, ~new_, str) => 9 | Js.String.replaceByRe(Js.Re.fromStringWithFlags(old, ~flags="g"), new_, str); 10 | 11 | let isMatch: (string, Js.Re.t) => bool = (s, r) => O.isSome(Js.String.match(r, s)); 12 | 13 | // Return the string if condition is true, else empty string. 14 | let strIf = (cond: bool, s: string) => cond ? s : ""; 15 | let strFrom = (toString: 'a => string, opt: option('a)) => O.mapWithDefault(opt, "", toString); 16 | 17 | // Convert a string to an int, handling failure with an option type. 18 | let parseInt = str => 19 | switch (int_of_string(str)) { 20 | | i => Some(i) 21 | | exception _ => None 22 | }; 23 | 24 | // Convert a string to an float, handling failure with an option type. 25 | let parseFloat = str => 26 | switch (float_of_string(str)) { 27 | | i => Some(i) 28 | | exception _ => None 29 | }; 30 | 31 | // Note: these are duplicates of corresponding functions in the Array module. Can remove those later 32 | let joinWith: (array(string), string) => string = (arr, sep) => Js.Array.joinWith(sep, arr); 33 | let joinSpaces: array(string) => string = arr => joinWith(arr, " "); 34 | let mapJoin: (array('a), ~prefix: string=?, ~suffix: string=?, string, 'a => string) => string = 35 | (arr, ~prefix="", ~suffix="", sep, f) => prefix ++ joinWith(A.map(arr, f), sep) ++ suffix; 36 | let mapJoinWith: (array('a), string, 'a => string) => string = 37 | (arr, sep, f) => joinWith(A.map(arr, f), sep); 38 | let mapJoinCommas = (arr, ~prefix=?, ~suffix=?, f) => mapJoin(arr, ~prefix?, ~suffix?, ", ", f); 39 | let mapJoinSpaces = (arr, ~prefix=?, ~suffix=?, f) => mapJoin(arr, ~prefix?, ~suffix?, " ", f); 40 | let mapJoinCommasParens = (arr, f) => mapJoin(arr, ~prefix="(", ~suffix=")", ", ", f); 41 | let mapJoinIfNonEmpty: 42 | (array('a), ~onEmpty: string=?, ~prefix: string=?, ~suffix: string=?, string, 'a => string) => 43 | string = 44 | (arr, ~onEmpty="", ~prefix="", ~suffix="", sep, f) => 45 | switch (arr) { 46 | | [||] => onEmpty 47 | | _ => mapJoin(arr, ~prefix, ~suffix, sep, f) 48 | }; 49 | 50 | // Deduplicate strings in an array, preserving order. 51 | let dedupeArray = (strings: array(string)): array(string) => { 52 | // Doing this super imperative style cuz why not 53 | let seen = Js.Dict.empty(); 54 | let uniques = [||]; 55 | A.forEach(strings, s => 56 | if (Js.Dict.get(seen, s)->Belt.Option.isNone) { 57 | Js.Array.push(s, uniques) |> ignore; 58 | Js.Dict.set(seen, s, true) |> ignore; 59 | } 60 | ); 61 | uniques; 62 | }; 63 | 64 | // Deduplicate strings in a list, preserving order. 65 | let dedupeList = (strings: list(string)): list(string) => { 66 | let (_, reversed) = 67 | Belt.List.reduce(strings, (SSet.empty, []), ((seen, uniques), s) => 68 | SSet.has(seen, s) ? (seen, uniques) : (SSet.add(seen, s), Belt.List.add(uniques, s)) 69 | ); 70 | // Since we're pushing to the front of the list, the order will be reversed, so 71 | // reverse it before returning 72 | Belt.List.reverse(reversed); 73 | }; 74 | -------------------------------------------------------------------------------- /src/utils/Utils.re: -------------------------------------------------------------------------------- 1 | // A bunch of aliases to commonly used modules. This can be `open`ed 2 | include UtilsPrelude; 3 | 4 | module Array = ArrayUtils; 5 | module Dict = DictUtils; 6 | module Json = JsonUtils; 7 | module List = ListUtils; 8 | module Map = MapUtils; 9 | module Option = OptionUtils; 10 | module Promise = PromiseUtils; 11 | module Result = ResultUtils; 12 | module String = StringUtils; 13 | module JsSet = JsSet; 14 | module JsMap = JsMap; 15 | 16 | module Abbreviations = { 17 | module A = ArrayUtils; 18 | module D = DictUtils; 19 | module J = JsonUtils; 20 | module JD = J.Decode; 21 | module JE = J.Encode; 22 | module L = ListUtils; 23 | module M = MapUtils; 24 | module O = OptionUtils; 25 | module P = PromiseUtils; 26 | module R = ResultUtils; 27 | module S = StringUtils; 28 | }; 29 | -------------------------------------------------------------------------------- /src/utils/UtilsPrelude.re: -------------------------------------------------------------------------------- 1 | // Things to `open` in every `*Utils` module 2 | module IMap = Belt.Map.Int; 3 | module ISet = Belt.Set.Int; 4 | module SMap = Belt.Map.String; 5 | module SSet = Belt.Set.String; 6 | 7 | // Throw an exception as a native javascript error. Acts like failwith but 8 | // will have a stack trace if triggered. 9 | let throw: string => 'a = Js.Exn.raiseError; 10 | 11 | external id: 'a => 'a = "%identity"; 12 | 13 | let uncurry: (('a, 'b) => 'c, ('a, 'b)) => 'c = (f, (a, b)) => f(a, b); 14 | let uncurry3: (('a, 'b, 'c) => 'd, ('a, 'b, 'c)) => 'd = (f, (a, b, c)) => f(a, b, c); 15 | let uncurry4: (('a, 'b, 'c, 'd) => 'e, ('a, 'b, 'c, 'd)) => 'e = 16 | (f, (a, b, c, d)) => f(a, b, c, d); 17 | 18 | // Given a function which expects a tuple, turn it into a function which expects two arguments. 19 | let curry: ((('a, 'b)) => 'c, 'a, 'b) => 'c = (f, a, b) => f((a, b)); 20 | let curry3: ((('a, 'b, 'c)) => 'd, 'a, 'b, 'c) => 'd = (f, a, b, c) => f((a, b, c)); 21 | let curry4: ((('a, 'b, 'c, 'd)) => 'd, 'a, 'b, 'c, 'd) => 'd = 22 | (f, a, b, c, d) => f((a, b, c, d)); 23 | 24 | // Map two functions over a 2-tuple. 25 | let mapTup2: 'a1 'a2 'b1 'b2. ('a1 => 'a2, 'b1 => 'b2, ('a1, 'b1)) => ('a2, 'b2) = 26 | (f, g, (a, b)) => (f(a), g(b)); 27 | 28 | // Map a function over the first element in a tuple. 29 | let mapFst: 'a 'b 'c. ('a => 'c, ('a, 'b)) => ('c, 'b) = (f, (a, b)) => (f(a), b); 30 | 31 | // Map a function over the second element in a tuple. 32 | let mapSnd: 'a 'b 'c. ('b => 'c, ('a, 'b)) => ('a, 'c) = (f, (a, b)) => (a, f(b)); 33 | --------------------------------------------------------------------------------