Merge pull request #1070 from phadej/test-public
Make ComprehensiveAPI part of public API
This commit is contained in:
commit
da2af9fd5a
8 changed files with 67 additions and 57 deletions
|
@ -64,7 +64,7 @@ import Servant.API
|
||||||
DeleteNoContent, EmptyAPI, FormUrlEncoded, Get, Header,
|
DeleteNoContent, EmptyAPI, FormUrlEncoded, Get, Header,
|
||||||
Headers, JSON, NoContent (NoContent), Post, Put, QueryFlag,
|
Headers, JSON, NoContent (NoContent), Post, Put, QueryFlag,
|
||||||
QueryParam, QueryParams, Raw, ReqBody, addHeader, getHeaders)
|
QueryParam, QueryParams, Raw, ReqBody, addHeader, getHeaders)
|
||||||
import Servant.API.Internal.Test.ComprehensiveAPI
|
import Servant.Test.ComprehensiveAPI
|
||||||
import Servant.Client
|
import Servant.Client
|
||||||
import qualified Servant.Client.Core.Internal.Auth as Auth
|
import qualified Servant.Client.Core.Internal.Auth as Auth
|
||||||
import qualified Servant.Client.Core.Internal.Request as Req
|
import qualified Servant.Client.Core.Internal.Request as Req
|
||||||
|
|
|
@ -21,7 +21,7 @@ import GHC.Generics
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
|
|
||||||
import Servant.API
|
import Servant.API
|
||||||
import Servant.API.Internal.Test.ComprehensiveAPI
|
import Servant.Test.ComprehensiveAPI
|
||||||
import Servant.Docs.Internal
|
import Servant.Docs.Internal
|
||||||
|
|
||||||
-- * comprehensive api
|
-- * comprehensive api
|
||||||
|
|
|
@ -14,7 +14,7 @@ module Servant.ForeignSpec where
|
||||||
import Data.Monoid
|
import Data.Monoid
|
||||||
((<>))
|
((<>))
|
||||||
import Data.Proxy
|
import Data.Proxy
|
||||||
import Servant.API.Internal.Test.ComprehensiveAPI
|
import Servant.Test.ComprehensiveAPI
|
||||||
import Servant.Foreign
|
import Servant.Foreign
|
||||||
import Servant.Types.SourceT
|
import Servant.Types.SourceT
|
||||||
(SourceT)
|
(SourceT)
|
||||||
|
|
|
@ -51,7 +51,7 @@ import Servant.API
|
||||||
PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw,
|
PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw,
|
||||||
RemoteHost, ReqBody, StdMethod (..), Stream,
|
RemoteHost, ReqBody, StdMethod (..), Stream,
|
||||||
SourceIO, Verb, addHeader)
|
SourceIO, Verb, addHeader)
|
||||||
import Servant.API.Internal.Test.ComprehensiveAPI
|
import Servant.Test.ComprehensiveAPI
|
||||||
import Servant.Server
|
import Servant.Server
|
||||||
(Context ((:.), EmptyContext), Handler, Server, Tagged (..),
|
(Context ((:.), EmptyContext), Handler, Server, Tagged (..),
|
||||||
emptyServer, err401, err403, err404, serve, serveWithContext)
|
emptyServer, err401, err403, err404, serve, serveWithContext)
|
||||||
|
|
|
@ -48,7 +48,6 @@ library
|
||||||
Servant.API.Generic
|
Servant.API.Generic
|
||||||
Servant.API.Header
|
Servant.API.Header
|
||||||
Servant.API.HttpVersion
|
Servant.API.HttpVersion
|
||||||
Servant.API.Internal.Test.ComprehensiveAPI
|
|
||||||
Servant.API.IsSecure
|
Servant.API.IsSecure
|
||||||
Servant.API.Modifiers
|
Servant.API.Modifiers
|
||||||
Servant.API.QueryParam
|
Servant.API.QueryParam
|
||||||
|
@ -67,6 +66,10 @@ library
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
Servant.Types.SourceT
|
Servant.Types.SourceT
|
||||||
|
|
||||||
|
-- Test stuff
|
||||||
|
exposed-modules:
|
||||||
|
Servant.Test.ComprehensiveAPI
|
||||||
|
|
||||||
-- Safe links
|
-- Safe links
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
Servant.Links
|
Servant.Links
|
||||||
|
@ -74,6 +77,7 @@ library
|
||||||
-- Deprecated modules, to be removed in late 2019
|
-- Deprecated modules, to be removed in late 2019
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
Servant.Utils.Links
|
Servant.Utils.Links
|
||||||
|
Servant.API.Internal.Test.ComprehensiveAPI
|
||||||
|
|
||||||
-- Bundled with GHC: Lower bound to not force re-installs
|
-- Bundled with GHC: Lower bound to not force re-installs
|
||||||
-- text and mtl are bundled starting with GHC-8.4
|
-- text and mtl are bundled starting with GHC-8.4
|
||||||
|
|
|
@ -1,52 +1,6 @@
|
||||||
{-# LANGUAGE DataKinds #-}
|
module Servant.API.Internal.Test.ComprehensiveAPI
|
||||||
{-# LANGUAGE TypeOperators #-}
|
{-# DEPRECATED "Use Servant.TestComprehensiveAPI" #-}
|
||||||
|
( module Servant.Test.ComprehensiveAPI )
|
||||||
|
where
|
||||||
|
|
||||||
-- | This is a module containing an API with all `Servant.API` combinators. It
|
import Servant.Test.ComprehensiveAPI
|
||||||
-- is used for testing only (in particular, checking that instances exist for
|
|
||||||
-- the core servant classes for each combinator), and should not be imported.
|
|
||||||
module Servant.API.Internal.Test.ComprehensiveAPI where
|
|
||||||
|
|
||||||
import Data.Proxy
|
|
||||||
(Proxy (..))
|
|
||||||
import Servant.API
|
|
||||||
import Servant.Types.SourceT
|
|
||||||
(SourceT)
|
|
||||||
|
|
||||||
type GET = Get '[JSON] NoContent
|
|
||||||
|
|
||||||
type ComprehensiveAPI =
|
|
||||||
ComprehensiveAPIWithoutRaw :<|>
|
|
||||||
Raw
|
|
||||||
|
|
||||||
comprehensiveAPI :: Proxy ComprehensiveAPI
|
|
||||||
comprehensiveAPI = Proxy
|
|
||||||
|
|
||||||
type ComprehensiveAPIWithoutRaw =
|
|
||||||
GET :<|>
|
|
||||||
Get '[JSON] Int :<|>
|
|
||||||
Capture' '[Description "example description"] "foo" Int :> GET :<|>
|
|
||||||
Header "foo" Int :> GET :<|>
|
|
||||||
Header' '[Required, Lenient] "bar" Int :> GET :<|>
|
|
||||||
HttpVersion :> GET :<|>
|
|
||||||
IsSecure :> GET :<|>
|
|
||||||
QueryParam "foo" Int :> GET :<|>
|
|
||||||
QueryParam' '[Required, Lenient] "bar" Int :> GET :<|>
|
|
||||||
QueryParams "foo" Int :> GET :<|>
|
|
||||||
QueryFlag "foo" :> GET :<|>
|
|
||||||
RemoteHost :> GET :<|>
|
|
||||||
ReqBody '[JSON] Int :> GET :<|>
|
|
||||||
ReqBody' '[Lenient] '[JSON] Int :> GET :<|>
|
|
||||||
Get '[JSON] (Headers '[Header "foo" Int] NoContent) :<|>
|
|
||||||
"foo" :> GET :<|>
|
|
||||||
Vault :> GET :<|>
|
|
||||||
Verb 'POST 204 '[JSON] NoContent :<|>
|
|
||||||
Verb 'POST 204 '[JSON] Int :<|>
|
|
||||||
StreamBody NetstringFraming JSON (SourceT IO Int) :> Stream 'GET 200 NetstringFraming JSON (SourceT IO Int) :<|>
|
|
||||||
WithNamedContext "foo" '[] GET :<|>
|
|
||||||
CaptureAll "foo" Int :> GET :<|>
|
|
||||||
Summary "foo" :> GET :<|>
|
|
||||||
Description "foo" :> GET :<|>
|
|
||||||
EmptyAPI
|
|
||||||
|
|
||||||
comprehensiveAPIWithoutRaw :: Proxy ComprehensiveAPIWithoutRaw
|
|
||||||
comprehensiveAPIWithoutRaw = Proxy
|
|
||||||
|
|
52
servant/src/Servant/Test/ComprehensiveAPI.hs
Normal file
52
servant/src/Servant/Test/ComprehensiveAPI.hs
Normal file
|
@ -0,0 +1,52 @@
|
||||||
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
|
||||||
|
-- | This is a module containing an API with all `Servant.API` combinators. It
|
||||||
|
-- is used for testing only (in particular, checking that instances exist for
|
||||||
|
-- the core servant classes for each combinator).
|
||||||
|
module Servant.Test.ComprehensiveAPI where
|
||||||
|
|
||||||
|
import Data.Proxy
|
||||||
|
(Proxy (..))
|
||||||
|
import Servant.API
|
||||||
|
import Servant.Types.SourceT
|
||||||
|
(SourceT)
|
||||||
|
|
||||||
|
type GET = Get '[JSON] NoContent
|
||||||
|
|
||||||
|
type ComprehensiveAPI =
|
||||||
|
ComprehensiveAPIWithoutRaw :<|>
|
||||||
|
Raw
|
||||||
|
|
||||||
|
comprehensiveAPI :: Proxy ComprehensiveAPI
|
||||||
|
comprehensiveAPI = Proxy
|
||||||
|
|
||||||
|
type ComprehensiveAPIWithoutRaw =
|
||||||
|
GET :<|>
|
||||||
|
Get '[JSON] Int :<|>
|
||||||
|
Capture' '[Description "example description"] "foo" Int :> GET :<|>
|
||||||
|
Header "foo" Int :> GET :<|>
|
||||||
|
Header' '[Required, Lenient] "bar" Int :> GET :<|>
|
||||||
|
HttpVersion :> GET :<|>
|
||||||
|
IsSecure :> GET :<|>
|
||||||
|
QueryParam "foo" Int :> GET :<|>
|
||||||
|
QueryParam' '[Required, Lenient] "bar" Int :> GET :<|>
|
||||||
|
QueryParams "foo" Int :> GET :<|>
|
||||||
|
QueryFlag "foo" :> GET :<|>
|
||||||
|
RemoteHost :> GET :<|>
|
||||||
|
ReqBody '[JSON] Int :> GET :<|>
|
||||||
|
ReqBody' '[Lenient] '[JSON] Int :> GET :<|>
|
||||||
|
Get '[JSON] (Headers '[Header "foo" Int] NoContent) :<|>
|
||||||
|
"foo" :> GET :<|>
|
||||||
|
Vault :> GET :<|>
|
||||||
|
Verb 'POST 204 '[JSON] NoContent :<|>
|
||||||
|
Verb 'POST 204 '[JSON] Int :<|>
|
||||||
|
StreamBody NetstringFraming JSON (SourceT IO Int) :> Stream 'GET 200 NetstringFraming JSON (SourceT IO Int) :<|>
|
||||||
|
WithNamedContext "foo" '[] GET :<|>
|
||||||
|
CaptureAll "foo" Int :> GET :<|>
|
||||||
|
Summary "foo" :> GET :<|>
|
||||||
|
Description "foo" :> GET :<|>
|
||||||
|
EmptyAPI
|
||||||
|
|
||||||
|
comprehensiveAPIWithoutRaw :: Proxy ComprehensiveAPIWithoutRaw
|
||||||
|
comprehensiveAPIWithoutRaw = Proxy
|
|
@ -13,7 +13,7 @@ import Test.Hspec
|
||||||
(Expectation, Spec, describe, it, shouldBe)
|
(Expectation, Spec, describe, it, shouldBe)
|
||||||
|
|
||||||
import Servant.API
|
import Servant.API
|
||||||
import Servant.API.Internal.Test.ComprehensiveAPI
|
import Servant.Test.ComprehensiveAPI
|
||||||
(comprehensiveAPIWithoutRaw)
|
(comprehensiveAPIWithoutRaw)
|
||||||
import Servant.Links
|
import Servant.Links
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue