Format.

savonet · Jan 1, 2024 · 4caa962 · 4caa962
1 parent 52b108a
commit 4caa962
Show file tree

Hide file tree

Showing 6 changed files with 161 additions and 123 deletions.
diff --git a/.ocamlformat b/.ocamlformat
@@ -0,0 +1,10 @@
+version=0.25.1
+profile = conventional
+break-separators = after
+space-around-lists = false
+doc-comments = before
+match-indent = 2
+match-indent-nested = always
+parens-ite
+exp-grouping = preserve
+module-item-spacing = compact
diff --git a/src/SVG.ml b/src/SVG.ml
@@ -5,13 +5,21 @@
 
 type t = Buffer.t
 
-let w (svg:t) f = Printf.ksprintf (fun s -> Buffer.add_string svg s; Buffer.add_char svg '\n') f
+let w (svg : t) f =
+  Printf.ksprintf
+    (fun s ->
+      Buffer.add_string svg s;
+      Buffer.add_char svg '\n')
+    f
 
-let prop name o = Option.fold ~none:"" ~some:(Printf.sprintf " %s=\"%s\"" name) o
+let prop name o =
+  Option.fold ~none:"" ~some:(Printf.sprintf " %s=\"%s\"" name) o
 
-let prop_int name o = Option.fold ~none:"" ~some:(Printf.sprintf " %s=\"%d\"" name) o
+let prop_int name o =
+  Option.fold ~none:"" ~some:(Printf.sprintf " %s=\"%d\"" name) o
 
-let prop_float name o = Option.fold ~none:"" ~some:(Printf.sprintf " %s=\"%f\"" name) o
+let prop_float name o =
+  Option.fold ~none:"" ~some:(Printf.sprintf " %s=\"%f\"" name) o
 
 let empty () : t = Buffer.create 0
 
@@ -22,34 +30,37 @@ let create ?width ?height () =
   w svg "<svg%s%s>" width height;
   svg
 
-let line svg ?stroke ?stroke_width ?style (x0,y0) (x1,y1) =
+let line svg ?stroke ?stroke_width ?style (x0, y0) (x1, y1) =
   let stroke = prop "stroke" stroke in
   let stroke_width = prop_float "stroke-width" stroke_width in
   let style = prop "style" style in
-  w svg {|  <line x1="%f" y1="%f" x2="%f" y2="%f"%s%s%s/>|} x0 y0 x1 y1 stroke stroke_width style
+  w svg {|  <line x1="%f" y1="%f" x2="%f" y2="%f"%s%s%s/>|} x0 y0 x1 y1 stroke
+    stroke_width style
 
-let text svg ?text_anchor ?fill ?transform (x,y) t =
+let text svg ?text_anchor ?fill ?transform (x, y) t =
   let text_anchor =
     match text_anchor with
-    | Some `Start -> "start"
-    | Some `Middle -> "middle"
-    | Some `End -> "end"
-    | None -> ""
+      | Some `Start -> "start"
+      | Some `Middle -> "middle"
+      | Some `End -> "end"
+      | None -> ""
+  in
+  let text_anchor =
+    if text_anchor = "" then ""
+    else Printf.sprintf {| text-anchor="%s"|} text_anchor
   in
-  let text_anchor = if text_anchor = "" then "" else Printf.sprintf {| text-anchor="%s"|} text_anchor in
   let fill = prop "fill" fill in
   let transform = prop "transform" transform in
-  w svg {|  <text x="%f" y="%f"%s%s%s>%s</text>|} x y fill text_anchor transform t
+  w svg {|  <text x="%f" y="%f"%s%s%s>%s</text>|} x y fill text_anchor transform
+    t
 
 let polyline svg ?stroke ?stroke_width ?fill p =
   let p =
-    List.map (fun (x,y) -> Printf.sprintf "%f,%f" x y) p
-    |> String.concat " "
+    List.map (fun (x, y) -> Printf.sprintf "%f,%f" x y) p |> String.concat " "
   in
   let stroke = prop "stroke" stroke in
   let stroke_width = prop_float "stroke-width" stroke_width in
   let fill = prop "fill" fill in
   w svg {|  <polyline points="%s"%s%s%s/>|} p stroke stroke_width fill
 
