From f2f7b061d20dc85e3b647feb0d13ab35d1980f27 Mon Sep 17 00:00:00 2001 From: Index Int Date: Sat, 12 Sep 2015 15:11:24 +0300 Subject: [PATCH] Drop `EitherT` in favor of `ExceptT` --- servant-client/README.md | 4 +- servant-client/servant-client.cabal | 3 +- servant-client/src/Servant/Client.hs | 60 +++++----- servant-client/src/Servant/Common/Req.hs | 18 +-- servant-client/test/Servant/ClientSpec.hs | 112 +++++++++--------- servant-examples/hackage/hackage.hs | 10 +- servant-examples/servant-examples.cabal | 4 +- servant-examples/tutorial/T3.hs | 8 +- servant-examples/tutorial/T5.hs | 4 +- servant-examples/tutorial/T7.hs | 4 +- servant-examples/tutorial/T8.hs | 12 +- servant-mock/src/Servant/Mock.hs | 4 +- servant-server/CHANGELOG.md | 1 + servant-server/example/greet.hs | 2 +- servant-server/servant-server.cabal | 2 - servant-server/src/Servant/Server.hs | 6 +- servant-server/src/Servant/Server/Internal.hs | 48 ++++---- .../src/Servant/Server/Internal/Enter.hs | 8 -- .../Server/Internal/RoutingApplication.hs | 6 +- .../test/Servant/Server/Internal/EnterSpec.hs | 4 +- servant-server/test/Servant/ServerSpec.hs | 10 +- stack.yaml | 2 +- 22 files changed, 158 insertions(+), 174 deletions(-) diff --git a/servant-client/README.md b/servant-client/README.md index 6fa5a8c3..b1ef54b5 100644 --- a/servant-client/README.md +++ b/servant-client/README.md @@ -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 diff --git a/servant-client/servant-client.cabal b/servant-client/servant-client.cabal index 69237efc..685692bf 100644 --- a/servant-client/servant-client.cabal +++ b/servant-client/servant-client.cabal @@ -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 diff --git a/servant-client/src/Servant/Client.hs b/servant-client/src/Servant/Client.hs index 729d7a19..36f2ea8b 100644 --- a/servant-client/src/Servant/Client.hs +++ b/servant-client/src/Servant/Client.hs @@ -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 diff --git a/servant-client/src/Servant/Common/Req.hs b/servant-client/src/Servant/Common/Req.hs index 74a36526..55454620 100644 --- a/servant-client/src/Servant/Common/Req.hs +++ b/servant-client/src/Servant/Common/Req.hs @@ -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 () diff --git a/servant-client/test/Servant/ClientSpec.hs b/servant-client/test/Servant/ClientSpec.hs index 8bf70095..afee0481 100644 --- a/servant-client/test/Servant/ClientSpec.hs +++ b/servant-client/test/Servant/ClientSpec.hs @@ -13,12 +13,12 @@ module Servant.ClientSpec where #if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>)) +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 diff --git a/servant-examples/hackage/hackage.hs b/servant-examples/hackage/hackage.hs index f0fdc584..a559d85f 100644 --- a/servant-examples/hackage/hackage.hs +++ b/servant-examples/hackage/hackage.hs @@ -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" diff --git a/servant-examples/servant-examples.cabal b/servant-examples/servant-examples.cabal index a29ed7a2..3ff76755 100644 --- a/servant-examples/servant-examples.cabal +++ b/servant-examples/servant-examples.cabal @@ -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 diff --git a/servant-examples/tutorial/T3.hs b/servant-examples/tutorial/T3.hs index e8134fde..7b5bdeb3 100644 --- a/servant-examples/tutorial/T3.hs +++ b/servant-examples/tutorial/T3.hs @@ -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 diff --git a/servant-examples/tutorial/T5.hs b/servant-examples/tutorial/T5.hs index 326bd546..3b18aedb 100644 --- a/servant-examples/tutorial/T5.hs +++ b/servant-examples/tutorial/T5.hs @@ -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." } diff --git a/servant-examples/tutorial/T7.hs b/servant-examples/tutorial/T7.hs index 5dbaa1d9..e0145caf 100644 --- a/servant-examples/tutorial/T7.hs +++ b/servant-examples/tutorial/T7.hs @@ -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 diff --git a/servant-examples/tutorial/T8.hs b/servant-examples/tutorial/T8.hs index b57cc8e1..c0f8b691 100644 --- a/servant-examples/tutorial/T8.hs +++ b/servant-examples/tutorial/T8.hs @@ -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 diff --git a/servant-mock/src/Servant/Mock.hs b/servant-mock/src/Servant/Mock.hs index ddc836da..00f445b2 100644 --- a/servant-mock/src/Servant/Mock.hs +++ b/servant-mock/src/Servant/Mock.hs @@ -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 diff --git a/servant-server/CHANGELOG.md b/servant-server/CHANGELOG.md index f6122e63..bbc54235 100644 --- a/servant-server/CHANGELOG.md +++ b/servant-server/CHANGELOG.md @@ -2,6 +2,7 @@ HEAD ---- * Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators +* Drop `EitherT` in favor of `ExceptT` 0.4.1 ----- diff --git a/servant-server/example/greet.hs b/servant-server/example/greet.hs index 1d5603cc..3fda367d 100644 --- a/servant-server/example/greet.hs +++ b/servant-server/example/greet.hs @@ -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 diff --git a/servant-server/servant-server.cabal b/servant-server/servant-server.cabal index 786d0c87..0d26ac7b 100644 --- a/servant-server/servant-server.cabal +++ b/servant-server/servant-server.cabal @@ -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 diff --git a/servant-server/src/Servant/Server.hs b/servant-server/src/Servant/Server.hs index e560780b..58c34ea3 100644 --- a/servant-server/src/Servant/Server.hs +++ b/servant-server/src/Servant/Server.hs @@ -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 , 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`. diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index 2409ce6d..487911d5 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/servant-server/src/Servant/Server/Internal.hs @@ -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 diff --git a/servant-server/src/Servant/Server/Internal/Enter.hs b/servant-server/src/Servant/Server/Internal/Enter.hs index a8a904d6..5bcebe9d 100644 --- a/servant-server/src/Servant/Server/Internal/Enter.hs +++ b/servant-server/src/Servant/Server/Internal/Enter.hs @@ -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 diff --git a/servant-server/src/Servant/Server/Internal/RoutingApplication.hs b/servant-server/src/Servant/Server/Internal/RoutingApplication.hs index e1ab3546..117ac97c 100644 --- a/servant-server/src/Servant/Server/Internal/RoutingApplication.hs +++ b/servant-server/src/Servant/Server/Internal/RoutingApplication.hs @@ -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 diff --git a/servant-server/test/Servant/Server/Internal/EnterSpec.hs b/servant-server/test/Servant/Server/Internal/EnterSpec.hs index fbc33aa5..973e1f89 100644 --- a/servant-server/test/Servant/Server/Internal/EnterSpec.hs +++ b/servant-server/test/Servant/Server/Internal/EnterSpec.hs @@ -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 diff --git a/servant-server/test/Servant/ServerSpec.hs b/servant-server/test/Servant/ServerSpec.hs index 5a83dcd6..45519e42 100644 --- a/servant-server/test/Servant/ServerSpec.hs +++ b/servant-server/test/Servant/ServerSpec.hs @@ -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" diff --git a/stack.yaml b/stack.yaml index dbc27da4..8e1a6e18 100644 --- a/stack.yaml +++ b/stack.yaml @@ -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