5.2 ast bump

.ocamlformat

@@ -1,4 +1,4 @@
-version=0.26.1
+version=0.26.2
 break-infix=fit-or-vertical
 parse-docstrings=true
 indicate-multiline-delimiters=no

src/value.ml

@@ -104,6 +104,10 @@ let rec type_to_expr typ =
       | Error (`Msg (loc, m)) ->
           pexp_extension ~loc @@ Location.error_extensionf ~loc "%s" m
       | Ok cases -> Exp.function_ ~loc cases)
+  | { ptyp_desc = Ptyp_open (module_e, typ); _ } ->
+      let module_ident = Opn.mk (Mod.mk (Pmod_ident module_e)) in
+      let v = type_to_expr typ in
+      pexp_open ~loc module_ident v
   | { ptyp_desc = Ptyp_arrow _; _ } ->
       pexp_extension ~loc
       @@ Location.error_extensionf ~loc "Functions cannot be converted yaml"
@@ -399,6 +403,10 @@ let rec of_yaml_type_to_expr name typ =
                  [%pat? _]
                  [%expr Error (`Msg "failed converting variant")];
              ]))
+  | { ptyp_desc = Ptyp_open (module_e, typ); _ } ->
+      let module_ident = Opn.mk (Mod.mk (Pmod_ident module_e)) in
+      let v = of_yaml_type_to_expr name typ in
+      pexp_open ~loc module_ident v
   | { ptyp_desc = Ptyp_arrow _; _ } ->
       pexp_extension ~loc
       @@ Location.error_extensionf ~loc "Functions cannot be converted yaml"

test/expect/errors/dune.inc

@@ -14,15 +14,17 @@
  (deps
   (:pp pp.exe)
   (:input err.ml))
- (action
-  (with-stdout-to
-   %{targets}
-   (bash "./%{pp} -no-color --impl %{input}"))))
+
+       (action
+          (with-stdout-to
+           %{targets}
+           (bash "./%{pp} -no-color --impl %{input}"))))
 
 ; Compare the post-processed output to the .expected file
 (rule
  (alias runtest)
- (package ppx_deriving_yaml)
+
+       (package ppx_deriving_yaml)
  (action
   (diff err.expected err.actual)))
 

test/expect/gen_rules.ml

@@ -10,6 +10,12 @@ let ppx_fail_global_stanzas () =
 
   |}
 
+let enabled_versions =
+  [ ("locally_open_module", "(enabled_if (>= %{ocaml_version} \"5.2.0\"))") ]
+
+let lookup_enabled base =
+  try List.assoc base enabled_versions with Not_found -> ""
+
 let output_stanzas ~expect_failure filename =
   let base = Filename.remove_extension filename in
   let pp_library ppf base =
@@ -18,8 +24,8 @@ let output_stanzas ~expect_failure filename =
       Format.fprintf ppf
         "; The PPX-dependent executable under test@,\
          @[<v 1>(executable@ (name %s)@ (modules %s)@ (preprocess (pps \
-         ppx_deriving_yaml))@ (libraries yaml))@]"
-        base base
+         ppx_deriving_yaml))@ (libraries yaml) %s)@]"
+        base base (lookup_enabled base)
     else ()
   in
   let pp_rule ppf base =
@@ -40,18 +46,21 @@ let output_stanzas ~expect_failure filename =
        @[<v 1>(deps@,\
        (:pp pp.exe)@,\
        (:input %s.ml))@]@,\
-       @[<v 1>(action@,\
+       %s\n\
+      \       @[<v 1>(action@,\
        %a))@]@]"
-      base base pp_action expect_failure
+      base base (lookup_enabled base) pp_action expect_failure
   in
   let pp_diff_alias ppf base =
     Format.fprintf ppf
       "; Compare the post-processed output to the .expected file@,\
        @[<v 1>(rule@,\
        (alias runtest)@,\
-       (package ppx_deriving_yaml)@,\
+       %s\n\
+      \       (package ppx_deriving_yaml)@,\
        @[<v 1>(action@,\
-       @[<hov 2>(diff@ %s.expected@ %s.actual)@])@])@]" base base
+       @[<hov 2>(diff@ %s.expected@ %s.actual)@])@])@]" (lookup_enabled base)
+      base base
   in
   let pp_run_alias ppf base =
     (* If we expect the derivation to succeed, then we should be able to compile
@@ -63,9 +72,10 @@ let output_stanzas ~expect_failure filename =
          ; Ensure that the post-processed executable runs correctly@,\
          @[<v 1>(rule@,\
          (alias runtest)@,\
-         (package ppx_deriving_yaml)@,\
+         %s\n\
+        \         (package ppx_deriving_yaml)@,\
          @[<v 1>(action@,\
-         @[<hov 2>(run@ ./%s.exe)@])@])@]" base
+         @[<hov 2>(run@ ./%s.exe)@])@])@]" (lookup_enabled base) base
     else ()
   in
   Format.set_margin 80;

