add ComprehensiveAPI to test whether we're missing instances

Some of the combinators are commented atm, because we *are* missing combinators.
This commit is contained in:
Sönke Hahn 2016-01-16 19:17:46 +01:00
parent b8d70e303a
commit e5974ec94d
9 changed files with 92 additions and 1 deletions

View file

@ -49,9 +49,12 @@ import Test.HUnit
import Test.QuickCheck import Test.QuickCheck
import Servant.API import Servant.API
import Servant.API.Internal.Test.ComprehensiveAPI
import Servant.Client import Servant.Client
import Servant.Server import Servant.Server
_ = client comprehensiveAPI
spec :: Spec spec :: Spec
spec = describe "Servant.Client" $ do spec = describe "Servant.Client" $ do
sucessSpec sucessSpec

View file

@ -1,7 +1,7 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
@ -18,8 +18,24 @@ import GHC.Generics
import Test.Hspec import Test.Hspec
import Servant.API import Servant.API
import Servant.API.Internal.Test.ComprehensiveAPI
import Servant.Docs.Internal import Servant.Docs.Internal
-- * comprehensive api
_ = docs comprehensiveAPI
instance ToParam (QueryParam "foo" Int) where
toParam = error "unused"
instance ToParam (QueryParams "foo" Int) where
toParam = error "unused"
instance ToParam (QueryFlag "foo") where
toParam = error "unused"
instance ToCapture (Capture "foo" Int) where
toCapture = error "unused"
-- * specs
spec :: Spec spec :: Spec
spec = describe "Servant.Docs" $ do spec = describe "Servant.Docs" $ do

View file

@ -21,6 +21,7 @@ import qualified Data.Text as T
import Language.ECMAScript3.Parser (program, parse) import Language.ECMAScript3.Parser (program, parse)
import Test.Hspec hiding (shouldContain, shouldNotContain) import Test.Hspec hiding (shouldContain, shouldNotContain)
import Servant.API.Internal.Test.ComprehensiveAPI
import Servant.JS import Servant.JS
import Servant.JS.Internal import Servant.JS.Internal
import qualified Servant.JS.Angular as NG import qualified Servant.JS.Angular as NG
@ -29,6 +30,12 @@ import qualified Servant.JS.JQuery as JQ
import qualified Servant.JS.Vanilla as JS import qualified Servant.JS.Vanilla as JS
import Servant.JSSpec.CustomHeaders import Servant.JSSpec.CustomHeaders
-- * comprehensive api
_ = (jsForAPI comprehensiveAPI vanillaJS :: Text)
-- * specs
type TestAPI = "simple" :> ReqBody '[JSON,FormUrlEncoded] Text :> Post '[JSON] Bool type TestAPI = "simple" :> ReqBody '[JSON,FormUrlEncoded] Text :> Post '[JSON] Bool
:<|> "has.extension" :> Get '[FormUrlEncoded,JSON] Bool :<|> "has.extension" :> Get '[FormUrlEncoded,JSON] Bool

View file

@ -45,3 +45,18 @@ executable mock-app
buildable: True buildable: True
else else
buildable: False buildable: False
test-suite spec
type: exitcode-stdio-1.0
ghc-options:
-Wall -fno-warn-name-shadowing
default-language: Haskell2010
hs-source-dirs: test
main-is: Spec.hs
other-modules:
Servant.MockSpec
build-depends:
base,
hspec,
servant,
servant-mock

View file

@ -0,0 +1,12 @@
module Servant.MockSpec where
import Test.Hspec
import Servant.API.Internal.Test.ComprehensiveAPI
import Servant.Mock
_ = mock comprehensiveAPI
spec :: Spec
spec = return ()

View file

@ -0,0 +1 @@
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

View file

@ -46,6 +46,7 @@ import Servant.API ((:<|>) (..), (:>), Capture, Delete,
QueryFlag, QueryParam, QueryParams, QueryFlag, QueryParam, QueryParams,
Raw, RemoteHost, ReqBody, Raw, RemoteHost, ReqBody,
StdMethod (..), Verb, addHeader) StdMethod (..), Verb, addHeader)
import Servant.API.Internal.Test.ComprehensiveAPI
import Servant.Server (ServantErr (..), Server, err404, import Servant.Server (ServantErr (..), Server, err404,
serve) serve)
import Test.Hspec (Spec, context, describe, it, import Test.Hspec (Spec, context, describe, it,
@ -60,6 +61,9 @@ import Servant.Server.Internal.Router
(tweakResponse, runRouter, (tweakResponse, runRouter,
Router, Router'(LeafRouter)) Router, Router'(LeafRouter))
-- * comprehensive api test
_ = serve comprehensiveAPI (error "unused") (error "unused")
-- * Specs -- * Specs

View file

@ -31,6 +31,7 @@ library
Servant.API.ContentTypes Servant.API.ContentTypes
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.QueryParam Servant.API.QueryParam
Servant.API.Raw Servant.API.Raw

View file

@ -0,0 +1,32 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
module Servant.API.Internal.Test.ComprehensiveAPI where
import Data.Proxy
import Servant.API
type GET = Get '[JSON] ()
type ComprehensiveAPI =
GET :<|>
Get '[JSON] Int :<|>
Capture "foo" Int :> GET :<|>
Header "foo" Int :> GET :<|>
-- HttpVersion :> GET :<|>
IsSecure :> GET :<|>
QueryParam "foo" Int :> GET :<|>
QueryParams "foo" Int :> GET :<|>
QueryFlag "foo" :> GET :<|>
-- Raw :<|>
-- RemoteHost :<|>
ReqBody '[JSON] Int :> GET :<|>
-- Get '[JSON] (Headers '[Header "foo" Int] ()) :<|>
"foo" :> GET :<|>
Vault :> GET :<|>
Verb 'POST 204 '[JSON] () :<|>
Verb 'POST 204 '[JSON] Int
comprehensiveAPI :: Proxy ComprehensiveAPI
comprehensiveAPI = Proxy