refactor: move bare_encoding/ser to catapult.utils

this way, the instrumentation library `catapult` gets smaller. Only
where the client is used do we pay the cost for the additional code.

src/client/backend.ml

@@ -2,7 +2,7 @@ open Catapult_utils
 module P = Catapult
 module Tracing = P.Tracing
 
-type event = P.Ser.Event.t
+type event = Ser.Event.t
 
 module type ARG = sig
   val conn : Connections.t
@@ -17,7 +17,7 @@ module Make (A : ARG) : P.BACKEND = struct
     | Some x -> Some (f x)
 
   let conv_arg (key, a) =
-    let open P.Ser in
+    let open Ser in
     let value =
       match a with
       | `Int x -> Arg_value.Int64 (Int64.of_int x)
@@ -31,7 +31,7 @@ module Make (A : ARG) : P.BACKEND = struct
   let emit ~id ~name ~ph ~tid ~pid ~cat ~ts_us ~args ~stack ~dur ?extra () :
       unit =
     let ev =
-      let open P.Ser in
+      let open Ser in
       let tid = Int64.of_int tid in
       let pid = Int64.of_int pid in
       let stack = opt_map_ Array.of_list stack in

src/client/connections.ml

@@ -19,16 +19,16 @@ module Logger = struct
     t_id: int; (* thread id *)
     trace_id: string; (* int, obtain from server *)
     buf: Buffer.t;
-    out: P.Bare_encoding.Encode.t; (* outputs to buf *)
+    out: Bare_encoding.Encode.t; (* outputs to buf *)
     sock: [ `Dealer ] Zmq.Socket.t;
     mutable closed: bool;
   }
 
