diff --git a/src/letsqlite.ml b/src/letsqlite.ml index d7b1961..a74097c 100644 --- a/src/letsqlite.ml +++ b/src/letsqlite.ml @@ -57,13 +57,33 @@ 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 execif r v = if Rc.is_success r then Norm v else Failed r + +let rowfold f (init,s) = + let rec fold acc ((),s) = + let r = S.step s + in if r = Rc.ROW then + match f acc (create_rowtbl s (S.row_data s)) with + | Error r -> stmtfail r s + | Ok x -> fold x ((),s) + else execif r (acc,s) + in fold init ((),s) >>$ reset + +let iter f (_,s) = + let wrap () x = let r = f x in + if r = Rc.OK then Ok () + else Error r + in rowfold wrap ((),s) + +let map f l (ival,s) = + let rec map l (b,s) = match l with + | [] -> Norm (b,s) + | h::t -> + let$ v,s = f h (ival,s) + in map t (v::b,s) + in let$ (v,s) = map l ([],s) + in Norm (List.rev v, s) let rec fold f l (v,s) = match l with | [] -> Norm (v,s) diff --git a/src/letsqlite.mli b/src/letsqlite.mli index cea4725..c0ecc45 100644 --- a/src/letsqlite.mli +++ b/src/letsqlite.mli @@ -106,17 +106,18 @@ val step : ('a,'a) monad_fun {b NOTE}: [step] will fail when the statement returns a row. *) -val rowfold : ('a -> rowdata -> 'a) -> ('a,'a) monad_fun +val rowfold : ('a -> rowdata -> ('a,Sqlite3.Rc.t) Result.t) -> ('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 +val iter : (rowdata -> Sqlite3.Rc.t) -> ('a,unit) monad_fun (** [rowfold_unit f] is equivalent to [rowfold_init f ()] but [f] is not passed a unit argument. *) +val map : ('a -> ('b,'c) monad_fun) -> 'a list -> ('b,'c list) monad_fun +(** [map f l] applies the monadic function [f] to each element of [l], + returning all the list of all their values. *) + 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]. *)