test/expect/passing/dune.inc

@@ -1,32 +1,70 @@
+; -------- Test: `locally_open_module.ml` --------
+
+; The PPX-dependent executable under test
+(executable
+ (name locally_open_module)
+ (modules locally_open_module)
+ (preprocess (pps ppx_deriving_yaml))
+ (libraries yaml) (enabled_if (>= %{ocaml_version} "5.2.0")))
+
+; Run the PPX on the `.ml` file
+(rule
+ (targets locally_open_module.actual)
+ (deps
+  (:pp pp.exe)
+  (:input locally_open_module.ml))
+ (enabled_if (>= %{ocaml_version} "5.2.0"))
+       (action
+                                                    (run ./%{pp} -deriving-keep-w32 both --impl %{input} -o %{targets})))
+
+; Compare the post-processed output to the .expected file
+(rule
+ (alias runtest)
+ (enabled_if (>= %{ocaml_version} "5.2.0"))
+       (package ppx_deriving_yaml)
+ (action
+  (diff locally_open_module.expected locally_open_module.actual)))
+
+; Ensure that the post-processed executable runs correctly
+(rule
+ (alias runtest)
+ (enabled_if (>= %{ocaml_version} "5.2.0"))
+         (package ppx_deriving_yaml)
+ (action
+  (run ./locally_open_module.exe)))
+
 ; -------- Test: `recursive.ml` --------
 
 ; The PPX-dependent executable under test
 (executable
  (name recursive)
  (modules recursive)
  (preprocess (pps ppx_deriving_yaml))
- (libraries yaml))
+ (libraries yaml) )
 
 ; Run the PPX on the `.ml` file
 (rule
  (targets recursive.actual)
  (deps
   (:pp pp.exe)
   (:input recursive.ml))
- (action
-  (run ./%{pp} -deriving-keep-w32 both --impl %{input} -o %{targets})))
+
+       (action
+          (run ./%{pp} -deriving-keep-w32 both --impl %{input} -o %{targets})))
 
 ; Compare the post-processed output to the .expected file
 (rule
  (alias runtest)
- (package ppx_deriving_yaml)
+
+       (package ppx_deriving_yaml)
  (action
   (diff recursive.expected recursive.actual)))
 
 ; Ensure that the post-processed executable runs correctly
 (rule
  (alias runtest)
- (package ppx_deriving_yaml)
+
+         (package ppx_deriving_yaml)
  (action
   (run ./recursive.exe)))
 
@@ -37,28 +75,31 @@
  (name simple)
  (modules simple)
  (preprocess (pps ppx_deriving_yaml))
- (libraries yaml))
+ (libraries yaml) )
 
 ; Run the PPX on the `.ml` file
 (rule
  (targets simple.actual)
  (deps
   (:pp pp.exe)
   (:input simple.ml))
- (action
-  (run ./%{pp} -deriving-keep-w32 both --impl %{input} -o %{targets})))
+
+       (action
+          (run ./%{pp} -deriving-keep-w32 both --impl %{input} -o %{targets})))
 
 ; Compare the post-processed output to the .expected file
 (rule
  (alias runtest)
- (package ppx_deriving_yaml)
+
+       (package ppx_deriving_yaml)
  (action
   (diff simple.expected simple.actual)))
 
 ; Ensure that the post-processed executable runs correctly
 (rule
  (alias runtest)
- (package ppx_deriving_yaml)
+
+         (package ppx_deriving_yaml)
  (action
   (run ./simple.exe)))
 
@@ -69,28 +110,31 @@
  (name skip_unknown)
  (modules skip_unknown)
  (preprocess (pps ppx_deriving_yaml))
