implements bin_io and sexp protocol for OGRE docs

The sexp is using the OGRE syntax not just a deriviation from the
representation.

Author: ivg

lib/ogre/ogre.ml

@@ -4,14 +4,14 @@ open Format
 
 type entry = {
   fields : string String.Map.t
-} [@@deriving compare, sexp]
+} [@@deriving bin_io, compare, sexp]
 
 type row = {row : entry array} [@@deriving sexp]
 type 'a seq = 'a Sequence.t
 
 module Type = struct
   type typ = Int | Str | Bool | Float
-  [@@deriving compare,enumerate,sexp]
+  [@@deriving bin_io, compare,enumerate,sexp]
   type 'a t = {
     parse : string -> 'a option;
     pack : 'a -> string;
@@ -26,9 +26,9 @@ module Type = struct
   type header = {
     fname : string;
     ftype : typ;
-  } [@@deriving compare, sexp]
+  } [@@deriving bin_io, compare, sexp]
 
-  type signature = header list [@@deriving compare, sexp]
+  type signature = header list [@@deriving bin_io, compare, sexp]
 
   type ('f,'k) scheme = {
     read : entry -> 'a -> 'b option;
@@ -169,19 +169,22 @@ let declare = Attribute.declare
 
 
 module Doc = struct
+  module Problem = Error
   module Error = Monad.Result.Error
   open Error.Syntax
 
   type t = {
     scheme  : Type.signature String.Map.t;
     entries : entry list String.Map.t;
-  } [@@deriving compare]
+  } [@@deriving bin_io, compare]
 
   let empty = {
     scheme = String.Map.empty;
     entries = String.Map.empty;
   }
 
+  let is_empty {scheme}= Map.is_empty scheme
+
   let errorf fmt = Or_error.errorf fmt
 
   let declarations {scheme} = Map.length scheme
@@ -395,6 +398,24 @@ module Doc = struct
         Sexp.scan_sexps (String.strip str |> Lexing.from_string) |>
         of_sexps)
 
+  let sexps_of_t {scheme; entries} =
+    let attrs =
+      Map.fold entries ~init:[] ~f:(fun ~key:n ~data:vs sexps ->
+          List.fold vs ~init:sexps ~f:(fun sexps v ->
+              sexp_of_attr scheme n v :: sexps)) in
+    Map.fold scheme ~init:attrs ~f:(fun ~key:n ~data:s xs ->
+        sexp_of_decl (n,s) :: xs)
+
+  let sexp_of_t doc = Sexp.List (sexps_of_t doc)
+
+  let t_of_sexp = function
+    | Sexp.Atom _ -> invalid_arg "Ogre.Doc.t_of_sexp: expects a list"
+    | List exp -> match of_sexps exp with
+      | Ok x -> x
+      | Error err ->
+        invalid_argf "Ogre.Doc.t_of_sexp: ill-formed document: %s"
+          (Problem.to_string_hum err) ()
+
   let to_string x = asprintf "%a" pp x
 end
 

lib/ogre/ogre.mli

@@ -510,13 +510,18 @@ end
 
 *)
 module Doc : sig
-  type t = doc [@@deriving compare]
+  type t = doc [@@deriving bin_io, compare, sexp]
 
 
   (** [empty] creates an empty document  *)
   val empty : doc
 
 
+  (** [is_empty x] is true iff [x] is [empty].
+      @since 2.2.0 *)
+  val is_empty : doc -> bool
+
+
   (** [merge d1 d2] merges two documents in one. Returns an error,
       if documents contain inconsistent declarations.*)
   val merge : doc -> doc -> doc Or_error.t