Commits

Sebastien Mondet  committed 6c93fc7

System: make API uniform (polymorphic variants)

  • Participants
  • Parent commits 9bf0a24

Comments (0)

Files changed (3)

File pvem_lwt_unix.ml

   (** {3 Access To Channels } *)
 
   (** Run a function [f] on an output channel, if the channel comes from
-      a [`file f], it will be closed before returning (in case of success,
+      a [`File f], it will be closed before returning (in case of success,
       or error, but not for exceptions). *)
   val with_out_channel:
     ?buffer_size:int ->
   val flush: Lwt_io.output_channel ->  (unit, [> `IO of [> `Exn of exn ] ]) t
 
   (** Run a function [f] on an input channel, if the channel comes from
-      a [`file f], it will be closed before returning (in case of success,
+      a [`File f], it will be closed before returning (in case of success,
       or error, but not for exceptions). *)
   val with_in_channel:
     [ `Channel of Lwt_io.input_channel | `File of string | `Stdin ] ->
   (** Basic system access functions. *)
 
   (** Block for a given amount of seconds ([Lwt_unix.sleep]). *)
-  val sleep: float -> (unit, [> `system_exn of exn ]) t
+  val sleep: float -> (unit, [> `System of [> `Sleep of float]  * [> `Exn of exn ]]) t
 
   (** Manipulate [/bin/sh] commands (flavors of [Unix.system]).  *)
   module Shell : sig
     (** Make [/bin/sh] execute a command, fail if it does not return 0. *)
     val do_or_fail: string ->
       (unit,
-       [> `shell of
-            string * [> `exited of int | `exn of exn | `signaled of int | `stopped of int ]
+       [> `Shell of
+            string * [> `Exited of int | `Exn of exn | `Signaled of int | `Stopped of int ]
        ]) t
 
     (** Execute a shell command and return its standard output, standard error,
         [stdout, stderr]. *)
     val execute:
       string ->
-      (string * string * [ `exited of int | `signaled of int | `stopped of int ],
-       [> `shell of string * [> `exn of exn ]]) t
+      (string * string * [ `Exited of int | `Signaled of int | `Stopped of int ],
+       [> `Shell of string * [> `Exn of exn ]]) t
 
   end
 
   (** Execute a function [f] with a timeout (in seconds). If [f] throws
-      an exception it will be passed as [`system_exn e], if the functions
-      timeouts the error will be [`timeout time]. *)
+      an exception it will be passed as [`System (_, e)], if the functions
+      timeouts the error will be [`Timeout time]. *)
   val with_timeout : float ->
-    f:(unit -> ('a, [> `system_exn of exn | `timeout of float ] as 'b) t) ->
-    ('a, 'b) t
+    f:(unit -> ('a, [> `Timeout of float
+                    | `System of [> `With_timeout of float ] * [> `Exn of exn ] 
+                    ] as 'error) t) -> 
+    ('a, 'error) t
 
   (** Create a new empty directory or fail if it already exists
       (i.e. like [mkdir]). The default permissions are [0o700]. *)
   val make_new_directory: ?perm:int -> string ->
     (unit,
-     [> `system of
-          [> `make_directory of string ] *
-            [> `already_exists | `exn of exn
-            | `wrong_access_rights of int ] ]) t
+     [> `System of
+          [> `Make_directory of string ] *
+            [> `Already_exists | `Exn of exn
+            | `Wrong_access_rights of int ] ]) t
 
   (** Create as many directories as needed (can be 0) to ensure that the
       directory path exists (like [mkdir -p]). The default permissions
       are [0o700].  *)
   val ensure_directory_path: ?perm:int -> string ->
     (unit,
-     [> `system of
-          [> `make_directory of string ] *
-            [> `exn of exn | `wrong_access_rights of int ] ]) t
+     [> `System of
+          [> `Make_directory of string ] *
+            [> `Exn of exn | `Wrong_access_rights of int ] ]) t
 
   (** Quick information on files. *)
   type file_info =
-    [ `absent
-    | `regular_file of int
-    | `symlink of string
-    | `block_device
-    | `character_device
-    | `directory
-    | `fifo
-    | `socket]
+    [ `Absent
+    | `Regular_file of int
+    | `Symlink of string
+    | `Block_device
+    | `Character_device
+    | `Directory
+    | `Fifo
+    | `Socket]
 
   (** Get information about a path (whether it exists, its size, or
       sym-link destination). If [follow_symlink] is [false]
-      (default) use [lstat] (so the result can be [`symlink _]), if [true]
+      (default) use [lstat] (so the result can be [`Symlink _]), if [true]
       call [stat] (information about the target).  *)
   val file_info :
     ?follow_symlink:bool -> string ->
     (file_info,
-     [> `system of [> `file_info of string ] * [> `exn of exn ] ]) t
+     [> `System of [> `File_info of string ] * [> `Exn of exn ] ]) t
 
   (** Get all the children of a directory, through a [next] stream-like
       function. *)
   val list_directory: string ->
-    [ `stream of
+    [ `Stream of
         (unit ->
          (string option,
-          [> `system of [> `list_directory of string ] * [> `exn of exn ] ]) t) ]
+          [> `System of [> `List_directory of string ] * [> `Exn of exn ] ]) t) ]
 
   (** Remove a file or a directory recursively. [remove] does not fail
       if the file does not exist.  *)
   val remove: string ->
     (unit,
-     [> `system of [> `file_info of string
+     [> `System of [> `File_info of string
                    | `IO of [> `File_exists of string | `Wrong_path of string ]
-                   | `remove of string
-                   | `list_directory of string ] * [> `exn of exn ] ]) t
+                   | `Remove of string
+                   | `List_directory of string ] * [> `Exn of exn ] ]) t
 
   (** Make a symbolic link [link_path] pointing at
       [target]. [make_symlink] fails if the file [link_path] already
       exists. *)
   val make_symlink: target:string -> link_path:string ->
     (unit,
-     [> `system of [> `make_symlink of string * string]
-                   * [> `file_exists of string
-                     | `exn of exn ] ]) t
+     [> `System of [> `Make_symlink of string * string]
+                   * [> `File_exists of string
+                     | `Exn of exn ] ]) t
 
   (** Specification of a “destination” for [copy] and [move]. *)
   type file_destination = [
-    | `into of string (** [`into path] means copy 'file' into the {b directory} path. *)
-    | `onto of string (** [`onto path] means copy 'file' {b as} [path]. *)
+    | `Into of string (** [`Into path] means copy 'file' into the {b directory} path. *)
+    | `Onto of string (** [`Onto path] means copy 'file' {b as} [path]. *)
   ]
 
   (** Copy files or directories (recursively).
       The [buffer_size] (default [64_000]) is used both for reading and
       writing files.
 
-      On can [`fail] on symbolic links, [`follow] them, or [`redo] a new
+      On can [`Fail] on symbolic links, [`Follow] them, or [`Redo] a new
       symlink with the same target.
 
   *)
   val copy:
     ?ignore_strange:bool ->
