eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

better MimeRender/Unrender instances

Browse source
This commit is contained in:
Alp Mestanogullari 2021-12-06 17:31:15 +01:00
parent 3ed24fdd90
commit c2af6e775d
1 changed files with 10 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
servant/src/Servant/API/UVerb.hs
View file

@ -33,12 +33,14 @@ module Servant.API.UVerb
)
where
import Data.Aeson
import Data.Proxy (Proxy (Proxy))
import GHC.TypeLits (Nat)
import Network.HTTP.Types (Status, StdMethod)
import Servant.API.ContentTypes (JSON, PlainText, FormUrlEncoded, OctetStream, NoContent, MimeRender(mimeRender), MimeUnrender(mimeUnrender))
import Servant.API.Status (KnownStatus, statusVal)
import Servant.API.UVerb.Union
import Web.FormUrlEncoded
class KnownStatus (StatusOf a) => HasStatus (a :: *) where
type StatusOf (a :: *) :: Nat
@ -99,26 +101,26 @@ instance KnownStatus n => HasStatus (WithStatus n a) where
-- use 'respond' instead of 'pure' or 'return', so all old handlers would have to be rewritten.
data UVerb (method :: StdMethod) (contentTypes :: [*]) (as :: [*])
instance {-# OVERLAPPING #-} MimeRender JSON a => MimeRender JSON (WithStatus _status a) where
mimeRender contentTypeProxy (WithStatus a) = mimeRender contentTypeProxy a
instance ToJSON a => ToJSON (WithStatus _status a) where
toJSON (WithStatus a) = toJSON a
instance {-# OVERLAPPING #-} MimeRender PlainText a => MimeRender PlainText (WithStatus _status a) where
mimeRender contentTypeProxy (WithStatus a) = mimeRender contentTypeProxy a
instance {-# OVERLAPPING #-} MimeRender FormUrlEncoded a => MimeRender FormUrlEncoded (WithStatus _status a) where
mimeRender contentTypeProxy (WithStatus a) = mimeRender contentTypeProxy a
instance ToForm a => ToForm (WithStatus _status a) where
toForm (WithStatus a) = toForm a
instance {-# OVERLAPPING #-} MimeRender OctetStream a => MimeRender OctetStream (WithStatus _status a) where
mimeRender contentTypeProxy (WithStatus a) = mimeRender contentTypeProxy a
instance {-# OVERLAPPING #-} MimeUnrender JSON a => MimeUnrender JSON (WithStatus _status a) where
mimeUnrender contentTypeProxy input = WithStatus <$> mimeUnrender contentTypeProxy input
instance FromJSON a => FromJSON (WithStatus _status a) where
parseJSON v = WithStatus <$> parseJSON v
instance {-# OVERLAPPING #-} MimeUnrender PlainText a => MimeUnrender PlainText (WithStatus _status a) where
mimeUnrender contentTypeProxy input = WithStatus <$> mimeUnrender contentTypeProxy input
instance {-# OVERLAPPING #-} MimeUnrender FormUrlEncoded a => MimeUnrender FormUrlEncoded (WithStatus _status a) where
mimeUnrender contentTypeProxy input = WithStatus <$> mimeUnrender contentTypeProxy input
instance FromForm a => FromForm (WithStatus _status a) where
fromForm v = WithStatus <$> fromForm v
instance {-# OVERLAPPING #-} MimeUnrender OctetStream a => MimeUnrender OctetStream (WithStatus _status a) where
mimeUnrender contentTypeProxy input = WithStatus <$> mimeUnrender contentTypeProxy input