Monadic Retry

A Monad for composing computations with retry logic. (Useful when we work with Cloud Services)

 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: 
75: 
76: 
77: 
78: 
79: 
80:

open System
open System.Threading

type ShouldRetry = ShouldRetry of (RetryCount * LastException -> bool * RetryDelay)
and RetryCount = int
and LastException = exn
and RetryDelay = TimeSpan
type RetryPolicy = RetryPolicy of ShouldRetry
    
type RetryPolicies() =
    static member NoRetry () : RetryPolicy =
        RetryPolicy( ShouldRetry (fun (retryCount, _) -> (retryCount < 1, TimeSpan.Zero)) )
    static member Retry (retryCount : int , intervalBewteenRetries : RetryDelay) : RetryPolicy =
        RetryPolicy( ShouldRetry (fun (currentRetryCount, _) -> (currentRetryCount < retryCount, intervalBewteenRetries)))
    static member Retry (currentRetryCount : int) : RetryPolicy =
        RetryPolicies.Retry(currentRetryCount, TimeSpan.Zero)

type RetryResult<'T> = 
    | RetrySuccess of 'T
    | RetryFailure of exn
    
type Retry<'T> = Retry of (RetryPolicy -> RetryResult<'T>)

type RetryBuilder() =
    member self.Return (value : 'T) : Retry<'T> = Retry (fun retryPolicy -> RetrySuccess value)

    member self.Bind (retry : Retry<'T>, bindFunc : 'T -> Retry<'U>) : Retry<'U> = 
        Retry (fun retryPolicy ->
            let (Retry retryFunc) = retry 
            match retryFunc retryPolicy with
            | RetrySuccess value ->
                let (Retry retryFunc') = bindFunc value
                retryFunc' retryPolicy
            | RetryFailure exn -> RetryFailure exn )

    member self.Delay (f : unit -> Retry<'T>) : Retry<'T> = 
        Retry (fun retryPolicy ->
            let resultCell : option<RetryResult<'T>> ref = ref None 
            let lastExceptionCell : exn ref = ref null
            let (RetryPolicy(ShouldRetry shouldRetry)) = retryPolicy
            let canRetryCell : bool ref = ref true
            let currentRetryCountCell : int ref = ref 0
            while !canRetryCell do
                try
                    let (Retry retryFunc) = f ()
                    let result = retryFunc retryPolicy
                    resultCell := Some result
                    canRetryCell := false
                with e -> 
                    lastExceptionCell := e
                    currentRetryCountCell := 1 + !currentRetryCountCell
                    match shouldRetry(!currentRetryCountCell, !lastExceptionCell) with
                    | (true, retryDelay) ->
                        Thread.Sleep(retryDelay)
                    | (false, _) -> 
                        canRetryCell := false
            
            match !resultCell with
            | Some result -> result
            | None -> RetryFailure !lastExceptionCell )

[<AutoOpen>]
module Retry = 
    let retry = new RetryBuilder()
    let retryWithPolicy (retryPolicy : RetryPolicy) (retry : Retry<'T>) = 
        Retry (fun _ -> let (Retry retryFunc) = retry in retryFunc retryPolicy)
    let run (retry : Retry<'T>) (retryPolicy : RetryPolicy) : RetryResult<'T> =
        let (Retry retryFunc) = retry
        retryFunc retryPolicy


// Example
let test = 
    let random = new Random()
    retry {
        return 1 / random.Next(0, 2)
    }

(test, RetryPolicies.NoRetry()) ||> run
(test, RetryPolicies.Retry 10) ||> run

namespace System

namespace System.Threading

Multiple items
union case ShouldRetry.ShouldRetry: (RetryCount * LastException -> bool * RetryDelay) -> ShouldRetry

--------------------
type ShouldRetry = | ShouldRetry of (RetryCount * LastException -> bool * RetryDelay)

Full name: Script.ShouldRetry

type RetryCount = int

Full name: Script.RetryCount

type LastException = exn

Full name: Script.LastException

type bool = Boolean

Full name: Microsoft.FSharp.Core.bool

type RetryDelay = TimeSpan

Full name: Script.RetryDelay

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<_>

type exn = Exception

Full name: Microsoft.FSharp.Core.exn

Multiple items
type TimeSpan =
  struct
    new : ticks:int64 -> TimeSpan + 3 overloads
    member Add : ts:TimeSpan -> TimeSpan
    member CompareTo : value:obj -> int + 1 overload
    member Days : int
    member Duration : unit -> TimeSpan
    member Equals : value:obj -> bool + 1 overload
    member GetHashCode : unit -> int
    member Hours : int
    member Milliseconds : int
    member Minutes : int
    ...
  end

Full name: System.TimeSpan

--------------------
TimeSpan()
TimeSpan(ticks: int64) : unit
TimeSpan(hours: int, minutes: int, seconds: int) : unit
TimeSpan(days: int, hours: int, minutes: int, seconds: int) : unit
TimeSpan(days: int, hours: int, minutes: int, seconds: int, milliseconds: int) : unit

Multiple items
union case RetryPolicy.RetryPolicy: ShouldRetry -> RetryPolicy

--------------------
type RetryPolicy = | RetryPolicy of ShouldRetry

Full name: Script.RetryPolicy

Multiple items
type RetryPolicies =
  new : unit -> RetryPolicies
  static member NoRetry : unit -> RetryPolicy
  static member Retry : currentRetryCount:int -> RetryPolicy
  static member Retry : retryCount:int * intervalBewteenRetries:RetryDelay -> RetryPolicy

Full name: Script.RetryPolicies

--------------------
new : unit -> RetryPolicies

static member RetryPolicies.NoRetry : unit -> RetryPolicy

Full name: Script.RetryPolicies.NoRetry

val retryCount : RetryCount

field TimeSpan.Zero

static member RetryPolicies.Retry : retryCount:int * intervalBewteenRetries:RetryDelay -> RetryPolicy

Full name: Script.RetryPolicies.Retry

val retryCount : int

val intervalBewteenRetries : RetryDelay

val currentRetryCount : RetryCount

static member RetryPolicies.Retry : currentRetryCount:int -> RetryPolicy

Full name: Script.RetryPolicies.Retry

val currentRetryCount : int

static member RetryPolicies.Retry : currentRetryCount:int -> RetryPolicy
static member RetryPolicies.Retry : retryCount:int * intervalBewteenRetries:RetryDelay -> RetryPolicy

type RetryResult<'T> =
| RetrySuccess of 'T
| RetryFailure of exn

Full name: Script.RetryResult<_>

union case RetryResult.RetrySuccess: 'T -> RetryResult<'T>

union case RetryResult.RetryFailure: exn -> RetryResult<'T>

Multiple items
union case Retry.Retry: (RetryPolicy -> RetryResult<'T>) -> Retry<'T>

--------------------
type Retry<'T> = | Retry of (RetryPolicy -> RetryResult<'T>)

Full name: Script.Retry<_>

Multiple items
type RetryBuilder =
  new : unit -> RetryBuilder
  member Bind : retry:Retry<'T> * bindFunc:('T -> Retry<'U>) -> Retry<'U>
  member Delay : f:(unit -> Retry<'T>) -> Retry<'T>
  member Return : value:'T -> Retry<'T>

Full name: Script.RetryBuilder

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

val self : RetryBuilder

member RetryBuilder.Return : value:'T -> Retry<'T>

Full name: Script.RetryBuilder.Return

val value : 'T

val retryPolicy : RetryPolicy

member RetryBuilder.Bind : retry:Retry<'T> * bindFunc:('T -> Retry<'U>) -> Retry<'U>

Full name: Script.RetryBuilder.Bind

val retry : Retry<'T>

val bindFunc : ('T -> Retry<'U>)

val retryFunc : (RetryPolicy -> RetryResult<'T>)

val retryFunc' : (RetryPolicy -> RetryResult<'U>)

Multiple items
val exn : exn

--------------------
type exn = Exception

Full name: Microsoft.FSharp.Core.exn

member RetryBuilder.Delay : f:(unit -> Retry<'T>) -> Retry<'T>

Full name: Script.RetryBuilder.Delay

val f : (unit -> Retry<'T>)

type unit = Unit

Full name: Microsoft.FSharp.Core.unit

val resultCell : RetryResult<'T> option ref

type 'T option = Option<'T>

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

Multiple items
val ref : value:'T -> 'T ref

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

--------------------
type 'T ref = Ref<'T>

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

union case Option.None: Option<'T>

val lastExceptionCell : exn ref

val shouldRetry : (RetryCount * LastException -> bool * RetryDelay)

val canRetryCell : bool ref

val currentRetryCountCell : int ref

val result : RetryResult<'T>

union case Option.Some: Value: 'T -> Option<'T>

val e : exn

val retryDelay : RetryDelay

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 AutoOpenAttribute =
  inherit Attribute
  new : unit -> AutoOpenAttribute
  new : path:string -> AutoOpenAttribute
  member Path : string

Full name: Microsoft.FSharp.Core.AutoOpenAttribute

--------------------
new : unit -> AutoOpenAttribute
new : path:string -> AutoOpenAttribute

val retry : RetryBuilder

Full name: Script.Retry.retry

val retryWithPolicy : retryPolicy:RetryPolicy -> retry:Retry<'T> -> Retry<'T>

Full name: Script.Retry.retryWithPolicy

val run : retry:Retry<'T> -> retryPolicy:RetryPolicy -> RetryResult<'T>

Full name: Script.Retry.run

val test : Retry<int>

Full name: Script.test

val random : Random

Multiple items
type Random =
  new : unit -> Random + 1 overload
  member Next : unit -> int + 2 overloads
  member NextBytes : buffer:byte[] -> unit
  member NextDouble : unit -> float

Full name: System.Random

--------------------
Random() : unit
Random(Seed: int) : unit

Random.Next() : int
Random.Next(maxValue: int) : int
Random.Next(minValue: int, maxValue: int) : int

static member RetryPolicies.NoRetry : unit -> RetryPolicy

Raw view Test code New version

More information

Link:	http://fssnip.net/8o
Posted:	12 years ago
Author:	Nick Palladinos
Tags:	retry , monad , builder