diff --git a/.travis.yml b/.travis.yml index 9e609a77..79214952 100644 --- a/.travis.yml +++ b/.travis.yml @@ -148,6 +148,7 @@ install: if ! $GHCJS && { [ $HCNUMVER -ge 80400 ] && [ $HCNUMVER -lt 80804 ] || [ $HCNUMVER -ge 81000 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo "packages: doc/cookbook/generic" >> cabal.project ; fi if ! $GHCJS && { [ $HCNUMVER -ge 80400 ] && [ $HCNUMVER -lt 80804 ] || [ $HCNUMVER -ge 81000 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo "packages: doc/cookbook/pagination" >> cabal.project ; fi if ! $GHCJS && { [ $HCNUMVER -ge 80400 ] && [ $HCNUMVER -lt 80804 ] || [ $HCNUMVER -ge 81000 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo "packages: doc/cookbook/testing" >> cabal.project ; fi + if ! $GHCJS && { [ $HCNUMVER -ge 80600 ] && [ $HCNUMVER -lt 80800 ] || [ $HCNUMVER -ge 80804 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo "packages: doc/cookbook/uverb" >> cabal.project ; fi if ! $GHCJS && { [ $HCNUMVER -ge 80400 ] && [ $HCNUMVER -lt 80804 ] || [ $HCNUMVER -ge 81000 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo "packages: doc/cookbook/structuring-apis" >> cabal.project ; fi if ! $GHCJS && { [ $HCNUMVER -ge 80400 ] && [ $HCNUMVER -lt 80804 ] || [ $HCNUMVER -ge 81000 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo "packages: doc/cookbook/using-custom-monad" >> cabal.project ; fi if ! $GHCJS && { [ $HCNUMVER -ge 80400 ] && [ $HCNUMVER -lt 80804 ] || [ $HCNUMVER -ge 81000 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo "packages: doc/cookbook/using-free-client" >> cabal.project ; fi @@ -191,6 +192,8 @@ install: - "if ! $GHCJS && { [ $HCNUMVER -ge 80400 ] && [ $HCNUMVER -lt 80804 ] || [ $HCNUMVER -ge 81000 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - if ! $GHCJS && { [ $HCNUMVER -ge 80400 ] && [ $HCNUMVER -lt 80804 ] || [ $HCNUMVER -ge 81000 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo 'package cookbook-testing' >> cabal.project ; fi - "if ! $GHCJS && { [ $HCNUMVER -ge 80400 ] && [ $HCNUMVER -lt 80804 ] || [ $HCNUMVER -ge 81000 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && { [ $HCNUMVER -ge 80600 ] && [ $HCNUMVER -lt 80800 ] || [ $HCNUMVER -ge 80804 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo 'package cookbook-uverb' >> cabal.project ; fi + - "if ! $GHCJS && { [ $HCNUMVER -ge 80600 ] && [ $HCNUMVER -lt 80800 ] || [ $HCNUMVER -ge 80804 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - if ! $GHCJS && { [ $HCNUMVER -ge 80400 ] && [ $HCNUMVER -lt 80804 ] || [ $HCNUMVER -ge 81000 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo 'package cookbook-structuring-apis' >> cabal.project ; fi - "if ! $GHCJS && { [ $HCNUMVER -ge 80400 ] && [ $HCNUMVER -lt 80804 ] || [ $HCNUMVER -ge 81000 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - if ! $GHCJS && { [ $HCNUMVER -ge 80400 ] && [ $HCNUMVER -lt 80804 ] || [ $HCNUMVER -ge 81000 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo 'package cookbook-using-custom-monad' >> cabal.project ; fi @@ -210,7 +213,7 @@ install: echo "allow-newer: servant-multipart:servant-client-core" >> cabal.project echo "allow-newer: servant-js:servant" >> cabal.project echo "optimization: False" >> cabal.project - - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(cookbook-basic-auth|cookbook-basic-streaming|cookbook-curl-mock|cookbook-custom-errors|cookbook-db-postgres-pool|cookbook-file-upload|cookbook-generic|cookbook-pagination|cookbook-structuring-apis|cookbook-testing|cookbook-using-custom-monad|cookbook-using-free-client|servant|servant-client|servant-client-core|servant-conduit|servant-docs|servant-foreign|servant-http-streams|servant-machines|servant-pipes|servant-server|tutorial)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(cookbook-basic-auth|cookbook-basic-streaming|cookbook-curl-mock|cookbook-custom-errors|cookbook-db-postgres-pool|cookbook-file-upload|cookbook-generic|cookbook-pagination|cookbook-structuring-apis|cookbook-testing|cookbook-using-custom-monad|cookbook-using-free-client|cookbook-uverb|servant|servant-client|servant-client-core|servant-conduit|servant-docs|servant-foreign|servant-http-streams|servant-machines|servant-pipes|servant-server|tutorial)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true - if [ -f "servant/configure.ac" ]; then (cd "servant" && autoreconf -i); fi @@ -233,6 +236,7 @@ install: - if [ -f "doc/cookbook/generic/configure.ac" ]; then (cd "doc/cookbook/generic" && autoreconf -i); fi - if [ -f "doc/cookbook/pagination/configure.ac" ]; then (cd "doc/cookbook/pagination" && autoreconf -i); fi - if [ -f "doc/cookbook/testing/configure.ac" ]; then (cd "doc/cookbook/testing" && autoreconf -i); fi + - if [ -f "doc/cookbook/uverb/configure.ac" ]; then (cd "doc/cookbook/uverb" && autoreconf -i); fi - if [ -f "doc/cookbook/structuring-apis/configure.ac" ]; then (cd "doc/cookbook/structuring-apis" && autoreconf -i); fi - if [ -f "doc/cookbook/using-custom-monad/configure.ac" ]; then (cd "doc/cookbook/using-custom-monad" && autoreconf -i); fi - if [ -f "doc/cookbook/using-free-client/configure.ac" ]; then (cd "doc/cookbook/using-free-client" && autoreconf -i); fi @@ -271,6 +275,7 @@ script: - PKGDIR_cookbook_generic="$(find . -maxdepth 1 -type d -regex '.*/cookbook-generic-[0-9.]*')" - PKGDIR_cookbook_pagination="$(find . -maxdepth 1 -type d -regex '.*/cookbook-pagination-[0-9.]*')" - PKGDIR_cookbook_testing="$(find . -maxdepth 1 -type d -regex '.*/cookbook-testing-[0-9.]*')" + - PKGDIR_cookbook_uverb="$(find . -maxdepth 1 -type d -regex '.*/cookbook-uverb-[0-9.]*')" - PKGDIR_cookbook_structuring_apis="$(find . -maxdepth 1 -type d -regex '.*/cookbook-structuring-apis-[0-9.]*')" - PKGDIR_cookbook_using_custom_monad="$(find . -maxdepth 1 -type d -regex '.*/cookbook-using-custom-monad-[0-9.]*')" - PKGDIR_cookbook_using_free_client="$(find . -maxdepth 1 -type d -regex '.*/cookbook-using-free-client-[0-9.]*')" @@ -298,6 +303,7 @@ script: if ! $GHCJS && { [ $HCNUMVER -ge 80400 ] && [ $HCNUMVER -lt 80804 ] || [ $HCNUMVER -ge 81000 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo "packages: ${PKGDIR_cookbook_generic}" >> cabal.project ; fi if ! $GHCJS && { [ $HCNUMVER -ge 80400 ] && [ $HCNUMVER -lt 80804 ] || [ $HCNUMVER -ge 81000 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo "packages: ${PKGDIR_cookbook_pagination}" >> cabal.project ; fi if ! $GHCJS && { [ $HCNUMVER -ge 80400 ] && [ $HCNUMVER -lt 80804 ] || [ $HCNUMVER -ge 81000 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo "packages: ${PKGDIR_cookbook_testing}" >> cabal.project ; fi + if ! $GHCJS && { [ $HCNUMVER -ge 80600 ] && [ $HCNUMVER -lt 80800 ] || [ $HCNUMVER -ge 80804 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo "packages: ${PKGDIR_cookbook_uverb}" >> cabal.project ; fi if ! $GHCJS && { [ $HCNUMVER -ge 80400 ] && [ $HCNUMVER -lt 80804 ] || [ $HCNUMVER -ge 81000 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo "packages: ${PKGDIR_cookbook_structuring_apis}" >> cabal.project ; fi if ! $GHCJS && { [ $HCNUMVER -ge 80400 ] && [ $HCNUMVER -lt 80804 ] || [ $HCNUMVER -ge 81000 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo "packages: ${PKGDIR_cookbook_using_custom_monad}" >> cabal.project ; fi if ! $GHCJS && { [ $HCNUMVER -ge 80400 ] && [ $HCNUMVER -lt 80804 ] || [ $HCNUMVER -ge 81000 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo "packages: ${PKGDIR_cookbook_using_free_client}" >> cabal.project ; fi @@ -341,6 +347,8 @@ script: - "if ! $GHCJS && { [ $HCNUMVER -ge 80400 ] && [ $HCNUMVER -lt 80804 ] || [ $HCNUMVER -ge 81000 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - if ! $GHCJS && { [ $HCNUMVER -ge 80400 ] && [ $HCNUMVER -lt 80804 ] || [ $HCNUMVER -ge 81000 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo 'package cookbook-testing' >> cabal.project ; fi - "if ! $GHCJS && { [ $HCNUMVER -ge 80400 ] && [ $HCNUMVER -lt 80804 ] || [ $HCNUMVER -ge 81000 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && { [ $HCNUMVER -ge 80600 ] && [ $HCNUMVER -lt 80800 ] || [ $HCNUMVER -ge 80804 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo 'package cookbook-uverb' >> cabal.project ; fi + - "if ! $GHCJS && { [ $HCNUMVER -ge 80600 ] && [ $HCNUMVER -lt 80800 ] || [ $HCNUMVER -ge 80804 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - if ! $GHCJS && { [ $HCNUMVER -ge 80400 ] && [ $HCNUMVER -lt 80804 ] || [ $HCNUMVER -ge 81000 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo 'package cookbook-structuring-apis' >> cabal.project ; fi - "if ! $GHCJS && { [ $HCNUMVER -ge 80400 ] && [ $HCNUMVER -lt 80804 ] || [ $HCNUMVER -ge 81000 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - if ! $GHCJS && { [ $HCNUMVER -ge 80400 ] && [ $HCNUMVER -lt 80804 ] || [ $HCNUMVER -ge 81000 ] && [ $HCNUMVER -lt 81002 ]; } ; then echo 'package cookbook-using-custom-monad' >> cabal.project ; fi @@ -360,7 +368,7 @@ script: echo "allow-newer: servant-multipart:servant-client-core" >> cabal.project echo "allow-newer: servant-js:servant" >> cabal.project echo "optimization: False" >> cabal.project - - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(cookbook-basic-auth|cookbook-basic-streaming|cookbook-curl-mock|cookbook-custom-errors|cookbook-db-postgres-pool|cookbook-file-upload|cookbook-generic|cookbook-pagination|cookbook-structuring-apis|cookbook-testing|cookbook-using-custom-monad|cookbook-using-free-client|servant|servant-client|servant-client-core|servant-conduit|servant-docs|servant-foreign|servant-http-streams|servant-machines|servant-pipes|servant-server|tutorial)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(cookbook-basic-auth|cookbook-basic-streaming|cookbook-curl-mock|cookbook-custom-errors|cookbook-db-postgres-pool|cookbook-file-upload|cookbook-generic|cookbook-pagination|cookbook-structuring-apis|cookbook-testing|cookbook-using-custom-monad|cookbook-using-free-client|cookbook-uverb|servant|servant-client|servant-client-core|servant-conduit|servant-docs|servant-foreign|servant-http-streams|servant-machines|servant-pipes|servant-server|tutorial)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true - | @@ -386,6 +394,7 @@ script: cookbook-generic) echo ${PKGDIR_cookbook_generic} ;; cookbook-pagination) echo ${PKGDIR_cookbook_pagination} ;; cookbook-testing) echo ${PKGDIR_cookbook_testing} ;; + cookbook-uverb) echo ${PKGDIR_cookbook_uverb} ;; cookbook-structuring-apis) echo ${PKGDIR_cookbook_structuring_apis} ;; cookbook-using-custom-monad) echo ${PKGDIR_cookbook_using_custom_monad} ;; cookbook-using-free-client) echo ${PKGDIR_cookbook_using_free_client} ;; diff --git a/doc/cookbook/uverb/uverb.cabal b/doc/cookbook/uverb/uverb.cabal index 0388365d..8b6b0b45 100644 --- a/doc/cookbook/uverb/uverb.cabal +++ b/doc/cookbook/uverb/uverb.cabal @@ -10,7 +10,7 @@ maintainer: haskell-servant-maintainers@googlegroups.com category: Servant build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.2 +tested-with: GHC==8.6.5, GHC==8.8.4, GHC==8.10.1 executable cookbook-uverb main-is: UVerb.lhs diff --git a/servant/src/Servant/API/UVerb.hs b/servant/src/Servant/API/UVerb.hs index 4074adef..f7b1f740 100644 --- a/servant/src/Servant/API/UVerb.hs +++ b/servant/src/Servant/API/UVerb.hs @@ -4,14 +4,13 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | An alternative to 'Verb' for end-points that respond with a resource value of any of an -- open union of types, and specific status codes for each type in this union. (`UVerb` is @@ -34,12 +33,10 @@ module Servant.API.UVerb ) where -import Data.Aeson (FromJSON, ToJSON) import Data.Proxy (Proxy (Proxy)) -import qualified GHC.Generics as GHC import GHC.TypeLits (Nat) import Network.HTTP.Types (Status, StdMethod) -import Servant.API.ContentTypes (MimeRender (mimeRender), MimeUnrender (mimeUnrender), NoContent) +import Servant.API.ContentTypes (NoContent, MimeRender(mimeRender), MimeUnrender(mimeUnrender)) import Servant.API.Status (KnownStatus, statusVal) import Servant.API.UVerb.Union @@ -49,9 +46,6 @@ class KnownStatus (StatusOf a) => HasStatus (a :: *) where statusOf :: forall a proxy. HasStatus a => proxy a -> Status statusOf = const (statusVal (Proxy :: Proxy (StatusOf a))) -instance KnownStatus n => HasStatus (WithStatus n a) where - type StatusOf (WithStatus n a) = n - -- | If an API can respond with 'NoContent' we assume that this will happen -- with the status code 204 No Content. If this needs to be overridden, -- 'WithStatus' can be used. @@ -70,12 +64,10 @@ instance (HasStatus a, HasStatuses as) => HasStatuses (a ': as) where type Statuses (a ': as) = StatusOf a ': Statuses as statuses _ = statusOf (Proxy :: Proxy a) : statuses (Proxy :: Proxy as) +-- | A simple newtype wrapper that pairs a type with its status code. It +-- implements all the content types that Servant ships with by default. newtype WithStatus (k :: Nat) a = WithStatus a - deriving (Eq, Show, GHC.Generic) - -instance (GHC.Generic (WithStatus n a), ToJSON a) => ToJSON (WithStatus n a) - -instance (GHC.Generic (WithStatus n a), FromJSON a) => FromJSON (WithStatus n a) + deriving (Eq, Show) instance MimeRender ctype a => MimeRender ctype (WithStatus _status a) where mimeRender contentTypeProxy (WithStatus a) = mimeRender contentTypeProxy a @@ -84,6 +76,24 @@ instance MimeUnrender ctype a => MimeUnrender ctype (WithStatus _status a) where mimeUnrender contentTypeProxy input = WithStatus <$> mimeUnrender contentTypeProxy input +-- | an instance of this typeclass assigns a HTTP status code to a return type +-- +-- Example: +-- +-- @ +-- data NotFoundError = NotFoundError String +-- +-- instance HasStatus NotFoundError where +-- type StatusOf NotFoundError = 404 +-- @ +-- +-- You can also use the convience newtype wrapper 'WithStatus' if you want to +-- avoid writing a 'HasStatus' instance manually. It also has the benefit of +-- showing the status code in the type; which might aid in readability. +instance KnownStatus n => HasStatus (WithStatus n a) where + type StatusOf (WithStatus n a) = n + + -- | A variant of 'Verb' that can have any of a number of response values and status codes. -- -- FUTUREWORK: it would be nice to make 'Verb' a special case of 'UVerb', and only write