-let to_string (svg:t) =
-  Buffer.contents svg ^ "</svg>\n"
+let to_string (svg : t) = Buffer.contents svg ^ "</svg>\n"
diff --git a/src/main.ml b/src/main.ml
@@ -5,34 +5,37 @@ let () =
   let branch = ref "" in
   Arg.parse
     [
-      "-i", Arg.Set_string dir, "Set directory containing metrics";
-      "-o", Arg.Set_string fname, "Set output file name";
-      "--branch", Arg.Set_string branch, "Set branch";
-      "--update", Arg.Set update, "Update data"
+      ("-i", Arg.Set_string dir, "Set directory containing metrics");
+      ("-o", Arg.Set_string fname, "Set output file name");
+      ("--branch", Arg.Set_string branch, "Set branch");
+      ("--update", Arg.Set update, "Update data");
     ]
-    (fun _ -> ()) "metrics [option]";
+    (fun _ -> ())
+    "metrics [option]";
   let branch = if !branch = "" then None else Some !branch in
   Metrics.load_liquidsoap ~update:!update ~directory:!dir ?branch ();
   let oc = open_out !fname in
-  let w fmt = Printf.ksprintf (fun s -> output_string oc (s^"\n")) fmt in
+  let w fmt = Printf.ksprintf (fun s -> output_string oc (s ^ "\n")) fmt in
   w "<!DOCTYPE html>";
   w "<html>";
   w "<head>";
   w "<title>Liquidsoap metrics</title>";
   w {|<link rel="stylesheet" href="style.css">|};
-  w {|<link rel="icon" type="image/png" href="http://liquidsoap.info/assets/img/favicon.ico">|};
+  w
+    {|<link rel="icon" type="image/png" href="http://liquidsoap.info/assets/img/favicon.ico">|};
   w "</head>";
   w "<body>";
   w "<h1>Liquidsoap metrics</h1>";
   List.iter
     (fun (name, _category, unit, min, data) ->
-       Printf.printf "Plotting '%s'\n" name;
-       w "<h2>%s</h2>" (String.capitalize_ascii name);
-       w "<div class=\"plot\">";
-       let ordinate = Printf.sprintf "value (%s)" unit in
-       w "%s" (Plot.svg ~abscissa:"time (s)" ~ordinate ~width:800. ~height:400. ?y_min:min data);
-       w "</div>"
-    )
+      Printf.printf "Plotting '%s'\n" name;
+      w "<h2>%s</h2>" (String.capitalize_ascii name);
+      w "<div class=\"plot\">";
+      let ordinate = Printf.sprintf "value (%s)" unit in
+      w "%s"
+        (Plot.svg ~abscissa:"time (s)" ~ordinate ~width:800. ~height:400.
+           ?y_min:min data);
+      w "</div>")
     (Metrics.series ());
   w "</body>";
-  w "</html>";
+  w "</html>"
diff --git a/src/metrics.ml b/src/metrics.ml
@@ -1,36 +1,23 @@
-type entry =
-  {
-    name : string;
-    category : string;
-    value : float;
-    unit : string;
-    time : float;
-    min : float option
-  }
+type entry = {
+  name : string;
+  category : string;
+  value : float;
+  unit : string;
+  time : float;
+  min : float option;
+}
 
-type entries =
-  {
-    entries : entry list;
-    branch : string;
-  }
+type entries = { entries : entry list; branch : string }
 
 let parse_file fname =
   let ic = open_in fname in
   let s = really_input_string ic (in_channel_length ic) in
   close_in ic;
-  let yaml = Yaml.yaml_of_string s |> Result.get_ok |> Yaml.to_json |> Result.get_ok in
   let yaml =
-    match yaml with
-    | `A l -> l
-    | _ -> assert false
-  in
-  let yaml =
-    List.map
-      (function
-        | `O l -> l
-        | _ -> assert false
-      ) yaml
+    Yaml.yaml_of_string s |> Result.get_ok |> Yaml.to_json |> Result.get_ok
   in
+  let yaml = match yaml with `A l -> l | _ -> assert false in
+  let yaml = List.map (function `O l -> l | _ -> assert false) yaml in
   let string = function `String s -> s | _ -> assert false in
   let float = function `Float x -> x | _ -> assert false in
   let string l k = List.assoc k l |> string in
@@ -39,12 +26,21 @@ let parse_file fname =
   let entries =
     List.filter_map
       (fun l ->
-         let string = string l in
-         let float = float l in
-         let float_opt = float_opt l in
-         if List.mem_assoc "commit" l then None else
-           Some {name = string "name"; category = string "category"; value = float "value"; unit = string "unit"; time = float "time"; min = float_opt "min"}
-      ) yaml
+        let string = string l in
+        let float = float l in
+        let float_opt = float_opt l in
+        if List.mem_assoc "commit" l then None
+        else
+          Some
+            {
+              name = string "name";
+              category = string "category";
+              value = float "value";
+              unit = string "unit";
+              time = float "time";
+              min = float_opt "min";
+            })
+      yaml
   in
   let branch =
     let header = List.find (fun l -> List.mem_assoc "commit" l) yaml in
