From cb311bf764344540eb2953ce96bdd09ea4ca727b Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 23 Nov 2014 12:54:28 +0100 Subject: [PATCH] breaking change: renamed CCIO to advanced.CCMonadIO; new CCIO module, much simpler --- _oasis | 2 +- advanced/CCMonadIO.ml | 519 +++++++++++++++++++++++++++++++++++++ advanced/CCMonadIO.mli | 323 +++++++++++++++++++++++ core/CCIO.ml | 571 ++++++++++------------------------------- core/CCIO.mli | 290 +++++---------------- 5 files changed, 1038 insertions(+), 667 deletions(-) create mode 100644 advanced/CCMonadIO.ml create mode 100644 advanced/CCMonadIO.mli diff --git a/_oasis b/_oasis index aa4e6762..e95bd4f5 100644 --- a/_oasis +++ b/_oasis @@ -61,7 +61,7 @@ Library "containers_string" Library "containers_advanced" Path: advanced Pack: true - Modules: CCLinq, CCBatch, CCCat + Modules: CCLinq, CCBatch, CCCat, CCMonadIO FindlibName: advanced FindlibParent: containers BuildDepends: containers diff --git a/advanced/CCMonadIO.ml b/advanced/CCMonadIO.ml new file mode 100644 index 00000000..961880e5 --- /dev/null +++ b/advanced/CCMonadIO.ml @@ -0,0 +1,519 @@ + +(* +copyright (c) 2013-2014, simon cruanes +all rights reserved. + +redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +redistributions of source code must retain the above copyright notice, this +list of conditions and the following disclaimer. redistributions in binary +form must reproduce the above copyright notice, this list of conditions and the +following disclaimer in the documentation and/or other materials provided with +the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(** {1 IO Monad} *) + +type _ t = + | Return : 'a -> 'a t + | Fail : string -> 'a t + | Map : ('a -> 'b) * 'a t -> 'b t + | Bind : ('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 + | 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 -> WithGuard (b, Bind (f,a)) + +let map f x = Map(f, x) + +let (>|=) x f = Map(f, x) + +let return x = Return x +let pure = return + +let fail msg = Fail msg + +let (<*>) f a = Star (f, a) + +let lift = map + +let lift2 f a b = + a >>= fun x -> map (f x) b + +let lift3 f a b c = + a >>= fun x -> + b >>= fun y -> map (f x y) c + +let sequence_map f l = + SequenceMap (f,l) + +let sequence l = + let _id x = x in + SequenceMap(_id, l) + +let repeat i a = + if i <= 0 then Return [] else 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 + | Return x -> x + | Fail msg -> raise (IOFailure msg) + | Map (f, a) -> f (_run a) + | Bind (f, a) -> _run (f (_run a)) + | WithGuard (g, a) -> + begin try + let res = _run a in + _run g; + res + with e -> + _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() + | 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 + | 0 -> List.rev acc + | _ -> + let x = _run a in + _repeat (x::acc) (i-1) a +and _repeat_ignore : type a. int -> a t -> unit + = fun i a -> match i with + | 0 -> () + | _ -> + let _ = _run a in + _repeat_ignore (i-1) a +and _sequence_map : type a b. (a -> b t) -> a list -> b list -> b list + = fun f l acc -> match l with + | [] -> List.rev acc + | a::tail -> + let x = _run (f a) in + _sequence_map f tail (x::acc) + +let _printers = + ref [ + (* default printer *) + ( function IOFailure msg + | Sys_error msg -> Some msg + | Exit -> Some "exit" + | _ -> None + ) + ] + +exception PrinterResult of string + +let _print_exn e = + try + List.iter + (fun p -> match p e with + | None -> () + | Some msg -> raise (PrinterResult msg) + ) !_printers; + Printexc.to_string e + with PrinterResult s -> s + +let run x = + try `Ok (_run x) + with e -> `Error (_print_exn e) + +exception IO_error of string + +let run_exn x = + try _run x + with e -> raise (IO_error (_print_exn e)) + +let register_printer p = _printers := p :: !_printers + +(** {2 Standard Wrappers} *) + +let _open_in mode flags filename () = + open_in_gen flags mode filename +let _close_in ic () = close_in ic + +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) + +let _read_line ic () = + try Some (Pervasives.input_line ic) + with End_of_file -> None +let read_line ic = Wrap(_read_line ic) + +let rec _read_lines ic acc = + read_line ic + >>= function + | None -> return (List.rev acc) + | Some l -> _read_lines ic (l::acc) + +let read_lines ic = _read_lines ic [] + +let _read_all ic () = + let buf = Buffer.create 128 in + try + while true do + Buffer.add_channel buf ic 1024 + done; + "" (* never returned *) + with End_of_file -> Buffer.contents buf + +let read_all ic = Wrap(_read_all ic) + +let _open_out mode flags filename () = + open_out_gen flags mode filename +let _close_out oc () = close_out oc + +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) + +let _write_str oc s () = output oc s 0 (String.length s) +let write_str oc s = Wrap (_write_str oc s) + +let _write_line oc l () = + output_string oc l; + output_char oc '\n' +let write_line oc l = Wrap (_write_line oc l) + +let _write_buf oc buf () = Buffer.output_buffer oc buf +let write_buf oc buf = Wrap (_write_buf oc buf) + +let flush oc = Wrap (fun () -> Pervasives.flush oc) + +(** {2 Seq} *) + +module Seq = struct + type 'a step_result = + | Yield of 'a + | Stop + + type 'a gen = unit -> 'a step_result io + + type 'a t = 'a gen + + let _stop () = return Stop + let _yield x = return (Yield x) + + let map_pure f gen () = + gen() >>= function + | Stop -> _stop () + | Yield x -> _yield (f x) + + let map f g () = + g() >>= function + | Stop -> _stop () + | Yield x -> f x >>= _yield + + let rec filter_map f g () = + g() >>= function + | Stop -> _stop() + | Yield x -> + match f x with + | None -> filter_map f g() + | Some y -> _yield y + + let rec filter f g () = + g() >>= function + | Stop -> _stop() + | Yield x -> + if f x then _yield x else filter f g() + + let rec flat_map f g () = + g() >>= function + | Stop -> _stop () + | Yield x -> + f x >>= fun g' -> _flat_map_aux f g g' () + and _flat_map_aux f g g' () = + g'() >>= function + | Stop -> flat_map f g () + | Yield x -> _yield x + + let general_iter f acc g = + let acc = ref acc in + let rec _next () = + g() >>= function + | Stop -> _stop() + | Yield x -> + f !acc x >>= function + | `Stop -> _stop() + | `Continue (acc', ret) -> + acc := acc'; + match ret with + | None -> _next() + | Some y -> _yield y + in + _next + + let take n seq = + general_iter + (fun n x -> if n<=0 + then return `Stop + else return (`Continue (n-1, Some x)) + ) n seq + + let drop n seq = + general_iter + (fun n x -> if n<=0 + then return (`Continue (n, Some x)) + else return (`Continue (n-1, None)) + ) n seq + + let take_while p seq = + general_iter + (fun () x -> + p x >|= function + | true -> `Continue ((), Some x) + | false -> `Stop + ) () seq + + let drop_while p seq = + general_iter + (fun dropping x -> + if dropping + then p x >|= function + | true -> `Continue (true, None) + | false -> `Continue (false, Some x) + else return (`Continue (false, Some x)) + ) true seq + + (* apply all actions from [l] to [x] *) + let rec _apply_all_to x l = match l with + | [] -> return () + | f::tail -> f x >>= fun () -> _apply_all_to x tail + + let _tee funs g () = + g() >>= function + | Stop -> _stop() + | Yield x -> + _apply_all_to x funs >>= fun () -> + _yield x + + let tee funs g = match funs with + | [] -> g + | _::_ -> _tee funs g + + (** {6 Consume} *) + + let rec fold_pure f acc g = + g() >>= function + | Stop -> return acc + | Yield x -> fold_pure f (f acc x) g + + let length g = fold_pure (fun acc _ -> acc+1) 0 g + + let rec fold f acc g = + g() >>= function + | Stop -> return acc + | Yield x -> + f acc x >>= fun acc' -> fold f acc' g + + let rec iter f g = + g() >>= function + | Stop -> return () + | Yield x -> f x >>= fun _ -> iter f g + + let of_fun g = g + + let empty () = _stop() + + let singleton x = + let first = ref true in + fun () -> + if !first then (first := false; _yield x) else _stop() + + let cons x g = + let first = ref true in + fun () -> + if !first then (first := false; _yield x) else g() + + let of_list l = + let l = ref l in + fun () -> match !l with + | [] -> _stop() + | x::tail -> l:= tail; _yield x + + let of_array a = + let i = ref 0 in + fun () -> + if !i = Array.length a + then _stop() + else ( + let x = a.(!i) in + incr i; + _yield x + ) + + (* TODO: wrapper around with_in? using bind ~finalize:... ? *) + + let chunks ~size ic = + let buf = Buffer.create size in + let eof = ref false in + let next() = + 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 -> + let s = Buffer.contents buf in + eof := true; + if s="" then _stop() else _yield s + in + next + + let lines ic () = + try _yield (input_line ic) + with End_of_file -> _stop() + + let words _g = + failwith "words: not implemented yet" + (* TODO: state machine that goes: + - 0: read input chunk + - switch to "search for ' '", and yield word + - goto 0 if no ' ' found + - yield leftover when g returns Stop + let buf = Buffer.create 32 in + let next() = + g() >>= function + | Stop -> _stop + | Yield s -> + Buffer.add_string buf s; + search_ + in + next + *) + + let output ?sep oc seq = + let first = ref true in + iter + (fun s -> + (* print separator *) + ( if !first + then (first:=false; return ()) + else match sep with + | None -> return () + | Some sep -> write_str oc sep + ) >>= fun () -> + write_str oc s + ) seq + >>= fun () -> flush oc +end + +(** {6 File and file names} *) + +module File = struct + type t = string + + let to_string f = f + + let make f = + if Filename.is_relative f + then Filename.concat (Sys.getcwd()) f + else f + + let exists f = Wrap (fun () -> Sys.file_exists f) + + let is_directory f = Wrap (fun () -> Sys.is_directory f) + + let remove f = Wrap (fun () -> Sys.remove f) + + let _read_dir d () = + if Sys.is_directory d + then + let arr = Sys.readdir d in + Seq.map_pure make (Seq.of_array arr) + else Seq.empty + + let rec _walk d () = + if Sys.is_directory d + then + let arr = Sys.readdir d in + let tail = Seq.of_array arr in + let tail = Seq.flat_map + (fun s -> return (_walk (Filename.concat d s) ())) + tail + in Seq.cons (`Dir,d) tail + else Seq.singleton (`File, d) + + let walk t = Wrap (_walk t) + + let read_dir ?(recurse=false) d = + if recurse + then walk d + >|= Seq.filter_map + (function + | `File, f -> Some f + | `Dir, _ -> None + ) + else Wrap (_read_dir d) + + let rec _read_dir_rec d () = + if Sys.is_directory d + then + let arr = Sys.readdir d in + let arr = Seq.of_array arr in + let arr = Seq.map_pure (fun s -> Filename.concat d s) arr in + Seq.flat_map + (fun s -> + if Sys.is_directory s + then return (_read_dir_rec s ()) + else return (Seq.singleton s) + ) arr + else Seq.empty +end + +(** {2 Raw} *) + +module Raw = struct + let wrap f = Wrap f +end diff --git a/advanced/CCMonadIO.mli b/advanced/CCMonadIO.mli new file mode 100644 index 00000000..03c4216d --- /dev/null +++ b/advanced/CCMonadIO.mli @@ -0,0 +1,323 @@ + +(* +copyright (c) 2013-2014, simon cruanes +all rights reserved. + +redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +redistributions of source code must retain the above copyright notice, this +list of conditions and the following disclaimer. redistributions in binary +form must reproduce the above copyright notice, this list of conditions and the +following disclaimer in the documentation and/or other materials provided with +the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(** {1 IO Monad} + +A simple abstraction over blocking IO, with strict evaluation. This is in +no way an alternative to Lwt/Async if you need concurrency. + +@since 0.3.3 +*) + +(** +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 +(** wait for the result of an action, then use a function to build a + new action and execute it *) + +val return : 'a -> 'a t +(** Just return a value *) + +val repeat : int -> 'a t -> 'a list t +(** Repeat an IO action as many times as required *) + +val repeat' : int -> 'a t -> unit t +(** Same as {!repeat}, but ignores the result *) + +val map : ('a -> 'b) -> 'a t -> 'b t +(** Map values *) + +val (>|=) : 'a t -> ('a -> 'b) -> 'b t + +val bind : ?finalize:(unit t) -> ('a -> 'b t) -> 'a t -> 'b t +(** [bind f a] runs the action [a] and applies [f] to its result + to obtain a new action. It then behaves exactly like this new + action. + @param finalize an optional action that is always run after evaluating + the whole action *) + +val pure : 'a -> 'a t +val (<*>) : ('a -> 'b) t -> 'a t -> 'b t + +val lift : ('a -> 'b) -> 'a t -> 'b t +(** Synonym to {!map} *) + +val lift2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t +val lift3 : ('a -> 'b -> 'c -> 'd) -> 'a t -> 'b t -> 'c t -> 'd t + +val sequence : 'a t list -> 'a list t +(** Runs operations one by one and gather their results *) + +val sequence_map : ('a -> 'b t) -> 'a list -> 'b list t +(** Generalization of {!sequence} *) + +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 +(** Same as {!(>>=)}, but taking the finalizer into account. Once this + IO value is done executing, the finalizer is executed and the resource, + fred. *) + +(** {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 + computation, or some [`Error "message"] *) + +exception IO_error of string + +val run_exn : 'a t -> 'a +(** Unsafe version of {!run}. It assumes non-failure. + @raise IO_error if the execution didn't go well *) + +val register_printer : (exn -> string option) -> unit +(** [register_printer p] register [p] as a possible failure printer. + If [run a] raises an exception [e], [p e] is evaluated. If [p e = Some msg] + then the error message will be [msg], otherwise other printers will + be tried *) + +(** {2 Standard Wrappers} *) + +(** {6 Input} *) + +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 *) + +val read_line : in_channel -> string option t +(** Read a line from the channel. Returns [None] if the input is terminated. *) + +val read_lines : in_channel -> string list t +(** Read all lines eagerly *) + +val read_all : in_channel -> string t +(** Read the whole channel into a buffer, then converted into a string *) + +(** {6 Output} *) + +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 + +val write_str : out_channel -> string -> unit t + +val write_buf : out_channel -> Buffer.t -> unit t + +val write_line : out_channel -> string -> unit t + +val flush : out_channel -> unit t + +(* TODO: printf/fprintf wrappers *) + +(** {2 Streams} + +Iterators on chunks of bytes, or lines, or any other value using combinators. +Those iterators are usable only once, because their source might +be usable only once (think of a socket) *) + +module Seq : sig + type 'a t + (** An IO stream of values of type 'a, consumable (iterable only once) *) + + val map : ('a -> 'b io) -> 'a t -> 'b t + (** Map values with actions *) + + val map_pure : ('a -> 'b) -> 'a t -> 'b t + (** Map values with a pure function *) + + val filter_map : ('a -> 'b option) -> 'a t -> 'b t + + val filter : ('a -> bool) -> 'a t -> 'a t + + val flat_map : ('a -> 'b t io) -> 'a t -> 'b t + (** Map each value to a sub sequence of values *) + + val take : int -> 'a t -> 'a t + + val drop : int -> 'a t -> 'a t + + val take_while : ('a -> bool io) -> 'a t -> 'a t + + val drop_while : ('a -> bool io) -> 'a t -> 'a t + + val general_iter : ('b -> 'a -> [`Stop | `Continue of ('b * 'c option)] io) -> + 'b -> 'a t -> 'c t + (** [general_iter f acc seq] performs a [filter_map] over [seq], + using [f]. [f] is given a state and the current value, and + can either return [`Stop] to indicate it stops traversing, + or [`Continue (st, c)] where [st] is the new state and + [c] an optional output value. + The result is the stream of values output by [f] *) + + val tee : ('a -> unit io) list -> 'a t -> 'a t + (** [tee funs seq] behaves like [seq], but each element is given to + every function [f] in [funs]. This function [f] returns an action that + is eagerly executed. *) + + (** {6 Consume} *) + + val iter : ('a -> _ io) -> 'a t -> unit io + (** Iterate on the stream, with an action for each element *) + + val length : _ t -> int io + (** Length of the stream *) + + val fold : ('b -> 'a -> 'b io) -> 'b -> 'a t -> 'b io + (** [fold f acc seq] folds over [seq], consuming it. Every call to [f] + has the right to return an IO value. *) + + val fold_pure : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b io + (** [fold f acc seq] folds over [seq], consuming it. [f] is pure. *) + + (** {6 Standard Wrappers} *) + + type 'a step_result = + | Yield of 'a + | Stop + + type 'a gen = unit -> 'a step_result io + + val of_fun : 'a gen -> 'a t + (** Create a stream from a function that yields an element or stops *) + + val empty : 'a t + val singleton : 'a -> 'a t + val cons : 'a -> 'a t -> 'a t + val of_list : 'a list -> 'a t + val of_array : 'a array -> 'a t + + val chunks : size:int -> in_channel -> string t + (** Read the channel's content into chunks of size [size] *) + + val lines : in_channel -> string t + (** Lines of an input channel *) + + val words : string t -> string t + (** Split strings into words at " " boundaries. + {b NOT IMPLEMENTED} *) + + val output : ?sep:string -> out_channel -> string t -> unit io + (** [output oc seq] outputs every value of [seq] into [oc], separated + with the optional argument [sep] (default: None). + It blocks until all values of [seq] are produced and written to [oc]. *) +end + +(** {6 File and file names} + +How to list recursively files in a directory: +{[ + CCIO.( + File.read_dir ~recurse:true (File.make "/tmp") + >>= Seq.output ~sep:"\n" stdout + ) |> CCIO.run_exn ;; + + ]} + +See {!File.walk} if you also need to list directories. +*) + +module File : sig + type t = string + (** A file is always represented by its absolute path *) + + val to_string : t -> string + + val make : string -> t + (** Build a file representation from a path (absolute or relative) *) + + val exists : t -> bool io + + val is_directory : t -> bool io + + val remove : t -> unit io + + val read_dir : ?recurse:bool -> t -> t Seq.t io + (** [read_dir d] returns a sequence of files and directory contained + in the directory [d] (or an empty stream if [d] is not a directory) + @param recurse if true (default [false]), sub-directories are also + explored *) + + val walk : t -> ([`File | `Dir] * t) Seq.t io + (** similar to {!read_dir} (with [recurse=true]), this function walks + a directory recursively and yields either files or directories. + Is a file anything that doesn't satisfy {!is_directory} (including + symlinks, etc.) *) +end + +(** {2 Low level access} *) +module Raw : sig + val wrap : (unit -> 'a) -> 'a t + (** [wrap f] is the IO action that, when executed, returns [f ()]. + [f] should be callable as many times as required *) +end diff --git a/core/CCIO.ml b/core/CCIO.ml index 961880e5..5f8a6116 100644 --- a/core/CCIO.ml +++ b/core/CCIO.ml @@ -24,432 +24,127 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) -(** {1 IO Monad} *) +(** {1 IO Utils} *) -type _ t = - | Return : 'a -> 'a t - | Fail : string -> 'a t - | Map : ('a -> 'b) * 'a t -> 'b t - | Bind : ('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 - | SequenceMap : ('a -> 'b t) * 'a list -> 'b list t +type 'a or_error = [ `Ok of 'a | `Error of string ] (** See {!CCError} *) +type 'a gen = unit -> 'a option (** See {!CCGen} *) -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 -> WithGuard (b, Bind (f,a)) - -let map f x = Map(f, x) - -let (>|=) x f = Map(f, x) - -let return x = Return x -let pure = return - -let fail msg = Fail msg - -let (<*>) f a = Star (f, a) - -let lift = map - -let lift2 f a b = - a >>= fun x -> map (f x) b - -let lift3 f a b c = - a >>= fun x -> - b >>= fun y -> map (f x y) c - -let sequence_map f l = - SequenceMap (f,l) - -let sequence l = - let _id x = x in - SequenceMap(_id, l) - -let repeat i a = - if i <= 0 then Return [] else 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 - | Return x -> x - | Fail msg -> raise (IOFailure msg) - | Map (f, a) -> f (_run a) - | Bind (f, a) -> _run (f (_run a)) - | WithGuard (g, a) -> - begin try - let res = _run a in - _run g; - res - with e -> - _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() - | 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 - | 0 -> List.rev acc - | _ -> - let x = _run a in - _repeat (x::acc) (i-1) a -and _repeat_ignore : type a. int -> a t -> unit - = fun i a -> match i with - | 0 -> () - | _ -> - let _ = _run a in - _repeat_ignore (i-1) a -and _sequence_map : type a b. (a -> b t) -> a list -> b list -> b list - = fun f l acc -> match l with - | [] -> List.rev acc - | a::tail -> - let x = _run (f a) in - _sequence_map f tail (x::acc) - -let _printers = - ref [ - (* default printer *) - ( function IOFailure msg - | Sys_error msg -> Some msg - | Exit -> Some "exit" - | _ -> None - ) - ] - -exception PrinterResult of string - -let _print_exn e = +let with_in ?(mode=0o644) ?(flags=[]) filename f = + let ic = open_in_gen flags mode filename in try - List.iter - (fun p -> match p e with - | None -> () - | Some msg -> raise (PrinterResult msg) - ) !_printers; - Printexc.to_string e - with PrinterResult s -> s + let x = f ic in + close_in ic; + x + with e -> + close_in ic; + raise e -let run x = - try `Ok (_run x) - with e -> `Error (_print_exn e) +let read_chunks ?(size=256) ic = + let buf = Buffer.create size in + let eof = ref false in + let next() = + if !eof then None + else try + Buffer.add_channel buf ic size; + let s = Buffer.contents buf in + Buffer.clear buf; + Some s + with End_of_file -> + let s = Buffer.contents buf in + eof := true; + if s="" then None else Some s + in + next -exception IO_error of string - -let run_exn x = - try _run x - with e -> raise (IO_error (_print_exn e)) - -let register_printer p = _printers := p :: !_printers - -(** {2 Standard Wrappers} *) - -let _open_in mode flags filename () = - open_in_gen flags mode filename -let _close_in ic () = close_in ic - -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) - -let _read_line ic () = - try Some (Pervasives.input_line ic) +let read_line ic = + try Some (input_line ic) with End_of_file -> None -let read_line ic = Wrap(_read_line ic) -let rec _read_lines ic acc = - read_line ic - >>= function - | None -> return (List.rev acc) - | Some l -> _read_lines ic (l::acc) +let read_lines ic = + let stop = ref false in + fun () -> + if !stop then None + else try Some (input_line ic) + with End_of_file -> (stop:=true; None) -let read_lines ic = _read_lines ic [] +let read_lines_l ic = + let l = ref [] in + try + while true do + l := input_line ic :: !l + done; + assert false + with End_of_file -> + List.rev !l -let _read_all ic () = - let buf = Buffer.create 128 in +let read_all ic = + let buf = Buffer.create 256 in try while true do Buffer.add_channel buf ic 1024 done; - "" (* never returned *) - with End_of_file -> Buffer.contents buf + assert false (* never reached*) + with End_of_file -> + Buffer.contents buf -let read_all ic = Wrap(_read_all ic) +let with_out ?(mode=0o644) ?(flags=[]) filename f = + let oc = open_out_gen flags mode filename in + try + let x = f oc in + close_out oc; + x + 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_a ?mode ?(flags=[]) filename f = + with_out ?mode ~flags:(Open_creat::Open_append::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) - -let _write_str oc s () = output oc s 0 (String.length s) -let write_str oc s = Wrap (_write_str oc s) - -let _write_line oc l () = - output_string oc l; +let write_line oc s = + output_string oc s; output_char oc '\n' -let write_line oc l = Wrap (_write_line oc l) -let _write_buf oc buf () = Buffer.output_buffer oc buf -let write_buf oc buf = Wrap (_write_buf oc buf) +let write_gen ?(sep="") oc g = + let rec recurse () = match g() with + | None -> () + | Some s -> + output_string oc sep; + output_string oc s; + recurse () + in match g() with + | None -> () + | Some s -> + output_string oc s; + recurse () -let flush oc = Wrap (fun () -> Pervasives.flush oc) +let rec write_lines oc g = match g () with + | None -> () + | Some l -> + write_line oc l; + write_lines oc g -(** {2 Seq} *) +let write_lines_l oc l = + List.iter (write_line oc) l -module Seq = struct - type 'a step_result = - | Yield of 'a - | Stop +let tee funs g () = match g() with + | None -> None + | Some x as res -> + List.iter + (fun f -> + try f x + with _ -> () + ) funs; + res - type 'a gen = unit -> 'a step_result io +(* TODO: lines/unlines: string gen -> string gen *) - type 'a t = 'a gen - - let _stop () = return Stop - let _yield x = return (Yield x) - - let map_pure f gen () = - gen() >>= function - | Stop -> _stop () - | Yield x -> _yield (f x) - - let map f g () = - g() >>= function - | Stop -> _stop () - | Yield x -> f x >>= _yield - - let rec filter_map f g () = - g() >>= function - | Stop -> _stop() - | Yield x -> - match f x with - | None -> filter_map f g() - | Some y -> _yield y - - let rec filter f g () = - g() >>= function - | Stop -> _stop() - | Yield x -> - if f x then _yield x else filter f g() - - let rec flat_map f g () = - g() >>= function - | Stop -> _stop () - | Yield x -> - f x >>= fun g' -> _flat_map_aux f g g' () - and _flat_map_aux f g g' () = - g'() >>= function - | Stop -> flat_map f g () - | Yield x -> _yield x - - let general_iter f acc g = - let acc = ref acc in - let rec _next () = - g() >>= function - | Stop -> _stop() - | Yield x -> - f !acc x >>= function - | `Stop -> _stop() - | `Continue (acc', ret) -> - acc := acc'; - match ret with - | None -> _next() - | Some y -> _yield y - in - _next - - let take n seq = - general_iter - (fun n x -> if n<=0 - then return `Stop - else return (`Continue (n-1, Some x)) - ) n seq - - let drop n seq = - general_iter - (fun n x -> if n<=0 - then return (`Continue (n, Some x)) - else return (`Continue (n-1, None)) - ) n seq - - let take_while p seq = - general_iter - (fun () x -> - p x >|= function - | true -> `Continue ((), Some x) - | false -> `Stop - ) () seq - - let drop_while p seq = - general_iter - (fun dropping x -> - if dropping - then p x >|= function - | true -> `Continue (true, None) - | false -> `Continue (false, Some x) - else return (`Continue (false, Some x)) - ) true seq - - (* apply all actions from [l] to [x] *) - let rec _apply_all_to x l = match l with - | [] -> return () - | f::tail -> f x >>= fun () -> _apply_all_to x tail - - let _tee funs g () = - g() >>= function - | Stop -> _stop() - | Yield x -> - _apply_all_to x funs >>= fun () -> - _yield x - - let tee funs g = match funs with - | [] -> g - | _::_ -> _tee funs g - - (** {6 Consume} *) - - let rec fold_pure f acc g = - g() >>= function - | Stop -> return acc - | Yield x -> fold_pure f (f acc x) g - - let length g = fold_pure (fun acc _ -> acc+1) 0 g - - let rec fold f acc g = - g() >>= function - | Stop -> return acc - | Yield x -> - f acc x >>= fun acc' -> fold f acc' g - - let rec iter f g = - g() >>= function - | Stop -> return () - | Yield x -> f x >>= fun _ -> iter f g - - let of_fun g = g - - let empty () = _stop() - - let singleton x = - let first = ref true in - fun () -> - if !first then (first := false; _yield x) else _stop() - - let cons x g = - let first = ref true in - fun () -> - if !first then (first := false; _yield x) else g() - - let of_list l = - let l = ref l in - fun () -> match !l with - | [] -> _stop() - | x::tail -> l:= tail; _yield x - - let of_array a = - let i = ref 0 in - fun () -> - if !i = Array.length a - then _stop() - else ( - let x = a.(!i) in - incr i; - _yield x - ) - - (* TODO: wrapper around with_in? using bind ~finalize:... ? *) - - let chunks ~size ic = - let buf = Buffer.create size in - let eof = ref false in - let next() = - 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 -> - let s = Buffer.contents buf in - eof := true; - if s="" then _stop() else _yield s - in - next - - let lines ic () = - try _yield (input_line ic) - with End_of_file -> _stop() - - let words _g = - failwith "words: not implemented yet" - (* TODO: state machine that goes: - - 0: read input chunk - - switch to "search for ' '", and yield word - - goto 0 if no ' ' found - - yield leftover when g returns Stop - let buf = Buffer.create 32 in - let next() = - g() >>= function - | Stop -> _stop - | Yield s -> - Buffer.add_string buf s; - search_ - in - next - *) - - let output ?sep oc seq = - let first = ref true in - iter - (fun s -> - (* print separator *) - ( if !first - then (first:=false; return ()) - else match sep with - | None -> return () - | Some sep -> write_str oc sep - ) >>= fun () -> - write_str oc s - ) seq - >>= fun () -> flush oc -end - -(** {6 File and file names} *) +(* TODO: words: string gen -> string gen, + with a state machine that goes: + - 0: read input chunk + - switch to "search for ' '", and yield word + - goto 0 if no ' ' found + - yield leftover when g returns Stop +*) module File = struct type t = string @@ -461,59 +156,53 @@ module File = struct then Filename.concat (Sys.getcwd()) f else f - let exists f = Wrap (fun () -> Sys.file_exists f) + let exists f = Sys.file_exists f - let is_directory f = Wrap (fun () -> Sys.is_directory f) + let is_directory f = Sys.is_directory f - let remove f = Wrap (fun () -> Sys.remove f) + let remove f = Sys.remove f - let _read_dir d () = + let read_dir_base d = if Sys.is_directory d then let arr = Sys.readdir d in - Seq.map_pure make (Seq.of_array arr) - else Seq.empty + CCGen.of_array arr + else CCGen.empty - let rec _walk d () = + let cons_ x tl = + let first=ref true in + fun () -> + if !first then ( + first := false; + Some x + ) else tl () + + let rec walk d = if Sys.is_directory d then let arr = Sys.readdir d in - let tail = Seq.of_array arr in - let tail = Seq.flat_map - (fun s -> return (_walk (Filename.concat d s) ())) + let tail = CCGen.of_array arr in + let tail = CCGen.flat_map + (fun s -> walk (Filename.concat d s)) tail - in Seq.cons (`Dir,d) tail - else Seq.singleton (`File, d) + in cons_ (`Dir,d) tail + else CCGen.singleton (`File, d) - let walk t = Wrap (_walk t) + type walk_item = [`File | `Dir] * t let read_dir ?(recurse=false) d = if recurse - then walk d - >|= Seq.filter_map - (function - | `File, f -> Some f - | `Dir, _ -> None - ) - else Wrap (_read_dir d) - - let rec _read_dir_rec d () = - if Sys.is_directory d then - let arr = Sys.readdir d in - let arr = Seq.of_array arr in - let arr = Seq.map_pure (fun s -> Filename.concat d s) arr in - Seq.flat_map - (fun s -> - if Sys.is_directory s - then return (_read_dir_rec s ()) - else return (Seq.singleton s) - ) arr - else Seq.empty -end + CCGen.filter_map + (function + | `File, f -> Some f + | `Dir, _ -> None + ) (walk d) + else read_dir_base d -(** {2 Raw} *) - -module Raw = struct - let wrap f = Wrap f + let show_walk_item (i,f) = + (match i with + | `File -> "file:" + | `Dir -> "dir: " + ) ^ f end diff --git a/core/CCIO.mli b/core/CCIO.mli index 03c4216d..20bdd622 100644 --- a/core/CCIO.mli +++ b/core/CCIO.mli @@ -24,267 +24,110 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) -(** {1 IO Monad} +(** {1 IO Utils} -A simple abstraction over blocking IO, with strict evaluation. This is in -no way an alternative to Lwt/Async if you need concurrency. +Simple utilities to deal with basic Input/Output tasks in a resource-safe +way. For advanced IO tasks, the user is advised to use something +like Lwt or Async, that are far more comprehensive. +This module depends on {!CCGen}. -@since 0.3.3 -*) +@since NEXT_RELEASE + +{b NOTE} this was formerly a monadic IO module. The old module is now +in [containers.advanced] under the name [CCMonadIO]. -(** Examples: - obtain the list of lines of a file: {[ -let l = CCIO.((with_in "/tmp/some_file" >>>= read_lines) |> run_exn);; +# let l = CCIO.(with_in "/tmp/some_file" read_lines);; ]} - 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 +# CCIO.( + with_in "/tmp/input" + (fun ic -> + with_out ~flags:[Open_creat] ~mode:0o644 "/tmp/output" + (fun oc -> + Seq.chunks 512 ic |> Seq.to_output oc + ) + ) ) ;; - -# run a;; ]} *) -type 'a t -type 'a io = 'a t +type 'a or_error = [ `Ok of 'a | `Error of string ] (** See {!CCError} *) +type 'a gen = unit -> 'a option (** See {!CCGen} *) -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 -(** wait for the result of an action, then use a function to build a - new action and execute it *) - -val return : 'a -> 'a t -(** Just return a value *) - -val repeat : int -> 'a t -> 'a list t -(** Repeat an IO action as many times as required *) - -val repeat' : int -> 'a t -> unit t -(** Same as {!repeat}, but ignores the result *) - -val map : ('a -> 'b) -> 'a t -> 'b t -(** Map values *) - -val (>|=) : 'a t -> ('a -> 'b) -> 'b t - -val bind : ?finalize:(unit t) -> ('a -> 'b t) -> 'a t -> 'b t -(** [bind f a] runs the action [a] and applies [f] to its result - to obtain a new action. It then behaves exactly like this new - action. - @param finalize an optional action that is always run after evaluating - the whole action *) - -val pure : 'a -> 'a t -val (<*>) : ('a -> 'b) t -> 'a t -> 'b t - -val lift : ('a -> 'b) -> 'a t -> 'b t -(** Synonym to {!map} *) - -val lift2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t -val lift3 : ('a -> 'b -> 'c -> 'd) -> 'a t -> 'b t -> 'c t -> 'd t - -val sequence : 'a t list -> 'a list t -(** Runs operations one by one and gather their results *) - -val sequence_map : ('a -> 'b t) -> 'a list -> 'b list t -(** Generalization of {!sequence} *) - -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 -(** Same as {!(>>=)}, but taking the finalizer into account. Once this - IO value is done executing, the finalizer is executed and the resource, - fred. *) - -(** {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 - computation, or some [`Error "message"] *) - -exception IO_error of string - -val run_exn : 'a t -> 'a -(** Unsafe version of {!run}. It assumes non-failure. - @raise IO_error if the execution didn't go well *) - -val register_printer : (exn -> string option) -> unit -(** [register_printer p] register [p] as a possible failure printer. - If [run a] raises an exception [e], [p e] is evaluated. If [p e = Some msg] - then the error message will be [msg], otherwise other printers will - be tried *) - -(** {2 Standard Wrappers} *) - -(** {6 Input} *) +(** {2 Input} *) 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. *) + string -> (in_channel -> 'a) -> 'a +(** Open an input file with the given optional flag list, calls the function + on the input channel. When the function raises or returns, the + channel is closed. *) -val read : in_channel -> string -> int -> int -> int t -(** Read a chunk into the given string *) +val read_chunks : ?size:int -> in_channel -> string gen +(** Read the channel's content into chunks of size [size] *) -val read_line : in_channel -> string option t -(** Read a line from the channel. Returns [None] if the input is terminated. *) +val read_line : in_channel -> string option +(** Read a line from the channel. Returns [None] if the input is terminated. + The "\n" is removed from the line. *) -val read_lines : in_channel -> string list t -(** Read all lines eagerly *) +val read_lines : in_channel -> string gen +(** Read all lines. The generator should be traversed only once. *) -val read_all : in_channel -> string t +val read_lines_l : in_channel -> string list +(** Read all lines into a list *) + +val read_all : in_channel -> string (** Read the whole channel into a buffer, then converted into a string *) (** {6 Output} *) val with_out : ?mode:int -> ?flags:open_flag list -> - string -> out_channel with_finalizer + string -> (out_channel -> 'a) -> 'a (** Same as {!with_in} but for an output channel *) val with_out_a : ?mode:int -> ?flags:open_flag list -> - string -> out_channel with_finalizer + string -> (out_channel -> 'a) -> 'a (** Similar to {!with_out} but with the [Open_append] and [Open_creat] flags activated *) -val write : out_channel -> string -> int -> int -> unit t +val write_line : out_channel -> string -> unit +(** Write the given string on the channel, followed by "\n" *) -val write_str : out_channel -> string -> unit t +val write_gen : ?sep:string -> out_channel -> string gen -> unit +(** Write the given strings on the output. If provided, add [sep] between + every two string (but not at the end) *) -val write_buf : out_channel -> Buffer.t -> unit t +val write_lines : out_channel -> string gen -> unit +(** Write every string on the output, followed by "\n". *) -val write_line : out_channel -> string -> unit t +val write_lines_l : out_channel -> string list -> unit -val flush : out_channel -> unit t +(** {2 Misc for Generators} *) -(* TODO: printf/fprintf wrappers *) - -(** {2 Streams} - -Iterators on chunks of bytes, or lines, or any other value using combinators. -Those iterators are usable only once, because their source might -be usable only once (think of a socket) *) - -module Seq : sig - type 'a t - (** An IO stream of values of type 'a, consumable (iterable only once) *) - - val map : ('a -> 'b io) -> 'a t -> 'b t - (** Map values with actions *) - - val map_pure : ('a -> 'b) -> 'a t -> 'b t - (** Map values with a pure function *) - - val filter_map : ('a -> 'b option) -> 'a t -> 'b t - - val filter : ('a -> bool) -> 'a t -> 'a t - - val flat_map : ('a -> 'b t io) -> 'a t -> 'b t - (** Map each value to a sub sequence of values *) - - val take : int -> 'a t -> 'a t - - val drop : int -> 'a t -> 'a t - - val take_while : ('a -> bool io) -> 'a t -> 'a t - - val drop_while : ('a -> bool io) -> 'a t -> 'a t - - val general_iter : ('b -> 'a -> [`Stop | `Continue of ('b * 'c option)] io) -> - 'b -> 'a t -> 'c t - (** [general_iter f acc seq] performs a [filter_map] over [seq], - using [f]. [f] is given a state and the current value, and - can either return [`Stop] to indicate it stops traversing, - or [`Continue (st, c)] where [st] is the new state and - [c] an optional output value. - The result is the stream of values output by [f] *) - - val tee : ('a -> unit io) list -> 'a t -> 'a t - (** [tee funs seq] behaves like [seq], but each element is given to - every function [f] in [funs]. This function [f] returns an action that - is eagerly executed. *) - - (** {6 Consume} *) - - val iter : ('a -> _ io) -> 'a t -> unit io - (** Iterate on the stream, with an action for each element *) - - val length : _ t -> int io - (** Length of the stream *) - - val fold : ('b -> 'a -> 'b io) -> 'b -> 'a t -> 'b io - (** [fold f acc seq] folds over [seq], consuming it. Every call to [f] - has the right to return an IO value. *) - - val fold_pure : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b io - (** [fold f acc seq] folds over [seq], consuming it. [f] is pure. *) - - (** {6 Standard Wrappers} *) - - type 'a step_result = - | Yield of 'a - | Stop - - type 'a gen = unit -> 'a step_result io - - val of_fun : 'a gen -> 'a t - (** Create a stream from a function that yields an element or stops *) - - val empty : 'a t - val singleton : 'a -> 'a t - val cons : 'a -> 'a t -> 'a t - val of_list : 'a list -> 'a t - val of_array : 'a array -> 'a t - - val chunks : size:int -> in_channel -> string t - (** Read the channel's content into chunks of size [size] *) - - val lines : in_channel -> string t - (** Lines of an input channel *) - - val words : string t -> string t - (** Split strings into words at " " boundaries. - {b NOT IMPLEMENTED} *) - - val output : ?sep:string -> out_channel -> string t -> unit io - (** [output oc seq] outputs every value of [seq] into [oc], separated - with the optional argument [sep] (default: None). - It blocks until all values of [seq] are produced and written to [oc]. *) -end +val tee : ('a -> unit) list -> 'a gen -> 'a gen +(** [tee funs gen] behaves like [gen], but each element is given to + every function [f] in [funs] at the time the element is produced. *) (** {6 File and file names} How to list recursively files in a directory: {[ - CCIO.( - File.read_dir ~recurse:true (File.make "/tmp") - >>= Seq.output ~sep:"\n" stdout - ) |> CCIO.run_exn ;; +# let files = CCIO.File.read_dir ~recurse:true (CCIO.File.make "/tmp");; +# CCIO.write_lines stdout files;; +]} - ]} +See {!File.walk} if you also need to list directories: -See {!File.walk} if you also need to list directories. +{[ +# let content = CCIO.File.walk (CCIO.File.make "/tmp");; +# CCGen.map CCIO.File.show_walk_item content |> CCIO.write_lines stdout;; *) module File : sig @@ -296,28 +139,25 @@ module File : sig val make : string -> t (** Build a file representation from a path (absolute or relative) *) - val exists : t -> bool io + val exists : t -> bool - val is_directory : t -> bool io + val is_directory : t -> bool - val remove : t -> unit io + val remove : t -> unit - val read_dir : ?recurse:bool -> t -> t Seq.t io + val read_dir : ?recurse:bool -> t -> t gen (** [read_dir d] returns a sequence of files and directory contained in the directory [d] (or an empty stream if [d] is not a directory) @param recurse if true (default [false]), sub-directories are also explored *) - val walk : t -> ([`File | `Dir] * t) Seq.t io + type walk_item = [`File | `Dir] * t + + val walk : t -> walk_item gen (** similar to {!read_dir} (with [recurse=true]), this function walks a directory recursively and yields either files or directories. Is a file anything that doesn't satisfy {!is_directory} (including symlinks, etc.) *) -end -(** {2 Low level access} *) -module Raw : sig - val wrap : (unit -> 'a) -> 'a t - (** [wrap f] is the IO action that, when executed, returns [f ()]. - [f] should be callable as many times as required *) + val show_walk_item : walk_item -> string end