Forsake `fmap`

16 files changed, 48 insertions, 50 deletions

diff --git a/lib/Utilities.ml b/lib/Utilities.ml
index 1e25176..8f278a3 100644
--- a/lib/Utilities.ml
+++ b/lib/Utilities.ml
@@ -6,14 +6,12 @@ end
 
 module Option = struct
   let ( let* ) = Option.bind
-  let fmap f m = Option.bind m f
   let ( |>> ) = Option.bind
   let sequence = function None -> Ok None | Some x -> Result.map Option.some x
 end
 
 module Result = struct
   let ( let* ) = Result.bind
-  let fmap f m = Result.bind m f
   let ( |>> ) = Result.bind
 end
 
diff --git a/lib/Utilities.mli b/lib/Utilities.mli
index 7af9f03..204fec3 100644
--- a/lib/Utilities.mli
+++ b/lib/Utilities.mli
@@ -7,7 +7,6 @@ end
 module Result : sig
   val ( let* ) : ('a, 'e) result -> ('a -> ('b, 'e) result) -> ('b, 'e) result
   val ( |>> ) : ('a, 'e) result -> ('a -> ('b, 'e) result) -> ('b, 'e) result
-  val fmap : ('a -> ('b, 'e) result) -> ('a, 'e) result -> ('b, 'e) result
 end
 
 module List : sig
@@ -20,7 +19,6 @@ end
 module Option : sig
   val ( let* ) : 'a option -> ('a -> 'b option) -> 'b option
   val ( |>> ) : 'a option -> ('a -> 'b option) -> 'b option
-  val fmap : ('a -> 'b option) -> 'a option -> 'b option
   val sequence : ('a, 'b) result option -> ('a option, 'b) result
 end
 
diff --git a/lib/backend/storage/LMDB.ml b/lib/backend/storage/LMDB.ml
index 3b38b93..a378200 100644
--- a/lib/backend/storage/LMDB.ml
+++ b/lib/backend/storage/LMDB.ml
@@ -146,8 +146,8 @@ let parse (c : Concepts.Configuration.term) =
   let open Concepts.Configuration in
   let open Utilities.Result in
   let* config = as_dictionary c "lmdb" in
-  let* path = value_for "path" config |> fmap as_string in
-  let* mode = value_for "mode" config |> fmap as_int in
+  let* path = value_for "path" config |>> as_string in
+  let* mode = value_for "mode" config |>> as_int in
   Ok (path, mode)
 
 (* directories are traversable wherever they are readable *)
diff --git a/lib/concepts/Configuration.ml b/lib/concepts/Configuration.ml
index b2c29eb..2cd29d6 100644
--- a/lib/concepts/Configuration.ml
+++ b/lib/concepts/Configuration.ml
@@ -62,7 +62,7 @@ let as_dictionary t tag : (dictionary, Condition.condition) result =
         | p -> Error (Error.malformed_pair p) )
       pairs (Ok BatMap.empty)
   in
-  strip_tag tag t |> fmap as_dictionary'
+  strip_tag tag t |>> as_dictionary'
 
 let as_string = function Atom s -> Ok s | form -> Error (Error.expected_atom form)
 
diff --git a/lib/concepts/Encoding.ml b/lib/concepts/Encoding.ml
index d78eb28..6420817 100644
--- a/lib/concepts/Encoding.ml
+++ b/lib/concepts/Encoding.ml
@@ -206,7 +206,7 @@ module Value = struct
 
   let hash_of_bencode value =
     let open Utilities.Result in
-    Bencode.with_tag 'h' value |> fmap Bencode.as_string |> Result.map Hash.of_raw_string
+    Bencode.with_tag 'h' value |>> Bencode.as_string |> Result.map Hash.of_raw_string
 
   let bencode_of_option f option =
     Bencode.Tagged ('?', Option.map f option |> Option.to_list |> fun x -> Bencode.List x)
@@ -214,15 +214,15 @@ module Value = struct
   let option_of_bencode f value =
     let open Utilities.Result in
     Bencode.with_tag '?' value
-    |> fmap Bencode.as_list
+    |>> Bencode.as_list
     |> Result.map Utilities.List.hd_opt
-    |> fmap (function None -> Ok None | Some v -> f v |> Result.map Option.some)
+    |>> (function None -> Ok None | Some v -> f v |> Result.map Option.some)
 end
 
 module Field = struct
   let string value = Bencode.String value
   let address address = Bencode.String (Hash.to_raw_string address)
-  let require_string key data = Bencode.field key data |> Utilities.Result.fmap Bencode.as_string
+  let require_string key data = Utilities.Result.(Bencode.field key data |>> Bencode.as_string)
 
   let require_address ~malformed key data =
     let open Utilities.Result in
@@ -264,8 +264,8 @@ module Record = struct
       | _ -> Error (B.malformed ())
 
     let to_blob object_ = to_bencode object_ |> Bencode.to_blob
-    let of_blob blob = Bencode.of_blob blob |> Utilities.Result.fmap of_bencode
+    let of_blob blob = Utilities.Result.(Bencode.of_blob blob |>> of_bencode)
     let to_bytes object_ = to_blob object_ |> Blob.bytes_of_blob
-    let of_bytes bytes = Bencode.of_bytes bytes |> Utilities.Result.fmap of_bencode
+    let of_bytes bytes = Utilities.Result.(Bencode.of_bytes bytes |>> of_bencode)
   end
 end
diff --git a/lib/concepts/Tuple.ml b/lib/concepts/Tuple.ml
index c2da77c..dfb7cbe 100644
--- a/lib/concepts/Tuple.ml
+++ b/lib/concepts/Tuple.ml
@@ -30,8 +30,8 @@ and Body : Encoding.Record.BODY = struct
 
   let of_fields data =
     let open Utilities.Result in
-    let* type_ = Encoding.Bencode.field "type" data |> fmap Encoding.Bencode.as_string in
-    let* kvs = Encoding.Bencode.field "attributes" data |> fmap Encoding.Bencode.as_dict in
+    let* type_ = Encoding.Bencode.field "type" data |>> Encoding.Bencode.as_string in
+    let* kvs = Encoding.Bencode.field "attributes" data |>> Encoding.Bencode.as_dict in
     kvs
     |> List.map (fun (name, v) -> value_of_bencode v |> Result.map (fun v -> name, v))
     |> Utilities.List.sequence
diff --git a/lib/evaluators/FOL.ml b/lib/evaluators/FOL.ml
index 90f79ca..f337d61 100644
--- a/lib/evaluators/FOL.ml
+++ b/lib/evaluators/FOL.ml
@@ -53,13 +53,13 @@ let rec term_of_bencode =
   | Bencode.Tagged ('b', segments) ->
       strings segments |> Result.map (fun segments -> Base (Kernel.Path.of_list segments))
   | Bencode.Tagged ('p', data) ->
-      let* term = Bencode.field "term" data |> fmap term_of_bencode in
-      let* attributes = Bencode.field "attributes" data |> fmap strings in
+      let* term = Bencode.field "term" data |>> term_of_bencode in
+      let* attributes = Bencode.field "attributes" data |>> strings in
       Ok (Project (term, BatFingerTree.of_list attributes))
   | _ -> Error (Error.malformed_program ())
 
 let encode term = bencode_of_term term |> Bencode.to_bytes |> Bytes.to_string
-let decode source = Bencode.of_bytes (Bytes.of_string source) |> Utilities.Result.fmap term_of_bencode
+let decode source = Utilities.Result.(Bencode.of_bytes (Bytes.of_string source) |>> term_of_bencode)
 
 (* TODO: To strenghten our checks for self references, we need to
    construct a graph and see raise a condition if there are self
@@ -105,7 +105,7 @@ let rec describe =
   let open Utilities.Result in
   function
   | Base relation -> Protocols.Relation.heading relation
-  | Project (plan, attributes) -> describe plan |> fmap (restrict attributes)
+  | Project (plan, attributes) -> describe plan |>> restrict attributes
 
 let rec modes =
   let open Utilities.Result in
diff --git a/lib/kernel/Branch.ml b/lib/kernel/Branch.ml
index 561bff3..439339e 100644
--- a/lib/kernel/Branch.ml
+++ b/lib/kernel/Branch.ml
@@ -50,14 +50,13 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     let of_fields fields =
       let open Utilities.Result in
       let open Concepts.Encoding in
-      let* multigroups = Bencode.field "multigroups" fields |> fmap Value.hash_of_bencode in
+      let* multigroups = Bencode.field "multigroups" fields |>> Value.hash_of_bencode in
       let* previous =
         Bencode.field "previous" fields
-        |> fmap
-             (Value.option_of_bencode (fun v ->
-                  Value.hash_of_bencode v
-                  |> Result.map (fun hash -> S.Hash hash)
-                  |> Result.map (SI.Pointer.make Loader.load) ) )
+        |>> Value.option_of_bencode (fun v ->
+                Value.hash_of_bencode v
+                |> Result.map (fun hash -> S.Hash hash)
+                |> Result.map (SI.Pointer.make Loader.load) )
       in
       Ok {multigroups; previous}
   end
@@ -65,7 +64,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct
   and Loader : sig
     val load : S.transaction -> S.address -> (t, Concepts.Condition.condition) result
   end = struct
-    let load tx addr = SI.get_req tx addr |> Utilities.Result.fmap Representation.of_blob
+    let load tx addr = Utilities.Result.(SI.get_req tx addr |>> Representation.of_blob)
   end
 
   let pointer_of hash = SI.Pointer.make Loader.load (S.Hash hash)
@@ -73,7 +72,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct
   let node_of tx branch =
     let open Utilities.Result in
     MultigroupM.find tx branch.multigroups
-    |> fmap (Option.to_result ~none:(Error.incomplete_branch branch.multigroups))
+    |>> Option.to_result ~none:(Error.incomplete_branch branch.multigroups)
 
   (* Given [root], the stored programs of this state run through the
      evaluators registered under it, against this very state, so an
@@ -144,7 +143,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct
                     update_only (fun node' ->
                         Handle.require Addressable.from node'
                         |> Result.map Addressable.address
-                        |> fmap (fun addr -> self#deriving {branch with multigroups= addr}) ) ) ] );
+                        |>> (fun addr -> self#deriving {branch with multigroups= addr}) ) ) ] );
             Directory.make
               object
                 method list =
diff --git a/lib/kernel/EphemeralRelation.ml b/lib/kernel/EphemeralRelation.ml
index 3e955ba..8843d11 100644
--- a/lib/kernel/EphemeralRelation.ml
+++ b/lib/kernel/EphemeralRelation.ml
@@ -49,9 +49,9 @@ module Persisted = struct
       let open Utilities.Result in
       let open Concepts.Encoding in
       let* name = Field.require_string "name" fields in
-      let* schematics = Bencode.field "schema" fields |> fmap Value.hash_of_bencode in
+      let* schematics = Bencode.field "schema" fields |>> Value.hash_of_bencode in
       let* evaluator = Field.require_string "evaluator" fields in
-      let* code = Bencode.field "program" fields |> fmap Value.hash_of_bencode in
+      let* code = Bencode.field "program" fields |>> Value.hash_of_bencode in
       Ok {name; schematics; pointer= {evaluator; code}}
   end
 end
diff --git a/lib/kernel/Merkle.ml b/lib/kernel/Merkle.ml
index 6b44c41..c64a9a3 100644
--- a/lib/kernel/Merkle.ml
+++ b/lib/kernel/Merkle.ml
@@ -87,14 +87,14 @@ functor
         as_string t
         |> Result.map String.to_bytes
         |> Result.map Concepts.Blob.blob_of_bytes
-        |> fmap K.decode
+        |>> K.decode
       in
       let decode_value t = as_string t |> Result.map Concepts.Hash.of_raw_string in
       let decode_list f data =
         data
-        |> fmap as_list
+        |>> as_list
         |> Result.map (List.map f)
-        |> fmap Utilities.List.sequence
+        |>> Utilities.List.sequence
         |> Result.map BatFingerTree.of_list
       in
       function
@@ -108,7 +108,7 @@ functor
           Ok (Trunk {keys; children})
       | _ -> Error (Error.malformed_node ())
 
-    let from_blob blob = Concepts.Encoding.Bencode.of_blob blob |> Utilities.Result.fmap of_bencode
+    let from_blob blob = Utilities.Result.(Concepts.Encoding.Bencode.of_blob blob |>> of_bencode)
 
     let to_bencode =
       let open Concepts.Encoding.Bencode in
@@ -381,7 +381,7 @@ functor
 
     let rec shrink tx = function
       | Trunk {children; _} when BatFingerTree.size children = 1 ->
-          Utilities.Result.fmap (shrink tx) (find' tx (BatFingerTree.get children 0))
+          Result.bind (find' tx (BatFingerTree.get children 0)) (shrink tx)
       | node -> Ok node
 
     let remove tx key node =
@@ -454,7 +454,7 @@ functor
       let* () = S.put tx (S.Hash addr) data in
       Ok addr
 
-    let retrieve tx addr = SI.get_req tx (S.Hash addr) |> fmap V.decode
+    let retrieve tx addr = SI.get_req tx (S.Hash addr) |>> V.decode
     let find = Tree.find
     let from x = x
     let into x = x
@@ -470,7 +470,7 @@ functor
     let of_list tx bindings =
       List.map (fun (k, v) -> intern tx v |> Result.map (fun addr -> k, addr)) bindings
       |> Utilities.List.sequence
-      |> fmap (Tree.of_list tx)
+      |>> Tree.of_list tx
 
     let remove = Tree.remove
 
diff --git a/lib/kernel/Multigroup.ml b/lib/kernel/Multigroup.ml
index 669babb..399ab30 100644
--- a/lib/kernel/Multigroup.ml
+++ b/lib/kernel/Multigroup.ml
@@ -90,8 +90,8 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     let of_fields fields =
       let open Utilities.Result in
       let open Concepts.Encoding in
-      let* schemas = Bencode.field "schemas" fields |> fmap Value.hash_of_bencode in
-      let* denials = Bencode.field "denials" fields |> fmap Value.hash_of_bencode in
+      let* schemas = Bencode.field "schemas" fields |>> Value.hash_of_bencode in
+      let* denials = Bencode.field "denials" fields |>> Value.hash_of_bencode in
       Ok {schemas; denials}
   end)
 
@@ -100,7 +100,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct
 
   let node_of tx addr =
     let open Utilities.Result in
-    T.find tx addr |> fmap (Option.to_result ~none:(Error.incomplete addr))
+    T.find tx addr |>> Option.to_result ~none:(Error.incomplete addr)
 
   (* What [h] holds under [property], each to store once the write has
      begun, and the tree they make when it has. *)
@@ -116,9 +116,10 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     |> Utilities.List.sequence
 
   let tree_of tx admissions =
+    let open Utilities.Result in
     List.map (fun (name, store) -> store tx |> Result.map (fun addr -> name, addr)) admissions
     |> Utilities.List.sequence
-    |> Utilities.Result.fmap (T.of_list tx)
+    |>> T.of_list tx
 
   let admit_schema _ h =
     let open Utilities.Result in
@@ -229,7 +230,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct
         let derive f node' =
           Protocols.Handle.require Protocols.Addressable.from node'
           |> Result.map Protocols.Addressable.address
-          |> fmap (fun addr -> self#deriving (f addr))
+          |>> (fun addr -> self#deriving (f addr))
         in
         Protocols.
           [ Addressable.make self;
diff --git a/lib/kernel/Namespace.ml b/lib/kernel/Namespace.ml
index 80c446f..efaf667 100644
--- a/lib/kernel/Namespace.ml
+++ b/lib/kernel/Namespace.ml
@@ -25,9 +25,10 @@ class namespace =
     method list = Atomic.get entries |> BatMap.keys |> BatFingerTree.of_enum |> Result.ok
 
     method find key =
+      let open Utilities.Option in
       Atomic.get entries
       |> BatMap.find_opt key
-      |> Utilities.Option.fmap Protocols.Handle.copy
+      |>> Protocols.Handle.copy
       |> Result.ok
   end
 
diff --git a/lib/kernel/Prototype.ml b/lib/kernel/Prototype.ml
index ea1083b..217b221 100644
--- a/lib/kernel/Prototype.ml
+++ b/lib/kernel/Prototype.ml
@@ -120,8 +120,9 @@ module Directory = struct
            method list = SI.with_read storage (Fun.flip Tree.keys node)
 
            method find k =
+             let open Utilities.Result in
              SI.with_read storage (fun tx -> Tree.lookup tx k node)
-             |> Utilities.Result.fmap (function
+             |>> (function
                | None -> Ok None
                | Some x -> constructor x |> Result.map Option.some )
          end
diff --git a/lib/kernel/Storage.ml b/lib/kernel/Storage.ml
index da438d2..5b1b722 100644
--- a/lib/kernel/Storage.ml
+++ b/lib/kernel/Storage.ml
@@ -51,5 +51,5 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     Ok address
 
   let get_req tx addr =
-    S.get tx addr |> Utilities.Result.fmap (Option.to_result ~none:(Error.missing_data addr))
+    Utilities.Result.(S.get tx addr |>> Option.to_result ~none:(Error.missing_data addr))
 end
diff --git a/lib/kernel/SubstantialRelation.ml b/lib/kernel/SubstantialRelation.ml
index 9cb57f0..fe9e34f 100644
--- a/lib/kernel/SubstantialRelation.ml
+++ b/lib/kernel/SubstantialRelation.ml
@@ -61,8 +61,8 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     let of_fields fields =
       let open Utilities.Result in
       let open Concepts.Encoding in
-      let* schematics = Bencode.field "schema" fields |> fmap Value.hash_of_bencode in
-      let* tuples = Bencode.field "tuples" fields |> fmap Value.hash_of_bencode in
+      let* schematics = Bencode.field "schema" fields |>> Value.hash_of_bencode in
+      let* tuples = Bencode.field "tuples" fields |>> Value.hash_of_bencode in
       Ok {schematics; tuples}
   end
 
diff --git a/lib/kernel/Tuple.ml b/lib/kernel/Tuple.ml
index 41babe9..7cd952e 100644
--- a/lib/kernel/Tuple.ml
+++ b/lib/kernel/Tuple.ml
@@ -67,8 +67,8 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     let of_fields data =
       let open Utilities.Result in
       let open Concepts.Encoding in
-      let* type_ = Bencode.field "type" data |> fmap Bencode.as_string in
-      let* attributes = Bencode.field "attributes" data |> fmap Value.hash_of_bencode in
+      let* type_ = Bencode.field "type" data |>> Bencode.as_string in
+      let* attributes = Bencode.field "attributes" data |>> Value.hash_of_bencode in
       Ok {type_; attributes}
   end
 
@@ -80,7 +80,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct
   let node tx {attributes; _} =
     let open Utilities.Result in
     AttributeM.find tx attributes
-    |> fmap (Option.to_result ~none:(Error.incomplete_tuple attributes))
+    |>> Option.to_result ~none:(Error.incomplete_tuple attributes)
 
   let empty tx ~type_ () =
     let open Utilities.Result in