From f9c61379c04d436fc9e1353f61c46740c6eac272 Mon Sep 17 00:00:00 2001 From: "Julian K. Arni" Date: Fri, 8 Jan 2016 19:33:36 +0100 Subject: [PATCH] Refactor NoContent logic. Now MimeRender and MimeUnrender instances are not needed. --- servant/src/Servant/API/ContentTypes.hs | 36 +++++++++++-------------- 1 file changed, 16 insertions(+), 20 deletions(-) diff --git a/servant/src/Servant/API/ContentTypes.hs b/servant/src/Servant/API/ContentTypes.hs index c7776aa9..61bf1ce9 100644 --- a/servant/src/Servant/API/ContentTypes.hs +++ b/servant/src/Servant/API/ContentTypes.hs @@ -238,11 +238,12 @@ class (AllMime list) => AllMimeRender (list :: [*]) a where -> a -- value to serialize -> [(M.MediaType, ByteString)] -- content-types/response pairs -instance ( MimeRender ctyp a ) => AllMimeRender '[ctyp] a where +instance OVERLAPPABLE_ ( MimeRender ctyp a ) => AllMimeRender '[ctyp] a where allMimeRender _ a = [(contentType pctyp, mimeRender pctyp a)] where pctyp = Proxy :: Proxy ctyp -instance ( MimeRender ctyp a +instance OVERLAPPABLE_ + ( MimeRender ctyp a , AllMimeRender (ctyp' ': ctyps) a ) => AllMimeRender (ctyp ': ctyp' ': ctyps) a where allMimeRender _ a = (contentType pctyp, mimeRender pctyp a) @@ -250,6 +251,19 @@ instance ( MimeRender ctyp a where pctyp = Proxy :: Proxy ctyp pctyps = Proxy :: Proxy (ctyp' ': ctyps) + +-- Ideally we would like to declare a 'MimeRender a NoContent' instance, and +-- then this would be taken care of. However there is no more specific instance +-- between that and 'MimeRender JSON a', so we do this instead +instance OVERLAPPING_ ( Accept ctyp ) => AllMimeRender '[ctyp] NoContent where + allMimeRender _ _ = [(contentType pctyp, "")] + where pctyp = Proxy :: Proxy ctyp + +instance OVERLAPPING_ + ( AllMime (ctyp ': ctyp' ': ctyps) + ) => AllMimeRender (ctyp ': ctyp' ': ctyps) NoContent where + allMimeRender p _ = zip (allMime p) (repeat "") + -------------------------------------------------------------------------- -- Check that all elements of list are instances of MimeUnrender -------------------------------------------------------------------------- @@ -308,24 +322,6 @@ instance MimeRender OctetStream BS.ByteString where data NoContent = NoContent deriving (Show, Eq, Read) -instance FromJSON NoContent where - parseJSON _ = return NoContent - -instance ToJSON NoContent where - toJSON _ = "" - - -instance OVERLAPPING_ - MimeRender JSON NoContent where - mimeRender _ _ = "" - -instance OVERLAPPING_ - MimeRender PlainText NoContent where - mimeRender _ _ = "" - -instance OVERLAPPING_ - MimeRender OctetStream NoContent where - mimeRender _ _ = "" -------------------------------------------------------------------------- -- * MimeUnrender Instances