simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2025-12-09 12:45:34 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions 2

deal properly with broken symlinks and permission errors

Browse source
This commit is contained in:
Simon Cruanes 2016-11-11 00:12:06 +01:00
parent 8e2fd235bb
commit f29329fb03
1 changed files with 9 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
src/core/CCIO.ml
View file

@ -6,6 +6,8 @@
type 'a or_error = ('a, string) Result.result type 'a or_error = ('a, string) Result.result
type 'a gen = unit -> 'a option type 'a gen = unit -> 'a option
let gen_empty () = None
let gen_singleton x = let gen_singleton x =
let done_ = ref false in let done_ = ref false in
fun () -> if !done_ then None else (done_ := true; Some x) fun () -> if !done_ then None else (done_ := true; Some x)
@ -294,14 +296,17 @@ module File = struct
) else tl () ) else tl ()
let rec walk d = let rec walk d =
if Sys.is_directory d if not (Sys.file_exists d) then gen_empty
then else if Sys.is_directory d
let arr = Sys.readdir d in then (
(* try to list the directory *)
let arr = try Sys.readdir d with Sys_error _ -> [||] in
let tail = gen_of_array arr in let tail = gen_of_array arr in
let tail = gen_flat_map let tail = gen_flat_map
(fun s -> walk (Filename.concat d s)) (fun s -> walk (Filename.concat d s))
tail tail
in cons_ (`Dir,d) tail in cons_ (`Dir,d) tail
)
else gen_singleton (`File, d) else gen_singleton (`File, d)
(*$R (*$R
@ -327,7 +332,7 @@ module File = struct
(walk d) (walk d)
else read_dir_base d else read_dir_base d
let show_walk_item (i,f) = let show_walk_item ((i,f):walk_item) =
(match i with (match i with
| `File -> "file:" | `File -> "file:"
| `Dir -> "dir:" | `Dir -> "dir:"