OCaml 5.5.0 released

Ecosystem
,
11

I attempted to apply OCaml 5.5.0 new features in a program that addresses this challenge question from everybody codes

Here is my solution.

module type Enum = sig
  type t
  val of_string : string -> t option
end

module Color = struct
  type t = Blue | Green | Red | Black | White
  let of_string = function
    | "BLUE" -> Some Blue
    | "GREEN" -> Some Green
    | "RED" -> Some Red
    | "BLACK" -> Some Black
    | "WHITE" -> Some White
    | _ -> None
end

module Shape = struct
  type t = Circle | Pentagon | Hexagon | Triangle | Square
  let of_string = function
    | "CIRCLE" -> Some Circle
    | "PENTAGON" -> Some Pentagon
    | "HEXAGON" -> Some Hexagon
    | "TRIANGLE" -> Some Triangle
    | "SQUARE" -> Some Square
    | _ -> None
end

type connector = { color : Color.t; shape : Shape.t }

type spec = { id : int; plug : connector; lsock : connector; rsock : connector }

type tree = { id : int; left : socket; right : socket }
and socket = Free of connector | Plugged of tree

let plant (s : spec) : tree =
  { id = s.id; left = Free s.lsock; right = Free s.rsock }

let required (module E : Enum) ~what s : E.t =
  match E.of_string s with
  | Some v -> v
  | None -> invalid_arg (Printf.sprintf "unknown %s %S" what s)

let connector_of_string s =
  match String.split_first ~sep:" " s with
  | None -> invalid_arg ("connector: " ^ s)
  | Some (c, sh) ->
      { color = required (module Color) ~what:"color" c;
        shape = required (module Shape) ~what:"shape" sh }

let spec_of_line line =
  let open Option.Syntax in
  let get key s =
    let* k, v = String.split_first ~sep:"=" s in
    if String.equal k key then Some v else None
  in
  let parsed =
    match String.split_all ~sep:", " ~drop:String.is_empty line with
    | id :: plug :: lsock :: rsock :: _ ->
        let* id = get "id" id in
        let* id = int_of_string_opt id in
        let* plug = get "plug" plug in
        let* lsock = get "leftSocket" lsock in
        let+ rsock = get "rightSocket" rsock in
        { id;
          plug = connector_of_string plug;
          lsock = connector_of_string lsock;
          rsock = connector_of_string rsock }
    | _ -> None
  in
  match parsed with
  | Some s -> s
  | None -> invalid_arg ("node line: " ^ line)

let insert tree spec =
  let type verdict = Placed of tree | No_match in
  let rec go t =
    let into sock rebuild =
      match sock with
      | Free c when c = spec.plug -> Placed (rebuild (Plugged (plant spec)))
      | Free _ -> No_match
      | Plugged child -> (
          match go child with
          | Placed child' -> Placed (rebuild (Plugged child'))
          | No_match -> No_match)
    in
    match into t.left (fun l -> { t with left = l }) with
    | Placed _ as placed -> placed
    | No_match -> into t.right (fun r -> { t with right = r })
  in
  match go tree with
  | Placed t -> t
  | No_match -> invalid_arg (Printf.sprintf "node %d fits no socket" spec.id)

let rec in_order t =
  Seq.delay (fun () ->
      let sub = function Free _ -> Seq.empty | Plugged c -> in_order c in
      Seq.append (sub t.left) (Seq.cons t.id (sub t.right)))

let checksum tree =
  Seq.fold_lefti (fun acc i id -> acc + (i + 1) * id) 0 (in_order tree)

let () =
  match
    In_channel.input_lines stdin
    |> List.filter (Fun.negate String.is_empty)
    |> List.map spec_of_line
  with
  | [] -> ()
  | root :: rest ->
      let timer_start = Sys.time () in
      List.fold_left insert (plant root) rest
      |> checksum
      |> Printf.printf "%d\n%!";
      (Sys.time () -. timer_start) *. 1e6
      |> Printf.printf "Elapsed time: %.1f microseconds\n%!"

I would like to have a conversation about my conversation regarding what I could have done better.
Thank you for your time.