From 699c86fa1940372571d8785c52ce67fb16a1f2a6 Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Sat, 2 Jun 2018 16:22:20 -0400 Subject: [PATCH] Split into servant-checked-exceptions and -core - Split out servant-checked-exceptions-core and build with ghc/ghcjs - Split out servant-checked-exceptions serverside package and test with ghc - Shuffle documentation - Bump version number and CHANGELOGs - Updating the travis config to the latest version. --- .gitignore | 1 + .travis.yml | 105 ++++++++++--- CHANGELOG.md | 15 -- README.md | 10 ++ cabal.project | 1 + servant-checked-exceptions-core/CHANGELOG.md | 11 ++ servant-checked-exceptions-core/LICENSE | 30 ++++ servant-checked-exceptions-core/README.md | 1 + .../example}/Api.hs | 0 .../example}/Docs.hs | 0 .../servant-checked-exceptions-core.cabal | 84 +++++++++++ .../src}/Servant/Checked/Exceptions.hs | 6 +- .../Servant/Checked/Exceptions/Envelope.hs | 31 ++++ .../Servant/Checked/Exceptions/Internal.hs | 11 ++ .../Checked/Exceptions/Internal/Envelope.hs | 31 +--- .../Checked/Exceptions/Internal/Prism.hs | 0 .../Checked/Exceptions/Internal/Servant.hs | 19 +++ .../Exceptions/Internal/Servant/API.hs | 46 +----- .../Exceptions/Internal/Servant/Docs.hs | 0 .../Checked/Exceptions/Internal/Util.hs | 0 .../Checked/Exceptions/Internal/Verbs.hs | 69 +++++++++ .../src/Servant/Checked/Exceptions/Verbs.hs | 43 ++++++ .../test}/DocTest.hs | 0 servant-checked-exceptions/CHANGELOG.md | 33 ++++ servant-checked-exceptions/LICENSE | 30 ++++ servant-checked-exceptions/README.md | 1 + servant-checked-exceptions/example/Api.hs | 141 ++++++++++++++++++ .../example}/Client.hs | 0 servant-checked-exceptions/example/Docs.hs | 63 ++++++++ .../example}/Server.hs | 0 .../servant-checked-exceptions.cabal | 18 +-- .../src/Servant/Checked/Exceptions.hs | 99 ++++++++++++ .../Servant/Checked/Exceptions/Internal.hs | 5 +- .../Checked/Exceptions/Internal/Servant.hs | 0 .../Exceptions/Internal/Servant/API.hs | 7 + .../Exceptions/Internal/Servant/Client.hs | 0 .../Exceptions/Internal/Servant/Server.hs | 2 +- .../test}/Spec.hs | 0 stack.yaml | 3 +- 39 files changed, 787 insertions(+), 129 deletions(-) delete mode 100644 CHANGELOG.md create mode 100644 cabal.project create mode 100644 servant-checked-exceptions-core/CHANGELOG.md create mode 100644 servant-checked-exceptions-core/LICENSE create mode 120000 servant-checked-exceptions-core/README.md rename {example => servant-checked-exceptions-core/example}/Api.hs (100%) rename {example => servant-checked-exceptions-core/example}/Docs.hs (100%) create mode 100644 servant-checked-exceptions-core/servant-checked-exceptions-core.cabal rename {src => servant-checked-exceptions-core/src}/Servant/Checked/Exceptions.hs (95%) create mode 100644 servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Envelope.hs create mode 100644 servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Internal.hs rename {src => servant-checked-exceptions-core/src}/Servant/Checked/Exceptions/Internal/Envelope.hs (96%) rename {src => servant-checked-exceptions-core/src}/Servant/Checked/Exceptions/Internal/Prism.hs (100%) create mode 100644 servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Internal/Servant.hs rename {src => servant-checked-exceptions-core/src}/Servant/Checked/Exceptions/Internal/Servant/API.hs (57%) rename {src => servant-checked-exceptions-core/src}/Servant/Checked/Exceptions/Internal/Servant/Docs.hs (100%) rename {src => servant-checked-exceptions-core/src}/Servant/Checked/Exceptions/Internal/Util.hs (100%) create mode 100644 servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Internal/Verbs.hs create mode 100644 servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Verbs.hs rename {test => servant-checked-exceptions-core/test}/DocTest.hs (100%) create mode 100644 servant-checked-exceptions/CHANGELOG.md create mode 100644 servant-checked-exceptions/LICENSE create mode 120000 servant-checked-exceptions/README.md create mode 100644 servant-checked-exceptions/example/Api.hs rename {example => servant-checked-exceptions/example}/Client.hs (100%) create mode 100644 servant-checked-exceptions/example/Docs.hs rename {example => servant-checked-exceptions/example}/Server.hs (100%) rename servant-checked-exceptions.cabal => servant-checked-exceptions/servant-checked-exceptions.cabal (87%) create mode 100644 servant-checked-exceptions/src/Servant/Checked/Exceptions.hs rename {src => servant-checked-exceptions/src}/Servant/Checked/Exceptions/Internal.hs (72%) rename {src => servant-checked-exceptions/src}/Servant/Checked/Exceptions/Internal/Servant.hs (100%) create mode 100644 servant-checked-exceptions/src/Servant/Checked/Exceptions/Internal/Servant/API.hs rename {src => servant-checked-exceptions/src}/Servant/Checked/Exceptions/Internal/Servant/Client.hs (100%) rename {src => servant-checked-exceptions/src}/Servant/Checked/Exceptions/Internal/Servant/Server.hs (99%) rename {test => servant-checked-exceptions/test}/Spec.hs (100%) diff --git a/.gitignore b/.gitignore index 096abdd..18a004f 100644 --- a/.gitignore +++ b/.gitignore @@ -16,3 +16,4 @@ cabal.sandbox.config *.hp *.eventlog .stack-work/ +*.nix diff --git a/.travis.yml b/.travis.yml index a47f030..7525c2d 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,11 +1,18 @@ +# This is the complex Travis configuration, which is intended for use +# on open source libraries which need compatibility across multiple GHC +# versions, must work with cabal-install, and should be +# cross-platform. For more information and other options, see: +# +# https://docs.haskellstack.org/en/stable/travis_ci/ +# # Copy these contents into the root directory of your Github project in a file # named .travis.yml # Use new container infrastructure to enable caching sudo: false -# Choose a lightweight base image; we provide our own build tools. -language: c +# Do not choose a language; we provide our own build tools. +language: generic # Caching so the next build will be fast too. cache: @@ -13,6 +20,7 @@ cache: - $HOME/.ghc - $HOME/.cabal - $HOME/.stack + - $TRAVIS_BUILD_DIR/.stack-work # The different configurations we want to test. We have BUILD=cabal which uses # cabal-install, and BUILD=stack which uses Stack. More documentation on each @@ -29,14 +37,32 @@ matrix: # are finished building. Don't wait for the "allowed_failures" to finish. fast_finish: true include: + # We grab the appropriate GHC and cabal-install versions from hvr's PPA. See: + # https://github.com/hvr/multi-ghc-travis + #- env: BUILD=cabal GHCVER=7.0.4 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7 + # compiler: ": #GHC 7.0.4" + # addons: {apt: {packages: [cabal-install-1.16,ghc-7.0.4,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} + #- env: BUILD=cabal GHCVER=7.2.2 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7 + # compiler: ": #GHC 7.2.2" + # addons: {apt: {packages: [cabal-install-1.16,ghc-7.2.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} + #- env: BUILD=cabal GHCVER=7.4.2 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7 + # compiler: ": #GHC 7.4.2" + # addons: {apt: {packages: [cabal-install-1.16,ghc-7.4.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} + #- env: BUILD=cabal GHCVER=7.6.3 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7 + # compiler: ": #GHC 7.6.3" + # addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} + #- env: BUILD=cabal GHCVER=7.8.4 CABALVER=1.18 HAPPYVER=1.19.5 ALEXVER=3.1.7 + # compiler: ": #GHC 7.8.4" + # addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} + #- env: BUILD=cabal GHCVER=7.10.3 CABALVER=1.22 HAPPYVER=1.19.5 ALEXVER=3.1.7 + # compiler: ": #GHC 7.10.3" + # addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} - env: BUILD=cabal GHCVER=8.0.2 CABALVER=1.24 HAPPYVER=1.19.5 ALEXVER=3.1.7 compiler: ": #GHC 8.0.2" addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} - - env: BUILD=cabal GHCVER=8.2.2 CABALVER=2.0 HAPPYVER=1.19.5 ALEXVER=3.1.7 compiler: ": #GHC 8.2.2" addons: {apt: {packages: [cabal-install-2.0,ghc-8.2.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} - - env: BUILD=cabal GHCVER=8.4.1 CABALVER=2.0 HAPPYVER=1.19.5 ALEXVER=3.1.7 compiler: ": #GHC 8.4.1" addons: {apt: {packages: [cabal-install-2.0,ghc-8.4.1,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} @@ -47,25 +73,67 @@ matrix: compiler: ": #GHC HEAD" addons: {apt: {packages: [cabal-install-head,ghc-head,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} - # The Stack LTS builds. - - # Build using the configuration specified in the stack.yaml file in the - # current directory. + # The Stack builds. We can pass in arbitrary Stack arguments via the ARGS + # variable, such as using --stack-yaml to point to a different file. - env: BUILD=stack ARGS="" compiler: ": #stack default" addons: {apt: {packages: [libgmp-dev]}} + #- env: BUILD=stack ARGS="--resolver lts-2" + # compiler: ": #stack 7.8.4" + # addons: {apt: {packages: [libgmp-dev]}} + + #- env: BUILD=stack ARGS="--resolver lts-3" + # compiler: ": #stack 7.10.2" + # addons: {apt: {packages: [libgmp-dev]}} + + #- env: BUILD=stack ARGS="--resolver lts-6" + # compiler: ": #stack 7.10.3" + # addons: {apt: {packages: [libgmp-dev]}} + + #- env: BUILD=stack ARGS="--resolver lts-7" + # compiler: ": #stack 8.0.1" + # addons: {apt: {packages: [libgmp-dev]}} + + # - env: BUILD=stack ARGS="--resolver lts-9" + # compiler: ": #stack 8.0.2" + # addons: {apt: {packages: [libgmp-dev]}} + - env: BUILD=stack ARGS="--resolver lts-11" compiler: ": #stack 8.2.2" addons: {apt: {packages: [libgmp-dev]}} - # Nightly builds are allowed to fail - env: BUILD=stack ARGS="--resolver nightly" compiler: ": #stack nightly" addons: {apt: {packages: [libgmp-dev]}} - # Build on OS X with Stack in addition to Linux. + # Build on macOS in addition to Linux + - env: BUILD=stack ARGS="" + compiler: ": #stack default osx" + os: osx + + # Travis includes an macOS which is incompatible with GHC 7.8.4 + #- env: BUILD=stack ARGS="--resolver lts-2" + # compiler: ": #stack 7.8.4 osx" + # os: osx + + #- env: BUILD=stack ARGS="--resolver lts-3" + # compiler: ": #stack 7.10.2 osx" + # os: osx + + #- env: BUILD=stack ARGS="--resolver lts-6" + # compiler: ": #stack 7.10.3 osx" + # os: osx + + #- env: BUILD=stack ARGS="--resolver lts-7" + # compiler: ": #stack 8.0.1 osx" + # os: osx + + # - env: BUILD=stack ARGS="--resolver lts-9" + # compiler: ": #stack 8.0.2 osx" + # os: osx + - env: BUILD=stack ARGS="--resolver lts-11" compiler: ": #stack 8.2.2 osx" os: osx @@ -75,8 +143,8 @@ matrix: os: osx allow_failures: - - env: BUILD=stack ARGS="--resolver nightly" - env: BUILD=cabal GHCVER=head CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7 + - env: BUILD=stack ARGS="--resolver nightly" - os: osx before_install: @@ -93,9 +161,9 @@ before_install: - | if [ `uname` = "Darwin" ] then - travis_retry curl --insecure -L https://www.stackage.org/stack/osx-x86_64 | tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin + travis_retry curl --insecure -L https://get.haskellstack.org/stable/osx-x86_64.tar.gz | tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin else - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' + travis_retry curl -L https://get.haskellstack.org/stable/linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' fi # Use the more reliable S3 mirror of Hackage @@ -103,10 +171,6 @@ before_install: echo 'remote-repo: hackage.haskell.org:http://hackage.fpcomplete.com/' > $HOME/.cabal/config echo 'remote-repo-cache: $HOME/.cabal/packages' >> $HOME/.cabal/config - if [ "$CABALVER" != "1.16" ] - then - echo 'jobs: $ncpus' >> $HOME/.cabal/config - fi install: - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" @@ -160,10 +224,13 @@ script: cd "$PKGVER" cabal configure --enable-tests --ghc-options -O0 --flags="buildexample" cabal build - cabal test + if [ "$CABALVER" = "1.16" ] || [ "$CABALVER" = "1.18" ]; then + cabal test + else + cabal test --show-details=streaming --log=/dev/stdout + fi cd $ORIGDIR done ;; esac set +ex - diff --git a/CHANGELOG.md b/CHANGELOG.md deleted file mode 100644 index 16b9f07..0000000 --- a/CHANGELOG.md +++ /dev/null @@ -1,15 +0,0 @@ - -## 1.1.0.0 - -* Updated the servant dependency to >= 0.12. - -## 1.0.0.0 - -* Add a `ErrStatus` class that can be used to set the HTTP Status Code. Given - an endpoint that returns a `Envelope '[e1, e2] a`, you must declare an - instance of `ErrStatus` for `e1` and `e2`. This is a breaking change. - -## 0.4.1.0 - -* Add `NoThrow` type to represent handlers that don't throw any errors, but - do return a result wrapped in an `Envelope`. diff --git a/README.md b/README.md index 7cc973f..5bd7aba 100644 --- a/README.md +++ b/README.md @@ -210,3 +210,13 @@ search api: ``` You can see that both the success and error responses are documented. + +## Packaging the core types + +[`servant-checked-exceptions-core`](https://hackage.haskell.org/package/servant-checked-exceptions-core) +exports the core types need for building an API with checked exceptions, +allowing you to avoid depending on server-side libraries like `warp`, `Glob` +and `servant-server`. This can be useful if you are writing an API meant to be +shared with ghcjs and run in a browser, where these dependencies aren't +available. + diff --git a/cabal.project b/cabal.project new file mode 100644 index 0000000..e6e5cc5 --- /dev/null +++ b/cabal.project @@ -0,0 +1 @@ +packages: servant-checked-exceptions-core/* servant-checked-exceptions/* diff --git a/servant-checked-exceptions-core/CHANGELOG.md b/servant-checked-exceptions-core/CHANGELOG.md new file mode 100644 index 0000000..fd1490a --- /dev/null +++ b/servant-checked-exceptions-core/CHANGELOG.md @@ -0,0 +1,11 @@ +## 2.0.0.0 + +* Initial release of `servant-checked-exceptions-core` package, with + core types factored out of `servant-checked-exceptions` for users + who want access to them without incurring a dependency on `servant-server` + and `servant-client`. See + [issue 25](https://github.com/cdepillabout/servant-checked-exceptions/issues/25) + +* Compared to `servant-checked-exceptions`, `servant-checked-exceptions-core` + breaks up the `Exceptions` module into `Verbs` and `Envelope`. + [issue 18](https://github.com/cdepillabout/servant-checked-exceptions/issues/18) diff --git a/servant-checked-exceptions-core/LICENSE b/servant-checked-exceptions-core/LICENSE new file mode 100644 index 0000000..349af1a --- /dev/null +++ b/servant-checked-exceptions-core/LICENSE @@ -0,0 +1,30 @@ +Copyright Dennis Gosnell (c) 2017 + +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 Author name here nor the names of other + 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 +OWNER 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. diff --git a/servant-checked-exceptions-core/README.md b/servant-checked-exceptions-core/README.md new file mode 120000 index 0000000..32d46ee --- /dev/null +++ b/servant-checked-exceptions-core/README.md @@ -0,0 +1 @@ +../README.md \ No newline at end of file diff --git a/example/Api.hs b/servant-checked-exceptions-core/example/Api.hs similarity index 100% rename from example/Api.hs rename to servant-checked-exceptions-core/example/Api.hs diff --git a/example/Docs.hs b/servant-checked-exceptions-core/example/Docs.hs similarity index 100% rename from example/Docs.hs rename to servant-checked-exceptions-core/example/Docs.hs diff --git a/servant-checked-exceptions-core/servant-checked-exceptions-core.cabal b/servant-checked-exceptions-core/servant-checked-exceptions-core.cabal new file mode 100644 index 0000000..76e258e --- /dev/null +++ b/servant-checked-exceptions-core/servant-checked-exceptions-core.cabal @@ -0,0 +1,84 @@ +name: servant-checked-exceptions-core +version: 2.0.0.0 +synopsis: Checked exceptions for Servant APIs. +description: Please see . +homepage: https://github.com/cdepillabout/servant-checked-exceptions +license: BSD3 +license-file: LICENSE +author: Dennis Gosnell +maintainer: cdep.illabout@gmail.com +copyright: 2017-2018 Dennis Gosnell +category: Text +build-type: Simple +extra-source-files: CHANGELOG.md + , README.md +cabal-version: >=1.10 + +flag buildexample + description: Build a small example program + default: False + +library + hs-source-dirs: src + exposed-modules: Servant.Checked.Exceptions + , Servant.Checked.Exceptions.Envelope + , Servant.Checked.Exceptions.Verbs + , Servant.Checked.Exceptions.Internal + , Servant.Checked.Exceptions.Internal.Envelope + , Servant.Checked.Exceptions.Internal.Prism + , Servant.Checked.Exceptions.Internal.Servant + , Servant.Checked.Exceptions.Internal.Servant.API + , Servant.Checked.Exceptions.Internal.Servant.Docs + , Servant.Checked.Exceptions.Internal.Util + , Servant.Checked.Exceptions.Internal.Verbs + build-depends: base >= 4.9 && < 5 + , aeson + , bytestring + , deepseq + , http-media + , http-types + , profunctors + , tagged + , servant >= 0.12 + , servant-docs >= 0.10 + , text + , world-peace + default-language: Haskell2010 + ghc-options: -Wall -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -fwarn-monomorphism-restriction + other-extensions: QuasiQuotes + , TemplateHaskell + +executable servant-checked-exceptions-example-docs + main-is: Docs.hs + other-modules: Api + hs-source-dirs: example + build-depends: base + , aeson + , http-api-data + , http-types + , servant + , servant-checked-exceptions-core + , servant-docs + , text + default-language: Haskell2010 + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + + if flag(buildexample) + buildable: True + else + buildable: False + +test-suite servant-checked-exceptions-doctest + if impl(ghcjs) + buildable: False + type: exitcode-stdio-1.0 + main-is: DocTest.hs + hs-source-dirs: test + build-depends: base + , doctest + , Glob + default-language: Haskell2010 + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N +source-repository head + type: git + location: git@github.com:cdepillabout/servant-checked-exceptions.git diff --git a/src/Servant/Checked/Exceptions.hs b/servant-checked-exceptions-core/src/Servant/Checked/Exceptions.hs similarity index 95% rename from src/Servant/Checked/Exceptions.hs rename to servant-checked-exceptions-core/src/Servant/Checked/Exceptions.hs index 936d570..5dc5059 100644 --- a/src/Servant/Checked/Exceptions.hs +++ b/servant-checked-exceptions-core/src/Servant/Checked/Exceptions.hs @@ -165,9 +165,13 @@ module Servant.Checked.Exceptions -- combinators. It also exports the 'OpenProduct' type and 'ToProduct' type -- class used by some of the functions above. , module Data.WorldPeace + , module Servant.Checked.Exceptions.Internal.Servant.Docs ) where import Data.WorldPeace import Network.HTTP.Types (Status) -import Servant.Checked.Exceptions.Internal +import Servant.Checked.Exceptions.Internal.Envelope +import Servant.Checked.Exceptions.Internal.Servant.API +import Servant.Checked.Exceptions.Internal.Servant.Docs +import Servant.Checked.Exceptions.Internal.Verbs diff --git a/servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Envelope.hs b/servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Envelope.hs new file mode 100644 index 0000000..93e45fb --- /dev/null +++ b/servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Envelope.hs @@ -0,0 +1,31 @@ +module Servant.Checked.Exceptions.Envelope ( + -- * Envelope + Envelope(..) + -- * Helper functions + -- ** Envelope Constructors + , toSuccEnvelope + , toErrEnvelope + , pureSuccEnvelope + , pureErrEnvelope + -- ** Envelope Destructors + , envelope + , emptyEnvelope + , fromEnvelope + , fromEnvelopeOr + , fromEnvelopeM + , fromEnvelopeOrM + , errEnvelopeMatch + , catchesEnvelope + -- ** Optics + , _SuccEnvelope + , _ErrEnvelope + , _ErrEnvelopeErr + -- ** Either + , envelopeToEither + , eitherToEnvelope + , isoEnvelopeEither + -- * Setup code for doctests + -- $setup + ) where + +import Servant.Checked.Exceptions.Internal.Envelope diff --git a/servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Internal.hs b/servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Internal.hs new file mode 100644 index 0000000..ae59b11 --- /dev/null +++ b/servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Internal.hs @@ -0,0 +1,11 @@ +module Servant.Checked.Exceptions.Internal + ( module Servant.Checked.Exceptions.Internal.Envelope + , module Servant.Checked.Exceptions.Internal.Verbs + , module Servant.Checked.Exceptions.Internal.Servant + , module Servant.Checked.Exceptions.Internal.Util + ) where + +import Servant.Checked.Exceptions.Internal.Envelope +import Servant.Checked.Exceptions.Internal.Verbs +import Servant.Checked.Exceptions.Internal.Servant +import Servant.Checked.Exceptions.Internal.Util diff --git a/src/Servant/Checked/Exceptions/Internal/Envelope.hs b/servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Internal/Envelope.hs similarity index 96% rename from src/Servant/Checked/Exceptions/Internal/Envelope.hs rename to servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Internal/Envelope.hs index 23e2bad..aef6d46 100644 --- a/src/Servant/Checked/Exceptions/Internal/Envelope.hs +++ b/servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Internal/Envelope.hs @@ -30,36 +30,7 @@ Other than the 'Envelope' type, the most important thing in this module is the 'ToJSON' instance for 'Envelope'. -} -module Servant.Checked.Exceptions.Internal.Envelope - ( - -- * Envelope - Envelope(..) - -- * Helper functions - -- ** Envelope Constructors - , toSuccEnvelope - , toErrEnvelope - , pureSuccEnvelope - , pureErrEnvelope - -- ** Envelope Destructors - , envelope - , emptyEnvelope - , fromEnvelope - , fromEnvelopeOr - , fromEnvelopeM - , fromEnvelopeOrM - , errEnvelopeMatch - , catchesEnvelope - -- ** Optics - , _SuccEnvelope - , _ErrEnvelope - , _ErrEnvelopeErr - -- ** Either - , envelopeToEither - , eitherToEnvelope - , isoEnvelopeEither - -- * Setup code for doctests - -- $setup - ) where +module Servant.Checked.Exceptions.Internal.Envelope where import Control.Applicative ((<|>)) import Control.Monad.Fix (MonadFix(mfix)) diff --git a/src/Servant/Checked/Exceptions/Internal/Prism.hs b/servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Internal/Prism.hs similarity index 100% rename from src/Servant/Checked/Exceptions/Internal/Prism.hs rename to servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Internal/Prism.hs diff --git a/servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Internal/Servant.hs b/servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Internal/Servant.hs new file mode 100644 index 0000000..990896b --- /dev/null +++ b/servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Internal/Servant.hs @@ -0,0 +1,19 @@ +{- | +Module : Servant.Checked.Exceptions.Internal.Servant + +Copyright : Dennis Gosnell 2017 +License : BSD3 + +Maintainer : Dennis Gosnell (cdep.illabout@gmail.com) +Stability : experimental +Portability : unknown + +Export all of instances for the Client, Docs, and Server. +-} + +module Servant.Checked.Exceptions.Internal.Servant + ( module Servant.Checked.Exceptions.Internal.Servant.API + ) where + +import Servant.Checked.Exceptions.Internal.Servant.API +import Servant.Checked.Exceptions.Internal.Servant.Docs () diff --git a/src/Servant/Checked/Exceptions/Internal/Servant/API.hs b/servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Internal/Servant/API.hs similarity index 57% rename from src/Servant/Checked/Exceptions/Internal/Servant/API.hs rename to servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Internal/Servant/API.hs index 354c147..13026b9 100644 --- a/src/Servant/Checked/Exceptions/Internal/Servant/API.hs +++ b/servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Internal/Servant/API.hs @@ -20,11 +20,8 @@ This module defines the 'Throws' and 'Throwing' types. module Servant.Checked.Exceptions.Internal.Servant.API where -import Data.Typeable (Typeable) import GHC.Exts (Constraint) -import GHC.Generics (Generic) -import GHC.TypeLits (Nat) -import Network.HTTP.Types (Status, StdMethod(DELETE, GET, PATCH, POST, PUT)) +import Network.HTTP.Types (Status) import Servant.API ((:>)) import Servant.Checked.Exceptions.Internal.Util (Snoc) @@ -70,47 +67,6 @@ type family ThrowingNonterminal api where ThrowingNonterminal (Throwing es :> c :> api) = c :> Throwing es :> api -data VerbWithErr - (method :: k1) - (successStatusCode :: Nat) - (contentTypes :: [*]) - (es :: [*]) - a - deriving (Generic, Typeable) - -type GetWithErr = VerbWithErr 'GET 200 -type PostWithErr = VerbWithErr 'POST 200 -type PutWithErr = VerbWithErr 'PUT 200 -type DeleteWithErr = VerbWithErr 'DELETE 200 -type PatchWithErr = VerbWithErr 'PATCH 200 - -type PostCreatedWithErr = VerbWithErr 'POST 201 - -type GetAcceptedWithErr = VerbWithErr 'GET 202 -type PostAcceptedWithErr = VerbWithErr 'POST 202 -type DeleteAcceptedWithErr = VerbWithErr 'DELETE 202 -type PatchAcceptedWithErr = VerbWithErr 'PATCH 202 -type PutAcceptedWithErr = VerbWithErr 'PUT 202 - -type GetNonAuthoritativeWithErr = VerbWithErr 'GET 203 -type PostNonAuthoritativeWithErr = VerbWithErr 'POST 203 -type DeleteNonAuthoritativeWithErr = VerbWithErr 'DELETE 203 -type PatchNonAuthoritativeWithErr = VerbWithErr 'PATCH 203 -type PutNonAuthoritativeWithErr = VerbWithErr 'PUT 203 - -type GetNoContentWithErr = VerbWithErr 'GET 204 -type PostNoContentWithErr = VerbWithErr 'POST 204 -type DeleteNoContentWithErr = VerbWithErr 'DELETE 204 -type PatchNoContentWithErr = VerbWithErr 'PATCH 204 -type PutNoContentWithErr = VerbWithErr 'PUT 204 - -type GetResetContentWithErr = VerbWithErr 'GET 205 -type PostResetContentWithErr = VerbWithErr 'POST 205 -type DeleteResetContentWithErr = VerbWithErr 'DELETE 205 -type PatchResetContentWithErr = VerbWithErr 'PATCH 205 -type PutResetContentWithErr = VerbWithErr 'PUT 205 - -type GetPartialContentWithErr = VerbWithErr 'GET 206 class ErrStatus e where toErrStatus :: e -> Status diff --git a/src/Servant/Checked/Exceptions/Internal/Servant/Docs.hs b/servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Internal/Servant/Docs.hs similarity index 100% rename from src/Servant/Checked/Exceptions/Internal/Servant/Docs.hs rename to servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Internal/Servant/Docs.hs diff --git a/src/Servant/Checked/Exceptions/Internal/Util.hs b/servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Internal/Util.hs similarity index 100% rename from src/Servant/Checked/Exceptions/Internal/Util.hs rename to servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Internal/Util.hs diff --git a/servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Internal/Verbs.hs b/servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Internal/Verbs.hs new file mode 100644 index 0000000..29be52e --- /dev/null +++ b/servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Internal/Verbs.hs @@ -0,0 +1,69 @@ +{- | +Module : Servant.Checked.Exceptions.Internal.Verbs + +Copyright : Dennis Gosnell 2017 +License : BSD3 + +Maintainer : Dennis Gosnell (cdep.illabout@gmail.com) +Stability : experimental +Portability : unknown + +This module defines the 'Throws' and 'Throwing' types. +-} + +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module Servant.Checked.Exceptions.Internal.Verbs where + + +import Data.Typeable (Typeable) +import GHC.Generics (Generic) +import GHC.TypeLits (Nat) +import Network.HTTP.Types (StdMethod(DELETE, GET, PATCH, POST, PUT)) + +data VerbWithErr + (method :: k1) + (successStatusCode :: Nat) + (contentTypes :: [*]) + (es :: [*]) + a + deriving (Generic, Typeable) + +type GetWithErr = VerbWithErr 'GET 200 +type PostWithErr = VerbWithErr 'POST 200 +type PutWithErr = VerbWithErr 'PUT 200 +type DeleteWithErr = VerbWithErr 'DELETE 200 +type PatchWithErr = VerbWithErr 'PATCH 200 + +type PostCreatedWithErr = VerbWithErr 'POST 201 + +type GetAcceptedWithErr = VerbWithErr 'GET 202 +type PostAcceptedWithErr = VerbWithErr 'POST 202 +type DeleteAcceptedWithErr = VerbWithErr 'DELETE 202 +type PatchAcceptedWithErr = VerbWithErr 'PATCH 202 +type PutAcceptedWithErr = VerbWithErr 'PUT 202 + +type GetNonAuthoritativeWithErr = VerbWithErr 'GET 203 +type PostNonAuthoritativeWithErr = VerbWithErr 'POST 203 +type DeleteNonAuthoritativeWithErr = VerbWithErr 'DELETE 203 +type PatchNonAuthoritativeWithErr = VerbWithErr 'PATCH 203 +type PutNonAuthoritativeWithErr = VerbWithErr 'PUT 203 + +type GetNoContentWithErr = VerbWithErr 'GET 204 +type PostNoContentWithErr = VerbWithErr 'POST 204 +type DeleteNoContentWithErr = VerbWithErr 'DELETE 204 +type PatchNoContentWithErr = VerbWithErr 'PATCH 204 +type PutNoContentWithErr = VerbWithErr 'PUT 204 + +type GetResetContentWithErr = VerbWithErr 'GET 205 +type PostResetContentWithErr = VerbWithErr 'POST 205 +type DeleteResetContentWithErr = VerbWithErr 'DELETE 205 +type PatchResetContentWithErr = VerbWithErr 'PATCH 205 +type PutResetContentWithErr = VerbWithErr 'PUT 205 + +type GetPartialContentWithErr = VerbWithErr 'GET 206 diff --git a/servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Verbs.hs b/servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Verbs.hs new file mode 100644 index 0000000..e8b5b1b --- /dev/null +++ b/servant-checked-exceptions-core/src/Servant/Checked/Exceptions/Verbs.hs @@ -0,0 +1,43 @@ +module Servant.Checked.Exceptions.Verbs ( + -- *** Specialized Verbs + -- **** HTTP 200 + GetWithErr + , PostWithErr + , PutWithErr + , DeleteWithErr + , PatchWithErr + , VerbWithErr + -- **** HTTP 201 + , PostCreatedWithErr + -- **** HTTP 202 + , GetAcceptedWithErr + , PostAcceptedWithErr + , DeleteAcceptedWithErr + , PatchAcceptedWithErr + , PutAcceptedWithErr + -- **** HTTP 203 + , GetNonAuthoritativeWithErr + , PostNonAuthoritativeWithErr + , DeleteNonAuthoritativeWithErr + , PatchNonAuthoritativeWithErr + , PutNonAuthoritativeWithErr + -- **** HTTP 204 + , GetNoContentWithErr + , PostNoContentWithErr + , DeleteNoContentWithErr + , PatchNoContentWithErr + , PutNoContentWithErr + -- **** HTTP 205 + , GetResetContentWithErr + , PostResetContentWithErr + , DeleteResetContentWithErr + , PatchResetContentWithErr + , PutResetContentWithErr + -- **** HTTP 206 + , GetPartialContentWithErr + -- * 'Envelope' response wrapper + , module Data.WorldPeace + )where + +import Data.WorldPeace +import Servant.Checked.Exceptions.Internal.Verbs diff --git a/test/DocTest.hs b/servant-checked-exceptions-core/test/DocTest.hs similarity index 100% rename from test/DocTest.hs rename to servant-checked-exceptions-core/test/DocTest.hs diff --git a/servant-checked-exceptions/CHANGELOG.md b/servant-checked-exceptions/CHANGELOG.md new file mode 100644 index 0000000..aa4889b --- /dev/null +++ b/servant-checked-exceptions/CHANGELOG.md @@ -0,0 +1,33 @@ +## 2.0.0.0 + +* Split into two package `servant-checked-exceptions-core` and + `servant-checked-exceptions`. The former defines the core types + and functions for using checked exceptions in a servant API; + the latter reexports the former and adds instances for `HasServer` + and `HasClient`. The rationale is described further in + [issue 25](https://github.com/cdepillabout/servant-checked-exceptions/issues/25) + + Most users should only depend on `servant-checked-exceptions`. + But users who need access to core types without incurring a dependency + on `servant-server` and `servant-client` can depend on + `servant-checked-exceptions-core` instead. + +* Split `Exceptions` module into `Envelope` and `Verbs` in + `servant-checked-exceptions-core`, for better module organization. + More information in + [issue 18](https://github.com/cdepillabout/servant-checked-exceptions/issues/18) + +## 1.1.0.0 + +* Updated the servant dependency to >= 0.12. + +## 1.0.0.0 + +* Add a `ErrStatus` class that can be used to set the HTTP Status Code. Given + an endpoint that returns a `Envelope '[e1, e2] a`, you must declare an + instance of `ErrStatus` for `e1` and `e2`. This is a breaking change. + +## 0.4.1.0 + +* Add `NoThrow` type to represent handlers that don't throw any errors, but + do return a result wrapped in an `Envelope`. diff --git a/servant-checked-exceptions/LICENSE b/servant-checked-exceptions/LICENSE new file mode 100644 index 0000000..349af1a --- /dev/null +++ b/servant-checked-exceptions/LICENSE @@ -0,0 +1,30 @@ +Copyright Dennis Gosnell (c) 2017 + +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 Author name here nor the names of other + 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 +OWNER 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. diff --git a/servant-checked-exceptions/README.md b/servant-checked-exceptions/README.md new file mode 120000 index 0000000..32d46ee --- /dev/null +++ b/servant-checked-exceptions/README.md @@ -0,0 +1 @@ +../README.md \ No newline at end of file diff --git a/servant-checked-exceptions/example/Api.hs b/servant-checked-exceptions/example/Api.hs new file mode 100644 index 0000000..aedfeda --- /dev/null +++ b/servant-checked-exceptions/example/Api.hs @@ -0,0 +1,141 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} + +module Api where + +import Data.Aeson + (FromJSON(parseJSON), ToJSON(toJSON), Value, withText) +import Data.Aeson.Types (Parser) +import Data.String (IsString) +import Data.Text (unpack) +import Network.HTTP.Types (Status, status400, status404) +import Servant.API (Capture, JSON, Post, (:>), (:<|>)) +import Text.Read (readMaybe) +import Web.HttpApiData (FromHttpApiData, ToHttpApiData) + +import Servant.Checked.Exceptions (NoThrow, Throws) +import Servant.Checked.Exceptions.Internal.Servant.API (ErrStatus(toErrStatus)) + +--------- +-- API -- +--------- + +-- | This is our main 'Api' type. We will create a server, a client, and +-- documentation for this api. +-- +-- This api is composed of three routes, 'ApiStrictSearch', 'ApiLaxSearch', and +-- 'ApiNoErrSearch'. +type Api = ApiStrictSearch :<|> ApiLaxSearch :<|> ApiNoErrSearch + +-- | This is a strict search api. You pass it a @\"query\"@, and it returns a +-- 'SearchResponse'. It potentially returns a 'BadSearchTermErr' if your query +-- is not the string @\"hello\"@. It returns an 'IncorrectCapitialization' +-- error if your query is not capitalized like @\"Hello\"@. +-- +-- Notice how we are using 'Throws' to indicate we will potentially throw an +-- error. Also, notice how we can list multiple 'Throws'. +type ApiStrictSearch = + "strict-search" :> + Capture "query" SearchQuery :> + Throws BadSearchTermErr :> + Throws IncorrectCapitalization :> + Post '[JSON] SearchResponse + +-- | This is similar to 'ApiStrictSearch', but it doesn't force the query to be +-- capitalized correctly. It only returns a 'BadSearchTermErr'. +type ApiLaxSearch = + "lax-search" :> + Capture "query" SearchQuery :> + Throws BadSearchTermErr :> + Post '[JSON] SearchResponse + +-- | This is similar to 'ApiLaxSearch', but it doesn't force the query to use +-- correct terms. It does not return an error. +type ApiNoErrSearch = + "no-err-search" :> + Capture "query" SearchQuery :> + NoThrow :> + Post '[JSON] SearchResponse + +------------------------------ +-- Parameters and Responses -- +------------------------------ + +-- | This 'SearchQuery' type is just a newtype wrapper around a 'String'. +newtype SearchQuery = SearchQuery + { unSearchQuery :: String + } deriving ( Eq + , FromHttpApiData + , FromJSON + , IsString + , Ord + , Read + , Show + , ToHttpApiData + , ToJSON + ) + +-- | This 'SearchResponse' type is just a newtype wrapper around a 'String'. +newtype SearchResponse = SearchResponse + { unSearchResponse :: String + } deriving ( Eq + , FromHttpApiData + , FromJSON + , IsString + , Ord + , Read + , Show + , ToHttpApiData + , ToJSON + ) + +------------ +-- Errors -- +------------ + +-- | This error is returned when the search query is not the string @\"hello\"@. +data BadSearchTermErr = BadSearchTermErr deriving (Eq, Read, Show) + +instance ToJSON BadSearchTermErr where + toJSON :: BadSearchTermErr -> Value + toJSON = toJSON . show + +instance FromJSON BadSearchTermErr where + parseJSON :: Value -> Parser BadSearchTermErr + parseJSON = withText "BadSearchTermErr" $ + maybe (fail "could not parse as BadSearchTermErr") pure . readMaybe . unpack + +instance ErrStatus BadSearchTermErr where + toErrStatus :: BadSearchTermErr -> Status + toErrStatus _ = status404 + +-- | This error is returned when the search query is @\"hello\"@, but it is not +-- capitalized correctly. For example, the search query @\"hello\"@ will +-- return an 'IncorrectCapitialization' error. However, the search query +-- @\"Hello\"@ will return a success. +data IncorrectCapitalization = IncorrectCapitalization deriving (Eq, Read, Show) + +instance ToJSON IncorrectCapitalization where + toJSON :: IncorrectCapitalization -> Value + toJSON = toJSON . show + +instance FromJSON IncorrectCapitalization where + parseJSON :: Value -> Parser IncorrectCapitalization + parseJSON = withText "IncorrectCapitalization" $ + maybe (fail "could not parse as IncorrectCapitalization") pure . readMaybe . unpack + +instance ErrStatus IncorrectCapitalization where + toErrStatus :: IncorrectCapitalization -> Status + toErrStatus _ = status400 + +---------- +-- Port -- +---------- + +-- | The port to run the server on. +port :: Int +port = 8201 diff --git a/example/Client.hs b/servant-checked-exceptions/example/Client.hs similarity index 100% rename from example/Client.hs rename to servant-checked-exceptions/example/Client.hs diff --git a/servant-checked-exceptions/example/Docs.hs b/servant-checked-exceptions/example/Docs.hs new file mode 100644 index 0000000..68f5a63 --- /dev/null +++ b/servant-checked-exceptions/example/Docs.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE EmptyCase #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Main where + +import Data.Proxy (Proxy(Proxy)) +import Data.Text (Text) +import Servant.API (Capture) +import Servant.Docs + (DocCapture(DocCapture), ToCapture(toCapture), ToSample(toSamples), + docs, markdown) + +import Servant.Checked.Exceptions () + +import Api + (Api, BadSearchTermErr(BadSearchTermErr), + IncorrectCapitalization(IncorrectCapitalization), SearchQuery, + SearchResponse) + +-- This module prints out documentation for 'Api'. +-- +-- Notice how we only need 'ToSample' instances for the two errors we are +-- throwing with 'Throws': 'BadSearchTermErr' and 'IncorrectCapitialization'. +-- We don't have to directly worry about writing instances for 'Envelope'. + +instance ToSample SearchResponse where + toSamples :: Proxy SearchResponse -> [(Text, SearchResponse)] + toSamples Proxy = [("This is a successful response.", "good")] + +instance ToCapture (Capture "query" SearchQuery) where + toCapture :: Proxy (Capture "query" SearchQuery) -> DocCapture + toCapture Proxy = + DocCapture "query" "a search string like \"hello\" or \"bye\"" + +instance ToSample BadSearchTermErr where + toSamples :: Proxy BadSearchTermErr -> [(Text, BadSearchTermErr)] + toSamples Proxy = + [("a completely incorrect search term was used", BadSearchTermErr)] + +instance ToSample IncorrectCapitalization where + toSamples :: Proxy IncorrectCapitalization -> [(Text, IncorrectCapitalization)] + toSamples Proxy = + [ ( "the search term \"Hello\" has not been capitalized correctly" + , IncorrectCapitalization) + ] + +-- | Print the documentation rendered as markdown to stdout. +main :: IO () +main = putStrLn . markdown $ docs (Proxy :: Proxy Api) diff --git a/example/Server.hs b/servant-checked-exceptions/example/Server.hs similarity index 100% rename from example/Server.hs rename to servant-checked-exceptions/example/Server.hs diff --git a/servant-checked-exceptions.cabal b/servant-checked-exceptions/servant-checked-exceptions.cabal similarity index 87% rename from servant-checked-exceptions.cabal rename to servant-checked-exceptions/servant-checked-exceptions.cabal index 4bcc26f..1ea9d31 100644 --- a/servant-checked-exceptions.cabal +++ b/servant-checked-exceptions/servant-checked-exceptions.cabal @@ -1,5 +1,5 @@ name: servant-checked-exceptions -version: 1.1.0.0 +version: 2.0.0.0 synopsis: Checked exceptions for Servant APIs. description: Please see . homepage: https://github.com/cdepillabout/servant-checked-exceptions @@ -12,7 +12,6 @@ category: Text build-type: Simple extra-source-files: CHANGELOG.md , README.md - , stack.yaml cabal-version: >=1.10 flag buildexample @@ -23,14 +22,10 @@ library hs-source-dirs: src exposed-modules: Servant.Checked.Exceptions , Servant.Checked.Exceptions.Internal - , Servant.Checked.Exceptions.Internal.Envelope - , Servant.Checked.Exceptions.Internal.Prism , Servant.Checked.Exceptions.Internal.Servant , Servant.Checked.Exceptions.Internal.Servant.API , Servant.Checked.Exceptions.Internal.Servant.Client - , Servant.Checked.Exceptions.Internal.Servant.Docs , Servant.Checked.Exceptions.Internal.Servant.Server - , Servant.Checked.Exceptions.Internal.Util build-depends: base >= 4.9 && < 5 , aeson , bytestring @@ -40,6 +35,7 @@ library , profunctors , tagged , servant >= 0.12 + , servant-checked-exceptions-core , servant-client >= 0.12 , servant-client-core >= 0.12 , servant-docs >= 0.10 @@ -117,16 +113,6 @@ executable servant-checked-exceptions-example-server else buildable: False -test-suite servant-checked-exceptions-doctest - type: exitcode-stdio-1.0 - main-is: DocTest.hs - hs-source-dirs: test - build-depends: base - , doctest - , Glob - default-language: Haskell2010 - ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N - test-suite servant-checked-exceptions-test type: exitcode-stdio-1.0 main-is: Spec.hs diff --git a/servant-checked-exceptions/src/Servant/Checked/Exceptions.hs b/servant-checked-exceptions/src/Servant/Checked/Exceptions.hs new file mode 100644 index 0000000..3ecce31 --- /dev/null +++ b/servant-checked-exceptions/src/Servant/Checked/Exceptions.hs @@ -0,0 +1,99 @@ +{- | +Module : Servant.Checked.Exceptions + +Copyright : Dennis Gosnell 2017 +License : BSD3 + +Maintainer : Dennis Gosnell (cdep.illabout@gmail.com) +Stability : experimental +Portability : unknown + +This module gives you the ability to specify which errors are thrown by a +Servant api. This is done with the 'Throws' data type. Here is an example of +creating an api that uses 'Throws': + +@ + type Api = + \"author\" 'Servant.API.:>' + 'Servant.API.Capture' \"author-id\" AuthorId 'Servant.API.:>' + 'Throws' CouldNotConnectToDbError 'Servant.API.:>' + 'Throws' AuthorNotFoundError 'Servant.API.:>' + 'Servant.API.Get' \'['Servant.API.JSON'] Author +@ + +This api will return an @Author@ for a given @AuthorId@. 'Throws' is used +to indicate that this api will potentially return two different errors: +@CouldNotConnectToDbError@ and @AuthorNotFoundError@. + +These two errors might be defined like this: + +@ + data CouldNotConnectToDbError = CouldNotConnectToDbError + deriving ('Eq', 'Read', 'Show') + + data AuthorNotFoundError = AuthorNotFoundError + deriving ('Eq', 'Read', 'Show') +@ + +Writing the server handler for this api will look like the following. Notice +how the 'Envelope' type is used: + +@ + getAuthorHandler + :: AuthorId + -> 'Handler' ('Envelope' \'[DatabaseError, AuthorNotFoundError] Author) + getAuthorHandler authorId = do + eitherAuthor <- getAuthorFromDb authorId + case eitherAuthor of + Left NoDb -> pure $ 'toErrEnvelope' CouldNotConnectToDbError + Left NoAuthor -> pure $ 'toErrEnvelope' AuthorNotFoundError + Right author -> pure $ 'toSuccEnvelope' author + + getAuthorFromDb :: AuthorId -> Handler (Either DbErr Author) + getAuthorFromDb = ... + + data DbErr = NoDb | NoAuthor +@ + +@'Envelope' \'[DatabaseError, AuthorNotFoundError] Author@ represents a +response that will contain an @Author@ on success, or contain either a +@DatabaseError@ or a @AuthorNotFoundError@ on error. + +Under the hood, 'Envelope' is using an extensible sum-type ('OpenUnion') to +represent possible errors. Working with an api that returns two possible +errors is just as easy as working with an api that returns three possible +errors. + +Clients will also use the 'Envelope' type: + +@ + getAuthor + :: AuthorId + -> 'Servant.Client.ClientM' ('Envelope' \'[DatabaseError, AuthorNotFoundError] Author) + getAuthor = 'Servant.Client.client' ('Data.Proxy.Proxy' :: 'Data.Proxy.Proxy' Api) +@ + +It is easy to do case analysis (similar to pattern matching) on the 'Envelope' +type with the 'catchesEnvelope' function. + +Checkout the + +in the repository on Github. It includes a fleshed-out example of an +, +, +, +and +. +The +shows how to compile and run the examples. +-} + +{-# LANGUAGE PackageImports #-} + +module Servant.Checked.Exceptions ( + module Servant.Checked.Exceptions + , module Servant.Checked.Exceptions.Internal + ) where + +import "servant-checked-exceptions-core" Servant.Checked.Exceptions +import Servant.Checked.Exceptions.Internal diff --git a/src/Servant/Checked/Exceptions/Internal.hs b/servant-checked-exceptions/src/Servant/Checked/Exceptions/Internal.hs similarity index 72% rename from src/Servant/Checked/Exceptions/Internal.hs rename to servant-checked-exceptions/src/Servant/Checked/Exceptions/Internal.hs index 8390b9b..e4c003c 100644 --- a/src/Servant/Checked/Exceptions/Internal.hs +++ b/servant-checked-exceptions/src/Servant/Checked/Exceptions/Internal.hs @@ -12,11 +12,14 @@ Export all of the internal functions. -} module Servant.Checked.Exceptions.Internal - ( module Servant.Checked.Exceptions.Internal.Envelope + ( -- * Reexported modules from servant-checked-exceptions-core + module Servant.Checked.Exceptions.Internal.Envelope , module Servant.Checked.Exceptions.Internal.Servant , module Servant.Checked.Exceptions.Internal.Util + , module Servant.Checked.Exceptions.Internal.Verbs ) where import Servant.Checked.Exceptions.Internal.Envelope import Servant.Checked.Exceptions.Internal.Servant import Servant.Checked.Exceptions.Internal.Util +import Servant.Checked.Exceptions.Internal.Verbs diff --git a/src/Servant/Checked/Exceptions/Internal/Servant.hs b/servant-checked-exceptions/src/Servant/Checked/Exceptions/Internal/Servant.hs similarity index 100% rename from src/Servant/Checked/Exceptions/Internal/Servant.hs rename to servant-checked-exceptions/src/Servant/Checked/Exceptions/Internal/Servant.hs diff --git a/servant-checked-exceptions/src/Servant/Checked/Exceptions/Internal/Servant/API.hs b/servant-checked-exceptions/src/Servant/Checked/Exceptions/Internal/Servant/API.hs new file mode 100644 index 0000000..de98356 --- /dev/null +++ b/servant-checked-exceptions/src/Servant/Checked/Exceptions/Internal/Servant/API.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE PackageImports #-} + +module Servant.Checked.Exceptions.Internal.Servant.API ( + module Servant.Checked.Exceptions.Internal.Servant.API + ) where + +import "servant-checked-exceptions-core" Servant.Checked.Exceptions.Internal.Servant.API diff --git a/src/Servant/Checked/Exceptions/Internal/Servant/Client.hs b/servant-checked-exceptions/src/Servant/Checked/Exceptions/Internal/Servant/Client.hs similarity index 100% rename from src/Servant/Checked/Exceptions/Internal/Servant/Client.hs rename to servant-checked-exceptions/src/Servant/Checked/Exceptions/Internal/Servant/Client.hs diff --git a/src/Servant/Checked/Exceptions/Internal/Servant/Server.hs b/servant-checked-exceptions/src/Servant/Checked/Exceptions/Internal/Servant/Server.hs similarity index 99% rename from src/Servant/Checked/Exceptions/Internal/Servant/Server.hs rename to servant-checked-exceptions/src/Servant/Checked/Exceptions/Internal/Servant/Server.hs index ea059f0..f66f891 100644 --- a/src/Servant/Checked/Exceptions/Internal/Servant/Server.hs +++ b/servant-checked-exceptions/src/Servant/Checked/Exceptions/Internal/Servant/Server.hs @@ -76,8 +76,8 @@ import Servant.Checked.Exceptions.Internal.Servant.API , Throwing , ThrowingNonterminal , Throws - , VerbWithErr ) +import Servant.Checked.Exceptions.Verbs (VerbWithErr) -- TODO: Make sure to also account for when headers are being used. -- This might be hard to do: diff --git a/test/Spec.hs b/servant-checked-exceptions/test/Spec.hs similarity index 100% rename from test/Spec.hs rename to servant-checked-exceptions/test/Spec.hs diff --git a/stack.yaml b/stack.yaml index a2ac470..c0f9005 100644 --- a/stack.yaml +++ b/stack.yaml @@ -5,7 +5,8 @@ resolver: lts-11.4 # Local packages, usually specified by relative directory name packages: -- '.' +- 'servant-checked-exceptions' +- 'servant-checked-exceptions-core' # Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3) extra-deps: