# HG changeset patch
# User Malcolm Matalka <malcolm.matalka@acsl.se>
# Date 1588150613 -7200
#      Wed Apr 29 10:56:53 2020 +0200
# Node ID 3045e4de2691a006007dc23c9db5cf507d86b898
# Parent  0aa9eb9a6eb3506fa1c8c7a02e34c115b01fe122
REFACTOR Switch to ocamlformat

diff --git a/src/oth/oth.ml b/src/oth/oth.ml
--- a/src/oth/oth.ml
+++ b/src/oth/oth.ml
@@ -11,38 +11,41 @@
 end
 
 module Test_result = struct
-  type t = { name : string
-           ; desc : string option
-           ; duration : Duration.t
-           ; res : [ `Ok | `Exn of (exn * Printexc.raw_backtrace option) | `Timedout ]
-           }
+  type t = {
+    name : string;
+    desc : string option;
+    duration : Duration.t;
+    res : [ `Ok | `Exn      of exn * Printexc.raw_backtrace option | `Timedout ];
+  }
 end
 
 module Run_result = struct
   type t = Test_result.t list
+
   let of_test_results = CCFun.id
+
   let test_results = CCFun.id
 end
 
 module Test = struct
-  type t = (State.t -> Run_result.t)
+  type t = State.t -> Run_result.t
 end
 
 module Outputter = struct
-  type t = (Run_result.t -> unit)
+  type t = Run_result.t -> unit
 
   let basic_stdout =
