Shell: improve Lwt_utils

This commit is contained in:
Grégoire Henry 2017-01-23 11:09:39 +01:00
parent 31872eb1b1
commit a65ad52620
2 changed files with 12 additions and 6 deletions

View File

@ -346,12 +346,14 @@ let remove_dir dir =
Lwt.return () Lwt.return ()
let rec create_dir ?(perm = 0o755) dir = let rec create_dir ?(perm = 0o755) dir =
if Sys.file_exists dir then Lwt_unix.file_exists dir >>= function
Lwt.return () | false ->
else begin
create_dir (Filename.dirname dir) >>= fun () -> create_dir (Filename.dirname dir) >>= fun () ->
Lwt_unix.mkdir dir perm Lwt_unix.mkdir dir perm
end | true ->
Lwt_unix.stat dir >>= function
| {st_kind = S_DIR} -> Lwt.return_unit
| _ -> failwith "Not a directory"
let create_file ?(perm = 0o644) name content = let create_file ?(perm = 0o644) name content =
Lwt_unix.openfile name Unix.([O_TRUNC; O_CREAT; O_WRONLY]) perm >>= fun fd -> Lwt_unix.openfile name Unix.([O_TRUNC; O_CREAT; O_WRONLY]) perm >>= fun fd ->
@ -402,4 +404,6 @@ let with_timeout ?(canceler = Canceler.create ()) timeout f =
Canceler.cancel canceler >>= fun () -> Canceler.cancel canceler >>= fun () ->
fail Timeout fail Timeout
let unless cond f =
if cond then Lwt.return () else f ()

View File

@ -67,3 +67,5 @@ val with_timeout:
?canceler:Canceler.t -> ?canceler:Canceler.t ->
float -> (Canceler.t -> 'a tzresult Lwt.t) -> 'a tzresult Lwt.t float -> (Canceler.t -> 'a tzresult Lwt.t) -> 'a tzresult Lwt.t
val unless: bool -> (unit -> unit Lwt.t) -> unit Lwt.t