Retry Monad: An Implementation

One application that seems quite intuitively to be a good case for “monadization” is that of retrying a function call upon an exception that is thrown while executing it. This may be needed for inherently unreliable operations, dependent on a network connection, for example. Discussions of this can be easily found. Here is one on StackOverflow.

The complete solution is on F# Snippets. Here is the explanation.

Any monad has these components:

1. Monadic type: M<‘a>
2. Return function that creates a monadic type from a value of type ‘a
3. Bind function that is capable of linking monads together

So, in this order. We first define our monadic type:

    type RetryMonad<'a> = RetryParams -> 'a
    let rm<'a> (f : RetryParams -> 'a) : RetryMonad<'a> = f

RetryMonad is just a function, that takes RetryParams type and returns a value. How is this helpful? Well, an operation or a sequence of operations of any kind can be easily wrapped into a retry monad:

    let fn1 (x:float) (y:float) = rm (fun rp -> x * y)

I have also defined the “rm” operator for purely decorative purposes: it displays “RetryMonad” whenever it is used instead of RetryParams -> ‘a.

    let fn1 (x:float) (y:float) = rm (fun rp -> x * y)

rm operator gives us a printout of

val fn1 : float -> float -> RetryMonad<float>

in F# interactive. Otherwise it would look:

val fn1 : float -> float -> 'a -> float

RetryParams simply encapsulates our retry configuration: how many retries to perform and how long to wait between them.

    type RetryParams = {
        maxRetries : int; waitBetweenRetries : int
        }

    let defaultRetryParams = {maxRetries = 3; waitBetweenRetries = 1000}

Next we define the builder class where Bind and Return are defined, together with Delay and Run required by F#.

type RetryBuilder () =
   member this.Return (x : 'a) = fun defaultRetryParams -> x
   member this.Run(m : RetryMonad<'a>) = m
   member this.Delay(f : unit -> RetryMonad<'a>) = f ()

Next defining the Bind function is the most interesting part. Bind has a signature:

(RetryMonad * ‘a -> RetryMonad) -> RetryMonad. In other words it knows how to do two things: 1. Extract the actual value from RetryMonad, i.e. execute the underlying function with retries, and 2. pass the result onward to the next monad in the chain.

        member this.Bind (p : RetryMonad<'a>, f : 'a -> RetryMonad<'b>)  =
            rm (fun retryParams -> 
                let value = retryFunc p retryParams //extract the value
                f value retryParams                //... and pass it on
            )

Here retryFunc is doing all the work of executing a function with retries:

    let internal retryFunc<'a> (f : RetryMonad<'a>) =
        rm (fun retryParams -> 
            let rec execWithRetry f i e =
                match i with
                | n when n = retryParams.maxRetries -> raise e
                | _ -> 
                    try
                        f retryParams //actual execution
                    with 
                    | e -> Thread.Sleep(retryParams.waitBetweenRetries); execWithRetry f (i + 1) e
            execWithRetry f 0 (Exception())
            ) 

Notice here that retryParams are available to the function during execution. This opens up possibilities of how the function may tune its actions depending on the retry policy. In this example there is not much to do, but RetryParams may theoretically be a more sophisticated type.

retryFunc throws the exception it gets from the function if there is an unrecoverable failure.
Since execWithRetry is tail recursive, there is no punishment normally associated with recursion (dipping into the stack, etc). In functional languages this is essentially a “while” loop.

This is it! The only thing left to do is to create an instance of the builder:

let retry = RetryBuilder()

An example program is below. Since we are chaining monads of the RetryMonad type, actual functions need to first be “wrapped” in it. See definitions of fn1 and fn2. “rm” in the body of those functions is just for “show”, not strictly necessary.

let Main(args) =
    
    let fn1 (x:float) (y:float) = rm (fun rp -> x * y)
    let fn2 (x:float) (y:float) = rm (fun rp -> if y = 0. then raise (invalidArg "y" "cannot be 0") else x / y)

    try
        let x = 
            (retry {
                let! a = fn1 7. 5.
                let! b = fn1 a 10.
                return b
            }) defaultRetryParams 

        printfn "first retry: %f" x

        let retryParams = {maxRetries = 5; waitBetweenRetries = 100}

        let ym = 
            retry {
                let! a = fn1 7. 5.
                let! b = fn1 a a
                let! c = fn2 b 0.
                return c
            }

        let y = ym retryParams
        0
    with
        e -> Console.WriteLine(e.Message); 1

This is slightly contrived, of course but you can see it in action if you insert some debugging output into the body of the functions, like I did in the complete solution:

Attempt 1
Result: 35. MaxRetries: 3. Wait: 1000.
Attempt 1
Result: 350. MaxRetries: 3. Wait: 1000.
first retry: 350.000000

Attempt 1
Result: 35. MaxRetries: 5. Wait: 100.
Attempt 1
Result: 1225. MaxRetries: 5. Wait: 100.
Attempt 1
Attempt 2
Attempt 3
Attempt 4
Attempt 5
cannot be 0
Parameter name: y