git.iko.soy/servant
on master help sign in
Revert "Move WithStatus to cookbook [WIP]"
49801dbMatthias Fischmann
servant/src/Servant/API.hs+1−1
compare with master
unifiedsplit
@@ -127,7 +127,7 @@ import Servant.API.Sub
127 ((:>))
127 ((:>))
128import Servant.API.UVerb
128import Servant.API.UVerb
129 (HasStatus, IsMember, StatusOf, Statuses, UVerb, Union,
129 (HasStatus, IsMember, StatusOf, Statuses, UVerb, Union,
130− Unique, inject, statusOf)
130+ Unique, WithStatus (..), inject, statusOf)
131import Servant.API.Vault
131import Servant.API.Vault
132 (Vault)
132 (Vault)
133import Servant.API.Verbs
133import Servant.API.Verbs
servant/src/Servant/API/UVerb.hs+32−1
@@ -28,6 +28,7 @@ module Servant.API.UVerb
28 HasStatus (StatusOf),
28 HasStatus (StatusOf),
29 statusOf,
29 statusOf,
30 HasStatuses (Statuses, statuses),
30 HasStatuses (Statuses, statuses),
31+ WithStatus (..),
31 module Servant.API.UVerb.Union,
32 module Servant.API.UVerb.Union,
32 )
33 )
33where
34where
@@ -35,7 +36,7 @@ where
35import Data.Proxy (Proxy (Proxy))
36import Data.Proxy (Proxy (Proxy))
36import GHC.TypeLits (Nat)
37import GHC.TypeLits (Nat)
37import Network.HTTP.Types (Status, StdMethod)
38import Network.HTTP.Types (Status, StdMethod)
38−import Servant.API.ContentTypes (MimeRender (mimeRender), MimeUnrender (mimeUnrender), NoContent)
39+import Servant.API.ContentTypes (NoContent, MimeRender(mimeRender), MimeUnrender(mimeUnrender))
39import Servant.API.Status (KnownStatus, statusVal)
40import Servant.API.Status (KnownStatus, statusVal)
40import Servant.API.UVerb.Union
41import Servant.API.UVerb.Union
41
42
@@ -63,6 +64,36 @@ instance (HasStatus a, HasStatuses as) => HasStatuses (a ': as) where
63 type Statuses (a ': as) = StatusOf a ': Statuses as
64 type Statuses (a ': as) = StatusOf a ': Statuses as
64 statuses _ = statusOf (Proxy :: Proxy a) : statuses (Proxy :: Proxy as)
65 statuses _ = statusOf (Proxy :: Proxy a) : statuses (Proxy :: Proxy as)
65
66
67+-- | A simple newtype wrapper that pairs a type with its status code. It
68+-- implements all the content types that Servant ships with by default.
69+newtype WithStatus (k :: Nat) a = WithStatus a
70+ deriving (Eq, Show)
71+
72+instance MimeRender ctype a => MimeRender ctype (WithStatus _status a) where
73+ mimeRender contentTypeProxy (WithStatus a) = mimeRender contentTypeProxy a
74+
75+instance MimeUnrender ctype a => MimeUnrender ctype (WithStatus _status a) where
76+ mimeUnrender contentTypeProxy input =
77+ WithStatus <$> mimeUnrender contentTypeProxy input
78+
79+-- | an instance of this typeclass assigns a HTTP status code to a return type
80+--
81+-- Example:
82+--
83+-- @
84+-- data NotFoundError = NotFoundError String
85+--
86+-- instance HasStatus NotFoundError where
87+-- type StatusOf NotFoundError = 404
88+-- @
89+--
90+-- You can also use the convience newtype wrapper 'WithStatus' if you want to
91+-- avoid writing a 'HasStatus' instance manually. It also has the benefit of
92+-- showing the status code in the type; which might aid in readability.
93+instance KnownStatus n => HasStatus (WithStatus n a) where
94+ type StatusOf (WithStatus n a) = n
95+
96+
66-- | A variant of 'Verb' that can have any of a number of response values and status codes.
97-- | A variant of 'Verb' that can have any of a number of response values and status codes.
67--
98--
68-- FUTUREWORK: it would be nice to make 'Verb' a special case of 'UVerb', and only write
99-- FUTUREWORK: it would be nice to make 'Verb' a special case of 'UVerb', and only write