How to shorten this OCaml code? - functional-programming

Question

I am just wondering how to shorten these code as I suspect it is too redundant
let get ename doc =
try Some (StringMap.find ename doc) with Not_found -> None;;
let get_double ename doc =
let element = get ename doc in
match element with
| None -> None
| Some (Double v) -> Some v
| _ -> raise Wrong_bson_type;;
let get_string ename doc =
let element = get ename doc in
match element with
| None -> None
| Some (String v) -> Some v
| _ -> raise Wrong_bson_type;;
let get_doc ename doc =
let element = get ename doc in
match element with
| None -> None
| Some (Document v) -> Some v
| _ -> raise Wrong_bson_type;;
So, basically, I have different types of values, and I put all those kinds of values into a map.
The code above is for getting according type of values out of the map. What I do is that for each type, I have a get. To get one type of value, I have to see a). whether it is there or not; b). whether it is that type indeed, if not, raise an exception.
But the code above seems to redundant as you can see. The only diff between each type's get is just the type itself.
How can I shorten this code?

Answer 1

You can do this:
let get_generic extract ename doc =
let element = get ename doc in
match element with
| None -> None
| Some v -> Some (extract v)
let get_double = get_generic (function Double v -> v | _ -> raise Wrong_bson_type)
let get_string = get_generic (function String v -> v | _ -> raise Wrong_bson_type)
let get_doc = get_generic (function Document v -> v | _ -> raise Wrong_bson_type)
EDIT:
To remove the redundant raise Wrong_bson_type (But it is ugly):
let get_generic extract ename doc = try
let element = get ename doc in
match element with
| None -> None
| Some v -> Some (extract v)
with Match_failure _ -> raise Wrong_bson_type
let get_double = get_generic (fun (Double v) -> v)
let get_string = get_generic (fun (String v) -> v)
let get_doc = get_generic (fun (Document v)-> v)

Answer 2

You can use GADT to do that:
If you define a type expr like this:
type _ expr =
| Document: document -> document expr
| String: string -> string expr
| Double: float -> float expr
You can write a function get like this:
let get : type v. v expr -> v = function
Document doc -> doc
| String s -> s
| Double d -> d

Answer 3

With GADTs:
type _ asked =
| TDouble : float asked
| TString : string asked
| TDocument : document asked
let get : type v. v asked -> string -> doc StringMap.t -> v option =
fun asked ename doc ->
try
Some (match asked, StringMap.find ename doc with
| TDouble, Double f -> f
| TString, String s -> s
| TDocument, Document d -> d)
with Not_found -> None
let get_double = get TDouble
let get_string = get TString
let get_document = get TDocument

Answer 4

If you can live with these extractor functions:
let extract_double = function
| Double v -> v
| _ -> raise Wrong_bson_type
let extract_string = function
| String v -> v
| _ -> raise Wrong_bson_type
let extract_doc = function
| Document v -> v
| _ -> raise Wrong_bson_type
Then you can use monadic style for the higher-order function, which allows you to keep your original definition of get:
let return x = Some x
let (>>=) mx f =
match mx with
| Some x -> f x
| None -> None
let get_with exf ename doc =
(get ename doc) >>= fun v ->
return (exf v)
let get_double = get_with extract_double
let get_string = get_with extract_string
let get_doc = get_with extract_doc
Less redundant and abstracts the side effect to generic bind and return operations.