6 people like it.

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

More information

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