sqlite3.carp

(relative-include "sqlite3_helper.h")
(add-cflag "-lsqlite3")

(doc SQLite3 "is a simple high-level wrapper around SQLite3. It doesn’t intend
to wrap everything, but it tries to be useful.

## Installation

```clojure
(load \"git@veitheller.de:git/carpentry/sqlite3.git@0.2.0\")
```

## Usage

The module `SQLite3` provides facilities for opening, closing, and querying
databases.

```clojure
(load \"git@veitheller.de:git/carpentry/sqlite3.git@0.2.0\")

; opening DBs can fail, for the purposes of this example we
; ignore that
(defn main []
  (let-do [db (Result.unsafe-from-success (SQLite3.open \"db\"))]
    ; Let's make sure our table is there
    (ignore
       (SQLite3.query &db
                      \"CREATE TABLE IF NOT EXISTS mytable (name TEXT, age INT)\"
                      &[]))

    ; we can prepare statements
    (ignore
       (SQLite3.query &db
                      \"INSERT INTO mytable VALUES (?1, ?2);\"
                      &[(to-sqlite3 @\"Carp\") (to-sqlite3 4)]))

    ; and query things
    (println* &(SQLite3.query &db \"SELECT * from mytable;\" &[]))
    (SQLite3.close db)))
```

Because `open` and `query` return `Result` types, we could also use
combinators!")
(defmodule SQLite3
  (private sql_ok)
  (hidden sql_ok)
  (register sql_ok Int "SQLITE_OK")
  (private sql_int)
  (hidden sql_int)
  (register sql_int Int "SQLITE_INTEGER")
  (private sql_double)
  (hidden sql_double)
  (register sql_double Int "SQLITE_FLOAT")
  (private sql_text)
  (hidden sql_text)
  (register sql_text Int "SQLITE_TEXT")
  (private sql_blob)
  (hidden sql_blob)
  (register sql_blob Int "SQLITE_BLOB")

  (doc SQLite "is the opaque database type. You’ll need one of those to query
anything.

It can be obtained by using [open](#open).")
  (register-type SQLite)

  (doc Type "represent all the SQLite types we can represent.

The constructors are `Null`, `Integer`, `Floating`, `Text`, and `Blob`. Most
primitive Carp types can be casted to appropriate SQLite types by using the
`to-sqlite3` interface.")
  (deftype Type
    (Null [])
    (Integer [Long])
    (Floating [Double])
    (Text [String])
    (Blob [(Array Byte)]))

  (private SQLiteColumn)
  (hidden SQLiteColumn)
  (register-type SQLiteColumn)

  (defmodule Type
    (defmodule SQLiteColumn
      (register nil (Fn [] SQLiteColumn) "SQLiteColumn_nil")
      (register int (Fn [Long] SQLiteColumn) "SQLiteColumn_int")
      (register float (Fn [Double] SQLiteColumn) "SQLiteColumn_float")
      (register text (Fn [String] SQLiteColumn) "SQLiteColumn_text")
      (register blob (Fn [(Array Byte)] SQLiteColumn) "SQLiteColumn_blob"))

    (defn = [a b]
      (match-ref a
        (Null) (match-ref b (Null) true _ false)
        (Integer ai) (match-ref b (Integer bi) (= ai bi) _ false)
        (Floating af) (match-ref b (Floating bf) (= af bf) _ false)
        (Text as) (match-ref b (Text bs) (= as bs) _ false)
        (Blob ab) (match-ref b (Blob bb) (= ab bb) _ false)))
    (implements = SQLite3.Type.=)

    (defn prn [s] (SQLite3.Type.str s))
    (implements prn SQLite3.Type.prn)

    (defn to-sqlite3-internal [x]
      (match x
        (Null) (SQLiteColumn.nil)
        (Integer i) (SQLiteColumn.int i)
        (Floating f) (SQLiteColumn.float f)
        (Text s) (SQLiteColumn.text s)
        (Blob s) (SQLiteColumn.blob s))))

  (defmodule SQLiteColumn
    (register tag (Fn [&SQLiteColumn] Int) "SQLiteColumn_tag")

    (register from-integer (Fn [SQLiteColumn] Long) "SQLiteColumn_from_int")
    (register from-floating (Fn [SQLiteColumn] Double) "SQLiteColumn_from_float")
    (register from-text (Fn [SQLiteColumn] String) "SQLiteColumn_from_str")
    (register from-blob
      (Fn [SQLiteColumn] (Array Byte))
      "SQLiteColumn_from_blob")

    (register delete (Fn [SQLiteColumn] ()))
    (implements delete SQLite3.SQLiteColumn.delete)
    (register copy (Fn [&SQLiteColumn] SQLiteColumn))
    (implements copy SQLite3.SQLiteColumn.copy)

    (defn to-carp [c]
      (case (tag &c)
            sql_int
            (Type.Integer (from-integer c))
            sql_double
            (Type.Floating (from-floating c))
            sql_text
            (Type.Text (from-text c))
            sql_blob
            (Type.Blob (from-blob c))
            (Type.Null))))

  (private SQLiteRow)
  (hidden SQLiteRow)
  (register-type SQLiteRow)
  (defmodule SQLiteRow
    (register length (Fn [&SQLiteRow] Int) "SQLiteRow_length")
    (register nth (Fn [&SQLiteRow Int] SQLiteColumn) "SQLiteRow_nth")

    (defn to-carp [r]
      (let-do [l (length &r)
               a (Array.allocate l)]
        (for [i 0 l]
          (Array.aset-uninitialized! &a i (SQLiteColumn.to-carp (nth &r i))))
        a)))

  (private SQLiteRes)
  (hidden SQLiteRes)
  (register-type SQLiteRes)
  (defmodule SQLiteRes
    (register ok? (Fn [&SQLiteRes] Bool) "SQLiteRes_is_ok")
    (register length (Fn [&SQLiteRes] Int) "SQLiteRes_length")
    (register nth (Fn [&SQLiteRes Int] SQLiteRow) "SQLiteRes_nth")
    (register error (Fn [SQLiteRes] String) "SQLiteRes_error")
    (register delete (Fn [SQLiteRes] ()))
    (implements delete SQLite3.SQLiteRes.delete)

    (defn to-array [r]
      (let-do [l (length &r)
               a (Array.allocate l)]
        (for [i 0 l]
          (Array.aset-uninitialized! &a i (SQLiteRow.to-carp (nth &r i))))
        a)))

  (private init)
  (hidden init)
  (register init (Fn [] SQLite))
  (private open-)
  (hidden open-)
  (register open- (Fn [&SQLite (Ptr CChar)] Int) "SQLite3_open_c")
  (private exec-)
  (hidden exec-)
  (register exec-
    (Fn [&SQLite (Ptr CChar) &(Array SQLiteColumn)] SQLiteRes)
    "SQLite3_exec_c")
  (private error-)
  (hidden error-)
  (register error- (Fn [SQLite] String) "SQLite3_error_and_close")

  (doc open "opens a database with the filename `s`.

If it fails, we return an error message using `Result.Error`.")
  (defn open [s]
    (let [db (SQLite3.init)
          res (open- &db (cstr s))]
      (if (= res sql_ok) (Result.Success db) (Result.Error (error- db)))))

  (doc query "queries the database `db` using the query `s` and the parameters
`p`.

If it fails, we return an error message using `Result.Error`.")
  (defn query [db s p]
    (let [r (exec- db
                   (cstr s)
                   &(Array.copy-map &(fn [x] (Type.to-sqlite3-internal @x)) p))]
      (if (SQLiteRes.ok? &r)
        (Result.Success (SQLiteRes.to-array r))
        (Result.Error (SQLiteRes.error r)))))

  (doc close "closes a database.")
  (register close (Fn [SQLite] ()) "SQLite3_close_c")

  (doc Stmt "is an opaque prepared statement type. Prepare once with
[prepare](#prepare), execute with [exec-prepared](#exec-prepared), and
release with [finalize-stmt](#finalize-stmt).")
  (register-type Stmt)

  (private stmt-init)
  (hidden stmt-init)
  (register stmt-init (Fn [] Stmt) "SQLite3_stmt_init")
  (private errmsg)
  (hidden errmsg)
  (register errmsg (Fn [&SQLite] String) "SQLite3_errmsg_c")
  (private exec-prepared-)
  (hidden exec-prepared-)
  (register exec-prepared-
    (Fn [&Stmt &(Array SQLiteColumn)] SQLiteRes)
    "SQLite3_exec_prepared_c")
  (private prepare-)
  (hidden prepare-)
  (register prepare- (Fn [&SQLite (Ptr CChar) &Stmt] Int) "SQLite3_prepare_c")

  (doc prepare "prepares a SQL statement for repeated execution via
[exec-prepared](#exec-prepared). Release with [finalize-stmt](#finalize-stmt)
when done.")
  (defn prepare [db sql]
    (let [stmt (stmt-init)
          res (prepare- db (cstr sql) &stmt)]
      (if (= res sql_ok) (Result.Success stmt) (Result.Error (errmsg db)))))

  (doc exec-prepared "executes a prepared statement with the given parameters.
Automatically resets the statement afterward for reuse.")
  (defn exec-prepared [stmt p]
    (let [r (exec-prepared- stmt
                            &(Array.copy-map &(fn [x]
                                               (Type.to-sqlite3-internal @x))
                                             p))]
      (if (SQLiteRes.ok? &r)
        (Result.Success (SQLiteRes.to-array r))
        (Result.Error (SQLiteRes.error r)))))

  (doc reset-stmt "manually resets a prepared statement and clears its bindings.
Called automatically by [exec-prepared](#exec-prepared).")
  (register reset-stmt (Fn [&Stmt] ()) "SQLite3_reset_stmt_c")

  (doc finalize-stmt "releases a prepared statement’s resources. Must not be
used afterward.")
  (register finalize-stmt (Fn [Stmt] ()) "SQLite3_finalize_stmt_c")

  (doc last-insert-rowid "returns the row ID of the last successful INSERT.")
  (register last-insert-rowid (Fn [&SQLite] Long) "SQLite3_last_insert_rowid")

  (doc changes "returns the number of rows modified by the last INSERT, UPDATE,
or DELETE.")
  (register changes (Fn [&SQLite] Int) "SQLite3_changes")

  (doc begin "begins a transaction.")
  (defn begin [db]
    (match (query db "BEGIN TRANSACTION;" &[])
      (Result.Success _) (Result.Success ())
      (Result.Error e) (Result.Error e)))

  (doc commit "commits the current transaction.")
  (defn commit [db]
    (match (query db "COMMIT;" &[])
      (Result.Success _) (Result.Success ())
      (Result.Error e) (Result.Error e)))

  (doc rollback "rolls back the current transaction.")
  (defn rollback [db]
    (match (query db "ROLLBACK;" &[])
      (Result.Success _) (Result.Success ())
      (Result.Error e) (Result.Error e)))

  (doc with-transaction "executes `body` inside a transaction. Rolls back on
`Result.Error`, commits on success.")
  (defmacro with-transaction [db body]
    (list 'let
          (array '__wtx_begin (list 'SQLite3.begin db))
          (list 'match
                '__wtx_begin
                (list 'Result.Error '__wtx_err)
                (list 'Result.Error '__wtx_err)
                (list 'Result.Success '_)
                (list 'let
                      (array '__wtx_result body)
                      (list 'match
                            '__wtx_result
                            (list 'Result.Error '__wtx_berr)
                            (list 'do
                                  (list 'ignore (list 'SQLite3.rollback db))
                                  (list 'Result.Error '__wtx_berr))
                            (list 'Result.Success '__wtx_val)
                            (list 'match
                                  (list 'SQLite3.commit db)
                                  (list 'Result.Error '__wtx_cerr)
                                  (list 'do
                                        (list 'ignore
                                              (list 'SQLite3.rollback db))
                                        (list 'Result.Error '__wtx_cerr))
                                  (list 'Result.Success '_)
                                  (list 'Result.Success '__wtx_val)))))))

  (doc with-prepared "prepares `sql` on the database `db`, binds the resulting
statement to `stmt`, evaluates `body`, and finalizes the statement on every
exit path — including when `body` short-circuits.

Like the body of [with-transaction](#with-transaction), `body` must evaluate to
a `Result`. The whole form returns the prepare error if the statement can’t be
prepared, otherwise the `Result` that `body` produced. A failed prepare and an
error the body returns are both `Result.Error String`, so a caller can’t tell
them apart by type.

```
(SQLite3.with-prepared [stmt &db \"INSERT INTO t VALUES (?1, ?2)\"]
  (do
    (for [i 0 100]
      (ignore (SQLite3.exec-prepared &stmt (SQLite3.params i @\"row\"))))
    (Result.Success ())))
```")
  (defmacro with-prepared [binding body]
    (let [stmt (car binding)
          db (cadr binding)
          sql (car (cddr binding))]
      (list 'match
            (list 'SQLite3.prepare db sql)
            (list 'Result.Error '__wp_err)
            (list 'Result.Error '__wp_err)
            (list 'Result.Success stmt)
            (list 'let-do
                  (array '__wp_res body)
                  (list 'SQLite3.finalize-stmt stmt)
                  '__wp_res))))

  (doc params "wraps each argument in `to-sqlite3` and returns a reference to
the resulting parameter array, ready to hand to [query](#query) or
[exec-prepared](#exec-prepared).

`(SQLite3.params id @\"name\")` expands to
`&[(to-sqlite3 id) (to-sqlite3 @\"name\")]`, removing the per-argument
`to-sqlite3` ceremony. Values that are already a `SQLite3.Type` — such as
`(SQLite3.Type.Null)` or a `Blob` — pass straight through, so they can be mixed
in with primitives.")
  (defmacro params [:rest args]
    (list 'ref (collect-into (map (fn [a] (list 'to-sqlite3 a)) args) array))))

(definterface to-sqlite3 (Fn [a] SQLite3.Type))

(defmodule Bool
  (defn to-sqlite3 [b] (SQLite3.Type.Integer (if b 1l 0l)))
  (implements to-sqlite3 Bool.to-sqlite3))

(defmodule Int
  (defn to-sqlite3 [i] (SQLite3.Type.Integer (Long.from-int i)))
  (implements to-sqlite3 Int.to-sqlite3))

(defmodule Long
  (defn to-sqlite3 [l] (SQLite3.Type.Integer l))
  (implements to-sqlite3 Long.to-sqlite3))

(defmodule Float
  (defn to-sqlite3 [f] (SQLite3.Type.Floating (Double.from-float f)))
  (implements to-sqlite3 Float.to-sqlite3))

(defmodule Double
  (defn to-sqlite3 [d] (SQLite3.Type.Floating d))
  (implements to-sqlite3 Double.to-sqlite3))

(defmodule String
  (defn to-sqlite3 [s] (SQLite3.Type.Text s))
  (implements to-sqlite3 String.to-sqlite3))

(defmodule SQLite3
  (defmodule Type
    (doc to-sqlite3 "is the identity on values that are already a
`SQLite3.Type`, so pre-built `Null` and `Blob` values flow through
[params](#params) next to primitives.")
    (sig to-sqlite3 (Fn [SQLite3.Type] SQLite3.Type))
    (defn to-sqlite3 [t] t)
    (implements to-sqlite3 SQLite3.Type.to-sqlite3)))