Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Use annotated-exception #131

Merged
merged 18 commits into from
Nov 30, 2023
Merged
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Prev Previous commit
more constraint consistency
chris-martin committed Nov 30, 2023
commit ab8aa8b63cd869fd0a156b9e171f9194d773c6d2
3 changes: 1 addition & 2 deletions library/Freckle/App/Http.hs
Original file line number Diff line number Diff line change
@@ -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
2 changes: 1 addition & 1 deletion library/Freckle/App/Http/Retry.hs
Original file line number Diff line number Diff line change
@@ -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 $
8 changes: 3 additions & 5 deletions library/Freckle/App/Kafka/Consumer.hs
Original file line number Diff line number Diff line change
@@ -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 =
2 changes: 1 addition & 1 deletion library/Freckle/App/Memcached/CacheKey.hs
Original file line number Diff line number Diff line change
@@ -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
9 changes: 5 additions & 4 deletions library/Freckle/App/Test.hs
Original file line number Diff line number Diff line change
@@ -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 ()
2 changes: 1 addition & 1 deletion library/Freckle/App/Test/Yesod.hs
Original file line number Diff line number Diff line change
@@ -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