The Critical monad is de­fined as fol­lows. First there is the type that prop­a­gates through the monad:

type Result<'a, 'b> =
| Success of 'a
| Failure of 'b

Then we de­fine the usual com­pu­ta­tion ex­pres­sion meth­ods.

type Critical() =
       // a -> m a
        member o.Return x       = Success x
        // m a -> (a -> m b) -> m b
        member o.Bind (m, f)    = match m with
                                    | Failure e -> Failure e
                                    | Success x -> f x
        // m a -> m a
        member o.ReturnFrom m   = m

Explaining how com­pu­ta­tional ex­pres­sions work in F# is a blog onto it­self. And sev­eral chap­ters in many books. Sufficient to say that con­cep­tu­ally this prop­a­gates the suc­cess value and re­turns the fail­ure value.

We then de­fine an in­stance of this type, so that we can use the nice ‘critical { … }’ syn­tax.

let critical = Critical()

We then go and de­fine the func­tions that the user needs to use to an­no­tate their func­tion calls. The sim­plest one is the one to prop­a­gate any ex­cep­tion com­ing from the func­tion ‘f’.

let fault f = f

Then it comes the one to man­age con­tin­gen­cies. This will trap any ex­cep­tion for which ‘stopF ex’ is ‘true’, call ‘errF ex’ to con­struct the er­ror re­turn value and wrap it in a ‘Failure’. Otherwise it will rethrow the ex­cep­tion.

let contingentGen stopF errF f =
    try
        Success(f ())
    with
        | ex when stopF ex -> Failure(errF ex)
        | _                -> reraise ()

Albeit very sim­ple, the above is the core of the sys­tem. Everything else is just de­tails. Let’s look at them.

First we want a func­tion that takes as pa­ra­me­ter a list of (Exception, ReturnValue) and gives back the cor­rect stopF errF to plug into ‘contingentGen’.

let exceptionMapToFuncs exMap =
    let tryFind ex = exMap |> List.tryFind (fun (k, _) -> k.GetType() = ex.GetType())
    (fun ex ->
        let found = tryFind ex
        match found with Some(_) -> true | None -> false),
    (fun ex ->
        let found = tryFind ex
        match found with
        | Some(k, v)    -> v ex
        | None          -> raise ex)

Then ug­li­ness comes. For the sake of get­ting a de­cent syn­tax (not great) on the call­ing site, we need to fake over­load­ing of func­tions by the old trick of adding a num­ber at the end. Thanks to Tobias to point out this (my api was even worse ear­lier).

I of­ten won­dered about the trade-off be­tween cur­ry­ing and over­load­ing for func­tions. I seem to al­ways paint my­self in a sit­u­a­tion where I need over­load­ing. In any case, here it goes:

let contingent1 exMap f x =
    let stopF, errF = exceptionMapToFuncs exMap
    contingentGen stopF errF (fun _ -> f x)
let contingent2 exMap f x y =
    let stopF, errF = exceptionMapToFuncs exMap
    contingentGen stopF errF (fun _ -> f x y)
let contingent3 exMap f x y z =
    let stopF, errF = exceptionMapToFuncs exMap
    contingentGen stopF errF (fun _ -> f x y z)

Sometimes you want to trap all ex­cep­tions from a func­tion and re­turn your own er­ror value:

let neverThrow1 exc f x     = contingentGen (fun _ -> true) (fun ex -> exc ex) (fun _ -> f x)
let neverThrow2 exc f x y   = contingentGen (fun _ -> true) (fun ex -> exc ex) (fun _ -> f x y)
let neverThrow3 exc f x y z = contingentGen (fun _ -> true) (fun ex -> exc ex) (fun _ -> f x y z)

Other times you need to go from a func­tion that re­turns re­turn val­ues to one that throws ex­cep­tions. You need trans­lat­ing from con­tin­gen­cies to faults:

let alwaysThrow exc f x =
    match f x with
    | Success(ret)              -> ret
    | Failure(e)                -> raise (exc e)

And that’s it. Hopefully we have bridged the gap be­tween ex­cep­tions and re­turn val­ues with­out mak­ing the code too ugly (just a lit­tle bit). Or per­haps not.

I need to add that I haven’t used this li­brary my­self (yet). I’m sure when I do I’ll dis­cover many things to change.