module Aws.Test.Utils
(
testDataPrefix
, sshow
, tryT
, retryT
, retryT_
, testData
) where
import Control.Applicative
import Control.Concurrent (threadDelay)
import qualified Control.Exception.Lifted as LE
import Control.Error hiding (syncIO)
import Control.Monad.IO.Class
import Control.Monad.Trans.Control
import Data.Dynamic (Dynamic)
import Data.Monoid
import Data.String
import qualified Data.Text as T
import System.Exit (ExitCode)
testDataPrefix :: IsString a => a
testDataPrefix = "__TEST_AWSHASKELLBINDINGS__"
tryT :: MonadBaseControl IO m => m a -> EitherT T.Text m a
tryT = fmapLT (T.pack . show) . syncIO
syncIO :: MonadBaseControl IO m => m a -> EitherT LE.SomeException m a
syncIO a = EitherT $ LE.catches (Right <$> a)
[ LE.Handler $ \e -> LE.throw (e :: LE.ArithException)
, LE.Handler $ \e -> LE.throw (e :: LE.ArrayException)
, LE.Handler $ \e -> LE.throw (e :: LE.AssertionFailed)
, LE.Handler $ \e -> LE.throw (e :: LE.AsyncException)
, LE.Handler $ \e -> LE.throw (e :: LE.BlockedIndefinitelyOnMVar)
, LE.Handler $ \e -> LE.throw (e :: LE.BlockedIndefinitelyOnSTM)
, LE.Handler $ \e -> LE.throw (e :: LE.Deadlock)
, LE.Handler $ \e -> LE.throw (e :: Dynamic)
, LE.Handler $ \e -> LE.throw (e :: LE.ErrorCall)
, LE.Handler $ \e -> LE.throw (e :: ExitCode)
, LE.Handler $ \e -> LE.throw (e :: LE.NestedAtomically)
, LE.Handler $ \e -> LE.throw (e :: LE.NoMethodError)
, LE.Handler $ \e -> LE.throw (e :: LE.NonTermination)
, LE.Handler $ \e -> LE.throw (e :: LE.PatternMatchFail)
, LE.Handler $ \e -> LE.throw (e :: LE.RecConError)
, LE.Handler $ \e -> LE.throw (e :: LE.RecSelError)
, LE.Handler $ \e -> LE.throw (e :: LE.RecUpdError)
, LE.Handler $ return . Left
]
testData :: (IsString a, Monoid a) => a -> a
testData a = testDataPrefix <> a
retryT :: MonadIO m => Int -> EitherT T.Text m a -> EitherT T.Text m a
retryT n f = snd <$> retryT_ n f
retryT_ :: MonadIO m => Int -> EitherT T.Text m a -> EitherT T.Text m (Int, a)
retryT_ n f = go 1
where
go x
| x >= n = fmapLT (\e -> "error after " <> sshow x <> " retries: " <> e) ((x,) <$> f)
| otherwise = ((x,) <$> f) `catchT` \_ -> do
liftIO $ threadDelay (1000000 * min 60 (2^(x1)))
go (succ x)
sshow :: (Show a, IsString b) => a -> b
sshow = fromString . show