adam@1656:  (* Copyright (c) 2009-2010, Adam Chlipala
adamc@885:  * All rights reserved.
adamc@885:  *
adamc@885:  * Redistribution and use in source and binary forms, with or without
adamc@885:  * modification, are permitted provided that the following conditions are met:
adamc@885:  *
adamc@885:  * - Redistributions of source code must retain the above copyright notice,
adamc@885:  *   this list of conditions and the following disclaimer.
adamc@885:  * - Redistributions in binary form must reproduce the above copyright notice,
adamc@885:  *   this list of conditions and the following disclaimer in the documentation
adamc@885:  *   and/or other materials provided with the distribution.
adamc@885:  * - The names of contributors may not be used to endorse or promote products
adamc@885:  *   derived from this software without specific prior written permission.
adamc@885:  *
adamc@885:  * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
adamc@885:  * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
adamc@885:  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
adamc@885:  * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
adam@1682:  * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
adamc@885:  * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
adamc@885:  * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
adamc@885:  * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
adamc@885:  * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
adamc@885:  * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
adamc@885:  * POSSIBILITY OF SUCH DAMAGE.
adamc@885:  *)
adamc@885: 
adamc@885: structure SQLite :> SQLITE = struct
adamc@885: 
adamc@885: open Settings
adamc@885: open Print.PD
adamc@885: open Print
adamc@885: 
adamc@885: fun p_sql_type t =
adamc@885:     case t of
adamc@885:         Int => "integer"
adamc@885:       | Float => "real"
adamc@885:       | String => "text"
adamc@1014:       | Char => "text"
adamc@885:       | Bool => "integer"
adamc@887:       | Time => "text"
adamc@885:       | Blob => "blob"
adamc@885:       | Channel => "integer"
adamc@885:       | Client => "integer"
adamc@885:       | Nullable t => p_sql_type t
adamc@885: 
adamc@885: val ident = String.translate (fn #"'" => "PRIME"
adamc@885:                                | ch => str ch)
adamc@885: 
adamc@885: fun checkRel (table, checkNullable) (s, xts) =
adamc@885:     let
adamc@885:         val q = "SELECT COUNT(*) FROM sqlite_master WHERE type = '" ^ table ^ "' AND name = '"
adamc@885:                 ^ s ^ "'"
adamc@885:     in
adamc@885:         box [string "if (sqlite3_prepare_v2(conn->conn, \"",
adamc@885:              string q,
adamc@885:              string "\", -1, &stmt, NULL) != SQLITE_OK) {",
adamc@885:              newline,
adamc@885:              box [string "sqlite3_close(conn->conn);",
adamc@885:                   newline,
adamc@1266:                   string "uw_error(ctx, FATAL, \"Query preparation failed:<br />",
adamc@885:                   string q,
adamc@885:                   string "\");",
adamc@885:                   newline],
adamc@885:              string "}",
adamc@885:              newline,
adamc@885:              newline,
adamc@885: 
adamc@885:              string "while ((res = sqlite3_step(stmt)) == SQLITE_BUSY)",
adamc@885:              newline,
adamc@885:              box [string "sleep(1);",
adamc@885:                   newline],
adamc@885:              newline,
adamc@885:              string "if (res == SQLITE_DONE) {",
adamc@885:              newline,
adamc@885:              box [string "sqlite3_finalize(stmt);",
adamc@885:                   newline,
adamc@885:                   string "sqlite3_close(conn->conn);",
adamc@885:                   newline,
adamc@1266:                   string "uw_error(ctx, FATAL, \"No row returned:<br />",
adamc@885:                   string q,
adamc@885:                   string "\");",
adamc@885:                   newline],
adamc@885:              string "}",
adamc@885:              newline,
adamc@885:              newline,
adamc@885:              string "if (res != SQLITE_ROW) {",
adamc@885:              newline,
adamc@885:              box [string "sqlite3_finalize(stmt);",
adamc@885:                   newline,
adamc@885:                   string "sqlite3_close(conn->conn);",
adamc@885:                   newline,
adamc@1266:                   string "uw_error(ctx, FATAL, \"Error getting row:<br />",
adamc@885:                   string q,
adamc@885:                   string "\");",
adamc@885:                   newline],
adamc@885:              string "}",
adamc@885:              newline,
adamc@885:              newline,
adamc@885: 
adamc@885:              string "if (sqlite3_column_count(stmt) != 1) {",
adamc@885:              newline,
adamc@885:              box [string "sqlite3_finalize(stmt);",
adamc@885:                   newline,
adamc@885:                   string "sqlite3_close(conn->conn);",
adamc@885:                   newline,
adamc@1266:                   string "uw_error(ctx, FATAL, \"Bad column count:<br />",
adamc@885:                   string q,
adamc@885:                   string "\");",
adamc@885:                   newline],
adamc@885:              string "}",
adamc@885:              newline,
adamc@885:              newline,
adamc@885: 
adamc@885:              string "if (sqlite3_column_int(stmt, 0) != 1) {",
adamc@885:              newline,
adamc@885:              box [string "sqlite3_finalize(stmt);",
adamc@885:                   newline,
adamc@885:                   string "sqlite3_close(conn->conn);",
adamc@885:                   newline,
adamc@885:                   string "uw_error(ctx, FATAL, \"Table '",
adamc@885:                   string s,
adamc@885:                   string "' does not exist.\");",
adamc@885:                   newline],
adamc@885:              string "}",
adamc@885:              newline,
adamc@885:              newline,
adamc@885:              string "sqlite3_finalize(stmt);",
adamc@885:              newline]
adamc@885:     end
adamc@885: 
adamc@885: fun init {dbstring, prepared = ss, tables, views, sequences} =
adamc@885:     let
adamc@885:         val db = ref dbstring
adamc@885:     in
adamc@885:         app (fn s =>
adamc@885:                 case String.fields (fn ch => ch = #"=") s of
adamc@885:                     [name, value] =>
adamc@885:                     (case name of
adamc@885:                          "dbname" => db := value
adamc@885:                        | _ => ())
adamc@885:                   | _ => ()) (String.tokens Char.isSpace dbstring);
adamc@885: 
adamc@885:         box [string "typedef struct {",
adamc@885:              newline,
adamc@885:              box [string "sqlite3 *conn;",
adamc@885:                   newline,
adamc@885:                   p_list_sepi (box [])
adamc@885:                               (fn i => fn _ =>
adamc@885:                                           box [string "sqlite3_stmt *p",
adamc@885:                                                string (Int.toString i),
adamc@885:                                                string ";",
adamc@885:                                                newline])
adamc@885:                               ss],
adamc@885:              string "} uw_conn;",
adamc@885:              newline,
adamc@885:              newline,
adamc@885: 
adamc@1094:              string "static void uw_client_init(void) {",
adamc@885:              newline,
adamc@885:              box [string "uw_sqlfmtInt = \"%lld%n\";",
adamc@885:                   newline,
adam@1920:                   string "uw_sqlfmtFloat = \"%.16g%n\";",
adamc@885:                   newline,
adamc@885:                   string "uw_Estrings = 0;",
adamc@885:                   newline,
adam@1834:                   string "uw_sql_type_annotations = 0;",
adam@1834:                   newline,
adamc@885:                   string "uw_sqlsuffixString = \"\";",
adamc@885:                   newline,
adamc@1011:                   string "uw_sqlsuffixChar = \"\";",
adamc@1011:                   newline,
adamc@885:                   string "uw_sqlsuffixBlob = \"\";",
adamc@885:                   newline,
adamc@885:                   string "uw_sqlfmtUint4 = \"%u%n\";",
adamc@885:                   newline],
adamc@885:              string "}",
adamc@885:              newline,
adamc@885:              newline,
adamc@885: 
adamc@885:              if #persistent (currentProtocol ()) then
adamc@885:                  box [string "static void uw_db_validate(uw_context ctx) {",
adamc@885:                       newline,
adamc@885:                       string "uw_conn *conn = uw_get_db(ctx);",
adamc@885:                       newline,
adamc@885:                       string "sqlite3_stmt *stmt;",
adamc@885:                       newline,
adamc@885:                       string "int res;",
adamc@885:                       newline,
adamc@885:                       newline,
adamc@885:                       p_list_sep newline (checkRel ("table", true)) tables,
adamc@885:                       p_list_sep newline (fn name => checkRel ("table", true)
adamc@885:                                                               (name, [("id", Settings.Client)])) sequences,
adamc@885:                       p_list_sep newline (checkRel ("view", false)) views,
adamc@885:                       string "}",
adamc@885:                       newline,
adamc@885:                       newline,
adamc@885: 
adamc@885:                       string "static void uw_db_prepare(uw_context ctx) {",
adamc@885:                       newline,
adamc@885:                       string "uw_conn *conn = uw_get_db(ctx);",
adamc@885:                       newline,
adamc@885:                       newline,
adamc@885: 
adam@2103:                       p_list_sepi newline (fn i => fn (s, _) =>
adamc@885:                                                       let
adamc@885:                                                           fun uhoh this s args =
adamc@885:                                                               box [p_list_sepi (box [])
adamc@885:                                                                                (fn j => fn () =>
adamc@885:                                                                                            box [string
adamc@885:                                                                                                     "sqlite3_finalize(conn->p",
adamc@885:                                                                                                 string (Int.toString j),
adamc@885:                                                                                                 string ");",
adamc@885:                                                                                                 newline])
adamc@885:                                                                                (List.tabulate (i, fn _ => ())),
adamc@885:                                                                    box (if this then
adamc@885:                                                                             [string
adamc@885:                                                                                  "sqlite3_finalize(conn->p",
adamc@885:                                                                              string (Int.toString i),
adamc@885:                                                                              string ");",
adamc@885:                                                                              newline]
adamc@885:                                                                         else
adamc@885:                                                                             []),
adamc@885:                                                                    string "sqlite3_close(conn->conn);",
adamc@885:                                                                    newline,
adamc@885:                                                                    string "uw_error(ctx, FATAL, \"",
adamc@885:                                                                    string s,
adamc@885:                                                                    string "\"",
adamc@885:                                                                    p_list_sep (box []) (fn s => box [string ", ",
adamc@885:                                                                                                      string s]) args,
adamc@885:                                                                    string ");",
adamc@885:                                                                    newline]
adamc@885:                                                       in
adamc@885:                                                           box [string "if (sqlite3_prepare_v2(conn->conn, \"",
adam@1656:                                                                string (Prim.toCString s),
adamc@885:                                                                string "\", -1, &conn->p",
adamc@885:                                                                string (Int.toString i),
adamc@885:                                                                string ", NULL) != SQLITE_OK) {",
adamc@885:                                                                newline,
adamc@886:                                                                box [string "char msg[1024];",
adamc@886:                                                                     newline,
adamc@886:                                                                     string "strncpy(msg, sqlite3_errmsg(conn->conn), 1024);",
adamc@886:                                                                     newline,
adamc@886:                                                                     string "msg[1023] = 0;",
adamc@886:                                                                     newline,
adamc@886:                                                                     uhoh false ("Error preparing statement: "
adam@1656:                                                                                 ^ Prim.toCString s ^ "<br />%s") ["msg"]],
adamc@885:                                                                string "}",
adamc@885:                                                                newline]
adamc@885:                                                       end)
adamc@885:                                   ss,
adamc@885: 
adamc@885:                       string "}"]
adamc@885:              else
adamc@885:                  box [string "static void uw_db_prepare(uw_context ctx) { }",
adamc@885:                       newline,
adamc@885:                       string "static void uw_db_validate(uw_context ctx) { }"],
adamc@885:              newline,
adamc@885:              newline,
adam@1682: 
adamc@1094:              string "static void uw_db_init(uw_context ctx) {",
adamc@885:              newline,
adamc@885:              string "sqlite3 *sqlite;",
adamc@885:              newline,
adamc@1115:              string "sqlite3_stmt *stmt;",
adamc@1115:              newline,
adamc@885:              string "uw_conn *conn;",
adamc@885:              newline,
adamc@885:              newline,
adamc@885:              string "if (sqlite3_open(\"",
adamc@885:              string (!db),
adamc@885:              string "\", &sqlite) != SQLITE_OK) uw_error(ctx, FATAL, ",
adamc@885:              string "\"Can't open SQLite database.\");",
adamc@885:              newline,
adamc@885:              newline,
adamc@1115:              string "if (uw_database_max < SIZE_MAX) {",
adamc@1115:              newline,
adamc@1115:              box [string "char buf[100];",
adamc@1115:                   newline,
adamc@1115:                   newline,
adamc@1115: 
adamc@1115:                   string "sprintf(buf, \"PRAGMA max_page_count = %llu\", (unsigned long long)(uw_database_max / 1024));",
adamc@1115:                   newline,
adamc@1115:                   newline,
adamc@1115: 
adamc@1115:                   string "if (sqlite3_prepare_v2(sqlite, buf, -1, &stmt, NULL) != SQLITE_OK) {",
adamc@1115:                   newline,
adamc@1115:                   box [string "sqlite3_close(sqlite);",
adamc@1115:                        newline,
adamc@1115:                        string "uw_error(ctx, FATAL, \"Can't prepare max_page_count query for SQLite database\");",
adamc@1115:                        newline],
adamc@1115:                   string "}",
adamc@1115:                   newline,
adamc@1115:                   newline,
adamc@1115: 
adamc@1115:                   string "if (sqlite3_step(stmt) != SQLITE_ROW) {",
adamc@1115:                   newline,
adamc@1115:                   box [string "sqlite3_finalize(stmt);",
adamc@1115:                        newline,
adamc@1115:                        string "sqlite3_close(sqlite);",
adamc@1115:                        newline,
adamc@1115:                        string "uw_error(ctx, FATAL, \"Can't set max_page_count parameter for SQLite database\");",
adamc@1115:                        newline],
adamc@1115:                   string "}",
adamc@1115:                   newline,
adamc@1115:                   newline,
adamc@1115: 
adamc@1115:                   string "sqlite3_finalize(stmt);",
adamc@1115:                   newline],
adamc@1115:              string "}",
adamc@1115:              newline,
adamc@1115:              newline,
adam@1682: 
adamc@885:              string "conn = calloc(1, sizeof(uw_conn));",
adamc@885:              newline,
adamc@885:              string "conn->conn = sqlite;",
adamc@885:              newline,
adamc@885:              string "uw_set_db(ctx, conn);",
adamc@885:              newline,
adamc@885:              string "uw_db_validate(ctx);",
adamc@885:              newline,
adamc@885:              string "uw_db_prepare(ctx);",
adamc@885:              newline,
adamc@885:              string "}",
adamc@885:              newline,
adamc@885:              newline,
adamc@885: 
adamc@1094:              string "static void uw_db_close(uw_context ctx) {",
adamc@885:              newline,
adamc@885:              string "uw_conn *conn = uw_get_db(ctx);",
adamc@885:              newline,
adamc@885:              p_list_sepi (box [])
adamc@885:                          (fn i => fn _ =>
adamc@885:                                      box [string "if (conn->p",
adamc@885:                                           string (Int.toString i),
adamc@885:                                           string ") sqlite3_finalize(conn->p",
adamc@885:                                           string (Int.toString i),
adamc@885:                                           string ");",
adamc@885:                                           newline])
adamc@885:                          ss,
adamc@885:              string "sqlite3_close(conn->conn);",
adamc@885:              newline,
adamc@885:              string "}",
adamc@885:              newline,
adamc@885:              newline,
adamc@885: 
adam@1936:              string "static int uw_db_begin(uw_context ctx, int could_write) {",
adamc@885:              newline,
adamc@885:              string "uw_conn *conn = uw_get_db(ctx);",
adamc@885:              newline,
adamc@885:              newline,
adamc@885:              string "if (sqlite3_exec(conn->conn, \"BEGIN\", NULL, NULL, NULL) == SQLITE_OK)",
adamc@885:              newline,
adamc@885:              box [string "return 0;",
adamc@885:                   newline],
adamc@885:              string "else {",
adamc@885:              newline,
adamc@1266:              box [string "fprintf(stderr, \"Begin error: %s<br />\", sqlite3_errmsg(conn->conn));",
adamc@885:                   newline,
adamc@885:                   string "return 1;",
adamc@885:                   newline],
adamc@885:              string "}",
adamc@885:              newline,
adamc@885:              string "}",
adamc@885:              newline,
adamc@1094:              string "static int uw_db_commit(uw_context ctx) {",
adamc@885:              newline,
adamc@885:              string "uw_conn *conn = uw_get_db(ctx);",
adamc@885:              newline,
adamc@885:              string "if (sqlite3_exec(conn->conn, \"COMMIT\", NULL, NULL, NULL) == SQLITE_OK)",
adamc@885:              newline,
adamc@885:              box [string "return 0;",
adamc@885:                   newline],
adamc@885:              string "else {",
adamc@885:              newline,
adamc@1266:              box [string "fprintf(stderr, \"Commit error: %s<br />\", sqlite3_errmsg(conn->conn));",
adamc@885:                   newline,
adamc@885:                   string "return 1;",
adamc@885:                   newline],
adamc@885:              string "}",
adamc@885:              newline,
adamc@885:              string "}",
adamc@885:              newline,
adamc@885:              newline,
adamc@885: 
adamc@1094:              string "static int uw_db_rollback(uw_context ctx) {",
adamc@885:              newline,
adamc@885:              string "uw_conn *conn = uw_get_db(ctx);",
adamc@885:              newline,
adamc@885:              string "if (sqlite3_exec(conn->conn, \"ROLLBACK\", NULL, NULL, NULL) == SQLITE_OK)",
adamc@885:              newline,
adamc@885:              box [string "return 0;",
adamc@885:                   newline],
adamc@885:              string "else {",
adamc@885:              newline,
adamc@1266:              box [string "fprintf(stderr, \"Rollback error: %s<br />\", sqlite3_errmsg(conn->conn));",
adamc@885:                   newline,
adamc@885:                   string "return 1;",
adamc@885:                   newline],
adamc@885:              string "}",
adamc@885:              newline,
adamc@885:              string "}",
adamc@885:              newline,
adamc@885:              newline]
adamc@885:     end
adamc@885: 
adam@1352: val fmt = "\"%Y-%m-%d %H:%M:%S\""
adam@1352: 
adamc@885: fun p_getcol {loc, wontLeakStrings, col = i, typ = t} =
adamc@885:     let
adamc@885:         fun p_unsql t =
adamc@885:             case t of
adamc@885:                 Int => box [string "sqlite3_column_int64(stmt, ", string (Int.toString i), string ")"]
adamc@885:               | Float => box [string "sqlite3_column_double(stmt, ", string (Int.toString i), string ")"]
adamc@885:               | String =>
adamc@885:                 if wontLeakStrings then
adamc@1014:                     box [string "(uw_Basis_string)sqlite3_column_text(stmt, ", string (Int.toString i), string ")"]
adamc@885:                 else
adamc@1014:                     box [string "uw_strdup(ctx, (uw_Basis_string)sqlite3_column_text(stmt, ", string (Int.toString i), string "))"]
adamc@1014:               | Char => box [string "sqlite3_column_text(stmt, ", string (Int.toString i), string ")[0]"]
adamc@885:               | Bool => box [string "(uw_Basis_bool)sqlite3_column_int(stmt, ", string (Int.toString i), string ")"]
adam@1352:               | Time => box [string "uw_Basis_stringToTimef_error(ctx, ",
adam@1352:                              string fmt,
adam@1352:                              string ", (uw_Basis_string)sqlite3_column_text(stmt, ",
adam@1352:                              string (Int.toString i),
adam@1352:                              string "))"]
adamc@885:               | Blob => box [string "({",
adamc@885:                              newline,
adamc@890:                              string "char *data = (char *)sqlite3_column_blob(stmt, ",
adamc@885:                              string (Int.toString i),
adamc@885:                              string ");",
adamc@885:                              newline,
adamc@890:                              string "int len = sqlite3_column_bytes(stmt, ",
adamc@885:                              string (Int.toString i),
adamc@890:                              string ");",
adamc@890:                              newline,
adamc@890:                              string "uw_Basis_blob b = {len, uw_memdup(ctx, data, len)};",
adamc@885:                              newline,
adamc@885:                              string "b;",
adamc@885:                              newline,
adamc@885:                              string "})"]
adamc@886:               | Channel => box [string "({",
adamc@886:                                 newline,
adamc@886:                                 string "sqlite3_int64 n = sqlite3_column_int64(stmt, ",
adamc@886:                                 string (Int.toString i),
adamc@886:                                 string ");",
adamc@886:                                 newline,
adamc@886:                                 string "uw_Basis_channel ch = {n >> 32, n & 0xFFFFFFFF};",
adamc@886:                                 newline,
adamc@886:                                 string "ch;",
adamc@886:                                 newline,
adamc@886:                                 string "})"]
adamc@885:               | Client => box [string "sqlite3_column_int(stmt, ", string (Int.toString i), string ")"]
adamc@885: 
adamc@885:               | Nullable _ => raise Fail "Postgres: Recursive Nullable"
adamc@885: 
adamc@885:         fun getter t =
adamc@885:             case t of
adamc@885:                 Nullable t =>
adamc@885:                 box [string "(sqlite3_column_type(stmt, ",
adamc@885:                      string (Int.toString i),
adamc@885:                      string ") == SQLITE_NULL ? NULL : ",
adamc@885:                      case t of
adamc@885:                          String => getter t
adamc@885:                        | _ => box [string "({",
adamc@885:                                    newline,
adamc@885:                                    string (p_sql_ctype t),
adamc@885:                                    space,
adamc@885:                                    string "*tmp = uw_malloc(ctx, sizeof(",
adamc@885:                                    string (p_sql_ctype t),
adamc@885:                                    string "));",
adamc@885:                                    newline,
adamc@885:                                    string "*tmp = ",
adamc@885:                                    getter t,
adamc@885:                                    string ";",
adamc@885:                                    newline,
adamc@885:                                    string "tmp;",
adamc@885:                                    newline,
adamc@885:                                    string "})"],
adamc@885:                      string ")"]
adamc@885:               | _ =>
adamc@885:                 box [string "(sqlite3_column_type(stmt, ",
adamc@885:                      string (Int.toString i),
adamc@885:                      string ") == SQLITE_NULL ? ",
adamc@885:                      box [string "({",
adamc@885:                           string (p_sql_ctype t),
adamc@885:                           space,
adamc@885:                           string "tmp;",
adamc@885:                           newline,
adamc@885:                           string "uw_error(ctx, FATAL, \"",
adamc@885:                           string (ErrorMsg.spanToString loc),
adamc@885:                           string ": Unexpectedly NULL field #",
adamc@885:                           string (Int.toString i),
adamc@885:                           string "\");",
adamc@885:                           newline,
adamc@885:                           string "tmp;",
adamc@885:                           newline,
adamc@885:                           string "})"],
adamc@885:                      string " : ",
adamc@885:                      p_unsql t,
adamc@885:                      string ")"]
adamc@885:     in
adamc@885:         getter t
adamc@885:     end
adamc@885: 
adamc@885: fun queryCommon {loc, query, cols, doCols} =
adamc@885:     box [string "int r;",
adamc@885:          newline,
adamc@885: 
adamc@885:          string "sqlite3_reset(stmt);",
adamc@885:          newline,
adamc@885: 
adamc@885:          string "uw_end_region(ctx);",
adamc@885:          newline,
adamc@885:          string "while ((r = sqlite3_step(stmt)) == SQLITE_ROW) {",
adamc@885:          newline,
adamc@885:          doCols p_getcol,
adamc@885:          string "}",
adamc@885:          newline,
adamc@885:          newline,
adamc@885: 
adamc@885:          string "if (r == SQLITE_BUSY) {",
adamc@885:          box [string "sleep(1);",
adamc@885:               newline,
adamc@885:               string "uw_error(ctx, UNLIMITED_RETRY, \"Database is busy\");",
adamc@885:               newline],
adamc@885:          string "}",
adamc@885:          newline,
adamc@885:          newline,
adamc@885: 
adamc@885:          string "if (r != SQLITE_DONE) uw_error(ctx, FATAL, \"",
adamc@885:          string (ErrorMsg.spanToString loc),
adamc@1266:          string ": query step failed: %s<br />%s\", ",
adamc@885:          query,
adamc@885:          string ", sqlite3_errmsg(conn->conn));",
adamc@885:          newline,
adamc@885:          newline]
adamc@885: 
adamc@885: fun query {loc, cols, doCols} =
adamc@885:     box [string "uw_conn *conn = uw_get_db(ctx);",
adamc@885:          newline,
adamc@886:          string "sqlite3_stmt *stmt;",
adamc@885:          newline,
adamc@885:          newline,
adamc@1266:          string "if (sqlite3_prepare_v2(conn->conn, query, -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: %s<br />%s\", sqlite3_errmsg(conn->conn), query);",
adamc@885:          newline,
adamc@885:          newline,
adamc@885:          string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_finalize, stmt);",
adamc@885:          newline,
adamc@885:          newline,
adamc@885: 
adamc@885:          queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query"},
adamc@885: 
adamc@885:          string "uw_pop_cleanup(ctx);",
adamc@885:          newline]
adamc@885: 
adamc@1014: val p_pre_inputs =
adamc@1014:     p_list_sepi (box [])
adamc@1014:                 (fn i => fn t =>
adamc@1014:                             case t of
adamc@1014:                                 Char => box [string "char arg",
adamc@1014:                                              string (Int.toString (i + 1)),
adamc@1014:                                              string "s = {arg",
adamc@1014:                                              string (Int.toString (i + 1)),
adamc@1014:                                              string ", 0};",
adamc@1014:                                              newline]
adamc@1014:                               | _ => box [])
adamc@1014: 
adamc@885: fun p_inputs loc =
adamc@885:     p_list_sepi (box [])
adamc@885:                 (fn i => fn t =>
adamc@885:                             let
adamc@885:                                 fun bind (t, arg) =
adamc@885:                                     case t of
adamc@885:                                         Int => box [string "sqlite3_bind_int64(stmt, ",
adamc@885:                                                     string (Int.toString (i + 1)),
adamc@885:                                                     string ", ",
adamc@885:                                                     arg,
adamc@885:                                                     string ")"]
adamc@885:                                       | Float => box [string "sqlite3_bind_double(stmt, ",
adamc@885:                                                       string (Int.toString (i + 1)),
adamc@885:                                                       string ", ",
adamc@885:                                                       arg,
adamc@1014:                                                       string ")"]
adamc@885:                                       | String => box [string "sqlite3_bind_text(stmt, ",
adamc@885:                                                        string (Int.toString (i + 1)),
adamc@885:                                                        string ", ",
adamc@885:                                                        arg,
adamc@885:                                                        string ", -1, SQLITE_TRANSIENT)"]
adamc@1014:                                       | Char => box [string "sqlite3_bind_text(stmt, ",
adamc@1014:                                                      string (Int.toString (i + 1)),
adamc@1014:                                                      string ", ",
adamc@1014:                                                      arg,
adamc@1014:                                                      string "s, -1, SQLITE_TRANSIENT)"]
adamc@885:                                       | Bool => box [string "sqlite3_bind_int(stmt, ",
adamc@885:                                                      string (Int.toString (i + 1)),
adamc@885:                                                      string ", ",
adamc@885:                                                      arg,
adamc@885:                                                      string ")"]
adamc@887:                                       | Time => box [string "sqlite3_bind_text(stmt, ",
adamc@885:                                                      string (Int.toString (i + 1)),
adam@1359:                                                      string ", uw_Basis_timef(ctx, ",
adam@1352:                                                      string fmt,
adam@1352:                                                      string ", ",
adamc@885:                                                      arg,
adamc@887:                                                      string "), -1, SQLITE_TRANSIENT)"]
adamc@885:                                       | Blob => box [string "sqlite3_bind_blob(stmt, ",
adamc@885:                                                      string (Int.toString (i + 1)),
adamc@885:                                                      string ", ",
adamc@885:                                                      arg,
adamc@885:                                                      string ".data, ",
adamc@885:                                                      arg,
adamc@890:                                                      string ".size, SQLITE_TRANSIENT)"]
adamc@886:                                       | Channel => box [string "sqlite3_bind_int64(stmt, ",
adamc@885:                                                         string (Int.toString (i + 1)),
adamc@886:                                                         string ", ((sqlite3_int64)",
adamc@885:                                                         arg,
adamc@886:                                                         string ".cli << 32) | ",
adamc@886:                                                         arg,
adamc@886:                                                         string ".chn)"]
adamc@885:                                       | Client => box [string "sqlite3_bind_int(stmt, ",
adamc@885:                                                        string (Int.toString (i + 1)),
adamc@885:                                                        string ", ",
adamc@885:                                                        arg,
adamc@885:                                                        string ")"]
adamc@885:                                       | Nullable t => box [string "(",
adamc@885:                                                            arg,
adamc@885:                                                            string " == NULL ? sqlite3_bind_null(stmt, ",
adamc@885:                                                            string (Int.toString (i + 1)),
adamc@885:                                                            string ") : ",
adamc@885:                                                            bind (t, case t of
adamc@885:                                                                         String => arg
adamc@885:                                                                       | _ => box [string "(*", arg, string ")"]),
adamc@885:                                                            string ")"]
adamc@885:                             in
adamc@885:                                 box [string "if (",
adamc@885:                                      bind (t, box [string "arg", string (Int.toString (i + 1))]),
adamc@885:                                      string " != SQLITE_OK) uw_error(ctx, FATAL, \"",
adamc@885:                                      string (ErrorMsg.spanToString loc),
adamc@885:                                      string ": Error binding parameter #",
adamc@885:                                      string (Int.toString (i + 1)),
adamc@885:                                      string ": %s\", sqlite3_errmsg(conn->conn));",
adamc@885:                                      newline]
adamc@885:                             end)
adamc@885: 
adamc@885: fun queryPrepared {loc, id, query, inputs, cols, doCols, nested} =
adamc@885:     box [string "uw_conn *conn = uw_get_db(ctx);",
adamc@885:          newline,
adamc@1014:          p_pre_inputs inputs,
adamc@885:          if nested then
adamc@885:              box [string "sqlite3_stmt *stmt;",
adamc@885:                   newline]
adamc@885:          else
adamc@885:              box [string "sqlite3_stmt *stmt = conn->p",
adamc@885:                   string (Int.toString id),
adamc@885:                   string ";",
adamc@885:                   newline,
adamc@885:                   newline,
adamc@885: 
adamc@885:                   string "if (stmt == NULL) {",
adamc@885:                   newline],
adamc@885: 
adamc@885:          string "if (sqlite3_prepare_v2(conn->conn, \"",
adam@1656:          string (Prim.toCString query),
adamc@885:          string "\", -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: ",
adam@1656:          string (Prim.toCString query),
adamc@1266:          string "<br />%s\", sqlite3_errmsg(conn->conn));",
adamc@885:          newline,
adamc@885:          if nested then
adamc@885:              box [string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_finalize, stmt);",
adamc@885:                   newline]
adamc@885:          else
adamc@885:              box [string "conn->p",
adamc@885:                   string (Int.toString id),
adamc@885:                   string " = stmt;",
adamc@885:                   newline,
adamc@885:                   string "}",
adamc@885:                   newline,
adamc@885:                   newline,
adamc@885:                   string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_clear_bindings, stmt);",
adamc@885:                   newline,
adamc@885:                   string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_reset, stmt);",
adamc@885:                   newline],
adamc@885:          newline,
adamc@885: 
adamc@885:          p_inputs loc inputs,
adamc@885:          newline,
adamc@885: 
adamc@885:          queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
adam@1656:                                                                             string (Prim.toCString query),
adamc@885:                                                                             string "\""]},
adamc@885: 
adamc@885:          string "uw_pop_cleanup(ctx);",
adamc@885:          newline,
adamc@885:          if nested then
adamc@885:              box []
adamc@885:          else
adamc@885:              box [string "uw_pop_cleanup(ctx);",
adamc@885:                   newline]]
adamc@885: 
adam@1293: fun dmlCommon {loc, dml, mode} =
adamc@885:     box [string "int r;",
adamc@885:          newline,
adamc@885: 
adamc@885:          string "if ((r = sqlite3_step(stmt)) == SQLITE_BUSY) {",
adamc@885:          box [string "sleep(1);",
adamc@885:               newline,
adamc@885:               string "uw_error(ctx, UNLIMITED_RETRY, \"Database is busy\");",
adamc@885:               newline],
adamc@885:          string "}",
adamc@885:          newline,
adamc@885:          newline,
adamc@885: 
adam@1293:          string "if (r != SQLITE_DONE) ",
adam@1293:          case mode of
adam@1293:              Settings.Error => box [string "uw_error(ctx, FATAL, \"",
adam@1293:                                     string (ErrorMsg.spanToString loc),
adam@1293:                                     string ": DML step failed: %s<br />%s\", ",
adam@1293:                                     dml,
adam@1293:                                     string ", sqlite3_errmsg(conn->conn));"]
adam@1295:            | Settings.None => string "uw_set_error_message(ctx, sqlite3_errmsg(conn->conn));",
adamc@885:          newline]
adamc@885: 
adam@1293: fun dml (loc, mode) =
adamc@885:     box [string "uw_conn *conn = uw_get_db(ctx);",
adamc@885:          newline,
adamc@886:          string "sqlite3_stmt *stmt;",
adamc@885:          newline,
adamc@885:          newline,
adamc@1266:          string "if (sqlite3_prepare_v2(conn->conn, dml, -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: %s<br />%s\", dml, sqlite3_errmsg(conn->conn));",
adamc@885:          newline,
adamc@885:          newline,
adamc@885:          string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_finalize, stmt);",
adamc@885:          newline,
adamc@885:          newline,
adamc@885: 
adam@1293:          dmlCommon {loc = loc, dml = string "dml", mode = mode},
adamc@885: 
adamc@885:          string "uw_pop_cleanup(ctx);",
adamc@885:          newline]
adamc@885: 
adam@1293: fun dmlPrepared {loc, id, dml, inputs, mode = mode} =
adamc@885:     box [string "uw_conn *conn = uw_get_db(ctx);",
adamc@885:          newline,
adamc@1014:          p_pre_inputs inputs,
adamc@885:          string "sqlite3_stmt *stmt = conn->p",
adamc@885:          string (Int.toString id),
adamc@885:          string ";",
adamc@885:          newline,
adamc@885:          newline,
adamc@885: 
adamc@885:          string "if (stmt == NULL) {",
adamc@885:          newline,
adamc@885:          box [string "if (sqlite3_prepare_v2(conn->conn, \"",
adam@1656:               string (Prim.toCString dml),
adamc@885:               string "\", -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: ",
adam@1656:               string (Prim.toCString dml),
adamc@1266:               string "<br />%s\", sqlite3_errmsg(conn->conn));",
adamc@885:               newline,
adamc@885:               string "conn->p",
adamc@885:               string (Int.toString id),
adamc@885:               string " = stmt;",
adamc@885:               newline],
adamc@885:          string "}",
adamc@885:          newline,
adamc@885: 
adamc@885:          string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_clear_bindings, stmt);",
adamc@885:          newline,
adamc@885:          string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_reset, stmt);",
adamc@885:          newline,
adamc@885: 
adamc@885:          p_inputs loc inputs,
adamc@885:          newline,
adamc@885: 
adamc@885:          dmlCommon {loc = loc, dml = box [string "\"",
adam@1656:                                           string (Prim.toCString dml),
adam@1293:                                           string "\""], mode = mode},
adamc@885: 
adamc@885:          string "uw_pop_cleanup(ctx);",
adamc@885:          newline,
adamc@885:          string "uw_pop_cleanup(ctx);",
adamc@885:          newline]
adamc@885: 
adamc@885: fun nextval {loc, seqE, seqName} =
adamc@885:     box [string "uw_conn *conn = uw_get_db(ctx);",
adamc@885:          newline,
adamc@885:          string "char *insert = ",
adamc@885:          case seqName of
adamc@886:              SOME s => string ("\"INSERT INTO " ^ s ^ " VALUES (NULL)\"")
adamc@885:            | NONE => box [string "uw_Basis_strcat(ctx, \"INSERT INTO \", uw_Basis_strcat(ctx, ",
adamc@885:                           seqE,
adamc@885:                           string ", \" VALUES ()\"))"],
adamc@885:          string ";",
adamc@885:          newline,
adamc@885:          string "char *delete = ",
adamc@885:          case seqName of
adamc@885:              SOME s => string ("\"DELETE FROM " ^ s ^ "\"")
adamc@885:            | NONE => box [string "uw_Basis_strcat(ctx, \"DELETE FROM \", ",
adamc@885:                           seqE,
adamc@885:                           string ")"],
adamc@885:          string ";",
adamc@885:          newline,
adamc@885:          newline,
adamc@885: 
adamc@886:          string "if (sqlite3_exec(conn->conn, insert, NULL, NULL, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"'nextval' INSERT failed: %s\", sqlite3_errmsg(conn->conn));",
adamc@885:          newline,
adamc@885:          string "n = sqlite3_last_insert_rowid(conn->conn);",
adamc@885:          newline,
adamc@886:          string "if (sqlite3_exec(conn->conn, delete, NULL, NULL, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"'nextval' DELETE failed: %s\", sqlite3_errmsg(conn->conn));",
adamc@885:          newline]
adamc@885: 
adamc@885: fun nextvalPrepared _ = raise Fail "SQLite.nextvalPrepared called"
adamc@1073: fun setval _ = raise Fail "SQLite.setval called"
adamc@885: 
adamc@885: fun sqlifyString s = "'" ^ String.translate (fn #"'" => "''"
adam@1285:                                               | #"\000" => ""
adam@1285:                                               | ch => str ch)
adam@1285:                                             s ^ "'"
adamc@885: 
adamc@885: fun p_cast (s, _) = s
adamc@885: 
adamc@885: fun p_blank _ = "?"
adamc@885: 
adamc@885: val () = addDbms {name = "sqlite",
adam@1682:                   randomFunction = "RANDOM",
adam@1464:                   header = Config.sqheader,
adamc@885:                   link = "-lsqlite3",
adamc@885:                   init = init,
adamc@885:                   p_sql_type = p_sql_type,
adamc@885:                   query = query,
adamc@885:                   queryPrepared = queryPrepared,
adamc@885:                   dml = dml,
adamc@885:                   dmlPrepared = dmlPrepared,
adamc@885:                   nextval = nextval,
adamc@885:                   nextvalPrepared = nextvalPrepared,
adamc@1073:                   setval = setval,
adamc@885:                   sqlifyString = sqlifyString,
adamc@885:                   p_cast = p_cast,
adamc@885:                   p_blank = p_blank,
adamc@885:                   supportsDeleteAs = false,
adamc@886:                   supportsUpdateAs = false,
adamc@886:                   createSequence = fn s => "CREATE TABLE " ^ s ^ " (id INTEGER PRIMARY KEY AUTOINCREMENT)",
adamc@885:                   textKeysNeedLengths = false,
adamc@885:                   supportsNextval = false,
adamc@885:                   supportsNestedPrepared = false,
adamc@890:                   sqlPrefix = "",
adamc@1014:                   supportsOctetLength = false,
adamc@1014:                   trueString = "1",
adamc@1196:                   falseString = "0",
adamc@1196:                   onlyUnion = false,
adam@1777:                   nestedRelops = false,
adam@1777:                   windowFunctions = false}
adamc@885: 
adamc@885: end