bencode helpers between dicts and string maps

4 files changed, 25 insertions, 43 deletions

diff --git a/lib/concepts/Encoding.ml b/lib/concepts/Encoding.ml
index 50eb6e6..34ca3a0 100644
--- a/lib/concepts/Encoding.ml
+++ b/lib/concepts/Encoding.ml
@@ -113,6 +113,14 @@ module Bencode = struct
   let as_int = function Int n -> Ok n | _ -> Error (Error.type_mismatch ~expected:"integer")
   let as_list = function List l -> Ok l | _ -> Error (Error.type_mismatch ~expected:"list")
   let as_dict = function Dict d -> Ok d | _ -> Error (Error.type_mismatch ~expected:"dict")
+  let of_map f map = Dict (List.map (fun (k, v) -> k, f v) (BatMap.String.bindings map))
+
+  let to_map f data =
+    let open Utilities.Result in
+    let* kvs = as_dict data in
+    List.map (fun (k, v) -> f v |> Result.map (fun v -> k, v)) kvs
+    |> Utilities.List.sequence
+    |> Result.map BatMap.String.of_list
 
   let of_bytes (bytes : bytes) : (t, Condition.condition) result =
     let open Utilities.Result in
diff --git a/lib/concepts/Tuple.ml b/lib/concepts/Tuple.ml
index dfb7cbe..943c1f6 100644
--- a/lib/concepts/Tuple.ml
+++ b/lib/concepts/Tuple.ml
@@ -23,19 +23,15 @@ and Body : Encoding.Record.BODY = struct
 
   let fields {type_; attributes} =
     [ "type", Encoding.Bencode.String type_;
-      ( "attributes",
-        Encoding.Bencode.Dict
-          ( BatMap.String.enum attributes
-          |> BatEnum.fold (fun acc (name, value) -> (name, bencode_of_value value) :: acc) [] ) ) ]
+      "attributes", Encoding.Bencode.of_map bencode_of_value attributes ]
 
   let of_fields data =
     let open Utilities.Result 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
-    |> Result.map (fun kvs -> {type_; attributes= BatMap.String.of_list kvs})
+    let* attributes =
+      Encoding.Bencode.field "attributes" data |>> Encoding.Bencode.to_map value_of_bencode
+    in
+    Ok {type_; attributes}
 end
 
 let hash tuple = Representation.to_blob tuple |> Hash.hash_of_blob
diff --git a/lib/evaluators/FOL.ml b/lib/evaluators/FOL.ml
index a7685bd..01264e3 100644
--- a/lib/evaluators/FOL.ml
+++ b/lib/evaluators/FOL.ml
@@ -53,11 +53,7 @@ let rec bencode_of_term =
         ( 'w',
           Bencode.Dict
             [ "term", bencode_of_term term;
-              ( "binding",
-                Bencode.Dict
-                  ( BatMap.String.bindings binding
-                  |> List.map (fun (name, value) -> name, Concepts.Tuple.bencode_of_value value) ) )
-            ] )
+              "binding", Bencode.of_map Concepts.Tuple.bencode_of_value binding ] )
 
 let rec term_of_bencode =
   let open Utilities.Result in
@@ -74,15 +70,10 @@ let rec term_of_bencode =
       Ok (Project (term, BatFingerTree.of_list attributes))
   | Bencode.Tagged ('w', data) ->
       let* term = Bencode.field "term" data |>> term_of_bencode in
-      let* binding = Bencode.field "binding" data |>> Bencode.as_dict in
       let* binding =
-        List.map
-          (fun (name, value) ->
-            Concepts.Tuple.value_of_bencode value |> Result.map (fun value -> name, value) )
-          binding
-        |> Utilities.List.sequence
+        Bencode.field "binding" data |>> Bencode.to_map Concepts.Tuple.value_of_bencode
       in
-      Ok (Where (term, BatMap.String.of_list binding))
+      Ok (Where (term, binding))
   | _ -> Error (Error.malformed_program ())
 
 let encode term = bencode_of_term term |> Bencode.to_bytes |> Bytes.to_string
diff --git a/lib/kernel/SubstantialRelation.ml b/lib/kernel/SubstantialRelation.ml
index e89b008..f269686 100644
--- a/lib/kernel/SubstantialRelation.ml
+++ b/lib/kernel/SubstantialRelation.ml
@@ -81,22 +81,15 @@ module Make (S : Abstract.Storage.STORAGE) = struct
       let open Concepts.Encoding in
       [ "schema", Value.bencode_of_hash schematics;
         "tuples", Value.bencode_of_hash tuples;
-        ( "indexes",
-          Bencode.Dict
-            (BatMap.String.bindings indexes |> List.map (fun (a, h) -> a, Value.bencode_of_hash h))
-        ) ]
+        "indexes", Bencode.of_map Value.bencode_of_hash indexes ]
 
     let of_fields fields =
       let open Utilities.Result in
       let open Concepts.Encoding in
       let* schematics = Bencode.field "schema" fields |>> Value.hash_of_bencode in
       let* tuples = Bencode.field "tuples" fields |>> Value.hash_of_bencode in
-      let* indexes = Bencode.field "indexes" fields |>> Bencode.as_dict in
-      let* indexes =
-        List.map (fun (a, h) -> Value.hash_of_bencode h |> Result.map (fun h -> a, h)) indexes
-        |> Utilities.List.sequence
-      in
-      Ok {schematics; tuples; indexes= BatMap.String.of_list indexes}
+      let* indexes = Bencode.field "indexes" fields |>> Bencode.to_map Value.hash_of_bencode in
+      Ok {schematics; tuples; indexes}
   end
 
   let encode = Representation.to_blob
@@ -109,23 +102,17 @@ module Make (S : Abstract.Storage.STORAGE) = struct
 
   let store_schema tx description =
     Concepts.Encoding.Bencode.(
-      Dict
-        ( BatMap.String.bindings description
-        |> List.map (fun (name, {Protocols.Schematics.domain; _}) -> name, String domain) )
-      |> to_blob )
+      of_map (fun {Protocols.Schematics.domain; _} -> String domain) description |> to_blob )
     |> SI.store_blob tx
 
   let schema_of tx schematics =
     let open Utilities.Result in
+    let open Concepts.Encoding in
     let* data = SI.get_req tx (S.Hash schematics) in
-    let* fields = Concepts.Encoding.Bencode.of_blob data in
-    let* kvs = Concepts.Encoding.Bencode.as_dict fields in
-    kvs
-    |> List.map (fun (name, domain) ->
-        Concepts.Encoding.Bencode.as_string domain
-        |> Result.map (fun domain -> name, {Protocols.Schematics.domain; provenance= []}) )
-    |> Utilities.List.sequence
-    |> Result.map BatMap.String.of_list
+    Bencode.of_blob data
+    |>> Bencode.to_map (fun domain ->
+        Bencode.as_string domain
+        |> Result.map (fun domain -> {Protocols.Schematics.domain; provenance= []}) )
 
   let prefix value =
     Concepts.Encoding.Bencode.to_bytes (Concepts.Tuple.bencode_of_value value)