OCaml 将无参数变体序列化为“字符串枚举”通过 Yojson

如何解决OCaml 将无参数变体序列化为“字符串枚举”通过 Yojson

假设我正在构建一个记录类型：

type thing {
  fruit: string;
}

但我希望将 fruit 的可能值限制为一组固定的字符串。

在 OCaml 中将其建模为变体似乎很自然，例如：

type fruit = APPLE | BANANA | CHERRY

type thing {
  fruit: fruit;
}

到目前为止还好。

但是如果我在这些类型上使用 [@@deriving yojson] 那么序列化的输出将是这样的：

{ "fruit": ["APPLE"] }

默认情况下，Yojson 想要将一个变体序列化为一个 [<name>,<args>...] 元组...我可以看到它的逻辑，但在这里没有帮助。

我希望它序列化为：

{ "fruit": "APPLE" }

利用几个 ppx 派生插件，我设法构建了这个模块以根据需要进行反序列化：

module Fruit = struct
  type t = APPLE | BANANA | CHERRY [@@deriving enum,variants]

  let names =
    let pairs i (name,_) = (name,(Option.get (of_enum i))) in
    let valist = List.mapi pairs Variants.descriptions in
    List.to_seq valist |> Hashtbl.of_seq
  
  let to_yojson v = `String (Variants.to_name v)

  let of_yojson = function
    | `String s -> Hashtbl.find_opt names s
                   |> Option.to_result ~none:(Printf.sprintf "Invalid value: %s" s)
    | yj -> Error (Printf.sprintf "Invalid value: %s" (Yojson.Safe.to_string yj))
end

哪个工作正常......但我有一些其他的“字符串枚举”变体，我想以同样的方式对待。我不想每次都复制粘贴这段代码。

我做到了：

module StrEnum (
  V : sig
    type t
    val of_enum : int -> t option
    module Variants : sig
      val descriptions : (string * int) list
      val to_name : t -> string
    end
  end
) = struct  
  type t = V.t

  let names =
    let pairs i (name,(Option.get (V.of_enum i))) in
    let valist = List.mapi pairs V.Variants.descriptions in
    List.to_seq valist |> Hashtbl.of_seq
  
  let to_yojson v = `String (V.Variants.to_name v)

  let of_yojson = function
    | `String s -> Hashtbl.find_opt names s
                  |> Option.to_result ~none:(Printf.sprintf "Invalid StrEnum value: %s" s)
    | yj -> Error (Printf.sprintf "Invalid StrEnum value: %s" (Yojson.Safe.to_string yj))
end

module Fruit = struct
  type t = APPLE | BANANA | CHERRY [@@deriving enum,variants]
end

module FruitEnum = StrEnum (Fruit)

这似乎是类型检查，我可以：

utop # Yojson.Safe.to_string (FruitEnum.to_yojson Fruit.APPLE);;
- : string = "\"APPLE\""

utop # FruitEnum.of_yojson (Yojson.Safe.from_string "\"BANANA\"");;
- : (FruitEnum.t,string) result = Ok Fruit.BANANA

...但是当我尝试：

type thing {
  fruit: FruitEnum.t;
}
[@@deriving yojson]

我得到 Error: Unbound value FruitEnum.t

这似乎是因为我正在从变体的模块中重新导出 type t = V.t，但我不太明白。（还是因为 yojson ppx 无法正确“看到”函子的结果？）
我该如何解决这个问题？

我还希望能够跳过单独定义变体模块而直接执行：

module Fruit = StrEnum (struct
  type t = APPLE | BANANA | CHERRY [@@deriving enum,variants]
end)

...但这给出了错误：

