diff --git a/library/Freckle/App/Http.hs b/library/Freckle/App/Http.hs index 91f17f06..8f6ce5e7 100644 --- a/library/Freckle/App/Http.hs +++ b/library/Freckle/App/Http.hs @@ -212,8 +212,7 @@ addBearerAuthorizationHeader = addRequestHeader hAuthorization . ("Bearer " <>) -- error response bodies too, you'll want to use 'setRequestCheckStatus' so that -- you see status-code exceptions before 'HttpDecodeError's. getResponseBodyUnsafe - :: (MonadIO m, Exception e) - => HasCallStack + :: (MonadIO m, Exception e, HasCallStack) => Response (Either e a) -> m a getResponseBodyUnsafe = either throwM pure . getResponseBody diff --git a/library/Freckle/App/Http/Retry.hs b/library/Freckle/App/Http/Retry.hs index 455b8922..23e84e29 100644 --- a/library/Freckle/App/Http/Retry.hs +++ b/library/Freckle/App/Http/Retry.hs @@ -78,7 +78,7 @@ suppressRetryStatusError req = originalCheckResponse = checkResponse req checkRetriesExhausted - :: MonadIO m => HasCallStack => Int -> Response body -> m (Response body) + :: (MonadIO m, HasCallStack) => Int -> Response body -> m (Response body) checkRetriesExhausted retryLimit resp | getResponseStatus resp == status429 = throwM $ diff --git a/library/Freckle/App/Kafka/Consumer.hs b/library/Freckle/App/Kafka/Consumer.hs index 6e020313..ff9a1583 100644 --- a/library/Freckle/App/Kafka/Consumer.hs +++ b/library/Freckle/App/Kafka/Consumer.hs @@ -129,8 +129,7 @@ subscription KafkaConsumerConfig {..} = <> extraSubscriptionProps kafkaConsumerConfigExtraSubscriptionProps withKafkaConsumer - :: MonadUnliftIO m - => HasCallStack + :: (MonadUnliftIO m, HasCallStack) => KafkaConsumerConfig -> (KafkaConsumer -> m a) -> m a @@ -167,8 +166,8 @@ runConsumer , MonadTracer m , HasKafkaConsumer env , FromJSON a + , HasCallStack ) - => HasCallStack => Timeout -> (a -> m ()) -> m () @@ -200,8 +199,7 @@ runConsumer pollTimeout onMessage = ] fromKafkaError - :: (MonadIO m, MonadLogger m) - => HasCallStack + :: (MonadIO m, MonadLogger m, HasCallStack) => Either KafkaError a -> m (Maybe a) fromKafkaError = diff --git a/library/Freckle/App/Memcached/CacheKey.hs b/library/Freckle/App/Memcached/CacheKey.hs index 3a0a67f8..e163de49 100644 --- a/library/Freckle/App/Memcached/CacheKey.hs +++ b/library/Freckle/App/Memcached/CacheKey.hs @@ -42,7 +42,7 @@ cacheKey t Left $ "Not a valid memcached key:\n " <> unpack t <> "\n\n" <> msg -- | Build a 'CacheKey' and throw if invalid -cacheKeyThrow :: (HasCallStack, MonadIO m) => Text -> m CacheKey +cacheKeyThrow :: (MonadIO m, HasCallStack) => Text -> m CacheKey cacheKeyThrow = either throwString pure . cacheKey fromCacheKey :: CacheKey -> Key diff --git a/library/Freckle/App/Test.hs b/library/Freckle/App/Test.hs index 18228165..4bb9fc21 100644 --- a/library/Freckle/App/Test.hs +++ b/library/Freckle/App/Test.hs @@ -100,9 +100,10 @@ instance MonadMask (AppExample app) where uninterruptibleMask = UnliftIO.uninterruptibleMask generalBracket acquire release use = mask $ \unmasked -> do resource <- acquire - b <- unmasked (use resource) `catch` \e -> do - _ <- release resource (ExitCaseException e) - MonadThrow.throwM e + b <- + unmasked (use resource) `catch` \e -> do + _ <- release resource (ExitCaseException e) + MonadThrow.throwM e c <- release resource (ExitCaseSuccess b) pure (b, c) @@ -177,7 +178,7 @@ withAppSql f run = withApp run . beforeSql f beforeSql :: HasSqlPool app => SqlPersistT IO a -> SpecWith app -> SpecWith app beforeSql f = beforeWith $ \app -> app <$ runSqlPool f (getSqlPool app) -expectationFailure :: (HasCallStack, MonadIO m) => String -> m a +expectationFailure :: (MonadIO m, HasCallStack) => String -> m a expectationFailure msg = Hspec.expectationFailure msg >> error "unreachable" pending :: MonadIO m => m () diff --git a/library/Freckle/App/Test/Yesod.hs b/library/Freckle/App/Test/Yesod.hs index 9f4ec7aa..7edcb383 100644 --- a/library/Freckle/App/Test/Yesod.hs +++ b/library/Freckle/App/Test/Yesod.hs @@ -216,7 +216,7 @@ addJsonHeaders = do -- If the status code doesn't match, a portion of the body is also -- printed to aid in debugging. statusIs - :: forall m site. (HasCallStack, MonadYesodExample site m) => Int -> m () + :: forall m site. (MonadYesodExample site m, HasCallStack) => Int -> m () statusIs = liftYesodExample . Yesod.Test.statusIs -- | Assert that the given header field's value satisfied some predicate