impl/sqlgg_sqlite3.ml

   1 (**
   2   Sqlite3 OCaml traits for sqlgg
   3   by ygrek
   4   2015-07-09
   5
   6   This is free and unencumbered software released into the public domain.
   7
   8   Anyone is free to copy, modify, publish, use, compile, sell, or
   9   distribute this software, either in source code form or as a compiled
  10   binary, for any purpose, commercial or non-commercial, and by any
  11   means.
  12
  13   For more information, please refer to <http://unlicense.org/>
  14 *)
  15
  16 open Printf
  17
  18 module S = Sqlite3
  19
  20 type statement = S.stmt * string
  21 type connection = S.db
  22 type params = statement
  23 type row = statement
  24 type result = unit
  25
  26 type num = int64
  27 type text = string
  28 type any = string
  29 type datetime = float
  30
  31 exception Oops of string
  32
  33 let get_column_Bool (stmt,sql) index =
  34   match S.column stmt index with
  35   | S.Data.INT i -> i <> 0L
  36   | _ -> raise (Oops (sprintf "get_column_Bool %u for %s" index sql))
  37
  38 let get_column_Int (stmt,sql) index =
  39   match S.column stmt index with
  40   | S.Data.INT i -> i
  41   | _ -> raise (Oops (sprintf "get_column_Int %u for %s" index sql))
  42
  43 let get_column_Text (stmt,_) index =
  44   let x = S.column stmt index in
  45   S.Data.to_string x
  46
  47 let get_column_Any = get_column_Text
  48
  49 let get_column_Float (stmt,sql) index =
  50   match S.column stmt index with
  51   | S.Data.FLOAT i -> i
  52   | _ -> raise (Oops (sprintf "get_column_Float %u for %s" index sql))
  53
  54 let get_column_Datetime = get_column_Float
  55
  56 let test_ok sql rc =
  57   if rc <> S.Rc.OK then
  58     raise (Oops (sprintf "test_ok %s for %s" (S.Rc.to_string rc) sql))
  59
  60 let bind_param d (stmt,sql) index =
  61   let rc = S.bind stmt (index+1) d in
  62   test_ok sql rc
  63
  64 let start_params stmt _ = stmt
  65 let finish_params _ = ()
  66
  67 let set_param_null = bind_param S.Data.NULL
  68 let set_param_Text stmt index v = bind_param (S.Data.TEXT v) stmt index
  69 let set_param_Any = set_param_Text
  70 let set_param_Bool stmt index v = bind_param (S.Data.INT (if v then 1L else 0L)) stmt index
  71 let set_param_Int stmt index v = bind_param (S.Data.INT v) stmt index
  72 let set_param_Float stmt index v = bind_param (S.Data.FLOAT v) stmt index
  73 let set_param_Datetime = set_param_Float
  74
  75 let no_params _ = ()
  76
  77 let try_finally final f x =
  78   let r =
  79     try f x with exn -> final (); raise exn
  80   in
  81     final ();
  82     r
  83
  84 let with_sql db sql f =
  85   let stmt = S.prepare db sql in
  86   try_finally
  87     (fun () -> test_ok sql (S.finalize stmt))
  88     f (stmt,sql)
  89
  90 let select db sql set_params callback =
  91   with_sql db sql (fun stmt ->
  92     set_params stmt;
  93     while S.Rc.ROW = S.step (fst stmt) do
  94       callback stmt
  95     done)
  96
  97 let execute db sql set_params =
  98   with_sql db sql (fun stmt ->
  99     set_params stmt;
 100     let rc = S.step (fst stmt) in
 101     if rc <> S.Rc.DONE then raise (Oops (sprintf "execute : %s" sql));
 102     Int64.of_int (S.changes db)
 103   )
 104
 105 let select1 db sql set_params callback =
 106   with_sql db sql (fun stmt ->
 107     set_params stmt;
 108     if S.Rc.ROW = S.step (fst stmt) then
 109       Some (callback stmt)
 110     else
 111       None)