upgrade ppxlib to 0.36 / handle Ptyp_open (#60)

anmonteiro · web-flow · commit d6ca192bc688 · 2025-12-13T20:07:40.000-08:00
diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml
@@ -37,7 +37,7 @@ jobs:
           opam-repositories: |
             default: https://github.com/ocaml/opam-repository.git
 
-      - run: opam install . --deps-only --with-test
+      - run: opam install . --deps-only --with-test --with-dev-setup
 
       - run: opam exec -- dune build
 
diff --git a/CHANGES.md b/CHANGES.md
@@ -1,3 +1,8 @@
+## Unreleased
+
+- Support `Ptype_open`, e.g. `type u = X.(x) [@@deriving json]`
+  ([#60](https://github.com/melange-community/melange-json/pull/60))
+
 ## 2.0.0 (2025-03-11)
 
 - **[breaking]** Library, PPX: Unify runtimes (`*.ppx-runtime` libraries are
diff --git a/Makefile b/Makefile
@@ -13,7 +13,7 @@ help: ## Print this help message
 
 .PHONY: create-switch
 create-switch: ## Create opam switch
-	opam switch create . 5.2.0 -y --deps-only
+	opam switch create . 5.4.0 -y --deps-only
 
 .PHONY: init
 init: create-switch install ## Configure everything to develop this repository in local
diff --git a/dune-project b/dune-project
@@ -35,13 +35,13 @@
     (>= "3.10.0")
     :with-test))
   (ppxlib
-   (>= "0.32.0"))
-  (opam-check-npm-deps :with-test) ; todo: use with-dev-setup once opam 2.2 is out
-  (ocaml-lsp-server :with-test)
+   (>= "0.36.0"))
+  (opam-check-npm-deps :with-dev-setup)
+  (ocaml-lsp-server :with-dev-setup)
   (ocamlformat
    (and
     (>= "0.27.0")
-    :with-test))))
+    :with-dev-setup))))
 
 (package
  (name melange-json-native)
@@ -53,6 +53,6 @@
   (ocaml
    (>= "4.12"))
   (ppxlib
-   (>= "0.32.0"))
+   (>= "0.36.0"))
   (yojson
    (>= "1.6.0"))))
diff --git a/melange-json-native.opam b/melange-json-native.opam
@@ -14,7 +14,7 @@ bug-reports: "https://github.com/melange-community/melange-json/issues"
 depends: [
   "dune" {>= "3.16"}
   "ocaml" {>= "4.12"}
-  "ppxlib" {>= "0.32.0"}
+  "ppxlib" {>= "0.36.0"}
   "yojson" {>= "1.6.0"}
   "odoc" {with-doc}
 ]