-    ?symlinks:[ `fail | `follow | `redo ] ->
+    ?symlinks:[ `Fail | `Follow | `Redo ] ->
     ?buffer_size:int ->
-    ?if_exists:[ `fail | `overwrite | `update ] ->
+    ?if_exists:[ `Fail | `Overwrite | `Update ] ->
     src:string -> file_destination ->
     (unit,
-     [> `system of
-          [> `copy of string
-          | `file_info of string
-          | `list_directory of string
-          | `make_symlink of string * string
-          | `remove of string
-          | `make_directory of string ] *
-            [> `already_exists
+     [> `System of
+          [> `Copy of string
+          | `File_info of string
+          | `List_directory of string
+          | `Make_symlink of string * string
+          | `Remove of string
+          | `Make_directory of string ] *
+            [> `Already_exists
             | `IO of [> `File_exists of string | `Wrong_path of string ]
-            | `exn of exn
-            | `file_exists of string
-            | `wrong_path of string
-            | `file_not_found of string
-            | `wrong_access_rights of int
-            | `not_a_directory of string
-            | `wrong_file_kind of
+            | `Exn of exn
+            | `File_exists of string
+            | `Wrong_path of string
+            | `File_not_found of string
+            | `Wrong_access_rights of int
+            | `Not_a_directory of string
+            | `Wrong_file_kind of
                 string *
-                  [> `block_device | `character_device
-                  | `fifo | `socket | `symlink of string ] ] ]) t
+                  [> `Block_device | `Character_device
+                  | `Fifo | `Socket | `Symlink of string ] ] ]) t
 
   (** Try to move [src] to [dest] using [Lwt_unix.rename], if it works,
-      return [`moved] if it does not work but [copy] could work
+      return [`Moved] if it does not work but [copy] could work
       (i.e. both paths are not in the same {i device}) return
-      [`must_copy]. *)
+      [`Must_copy]. *)
   val move_in_same_device:
-    ?if_exists:[ `fail | `overwrite | `update ] ->
+    ?if_exists:[ `Fail | `Overwrite | `Update ] ->
     src:string -> file_destination ->
-    ([ `moved | `must_copy ],
-     [> `system of [> `move of string | `file_info of string ]
-                   * [> `exn of exn
-                     | `file_exists of string] ]) t
+    ([ `Moved | `Must_copy ],
+     [> `System of [> `Move of string | `File_info of string ]
+                   * [> `Exn of exn
+                     | `File_exists of string] ]) t
 
   (** Heavy-weight function trying to mimic the behavior the UNIX command “mv”
       (c.f. {{:http://www.openbsd.org/cgi-bin/cvsweb/src/bin/mv/mv.c?rev=1.35;content-type=text%2Fplain;only_with_tag=HEAD}mv.c}):
-      it tries [move_in_same_device] and if it returns [`must_copy] it
+      it tries [move_in_same_device] and if it returns [`Must_copy] it
       calls [copy] and [remove] (if [copy] fails, the [remove] won't
       happen but there will be no clean-up of the files already
       copied).
   *)
   val move:
     ?ignore_strange:bool ->
-    ?symlinks:[ `fail | `follow | `redo ] ->
+    ?symlinks:[ `Fail | `Follow | `Redo ] ->
     ?buffer_size:int ->
-    ?if_exists:[ `fail | `overwrite | `update ] ->
+    ?if_exists:[ `Fail | `Overwrite | `Update ] ->
     src:string -> file_destination ->
     (unit,
-     [> `system of
-          [> `copy of string
-          | `move of string
-          | `remove of string
-          | `file_info of string
-          | `list_directory of string
-          | `make_symlink of string * string
-          | `make_directory of string ] *
-            [> `already_exists
+     [> `System of
+          [> `Copy of string
+          | `Move of string
+          | `Remove of string
+          | `File_info of string
+          | `List_directory of string
+          | `Make_symlink of string * string
+          | `Make_directory of string ] *
+            [> `Already_exists
             | `IO of [> `File_exists of string | `Wrong_path of string ]
-            | `exn of exn
-            | `file_exists of string
-            | `wrong_path of string
-            | `file_not_found of string
-            | `wrong_access_rights of int
-            | `not_a_directory of string
-            | `wrong_file_kind of
+            | `Exn of exn
+            | `File_exists of string
+            | `Wrong_path of string
+            | `File_not_found of string
+            | `Wrong_access_rights of int
+            | `Not_a_directory of string
+            | `Wrong_file_kind of
                 string *
-                  [> `block_device | `character_device
-                  | `fifo | `socket | `symlink of string ] ] ]) t
+                  [> `Block_device | `Character_device
+                  | `Fifo | `Socket | `Symlink of string ] ] ]) t
 
-  (** Representation of a hierarchy of files ([`leaf]) and directories ([`node]). *)
+  (** Representation of a hierarchy of files ([`Leaf]) and directories ([`Node]). *)
   type file_tree = [
-    | `node of string * file_tree list
-    | `leaf of string * file_info
+    | `Node of string * file_tree list
+    | `Leaf of string * file_info
   ]
 
   (** Obtain the [file_tree] starting at a given path. *)
   val file_tree :
     ?follow_symlinks:bool ->
     string ->
-    (file_tree, [> `system of
-                     [> `file_info of string
-                     | `file_tree of string
-                     | `list_directory of string ] *
-                       [> `exn of exn
-                       | `file_not_found of string] ]) t
+    (file_tree, [> `System of
+                     [> `File_info of string
+                     | `File_tree of string
+                     | `List_directory of string ] *
+                       [> `Exn of exn
+                       | `File_not_found of string] ]) t
 end
 
 
 
 module System : SYSTEM = struct
 
