Revert "Move WithStatus to cookbook [WIP]"

This reverts commit 5e43135e37.
This commit is contained in:
Matthias Fischmann 2020-12-06 14:56:41 +01:00
parent 5e43135e37
commit 49801db151
No known key found for this signature in database
GPG key ID: 0DE4AA9C5446EBF4
2 changed files with 33 additions and 2 deletions

View file

@ -127,7 +127,7 @@ import Servant.API.Sub
((:>))
import Servant.API.UVerb
(HasStatus, IsMember, StatusOf, Statuses, UVerb, Union,
Unique, inject, statusOf)
Unique, WithStatus (..), inject, statusOf)
import Servant.API.Vault
(Vault)
import Servant.API.Verbs

View file

@ -28,6 +28,7 @@ module Servant.API.UVerb
HasStatus (StatusOf),
statusOf,
HasStatuses (Statuses, statuses),
WithStatus (..),
module Servant.API.UVerb.Union,
)
where
@ -35,7 +36,7 @@ where
import Data.Proxy (Proxy (Proxy))
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
@ -63,6 +64,36 @@ 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)
instance MimeRender ctype a => MimeRender ctype (WithStatus _status a) where
mimeRender contentTypeProxy (WithStatus a) = mimeRender contentTypeProxy a
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