From 57b48639ab6839e52b5842021e276fac2f4ba6ad Mon Sep 17 00:00:00 2001 From: Peter McGoron Date: Sat, 9 Oct 2021 22:25:47 -0400 Subject: [PATCH] rearrange functions * Replace getrow with get_exactly_one_row, since there was no way to detect when another row would be available * Introduce rowfold, which allows for iterating over all rows returns fromed a SQL query * Introduce functions into the interface that were left out --- src/letsqlite.ml | 38 +++++++++++++++++++++++--------------- src/letsqlite.mli | 41 ++++++++++++++++++++++++++++++++--------- 2 files changed, 55 insertions(+), 24 deletions(-) diff --git a/src/letsqlite.ml b/src/letsqlite.ml index 81ee72c..d7b1961 100644 --- a/src/letsqlite.ml +++ b/src/letsqlite.ml @@ -23,7 +23,7 @@ let (@>$) s f = fun x -> s x >>$ f (* Helper definitions *) let transform f (v,s) = Norm ((f v),s) -let inject v (_,s) = Norm (v,s) +let inject v = transform (fun _ -> v) let fail er (_,s) = let er2 = S.finalize s in if Rc.is_success er then Failed er2 @@ -38,6 +38,12 @@ let arr_to_tbl tbl keys vals = assert (Array.length keys = Array.length vals); Array.iteri (fun i x -> Hashtbl.add tbl x vals.(i)) keys +let create_rowtbl s rowdata = + let keys = S.row_names s + in let tbl = Hashtbl.create (Array.length keys) + in arr_to_tbl tbl keys rowdata; + tbl + (* Monadic functions *) let prepare db stmt v = try Norm (v,(S.prepare db stmt)) with @@ -49,19 +55,29 @@ let reprepare db stmt (v,s) = let reset (v,s) = lift_err (S.reset s) (v,s) let step (v,s) = lift_err (S.step s) (v,s) +let bind_values l (v,s) = lift_err (S.bind_values s l) (v,s) +let clear_bindings (v,s) = lift_err (S.clear_bindings s) (v,s) +let rowfold f (v,s) = + let g x arr = f x (create_rowtbl s arr) + in let (r,x) = S.fold ~f:g ~init:v s + in if Rc.is_success r then Norm (x,s) + else stmtfail r s +let rowfold_init f i = inject i @>$ rowfold f +let iter f = rowfold_init (fun () x -> f x) () let rec fold f l (v,s) = match l with | [] -> Norm (v,s) | h::t -> f h (v,s) >>$ fold f t -let getrow (_,s) = +let get_exactly_one_row (_,s) = let r = S.step s in match r with | Rc.ROW -> if S.data_count s = 0 then stmtfail Rc.NOTFOUND s - else let keys = S.row_names s - in let tbl = Hashtbl.create (Array.length keys) - in arr_to_tbl tbl keys (S.row_data s); - Norm (((),tbl),s) + else let tbl = create_rowtbl s (S.row_data s) + in let r = S.step s + in if Rc.is_success r then + reset (((),tbl),s) + else stmtfail r s | x -> stmtfail x s let exec_extract extrfun convfun ((_,arg),s) = @@ -72,20 +88,12 @@ let exec_extract extrfun convfun ((_,arg),s) = | Some x -> Norm ((x,arg), s) ) -let get_exactly_one_row tr = - let$ (v,s) = getrow tr - in let r = S.step s - in if Rc.is_success r then reset (v,s) - else Failed r - let extract name conv tu = exec_extract (fun tbl -> Hashtbl.find_opt tbl name) conv tu let finalize = function | Failed e -> raise (S.SqliteError (Rc.to_string e)) | Norm (v,s) -> Rc.check (S.finalize s); v -let bind_values l (v,s) = lift_err (S.bind_values s l) (v,s) -let clear_bindings (v,s) = lift_err (S.clear_bindings s) (v,s) let exec db s = prepare db s () >>$ step let reexec db s = reprepare db s @>$ step @@ -105,7 +113,7 @@ let%test "simple usage" = >>$ extract "y" S.Data.to_int64 in let$ ((v,r),s) = m in s1 := [v]; - let$ ((v,r),s) = bind_values [S.Data.INT 2L] ((v,r),s) + let$ ((v,_),s) = bind_values [S.Data.INT 2L] ((v,r),s) >>$ get_exactly_one_row >>$ extract "y" S.Data.to_int64 in s1 := v::!s1; diff --git a/src/letsqlite.mli b/src/letsqlite.mli index 001b228..cea4725 100644 --- a/src/letsqlite.mli +++ b/src/letsqlite.mli @@ -1,16 +1,20 @@ +(** Letsqlite main interface. *) + (** {1 Type definitions} Types used for monad composition. *) + type 'a stmt_m = | Failed of Sqlite3.Rc.t | Norm of ('a * Sqlite3.stmt) + (** The ['a] value in the [stmt_m] is referred to as the bundled value. A function may "fail with [e]", in which it returns [Failed e], or it may "return a value", in which it returns [Norm v s]. They are collectively refered to as the monad's values. - The bundled {Sqlite.stmt} value is refered to as [S], and the + The bundled {!Sqlite.stmt} value is refered to as [S], and the value bundled is refered to as [V]. {i Never directly use [Failed].} You run the likelihood of leaking @@ -33,6 +37,10 @@ val (let$) : 'a stmt_m -> ('a,'b) monad_fun -> 'b stmt_m (** [let$ (v,s) = f (V,S) in ...] is equivalent to [f (V,S) >>$ (fun (v,s) -> ...)]. *) +val (@>$) : ('a,'b) monad_fun -> ('b,'c) monad_fun -> ('a,'c) monad_fun +(** [f @>$ g] composes to monadic functions so they become another + monadic function. *) + val (>-$) : 'a stmt_m -> ('a,'b) monad_fun -> 'a stmt_m (** [>-$] is the passthrough function. @@ -47,13 +55,16 @@ These functions do not execute any SQL queries. They exist to make dealing with the monad easier. *) +val transform : ('a -> 'b) -> ('a,'b) monad_fun +(** [transform f] maps [V] to [f V]. *) + val inject : 'a -> ('b,'a) monad_fun (** [inject x] returns [Norm x S], discarding [V]. *) val fail : Sqlite3.Rc.t -> ('a,'b) monad_fun (** [fail e] finalizes [S] and returns [Failure], where the error code is [e] if [e] is not a success error code, and the return code - of {finalize} otherwise. + of {!Sqlite3.finalize} otherwise. *) val stmtfail : Sqlite3.Rc.t -> Sqlite3.stmt -> unit stmt_m @@ -73,7 +84,7 @@ val lift_err : Sqlite3.Rc.t -> ('a,'a) monad_fun (** {1 Execution functions} -All of these functions will (effectively) exceute {fail} and return +All of these functions will (effectively) exceute {!fail} and return [Failed] on failure. All functions will omit error behavior unless there is something different across any of them. *) @@ -90,20 +101,32 @@ val reset : ('a,'a) monad_fun (** [reset] resets [S] so that it may be executed again. *) val step : ('a,'a) monad_fun -(** [step] is equivalent to the Sqlite3 function {step}. +(** [step] is equivalent to {!Sqlite3.step}. {b NOTE}: [step] will fail when the statement returns a row. *) +val rowfold : ('a -> rowdata -> 'a) -> ('a,'a) monad_fun +(** [rowfold f] iterates over each row returns by [S] and applies + [f] to it, returning some value. *) + +val rowfold_init : ('a -> rowdata -> 'a) -> 'a -> ('b,'a) monad_fun +(** [rowfold_initf i] changes [V] to [i] and then applies [rowfold]. *) + +val iter : (rowdata -> unit) -> ('a,unit) monad_fun +(** [rowfold_unit f] is equivalent to [rowfold_init f ()] but [f] + is not passed a unit argument. *) + val fold : ('a -> ('b,'b) monad_fun) -> 'a list -> ('b,'b) monad_fun (** [fold f l] applies each element of [l] to make a monadic function [f]. *) -val getrow : ('a,(unit * rowdata)) monad_fun -(** [getrow] steps [S] and stores the returned row. The value in [S] is - discarded. +val get_exactly_one_row : ('a,(unit * rowdata)) monad_fun +(** [get_exactly_one_row] steps [S] and stores the returned row. The + value in [S] is discarded. The function fails if there is not exactly + one row. The function returns a tuple with the unit type to interact with - {extract}. + {!extract}. *) val exec_extract : ('a -> 'b option) -> ('b -> 'c option) @@ -132,7 +155,7 @@ val clear_bindings : ('a,'a) monad_fun (** [clear_bindings] clears any values bound to [S]. *) val exec : Sqlite3.db -> string -> unit stmt_m -(** [exec db s] is equivalent to a call to {prepare} followed by {step}. *) +(** [exec db s] is equivalent to a call to {!prepare} followed by {!step}. *) val reexec : Sqlite3.db -> string -> ('a,'a) monad_fun (** [reexec db s] is equivalent to [reprepare >>$ step]. *)