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

Drop EitherT in favor of ExceptT

Browse source
This commit is contained in:
Index Int 2015-09-12 15:11:24 +03:00
parent 961887cc95
commit f2f7b061d2
22 changed files with 158 additions and 174 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
servant-client/README.md
View file

@ -13,8 +13,8 @@ type MyApi = "books" :> Get '[JSON] [Book] -- GET /books
myApi :: Proxy MyApi
myApi = Proxy
getAllBooks :: EitherT String IO [Book]
postNewBook :: Book -> EitherT String IO Book
getAllBooks :: ExceptT String IO [Book]
postNewBook :: Book -> ExceptT String IO Book
-- 'client' allows you to produce operations to query an API from a client.
(getAllBooks :<|> postNewBook) = client myApi host
where host = BaseUrl Http "localhost" 8080

3
servant-client/servant-client.cabal
View file

@ -33,7 +33,6 @@ library
, aeson
, attoparsec
, bytestring
, either
, exceptions
, http-client
, http-client-tls
@ -61,10 +60,10 @@ test-suite spec
, Servant.Common.BaseUrlSpec
build-depends:
base == 4.*
, transformers
, aeson
, bytestring
, deepseq
, either
, hspec == 2.*
, http-client
, http-media

60
servant-client/src/Servant/Client.hs
View file

