in progress switch to using effects

sqlite/capi.kk

@@ -15,6 +15,26 @@ extern make-sqlite-ok(): int32
   c inline "SQLITE_OK"
 pub val int32/sqlite-ok: int32 = make-sqlite-ok()
 
+extern make-sqlite-open-readonly(): int32 { c inline "SQLITE_OPEN_READONLY" }
+extern make-sqlite-open-readwrite(): int32 { c inline "SQLITE_OPEN_READWRITE" }
+extern make-sqlite-open-readwritecreate(): int32 { c inline "SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE" }
+pub val int32/open-readonly = make-sqlite-open-readonly()
+pub val int32/open-readwrite = make-sqlite-open-readwrite()
+pub val int32/open-readwritecreate = make-sqlite-open-readwritecreate()
+
+extern make-sqlite-open-uri(): int32 { c inline "SQLITE_OPEN_URI" }
+extern make-sqlite-open-sharedcache(): int32 { c inline "SQLITE_OPEN_SHAREDCACHE" }
+extern make-sqlite-open-memory(): int32 { c inline "SQLITE_OPEN_MEMORY" }
+extern make-sqlite-open-exrescode(): int32 { c inline "SQLITE_OPEN_EXRESCODE" }
+extern make-sqlite-open-nomutex(): int32 { c inline "SQLITE_OPEN_NOMUTEX" }
+extern make-sqlite-open-fullmutex(): int32 { c inline "SQLITE_OPEN_FULLMUTEX" }
+pub val int32/open-uri = make-sqlite-open-uri()
+pub val int32/open-sharedcache = make-sqlite-open-sharedcache()
+pub val int32/open-memory = make-sqlite-open-memory()
+pub val int32/open-exrescode = make-sqlite-open-exrescode()
+pub val int32/open-nomutex = make-sqlite-open-nomutex()
+pub val int32/open-fullmutex = make-sqlite-open-fullmutex()
+
 pub extern initialize(): int32
   c inline "sqlite3_initialize()"
 
@@ -53,11 +73,17 @@ pub extern column-count(^stmt: any): int
 
 pub extern column-type(^stmt: any, col: int32): int32
   c "kk_sqlite3_column_type"
-pub extern int32/integer(): int32 { c inline "SQLITE_INTEGER" }
+
-pub extern int32/float(): int32 { c inline "SQLITE_FLOAT" }
+extern make-sqlite-integer(): int32 { c inline "SQLITE_INTEGER" }
-pub extern int32/blob(): int32 { c inline "SQLITE_BLOB" }
+extern make-sqlite-float(): int32 { c inline "SQLITE_FLOAT" }
-pub extern int32/null(): int32 { c inline "SQLITE_NULL" }
+extern make-sqlite-blob(): int32 { c inline "SQLITE_BLOB" }
-pub extern int32/text(): int32 { c inline "SQLITE_TEXT" }
+extern make-sqlite-null(): int32 { c inline "SQLITE_NULL" }
+extern make-sqlite-text(): int32 { c inline "SQLITE_TEXT" }
+pub val int32/integer = make-sqlite-integer()
+pub val int32/float = make-sqlite-float()
+pub val int32/blob = make-sqlite-blob()
+pub val int32/null = make-sqlite-null()
+pub val int32/text = make-sqlite-text()
 
 //TODO(zephyr): waiting on a proper bytes type in koka
 // pub extern column-blob(^stmt: any, col: int32): maybe<bytes>
@@ -75,17 +101,29 @@ pub extern column-text(^stmt: any, col: int32): string
 // pub extern bind-blob(^stmt: any, col: int32, ^value: bytes): int32
 //   c "kk_sqlite3_bind_blob"
 
-pub extern bind-double(^stmt: any, col: int32, ^value: float64): int32
+pub extern bind-double(^stmt: any, param: int32, ^value: float64): int32
   c "kk_sqlite3_bind_double"
 
-pub extern bind-int64(^stmt: any, col: int32, value: int64): int32
+pub extern bind-int64(^stmt: any, param: int32, value: int64): int32
   c "kk_sqlite3_bind_int64"
 
-pub extern bind-null(^stmt: any, col: int32): int32
+pub extern bind-null(^stmt: any, param: int32): int32
   c "kk_sqlite3_bind_null"
 
-pub extern bind-text(^stmt: any, col: int32, ^value: string): int32
+pub extern bind-text(^stmt: any, param: int32, ^value: string): int32
   c "kk_sqlite3_bind_text"
 
-pub extern bind-zeroblob(^stmt: any, col: int32, length: int64): int32
+pub extern bind-zeroblob(^stmt: any, param: int32, length: int64): int32
   c "kk_sqlite3_bind_zeroblob"
+
+pub extern clear-bindings(^stmt: any): int32
+  c "kk_sqlite3_clear_bindings"
+
+pub extern parameter-count(^stmt: any): int32
+  c "kk_sqlite3_parameter_count"
+
+pub extern parameter-name(^stmt: any, param: int32): string
+  c "kk_sqlite3_parameter_name"
+
+pub extern parameter-index(^stmt: any, name: string): int32
+  c "kk_sqlite3_parameter_index"

sqlite/effective.kk

