From d03ea3dc54336e350d199edb4345429f2b1ff5d7 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 23 Jul 2014 12:25:00 +0200 Subject: [PATCH] CCIO: explicit finalizer system, to use a >>>= operator rather than callbacks. bugfix in Seq.chunks --- core/CCIO.ml | 75 ++++++++++++++++++++++++++++++--------------------- core/CCIO.mli | 52 ++++++++++++++++++++++++++++++++--- 2 files changed, 94 insertions(+), 33 deletions(-) diff --git a/core/CCIO.ml b/core/CCIO.ml index 3553e966..f91e33cb 100644 --- a/core/CCIO.ml +++ b/core/CCIO.ml @@ -31,22 +31,22 @@ type _ t = | Fail : string -> 'a t | Map : ('a -> 'b) * 'a t -> 'b t | Bind : ('a -> 'b t) * 'a t -> 'b t - | BindWith : unit t * ('a -> 'b t) * 'a t -> 'b t + | WithGuard: unit t * 'a t -> 'a t (* run guard in any case *) | Star : ('a -> 'b) t * 'a t -> 'b t | Repeat : int * 'a t -> 'a list t | RepeatIgnore : int * 'a t -> unit t | Wrap : (unit -> 'a) -> 'a t - | WrapJoin : (unit -> 'a t) -> 'a t | SequenceMap : ('a -> 'b t) * 'a list -> 'b list t type 'a io = 'a t +type 'a with_finalizer = ('a t * unit t) t type 'a or_error = [ `Ok of 'a | `Error of string ] let (>>=) x f = Bind(f,x) let bind ?finalize f a = match finalize with | None -> Bind(f,a) - | Some b -> BindWith (b,f,a) + | Some b -> WithGuard (b, Bind (f,a)) let map f x = Map(f, x) @@ -81,6 +81,14 @@ let repeat i a = let repeat' i a = if i <= 0 then Return () else RepeatIgnore (i,a) +(** {2 Finalizers} *) + +let (>>>=) a f = + a >>= function + | x, finalizer -> WithGuard (finalizer, x >>= f) + +(** {2 Running} *) + exception IOFailure of string let rec _run : type a. a t -> a = function @@ -88,20 +96,19 @@ let rec _run : type a. a t -> a = function | Fail msg -> raise (IOFailure msg) | Map (f, a) -> f (_run a) | Bind (f, a) -> _run (f (_run a)) - | BindWith (finalize, f, a) -> + | WithGuard (g, a) -> begin try - let res = _run (f (_run a)) in - _run finalize; + let res = _run a in + _run g; res with e -> - _run finalize; + _run g; raise e end | Star (f, a) -> _run f (_run a) | Repeat (i,a) -> _repeat [] i a | RepeatIgnore (i,a) -> _repeat_ignore i a | Wrap f -> f() - | WrapJoin f -> _run (f()) | SequenceMap (f, l) -> _sequence_map f l [] and _repeat : type a. a list -> int -> a t -> a list = fun acc i a -> match i with @@ -158,16 +165,14 @@ let register_printer p = _printers := p :: !_printers (** {2 Standard Wrappers} *) -let _with_in flags filename f () = - let ic = open_in_gen flags 0x644 filename in - try - f ic - with e -> - close_in ic; - raise e +let _open_in mode flags filename () = + open_in_gen flags mode filename +let _close_in ic () = close_in ic -let with_in ?(flags=[]) filename f = - WrapJoin (_with_in flags filename f) +let with_in ?(mode=0o644) ?(flags=[]) filename = + Wrap (_open_in mode flags filename) + >>= fun ic -> + Return (Return ic, Wrap (_close_in ic)) let _read ic s i len () = input ic s i len let read ic s i len = Wrap (_read ic s i len) @@ -196,16 +201,17 @@ let _read_all ic () = let read_all ic = Wrap(_read_all ic) -let _with_out flags filename f () = - let oc = open_out_gen flags 0x644 filename in - try - f oc - with e -> - close_out oc; - raise e +let _open_out mode flags filename () = + open_out_gen flags mode filename +let _close_out oc () = close_out oc -let with_out ?(flags=[]) filename f = - WrapJoin (_with_out flags filename f) +let with_out ?(mode=0o644) ?(flags=[]) filename = + Wrap(_open_out mode (Open_wronly::flags) filename) + >>= fun oc -> + Return(Return oc, Wrap(_close_out oc)) + +let with_out_a ?mode ?(flags=[]) filename = + with_out ?mode ~flags:(Open_creat::Open_append::flags) filename let _write oc s i len () = output oc s i len let write oc s i len = Wrap (_write oc s i len) @@ -323,13 +329,18 @@ module Seq = struct let chunks ~size ic = let buf = Buffer.create size in + let eof = ref false in let next() = - try + if !eof then _stop() + else try Buffer.add_channel buf ic size; let s = Buffer.contents buf in Buffer.clear buf; _yield s - with End_of_file -> _stop() + with End_of_file -> + let s = Buffer.contents buf in + eof := true; + if s="" then _stop() else _yield s in next @@ -355,16 +366,20 @@ module Seq = struct next *) - let output ?(sep="\n") oc seq = + let output ?sep oc seq = let first = ref true in iter (fun s -> + (* print separator *) ( if !first then (first:=false; return ()) - else write_str oc sep + else match sep with + | None -> return () + | Some sep -> write_str oc sep ) >>= fun () -> write_str oc s ) seq + >>= fun () -> flush oc end (** {2 Raw} *) diff --git a/core/CCIO.mli b/core/CCIO.mli index 4f42dd44..2a09c7b3 100644 --- a/core/CCIO.mli +++ b/core/CCIO.mli @@ -29,11 +29,37 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. A simple abstraction over blocking IO, with strict evaluation. This is in no way an alternative to Lwt/Async if you need concurrency. -@since NEXT_RELEASE *) +@since NEXT_RELEASE + +Examples: + +- obtain the list of lines of a file: +{[ +let l = CCIO.((with_in "/tmp/some_file" >>>= read_lines) |> run_exn);; +]} + +- transfer one file into another: +{[ +# let a = CCIO.( + with_in "input" >>>= fun ic -> + with_out ~flags:[Open_creat] "output" >>>= fun oc -> + Seq.chunks 512 ic + |> Seq.output oc +) ;; + +# run a;; +]} + +*) type 'a t type 'a io = 'a t +type 'a with_finalizer +(** A value of type ['a with_finalizer] is similar to a value ['a t] but + also contains a finalizer that must be run to cleanup. + See {!(>>>=)} to get rid of it. *) + type 'a or_error = [ `Ok of 'a | `Error of string ] val (>>=) : 'a t -> ('a -> 'b t) -> 'b t @@ -80,6 +106,15 @@ val fail : string -> 'a t (** [fail msg] fails with the given message. Running the IO value will return an [`Error] variant *) +(** {2 Finalizers} *) + +val (>>>=) : 'a with_finalizer -> ('a -> 'b t) -> 'b t +(** Alternative to {!(>>=)} that also takes a [unit t] value, that is a + finalizer. This action will run in any case (even failure). + Other than the finalizer, this behaves like {!(>>=)} *) + +(** {2 Running} *) + val run : 'a t -> 'a or_error (** Run an IO action. @return either [`Ok x] when [x] is the successful result of the @@ -101,7 +136,11 @@ val register_printer : (exn -> string option) -> unit (** {6 Input} *) -val with_in : ?flags:open_flag list -> string -> (in_channel -> 'a t) -> 'a t +val with_in : ?mode:int -> ?flags:open_flag list -> + string -> in_channel with_finalizer +(** Open an input file with the given optional flag list. + It yields a [in_channel] with a finalizer attached. See {!(>>>=)} to + use it. *) val read : in_channel -> string -> int -> int -> int t (** Read a chunk into the given string *) @@ -117,7 +156,14 @@ val read_all : in_channel -> string t (** {6 Output} *) -val with_out : ?flags:open_flag list -> string -> (out_channel -> 'a t) -> 'a t +val with_out : ?mode:int -> ?flags:open_flag list -> + string -> out_channel with_finalizer +(** Same as {!with_in} but for an output channel *) + +val with_out_a : ?mode:int -> ?flags:open_flag list -> + string -> out_channel with_finalizer +(** Similar to {!with_out} but with the [Open_append] and [Open_creat] + flags activated *) val write : out_channel -> string -> int -> int -> unit t