4 people like it.

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 New version

More information

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