servant-server 0.16.2 → 0.17
raw patch · 8 files changed
+237/−210 lines, 8 filesdep −doctestdep ~basedep ~hspec-waidep ~servantsetup-changed
Dependencies removed: doctest
Dependency ranges changed: base, hspec-wai, servant
Files
- CHANGELOG.md +45/−0
- Setup.hs +1/−32
- servant-server.cabal +7/−26
- src/Servant/Server.hs +1/−1
- src/Servant/Server/Internal.hs +36/−13
- src/Servant/Server/Internal/DelayedIO.hs +3/−4
- test/Servant/ServerSpec.hs +144/−107
- test/doctests.hs +0/−27
CHANGELOG.md view
@@ -1,6 +1,51 @@ [The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-server/CHANGELOG.md) [Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md) +0.17+----++### Significant changes++- Add NoContentVerb [#1028](https://github.com/haskell-servant/servant/issues/1028) [#1219](https://github.com/haskell-servant/servant/pull/1219) [#1228](https://github.com/haskell-servant/servant/pull/1228)++ The `NoContent` API endpoints should now use `NoContentVerb` combinator.+ The API type changes are usually of the kind++ ```diff+ - :<|> PostNoContent '[JSON] NoContent+ + :<|> PostNoContent+ ```++ i.e. one doesn't need to specify the content-type anymore. There is no content.++- `Capture` can be `Lenient` [#1155](https://github.com/haskell-servant/servant/issues/1155) [#1156](https://github.com/haskell-servant/servant/pull/1156)++ You can specify a lenient capture as++ ```haskell+ :<|> "capture-lenient" :> Capture' '[Lenient] "foo" Int :> GET+ ```++ which will make the capture always succeed. Handlers will be of the+ type `Either String CapturedType`, where `Left err` represents+ the possible parse failure.++- *servant-server* use queryString to parse QueryParam, QueryParams and QueryFlag [#1249](https://github.com/haskell-servant/servant/pull/1249) [#1262](https://github.com/haskell-servant/servant/pull/1262)++ Some APIs need query parameters rewriting, e.g. in order to support+ for multiple casing (camel, snake, etc) or something to that effect.++ This could be easily achieved by using WAI Middleware and modyfing+ request's `Query`. But QueryParam, QueryParams and QueryFlag use+ `rawQueryString`. By using `queryString` rather then `rawQueryString`+ we can enable such rewritings.++- *servant* *servant-server* Make packages `build-type: Simple` [#1263](https://github.com/haskell-servant/servant/pull/1263)++ We used `build-type: Custom`, but it's problematic e.g.+ for cross-compiling. The benefit is small, as the doctests+ can be run other ways too (though not so conviniently).+ 0.16.2 ------
Setup.hs view
@@ -1,33 +1,2 @@-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -Wall #-}-module Main (main) where--#ifndef MIN_VERSION_cabal_doctest-#define MIN_VERSION_cabal_doctest(x,y,z) 0-#endif--#if MIN_VERSION_cabal_doctest(1,0,0)--import Distribution.Extra.Doctest ( defaultMainWithDoctests )-main :: IO ()-main = defaultMainWithDoctests "doctests"--#else--#ifdef MIN_VERSION_Cabal--- If the macro is defined, we have new cabal-install,--- but for some reason we don't have cabal-doctest in package-db------ Probably we are running cabal sdist, when otherwise using new-build--- workflow-#warning You are configuring this package without cabal-doctest installed. \- The doctests test-suite will not work as a result. \- To fix this, install cabal-doctest before configuring.-#endif--import Distribution.Simple--main :: IO ()+import Distribution.Simple main = defaultMain--#endif
servant-server.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: servant-server-version: 0.16.2+version: 0.17 synopsis: A family of combinators for defining webservices APIs and serving them category: Servant, Web@@ -22,13 +22,13 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com copyright: 2014-2016 Zalora South East Asia Pte Ltd, 2016-2019 Servant Contributors-build-type: Custom+build-type: Simple tested-with: GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5- || ==8.8.1+ || ==8.8.2 extra-source-files: CHANGELOG.md@@ -38,12 +38,6 @@ type: git location: http://github.com/haskell-servant/servant.git -custom-setup- setup-depends:- base >= 4 && <5,- Cabal,- cabal-doctest >= 1.0.6 && <1.1- library exposed-modules: Servant@@ -69,7 +63,7 @@ -- Bundled with GHC: Lower bound to not force re-installs -- text and mtl are bundled starting with GHC-8.4 build-depends:- base >= 4.9 && < 4.13+ base >= 4.9 && < 4.14 , bytestring >= 0.10.8.1 && < 0.11 , containers >= 0.5.7.1 && < 0.7 , mtl >= 2.2.2 && < 2.3@@ -80,13 +74,13 @@ -- Servant dependencies -- strict dependency as we re-export 'servant' things. build-depends:- servant >= 0.16.2 && < 0.16.3+ servant >= 0.16 && < 0.17.1 , http-api-data >= 0.4.1 && < 0.4.2 -- Other dependencies: Lower bound around what is in the latest Stackage LTS. -- Here can be exceptions if we really need features from the newer versions. build-depends:- base-compat >= 0.10.5 && < 0.11+ base-compat >= 0.10.5 && < 0.12 , base64-bytestring >= 1.0.0.1 && < 1.1 , exceptions >= 0.10.0 && < 0.11 , http-media >= 0.7.1.3 && < 0.9@@ -165,7 +159,7 @@ aeson >= 1.4.1.0 && < 1.5 , directory >= 1.3.0.0 && < 1.4 , hspec >= 2.6.0 && < 2.8- , hspec-wai >= 0.9.0 && < 0.10+ , hspec-wai >= 0.10.1 && < 0.11 , QuickCheck >= 2.12.6.1 && < 2.14 , should-not-typecheck >= 2.1.0 && < 2.2 , temporary >= 1.3 && < 1.4@@ -173,16 +167,3 @@ build-tool-depends: hspec-discover:hspec-discover >= 2.6.0 && <2.8--test-suite doctests- build-depends:- base- , servant-server- , doctest >= 0.16.0 && <0.17- type: exitcode-stdio-1.0- main-is: test/doctests.hs- buildable: True- default-language: Haskell2010- ghc-options: -Wall -threaded- if impl(ghc >= 8.2)- x-doctest-options: -fdiagnostics-color=never
src/Servant/Server.hs view
@@ -110,7 +110,7 @@ -- Example: -- -- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books--- > :<|> "books" :> ReqBody Book :> Post '[JSON] Book -- POST /books+-- > :<|> "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book -- POST /books -- > -- > server :: Server MyApi -- > server = listAllBooks :<|> postBook
src/Servant/Server/Internal.hs view
@@ -64,7 +64,7 @@ (SockAddr) import Network.Wai (Application, Request, httpVersion, isSecure, lazyRequestBody,- rawQueryString, remoteHost, requestBody, requestHeaders,+ queryString, remoteHost, requestBody, requestHeaders, requestMethod, responseLBS, responseStream, vault) import Prelude () import Prelude.Compat@@ -75,10 +75,12 @@ IsSecure (..), QueryFlag, QueryParam', QueryParams, Raw, ReflectMethod (reflectMethod), RemoteHost, ReqBody', SBool (..), SBoolI (..), SourceIO, Stream, StreamBody',- Summary, ToSourceIO (..), Vault, Verb, WithNamedContext)+ Summary, ToSourceIO (..), Vault, Verb, NoContentVerb,+ WithNamedContext) import Servant.API.ContentTypes (AcceptHeader (..), AllCTRender (..), AllCTUnrender (..),- AllMime, MimeRender (..), MimeUnrender (..), canHandleAcceptH)+ AllMime, MimeRender (..), MimeUnrender (..), canHandleAcceptH,+ NoContent) import Servant.API.Modifiers (FoldLenient, FoldRequired, RequestArgument, unfoldRequestArgument)@@ -87,7 +89,7 @@ import qualified Servant.Types.SourceT as S import Web.HttpApiData (FromHttpApiData, parseHeader, parseQueryParam,- parseUrlPieceMaybe, parseUrlPieces)+ parseUrlPieces, parseUrlPiece) import Servant.Server.Internal.BasicAuth import Servant.Server.Internal.Context@@ -166,11 +168,11 @@ -- > server = getBook -- > where getBook :: Text -> Handler Book -- > getBook isbn = ...-instance (KnownSymbol capture, FromHttpApiData a, HasServer api context)+instance (KnownSymbol capture, FromHttpApiData a, HasServer api context, SBoolI (FoldLenient mods)) => HasServer (Capture' mods capture a :> api) context where type ServerT (Capture' mods capture a :> api) m =- a -> ServerT api m+ If (FoldLenient mods) (Either String a) a -> ServerT api m hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s @@ -178,9 +180,11 @@ CaptureRouter $ route (Proxy :: Proxy api) context- (addCapture d $ \ txt -> case parseUrlPieceMaybe txt of- Nothing -> delayedFail err400- Just v -> return v+ (addCapture d $ \ txt -> case ( sbool :: SBool (FoldLenient mods)+ , parseUrlPiece txt :: Either T.Text a) of+ (SFalse, Left e) -> delayedFail err400 { errBody = cs e }+ (SFalse, Right v) -> return v+ (STrue, piece) -> return $ (either (Left . cs) Right) piece ) -- | If you use 'CaptureAll' in one of the endpoints for your API,@@ -260,6 +264,17 @@ let bdy = if allowedMethodHead method request then "" else body in Route $ responseLBS status ((hContentType, cs contentT) : headers) bdy +noContentRouter :: Method+ -> Status+ -> Delayed env (Handler b)+ -> Router env+noContentRouter method status action = leafRouter route'+ where+ route' env request respond =+ runAction (action `addMethodCheck` methodCheck method request)+ env request respond $ \ _output ->+ Route $ responseLBS status [] ""+ instance {-# OVERLAPPABLE #-} ( AllCTRender ctypes a, ReflectMethod method, KnownNat status ) => HasServer (Verb method status ctypes a) context where@@ -283,7 +298,15 @@ where method = reflectMethod (Proxy :: Proxy method) status = toEnum . fromInteger $ natVal (Proxy :: Proxy status) +instance (ReflectMethod method) =>+ HasServer (NoContentVerb method) context where + type ServerT (NoContentVerb method) m = m NoContent+ hoistServerWithContext _ _ nt s = nt s++ route Proxy _ = noContentRouter method status204+ where method = reflectMethod (Proxy :: Proxy method)+ instance {-# OVERLAPPABLE #-} ( MimeRender ctype chunk, ReflectMethod method, KnownNat status, FramingRender framing, ToSourceIO chunk a@@ -429,7 +452,7 @@ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s route Proxy context subserver =- let querytext req = parseQueryText $ rawQueryString req+ let querytext = queryToQueryText . queryString paramname = cs $ symbolVal (Proxy :: Proxy sym) parseParam :: Request -> DelayedIO (RequestArgument mods a)@@ -496,8 +519,8 @@ params :: [T.Text] params = mapMaybe snd . filter (looksLikeParam . fst)- . parseQueryText- . rawQueryString+ . queryToQueryText + . queryString $ req looksLikeParam name = name == paramname || name == (paramname <> "[]")@@ -523,7 +546,7 @@ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s route Proxy context subserver =- let querytext r = parseQueryText $ rawQueryString r+ let querytext = queryToQueryText . queryString param r = case lookup paramname (querytext r) of Just Nothing -> True -- param is there, with no value Just (Just v) -> examine v -- param with a value
src/Servant/Server/Internal/DelayedIO.hs view
@@ -12,13 +12,12 @@ import Control.Monad.Trans (MonadIO (..), MonadTrans (..)) import Control.Monad.Trans.Control- (ComposeSt, MonadBaseControl (..), MonadTransControl (..),- defaultLiftBaseWith, defaultRestoreM)+ (MonadBaseControl (..)) import Control.Monad.Trans.Resource (MonadResource (..), ResourceT, runInternalState,- runResourceT, transResourceT, withInternalState)+ transResourceT, withInternalState) import Network.Wai- (Application, Request, Response, ResponseReceived)+ (Request) import Servant.Server.Internal.RouteResult import Servant.Server.Internal.ServerError
test/Servant/ServerSpec.hs view
@@ -25,6 +25,8 @@ import qualified Data.ByteString.Base64 as Base64 import Data.Char (toUpper)+import Data.Maybe+ (fromMaybe) import Data.Proxy (Proxy (Proxy)) import Data.String@@ -35,23 +37,23 @@ import GHC.Generics (Generic) import Network.HTTP.Types- (Status (..), hAccept, hContentType, imATeapot418,+ (QueryItem, Status (..), hAccept, hContentType, imATeapot418, methodDelete, methodGet, methodHead, methodPatch, methodPost, methodPut, ok200, parseQuery) import Network.Wai- (Application, Request, pathInfo, queryString, rawQueryString,- requestHeaders, responseLBS)+ (Application, Middleware, Request, pathInfo, queryString,+ rawQueryString, requestHeaders, responseLBS) import Network.Wai.Test (defaultRequest, request, runSession, simpleBody, simpleHeaders, simpleStatus) import Servant.API ((:<|>) (..), (:>), AuthProtect, BasicAuth,- BasicAuthData (BasicAuthData), Capture, CaptureAll, Delete,- EmptyAPI, Get, Header, Headers, HttpVersion, IsSecure (..),- JSON, NoContent (..), NoFraming, OctetStream, Patch,- PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw,- RemoteHost, ReqBody, SourceIO, StdMethod (..), Stream, Verb,- addHeader)+ BasicAuthData (BasicAuthData), Capture, Capture', CaptureAll,+ Delete, EmptyAPI, Get, Header, Headers, HttpVersion,+ IsSecure (..), JSON, Lenient, NoContent (..), NoContentVerb,+ NoFraming, OctetStream, Patch, PlainText, Post, Put,+ QueryFlag, QueryParam, QueryParams, Raw, RemoteHost, ReqBody,+ SourceIO, StdMethod (..), Stream, Strict, Verb, addHeader) import Servant.Server (Context ((:.), EmptyContext), Handler, Server, Tagged (..), emptyServer, err401, err403, err404, serve, serveWithContext)@@ -103,7 +105,7 @@ type VerbApi method status = Verb method status '[JSON] Person- :<|> "noContent" :> Verb method status '[JSON] NoContent+ :<|> "noContent" :> NoContentVerb method :<|> "header" :> Verb method status '[JSON] (Headers '[Header "H" Int] Person) :<|> "headerNC" :> Verb method status '[JSON] (Headers '[Header "H" Int] NoContent) :<|> "accept" :> ( Verb method status '[JSON] Person@@ -140,7 +142,7 @@ it "returns no content on NoContent" $ do response <- THW.request method "/noContent" [] ""- liftIO $ statusCode (simpleStatus response) `shouldBe` status+ liftIO $ statusCode (simpleStatus response) `shouldBe` 204 liftIO $ simpleBody response `shouldBe` "" -- HEAD should not return body@@ -204,14 +206,28 @@ ------------------------------------------------------------------------------ type CaptureApi = Capture "legs" Integer :> Get '[JSON] Animal+ :<|> "ears" :> Capture' '[Lenient] "ears" Integer :> Get '[JSON] Animal+ :<|> "eyes" :> Capture' '[Strict] "eyes" Integer :> Get '[JSON] Animal captureApi :: Proxy CaptureApi captureApi = Proxy-captureServer :: Integer -> Handler Animal-captureServer legs = case legs of- 4 -> return jerry- 2 -> return tweety- _ -> throwError err404 +captureServer :: Server CaptureApi+captureServer = getLegs :<|> getEars :<|> getEyes+ where getLegs :: Integer -> Handler Animal+ getLegs legs = case legs of+ 4 -> return jerry+ 2 -> return tweety+ _ -> throwError err404++ getEars :: Either String Integer -> Handler Animal+ getEars (Left _) = return chimera -- ignore integer parse error, return weird animal+ getEars (Right 2) = return jerry+ getEars (Right _) = throwError err404++ getEyes :: Integer -> Handler Animal+ getEyes 2 = return jerry+ getEyes _ = throwError err404+ captureSpec :: Spec captureSpec = do describe "Servant.API.Capture" $ do@@ -224,6 +240,17 @@ it "returns 400 if the decoding fails" $ do get "/notAnInt" `shouldRespondWith` 400 + it "returns an animal if eyes or ears are 2" $ do+ get "/ears/2" `shouldRespondWith` 200+ get "/eyes/2" `shouldRespondWith` 200++ it "returns a weird animal on Lenient Capture" $ do+ response <- get "/ears/bla"+ liftIO $ decode' (simpleBody response) `shouldBe` Just chimera++ it "returns 400 if parsing integer fails on Strict Capture" $ do+ get "/eyes/bla" `shouldRespondWith` 400+ with (return (serve (Proxy :: Proxy (Capture "captured" String :> Raw)) (\ "captured" -> Tagged $ \request_ respond ->@@ -314,118 +341,124 @@ queryParamServer (Just name_) = return alice{name = name_} queryParamServer Nothing = return alice ++ queryParamSpec :: Spec queryParamSpec = do+ let mkRequest params pinfo = Network.Wai.Test.request defaultRequest+ { rawQueryString = params+ , queryString = parseQuery params+ , pathInfo = pinfo+ }+ describe "Servant.API.QueryParam" $ do it "allows retrieving simple GET parameters" $- (flip runSession) (serve queryParamApi qpServer) $ do- let params1 = "?name=bob"- response1 <- Network.Wai.Test.request defaultRequest{- rawQueryString = params1,- queryString = parseQuery params1- }- liftIO $ do- decode' (simpleBody response1) `shouldBe` Just alice{- name = "bob"- }+ flip runSession (serve queryParamApi qpServer) $ do+ response1 <- mkRequest "?name=bob" []+ liftIO $ decode' (simpleBody response1) `shouldBe` Just alice+ { name = "bob"+ } it "allows retrieving lists in GET parameters" $- (flip runSession) (serve queryParamApi qpServer) $ do- let params2 = "?names[]=bob&names[]=john"- response2 <- Network.Wai.Test.request defaultRequest{- rawQueryString = params2,- queryString = parseQuery params2,- pathInfo = ["a"]- }- liftIO $- decode' (simpleBody response2) `shouldBe` Just alice{- name = "john"- }+ flip runSession (serve queryParamApi qpServer) $ do+ response2 <- mkRequest "?names[]=bob&names[]=john" ["a"]+ liftIO $ decode' (simpleBody response2) `shouldBe` Just alice+ { name = "john"+ } it "parses a query parameter" $- (flip runSession) (serve queryParamApi qpServer) $ do- let params = "?age=55"- response <- Network.Wai.Test.request defaultRequest{- rawQueryString = params,- queryString = parseQuery params,- pathInfo = ["param"]- }- liftIO $- decode' (simpleBody response) `shouldBe` Just alice{- age = 55- }+ flip runSession (serve queryParamApi qpServer) $ do+ response <- mkRequest "?age=55" ["param"]+ liftIO $ decode' (simpleBody response) `shouldBe` Just alice+ { age = 55+ } it "generates an error on query parameter parse failure" $- (flip runSession) (serve queryParamApi qpServer) $ do- let params = "?age=foo"- response <- Network.Wai.Test.request defaultRequest{- rawQueryString = params,- queryString = parseQuery params,- pathInfo = ["param"]- }+ flip runSession (serve queryParamApi qpServer) $ do+ response <- mkRequest "?age=foo" ["param"] liftIO $ statusCode (simpleStatus response) `shouldBe` 400 return () it "parses multiple query parameters" $- (flip runSession) (serve queryParamApi qpServer) $ do- let params = "?ages=10&ages=22"- response <- Network.Wai.Test.request defaultRequest{- rawQueryString = params,- queryString = parseQuery params,- pathInfo = ["multiparam"]- }- liftIO $- decode' (simpleBody response) `shouldBe` Just alice{- age = 32- }+ flip runSession (serve queryParamApi qpServer) $ do+ response <- mkRequest "?ages=10&ages=22" ["multiparam"]+ liftIO $ decode' (simpleBody response) `shouldBe` Just alice+ { age = 32+ } it "generates an error on parse failures of multiple parameters" $- (flip runSession) (serve queryParamApi qpServer) $ do- let params = "?ages=2&ages=foo"- response <- Network.Wai.Test.request defaultRequest{- rawQueryString = params,- queryString = parseQuery params,- pathInfo = ["multiparam"]- }+ flip runSession (serve queryParamApi qpServer) $ do+ response <- mkRequest "?ages=2&ages=foo" ["multiparam"] liftIO $ statusCode (simpleStatus response) `shouldBe` 400 return () - it "allows retrieving value-less GET parameters" $- (flip runSession) (serve queryParamApi qpServer) $ do- let params3 = "?capitalize"- response3 <- Network.Wai.Test.request defaultRequest{- rawQueryString = params3,- queryString = parseQuery params3,- pathInfo = ["b"]- }- liftIO $- decode' (simpleBody response3) `shouldBe` Just alice{- name = "ALICE"- }+ flip runSession (serve queryParamApi qpServer) $ do+ response3 <- mkRequest "?capitalize" ["b"]+ liftIO $ decode' (simpleBody response3) `shouldBe` Just alice+ { name = "ALICE"+ } - let params3' = "?capitalize="- response3' <- Network.Wai.Test.request defaultRequest{- rawQueryString = params3',- queryString = parseQuery params3',- pathInfo = ["b"]- }- liftIO $- decode' (simpleBody response3') `shouldBe` Just alice{- name = "ALICE"- }+ response3' <- mkRequest "?capitalize=" ["b"]+ liftIO $ decode' (simpleBody response3') `shouldBe` Just alice+ { name = "ALICE"+ } - let params3'' = "?unknown="- response3'' <- Network.Wai.Test.request defaultRequest{- rawQueryString = params3'',- queryString = parseQuery params3'',- pathInfo = ["b"]- }- liftIO $- decode' (simpleBody response3'') `shouldBe` Just alice{- name = "Alice"- }+ response3'' <- mkRequest "?unknown=" ["b"]+ liftIO $ decode' (simpleBody response3'') `shouldBe` Just alice+ { name = "Alice"+ } + describe "Uses queryString instead of rawQueryString" $ do+ -- test query parameters rewriter+ let queryRewriter :: Middleware+ queryRewriter app req = app req+ { queryString = fmap rewrite $ queryString req+ }+ where+ rewrite :: QueryItem -> QueryItem+ rewrite (k, v) = (fromMaybe k (BS.stripPrefix "person_" k), v)++ let app = queryRewriter $ serve queryParamApi qpServer++ it "allows rewriting for simple GET/query parameters" $+ flip runSession app $ do+ response1 <- mkRequest "?person_name=bob" []+ liftIO $ decode' (simpleBody response1) `shouldBe` Just alice+ { name = "bob"+ }++ it "allows rewriting for lists in GET parameters" $+ flip runSession app $ do+ response2 <- mkRequest "?person_names[]=bob&person_names[]=john" ["a"]+ liftIO $ decode' (simpleBody response2) `shouldBe` Just alice+ { name = "john"+ }++ it "allows rewriting when parsing multiple query parameters" $+ flip runSession app $ do+ response <- mkRequest "?person_ages=10&person_ages=22" ["multiparam"]+ liftIO $ decode' (simpleBody response) `shouldBe` Just alice+ { age = 32+ }++ it "allows retrieving value-less GET parameters" $+ flip runSession app $ do+ response3 <- mkRequest "?person_capitalize" ["b"]+ liftIO $ decode' (simpleBody response3) `shouldBe` Just alice+ { name = "ALICE"+ }++ response3' <- mkRequest "?person_capitalize=" ["b"]+ liftIO $ decode' (simpleBody response3') `shouldBe` Just alice+ { name = "ALICE"+ }++ response3'' <- mkRequest "?person_unknown=" ["b"]+ liftIO $ decode' (simpleBody response3'') `shouldBe` Just alice+ { name = "Alice"+ }+ -- }}} ------------------------------------------------------------------------------ -- * reqBodySpec {{{@@ -519,7 +552,7 @@ rawSpec = do describe "Servant.API.Raw" $ do it "runs applications" $ do- (flip runSession) (serve rawApi (rawApplication (const (42 :: Integer)))) $ do+ flip runSession (serve rawApi (rawApplication (const (42 :: Integer)))) $ do response <- Network.Wai.Test.request defaultRequest{ pathInfo = ["foo"] }@@ -527,7 +560,7 @@ simpleBody response `shouldBe` "42" it "gets the pathInfo modified" $ do- (flip runSession) (serve rawApi (rawApplication pathInfo)) $ do+ flip runSession (serve rawApi (rawApplication pathInfo)) $ do response <- Network.Wai.Test.request defaultRequest{ pathInfo = ["foo", "bar"] }@@ -779,6 +812,10 @@ tweety :: Animal tweety = Animal "Bird" 2++-- weird animal with non-integer amount of ears+chimera :: Animal+chimera = Animal "Chimera" (-1) beholder :: Animal beholder = Animal "Beholder" 0
− test/doctests.hs
@@ -1,27 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Main (doctests)--- Copyright : (C) 2012-14 Edward Kmett--- License : BSD-style (see the file LICENSE)--- Maintainer : Edward Kmett <ekmett@gmail.com>--- Stability : provisional--- Portability : portable------ This module provides doctests for a project based on the actual versions--- of the packages it was built with. It requires a corresponding Setup.lhs--- to be added to the project-------------------------------------------------------------------------------module Main where--import Build_doctests- (flags, module_sources, pkgs)-import Data.Foldable- (traverse_)-import Test.DocTest--main :: IO ()-main = do- traverse_ putStrLn args- doctest args- where- args = flags ++ pkgs ++ module_sources