mclements / mercury-sqlite3

Mercury module for sqlite3 (based on wangp's sqlite3 module in the pushpull library)

mercury-sqlite3: Mercury module for SQLite

Introduction

The sqlite3 module is a modest extension of the =pushpull.sqlite3= module from the =pushpull= module by Peter Wang. The original module by Peter included:

• Opening and closing databases (with options)
• Transactions
• Execution of SQL statements
• Prepared SQL statements
• Binding statements
• Stepping through statements
• Reset and finalize statements
• Reading results from executed statements
• Some high-level with constructs, including aggregators.

The extensions include:

• A new sum type data_type for the output (replacing bind_value), with a more general column predicate
• Some predicates to work with the with constructs
• Some additional information predicates, including column_count, column_name, data_count, db_handle and column_type_id
• write_table predicate
• read_query predicate
• Utilities and types to create user-defined functions, including create_sqlite3_function

Some details

data_type type

Rows are represented as list(data_type). The type data_type is defined by:

:- type data_type
   --->  null
   ;     int(int)
   ;     float(float)
   ;     text(string)
   ;     blob(c_pointer, int).

Examples of the values returned by read_query are given in the test example below.

Creating user-defined SQLite functions

The main predicate create_sqlite3_function(Db, SqlName, Func, Failure, !IO), where Db is the database, SqlName is a string for the name of the aggregate, Func is a C pointer to the SQLite function, Failure is the output string for whether the operation failed, and !IO is for input/output.

:- pred create_sqlite3_function(db(_)::in, string::in, sqlite3_function::in,
				string::out, io::di, io::uo) is det.

The main challenge is how to define the SQLite function. This can be defined in C and then return a pointer to Mercury for that function. Alternatively, the function can be defined in Mercury, exported to C and then a pointer to that function can be used. Examples of each are given in the test code below.

Test example

:- module test_sqlite3.

:- interface.
:- import_module io.

:- pred main(io::di, io::uo) is det.

:- implementation.
:- import_module sqlite3, maybe, list, pair, float, string, bool.

main(!IO) :-
    test(!IO).

:- func maybe_string(data_type) = maybe(string).
maybe_string(Value) = (if Value = text(String) then yes(String) else no).
:- func maybe_float(data_type) = maybe(float).
maybe_float(Value) = (if Value = float(Float) then yes(Float) else no).
:- func maybe_int(data_type) = maybe(int).
maybe_int(Value) = (if Value = int(Int) then yes(Int) else no).

:- func maybe_null(data_type) = maybe(data_type).
maybe_null(Value) = (if Value = null then yes(null) else no).

%% :- func read3(list(data_type)) = {maybe(string), maybe(int), maybe(float)}.
%% read3(Value) =
%% (if Value = [A,B,C] then {maybe_string(A),maybe_int(B),maybe_float(C)} else {no,no,no}).

:- type r ---> r(string,int,float).
:- func read3(list(data_type)) = maybe(r).
read3(Value) =
(if Value = [text(A),int(B),float(C)] then yes(r(A,B,C)) else no).

:- pred test(io::di, io::uo) is det.
test(!IO) :-
    open_rw(":memory:", normal, MaybeDb, !IO),
    (MaybeDb = ok(Db) ->
	 (
	     Data = map(func(I) = [text("a"), float(float.float(I))], 1..5),
	     write_table(Db, "temp", ["s", "x"], Data, !IO),
	     read_query(Db, "select * from temp", Headers0, Output0, !IO),
	     print_line(Headers0, !IO),
	     print_line(Output0, !IO),
	     Data2 = append(map(func(I) = [text("Östersund"), float(float.float(I))], 1..500),
			    map(func(I) = [text("Göteborg"), float(float.float(I))], 1..1000)),
	     write_table(Db, "temp2", ["s", "x"], Data2, !IO),
	     create_sqlite3_function(Db, "identity", c_noopfunc, _, !IO),
	     create_sqlite3_function(Db, "identity2", c_noopfunc2, _, !IO),
	     create_sqlite3_function(Db, "identity3", c_noopfunc3, _, !IO),
	     create_sqlite3_function(Db, "mysum", c_mysum, c_myfinal, _, !IO),
	     Sql = "select s, count(*), sum(identity(x)) from temp2 group by s",
	     read_query(Db, Sql, Headers, Output, !IO),
	     print_line(Headers, !IO),
	     print_line(Output, !IO),
	     Sql2 = "select identity3(s), count(*), mysum(identity2(x)) from temp2 group by s",
	     read_query(Db, Sql2, Headers2, Output2, !IO),
	     print_line(Headers2, !IO),
	     Out2 = (ok(Out) = Output2 -> map(read3, Out) ; []),
	     print_line(Out2, !IO)
	 ),
	 close(Db, !IO)
    ;
    print_line("failed to open the database", !IO)).


%-----------------------------------------------------------------------------%
% User-defined functions

%% hlc.gc grade requires that sqlite3.h be included again (otherwise: unknown type names)
:- pragma foreign_decl("C", "
    #include <sqlite3.h>
").

%% The following code creates an "identity" function in SQLite
%% create_sqlite3_function <- noopfunc (C+ptr)
:- pragma foreign_code("C", "
static void noopfunc(sqlite3_context *context, int argc, sqlite3_value **argv) {
  assert( argc==1 );
  sqlite3_result_value(context, argv[0]);
}
").
:- func c_noopfunc = sqlite3_function.
:- pragma foreign_proc("C", c_noopfunc = (Ptr::out),
		       [thread_safe, promise_pure],
		       "Ptr = noopfunc;").

%% create_sqlite3_function <- noopfunc2 (foreign_export+ptr) <- noopfunc2 (impure pred)
:- impure pred noopfunc2(context::in, int32::in, sqlite3_value_array::in) is det.
noopfunc2(Context, _Argc, Argv) :-
    impure result_value(Context, Argv ^ elem(0)).
:- pragma foreign_export("C", noopfunc2(in, in, in), "noopfunc2").
:- func c_noopfunc2 = sqlite3_function.
:- pragma foreign_proc("C", c_noopfunc2 = (Ptr::out),
		       [thread_safe, promise_pure],
		       "Ptr = noopfunc2;").

:- impure pred noopfunc3(context::in, int32::in, sqlite3_value_array::in) is det.
noopfunc3(Context, _Argc, Argv) :-
    value_text(Argv ^ elem(0), Text),
    impure result_text(Context, "Region: " ++ Text).
:- pragma foreign_export("C", noopfunc3(in, in, in), "noopfunc3").
:- func c_noopfunc3 = sqlite3_function.
:- pragma foreign_proc("C", c_noopfunc3 = (Ptr::out),
		       [thread_safe, promise_pure],
		       "Ptr = noopfunc3;").

%% "Hello World" for user-defined SQL aggregates: sums:)
:- pragma foreign_code("C", "
static void mysum(sqlite3_context *context, int argc, sqlite3_value **argv) {
  double* p;
  assert(argc==1);
  p = sqlite3_aggregate_context(context, sizeof(*p));
  if (SQLITE_NULL != sqlite3_value_numeric_type(argv[0])) {
    *p = *p + sqlite3_value_double(argv[0]);
  }
}
static void myfinal(sqlite3_context *context) {
  double* p = sqlite3_aggregate_context(context, 0);
  sqlite3_result_double(context, *p);
}
").
:- func c_mysum = sqlite3_function.
:- pragma foreign_proc("C", c_mysum = (Ptr::out),
		       [thread_safe, promise_pure],
		       "Ptr = mysum;").
:- func c_myfinal = sqlite3_final.
:- pragma foreign_proc("C", c_myfinal = (Ptr::out),
		       [thread_safe, promise_pure],
		       "Ptr = myfinal;").

Cleaning up from any previous compiling, then compiling and running the test example, we get:

rm -rf Mercury
rm -rf test_sqlite3
ok(["s", "x"])
ok([[text("a"), float(1.0)], [text("a"), float(2.0)], [text("a"), float(3.0)], [text("a"), float(4.0)], [text("a"), float(5.0)]])
ok(["s", "count(*)", "sum(identity(x))"])
ok([[text("Göteborg"), int(1000), float(500500.0)], [text("Östersund"), int(500), float(125250.0)]])
ok(["identity3(s)", "count(*)", "mysum(identity2(x))"])
[yes(r("Region: Göteborg", 1000, 500500.0)), yes(r("Region: Östersund", 500, 125250.0))]

Detailed documentation

% Copyright (C) 2015 Peter Wang
% Copyright (C) 2023 Mark Clements

:- module sqlite3.
:- interface.

:- import_module array.
:- import_module assoc_list.
:- import_module bool.
:- import_module char.
:- import_module io.
:- import_module maybe.
:- import_module list.

:- import_module float.

%-----------------------------------------------------------------------------%

:- type rw ---> rw.
:- type ro ---> ro.

:- type db(RwRo).

:- type synchronous
    --->    off
    ;       normal
    ;       full.

:- type stmt.

:- type bind_index
    --->    num(int)
    ;       name(string).

:- type step_result
    --->    done
    ;       row
    ;       error(string).

:- inst step_result_nonerror
    --->    done
    ;       row.

:- type column
    --->    column(int).

:- type column_type
   --->  integer
   ;     float
   ;     text
   ;     blob
   ;     null.

:- type data_type
   --->  null
   ;     int(int)
   ;     float(float)
   ;     text(string)
   ;     blob(c_pointer, int).

:- type row_type == list(data_type).

:- type table_type == list(row_type).

:- type sqlite_error % exception type
    --->    sqlite_error(string).

%-----------------------------------------------------------------------------%

:- pred init_multithreaded(maybe_error::out, io::di, io::uo) is det.

:- pred synchronous(synchronous, string).
:- mode synchronous(in, out) is det.
:- mode synchronous(out, in) is semidet.

:- pred open_rw(string::in, synchronous::in, maybe_error(db(rw))::out,
    io::di, io::uo) is det.

:- pred open_ro(string::in, maybe_error(db(ro))::out, io::di, io::uo) is det.

:- pred close(db(RwRo)::in, io::di, io::uo) is det.

    % This is only good for temporarily treating a rw database connection
    % as a ro database connection.  It should be avoided.
    %
:- pred rw_db_to_ro_db(db(rw)::in, db(ro)::out) is det.

%-----------------------------------------------------------------------------%

    % Must be paired with end_transaction or rollback_transaction.
    %
:- pred begin_transaction(db(RwRo)::in, maybe_error::out,
    io::di, io::uo) is det.

:- pred end_transaction(db(RwRo)::in, maybe_error::out,
    io::di, io::uo) is det.

:- pred rollback_transaction(db(RwRo)::in, maybe_error::out,
    io::di, io::uo) is det.

:- pred exec(db(RwRo)::in, string::in, maybe_error::out,
    io::di, io::uo) is det.

%-----------------------------------------------------------------------------%

% Low-level interface

:- pred prepare(db(RwRo)::in, string::in, maybe_error(stmt)::out,
    io::di, io::uo) is det.

:- pred bind(db(RwRo)::in, stmt::in, bind_index::in, data_type::in,
    maybe_error::out, io::di, io::uo) is det.

:- pred bind_int(db(RwRo)::in, stmt::in, bind_index::in, int::in,
    maybe_error::out, io::di, io::uo) is det.

:- pred bind_float(db(RwRo)::in, stmt::in, bind_index::in, float::in,
    maybe_error::out, io::di, io::uo) is det.

    % This is "unsafe" in that the GC could collect the string while it is
    % still bound to the stmt.  You must keep a reference to the string while
    % it is still bound to the stmt.
    %
:- pred unsafe_bind_text(db(RwRo)::in, stmt::in, bind_index::in, string::in,
    maybe_error::out, io::di, io::uo) is det.

    % This is "unsafe" in that the GC could collect the object containing
    % the pointer address while the address is still bound to the stmt.
    % You must keep a reference to the object while the pointer is still
    % bound to the stmt.
    %
:- pred unsafe_bind_blob(db(RwRo)::in, stmt::in, bind_index::in,
    c_pointer::in, int::in, maybe_error::out, io::di, io::uo) is det.

:- pred bind_null(db(RwRo)::in, stmt::in, bind_index::in,
    maybe_error::out, io::di, io::uo) is det.

:- pred step(db(RwRo)::in, sqlite3.stmt::in, step_result::out,
    io::di, io::uo) is det.

:- pred reset(db(RwRo)::in, stmt::in, maybe_error::out,
    io::di, io::uo) is det.

:- pred finalize(stmt::in, io::di, io::uo) is det.

%-----------------------------------------------------------------------------%

:- pred column_is_null(stmt::in, column::in, bool::out,
    io::di, io::uo) is det.

:- pred column_int(stmt::in, column::in, int::out,
    io::di, io::uo) is det.

:- pred column_float(stmt::in, column::in, float::out,
    io::di, io::uo) is det.

:- pred column_text(stmt::in, column::in, string::out,
    io::di, io::uo) is det.

:- pred column_maybe_text(stmt::in, column::in, maybe(string)::out,
    io::di, io::uo) is det.

:- pred column_blob(stmt::in, column::in, c_pointer::out, int::out,
		    io::di, io::uo) is det.

:- pred column_type(stmt::in, column::in, int::out,
		    io::di, io::uo) is det.

:- pred column(stmt::in, column::in, data_type::out, io::di, io::uo) is det.

:- pred column_count(stmt::in, int::out, io::di, io::uo) is det.

:- pred column_name(stmt::in, column::in, string::out,
    io::di, io::uo) is det.

:- pred data_count(stmt::in, int::out, io::di, io::uo) is det.

:- pred db_handle(stmt::in, db(T)::out, io::di, io::uo) is det.

:- func column_type_id(column_type) = int.

%-----------------------------------------------------------------------------%

:- func escape_LIKE_argument(char, string) = string.

%-----------------------------------------------------------------------------%

% High-level interface

    % The bindings list is kept alive until the statement is finalized.
    %
:- pred with_stmt(
    pred(db(RwRo), stmt, T, io, io)::in(pred(in, in, out(TI), di, uo) is det),
    db(RwRo)::in, string::in, assoc_list(bind_index, data_type)::in,
    T::out(TI), io::di, io::uo) is det.

:- pred with_prepared_stmt(
    pred(db(RwRo), stmt, T, io, io)::in(pred(in, in, out(TI), di, uo) is det),
    db(RwRo)::in, stmt::in, assoc_list(bind_index, data_type)::in,
    T::out(TI), io::di, io::uo) is det.

:- pred with_stmt_acc(
    pred(db(RwRo), stmt, T, T, io, io)::in(pred(in, in, in, out, di, uo) is det),
    db(RwRo)::in, string::in, assoc_list(bind_index, data_type)::in,
    T::in, T::out, io::di, io::uo) is det.

:- pred with_stmt_acc3(
    pred(db(RwRo), stmt, maybe_error, A, A, B, B, C, C, io, io),
    db(RwRo), string, assoc_list(bind_index, data_type),
    maybe_error, A, A, B, B, C, C, io, io).
:- mode with_stmt_acc3(
    in(pred(in, in, out, in, out, in, out, in, out, di, uo) is det),
    in, in, in, out, in, out, in, out, in, out, di, uo) is det.
:- mode with_stmt_acc3(
    in(pred(in, in, out, in, out, in, out, array_di, array_uo, di, uo) is det),
    in, in, in, out, in, out, in, out, array_di, array_uo, di, uo) is det.

:- pred bind_checked(db(RwRo)::in, stmt::in,
    assoc_list(bind_index, data_type)::in, io::di, io::uo) is det.

:- pred step_ok(db(RwRo)::in, stmt::in, step_result::out(step_result_nonerror),
    io::di, io::uo) is det.

:- pred step_ok_keep_alive(db(RwRo)::in, stmt::in,
    assoc_list(bind_index, data_type)::in,
    step_result::out(step_result_nonerror), io::di, io::uo) is det.

:- pred insert_row(db(rw)::in, stmt::in, maybe_error::out,
    io::di, io::uo) is det.

:- pred get_header(db(rw)::in, stmt::in, maybe_error(list(string))::out,
    io::di, io::uo) is det.

:- pred get_row(db(rw)::in, stmt::in, maybe_error(row_type)::out,
    io::di, io::uo) is det.

:- pred get_rows(db(rw)::in, stmt::in, maybe_error(table_type)::out,
		 io::di, io::uo) is det.

:- pred get_cols(db(rw)::in, stmt::in, list(list(data_type))::out,
    io::di, io::uo) is det.

:- pred write_table(db(rw)::in, % Db
		    string::in, % TableName
		    list(string)::in, % Headers
		    list(list(data_type))::in, % Data
		    io::di, io::uo) is det.

:- pred read_query(db(rw)::in, % Db
		   string::in, % Query
		   maybe_error(list(string))::out, % Headers
		   maybe_error(list(list(data_type)))::out, % Data
		   io::di, io::uo) is det.


%-----------------------------------------------------------------------------%
%% utilities to support creating functions

:- type context.

:- type sqlite3_value.

:- type sqlite3_value_array.

:- type sqlite3_function.
:- type sqlite3_final.
:- type void_star.

:- func lookup(sqlite3_value_array, int) = sqlite3_value is det.
:- pred lookup(sqlite3_value_array::in, int::in, sqlite3_value::out) is det.
:- func elem(int, sqlite3_value_array) = sqlite3_value.
:- mode elem(in, in) = out is det.

:- impure pred result_value(context::in, sqlite3_value::in) is det.
:- impure pred result_double(context::in, float::in) is det.
:- impure pred result_int(context::in, int::in) is det.
:- impure pred result_blob(context::in, c_pointer::in, int::in) is det.
:- impure pred result_text(context::in, string::in) is det.
:- impure pred result_null(context::in) is det.
:- impure pred result(context::in, data_type::in) is det.

:- pred value_double(sqlite3_value::in, float::out) is det.
:- pred value_int(sqlite3_value::in, int::out) is det.
:- pred value_text(sqlite3_value::in, string::out) is det.
:- pred value_blob(sqlite3_value::in, c_pointer::out, int::out) is det.
:- pred value(sqlite3_value::in, data_type::out) is det.
:- func value_type(sqlite3_value) =int is det.

:- pred create_sqlite3_function(db(_)::in, string::in, sqlite3_function::in,
				string::out, io::di, io::uo) is det.
:- pred create_sqlite3_function(db(_)::in, string::in,
				%% void_star::in,
				sqlite3_function::in, sqlite3_final::in, 
				string::out, io::di, io::uo) is det.