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和{{1将分别显示出来。由于GADT，最后三行中的模式匹配是详尽无遗的。

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

更新

至于srv_record中的f还应处理resolve的要求，这是另一种尝试。

Error

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; } 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不会受伤。

Answer 2

It depends on the use case. If you just wish to emulate ad-hoc polymorphism (to use the same function name resolve with different argument types), the solution, suggested by @objmagic, will work. But, I would rather use three separate functions: resolve_a, resolve_aaa and resolve_bbb. This will keep type definitions much simpler and easy to read.

But if A, AAA and BBB tags are needed to run resolution for, say, a list of requests, I would suggest using existential wrapper.

The same GADT definitions:

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; }

Then we need to introduce existential wrapper to do type erasure

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

and pattern match on it

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}]))

See, you don't even need to type annotate this function!

And finally, we can run resolution for a list of requests like this

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)

所需的优雅打字解决方案，一个参数的输入是另一个的功能

2 个答案: