moving servant-swagger into the main servant repo

2021-11-17 12:33:17 +01:00 · 2021-11-17 12:33:17 +01:00 · 39fb875951
commit 39fb875951
parent efffc70919
30 changed files with 2551 additions and 0 deletions
--- a/cabal.project
+++ b/cabal.project
@ -12,6 +12,7 @@ packages:
  servant-docs/
  servant-foreign/
  servant-server/
+  servant-swagger/
  doc/tutorial/

 -- servant streaming
--- a/servant-swagger/.travis.yml
+++ b/servant-swagger/.travis.yml
@ -0,0 +1,167 @@
+# This Travis job script has been generated by a script via
+#
+#   haskell-ci '--config=cabal.haskell-ci' 'cabal.project'
+#
+# 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.3
+#
+version: ~> 1.0
+language: c
+os: linux
+dist: xenial
+git:
+  # whether to recursively clone submodules
+  submodules: false
+branches:
+  only:
+    - master
+cache:
+  directories:
+    - $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.10.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.10.2","cabal-install-3.2"]}}
+      os: linux
+    - compiler: ghc-8.8.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.8.4","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-swagger' >> cabal.project ; fi
+  - "if [ $HCNUMVER -ge 80200 ] ; then echo '  ghc-options: -Werror=missing-methods' >> cabal.project ; fi"
+  - |
+    echo "allow-newer: aeson-pretty-0.8.7:base-compat" >> cabal.project
+  - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(servant-swagger)$' || 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_swagger="$(find . -maxdepth 1 -type d -regex '.*/servant-swagger-[0-9.]*')"
+  # Generate cabal.project
+  - rm -rf cabal.project cabal.project.local cabal.project.freeze
+  - touch cabal.project
+  - |
+    echo "packages: ${PKGDIR_servant_swagger}" >> cabal.project
+  - if [ $HCNUMVER -ge 80200 ] ; then echo 'package servant-swagger' >> cabal.project ; fi
+  - "if [ $HCNUMVER -ge 80200 ] ; then echo '  ghc-options: -Werror=missing-methods' >> cabal.project ; fi"
+  - |
+    echo "allow-newer: aeson-pretty-0.8.7:base-compat" >> cabal.project
+  - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(servant-swagger)$' || 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_swagger} && ${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 swagger2-2.3
+  - if [ $HCNUMVER -lt 80800 ] ; then ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --constraint='swagger2 ==2.3.*' all ; fi
+  # Constraint set swagger2-2.4
+  - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --constraint='swagger2 ==2.4.*' all
+  # Constraint set swagger2-2.5
+  - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --constraint='swagger2 ==2.5.*' all
+  # Constraint set servant-0.18.1
+  - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --constraint='servant == 0.18.1' all
+
+# REGENDATA ("0.10.3",["--config=cabal.haskell-ci","cabal.project"])
+# EOF
--- a/servant-swagger/CHANGELOG.md
+++ b/servant-swagger/CHANGELOG.md
@ -0,0 +1,143 @@
+1.1.9
+-------
+
+* Support `servant-0.18`
+
+1.1.8
+-------
+
+* Support `servant-0.17`
+
+1.1.7.1
+-------
+
+* Support `swagger2-2.4`
+
+1.1.7
+-----
+
+* Support servant-0.15
+   - support for 'Stream' and 'StreamBody' combinators
+   - orphan 'ToSchema (SourceT m a)' instance
+* Fix BodyTypes to work with generalized ReqBody' 
+  [#88](https://github.com/haskell-servant/servant-swagger/pull/88)
+
+1.1.6
+-----
+
+* Fixes:
+  * `validateEveryToJSON` now prints validation errors
+
+* Notes:
+  * GHC-8.6 compatible release
+
+1.1.5
+-----
+
+* Notes:
+    * `servant-0.13` compatible release
+    * Drops compatibility with previous `servant` versions.
+
+1.1.4
+-----
+
+* Notes:
+    * `servant-0.12` compatible release
+
+1.1.3.1
+---
+
+* Notes:
+   * GHC-8.2 compatible release
+
+1.1.3
+---
+
+* Notes:
+   * `servant-0.11` compatible release
+
+1.1.2.1
+---
+
+* Notes:
+   * `servant-0.10` compatible release
+
+1.1.2
+---
+
+* Minor fixes:
+  * Support for aeson-1, insert-ordered-containers-0.2
+  * CaptureAll instance
+
+1.1.1
+---
+
+* Minor fixes:
+  * Fix `unused-imports` and `unused-foralls` warnings;
+  * Fix tests to match `swagger2-2.1.1` (add `example` property for `UTCTime` schema).
+
+1.1
+---
+
+* Breaking changes:
+    * Requires `swagger2 >= 2.1`
+    * Requires `servant >= 0.5`
+
+* Notes:
+    * GHC-8.0 compatible release
+
+1.0.3
+---
+
+* Fixes:
+    * Improve compile-time performance of `BodyTypes` even further (see [18e0d95](https://github.com/haskell-servant/servant-swagger/commit/18e0d95ef6fe9076dd9621cb515d8d1a189f71d3))!
+
+1.0.2
+---
+
+* Minor changes:
+    * Add GHC 7.8 support (see [#26](https://github.com/haskell-servant/servant-swagger/pull/26)).
+
+* Fixes:
+    * Improve compile-time performance of `BodyTypes` (see [#25](https://github.com/haskell-servant/servant-swagger/issues/25)).
+
+1.0.1
+---
+
+* Fixes:
+    * Stop using `Data.Swagger.Internal`;
+    * Documentation fixes (links to examples).
+
+1.0
+---
+
+* Major changes (see [#24](https://github.com/haskell-servant/servant-swagger/pull/24)):
+    * Switch to `swagger2-2.*`;
+    * Add automatic `ToJSON`/`ToSchema` validation tests;
+    * Add great documentation;
+    * Export some type-level functions for servant API.
+
+* Minor changes:
+    * Rework Todo API example;
+    * Stop exporting `ToResponseHeader`, `AllAccept` and `AllToResponseHeader` (see [bd50db4](https://github.com/haskell-servant/servant-swagger/commit/bd50db48ca6a106e4366560ded70932d409de1e2));
+    * Change maintainer, update authors/copyrights (see [1a62681](https://github.com/haskell-servant/servant-swagger/commit/1a6268101dc826a92c42e832e402e251c0d32147));
+    * Include changelog and example files into `extra-source-files`.
+
+0.1.2
+---
+
+* Fixes:
+    * Fix default spec for `ReqBody` param to be required (see [#22](https://github.com/haskell-servant/servant-swagger/issues/22));
+    * Set version bounds for `swagger2`.
+
+0.1.1
+---
+
+* Fixes:
+    * Fix `subOperations` to filter endpoints also by method (see [#18](https://github.com/haskell-servant/servant-swagger/issues/18));
+    * Fix response schema in `ToSwagger` instance for `Header` (see [b59e557](https://github.com/haskell-servant/servant-swagger/commit/b59e557a05bc2669332c52b397879e7598747b82)).
+
+0.1
+---
+* Major changes
+    * Use `swagger2` for data model (see [#9](https://github.com/dmjio/servant-swagger/pull/9)); this changes almost everything.
--- a/servant-swagger/LICENSE
+++ b/servant-swagger/LICENSE
@ -0,0 +1,28 @@
+Copyright (c) 2015-2016, Servant contributors
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+* Redistributions of source code must retain the above copyright notice, this
+  list of conditions and the following disclaimer.
+
+* Redistributions in binary form must reproduce the above copyright notice,
+  this list of conditions and the following disclaimer in the documentation
+  and/or other materials provided with the distribution.
+
+* Neither the name of servant-swagger nor the names of its
+  contributors may be used to endorse or promote products derived from
+  this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
--- a/servant-swagger/README.md
+++ b/servant-swagger/README.md
@ -0,0 +1,47 @@
+# servant-swagger
+
+[![Build Status](https://travis-ci.org/haskell-servant/servant-swagger.svg?branch=master)](https://travis-ci.org/haskell-servant/servant-swagger)
+[![Hackage](https://img.shields.io/hackage/v/servant-swagger.svg)](http://hackage.haskell.org/package/servant-swagger)
+[![Stackage LTS](http://stackage.org/package/servant-swagger/badge/lts)](http://stackage.org/lts/package/servant-swagger)
+[![Stackage Nightly](http://stackage.org/package/servant-swagger/badge/nightly)](http://stackage.org/nightly/package/servant-swagger)
+
+Swagger 2.0 conforming json for [servant](https://github.com/haskell-servant/servant) APIs.
+
+![servant-swagger robot](http://s16.postimg.org/rndz1wbyt/servant.png)
+
+### Motivation
+
+Swagger is a project used to describe and document RESTful APIs.
+Unlike Servant it is language-agnostic and thus is quite popular among developers
+in different languages. It also exists for a longer time and has more tools to work with.
+
+This package provides means to generate Swagger specification for a Servant API
+and also to partially test whether API conforms with its specification.
+
+Generated Swagger specification then can be used for many things such as
+- displaying interactive documentation using [Swagger UI](http://swagger.io/swagger-ui/);
+- generating clients and servers in many languages using [Swagger Codegen](http://swagger.io/swagger-codegen/);
+- and [many others](http://swagger.io/open-source-integrations/).
+
+### Usage
+
+Please refer to [haddock documentation](http://hackage.haskell.org/package/servant-swagger).
+
+Some examples can be found in [`example/` directory](/example).
+
+### Try it out
+
+All generated swagger specifications can be interactively viewed on [Swagger Editor](http://editor.swagger.io/).
+
+Ready-to-use specification can be served as JSON and interactive API documentation
+can be displayed using [Swagger UI](https://github.com/swagger-api/swagger-ui).
+
+Many Swagger tools, including server and client code generation for many languages, can be found on
+[Swagger's Tools and Integrations page](http://swagger.io/open-source-integrations/).
+
+### Contributing
+
+We are happy to receive bug reports, fixes, documentation enhancements, and other improvements.
+
+Please report bugs via the [github issue tracker](https://github.com/haskell-servant/servant-swagger/issues).
+
--- a/servant-swagger/Setup.hs
+++ b/servant-swagger/Setup.hs
@ -0,0 +1,33 @@
+{-# 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 ()
+main = defaultMain
+
+#endif
--- a/servant-swagger/cabal.haskell-ci
+++ b/servant-swagger/cabal.haskell-ci
@ -0,0 +1,14 @@
+branches: master
+
+constraint-set swagger2-2.3
+  ghc: <8.8
+  constraints: swagger2 ==2.3.*
+
+constraint-set swagger2-2.4
+  constraints: swagger2 ==2.4.*
+
+constraint-set swagger2-2.5
+  constraints: swagger2 ==2.5.*
+
+constraint-set servant-0.17
+  constraints: servant == 0.17.*
--- a/servant-swagger/cabal.project
+++ b/servant-swagger/cabal.project
@ -0,0 +1,2 @@
+packages: .
+allow-newer: aeson-pretty-0.8.7:base-compat
--- a/servant-swagger/example/LICENSE
+++ b/servant-swagger/example/LICENSE
@ -0,0 +1,28 @@
+Copyright (c) 2015-2016, Servant contributors
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+* Redistributions of source code must retain the above copyright notice, this
+  list of conditions and the following disclaimer.
+
+* Redistributions in binary form must reproduce the above copyright notice,
+  this list of conditions and the following disclaimer in the documentation
+  and/or other materials provided with the distribution.
+
+* Neither the name of servant-swagger nor the names of its
+  contributors may be used to endorse or promote products derived from
+  this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
--- a/servant-swagger/example/example.cabal
+++ b/servant-swagger/example/example.cabal
@ -0,0 +1,62 @@
+name:                example
+version:             1.0
+synopsis:            servant-swagger demonstration
+description:         servant-swagger demonstration
+license:             BSD3
+license-file:        LICENSE
+author:              David Johnson, Nickolay Kudasov
+maintainer:          nickolay.kudasov@gmail.com
+copyright:           (c) 2015-2016, Servant contributors
+category:            Web
+build-type:          Simple
+cabal-version:       >=1.10
+data-files:
+  swagger.json
+
+library
+  ghc-options:      -Wall
+  hs-source-dirs: src/
+  exposed-modules:
+    Todo
+  build-depends:  base
+                , aeson
+                , aeson-pretty
+                , bytestring
+                , lens
+                , servant
+                , servant-server
+                , servant-swagger
+                , swagger2
+                , text
+                , time
+  default-language: Haskell2010
+
+executable swagger-server
+  ghc-options:      -Wall
+  hs-source-dirs: server/
+  main-is: Main.hs
+  build-depends:  base
+                , example
+                , servant-server
+                , warp
+  default-language: Haskell2010
+
+test-suite swagger-server-spec
+  ghc-options:      -Wall
+  type:             exitcode-stdio-1.0
+  hs-source-dirs:   test
+  main-is:          Spec.hs
+  other-modules:
+    TodoSpec
+    Paths_example
+  build-depends:    base  == 4.*
+                  , base-compat >= 0.6.0
+                  , aeson >=0.11.2.0
+                  , bytestring
+                  , example
+                  , hspec
+                  , servant-swagger
+                  , QuickCheck
+                  , quickcheck-instances
+  default-language: Haskell2010
+
--- a/servant-swagger/example/server/Main.hs
+++ b/servant-swagger/example/server/Main.hs
@ -0,0 +1,11 @@
+module Main where
+
+import Network.Wai.Handler.Warp
+import Servant
+import Todo
+
+main :: IO ()
+main = do
+  putStrLn "Running on port 8000"
+  run 8000 $ serve (Proxy :: Proxy API) server
+
--- a/servant-swagger/example/src/Todo.hs
+++ b/servant-swagger/example/src/Todo.hs
@ -0,0 +1,73 @@
+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE DeriveDataTypeable         #-}
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE TypeOperators              #-}
+module Todo where
+
+import           Control.Lens
+import           Data.Aeson
+import           Data.Aeson.Encode.Pretty   (encodePretty)
+import qualified Data.ByteString.Lazy.Char8 as BL8
+import           Data.Proxy
+import           Data.Swagger
+import           Data.Text                  (Text)
+import           Data.Time                  (UTCTime (..), fromGregorian)
+import           Data.Typeable              (Typeable)
+import           GHC.Generics
+import           Servant
+import           Servant.Swagger
+
+todoAPI :: Proxy TodoAPI
+todoAPI = Proxy
+
+-- | The API of a Todo service.
+type TodoAPI
+    = "todo" :> Get '[JSON] [Todo]
+ :<|> "todo" :> ReqBody '[JSON] Todo :> Post '[JSON] TodoId
+ :<|> "todo" :> Capture "id" TodoId :> Get '[JSON] Todo
+ :<|> "todo" :> Capture "id" TodoId :> ReqBody '[JSON] Todo :> Put '[JSON] TodoId
+
+-- | API for serving @swagger.json@.
+type SwaggerAPI = "swagger.json" :> Get '[JSON] Swagger
+
+-- | Combined API of a Todo service with Swagger documentation.
+type API = SwaggerAPI :<|> TodoAPI
+
+-- | A single Todo entry.
+data Todo = Todo
+  { created :: UTCTime  -- ^ Creation datetime.
+  , summary :: Text     -- ^ Task summary.
+  } deriving (Show, Generic, Typeable)
+
+-- | A unique Todo entry ID.
+newtype TodoId = TodoId Int
+  deriving (Show, Generic, Typeable, ToJSON, FromHttpApiData)
+
+instance ToJSON Todo
+instance FromJSON Todo
+
+instance ToSchema Todo where
+  declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
+    & mapped.schema.description ?~ "This is some real Todo right here"
+    & mapped.schema.example ?~ toJSON (Todo (UTCTime (fromGregorian 2015 12 31) 0) "get milk")
+
+instance ToParamSchema TodoId
+instance ToSchema TodoId
+
+-- | Swagger spec for Todo API.
+todoSwagger :: Swagger
+todoSwagger = toSwagger todoAPI
+  & info.title   .~ "Todo API"
+  & info.version .~ "1.0"
+  & info.description ?~ "This is an API that tests swagger integration"
+  & info.license ?~ ("MIT" & url ?~ URL "http://mit.com")
+
+-- | Combined server of a Todo service with Swagger documentation.
+server :: Server API
+server = return todoSwagger :<|> error "not implemented"
+
+-- | Output generated @swagger.json@ file for the @'TodoAPI'@.
+writeSwaggerJSON :: IO ()
+writeSwaggerJSON = BL8.writeFile "example/swagger.json" (encodePretty todoSwagger)
--- a/servant-swagger/example/swagger.json
+++ b/servant-swagger/example/swagger.json
@ -0,0 +1,158 @@
+{
+    "swagger": "2.0",
+    "info": {
+        "version": "1.0",
+        "title": "Todo API",
+        "license": {
+            "url": "http://mit.com",
+            "name": "MIT"
+        },
+        "description": "This is an API that tests swagger integration"
+    },
+    "definitions": {
+        "Todo": {
+            "example": {
+                "summary": "get milk",
+                "created": "2015-12-31T00:00:00Z"
+            },
+            "required": [
+                "created",
+                "summary"
+            ],
+            "type": "object",
+            "description": "This is some real Todo right here",
+            "properties": {
+                "summary": {
+                    "type": "string"
+                },
+                "created": {
+                    "$ref": "#/definitions/UTCTime"
+                }
+            }
+        },
+        "UTCTime": {
+            "example": "2016-07-22T00:00:00Z",
+            "format": "yyyy-mm-ddThh:MM:ssZ",
+            "type": "string"
+        },
+        "TodoId": {
+            "maximum": 9223372036854775807,
+            "minimum": -9223372036854775808,
+            "type": "integer"
+        }
+    },
+    "paths": {
+        "/todo/{id}": {
+            "get": {
+                "responses": {
+                    "400": {
+                        "description": "Invalid `id`"
+                    },
+                    "200": {
+                        "schema": {
+                            "$ref": "#/definitions/Todo"
+                        },
+                        "description": ""
+                    }
+                },
+                "produces": [
+                    "application/json;charset=utf-8"
+                ],
+                "parameters": [
+                    {
+                        "maximum": 9223372036854775807,
+                        "minimum": -9223372036854775808,
+                        "required": true,
+                        "in": "path",
+                        "name": "id",
+                        "type": "integer"
+                    }
+                ]
+            },
+            "put": {
+                "consumes": [
+                    "application/json;charset=utf-8"
+                ],
+                "responses": {
+                    "400": {
+                        "description": "Invalid `body` or `id`"
+                    },
+                    "200": {
+                        "schema": {
+                            "$ref": "#/definitions/TodoId"
+                        },
+                        "description": ""
+                    }
+                },
+                "produces": [
+                    "application/json;charset=utf-8"
+                ],
+                "parameters": [
+                    {
+                        "maximum": 9223372036854775807,
+                        "minimum": -9223372036854775808,
+                        "required": true,
+                        "in": "path",
+                        "name": "id",
+                        "type": "integer"
+                    },
+                    {
+                        "required": true,
+                        "schema": {
+                            "$ref": "#/definitions/Todo"
+                        },
+                        "in": "body",
+                        "name": "body"
+                    }
+                ]
+            }
+        },
+        "/todo": {
+            "post": {
+                "consumes": [
+                    "application/json;charset=utf-8"
+                ],
+                "responses": {
+                    "400": {
+                        "description": "Invalid `body`"
+                    },
+                    "200": {
+                        "schema": {
+                            "$ref": "#/definitions/TodoId"
+                        },
+                        "description": ""
+                    }
+                },
+                "produces": [
+                    "application/json;charset=utf-8"
+                ],
+                "parameters": [
+                    {
+                        "required": true,
+                        "schema": {
+                            "$ref": "#/definitions/Todo"
+                        },
+                        "in": "body",
+                        "name": "body"
+                    }
+                ]
+            },
+            "get": {
+                "responses": {
+                    "200": {
+                        "schema": {
+                            "items": {
+                                "$ref": "#/definitions/Todo"
+                            },
+                            "type": "array"
+                        },
+                        "description": ""
+                    }
+                },
+                "produces": [
+                    "application/json;charset=utf-8"
+                ]
+            }
+        }
+    }
+}
--- a/servant-swagger/example/test/Spec.hs
+++ b/servant-swagger/example/test/Spec.hs
@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
--- a/servant-swagger/example/test/TodoSpec.hs
+++ b/servant-swagger/example/test/TodoSpec.hs
@ -0,0 +1,28 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module TodoSpec where
+
+import Prelude ()
+import Prelude.Compat
+
+import           Data.Aeson
+import qualified Data.ByteString.Lazy.Char8 as BL8
+import           Paths_example
+import           Servant.Swagger.Test
+import           Test.Hspec
+import           Test.QuickCheck
+import           Test.QuickCheck.Instances  ()
+import           Todo
+
+spec :: Spec
+spec = describe "Swagger" $ do
+  context "ToJSON matches ToSchema" $ validateEveryToJSON todoAPI
+  it "swagger.json is up-to-date" $ do
+    path <- getDataFileName "swagger.json"
+    swag <- eitherDecode <$> BL8.readFile path
+    swag `shouldBe` Right todoSwagger
+
+instance Arbitrary Todo where
+  arbitrary = Todo <$> arbitrary <*> arbitrary
+
+instance Arbitrary TodoId where
+  arbitrary = TodoId <$> arbitrary
--- a/servant-swagger/servant-swagger.cabal
+++ b/servant-swagger/servant-swagger.cabal
@ -0,0 +1,127 @@
+name:                servant-swagger
+version:             1.1.11
+synopsis:            Generate a Swagger/OpenAPI/OAS 2.0 specification for your servant API.
+description:
+  Swagger is a project used to describe and document RESTful APIs. The core of the 
+  project is the [OpenAPI Specification (OAS)](https://swagger.io/docs/specification/about/). 
+  This library implements v2.0 of the spec. Unlike Servant it is language-agnostic and thus is 
+  quite popular among developers in different languages. It has also existed for a longer time 
+  and has more helpful tooling.
+  .
+  This package provides means to generate a Swagger/OAS specification for a Servant API
+  and also to partially test whether an API conforms with its specification.
+  .
+  Generated Swagger specification then can be used for many things such as
+  .
+  * displaying interactive documentation using [Swagger UI](http://swagger.io/swagger-ui/);
+  .
+  * generating clients and servers in many languages using [Swagger Codegen](http://swagger.io/swagger-codegen/);
+  .
+  * and [many others](http://swagger.io/open-source-integrations/).
+homepage:            https://github.com/haskell-servant/servant-swagger
+bug-reports:         https://github.com/haskell-servant/servant-swagger/issues
+license:             BSD3
+license-file:        LICENSE
+author:              David Johnson, Nickolay Kudasov
+maintainer:          nickolay.kudasov@gmail.com
+copyright:           (c) 2015-2018, Servant contributors
+category:            Web, Servant, Swagger
+build-type:          Custom
+cabal-version:       1.18
+tested-with: GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.2
+
+extra-source-files:
+    README.md
+  , CHANGELOG.md
+  , example/server/*.hs
+  , example/src/*.hs
+  , example/test/*.hs
+  , example/*.cabal
+  , example/swagger.json
+  , example/LICENSE
+extra-doc-files:
+    example/src/*.hs
+  , example/test/*.hs
+
+source-repository head
+  type:     git
+  location: https://github.com/haskell-servant/servant-swagger.git
+
+custom-setup
+  setup-depends:
+    base >=4.9 && <5,
+    Cabal >= 1.24 && <3.3,
+    cabal-doctest >=1.0.6 && <1.1
+
+library
+  ghc-options:         -Wall
+  exposed-modules:
+    Servant.Swagger
+    Servant.Swagger.Test
+    Servant.Swagger.TypeLevel
+
+    -- Internal modules
+    Servant.Swagger.Internal
+    Servant.Swagger.Internal.Orphans
+    Servant.Swagger.Internal.Test
+    Servant.Swagger.Internal.TypeLevel
+    Servant.Swagger.Internal.TypeLevel.API
+    Servant.Swagger.Internal.TypeLevel.Every
+    Servant.Swagger.Internal.TypeLevel.TMap
+  hs-source-dirs:      src
+  build-depends:       aeson                     >=1.4.2.0 && <1.6
+                     , aeson-pretty              >=0.8.7    && <0.9
+                     , base                      >=4.9.1.0  && <5
+                     , base-compat               >=0.10.5   && <0.12
+                     , bytestring                >=0.10.8.1 && <0.11
+                     , http-media                >=0.7.1.3  && <0.9
+                     , insert-ordered-containers >=0.2.1.0  && <0.3
+                     , lens                      >=4.17     && <6
+                     , servant                   >=0.18.1   && <0.19
+                     , singleton-bool            >=0.1.4    && <0.2
+                     , swagger2                  >=2.3.0.1  && <3
+                     , text                      >=1.2.3.0  && <1.3
+                     , unordered-containers      >=0.2.9.0  && <0.3
+
+                     , hspec
+                     , QuickCheck
+  default-language:    Haskell2010
+
+test-suite doctests
+  ghc-options:      -Wall
+  build-depends:
+    base,
+    directory >= 1.0,
+    doctest >= 0.18 && <0.19,
+    servant,
+    QuickCheck,
+    filepath
+  default-language: Haskell2010
+  hs-source-dirs:   test
+  main-is:          doctests.hs
+  type:             exitcode-stdio-1.0
+
+test-suite spec
+  ghc-options:      -Wall
+  type:             exitcode-stdio-1.0
+  hs-source-dirs:   test
+  main-is:          Spec.hs
+  build-tool-depends: hspec-discover:hspec-discover >=2.6.0 && <2.8
+  build-depends:    base
+                  , base-compat
+                  , aeson
+                  , hspec >=2.6.0 && <2.8
+                  , QuickCheck
+                  , lens
+                  , lens-aeson >=1.0.2    && <1.2
+                  , servant
+                  , servant-swagger
+                  , swagger2
+                  , text
+                  , template-haskell
+                  , utf8-string >=1.0.1.1 && <1.1
+                  , time
+                  , vector
+  other-modules:
+    Servant.SwaggerSpec
+  default-language: Haskell2010
--- a/servant-swagger/src/Servant/Swagger.hs
+++ b/servant-swagger/src/Servant/Swagger.hs
@ -0,0 +1,186 @@
+-- |
+-- Module:      Servant.Swagger
+-- License:     BSD3
+-- Maintainer:  Nickolay Kudasov <nickolay@getshoptv.com>
+-- Stability:   experimental
+--
+-- This module provides means to generate and manipulate
+-- Swagger specification for servant APIs.
+--
+-- Swagger is a project used to describe and document RESTful APIs.
+--
+-- The Swagger specification defines a set of files required to describe such an API.
+-- These files can then be used by the Swagger-UI project to display the API
+-- and Swagger-Codegen to generate clients in various languages.
+-- Additional utilities can also take advantage of the resulting files, such as testing tools.
+--
+-- For more information see <http://swagger.io/ Swagger documentation>.
+module Servant.Swagger (
+  -- * How to use this library
+  -- $howto
+
+  -- ** Generate @'Swagger'@
+  -- $generate
+
+  -- ** Annotate
+  -- $annotate
+
+  -- ** Test
+  -- $test
+
+  -- ** Serve
+  -- $serve
+
+  -- * @'HasSwagger'@ class
+  HasSwagger(..),
+
+  -- * Manipulation
+  subOperations,
+
+  -- * Testing
+  validateEveryToJSON,
+  validateEveryToJSONWithPatternChecker,
+) where
+
+import           Servant.Swagger.Internal
+import           Servant.Swagger.Test
+import           Servant.Swagger.Internal.Orphans ()
+
+-- $setup
+-- >>> import Control.Applicative
+-- >>> import Control.Lens
+-- >>> import Data.Aeson
+-- >>> import Data.Aeson.Encode.Pretty
+-- >>> import Data.Swagger
+-- >>> import Data.Typeable
+-- >>> import GHC.Generics
+-- >>> import Servant.API
+-- >>> import Test.Hspec
+-- >>> import Test.QuickCheck
+-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL8
+-- >>> :set -XDataKinds
+-- >>> :set -XDeriveDataTypeable
+-- >>> :set -XDeriveGeneric
+-- >>> :set -XGeneralizedNewtypeDeriving
+-- >>> :set -XOverloadedStrings
+-- >>> :set -XTypeOperators
+-- >>> data User = User { name :: String, age :: Int } deriving (Show, Generic, Typeable)
+-- >>> newtype UserId = UserId Integer deriving (Show, Generic, Typeable, ToJSON)
+-- >>> instance ToJSON User
+-- >>> instance ToSchema User
+-- >>> instance ToSchema UserId
+-- >>> instance ToParamSchema UserId
+-- >>> type GetUsers = Get '[JSON] [User]
+-- >>> type GetUser  = Capture "user_id" UserId :> Get '[JSON] User
+-- >>> type PostUser = ReqBody '[JSON] User :> Post '[JSON] UserId
+-- >>> type UserAPI  = GetUsers :<|> GetUser :<|> PostUser
+-- >>> orderedKeys = encodePretty' (defConfig { confCompare = compare, confIndent = Spaces 0 })
+
+-- $howto
+--
+-- This section explains how to use this library to generate Swagger specification,
+-- modify it and run automatic tests for a servant API.
+--
+-- For the purposes of this section we will use this servant API:
+--
+-- >>> data User = User { name :: String, age :: Int } deriving (Show, Generic, Typeable)
+-- >>> newtype UserId = UserId Integer deriving (Show, Generic, Typeable, ToJSON)
+-- >>> instance ToJSON User
+-- >>> instance ToSchema User
+-- >>> instance ToSchema UserId
+-- >>> instance ToParamSchema UserId
+-- >>> type GetUsers = Get '[JSON] [User]
+-- >>> type GetUser  = Capture "user_id" UserId :> Get '[JSON] User
+-- >>> type PostUser = ReqBody '[JSON] User :> Post '[JSON] UserId
+-- >>> type UserAPI  = GetUsers :<|> GetUser :<|> PostUser
+--
+-- Here we define a user API with three endpoints. @GetUsers@ endpoint returns a list of all users.
+-- @GetUser@ returns a user given his\/her ID. @PostUser@ creates a new user and returns his\/her ID.
+
+-- $generate
+-- In order to generate @'Swagger'@ specification for a servant API, just use @'toSwagger'@:
+--
+-- >>> BSL8.putStrLn . orderedKeys $ toSwagger (Proxy :: Proxy UserAPI)
+-- {"definitions":{"User":{"properties":{"age":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"},"name":{"type":"string"}},"required":["name","age"],"type":"object"},"UserId":{"type":"integer"}},"info":{"title":"","version":""},"paths":{"/":{"get":{"produces":["application/json;charset=utf-8"],"responses":{"200":{"description":"","schema":{"items":{"$ref":"#/definitions/User"},"type":"array"}}}},"post":{"consumes":["application/json;charset=utf-8"],"parameters":[{"in":"body","name":"body","required":true,"schema":{"$ref":"#/definitions/User"}}],"produces":["application/json;charset=utf-8"],"responses":{"200":{"description":"","schema":{"$ref":"#/definitions/UserId"}},"400":{"description":"Invalid `body`"}}}},"/{user_id}":{"get":{"parameters":[{"in":"path","name":"user_id","required":true,"type":"integer"}],"produces":["application/json;charset=utf-8"],"responses":{"200":{"description":"","schema":{"$ref":"#/definitions/User"}},"400":{"description":"Invalid `user_id`"}}}}},"swagger":"2.0"}
+--
+-- By default @'toSwagger'@ will generate specification for all API routes, parameters, headers, responses and data schemas.
+--
+-- For some parameters it will also add 400 responses with a description mentioning parameter name.
+--
+-- Data schemas come from @'ToParamSchema'@ and @'ToSchema'@ classes.
+
+-- $annotate
+-- While initially generated @'Swagger'@ looks good, it lacks some information it can't get from a servant API.
+--
+-- We can add this information using field lenses from @"Data.Swagger"@:
+--
+-- >>> :{
+-- BSL8.putStrLn $ orderedKeys $ toSwagger (Proxy :: Proxy UserAPI)
+--   & info.title        .~ "User API"
+--   & info.version      .~ "1.0"
+--   & info.description  ?~ "This is an API for the Users service"
+--   & info.license      ?~ "MIT"
+--   & host              ?~ "example.com"
+-- :}
+-- {"definitions":{"User":{"properties":{"age":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"},"name":{"type":"string"}},"required":["name","age"],"type":"object"},"UserId":{"type":"integer"}},"host":"example.com","info":{"description":"This is an API for the Users service","license":{"name":"MIT"},"title":"User API","version":"1.0"},"paths":{"/":{"get":{"produces":["application/json;charset=utf-8"],"responses":{"200":{"description":"","schema":{"items":{"$ref":"#/definitions/User"},"type":"array"}}}},"post":{"consumes":["application/json;charset=utf-8"],"parameters":[{"in":"body","name":"body","required":true,"schema":{"$ref":"#/definitions/User"}}],"produces":["application/json;charset=utf-8"],"responses":{"200":{"description":"","schema":{"$ref":"#/definitions/UserId"}},"400":{"description":"Invalid `body`"}}}},"/{user_id}":{"get":{"parameters":[{"in":"path","name":"user_id","required":true,"type":"integer"}],"produces":["application/json;charset=utf-8"],"responses":{"200":{"description":"","schema":{"$ref":"#/definitions/User"}},"400":{"description":"Invalid `user_id`"}}}}},"swagger":"2.0"}
+--
+-- It is also useful to annotate or modify certain endpoints.
+-- @'subOperations'@ provides a convenient way to zoom into a part of an API.
+--
+-- @'subOperations' sub api@ traverses all operations of the @api@ which are also present in @sub@.
+-- Furthermore, @sub@ is required to be an exact sub API of @api. Otherwise it will not typecheck.
+--
+-- @"Data.Swagger.Operation"@ provides some useful helpers that can be used with @'subOperations'@.
+-- One example is applying tags to certain endpoints:
+--
+-- >>> let getOps  = subOperations (Proxy :: Proxy (GetUsers :<|> GetUser)) (Proxy :: Proxy UserAPI)
+-- >>> let postOps = subOperations (Proxy :: Proxy PostUser) (Proxy :: Proxy UserAPI)
+-- >>> :{
+-- BSL8.putStrLn $ orderedKeys $ toSwagger (Proxy :: Proxy UserAPI)
+--   & applyTagsFor getOps  ["get"  & description ?~ "GET operations"]
+--   & applyTagsFor postOps ["post" & description ?~ "POST operations"]
+-- :}
+-- {"definitions":{"User":{"properties":{"age":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"},"name":{"type":"string"}},"required":["name","age"],"type":"object"},"UserId":{"type":"integer"}},"info":{"title":"","version":""},"paths":{"/":{"get":{"produces":["application/json;charset=utf-8"],"responses":{"200":{"description":"","schema":{"items":{"$ref":"#/definitions/User"},"type":"array"}}},"tags":["get"]},"post":{"consumes":["application/json;charset=utf-8"],"parameters":[{"in":"body","name":"body","required":true,"schema":{"$ref":"#/definitions/User"}}],"produces":["application/json;charset=utf-8"],"responses":{"200":{"description":"","schema":{"$ref":"#/definitions/UserId"}},"400":{"description":"Invalid `body`"}},"tags":["post"]}},"/{user_id}":{"get":{"parameters":[{"in":"path","name":"user_id","required":true,"type":"integer"}],"produces":["application/json;charset=utf-8"],"responses":{"200":{"description":"","schema":{"$ref":"#/definitions/User"}},"400":{"description":"Invalid `user_id`"}},"tags":["get"]}}},"swagger":"2.0","tags":[{"description":"GET operations","name":"get"},{"description":"POST operations","name":"post"}]}
+--
+-- This applies @\"get\"@ tag to the @GET@ endpoints and @\"post\"@ tag to the @POST@ endpoint of the User API.
+
+-- $test
+-- Automatic generation of data schemas uses @'ToSchema'@ instances for the types
+-- used in a servant API. But to encode/decode actual data servant uses different classes.
+-- For instance in @UserAPI@ @User@ is always encoded/decoded using @'ToJSON'@ and @'FromJSON'@ instances.
+--
+-- To be sure your Haskell server/client handles data properly you need to check
+-- that @'ToJSON'@ instance always generates values that satisfy schema produced
+-- by @'ToSchema'@ instance.
+--
+-- With @'validateEveryToJSON'@ it is possible to test all those instances automatically,
+-- without having to write down every type:
+--
+-- >>> instance Arbitrary User where arbitrary = User <$> arbitrary <*> arbitrary
+-- >>> instance Arbitrary UserId where arbitrary = UserId <$> arbitrary
+-- >>> hspec $ validateEveryToJSON (Proxy :: Proxy UserAPI)
+-- <BLANKLINE>
+-- [User]
+-- ...
+-- User
+-- ...
+-- UserId
+-- ...
+-- Finished in ... seconds
+-- 3 examples, 0 failures
+--
+-- Although servant is great, chances are that your API clients don't use Haskell.
+-- In many cases @swagger.json@ serves as a specification, not a Haskell type.
+--
+-- In this cases it is a good idea to store generated and annotated @'Swagger'@ in a @swagger.json@ file
+-- under a version control system (such as Git, Subversion, Mercurial, etc.).
+--
+-- It is also recommended to version API based on changes to the @swagger.json@ rather than changes
+-- to the Haskell API.
+--
+-- See <example/test/TodoSpec.hs TodoSpec.hs> for an example of a complete test suite for a swagger specification.
+
+-- $serve
+-- If you're implementing a server for an API, you might also want to serve its @'Swagger'@ specification.
+--
+-- See <example/src/Todo.hs Todo.hs> for an example of a server.
--- a/servant-swagger/src/Servant/Swagger/Internal.hs
+++ b/servant-swagger/src/Servant/Swagger/Internal.hs
@ -0,0 +1,477 @@
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE ConstraintKinds      #-}
+{-# LANGUAGE DataKinds            #-}
+{-# LANGUAGE FlexibleContexts     #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE PolyKinds            #-}
+{-# LANGUAGE RankNTypes           #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TypeOperators        #-}
+#if __GLASGOW_HASKELL__ >= 806
+{-# LANGUAGE UndecidableInstances #-}
+#endif
+module Servant.Swagger.Internal where
+
+import Prelude ()
+import Prelude.Compat
+
+import           Control.Applicative                    ((<|>))
+import           Control.Lens
+import           Data.Aeson
+import           Data.HashMap.Strict.InsOrd             (InsOrdHashMap)
+import qualified Data.HashMap.Strict.InsOrd             as InsOrdHashMap
+import           Data.Foldable (toList)
+import           Data.Proxy
+import           Data.Typeable
+import           Data.Singletons.Bool
+import           Data.Swagger                           hiding (Header)
+import qualified Data.Swagger                           as Swagger
+import           Data.Swagger.Declare
+import           Data.Text                              (Text)
+import qualified Data.Text                              as Text
+import           GHC.TypeLits
+import           Network.HTTP.Media                     (MediaType)
+import           Servant.API
+import           Servant.API.Description                (FoldDescription,
+                                                         reflectDescription)
+import           Servant.API.Modifiers                  (FoldRequired)
+
+import           Servant.Swagger.Internal.TypeLevel.API
+
+-- | Generate a Swagger specification for a servant API.
+--
+-- To generate Swagger specification, your data types need
+-- @'ToParamSchema'@ and/or @'ToSchema'@ instances.
+--
+-- @'ToParamSchema'@ is used for @'Capture'@, @'QueryParam'@ and @'Header'@.
+-- @'ToSchema'@ is used for @'ReqBody'@ and response data types.
+--
+-- You can easily derive those instances via @Generic@.
+-- For more information, refer to <http://hackage.haskell.org/package/swagger2/docs/Data-Swagger.html swagger2 documentation>.
+--
+-- Example:
+--
+-- @
+-- newtype Username = Username String deriving (Generic, ToText)
+--
+-- instance ToParamSchema Username
+--
+-- data User = User
+--   { username :: Username
+--   , fullname :: String
+--   } deriving (Generic)
+--
+-- instance ToJSON User
+-- instance ToSchema User
+--
+-- type MyAPI = QueryParam "username" Username :> Get '[JSON] User
+--
+-- mySwagger :: Swagger
+-- mySwagger = toSwagger (Proxy :: Proxy MyAPI)
+-- @
+class HasSwagger api where
+  -- | Generate a Swagger specification for a servant API.
+  toSwagger :: Proxy api -> Swagger
+
+instance HasSwagger Raw where
+  toSwagger _ = mempty & paths . at "/" ?~ mempty
+
+instance HasSwagger EmptyAPI where
+  toSwagger _ = mempty
+
+-- | All operations of sub API.
+-- This is similar to @'operationsOf'@ but ensures that operations
+-- indeed belong to the API at compile time.
+subOperations :: (IsSubAPI sub api, HasSwagger sub) =>
+  Proxy sub     -- ^ Part of a servant API.
+  -> Proxy api  -- ^ The whole servant API.
+  -> Traversal' Swagger Operation
+subOperations sub _ = operationsOf (toSwagger sub)
+
+-- | Make a singleton Swagger spec (with only one endpoint).
+-- For endpoints with no content see 'mkEndpointNoContent'.
+mkEndpoint :: forall a cs hs proxy method status.
+  (ToSchema a, AllAccept cs, AllToResponseHeader hs, SwaggerMethod method, KnownNat status)
+  => FilePath                                       -- ^ Endpoint path.
+  -> proxy (Verb method status cs (Headers hs a))  -- ^ Method, content-types, headers and response.
+  -> Swagger
+mkEndpoint path proxy
+  = mkEndpointWithSchemaRef (Just ref) path proxy
+      & definitions .~ defs
+  where
+    (defs, ref) = runDeclare (declareSchemaRef (Proxy :: Proxy a)) mempty
+
+-- | Make a singletone 'Swagger' spec (with only one endpoint) and with no content schema.
+mkEndpointNoContent :: forall nocontent cs hs proxy method status.
+  (AllAccept cs, AllToResponseHeader hs, SwaggerMethod method, KnownNat status)
+  => FilePath                                               -- ^ Endpoint path.
+  -> proxy (Verb method status cs (Headers hs nocontent))  -- ^ Method, content-types, headers and response.
+  -> Swagger
+mkEndpointNoContent path proxy
+  = mkEndpointWithSchemaRef Nothing path proxy
+
+-- | Like @'mkEndpoint'@ but with explicit schema reference.
+-- Unlike @'mkEndpoint'@ this function does not update @'definitions'@.
+mkEndpointWithSchemaRef :: forall cs hs proxy method status a.
+  (AllAccept cs, AllToResponseHeader hs, SwaggerMethod method, KnownNat status)
+  => Maybe (Referenced Schema)
+  -> FilePath
+  -> proxy (Verb method status cs (Headers hs a))
+  -> Swagger
+mkEndpointWithSchemaRef mref path _ = mempty
+  & paths.at path ?~
+    (mempty & method ?~ (mempty
+      & produces ?~ MimeList responseContentTypes
+      & at code ?~ Inline (mempty
+            & schema  .~ mref
+            & headers .~ responseHeaders)))
+  where
+    method               = swaggerMethod (Proxy :: Proxy method)
+    code                 = fromIntegral (natVal (Proxy :: Proxy status))
+    responseContentTypes = allContentType (Proxy :: Proxy cs)
+    responseHeaders      = toAllResponseHeaders (Proxy :: Proxy hs)
+
+mkEndpointNoContentVerb :: forall proxy method.
+  (SwaggerMethod method)
+  => FilePath                      -- ^ Endpoint path.
+  -> proxy (NoContentVerb method)  -- ^ Method
+  -> Swagger
+mkEndpointNoContentVerb path _ = mempty
+  & paths.at path ?~
+    (mempty & method ?~ (mempty
+      & at code ?~ Inline mempty))
+  where
+    method               = swaggerMethod (Proxy :: Proxy method)
+    code                 = 204 -- hardcoded in servant-server
+
+-- | Add parameter to every operation in the spec.
+addParam :: Param -> Swagger -> Swagger
+addParam param = allOperations.parameters %~ (Inline param :)
+
+-- | Add accepted content types to every operation in the spec.
+addConsumes :: [MediaType] -> Swagger -> Swagger
+addConsumes cs = allOperations.consumes %~ (<> Just (MimeList cs))
+
+-- | Format given text as inline code in Markdown.
+markdownCode :: Text -> Text
+markdownCode s = "`" <> s <> "`"
+
+addDefaultResponse400 :: ParamName -> Swagger -> Swagger
+addDefaultResponse400 pname = setResponseWith (\old _new -> alter400 old) 400 (return response400)
+  where
+    sname = markdownCode pname
+    description400 = "Invalid " <> sname
+    alter400 = description %~ (<> (" or " <> sname))
+    response400 = mempty & description .~ description400
+
+-- | Methods, available for Swagger.
+class SwaggerMethod method where
+  swaggerMethod :: proxy method -> Lens' PathItem (Maybe Operation)
+
+instance SwaggerMethod 'GET     where swaggerMethod _ = get
+instance SwaggerMethod 'PUT     where swaggerMethod _ = put
+instance SwaggerMethod 'POST    where swaggerMethod _ = post
+instance SwaggerMethod 'DELETE  where swaggerMethod _ = delete
+instance SwaggerMethod 'OPTIONS where swaggerMethod _ = options
+instance SwaggerMethod 'HEAD    where swaggerMethod _ = head_
+instance SwaggerMethod 'PATCH   where swaggerMethod _ = patch
+
+instance HasSwagger (UVerb method cs '[]) where
+  toSwagger _ = mempty
+
+-- | @since <TODO>
+instance
+  {-# OVERLAPPABLE #-}
+  ( ToSchema a,
+    HasStatus a,
+    AllAccept cs,
+    SwaggerMethod method,
+    HasSwagger (UVerb method cs as)
+  ) =>
+  HasSwagger (UVerb method cs (a ': as))
+  where
+  toSwagger _ =
+    toSwagger (Proxy :: Proxy (Verb method (StatusOf a) cs a))
+      `combineSwagger` toSwagger (Proxy :: Proxy (UVerb method cs as))
+
+-- ATTENTION: do not remove this instance!
+-- A similar instance above will always use the more general
+-- polymorphic -- HasSwagger instance and will result in a type error
+-- since 'NoContent' does not have a 'ToSchema' instance.
+instance
+  ( KnownNat status,
+    AllAccept cs,
+    SwaggerMethod method,
+    HasSwagger (UVerb method cs as)
+  ) =>
+  HasSwagger (UVerb method cs (WithStatus status NoContent ': as))
+  where
+  toSwagger _ =
+    toSwagger (Proxy :: Proxy (Verb method status cs NoContent))
+      `combineSwagger` toSwagger (Proxy :: Proxy (UVerb method cs as))
+
+
+-- workaround for https://github.com/GetShopTV/swagger2/issues/218
+-- We'd like to juse use (<>) but the instances are wrong
+combinePathItem :: PathItem -> PathItem -> PathItem
+combinePathItem s t = PathItem
+    { _pathItemGet = _pathItemGet s <> _pathItemGet t
+    , _pathItemPut = _pathItemPut s <> _pathItemPut t
+    , _pathItemPost = _pathItemPost s <> _pathItemPost t
+    , _pathItemDelete = _pathItemDelete s <> _pathItemDelete t
+    , _pathItemOptions = _pathItemOptions s <> _pathItemOptions t
+    , _pathItemHead = _pathItemHead s <> _pathItemHead t
+    , _pathItemPatch = _pathItemPatch s <> _pathItemPatch t
+    , _pathItemParameters = _pathItemParameters s <> _pathItemParameters t
+    }
+
+combineSwagger :: Swagger -> Swagger -> Swagger
+combineSwagger s t = Swagger
+    { _swaggerInfo = _swaggerInfo s <> _swaggerInfo t
+    , _swaggerHost = _swaggerHost s <|> _swaggerHost t
+    , _swaggerBasePath = _swaggerBasePath s <|> _swaggerBasePath t
+    , _swaggerSchemes = _swaggerSchemes s <> _swaggerSchemes t
+    , _swaggerConsumes = _swaggerConsumes s <> _swaggerConsumes t
+    , _swaggerProduces = _swaggerProduces s <> _swaggerProduces t
+    , _swaggerPaths = InsOrdHashMap.unionWith combinePathItem (_swaggerPaths s) (_swaggerPaths t)
+    , _swaggerDefinitions = _swaggerDefinitions s <> _swaggerDefinitions t
+    , _swaggerParameters = _swaggerParameters s <> _swaggerParameters t
+    , _swaggerResponses = _swaggerResponses s <> _swaggerResponses t
+    , _swaggerSecurityDefinitions = _swaggerSecurityDefinitions s <> _swaggerSecurityDefinitions t
+    , _swaggerSecurity = _swaggerSecurity s <> _swaggerSecurity t
+    , _swaggerTags = _swaggerTags s <> _swaggerTags t
+    , _swaggerExternalDocs = _swaggerExternalDocs s <|> _swaggerExternalDocs t
+    }
+
+instance {-# OVERLAPPABLE #-} (ToSchema a, AllAccept cs, KnownNat status, SwaggerMethod method) => HasSwagger (Verb method status cs a) where
+  toSwagger _ = toSwagger (Proxy :: Proxy (Verb method status cs (Headers '[] a)))
+
+-- | @since 1.1.7
+instance (ToSchema a, Accept ct, KnownNat status, SwaggerMethod method) => HasSwagger (Stream method status fr ct a) where
+  toSwagger _ = toSwagger (Proxy :: Proxy (Verb method status '[ct] (Headers '[] a)))
+
+instance {-# OVERLAPPABLE #-} (ToSchema a, AllAccept cs, AllToResponseHeader hs, KnownNat status, SwaggerMethod method)
+  => HasSwagger (Verb method status cs (Headers hs a)) where
+  toSwagger = mkEndpoint "/"
+
+-- ATTENTION: do not remove this instance!
+-- A similar instance above will always use the more general
+-- polymorphic -- HasSwagger instance and will result in a type error
+-- since 'NoContent' does not have a 'ToSchema' instance.
+instance (AllAccept cs, KnownNat status, SwaggerMethod method) => HasSwagger (Verb method status cs NoContent) where
+  toSwagger _ = toSwagger (Proxy :: Proxy (Verb method status cs (Headers '[] NoContent)))
+
+instance (AllAccept cs, AllToResponseHeader hs, KnownNat status, SwaggerMethod method)
+  => HasSwagger (Verb method status cs (Headers hs NoContent)) where
+  toSwagger = mkEndpointNoContent "/"
+
+instance (SwaggerMethod method) => HasSwagger (NoContentVerb method) where
+  toSwagger =  mkEndpointNoContentVerb "/"
+
+instance (HasSwagger a, HasSwagger b) => HasSwagger (a :<|> b) where
+  toSwagger _ = toSwagger (Proxy :: Proxy a) <> toSwagger (Proxy :: Proxy b)
+
+-- | @'Vault'@ combinator does not change our specification at all.
+instance (HasSwagger sub) => HasSwagger (Vault :> sub) where
+  toSwagger _ = toSwagger (Proxy :: Proxy sub)
+
+-- | @'IsSecure'@ combinator does not change our specification at all.
+instance (HasSwagger sub) => HasSwagger (IsSecure :> sub) where
+  toSwagger _ = toSwagger (Proxy :: Proxy sub)
+
+-- | @'RemoteHost'@ combinator does not change our specification at all.
+instance (HasSwagger sub) => HasSwagger (RemoteHost :> sub) where
+  toSwagger _ = toSwagger (Proxy :: Proxy sub)
+
+-- | @'Fragment'@ combinator does not change our specification at all.
+instance HasSwagger sub => HasSwagger (Fragment a :> sub) where
+  toSwagger _ = toSwagger (Proxy :: Proxy sub)
+
+-- | @'HttpVersion'@ combinator does not change our specification at all.
+instance (HasSwagger sub) => HasSwagger (HttpVersion :> sub) where
+  toSwagger _ = toSwagger (Proxy :: Proxy sub)
+
+-- | @'WithNamedContext'@ combinator does not change our specification at all.
+instance (HasSwagger sub) => HasSwagger (WithNamedContext x c sub) where
+  toSwagger _ = toSwagger (Proxy :: Proxy sub)
+
+instance (KnownSymbol sym, HasSwagger sub) => HasSwagger (sym :> sub) where
+  toSwagger _ = prependPath piece (toSwagger (Proxy :: Proxy sub))
+    where
+      piece = symbolVal (Proxy :: Proxy sym)
+
+instance (KnownSymbol sym, Typeable a, ToParamSchema a, HasSwagger sub, KnownSymbol (FoldDescription mods)) => HasSwagger (Capture' mods sym a :> sub) where
+  toSwagger _ = toSwagger (Proxy :: Proxy sub)
+    & addParam param
+    & prependPath capture
+    & addDefaultResponse400 tname
+    where
+      symbol = symbolVal (Proxy :: Proxy sym)
+      pname = if symbol == ""
+        then camelTo2 '-' . tyConName . typeRepTyCon $ typeRep (Proxy :: Proxy a)
+        else symbol
+      tname = Text.pack pname
+      transDesc ""   = Nothing
+      transDesc desc = Just (Text.pack desc)
+      capture = "{" <> pname <> "}"
+      param = mempty
+        & name .~ tname
+        & description .~ transDesc (reflectDescription (Proxy :: Proxy mods))
+        & required ?~ True
+        & schema .~ ParamOther (mempty
+            & in_ .~ ParamPath
+            & paramSchema .~ toParamSchema (Proxy :: Proxy a))
+
+-- | Swagger Spec doesn't have a notion of CaptureAll, this instance is the best effort.
+instance (KnownSymbol sym, Typeable a, ToParamSchema a, HasSwagger sub) => HasSwagger (CaptureAll sym a :> sub) where
+  toSwagger _ = toSwagger (Proxy :: Proxy (Capture sym a :> sub))
+
+instance (KnownSymbol desc, HasSwagger api) => HasSwagger (Description desc :> api) where
+  toSwagger _ = toSwagger (Proxy :: Proxy api)
+    & allOperations.description %~ (Just (Text.pack (symbolVal (Proxy :: Proxy desc))) <>)
+
+instance (KnownSymbol desc, HasSwagger api) => HasSwagger (Summary desc :> api) where
+  toSwagger _ = toSwagger (Proxy :: Proxy api)
+    & allOperations.summary %~ (Just (Text.pack (symbolVal (Proxy :: Proxy desc))) <>)
+
+instance (KnownSymbol sym, ToParamSchema a, HasSwagger sub, SBoolI (FoldRequired mods), KnownSymbol (FoldDescription mods)) => HasSwagger (QueryParam' mods sym a :> sub) where
+  toSwagger _ = toSwagger (Proxy :: Proxy sub)
+    & addParam param
+    & addDefaultResponse400 tname
+    where
+      tname = Text.pack (symbolVal (Proxy :: Proxy sym))
+      transDesc ""   = Nothing
+      transDesc desc = Just (Text.pack desc)
+      param = mempty
+        & name .~ tname
+        & description .~ transDesc (reflectDescription (Proxy :: Proxy mods))
+        & required ?~ reflectBool (Proxy :: Proxy (FoldRequired mods))
+        & schema .~ ParamOther sch
+      sch = mempty
+        & in_ .~ ParamQuery
+        & paramSchema .~ toParamSchema (Proxy :: Proxy a)
+
+instance (KnownSymbol sym, ToParamSchema a, HasSwagger sub) => HasSwagger (QueryParams sym a :> sub) where
+  toSwagger _ = toSwagger (Proxy :: Proxy sub)
+    & addParam param
+    & addDefaultResponse400 tname
+    where
+      tname = Text.pack (symbolVal (Proxy :: Proxy sym))
+      param = mempty
+        & name .~ tname
+        & schema .~ ParamOther sch
+      sch = mempty
+        & in_ .~ ParamQuery
+        & paramSchema .~ pschema
+      pschema = mempty
+#if MIN_VERSION_swagger2(2,4,0)
+        & type_ ?~ SwaggerArray
+#else
+        & type_ .~ SwaggerArray
+#endif
+        & items ?~ SwaggerItemsPrimitive (Just CollectionMulti) (toParamSchema (Proxy :: Proxy a))
+
+instance (KnownSymbol sym, HasSwagger sub) => HasSwagger (QueryFlag sym :> sub) where
+  toSwagger _ = toSwagger (Proxy :: Proxy sub)
+    & addParam param
+    & addDefaultResponse400 tname
+    where
+      tname = Text.pack (symbolVal (Proxy :: Proxy sym))
+      param = mempty
+        & name .~ tname
+        & schema .~ ParamOther (mempty
+            & in_ .~ ParamQuery
+            & allowEmptyValue ?~ True
+            & paramSchema .~ (toParamSchema (Proxy :: Proxy Bool)
+                & default_ ?~ toJSON False))
+
+instance (KnownSymbol sym, ToParamSchema a, HasSwagger sub, SBoolI (FoldRequired mods), KnownSymbol (FoldDescription mods)) => HasSwagger (Header' mods  sym a :> sub) where
+  toSwagger _ = toSwagger (Proxy :: Proxy sub)
+    & addParam param
+    & addDefaultResponse400 tname
+    where
+      tname = Text.pack (symbolVal (Proxy :: Proxy sym))
+      transDesc ""   = Nothing
+      transDesc desc = Just (Text.pack desc)
+      param = mempty
+        & name .~ tname
+        & description .~ transDesc (reflectDescription (Proxy :: Proxy mods))
+        & required ?~ reflectBool (Proxy :: Proxy (FoldRequired mods))
+        & schema .~ ParamOther (mempty
+            & in_ .~ ParamHeader
+            & paramSchema .~ toParamSchema (Proxy :: Proxy a))
+
+instance (ToSchema a, AllAccept cs, HasSwagger sub, KnownSymbol (FoldDescription mods)) => HasSwagger (ReqBody' mods cs a :> sub) where
+  toSwagger _ = toSwagger (Proxy :: Proxy sub)
+    & addParam param
+    & addConsumes (allContentType (Proxy :: Proxy cs))
+    & addDefaultResponse400 tname
+    & definitions %~ (<> defs)
+    where
+      tname = "body"
+      transDesc ""   = Nothing
+      transDesc desc = Just (Text.pack desc)
+      (defs, ref) = runDeclare (declareSchemaRef (Proxy :: Proxy a)) mempty
+      param = mempty
+        & name      .~ tname
+        & description .~ transDesc (reflectDescription (Proxy :: Proxy mods))
+        & required  ?~ True
+        & schema    .~ ParamBody ref
+
+-- | This instance is an approximation.
+--
+-- @since 1.1.7
+instance (ToSchema a, Accept ct, HasSwagger sub, KnownSymbol (FoldDescription mods)) => HasSwagger (StreamBody' mods fr ct a :> sub) where
+  toSwagger _ = toSwagger (Proxy :: Proxy sub)
+    & addParam param
+    & addConsumes (toList (contentTypes (Proxy :: Proxy ct)))
+    & addDefaultResponse400 tname
+    & definitions %~ (<> defs)
+    where
+      tname = "body"
+      transDesc ""   = Nothing
+      transDesc desc = Just (Text.pack desc)
+      (defs, ref) = runDeclare (declareSchemaRef (Proxy :: Proxy a)) mempty
+      param = mempty
+        & name      .~ tname
+        & description .~ transDesc (reflectDescription (Proxy :: Proxy mods))
+        & required  ?~ True
+        & schema    .~ ParamBody ref
+
+-- =======================================================================
+-- Below are the definitions that should be in Servant.API.ContentTypes
+-- =======================================================================
+
+class AllAccept cs where
+  allContentType :: Proxy cs -> [MediaType]
+
+instance AllAccept '[] where
+  allContentType _ = []
+
+instance (Accept c, AllAccept cs) => AllAccept (c ': cs) where
+  allContentType _ = contentType (Proxy :: Proxy c) : allContentType (Proxy :: Proxy cs)
+
+class ToResponseHeader h where
+  toResponseHeader :: Proxy h -> (HeaderName, Swagger.Header)
+
+instance (KnownSymbol sym, ToParamSchema a) => ToResponseHeader (Header sym a) where
+  toResponseHeader _ = (hname, Swagger.Header Nothing hschema)
+    where
+      hname = Text.pack (symbolVal (Proxy :: Proxy sym))
+      hschema = toParamSchema (Proxy :: Proxy a)
+
+class AllToResponseHeader hs where
+  toAllResponseHeaders :: Proxy hs -> InsOrdHashMap HeaderName Swagger.Header
+
+instance AllToResponseHeader '[] where
+  toAllResponseHeaders _ = mempty
+
+instance (ToResponseHeader h, AllToResponseHeader hs) => AllToResponseHeader (h ': hs) where
+  toAllResponseHeaders _ = InsOrdHashMap.insert headerName headerBS hdrs
+    where
+      (headerName, headerBS) = toResponseHeader (Proxy :: Proxy h)
+      hdrs = toAllResponseHeaders (Proxy :: Proxy hs)
+
+instance AllToResponseHeader hs => AllToResponseHeader (HList hs) where
+  toAllResponseHeaders _ = toAllResponseHeaders (Proxy :: Proxy hs)
--- a/servant-swagger/src/Servant/Swagger/Internal/Orphans.hs
+++ b/servant-swagger/src/Servant/Swagger/Internal/Orphans.hs
@ -0,0 +1,27 @@
+{-# OPTIONS_GHC -fno-warn-orphans       #-}
+{-# LANGUAGE CPP                        #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE StandaloneDeriving         #-}
+module Servant.Swagger.Internal.Orphans where
+
+import           Data.Proxy
+                 (Proxy (..))
+import           Data.Swagger
+import           Servant.Types.SourceT
+                 (SourceT)
+#if MIN_VERSION_GLASGOW_HASKELL(8,8,1,0)
+import           Servant.API (WithStatus(..))
+#endif
+
+-- | Pretend that 'SourceT m a' is '[a]'.
+--
+-- @since 1.1.7
+--
+instance ToSchema a => ToSchema (SourceT m a) where
+    declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [a])
+
+#if MIN_VERSION_GLASGOW_HASKELL(8,8,1,0)
+-- @since 1.1.11
+deriving instance ToSchema a => ToSchema (WithStatus s a)
+#endif
--- a/servant-swagger/src/Servant/Swagger/Internal/Test.hs
+++ b/servant-swagger/src/Servant/Swagger/Internal/Test.hs
@ -0,0 +1,205 @@
+{-# LANGUAGE ConstraintKinds     #-}
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE OverloadedStrings   #-}
+module Servant.Swagger.Internal.Test where
+
+import           Data.Aeson                         (ToJSON (..))
+import           Data.Aeson.Encode.Pretty           (encodePretty', defConfig,
+                                                     confCompare)
+import           Data.Swagger                       (Pattern, ToSchema,
+                                                     toSchema)
+import           Data.Swagger.Schema.Validation
+import           Data.Text                          (Text)
+import qualified Data.Text.Lazy                     as TL
+import qualified Data.Text.Lazy.Encoding            as TL
+import           Data.Typeable
+import           Test.Hspec
+import           Test.Hspec.QuickCheck
+import           Test.QuickCheck                    (Arbitrary, Property,
+                                                     counterexample, property)
+
+import           Servant.API
+import           Servant.Swagger.Internal.TypeLevel
+
+-- $setup
+-- >>> import Control.Applicative
+-- >>> import GHC.Generics
+-- >>> import Test.QuickCheck
+-- >>> :set -XDeriveGeneric
+-- >>> :set -XGeneralizedNewtypeDeriving
+-- >>> :set -XDataKinds
+-- >>> :set -XTypeOperators
+
+-- | Verify that every type used with @'JSON'@ content type in a servant API
+-- has compatible @'ToJSON'@ and @'ToSchema'@ instances using @'validateToJSON'@.
+--
+-- /NOTE:/ @'validateEveryToJSON'@ does not perform string pattern validation.
+-- See @'validateEveryToJSONWithPatternChecker'@.
+--
+-- @'validateEveryToJSON'@ will produce one @'prop'@ specification for every type in the API.
+-- Each type only gets one test, even if it occurs multiple times in the API.
+--
+-- >>> data User = User { name :: String, age :: Maybe Int } deriving (Show, Generic, Typeable)
+-- >>> newtype UserId = UserId String deriving (Show, Generic, Typeable, ToJSON, Arbitrary)
+-- >>> instance ToJSON User
+-- >>> instance ToSchema User
+-- >>> instance ToSchema UserId
+-- >>> instance Arbitrary User where arbitrary = User <$> arbitrary <*> arbitrary
+-- >>> type UserAPI = (Capture "user_id" UserId :> Get '[JSON] User) :<|> (ReqBody '[JSON] User :> Post '[JSON] UserId)
+--
+-- >>> hspec $ context "ToJSON matches ToSchema" $ validateEveryToJSON (Proxy :: Proxy UserAPI)
+-- <BLANKLINE>
+-- ToJSON matches ToSchema
+--   User
+-- ...
+--   UserId
+-- ...
+-- Finished in ... seconds
+-- 2 examples, 0 failures
+--
+-- For the test to compile all body types should have the following instances:
+--
+--    * @'ToJSON'@ and @'ToSchema'@ are used to perform the validation;
+--    * @'Typeable'@ is used to name the test for each type;
+--    * @'Show'@ is used to display value for which @'ToJSON'@ does not satisfy @'ToSchema'@.
+--    * @'Arbitrary'@ is used to arbitrarily generate values.
+--
+-- If any of the instances is missing, you'll get a descriptive type error:
+--
+-- >>> data Contact = Contact { fullname :: String, phone :: Integer } deriving (Show, Generic)
+-- >>> instance ToJSON Contact
+-- >>> instance ToSchema Contact
+-- >>> type ContactAPI = Get '[JSON] Contact
+-- >>> hspec $ validateEveryToJSON (Proxy :: Proxy ContactAPI)
+-- ...
+-- ...No instance for (Arbitrary Contact)
+-- ...  arising from a use of ‘validateEveryToJSON’
+-- ...
+validateEveryToJSON
+  :: forall proxy api .
+     TMap (Every [Typeable, Show, Arbitrary, ToJSON, ToSchema])
+          (BodyTypes JSON api)
+  => proxy api   -- ^ Servant API.
+  -> Spec
+validateEveryToJSON _ = props
+  (Proxy :: Proxy [ToJSON, ToSchema])
+  (maybeCounterExample . prettyValidateWith validateToJSON)
+  (Proxy :: Proxy (BodyTypes JSON api))
+
+-- | Verify that every type used with @'JSON'@ content type in a servant API
+-- has compatible @'ToJSON'@ and @'ToSchema'@ instances using @'validateToJSONWithPatternChecker'@.
+--
+-- For validation without patterns see @'validateEveryToJSON'@.
+validateEveryToJSONWithPatternChecker :: forall proxy api. TMap (Every [Typeable, Show, Arbitrary, ToJSON, ToSchema]) (BodyTypes JSON api) =>
+  (Pattern -> Text -> Bool)   -- ^ @'Pattern'@ checker.
+  -> proxy api                -- ^ Servant API.
+  -> Spec
+validateEveryToJSONWithPatternChecker checker _ = props
+  (Proxy :: Proxy [ToJSON, ToSchema])
+  (maybeCounterExample . prettyValidateWith (validateToJSONWithPatternChecker checker))
+  (Proxy :: Proxy (BodyTypes JSON api))
+
+-- * QuickCheck-related stuff
+
+-- | Construct property tests for each type in a list.
+-- The name for each property is the name of the corresponding type.
+--
+-- >>> :{
+--  hspec $
+--    context "read . show == id" $
+--      props
+--        (Proxy :: Proxy [Eq, Show, Read])
+--        (\x -> read (show x) === x)
+--        (Proxy :: Proxy [Bool, Int, String])
+-- :}
+-- <BLANKLINE>
+-- read . show == id
+--   Bool
+-- ...
+--   Int
+-- ...
+--   [Char]
+-- ...
+-- Finished in ... seconds
+-- 3 examples, 0 failures
+props :: forall p p'' cs xs. TMap (Every (Typeable ': Show ': Arbitrary ': cs)) xs =>
+  p cs                                          -- ^ A list of constraints.
+  -> (forall x. EveryTF cs x => x -> Property)  -- ^ Property predicate.
+  -> p'' xs                                     -- ^ A list of types.
+  -> Spec
+props _ f px = sequence_ specs
+  where
+    specs :: [Spec]
+    specs = tmapEvery (Proxy :: Proxy (Typeable ': Show ': Arbitrary ': cs)) aprop px
+
+    aprop :: forall p' a. (EveryTF cs a, Typeable a, Show a, Arbitrary a) => p' a -> Spec
+    aprop _ = prop (show (typeOf (undefined :: a))) (f :: a -> Property)
+
+-- | Pretty print validation errors
+-- together with actual JSON and Swagger Schema
+-- (using 'encodePretty').
+--
+-- >>> import Data.Aeson
+-- >>> import Data.Foldable (traverse_)
+-- >>> data Person = Person { name :: String, phone :: Integer } deriving (Generic)
+-- >>> instance ToJSON Person where toJSON p = object [ "name" .= name p ]
+-- >>> instance ToSchema Person
+-- >>> let person = Person { name = "John", phone = 123456 }
+-- >>> traverse_ putStrLn $ prettyValidateWith validateToJSON person
+-- Validation against the schema fails:
+--   * property "phone" is required, but not found in "{\"name\":\"John\"}"
+-- <BLANKLINE>
+-- JSON value:
+-- {
+--     "name": "John"
+-- }
+-- <BLANKLINE>
+-- Swagger Schema:
+-- {
+--     "properties": {
+--         "name": {
+--             "type": "string"
+--         },
+--         "phone": {
+--             "type": "integer"
+--         }
+--     },
+--     "required": [
+--         "name",
+--         "phone"
+--     ],
+--     "type": "object"
+-- }
+-- <BLANKLINE>
+--
+-- FIXME: this belongs in "Data.Swagger.Schema.Validation" (in @swagger2@).
+prettyValidateWith
+  :: forall a. (ToJSON a, ToSchema a)
+  => (a -> [ValidationError]) -> a -> Maybe String
+prettyValidateWith f x =
+  case f x of
+    []      -> Nothing
+    errors  -> Just $ unlines
+      [ "Validation against the schema fails:"
+      , unlines (map ("  * " ++) errors)
+      , "JSON value:"
+      , ppJSONString json
+      , ""
+      , "Swagger Schema:"
+      , ppJSONString (toJSON schema)
+      ]
+  where
+    ppJSONString = TL.unpack . TL.decodeUtf8 . encodePretty' ppCfg
+    ppCfg = defConfig { confCompare = compare }
+
+    json   = toJSON x
+    schema = toSchema (Proxy :: Proxy a)
+
+-- | Provide a counterexample if there is any.
+maybeCounterExample :: Maybe String -> Property
+maybeCounterExample Nothing  = property True
+maybeCounterExample (Just s) = counterexample s (property False)
--- a/servant-swagger/src/Servant/Swagger/Internal/TypeLevel.hs
+++ b/servant-swagger/src/Servant/Swagger/Internal/TypeLevel.hs
@ -0,0 +1,9 @@
+module Servant.Swagger.Internal.TypeLevel (
+  module Servant.Swagger.Internal.TypeLevel.API,
+  module Servant.Swagger.Internal.TypeLevel.Every,
+  module Servant.Swagger.Internal.TypeLevel.TMap,
+) where
+
+import           Servant.Swagger.Internal.TypeLevel.API
+import           Servant.Swagger.Internal.TypeLevel.Every
+import           Servant.Swagger.Internal.TypeLevel.TMap
--- a/servant-swagger/src/Servant/Swagger/Internal/TypeLevel/API.hs
+++ b/servant-swagger/src/Servant/Swagger/Internal/TypeLevel/API.hs
@ -0,0 +1,86 @@
+{-# LANGUAGE ConstraintKinds      #-}
+{-# LANGUAGE DataKinds            #-}
+{-# LANGUAGE KindSignatures       #-}
+{-# LANGUAGE PolyKinds            #-}
+{-# LANGUAGE TypeFamilies         #-}
+{-# LANGUAGE TypeOperators        #-}
+{-# LANGUAGE UndecidableInstances #-}
+module Servant.Swagger.Internal.TypeLevel.API where
+
+import           GHC.Exts       (Constraint)
+import           Servant.API
+
+-- | Build a list of endpoints from an API.
+type family EndpointsList api where
+  EndpointsList (a :<|> b) = AppendList (EndpointsList a) (EndpointsList b)
+  EndpointsList (e :> a)   = MapSub e (EndpointsList a)
+  EndpointsList a = '[a]
+
+-- | Check whether @sub@ is a sub API of @api@.
+type family IsSubAPI sub api :: Constraint where
+  IsSubAPI sub api = AllIsElem (EndpointsList sub) api
+
+-- | Check that every element of @xs@ is an endpoint of @api@.
+type family AllIsElem xs api :: Constraint where
+  AllIsElem '[] api = ()
+  AllIsElem (x ': xs) api = (IsIn x api, AllIsElem xs api)
+
+-- | Apply @(e :>)@ to every API in @xs@.
+type family MapSub e xs where
+  MapSub e '[] = '[]
+  MapSub e (x ': xs) = (e :> x) ': MapSub e xs
+
+-- | Append two type-level lists.
+type family AppendList xs ys where
+  AppendList '[]       ys = ys
+  AppendList (x ': xs) ys = x ': AppendList xs ys
+
+type family Or (a :: Constraint) (b :: Constraint) :: Constraint where
+  Or () b = ()
+  Or a () = ()
+
+type family IsIn sub api :: Constraint where
+  IsIn e (a :<|> b) = Or (IsIn e a) (IsIn e b)
+  IsIn (e :> a) (e :> b) = IsIn a b
+  IsIn e e = ()
+
+-- | Check whether a type is a member of a list of types.
+-- This is a type-level analogue of @'elem'@.
+type family Elem x xs where
+  Elem x '[] = 'False
+  Elem x (x ': xs) = 'True
+  Elem x (y ': xs) = Elem x xs
+
+-- | Remove duplicates from a type-level list.
+type family Nub xs where
+  Nub '[] = '[]
+  Nub (x ': xs) = x ': Nub (Remove x xs)
+
+-- | Remove element from a type-level list.
+type family Remove x xs where
+  Remove x '[]       = '[]
+  Remove x (x ': ys) =      Remove x ys
+  Remove x (y ': ys) = y ': Remove x ys
+
+-- | Extract a list of unique "body" types for a specific content-type from a servant API.
+type BodyTypes c api = Nub (BodyTypes' c api)
+
+-- | @'AddBodyType' c cs a as@ adds type @a@ to the list @as@
+-- only if @c@ is in @cs@.
+type AddBodyType c cs a as = If (Elem c cs) (a ': as) as
+
+-- | Extract a list of "body" types for a specific content-type from a servant API.
+-- To extract unique types see @'BodyTypes'@.
+--
+-- @'NoContent'@ is removed from the list and not tested.  (This allows for leaving the body
+-- completely empty on responses to requests that only accept 'application/json', while
+-- setting the content-type in the response accordingly.)
+type family BodyTypes' c api :: [*] where
+  BodyTypes' c (Verb verb b cs (Headers hdrs a)) = AddBodyType c cs a '[]
+  BodyTypes' c (Verb verb b cs NoContent) = '[]
+  BodyTypes' c (Verb verb b cs a) = AddBodyType c cs a '[]
+  BodyTypes' c (ReqBody' mods cs a :> api) = AddBodyType c cs a (BodyTypes' c api)
+  BodyTypes' c (e :> api) = BodyTypes' c api
+  BodyTypes' c (a :<|> b) = AppendList (BodyTypes' c a) (BodyTypes' c b)
+  BodyTypes' c api = '[]
+
--- a/servant-swagger/src/Servant/Swagger/Internal/TypeLevel/Every.hs
+++ b/servant-swagger/src/Servant/Swagger/Internal/TypeLevel/Every.hs
@ -0,0 +1,63 @@
+{-# LANGUAGE CPP                     #-}
+{-# LANGUAGE ConstraintKinds         #-}
+{-# LANGUAGE DataKinds               #-}
+{-# LANGUAGE FlexibleContexts        #-}
+{-# LANGUAGE FlexibleInstances       #-}
+{-# LANGUAGE GADTs                   #-}
+{-# LANGUAGE InstanceSigs            #-}
+{-# LANGUAGE KindSignatures          #-}
+{-# LANGUAGE MultiParamTypeClasses   #-}
+{-# LANGUAGE PolyKinds               #-}
+{-# LANGUAGE RankNTypes              #-}
+{-# LANGUAGE ScopedTypeVariables     #-}
+{-# LANGUAGE TypeFamilies            #-}
+{-# LANGUAGE TypeOperators           #-}
+{-# LANGUAGE UndecidableInstances    #-}
+#if __GLASGOW_HASKELL__ >= 800
+{-# LANGUAGE UndecidableSuperClasses #-}
+#endif
+module Servant.Swagger.Internal.TypeLevel.Every where
+
+import           Data.Proxy
+import           GHC.Exts                                (Constraint)
+
+import           Servant.Swagger.Internal.TypeLevel.TMap
+
+-- $setup
+-- >>> :set -XDataKinds
+-- >>> :set -XFlexibleContexts
+-- >>> :set -XGADTs
+-- >>> :set -XRankNTypes
+-- >>> :set -XScopedTypeVariables
+-- >>> import GHC.TypeLits
+-- >>> import Data.List
+
+-- | Apply multiple constraint constructors to a type.
+--
+-- @
+-- EveryTF '[Show, Read] a ~ (Show a, Read a)
+-- @
+--
+-- Note that since this is a type family, you have to alway fully apply @'EveryTF'@.
+--
+-- For partial application of multiple constraint constructors see @'Every'@.
+type family EveryTF cs x :: Constraint where
+  EveryTF '[] x = ()
+  EveryTF (c ': cs) x = (c x, EveryTF cs x)
+
+-- | Apply multiple constraint constructors to a type as a class.
+--
+-- This is different from @'EveryTF'@ in that it allows partial application.
+class EveryTF cs x => Every (cs :: [* -> Constraint]) (x :: *) where
+
+instance Every '[] x where
+instance (c x, Every cs x) => Every (c ': cs) x where
+
+-- | Like @'tmap'@, but uses @'Every'@ for multiple constraints.
+--
+-- >>> let zero :: forall p a. (Show a, Num a) => p a -> String; zero _ = show (0 :: a)
+-- >>> tmapEvery (Proxy :: Proxy [Show, Num]) zero (Proxy :: Proxy [Int, Float]) :: [String]
+-- ["0","0.0"]
+tmapEvery :: forall a cs p p'' xs. (TMap (Every cs) xs) =>
+  p cs -> (forall x p'. Every cs x => p' x -> a) -> p'' xs -> [a]
+tmapEvery _ = tmap (Proxy :: Proxy (Every cs))
--- a/servant-swagger/src/Servant/Swagger/Internal/TypeLevel/TMap.hs
+++ b/servant-swagger/src/Servant/Swagger/Internal/TypeLevel/TMap.hs
@ -0,0 +1,37 @@
+{-# LANGUAGE ConstraintKinds       #-}
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE KindSignatures        #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PolyKinds             #-}
+{-# LANGUAGE RankNTypes            #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE UndecidableInstances  #-}
+module Servant.Swagger.Internal.TypeLevel.TMap where
+
+import           Data.Proxy
+import           GHC.Exts   (Constraint)
+
+-- $setup
+-- >>> :set -XDataKinds
+-- >>> :set -XFlexibleContexts
+-- >>> :set -XGADTs
+-- >>> :set -XRankNTypes
+-- >>> :set -XScopedTypeVariables
+-- >>> import GHC.TypeLits
+-- >>> import Data.List
+
+-- | Map a list of constrained types to a list of values.
+--
+-- >>> tmap (Proxy :: Proxy KnownSymbol) symbolVal (Proxy :: Proxy ["hello", "world"])
+-- ["hello","world"]
+class TMap (q :: k -> Constraint) (xs :: [k]) where
+  tmap :: p q -> (forall x p'. q x => p' x -> a) -> p'' xs -> [a]
+
+instance TMap q '[] where
+  tmap _ _ _ = []
+
+instance (q x, TMap q xs) => TMap q (x ': xs) where
+  tmap q f _ = f (Proxy :: Proxy x) : tmap q f (Proxy :: Proxy xs)
+
--- a/servant-swagger/src/Servant/Swagger/Test.hs
+++ b/servant-swagger/src/Servant/Swagger/Test.hs
@ -0,0 +1,13 @@
+-- |
+-- Module:      Servant.Swagger.Test
+-- License:     BSD3
+-- Maintainer:  Nickolay Kudasov <nickolay@getshoptv.com>
+-- Stability:   experimental
+--
+-- Automatic tests for servant API against Swagger spec.
+module Servant.Swagger.Test (
+  validateEveryToJSON,
+  validateEveryToJSONWithPatternChecker,
+) where
+
+import           Servant.Swagger.Internal.Test
--- a/servant-swagger/src/Servant/Swagger/TypeLevel.hs
+++ b/servant-swagger/src/Servant/Swagger/TypeLevel.hs
@ -0,0 +1,15 @@
+-- |
+-- Module:      Servant.Swagger.TypeLevel
+-- License:     BSD3
+-- Maintainer:  Nickolay Kudasov <nickolay@getshoptv.com>
+-- Stability:   experimental
+--
+-- Useful type families for servant APIs.
+module Servant.Swagger.TypeLevel (
+  IsSubAPI,
+  EndpointsList,
+  BodyTypes,
+) where
+
+import           Servant.Swagger.Internal.TypeLevel
+
--- a/servant-swagger/stack.yaml
+++ b/servant-swagger/stack.yaml
@ -0,0 +1,8 @@
+resolver: lts-16.7
+packages:
+- '.'
+- example/
+
+extra-deps:
+- servant-0.18.1
+- servant-server-0.18.1
--- a/servant-swagger/test/Servant/SwaggerSpec.hs
+++ b/servant-swagger/test/Servant/SwaggerSpec.hs
@ -0,0 +1,489 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds          #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric      #-}
+{-# LANGUAGE OverloadedStrings  #-}
+{-# LANGUAGE QuasiQuotes        #-}
+{-# LANGUAGE TypeFamilies       #-}
+{-# LANGUAGE TypeOperators      #-}
+{-# LANGUAGE PackageImports     #-}
+module Servant.SwaggerSpec where
+
+import           Control.Lens
+import           Data.Aeson       (ToJSON(toJSON), Value, genericToJSON)
+import           Data.Aeson.QQ.Simple
+import qualified Data.Aeson.Types as JSON
+import           Data.Char        (toLower)
+import           Data.Int         (Int64)
+import           Data.Proxy
+import           Data.Swagger
+import           Data.Text        (Text)
+import           Data.Time
+import           GHC.Generics
+import           Servant.API
+import           Servant.Swagger
+import           Servant.Test.ComprehensiveAPI (comprehensiveAPI)
+import           Test.Hspec       hiding (example)
+
+#if !MIN_VERSION_swagger2(2,4,0)
+import           Data.Aeson.Lens   (key, _Array)
+import qualified Data.Vector as V
+#endif
+
+checkAPI :: HasSwagger api => Proxy api -> Value -> IO ()
+checkAPI proxy = checkSwagger (toSwagger proxy)
+
+checkSwagger :: Swagger -> Value -> IO ()
+checkSwagger swag js = toJSON swag `shouldBe` js
+
+spec :: Spec
+spec = describe "HasSwagger" $ do
+  it "Todo API" $ checkAPI (Proxy :: Proxy TodoAPI) todoAPI
+  it "Hackage API (with tags)" $ checkSwagger hackageSwaggerWithTags hackageAPI
+  it "GetPost API (test subOperations)" $ checkSwagger getPostSwagger getPostAPI
+  it "UVerb API" $ checkSwagger uverbSwagger uverbAPI
+  it "Comprehensive API" $ do
+    let _x = toSwagger comprehensiveAPI
+    True `shouldBe` True -- type-level test
+
+main :: IO ()
+main = hspec spec
+
+-- =======================================================================
+-- Todo API
+-- =======================================================================
+
+data Todo = Todo
+  { created :: UTCTime
+  , title   :: String
+  , summary :: Maybe String
+  } deriving (Generic)
+
+instance ToJSON Todo
+instance ToSchema Todo
+
+newtype TodoId = TodoId String deriving (Generic)
+instance ToParamSchema TodoId
+
+type TodoAPI = "todo" :> Capture "id" TodoId :> Get '[JSON] Todo
+
+todoAPI :: Value
+todoAPI = [aesonQQ|
+{
+  "swagger":"2.0",
+  "info":
+    {
+      "title": "",
+      "version": ""
+    },
+  "definitions":
+    {
+      "Todo":
+        {
+          "type": "object",
+          "required": [ "created", "title" ],
+          "properties":
+            {
+              "created": { "$ref": "#/definitions/UTCTime" },
+              "title": { "type": "string" },
+              "summary": { "type": "string" }
+            }
+        },
+      "UTCTime":
+        {
+          "type": "string",
+          "format": "yyyy-mm-ddThh:MM:ssZ",
+          "example": "2016-07-22T00:00:00Z"
+        }
+    },
+  "paths":
+    {
+      "/todo/{id}":
+        {
+          "get":
+            {
+              "responses":
+                {
+                  "200":
+                    {
+                      "schema": { "$ref":"#/definitions/Todo" },
+                      "description": ""
+                    },
+                  "400": { "description": "Invalid `id`" }
+                },
+              "produces": [ "application/json;charset=utf-8" ],
+              "parameters":
+                [
+                  {
+                    "required": true,
+                    "in": "path",
+                    "name": "id",
+                    "type": "string"
+                   }
+                ]
+            }
+        }
+    }
+}
+|]
+
+-- =======================================================================
+-- Hackage API
+-- =======================================================================
+
+type HackageAPI
+    = HackageUserAPI
+ :<|> HackagePackagesAPI
+
+type HackageUserAPI =
+      "users" :> Get '[JSON] [UserSummary]
+ :<|> "user"  :> Capture "username" Username :> Get '[JSON] UserDetailed
+
+type HackagePackagesAPI
+    = "packages" :> Get '[JSON] [Package]
+
+type Username = Text
+
+data UserSummary = UserSummary
+  { summaryUsername :: Username
+  , summaryUserid   :: Int64  -- Word64 would make sense too
+  } deriving (Eq, Show, Generic)
+
+lowerCutPrefix :: String -> String -> String
+lowerCutPrefix s = map toLower . drop (length s)
+
+instance ToJSON UserSummary where
+  toJSON = genericToJSON JSON.defaultOptions { JSON.fieldLabelModifier = lowerCutPrefix "summary" }
+
+instance ToSchema UserSummary where
+  declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions { fieldLabelModifier = lowerCutPrefix "summary" } proxy
+    & mapped.schema.example ?~ toJSON UserSummary
+         { summaryUsername = "JohnDoe"
+         , summaryUserid   = 123 }
+
+type Group = Text
+
+data UserDetailed = UserDetailed
+  { username :: Username
+  , userid   :: Int64
+  , groups   :: [Group]
+  } deriving (Eq, Show, Generic)
+instance ToSchema UserDetailed
+
+newtype Package = Package { packageName :: Text }
+  deriving (Eq, Show, Generic)
+instance ToSchema Package
+
+hackageSwaggerWithTags :: Swagger
+hackageSwaggerWithTags = toSwagger (Proxy :: Proxy HackageAPI)
+  & host ?~ Host "hackage.haskell.org" Nothing
+  & applyTagsFor usersOps    ["users"    & description ?~ "Operations about user"]
+  & applyTagsFor packagesOps ["packages" & description ?~ "Query packages"]
+  where
+    usersOps, packagesOps :: Traversal' Swagger Operation
+    usersOps    = subOperations (Proxy :: Proxy HackageUserAPI)     (Proxy :: Proxy HackageAPI)
+    packagesOps = subOperations (Proxy :: Proxy HackagePackagesAPI) (Proxy :: Proxy HackageAPI)
+
+hackageAPI :: Value
+hackageAPI = modifyValue [aesonQQ|
+{
+   "swagger":"2.0",
+   "host":"hackage.haskell.org",
+   "info":{
+      "version":"",
+      "title":""
+   },
+   "definitions":{
+      "UserDetailed":{
+         "required":[
+            "username",
+            "userid",
+            "groups"
+         ],
+         "type":"object",
+         "properties":{
+            "groups":{
+               "items":{
+                  "type":"string"
+               },
+               "type":"array"
+            },
+            "username":{
+               "type":"string"
+            },
+            "userid":{
+               "maximum":9223372036854775807,
+               "minimum":-9223372036854775808,
+               "type":"integer",
+               "format":"int64"
+            }
+         }
+      },
+      "Package":{
+         "required":[
+            "packageName"
+         ],
+         "type":"object",
+         "properties":{
+            "packageName":{
+               "type":"string"
+            }
+         }
+      },
+      "UserSummary":{
+         "required":[
+            "username",
+            "userid"
+         ],
+         "type":"object",
+         "properties":{
+            "username":{
+               "type":"string"
+            },
+            "userid":{
+               "maximum":9223372036854775807,
+               "minimum":-9223372036854775808,
+               "type":"integer",
+               "format":"int64"
+            }
+         },
+         "example":{
+            "username": "JohnDoe",
+            "userid": 123
+         }
+      }
+   },
+   "paths":{
+      "/users":{
+         "get":{
+            "responses":{
+               "200":{
+                  "schema":{
+                     "items":{
+                        "$ref":"#/definitions/UserSummary"
+                     },
+                     "type":"array"
+                  },
+                  "description":""
+               }
+            },
+            "produces":[
+               "application/json;charset=utf-8"
+            ],
+            "tags":[
+               "users"
+            ]
+         }
+      },
+      "/packages":{
+         "get":{
+            "responses":{
+               "200":{
+                  "schema":{
+                     "items":{
+                        "$ref":"#/definitions/Package"
+                     },
+                     "type":"array"
+                  },
+                  "description":""
+               }
+            },
+            "produces":[
+               "application/json;charset=utf-8"
+            ],
+            "tags":[
+               "packages"
+            ]
+         }
+      },
+      "/user/{username}":{
+         "get":{
+            "responses":{
+               "400":{
+                  "description":"Invalid `username`"
+               },
+               "200":{
+                  "schema":{
+                     "$ref":"#/definitions/UserDetailed"
+                  },
+                  "description":""
+               }
+            },
+            "produces":[
+               "application/json;charset=utf-8"
+            ],
+            "parameters":[
+               {
+                  "required":true,
+                  "in":"path",
+                  "name":"username",
+                  "type":"string"
+               }
+            ],
+            "tags":[
+               "users"
+            ]
+         }
+      }
+   },
+   "tags":[
+      {
+         "name":"users",
+         "description":"Operations about user"
+      },
+      {
+         "name":"packages",
+         "description":"Query packages"
+      }
+   ]
+}
+|]
+  where
+    modifyValue :: Value -> Value
+#if MIN_VERSION_swagger2(2,4,0)
+    modifyValue = id
+#else
+    -- swagger2-2.4 preserves order of tags
+    -- swagger2-2.3 used Set, so they are ordered
+    -- packages comes before users.
+    -- We simply reverse, not properly sort here for simplicity: 2 elements.
+    modifyValue = over (key "tags" . _Array) V.reverse
+#endif
+
+
+-- =======================================================================
+-- Get/Post API (test for subOperations)
+-- =======================================================================
+
+type GetPostAPI = Get '[JSON] String :<|> Post '[JSON] String
+
+getPostSwagger :: Swagger
+getPostSwagger = toSwagger (Proxy :: Proxy GetPostAPI)
+  & applyTagsFor getOps ["get" & description ?~ "GET operations"]
+  where
+    getOps :: Traversal' Swagger Operation
+    getOps = subOperations (Proxy :: Proxy (Get '[JSON] String)) (Proxy :: Proxy GetPostAPI)
+
+getPostAPI :: Value
+getPostAPI = [aesonQQ|
+{
+   "swagger":"2.0",
+   "info":{
+      "version":"",
+      "title":""
+   },
+   "paths":{
+      "/":{
+         "post":{
+            "responses":{
+               "200":{
+                  "schema":{
+                     "type":"string"
+                  },
+                  "description":""
+               }
+            },
+            "produces":[ "application/json;charset=utf-8" ]
+         },
+         "get":{
+            "responses":{
+               "200":{
+                  "schema":{
+                     "type":"string"
+                  },
+                  "description":""
+               }
+            },
+            "produces":[ "application/json;charset=utf-8" ],
+            "tags":[ "get" ]
+         }
+      }
+   },
+   "tags":[
+      {
+         "name":"get",
+         "description":"GET operations"
+      }
+   ]
+}
+|]
+
+-- =======================================================================
+-- UVerb API
+-- =======================================================================
+
+data Lunch = Lunch {name :: String}
+  deriving (Eq, Show, Generic)
+
+instance ToSchema Lunch
+
+instance HasStatus Lunch where
+  type StatusOf Lunch = 200
+
+data NoLunch = NoLunch
+  deriving (Eq, Show, Generic)
+
+instance ToSchema NoLunch
+
+instance HasStatus NoLunch where
+  type StatusOf NoLunch = 404
+
+type UVerbAPI2 =
+  "lunch" :> UVerb 'GET '[JSON] '[Lunch, NoLunch]
+
+uverbSwagger :: Swagger
+uverbSwagger = toSwagger (Proxy :: Proxy UVerbAPI2)
+
+uverbAPI :: Value
+uverbAPI =
+  [aesonQQ|
+  {
+    "swagger": "2.0",
+    "info": {
+      "version": "",
+      "title": ""
+    },
+    "definitions": {
+      "Lunch": {
+        "required": [
+          "name"
+        ],
+        "type": "object",
+        "properties": {
+          "name": {
+            "type": "string"
+          }
+        }
+      },
+      "NoLunch": {
+        "type": "string",
+        "enum": [
+          "NoLunch"
+        ]
+      }
+    },
+    "paths": {
+      "/lunch": {
+        "get": {
+          "responses": {
+            "404": {
+              "schema": {
+                "$ref": "#/definitions/NoLunch"
+              },
+              "description": ""
+            },
+            "200": {
+              "schema": {
+                "$ref": "#/definitions/Lunch"
+              },
+              "description": ""
+            }
+          },
+          "produces": [
+            "application/json;charset=utf-8"
+          ]
+        }
+      }
+    }
+}
+|]
--- a/servant-swagger/test/Spec.hs
+++ b/servant-swagger/test/Spec.hs
@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
--- a/servant-swagger/test/doctests.hs
+++ b/servant-swagger/test/doctests.hs
@ -0,0 +1,12 @@
+module Main where
+
+import Build_doctests (flags, pkgs, module_sources)
+import Data.Foldable (traverse_)
+import Test.DocTest
+
+main :: IO ()
+main = do
+    traverse_ putStrLn args
+    doctest args
+  where
+    args = flags ++ pkgs ++ module_sources