aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/Utilities.ml2
-rw-r--r--lib/Utilities.mli2
-rw-r--r--lib/backend/storage/LMDB.ml4
-rw-r--r--lib/concepts/Configuration.ml2
-rw-r--r--lib/concepts/Encoding.ml12
-rw-r--r--lib/concepts/Tuple.ml4
-rw-r--r--lib/evaluators/FOL.ml8
-rw-r--r--lib/kernel/Branch.ml17
-rw-r--r--lib/kernel/EphemeralRelation.ml4
-rw-r--r--lib/kernel/Merkle.ml14
-rw-r--r--lib/kernel/Multigroup.ml11
-rw-r--r--lib/kernel/Namespace.ml3
-rw-r--r--lib/kernel/Prototype.ml3
-rw-r--r--lib/kernel/Storage.ml2
-rw-r--r--lib/kernel/SubstantialRelation.ml4
-rw-r--r--lib/kernel/Tuple.ml6
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
generated by cgit v1.2.3 (git 2.25.1) at 2026-11-04 01:54:50 +0000