simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2025-12-06 11:15:31 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source
This commit is contained in:
Simon Cruanes 2014-11-23 12:54:28 +01:00
parent 13862b5133
commit cb311bf764
5 changed files with 1038 additions and 667 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
_oasis
View file

@ -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

519
advanced/CCMonadIO.ml Normal file
View file

@ -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

323
advanced/CCMonadIO.mli Normal file
View file

@ -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

565
core/CCIO.ml
View file

@ -24,433 +24,128 @@ 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
let with_in ?(mode=0o644) ?(flags=[]) filename f =
let ic = open_in_gen flags mode filename in
try
let x = f ic in
close_in ic;
x
with e ->
_run g;
close_in ic;
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 read_chunks ?(size=256) ic =
let buf = Buffer.create size in
let eof = ref false in
let next() =
if !eof then _stop()
if !eof then None
else try
Buffer.add_channel buf ic size;
let s = Buffer.contents buf in
Buffer.clear buf;
_yield s
Some s
with End_of_file ->
let s = Buffer.contents buf in
eof := true;
if s="" then _stop() else _yield s
if s="" then None else Some s
in
next
let lines ic () =
try _yield (input_line ic)
with End_of_file -> _stop()
let read_line ic =
try Some (input_line ic)
with End_of_file -> None
let words _g =
failwith "words: not implemented yet"
(* TODO: state machine that goes:
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_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 256 in
try
while true do
Buffer.add_channel buf ic 1024
done;
assert false (* never reached*)
with End_of_file ->
Buffer.contents buf
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 with_out_a ?mode ?(flags=[]) filename f =
with_out ?mode ~flags:(Open_creat::Open_append::flags) filename f
let write_line oc s =
output_string oc s;
output_char oc '\n'
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 rec write_lines oc g = match g () with
| None -> ()
| Some l ->
write_line oc l;
write_lines oc g
let write_lines_l oc l =
List.iter (write_line oc) l
let tee funs g () = match g() with
| None -> None
| Some x as res ->
List.iter
(fun f ->
try f x
with _ -> ()
) funs;
res
(* TODO: lines/unlines: string gen -> string gen *)
(* 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
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)
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
then
CCGen.filter_map
(function
| `File, f -> Some f
| `Dir, _ -> None
)
else Wrap (_read_dir d)
) (walk d)
else read_dir_base 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
let show_walk_item (i,f) =
(match i with
| `File -> "file:"
| `Dir -> "dir: "
) ^ f
end

290
core/CCIO.mli
View file

@ -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