Release 0.3

CHANGES

@@ -1,3 +1,9 @@
+0.3 (2020-09-13) Nancy
+----------------------
+
+- containers > 3.0 compatibility
+- Add Prom_cfg, module to generate prometheus autoconfiguration files
+
 0.2 (2020-02-27) Paris
 ----------------------
 

prom.opam

@@ -8,7 +8,7 @@ doc: "https://vbmithr.github.io/ocaml-prometheus/doc"
 build: [ "dune" "build" "-j" jobs "-p" name ]
 run-test: [ "dune" "runtest" "-j" jobs "-p" name ]
 depends: [
-  "ocaml" {>= "4.07.0"}
+  "ocaml" {>= "4.08.0"}
   "dune" {>= "1.11.4"}
   "fmt" {>= "0.8.8"}
   "ptime" {>= "0.8.5"}

src/dune

@@ -1,4 +1,11 @@
 (library
  (name            prom)
  (public_name     prom)
+ (modules         prom kll)
  (libraries       fmt ptime containers))
+
+(library
+ (name            prom_cfg)
+ (public_name     prom.cfg)
+ (modules         prom_cfg))
+

src/kll.ml

@@ -2,17 +2,18 @@ open Containers
 module Array = Vector
 
 module MakeCompactor (T : Set.OrderedType) = struct
-  type t =
-    { mutable numCompactions: int
-    ; alternate: bool
-    ; mutable elts: T.t Vector.vector }
+  type t = {
+    mutable numCompactions : int;
+    alternate : bool;
+    mutable elts : T.t Vector.vector;
+  }
 
   let create ?(alternate = true) ?(elts = Vector.create ()) () =
-    {numCompactions= 0; alternate; elts}
+    { numCompactions = 0; alternate; elts }
 
-  let length {elts; _} = Vector.length elts
+  let length { elts; _ } = Vector.length elts
 
-  let iter f {elts; _} = Vector.iter f elts
+  let iter f { elts; _ } = Vector.iter f elts
 
   let push t v = Vector.push t.elts v
 
@@ -22,17 +23,17 @@ module MakeCompactor (T : Set.OrderedType) = struct
     let odd =
       if t.alternate then t.numCompactions mod 2 = 1 else Random.bool ()
     in
-    Vector.sort' T.compare t.elts ;
+    Vector.sort' T.compare t.elts;
     let lastItem =
       if Vector.length t.elts mod 2 = 1 then Vector.pop t.elts else None
     in
     let newElts = Vector.create () in
     Vector.iteri
       (fun i v -> if Bool.equal odd (i mod 2 = 1) then Vector.push newElts v)
-      t.elts ;
-    Vector.clear t.elts ;
-    Option.iter (Vector.push t.elts) lastItem ;
-    t.numCompactions <- succ t.numCompactions ;
+      t.elts;
+    Vector.clear t.elts;
+    Option.iter (Vector.push t.elts) lastItem;
+    t.numCompactions <- succ t.numCompactions;
     newElts
 end
 
@@ -46,22 +47,25 @@ module type S = sig
 
   val update : t -> elt -> unit
 
-  val cdf : t -> (elt * float) list
+  val update_n : t -> elt -> int -> unit
 
-  val pp_cdf : elt Fmt.t -> Format.formatter -> t -> unit
+  val cdf : t -> (elt * float) array
+
+  val pp_cdf : elt Fmt.t -> Format.formatter -> (elt * float) array -> unit
 end
 
 module Make (T : Set.OrderedType) : S with type elt := T.t = struct
   module Compactor = MakeCompactor (T)
 
-  type t =
-    { k: int
-    ; c: float
-    ; lazy_mode: bool
-    ; alternate: bool
-    ; compactors: Compactor.t Vector.vector
-    ; mutable size: int
-    ; mutable maxSize: int }
+  type t = {
+    k : int;
+    c : float;
+    lazy_mode : bool;
+    alternate : bool;
+    compactors : Compactor.t Vector.vector;
+    mutable size : int;
+    mutable maxSize : int;
+  }
 
   let update_size t =
     t.size <- Vector.fold (fun a c -> a + Compactor.length c) 0 t.compactors
@@ -73,7 +77,7 @@ module Make (T : Set.OrderedType) : S with type elt := T.t = struct
   (* [grow t] adds an additional empty compactor to [t] and update
      [maxSize]. *)
   let grow t =
-    Vector.push t.compactors (Compactor.create ()) ;
+    Vector.push t.compactors (Compactor.create ());
     let _, newMaxSize =
       Vector.fold
         (fun (i, a) _ -> (succ i, a + capacity t i))
@@ -84,53 +88,64 @@ module Make (T : Set.OrderedType) : S with type elt := T.t = struct
   let create ?(k = 128) ?(c = 2. /. 3.) ?(lazy_mode = true) ?(alternate = true)
       () =
     let t =
-      { k
-      ; c
-      ; lazy_mode
-      ; alternate
-      ; compactors= Vector.create ()
-      ; size= 0
-      ; maxSize= 0 }
+      {
+        k;
+        c;
+        lazy_mode;
+        alternate;
+        compactors = Vector.create ();
+        size = 0;
+        maxSize = 0;
+      }
     in
-    grow t ; t
+    grow t;
+    t
 
   let compress_aux t =
     Vector.iteri
       (fun i c ->
         if Compactor.length c >= capacity t i then (
-          if succ i >= Vector.length t.compactors then grow t ;
+          if succ i >= Vector.length t.compactors then grow t;
           let newElts = Compactor.compact t.compactors.(i) in
-          Compactor.extend t.compactors.(succ i) newElts ;
-          update_size t ;
-          if t.lazy_mode then raise Exit ))
+          Compactor.extend t.compactors.(succ i) newElts;
+          update_size t;
+          if t.lazy_mode then raise_notrace Exit ))
       t.compactors
 
   let compress t = try compress_aux t with Exit -> ()
 
   let update t v =