-  let wrap_deferred_system f =
-    wrap_deferred f ~on_exn:(fun e -> `system_exn e)
+  let wrap_deferred_system cmd f =
+    wrap_deferred f ~on_exn:(fun e -> `System (cmd, `Exn e))
+  let fail_sys r = fail (`System r)
 
   module Shell = struct
 
     let discriminate_process_status s ret =
       begin match ret with
       | Lwt_unix.WEXITED 0 -> return ()
-      | Lwt_unix.WEXITED n -> fail (`shell (s, `exited n))
-      | Lwt_unix.WSIGNALED n ->
-        fail (`shell (s, `signaled n))
-      | Lwt_unix.WSTOPPED n -> fail (`shell (s, `stopped n))
+      | Lwt_unix.WEXITED n -> fail (`Shell (s, `Exited n))
+      | Lwt_unix.WSIGNALED n -> fail (`Shell (s, `Signaled n))
+      | Lwt_unix.WSTOPPED n -> fail (`Shell (s, `Stopped n))
     end
 
   let do_or_fail s =
     wrap_deferred  Lwt_io.(fun () -> Lwt_unix.system s)
-      ~on_exn:(fun e -> `shell (s, `exn e))
+      ~on_exn:(fun e -> `Shell (s, `Exn e))
     >>= fun ret ->
     discriminate_process_status s ret
 
 
   let execute s =
-    wrap_deferred ~on_exn:(fun e -> `shell (s, `exn e))
+    wrap_deferred ~on_exn:(fun e -> `Shell (s, `Exn e))
       Lwt.(fun () ->
           let inprocess = Lwt_process.(open_process_full (shell s)) in
           Lwt_list.map_p Lwt_io.read
     >>= fun (ret, output) ->
     let code =
       match ret with
-      | Lwt_unix.WEXITED n ->   (`exited n)
-      | Lwt_unix.WSIGNALED n -> (`signaled n)
-      | Lwt_unix.WSTOPPED n ->  (`stopped n)
+      | Lwt_unix.WEXITED n ->   (`Exited n)
+      | Lwt_unix.WSIGNALED n -> (`Signaled n)
+      | Lwt_unix.WSTOPPED n ->  (`Stopped n)
     in
     begin match output with
     | [out; err] -> return (out, err, code)
 
 
   let sleep f =
-    wrap_deferred_system (fun () -> Lwt_unix.sleep f)
+    wrap_deferred_system (`Sleep f) (fun () -> Lwt_unix.sleep f)
 
   let with_timeout time ~f =
     Lwt.catch
         Lwt_unix.with_timeout time f
       end
       begin function
-      | Lwt_unix.Timeout -> fail (`timeout time)
-      | e -> fail (`system_exn e)
+      | Lwt_unix.Timeout -> fail (`Timeout time)
+      | e -> fail_sys (`With_timeout time, `Exn e)
       end
 
 
   let mkdir_or_fail ?(perm=0o700) dirname =
+    let fail_here e =
+      fail_sys (`Make_directory dirname, e) in
     Lwt.catch
       Lwt.(fun () -> Lwt_unix.mkdir dirname perm >>= fun () -> return (`Ok ()))
       begin function
       | Unix.Unix_error (Unix.EACCES, cmd, arg)  ->
-        fail (`system (`make_directory dirname, `wrong_access_rights perm))
+        fail_here (`Wrong_access_rights perm)
       | Unix.Unix_error (Unix.EEXIST, cmd, arg)  ->
-        fail (`system (`make_directory dirname, `already_exists))
+        fail_here (`Already_exists)
       | Unix.Unix_error (Unix.EISDIR, cmd, arg)  ->
         (* Bypass MacOSX bug https://github.com/janestreet/core/issues/7 *)
-        fail (`system (`make_directory dirname, `already_exists))
-      | e ->
-        fail (`system (`make_directory dirname, `exn e))
+        fail_here (`Already_exists)
+      | e -> fail_here (`Exn e)
       end
 
   let mkdir_even_if_exists ?(perm=0o700) dirname =
+    let fail_here e =
+      fail_sys (`Make_directory dirname, e) in
     Lwt.catch
       Lwt.(fun () -> Lwt_unix.mkdir dirname perm >>= fun () -> return (`Ok ()))
       begin function
       | Unix.Unix_error (Unix.EACCES, cmd, arg)  ->
-        fail (`system (`make_directory dirname, `wrong_access_rights perm))
+        fail_here (`Wrong_access_rights perm)
       | Unix.Unix_error (Unix.EISDIR, cmd, arg)  ->
         (* Bypass MacOSX bug https://github.com/janestreet/core/issues/7 *)
         return ()
       | Unix.Unix_error (Unix.EEXIST, cmd, arg)  -> return ()
-      | e -> fail (`system (`make_directory dirname, `exn e))
+      | e -> fail_here (`Exn e)
       end
 
   let make_new_directory ?perm dirname =
     return ()
 
   type file_info =
-    [ `absent
-    | `regular_file of int
-    | `symlink of string
-    | `block_device
-    | `character_device
-    | `directory
-    | `fifo
-    | `socket]
+    [ `Absent
+    | `Regular_file of int
+    | `Symlink of string
+    | `Block_device
+    | `Character_device
+    | `Directory
+    | `Fifo
+    | `Socket]
 
 (*
   WARNING: this is a work-around for issue [329] with Lwt_unix.readlink.
       if follow_symlink then Lwt_unix.stat else Lwt_unix.lstat in
     (* eprintf "(l)stat %s? \n%!" path; *)
     Lwt.catch
-      Lwt.(fun () -> stat_fun path >>= fun s -> return (`Ok (`unix_stats s)))
+      Lwt.(fun () -> stat_fun path >>= fun s -> return (`Ok (`Unix_stats s)))
       begin function