@@ -0,0 +1,167 @@
+// High-level SQLite3 API.
+//
+// This module uses effects to enforce safety invariants;
+// it is not possible to retain a statement beyond the lifetime of a database.
+module sqlite/effective
+
+import std/core/undiv
+import std/num/int32
+import std/num/int64
+import sqlite/capi
+import sqlite/sqlite-result
+
+// Throw an `:ExnSqlite3` if a result code is not `SQLITE_OK` or `SQLITE_OK_LOAD_PERMANENTLY`.
+// `:r` must be a result code produced by SQLite3 and must not be `SQLITE_ROW` or `SQLITE_DONE`.
+fun trusted-check-ok(r: int32, msg: string, ?kk-file-line: string): exn ()
+  // Explicitly check for SQLITE_OK first on the assumption that the single
+  // i32 comparison for the common case is cheaper than the match to convert to
+  // the Koka type.
+  if r != capi/int32/sqlite-ok then
+    val r' = try(fn() r.sqlite-result, fn(exn) impossible(exn.message))
+    match r'
+      Error-Code(code) -> throw(msg, ExnSqlite3(code))
+      Ok -> impossible("got ok after explicit check for ok")
+      Row -> impossible("SQLITE_ROW")
+      Done -> impossible("SQLITE_DONE")
+      // Ok-Load-Permanently is an uncommon case, but it's still a variety of ok.
+      Ok-Load-Permanently -> ()
+
+named scoped effect database<s::S>
+  fun prepare-stmt(sql: sslice, ?persistent: bool, ?disable-vtab: bool, ?disable-log: bool): (any, sslice)
+
+fun with-db(name: db-name, base-flags: int32, sync-mode: sync-mode, vfs: string, action: forall<s> (ev<database<s>>) -> <database<s>,exn|e> a): <exn|e> a
+  val flags = match sync-mode
+    Single-Thread -> base-flags.or(open-exrescode)
+    Multi-Thread -> base-flags.or(open-exrescode).or(open-nomutex)
+    Serialized -> base-flags.or(open-exrescode).or(open-fullmutex)
+  val (conn, r) = match name
+    Filename(path) -> capi/open-v2(path, flags, vfs)
+    URI(uri) -> capi/open-v2(uri, flags.or(open-uri), vfs)
+    Memory-Shared(name) -> capi/open-v2("file:" ++ name ++ "?mode=memory&cache=shared", flags.or(open-uri).or(open-sharedcache).or(open-memory), vfs)
+    Memory -> capi/open-v2(":memory:", flags.or(open-memory), vfs)
+  r.trusted-check-ok("opening database")
+  with finally
+    capi/close(conn).trusted-check-ok("closing database")
+  with db <- named handler
+    fun prepare-stmt(sql: sslice, persistent: bool, disable-vtab: bool, disable-log: bool)
+      val flags' = 0.i32
+        .or(persistent.int32 * 0x01.i32)
+        .or(disable-vtab.int32 * 0x04.i32)
+        .or(disable-log.int32 * 0x10.i32)
+      val (stmt, rest, r') = capi/prepare-v3(conn, sql, flags')
+      if r' != capi/int32/sqlite-ok then
+        val rr = try(fn() r'.sqlite-result, fn(exn) impossible(exn.message))
+        match rr
+          Error-Code(code) -> throw("preparing statement", ExnPrepare(code, sql, capi/error-offset(conn)))
+          t -> impossible(t.show)
+      (stmt, rest)
+  action(db)
+
+// Modes that can be used to name a database to be opened.
+pub type db-name
+  Filename(path: string)
+  URI(uri: string)
+  Memory-Shared(name: string) // in-memory database with shared cache
+  Memory
+
+// Synchronization modes in which to open a database.
+pub type sync-mode
+  Single-Thread // No concurrent use is safe.
+  Multi-Thread // The database is thread-safe, but connections are not.
+  Serialized // The database and connections are always thread-safe.
+
+// Open or create a database in read-write mode.
+//
+// Once `:action` returns, the database is closed automatically.
+// Exceptions are thrown on error when opening or closing the database.
+pub fun open(name: db-name, sync-mode: sync-mode = Serialized, vfs: string = "", action: forall<s> (ev<database<s>>) -> <database<s>,exn|e> a): <exn|e> a
+  with-db(name, capi/int32/open-readwritecreate, sync-mode, vfs, action)
+
+// Open an existing database in read-write mode.
+//
+// Once `:action` returns, the database is closed automatically.
+// Exceptions are thrown on error when opening or closing the database.
+pub fun open-existing(name: db-name, sync-mode: sync-mode = Serialized, vfs: string = "", action: forall<s> (ev<database<s>>) -> <database<s>,exn|e> a): <exn|e> a
+  with-db(name, capi/int32/open-readwrite, sync-mode, vfs, action)
+
+// Open a database in read-only mode.
+//
+// Once `:action` returns, the database is closed automatically.
+// Exceptions are thrown on error when opening or closing the databse.
+pub fun read-only(name: db-name, sync-mode: sync-mode = Serialized, vfs: string = "", action: forall<s> (ev<database<s>>) -> <database<s>,exn|e> a): <exn|e> a
+  with-db(name, capi/int32/open-readonly, sync-mode, vfs, action)
+
+named scoped effect statement<r::S> in database<s>
+  fun stmt-reset(): ()
+  fun bind(bind: list<sql-value>, bind-named: list<(string, sql-value)>): ()
+  fun stmt-step(): int32
+
+// Create a prepared statement.
+//
+// Once `:action` returns, the statement is finalized automatically,
+// which can cause an exception to be thrown.
+pub fun prepare(db: ev<database<s>>, sql: sslice, persistent: bool = False, disable-vtab: bool = False, disable-log: bool = False, action: forall<r> (ev<statement<r>>, sslice) -> <database<s>,statement<r>,exn|e> a): <database<s>,exn|e> a
+  val (cref, rest) = db.prepare-stmt(sql)
+  with finally
+    capi/finalize(cref).trusted-check-ok("finalizing statement")
+  with stmt <- named handler
+    fun stmt-reset() capi/reset(cref).trusted-check-ok("resetting statement")
+    fun bind(bind, bind-named) cref.set-params
+    fun stmt-step() capi/step(cref)
+  action(stmt, rest)
+
+pub type sql-value
+  // Blob(x: bytes)
+  Float(x: float64)
+  Integer(x: int64)
+  Text(x: string)
+  Null
+
+fun set-params(stmt: any, ?bind: list<sql-value>, ?bind-named: list<(string, sql-value)>): exn ()
+  bind.foreach-indexed() fn(i, v)
+    val r = match v
+      Float(x) -> capi/bind-double(stmt, int32(i+1), x)
+      Integer(x) -> capi/bind-int64(stmt, int32(i+1), x)
+      Text(x) -> capi/bind-text(stmt, int32(i+1), x)
+      Null -> capi/bind-null(stmt, int32(i+1))
+    r.trusted-check-ok("binding parameter " ++ show(i+1)) // TODO(zephyr): lazy?
+  bind-named.foreach() fn((name, v))
+    val i = capi/parameter-index(stmt, name)
+    if i == 0.i32 then throw("no parameter named " ++ name.show, ExnRange)
+    val r = match v
+      Float(x) -> capi/bind-double(stmt, i, x)
+      Integer(x) -> capi/bind-int64(stmt, i, x)
+      Text(x) -> capi/bind-text(stmt, i, x)
+      Null -> capi/bind-null(stmt, i)
+    r.trusted-check-ok("binding parameter " ++ name.show)
+
+named scoped effect row<r::S> in statement<s>
+  fun num-column(): int
+  fun column(col: int): sql-value
+  // fun blob(col: int): bytes
+  fun float64(col: int): float64
+  fun int(col: int): int
+  fun text(col: int): string
+  fun null(col: int): bool
+
+fun with-row(stmt: any, action: forall<r> (ev<row<r>>) -> <row<r>|e> a): e a
+  with r <- named handler
+    fun num-column()
+      capi/column-count(stmt)
+    fun column(col)
+      val t = capi/column-type(stmt, col.int32)
+      if t == capi/int32/integer then Integer(capi/column-integer(stmt, col.int32).int64)
+      else if t == capi/int32/float then Float(capi/column-double(stmt, col.int32))
+      // else if t == capi/int32/blob then Blob(capi/column-blob(stmt, col.int32))
+      else if t == capi/int32/text then Text(capi/column-text(stmt, col.int32))
+      // If the DB gives us something unimaginable, pretend it's nothing.
+      else Null
+    fun float64(col)
+      capi/column-double(stmt, col.int32)
+    fun int(col)
+      capi/column-integer(stmt, col.int32)
+    fun text(col)
+      capi/column-text(stmt, col.int32)
+    fun null(col)
+      capi/column-type(stmt, col.int32) == capi/int32/null
+  action(r)

sqlite/sqlite-inline.c

@@ -7,6 +7,8 @@ static inline sqlite3 *borrow_db(kk_box_t cref, kk_context_t *_ctx) {
 
 kk_string_t kk_sqlite3_errstr(int32_t x, kk_context_t *_ctx) {
     const char *s = sqlite3_errstr((int)x);
+    // NOTE(zephyr): kk_string_alloc_from_utf8 calls C stdlib strlen(),
+    // which is not guaranteed to handle a NULL pointer.
     if (s == NULL) {
         return kk_string_empty();
     }
@@ -116,29 +118,54 @@ kk_string_t kk_sqlite3_column_text(kk_box_t cref, int32_t col, kk_context_t *_ct
     return kk_string_alloc_from_qutf8n((kk_ssize_t)len, (const char *)text, _ctx);
 }
 
-int32_t kk_sqlite3_bind_double(kk_box_t cref, int32_t col, double value, kk_context_t *_ctx) {
+int32_t kk_sqlite3_bind_double(kk_box_t cref, int32_t param, double value, kk_context_t *_ctx) {
     sqlite3_stmt *stmt = borrow_stmt(cref, _ctx);
-    return sqlite3_bind_double(stmt, col, value);
+    return sqlite3_bind_double(stmt, param, value);
 }
 
-int32_t kk_sqlite3_bind_int64(kk_box_t cref, int32_t col, int64_t value, kk_context_t *_ctx) {
+int32_t kk_sqlite3_bind_int64(kk_box_t cref, int32_t param, int64_t value, kk_context_t *_ctx) {
     sqlite3_stmt *stmt = borrow_stmt(cref, _ctx);
-    return sqlite3_bind_int64(stmt, col, (sqlite3_int64)value);
+    return sqlite3_bind_int64(stmt, param, (sqlite3_int64)value);
 }
 
-int32_t kk_sqlite3_bind_null(kk_box_t cref, int32_t col, kk_context_t *_ctx) {
+int32_t kk_sqlite3_bind_null(kk_box_t cref, int32_t param, kk_context_t *_ctx) {
     sqlite3_stmt *stmt = borrow_stmt(cref, _ctx);
-    return sqlite3_bind_null(stmt, col);
+    return sqlite3_bind_null(stmt, param);
 }
 
-int32_t kk_sqlite3_bind_text(kk_box_t cref, int32_t col, kk_string_t value, kk_context_t *_ctx) {
+int32_t kk_sqlite3_bind_text(kk_box_t cref, int32_t param, kk_string_t value, kk_context_t *_ctx) {
     sqlite3_stmt *stmt = borrow_stmt(cref, _ctx);
     kk_ssize_t len = 0;
     const char *text = kk_string_cbuf_borrow(value, &len, _ctx);
-    return sqlite3_bind_text64(stmt, col, text, (sqlite3_uint64)len, SQLITE_TRANSIENT, SQLITE_UTF8);
+    return sqlite3_bind_text64(stmt, param, text, (sqlite3_uint64)len, SQLITE_TRANSIENT, SQLITE_UTF8);
 }
 
-int32_t kk_sqlite3_bind_zeroblob(kk_box_t cref, int32_t col, int64_t length, kk_context_t *_ctx) {
+int32_t kk_sqlite3_bind_zeroblob(kk_box_t cref, int32_t param, int64_t length, kk_context_t *_ctx) {
     sqlite3_stmt *stmt = borrow_stmt(cref, _ctx);
-    return sqlite3_bind_zeroblob64(stmt, col, (sqlite3_uint64)length);
+    return sqlite3_bind_zeroblob64(stmt, param, (sqlite3_uint64)length);
+}
+
+int32_t kk_sqlite3_clear_bindings(kk_box_t cref, kk_context_t *_ctx) {
+    sqlite3_stmt *stmt = borrow_stmt(cref, _ctx);
+    return sqlite3_clear_bindings(stmt);
+}
+
+int32_t kk_sqlite3_parameter_count(kk_box_t cref, kk_context_t *_ctx) {
+    sqlite3_stmt *stmt = borrow_stmt(cref, _ctx);
+    return (int32_t)sqlite3_bind_parameter_count(stmt);
+}
+
+kk_string_t kk_sqlite3_parameter_name(kk_box_t cref, int32_t param, kk_context_t *_ctx) {
+    sqlite3_stmt *stmt = borrow_stmt(cref, _ctx);
+    const char *name = sqlite3_bind_parameter_name(stmt, (int)param);
+    if (name == NULL) {
+        return kk_string_empty();
+    }
+    return kk_string_alloc_from_utf8(name, _ctx);
+}
+
+int32_t kk_sqlite3_parameter_index(kk_box_t cref, kk_string_t name, kk_context_t *_ctx) {
+    sqlite3_stmt *stmt = borrow_stmt(cref, _ctx);
+    const char *s = kk_string_cbuf_borrow(name, NULL, _ctx);
+    return (int32_t)sqlite3_bind_parameter_index(stmt, s);
 }

sqlite/sqlite-result.kk

@@ -7,7 +7,7 @@ pub type sqlite-result
   Ok
   Row
   Done
-  Error-Code(code: sqlite-error, pos: int)
+  Error-Code(code: sqlite-error)
   Ok-Load-Permanently
 
 // Error result codes.
@@ -205,7 +205,7 @@ pub fun int32(r: sqlite-result): int32
     Ok -> 0.int32
     Row -> 100.int32
     Done -> 101.int32
-    Error-Code(err, _) -> match err
+    Error-Code(err) -> match err
       Error(Nothing) -> 1.int32
       Error(Just(Error-Missing-Coll-Seq)) -> 257.int32
       Error(Just(Error-Retry)) -> 513.int32
@@ -305,105 +305,105 @@ pub fun int32(r: sqlite-result): int32
 
 // Get the SQLite result corresponding to a result code from the C API.
 // Throws an exception if `r` does not correspond to a valid result.
-pub fun int32/sqlite-result(r: int32, pos: int = -1): exn sqlite-result
+pub fun int32/sqlite-result(r: int32): exn sqlite-result
   match r.int
     0 -> Ok
     256 -> Ok-Load-Permanently
-    1 -> Error-Code(Error(Nothing), pos)
+    1 -> Error-Code(Error(Nothing))
-    257 -> Error-Code(Error(Just(Error-Missing-Coll-Seq)), pos)
+    257 -> Error-Code(Error(Just(Error-Missing-Coll-Seq)))
-    513 -> Error-Code(Error(Just(Error-Retry)), pos)
+    513 -> Error-Code(Error(Just(Error-Retry)))
-    769 -> Error-Code(Error(Just(Error-Snapshot)), pos)
+    769 -> Error-Code(Error(Just(Error-Snapshot)))
-    2 -> Error-Code(Internal(Nothing), pos)
+    2 -> Error-Code(Internal(Nothing))
-    3 -> Error-Code(Perm(Nothing), pos)
+    3 -> Error-Code(Perm(Nothing))
-    4 -> Error-Code(Abort(Nothing), pos)
+    4 -> Error-Code(Abort(Nothing))
-    516 -> Error-Code(Abort(Just(Abort-Rollback)), pos)
+    516 -> Error-Code(Abort(Just(Abort-Rollback)))
-    5 -> Error-Code(Busy(Nothing), pos)
+    5 -> Error-Code(Busy(Nothing))
-    261 -> Error-Code(Busy(Just(Busy-Recovery)), pos)
+    261 -> Error-Code(Busy(Just(Busy-Recovery)))
-    517 -> Error-Code(Busy(Just(Busy-Snapshot)), pos)
+    517 -> Error-Code(Busy(Just(Busy-Snapshot)))
-    773 -> Error-Code(Busy(Just(Busy-Timeout)), pos)
+    773 -> Error-Code(Busy(Just(Busy-Timeout)))
-    6 -> Error-Code(Locked(Nothing), pos)
+    6 -> Error-Code(Locked(Nothing))
-    262 -> Error-Code(Locked(Just(Locked-Shared-Cache)), pos)
+    262 -> Error-Code(Locked(Just(Locked-Shared-Cache)))
-    518 -> Error-Code(Locked(Just(Locked-VTab)), pos)
+    518 -> Error-Code(Locked(Just(Locked-VTab)))
-    7 -> Error-Code(No-Mem(Nothing), pos)
+    7 -> Error-Code(No-Mem(Nothing))
-    8 -> Error-Code(Read-Only(Nothing), pos)
+    8 -> Error-Code(Read-Only(Nothing))
-    264 -> Error-Code(Read-Only(Just(Read-Only-Recovery)), pos)
+    264 -> Error-Code(Read-Only(Just(Read-Only-Recovery)))
-    520 -> Error-Code(Read-Only(Just(Read-Only-Cant-Lock)), pos)
+    520 -> Error-Code(Read-Only(Just(Read-Only-Cant-Lock)))
-    776 -> Error-Code(Read-Only(Just(Read-Only-Rollback)), pos)
+    776 -> Error-Code(Read-Only(Just(Read-Only-Rollback)))
-    1032 -> Error-Code(Read-Only(Just(Read-Only-DB-Moved)), pos)
+    1032 -> Error-Code(Read-Only(Just(Read-Only-DB-Moved)))
-    1288 -> Error-Code(Read-Only(Just(Read-Only-Cant-Init)), pos)
+    1288 -> Error-Code(Read-Only(Just(Read-Only-Cant-Init)))
-    1544 -> Error-Code(Read-Only(Just(Read-Only-Directory)), pos)
+    1544 -> Error-Code(Read-Only(Just(Read-Only-Directory)))
-    9 -> Error-Code(Interrupt(Nothing), pos)
+    9 -> Error-Code(Interrupt(Nothing))
-    10 -> Error-Code(IO-Err(Nothing), pos)
+    10 -> Error-Code(IO-Err(Nothing))
-    266 -> Error-Code(IO-Err(Just(IO-Err-Read)), pos)
+    266 -> Error-Code(IO-Err(Just(IO-Err-Read)))
-    522 -> Error-Code(IO-Err(Just(IO-Err-Short-Read)), pos)
+    522 -> Error-Code(IO-Err(Just(IO-Err-Short-Read)))
-    778 -> Error-Code(IO-Err(Just(IO-Err-Write)), pos)
+    778 -> Error-Code(IO-Err(Just(IO-Err-Write)))
-    1034 -> Error-Code(IO-Err(Just(IO-Err-Fsync)), pos)
+    1034 -> Error-Code(IO-Err(Just(IO-Err-Fsync)))
-    1290 -> Error-Code(IO-Err(Just(IO-Err-Dir-Fsync)), pos)
+    1290 -> Error-Code(IO-Err(Just(IO-Err-Dir-Fsync)))
-    1546 -> Error-Code(IO-Err(Just(IO-Err-Truncate)), pos)
+    1546 -> Error-Code(IO-Err(Just(IO-Err-Truncate)))
-    1802 -> Error-Code(IO-Err(Just(IO-Err-Fstat)), pos)
+    1802 -> Error-Code(IO-Err(Just(IO-Err-Fstat)))
-    2058 -> Error-Code(IO-Err(Just(IO-Err-Unlock)), pos)
+    2058 -> Error-Code(IO-Err(Just(IO-Err-Unlock)))
-    2314 -> Error-Code(IO-Err(Just(IO-Err-Read-Lock)), pos)
+    2314 -> Error-Code(IO-Err(Just(IO-Err-Read-Lock)))
-    2570 -> Error-Code(IO-Err(Just(IO-Err-Delete)), pos)
+    2570 -> Error-Code(IO-Err(Just(IO-Err-Delete)))
-    3082 -> Error-Code(IO-Err(Just(IO-Err-No-Mem)), pos)
+    3082 -> Error-Code(IO-Err(Just(IO-Err-No-Mem)))
-    3338 -> Error-Code(IO-Err(Just(IO-Err-Access)), pos)
+    3338 -> Error-Code(IO-Err(Just(IO-Err-Access)))
-    3594 -> Error-Code(IO-Err(Just(IO-Err-Check-Reserved-Lock)), pos)
+    3594 -> Error-Code(IO-Err(Just(IO-Err-Check-Reserved-Lock)))
-    3850 -> Error-Code(IO-Err(Just(IO-Err-Lock)), pos)
+    3850 -> Error-Code(IO-Err(Just(IO-Err-Lock)))
-    4106 -> Error-Code(IO-Err(Just(IO-Err-Close)), pos)
+    4106 -> Error-Code(IO-Err(Just(IO-Err-Close)))
-    4618 -> Error-Code(IO-Err(Just(IO-Err-Shm-Open)), pos)
+    4618 -> Error-Code(IO-Err(Just(IO-Err-Shm-Open)))
-    4874 -> Error-Code(IO-Err(Just(IO-Err-Shm-Size)), pos)
+    4874 -> Error-Code(IO-Err(Just(IO-Err-Shm-Size)))
-    5386 -> Error-Code(IO-Err(Just(IO-Err-Shm-Map)), pos)
+    5386 -> Error-Code(IO-Err(Just(IO-Err-Shm-Map)))
-    5642 -> Error-Code(IO-Err(Just(IO-Err-Seek)), pos)
+    5642 -> Error-Code(IO-Err(Just(IO-Err-Seek)))
-    5898 -> Error-Code(IO-Err(Just(IO-Err-Delete-No-Ent)), pos)
+    5898 -> Error-Code(IO-Err(Just(IO-Err-Delete-No-Ent)))
-    6154 -> Error-Code(IO-Err(Just(IO-Err-Mmap)), pos)
+    6154 -> Error-Code(IO-Err(Just(IO-Err-Mmap)))
-    6410 -> Error-Code(IO-Err(Just(IO-Err-Get-Temp-Path)), pos)
+    6410 -> Error-Code(IO-Err(Just(IO-Err-Get-Temp-Path)))
-    6666 -> Error-Code(IO-Err(Just(IO-Err-Convpath)), pos)
+    6666 -> Error-Code(IO-Err(Just(IO-Err-Convpath)))
-    6922 -> Error-Code(IO-Err(Just(IO-Err-Vnode)), pos)
+    6922 -> Error-Code(IO-Err(Just(IO-Err-Vnode)))
-    7178 -> Error-Code(IO-Err(Just(IO-Err-Auth)), pos)
+    7178 -> Error-Code(IO-Err(Just(IO-Err-Auth)))
-    7434 -> Error-Code(IO-Err(Just(IO-Err-Begin-Atomic)), pos)
+    7434 -> Error-Code(IO-Err(Just(IO-Err-Begin-Atomic)))
-    7690 -> Error-Code(IO-Err(Just(IO-Err-Commit-Atomic)), pos)
+    7690 -> Error-Code(IO-Err(Just(IO-Err-Commit-Atomic)))
-    7946 -> Error-Code(IO-Err(Just(IO-Err-Rollback-Atomic)), pos)
+    7946 -> Error-Code(IO-Err(Just(IO-Err-Rollback-Atomic)))
-    8202 -> Error-Code(IO-Err(Just(IO-Err-Data)), pos)
+    8202 -> Error-Code(IO-Err(Just(IO-Err-Data)))
-    8458 -> Error-Code(IO-Err(Just(IO-Err-Corrupt-FS)), pos)
+    8458 -> Error-Code(IO-Err(Just(IO-Err-Corrupt-FS)))
-    11 -> Error-Code(Corrupt(Nothing), pos)
+    11 -> Error-Code(Corrupt(Nothing))
-    267 -> Error-Code(Corrupt(Just(Corrupt-Vtab)), pos)
+    267 -> Error-Code(Corrupt(Just(Corrupt-Vtab)))
-    523 -> Error-Code(Corrupt(Just(Corrupt-Sequence)), pos)
+    523 -> Error-Code(Corrupt(Just(Corrupt-Sequence)))
-    779 -> Error-Code(Corrupt(Just(Corrupt-Index)), pos)
+    779 -> Error-Code(Corrupt(Just(Corrupt-Index)))
-    12 -> Error-Code(Not-Found(Nothing), pos)
+    12 -> Error-Code(Not-Found(Nothing))
-    13 -> Error-Code(Full(Nothing), pos)
+    13 -> Error-Code(Full(Nothing))
-    14 -> Error-Code(Cant-Open(Nothing), pos)
+    14 -> Error-Code(Cant-Open(Nothing))
-    526 -> Error-Code(Cant-Open(Just(Cant-Open-Isdir)), pos)
+    526 -> Error-Code(Cant-Open(Just(Cant-Open-Isdir)))
-    782 -> Error-Code(Cant-Open(Just(Cant-Open-Fullpath)), pos)
+    782 -> Error-Code(Cant-Open(Just(Cant-Open-Fullpath)))
-    1038 -> Error-Code(Cant-Open(Just(Cant-Open-Convpath)), pos)
+    1038 -> Error-Code(Cant-Open(Just(Cant-Open-Convpath)))
-    1294 -> Error-Code(Cant-Open(Just(Cant-Open-DirtyWAL)), pos)
+    1294 -> Error-Code(Cant-Open(Just(Cant-Open-DirtyWAL)))
-    1550 -> Error-Code(Cant-Open(Just(Cant-Open-Symlink)), pos)
+    1550 -> Error-Code(Cant-Open(Just(Cant-Open-Symlink)))
-    15 -> Error-Code(Protocol(Nothing), pos)
+    15 -> Error-Code(Protocol(Nothing))
-    17 -> Error-Code(Schema(Nothing), pos)
+    17 -> Error-Code(Schema(Nothing))
-    18 -> Error-Code(Too-Big(Nothing), pos)
+    18 -> Error-Code(Too-Big(Nothing))
-    19 -> Error-Code(Constraint(Nothing), pos)
+    19 -> Error-Code(Constraint(Nothing))
-    275 -> Error-Code(Constraint(Just(Constraint-Check)), pos)
+    275 -> Error-Code(Constraint(Just(Constraint-Check)))
-    531 -> Error-Code(Constraint(Just(Constraint-Commithook)), pos)
+    531 -> Error-Code(Constraint(Just(Constraint-Commithook)))
-    787 -> Error-Code(Constraint(Just(Constraint-Foreignkey)), pos)
+    787 -> Error-Code(Constraint(Just(Constraint-Foreignkey)))
-    1043 -> Error-Code(Constraint(Just(Constraint-Function)), pos)
+    1043 -> Error-Code(Constraint(Just(Constraint-Function)))
-    1299 -> Error-Code(Constraint(Just(Constraint-Notnull)), pos)
+    1299 -> Error-Code(Constraint(Just(Constraint-Notnull)))
-    1555 -> Error-Code(Constraint(Just(Constraint-Primarykey)), pos)
+    1555 -> Error-Code(Constraint(Just(Constraint-Primarykey)))
-    1811 -> Error-Code(Constraint(Just(Constraint-Trigger)), pos)
+    1811 -> Error-Code(Constraint(Just(Constraint-Trigger)))
-    2067 -> Error-Code(Constraint(Just(Constraint-Unique)), pos)
+    2067 -> Error-Code(Constraint(Just(Constraint-Unique)))
-    2323 -> Error-Code(Constraint(Just(Constraint-VTab)), pos)
+    2323 -> Error-Code(Constraint(Just(Constraint-VTab)))
-    2579 -> Error-Code(Constraint(Just(Constraint-Rowid)), pos)
+    2579 -> Error-Code(Constraint(Just(Constraint-Rowid)))
-    2835 -> Error-Code(Constraint(Just(Constraint-Pinned)), pos)
+    2835 -> Error-Code(Constraint(Just(Constraint-Pinned)))
-    3091 -> Error-Code(Constraint(Just(Constraint-Datatype)), pos)
+    3091 -> Error-Code(Constraint(Just(Constraint-Datatype)))
-    20 -> Error-Code(Mismatch(Nothing), pos)
+    20 -> Error-Code(Mismatch(Nothing))
-    21 -> Error-Code(Misuse(Nothing), pos)
+    21 -> Error-Code(Misuse(Nothing))
-    21 -> Error-Code(No-LFS(Nothing), pos)
+    21 -> Error-Code(No-LFS(Nothing))
-    23 -> Error-Code(Auth(Nothing), pos)
+    23 -> Error-Code(Auth(Nothing))
-    279 -> Error-Code(Auth(Just(Auth-User)), pos)
+    279 -> Error-Code(Auth(Just(Auth-User)))
-    25 -> Error-Code(Range(Nothing), pos)
+    25 -> Error-Code(Range(Nothing))
-    26 -> Error-Code(Not-A-DB(Nothing), pos)
+    26 -> Error-Code(Not-A-DB(Nothing))
-    27 -> Error-Code(Notice(Nothing), pos)
+    27 -> Error-Code(Notice(Nothing))
-    283 -> Error-Code(Notice(Just(Notice-Recover-WAL)), pos)
+    283 -> Error-Code(Notice(Just(Notice-Recover-WAL)))
-    539 -> Error-Code(Notice(Just(Notice-Recover-Rollback)), pos)
+    539 -> Error-Code(Notice(Just(Notice-Recover-Rollback)))
-    28 -> Error-Code(Warning(Nothing), pos)
+    28 -> Error-Code(Warning(Nothing))
-    284 -> Error-Code(Warning(Just(Warning-Autoindex)), pos)
+    284 -> Error-Code(Warning(Just(Warning-Autoindex)))
     100 -> Row
     101 -> Done
     v -> throw("invalid SQLite3 result code " ++ v.show, ExnRange)
@@ -412,21 +412,28 @@ pub fun int32/sqlite-result(r: int32, pos: int = -1): exn sqlite-result
 // E.g., `Constraint(Just(Constraint-Unique))` is converted to `Constraint(Nothing)`.
 pub fun primary(r: sqlite-result): sqlite-result
   match r
-    Error-Code(Error(Just(_)), pos) -> Error-Code(Error(Nothing), pos)
+    Error-Code(Error(Just(_))) -> Error-Code(Error(Nothing))
-    Error-Code(Abort(Just(_)), pos) -> Error-Code(Abort(Nothing), pos)
+    Error-Code(Abort(Just(_))) -> Error-Code(Abort(Nothing))
-    Error-Code(Busy(Just(_)), pos) -> Error-Code(Busy(Nothing), pos)
+    Error-Code(Busy(Just(_))) -> Error-Code(Busy(Nothing))
-    Error-Code(Locked(Just(_)), pos) -> Error-Code(Locked(Nothing), pos)
+    Error-Code(Locked(Just(_))) -> Error-Code(Locked(Nothing))
-    Error-Code(Read-Only(Just(_)), pos) -> Error-Code(Read-Only(Nothing), pos)
+    Error-Code(Read-Only(Just(_))) -> Error-Code(Read-Only(Nothing))
-    Error-Code(IO-Err(Just(_)), pos) -> Error-Code(IO-Err(Nothing), pos)
+    Error-Code(IO-Err(Just(_))) -> Error-Code(IO-Err(Nothing))
-    Error-Code(Corrupt(Just(_)), pos) -> Error-Code(Corrupt(Nothing), pos)
+    Error-Code(Corrupt(Just(_))) -> Error-Code(Corrupt(Nothing))
-    Error-Code(Cant-Open(Just(_)), pos) -> Error-Code(Cant-Open(Nothing), pos)
+    Error-Code(Cant-Open(Just(_))) -> Error-Code(Cant-Open(Nothing))
-    Error-Code(Constraint(Just(_)), pos) -> Error-Code(Constraint(Nothing), pos)
+    Error-Code(Constraint(Just(_))) -> Error-Code(Constraint(Nothing))
-    Error-Code(Auth(Just(_)), pos) -> Error-Code(Auth(Nothing), pos)
+    Error-Code(Auth(Just(_))) -> Error-Code(Auth(Nothing))
-    Error-Code(Notice(Just(_)), pos) -> Error-Code(Notice(Nothing), pos)
+    Error-Code(Notice(Just(_))) -> Error-Code(Notice(Nothing))
-    Error-Code(Warning(Just(_)), pos) -> Error-Code(Warning(Nothing), pos)
+    Error-Code(Warning(Just(_))) -> Error-Code(Warning(Nothing))
     Ok-Load-Permanently -> Ok
     r -> r
 
 // Get the message corresponding to a result code.
 pub fun show(r: sqlite-result): string
   capi/errstr(r.int32)
+
+pub extend type exception-info
+  // Generic exceptions from SQLite3.
+  ExnSqlite3(code: sqlite-error)
+  // Exceptions from preparing SQL statements.
+  // The error may not be due to the SQL text, and therefore the `:pos` may be `-1`.
+  ExnPrepare(code: sqlite-error, stmt: sslice, pos: int)

sqlite/sqlite3.kk

@@ -1,7 +1,7 @@
 // Low level wrapper around a modern subset of the SQLite3 API.
 //
 // Using this module involves manual resource management.
-// 
+// Statements must be finalized and databases must be closed.
 module sqlite/sqlite3
 
 import sqlite/capi
@@ -143,10 +143,10 @@ pub type sqlite3-type
 // The leftmost column is numbered 0.
 pub fun statment/column-type(stmt: statement, col: int): sqlite3-type
   val t = capi/column-type(stmt.cref, col.int32)
-  if t == int32/integer() then Integer
+  if t == capi/int32/integer then Integer
-  else if t == int32/float() then Float
+  else if t == capi/int32/float then Float
-  else if t == int32/blob() then Blob
+  else if t == capi/int32/blob then Blob
-  else if t == int32/text() then Text
+  else if t == capi/int32/text then Text
   // If the DB gives us something unimaginable, pretend it's nothing.
   else Null
 
@@ -169,17 +169,45 @@ pub fun statement/int(stmt: statement, col: int): int
 pub fun statement/text(stmt: statement, col: int): string
   capi/column-text(stmt.cref, col.int32)
 
-pub fun statement/bind-float64(stmt: statement, col: int, value: float64): sqlite-result
+// Bind a float64 value to a statement parameter.
-  capi/bind-double(stmt.cref, col.int32, value).trusted-result
+// The first pararmeter number is 1.
+pub fun statement/bind-float64(stmt: statement, param: int, value: float64): sqlite-result
+  capi/bind-double(stmt.cref, param.int32, value).trusted-result
 
-pub fun statement/bind-int64(stmt: statement, col: int, value: int64): sqlite-result
+// Bind an int64 value to a statement parameter.
-  capi/bind-int64(stmt.cref, col.int32, value).trusted-result
+// The first parameter number is 1.
+pub fun statement/bind-int64(stmt: statement, param: int, value: int64): sqlite-result
+  capi/bind-int64(stmt.cref, param.int32, value).trusted-result
 
-pub fun statement/bind-null(stmt: statement, col: int): sqlite-result
+// Bind NULL to a statement parameter.
-  capi/bind-null(stmt.cref, col.int32).trusted-result
+// The first parameter number is 1.
+pub fun statement/bind-null(stmt: statement, param: int): sqlite-result
+  capi/bind-null(stmt.cref, param.int32).trusted-result
 
-pub fun statement/bind-text(stmt: statement, col: int, value: string): sqlite-result
+// Bind a string to a statement parameter.
-  capi/bind-text(stmt.cref, col.int32, value).trusted-result
+// The first parameter number is 1.
+pub fun statement/bind-text(stmt: statement, param: int, value: string): sqlite-result
+  capi/bind-text(stmt.cref, param.int32, value).trusted-result
 
-pub fun statement/bind-zeroblob(stmt: statement, col: int, length: int64): sqlite-result
+// Bind a BLOB value initialized to `length` zeros to a statement parameter.
-  capi/bind-zeroblob(stmt.cref, col.int32, length).trusted-result
+// The first parameter number is 1.
+pub fun statement/bind-zeroblob(stmt: statement, param: int, length: int64): sqlite-result
+  capi/bind-zeroblob(stmt.cref, param.int32, length).trusted-result
+
+// Set all bound parameters to NULL.
+pub fun statement/clear-bindings(stmt: statement): sqlite-result
+  capi/clear-bindings(stmt.cref).trusted-result
+
+// Get the number of bindable parameters in the statement.
+pub fun statement/param-count(stmt: statement): int
+  capi/parameter-count(stmt.cref).int
+
+// Get the name of a parameter.
+// The first parameter number is 1.
+pub fun statement/param-name(stmt: statement, param: int): string
+  capi/parameter-name(stmt.cref, param.int32)
+
+// Get the index of the parameter with the given name.
+// The result is suitable to pass to bind functions.
+pub fun statement/param-index(stmt: statement, name: string): int
+  capi/parameter-index(stmt.cref, name).int

test/test.kk

@@ -10,17 +10,17 @@ tail fun do-while(f: () -> <div|e> maybe<a>): <div|e> a
     Nothing -> do-while(f)
     Just(r) -> r
 
-fun stmt(db: sqlite3, sql: string, bind: maybe<string> = Nothing)
+fun stmt(db: sqlite3, sql: string, bind: list<(string, string)> = Nil)
   println(sql)
   match db.prepare(sql.slice)
     Left(r-prep) -> println("  prepare result: " ++ r-prep.show)
     Right((stmt, rest)) ->
       println("  prepare remainder: " ++ rest.show)
-      match bind
+      println("  param count: " ++ stmt.param-count.show)
-        Nothing -> ()
+      bind.foreach() fn((name, text))
-        Just(text) -> 
+        val idx = stmt.param-index(name)
-          val r = stmt.bind-text(1, text)
+        val r = stmt.bind-text(idx, text)
-          println("  bind result: " ++ r.show)
+        println("  bind " ++ name ++ " result: " ++ r.show)
       val r-step = do-while
         val r = stmt.step
         match r
@@ -29,7 +29,7 @@ fun stmt(db: sqlite3, sql: string, bind: maybe<string> = Nothing)
               println("    col " ++ i.show ++ ": " ++ stmt.text(i))
             Nothing
           r -> Just(r)
-      println("  final step result:     " ++ r-step.show)
+      println("  final step result: " ++ r-step.show)
       val r-fin = stmt.finalize
       println("  finalize result: " ++ r-fin.show)
 
@@ -39,7 +39,7 @@ pub fun main()
   println("open result: " ++ r-open.show)
   stmt(db, "DROP TABLE IF EXISTS koka; -- reset previous test runs")
   stmt(db, "CREATE TABLE koka(v TEXT NOT NULL)")
-  stmt(db, "INSERT INTO koka VALUES (?);", Just("value inserted from koka"))
+  stmt(db, "INSERT INTO koka VALUES (?1);", [("?1", "value inserted from koka")])
   stmt(db, "SELECT * FROM koka")
   val r-close = db.close
   println("close result: " ++ r-close.show)