Top level printers for the main cohttp types

.merlin

@@ -32,6 +32,7 @@ PKG cmdliner
 PKG js_of_ocaml
 PKG magic-mime
 PKG alcotest
+PKG compiler-libs.toplevel
 
 B _build/
 B _build/lwt

_oasis

@@ -44,6 +44,15 @@ Library cohttp_test
   Modules:       Cohttp_test
   BuildDepends:  cohttp, oUnit
 
+Library cohttp_top
+  Install:       true
+  Path:          top
+  Findlibname:   top
+  FindlibParent: cohttp
+  XMETARequires: cohttp
+  BuildDepends:  compiler-libs.toplevel
+  Modules:       Cohttp_top
+
 Flag all
   Description: build everything that is possible
   Default:     false

_tags

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 811b48ecb494c9283414e38214743062)
+# DO NOT EDIT (digest: e44c7776ad3e33b5f7a5cacdf7e3cf51)
 # Ignore VCS directories, you can use the same kind of rule outside
 # OASIS_START/STOP if you want to exclude directories that contains
 # useless stuff for the build process
@@ -49,6 +49,9 @@ true: annot, bin_annot
 <lib/*.ml{,i,y}>: pkg_uri
 <lib/*.ml{,i,y}>: pkg_uri.services
 <lib/*.ml{,i,y}>: use_cohttp
+# Library cohttp_top
+"top/cohttp_top.cmxs": use_cohttp_top
+<top/*.ml{,i,y}>: pkg_compiler-libs.toplevel
 # Library cohttp_lwt
 "lwt/cohttp_lwt.cmxs": use_cohttp_lwt
 # Library cohttp_lwt_unix

lib/META

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 0993413eb2018c7116a8e1ceec9b45f9)
+# DO NOT EDIT (digest: 43144d443f8df44ab09d0fc9136bc5d0)
 version = "0.17.2"
 description = "HTTP library for Lwt, Async, JavaScript and Mirage"
 requires =
@@ -9,6 +9,17 @@ archive(byte, plugin) = "cohttp.cma"
 archive(native) = "cohttp.cmxa"
 archive(native, plugin) = "cohttp.cmxs"
 exists_if = "cohttp.cma"
+package "top" (
+ version = "0.17.2"
+ description = "HTTP library for Lwt, Async, JavaScript and Mirage"
+ requires = "cohttp"
+ archive(byte) = "cohttp_top.cma"
+ archive(byte, plugin) = "cohttp_top.cma"
+ archive(native) = "cohttp_top.cmxa"
+ archive(native, plugin) = "cohttp_top.cmxs"
+ exists_if = "cohttp_top.cma"
+)
+
 package "test" (
  version = "0.17.2"
  description = "HTTP library for Lwt, Async, JavaScript and Mirage"

lib/header.ml

@@ -248,6 +248,7 @@ let connection h =
   | Some x -> Some (`Unknown x)
   | x -> None
 
+open Sexplib
 open Sexplib.Std
 open Sexplib.Conv
 
@@ -256,3 +257,6 @@ let sexp_of_t t =
 
 let t_of_sexp s =
   of_list (list_of_sexp (pair_of_sexp string_of_sexp string_of_sexp) s)
+
+let pp_hum ppf h =
+  Format.fprintf ppf "%s" (h |> sexp_of_t |> Sexp.to_string_hum)

lib/header.mli

@@ -105,3 +105,6 @@ val prepend_user_agent : t -> string -> t
     "User-Agent" field (if any). *)
 
 val connection : t -> [`Keep_alive | `Close | `Unknown of string] option
+
+(** Human-readable output, used by the toplevel printer *)
+val pp_hum : Format.formatter -> t -> unit

lib/request.ml

@@ -70,6 +70,9 @@ let make_for_client ?headers ?(chunked=true) ?(body_length=Int64.zero) meth uri
   in
   make ~meth ~encoding ?headers uri
 
+let pp_hum ppf r =
+  Format.fprintf ppf "%s" (r |> sexp_of_t |> Sexplib.Sexp.to_string_hum)
+
 type tt = t
 module Make(IO : S.IO) = struct
   type t = tt

lib/request.mli

@@ -27,6 +27,9 @@
     serializers to convert to-and-from an {!Core.Std.Sexp.t}. *)
 include S.Request
 
+(** Human-readable output, used by the toplevel printer *)
+val pp_hum : Format.formatter -> t -> unit
+
 (** Functor to construct the IO-specific HTTP request handling functions *)
 module Make(IO : S.IO) : S.Http_io
   with type t = t

lib/response.ml

@@ -29,6 +29,9 @@ let make ?(version=`HTTP_1_1) ?(status=`OK) ?(flush=false) ?(encoding=Transfer.C
   let headers = match headers with None -> Header.init () |Some h -> h in
   { encoding; headers; version; flush; status }
 
+let pp_hum ppf r =
+  Format.fprintf ppf "%s" (r |> sexp_of_t |> Sexplib.Sexp.to_string_hum)
+
 type tt = t
 module Make(IO : S.IO) = struct
   type t = tt

lib/response.mli

@@ -29,6 +29,9 @@
     serializers to convert to-and-from an {!Core.Std.Sexp.t}. *)
 include S.Response
 
+(** Human-readable output, used by the toplevel printer *)
+val pp_hum : Format.formatter -> t -> unit
+
 (** Functor to construct the IO-specific response handling function *)
 module Make(IO : S.IO) : S.Http_io
   with type t = t

myocamlbuild.ml

@@ -1,5 +1,5 @@
 (* OASIS_START *)
-(* DO NOT EDIT (digest: ff6dfa24b5c9bce29b3a58476f2a0337) *)
+(* DO NOT EDIT (digest: 263a4e4510a24a3732c5cc97c5ccec8d) *)
 module OASISGettext = struct
 (* # 22 "src/oasis/OASISGettext.ml" *)
 
@@ -611,6 +611,7 @@ let package_default =
        [
           ("cohttp", ["lib"], []);
           ("cohttp_test", ["lib"], []);
+          ("cohttp_top", ["top"], []);
           ("cohttp_lwt", ["lwt"], []);
           ("cohttp_lwt_unix", ["lwt"], []);
           ("cohttp_lwt_xhr", ["js"], []);
@@ -636,6 +637,6 @@ let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false}
 
 let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;;
 
-# 640 "myocamlbuild.ml"
+# 641 "myocamlbuild.ml"
 (* OASIS_STOP *)
 Ocamlbuild_plugin.dispatch dispatch_default;;

setup.ml

@@ -1,7 +1,7 @@
 (* setup.ml generated for the first time by OASIS v0.4.5 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: 2803c6b233c82e6bd6bdb06949376864) *)
+(* DO NOT EDIT (digest: ddfca6121be164d9f95dd91f3e7db714) *)
 (*
    Regenerated by OASIS v0.4.5
    Visit http://oasis.forge.ocamlcore.org for more information and
@@ -7200,6 +7200,37 @@ let setup_t =
                       lib_findlib_name = Some "test";
                       lib_findlib_containers = []
                    });
+               Library
+                 ({
+                     cs_name = "cohttp_top";
+                     cs_data = PropList.Data.create ();
+                     cs_plugin_data = []
+                  },
+                   {
+                      bs_build = [(OASISExpr.EBool true, true)];
+                      bs_install = [(OASISExpr.EBool true, true)];
+                      bs_path = "top";
+                      bs_compiled_object = Best;
+                      bs_build_depends =
+                        [FindlibPackage ("compiler-libs.toplevel", None)];
+                      bs_build_tools = [ExternalTool "ocamlbuild"];
+                      bs_c_sources = [];
+                      bs_data_files = [];
+                      bs_ccopt = [(OASISExpr.EBool true, [])];
+                      bs_cclib = [(OASISExpr.EBool true, [])];
+                      bs_dlllib = [(OASISExpr.EBool true, [])];
+                      bs_dllpath = [(OASISExpr.EBool true, [])];
+                      bs_byteopt = [(OASISExpr.EBool true, [])];
+                      bs_nativeopt = [(OASISExpr.EBool true, [])]
+                   },
+                   {
+                      lib_modules = ["Cohttp_top"];
+                      lib_pack = false;
+                      lib_internal_modules = [];
+                      lib_findlib_parent = Some "cohttp";
+                      lib_findlib_name = Some "top";
+                      lib_findlib_containers = []
+                   });
                Flag
                  ({
                      cs_name = "all";
@@ -8856,14 +8887,14 @@ let setup_t =
        };
      oasis_fn = Some "_oasis";
      oasis_version = "0.4.5";
-     oasis_digest = Some "$\137O6@C\018�\154%-a�mҴ";
+     oasis_digest = Some "_\141�\155��a\004E\133�N�\011-\128";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false
   };;
 
 let setup () = BaseSetup.setup setup_t;;
 
-# 8868 "setup.ml"
+# 8899 "setup.ml"
 (* OASIS_STOP *)
 let () = setup ();;

top/cohttp_top.ml

@@ -0,0 +1,20 @@
+let printers = [ "Cohttp.Header.pp_hum"
+               ; "Cohttp.Request.pp_hum"
+               ; "Cohttp.Response.pp_hum" ]
+
+let eval_string
+      ?(print_outcome = false) ?(err_formatter = Format.err_formatter) str =
+  let lexbuf = Lexing.from_string str in
+  let phrase = !Toploop.parse_toplevel_phrase lexbuf in
+  Toploop.execute_phrase print_outcome err_formatter phrase
+
+let rec install_printers = function
+  | [] -> true
+  | printer :: printers ->
+      let cmd = Printf.sprintf "#install_printer %s;;" printer in
+      eval_string cmd && install_printers printers
+
+let () =
+  if not (install_printers printers) then
+    Format.eprintf "Problem installing Cohttp-printers@."
+

top/cohttp_top.mldylib

@@ -0,0 +1,4 @@
+# OASIS_START
+# DO NOT EDIT (digest: 2f82f537ac3c3eae3961f1001930e9e6)
+Cohttp_top
+# OASIS_STOP

top/cohttp_top.mllib

@@ -0,0 +1,4 @@
+# OASIS_START
+# DO NOT EDIT (digest: 2f82f537ac3c3eae3961f1001930e9e6)
+Cohttp_top
+# OASIS_STOP