-      | Unix.Unix_error (Unix.ENOENT, cmd, arg)  -> return `absent
-      | e -> fail (`system (`file_info path, `exn e))
+      | Unix.Unix_error (Unix.ENOENT, cmd, arg)  -> return `Absent
+      | e -> fail_sys (`File_info path, `Exn e)
       end
     >>= fun m ->
     let open Lwt_unix in
     begin match m with
-    | `absent -> return `absent
-    | `unix_stats stats ->
+    | `Absent -> return `Absent
+    | `Unix_stats stats ->
       begin match stats.st_kind with
-      | S_DIR -> return (`directory)
-      | S_REG -> return (`regular_file (stats.st_size))
+      | S_DIR -> return (`Directory)
+      | S_REG -> return (`Regular_file (stats.st_size))
       | S_LNK ->
         (* eprintf "readlink %s? \n%!" path; *)
         begin
           catch_deferred (fun () -> lwt_unix_readlink path)
           >>< begin function
           | `Ok s -> return s
-          | `Error e -> fail (`system (`file_info path, `exn e))
+          | `Error e -> fail (`System (`File_info path, `Exn e))
           end
         end
         >>= fun destination ->
         (* eprintf "readlink %s worked \n%!" path; *)
-        return (`symlink destination)
-      | S_CHR -> return (`character_device)
-      | S_BLK -> return (`block_device)
-      | S_FIFO -> return (`fifo)
-      | S_SOCK -> return (`socket)
+        return (`Symlink destination)
+      | S_CHR -> return (`Character_device)
+      | S_BLK -> return (`Block_device)
+      | S_FIFO -> return (`Fifo)
+      | S_SOCK -> return (`Socket)
       end
     end
 
   let list_directory path =
     let f_stream = Lwt_unix.files_of_directory path in
     let next s =
-      wrap_deferred ~on_exn:(fun e -> `system (`list_directory path, `exn e))
+      wrap_deferred ~on_exn:(fun e -> `System (`List_directory path, `Exn e))
         Lwt.(fun () ->
             catch (fun () -> Lwt_stream.next s >>= fun n -> return (Some n))
               (function Lwt_stream.Empty -> return None | e -> fail e)) in
-    `stream (fun () -> (next f_stream))
+    `Stream (fun () -> (next f_stream))
 
   let remove path =
     let rec remove_aux path =
       file_info path
       >>= begin function
-      | `absent -> return ()
-      | `block_device
-      | `character_device
-      | `symlink _
-      | `fifo
-      | `socket
-      | `regular_file _-> wrap_deferred_system (fun () -> Lwt_unix.unlink path)
-      | `directory ->
-        let `stream next_dir = list_directory path in
+      | `Absent -> return ()
+      | `Block_device
+      | `Character_device
+      | `Symlink _
+      | `Fifo
+      | `Socket
+      | `Regular_file _-> wrap_deferred_system (`Remove path) (fun () -> Lwt_unix.unlink path)
+      | `Directory ->
+        let `Stream next_dir = list_directory path in
         let rec loop () =
           next_dir ()
           >>= begin function
         in
         loop ()
         >>= fun () ->
-        wrap_deferred_system (fun () -> Lwt_unix.rmdir path)
+        wrap_deferred_system (`Remove path) (fun () -> Lwt_unix.rmdir path)
       end
     in
     remove_aux path
     >>< begin function
     | `Ok () -> return ()
-    | `Error (`system_exn e) -> fail (`system (`remove path, `exn e))
-    | `Error (`system e) -> fail (`system e)
+    | `Error (`System_exn e) -> fail (`System (`Remove path, `Exn e))
+    | `Error (`System e) -> fail (`System e)
     end
 
   let make_symlink ~target ~link_path =
       ~on_exn:(fun e ->
           begin match e with
           | Unix.Unix_error (Unix.EEXIST, cmd, arg)  ->
-            (`system (`make_symlink (target, link_path), `file_exists link_path))
-          | e ->  (`system (`make_symlink (target, link_path), `exn e))
+            (`System (`Make_symlink (target, link_path), `File_exists link_path))
+          | e ->  (`System (`Make_symlink (target, link_path), `Exn e))
           end)
 
   type file_destination = [
-    | `into of string
-    | `onto of string
+    | `Into of string
+    | `Onto of string
   ]
   let path_of_destination ~src ~dst =
     match dst with
-    | `into p -> Filename.(concat p (basename src))
-    | `onto p -> p
+    | `Into p -> Filename.(concat p (basename src))
+    | `Onto p -> p
 
   let copy
-      ?(ignore_strange=false) ?(symlinks=`fail) ?(buffer_size=64_000)
-      ?(if_exists=`fail)
+      ?(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 ->
+      | `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 ->
+        | `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 -> (* make_symlink already fails on existing files *)
+          | `Fail -> (* make_symlink already fails on existing files *)
             return ()
-          | `overwrite
-          | `update -> remove link_path (* remove does not fail on missing files *)
+          | `Overwrite
+          | `Update -> remove link_path (* remove does not fail on missing files *)
           end
           >>= fun () ->
           make_symlink ~target:content ~link_path
         end
-      | `regular_file _->
+      | `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
+          | `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 ->
                   end
                 in
                 loop ()))
-      | `directory ->
+      | `Directory ->
         let new_dir = path_of_destination ~src ~dst in
         file_info new_dir
         >>= begin function
-        | `absent ->
+        | `Absent ->
           make_new_directory new_dir
         | smth_else ->
           begin match if_exists with
-          | `fail -> fail (`file_exists new_dir)
-          | `overwrite ->
+          | `Fail -> fail (`File_exists new_dir)
+          | `Overwrite ->
             remove new_dir
             >>= fun () ->
             make_new_directory new_dir
-          | `update ->
-            if smth_else = `directory
+          | `Update ->
+            if smth_else = `Directory
             then return ()
-            else fail (`not_a_directory new_dir)
+            else fail (`Not_a_directory new_dir)
           end
         end
         >>= fun () ->
-        let `stream next_dir = list_directory src in
+        let `Stream next_dir = list_directory src in
         let rec loop () =
           next_dir ()
           >>= begin function
           | Some name ->
             copy_aux
               ~src:(Filename.concat src name)
-              ~dst:(`into new_dir)
+              ~dst:(`Into new_dir)
             >>= fun () ->
             loop ()
           | None -> return ()
      | `Ok () -> return ()
      | `Error err ->
        begin match err with
-       | `IO (`Exn e) -> fail (`system (`copy src, `exn e))
+       | `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)
+       | `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)
 
-  let move_in_same_device ?(if_exists=`fail) ~src dst =
+  let move_in_same_device ?(if_exists=`Fail) ~src dst =
     let real_dest = path_of_destination ~src ~dst in
     begin match if_exists with
