Элегантное типизированное решение желаемое, ввод одного параметра является функцией другого

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)

Update:

что касается вашего требования, чтобы f в resolve также должны обращаться 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

Это зависит от варианта использования. Если вы просто хотите подражать ad-hoc-полиморфизму (использовать одно и то же имя функции 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; } 

Затем нам нужно ввести экзистенциальную оболочку для Набирает Erasure

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

Смотрите, вы дон 't даже нужно вводить аннотацию этой функции!

И, наконец, мы можем запустить решение для списка запросов, как этот

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)