Compare commits
51 Commits
issue-14/r
...
master
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
0535413b1a | ||
|
|
7cc95a8120 | ||
|
|
e1a919127a | ||
|
|
e6daf03c16 | ||
|
|
7926ad6bdb | ||
|
|
fa9cc11095 | ||
|
|
dfec2529ac | ||
|
|
eb3cdbcd3a | ||
|
|
f48088b7d2 | ||
|
|
2bf03e822a | ||
|
|
092ebe5423 | ||
|
|
13d32d6768 | ||
|
|
8e8e9b501b | ||
|
|
c93bd5a832 | ||
|
|
f9989bbf79 | ||
|
|
bb8177928e | ||
|
|
f6fb9033e9 | ||
|
|
804b06283d | ||
|
|
a5cdf78d82 | ||
|
|
638580ba49 | ||
|
|
8803b1c09e | ||
|
|
e69d4026af | ||
|
|
98fd048bdc | ||
|
|
902d7a7583 | ||
|
|
bc36737c45 | ||
|
|
0190e5e737 | ||
|
|
7d6a97af5a | ||
|
|
9743ac5ec4 | ||
|
|
e3bf044741 | ||
|
|
89c9170bdf | ||
|
|
35c98622fc | ||
|
|
cb06284c75 | ||
|
|
4dfcc862e7 | ||
|
|
ae40f3d9f7 | ||
|
|
d66c2d278a | ||
|
|
78f30bc997 | ||
|
|
b4a69516d2 | ||
|
|
226c7647e1 | ||
|
|
26523832f8 | ||
|
|
d262cead57 | ||
|
|
4757df4195 | ||
|
|
76a0394cea | ||
|
|
d46b7183ad | ||
|
|
35bd148037 | ||
|
|
bc301ad7c1 | ||
|
|
0f334449cb | ||
|
|
4f24452d03 | ||
|
|
6e6595f68c | ||
|
|
53785354d3 | ||
|
|
026d4b8bb4 | ||
|
|
3571f543fd |
190
.travis.yml
190
.travis.yml
@ -1,38 +1,158 @@
|
|||||||
sudo: false
|
# This Travis job script has been generated by a script via
|
||||||
|
#
|
||||||
|
# haskell-ci '--config=cabal.haskell-ci' 'servant-quickcheck.cabal'
|
||||||
|
#
|
||||||
|
# To regenerate the script (for example after adjusting tested-with) run
|
||||||
|
#
|
||||||
|
# haskell-ci regenerate
|
||||||
|
#
|
||||||
|
# For more information, see https://github.com/haskell-CI/haskell-ci
|
||||||
|
#
|
||||||
|
# version: 0.10.1
|
||||||
|
#
|
||||||
|
version: ~> 1.0
|
||||||
language: c
|
language: c
|
||||||
|
os: linux
|
||||||
env:
|
dist: xenial
|
||||||
- STACK_YAML=stack.yaml
|
git:
|
||||||
- STACK_YAML=stack-lts-7.yaml
|
# whether to recursively clone submodules
|
||||||
- STACK_YAML=stack-lts-6.yaml
|
submodules: false
|
||||||
- STACK_YAML=stack-lts-9.yaml
|
branches:
|
||||||
|
only:
|
||||||
|
- master
|
||||||
addons:
|
|
||||||
apt:
|
|
||||||
packages: libgmp-dev
|
|
||||||
|
|
||||||
|
|
||||||
install:
|
|
||||||
# stack
|
|
||||||
- mkdir -p ~/.local/bin
|
|
||||||
- export PATH=~/.local/bin:$PATH
|
|
||||||
- travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
|
|
||||||
- stack --version
|
|
||||||
|
|
||||||
script:
|
|
||||||
- stack setup --no-terminal
|
|
||||||
- stack build --ghc-options=-Werror --no-terminal
|
|
||||||
- stack test --ghc-options=-Werror --no-terminal --coverage
|
|
||||||
- stack haddock --no-terminal
|
|
||||||
|
|
||||||
after_script:
|
|
||||||
# SHC only has a build for 8.0.1, not above
|
|
||||||
- if [ "$STACK_YAML" == stack-lts-7.yaml ]
|
|
||||||
- travis_retry curl -L https://github.com/rubik/stack-hpc-coveralls/releases/download/v0.0.4.0/shc-linux-x64-8.0.1.tar.bz2 | tar -xj
|
|
||||||
- ./shc servant-quickcheck spec
|
|
||||||
|
|
||||||
cache:
|
cache:
|
||||||
directories:
|
directories:
|
||||||
- $HOME/.stack
|
- $HOME/.cabal/packages
|
||||||
|
- $HOME/.cabal/store
|
||||||
|
- $HOME/.hlint
|
||||||
|
before_cache:
|
||||||
|
- rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log
|
||||||
|
# remove files that are regenerated by 'cabal update'
|
||||||
|
- rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*
|
||||||
|
- rm -fv $CABALHOME/packages/hackage.haskell.org/*.json
|
||||||
|
- rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache
|
||||||
|
- rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar
|
||||||
|
- rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx
|
||||||
|
- rm -rfv $CABALHOME/packages/head.hackage
|
||||||
|
jobs:
|
||||||
|
include:
|
||||||
|
- compiler: ghc-8.8.3
|
||||||
|
addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.8.3","cabal-install-3.2"]}}
|
||||||
|
os: linux
|
||||||
|
- compiler: ghc-8.6.5
|
||||||
|
addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.6.5","cabal-install-3.2"]}}
|
||||||
|
os: linux
|
||||||
|
- compiler: ghc-8.4.4
|
||||||
|
addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.4.4","cabal-install-3.2"]}}
|
||||||
|
os: linux
|
||||||
|
- compiler: ghc-8.2.2
|
||||||
|
addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.2.2","cabal-install-3.2"]}}
|
||||||
|
os: linux
|
||||||
|
- compiler: ghc-8.0.2
|
||||||
|
addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.0.2","cabal-install-3.2"]}}
|
||||||
|
os: linux
|
||||||
|
before_install:
|
||||||
|
- HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')
|
||||||
|
- WITHCOMPILER="-w $HC"
|
||||||
|
- HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//')
|
||||||
|
- HCPKG="$HC-pkg"
|
||||||
|
- unset CC
|
||||||
|
- CABAL=/opt/ghc/bin/cabal
|
||||||
|
- CABALHOME=$HOME/.cabal
|
||||||
|
- export PATH="$CABALHOME/bin:$PATH"
|
||||||
|
- TOP=$(pwd)
|
||||||
|
- "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')"
|
||||||
|
- echo $HCNUMVER
|
||||||
|
- CABAL="$CABAL -vnormal+nowrap"
|
||||||
|
- set -o pipefail
|
||||||
|
- TEST=--enable-tests
|
||||||
|
- BENCH=--enable-benchmarks
|
||||||
|
- HEADHACKAGE=false
|
||||||
|
- rm -f $CABALHOME/config
|
||||||
|
- |
|
||||||
|
echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config
|
||||||
|
echo "remote-build-reporting: anonymous" >> $CABALHOME/config
|
||||||
|
echo "write-ghc-environment-files: always" >> $CABALHOME/config
|
||||||
|
echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config
|
||||||
|
echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config
|
||||||
|
echo "world-file: $CABALHOME/world" >> $CABALHOME/config
|
||||||
|
echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config
|
||||||
|
echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config
|
||||||
|
echo "installdir: $CABALHOME/bin" >> $CABALHOME/config
|
||||||
|
echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config
|
||||||
|
echo "store-dir: $CABALHOME/store" >> $CABALHOME/config
|
||||||
|
echo "install-dirs user" >> $CABALHOME/config
|
||||||
|
echo " prefix: $CABALHOME" >> $CABALHOME/config
|
||||||
|
echo "repository hackage.haskell.org" >> $CABALHOME/config
|
||||||
|
echo " url: http://hackage.haskell.org/" >> $CABALHOME/config
|
||||||
|
install:
|
||||||
|
- ${CABAL} --version
|
||||||
|
- echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
|
||||||
|
- |
|
||||||
|
echo "program-default-options" >> $CABALHOME/config
|
||||||
|
echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config
|
||||||
|
- cat $CABALHOME/config
|
||||||
|
- rm -fv cabal.project cabal.project.local cabal.project.freeze
|
||||||
|
- travis_retry ${CABAL} v2-update -v
|
||||||
|
# Generate cabal.project
|
||||||
|
- rm -rf cabal.project cabal.project.local cabal.project.freeze
|
||||||
|
- touch cabal.project
|
||||||
|
- |
|
||||||
|
echo "packages: ." >> cabal.project
|
||||||
|
- if [ $HCNUMVER -ge 80200 ] ; then echo 'package servant-quickcheck' >> cabal.project ; fi
|
||||||
|
- "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi"
|
||||||
|
- |
|
||||||
|
- "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(servant-quickcheck)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
|
||||||
|
- cat cabal.project || true
|
||||||
|
- cat cabal.project.local || true
|
||||||
|
- if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi
|
||||||
|
- ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH}
|
||||||
|
- "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"
|
||||||
|
- rm cabal.project.freeze
|
||||||
|
- travis_wait 40 ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all
|
||||||
|
- travis_wait 40 ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all
|
||||||
|
script:
|
||||||
|
- DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
|
||||||
|
# Packaging...
|
||||||
|
- ${CABAL} v2-sdist all
|
||||||
|
# Unpacking...
|
||||||
|
- mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/
|
||||||
|
- cd ${DISTDIR} || false
|
||||||
|
- find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \;
|
||||||
|
- find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \;
|
||||||
|
- PKGDIR_servant_quickcheck="$(find . -maxdepth 1 -type d -regex '.*/servant-quickcheck-[0-9.]*')"
|
||||||
|
# Generate cabal.project
|
||||||
|
- rm -rf cabal.project cabal.project.local cabal.project.freeze
|
||||||
|
- touch cabal.project
|
||||||
|
- |
|
||||||
|
echo "packages: ${PKGDIR_servant_quickcheck}" >> cabal.project
|
||||||
|
- if [ $HCNUMVER -ge 80200 ] ; then echo 'package servant-quickcheck' >> cabal.project ; fi
|
||||||
|
- "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi"
|
||||||
|
- |
|
||||||
|
- "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(servant-quickcheck)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
|
||||||
|
- cat cabal.project || true
|
||||||
|
- cat cabal.project.local || true
|
||||||
|
# Building...
|
||||||
|
# this builds all libraries and executables (without tests/benchmarks)
|
||||||
|
- ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all
|
||||||
|
# Building with tests and benchmarks...
|
||||||
|
# build & run tests, build benchmarks
|
||||||
|
- ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all
|
||||||
|
# Testing...
|
||||||
|
- ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all
|
||||||
|
# cabal check...
|
||||||
|
- (cd ${PKGDIR_servant_quickcheck} && ${CABAL} -vnormal check)
|
||||||
|
# haddock...
|
||||||
|
- ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all
|
||||||
|
# Building without installed constraints for packages in global-db...
|
||||||
|
- rm -f cabal.project.local
|
||||||
|
- ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all
|
||||||
|
# Constraint sets
|
||||||
|
- rm -rf cabal.project.local
|
||||||
|
# Constraint set base-compat-0.10
|
||||||
|
- ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --constraint='base-compat ==0.10.*' all
|
||||||
|
# Constraint set base-compat-0.11
|
||||||
|
- ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --constraint='base-compat ==0.11.*' all
|
||||||
|
|
||||||
|
# REGENDATA ("0.10.1",["--config=cabal.haskell-ci","servant-quickcheck.cabal"])
|
||||||
|
# EOF
|
||||||
|
|||||||
105
CHANGELOG.yaml
105
CHANGELOG.yaml
@ -1,15 +1,112 @@
|
|||||||
upcoming:
|
|
||||||
|
|
||||||
releases:
|
releases:
|
||||||
|
- version: "0.0.9.0"
|
||||||
- version: "0.0.3.1"
|
|
||||||
changes:
|
changes:
|
||||||
|
- description: "Support servant-0.15 (#65)"
|
||||||
|
authors: fizruk
|
||||||
|
date: 2020-06-25
|
||||||
|
|
||||||
|
- description: "Relax constraints for GHC 8.10 (#70)"
|
||||||
|
authors: felixmulder
|
||||||
|
date: 2020-06-20
|
||||||
|
|
||||||
|
- version: "0.0.8.0"
|
||||||
|
changes:
|
||||||
|
- description: Support for servant-0.17
|
||||||
|
authors: phadej
|
||||||
|
date: 2019-01-23
|
||||||
|
|
||||||
|
- version: "0.0.7.3"
|
||||||
|
changes:
|
||||||
|
- description: Support for servant-0.14
|
||||||
|
issue: 53
|
||||||
|
authors: phadej
|
||||||
|
date: 2018-06-12
|
||||||
|
|
||||||
|
- description: Fix a failure from OnlyJsonObjects when there is no content-type.
|
||||||
|
issue: 55
|
||||||
|
authors: Phenitei
|
||||||
|
date: 2018-08-27
|
||||||
|
|
||||||
|
- description: A bug fix where notAllowedContainsAllowHeader would print the initial request alongside the failure instead of the request causing the failure when it failed.
|
||||||
|
issue: 57
|
||||||
|
authors: Phenitei
|
||||||
|
date: 2018-08-29
|
||||||
|
|
||||||
|
- description: QuickCheck 2.12 compatibility
|
||||||
|
issue: 58
|
||||||
|
authors: parsonsmatt
|
||||||
|
date: 2018-10-12
|
||||||
|
|
||||||
|
- description: GHC 8.6 compatibility
|
||||||
|
issue: 59
|
||||||
|
authors: phadej
|
||||||
|
date: 2018-10-15
|
||||||
|
|
||||||
|
- version: "0.0.7.2"
|
||||||
|
changes:
|
||||||
|
|
||||||
|
- description: Allow client to pass an HTTP Manager in to functions
|
||||||
|
issue: 47
|
||||||
|
authors: parsonsmatt
|
||||||
|
date: 2018-05-10
|
||||||
|
|
||||||
|
- description: Fix "should not happen" error when exceptions are thrown
|
||||||
|
issue: 48
|
||||||
|
authors: parsonsmatt
|
||||||
|
date: 2018-05-10
|
||||||
|
|
||||||
|
- version: "0.0.7.0"
|
||||||
|
changes:
|
||||||
|
|
||||||
|
- description: Support for base-compat-0.10
|
||||||
|
issue: none
|
||||||
|
authors: phadej
|
||||||
|
date: 2018-04-12
|
||||||
|
|
||||||
|
- version: "0.0.7.0"
|
||||||
|
changes:
|
||||||
|
|
||||||
|
- description: Support for GHC-8.4.1
|
||||||
|
issue: none
|
||||||
|
authors: phadej
|
||||||
|
date: 2018-03-23
|
||||||
|
|
||||||
|
- description: Requires hspec-2.5
|
||||||
|
issue: none
|
||||||
|
authors: phadej
|
||||||
|
date: 2018-03-23
|
||||||
|
|
||||||
|
- version: "0.0.6.0"
|
||||||
|
changes:
|
||||||
|
|
||||||
|
- description: Support for servant-0.12
|
||||||
|
issue: none
|
||||||
|
authors: phadej
|
||||||
|
date: 2018-02-09
|
||||||
|
|
||||||
|
- version: "0.0.5.0"
|
||||||
|
changes:
|
||||||
|
|
||||||
|
- description: Export forgotten predicates
|
||||||
|
issue: none
|
||||||
|
pr: 40
|
||||||
|
authors: Phenitei
|
||||||
|
date: 2017-12-14
|
||||||
|
|
||||||
|
- version: "0.0.4"
|
||||||
|
changes:
|
||||||
|
|
||||||
|
- description: Support for Servant 0.12
|
||||||
|
issue: none
|
||||||
|
authors: phadej
|
||||||
|
date: 2017-11-07
|
||||||
|
|
||||||
- description: Support for Servant 0.11
|
- description: Support for Servant 0.11
|
||||||
issue: none
|
issue: none
|
||||||
pr: 32
|
pr: 32
|
||||||
authors: adinapoli-iohk
|
authors: adinapoli-iohk
|
||||||
date: 2017-10-18
|
date: 2017-10-18
|
||||||
|
notes: Includes 0-weighted instance for EmptyAPI
|
||||||
|
|
||||||
- version: "0.0.3.0"
|
- version: "0.0.3.0"
|
||||||
changes:
|
changes:
|
||||||
|
|||||||
7
cabal.haskell-ci
Normal file
7
cabal.haskell-ci
Normal file
@ -0,0 +1,7 @@
|
|||||||
|
branches: master
|
||||||
|
|
||||||
|
constraint-set base-compat-0.10
|
||||||
|
constraints: base-compat ==0.10.*
|
||||||
|
|
||||||
|
constraint-set base-compat-0.11
|
||||||
|
constraints: base-compat ==0.11.*
|
||||||
4
cabal.project
Normal file
4
cabal.project
Normal file
@ -0,0 +1,4 @@
|
|||||||
|
packages: .
|
||||||
|
tests: true
|
||||||
|
|
||||||
|
allow-newer: servant-blaze:servant
|
||||||
31
example/Main.hs
Normal file
31
example/Main.hs
Normal file
@ -0,0 +1,31 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings, DataKinds #-}
|
||||||
|
module Main (main) where
|
||||||
|
|
||||||
|
import Servant
|
||||||
|
import Servant.QuickCheck
|
||||||
|
import Test.Hspec
|
||||||
|
import Data.Text (Text)
|
||||||
|
import System.Environment (getArgs)
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = do
|
||||||
|
args <- getArgs
|
||||||
|
case args of
|
||||||
|
[] -> putStrLn "Not running without arguments. Try --help or --fail-fast."
|
||||||
|
_ -> hspec spec
|
||||||
|
|
||||||
|
-- Change to String to reproduce
|
||||||
|
-- https://github.com/haskell-servant/servant-quickcheck/issues/41
|
||||||
|
type API = Get '[PlainText] Text
|
||||||
|
|
||||||
|
api :: Proxy API
|
||||||
|
api = Proxy
|
||||||
|
|
||||||
|
server :: Server API
|
||||||
|
server = return "Sigurð Fáfnirslayer"
|
||||||
|
|
||||||
|
spec :: Spec
|
||||||
|
spec = describe "example server" $
|
||||||
|
it "mangles UTF-8 in error messages" $
|
||||||
|
withServantServer api (return server) $ \burl ->
|
||||||
|
serverSatisfies api burl defaultArgs (getsHaveCacheControlHeader <%> mempty)
|
||||||
@ -1,22 +1,22 @@
|
|||||||
name: servant-quickcheck
|
name: servant-quickcheck
|
||||||
version: 0.0.3.1
|
version: 0.0.9.1
|
||||||
synopsis: QuickCheck entire APIs
|
synopsis: QuickCheck entire APIs
|
||||||
description:
|
description:
|
||||||
This packages provides QuickCheck properties that are tested across an entire
|
This packages provides QuickCheck properties that are tested across an entire
|
||||||
API.
|
API.
|
||||||
|
|
||||||
license: BSD3
|
license: BSD3
|
||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
author: Julian K. Arni
|
author: Julian K. Arni
|
||||||
maintainer: jkarni@gmail.com
|
maintainer: jkarni@gmail.com
|
||||||
category: Web
|
category: Web
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
cabal-version: >=1.10
|
||||||
extra-source-files:
|
extra-source-files: CHANGELOG.yaml
|
||||||
CHANGELOG.yaml
|
tested-with: GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || == 8.8.3
|
||||||
|
|
||||||
source-repository head
|
source-repository head
|
||||||
type: git
|
type: git
|
||||||
location: https://github.com/haskell-servant/servant-quickcheck
|
location: https://github.com/haskell-servant/servant-quickcheck
|
||||||
|
|
||||||
flag long-tests
|
flag long-tests
|
||||||
@ -24,88 +24,115 @@ flag long-tests
|
|||||||
default: False
|
default: False
|
||||||
|
|
||||||
library
|
library
|
||||||
exposed-modules: Servant.QuickCheck
|
exposed-modules:
|
||||||
, Servant.QuickCheck.Internal
|
Servant.QuickCheck
|
||||||
, Servant.QuickCheck.Internal.Predicates
|
Servant.QuickCheck.Internal
|
||||||
, Servant.QuickCheck.Internal.HasGenRequest
|
Servant.QuickCheck.Internal.Equality
|
||||||
, Servant.QuickCheck.Internal.QuickCheck
|
Servant.QuickCheck.Internal.ErrorTypes
|
||||||
, Servant.QuickCheck.Internal.Equality
|
Servant.QuickCheck.Internal.HasGenRequest
|
||||||
, Servant.QuickCheck.Internal.ErrorTypes
|
Servant.QuickCheck.Internal.Predicates
|
||||||
build-depends: base >=4.8 && <4.10
|
Servant.QuickCheck.Internal.QuickCheck
|
||||||
, base-compat == 0.9.*
|
|
||||||
, aeson > 0.8 && < 2
|
|
||||||
, bytestring == 0.10.*
|
|
||||||
, case-insensitive == 1.2.*
|
|
||||||
, clock >= 0.7 && < 0.8
|
|
||||||
, data-default-class >= 0.0 && < 0.2
|
|
||||||
, hspec >= 2.2 && < 2.5
|
|
||||||
, http-client >= 0.4.30 && < 0.6
|
|
||||||
, http-media == 0.6.*
|
|
||||||
, http-types > 0.8 && < 0.10
|
|
||||||
, mtl > 2.1 && < 2.3
|
|
||||||
, pretty == 1.1.*
|
|
||||||
, process >= 1.2 && < 1.5
|
|
||||||
, QuickCheck > 2.7 && < 2.11
|
|
||||||
, servant > 0.6 && < 0.12
|
|
||||||
, servant-client > 0.6 && < 0.12
|
|
||||||
, servant-server > 0.6 && < 0.12
|
|
||||||
, split == 0.2.*
|
|
||||||
, string-conversions > 0.3 && < 0.5
|
|
||||||
, temporary == 1.2.*
|
|
||||||
, text == 1.*
|
|
||||||
, time >= 1.5 && < 1.7
|
|
||||||
, warp >= 3.2.4 && < 3.3
|
|
||||||
|
|
||||||
hs-source-dirs: src
|
build-depends:
|
||||||
default-extensions: TypeOperators
|
aeson >=0.8 && <2
|
||||||
, FlexibleInstances
|
, base >=4.9 && <4.15
|
||||||
, FlexibleContexts
|
, base-compat-batteries >=0.10.1 && <0.12
|
||||||
, DataKinds
|
, bytestring >=0.10 && <0.11
|
||||||
, GADTs
|
, case-insensitive >=1.2 && <1.3
|
||||||
, MultiParamTypeClasses
|
, clock >=0.7 && <0.9
|
||||||
, DeriveFunctor
|
, data-default-class >=0.0 && <0.2
|
||||||
, KindSignatures
|
, hspec >=2.5.6 && <2.8
|
||||||
, RankNTypes
|
, http-client >=0.4.30 && <0.8
|
||||||
, ConstraintKinds
|
, http-media >=0.6 && <0.9
|
||||||
, DeriveGeneric
|
, http-types >=0.8 && <0.13
|
||||||
, ScopedTypeVariables
|
, mtl >=2.1 && <2.3
|
||||||
, OverloadedStrings
|
, pretty >=1.1 && <1.2
|
||||||
, FunctionalDependencies
|
, process >=1.2 && <1.7
|
||||||
, NoImplicitPrelude
|
, QuickCheck >=2.7 && <2.15
|
||||||
, DeriveDataTypeable
|
, servant >=0.17 && <0.19
|
||||||
default-language: Haskell2010
|
, servant-client >=0.17 && <0.19
|
||||||
|
, servant-server >=0.17 && <0.19
|
||||||
|
, split >=0.2 && <0.3
|
||||||
|
, string-conversions >=0.3 && <0.5
|
||||||
|
, temporary >=1.2 && <1.4
|
||||||
|
, text >=1 && <2
|
||||||
|
, time >=1.5 && <1.11
|
||||||
|
, warp >=3.2.4 && <3.4
|
||||||
|
|
||||||
|
if !impl(ghc >=8.0)
|
||||||
|
build-depends: semigroups >=0.18.3 && <0.20
|
||||||
|
|
||||||
|
hs-source-dirs: src
|
||||||
|
default-extensions:
|
||||||
|
NoImplicitPrelude
|
||||||
|
ConstraintKinds
|
||||||
|
DataKinds
|
||||||
|
DeriveDataTypeable
|
||||||
|
DeriveFunctor
|
||||||
|
DeriveGeneric
|
||||||
|
FlexibleContexts
|
||||||
|
FlexibleInstances
|
||||||
|
FunctionalDependencies
|
||||||
|
GADTs
|
||||||
|
KindSignatures
|
||||||
|
MultiParamTypeClasses
|
||||||
|
OverloadedStrings
|
||||||
|
RankNTypes
|
||||||
|
ScopedTypeVariables
|
||||||
|
TypeOperators
|
||||||
|
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
test-suite spec
|
test-suite spec
|
||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
ghc-options: -Wall -threaded
|
ghc-options: -Wall -threaded
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
hs-source-dirs: test
|
hs-source-dirs: test
|
||||||
main-is: Spec.hs
|
main-is: Spec.hs
|
||||||
other-modules: Servant.QuickCheck.InternalSpec
|
other-modules: Servant.QuickCheck.InternalSpec
|
||||||
build-depends: base == 4.*
|
build-tool-depends: hspec-discover:hspec-discover -any
|
||||||
, base-compat
|
build-depends:
|
||||||
, aeson
|
aeson
|
||||||
, servant-quickcheck
|
, base
|
||||||
, bytestring
|
, base-compat-batteries
|
||||||
, hspec
|
, blaze-html
|
||||||
, hspec-core
|
, bytestring
|
||||||
, http-client
|
, hspec
|
||||||
, blaze-html
|
, hspec-core >=2.5.5 && <2.8
|
||||||
, warp
|
, http-client
|
||||||
, servant-server
|
, QuickCheck
|
||||||
, servant-client
|
, quickcheck-io
|
||||||
, servant
|
, servant
|
||||||
, servant-blaze
|
, servant-blaze
|
||||||
, transformers
|
, servant-client
|
||||||
, QuickCheck
|
, servant-quickcheck
|
||||||
, quickcheck-io
|
, servant-server
|
||||||
default-extensions: TypeOperators
|
, transformers
|
||||||
, FlexibleInstances
|
, warp
|
||||||
, FlexibleContexts
|
|
||||||
, GADTs
|
default-extensions:
|
||||||
, DataKinds
|
NoImplicitPrelude
|
||||||
, NoImplicitPrelude
|
DataKinds
|
||||||
, OverloadedStrings
|
FlexibleContexts
|
||||||
, ScopedTypeVariables
|
FlexibleInstances
|
||||||
|
GADTs
|
||||||
|
OverloadedStrings
|
||||||
|
ScopedTypeVariables
|
||||||
|
TypeOperators
|
||||||
|
|
||||||
if flag(long-tests)
|
if flag(long-tests)
|
||||||
cpp-options: -DLONG_TESTS
|
cpp-options: -DLONG_TESTS
|
||||||
|
|
||||||
|
test-suite example
|
||||||
|
type: exitcode-stdio-1.0
|
||||||
|
main-is: Main.hs
|
||||||
|
hs-source-dirs: example
|
||||||
|
ghc-options: -Wall
|
||||||
|
build-depends:
|
||||||
|
base
|
||||||
|
, hspec
|
||||||
|
, servant-quickcheck
|
||||||
|
, servant-server
|
||||||
|
, text
|
||||||
|
|
||||||
|
default-language: Haskell2010
|
||||||
|
|||||||
@ -29,8 +29,10 @@ module Servant.QuickCheck
|
|||||||
, not500
|
, not500
|
||||||
, notLongerThan
|
, notLongerThan
|
||||||
, onlyJsonObjects
|
, onlyJsonObjects
|
||||||
|
, honoursAcceptHeader
|
||||||
, notAllowedContainsAllowHeader
|
, notAllowedContainsAllowHeader
|
||||||
, unauthorizedContainsWWWAuthenticate
|
, unauthorizedContainsWWWAuthenticate
|
||||||
|
, getsHaveLastModifiedHeader
|
||||||
, getsHaveCacheControlHeader
|
, getsHaveCacheControlHeader
|
||||||
, headsHaveCacheControlHeader
|
, headsHaveCacheControlHeader
|
||||||
, createContainsValidLocation
|
, createContainsValidLocation
|
||||||
|
|||||||
@ -5,15 +5,19 @@ import Data.ByteString (ByteString)
|
|||||||
import qualified Data.ByteString.Lazy as LB
|
import qualified Data.ByteString.Lazy as LB
|
||||||
import Data.Function (on)
|
import Data.Function (on)
|
||||||
import Network.HTTP.Client (Response, responseBody)
|
import Network.HTTP.Client (Response, responseBody)
|
||||||
|
import Data.Semigroup (Semigroup (..))
|
||||||
import Prelude.Compat
|
import Prelude.Compat
|
||||||
|
|
||||||
newtype ResponseEquality b
|
newtype ResponseEquality b
|
||||||
= ResponseEquality { getResponseEquality :: Response b -> Response b -> Bool }
|
= ResponseEquality { getResponseEquality :: Response b -> Response b -> Bool }
|
||||||
|
|
||||||
|
instance Semigroup (ResponseEquality b) where
|
||||||
|
ResponseEquality a <> ResponseEquality b = ResponseEquality $ \x y ->
|
||||||
|
a x y && b x y
|
||||||
|
|
||||||
instance Monoid (ResponseEquality b) where
|
instance Monoid (ResponseEquality b) where
|
||||||
mempty = ResponseEquality $ \_ _ -> True
|
mempty = ResponseEquality $ \_ _ -> True
|
||||||
ResponseEquality a `mappend` ResponseEquality b = ResponseEquality $ \x y ->
|
mappend = (<>)
|
||||||
a x y && b x y
|
|
||||||
|
|
||||||
-- | Use `Eq` instance for `Response`
|
-- | Use `Eq` instance for `Response`
|
||||||
--
|
--
|
||||||
|
|||||||
@ -1,3 +1,4 @@
|
|||||||
|
{-# LANGUAGE CPP #-}
|
||||||
module Servant.QuickCheck.Internal.ErrorTypes where
|
module Servant.QuickCheck.Internal.ErrorTypes where
|
||||||
|
|
||||||
import Control.Exception (Exception (..))
|
import Control.Exception (Exception (..))
|
||||||
@ -8,9 +9,10 @@ import Data.Typeable (Typeable)
|
|||||||
import GHC.Generics (Generic)
|
import GHC.Generics (Generic)
|
||||||
import qualified Network.HTTP.Client as C
|
import qualified Network.HTTP.Client as C
|
||||||
import Network.HTTP.Types (Header, statusCode)
|
import Network.HTTP.Types (Header, statusCode)
|
||||||
import Prelude.Compat
|
|
||||||
import Text.PrettyPrint
|
import Text.PrettyPrint
|
||||||
|
|
||||||
|
import Prelude.Compat hiding ((<>))
|
||||||
|
|
||||||
data PredicateFailure
|
data PredicateFailure
|
||||||
= PredicateFailure T.Text (Maybe C.Request) (C.Response LBS.ByteString)
|
= PredicateFailure T.Text (Maybe C.Request) (C.Response LBS.ByteString)
|
||||||
deriving (Typeable, Generic)
|
deriving (Typeable, Generic)
|
||||||
|
|||||||
@ -2,7 +2,6 @@
|
|||||||
{-# LANGUAGE PolyKinds #-}
|
{-# LANGUAGE PolyKinds #-}
|
||||||
module Servant.QuickCheck.Internal.HasGenRequest where
|
module Servant.QuickCheck.Internal.HasGenRequest where
|
||||||
|
|
||||||
import Data.Monoid ((<>))
|
|
||||||
import Data.String (fromString)
|
import Data.String (fromString)
|
||||||
import Data.String.Conversions (cs)
|
import Data.String.Conversions (cs)
|
||||||
import GHC.TypeLits (KnownSymbol, Nat, symbolVal)
|
import GHC.TypeLits (KnownSymbol, Nat, symbolVal)
|
||||||
@ -64,13 +63,17 @@ instance (KnownSymbol path, HasGenRequest b) => HasGenRequest (path :> b) where
|
|||||||
(oldf, old) = genRequest (Proxy :: Proxy b)
|
(oldf, old) = genRequest (Proxy :: Proxy b)
|
||||||
new = cs $ symbolVal (Proxy :: Proxy path)
|
new = cs $ symbolVal (Proxy :: Proxy path)
|
||||||
|
|
||||||
#if MIN_VERSION_servant(0,11,0)
|
|
||||||
instance HasGenRequest EmptyAPI where
|
instance HasGenRequest EmptyAPI where
|
||||||
genRequest _ = (0, error "EmptyAPIs cannot be queried.")
|
genRequest _ = (0, error "EmptyAPIs cannot be queried.")
|
||||||
#endif
|
|
||||||
|
instance HasGenRequest api => HasGenRequest (Summary d :> api) where
|
||||||
|
genRequest _ = genRequest (Proxy :: Proxy api)
|
||||||
|
|
||||||
|
instance HasGenRequest api => HasGenRequest (Description d :> api) where
|
||||||
|
genRequest _ = genRequest (Proxy :: Proxy api)
|
||||||
|
|
||||||
instance (Arbitrary c, HasGenRequest b, ToHttpApiData c )
|
instance (Arbitrary c, HasGenRequest b, ToHttpApiData c )
|
||||||
=> HasGenRequest (Capture x c :> b) where
|
=> HasGenRequest (Capture' mods x c :> b) where
|
||||||
genRequest _ = (oldf, do
|
genRequest _ = (oldf, do
|
||||||
old' <- old
|
old' <- old
|
||||||
new' <- toUrlPiece <$> new
|
new' <- toUrlPiece <$> new
|
||||||
@ -79,7 +82,6 @@ instance (Arbitrary c, HasGenRequest b, ToHttpApiData c )
|
|||||||
(oldf, old) = genRequest (Proxy :: Proxy b)
|
(oldf, 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 )
|
instance (Arbitrary c, HasGenRequest b, ToHttpApiData c )
|
||||||
=> HasGenRequest (CaptureAll x c :> b) where
|
=> HasGenRequest (CaptureAll x c :> b) where
|
||||||
genRequest _ = (oldf, do
|
genRequest _ = (oldf, do
|
||||||
@ -90,13 +92,12 @@ instance (Arbitrary c, HasGenRequest b, ToHttpApiData c )
|
|||||||
where
|
where
|
||||||
(oldf, old) = genRequest (Proxy :: Proxy b)
|
(oldf, old) = genRequest (Proxy :: Proxy b)
|
||||||
new = arbitrary :: Gen [c]
|
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' mods h c :> b) where
|
||||||
genRequest _ = (oldf, do
|
genRequest _ = (oldf, do
|
||||||
old' <- old
|
old' <- old
|
||||||
new' <- toUrlPiece <$> new
|
new' <- toUrlPiece <$> new -- TODO: generate lenient or/and optional
|
||||||
return $ \burl -> let r = old' burl in r {
|
return $ \burl -> let r = old' burl in r {
|
||||||
requestHeaders = (hdr, cs new') : requestHeaders r })
|
requestHeaders = (hdr, cs new') : requestHeaders r })
|
||||||
where
|
where
|
||||||
@ -105,9 +106,9 @@ instance (Arbitrary c, KnownSymbol h, HasGenRequest b, ToHttpApiData c)
|
|||||||
new = arbitrary :: Gen c
|
new = arbitrary :: Gen c
|
||||||
|
|
||||||
instance (AllMimeRender x c, Arbitrary c, HasGenRequest b)
|
instance (AllMimeRender x c, Arbitrary c, HasGenRequest b)
|
||||||
=> HasGenRequest (ReqBody x c :> b) where
|
=> HasGenRequest (ReqBody' mods x c :> b) where
|
||||||
genRequest _ = (oldf, do
|
genRequest _ = (oldf, do
|
||||||
old' <- old
|
old' <- old -- TODO: generate lenient
|
||||||
new' <- new
|
new' <- new
|
||||||
(ct, bd) <- elements $ allMimeRender (Proxy :: Proxy x) new'
|
(ct, bd) <- elements $ allMimeRender (Proxy :: Proxy x) new'
|
||||||
return $ \burl -> let r = old' burl in r {
|
return $ \burl -> let r = old' burl in r {
|
||||||
@ -119,9 +120,9 @@ instance (AllMimeRender x c, Arbitrary c, HasGenRequest b)
|
|||||||
new = arbitrary :: Gen c
|
new = arbitrary :: Gen c
|
||||||
|
|
||||||
instance (KnownSymbol x, Arbitrary c, ToHttpApiData c, HasGenRequest b)
|
instance (KnownSymbol x, Arbitrary c, ToHttpApiData c, HasGenRequest b)
|
||||||
=> HasGenRequest (QueryParam x c :> b) where
|
=> HasGenRequest (QueryParam' mods x c :> b) where
|
||||||
genRequest _ = (oldf, do
|
genRequest _ = (oldf, do
|
||||||
new' <- new
|
new' <- new -- TODO: generate lenient or/and optional
|
||||||
old' <- old
|
old' <- old
|
||||||
return $ \burl -> let r = old' burl
|
return $ \burl -> let r = old' burl
|
||||||
newExpr = param <> "=" <> cs (toQueryParam new')
|
newExpr = param <> "=" <> cs (toQueryParam new')
|
||||||
@ -167,6 +168,15 @@ instance (ReflectMethod method)
|
|||||||
, method = reflectMethod (Proxy :: Proxy method)
|
, method = reflectMethod (Proxy :: Proxy method)
|
||||||
})
|
})
|
||||||
|
|
||||||
|
instance (ReflectMethod method)
|
||||||
|
=> HasGenRequest (NoContentVerb (method :: k)) where
|
||||||
|
genRequest _ = (1, return $ \burl -> defaultRequest
|
||||||
|
{ host = cs $ baseUrlHost burl
|
||||||
|
, port = baseUrlPort burl
|
||||||
|
, secure = baseUrlScheme burl == Https
|
||||||
|
, method = reflectMethod (Proxy :: Proxy method)
|
||||||
|
})
|
||||||
|
|
||||||
instance (HasGenRequest a) => HasGenRequest (RemoteHost :> a) where
|
instance (HasGenRequest a) => HasGenRequest (RemoteHost :> a) where
|
||||||
genRequest _ = genRequest (Proxy :: Proxy a)
|
genRequest _ = genRequest (Proxy :: Proxy a)
|
||||||
|
|
||||||
|
|||||||
@ -11,7 +11,7 @@ import Data.CaseInsensitive (foldCase, foldedCase, mk)
|
|||||||
import Data.Either (isRight)
|
import Data.Either (isRight)
|
||||||
import Data.List.Split (wordsBy)
|
import Data.List.Split (wordsBy)
|
||||||
import Data.Maybe (fromMaybe, isJust)
|
import Data.Maybe (fromMaybe, isJust)
|
||||||
import Data.Monoid ((<>))
|
import Data.Semigroup (Semigroup (..))
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.Time (UTCTime, defaultTimeLocale, parseTimeM,
|
import Data.Time (UTCTime, defaultTimeLocale, parseTimeM,
|
||||||
rfc822DateFormat)
|
rfc822DateFormat)
|
||||||
@ -84,15 +84,13 @@ notLongerThan maxAllowed
|
|||||||
-- /Since 0.0.0.0/
|
-- /Since 0.0.0.0/
|
||||||
onlyJsonObjects :: ResponsePredicate
|
onlyJsonObjects :: ResponsePredicate
|
||||||
onlyJsonObjects
|
onlyJsonObjects
|
||||||
= ResponsePredicate (\resp -> case go resp of
|
= ResponsePredicate (\resp -> do
|
||||||
Nothing -> throw $ PredicateFailure "onlyJsonObjects" Nothing resp
|
case lookup "content-type" (first foldedCase <$> responseHeaders resp) of
|
||||||
Just () -> return ())
|
Nothing -> return ()
|
||||||
where
|
Just ctype -> when ("application/json" `SBS.isPrefixOf` ctype) $ do
|
||||||
go r = do
|
case (decode (responseBody resp) :: Maybe Object) of
|
||||||
ctyp <- lookup "content-type" (first foldedCase <$> responseHeaders r)
|
Nothing -> throw $ PredicateFailure "onlyJsonObjects" Nothing resp
|
||||||
when ("application/json" `SBS.isPrefixOf` ctyp) $ do
|
Just _ -> return ())
|
||||||
(_ :: Object) <- decode (responseBody r)
|
|
||||||
return ()
|
|
||||||
|
|
||||||
-- | __Optional__
|
-- | __Optional__
|
||||||
--
|
--
|
||||||
@ -189,14 +187,15 @@ getsHaveLastModifiedHeader
|
|||||||
notAllowedContainsAllowHeader :: RequestPredicate
|
notAllowedContainsAllowHeader :: RequestPredicate
|
||||||
notAllowedContainsAllowHeader
|
notAllowedContainsAllowHeader
|
||||||
= RequestPredicate $ \req mgr -> do
|
= RequestPredicate $ \req mgr -> do
|
||||||
resp <- mapM (flip httpLbs mgr) $ [ req { method = renderStdMethod m }
|
let reqs = [ req { method = renderStdMethod m } | m <- [minBound .. maxBound]
|
||||||
| m <- [minBound .. maxBound ]
|
, renderStdMethod m /= method req ]
|
||||||
, renderStdMethod m /= method req ]
|
resp <- mapM (flip httpLbs mgr) reqs
|
||||||
case filter pred' resp of
|
|
||||||
(x:_) -> throw $ PredicateFailure "notAllowedContainsAllowHeader" (Just req) x
|
case filter pred' (zip reqs resp) of
|
||||||
|
(x:_) -> throw $ PredicateFailure "notAllowedContainsAllowHeader" (Just $ fst x) (snd x)
|
||||||
[] -> return resp
|
[] -> return resp
|
||||||
where
|
where
|
||||||
pred' resp = responseStatus resp == status405 && not (hasValidHeader "Allow" go resp)
|
pred' (_, resp) = responseStatus resp == status405 && not (hasValidHeader "Allow" go resp)
|
||||||
where
|
where
|
||||||
go x = all (\y -> isRight $ parseMethod $ SBSC.pack y)
|
go x = all (\y -> isRight $ parseMethod $ SBSC.pack y)
|
||||||
$ wordsBy (`elem` (", " :: [Char])) (SBSC.unpack x)
|
$ wordsBy (`elem` (", " :: [Char])) (SBSC.unpack x)
|
||||||
@ -377,9 +376,12 @@ newtype ResponsePredicate = ResponsePredicate
|
|||||||
{ getResponsePredicate :: Response LBS.ByteString -> IO ()
|
{ getResponsePredicate :: Response LBS.ByteString -> IO ()
|
||||||
} deriving (Generic)
|
} deriving (Generic)
|
||||||
|
|
||||||
|
instance Semigroup ResponsePredicate where
|
||||||
|
ResponsePredicate a <> ResponsePredicate b = ResponsePredicate $ \x -> a x >> b x
|
||||||
|
|
||||||
instance Monoid ResponsePredicate where
|
instance Monoid ResponsePredicate where
|
||||||
mempty = ResponsePredicate $ const $ return ()
|
mempty = ResponsePredicate $ const $ return ()
|
||||||
ResponsePredicate a `mappend` ResponsePredicate b = ResponsePredicate $ \x -> a x >> b x
|
mappend = (<>)
|
||||||
|
|
||||||
-- | A predicate that depends on both the request and the response.
|
-- | A predicate that depends on both the request and the response.
|
||||||
--
|
--
|
||||||
@ -391,7 +393,11 @@ newtype RequestPredicate = RequestPredicate
|
|||||||
-- TODO: This isn't actually a monoid
|
-- TODO: This isn't actually a monoid
|
||||||
instance Monoid RequestPredicate where
|
instance Monoid RequestPredicate where
|
||||||
mempty = RequestPredicate (\r m -> httpLbs r m >>= \x -> return ([x]))
|
mempty = RequestPredicate (\r m -> httpLbs r m >>= \x -> return ([x]))
|
||||||
RequestPredicate a `mappend` RequestPredicate b = RequestPredicate $ \r mgr ->
|
mappend = (<>)
|
||||||
|
|
||||||
|
-- TODO: This isn't actually a monoid
|
||||||
|
instance Semigroup RequestPredicate where
|
||||||
|
RequestPredicate a <> RequestPredicate b = RequestPredicate $ \r mgr ->
|
||||||
liftM2 (<>) (a r mgr) (b r mgr)
|
liftM2 (<>) (a r mgr) (b r mgr)
|
||||||
|
|
||||||
-- | A set of predicates. Construct one with 'mempty' and '<%>'.
|
-- | A set of predicates. Construct one with 'mempty' and '<%>'.
|
||||||
@ -400,10 +406,13 @@ data Predicates = Predicates
|
|||||||
, responsePredicates :: ResponsePredicate
|
, responsePredicates :: ResponsePredicate
|
||||||
} deriving (Generic)
|
} deriving (Generic)
|
||||||
|
|
||||||
|
instance Semigroup Predicates where
|
||||||
|
a <> b = Predicates (requestPredicates a <> requestPredicates b)
|
||||||
|
(responsePredicates a <> responsePredicates b)
|
||||||
|
|
||||||
instance Monoid Predicates where
|
instance Monoid Predicates where
|
||||||
mempty = Predicates mempty mempty
|
mempty = Predicates mempty mempty
|
||||||
a `mappend` b = Predicates (requestPredicates a <> requestPredicates b)
|
mappend = (<>)
|
||||||
(responsePredicates a <> responsePredicates b)
|
|
||||||
|
|
||||||
class JoinPreds a where
|
class JoinPreds a where
|
||||||
joinPreds :: a -> Predicates -> Predicates
|
joinPreds :: a -> Predicates -> Predicates
|
||||||
|
|||||||
@ -2,7 +2,7 @@
|
|||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
module Servant.QuickCheck.Internal.QuickCheck where
|
module Servant.QuickCheck.Internal.QuickCheck where
|
||||||
|
|
||||||
import Control.Concurrent (modifyMVar_, newMVar, readMVar)
|
import Control.Concurrent (tryReadMVar, newEmptyMVar, tryPutMVar)
|
||||||
import Control.Monad (unless)
|
import Control.Monad (unless)
|
||||||
import qualified Data.ByteString.Lazy as LBS
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
import Data.Proxy (Proxy)
|
import Data.Proxy (Proxy)
|
||||||
@ -11,6 +11,9 @@ import Network.Wai.Handler.Warp (withApplication)
|
|||||||
import Prelude.Compat
|
import Prelude.Compat
|
||||||
import Servant (Context (EmptyContext), HasServer,
|
import Servant (Context (EmptyContext), HasServer,
|
||||||
Server, serveWithContext)
|
Server, serveWithContext)
|
||||||
|
#if MIN_VERSION_servant_server(0,18,0)
|
||||||
|
import Servant (DefaultErrorFormatters, ErrorFormatters, HasContextEntry, type (.++))
|
||||||
|
#endif
|
||||||
import Servant.Client (BaseUrl (..), Scheme (..))
|
import Servant.Client (BaseUrl (..), Scheme (..))
|
||||||
import System.IO.Unsafe (unsafePerformIO)
|
import System.IO.Unsafe (unsafePerformIO)
|
||||||
import Test.Hspec (Expectation, expectationFailure)
|
import Test.Hspec (Expectation, expectationFailure)
|
||||||
@ -37,7 +40,11 @@ withServantServer api = withServantServerAndContext api EmptyContext
|
|||||||
-- application.
|
-- application.
|
||||||
--
|
--
|
||||||
-- /Since 0.0.0.0/
|
-- /Since 0.0.0.0/
|
||||||
|
#if MIN_VERSION_servant_server(0,18,0)
|
||||||
|
withServantServerAndContext :: (HasServer a ctx, HasContextEntry (ctx .++ DefaultErrorFormatters) ErrorFormatters)
|
||||||
|
#else
|
||||||
withServantServerAndContext :: HasServer a ctx
|
withServantServerAndContext :: HasServer a ctx
|
||||||
|
#endif
|
||||||
=> Proxy a -> Context ctx -> IO (Server a) -> (BaseUrl -> IO r) -> IO r
|
=> Proxy a -> Context ctx -> IO (Server a) -> (BaseUrl -> IO r) -> IO r
|
||||||
withServantServerAndContext api ctx server t
|
withServantServerAndContext api ctx server t
|
||||||
= withApplication (return . serveWithContext api ctx =<< server) $ \port ->
|
= withApplication (return . serveWithContext api ctx =<< server) $ \port ->
|
||||||
@ -73,21 +80,29 @@ serversEqual api burl1 burl2 args req = do
|
|||||||
let reqs = (\f -> (f burl1, f burl2)) <$> runGenRequest api
|
let reqs = (\f -> (f burl1, f burl2)) <$> runGenRequest api
|
||||||
-- This MVar stuff is clunky! But there doesn't seem to be an easy way to
|
-- This MVar stuff is clunky! But there doesn't seem to be an easy way to
|
||||||
-- return results when a test fails, since an exception is throw.
|
-- return results when a test fails, since an exception is throw.
|
||||||
deetsMVar <- newMVar $ error "should not be called"
|
deetsMVar <- newEmptyMVar
|
||||||
r <- quickCheckWithResult args { chatty = False } $ monadicIO $ forAllM reqs $ \(req1, req2) -> do
|
r <- quickCheckWithResult args { chatty = False } $ monadicIO $ forAllM reqs $ \(req1, req2) -> do
|
||||||
resp1 <- run $ C.httpLbs (noCheckStatus req1) defManager
|
resp1 <- run $ C.httpLbs (noCheckStatus req1) defManager
|
||||||
resp2 <- run $ C.httpLbs (noCheckStatus req2) defManager
|
resp2 <- run $ C.httpLbs (noCheckStatus req2) defManager
|
||||||
unless (getResponseEquality req resp1 resp2) $ do
|
unless (getResponseEquality req resp1 resp2) $ do
|
||||||
monitor (counterexample "hi" )
|
monitor (counterexample "hi" )
|
||||||
run $ modifyMVar_ deetsMVar $ const $ return $
|
_ <- run $ tryPutMVar deetsMVar $ ServerEqualityFailure req1 resp1 resp2
|
||||||
ServerEqualityFailure req1 resp1 resp2
|
|
||||||
assert False
|
assert False
|
||||||
case r of
|
case r of
|
||||||
Success {} -> return ()
|
Success {} -> return ()
|
||||||
Failure{..} -> readMVar deetsMVar >>= \x -> expectationFailure $ "Failed:\n" ++ show x
|
Failure{..} -> do
|
||||||
|
mx <- tryReadMVar deetsMVar
|
||||||
|
case mx of
|
||||||
|
Just x ->
|
||||||
|
expectationFailure $ "Failed:\n" ++ show x
|
||||||
|
Nothing ->
|
||||||
|
expectationFailure $ "We failed to record a reason for failure: " <> show r
|
||||||
GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"
|
GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"
|
||||||
NoExpectedFailure {} -> expectationFailure "No expected failure"
|
NoExpectedFailure {} -> expectationFailure "No expected failure"
|
||||||
|
#if MIN_VERSION_QuickCheck(2,12,0)
|
||||||
|
#else
|
||||||
InsufficientCoverage {} -> expectationFailure "Insufficient coverage"
|
InsufficientCoverage {} -> expectationFailure "Insufficient coverage"
|
||||||
|
#endif
|
||||||
|
|
||||||
-- | Check that a server satisfies the set of properties specified.
|
-- | Check that a server satisfies the set of properties specified.
|
||||||
--
|
--
|
||||||
@ -110,37 +125,61 @@ serversEqual api burl1 burl2 args req = do
|
|||||||
-- /Since 0.0.0.0/
|
-- /Since 0.0.0.0/
|
||||||
serverSatisfies :: (HasGenRequest a) =>
|
serverSatisfies :: (HasGenRequest a) =>
|
||||||
Proxy a -> BaseUrl -> Args -> Predicates -> Expectation
|
Proxy a -> BaseUrl -> Args -> Predicates -> Expectation
|
||||||
serverSatisfies api burl args preds = do
|
serverSatisfies api = serverSatisfiesMgr api defManager
|
||||||
|
|
||||||
|
-- | Check that a server satisfies the set of properties specified, and
|
||||||
|
-- accept a 'Manager' for running the HTTP requests through.
|
||||||
|
--
|
||||||
|
-- See 'serverSatisfies' for more details.
|
||||||
|
--
|
||||||
|
-- @since 0.0.7.2
|
||||||
|
serverSatisfiesMgr :: (HasGenRequest a) =>
|
||||||
|
Proxy a -> C.Manager -> BaseUrl -> Args -> Predicates -> Expectation
|
||||||
|
serverSatisfiesMgr api manager burl args preds = do
|
||||||
let reqs = ($ burl) <$> runGenRequest api
|
let reqs = ($ burl) <$> runGenRequest api
|
||||||
deetsMVar <- newMVar $ error "should not be called"
|
deetsMVar <- newEmptyMVar
|
||||||
r <- quickCheckWithResult args { chatty = False } $ monadicIO $ forAllM reqs $ \req -> do
|
r <- quickCheckWithResult args { chatty = False } $ monadicIO $ forAllM reqs $ \req -> do
|
||||||
v <- run $ finishPredicates preds (noCheckStatus req) defManager
|
v <- run $ finishPredicates preds (noCheckStatus req) manager
|
||||||
run $ modifyMVar_ deetsMVar $ const $ return v
|
_ <- run $ tryPutMVar deetsMVar v
|
||||||
case v of
|
case v of
|
||||||
Just _ -> assert False
|
Just _ -> assert False
|
||||||
_ -> return ()
|
_ -> return ()
|
||||||
case r of
|
case r of
|
||||||
Success {} -> return ()
|
Success {} -> return ()
|
||||||
Failure{..} -> readMVar deetsMVar >>= \x -> expectationFailure $
|
Failure {..} -> do
|
||||||
"Failed:\n" ++ show x
|
mx <- tryReadMVar deetsMVar
|
||||||
|
case mx of
|
||||||
|
Just x ->
|
||||||
|
expectationFailure $ "Failed:\n" ++ show x
|
||||||
|
Nothing ->
|
||||||
|
expectationFailure $ "We failed to record a reason for failure: " <> show r
|
||||||
GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"
|
GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"
|
||||||
NoExpectedFailure {} -> expectationFailure $ "No expected failure"
|
NoExpectedFailure {} -> expectationFailure $ "No expected failure"
|
||||||
InsufficientCoverage {} -> expectationFailure $ "Insufficient coverage"
|
#if MIN_VERSION_QuickCheck(2,12,0)
|
||||||
|
#else
|
||||||
|
InsufficientCoverage {} -> expectationFailure "Insufficient coverage"
|
||||||
|
#endif
|
||||||
|
|
||||||
serverDoesntSatisfy :: (HasGenRequest a) =>
|
serverDoesntSatisfy :: (HasGenRequest a) =>
|
||||||
Proxy a -> BaseUrl -> Args -> Predicates -> Expectation
|
Proxy a -> BaseUrl -> Args -> Predicates -> Expectation
|
||||||
serverDoesntSatisfy api burl args preds = do
|
serverDoesntSatisfy api = serverDoesntSatisfyMgr api defManager
|
||||||
|
|
||||||
|
serverDoesntSatisfyMgr :: (HasGenRequest a) =>
|
||||||
|
Proxy a -> C.Manager -> BaseUrl -> Args -> Predicates -> Expectation
|
||||||
|
serverDoesntSatisfyMgr api manager burl args preds = do
|
||||||
let reqs = ($ burl) <$> runGenRequest api
|
let reqs = ($ burl) <$> runGenRequest api
|
||||||
r <- quickCheckWithResult args $ monadicIO $ forAllM reqs $ \req -> do
|
r <- quickCheckWithResult args $ monadicIO $ forAllM reqs $ \req -> do
|
||||||
v <- run $ finishPredicates preds (noCheckStatus req) defManager
|
v <- run $ finishPredicates preds (noCheckStatus req) manager
|
||||||
assert $ not $ null v
|
assert $ not $ null v
|
||||||
case r of
|
case r of
|
||||||
Success {} -> return ()
|
Success {} -> return ()
|
||||||
GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"
|
GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"
|
||||||
Failure { output = m } -> expectationFailure $ "Failed:\n" ++ show m
|
Failure { output = m } -> expectationFailure $ "Failed:\n" ++ show m
|
||||||
NoExpectedFailure {} -> expectationFailure $ "No expected failure"
|
NoExpectedFailure {} -> expectationFailure $ "No expected failure"
|
||||||
InsufficientCoverage {} -> expectationFailure $ "Insufficient coverage"
|
#if MIN_VERSION_QuickCheck(2,12,0)
|
||||||
|
#else
|
||||||
|
InsufficientCoverage {} -> expectationFailure "Insufficient coverage"
|
||||||
|
#endif
|
||||||
|
|
||||||
noCheckStatus :: C.Request -> C.Request
|
noCheckStatus :: C.Request -> C.Request
|
||||||
#if MIN_VERSION_http_client(0,5,0)
|
#if MIN_VERSION_http_client(0,5,0)
|
||||||
|
|||||||
@ -1,6 +0,0 @@
|
|||||||
resolver: lts-6.30
|
|
||||||
packages:
|
|
||||||
- '.'
|
|
||||||
extra-deps: []
|
|
||||||
flags: {}
|
|
||||||
extra-package-dbs: []
|
|
||||||
@ -1,6 +0,0 @@
|
|||||||
resolver: lts-7.19
|
|
||||||
packages:
|
|
||||||
- '.'
|
|
||||||
extra-deps: []
|
|
||||||
flags: {}
|
|
||||||
extra-package-dbs: []
|
|
||||||
@ -1,6 +0,0 @@
|
|||||||
resolver: lts-9.1
|
|
||||||
packages:
|
|
||||||
- '.'
|
|
||||||
extra-deps: []
|
|
||||||
flags: {}
|
|
||||||
extra-package-dbs: []
|
|
||||||
10
stack.yaml
10
stack.yaml
@ -1,10 +1,10 @@
|
|||||||
resolver: lts-8.4
|
resolver: nightly-2018-09-03
|
||||||
packages:
|
packages:
|
||||||
- '.'
|
- '.'
|
||||||
extra-deps:
|
extra-deps:
|
||||||
- hspec-2.4.4
|
- hspec-discover-2.5.6
|
||||||
- hspec-core-2.4.4
|
- hspec-core-2.5.6
|
||||||
- hspec-discover-2.4.4
|
- hspec-2.5.6
|
||||||
- quickcheck-io-0.2.0
|
- QuickCheck-2.12
|
||||||
flags: {}
|
flags: {}
|
||||||
extra-package-dbs: []
|
extra-package-dbs: []
|
||||||
|
|||||||
@ -1,44 +0,0 @@
|
|||||||
module Main where
|
|
||||||
|
|
||||||
import Data.List (isPrefixOf)
|
|
||||||
import System.Directory
|
|
||||||
import System.FilePath
|
|
||||||
import System.FilePath.Find
|
|
||||||
import Test.DocTest
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = do
|
|
||||||
files <- find always (extension ==? ".hs") "src"
|
|
||||||
mCabalMacrosFile <- getCabalMacrosFile
|
|
||||||
doctest $ "-isrc" : "-Iinclude" :
|
|
||||||
(maybe [] (\ f -> ["-optP-include", "-optP" ++ f]) mCabalMacrosFile) ++
|
|
||||||
"-XOverloadedStrings" :
|
|
||||||
"-XDeriveFunctor" :
|
|
||||||
"-XFlexibleInstances" :
|
|
||||||
"-XFlexibleContexts" :
|
|
||||||
"-XMultiParamTypeClasses" :
|
|
||||||
"-XDataKinds" :
|
|
||||||
"-XTypeOperators" :
|
|
||||||
"-XGADTs" :
|
|
||||||
files
|
|
||||||
|
|
||||||
getCabalMacrosFile :: IO (Maybe FilePath)
|
|
||||||
getCabalMacrosFile = do
|
|
||||||
exists <- doesDirectoryExist "dist"
|
|
||||||
if exists
|
|
||||||
then do
|
|
||||||
contents <- getDirectoryContents "dist"
|
|
||||||
let rest = "build" </> "autogen" </> "cabal_macros.h"
|
|
||||||
whenExists $ case filter ("dist-sandbox-" `isPrefixOf`) contents of
|
|
||||||
[x] -> "dist" </> x </> rest
|
|
||||||
[] -> "dist" </> rest
|
|
||||||
xs -> error $ "ran doctests with multiple dist/dist-sandbox-xxxxx's: \n"
|
|
||||||
++ show xs ++ "\nTry cabal clean"
|
|
||||||
else return Nothing
|
|
||||||
where
|
|
||||||
whenExists :: FilePath -> IO (Maybe FilePath)
|
|
||||||
whenExists file = do
|
|
||||||
exists <- doesFileExist file
|
|
||||||
return $ if exists
|
|
||||||
then Just file
|
|
||||||
else Nothing
|
|
||||||
@ -17,25 +17,13 @@ import qualified Text.Blaze.Html as Blaze
|
|||||||
import qualified Text.Blaze.Html5 as Blaze5
|
import qualified Text.Blaze.Html5 as Blaze5
|
||||||
import Test.Hspec (Spec, context, describe, it, shouldBe,
|
import Test.Hspec (Spec, context, describe, it, shouldBe,
|
||||||
shouldContain)
|
shouldContain)
|
||||||
import Test.Hspec.Core.Spec (Arg, Example, Result (..),
|
import Test.Hspec.Core.Spec (Arg, Example, Result (..), ResultStatus (..),
|
||||||
defaultParams)
|
defaultParams, safeEvaluateExample)
|
||||||
import Test.QuickCheck.Gen (generate, unGen)
|
import Test.QuickCheck.Gen (generate, unGen)
|
||||||
import Test.QuickCheck.Random (mkQCGen)
|
import Test.QuickCheck.Random (mkQCGen)
|
||||||
|
|
||||||
|
|
||||||
#if MIN_VERSION_servant(0,8,0)
|
import Servant.Test.ComprehensiveAPI (comprehensiveAPIWithoutStreamingOrRaw)
|
||||||
import Servant.API.Internal.Test.ComprehensiveAPI (comprehensiveAPIWithoutRaw)
|
|
||||||
#else
|
|
||||||
import Servant.API.Internal.Test.ComprehensiveAPI (ComprehensiveAPI,
|
|
||||||
comprehensiveAPI)
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#if MIN_VERSION_hspec(2,4,0)
|
|
||||||
import Test.Hspec.Core.Spec (safeEvaluateExample)
|
|
||||||
#else
|
|
||||||
import Control.Exception (try)
|
|
||||||
import Test.Hspec.Core.Spec (evaluateExample)
|
|
||||||
#endif
|
|
||||||
|
|
||||||
import Servant.QuickCheck
|
import Servant.QuickCheck
|
||||||
import Servant.QuickCheck.Internal (genRequest, runGenRequest,
|
import Servant.QuickCheck.Internal (genRequest, runGenRequest,
|
||||||
@ -140,6 +128,10 @@ onlyJsonObjectSpec = describe "onlyJsonObjects" $ do
|
|||||||
withServantServerAndContext octetAPI ctx serverOctetAPI $ \burl ->
|
withServantServerAndContext octetAPI ctx serverOctetAPI $ \burl ->
|
||||||
serverSatisfies octetAPI burl args (onlyJsonObjects <%> mempty)
|
serverSatisfies octetAPI burl args (onlyJsonObjects <%> mempty)
|
||||||
|
|
||||||
|
it "does not fail when there is no content-type" $ do
|
||||||
|
withServantServerAndContext api2 ctx serverFailing $ \burl ->
|
||||||
|
serverSatisfies api2 burl args (onlyJsonObjects <%> mempty)
|
||||||
|
|
||||||
notLongerThanSpec :: Spec
|
notLongerThanSpec :: Spec
|
||||||
notLongerThanSpec = describe "notLongerThan" $ do
|
notLongerThanSpec = describe "notLongerThan" $ do
|
||||||
|
|
||||||
@ -157,7 +149,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 comprehensiveAPIWithoutRaw
|
let _g = genRequest comprehensiveAPIWithoutStreamingOrRaw
|
||||||
True `shouldBe` True -- This is a type-level check
|
True `shouldBe` True -- This is a type-level check
|
||||||
|
|
||||||
deepPathSpec :: Spec
|
deepPathSpec :: Spec
|
||||||
@ -281,6 +273,9 @@ server2 = return $ return 1
|
|||||||
server3 :: IO (Server API2)
|
server3 :: IO (Server API2)
|
||||||
server3 = return $ return 2
|
server3 = return $ return 2
|
||||||
|
|
||||||
|
serverFailing :: IO (Server API2)
|
||||||
|
serverFailing = return . throwError $ err405
|
||||||
|
|
||||||
-- With Doctypes
|
-- With Doctypes
|
||||||
type HtmlDoctype = Get '[HTML] Blaze.Html
|
type HtmlDoctype = Get '[HTML] Blaze.Html
|
||||||
|
|
||||||
@ -349,27 +344,14 @@ ctx = BasicAuthCheck (const . return $ NoSuchUser) :. EmptyContext
|
|||||||
-- Utils
|
-- Utils
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
evalExample :: (Example e, Arg e ~ ()) => e -> IO EvalResult
|
evalExample :: (Example e, Arg e ~ ()) => e -> IO EvalResult
|
||||||
#if MIN_VERSION_hspec(2,4,0)
|
|
||||||
evalExample e = do
|
evalExample e = do
|
||||||
r <- safeEvaluateExample e defaultParams ($ ()) progCallback
|
r <- safeEvaluateExample e defaultParams ($ ()) progCallback
|
||||||
case r of
|
case resultStatus r of
|
||||||
Left err -> return $ AnException err
|
Success -> return $ AllGood
|
||||||
Right Success -> return $ AllGood
|
Failure _ reason -> return $ FailedWith $ show reason
|
||||||
Right (Failure _ reason) -> return $ FailedWith $ show reason
|
Pending {} -> error "should not happen"
|
||||||
Right (Pending _) -> error "should not happen"
|
|
||||||
where
|
where
|
||||||
progCallback _ = return ()
|
progCallback _ = return ()
|
||||||
#else
|
|
||||||
evalExample e = do
|
|
||||||
r <- try $ evaluateExample e defaultParams ($ ()) progCallback
|
|
||||||
case r of
|
|
||||||
Left err -> return $ AnException err
|
|
||||||
Right Success -> return $ AllGood
|
|
||||||
Right (Fail _ reason) -> return $ FailedWith reason
|
|
||||||
Right (Pending _) -> error "should not happen"
|
|
||||||
where
|
|
||||||
progCallback _ = return ()
|
|
||||||
#endif
|
|
||||||
|
|
||||||
data EvalResult
|
data EvalResult
|
||||||
= AnException SomeException
|
= AnException SomeException
|
||||||
@ -387,8 +369,3 @@ noOfTestCases = 20000
|
|||||||
#else
|
#else
|
||||||
noOfTestCases = 1000
|
noOfTestCases = 1000
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#if !MIN_VERSION_servant(0,8,0)
|
|
||||||
comprehensiveAPIWithoutRaw :: Proxy ComprehensiveAPI
|
|
||||||
comprehensiveAPIWithoutRaw = comprehensiveAPI
|
|
||||||
#endif
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user