-    | `fail ->
+    | `Fail ->
       file_info real_dest
       >>= begin function
-      | `absent -> return ()
-      | _ -> fail (`system (`move src, `file_exists real_dest))
+      | `Absent -> return ()
+      | _ -> fail (`System (`Move src, `File_exists real_dest))
       end
     | _ -> (* Unix.rename does overwriting *) return ()
     end
     >>= fun () ->
     Lwt.catch
-      Lwt.(fun () -> Lwt_unix.rename src real_dest >>= fun () -> return (`Ok `moved))
+      Lwt.(fun () -> Lwt_unix.rename src real_dest >>= fun () -> return (`Ok `Moved))
       begin function
-      | Unix.Unix_error (Unix.EXDEV, cmd, arg)  -> return `must_copy
-      | Unix.Unix_error (Unix.ENOTEMPTY, cmd, arg)  -> return `must_copy
-      | e -> fail (`system (`move src, `exn e))
+      | Unix.Unix_error (Unix.EXDEV, cmd, arg)  -> return `Must_copy
+      | Unix.Unix_error (Unix.ENOTEMPTY, cmd, arg)  -> return `Must_copy
+      | e -> fail (`System (`Move src, `Exn e))
       end
 
   let move ?ignore_strange ?symlinks ?buffer_size ?if_exists ~src dst =
     move_in_same_device ?if_exists ~src dst
     >>= begin function
-    | `moved -> return ()
-    | `must_copy ->
+    | `Moved -> return ()
+    | `Must_copy ->
       copy ~src ?buffer_size ?ignore_strange ?symlinks ?if_exists dst
       >>= fun () ->
       remove src
 
 
   type file_tree = [
-    | `node of string * file_tree list
-    | `leaf of string * file_info
+    | `Node of string * file_tree list
+    | `Leaf of string * file_info
   ]
 
   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 directory p l = return (`Node (p, l)) in
+    let file p l = return (`Leaf (p, l)) in
     let rec find_aux path =
       file_info path
       >>= begin function
-      | `absent -> fail (`file_not_found path)
-      | `block_device
-      | `character_device
-      | `fifo
-      | `regular_file _
-      | `socket as k -> file (Filename.basename path) k
-      | `symlink content as k ->
+      | `Absent -> fail (`File_not_found path)
+      | `Block_device
+      | `Character_device
+      | `Fifo
+      | `Regular_file _
+      | `Socket as k -> file (Filename.basename path) k
+      | `Symlink content as k ->
         begin match follow_symlinks with
         | true ->
           let continue =
           find_aux continue
         | false -> file (Filename.basename path) k
         end
-      | `directory ->
-        let `stream next_dir = list_directory path in
+      | `Directory ->
+        let `Stream next_dir = list_directory path in
         let rec loop acc =
           next_dir ()
           >>= begin 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)
+       | `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)
 
 

File test/io_test.ml

 let say fmt =
   ksprintf (fun s -> eprintf "%s\n%!" s) fmt
 
-let wrap_deferred_io f =
-  wrap_deferred (fun () -> f ()) ~on_exn:(fun e -> `io_test_exn e)
-
 let copy () =
   let tmp = Filename.temp_file "io_test_copy" ".bin" in
   IO.write_file tmp ~content:"foo!"
     |`Error (`IO (`File_exists p)) -> return ()
     (* |`Error (`IO (`Exn e)) -> *)
       (* eprintf "io_exn: %s\n%!" Exn.(to_string e); *)
-      (* fail (`io_exn e) *)
+      (* fail (`Io_exn e) *)
     |`Error e -> fail e
     end
   end

File test/system_test.ml

     System.Shell.do_or_fail s) fmt
 
 let fail_test fmt =
-  ksprintf (fun s -> fail (`failed_test s)) fmt
+  ksprintf (fun s -> fail (`Failed_test s)) fmt
 
 let test_make_directory () =
   let tmp = Filename.temp_dir "sys_test_make_directory" "_dir" in
     System.ensure_directory_path "/please_dont_run_tests_as_root"
     >>< begin function
     | `Ok () -> say "ERROR: This should have failed!!"; return ()
-    | `Error (`system (`make_directory _, `wrong_access_rights _)) -> return ()
+    | `Error (`System (`Make_directory _, `Wrong_access_rights _)) -> return ()
     | `Error e -> say "ERROR: Got wrong error"; fail e
     end
   end
     System.make_new_directory tmp
     >>< begin function
     | `Ok () -> fail_test "This should have failed make_directory ~parents:false"
