From 7daaddf57cc349b3238ecf8af8d9029fa2f846f5 Mon Sep 17 00:00:00 2001
From: Friedrich von Never <friedrich@fornever.me>
Date: Wed, 12 Jun 2019 22:09:14 +0700
Subject: [PATCH] Add cooldown timer, pass wrapRun context (#29)

---
 Emulsion.Tests/MessageSystem.fs | 15 ++++++++++++---
 Emulsion/MessageSystem.fs       | 18 ++++++++++++++----
 2 files changed, 26 insertions(+), 7 deletions(-)

diff --git a/Emulsion.Tests/MessageSystem.fs b/Emulsion.Tests/MessageSystem.fs
index dfa69759..be368ab5 100644
--- a/Emulsion.Tests/MessageSystem.fs
+++ b/Emulsion.Tests/MessageSystem.fs
@@ -1,10 +1,12 @@
 module Emulsion.Tests.MessageSystem
 
-open Xunit
-
 open System
 open System.Threading
+
+open Xunit
+
 open Emulsion
+open Emulsion.MessageSystem
 
 let private performTest expectedStage runBody =
     use cts = new CancellationTokenSource()
@@ -12,7 +14,13 @@ let private performTest expectedStage runBody =
     let run ct =
         stage <- stage + 1
         runBody cts ct stage
-    MessageSystem.wrapRun cts.Token run ignore
+    let context = {
+        token = cts.Token
+        cooldown = TimeSpan.Zero
+        logError = ignore
+        logMessage = ignore
+    }
+    MessageSystem.wrapRun context run
     Assert.Equal(expectedStage, stage)
 
 [<Fact>]
@@ -21,6 +29,7 @@ let ``wrapRun should restart the activity on error``() =
         match stage with
         | 1 -> raise <| Exception()
         | 2 -> cts.Cancel()
+        | _ -> failwith "Impossible"
     )
 
 [<Fact>]
diff --git a/Emulsion/MessageSystem.fs b/Emulsion/MessageSystem.fs
index 67333245..c9a00db4 100644
--- a/Emulsion/MessageSystem.fs
+++ b/Emulsion/MessageSystem.fs
@@ -15,10 +15,20 @@ type IMessageSystem =
     /// Queues the message to be sent to the IM system when possible.
     abstract member PutMessage : OutgoingMessage -> unit
 
-let internal wrapRun (token: CancellationToken) (run: CancellationToken -> unit) (log: Exception -> unit) : unit =
-    while not token.IsCancellationRequested do
+type RestartContext = {
+    token: CancellationToken
+    cooldown: TimeSpan
+    logError: Exception -> unit
+    logMessage: string -> unit
+}
+
+let wrapRun (ctx: RestartContext) (run: CancellationToken -> unit) : unit =
+    while not ctx.token.IsCancellationRequested do
         try
-            run token
+            run ctx.token
         with
         | :? OperationCanceledException -> ()
-        | ex -> log ex
+        | ex ->
+            ctx.logError ex
+            ctx.logMessage <| sprintf "Waiting for %A to restart" ctx.cooldown
+            Thread.Sleep ctx.cooldown