eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

roughly working again

Browse source
This commit is contained in:
Sönke Hahn 2016-04-06 17:43:28 +08:00
parent 2434399845
commit 16219f00fe
2 changed files with 3 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
servant-client/src/Servant/Common/Req.hs
View file

@ -21,7 +21,7 @@ import Data.Text.Encoding
import Network.HTTP.Client hiding (Proxy, path) import Network.HTTP.Client hiding (Proxy, path)
import Network.HTTP.Media import Network.HTTP.Media
import Network.HTTP.Types import Network.HTTP.Types
import qualified Network.HTTP.Types.Header as HTTP import qualified Network.HTTP.Types.Header as HTTP
import Network.URI hiding (path) import Network.URI hiding (path)
import Servant.API.ContentTypes import Servant.API.ContentTypes
import Servant.Client.PerformRequest import Servant.Client.PerformRequest
@ -108,7 +108,7 @@ performRequest reqMethod req manager reqHost = do
, checkStatus = \ _status _headers _cookies -> Nothing , checkStatus = \ _status _headers _cookies -> Nothing
} }
eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request manager eResponse <- liftIO $ performHttpRequest manager request
case eResponse of case eResponse of
Left err -> Left err ->
throwE . ConnectionError $ SomeException err throwE . ConnectionError $ SomeException err
@ -145,8 +145,3 @@ performRequestNoBody :: Method -> Req -> Manager -> BaseUrl
performRequestNoBody reqMethod req manager reqHost = do performRequestNoBody reqMethod req manager reqHost = do
(_status, _body, _ct, hdrs, _response) <- performRequest reqMethod req manager reqHost (_status, _body, _ct, hdrs, _response) <- performRequest reqMethod req manager reqHost
return hdrs return hdrs
catchConnectionError :: IO a -> IO (Either ServantError a)
catchConnectionError action =
catch (Right <$> action) $ \e ->
pure . Left . ConnectionError $ SomeException (e :: HttpException)

2
servant-client/test/ghcjs/run-tests.sh
View file

@ -8,4 +8,4 @@ npm install xhr2
export STACK_YAML=stack-ghcjs.yaml export STACK_YAML=stack-ghcjs.yaml
stack setup stack setup
stack test stack test --fast