需要优雅的打字解决方案，一个参数的打字是另一个参数的函数

Question

我的打字问题有点复杂，至少对我来说是这样。

假设我们有这个：

type rr = A | AAA | BBB

type resolve_result_t = List of string list
                        | MX_records of mx_record list
                        | Srv of srv_record list
                        | Soa of soa_record
                        | Error of string
  and mx_record = { exchange : string; priority: int; }
  and srv_record = { priority: int; weight : int; port : int; name : string; }
  and soa_record = { nsname : string;
                     hostmaster: string;
                     serial : int;
                     refresh: int;
                     retry : int;
                     expire : int;
                     minttl : int; }


let resolve ?(rr_type=A) ~host (f : (resolve_result_t -> unit) : unit = 
match rr_type with 
| A -> 
  let g = fun raw -> f (List (raw |> some_string_list_func))
  ...code that uses g
| BBB -> 
  let g = fun raw -> f (MX_records (raw |> some_mx_record_list_func))
...

然后在调用者的代码中我们必须做这样的事情：

resolve ~host:"google.com" begin function 
  List l -> .. code that uses l | _ -> assert false (* Or deal with the warning *)
end

或

resolve ~rr_type:BBB ~host:"google.com" begin function 
  MX_records l -> ...similiar to previous example.

即使那些其他情况永远不会发生，因为函数的类型取决于另一个参数的类型。

我一直认为有一些类型系统技巧或 GADT 的用法，但我永远不能完全确定何时需要使用它们。

Answer 1

type _ rr =
  | A : string list rr
  | AAA : srv_record list rr
  | BBB : mx_record list rr

and _ resolve_result_t =
  | List : string list -> string list resolve_result_t
  | MX_records : mx_record list -> mx_record list resolve_result_t
  | Srv : srv_record list -> srv_record list resolve_result_t
  | Soa : soa_record list -> soa_record list resolve_result_t
  | Error : string -> string resolve_result_t

and mx_record  = { exchange : string; mx_priority: int; }

and srv_record = { srv_priority: int; weight : int; port : int; name : string; }

and soa_record = { nsname : string;
                   hostmaster: string;
                   serial : int;
                   refresh: int;
                   retry : int;
                   expire : int;
                   minttl : int; }

let resolve : type a. a rr -> string -> (a resolve_result_t -> unit) -> unit =
  fun rr_type host f ->
    match rr_type with
    | A -> f (List ["123"])
    | AAA -> f (Srv [{srv_priority=1;weight=1;port=1;name="123"}])
    | BBB -> f (MX_records [{exchange="123"; mx_priority=1}])

let () =
  let f = fun (List l) -> () in
  resolve A "google.com" f

在上面的代码中，我假设当你想使用 A、AAA、BBB 时，只有 List、Srv 和 MX_records 将分别出现。得益于 GADT，最后三行的模式匹配非常详尽。

此外，请注意，在 mx_record 和 srv_record 中，您希望以不同的方式命名两个 priority，否则您将收到警告（与子类型和类型相关定义阴影：{priority=1} 将始终具有类型 srv_record)

更新：

至于您要求 resolve 中的 f 也应该处理 Error，这是另一个尝试。

type _ rr =
  | A : string list rr
  | AAA : srv_record list rr
  | BBB : mx_record list rr

and _ resolve_result_t =
  | List : string list -> string list resolve_result_t
  | MX_records : mx_record list -> mx_record list resolve_result_t
  | Srv : srv_record list -> srv_record list resolve_result_t
  | Soa : soa_record list -> soa_record list resolve_result_t
  | Error : string -> string resolve_result_t

and 'a rrt =
  | Ok of 'a resolve_result_t
  | Err of string resolve_result_t

and mx_record  = { exchange : string; mx_priority: int; }

and srv_record = { srv_priority: int; weight : int; port : int; name : string; }

and soa_record = { nsname : string;
                   hostmaster: string;
                   serial : int;
                   refresh: int;
                   retry : int;
                   expire : int;
                   minttl : int; }

let resolve : type a. a rr -> string -> (a rrt -> unit) -> unit =
  fun rr_type host f ->
    match rr_type with
    | A -> f (Ok (List ["123"]))
    | AAA -> f (Ok (Srv [{srv_priority=1;weight=1;port=1;name="123"}]))
    | BBB -> f (Ok (MX_records [{exchange="123"; mx_priority=1}]))

let () =
  let f = function
    | Ok (List l) -> ()
    | Err (Error s) -> print_endline s in
  resolve A "google.com" f

GADT 繁重的代码编写起来要复杂得多。多一些 _ -> assert false 不会伤害。

Answer 2

这取决于用例。如果您只是想模拟临时多态性（使用相同的函数名称 resolve 和不同的参数类型），@objmagic 建议的解决方案将起作用。但是，我宁愿使用三个独立的函数：resolve_a、resolve_aaa 和 resolve_bbb。这将使类型定义更加简单易读。

但是，如果需要 A、AAA 和 BBB 标签来运行解析请求列表，我会建议使用存在性包装器。

相同的 GADT 定义：

type _ rr =
  | A : string list rr
  | AAA : srv_record list rr
  | BBB : mx_record list rr

and _ resolve_result_t =
  | List : string list -> string list resolve_result_t
  | MX_records : mx_record list -> mx_record list resolve_result_t
  | Srv : srv_record list -> srv_record list resolve_result_t
  | Soa : soa_record list -> soa_record list resolve_result_t
  | Error : string -> string resolve_result_t

and 'a rrt =
  | Ok of 'a resolve_result_t
  | Err of string resolve_result_t

and mx_record  = { exchange : string; mx_priority: int; }

and srv_record = { srv_priority: int; weight : int; port : int; name : string; }

and soa_record = { nsname : string;
                   hostmaster: string;
                   serial : int;
                   refresh: int;
                   retry : int;
                   expire : int;
                   minttl : int; }

然后我们需要引入existential wrapper来做类型擦除

type handler = Handler : 'a rr * ('a rrt -> unit) -> handler

并对其进行模式匹配

let resolve ~host = function
  | Handler (A, f) -> f (Ok (List []))
  | Handler (AAA, f) -> f (Ok (Srv [{srv_priority = 1; weight = 1; port = 1; name="123"}]))
  | Handler (BBB, f) -> f (Ok (MX_records [{exchange = "123"; mx_priority = 1}]))

看，你甚至不需要输入注释这个函数！

最后，我们可以运行解决像这样的请求列表

let () =
  let on_a = function
    | Ok (List l) -> print_endline "List"
    | Err (Error s) -> print_endline s
  and on_aaa = function
    | Ok (Srv l) -> print_endline "Srv"
    | Err (Error s) -> print_endline s
  and on_bbb = function
    | Ok (MX_records l) -> print_endline "MX_records"
    | Err (Error s) -> print_endline s
  in
  ["google.com", Handler(A, on_a);
   "google.com", Handler(AAA, on_aaa);
   "google.com", Handler(BBB, on_bbb)]
  |> ListLabels.iter ~f:(fun (host, handler) -> resolve ~host handler)

需要优雅的打字解决方案，一个参数的打字是另一个参数的函数

Elegant typing solution desired, typing of one parameter is a function of another

ocaml

types

static-typing

gadt