Make a function that takes a polymorphic variant list and returns the type of only variants in the list

Learning
1

I’m trying to make a function to check HTTP status codes, generate errors for unhandled ones, and pass the handled ones through to another function, like (simplified):

type unexpected_status =
  { path : string
  ; expected : Cohttp.Code.status_code list
  ; got : Cohttp.Code.status_code }

let get ?(ok_statuses=[ `OK ]) path =
  Cohttp_lwt_unix.get path
  >>= fun (res, body) ->
  Cohttp_lwt.Body.to_string body
  >|= fun body ->
  match Cohttp_lwt.Response.status res with
  | status when List.exists ok_statuses ~f:((=) status) ->
      Ok (status, body)
  | status ->
    Lwt.return_error
      (`Unexpected_status { path
                          ; expected = ok_statuses
                          ; got = status })

What’s annoying is that this function returns (Cohttp.Code.status_code, string) Lwt_result.t, but I’d really like to make it return only the statuses in ~ok_statuses (so I don’t have to have | _ -> assert false in every variant using this).

I think I’m trying to give it this type (although, honestly the <, > stuff still confuses me for some reason):

val get
  : ?ok_statuses:([< Cohttp.Code.status_code ] as 'status) list
  -> string
  -> ('status * string) Lwt_result.t

Is it possible to write this function in such a way that it does that?

2

I realized one piece of this is probably what status when List.exists ok_statuses ~f:((=) status) doesn’t give status the type I want, so I’d probably want to use the object from the list instead (List.find ok_statuses ~f:((=) status), but I’m still not sure how to make that have a less general type than Cohttp.Code.status_code (or if it’s possible at all).

3

This sounds doable with the right coercion. The right idea is probably to try to coerce your status to the smaller type first:

type core = [`A|`B]
type all = [ core | `C ]
let to_core  :  all -> (core,all) result = function
| #core as x -> Ok x
| x -> Error x

then check if it belongs to the list

1 Like
4

It seems to be doable following the idea of returning the member of the list. The trick is to make an equality predicate which don’t assume same-type arguments, and one solution is to serialize the values, e.g. using Marshall:

let poly_equal x y = Marshal.to_string x = Marshal.to_string y

let rec pick : 'a -> 'b list -> 'b option = fun x -> function
  | [] -> None
  | y :: ys -> if poly_equal x y then Some y else pick x ys

;;
val poly_equal : 'a -> 'b -> bool = <fun>
val pick : 'a -> 'b list -> 'b option = <fun>

This is not ideal. I think solutions of this kind will necessarily depend on “extra”-polymorphic functions provided by the OCaml core library. [see next post]

If ok_statuses has a default value, it’s type will be a super-type of that value’s type, i.e. [> `OK] in the given case, so you may want isolate the default case into a separate function.

5

Using Marshal.to_string x [] to do any comparison sounds both dangerous:

 Marshal.to_string [] [] = Marshal.to_string 0  []

and incredibly brittle: the marshaled string will depend on the amount of sharing in the both structure. For instance, in the toplevel, this equality is false

Marshal.to_string (let f = 0. in [f;f]) [] <> Marshal.to_string [0.;0.] []

but Flambda will share the constant 0. which makes the equality true

Marshal.to_string (let f = 0. in [f;f]) [] = Marshal.to_string [0.;0.] []

in this case.

The right way to do this is to coerce to the common subtype

let subtype_equal (* : al l -> [<all] -> bool *) = fun x y -> x = (y:>all)
let pick x = List.find_opt (subtype_equal x) l

But if the picked value is equal to x, it is simpler to just do the conversion directly

let conv = function 
| #core as x -> x 
| _ -> raise Not_found
6

Nice, I didn’t think of subtype_equal. That should make an acceptable option. I agree on the issues using Marshall.

Adapting your conv and to_core to the original question, the #core is only known as a type parameter, so that may not work.

7

Thanks both of you! This version worked for me:

let subtype_equal = fun x y -> x = (y:>all)
let pick x = List.find_opt (subtype_equal x) l

This is what I ended up with: https://github.com/brendanlong/feedbin-ocaml/commit/4b2854433e18f8af7d97855390e7ea1ee2167e11

I’m still not sure if I’m missing something with the | #variant_type -> version though. I think for what I want to do, I would need to refer to a type parameter, but something like | #'status is a syntax error, and if I start my function declaration with (type status), Merlin tells me that status isn’t a polymorphic variant type for some reason.