1 people like it.

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:10 years ago
Author:Eirik Tsarpalis
Tags: retry