package kaun-board

  1. Overview
  2. Docs

Source file event.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
(*---------------------------------------------------------------------------
  Copyright (c) 2026 The Raven authors. All rights reserved.
  SPDX-License-Identifier: ISC
  ---------------------------------------------------------------------------*)

let json_obj pairs =
  Jsont.Json.object' (List.map (fun (k, v) -> (Jsont.Json.name k, v)) pairs)

let json_mem name = function
  | Jsont.Object (mems, _) -> (
      match Jsont.Json.find_mem name mems with
      | Some (_, v) -> v
      | None -> Jsont.Null ((), Jsont.Meta.none))
  | _ -> Jsont.Null ((), Jsont.Meta.none)

type t =
  | Scalar of {
      step : int;
      epoch : int option;
      tag : string;
      value : float;
      wall_time : float;
    }

let of_json (json : Jsont.json) : (t, string) result =
  try
    match json_mem "type" json with
    | Jsont.String ("scalar", _) ->
        let step =
          match json_mem "step" json with
          | Jsont.Number (f, _) -> int_of_float f
          | _ -> failwith "expected int for step"
        in
        let tag =
          match json_mem "tag" json with
          | Jsont.String (s, _) -> s
          | _ -> failwith "expected string for tag"
        in
        let value =
          match json_mem "value" json with
          | Jsont.Number (f, _) -> f
          | _ -> failwith "expected number for value"
        in
        let epoch =
          match json_mem "epoch" json with
          | Jsont.Number (f, _) -> Some (int_of_float f)
          | _ -> None
        in
        let wall_time =
          match json_mem "wall_time" json with
          | Jsont.Number (f, _) -> f
          | _ -> 0.0
        in
        Ok (Scalar { step; epoch; tag; value; wall_time })
    | Jsont.String (other, _) -> Error ("unknown event type: " ^ other)
    | _ -> Error "missing or invalid type field"
  with Failure msg -> Error msg

let to_json (Scalar { step; epoch; tag; value; wall_time }) : Jsont.json =
  let epoch_field =
    Option.map (fun e -> ("epoch", Jsont.Json.int e)) epoch |> Option.to_list
  in
  json_obj
    ([
       ("type", Jsont.Json.string "scalar");
       ("step", Jsont.Json.int step);
       ("wall_time", Jsont.Json.number wall_time);
       ("tag", Jsont.Json.string tag);
       ("value", Jsont.Json.number value);
     ]
    @ epoch_field)