# Lifting polymorphic variants in a monad

I’m using polymorphic variants to define an error type which is then used to instantiate a monad. Something like:

``````module ErrorM(Error : sig type t end) = struct
type 'a t = ('a,Error.t) Result.t
let return: 'a -> 'a t = Result.ok
let ( let* ): 'a t -> ('a -> 'b t) -> 'b t = Result.bind
let error = Result.error
end

module M1 = struct
type error = [ `DivByZero ]
open ErrorM(struct type t = error end)

let eval x y =
if y = 0.0 then
error `DivByZero
else
return (x /. y)
end
``````

In a second module, the variant type is extended and used to instantiate a second monad:

``````module M2 = struct
type error = [ M1.error | `SqrtOfNeg ]
open ErrorM(struct type t = error end)

let eval x y =
let* u = M1.eval x y in
let* v =
if u < 0.0 then
error `SqrtOfNeg
else
return (Float.sqrt u)
in
return v
end
``````

Not surprisingly, M2 fails to typecheck. Even though M1.error < M2.error, any polymorphism is lost once the functions in the monad are used. A workaround is to coerce the error type in M1 to restore the polymorphism:

``````  let lift :
error
-> [> error]
= fun x -> (x : error :> [> error ])

let lift_m:
float t        (* = (float,error) Result.t *)
-> (float,[> error]) Result.t
= function
| Result.Ok v -> Result.Ok v
| Result.Error e -> Result.Error (lift e)
``````

Then in M2, write:

``````  let* u = M1.lift_m (M1.eval x y) in
``````

This is arguably not pretty; `lift_m` seems like a hack. Is there better, more idiomatic way to structure these modules and functors to avoid this?

Simplest solution might be to just forget the functor:

``````module ErrorM = struct
type ('a,'e) t = ('a,'e) Result.t
let return: 'a -> ('a,'e) t = Result.ok
let ( let* ): ('a,'e) t -> ('a -> ('b,'e) t) -> ('b,'e) t = Result.bind
let error = Result.error
end

module M1 = struct
type error = [ `DivByZero ]
open ErrorM

let eval x y =
if y = 0.0 then
error `DivByZero
else
return (x /. y)
end

module M2 = struct
type error = [ M1.error | `SqrtOfNeg ]
open ErrorM

let eval x y =
let* u = M1.eval x y in
let* v =
if u < 0.0 then
error `SqrtOfNeg
else
return (Float.sqrt u)
in
return v
end
``````