@@ -62,34 +58,35 @@ let add_file ?branch fname =
 
 let load_dir ?branch dir =
   let files =
-    Sys.readdir dir
-    |> Array.to_list
+    Sys.readdir dir |> Array.to_list
     |> List.map (fun s -> dir ^ "/" ^ s)
     |> List.filter (fun s -> Filename.check_suffix s ".yaml")
     |> List.sort_uniq compare
   in
   List.iter (add_file ?branch) files
 
-let load_liquidsoap ~directory ?(update=false) ?branch () =
+let load_liquidsoap ~directory ?(update = false) ?branch () =
   if update then
     if not (Sys.file_exists directory) then
-      assert (Sys.command (Printf.sprintf "git clone -b metrics https://github.com/savonet/liquidsoap.git %s" directory) = 0)
-    else
-      assert (Sys.command (Printf.sprintf "cd %s && git pull" directory) = 0);
+      assert (
+        Sys.command
+          (Printf.sprintf
+             "git clone -b metrics https://github.com/savonet/liquidsoap.git %s"
+             directory)
+        = 0)
+    else assert (Sys.command (Printf.sprintf "cd %s && git pull" directory) = 0);
   load_dir ?branch directory
 
 (** All the possible names for tests. *)
-let names () =
-  List.map (fun e -> e.name) !db
-  |> List.sort_uniq compare
+let names () = List.map (fun e -> e.name) !db |> List.sort_uniq compare
 
 (** All metrics series. *)
 let series () =
   List.map
     (fun n ->
-       let l = List.filter (fun e -> e.name = n) !db in
-       let e = List.hd l in
-       let l = List.map (fun e -> e.time, e.value) l in
-       let l = List.sort (fun (t,_) (t',_) -> compare t t') l in
-       n, e.category, e.unit, e.min, l
-    ) (names ())
+      let l = List.filter (fun e -> e.name = n) !db in
+      let e = List.hd l in
+      let l = List.map (fun e -> (e.time, e.value)) l in
+      let l = List.sort (fun (t, _) (t', _) -> compare t t') l in
+      (n, e.category, e.unit, e.min, l))
+    (names ())
diff --git a/src/plot.ml b/src/plot.ml
@@ -5,65 +5,77 @@ let format_timestamp f =
   Ptime.pp_human () formatter timestamp;
   Buffer.contents buf
 
-let svg ?(margin=100.) ~width ~height ?(abscissa="") ?(ordinate="") ?x_min ?x_max ?y_min ?y_max points =
+let svg ?(margin = 100.) ~width ~height ?(abscissa = "") ?(ordinate = "") ?x_min
+    ?x_max ?y_min ?y_max points =
   let x_min', x_max', y_min', y_max' =
     let x, y = List.hd points in
     List.fold_left
-      (fun (x_min', x_max', y_min', y_max') (x,y) ->
-         min x x_min',
-         max x x_max',
-         min y y_min',
-         max y y_max'
-      )
-      (x,x,y,y)
-      points
+      (fun (x_min', x_max', y_min', y_max') (x, y) ->
+        (min x x_min', max x x_max', min y y_min', max y y_max'))
+      (x, x, y, y) points
   in
   let x_min = Option.value x_min ~default:x_min' in
   let x_max = Option.value x_max ~default:x_max' in
   let y_min = Option.value y_min ~default:y_min' in
   let y_max = Option.value y_max ~default:y_max' in
-  let (++) (x,y) (x',y') = (x+.x',y+.y') in
-  let coord (x,y) =
-    margin +. (x -. x_min) /. (x_max -. x_min) *. width,
-    margin +. height -. ((y -. y_min) /. (y_max -. y_min) *. height)
+  let ( ++ ) (x, y) (x', y') = (x +. x', y +. y') in
+  let coord (x, y) =
+    ( margin +. ((x -. x_min) /. (x_max -. x_min) *. width),
+      margin +. height -. ((y -. y_min) /. (y_max -. y_min) *. height) )
   in
   let points =
-    points
-    |> List.sort (fun (x,_) (x',_) -> compare x x')
-    |> List.map coord
+    points |> List.sort (fun (x, _) (x', _) -> compare x x') |> List.map coord
   in
-  let svg = SVG.create ~width:(width +. 2. *. margin) ~height:(height +. 2. *. margin) () in
-  SVG.line svg ~stroke:"black" (coord (x_min,y_min)) (coord (x_max,y_min));
-  SVG.line svg ~stroke:"black" (coord (x_min,y_min)) (coord (x_min,y_max));
+  let svg =
+    SVG.create
+      ~width:(width +. (2. *. margin))
+      ~height:(height +. (2. *. margin))
+      ()
+  in
+  SVG.line svg ~stroke:"black" (coord (x_min, y_min)) (coord (x_max, y_min));
+  SVG.line svg ~stroke:"black" (coord (x_min, y_min)) (coord (x_min, y_max));
   let ticks = 5 in
   let tick = 10. in
   for i = 0 to ticks - 1 do
-    let x = x_min  +. float i *. (x_max -. x_min) /. float ticks in
+    let x = x_min +. (float i *. (x_max -. x_min) /. float ticks) in
     let y = y_min in
-    SVG.line svg ~stroke:"black" (coord (x,y) ++ (0.,-.tick/.2.)) (coord (x,y) ++ (0.,tick/.2.));
-    SVG.text svg (coord (x,y)) ~fill:"black" ~text_anchor:`Middle ~transform:"translate(0,20)" (format_timestamp x);
+    SVG.line svg ~stroke:"black"
+      (coord (x, y) ++ (0., -.tick /. 2.))
+      (coord (x, y) ++ (0., tick /. 2.));
+    SVG.text svg
+      (coord (x, y))
+      ~fill:"black" ~text_anchor:`Middle ~transform:"translate(0,20)"
+      (format_timestamp x);
     let x = x_min in
-    let y = y_min +. float i *. (y_max -. y_min) /. float ticks in
-    SVG.line svg ~stroke:"black" (coord (x,y) ++ (-.tick/.2.,0.)) (coord (x,y) ++ (tick/.2.,0.));
-    SVG.text svg (coord (x,y)) ~fill:"black" ~text_anchor:`End (Printf.sprintf "%.02f" y);
+    let y = y_min +. (float i *. (y_max -. y_min) /. float ticks) in
+    SVG.line svg ~stroke:"black"
+      (coord (x, y) ++ (-.tick /. 2., 0.))
+      (coord (x, y) ++ (tick /. 2., 0.));
+    SVG.text svg
+      (coord (x, y))
+      ~fill:"black" ~text_anchor:`End (Printf.sprintf "%.02f" y)
   done;
   (* Arrow heads *)
-  (
-    let x, y = coord (x_max,y_min) in
-    SVG.polyline svg ~stroke:"black" ~fill:"none" [
-      x -. tick/.2., y +. tick/.2.;
-      x, y;
-      x -. tick/.2., y -. tick/.2.
-    ];
-    let x, y = coord (x_min,y_max) in
-    SVG.polyline svg ~stroke:"black" ~fill:"none" [
-      x -. tick/.2., y +. tick/.2.;
-      x, y;
-      x +. tick/.2., y +. tick/.2.
-    ];
-  );
-  if abscissa <> "" then SVG.text svg (coord (x_max,y_min)) ~fill:"black" abscissa;
-  if ordinate <> "" then SVG.text svg (coord (x_min,y_max)) ~fill:"black" ~text_anchor:`Middle ordinate;
+  (let x, y = coord (x_max, y_min) in
+   SVG.polyline svg ~stroke:"black" ~fill:"none"
+     [
+       (x -. (tick /. 2.), y +. (tick /. 2.));
+       (x, y);
+       (x -. (tick /. 2.), y -. (tick /. 2.));
+     ];
+   let x, y = coord (x_min, y_max) in
+   SVG.polyline svg ~stroke:"black" ~fill:"none"
+     [
+       (x -. (tick /. 2.), y +. (tick /. 2.));
+       (x, y);
+       (x +. (tick /. 2.), y +. (tick /. 2.));
+     ]);
+  if abscissa <> "" then
+    SVG.text svg (coord (x_max, y_min)) ~fill:"black" abscissa;
+  if ordinate <> "" then
+    SVG.text svg
+      (coord (x_min, y_max))
+      ~fill:"black" ~text_anchor:`Middle ordinate;
   (* Actual plot *)
   SVG.polyline svg ~stroke:"red" ~stroke_width:2. ~fill:"none" points;
   SVG.to_string svg