@ -25,7 +25,7 @@ module Servant.Client
import Control.Applicative ((<$>))
#endif
import Control.Monad
import Control.Monad.Trans.Either
import Control.Monad.Trans.Except
import Data.ByteString.Lazy (ByteString)
import Data.List
import Data.Proxy
@ -50,8 +50,8 @@ import Servant.Common.Req
-- > myApi :: Proxy MyApi
-- > myApi = Proxy
-- >
-- > getAllBooks :: EitherT String IO [Book]
-- > postNewBook :: Book -> EitherT String IO Book
-- > getAllBooks :: ExceptT String IO [Book]
-- > postNewBook :: Book -> ExceptT String IO Book
-- > (getAllBooks :<|> postNewBook) = client myApi host
-- > where host = BaseUrl Http "localhost" 8080
client :: HasClient layout => Proxy layout -> BaseUrl -> Client layout
@ -76,8 +76,8 @@ class HasClient layout where
-- > myApi :: Proxy MyApi
-- > myApi = Proxy
-- >
-- > getAllBooks :: EitherT String IO [Book]
-- > postNewBook :: Book -> EitherT String IO Book
-- > getAllBooks :: ExceptT String IO [Book]
-- > postNewBook :: Book -> ExceptT String IO Book
-- > (getAllBooks :<|> postNewBook) = client myApi host
-- > where host = BaseUrl Http "localhost" 8080
instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
@ -102,7 +102,7 @@ instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
-- > myApi :: Proxy MyApi
-- > myApi = Proxy
-- >
-- > getBook :: Text -> EitherT String IO Book
-- > getBook :: Text -> ExceptT String IO Book
-- > getBook = client myApi host
-- > where host = BaseUrl Http "localhost" 8080
-- > -- then you can just use "getBook" to query that endpoint
@ -129,7 +129,7 @@ instance
#endif
-- See https://downloads.haskell.org/~ghc/7.8.2/docs/html/users_guide/type-class-extensions.html#undecidable-instances
(MimeUnrender ct a, cts' ~ (ct ': cts)) => HasClient (Delete cts' a) where
type Client (Delete cts' a) = EitherT ServantError IO a
type Client (Delete cts' a) = ExceptT ServantError IO a
clientWithRoute Proxy req baseurl =
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] baseurl
@ -140,7 +140,7 @@ instance
{-# OVERLAPPING #-}
#endif
HasClient (Delete cts ()) where
type Client (Delete cts ()) = EitherT ServantError IO ()
type Client (Delete cts ()) = ExceptT ServantError IO ()
clientWithRoute Proxy req baseurl =
void $ performRequestNoBody H.methodDelete req [204] baseurl
@ -153,7 +153,7 @@ instance
-- See https://downloads.haskell.org/~ghc/7.8.2/docs/html/users_guide/type-class-extensions.html#undecidable-instances
( MimeUnrender ct a, BuildHeadersTo ls, cts' ~ (ct ': cts)
) => HasClient (Delete cts' (Headers ls a)) where
type Client (Delete cts' (Headers ls a)) = EitherT ServantError IO (Headers ls a)
type Client (Delete cts' (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
clientWithRoute Proxy req baseurl = do
(hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] baseurl
return $ Headers { getResponse = resp
@ -169,7 +169,7 @@ instance
{-# OVERLAPPABLE #-}
#endif
(MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where
type Client (Get (ct ': cts) result) = EitherT ServantError IO result
type Client (Get (ct ': cts) result) = ExceptT ServantError IO result
clientWithRoute Proxy req baseurl =
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203] baseurl
@ -180,7 +180,7 @@ instance
{-# OVERLAPPING #-}
#endif
HasClient (Get (ct ': cts) ()) where
type Client (Get (ct ': cts) ()) = EitherT ServantError IO ()
type Client (Get (ct ': cts) ()) = ExceptT ServantError IO ()
clientWithRoute Proxy req baseurl =
performRequestNoBody H.methodGet req [204] baseurl
@ -192,7 +192,7 @@ instance
#endif
( MimeUnrender ct a, BuildHeadersTo ls
) => HasClient (Get (ct ': cts) (Headers ls a)) where
type Client (Get (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a)
type Client (Get (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
clientWithRoute Proxy req baseurl = do
(hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203, 204] baseurl
return $ Headers { getResponse = resp
@ -220,7 +220,7 @@ instance
-- > myApi :: Proxy MyApi
-- > myApi = Proxy
-- >
-- > viewReferer :: Maybe Referer -> EitherT String IO Book
-- > viewReferer :: Maybe Referer -> ExceptT String IO Book
-- > viewReferer = client myApi host
-- > where host = BaseUrl Http "localhost" 8080
-- > -- then you can just use "viewRefer" to query that endpoint
@ -250,7 +250,7 @@ instance
{-# OVERLAPPABLE #-}
#endif
(MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where
type Client (Post (ct ': cts) a) = EitherT ServantError IO a
type Client (Post (ct ': cts) a) = ExceptT ServantError IO a
clientWithRoute Proxy req baseurl =
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPost req [200,201] baseurl
@ -261,7 +261,7 @@ instance
{-# OVERLAPPING #-}
#endif
HasClient (Post (ct ': cts) ()) where
type Client (Post (ct ': cts) ()) = EitherT ServantError IO ()
type Client (Post (ct ': cts) ()) = ExceptT ServantError IO ()
clientWithRoute Proxy req baseurl =
void $ performRequestNoBody H.methodPost req [204] baseurl
@ -273,7 +273,7 @@ instance
#endif
( MimeUnrender ct a, BuildHeadersTo ls
) => HasClient (Post (ct ': cts) (Headers ls a)) where
type Client (Post (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a)
type Client (Post (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
clientWithRoute Proxy req baseurl = do
(hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPost req [200, 201] baseurl
return $ Headers { getResponse = resp
@ -289,7 +289,7 @@ instance
{-# OVERLAPPABLE #-}
#endif
(MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where
type Client (Put (ct ': cts) a) = EitherT ServantError IO a
type Client (Put (ct ': cts) a) = ExceptT ServantError IO a
clientWithRoute Proxy req baseurl =
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPut req [200,201] baseurl
@ -300,7 +300,7 @@ instance
{-# OVERLAPPING #-}
#endif
HasClient (Put (ct ': cts) ()) where
type Client (Put (ct ': cts) ()) = EitherT ServantError IO ()
type Client (Put (ct ': cts) ()) = ExceptT ServantError IO ()
clientWithRoute Proxy req baseurl =
void $ performRequestNoBody H.methodPut req [204] baseurl
@ -312,7 +312,7 @@ instance
#endif
( MimeUnrender ct a, BuildHeadersTo ls
) => HasClient (Put (ct ': cts) (Headers ls a)) where
type Client (Put (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a)
type Client (Put (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
clientWithRoute Proxy req baseurl = do
(hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPut req [200, 201] baseurl
return $ Headers { getResponse = resp
@ -328,7 +328,7 @@ instance
{-# OVERLAPPABLE #-}
#endif
(MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where
type Client (Patch (ct ': cts) a) = EitherT ServantError IO a
type Client (Patch (ct ': cts) a) = ExceptT ServantError IO a
clientWithRoute Proxy req baseurl =
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200,201] baseurl
@ -339,7 +339,7 @@ instance
{-# OVERLAPPING #-}
#endif
HasClient (Patch (ct ': cts) ()) where
type Client (Patch (ct ': cts) ()) = EitherT ServantError IO ()
type Client (Patch (ct ': cts) ()) = ExceptT ServantError IO ()
clientWithRoute Proxy req baseurl =
void $ performRequestNoBody H.methodPatch req [204] baseurl
@ -351,7 +351,7 @@ instance
#endif
( MimeUnrender ct a, BuildHeadersTo ls
) => HasClient (Patch (ct ': cts) (Headers ls a)) where
type Client (Patch (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a)
type Client (Patch (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
clientWithRoute Proxy req baseurl = do
(hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200, 201, 204] baseurl
return $ Headers { getResponse = resp
@ -378,7 +378,7 @@ instance
-- > myApi :: Proxy MyApi
-- > myApi = Proxy
-- >
-- > getBooksBy :: Maybe Text -> EitherT String IO [Book]
-- > getBooksBy :: Maybe Text -> ExceptT String IO [Book]
-- > getBooksBy = client myApi host
-- > where host = BaseUrl Http "localhost" 8080
-- > -- then you can just use "getBooksBy" to query that endpoint.
@ -424,7 +424,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
-- > myApi :: Proxy MyApi
-- > myApi = Proxy
-- >
-- > getBooksBy :: [Text] -> EitherT String IO [Book]
-- > getBooksBy :: [Text] -> ExceptT String IO [Book]
-- > getBooksBy = client myApi host
-- > where host = BaseUrl Http "localhost" 8080
-- > -- then you can just use "getBooksBy" to query that endpoint.
@ -465,7 +465,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
-- > myApi :: Proxy MyApi
-- > myApi = Proxy
-- >
-- > getBooks :: Bool -> EitherT String IO [Book]
-- > getBooks :: Bool -> ExceptT String IO [Book]
-- > getBooks = client myApi host
-- > where host = BaseUrl Http "localhost" 8080
-- > -- then you can just use "getBooks" to query that endpoint.
@ -507,7 +507,7 @@ instance (KnownSymbol sym, HasClient sublayout)
-- > myApi :: Proxy MyApi
-- > myApi = Proxy
-- >
-- > getBooksBy :: Maybe Text -> EitherT String IO [Book]
-- > getBooksBy :: Maybe Text -> ExceptT String IO [Book]
-- > getBooksBy = client myApi host
-- > where host = BaseUrl Http "localhost" 8080
-- > -- then you can just use "getBooksBy" to query that endpoint.
@ -552,7 +552,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
-- > myApi :: Proxy MyApi
-- > myApi = Proxy
-- >
-- > getBooksBy :: [Text] -> EitherT String IO [Book]
-- > getBooksBy :: [Text] -> ExceptT String IO [Book]
-- > getBooksBy = client myApi host
-- > where host = BaseUrl Http "localhost" 8080
-- > -- then you can just use "getBooksBy" to query that endpoint.
@ -593,7 +593,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
-- > myApi :: Proxy MyApi
-- > myApi = Proxy
-- >
-- > getBooks :: Bool -> EitherT String IO [Book]
-- > getBooks :: Bool -> ExceptT String IO [Book]
-- > getBooks = client myApi host
-- > where host = BaseUrl Http "localhost" 8080
-- > -- then you can just use "getBooks" to query that endpoint.
@ -618,7 +618,7 @@ instance (KnownSymbol sym, HasClient sublayout)
-- | Pick a 'Method' and specify where the server you want to query is. You get
-- back the full `Response`.
instance HasClient Raw where
type Client Raw = H.Method -> EitherT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
type Client Raw = H.Method -> ExceptT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
clientWithRoute :: Proxy Raw -> Req -> BaseUrl -> Client Raw
clientWithRoute Proxy req baseurl httpMethod = do
@ -639,7 +639,7 @@ instance HasClient Raw where
-- > myApi :: Proxy MyApi
-- > myApi = Proxy
-- >
-- > addBook :: Book -> EitherT String IO Book
-- > addBook :: Book -> ExceptT String IO Book
-- > addBook = client myApi host
-- > where host = BaseUrl Http "localhost" 8080
-- > -- then you can just use "addBook" to query that endpoint

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

@ -11,7 +11,7 @@ import Control.Exception
import Control.Monad
import Control.Monad.Catch (MonadThrow)
import Control.Monad.IO.Class
import Control.Monad.Trans.Either
import Control.Monad.Trans.Except
import Data.ByteString.Lazy hiding (pack, filter, map, null, elem)
import Data.IORef
import Data.String
@ -142,7 +142,7 @@ displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"
performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl
-> EitherT ServantError IO ( Int, ByteString, MediaType
-> ExceptT ServantError IO ( Int, ByteString, MediaType
, [HTTP.Header], Response ByteString)
performRequest reqMethod req isWantedStatus reqHost = do
partialRequest <- liftIO $ reqToRequest req reqHost
@ -156,7 +156,7 @@ performRequest reqMethod req isWantedStatus reqHost = do
Client.httpLbs request manager
case eResponse of
Left err ->
left . ConnectionError $ SomeException err
throwE . ConnectionError $ SomeException err
Right response -> do
let status = Client.responseStatus response
@ -166,25 +166,25 @@ performRequest reqMethod req isWantedStatus reqHost = do
ct <- case lookup "Content-Type" $ Client.responseHeaders response of
Nothing -> pure $ "application"//"octet-stream"
Just t -> case parseAccept t of
Nothing -> left $ InvalidContentTypeHeader (cs t) body
Nothing -> throwE $ InvalidContentTypeHeader (cs t) body
Just t' -> pure t'
unless (isWantedStatus status_code) $
left $ FailureResponse status ct body
throwE $ FailureResponse status ct body
return (status_code, body, ct, hrds, response)
performRequestCT :: MimeUnrender ct result =>
Proxy ct -> Method -> Req -> [Int] -> BaseUrl -> EitherT ServantError IO ([HTTP.Header], result)
Proxy ct -> Method -> Req -> [Int] -> BaseUrl -> ExceptT ServantError IO ([HTTP.Header], result)
performRequestCT ct reqMethod req wantedStatus reqHost = do
let acceptCT = contentType ct
(_status, respBody, respCT, hrds, _response) <-
performRequest reqMethod (req { reqAccept = [acceptCT] }) (`elem` wantedStatus) reqHost
unless (matches respCT (acceptCT)) $ left $ UnsupportedContentType respCT respBody
unless (matches respCT (acceptCT)) $ throwE $ UnsupportedContentType respCT respBody
case mimeUnrender ct respBody of
Left err -> left $ DecodeFailure err respCT respBody
Left err -> throwE $ DecodeFailure err respCT respBody
Right val -> return (hrds, val)
performRequestNoBody :: Method -> Req -> [Int] -> BaseUrl -> EitherT ServantError IO ()
performRequestNoBody :: Method -> Req -> [Int] -> BaseUrl -> ExceptT ServantError IO ()
performRequestNoBody reqMethod req wantedStatus reqHost = do
_ <- performRequest reqMethod req (`elem` wantedStatus) reqHost
return ()

110
servant-client/test/Servant/ClientSpec.hs
View file

@ -15,10 +15,10 @@ module Servant.ClientSpec where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import qualified Control.Arrow as Arrow
import Control.Arrow (left)
import Control.Concurrent
import Control.Exception
import Control.Monad.Trans.Either
import Control.Monad.Trans.Except
import Data.Aeson
import Data.ByteString.Lazy (ByteString)
import Data.Char
@ -105,14 +105,14 @@ server = serve api (
:<|> return
:<|> (\ name -> case name of
Just "alice" -> return alice
Just name -> left $ ServantErr 400 (name ++ " not found") "" []
Nothing -> left $ ServantErr 400 "missing parameter" "" [])
Just name -> throwE $ ServantErr 400 (name ++ " not found") "" []
Nothing -> throwE $ ServantErr 400 "missing parameter" "" [])
:<|> (\ names -> return (zipWith Person names [0..]))
:<|> return
:<|> (\ name -> case name of
Just "alice" -> return alice
Just name -> left $ ServantErr 400 (name ++ " not found") "" []
Nothing -> left $ ServantErr 400 "missing parameter" "" [])
Just name -> throwE $ ServantErr 400 (name ++ " not found") "" []
Nothing -> throwE $ ServantErr 400 "missing parameter" "" [])
:<|> (\ names -> return (zipWith Person names [0..]))
:<|> return
:<|> (\ _request respond -> respond $ responseLBS ok200 [] "rawSuccess")
@ -144,21 +144,21 @@ withFailServer action = withWaiDaemon (return failServer) action
spec :: IO ()
spec = withServer $ \ baseUrl -> do
let getGet :: EitherT ServantError IO Person
getDeleteEmpty :: EitherT ServantError IO ()
getCapture :: String -> EitherT ServantError IO Person
getBody :: Person -> EitherT ServantError IO Person
getQueryParam :: Maybe String -> EitherT ServantError IO Person
getQueryParams :: [String] -> EitherT ServantError IO [Person]
getQueryFlag :: Bool -> EitherT ServantError IO Bool
getMatrixParam :: Maybe String -> EitherT ServantError IO Person
getMatrixParams :: [String] -> EitherT ServantError IO [Person]
getMatrixFlag :: Bool -> EitherT ServantError IO Bool
getRawSuccess :: Method -> EitherT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], C.Response ByteString)
getRawFailure :: Method -> EitherT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], C.Response ByteString)
getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])] -> EitherT ServantError IO (String, Maybe Int, Bool, [(String, [Rational])])
getRespHeaders :: EitherT ServantError IO (Headers TestHeaders Bool)
getDeleteContentType :: EitherT ServantError IO ()
let getGet :: ExceptT ServantError IO Person
getDeleteEmpty :: ExceptT ServantError IO ()
getCapture :: String -> ExceptT ServantError IO Person
getBody :: Person -> ExceptT ServantError IO Person
getQueryParam :: Maybe String -> ExceptT ServantError IO Person
getQueryParams :: [String] -> ExceptT ServantError IO [Person]
getQueryFlag :: Bool -> ExceptT ServantError IO Bool
getMatrixParam :: Maybe String -> ExceptT ServantError IO Person
getMatrixParams :: [String] -> ExceptT ServantError IO [Person]
getMatrixFlag :: Bool -> ExceptT ServantError IO Bool
getRawSuccess :: Method -> ExceptT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], C.Response ByteString)
getRawFailure :: Method -> ExceptT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], C.Response ByteString)
getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])] -> ExceptT ServantError IO (String, Maybe Int, Bool, [(String, [Rational])])
getRespHeaders :: ExceptT ServantError IO (Headers TestHeaders Bool)
getDeleteContentType :: ExceptT ServantError IO ()
( getGet
:<|> getDeleteEmpty
:<|> getCapture
@ -178,54 +178,54 @@ spec = withServer $ \ baseUrl -> do
hspec $ do
it "Servant.API.Get" $ do
(Arrow.left show <$> runEitherT getGet) `shouldReturn` Right alice
(left show <$> runExceptT getGet) `shouldReturn` Right alice
describe "Servant.API.Delete" $ do
it "allows empty content type" $ do
(Arrow.left show <$> runEitherT getDeleteEmpty) `shouldReturn` Right ()
(left show <$> runExceptT getDeleteEmpty) `shouldReturn` Right ()
it "allows content type" $ do
(Arrow.left show <$> runEitherT getDeleteContentType) `shouldReturn` Right ()
(left show <$> runExceptT getDeleteContentType) `shouldReturn` Right ()
it "Servant.API.Capture" $ do
(Arrow.left show <$> runEitherT (getCapture "Paula")) `shouldReturn` Right (Person "Paula" 0)
(left show <$> runExceptT (getCapture "Paula")) `shouldReturn` Right (Person "Paula" 0)
it "Servant.API.ReqBody" $ do
let p = Person "Clara" 42
(Arrow.left show <$> runEitherT (getBody p)) `shouldReturn` Right p
(left show <$> runExceptT (getBody p)) `shouldReturn` Right p
it "Servant.API.QueryParam" $ do
Arrow.left show <$> runEitherT (getQueryParam (Just "alice")) `shouldReturn` Right alice
Left FailureResponse{..} <- runEitherT (getQueryParam (Just "bob"))
left show <$> runExceptT (getQueryParam (Just "alice")) `shouldReturn` Right alice
Left FailureResponse{..} <- runExceptT (getQueryParam (Just "bob"))
responseStatus `shouldBe` Status 400 "bob not found"
it "Servant.API.QueryParam.QueryParams" $ do
(Arrow.left show <$> runEitherT (getQueryParams [])) `shouldReturn` Right []
(Arrow.left show <$> runEitherT (getQueryParams ["alice", "bob"]))
(left show <$> runExceptT (getQueryParams [])) `shouldReturn` Right []
(left show <$> runExceptT (getQueryParams ["alice", "bob"]))
`shouldReturn` Right [Person "alice" 0, Person "bob" 1]
context "Servant.API.QueryParam.QueryFlag" $
forM_ [False, True] $ \ flag ->
it (show flag) $ do
(Arrow.left show <$> runEitherT (getQueryFlag flag)) `shouldReturn` Right flag
(left show <$> runExceptT (getQueryFlag flag)) `shouldReturn` Right flag
it "Servant.API.MatrixParam" $ do
Arrow.left show <$> runEitherT (getMatrixParam (Just "alice")) `shouldReturn` Right alice
Left FailureResponse{..} <- runEitherT (getMatrixParam (Just "bob"))
left show <$> runExceptT (getMatrixParam (Just "alice")) `shouldReturn` Right alice
Left FailureResponse{..} <- runExceptT (getMatrixParam (Just "bob"))
responseStatus `shouldBe` Status 400 "bob not found"
it "Servant.API.MatrixParam.MatrixParams" $ do
Arrow.left show <$> runEitherT (getMatrixParams []) `shouldReturn` Right []
Arrow.left show <$> runEitherT (getMatrixParams ["alice", "bob"])
left show <$> runExceptT (getMatrixParams []) `shouldReturn` Right []
left show <$> runExceptT (getMatrixParams ["alice", "bob"])
`shouldReturn` Right [Person "alice" 0, Person "bob" 1]
context "Servant.API.MatrixParam.MatrixFlag" $
forM_ [False, True] $ \ flag ->
it (show flag) $ do
Arrow.left show <$> runEitherT (getMatrixFlag flag) `shouldReturn` Right flag
left show <$> runExceptT (getMatrixFlag flag) `shouldReturn` Right flag
it "Servant.API.Raw on success" $ do
res <- runEitherT (getRawSuccess methodGet)
res <- runExceptT (getRawSuccess methodGet)
case res of
Left e -> assertFailure $ show e
Right (code, body, ct, _, response) -> do
@ -234,7 +234,7 @@ spec = withServer $ \ baseUrl -> do
C.responseStatus response `shouldBe` ok200
it "Servant.API.Raw on failure" $ do
res <- runEitherT (getRawFailure methodGet)
res <- runExceptT (getRawFailure methodGet)
case res of
Left e -> assertFailure $ show e
Right (code, body, ct, _, response) -> do
@ -243,7 +243,7 @@ spec = withServer $ \ baseUrl -> do
C.responseStatus response `shouldBe` badRequest400
it "Returns headers appropriately" $ withServer $ \ _ -> do
res <- runEitherT getRespHeaders
res <- runExceptT getRespHeaders
case res of
Left e -> assertFailure $ show e
Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]
@ -252,7 +252,7 @@ spec = withServer $ \ baseUrl -> do
it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $
property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->
ioProperty $ do
result <- Arrow.left show <$> runEitherT (getMultiple cap num flag body)
result <- left show <$> runExceptT (getMultiple cap num flag body)
return $
result === Right (cap, num, flag, body)
@ -261,11 +261,11 @@ spec = withServer $ \ baseUrl -> do
let test :: (WrappedApi, String) -> Spec
test (WrappedApi api, desc) =
it desc $
withWaiDaemon (return (serve api (left $ ServantErr 500 "error message" "" []))) $
withWaiDaemon (return (serve api (throwE $ ServantErr 500 "error message" "" []))) $
\ host -> do
let getResponse :: EitherT ServantError IO ()
let getResponse :: ExceptT ServantError IO ()
getResponse = client api host
Left FailureResponse{..} <- runEitherT getResponse
Left FailureResponse{..} <- runExceptT getResponse
responseStatus `shouldBe` (Status 500 "error message")
mapM_ test $
(WrappedApi (Proxy :: Proxy (Delete '[JSON] ())), "Delete") :
@ -276,54 +276,54 @@ spec = withServer $ \ baseUrl -> do
failSpec :: IO ()
failSpec = withFailServer $ \ baseUrl -> do
let getGet :: EitherT ServantError IO Person
getDeleteEmpty :: EitherT ServantError IO ()
getCapture :: String -> EitherT ServantError IO Person
getBody :: Person -> EitherT ServantError IO Person
let getGet :: ExceptT ServantError IO Person
getDeleteEmpty :: ExceptT ServantError IO ()
getCapture :: String -> ExceptT ServantError IO Person
getBody :: Person -> ExceptT ServantError IO Person
( getGet
:<|> getDeleteEmpty
:<|> getCapture
:<|> getBody
:<|> _ )
= client api baseUrl
getGetWrongHost :: EitherT ServantError IO Person
getGetWrongHost :: ExceptT ServantError IO Person
(getGetWrongHost :<|> _) = client api (BaseUrl Http "127.0.0.1" 19872 "")
hspec $ do
context "client returns errors appropriately" $ do
it "reports FailureResponse" $ do
Left res <- runEitherT getDeleteEmpty
Left res <- runExceptT getDeleteEmpty
case res of
FailureResponse (Status 404 "Not Found") _ _ -> return ()
_ -> fail $ "expected 404 response, but got " <> show res
it "reports DecodeFailure" $ do
Left res <- runEitherT (getCapture "foo")
Left res <- runExceptT (getCapture "foo")
case res of
DecodeFailure _ ("application/json") _ -> return ()
_ -> fail $ "expected DecodeFailure, but got " <> show res
it "reports ConnectionError" $ do
Left res <- runEitherT getGetWrongHost
Left res <- runExceptT getGetWrongHost
case res of
ConnectionError _ -> return ()
_ -> fail $ "expected ConnectionError, but got " <> show res
it "reports UnsupportedContentType" $ do
Left res <- runEitherT getGet
Left res <- runExceptT getGet
case res of
UnsupportedContentType ("application/octet-stream") _ -> return ()
_ -> fail $ "expected UnsupportedContentType, but got " <> show res
it "reports InvalidContentTypeHeader" $ do
Left res <- runEitherT (getBody alice)
Left res <- runExceptT (getBody alice)
case res of
InvalidContentTypeHeader "fooooo" _ -> return ()
_ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res
data WrappedApi where
WrappedApi :: (HasServer api, Server api ~ EitherT ServantErr IO a,
HasClient api, Client api ~ EitherT ServantError IO ()) =>
WrappedApi :: (HasServer api, Server api ~ ExceptT ServantErr IO a,
HasClient api, Client api ~ ExceptT ServantError IO ()) =>
Proxy api -> WrappedApi

10
servant-examples/hackage/hackage.hs
View file

@ -5,7 +5,7 @@
import Control.Applicative
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Either
import Control.Monad.Trans.Except
import Data.Aeson
import Data.Monoid
import Data.Proxy
@ -54,16 +54,16 @@ instance FromJSON Package
hackageAPI :: Proxy HackageAPI
hackageAPI = Proxy
getUsers :: EitherT ServantError IO [UserSummary]
getUser :: Username -> EitherT ServantError IO UserDetailed
getPackages :: EitherT ServantError IO [Package]
getUsers :: ExceptT ServantError IO [UserSummary]
getUser :: Username -> ExceptT ServantError IO UserDetailed
getPackages :: ExceptT ServantError IO [Package]
getUsers :<|> getUser :<|> getPackages = client hackageAPI $ BaseUrl Http "hackage.haskell.org" 80 ""
main :: IO ()
main = print =<< uselessNumbers
uselessNumbers :: IO (Either ServantError ())
uselessNumbers = runEitherT $ do
uselessNumbers = runExceptT $ do
users <- getUsers
liftIO . putStrLn $ show (length users) ++ " users"

4
servant-examples/servant-examples.cabal
View file

@ -25,7 +25,6 @@ executable tutorial
, base >= 4.7 && < 5
, bytestring
, directory
, either
, http-types
, js-jquery
, lucid
@ -50,10 +49,10 @@ executable t8-main
build-depends:
aeson
, base >= 4.7 && < 5
, either
, servant == 0.5.*
, servant-client == 0.5.*
, servant-server == 0.5.*
, transformers
, wai
executable hackage
@ -61,7 +60,6 @@ executable hackage
build-depends:
aeson >= 0.8
, base >=4.7 && < 5
, either
, servant == 0.5.*
, servant-client == 0.5.*
, text

8
servant-examples/tutorial/T3.hs
View file

@ -4,7 +4,7 @@
{-# LANGUAGE TypeOperators #-}
module T3 where
import Control.Monad.Trans.Either
import Control.Monad.Trans.Except
import Data.Aeson
import Data.List
import GHC.Generics
@ -69,15 +69,15 @@ server = position
:<|> hello
:<|> marketing
where position :: Int -> Int -> EitherT ServantErr IO Position
where position :: Int -> Int -> ExceptT ServantErr IO Position
position x y = return (Position x y)
hello :: Maybe String -> EitherT ServantErr IO HelloMessage
hello :: Maybe String -> ExceptT ServantErr IO HelloMessage
hello mname = return . HelloMessage $ case mname of
Nothing -> "Hello, anonymous coward"
Just n -> "Hello, " ++ n
marketing :: ClientInfo -> EitherT ServantErr IO Email
marketing :: ClientInfo -> ExceptT ServantErr IO Email
marketing clientinfo = return (emailForClient clientinfo)
app :: Application

4
servant-examples/tutorial/T5.hs
View file

@ -6,7 +6,7 @@
module T5 where
import Control.Monad.IO.Class
import Control.Monad.Trans.Either
import Control.Monad.Trans.Except
import Data.Aeson
import GHC.Generics
import Network.Wai
@ -29,7 +29,7 @@ server = do
exists <- liftIO (doesFileExist "myfile.txt")
if exists
then liftIO (readFile "myfile.txt") >>= return . FileContent
else left custom404Err
else throwE custom404Err
where custom404Err = err404 { errBody = "myfile.txt just isn't there, please leave this server alone." }

4
servant-examples/tutorial/T7.hs
View file

@ -3,7 +3,7 @@
{-# LANGUAGE TypeOperators #-}
module T7 where
import Control.Monad.Trans.Either
import Control.Monad.Trans.Except
import Control.Monad.Trans.Reader
import Network.Wai
import Servant
@ -26,7 +26,7 @@ readerServerT = a :<|> b
readerServer :: Server ReaderAPI
readerServer = enter readerToEither readerServerT
where readerToEither :: Reader String :~> EitherT ServantErr IO
where readerToEither :: Reader String :~> ExceptT ServantErr IO
readerToEither = Nat $ \r -> return (runReader r "hi")
app :: Application

12
servant-examples/tutorial/T8.hs
View file

@ -3,7 +3,7 @@
{-# LANGUAGE TypeOperators #-}
module T8 where
import Control.Monad.Trans.Either
import Control.Monad.Trans.Except
import Data.Aeson
import Servant
import Servant.Client
@ -12,20 +12,20 @@ import T3
position :: Int -- ^ value for "x"
-> Int -- ^ value for "y"
-> EitherT ServantError IO Position
-> ExceptT ServantError IO Position
hello :: Maybe String -- ^ an optional value for "name"
-> EitherT ServantError IO HelloMessage
-> ExceptT ServantError IO HelloMessage
marketing :: ClientInfo -- ^ value for the request body
-> EitherT ServantError IO Email
-> ExceptT ServantError IO Email
position :<|> hello :<|> marketing = client api baseUrl
baseUrl :: BaseUrl
baseUrl = BaseUrl Http "localhost" 8081 ""
queries :: EitherT ServantError IO (Position, HelloMessage, Email)
queries :: ExceptT ServantError IO (Position, HelloMessage, Email)
queries = do
pos <- position 10 10
msg <- hello (Just "servant")
@ -34,7 +34,7 @@ queries = do
run :: IO ()
run = do
res <- runEitherT queries
res <- runExceptT queries
case res of
Left err -> putStrLn $ "Error: " ++ show err
Right (pos, msg, em) -> do

4
servant-mock/src/Servant/Mock.hs
View file

@ -91,8 +91,8 @@ class HasServer api => HasMock api where
-- actually "means" 2 request handlers, of the following types:
--
-- @
-- getUser :: EitherT ServantErr IO User
-- getBook :: EitherT ServantErr IO Book
-- getUser :: ExceptT ServantErr IO User
-- getBook :: ExceptT ServantErr IO Book
-- @
--
-- So under the hood, 'mock' uses the 'IO' bit to generate

1
servant-server/CHANGELOG.md
View file

@ -2,6 +2,7 @@ HEAD
----
* Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators
* Drop `EitherT` in favor of `ExceptT`
0.4.1
-----

2
servant-server/example/greet.hs
View file

@ -44,7 +44,7 @@ testApi = Proxy
-- There's one handler per endpoint, which, just like in the type
-- that represents the API, are glued together using :<|>.
--
-- Each handler runs in the 'EitherT ServantErr IO' monad.
-- Each handler runs in the 'ExceptT ServantErr IO' monad.
server :: Server TestApi
server = helloH :<|> postGreetH :<|> deleteGreetH

2
servant-server/servant-server.cabal
View file

@ -48,7 +48,6 @@ library
, attoparsec >= 0.12 && < 0.14
, bytestring >= 0.10 && < 0.11
, containers >= 0.5 && < 0.6
, either >= 4.3 && < 4.5
, http-types >= 0.8 && < 0.9
, network-uri >= 2.6 && < 2.7
, mtl >= 2 && < 3
@ -97,7 +96,6 @@ test-suite spec
, bytestring
, bytestring-conversion
, directory
, either
, exceptions
, hspec == 2.*
, hspec-wai

6
servant-server/src/Servant/Server.hs
View file

@ -1,4 +1,3 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
@ -29,9 +28,6 @@ module Servant.Server
, evalStateTSNat
, logWriterTLNat
, logWriterTSNat
#if MIN_VERSION_mtl(2,2,1)
, fromExceptT
#endif
-- ** Functions based on <https://hackage.haskell.org/package/mmorph mmorph>
, hoistNat
, embedNat
@ -113,7 +109,7 @@ serve p server = toApplication (runRouter (route p (return (RR (Right server))))
-- Documentation
-- $enterDoc
-- Sometimes our cherished `EitherT` monad isn't quite the type you'd like for
-- Sometimes our cherished `ExceptT` monad isn't quite the type you'd like for
-- your handlers. Maybe you want to thread some configuration in a @Reader@
-- monad. Or have your types ensure that your handlers don't do any IO. Enter
-- `enter`.

48
servant-server/src/Servant/Server/Internal.hs
View file

@ -23,7 +23,7 @@ module Servant.Server.Internal
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Control.Monad.Trans.Either (EitherT)
import Control.Monad.Trans.Except (ExceptT)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.Map as M
@ -65,7 +65,7 @@ class HasServer layout where
route :: Proxy layout -> IO (RouteResult (Server layout)) -> Router
type Server layout = ServerT layout (EitherT ServantErr IO)
type Server layout = ServerT layout (ExceptT ServantErr IO)
-- * Instances
@ -107,7 +107,7 @@ captured _ = fromText
-- >
-- > server :: Server MyApi
-- > server = getBook
-- > where getBook :: Text -> EitherT ServantErr IO Book
-- > where getBook :: Text -> ExceptT ServantErr IO Book
-- > getBook isbn = ...
instance (KnownSymbol capture, FromText a, HasServer sublayout)
=> HasServer (Capture capture a :> sublayout) where
@ -142,7 +142,7 @@ processMethodRouter handleA status method headers request = case handleA of
methodRouter :: (AllCTRender ctypes a)
=> Method -> Proxy ctypes -> Status
-> IO (RouteResult (EitherT ServantErr IO a))
-> IO (RouteResult (ExceptT ServantErr IO a))
-> Router
methodRouter method proxy status action = LeafRouter route'
where
@ -158,7 +158,7 @@ methodRouter method proxy status action = LeafRouter route'
methodRouterHeaders :: (GetHeaders (Headers h v), AllCTRender ctypes v)
=> Method -> Proxy ctypes -> Status
-> IO (RouteResult (EitherT ServantErr IO (Headers h v)))
-> IO (RouteResult (ExceptT ServantErr IO (Headers h v)))
-> Router
methodRouterHeaders method proxy status action = LeafRouter route'
where
@ -174,7 +174,7 @@ methodRouterHeaders method proxy status action = LeafRouter route'
| otherwise = respond $ failWith NotFound
methodRouterEmpty :: Method
-> IO (RouteResult (EitherT ServantErr IO ()))
-> IO (RouteResult (ExceptT ServantErr IO ()))
-> Router
methodRouterEmpty method action = LeafRouter route'
where
@ -192,9 +192,9 @@ methodRouterEmpty method action = LeafRouter route'
--
-- The code of the handler will, just like
-- for 'Servant.API.Get.Get', 'Servant.API.Post.Post' and
-- 'Servant.API.Put.Put', run in @EitherT ServantErr IO ()@.
-- 'Servant.API.Put.Put', run in @ExceptT ServantErr IO ()@.
-- The 'Int' represents the status code and the 'String' a message
-- to be returned. You can use 'Control.Monad.Trans.Either.left' to
-- to be returned. You can use 'Control.Monad.Trans.Except.throwE' to
-- painlessly error out if the conditions for a successful deletion
-- are not met.
instance
@ -233,9 +233,9 @@ instance
-- | When implementing the handler for a 'Get' endpoint,
-- just like for 'Servant.API.Delete.Delete', 'Servant.API.Post.Post'
-- and 'Servant.API.Put.Put', the handler code runs in the
-- @EitherT ServantErr IO@ monad, where the 'Int' represents
-- @ExceptT ServantErr IO@ monad, where the 'Int' represents
-- the status code and the 'String' a message, returned in case of
-- failure. You can quite handily use 'Control.Monad.Trans.EitherT.left'
-- failure. You can quite handily use 'Control.Monad.Trans.Except.throwE'
-- to quickly fail if some conditions are not met.
--
-- If successfully returning a value, we use the type-level list, combined
@ -294,7 +294,7 @@ instance
-- >
-- > server :: Server MyApi
-- > server = viewReferer
-- > where viewReferer :: Referer -> EitherT ServantErr IO referer
-- > where viewReferer :: Referer -> ExceptT ServantErr IO referer
-- > viewReferer referer = return referer
instance (KnownSymbol sym, FromText a, HasServer sublayout)
=> HasServer (Header sym a :> sublayout) where
@ -310,9 +310,9 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
-- | When implementing the handler for a 'Post' endpoint,
-- just like for 'Servant.API.Delete.Delete', 'Servant.API.Get.Get'
-- and 'Servant.API.Put.Put', the handler code runs in the
-- @EitherT ServantErr IO@ monad, where the 'Int' represents
-- @ExceptT ServantErr IO@ monad, where the 'Int' represents
-- the status code and the 'String' a message, returned in case of
-- failure. You can quite handily use 'Control.Monad.Trans.EitherT.left'
-- failure. You can quite handily use 'Control.Monad.Trans.Except.throwE'
-- to quickly fail if some conditions are not met.
--
-- If successfully returning a value, we use the type-level list, combined
@ -356,9 +356,9 @@ instance
-- | When implementing the handler for a 'Put' endpoint,
-- just like for 'Servant.API.Delete.Delete', 'Servant.API.Get.Get'
-- and 'Servant.API.Post.Post', the handler code runs in the
-- @EitherT ServantErr IO@ monad, where the 'Int' represents
-- @ExceptT ServantErr IO@ monad, where the 'Int' represents
-- the status code and the 'String' a message, returned in case of
-- failure. You can quite handily use 'Control.Monad.Trans.EitherT.left'
-- failure. You can quite handily use 'Control.Monad.Trans.Except.throwE'
-- to quickly fail if some conditions are not met.
--
-- If successfully returning a value, we use the type-level list, combined
@ -401,9 +401,9 @@ instance
-- | When implementing the handler for a 'Patch' endpoint,
-- just like for 'Servant.API.Delete.Delete', 'Servant.API.Get.Get'
-- and 'Servant.API.Put.Put', the handler code runs in the
-- @EitherT ServantErr IO@ monad, where the 'Int' represents
-- @ExceptT ServantErr IO@ monad, where the 'Int' represents
-- the status code and the 'String' a message, returned in case of
-- failure. You can quite handily use 'Control.Monad.Trans.EitherT.left'
-- failure. You can quite handily use 'Control.Monad.Trans.Except.throwE'
-- to quickly fail if some conditions are not met.
--
-- If successfully returning a value, we just require that its type has
@ -459,7 +459,7 @@ instance
-- >
-- > server :: Server MyApi
-- > server = getBooksBy
-- > where getBooksBy :: Maybe Text -> EitherT ServantErr IO [Book]
-- > where getBooksBy :: Maybe Text -> ExceptT ServantErr IO [Book]
-- > getBooksBy Nothing = ...return all books...
-- > getBooksBy (Just author) = ...return books by the given author...
instance (KnownSymbol sym, FromText a, HasServer sublayout)
@ -496,7 +496,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
-- >
-- > server :: Server MyApi
-- > server = getBooksBy
-- > where getBooksBy :: [Text] -> EitherT ServantErr IO [Book]
-- > where getBooksBy :: [Text] -> ExceptT ServantErr IO [Book]
-- > getBooksBy authors = ...return all books by these authors...
instance (KnownSymbol sym, FromText a, HasServer sublayout)
=> HasServer (QueryParams sym a :> sublayout) where
@ -527,7 +527,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
-- >
-- > server :: Server MyApi
-- > server = getBooks
-- > where getBooks :: Bool -> EitherT ServantErr IO [Book]
-- > where getBooks :: Bool -> ExceptT ServantErr IO [Book]
-- > getBooks onlyPublished = ...return all books, or only the ones that are already published, depending on the argument...
instance (KnownSymbol sym, HasServer sublayout)
=> HasServer (QueryFlag sym :> sublayout) where
@ -567,7 +567,7 @@ parseMatrixText = parseQueryText
-- >
-- > server :: Server MyApi
-- > server = getBooksBy
-- > where getBooksBy :: Maybe Text -> EitherT ServantErr IO [Book]
-- > where getBooksBy :: Maybe Text -> ExceptT ServantErr IO [Book]
-- > getBooksBy Nothing = ...return all books...
-- > getBooksBy (Just author) = ...return books by the given author...
instance (KnownSymbol sym, FromText a, HasServer sublayout)
@ -607,7 +607,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
-- >
-- > server :: Server MyApi
-- > server = getBooksBy
-- > where getBooksBy :: [Text] -> EitherT ServantErr IO [Book]
-- > where getBooksBy :: [Text] -> ExceptT ServantErr IO [Book]
-- > getBooksBy authors = ...return all books by these authors...
instance (KnownSymbol sym, FromText a, HasServer sublayout)
=> HasServer (MatrixParams sym a :> sublayout) where
@ -641,7 +641,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
-- >
-- > server :: Server MyApi
-- > server = getBooks
-- > where getBooks :: Bool -> EitherT ServantErr IO [Book]
-- > where getBooks :: Bool -> ExceptT ServantErr IO [Book]
-- > getBooks onlyPublished = ...return all books, or only the ones that are already published, depending on the argument...
instance (KnownSymbol sym, HasServer sublayout)
=> HasServer (MatrixFlag sym :> sublayout) where
@ -699,7 +699,7 @@ instance HasServer Raw where
-- >
-- > server :: Server MyApi
-- > server = postBook
-- > where postBook :: Book -> EitherT ServantErr IO Book
-- > where postBook :: Book -> ExceptT ServantErr IO Book
-- > postBook book = ...insert into your db...
instance ( AllCTUnrender list a, HasServer sublayout
) => HasServer (ReqBody list a :> sublayout) where

8
servant-server/src/Servant/Server/Internal/Enter.hs
View file

@ -22,9 +22,6 @@ import Control.Monad.Morph
import Control.Monad.Reader
import qualified Control.Monad.State.Lazy as LState
import qualified Control.Monad.State.Strict as SState
#if MIN_VERSION_mtl(2,2,1)
import Control.Monad.Trans.Either
#endif
import qualified Control.Monad.Writer.Lazy as LWriter
import qualified Control.Monad.Writer.Strict as SWriter
import Data.Typeable
@ -83,11 +80,6 @@ logWriterTLNat logger = Nat $ \x -> do
liftIO $ logger w
return a
#if MIN_VERSION_mtl(2,2,1)
fromExceptT :: ExceptT e m :~> EitherT e m
fromExceptT = Nat $ \x -> EitherT $ runExceptT x
#endif
-- | Like @mmorph@'s `hoist`.
hoistNat :: (MFunctor t, Monad m) => (m :~> n) -> (t m :~> t n)
hoistNat (Nat n) = Nat $ hoist n

6
servant-server/src/Servant/Server/Internal/RoutingApplication.hs
View file

@ -8,7 +8,7 @@ module Servant.Server.Internal.RoutingApplication where
import Control.Applicative (Applicative, (<$>))
import Data.Monoid (Monoid, mappend, mempty)
#endif
import Control.Monad.Trans.Either (EitherT, runEitherT)
import Control.Monad.Trans.Except (ExceptT, runExceptT)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.IORef (newIORef, readIORef,
@ -107,7 +107,7 @@ toApplication ra request respond = do
routingRespond (Right response) =
respond response
runAction :: IO (RouteResult (EitherT ServantErr IO a))
runAction :: IO (RouteResult (ExceptT ServantErr IO a))
-> (RouteResult Response -> IO r)
-> (a -> RouteResult Response)
-> IO r
@ -116,7 +116,7 @@ runAction action respond k = do
go r
where
go (RR (Right a)) = do
e <- runEitherT a
e <- runExceptT a
respond $ case e of
Right x -> k x
Left err -> succeedWith $ responseServantErr err

4
servant-server/test/Servant/Server/Internal/EnterSpec.hs
View file

@ -5,7 +5,7 @@ module Servant.Server.Internal.EnterSpec where
import qualified Control.Category as C
import Control.Monad.Reader
import Control.Monad.Trans.Either
import Control.Monad.Trans.Except
import Data.Proxy
import Servant.API
import Servant.Server
@ -34,7 +34,7 @@ combinedAPI = Proxy
readerServer' :: ServerT ReaderAPI (Reader String)
readerServer' = return 1797 :<|> ask
fReader :: Reader String :~> EitherT ServantErr IO
fReader :: Reader String :~> ExceptT ServantErr IO
fReader = generalizeNat C.. (runReaderTNat "hi")
readerServer :: Server ReaderAPI

10
servant-server/test/Servant/ServerSpec.hs
View file

@ -10,7 +10,7 @@ module Servant.ServerSpec where
import Control.Monad (forM_, when)
import Control.Monad.Trans.Either (EitherT, left)
import Control.Monad.Trans.Except (ExceptT, throwE)
import Data.Aeson (FromJSON, ToJSON, decode', encode)
import Data.ByteString.Conversion ()
import Data.Char (toUpper)
@ -99,11 +99,11 @@ spec = do
type CaptureApi = Capture "legs" Integer :> Get '[JSON] Animal
captureApi :: Proxy CaptureApi
captureApi = Proxy
captureServer :: Integer -> EitherT ServantErr IO Animal
captureServer :: Integer -> ExceptT ServantErr IO Animal
captureServer legs = case legs of
4 -> return jerry
2 -> return tweety
_ -> left err404
_ -> throwE err404
captureSpec :: Spec
captureSpec = do
@ -481,11 +481,11 @@ headerApi = Proxy
headerSpec :: Spec
headerSpec = describe "Servant.API.Header" $ do
let expectsInt :: Maybe Int -> EitherT ServantErr IO ()
let expectsInt :: Maybe Int -> ExceptT ServantErr IO ()
expectsInt (Just x) = when (x /= 5) $ error "Expected 5"
expectsInt Nothing = error "Expected an int"
let expectsString :: Maybe String -> EitherT ServantErr IO ()
let expectsString :: Maybe String -> ExceptT ServantErr IO ()
expectsString (Just x) = when (x /= "more from you") $ error "Expected more from you"
expectsString Nothing = error "Expected a string"

2
stack.yaml
View file

@ -14,4 +14,4 @@ packages:
- servant-server/
extra-deps:
- engine-io-wai-1.0.2
resolver: nightly-2015-09-05
resolver: nightly-2015-09-10