breaking change: renamed CCIO to advanced.CCMonadIO; new CCIO module, much simpler

_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

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

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

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 =
+type 'a or_error = [ `Ok of 'a | `Error of string ]  (** See {!CCError} *)
-  | Return : 'a -> 'a t
+type 'a gen = unit -> 'a option  (** See {!CCGen} *)
-  | 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
+let with_in ?(mode=0o644) ?(flags=[]) filename f =
-type 'a with_finalizer = ('a t * unit t) t
+  let ic = open_in_gen flags mode filename in
-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
+    let x = f ic in
-      (fun p -> match p e with
+    close_in ic;
-        | None -> ()
+    x
-        | Some msg -> raise (PrinterResult msg)
+  with e ->
-      ) !_printers;
+    close_in ic;
-    Printexc.to_string e
+    raise e
-  with PrinterResult s -> s
 
-let run x =
+let read_chunks ?(size=256) ic =
-  try `Ok (_run x)
+  let buf = Buffer.create size in
-  with e -> `Error (_print_exn e)
+  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 read_line ic =
-
+  try Some (input_line ic)
-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 =
+let read_lines ic =
-  read_line ic
+  let stop = ref false in
-  >>= function
+  fun () ->
-  | None -> return (List.rev acc)
+    if !stop then None
-  | Some l -> _read_lines ic (l::acc)
+    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 read_all ic =
-  let buf = Buffer.create 128 in
+  let buf = Buffer.create 256 in
   try
     while true do
       Buffer.add_channel buf ic 1024
     done;
-    ""  (* never returned *)
+    assert false (* never reached*)
-  with End_of_file -> Buffer.contents buf
+  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 () =
+let with_out_a ?mode ?(flags=[]) filename f =
-  open_out_gen flags mode filename
+  with_out ?mode ~flags:(Open_creat::Open_append::flags) filename f
-let _close_out oc () = close_out oc
 
-let with_out ?(mode=0o644) ?(flags=[]) filename =
+let write_line oc s =
-  Wrap(_open_out mode (Open_wronly::flags) filename)
+  output_string oc s;
-  >>= 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_gen ?(sep="") oc g =
-let write_buf oc buf = Wrap (_write_buf oc buf)
+  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
+let tee funs g () = match g() with
-  type 'a step_result =
+  | None -> None
-    | Yield of 'a
+  | Some x as res ->
-    | Stop
+      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
+(* TODO:  words: string gen -> string gen,
-
+  with a state machine that goes:
-  let _stop () = return Stop
+  - 0: read input chunk
-  let _yield x = return (Yield x)
+  - switch to "search for ' '", and yield word
-
+  - goto 0 if no ' ' found
-  let map_pure f gen () =
+  - yield leftover when g returns Stop
-    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
@@ -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)
+      CCGen.of_array arr
-    else Seq.empty
+    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 = CCGen.of_array arr in
-      let tail = Seq.flat_map
+      let tail = CCGen.flat_map
-        (fun s -> return (_walk (Filename.concat d s) ()))
+        (fun s -> walk (Filename.concat d s))
         tail
-      in Seq.cons (`Dir,d) tail
+      in cons_ (`Dir,d) tail
-    else Seq.singleton (`File, d)
+    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
+      CCGen.filter_map
-      let arr = Seq.of_array arr in
+        (function
-      let arr = Seq.map_pure (fun s -> Filename.concat d s) arr in
+          | `File, f -> Some f
-      Seq.flat_map
+          | `Dir, _ -> None
-        (fun s ->
+        ) (walk d)
-          if Sys.is_directory s
+    else read_dir_base d
-            then return (_read_dir_rec s ())
-            else return (Seq.singleton s)
-        ) arr
-    else Seq.empty
-end
 
-(** {2 Raw} *)
+  let show_walk_item (i,f) =
-
+    (match i with
-module Raw = struct
+      | `File -> "file:"
-  let wrap f = Wrap f
+      | `Dir -> "dir: "
+    ) ^ f
 end

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
+Simple utilities to deal with basic Input/Output tasks in a resource-safe
-no way an alternative to Lwt/Async if you need concurrency.
+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.(
+# CCIO.(
-  with_in "input" >>>= fun ic ->
+  with_in "/tmp/input"
-  with_out ~flags:[Open_creat] "output" >>>= fun oc ->
+    (fun ic ->
-  Seq.chunks 512 ic
+      with_out ~flags:[Open_creat] ~mode:0o644 "/tmp/output"
-  |> Seq.output oc
+        (fun oc ->
+          Seq.chunks 512 ic |> Seq.to_output oc
+        )
+    )
 ) ;;
-
-# run a;;
 ]}
 *)
 
-type 'a t
+type 'a or_error = [ `Ok of 'a | `Error of string ]  (** See {!CCError} *)
-type 'a io = 'a t
+type 'a gen = unit -> 'a option  (** See {!CCGen} *)
 
-type 'a with_finalizer
+(** {2 Input} *)
-(** 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
+              string -> (in_channel -> 'a) -> 'a
-(** Open an input file with the given optional flag list.
+(** Open an input file with the given optional flag list, calls the function
-    It yields a [in_channel] with a finalizer attached. See {!(>>>=)} to
+    on the input channel. When the function raises or returns, the
-    use it. *)
+    channel is closed. *)
 
-val read : in_channel -> string -> int -> int -> int t
+val read_chunks : ?size:int -> in_channel -> string gen
-(** Read a chunk into the given string *)
+(** Read the channel's content into chunks of size [size] *)
 
-val read_line : in_channel -> string option t
+val read_line : in_channel -> string option
-(** Read a line from the channel. Returns [None] if the input is terminated. *)
+(** 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
+val read_lines : in_channel -> string gen
-(** Read all lines eagerly *)
+(** 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 *)
+val tee : ('a -> unit) list -> 'a gen -> 'a gen
-
+(** [tee funs gen] behaves like [gen], but each element is given to
-(** {2 Streams}
+    every function [f] in [funs] at the time the element is produced. *)
-
-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.(
+# let files = CCIO.File.read_dir ~recurse:true (CCIO.File.make "/tmp");;
-    File.read_dir ~recurse:true (File.make "/tmp")
+# CCIO.write_lines stdout files;;
-    >>= Seq.output ~sep:"\n" stdout
+]}
-  ) |> CCIO.run_exn ;;
 
-  ]}
+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} *)
+  val show_walk_item : walk_item -> string
-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