A simple retry combinator

A simple retry combinator with customizable retry policies.

 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:

module Retry    
    
    open System

    type RetryPolicy = Policy of (int -> exn -> TimeSpan option)

    /// retries given action based on policy
    let retry (Policy p) (f : unit -> 'T) =
        let rec aux retries =
            let result = 
                try Choice1Of2 <| f () 
                with e ->
                    match p (retries + 1) e with
                    | None -> reraise ()
                    | Some interval -> Choice2Of2 interval

            match result with
            | Choice1Of2 t -> t
            | Choice2Of2 interval ->
                do System.Threading.Thread.Sleep interval
                aux (retries + 1)

        aux 0


    // sample policies

    [<Measure>] type sec

    let ofSeconds (seconds : float<sec> option) = 
        match seconds with
        | None -> TimeSpan.Zero
        | Some secs -> TimeSpan.FromSeconds (float secs)

    type RetryPolicy with
        static member NoRetry = Policy(fun _ _ -> None)
        static member Infinite (?delay : float<sec>) = 
            Policy(fun _ _ -> Some <| ofSeconds delay)

        static member Retry(maxRetries : int, ?delay : float<sec>) =
            Policy(fun retries _ ->
                if retries > maxRetries then None
                else Some <| ofSeconds delay)

        static member ExponentialDelay(maxRetries : int, initialDelay : float<sec>) =
            Policy(fun retries _ ->
                if retries > maxRetries then None
                else
                    let delay = initialDelay * (2.0 ** float (retries - 1))
                    Some <| TimeSpan.FromSeconds(float delay))


    // examples

    let succeedAfter n =
        let count = ref 0
        fun () ->
            incr count
            printfn "%d" !count
            if !count > n then ()
            else
                failwith "not yet"


    succeedAfter 10 |> retry (RetryPolicy.Retry(5, 0.1<sec>))
    succeedAfter 10 |> retry (RetryPolicy.Retry(20, 0.1<sec>))
    succeedAfter 10 |> retry (RetryPolicy.Infinite())
    succeedAfter 5 |> retry (RetryPolicy.ExponentialDelay(10, 0.3<sec>))

module Retry

namespace System

type RetryPolicy =
  | Policy of (int -> exn -> TimeSpan option)
  static member ExponentialDelay : maxRetries:int * initialDelay:float<sec> -> RetryPolicy
  static member Infinite : ?delay:float<sec> -> RetryPolicy
  static member Retry : maxRetries:int * ?delay:float<sec> -> RetryPolicy
  static member NoRetry : RetryPolicy

Full name: Retry.RetryPolicy

union case RetryPolicy.Policy: (int -> exn -> TimeSpan option) -> RetryPolicy

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

type 'T option = Option<'T>

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

val retry : RetryPolicy -> f:(unit -> 'T) -> 'T

Full name: Retry.retry

retries given action based on policy

val p : (int -> exn -> TimeSpan option)

val f : (unit -> 'T)

type unit = Unit

Full name: Microsoft.FSharp.Core.unit

val aux : (int -> 'T)

val retries : int

val result : Choice<'T,TimeSpan>

union case Choice.Choice1Of2: 'T1 -> Choice<'T1,'T2>

val e : exn

union case Option.None: Option<'T>

val reraise : unit -> 'T

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

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

val interval : TimeSpan

union case Choice.Choice2Of2: 'T2 -> Choice<'T1,'T2>

val t : 'T

namespace System.Threading

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

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

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

Multiple items
type MeasureAttribute =
inherit Attribute
new : unit -> MeasureAttribute

Full name: Microsoft.FSharp.Core.MeasureAttribute

--------------------
new : unit -> MeasureAttribute

[<Measure>]
type sec

Full name: Retry.sec

val ofSeconds : seconds:float<sec> option -> TimeSpan

Full name: Retry.ofSeconds

val seconds : float<sec> option

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

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

--------------------
type float = Double

Full name: Microsoft.FSharp.Core.float

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

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

field TimeSpan.Zero

val secs : float<sec>

TimeSpan.FromSeconds(value: float) : TimeSpan

static member RetryPolicy.NoRetry : RetryPolicy

Full name: Retry.RetryPolicy.NoRetry

static member RetryPolicy.Infinite : ?delay:float<sec> -> RetryPolicy

Full name: Retry.RetryPolicy.Infinite

val delay : float<sec> option

static member RetryPolicy.Retry : maxRetries:int * ?delay:float<sec> -> RetryPolicy

Full name: Retry.RetryPolicy.Retry

val maxRetries : int

static member RetryPolicy.ExponentialDelay : maxRetries:int * initialDelay:float<sec> -> RetryPolicy

Full name: Retry.RetryPolicy.ExponentialDelay

val initialDelay : float<sec>

val delay : float<sec>

val succeedAfter : n:int -> (unit -> unit)

Full name: Retry.succeedAfter

val n : int

val count : int ref

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

val incr : cell:int ref -> unit

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

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

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

val failwith : message:string -> 'T

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

static member RetryPolicy.Retry : maxRetries:int * ?delay:float<sec> -> RetryPolicy

static member RetryPolicy.Infinite : ?delay:float<sec> -> RetryPolicy

static member RetryPolicy.ExponentialDelay : maxRetries:int * initialDelay:float<sec> -> RetryPolicy

Raw view Test code New version

More information

Link:	http://fssnip.net/iy
Posted:	11 years ago
Author:	Eirik Tsarpalis
Tags:	retry