-    Compactor.push t.compactors.(0) v ;
-    t.size <- succ t.size ;
+    Compactor.push t.compactors.(0) v;
+    t.size <- succ t.size;
     if t.size >= t.maxSize then (
-      compress t ;
+      compress t;
       assert (t.size < t.maxSize) )
 
+  let update_n t v n =
+    for _ = 0 to n - 1 do
+      update t v
+    done
+
   let cdf t =
     let itemsAndWeights = Vector.create () in
     Vector.iteri
       (fun i c ->
         Compactor.iter (fun e -> Vector.push itemsAndWeights (e, 2 lsl i)) c)
-      t.compactors ;
+      t.compactors;
     let totWeight = Vector.fold (fun a (_, w) -> a + w) 0 itemsAndWeights in
-    Vector.sort' Stdlib.compare itemsAndWeights ;
-    Vector.fold
-      (fun (cw, a) (e, w) ->
-        let cw = cw + w in
-        (cw, (e, float cw /. float totWeight) :: a))
-      (0, []) itemsAndWeights
-    |> snd |> List.rev
+    Vector.sort' Stdlib.compare itemsAndWeights;
+    let res = Vector.create () in
+    let _ =
+      Vector.fold
+        (fun cw (e, w) ->
+          let cw = cw + w in
+          Vector.push res (e, float cw /. float totWeight);
+          cw)
+        0 itemsAndWeights
+    in
+    Vector.to_array res
 
   let pp_cdf pp ppf t =
-    let a = cdf t in
     let pp_line ppf (v, p) = Fmt.pf ppf "%a %f" pp v p in
-    Fmt.pf ppf "%a@." (Fmt.list ~sep:Format.pp_print_newline pp_line) a
+    Fmt.pf ppf "%a@." (Fmt.array ~sep:Format.pp_print_newline pp_line) t
 end

src/kll.mli

@@ -1,3 +1,5 @@
+(** Mostly cargo-culted from https://github.com/edoliberty/streaming-quantiles *)
+
 module type S = sig
   type elt
 
@@ -8,9 +10,11 @@ module type S = sig
 
   val update : t -> elt -> unit
 
-  val cdf : t -> (elt * float) list
+  val update_n : t -> elt -> int -> unit
+
+  val cdf : t -> (elt * float) array
 
-  val pp_cdf : elt Fmt.t -> Format.formatter -> t -> unit
+  val pp_cdf : elt Fmt.t -> Format.formatter -> (elt * float) array -> unit
 end
 
 module Make (T : Set.OrderedType) : S with type elt := T.t

src/prom.ml

@@ -1,4 +1,3 @@
-open Containers
 module FSet = Set.Make (Float)
 module SMap = Map.Make (String)
 module FMap = Map.Make (Float)
@@ -19,15 +18,15 @@ let cumulate data =
         (v, add k v a))
       data (0, empty)
   in
-  add infinity cum a
+  add Float.infinity cum a
 
 let complex_cum_fmap count sum data = { count; sum; data }
 
 let complex_cum count sum data =
-  { count; sum; data = FMap.of_std_seq (List.to_std_seq data) }
+  { count; sum; data = FMap.of_seq (List.to_seq data) }
 
 let complex count sum data =
-  { count; sum; data = cumulate (FMap.of_std_seq (List.to_std_seq data)) }
+  { count; sum; data = cumulate (FMap.of_seq (List.to_seq data)) }
 
 module Descr = struct
   module T = struct
