cconv_test.ml

(*D

Trying CConv
============
  
See
[`c-cube/cconv`](https://github.com/c-cube/cconv)

For now, it is experimental:

    opam remote add ccube git@github.com:c-cube/yolopam-repository.git
    opam update
    opam install yojson cconv

Vim stuff:

    :Use cconv yojson
    :set makeprg=ocaml\ cconv_test.ml
    :nmap <leader>D :w ! oredoc.sh > ~/tmp/dd.html<cr>

Toplevel stuff:

D*)
#use "topfind"
#require "cconv.yojson"

let d fmt = Printf.(ksprintf (fun s -> eprintf "%s\n%!" s)) fmt

(*D

Versioned Formats
-----------------

We want backwards compatibility:

D*)
module V1 = struct
  type t = { x: float; y: float}
  let source =
    CConv.Source.(
      record_fix
        (fun self ->
           field "x" (fun p -> p.x) float_ @@
           field "y" (fun p -> p.y) float_ @@
           record_stop
        ))
  let sink =
    CConv.Sink.(
      record_fix
        (fun self ->
           field "x" float_ @@ fun x ->
           field "y" float_ @@ fun y ->
           yield_record {x;y}
      ))
end
module V2 = struct
  type t = { x: float; y: float; color: string}
  let source =
    CConv.Source.(
      record_fix
        (fun self ->
           field "x" (fun p -> p.x) float_ @@
           field "y" (fun p -> p.y) float_ @@
           field "color" (fun p -> p.color) string_ @@
           record_stop
        ))
  let sink =
    CConv.Sink.(
      record_fix
        (fun self ->
           field "x" float_ @@ fun x ->
           field "y" float_ @@ fun y ->
           field "color" string_ @@ fun color ->
           yield_record {x;y;color}
      ))
  let of_v1 p = { x = p.V1.x; y = p.V1.y; color = "blue"}
end
module Current = struct
  type t = V2.t = { x: float; y: float; color: string}
  let source =
    CConv.Source.(
      sum_fix (fun self t -> "V2", hcons V2.source t @@ hnil))
  let sink =
    CConv.Sink.(
      sum_fix
        (fun self str ->
           match str with
           | "V1" -> V1.sink |+| fun p -> yield (V2.of_v1 p)
           | "V2" -> V2.sink |+| fun p -> yield p
           | s ->
             CConv.report_error
               "expected version string (V1 or V2) but got: %S" s
        ))
  let of_json_string s =
    Yojson.Basic.from_string s |> CConv.from CConvYojson.source sink
  let to_json_string p =
    CConv.into source CConvYojson.sink p |> Yojson.Basic.to_string
end 


let () =
  d "Go!";
  d "P1: %s" Current.({x = 1.; y = 2.; color = "black"} |> to_json_string);
  let test s =
    d "%s → %s" s
      Current.(try of_json_string s |> to_json_string with e -> Printexc.to_string e);
  in
  test "[\"V1\",{\"y\":2.0,\"x\":1.0}]";
  test "[\"Wrong\",{\"y\":2.0,\"x\":1.0}]";
  test "[\"V1\",{\"z\":2.0,\"x\":1.0}]";
  test "[\"V1\",{\"y\":2.0,\"x\":1.0, \"additional\":2.0}]";
  d "Done!"