let copy
?(ignore_strange=false) ?(symlinks=`Fail) ?(buffer_size=64_000)
?(if_exists=`Fail)
~src dst =
let rec copy_aux ~src ~dst =
file_info src
>>= begin function
| `Absent -> fail (`File_not_found src)
| `Block_device
| `Character_device
| `Fifo
| `Socket as k ->
if ignore_strange then return () else fail (`Wrong_file_kind (src, k))
| `Symlink content ->
begin match symlinks with
| `Fail -> fail (`Wrong_file_kind (src, `Symlink content))
| `Follow -> copy_aux ~src:content ~dst
| `Redo ->
let link_path = path_of_destination ~src ~dst in
begin match if_exists with
| `Fail ->
return ()
| `Overwrite
| `Update -> remove link_path
end
>>= fun () ->
make_symlink ~target:content ~link_path
end
| `Regular_file _->
let output_path = path_of_destination ~src ~dst in
let open_spec =
match if_exists with
| `Fail -> `Create_file output_path
| `Overwrite | `Update -> `Overwrite_file output_path
in
IO.with_out_channel ~buffer_size open_spec ~f:(fun outchan ->
IO.with_in_channel ~buffer_size (`File src) ~f:(fun inchan ->
let rec loop () =
IO.read ~count:buffer_size inchan
>>= begin function
| "" -> return ()
| buf ->
IO.write outchan buf >>= fun () ->
loop ()
end
in
loop ()))
| `Directory ->
let new_dir = path_of_destination ~src ~dst in
file_info new_dir
>>= begin function
| `Absent ->
make_new_directory new_dir
| smth_else ->
begin match if_exists with
| `Fail -> fail (`File_exists new_dir)
| `Overwrite ->
remove new_dir
>>= fun () ->
make_new_directory new_dir
| `Update ->
if smth_else = `Directory
then return ()
else fail (`Not_a_directory new_dir)
end
end
>>= fun () ->
let `Stream next_dir = list_directory src in
let rec loop () =
next_dir ()
>>= begin function
| Some ".."
| Some "." -> loop ()
| Some name ->
copy_aux
~src:(Filename.concat src name)
~dst:(`Into new_dir)
>>= fun () ->
loop ()
| None -> return ()
end
in
loop ()
end
in
(copy_aux ~src ~dst
>>< begin function
| `Ok () -> return ()
| `Error err ->
begin match err with
| `IO (`Exn e) -> fail (`System (`Copy src, `Exn e))
| `IO (`File_exists _)
| `IO (`Wrong_path _)
| `File_exists _
| `File_not_found _
| `Not_a_directory _
| `Wrong_file_kind _ as e -> fail (`System (`Copy src, e))
| `System e -> fail (`System e)
end
end)