-    | `Error (`system (`make_directory _, `already_exists)) -> return ()
+    | `Error (`System (`Make_directory _, `Already_exists)) -> return ()
     | `Error e -> fail e
     end
   end
     System.file_info ?follow_symlink path
     >>= begin function
     | o when matches o -> return ()
-    | e -> fail (`wrong_file_info (path, e))
+    | e -> fail (`Wrong_file_info (path, e))
     end
   in
-  check ((=) `directory) "/" >>= fun () ->
-  check (function `regular_file _ -> true | _ -> false) "/etc/passwd" >>= fun () ->
-  ksprintf (check ((=) (`symlink "/etc/passwd"))) "%s/symlink_to_file" tmp
+  check ((=) `Directory) "/" >>= fun () ->
+  check (function `Regular_file _ -> true | _ -> false) "/etc/passwd" >>= fun () ->
+  ksprintf (check ((=) (`Symlink "/etc/passwd"))) "%s/symlink_to_file" tmp
   >>= fun () ->
-  ksprintf (check ((=) (`symlink "/tmp"))) "%s/symlink_to_dir" tmp
+  ksprintf (check ((=) (`Symlink "/tmp"))) "%s/symlink_to_dir" tmp
   >>= fun () ->
-  check ((=) `absent) "/sldkfjslakjfdlksj"
+  check ((=) `Absent) "/sldkfjslakjfdlksj"
   >>= fun () ->
 
   ksprintf System.Shell.do_or_fail "ls -l %s " tmp
 let is_present ?(and_matches=(fun _ -> true)) path =
   System.file_info path
   >>= begin function
-  | `absent -> fail (`wrong_file_info (path, `absent))
+  | `Absent -> fail (`Wrong_file_info (path, `Absent))
   | any when and_matches any -> return ()
-  | any_other -> fail (`wrong_file_info (path, any_other))
+  | any_other -> fail (`Wrong_file_info (path, any_other))
   end
 
 let is_absent path =
   System.file_info path
   >>= begin function
-  | `absent -> return ()
-  | e -> fail (`wrong_file_info (path, e))
+  | `Absent -> return ()
+  | e -> fail (`Wrong_file_info (path, e))
   end
 
 let random_tree path max_number_creations =
 let test_remove style =
   let in_dir =
     match style with
-    | `relative -> "test_flow_system_remove"
-    | `absolute -> "/tmp/test_flow_system_remove" in
+    | `Relative -> "test_flow_system_remove"
+    | `Absolute -> "/tmp/test_flow_system_remove" in
   cmdf "rm -fr %s" in_dir
   >>= fun () ->
   System.ensure_directory_path in_dir
   >>= fun () ->
   System.file_info test_regular
   >>= begin function
-  | `regular_file l when l > 2 -> return ()
-  | e -> fail (`wrong_file_info (test_regular, e))
+  | `Regular_file l when l > 2 -> return ()
+  | e -> fail (`Wrong_file_info (test_regular, e))
   end
   >>= fun () ->
   System.remove test_regular
   let test_symlink = Filename.concat in_dir "test_symlink" in
   System.make_symlink ~target:"/tmp/bouh" ~link_path:test_symlink
   >>= fun () ->
-  is_present ~and_matches:((=) (`symlink "/tmp/bouh")) test_symlink >>= fun () ->
+  is_present ~and_matches:((=) (`Symlink "/tmp/bouh")) test_symlink >>= fun () ->
   System.remove test_symlink >>= fun () ->
   is_absent test_symlink >>= fun () ->
   say "Removed: %s" test_symlink;
 
 let check_error_file_exists name expected_path =
   begin function
-  | `Ok () -> fail_test "%s: default 'if_exists' should be `fail" name
-  | `Error (`system (_, (`file_exists p))) when p = expected_path -> return ()
-  | `Error (`system (_, `IO (`File_exists p))) when p = expected_path -> return ()
+  | `Ok () -> fail_test "%s: default 'if_exists' should be `Fail" name
+  | `Error (`System (_, (`File_exists p))) when p = expected_path -> return ()
+  | `Error (`System (_, `IO (`File_exists p))) when p = expected_path -> return ()
   | `Error e -> fail e
   end
 
 let test_copy style_in style_out =
   let out_dir =
     match style_out with
-    | `relative -> "test_flow_system_copy_target"
-    | `absolute -> "/tmp/test_flow_system_copy_target" in
+    | `Relative -> "test_flow_system_copy_target"
+    | `Absolute -> "/tmp/test_flow_system_copy_target" in
   let in_dir =
     match style_in with
-    | `relative -> "test_flow_system_copy"
-    | `absolute -> "/tmp/test_flow_system_copy" in
+    | `Relative -> "test_flow_system_copy"
+    | `Absolute -> "/tmp/test_flow_system_copy" in
   say "test_copy %s/… → %s/…" in_dir out_dir;
   cmdf "rm -fr %s" in_dir >>= fun () ->
   cmdf "rm -fr %s" out_dir >>= fun () ->
   System.make_symlink ~target:"/tmp/bouh" ~link_path:test_symlink
   >>= fun () ->
 
-  say "`redo symlinks %s into %s" test_symlink out_dir;
-  System.copy ~symlinks:`redo ~src:test_symlink (`into out_dir)
+  say "`Redo symlinks %s into %s" test_symlink out_dir;
+  System.copy ~symlinks:`Redo ~src:test_symlink (`Into out_dir)
   >>= fun () ->
   let expected_path = Filename.concat out_dir "test_symlink" in
-  is_present ~and_matches:((=) (`symlink "/tmp/bouh")) expected_path
+  is_present ~and_matches:((=) (`Symlink "/tmp/bouh")) expected_path
   >>= fun () ->
 
-  System.copy ~symlinks:`redo ~src:test_symlink (`into out_dir)
+  System.copy ~symlinks:`Redo ~src:test_symlink (`Into out_dir)
   >>< check_error_file_exists "copy-redo-symlink" expected_path
   >>= fun () ->
 
-  System.copy ~symlinks:`redo ~src:test_symlink ~if_exists:`overwrite (`into out_dir)
+  System.copy ~symlinks:`Redo ~src:test_symlink ~if_exists:`Overwrite (`Into out_dir)
   >>= fun () ->
 
   say "redo symlink %s as %s" test_symlink out_dir;
   let dst = Filename.concat out_dir "test_symlink_new" in
-  System.copy ~symlinks:`redo ~src:test_symlink (`onto dst)
+  System.copy ~symlinks:`Redo ~src:test_symlink (`Onto dst)
   >>= fun () ->
-  is_present ~and_matches:((=) (`symlink "/tmp/bouh")) dst
+  is_present ~and_matches:((=) (`Symlink "/tmp/bouh")) dst
   >>= fun () ->
   System.remove dst (* we remove this one to be able to compare with
                        file_tree at the end *)
     let content = String.make size 'B' in
     IO.write_file test_reg_file ~content
     >>= fun () ->
-    System.copy ~src:test_reg_file (`into out_dir)
+    System.copy ~src:test_reg_file (`Into out_dir)
     >>= fun () ->
     let expected_path = Filename.(concat out_dir (basename test_reg_file)) in
-    is_present ~and_matches:((=) (`regular_file size)) expected_path
+    is_present ~and_matches:((=) (`Regular_file size)) expected_path
     >>= fun () ->
     IO.read_file expected_path
     >>= fun content_got ->
           test_reg_file expected_path
     end
     >>= fun () ->
-    System.copy ~src:test_reg_file (`into out_dir)
+    System.copy ~src:test_reg_file (`Into out_dir)
     >>< check_error_file_exists "copy-file" expected_path
     >>= fun () ->
     (* This one should work: *)
-    System.copy ~if_exists:`overwrite ~src:test_reg_file (`into out_dir)
+    System.copy ~if_exists:`Overwrite ~src:test_reg_file (`Into out_dir)
   in
   test_copy_file 200 >>= fun () ->
   test_copy_file 200_000 >>= fun () ->
   random_tree subtree_path 20
   >>= fun () ->
 
-  System.copy ~symlinks:`redo ~src:subtree_path (`into out_dir)
+  System.copy ~symlinks:`Redo ~src:subtree_path (`Into out_dir)
   >>= fun () ->
 
-  System.copy ~src:subtree_path (`into out_dir)
+  System.copy ~src:subtree_path (`Into out_dir)
   >>< check_error_file_exists "copy-whole-random-tree"
     Filename.(concat out_dir "random_tree")
   >>= fun () ->
     System.file_tree ~follow_symlinks:false out_dir
     >>= fun out_tree ->
     begin match in_tree, out_tree with
-    | `node (inname, lin), `node (outname, lout)
+    | `Node (inname, lin), `Node (outname, lout)
       when inname = Filename.basename in_dir
       && outname = Filename.basename out_dir
         && lin = lout ->
   compare_file_trees in_dir out_dir "after copy + copy-failure"
   >>= fun () ->
 
-  (* `overwrite should succeed and leave exactly the same result. *)
-  System.copy ~if_exists:`overwrite ~symlinks:`redo ~src:subtree_path (`into out_dir)
+  (* `Overwrite should succeed and leave exactly the same result. *)
+  System.copy ~if_exists:`Overwrite ~symlinks:`Redo ~src:subtree_path (`Into out_dir)
   >>= fun () ->
   compare_file_trees in_dir out_dir "after overwriting"
   >>= fun () ->
 
-  (* `update should add/overwrite files but not remove *)
+  (* `Update should add/overwrite files but not remove *)
   System.file_tree ~follow_symlinks:false out_dir
   >>= fun init_dir ->
   System.remove subtree_path  >>= fun () ->
      subtree_path/file *)
   System.file_tree ~follow_symlinks:false out_dir
   >>= fun out_tree_before ->
-  System.copy ~if_exists:`update ~symlinks:`redo ~src:subtree_path (`into out_dir)
+  System.copy ~if_exists:`Update ~symlinks:`Redo ~src:subtree_path (`Into out_dir)
   >>= fun () ->
   System.file_tree ~follow_symlinks:false out_dir
   >>= fun out_tree ->
   let rec path_list path tree =
     match tree with
-    | `leaf (f, _) -> [Filename.concat path f]
-    | `node (n, l) ->
+    | `Leaf (f, _) -> [Filename.concat path f]
+    | `Node (n, l) ->
       let now = Filename.concat path n in
       now :: List.concat_map l ~f:(fun sub -> path_list now sub)
   in
   begin match out_tree_before, out_tree with
-  | `node (dir, content_before), `node (same, content_after) when dir = same ->
+  | `Node (dir, content_before), `Node (same, content_after) when dir = same ->
     let paths_before = path_list "." out_tree_before in
     let paths_after = path_list "." out_tree in
     let check f =
   | _ ->
     (* say "out_tree_before: %s" (Sexp.to_string_hum (System.sexp_of_file_tree out_tree_before)); *)
     (* say "out_tree: %s" (Sexp.to_string_hum (System.sexp_of_file_tree out_tree)); *)
-    fail_test "out_tree_before <> out_tree (copy `update)"
+    fail_test "out_tree_before <> out_tree (copy `Update)"
   end
   >>= fun () ->
 
 
 let test_move style_in style_out =
   (*
-    Note: to test the `move` function in the [`must_copy] case one has to
+    Note: to test the `Move` function in the [`Must_copy] case one has to
     launch this test from another partition than the one containing "/tmp".
   *)
   let out_dir =
     match style_out with
-    | `relative -> "test_flow_system_move_target"
-    | `absolute -> "/tmp/test_flow_system_move_target" in
+    | `Relative -> "test_flow_system_move_target"
+    | `Absolute -> "/tmp/test_flow_system_move_target" in
   let in_dir =
     match style_in with
-    | `relative -> "test_flow_system_move"
-    | `absolute -> "/tmp/test_flow_system_move" in
+    | `Relative -> "test_flow_system_move"
+    | `Absolute -> "/tmp/test_flow_system_move" in
   say "test_move %s/… → %s/…" in_dir out_dir;
   cmdf "rm -fr %s" in_dir >>= fun () ->
   cmdf "rm -fr %s" out_dir >>= fun () ->
   let test_symlink = Filename.concat in_dir "test_symlink" in
   System.make_symlink ~target:"/tmp/bouh" ~link_path:test_symlink
   >>= fun () ->
-  System.move ~symlinks:`redo ~src:test_symlink (`into out_dir)
+  System.move ~symlinks:`Redo ~src:test_symlink (`Into out_dir)
   >>= fun () ->
   let expected_path = Filename.concat out_dir "test_symlink" in
-  is_present ~and_matches:((=) (`symlink "/tmp/bouh")) expected_path
+  is_present ~and_matches:((=) (`Symlink "/tmp/bouh")) expected_path
   >>= fun () ->
   is_absent test_symlink >>= fun () ->
 
   >>= fun src_tree ->
 
   let new_tree = Filename.concat out_dir "random_tree_moved" in
-  System.move ~symlinks:`redo ~src:subtree_path (`onto new_tree)
+  System.move ~symlinks:`Redo ~src:subtree_path (`Onto new_tree)
   >>= fun () ->
   System.file_tree ~follow_symlinks:false new_tree
   >>= fun dst_tree ->
   >>= fun () ->
 
   begin match src_tree, dst_tree with
