let file_tree ?(follow_symlinks=false) path =
let directory p l = return (`Node (p, l)) in
let file p l = return (`Leaf (p, l)) in
let rec find_aux ?name_to_report path =
let name =
match name_to_report with
| Some s -> s
| None -> Filename.basename path in
file_info path
>>= begin function
| `Absent -> fail (`File_not_found path)
| `Block_device
| `Character_device
| `Fifo
| `Regular_file _
| `Socket as k -> file name k
| `Symlink content as k ->
begin match follow_symlinks with
| true ->
let continue =
if Filename.is_relative content
then (Filename.concat path content)
else content in
find_aux ~name_to_report:(Filename.basename path) continue
| false ->
file name k
end
| `Directory ->
let `Stream next_dir = list_directory path in
let rec loop acc =
next_dir ()
>>= begin function
| Some ".."
| Some "." -> loop acc
| Some name -> loop (name :: acc)
| None -> return acc
end
in
loop []
>>= fun sub_list ->
List.fold_left
~init:(return []) (List.sort ~cmp:String.compare sub_list)
~f:(fun prev dir ->
prev >>= fun l ->
find_aux (Filename.concat path dir)
>>= fun newone ->
return (newone :: l))
>>| List.rev
>>= fun sub_tree ->
directory name sub_tree
end
in
(find_aux path
>>< function
| `Ok o -> return o
| `Error e ->
begin match e with
| `Io_exn e -> fail (`System (`File_tree path, `Exn e))
| `File_not_found _ as e -> fail (`System (`File_tree path, e))
| `System e -> fail (`System e)
end)