From 52d6c2d3472d3a64998ad0c5c789f136b9b8ce2d Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Wed, 17 Oct 2018 10:30:28 +0200
Subject: [PATCH] minor cleanup

---
 src/Utils/Sql.hs | 13 +++++++++++--
 1 file changed, 11 insertions(+), 2 deletions(-)

diff --git a/src/Utils/Sql.hs b/src/Utils/Sql.hs
index 5e456bc28..6cdb0a144 100644
--- a/src/Utils/Sql.hs
+++ b/src/Utils/Sql.hs
@@ -17,6 +17,8 @@ import Database.Persist.Sql
 import Database.PostgreSQL.Simple (sqlErrorHint)
 import Control.Monad.Catch (handleIf)
 
+import Data.Time.Clock
+
 setSerializable :: (MonadLogger m, MonadCatch m, MonadBase IO m, MonadIO m) => ReaderT SqlBackend m a -> ReaderT SqlBackend m a
 setSerializable act = setSerializable' (0 :: Integer)
   where
@@ -24,7 +26,14 @@ setSerializable act = setSerializable' (0 :: Integer)
 
     setSerializable' (min 10 -> logBackoff) =
       handleIf
-        (\e -> sqlErrorHint e == "The transaction might succeed if retried.")
-        (\e -> $logWarnS "Sql" (tshow e) *> threadDelay (1e3 * 2 ^ logBackoff) *> setSerializable' (succ logBackoff))
+        (\e -> "The transaction might succeed if retried." `isInfixOf` sqlErrorHint e)
+        (\e -> do
+            let
+              delay :: NominalDiffTime
+              delay = 1e-3 * 2 ^ logBackoff
+            $logWarnS "Sql" $ tshow (delay, e)
+            threadDelay . round $ delay * 1e6
+            setSerializable' (succ logBackoff)
+        )
         act'