Mercurial > urweb
changeset 886:5805fa825fe8
Most of demo working with SQLite
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Fri, 17 Jul 2009 17:03:37 -0400 |
| parents | e6070333d8a8 |
| children | 9eb479691d1c |
| files | src/monoize.sml src/mysql.sml src/postgres.sml src/settings.sig src/settings.sml src/sqlite.sml |
| diffstat | 6 files changed, 65 insertions(+), 25 deletions(-) [+] |
line wrap: on
line diff
--- a/src/monoize.sml Fri Jul 17 16:29:36 2009 -0400 +++ b/src/monoize.sml Fri Jul 17 17:03:37 2009 -0400 @@ -1606,19 +1606,35 @@ ((L'.EAbs ("fs", rt, (L'.TFun (s, (L'.TFun (s, s), loc)), loc), (L'.EAbs ("tab", s, (L'.TFun (s, s), loc), (L'.EAbs ("e", s, s, - strcat [sc "UPDATE ", - (L'.ERel 1, loc), - sc " AS T SET ", - strcatComma (map (fn (x, _) => - strcat [sc ("uw_" ^ x - ^ " = "), - (L'.EField - ((L'.ERel 2, - loc), - x), loc)]) - changed), - sc " WHERE ", - (L'.ERel 0, loc)]), loc)), loc)), loc), + if #supportsUpdateAs (Settings.currentDbms ()) then + strcat [sc "UPDATE ", + (L'.ERel 1, loc), + sc " AS T SET ", + strcatComma (map (fn (x, _) => + strcat [sc ("uw_" ^ x + ^ " = "), + (L'.EField + ((L'.ERel 2, + loc), + x), loc)]) + changed), + sc " WHERE ", + (L'.ERel 0, loc)] + else + strcat [sc "UPDATE ", + (L'.ERel 1, loc), + sc " SET ", + strcatComma (map (fn (x, _) => + strcat [sc ("uw_" ^ x + ^ " = "), + (L'.EField + ((L'.ERel 2, + loc), + x), loc)]) + changed), + sc " WHERE ", + (L'.EFfiApp ("Basis", "unAs", [(L'.ERel 0, loc)]), loc)]), + loc)), loc)), loc), fm) end | _ => poly ())
--- a/src/mysql.sml Fri Jul 17 16:29:36 2009 -0400 +++ b/src/mysql.sml Fri Jul 17 17:03:37 2009 -0400 @@ -1446,6 +1446,7 @@ p_cast = p_cast, p_blank = p_blank, supportsDeleteAs = false, + supportsUpdateAs = false, createSequence = fn s => "CREATE TABLE " ^ s ^ " (uw_id INTEGER PRIMARY KEY AUTO_INCREMENT)", textKeysNeedLengths = true, supportsNextval = false,
--- a/src/postgres.sml Fri Jul 17 16:29:36 2009 -0400 +++ b/src/postgres.sml Fri Jul 17 17:03:37 2009 -0400 @@ -890,6 +890,7 @@ p_cast = p_cast, p_blank = p_blank, supportsDeleteAs = true, + supportsUpdateAs = true, createSequence = fn s => "CREATE SEQUENCE " ^ s, textKeysNeedLengths = false, supportsNextval = true,
--- a/src/settings.sig Fri Jul 17 16:29:36 2009 -0400 +++ b/src/settings.sig Fri Jul 17 17:03:37 2009 -0400 @@ -150,6 +150,7 @@ p_cast : string * sql_type -> string, p_blank : int * sql_type -> string (* Prepared statement input *), supportsDeleteAs : bool, + supportsUpdateAs : bool, createSequence : string -> string, textKeysNeedLengths : bool, supportsNextval : bool,
--- a/src/settings.sml Fri Jul 17 16:29:36 2009 -0400 +++ b/src/settings.sml Fri Jul 17 17:03:37 2009 -0400 @@ -340,6 +340,7 @@ p_cast : string * sql_type -> string, p_blank : int * sql_type -> string, supportsDeleteAs : bool, + supportsUpdateAs : bool, createSequence : string -> string, textKeysNeedLengths : bool, supportsNextval : bool, @@ -363,6 +364,7 @@ p_cast = fn _ => "", p_blank = fn _ => "", supportsDeleteAs = false, + supportsUpdateAs = false, createSequence = fn _ => "", textKeysNeedLengths = false, supportsNextval = false,
--- a/src/sqlite.sml Fri Jul 17 16:29:36 2009 -0400 +++ b/src/sqlite.sml Fri Jul 17 17:03:37 2009 -0400 @@ -232,8 +232,14 @@ string (Int.toString i), string ", NULL) != SQLITE_OK) {", newline, - uhoh false ("Error preparing statement: " - ^ String.toString s) [], + box [string "char msg[1024];", + newline, + string "strncpy(msg, sqlite3_errmsg(conn->conn), 1024);", + newline, + string "msg[1023] = 0;", + newline, + uhoh false ("Error preparing statement: " + ^ String.toString s ^ "\\n%s") ["msg"]], string "}", newline] end) @@ -379,7 +385,17 @@ string "b;", newline, string "})"] - | Channel => box [string "sqlite3_column_int64(stmt, ", string (Int.toString i), string ")"] + | Channel => box [string "({", + newline, + string "sqlite3_int64 n = sqlite3_column_int64(stmt, ", + string (Int.toString i), + string ");", + newline, + string "uw_Basis_channel ch = {n >> 32, n & 0xFFFFFFFF};", + newline, + string "ch;", + newline, + string "})"] | Client => box [string "sqlite3_column_int(stmt, ", string (Int.toString i), string ")"] | Nullable _ => raise Fail "Postgres: Recursive Nullable" @@ -469,7 +485,7 @@ fun query {loc, cols, doCols} = box [string "uw_conn *conn = uw_get_db(ctx);", newline, - string "sqlite3 *stmt;", + string "sqlite3_stmt *stmt;", newline, newline, string "if (sqlite3_prepare_v2(conn->conn, query, -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: %s\\n%s\", sqlite3_errmsg(conn->conn));", @@ -522,11 +538,13 @@ string ".data, ", arg, string ".size, SQLITE_TRANSIENT"] - | Channel => box [string "sqlite_bind_int64(stmt, ", + | Channel => box [string "sqlite3_bind_int64(stmt, ", string (Int.toString (i + 1)), - string ", ", + string ", ((sqlite3_int64)", arg, - string ")"] + string ".cli << 32) | ", + arg, + string ".chn)"] | Client => box [string "sqlite3_bind_int(stmt, ", string (Int.toString (i + 1)), string ", ", @@ -629,7 +647,7 @@ fun dml loc = box [string "uw_conn *conn = uw_get_db(ctx);", newline, - string "sqlite3 *stmt;", + string "sqlite3_stmt *stmt;", newline, newline, string "if (sqlite3_prepare_v2(conn->conn, dml, -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: %s\\n%s\", dml, sqlite3_errmsg(conn->conn));", @@ -690,7 +708,7 @@ newline, string "char *insert = ", case seqName of - SOME s => string ("\"INSERT INTO " ^ s ^ " VALUES ()\"") + SOME s => string ("\"INSERT INTO " ^ s ^ " VALUES (NULL)\"") | NONE => box [string "uw_Basis_strcat(ctx, \"INSERT INTO \", uw_Basis_strcat(ctx, ", seqE, string ", \" VALUES ()\"))"], @@ -706,11 +724,11 @@ newline, newline, - string "if (sqlite3_exec(conn->conn, insert, NULL, NULL, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"'nextval' INSERT failed\");", + string "if (sqlite3_exec(conn->conn, insert, NULL, NULL, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"'nextval' INSERT failed: %s\", sqlite3_errmsg(conn->conn));", newline, string "n = sqlite3_last_insert_rowid(conn->conn);", newline, - string "if (sqlite3_exec(conn->conn, delete, NULL, NULL, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"'nextval' DELETE failed\");", + string "if (sqlite3_exec(conn->conn, delete, NULL, NULL, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"'nextval' DELETE failed: %s\", sqlite3_errmsg(conn->conn));", newline] fun nextvalPrepared _ = raise Fail "SQLite.nextvalPrepared called" @@ -744,7 +762,8 @@ p_cast = p_cast, p_blank = p_blank, supportsDeleteAs = false, - createSequence = fn s => "CREATE TABLE " ^ s ^ " (id INTEGER PRIMARY KEY AUTO INCREMENT)", + supportsUpdateAs = false, + createSequence = fn s => "CREATE TABLE " ^ s ^ " (id INTEGER PRIMARY KEY AUTOINCREMENT)", textKeysNeedLengths = false, supportsNextval = false, supportsNestedPrepared = false,