Cb check standalone (ocurrent#422)

* Added cb-schema inside pipeline

* Using cb-schema in the frontend

* Using cb-schema in cobench

* Added cb-check! with explanation in README

README.md

@@ -35,7 +35,19 @@ To be able to run your benchmarks, current-bench assumes certain things about yo
 ⚠️ The benchmarks are run on a single core (for now), so either don't include parallel benchmarks, or don't take the results at face value.
 
 ### JSon format
-To be able to draw graphs from your results, they need to follow this format:
+To be able to draw graphs from your results, they need to follow a specific format.
+You can automatically check that your output conforms to that format by calling `cb-check`:
+
+<!-- remove the pin when cb-check hits opam -->
+```bash
+opam pin -n cb-check [email protected]:ocurrent/current-bench.git
+opam install cb-check
+your_executable | cb-check
+# OR, if your_executable writes in some_file.json
+cb-check some_file.json
+```
+
+A description of that format is also specified below for convenience:
 
 ```json
 {

cb-check.opam

@@ -0,0 +1,30 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+synopsis: "Json schema checker for current-bench"
+maintainer: ["Ambre Austen Suhamy <[email protected]>"]
+authors: ["Ambre Austen Suhamy <[email protected]>"]
+homepage: "https://github.com/ocurrent/current-bench"
+bug-reports: "https://github.com/ocurrent/current-bench/issues"
+depends: [
+  "dune" {>= "2.9"}
+  "ocaml" {>= "4.13.0"}
+  "yojson"
+  "odoc" {with-doc}
+]
+build: [
+  ["dune" "subst"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "--promote-install-files=false"
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+  ["dune" "install" "-p" name "--create-install-files" name]
+]
+dev-repo: "git+https://github.com/ocurrent/current-bench.git"

cb-check/dune

@@ -0,0 +1,9 @@
+(executable
+ (name main)
+ (package cb-check)
+ (public_name cb-check)
+ (libraries yojson))
+
+(copy_files ../pipeline/cb-schema/*.ml)
+
+(copy_files ../pipeline/lib/json_parsing.ml)

cb-check/main.ml

@@ -0,0 +1,51 @@
+let read_all ic =
+  let b = Buffer.create 80 in
+  let rec loop () =
+    let line = input_line ic in
+    Buffer.add_string b (line ^ "\n");
+    loop ()
+  in
+  try loop ()
+  with End_of_file ->
+    close_in ic;
+    Buffer.contents b
+
+let pp = Yojson.Safe.pretty_print ~std:false
+
+let validate l =
+  let aux (str, _) =
+    match Yojson.Safe.from_string str with
+    | j -> (
+        match Cb_schema.S.of_json j with
+        | s -> Some s
+        | exception Invalid_argument s ->
+            Format.eprintf
+              "Some valid json didn't conform to the schema with error: \
+               %[email protected] json: %a@."
+              s pp j;
+            None)
+    | exception Yojson.Json_error s ->
+        Format.eprintf "\x1b[91mJson parsing failure, please report: \x1b[0m%s"
+          s;
+        exit 1
+  in
+  match List.filter_map aux l with
+  | [] ->
+      Format.printf "No schema-valid results were parsed.@.";
+      exit 1
+  | validated ->
+      Format.printf "Correctly parsed some benchmarks:@.";
+      Cb_schema.S.merge [] validated
+      |> List.map Cb_schema.S.to_json
+      |> List.iter (fun j -> Format.printf "%a@." pp j)
+
+let () =
+  let ic = if Array.length Sys.argv >= 2 then open_in Sys.argv.(1) else stdin in
+  let contents = read_all ic in
+  match Json_parsing.full contents with
+  | [] ->
+      Format.eprintf
+        "\x1b[91mCouldn't parse anything, verify that you output correct \
+         json.\x1b[0m@.";
+      exit 1
+  | l -> validate (List.rev l)

cobench/cobench.ml

@@ -1,6 +1,5 @@
 open Bechamel
-module C = Current_bench_json
-module L = C.Latest
+module L = Cb_schema.S
 module J = Yojson.Safe
 
 type value = L.value
@@ -10,7 +9,8 @@ let list vs = L.Floats vs
 
 type metric = L.metric
 
-let metric ~name ?(description = "") ?(units = "") ?(trend = "") value =
+let metric ~name ?(description = "") ?(units = "") ?(trend = L.Unspecified)
+    value =
   { L.name; description; units; trend; value; lines = [] }
 
 type result = L.result

cobench/cobench.mli

@@ -9,7 +9,7 @@ val metric :
   name:string ->
   ?description:string ->
   ?units:string ->
-  ?trend:string ->
+  ?trend:Cb_schema.S.trend ->
   value ->
   metric
 

cobench/dune

@@ -10,5 +10,4 @@
   ptime.clock.os
   yojson))
 
-(rule
- (copy ../pipeline/lib/current_bench_json.ml current_bench_json.ml))
+(copy_files ../pipeline/cb-schema/*.ml)

dune-project

@@ -74,3 +74,13 @@
    (and
     (>= 1.0.0)
     :with-test))))
+
+(package
+ (name cb-check)
+ (synopsis "Json schema checker for current-bench")
+ (authors "Ambre Austen Suhamy <[email protected]>")
+ (maintainers "Ambre Austen Suhamy <[email protected]>")
+ (depends
+  (ocaml
+   (>= 4.13.0))
+  yojson))

frontend/Dockerfile

@@ -11,13 +11,14 @@ ENV VITE_CURRENT_BENCH_VERSION=$VITE_CURRENT_BENCH_VERSION
 
 RUN apt-get update \
     && apt-get install --no-install-recommends --assume-yes \
-        screen \
+    screen \
     && rm -r /var/lib/apt/lists /var/cache/apt
 
 # set working directory
 WORKDIR /app
 
-COPY ./pipeline/lib/current_bench_json.ml /pipeline/lib/current_bench_json.ml
+COPY ./pipeline/cb-schema/schema.ml /pipeline/cb-schema/schema.ml
+COPY ./pipeline/cb-schema/json.ml /pipeline/cb-schema/json.ml
 
 # Build frontend code for production
 FROM dev AS builder

frontend/src/App.res

@@ -56,7 +56,7 @@ module Benchmark = {
 
   let decode = (result: BenchmarkMetrics.t) => {
     let metrics = yojson_of_result(result)
-    let metrics = Current_bench_json.Latest.of_json(metrics)
+    let metrics = Schema.of_json(metrics)
     let run_at = result.run_at->decodeRunAt->Belt.Option.getExn
     (result.commit, result.run_job_id, run_at, result.test_index, metrics)
   }
@@ -69,7 +69,7 @@ module Benchmark = {
     }
   }
 
-  let toLineGraph = (value: Current_bench_json.Latest.value) => {
+  let toLineGraph = (value: Schema.value) => {
     switch value {
     | Float(x) => LineGraph.DataRow.single(x)
     | Floats(xs) => LineGraph.DataRow.many(Array.of_list(xs))
@@ -84,8 +84,8 @@ module Benchmark = {
       acc,
       (commit, run_job_id, run_at, test_index, item),
     ) => {
-      List.fold_left((acc, result: Current_bench_json.Latest.result) => {
-        List.fold_left((acc, metric: Current_bench_json.Latest.metric) => {
+      List.fold_left((acc, result: Schema.result) => {
+        List.fold_left((acc, metric: Schema.metric) => {
           BenchmarkData.add(
             acc,
             ~testName=result.test_name,

frontend/src/BenchmarkDataHelpers.res

@@ -120,7 +120,7 @@ let addMissingComparisonMetrics = (comparisonBenchmarkDataByTestName, benchmarkD
               run_job_id: run_job_id,
               lines: []->Belt.List.fromArray,
               description: "",
-              trend: "",
+              trend: Schema.Unspecified,
               units: "",
             })
             (ts, md)

frontend/src/BenchmarkTest.res

@@ -25,15 +25,15 @@ type metricRow = {
   delta: option<float>,
   last_value: option<float>,
   comparison_value: option<float>,
-  trend: string,
+  trend: Schema.trend,
 }
 
 let getRowData = (
   ~comparison as (comparisonTimeseries, _)=([], []),
   (timeseries, metadata: BenchmarkData.metadata),
 ) => {
   if Belt.Array.length(timeseries) == 0 {
-    let d = {delta: None, last_value: None, comparison_value: None, trend: ""}
+    let d = {delta: None, last_value: None, comparison_value: None, trend: Schema.Unspecified}
     d
   } else {
     let last_value = BeltHelpers.Array.lastExn(timeseries)->LineGraph.DataRow.toValue
@@ -62,14 +62,9 @@ let getRowData = (
 }
 
 let isFavourableDelta = row => {
-  let ascending =
-    row.trend == "higher-is-better"
-      ? Some(true)
-      : row.trend == "lower-is-better"
-      ? Some(false)
-      : None
-  switch (row.delta, ascending) {
-  | (Some(delta), Some(ascending)) => delta == 0. ? None : Some(delta > 0. == ascending)
+  switch (row.delta, row.trend) {
+  | (Some(delta), Schema.Higher_is_better) => delta == 0. ? None : Some(delta > 0.)
+  | (Some(delta), Schema.Lower_is_better) => delta == 0. ? None : Some(delta < 0.)
   | _ => None
   }
 }
@@ -234,7 +229,7 @@ let make = (
       let suffixes = isOverlayed
         ? names->Belt.Array.map(x => Js.String.split("/", x)[1])
         : [metricName]
-      // FIXME: Validate that units are same on all the overlays? (ideally, in the current_bench_json.ml)
+      // FIXME: Validate that units are same on all the overlays? (ideally, in pipeline/cb-schema)
       let seriesArrays =
         names->Belt.Array.map(x => getSeriesArrays(dataByMetricName, comparison, x))
       // FIXME: Filter out very small values (quick fix for demo, before we work on grouping stuff)

frontend/src/DataHelpers.res

@@ -1,6 +1,6 @@
 let trimCommit = commit => String.length(commit) > 7 ? String.sub(commit, 0, 7) : commit
 
-let rec yojson_of_json = (json : Js.Json.t) : Current_bench_json.Json.t => {
+let rec yojson_of_json = (json : Js.Json.t) : Json.t => {
   switch Js.Json.classify(json) {
     | JSONFalse => #Bool(false)
     | JSONTrue => #Bool(true)

frontend/src/LineGraph.res

@@ -62,7 +62,7 @@ module DataRow = {
     runAt: Js.Date.t,
     units: units,
     description: string,
-    trend: string,
+    trend: Schema.trend,
     lines: list<(int, int)>,
     run_job_id: option<string>,
   }

frontend/src/json.ml

@@ -0,0 +1 @@
+../../pipeline/cb-schema/json.ml

frontend/src/schema.ml

@@ -0,0 +1 @@
+../../pipeline/cb-schema/schema.ml

pipeline/cb-schema/cb_schema.ml

@@ -0,0 +1,7 @@
+(* Warning: This library is used in the pipeline, the checker, AND the frontend.
+ * It must remain compatible with Rescript ~= OCaml 4.06 with a few missing stdlib modules
+ * and must have no external dependency.
+ *)
+
+module Json = Json
+module S = Schema

pipeline/cb-schema/dune

@@ -0,0 +1,3 @@
+(library
+ (name cb_schema)
+ (public_name cb-schema))

pipeline/cb-schema/json.ml

@@ -0,0 +1,47 @@
+type t =
+  (* Yojson.Safe.t = *)
+  [ `Null
+  | `Bool of bool
+  | `Int of int
+  | `Intlit of string
+  | `Float of float
+  | `String of string
+  | `Assoc of (string * t) list
+  | `List of t list
+  | `Tuple of t list
+  | `Variant of string * t option ]
+
+let error key value_type value =
+  match value with
+  | `Null -> invalid_arg @@ Format.sprintf "Mandatory key %S not found." key
+  | _ ->
+      invalid_arg
+      @@ Format.sprintf
+           "The value of key %S had an expected type of `%s`, but the value \
+            didn't fit."
+           key value_type
+
+let get_opt key = function
+  | `Assoc obj -> (
+      match List.assoc_opt key obj with None -> `Null | Some x -> x)
+  | _ -> `Null
+
+let to_string_option = function `String s -> Some s | _ -> None
+let to_int_option = function `Int s -> Some s | _ -> None
+let to_list_option = function `List xs -> Some xs | _ -> None
+let to_list key = function `List xs -> xs | j -> error key "list" j
+
+let get ?(context = "") key j =
+  let err () =
+    error
+      (if context = "" then key else context ^ "/" ^ key)
+      "json object" `Null
+  in
+  match get_opt key j with `Null -> err () | x -> x
+
+let to_string key = function `String s -> s | j -> error key "string" j
+
+let to_float key = function
+  | `Float x -> x
+  | `Int x -> float_of_int x
+  | j -> error key "float" j