Merge pull request #94 from haskell-servant/tvh/simpler-error

Don't export HttpException
This commit is contained in:
Alp Mestanogullari 2015-07-02 00:59:14 +02:00
commit fa6cfbb539
2 changed files with 11 additions and 15 deletions

View File

@ -48,13 +48,13 @@ data ServantError
{ responseContentType :: MediaType { responseContentType :: MediaType
, responseBody :: ByteString , responseBody :: ByteString
} }
| ConnectionError
{ connectionError :: HttpException
}
| InvalidContentTypeHeader | InvalidContentTypeHeader
{ responseContentTypeHeader :: ByteString { responseContentTypeHeader :: ByteString
, responseBody :: ByteString , responseBody :: ByteString
} }
| ConnectionError
{ connectionError :: SomeException
}
deriving (Show, Typeable) deriving (Show, Typeable)
instance Exception ServantError instance Exception ServantError
@ -152,11 +152,11 @@ performRequest reqMethod req isWantedStatus reqHost = do
} }
eResponse <- liftIO $ __withGlobalManager $ \ manager -> eResponse <- liftIO $ __withGlobalManager $ \ manager ->
catchHttpException $ catchConnectionError $
Client.httpLbs request manager Client.httpLbs request manager
case eResponse of case eResponse of
Left err -> Left err ->
left $ ConnectionError err left . ConnectionError $ SomeException err
Right response -> do Right response -> do
let status = Client.responseStatus response let status = Client.responseStatus response
@ -189,6 +189,7 @@ performRequestNoBody reqMethod req wantedStatus reqHost = do
_ <- performRequest reqMethod req (`elem` wantedStatus) reqHost _ <- performRequest reqMethod req (`elem` wantedStatus) reqHost
return () return ()
catchHttpException :: IO a -> IO (Either HttpException a) catchConnectionError :: IO a -> IO (Either ServantError a)
catchHttpException action = catchConnectionError action =
catch (Right <$> action) (pure . Left) catch (Right <$> action) $ \e ->
pure . Left . ConnectionError $ SomeException (e :: HttpException)

View File

@ -68,11 +68,6 @@ instance FromFormUrlEncoded Person where
a <- lookupEither "age" xs a <- lookupEither "age" xs
return $ Person (T.unpack n) (read $ T.unpack a) return $ Person (T.unpack n) (read $ T.unpack a)
deriving instance Eq ServantError
instance Eq C.HttpException where
a == b = show a == show b
alice :: Person alice :: Person
alice = Person "Alice" 42 alice = Person "Alice" 42
@ -311,7 +306,7 @@ failSpec = withFailServer $ \ baseUrl -> do
it "reports ConnectionError" $ do it "reports ConnectionError" $ do
Left res <- runEitherT getGetWrongHost Left res <- runEitherT getGetWrongHost
case res of case res of
ConnectionError (C.FailedConnectionException2 "127.0.0.1" 19872 False _) -> return () ConnectionError _ -> return ()
_ -> fail $ "expected ConnectionError, but got " <> show res _ -> fail $ "expected ConnectionError, but got " <> show res
it "reports UnsupportedContentType" $ do it "reports UnsupportedContentType" $ do