Error: This functor has type
       functor
         (V : sig
                type t
                val of_enum : int -> t option
                module Variants :
                  sig
                    val descriptions : (string * int) list
                    val to_name : t -> string
                  end
              end)
         ->
         sig
           type t = V.t
           val names : (string,t) Hashtbl.t
           val to_yojson : t -> [> `String of string ]
           val of_yojson : Yojson.Safe.t -> (t,string) result
         end
       The parameter cannot be eliminated in the result type.
       Please bind the argument to a module identifier.

我不明白出了什么问题。

解决方法

关于最后一个错误，这是因为 OCaml 需要一个“稳定路径”到模块内部的类型，以便它可以引用它们。稳定路径是类型的命名路径，例如Fruit.t。

相比之下，StrEnum(struct type t = ... end).t 不是一个稳定的路径，因为类型 t 正在引用模块文字中没有名称的类型 t。

长话短说，你基本上不能跳过单独定义变体模块。但很简单，只需两步即可：

module Fruit = struct
  type t = ...
end

module Fruit = StrEnum(Fruit)

第二个定义引用第一个并且隐藏它。阴影是 OCaml 中众所周知且经常使用的技术。

总的来说，我不确定所有这些 PPX 机器实际上是否合理。你可以很容易地手写转换器函数，例如

let to_yojson = function
  | APPLE -> `String "APPLE"
  | BANANA -> `String "BANANA"
  | CHERRY -> `String "CHERRY"

好吧，我很想尝试编写一个 PPX 派生器来执行此转换。

这是我最后的结果：

open Ppxlib
module List = ListLabels

let make_methods ~(loc : location) ~(is_poly : bool) (constructors : constructor_declaration list) =
  let (module Ast) = Ast_builder.make loc in
  let v_patt = match is_poly with
    | true -> fun name -> Ast.ppat_variant name None
    | false -> fun name -> Ast.ppat_construct { txt = (Lident name); loc } None
  and v_expr = match is_poly with
    | true -> fun name -> Ast.pexp_variant name None
    | false -> fun name -> Ast.pexp_construct { txt = (Lident name); loc } None
  in
  let (to_cases,of_cases) =
    List.map constructors ~f:(
      fun cd ->
        let name = cd.pcd_name.txt in
        let to_case = {
          pc_lhs = v_patt name;
          pc_guard = None;
          pc_rhs = [%expr `String [%e Ast.estring name] ];
        } in
        let of_case = {
          pc_lhs = Ast.ppat_variant "String" (Some (Ast.pstring name));
          pc_guard = None;
          pc_rhs = [%expr Ok ([%e v_expr name]) ];
        } in
        (to_case,of_case)
    )
    |> List.split
  in
  let of_default_case = {
    pc_lhs = [%pat? yj ];
    pc_guard = None;
    pc_rhs = [%expr Error (Printf.sprintf "Invalid value: %s" (Yojson.Safe.to_string yj)) ];
  } in
  let of_cases = of_cases @ [of_default_case] in
  let to_yojson = [%stri let to_yojson = [%e Ast.pexp_function to_cases]] in
  let of_yojson = [%stri let of_yojson = [%e Ast.pexp_function of_cases] ] in
  [to_yojson; of_yojson]

let type_impl ~(loc : location) (td : type_declaration) =
  match td with
  | {ptype_kind = (Ptype_abstract | Ptype_record _ | Ptype_open); _} ->
    Location.raise_errorf ~loc "Cannot derive yojson_str_enum for non variant types"
  | {ptype_kind = Ptype_variant constructors; _} -> begin
      let invalid_constructors =
        List.filter_map constructors ~f:(
          fun cd -> match cd.pcd_args with
            | (Pcstr_tuple [] | Pcstr_record []) -> None
            | _ -> Some (cd)
        )
      in
      if (List.length invalid_constructors) > 0 then
        Location.raise_errorf ~loc "Cannot derive yojson_str_enum for variant types with constructor args";
      match is_polymorphic_variant td ~sig_:false with
      | `Definitely | `Maybe -> make_methods ~loc ~is_poly:true constructors
      | `Surely_not -> make_methods ~loc ~is_poly:false constructors
    end

let generate_impl ~ctxt (_rec_flag,type_declarations) =
  (* [loc] is "location",not "lines of code" *)
  let loc = Expansion_context.Deriver.derived_item_loc ctxt in
  List.map type_declarations ~f:(type_impl ~loc)
  |> List.concat

let yojson_str_enum =
  Deriving.add
    "yojson_str_enum"
    ~str_type_decl:(Deriving.Generator.V2.make_noarg generate_impl)

要使其可用，它需要一个 dune 文件，例如：

(library
  (kind ppx_rewriter)
  (name <lib name>)
  (preprocess (pps ppxlib.metaquot))
  (libraries yojson ppxlib))

将 <lib name> 添加到 pps 文件中的 dune 后，用法如下：

module Fruit = struct
  type t = APPLE | BANANA | CHERRY [@@deriving yojson_str_enum]
end

它似乎适用于我的用例。它可能会根据 comment by @Yawar 进行扩展，以获取允许为变体标签指定字符串转换函数的参数。但我现在对 Fruit.APPLE -> "APPLE" 很满意。我还应该实现 sig_type_decl 版本。

我有点不确定的一个部分是：

      match is_polymorphic_variant td ~sig_:false with
      | `Definitely | `Maybe -> make_methods ~loc ~is_poly:true constructors
      | `Surely_not -> make_methods ~loc ~is_poly:false constructors

我不太清楚 `Maybe 情况何时发生，或者应该如何最正确地处理它，或者是否有比使用 is_polymorphic_variant 中的 enter image description here 方法更好的检测“反引号变体”的方法{1}}。

OCaml 将无参数变体序列化为“字符串枚举”通过 Yojson

如何解决OCaml 将无参数变体序列化为“字符串枚举”通过 Yojson

解决方法

相关推荐