-  | `node (inname, lin), `node (outname, lout)
+  | `Node (inname, lin), `Node (outname, lout)
     when inname = "random_tree" && outname = "random_tree_moved"
                 && lin = lout ->
     return ()
   >>= fun () ->
   System.ensure_directory_path (Filename.concat out_dir "somedir")
   >>= fun () ->
-  System.move (Filename.concat in_dir "somedir") (`into out_dir)
+  System.move (Filename.concat in_dir "somedir") (`Into out_dir)
   >>< check_error_file_exists "move should fail if exists"
     (Filename.concat out_dir "somedir")
   >>= fun () ->
-  System.move ~if_exists:`update ~src:(Filename.concat in_dir "somedir") (`into out_dir)
+  System.move ~if_exists:`Update ~src:(Filename.concat in_dir "somedir") (`Into out_dir)
   >>= fun () ->
 
   System.remove in_dir >>= fun () ->
 
   bind_on_error (silent "ls /some_big_path")
     begin function
-    | `shell (_, `exited 2) | `shell (_, `exited 1) -> return ()
+    | `Shell (_, `Exited 2) | `Shell (_, `Exited 1) -> return ()
     | e -> fail e
     end
   >>= fun () ->
 
   bind_on_error (silent "kill $$")
     begin function
-    | `shell (_, `signaled s) when s = Caml.Sys.sigterm -> return ()
+    | `Shell (_, `Signaled s) when s = Caml.Sys.sigterm -> return ()
     | e -> fail e
     end
   >>= fun () ->
 
   bind_on_error (silent "kill -9 $$")
     begin function