@@ -80,41 +79,41 @@ type m = Metric : 'a typ * 'a metric -> m
 
 type t = { descr : Descr.t; series : m }
 
+let name { descr; _ } = descr.name
+
+let help { descr; _ } = descr.help
+
 let create ?help name typ m =
   let m =
     List.fold_left
       (fun a (labels, v) ->
-        LabelsMap.add (SMap.of_std_seq (List.to_std_seq labels)) v a)
+        LabelsMap.add (SMap.of_seq (List.to_seq labels)) v a)
       LabelsMap.empty m
   in
   { descr = Descr.create ?help name; series = Metric (typ, m) }
 
 let add_labels labels ({ series = Metric (typ, m); _ } as t) =
   let m =
     LabelsMap.fold
-      (fun k v a ->
-        LabelsMap.add (SMap.add_std_seq k (List.to_std_seq labels)) v a)
+      (fun k v a -> LabelsMap.add (SMap.add_seq (List.to_seq labels) k) v a)
       m LabelsMap.empty
   in
   { t with series = Metric (typ, m) }
 
 let merge { descr; series = Metric (t, m); _ }
     { descr = descr'; series = Metric (t', m'); _ } =
-  match (eq_typ t t', Descr.equal descr descr') with
+  match (eq_typ t t', descr = descr') with
   | None, _ -> invalid_arg "merge"
   | _, false -> invalid_arg "merge"
   | Some Eq, true ->
-      {
-        descr;
-        series = Metric (t, LabelsMap.union (fun _ a _ -> Some a) m m');
-      }
+      { descr; series = Metric (t, LabelsMap.union (fun _ a _ -> Some a) m m') }
 
 let pp_ts ppf ts = Fmt.pf ppf "%f" (Ptime.to_float_s ts *. 1e3)
 
 let pp_float ppf f =
-  match Float.classify f with
+  match Float.classify_float f with
   | FP_nan -> Fmt.string ppf "Nan"
-  | FP_infinite when Float.sign_exn f = -1 -> Fmt.string ppf "-Inf"
+  | FP_infinite when Float.sign_bit f -> Fmt.string ppf "-Inf"
   | FP_infinite -> Fmt.string ppf "+Inf"
   | _ -> Fmt.float ppf f
 
@@ -132,9 +131,7 @@ let pp_sum_count name labels ppf { count; sum; _ } =
   Fmt.pf ppf "%s_count%a %d" name pp_labels labels count
 
 let pp_histogram_line name labels ts ppf (le, v) =
-  let labels =
-    List.rev (("le", Fmt.str "%a" pp_float le) :: List.rev labels)
-  in
+  let labels = List.rev (("le", Fmt.str "%a" pp_float le) :: List.rev labels) in
   Fmt.pf ppf "%s_bucket%a %d %a" name pp_labels labels v (Fmt.option pp_ts) ts
 
 let pp_summary_line name labels ts ppf (le, v) =
@@ -147,7 +144,6 @@ let pp_complex_histogram name labels ppf { ts; v = { data; _ } as cplx } =
   Fmt.list ~sep:Format.pp_print_newline
     (pp_histogram_line name labels ts)
     ppf (FMap.bindings data);
-
   Format.pp_print_newline ppf ();
   pp_sum_count name labels ppf cplx
 
@@ -188,7 +184,16 @@ let pp_summary name ppf (labels, t) =
   let aux { sum; count; data = kll, pct } =
     let cdf = KLL.cdf kll in
     let find_pct n =
-      List.find_opt (fun (_, p) -> Float.sign_exn (p -. n) = 1) cdf
+      match
+        Containers.Array.bsearch
+          ~cmp:(fun (_, x) (_, y) -> Float.compare x y)
+          (0., n) cdf
+      with
+      | `Empty -> None
+      | `All_lower -> None
+      | `All_bigger -> Some cdf.(0)
+      | `At i -> Some cdf.(i)
+      | `Just_after i -> Some cdf.(succ i)
     in
     let quantiles = FSet.fold (fun l a -> (l, find_pct l) :: a) pct [] in
     let quantiles =

src/prom.mli

@@ -1,5 +1,3 @@
-open Containers
-
 module SMap : Map.S with type key := string
 
 module FSet : Set.S with type elt := float
@@ -48,6 +46,10 @@ type t
 (** Type of a Prometheus metric. Contains a name, an optional help
     text, a type, and labels associated to a value. *)
 
+val name : t -> string
+
+val help : t -> string option
+
 val add_labels : (string * string) list -> t -> t
 (** [add_labels labels t] will add [labels] to all series in [t]. *)