diff --git a/melange-json.opam b/melange-json.opam
@@ -17,10 +17,10 @@ depends: [
   "melange" {>= "4.0.0"}
   "melange-jest" {with-test}
   "reason" {>= "3.10.0" & with-test}
-  "ppxlib" {>= "0.32.0"}
-  "opam-check-npm-deps" {with-test}
-  "ocaml-lsp-server" {with-test}
-  "ocamlformat" {>= "0.27.0" & with-test}
+  "ppxlib" {>= "0.36.0"}
+  "opam-check-npm-deps" {with-dev-setup}
+  "ocaml-lsp-server" {with-dev-setup}
+  "ocamlformat" {>= "0.27.0" & with-dev-setup}
   "odoc" {with-doc}
 ]
 build: [
@@ -39,6 +39,6 @@ build: [
 ]
 dev-repo: "git+https://github.com/melange-community/melange-json.git"
 pin-depends: [
-  [ "opam-check-npm-deps.dev" "git+https://github.com/ahrefs/opam-check-npm-deps.git#12e63761842c71dc3a688257f7827580ebe2b7f1"]
+  [ "opam-check-npm-deps.dev" "git+https://github.com/ahrefs/opam-check-npm-deps.git#8adc5a6fa6b744c4007f5085ef0cf1347a4b5f36" ]
 ]
 
diff --git a/melange-json.opam.template b/melange-json.opam.template
@@ -1,4 +1,4 @@
 pin-depends: [
-  [ "opam-check-npm-deps.dev" "git+https://github.com/ahrefs/opam-check-npm-deps.git#12e63761842c71dc3a688257f7827580ebe2b7f1"]
+  [ "opam-check-npm-deps.dev" "git+https://github.com/ahrefs/opam-check-npm-deps.git#8adc5a6fa6b744c4007f5085ef0cf1347a4b5f36" ]
 ]
 
diff --git a/package.json b/package.json
@@ -1,6 +1,7 @@
 {
   "devDependencies": {
-    "jest": "^26.5.2",
+    "jest": "^29.0",
+    "jest-environment-jsdom": "^29.0",
     "@testing-library/jest-dom": "^5.10.0"
   }
 }
diff --git a/ppx/native/common/ppx_deriving_tools.ml b/ppx/native/common/ppx_deriving_tools.ml
@@ -4,11 +4,35 @@ open Ast_builder.Default
 open StdLabels
 open Expansion_helpers
 
+module Lid = struct
+  let flatten =
+    let rec flat accu = function
+      | Lident s -> s :: accu
+      | Ldot (lid, s) -> flat (s :: accu) lid
+      | Lapply (_, _) -> failwith "Longident.flat"
+    in
+    fun lid -> flat [] lid
+
+  let unflatten l =
+    match l with
+    | [] -> None
+    | hd :: tl ->
+        Some
+          (List.fold_left
+             ~f:(fun p s -> Ldot (p, s))
+             ~init:(Lident hd) tl)
+end
+
 let not_supported ~loc what =
   Location.raise_errorf ~loc "%s are not supported" what
 
 let map_loc f a_loc = { a_loc with txt = f a_loc.txt }
 
+let lident_with_optional_open ?opn label =
+  match opn with
+  | Some { txt = lid; _ } -> Longident.Ldot (lid, label)
+  | None -> lident label
+
 let gen_bindings ~loc prefix n =
   List.split
     (List.init ~len:n ~f:(fun i ->
@@ -129,13 +153,14 @@ module Schema = struct
     | Rinherit _ ->
         not_supported ~loc:field.prf_loc "this polyvariant inherit"
 
-  let repr_core_type ty =
+  let rec repr_core_type ty =
     let loc = ty.ptyp_loc in
     match ty.ptyp_desc with
     | Ptyp_tuple ts -> `Ptyp_tuple ts
     | Ptyp_constr (id, ts) -> `Ptyp_constr (id, ts)
     | Ptyp_var txt -> `Ptyp_var { txt; loc = ty.ptyp_loc }
     | Ptyp_variant (fs, Closed, None) -> `Ptyp_variant fs
+    | Ptyp_open (id, ct) -> `Ptyp_open (id, repr_core_type ct)
     | Ptyp_variant _ -> not_supported ~loc "non closed polyvariants"
     | Ptyp_arrow _ -> not_supported ~loc "function types"
     | Ptyp_any -> not_supported ~loc "type placeholders"
@@ -246,11 +271,31 @@ module Schema = struct
 
       method private derive_of_core_type' t =
         let loc = t.ptyp_loc in
-        match repr_core_type t with
+        self#derive_of_core_type_repr ~loc t (repr_core_type t)
+
+      method private derive_of_core_type_repr ?opn ~loc t repr =
+        match repr with
         | `Ptyp_tuple ts -> As_fun (self#derive_of_tuple t ts)
         | `Ptyp_var label ->
-            As_val (ederiver self#name (map_loc lident label))
+            As_val
+              (ederiver self#name
+                 (map_loc (lident_with_optional_open ?opn) label))
+        | `Ptyp_open (_, `Ptyp_open _) -> assert false
+        | `Ptyp_open (lid, ct) ->
+            self#derive_of_core_type_repr ~opn:lid ~loc t ct
         | `Ptyp_constr (id, ts) ->
+            let id =
+              match opn with
+              | Some { txt = lid; loc } ->
+                  {
+                    txt =
+                      Lid.flatten lid @ Lid.flatten id.txt
+                      |> Lid.unflatten
+                      |> Option.get;
+                    loc;
+                  }
+              | None -> id
+            in
             self#derive_type_ref' self#name ~loc id ts
         | `Ptyp_variant fs -> As_fun (self#derive_of_polyvariant t fs)
 
diff --git a/ppx/test/dune b/ppx/test/dune
@@ -8,3 +8,9 @@
   ../../.ocamlformat
   ../native/ppx_deriving_json_native_test.exe
   ../browser/ppx_deriving_json_js_test.exe))
+
+(cram
+ (applies_to ptype_open)
+ (enabled_if
+  (>= %{ocaml_version} 5.2.0)))
+
diff --git a/ppx/test/ptype_open.t b/ppx/test/ptype_open.t
@@ -0,0 +1,96 @@
+We can use the `Ptyp_open` AST node:
+  $ echo '
+  > module X = struct
+  >  type x = (int * int) [@@deriving json]
+  > end
+  > type u = X.(x) [@@deriving json]
+  > let () = print_endline (Melange_json.to_string (u_to_json (1, 2)))
+  > let () = assert (u_of_json (Melange_json.of_string {|[1, 2]|}) = (1, 2))
+  > ' | ./run.sh
+  === ppx output:native ===
+  module X =
+    struct
+      type x = (int * int)[@@deriving json]
+      include
+        struct
+          let _ = fun (_ : x) -> ()
+          [@@@ocaml.warning "-39-11-27"]
+          let rec x_of_json =
+            (fun x ->
+               match x with
+               | `List (x_0::x_1::[]) -> ((int_of_json x_0), (int_of_json x_1))
+               | _ ->
+                   Melange_json.of_json_error ~json:x
+                     "expected a JSON array of length 2" : Yojson.Basic.t -> x)
+          let _ = x_of_json
+          [@@@ocaml.warning "-39-11-27"]
+          let rec x_to_json =
+            (fun x ->
+               match x with
+               | (x_0, x_1) -> `List [int_to_json x_0; int_to_json x_1] : 
+            x -> Yojson.Basic.t)
+          let _ = x_to_json
+        end[@@ocaml.doc "@inline"][@@merlin.hide ]
+    end
+  type u = X.(x)[@@deriving json]
+  include
+    struct
+      let _ = fun (_ : u) -> ()
+      [@@@ocaml.warning "-39-11-27"]
+      let rec u_of_json = (fun x -> X.x_of_json x : Yojson.Basic.t -> u)
+      let _ = u_of_json
+      [@@@ocaml.warning "-39-11-27"]
+      let rec u_to_json = (fun x -> X.x_to_json x : u -> Yojson.Basic.t)
+      let _ = u_to_json
+    end[@@ocaml.doc "@inline"][@@merlin.hide ]
+  let () = print_endline (Melange_json.to_string (u_to_json (1, 2)))
+  let () = assert ((u_of_json (Melange_json.of_string {|[1, 2]|})) = (1, 2))
+  === ppx output:browser ===
+  module X =
+    struct
+      type x = (int * int)[@@deriving json]
+      include
+        struct
+          let _ = fun (_ : x) -> ()
+          [@@@ocaml.warning "-39-11-27"]
+          let rec x_of_json =
+            (fun x ->
+               if
+                 Stdlib.(&&) (Js.Array.isArray x)
+                   (Stdlib.(=)
+                      (Js.Array.length (Obj.magic x : Js.Json.t array)) 2)
+               then
+                 let es = (Obj.magic x : Js.Json.t array) in
+                 ((int_of_json (Js.Array.unsafe_get es 0)),
+                   (int_of_json (Js.Array.unsafe_get es 1)))
+               else
+                 Melange_json.of_json_error ~json:x
+                   "expected a JSON array of length 2" : Js.Json.t -> x)
+          let _ = x_of_json
+          [@@@ocaml.warning "-39-11-27"]
+          let rec x_to_json =
+            (fun x ->
+               match x with
+               | (x_0, x_1) ->
+                   (Obj.magic [|(int_to_json x_0);(int_to_json x_1)|] : 
+                   Js.Json.t) : x -> Js.Json.t)
+          let _ = x_to_json
+        end[@@ocaml.doc "@inline"][@@merlin.hide ]
+    end
+  type u = X.(x)[@@deriving json]
+  include
+    struct
+      let _ = fun (_ : u) -> ()
+      [@@@ocaml.warning "-39-11-27"]
+      let rec u_of_json = (fun x -> X.x_of_json x : Js.Json.t -> u)
+      let _ = u_of_json
+      [@@@ocaml.warning "-39-11-27"]
+      let rec u_to_json = (fun x -> X.x_to_json x : u -> Js.Json.t)
+      let _ = u_to_json
+    end[@@ocaml.doc "@inline"][@@merlin.hide ]
+  let () = print_endline (Melange_json.to_string (u_to_json (1, 2)))
+  let () = assert ((u_of_json (Melange_json.of_string {|[1, 2]|})) = (1, 2))
+  === stdout:native ===
+  [1,2]
+  === stdout:js ===
+  [1,2]
diff --git a/yarn.lock b/yarn.lock

Original file line number	Diff line number	Diff line change
`@@ -14,7 +14,7 @@ bug-reports: "https://github.com/melange-community/melange-json/issues"`
`14`	`14`	`depends: [`
`15`	`15`	`"dune" {>= "3.16"}`
`16`	`16`	`"ocaml" {>= "4.12"}`
`17`		`- "ppxlib" {>= "0.32.0"}`
	`17`	`+ "ppxlib" {>= "0.36.0"}`
`18`	`18`	`"yojson" {>= "1.6.0"}`
`19`	`19`	`"odoc" {with-doc}`
`20`	`20`	`]`
Original file line number	Diff line number	Diff line change
`@@ -1,4 +1,4 @@`
`1`	`1`	`pin-depends: [`
`2`		`- [ "opam-check-npm-deps.dev" "git+https://github.com/ahrefs/opam-check-npm-deps.git#12e63761842c71dc3a688257f7827580ebe2b7f1"]`
	`2`	`+ [ "opam-check-npm-deps.dev" "git+https://github.com/ahrefs/opam-check-npm-deps.git#8adc5a6fa6b744c4007f5085ef0cf1347a4b5f36" ]`
`3`	`3`	`]`
`4`	`4`
Original file line number	Diff line number	Diff line change
`@@ -1,6 +1,7 @@`
`1`	`1`	`{`
`2`	`2`	`"devDependencies": {`
`3`		`- "jest": "^26.5.2",`
	`3`	`+ "jest": "^29.0",`
	`4`	`+ "jest-environment-jsdom": "^29.0",`
`4`	`5`	`"@testing-library/jest-dom": "^5.10.0"`
`5`	`6`	`}`
`6`	`7`	`}`