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 where
import Data.Aeson
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 (JSON, PlainText, FormUrlEncoded, OctetStream, NoContent, MimeRender(mimeRender), MimeUnrender(mimeUnrender)) import Servant.API.ContentTypes (JSON, PlainText, FormUrlEncoded, OctetStream, 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
import Web.FormUrlEncoded
class KnownStatus (StatusOf a) => HasStatus (a :: *) where class KnownStatus (StatusOf a) => HasStatus (a :: *) where
type StatusOf (a :: *) :: Nat 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. -- use 'respond' instead of 'pure' or 'return', so all old handlers would have to be rewritten.
data UVerb (method :: StdMethod) (contentTypes :: [*]) (as :: [*]) data UVerb (method :: StdMethod) (contentTypes :: [*]) (as :: [*])
instance {-# OVERLAPPING #-} MimeRender JSON a => MimeRender JSON (WithStatus _status a) where instance ToJSON a => ToJSON (WithStatus _status a) where
mimeRender contentTypeProxy (WithStatus a) = mimeRender contentTypeProxy a toJSON (WithStatus a) = toJSON a
instance {-# OVERLAPPING #-} MimeRender PlainText a => MimeRender PlainText (WithStatus _status a) where instance {-# OVERLAPPING #-} MimeRender PlainText a => MimeRender PlainText (WithStatus _status a) where
mimeRender contentTypeProxy (WithStatus a) = mimeRender contentTypeProxy a mimeRender contentTypeProxy (WithStatus a) = mimeRender contentTypeProxy a
instance {-# OVERLAPPING #-} MimeRender FormUrlEncoded a => MimeRender FormUrlEncoded (WithStatus _status a) where instance ToForm a => ToForm (WithStatus _status a) where
mimeRender contentTypeProxy (WithStatus a) = mimeRender contentTypeProxy a toForm (WithStatus a) = toForm a
instance {-# OVERLAPPING #-} MimeRender OctetStream a => MimeRender OctetStream (WithStatus _status a) where instance {-# OVERLAPPING #-} MimeRender OctetStream a => MimeRender OctetStream (WithStatus _status a) where
mimeRender contentTypeProxy (WithStatus a) = mimeRender contentTypeProxy a mimeRender contentTypeProxy (WithStatus a) = mimeRender contentTypeProxy a
instance {-# OVERLAPPING #-} MimeUnrender JSON a => MimeUnrender JSON (WithStatus _status a) where instance FromJSON a => FromJSON (WithStatus _status a) where
mimeUnrender contentTypeProxy input = WithStatus <$> mimeUnrender contentTypeProxy input parseJSON v = WithStatus <$> parseJSON v
instance {-# OVERLAPPING #-} MimeUnrender PlainText a => MimeUnrender PlainText (WithStatus _status a) where instance {-# OVERLAPPING #-} MimeUnrender PlainText a => MimeUnrender PlainText (WithStatus _status a) where
mimeUnrender contentTypeProxy input = WithStatus <$> mimeUnrender contentTypeProxy input mimeUnrender contentTypeProxy input = WithStatus <$> mimeUnrender contentTypeProxy input
instance {-# OVERLAPPING #-} MimeUnrender FormUrlEncoded a => MimeUnrender FormUrlEncoded (WithStatus _status a) where instance FromForm a => FromForm (WithStatus _status a) where
mimeUnrender contentTypeProxy input = WithStatus <$> mimeUnrender contentTypeProxy input fromForm v = WithStatus <$> fromForm v
instance {-# OVERLAPPING #-} MimeUnrender OctetStream a => MimeUnrender OctetStream (WithStatus _status a) where instance {-# OVERLAPPING #-} MimeUnrender OctetStream a => MimeUnrender OctetStream (WithStatus _status a) where
mimeUnrender contentTypeProxy input = WithStatus <$> mimeUnrender contentTypeProxy input mimeUnrender contentTypeProxy input = WithStatus <$> mimeUnrender contentTypeProxy input