Permalink
Browse files

Merge pull request #1 from msullivan/master

Implement insert_id/affected_rows and add a blob type that works with sqlite.
  • Loading branch information...
j4cbo committed Feb 6, 2014
2 parents 742a519 + ba45555 commit c7ba8cfa417dba209fe6287b99b778ef2aed7e72
@@ -22,7 +22,7 @@ structure SQLite :> SQLITE = struct
val ptrcell = C.alloc' C.S.ptr 0w1
val res = F_sqlite3_open.f' (filename', ptrcell)
val ptr = C.Get.ptr' (C.Ptr.|*! ptrcell)
in
in
C.free' filename';
C.free' ptrcell;
if C.Ptr.isNull' ptr
@@ -58,6 +58,10 @@ structure SQLite :> SQLITE = struct
stmt := NONE
)
fun last_insert_rowid db = F_sqlite3_last_insert_rowid.f' (get db)
fun changes db = F_sqlite3_changes.f' (get db)
val SQLITE_TRANSIENT : C.voidptr = C.U.i2p (C.Cvt.c_ulong (~(0w1)))
fun bind_blob (stmt : stmt, num, vec) = let
@@ -108,7 +112,7 @@ structure SQLite :> SQLITE = struct
fun read_bytes (p, n) = Word8Vector.tabulate (n,
fn i => Word8.fromLarge (Word32.toLarge (
C.Get.uchar' (C.Ptr.sub' C.S.uchar (p, i)))))
fun column_blob (stmt, num) = let
val arg = (get stmt, Int32.fromInt num)
val f = F_sqlite3_column_blob.f'
View
@@ -67,3 +67,10 @@ const unsigned char *sqlite3_column_text(sqlite3_stmt*, int iCol);
const void *sqlite3_column_text16(sqlite3_stmt*, int iCol);
int sqlite3_column_type(sqlite3_stmt*, int iCol);
sqlite3_value *sqlite3_column_value(sqlite3_stmt*, int iCol);
/*sqlite3_int64 sqlite3_last_insert_rowid(sqlite3*);*/
/* XXX: this is super wrong. but will probably work. */
/* Woooooo relying on platform ABI details. */
int sqlite3_last_insert_rowid(sqlite3*);
int sqlite3_changes(sqlite3*);
View
@@ -14,6 +14,9 @@ signature SQLITE = sig
val opendb : string -> db
val close : db -> unit
val last_insert_rowid : db -> Int32.int
val changes : db -> Int32.int
val prepare : db * string -> stmt
val reset : stmt -> unit
val finalize : stmt -> unit
View
@@ -79,6 +79,12 @@ structure SQLite :> SQLITE = struct
stmt := NONE
)
fun last_insert_rowid db =
Int64.toInt
((_import "sqlite3_last_insert_rowid" : ptr -> Int64.int;) (get db))
fun changes db =
(_import "sqlite3_changes" : ptr -> int;) (get db)
val SQLITE_TRANSIENT = P.sub (P.null, 0w1)
fun bind_blob (stmt, num, vec) =
View
@@ -4,6 +4,7 @@ exception ParseError of string
fun type_lookup "string" = String
| type_lookup "int" = Int
| type_lookup "blob" = Blob
| type_lookup t = raise ParseError ("Unknown type: \"" ^ t ^ "\"")
fun engine_lookup s =
@@ -29,6 +30,8 @@ fun engine_lookup s =
| VECTOR
| FOLD
| UNIT
| AFFECTED_ROWS
| INSERT_ID
| ENGINE
| EOF
| SQLDATA of string
@@ -39,7 +42,7 @@ fun engine_lookup s =
%nonterm START of engine option * sqlfunc list
| ITEMS of sqlfunc list
| ITEM of sqlfunc
| engine of engine
| engine of engine
| itype of inbinding
| otype of outbinding
| reptype of reptype
@@ -76,6 +79,8 @@ otype: LPAREN tupleitems RPAREN (OBtuple (Rsingle, tupleitems))
| LBRACE recorditems RBRACE (OBrecord (Rsingle, recorditems))
| LBRACE recorditems RBRACE reptype (OBrecord (reptype, recorditems))
| UNIT (OBunit)
| INSERT_ID (OBinsertId)
| AFFECTED_ROWS (OBaffectedRows)
reptype: LIST (Rlist)
| OPTION (Roption)
View
@@ -18,7 +18,7 @@ fun eof () = EOF (!lineNum, !lineNum)
whitespace = [\ \t];
token = [a-zA-Z_'];
sqlline = ([^-\n] .* "\n")
sqlline = ([^-\n] .* "\n")
| ("-" ([^-\n] .* "\n" | "\n"))
| ("--" ([^-\n] .* "\n" | "\n"));
@@ -35,6 +35,9 @@ sqlline = ([^-\n] .* "\n")
<HEADER> "array" => ( ARRAY (!lineNum, !lineNum) );
<HEADER> "vector" => ( VECTOR (!lineNum, !lineNum) );
<HEADER> "unit" => ( UNIT (!lineNum, !lineNum) );
<HEADER> "insert_id" => ( INSERT_ID (!lineNum, !lineNum) );
<HEADER> "affected_rows" => ( AFFECTED_ROWS (!lineNum, !lineNum) );
<HEADER> "->" => ( ARROW (!lineNum, !lineNum) );
<HEADER> "->" => ( ARROW (!lineNum, !lineNum) );
<HEADER> ":" => ( COLON (!lineNum, !lineNum) );
<HEADER> "{" => ( LBRACE (!lineNum, !lineNum) );
View
@@ -2,7 +2,7 @@ structure SquallInput = struct
datatype engine = SQLite | MySQL
datatype vartype = String | Int
datatype vartype = String | Int | Blob
datatype varspec = Vrequired of vartype | Voption of vartype | Vlist of vartype
@@ -15,6 +15,8 @@ structure SquallInput = struct
datatype outbinding = OBtuple of reptype * varspec list
| OBrecord of reptype * (string * varspec) list
| OBunit
| OBinsertId
| OBaffectedRows
type sqlfunc = { name: string,
inb: inbinding,
View
@@ -151,6 +151,16 @@ end = struct
("",
" case results of [] => ()\n"
^ " | _ => raise Fail \"Unexpected rows from DB\"\n")
| mkOutputProc SI.OBinsertId =
("()",
" case get nil of [] => Int32.fromLarge (Word64.toLargeInt (MySQLClient.insert_id conn))\n"
^ " | _ => raise Fail \"Unexpected rows from DB\"\n")
| mkOutputProc SI.OBaffectedRows =
("()",
" case get nil of [] => Int32.fromLarge (Word64.toLargeInt (MySQLClient.affected_rows conn))\n"
^ " | _ => raise Fail \"Unexpected rows from DB\"\n")
| mkOutputProc (SI.OBtuple (rt, types)) =
let
val names = List.tabulate(length types, fn i => "a_" ^ Int.toString i)
@@ -14,6 +14,8 @@ end = struct
"SQLite.bind_int (s, " ^ Int.toString (pos + 1) ^ ", " ^ ivar ^ ")"
| generateBindFunc (ivar, pos, SI.String) =
"SQLite.bind_text (s, " ^ Int.toString (pos + 1) ^ ", " ^ ivar ^ ")"
| generateBindFunc (ivar, pos, SI.Blob) =
"SQLite.bind_blob (s, " ^ Int.toString (pos + 1) ^ ", " ^ ivar ^ ")"
(* val generateBind: string * int * varspec -> string
@@ -39,22 +41,23 @@ end = struct
*)
fun generateReader (idx, SI.Int) = "SQLite.column_int (s, " ^ Int.toString idx ^ ")"
| generateReader (idx, SI.String) = "(case SQLite.column_text (s, " ^ Int.toString idx ^ ")of SOME s=>s|_=>raise(DataFormatError\""^Int.toString idx ^ "\"))"
| generateReader (idx, SI.Blob) = "(case SQLite.column_blob (s, " ^ Int.toString idx ^ ")of SOME s=>s|_=>raise(DataFormatError\""^Int.toString idx ^ "\"))"
(* fun generateConv: int * varspec -> string
*
* generateConv (idx, typ) produces SML source for an expression that
* generateConv (idx, typ) produces SML source for an expression that
* performs option checking on the given result column (if necessary) and
* then converts it to the correct type.
*)
fun generateConv (idx, SI.Vrequired typ) =
fun generateConv (idx, SI.Vrequired typ) =
"(case SQLite.column_type (s, " ^ Int.toString idx ^ ") of SQLite.NULL => "
^ "raise (DataFormatError\"" ^ Int.toString idx ^ "\") | _ => "
^ "raise (DataFormatError\"" ^ Int.toString idx ^ "\") | _ => "
^ generateReader (idx, typ) ^ ")"
| generateConv (idx, SI.Voption typ) =
| generateConv (idx, SI.Voption typ) =
"(case SQLite.column_type (s, " ^ Int.toString idx ^ ") of SQLite.NULL => NONE | _ => SOME ("
^ generateReader (idx, typ) ^ "))"
| generateConv (_, SI.Vlist typ) =
raise Fail "list not allowed in output types"
raise Fail "list not allowed in output types"
(* val mkSQLGen: SI.inbinding * string -> string * string list
*
@@ -76,8 +79,8 @@ end = struct
and mix' nil nil = nil
| mix' xs (y::ys) = y::(mix xs ys)
| mix' _ nil = raise ListPair.UnequalLengths
val (prologue, args) = case inb of
val (prologue, args) = case inb of
SI.IBunit => ("()", nil)
| SI.IBtuple arg_types => let
val arg_names = List.tabulate (length arg_types,
@@ -92,7 +95,7 @@ end = struct
| index ((a, b)::xs) = let val (xs', l) = index xs in ((a, l, b)::xs', l+1) end
val (args', _) = index (rev args)
val sql_gens = map generateBind args'
in
(prologue, sql_gens)
@@ -101,15 +104,11 @@ end = struct
(* val mkRepHandler: SI.reptype -> string
*
* Produce an expression that will turn results: string list list into the
* Produce an expression that will turn results: 'a list into the
* appropriate output value ('a list, 'a option, etc.). This ensures that the
* correct multiplicity of rows were returned: 0 for functions returning
* unit, 1 if returning a single tuple/record directy, etc.
*
* The resultant code assumes the existence of a function row:
* string list -> 'a, which handles converting each row; the row function is
* generated by mkOutputProc.
*
* This is used by mkOutputProc for the OBtuple and OBrecord options, but not
* for OBunit.
*)
@@ -147,6 +146,14 @@ end = struct
("()",
" case get nil of [] => ()\n"
^ " | _ => raise Fail \"Unexpected rows from DB\"\n")
| mkOutputProc SI.OBinsertId =
("()",
" case get nil of [] => SQLite.last_insert_rowid (valOf (!STMTS.db))\n"
^ " | _ => raise Fail \"Unexpected rows from DB\"\n")
| mkOutputProc SI.OBaffectedRows =
("()",
" case get nil of [] => SQLite.changes (valOf (!STMTS.db))\n"
^ " | _ => raise Fail \"Unexpected rows from DB\"\n")
| mkOutputProc (SI.OBtuple (rt, types)) =
let
fun getCol (typ, i) = "\n " ^ generateConv (i, typ)
@@ -212,8 +219,8 @@ end = struct
val (prologue, gens) = mkSQLGen (inb, sql)
val (rowFun, epilogue) = mkOutputProc outb
val (isFold, getRecurs) = mkExtra outb rowFun
in
" fun " ^ name ^ " " ^ prologue ^ (if isFold then " f" else "")
in
" fun " ^ name ^ " " ^ prologue ^ (if isFold then " f" else "")
^ " = let\n"
^ " val s = case STMTS." ^ name ^ " of ref (SOME s) => s | _ => raise Fail \"statement not prepared\"\n"
^ " val _ = SQLite.reset s\n"

0 comments on commit c7ba8cf

Please sign in to comment.