(** Generic differential testing: OCaml codec vs wire-generated C code.

    Each schema needs [c_read] and [c_write] functions (generated by
    {!Wire.to_c_stubs} and {!Wire.to_ml_stub}). All diff logic is generic over
    any record codec. *)

type 'r schema = {
  name : string;
  c_read : string -> string option;
  c_write : string -> string option;
  equal : 'r -> 'r -> bool;
  codec_decode : bytes -> int -> 'r;
  codec_encode : 'r -> bytes -> int -> unit;
  wire_size : int;
}

let schema ~name ~codec ~c_read ~c_write ~equal =
  let wire_size = Wire.Codec.wire_size codec in
  {
    name;
    c_read;
    c_write;
    equal;
    codec_decode = Wire.Codec.decode codec;
    codec_encode = Wire.Codec.encode codec;
    wire_size;
  }

type result =
  | Match
  | Both_failed
  | Value_mismatch of string
  | Only_c_ok of string
  | Only_ocaml_ok of string

let c_roundtrip schema buf =
  match schema.c_read buf with
  | None -> None
  | Some fields -> schema.c_write fields

let encode_to_string schema v =
  let buf = Bytes.create schema.wire_size in
  schema.codec_encode v buf 0;
  Bytes.unsafe_to_string buf

let decode_from_string schema s = schema.codec_decode (Bytes.of_string s) 0

let read schema buf =
  let c_result = c_roundtrip schema buf in
  let buf_too_short = String.length buf < schema.wire_size in
  let ocaml_result =
    if String.length buf = 0 || buf_too_short then None
    else Some (decode_from_string schema buf)
  in
  match (c_result, ocaml_result) with
  | Some c_bytes, Some v ->
      let ocaml_bytes = encode_to_string schema v in
      if c_bytes = ocaml_bytes then Match
      else Value_mismatch "roundtrip bytes differ"
  | None, None -> Both_failed
  | Some _, None -> Only_c_ok "OCaml decode returned empty"
  | None, Some _ -> Only_ocaml_ok "C roundtrip failed"

let write schema value =
  let ocaml_bytes = encode_to_string schema value in
  match c_roundtrip schema ocaml_bytes with
  | Some c_bytes ->
      if c_bytes = ocaml_bytes then Match
      else Value_mismatch "C roundtrip bytes differ from OCaml encoding"
  | None -> Only_ocaml_ok "C rejected OCaml-encoded bytes"

let full_roundtrip schema value =
  let ocaml_bytes = encode_to_string schema value in
  match c_roundtrip schema ocaml_bytes with
  | None -> Only_c_ok "C rejected OCaml-encoded bytes"
  | Some c_bytes ->
      let final = decode_from_string schema c_bytes in
      if schema.equal value final then Match
      else Value_mismatch "values differ after full roundtrip"

let roundtrip_struct s buf =
  match Wire.read_struct s buf with
  | Error e -> Error e
  | Ok ps -> Wire.write_struct s ps

type packed_test = {
  name : string;
  wire_size : int;
  test_read : string -> result;
  test_write : string -> result;
  test_roundtrip : string -> result;
}

let pack (type r) (schema : r schema) ~wire_size =
  let decode_value buf =
    let padded =
      if String.length buf >= wire_size then String.sub buf 0 wire_size
      else
        let b = Bytes.make wire_size '\000' in
        Bytes.blit_string buf 0 b 0 (String.length buf);
        Bytes.to_string b
    in
    if String.length padded = 0 then None
    else Some (decode_from_string schema padded)
  in
  {
    name = schema.name;
    wire_size;
    test_read = (fun buf -> read schema buf);
    test_write =
      (fun buf ->
        match decode_value buf with
        | Some v -> write schema v
        | None -> Both_failed);
    test_roundtrip =
      (fun buf ->
        match decode_value buf with
        | Some v -> full_roundtrip schema v
        | None -> Both_failed);
  }