-    List.iter
-      ~f:(fun tr ->
-          match tr.Test_result.res with
-            | `Timedout ->
-              Printf.printf "Test: %s\t\tTIMEDOUT\n" tr.Test_result.name
-            | `Ok ->
-              Printf.printf "Test: %s\t\tPASSED (%0.02f sec)\n"
+    List.iter ~f:(fun tr ->
+        match tr.Test_result.res with
+          | `Timedout          -> Printf.printf "Test: %s\t\tTIMEDOUT\n" tr.Test_result.name
+          | `Ok                ->
+              Printf.printf
+                "Test: %s\t\tPASSED (%0.02f sec)\n"
                 tr.Test_result.name
                 (Duration.to_f tr.Test_result.duration)
-            | `Exn (exn, bt_opt) ->
-              Printf.printf "Test: %s\t\tFAILED (%0.02f sec)\n"
+          | `Exn (exn, bt_opt) ->
+              Printf.printf
+                "Test: %s\t\tFAILED (%0.02f sec)\n"
                 tr.Test_result.name
                 (Duration.to_f tr.Test_result.duration);
               CCOpt.iter (Printf.printf "Description: %s\n") tr.Test_result.desc;
@@ -54,7 +57,7 @@
   let basic_tap out rr =
     let (oc, close) =
       match out with
-        | `Filename s -> (open_out s, close_out)
+        | `Filename s     -> (open_out s, close_out)
         | `Out_channel oc -> (oc, CCFun.const ())
     in
     let num_tests = List.length rr in
@@ -62,55 +65,54 @@
     let end_test = num_tests in
     Printf.fprintf oc "%d..%d\n" start_test end_test;
     let rec output_test n = function
-      | [] ->
-        ()
-      | tr::trs ->
-        assert (n <= end_test);
-        begin match tr.Test_result.res with
-          | `Ok ->
-            Printf.fprintf
-              oc
-              "ok %d %s\n# Elapsed %0.02f sec\n"
-              n
-              tr.Test_result.name
-              (Duration.to_f tr.Test_result.duration)
-          | `Timedout ->
-            Printf.fprintf
-              oc
-              "not ok %d %s\n# Elapsed %0.02f sec\n"
-              n
-              tr.Test_result.name
-              (Duration.to_f tr.Test_result.duration);
-            Printf.fprintf oc "# TIMEDOUT\n"
-          | `Exn (exn, bt_opt) ->
-            Printf.fprintf
-              oc
-              "not ok %d %s\n# Elapsed %0.02f sec\n"
-              n
-              tr.Test_result.name
-              (Duration.to_f tr.Test_result.duration);
-            Printf.fprintf
-              oc
-              "# Description: %s\n"
-              (CCString.replace
-                 ~which:`All
-                 ~sub:"\n"
-                 ~by:"\n# "
-                 (CCOpt.get_or ~default:"" tr.Test_result.desc));
-            Printf.fprintf
-              oc
-              "# Exn: %s\n"
-              (CCString.replace ~which:`All ~sub:"\n" ~by:"\n# " (Printexc.to_string exn));
-            Printf.fprintf
-              oc
-              "# Backtrace: %s\n"
-              (CCString.replace
-                 ~which:`All
-                 ~sub:"\n"
-                 ~by:"\n# "
-                 (CCOpt.get_or ~default:"" (CCOpt.map Printexc.raw_backtrace_to_string bt_opt)))
-        end;
-        output_test (n + 1) trs
+      | []        -> ()
+      | tr :: trs ->
+          assert (n <= end_test);
+          ( match tr.Test_result.res with
+            | `Ok                ->
+                Printf.fprintf
+                  oc
+                  "ok %d %s\n# Elapsed %0.02f sec\n"
+                  n
+                  tr.Test_result.name
+                  (Duration.to_f tr.Test_result.duration)
+            | `Timedout          ->
+                Printf.fprintf
+                  oc
+                  "not ok %d %s\n# Elapsed %0.02f sec\n"
+                  n
+                  tr.Test_result.name
+                  (Duration.to_f tr.Test_result.duration);
+                Printf.fprintf oc "# TIMEDOUT\n"
+            | `Exn (exn, bt_opt) ->
+                Printf.fprintf
+                  oc
+                  "not ok %d %s\n# Elapsed %0.02f sec\n"
+                  n
+                  tr.Test_result.name
+                  (Duration.to_f tr.Test_result.duration);
+                Printf.fprintf
+                  oc
+                  "# Description: %s\n"
+                  (CCString.replace
+                     ~which:`All
+                     ~sub:"\n"
+                     ~by:"\n# "
+                     (CCOpt.get_or ~default:"" tr.Test_result.desc));
+                Printf.fprintf
+                  oc
+                  "# Exn: %s\n"
+                  (CCString.replace ~which:`All ~sub:"\n" ~by:"\n# " (Printexc.to_string exn));
+                Printf.fprintf
+                  oc
+                  "# Backtrace: %s\n"
+                  (CCString.replace
+                     ~which:`All
+                     ~sub:"\n"
+                     ~by:"\n# "
+                     (CCOpt.get_or ~default:"" (CCOpt.map Printexc.raw_backtrace_to_string bt_opt)))
+            );
+          output_test (n + 1) trs
     in
     output_test start_test rr;
     close oc
@@ -118,69 +120,55 @@
   let of_env ?(default = []) env_name outputter_map rr =
     let outputters =
       let outputter_names =
-        try
-          CCString.Split.list_cpy ~by:" " (Sys.getenv env_name)
-        with
-          | Not_found ->
-            default
+        try CCString.Split.list_cpy ~by:" " (Sys.getenv env_name) with Not_found -> default
       in
       List.map
         ~f:(fun on -> CCList.Assoc.get_exn ~eq:CCString.equal on outputter_map)
         outputter_names
     in
-    List.iter
-      ~f:(fun outputter -> outputter rr)
-      outputters
+    List.iter ~f:(fun outputter -> outputter rr) outputters
 end
 
 let time_test s f =
   let start = Unix.gettimeofday () in
   let res =
     match CCResult.guard (fun () -> f s) with
-      | Ok () -> `Ok
+      | Ok ()     -> `Ok
       | Error exn -> `Exn (exn, Some (Printexc.get_raw_backtrace ()))
   in
   let stop = Unix.gettimeofday () in
   let duration = Duration.of_f (stop -. start) in
   (duration, res)
 
-let serial tests state =
-  List.concat
-    (List.map
-       ~f:(fun test -> test state)
-       tests)
+let serial tests state = List.concat (List.map ~f:(fun test -> test state) tests)
 
 let parallel = serial
 
 let test ?desc ~name f state =
   let (duration, res) = time_test state f in
-  Test_result.([{ name; desc; duration; res }])
+  Test_result.[ { name; desc; duration; res } ]
 
 let raw_test f state = f state
 
 let result_test rtest state =
   let res = rtest state in
   match res with
-    | Ok _ -> ()
+    | Ok _    -> ()
     | Error _ -> assert false
 
 let test_with_revops ?desc ~name ~revops tst =
-  test
-    ?desc
-    ~name
-    (fun state -> Revops.run_in_context revops (CCFun.flip tst state))
+  test ?desc ~name (fun state -> Revops.run_in_context revops (CCFun.flip tst state))
 
-let eval test =
-  test (State.create ())
+let eval test = test (State.create ())
 
 let main outputter test =
   let rr = eval test in
   outputter rr;
   List.iter
     (fun tr ->
-       match tr.Test_result.res with
-         | `Ok -> ()
-         | _ -> exit 1)
+      match tr.Test_result.res with
+        | `Ok -> ()
+        | _   -> exit 1)
     rr;
   exit 0
 
@@ -189,17 +177,15 @@
     try
       let dir = Sys.getenv "OTH_TAP_DIR" in
       Filename.concat dir (Filename.basename Sys.executable_name)
-    with
-      | Not_found ->
-        Filename.basename Sys.executable_name
+    with Not_found -> Filename.basename Sys.executable_name
   in
   let tap_output_name = tap_output_base_name ^ ".tap" in
   let outputter =
     Outputter.of_env
-      ~default:["stdout"; "tap"]
+      ~default:[ "stdout"; "tap" ]
       "OTH_OUTPUTTER"
-      [ ("stdout", Outputter.basic_stdout)
-      ; ("tap", Outputter.basic_tap (`Filename tap_output_name))
+      [
+        ("stdout", Outputter.basic_stdout); ("tap", Outputter.basic_tap (`Filename tap_output_name));
       ]
   in
   main outputter test
@@ -216,4 +202,5 @@
   loop' n
 
 let verbose = CCFun.id
+
 let silent = CCFun.id
diff --git a/src/oth/oth.mli b/src/oth/oth.mli
--- a/src/oth/oth.mli
+++ b/src/oth/oth.mli
@@ -12,30 +12,33 @@
 
 (** The result of a single test. *)
 module Test_result : sig
-  type t = { name : string
-           ; desc : string option
-           ; duration : Duration.t
-           ; res : [ `Ok | `Exn of (exn * Printexc.raw_backtrace option) | `Timedout ]
-           }
+  type t = {
+    name : string;
+    desc : string option;
+    duration : Duration.t;
+    res : [ `Ok | `Exn      of exn * Printexc.raw_backtrace option | `Timedout ];
+  }
 end
 
 (** The result of a run, which is a list of tests.  The order of the tests is
     undefined. *)
 module Run_result : sig
   type t
+
   val of_test_results : Test_result.t list -> t
+
   val test_results : t -> Test_result.t list
 end
 
 module Outputter : sig
-  type t = (Run_result.t -> unit)
+  type t = Run_result.t -> unit
 
   (** An outputter that writes a basic format to stdout. *)
   val basic_stdout : t
 
   (** An outputter that writes to a file. The [out_channel] specifies where to
       write the results to. *)
-  val basic_tap : [`Filename of string | `Out_channel of out_channel] -> t
+  val basic_tap : [ `Filename    of string | `Out_channel of out_channel ] -> t
 
   (** Takes an environment variable name and a list of tuples mapping a string
       name to an Outputter.  The environment variable will be compared to the
@@ -91,18 +94,11 @@
 
 (** Turn a test that returns a result into one that returns a unit.  This
     asserts that the result is on the 'Ok' path.  *)
-val result_test :
-  (State.t -> (unit, 'err) result) ->
-  State.t ->
-  unit
+val result_test : (State.t -> (unit, 'err) result) -> State.t -> unit
 
 (** Turn a function into a test with a setup and teardown phase *)
 val test_with_revops :
-  ?desc:string ->
-  name:string ->
-  revops:'a Revops.Oprev.t ->
-  ('a -> State.t -> unit) ->
-  Test.t
+  ?desc:string -> name:string -> revops:'a Revops.Oprev.t -> ('a -> State.t -> unit) -> Test.t
 
 (** Turn verbose logging on.  This is the default but can be turned off with
     {!silent}, this will turn it back on.
@@ -113,4 +109,4 @@
 (** Turn logging off in the test, this is useful in combination with {!loop}.
 
     @deprecated This no longer does anything. *)
-val silent  : Test.t -> Test.t
+val silent : Test.t -> Test.t
diff --git a/src/revops/revops.ml b/src/revops/revops.ml
--- a/src/revops/revops.ml
+++ b/src/revops/revops.ml
@@ -2,10 +2,13 @@
 
 module Monad = struct
   type 'a t = 'a
+
   let ( >>= ) v f = f v
+
   let return = CCFun.id
+
   let protect ~f ~finally = CCFun.finally ~f ~h:finally
 end
 
 (* Functor application, see revops_fn.ml *)
-include Revops_fn.Make(Monad)
+include Revops_fn.Make (Monad)
diff --git a/src/revops/revops_fn.ml b/src/revops/revops_fn.ml
--- a/src/revops/revops_fn.ml
+++ b/src/revops/revops_fn.ml
@@ -1,69 +1,59 @@
 (* Implementation for reversible operations. *)
 
-module Make = functor (Monad : Revops_intf.MONAD) -> struct
-  module M = Monad
+module Make =
+functor
+  (Monad : Revops_intf.MONAD)
+  ->
+  struct
+    module M = Monad
 
-  module Oprev = struct
-    type 'a t = (unit -> 'a M.t) * ('a -> unit M.t)
-
-    let make do_fun undo_fun = (do_fun, undo_fun)
-  end
+    module Oprev = struct
+      type 'a t = (unit -> 'a M.t) * ('a -> unit M.t)
 
-  module Revop = struct
-    type 'a t = ('a * ('a -> unit M.t))
-  end
+      let make do_fun undo_fun = (do_fun, undo_fun)
+    end
 
-  open M
+    module Revop = struct
+      type 'a t = 'a * ('a -> unit M.t)
+    end
 
-  let doop (do_fun, undo_fun) =
-    do_fun ()
-    >>= fun undo_state ->
-    return (undo_state, undo_fun)
+    open M
+
+    let doop (do_fun, undo_fun) = do_fun () >>= fun undo_state -> return (undo_state, undo_fun)
 
-  let undo (undo_state, undo_fun) = undo_fun undo_state
+    let undo (undo_state, undo_fun) = undo_fun undo_state
 
-  let peek (undo_state, undo_fun) = undo_state
+    let peek (undo_state, undo_fun) = undo_state
 
-  let compose ~introduce
-              ~eliminate_first
-              ~eliminate_second
-	      ~first
-	      ~second =
-  let (_, undo_first)  = first in
-  let (_, undo_second) = second in
-  let do_fun () =
-    doop first
-    >>= fun first_revop ->
-    doop second
-    >>= fun second_revop ->
-    introduce (peek first_revop) (peek second_revop)
-  in
-  let undo_fun undo_state =
-    eliminate_second undo_state
-    >>= fun second_state ->
-    undo_second second_state
-    >>= fun () ->
-    eliminate_first undo_state
-    >>= fun first_state ->
-    undo_first first_state
-  in
-  Oprev.make do_fun undo_fun
+    let compose ~introduce ~eliminate_first ~eliminate_second ~first ~second =
+      let (_, undo_first) = first in
+      let (_, undo_second) = second in
+      let do_fun () =
+        doop first
+        >>= fun first_revop ->
+        doop second >>= fun second_revop -> introduce (peek first_revop) (peek second_revop)
+      in
+      let undo_fun undo_state =
+        eliminate_second undo_state
+        >>= fun second_state ->
+        undo_second second_state
+        >>= fun () -> eliminate_first undo_state >>= fun first_state -> undo_first first_state
+      in
+      Oprev.make do_fun undo_fun
 
-  let compose_tuple first second =
-    compose
-      (fun l r -> return (l, r))
-      (CCFun.compose fst return)
-      (CCFun.compose snd return)
-      first
-      second
+    let compose_tuple first second =
+      compose
+        (fun l r -> return (l, r))
+        (CCFun.compose fst return)
+        (CCFun.compose snd return)
+        first
+        second
 
-  let ( +* ) = compose_tuple
+    let ( +* ) = compose_tuple
 
-  let run_in_context oprev action =
-    doop oprev
-    >>= fun revop ->
-    let unit_action () = action (peek revop) in
-    M.protect
-      ~f:unit_action
-      ~finally:(fun () -> undo revop)
-end
+    let run_in_context oprev action =
+      doop oprev
+      >>= fun revop ->
+      let unit_action () = action (peek revop) in
+      M.protect ~f:unit_action ~finally:(fun () -> undo revop)
+  end
diff --git a/src/revops/revops_fn.mli b/src/revops/revops_fn.mli
--- a/src/revops/revops_fn.mli
+++ b/src/revops/revops_fn.mli
@@ -2,6 +2,4 @@
  * Interface for reversible operations.
  *)
 
-module Make :
-  functor (Monad : Revops_intf.MONAD) ->
-    (Revops_intf.S with type 'a M.t = 'a Monad.t)
+module Make : functor (Monad : Revops_intf.MONAD) -> Revops_intf.S with type 'a M.t = 'a Monad.t
diff --git a/src/revops/revops_intf.ml b/src/revops/revops_intf.ml
--- a/src/revops/revops_intf.ml
+++ b/src/revops/revops_intf.ml
@@ -2,7 +2,9 @@
   type 'a t
 
   val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t
+
   val return : 'a -> 'a t
+
   val protect : f:(unit -> 'a t) -> finally:(unit -> 'b) -> 'a t
 end
 
@@ -11,6 +13,7 @@
 
   module Oprev : sig
     type 'a t
+
     val make : (unit -> 'a M.t) -> ('a -> unit M.t) -> 'a t
   end
 
@@ -29,12 +32,13 @@
    * oprev is setup and then the second. The order of evaluation on an undo is the
    * second oprev is torn-down and then the first.
    *)
-  val compose : introduce:('a -> 'b -> 'c M.t) ->
-                eliminate_first:('c -> 'a M.t) ->
-                eliminate_second:('c -> 'b M.t) ->
-                first:'a Oprev.t ->
-                second:'b Oprev.t ->
-                'c Oprev.t
+  val compose :
+    introduce:('a -> 'b -> 'c M.t) ->
+    eliminate_first:('c -> 'a M.t) ->
+    eliminate_second:('c -> 'b M.t) ->
+    first:'a Oprev.t ->
+    second:'b Oprev.t ->
+    'c Oprev.t
 
   val compose_tuple : 'a Oprev.t -> 'b Oprev.t -> ('a * 'b) Oprev.t
 
diff --git a/src/revops/revops_sys.ml b/src/revops/revops_sys.ml
--- a/src/revops/revops_sys.ml
+++ b/src/revops/revops_sys.ml
@@ -1,6 +1,6 @@
 (* Implementation of basic revops for system operations. *)
 
-let temp_file ?(prefix="Temp") ?(suffix = "CleanMe") () =
+let temp_file ?(prefix = "Temp") ?(suffix = "CleanMe") () =
   Revops.Oprev.make
     (fun () -> Filename.temp_file prefix suffix)
     (fun filename -> Unix.unlink filename)