-    | `shell (_, `signaled s) when s = Caml.Sys.sigkill -> return ()
+    | `Shell (_, `Signaled s) when s = Caml.Sys.sigkill -> return ()
     | e -> fail e
     end
   >>= fun () ->
       | (sin, sout, ex) when ok sin sout ex -> return ()
       | (sin, sout, ex) ->
         fail_test "output of '%s':\n%S\n%S\n%S" s sin sout
-          (<:sexp_of< [ `exited of int | `signaled of int | `stopped of int ] >>
+          (<:sexp_of< [ `Exited of int | `Signaled of int | `Stopped of int ] >>
               ex |! Sexp.to_string_hum)
       end
     ) fmt  in
 
   check_output "ls /"
     ~ok:(fun sin sout ex ->
-      ex = `exited 0 && sout = "" && String.length sin > 10)
+      ex = `Exited 0 && sout = "" && String.length sin > 10)
   >>= fun () ->
 
   check_output "ls /some_big_path"
-    ~ok:(fun sin sout ex -> ex = `exited 2 || ex = `exited 1)
+    ~ok:(fun sin sout ex -> ex = `Exited 2 || ex = `Exited 1)
   >>= fun () ->
 
-  check_output "kill -9 $$" ~ok:(fun _ _ ex -> ex = `signaled Caml.Sys.sigkill)
+  check_output "kill -9 $$" ~ok:(fun _ _ ex -> ex = `Signaled Caml.Sys.sigkill)
   >>= fun () ->
 
   check_output "echo 'bouh'; exit 2"
     ~ok:(fun sin sout ex ->
-      ex = `exited 2
+      ex = `Exited 2
       && sin = "bouh\n")
   >>= fun () ->
 
   >>= fun () ->
   test_file_info ()
   >>= fun () ->
-  test_remove `relative >>= fun () ->
-  test_remove `absolute >>= fun () ->
-  test_copy `relative `relative  >>= fun () ->
-  test_copy `absolute `absolute  >>= fun () ->
-  test_copy `absolute `relative  >>= fun () ->
-  test_copy `relative `absolute  >>= fun () ->
-  test_move `relative `relative  >>= fun () ->
-  test_move `absolute `absolute  >>= fun () ->
-  test_move `absolute `relative  >>= fun () ->
-  test_move `relative `absolute  >>= fun () ->
+  test_remove `Relative >>= fun () ->
+  test_remove `Absolute >>= fun () ->
+  test_copy `Relative `Relative  >>= fun () ->
+  test_copy `Absolute `Absolute  >>= fun () ->
+  test_copy `Absolute `Relative  >>= fun () ->
+  test_copy `Relative `Absolute  >>= fun () ->
+  test_move `Relative `Relative  >>= fun () ->
+  test_move `Absolute `Absolute  >>= fun () ->
+  test_move `Absolute `Relative  >>= fun () ->
+  test_move `Relative `Absolute  >>= fun () ->
   test_shell () >>= fun () ->
   say "sys_test: Successful End";
   return ()
   | `Error e ->
     eprintf "End with Error:\n%s\n%!"
       (<:sexp_of<
-          [ `system of
-              [`file_info of string | `make_directory of string
+          [ `System of
+              [`File_info of string | `Make_directory of string
          | `IO of [ `File_exists of string | `Wrong_path of string ]
-              | `file_tree of string
-              | `move of string
-              | `copy of string
-              | `make_symlink of string * string
-              | `remove of string | `list_directory of string ] *
-                [ `already_exists
+              | `File_tree of string
+              | `Move of string
+              | `Copy of string
+              | `Make_symlink of string * string
+              | `Remove of string | `List_directory of string ] *
+                [ `Already_exists
          (* | `IO of [ `Read_file_exn of string * exn | `Write_file_exn of string * exn ] *)
          | `IO of [ `File_exists of string | `Wrong_path of string ]
-                | `file_not_found of string
-                | `not_a_directory of string
-                | `file_exists of string
-                | `wrong_path of string
-                | `wrong_file_kind of string *
-                    [ `block_device | `character_device | `fifo | `socket | `symlink of string ]
-                | `exn of exn | `wrong_access_rights of int ]
+                | `File_not_found of string
+                | `Not_a_directory of string
+                | `File_exists of string
+                | `Wrong_path of string
+                | `Wrong_file_kind of string *
+                    [ `Block_device | `Character_device | `Fifo | `Socket | `Symlink of string ]
+                | `Exn of exn | `Wrong_access_rights of int ]
          | `IO of [ `Read_file_exn of string * exn | `Write_file_exn of string * exn ]
-          | `failed_test of string
-          | `write_file_error of string * exn
-          | `read_file_error of string * exn
-          | `file_exists of string
-          | `wrong_path of string
-          | `wrong_file_info of string *
-              [ `absent
-              | `block_device
-              | `character_device
-              | `directory
-              | `fifo
-              | `regular_file of int
-              | `socket
-              | `symlink of string ]
-          | `shell of
+          | `Failed_test of string
+          | `Write_file_error of string * exn
+          | `Read_file_error of string * exn
+          | `File_exists of string
+          | `Wrong_path of string
+          | `Wrong_file_info of string *
+              [ `Absent
+              | `Block_device
+              | `Character_device
+              | `Directory
+              | `Fifo
+              | `Regular_file of int
+              | `Socket
+              | `Symlink of string ]
+          | `Shell of
               string *
-                [ `exited of int
-                | `exn of exn
-                | `signaled of int
-                | `stopped of int ]
+                [ `Exited of int
+                | `Exn of exn
+                | `Signaled of int
+                | `Stopped of int ]
           ]  >> e
        |! Sexp.to_string_hum);
     exit 1