A => src/revops/revops.ml +11 -0
@@ 0,0 1,11 @@ 
+(* Implementation for reversible operations. *)
+
+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)

          
A => src/revops/revops.mli +4 -0
@@ 0,0 1,4 @@ 
+(*
+ * Interface for reversible operations.
+ *)
+include Revops_intf.S with type 'a M.t = 'a

          
A => src/revops/revops_fn.ml +69 -0
@@ 0,0 1,69 @@ 
+(* Implementation for reversible operations. *)
+
+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 Revop = struct
+    type 'a t = ('a * ('a -> unit M.t))
+  end
+
+  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 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_tuple first second =
+    compose
+      (fun l r -> return (l, r))
+      (CCFun.compose fst return)
+      (CCFun.compose snd return)
+      first
+      second
+
+  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

          
A => src/revops/revops_fn.mli +7 -0
@@ 0,0 1,7 @@ 
+(*
+ * Interface for reversible operations.
+ *)
+
+module Make :
+  functor (Monad : Revops_intf.MONAD) ->
+    (Revops_intf.S with type 'a M.t = 'a Monad.t)

          
A => src/revops/revops_intf.ml +52 -0
@@ 0,0 1,52 @@ 
+module type MONAD = sig
+  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
+
+module type S = sig
+  module M : MONAD
+
+  module Oprev : sig
+    type 'a t
+    val make : (unit -> 'a M.t) -> ('a -> unit M.t) -> 'a t
+  end
+
+  module Revop : sig
+    type 'a t
+  end
+
+  val doop : 'a Oprev.t -> 'a Revop.t M.t
+
+  val undo : 'a Revop.t -> unit M.t
+
+  val peek : 'a Revop.t -> 'a
+
+  (*
+   * Composes two oprevs. The order of evaluation on a doop of the result is the first
+   * 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_tuple : 'a Oprev.t -> 'b Oprev.t -> ('a * 'b) Oprev.t
+
+  (* Infix shorthand for compose tuple. *)
+  val ( +* ) : 'a Oprev.t -> 'b Oprev.t -> ('a * 'b) Oprev.t
+
+  (*
+   * Runs a unit function in the context of an oprev.
+   * 1. doop the oprev.
+   * 2. Runs the unit function.
+   * 3. undo the revop.
+   * 4. Returns the value from the unit function.
+   *)
+  val run_in_context : 'a Oprev.t -> ('a -> 'b M.t) -> 'b M.t
+end

          
A => src/revops/revops_sys.ml +6 -0
@@ 0,0 1,6 @@ 
+(* Implementation of basic revops for system operations. *)
+
+let temp_file ?(prefix="Temp") ?(suffix = "CleanMe") () =
+  Revops.Oprev.make
+    (fun () -> Filename.temp_file prefix suffix)
+    (fun filename -> Unix.unlink filename)

          
A => src/revops/revops_sys.mli +6 -0
@@ 0,0 1,6 @@ 
+(* Interface for basic revops for system operations. *)
+
+(*
+ * A revop for creating a temporary file and cleaning up afterward.
+ *)
+val temp_file : ?prefix:string -> ?suffix:string -> unit -> string Revops.Oprev.t