-  let send_msg ~ignore_err (self : t) (msg : P.Ser.Client_message.t) : unit =
+  let send_msg ~ignore_err (self : t) (msg : Ser.Client_message.t) : unit =
     if not self.closed then (
       try
         Buffer.clear self.buf;
-        P.Ser.Client_message.encode self.out msg;
+        Ser.Client_message.encode self.out msg;
         Zmq.Socket.send ~block:true self.sock (Buffer.contents self.buf)
       with e ->
         if ignore_err then
@@ -40,7 +40,7 @@ module Logger = struct
   let close (self : t) =
     if not self.closed then (
       (let msg =
-         P.Ser.Client_message.Client_close_trace { trace_id = self.trace_id }
+         Ser.Client_message.Client_close_trace { trace_id = self.trace_id }
        in
        send_msg ~ignore_err:true self msg);
       self.closed <- true;
@@ -50,7 +50,7 @@ module Logger = struct
   (* add a new logger, connect to daemon, and return logger *)
   let create ~trace_id ~ctx ~addr ~t_id () : t =
     let buf = Buffer.create 512 in
-    let out = P.Bare_encoding.Encode.of_buffer buf in
+    let out = Bare_encoding.Encode.of_buffer buf in
     let sock = connect_endpoint ctx addr in
 
     let logger = { t_id; sock; buf; out; trace_id; closed = false } in
@@ -59,8 +59,7 @@ module Logger = struct
 
     (* send initial message *)
     send_msg ~ignore_err:false logger
-      (P.Ser.Client_message.Client_open_trace
-         { P.Ser.Client_open_trace.trace_id });
+      (Ser.Client_message.Client_open_trace { Ser.Client_open_trace.trace_id });
     logger
 end
 
@@ -97,12 +96,12 @@ let create ~(addr : Endpoint_address.t) ~trace_id () : t =
   self
 
 (* send a message. *)
-let send_msg (self : t) ~pid ~now (ev : P.Ser.Event.t) : unit =
+let send_msg (self : t) ~pid ~now (ev : Ser.Event.t) : unit =
   if not self.closed then (
     let logger = Thread_local.get_or_create self.per_t in
     let msg =
-      P.Ser.Client_message.Client_emit
-        { P.Ser.Client_emit.trace_id = self.trace_id; ev }
+      Ser.Client_message.Client_emit
+        { Ser.Client_emit.trace_id = self.trace_id; ev }
     in
     Logger.send_msg ~ignore_err:false logger msg;
 

src/client/connections.mli

@@ -1,8 +1,7 @@
 open Catapult_utils
-module P = Catapult
 
 type t
 
 val create : addr:Endpoint_address.t -> trace_id:string -> unit -> t
-val send_msg : t -> pid:int -> now:float -> P.Ser.Event.t -> unit
+val send_msg : t -> pid:int -> now:float -> Ser.Event.t -> unit
 val close : t -> unit

src/core/arg.mli

@@ -6,3 +6,5 @@
 
 type t =
   [ `Int of int | `String of string | `Float of float | `Bool of bool | `Null ]
+(** Custum argument for events, spans, instants, etc. *)
+

src/core/catapult.ml

@@ -18,17 +18,15 @@
 module type BACKEND = Backend.S
 module type IMPL = Impl.S
 
-module Event_type = Event_type
 module Arg = Arg
-module Tracing = Tracing
-module Nil_impl = Nil_impl
 module Control = Tracing.Control
-module Ser = Ser
+module Event_type = Event_type
+module Nil_impl = Nil_impl
+module Tracing = Tracing
 
 (**/**)
 
 module Atomic_shim_ = Atomic_shim_
-module Bare_encoding = Bare_encoding
 module Clock = Clock
 
 (**/**)

src/core/dune

@@ -17,24 +17,3 @@
   (with-stdout-to
    %{targets}
    (run gen/gen.exe))))
-
-; generate (de)ser code
-
-(rule
- (alias lint)
- (targets ser.ml)
- (deps ser.bare)
- (mode promote)
- (action
-  (run bare-codegen --pp -o %{targets} %{deps})))
-
-; vendor runtime library for BARE
-
-(rule
- (alias lint)
- (targets Bare_encoding.ml Bare_encoding.mli)
- (mode promote)
- (action
-  (progn
-   (copy %{lib:bare_encoding:Bare_encoding.ml} Bare_encoding.ml)
-   (copy %{lib:bare_encoding:Bare_encoding.mli} Bare_encoding.mli))))

src/daemon/catapult_daemon.ml

@@ -6,7 +6,7 @@ module Log = (val Logs.src_log (Logs.Src.create "catapult.daemon"))
 open Catapult_utils
 open Tr.Syntax
 
-type event = P.Ser.Event.t
+type event = Ser.Event.t
 type batch = event list
 
 let now_us = P.Clock.now_us
@@ -202,17 +202,17 @@ end = struct
     Zmq.Socket.bind sock addr_str;
     sock
 
-  let handle_client_msg (self : t) (msg : P.Ser.Client_message.t) : unit =
-    Log.debug (fun k -> k "client msg:@ %a" P.Ser.Client_message.pp msg);
+  let handle_client_msg (self : t) (msg : Ser.Client_message.t) : unit =
+    Log.debug (fun k -> k "client msg:@ %a" Ser.Client_message.pp msg);
 
     match msg with
-    | P.Ser.Client_message.Client_open_trace { trace_id } ->
+    | Ser.Client_message.Client_open_trace { trace_id } ->
       Log.info (fun k -> k "client opened trace %S" trace_id);
       Tr.instant "open.trace" ~args:[ "id", `String trace_id ];
       Writer.incr_conn self.writer ~trace_id
-    | P.Ser.Client_message.Client_emit { trace_id; ev } ->
+    | Ser.Client_message.Client_emit { trace_id; ev } ->
       Writer.write self.writer ~trace_id ev
-    | P.Ser.Client_message.Client_close_trace { trace_id } ->
+    | Ser.Client_message.Client_close_trace { trace_id } ->
       Log.info (fun k -> k "client closed trace %S" trace_id);
       Writer.decr_conn self.writer ~trace_id
 
@@ -235,8 +235,8 @@ end = struct
     while not (Atomic.get self.stop) do
       match Zmq.Socket.recv ~block:false self.sock with
       | msg ->
-        let dec = P.Bare_encoding.Decode.of_string msg in
-        let msg = P.Ser.Client_message.decode dec in
+        let dec = Bare_encoding.Decode.of_string msg in
+        let msg = Ser.Client_message.decode dec in
         handle_client_msg self msg
       | exception Unix.Unix_error (Unix.EAGAIN, _, _) ->
         (* just poll *)

src/sqlite/backend.ml

@@ -3,7 +3,7 @@ module P = Catapult
 module Tracing = P.Tracing
 module Atomic = P.Atomic_shim_
 
-type event = P.Ser.Event.t
+type event = Ser.Event.t
 
 module type ARG = sig
   val writer : Writer.t

src/sqlite/ev_to_json.ml

@@ -1,4 +1,4 @@
-module P = Catapult
+open Catapult_utils
 module Out = Catapult_utils.Json_out
 
 let[@inline] field_col oc = Out.char oc ':'
@@ -16,20 +16,9 @@ let[@inline] opt_iter o f =
   | None -> ()
   | Some x -> f x
 
-let to_json buf (ev : P.Ser.Event.t) : string =
-  let {
-    P.Ser.Event.id;
-    name;
-    ph;
-    pid;
-    tid;
-    cat;
-    ts_us;
-    args;
-    stack;
-    dur;
-    extra;
-  } =
+let to_json buf (ev : Ser.Event.t) : string =
+  let { Ser.Event.id; name; ph; pid; tid; cat; ts_us; args; stack; dur; extra }
+      =
     ev
   in
 
@@ -85,23 +74,23 @@ let to_json buf (ev : P.Ser.Event.t) : string =
       field_col buf;
       Out.char buf '{';
       Array.iteri
-        (fun i { P.Ser.Arg.key; value } ->
+        (fun i { Ser.Arg.key; value } ->
           if i > 0 then field_sep buf;
           Out.str_val buf key;
           field_col buf;
           match value with
-          | P.Ser.Arg_value.Int64 i -> Out.int64 buf i
-          | P.Ser.Arg_value.String s -> Out.str_val buf s
-          | P.Ser.Arg_value.Float64 f -> Out.float buf f
-          | P.Ser.Arg_value.Bool s -> Out.bool buf s
-          | P.Ser.Arg_value.Void -> Out.null buf)
+          | Ser.Arg_value.Int64 i -> Out.int64 buf i
+          | Ser.Arg_value.String s -> Out.str_val buf s
+          | Ser.Arg_value.Float64 f -> Out.float buf f
+          | Ser.Arg_value.Bool s -> Out.bool buf s
+          | Ser.Arg_value.Void -> Out.null buf)
         args;
       Out.char buf '}';
       field_sep buf);
 
   opt_iter extra (fun l ->
       Array.iter
-        (fun { P.Ser.Extra.key; value } ->
+        (fun { Ser.Extra.key; value } ->
           Out.str_val buf key;
           field_col buf;
           Out.str_val buf value;

src/sqlite/ev_to_json.mli

@@ -1,3 +1,3 @@
-module P = Catapult
+open Catapult_utils
 
-val to_json : Buffer.t -> P.Ser.Event.t -> string
+val to_json : Buffer.t -> Ser.Event.t -> string

src/sqlite/writer.mli

@@ -1,5 +1,3 @@
-module P = Catapult
-
 type t
 
 val create :

src/utils/catapult_utils.ml

@@ -1,4 +1,6 @@
+module Bare_encoding = Bare_encoding
 module Endpoint_address = Endpoint_address
 module Gc_stats = Gc_stats
 module Json_out = Json_out
+module Ser = Ser
 module Thread_local = Thread_local

src/utils/dune

@@ -2,3 +2,24 @@
  (name catapult_utils)
  (public_name catapult.utils)
  (libraries catapult))
+
+; generate (de)ser code
+
+(rule
+ (alias lint)
+ (targets ser.ml)
+ (deps ser.bare)
+ (mode promote)
+ (action
+  (run bare-codegen --pp -o %{targets} %{deps})))
+
+; vendor runtime library for BARE
+
+(rule
+ (alias lint)
+ (targets Bare_encoding.ml Bare_encoding.mli)
+ (mode promote)
+ (action
+  (progn
+   (copy %{lib:bare_encoding:Bare_encoding.ml} Bare_encoding.ml)
+   (copy %{lib:bare_encoding:Bare_encoding.mli} Bare_encoding.mli))))