- (libraries yaml))
+ (libraries yaml) )
 
 ; Run the PPX on the `.ml` file
 (rule
  (targets skip_unknown.actual)
  (deps
   (:pp pp.exe)
   (:input skip_unknown.ml))
- (action
-  (run ./%{pp} -deriving-keep-w32 both --impl %{input} -o %{targets})))
+
+       (action
+          (run ./%{pp} -deriving-keep-w32 both --impl %{input} -o %{targets})))
 
 ; Compare the post-processed output to the .expected file
 (rule
  (alias runtest)
- (package ppx_deriving_yaml)
+
+       (package ppx_deriving_yaml)
  (action
   (diff skip_unknown.expected skip_unknown.actual)))
 
 ; Ensure that the post-processed executable runs correctly
 (rule
  (alias runtest)
- (package ppx_deriving_yaml)
+
+         (package ppx_deriving_yaml)
  (action
   (run ./skip_unknown.exe)))
 

test/expect/passing/locally_open_module.expected

@@ -0,0 +1,43 @@
+module M =
+  struct
+    type t =
+      | A 
+      | B 
+      | C [@@deriving yaml]
+    include
+      struct
+        let to_yaml =
+          function
+          | A -> `O [("A", (`A []))]
+          | B -> `O [("B", (`A []))]
+          | C -> `O [("C", (`A []))]
+        let of_yaml =
+          let (>>=) v f = match v with | Ok v -> f v | Error _ as e -> e
+            [@@warning "-26"] in
+          function
+          | `O (("A", `A [])::[]) -> Stdlib.Result.Ok A
+          | `O (("B", `A [])::[]) -> Stdlib.Result.Ok B
+          | `O (("C", `A [])::[]) -> Stdlib.Result.Ok C
+          | _ -> Stdlib.Error (`Msg "no match for this variant expression")
+      end[@@ocaml.doc "@inline"][@@merlin.hide ]
+  end
+type locally_open_m =
+  | Lom of M.(t) [@@deriving yaml]
+include
+  struct
+    let locally_open_m_to_yaml =
+      function
+      | Lom arg0 ->
+          `O [("Lom", (`A [((let open M in fun x -> to_yaml x)) arg0]))]
+    let locally_open_m_of_yaml =
+      let (>>=) v f = match v with | Ok v -> f v | Error _ as e -> e[@@warning
+                                                                    "-26"] in
+      function
+      | `O (("Lom", `A (arg0::[]))::[]) ->
+          ((let open M in fun x -> of_yaml x) arg0) >>=
+            ((fun arg0 -> Stdlib.Result.Ok (Lom arg0)))
+      | _ -> Stdlib.Error (`Msg "no match for this variant expression")
+  end[@@ocaml.doc "@inline"][@@merlin.hide ]
+let () =
+  let v = Lom A in
+  ((locally_open_m_to_yaml v) |> Yaml.to_string_exn) |> print_endline

test/expect/passing/locally_open_module.ml

@@ -0,0 +1,11 @@
+module M = struct
+  type t = A | B | C [@@deriving yaml]
+end
+
+type locally_open_m = Lom of M.(t) [@@deriving yaml]
+
+
+let () =
+  let v = Lom A in
+  locally_open_m_to_yaml v
+  |> Yaml.to_string_exn |> print_endline

test/expect/passing/recursive.expected

@@ -33,19 +33,17 @@ include
                       | `A lst ->
                           let (>>=) v f =
                             match v with | Ok v -> f v | Error _ as e -> e in
-                          ((fun f ->
-                              fun lst ->
-                                (Stdlib.List.fold_left
-                                   (fun acc ->
-                                      fun x ->
-                                        match acc with
-                                        | Stdlib.Ok acc ->
-                                            (f x) >>=
-                                              ((fun x -> Stdlib.Ok (x :: acc)))
-                                        | Stdlib.Error e -> Stdlib.Error e)
-                                   (Stdlib.Ok []) lst)
-                                  >>=
-                                  (fun lst -> Stdlib.Ok (Stdlib.List.rev lst))))
+                          ((fun f lst ->
+                              (Stdlib.List.fold_left
+                                 (fun acc x ->
+                                    match acc with
+                                    | Stdlib.Ok acc ->
+                                        (f x) >>=
+                                          ((fun x -> Stdlib.Ok (x :: acc)))
+                                    | Stdlib.Error e -> Stdlib.Error e)
+                                 (Stdlib.Ok []) lst)
+                                >>=
+                                (fun lst -> Stdlib.Ok (Stdlib.List.rev lst))))
                             (fun x -> of_yaml x) lst
                       | _ ->
                           Error