5 people like it.
Like the snippet!

Exception Retry Computation Expression

Retry monad: chaining functions together, retrying each one if exceptions are thrown, until the first time a function can no longer be retried

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
57: 
58: 
59: 
60: 
61: 
62: 
63: 
64: 
65: 
66: 
67: 
68: 
69: 
70: 
71: 
72: 
73: 
74:

module Retry =
    open System.Threading
    open System

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

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

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

    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
                    with 
                    | e -> Thread.Sleep(retryParams.waitBetweenRetries); execWithRetry f (i + 1) e
            execWithRetry f 0 (Exception())
            ) 

    
    type RetryBuilder() =
        
        member this.Bind (p : RetryMonad<'a>, f : 'a -> RetryMonad<'b>)  =
            rm (fun retryParams -> 
                let value = retryFunc p retryParams
                f value retryParams                
            )

        member this.Return (x : 'a) = fun defaultRetryParams -> x

        member this.Run(m : RetryMonad<'a>) = m

        member this.Delay(f : unit -> RetryMonad<'a>) = f ()

    let retry = RetryBuilder()

//Examples
let test() =
    
    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. //division by 0.
                return c
            }

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

namespace System

namespace System.Threading

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

Full name: Script.Retry.RetryParams

RetryParams.maxRetries: int

Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>

RetryParams.waitBetweenRetries: int

val defaultRetryParams : RetryParams

Full name: Script.Retry.defaultRetryParams

type RetryMonad<'a> = RetryParams -> 'a

Full name: Script.Retry.RetryMonad<_>

val rm : f:(RetryParams -> 'a) -> RetryMonad<'a>

Full name: Script.Retry.rm

val f : (RetryParams -> 'a)

val internal retryFunc : f:RetryMonad<'a> -> RetryMonad<'a>

Full name: Script.Retry.retryFunc

val f : RetryMonad<'a>

val retryParams : RetryParams

val execWithRetry : ((RetryParams -> 'b) -> int -> exn -> 'b)

val f : (RetryParams -> 'b)

val i : int

val e : exn

val n : int

val raise : exn:Exception -> 'T

Full name: Microsoft.FSharp.Core.Operators.raise

Multiple items
type Thread =
  inherit CriticalFinalizerObject
  new : start:ThreadStart -> Thread + 3 overloads
  member Abort : unit -> unit + 1 overload
  member ApartmentState : ApartmentState with get, set
  member CurrentCulture : CultureInfo with get, set
  member CurrentUICulture : CultureInfo with get, set
  member DisableComObjectEagerCleanup : unit -> unit
  member ExecutionContext : ExecutionContext
  member GetApartmentState : unit -> ApartmentState
  member GetCompressedStack : unit -> CompressedStack
  member GetHashCode : unit -> int
  ...

Full name: System.Threading.Thread

--------------------
Thread(start: ThreadStart) : unit
Thread(start: ParameterizedThreadStart) : unit
Thread(start: ThreadStart, maxStackSize: int) : unit
Thread(start: ParameterizedThreadStart, maxStackSize: int) : unit

Thread.Sleep(timeout: TimeSpan) : unit
Thread.Sleep(millisecondsTimeout: int) : unit

Multiple items
type Exception =
  new : unit -> Exception + 2 overloads
  member Data : IDictionary
  member GetBaseException : unit -> Exception
  member GetObjectData : info:SerializationInfo * context:StreamingContext -> unit
  member GetType : unit -> Type
  member HelpLink : string with get, set
  member InnerException : Exception
  member Message : string
  member Source : string with get, set
  member StackTrace : string
  ...

Full name: System.Exception

--------------------
Exception() : unit
Exception(message: string) : unit
Exception(message: string, innerException: exn) : unit

Multiple items
type RetryBuilder =
  new : unit -> RetryBuilder
  member Bind : p:RetryMonad<'a> * f:('a -> RetryMonad<'b>) -> RetryMonad<'b>
  member Delay : f:(unit -> RetryMonad<'a>) -> RetryMonad<'a>
  member Return : x:'a -> ('a0 -> 'a)
  member Run : m:RetryMonad<'a> -> RetryMonad<'a>

Full name: Script.Retry.RetryBuilder

--------------------
new : unit -> RetryBuilder

val this : RetryBuilder

member RetryBuilder.Bind : p:RetryMonad<'a> * f:('a -> RetryMonad<'b>) -> RetryMonad<'b>

Full name: Script.Retry.RetryBuilder.Bind

val p : RetryMonad<'a>

val f : ('a -> RetryMonad<'b>)

val value : 'a

member RetryBuilder.Return : x:'a -> ('a0 -> 'a)

Full name: Script.Retry.RetryBuilder.Return

val x : 'a

val defaultRetryParams : 'a

member RetryBuilder.Run : m:RetryMonad<'a> -> RetryMonad<'a>

Full name: Script.Retry.RetryBuilder.Run

val m : RetryMonad<'a>

member RetryBuilder.Delay : f:(unit -> RetryMonad<'a>) -> RetryMonad<'a>

Full name: Script.Retry.RetryBuilder.Delay

val f : (unit -> RetryMonad<'a>)

type unit = Unit

Full name: Microsoft.FSharp.Core.unit

val retry : RetryBuilder

Full name: Script.Retry.retry

val test : unit -> int

Full name: Script.test

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

val x : float

Multiple items
val float : value:'T -> float (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.float

--------------------
type float = System.Double

Full name: Microsoft.FSharp.Core.float

--------------------
type float<'Measure> = float

Full name: Microsoft.FSharp.Core.float<_>

val y : float

val fn2 : (float -> float -> 'a)

val raise : exn:System.Exception -> 'T

Full name: Microsoft.FSharp.Core.Operators.raise

val invalidArg : argumentName:string -> message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.invalidArg

val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn

val retryParams : obj

val ym : (obj -> obj)

val y : obj

property System.Exception.Message: string

Raw view Test code New version

More information

Link:	http://fssnip.net/bb
Posted:	12 years ago
Author:	Boris Kogan
Tags:	computation expression , monad , retry