Fix overlapping instance for WithStatus (#1361)

We do not need the `ToJSON` instance for `WithStatus`
it would cause an overlap between:

```
ToJSON a => MimeRender JSON a
```

and

```
forall cty a.  MimeRendercty  a =>  MimeRender cty (WithStatus a)
```
and Servant just needs the `MimeRender` typeclass for it to work

* Add some more docs to the UVerb module

* cookbook/uverb: Change GHC versions

CI was complaining some version did not exist. Trying to bump
Also added 8.10.1

* doc/cookbook/uverb: Remove 8.4.4 from tested versions

CI was running into a cabal bug for some reason
This commit is contained in:
Arian van Putten 2020-11-18 17:33:03 +01:00 committed by GitHub
parent 8e2a654e0e
commit 339eec6a90
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
3 changed files with 35 additions and 16 deletions

View file

@ -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} ;;

View file

@ -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

View file

@ -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