diff --git a/.ocamlformat b/.ocamlformat index 3ae0171..486d56e 100644 --- a/.ocamlformat +++ b/.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 \ No newline at end of file diff --git a/src/value.ml b/src/value.ml index 7c61e13..2624252 100644 --- a/src/value.ml +++ b/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" diff --git a/test/expect/errors/dune.inc b/test/expect/errors/dune.inc index b245a2e..fbf4662 100644 --- a/test/expect/errors/dune.inc +++ b/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))) diff --git a/test/expect/gen_rules.ml b/test/expect/gen_rules.ml index 26c4f15..ea164dd 100644 --- a/test/expect/gen_rules.ml +++ b/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@,\ @[(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 = @[(deps@,\ (:pp pp.exe)@,\ (:input %s.ml))@]@,\ - @[(action@,\ + %s\n\ + \ @[(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@,\ @[(rule@,\ (alias runtest)@,\ - (package ppx_deriving_yaml)@,\ + %s\n\ + \ (package ppx_deriving_yaml)@,\ @[(action@,\ - @[(diff@ %s.expected@ %s.actual)@])@])@]" base base + @[(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@,\ @[(rule@,\ (alias runtest)@,\ - (package ppx_deriving_yaml)@,\ + %s\n\ + \ (package ppx_deriving_yaml)@,\ @[(action@,\ - @[(run@ ./%s.exe)@])@])@]" base + @[(run@ ./%s.exe)@])@])@]" (lookup_enabled base) base else () in Format.set_margin 80; diff --git a/test/expect/passing/dune.inc b/test/expect/passing/dune.inc index 97822b6..06e3edb 100644 --- a/test/expect/passing/dune.inc +++ b/test/expect/passing/dune.inc @@ -1,3 +1,38 @@ +; -------- 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 @@ -5,7 +40,7 @@ (name recursive) (modules recursive) (preprocess (pps ppx_deriving_yaml)) - (libraries yaml)) + (libraries yaml) ) ; Run the PPX on the `.ml` file (rule @@ -13,20 +48,23 @@ (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,7 +75,7 @@ (name simple) (modules simple) (preprocess (pps ppx_deriving_yaml)) - (libraries yaml)) + (libraries yaml) ) ; Run the PPX on the `.ml` file (rule @@ -45,20 +83,23 @@ (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,7 +110,7 @@ (name skip_unknown) (modules skip_unknown) (preprocess (pps ppx_deriving_yaml)) - (libraries yaml)) + (libraries yaml) ) ; Run the PPX on the `.ml` file (rule @@ -77,20 +118,23 @@ (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))) diff --git a/test/expect/passing/locally_open_module.expected b/test/expect/passing/locally_open_module.expected new file mode 100644 index 0000000..84f3e20 --- /dev/null +++ b/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 diff --git a/test/expect/passing/locally_open_module.ml b/test/expect/passing/locally_open_module.ml new file mode 100644 index 0000000..156d54c --- /dev/null +++ b/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 diff --git a/test/expect/passing/recursive.expected b/test/expect/passing/recursive.expected index 4cd7c1c..2ffc054 100644 --- a/test/expect/passing/recursive.expected +++ b/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