diff --git a/src/prometheus/tiny_httpd_prometheus.ml b/src/prometheus/tiny_httpd_prometheus.ml index 7e6a8539..b7caf220 100644 --- a/src/prometheus/tiny_httpd_prometheus.ml +++ b/src/prometheus/tiny_httpd_prometheus.ml @@ -60,8 +60,17 @@ module Counter = struct let[@inline] incr self = A.incr self.c let[@inline] incr_by self n = ignore (A.fetch_and_add self.c n : int) - let[@inline] decr self = A.decr self.c - let[@inline] decr_by self n = ignore (A.fetch_and_add self.c (-n) : int) + + let incr_to self n = + while + let old = A.get self.c in + if old < n then + not (A.compare_and_set self.c old n) + else + false + do + () + done end module Gauge = struct @@ -197,3 +206,26 @@ let add_route_to_server (server : H.t) (reg : registry) : unit = let instrument_server (server : H.t) reg : unit = H.add_middleware ~stage:(`Stage 1) server (http_middleware global); add_route_to_server server reg + +module GC_metrics = struct + type t = { major_coll: counter; major_heap: gauge; compactions: counter } + + let create reg : t = + let major_coll = + Counter.create reg ~descr:"major GC collections" "ocaml_gc_major" + in + let major_heap = + Gauge.create reg ~descr:"size of major heap" "ocaml_gc_major_heap_size" + in + let compactions = + Counter.create reg ~descr:"number of GC compactions" + "ocaml_gc_compactions" + in + { major_coll; major_heap; compactions } + + let update (self : t) = + let stats = Gc.quick_stat () in + Counter.incr_to self.major_coll stats.major_collections; + Counter.incr_to self.compactions stats.compactions; + Gauge.set self.major_heap (int_of_float (stats.major_words *. 8.)) +end diff --git a/src/prometheus/tiny_httpd_prometheus.mli b/src/prometheus/tiny_httpd_prometheus.mli index e82a5e13..055dc135 100644 --- a/src/prometheus/tiny_httpd_prometheus.mli +++ b/src/prometheus/tiny_httpd_prometheus.mli @@ -26,8 +26,10 @@ module Counter : sig val create : Registry.t -> ?tags:tags -> ?descr:string -> string -> t val incr : t -> unit val incr_by : t -> int -> unit - val decr : t -> unit - val decr_by : t -> int -> unit + + val incr_to : t -> int -> unit + (** Increment to the given number. If it's lower than the current + value this does nothing *) end (** Gauges *) @@ -71,3 +73,10 @@ val add_route_to_server : Tiny_httpd.t -> Registry.t -> unit val instrument_server : Tiny_httpd.t -> Registry.t -> unit (** Add middleware and route *) + +module GC_metrics : sig + type t + + val create : Registry.t -> t + val update : t -> unit +end