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 import Servant.API.UVerb
(HasStatus, IsMember, StatusOf, Statuses, UVerb, Union, (HasStatus, IsMember, StatusOf, Statuses, UVerb, Union,
Unique, inject, statusOf) Unique, WithStatus (..), inject, statusOf)
import Servant.API.Vault import Servant.API.Vault
(Vault) (Vault)
import Servant.API.Verbs import Servant.API.Verbs

View file

@ -28,6 +28,7 @@ module Servant.API.UVerb
HasStatus (StatusOf), HasStatus (StatusOf),
statusOf, statusOf,
HasStatuses (Statuses, statuses), HasStatuses (Statuses, statuses),
WithStatus (..),
module Servant.API.UVerb.Union, module Servant.API.UVerb.Union,
) )
where where
@ -35,7 +36,7 @@ where
import Data.Proxy (Proxy (Proxy)) import Data.Proxy (Proxy (Proxy))
import GHC.TypeLits (Nat) import GHC.TypeLits (Nat)
import Network.HTTP.Types (Status, StdMethod) 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.Status (KnownStatus, statusVal)
import Servant.API.UVerb.Union 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 type Statuses (a ': as) = StatusOf a ': Statuses as
statuses _ = statusOf (Proxy :: Proxy a) : statuses (Proxy :: Proxy 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. -- | 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 -- FUTUREWORK: it would be nice to make 'Verb' a special case of 'UVerb', and only write