Move WithStatus to cookbook [WIP]
This commit is contained in:
parent
08579ca003
commit
5e43135e37
2 changed files with 2 additions and 33 deletions
|
@ -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, WithStatus (..), inject, statusOf)
|
Unique, inject, statusOf)
|
||||||
import Servant.API.Vault
|
import Servant.API.Vault
|
||||||
(Vault)
|
(Vault)
|
||||||
import Servant.API.Verbs
|
import Servant.API.Verbs
|
||||||
|
|
|
@ -28,7 +28,6 @@ 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
|
||||||
|
@ -36,7 +35,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 (NoContent, MimeRender(mimeRender), MimeUnrender(mimeUnrender))
|
import Servant.API.ContentTypes (MimeRender (mimeRender), MimeUnrender (mimeUnrender), NoContent)
|
||||||
import Servant.API.Status (KnownStatus, statusVal)
|
import Servant.API.Status (KnownStatus, statusVal)
|
||||||
import Servant.API.UVerb.Union
|
import Servant.API.UVerb.Union
|
||||||
|
|
||||||
|
@ -64,36 +63,6 @@ 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
|
||||||
|
|
Loading…
Add table
Reference in a new issue