mirror of
https://github.com/ilyakooo0/servant-quickcheck.git
synced 2024-10-26 18:17:32 +03:00
Support new CaptureAll combinator.
This commit is contained in:
parent
9ff43756ce
commit
0337996c6c
@ -11,7 +11,7 @@ matrix:
|
|||||||
|
|
||||||
install:
|
install:
|
||||||
- (mkdir -p $HOME/.local/bin && cd $HOME/.local/bin && wget https://zalora-public.s3.amazonaws.com/tinc && chmod +x tinc)
|
- (mkdir -p $HOME/.local/bin && cd $HOME/.local/bin && wget https://zalora-public.s3.amazonaws.com/tinc && chmod +x tinc)
|
||||||
- export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/1.22/bin:$PATH
|
- export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
|
||||||
- ghc --version
|
- ghc --version
|
||||||
- cabal --version
|
- cabal --version
|
||||||
- travis_retry cabal update
|
- travis_retry cabal update
|
||||||
@ -19,6 +19,7 @@ install:
|
|||||||
|
|
||||||
script:
|
script:
|
||||||
- tinc && cabal configure --enable-tests && cabal build && cabal test
|
- tinc && cabal configure --enable-tests && cabal build && cabal test
|
||||||
|
- cabal check
|
||||||
|
|
||||||
cache:
|
cache:
|
||||||
directories:
|
directories:
|
||||||
|
@ -13,7 +13,11 @@ category: Web
|
|||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
cabal-version: >=1.10
|
||||||
extra-source-files:
|
extra-source-files:
|
||||||
CHANGELOG.md
|
CHANGELOG.yaml
|
||||||
|
|
||||||
|
source-repository head
|
||||||
|
type: git
|
||||||
|
location: https://github.com/haskell-servant/servant-quickcheck
|
||||||
|
|
||||||
flag long-tests
|
flag long-tests
|
||||||
description: Run more QuickCheck tests
|
description: Run more QuickCheck tests
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{-# LANGUAGE CPP #-}
|
||||||
{-# LANGUAGE PolyKinds #-}
|
{-# LANGUAGE PolyKinds #-}
|
||||||
module Servant.QuickCheck.Internal.HasGenRequest where
|
module Servant.QuickCheck.Internal.HasGenRequest where
|
||||||
|
|
||||||
@ -5,6 +6,7 @@ import Data.Default.Class (def)
|
|||||||
import Data.Monoid ((<>))
|
import Data.Monoid ((<>))
|
||||||
import Data.String (fromString)
|
import Data.String (fromString)
|
||||||
import Data.String.Conversions (cs)
|
import Data.String.Conversions (cs)
|
||||||
|
import qualified Data.ByteString as BS
|
||||||
import GHC.TypeLits (KnownSymbol, Nat, symbolVal)
|
import GHC.TypeLits (KnownSymbol, Nat, symbolVal)
|
||||||
import Network.HTTP.Client (Request, RequestBody (..), host, method, path,
|
import Network.HTTP.Client (Request, RequestBody (..), host, method, path,
|
||||||
port, queryString, requestBody, requestHeaders,
|
port, queryString, requestBody, requestHeaders,
|
||||||
@ -44,6 +46,19 @@ instance (Arbitrary c, HasGenRequest b, ToHttpApiData c )
|
|||||||
old = genRequest (Proxy :: Proxy b)
|
old = genRequest (Proxy :: Proxy b)
|
||||||
new = arbitrary :: Gen c
|
new = arbitrary :: Gen c
|
||||||
|
|
||||||
|
#if MIN_VERSION_servant(0,8,0)
|
||||||
|
instance (Arbitrary c, HasGenRequest b, ToHttpApiData c )
|
||||||
|
=> HasGenRequest (CaptureAll x c :> b) where
|
||||||
|
genRequest _ = do
|
||||||
|
old' <- old
|
||||||
|
new' <- fmap (cs . toUrlPiece) <$> new
|
||||||
|
let new'' = BS.intercalate "/" new'
|
||||||
|
return $ \burl -> let r = old' burl in r { path = new'' <> path r }
|
||||||
|
where
|
||||||
|
old = genRequest (Proxy :: Proxy b)
|
||||||
|
new = arbitrary :: Gen [c]
|
||||||
|
#endif
|
||||||
|
|
||||||
instance (Arbitrary c, KnownSymbol h, HasGenRequest b, ToHttpApiData c)
|
instance (Arbitrary c, KnownSymbol h, HasGenRequest b, ToHttpApiData c)
|
||||||
=> HasGenRequest (Header h c :> b) where
|
=> HasGenRequest (Header h c :> b) where
|
||||||
genRequest _ = do
|
genRequest _ = do
|
||||||
|
@ -2,6 +2,9 @@
|
|||||||
resolver: nightly-2016-09-07
|
resolver: nightly-2016-09-07
|
||||||
packages:
|
packages:
|
||||||
- '.'
|
- '.'
|
||||||
extra-deps: []
|
extra-deps:
|
||||||
|
- 'servant-0.8.1'
|
||||||
|
- 'servant-server-0.8.1'
|
||||||
|
- 'servant-client-0.8.1'
|
||||||
flags: {}
|
flags: {}
|
||||||
extra-package-dbs: []
|
extra-package-dbs: []
|
||||||
|
@ -5,7 +5,7 @@ import Control.Concurrent.MVar (newMVar, readMVar, swapMVar)
|
|||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import Prelude.Compat
|
import Prelude.Compat
|
||||||
import Servant
|
import Servant
|
||||||
import Servant.API.Internal.Test.ComprehensiveAPI (comprehensiveAPI)
|
import Servant.API.Internal.Test.ComprehensiveAPI (comprehensiveAPIWithoutRaw)
|
||||||
import Test.Hspec (Spec, context, describe, it,
|
import Test.Hspec (Spec, context, describe, it,
|
||||||
shouldBe, shouldContain)
|
shouldBe, shouldContain)
|
||||||
import Test.Hspec.Core.Spec (Arg, Example, Result (..),
|
import Test.Hspec.Core.Spec (Arg, Example, Result (..),
|
||||||
@ -81,7 +81,7 @@ isComprehensiveSpec :: Spec
|
|||||||
isComprehensiveSpec = describe "HasGenRequest" $ do
|
isComprehensiveSpec = describe "HasGenRequest" $ do
|
||||||
|
|
||||||
it "has instances for all 'servant' combinators" $ do
|
it "has instances for all 'servant' combinators" $ do
|
||||||
let _g = genRequest comprehensiveAPI
|
let _g = genRequest comprehensiveAPIWithoutRaw
|
||||||
True `shouldBe` True -- This is a type-level check
|
True `shouldBe` True -- This is a type-level check
|
||||||
|
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user