From b5ae9c04fca62eaaefd6a6951fc743ea0fb01dae Mon Sep 17 00:00:00 2001 From: Ben Weitzman Date: Wed, 9 Nov 2016 22:32:27 -0500 Subject: [PATCH] make mimeRender failable --- servant/src/Servant/API/ContentTypes.hs | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/servant/src/Servant/API/ContentTypes.hs b/servant/src/Servant/API/ContentTypes.hs index 044f1c59..964aac44 100644 --- a/servant/src/Servant/API/ContentTypes.hs +++ b/servant/src/Servant/API/ContentTypes.hs @@ -157,7 +157,12 @@ newtype AcceptHeader = AcceptHeader BS.ByteString -- > type MyAPI = "path" :> Get '[MyContentType] Int -- class Accept ctype => MimeRender ctype a where - mimeRender :: Proxy ctype -> a -> ByteString + {-# MINIMAL mimeRenderMaybe | mimeRender #-} + mimeRenderMaybe :: Proxy ctype -> a -> Maybe ByteString + mimeRenderMaybe p val = Just $ mimeRender p val + + mimeRender :: Proxy ctype -> a -> ByteString + mimeRender _ _ = error "no mimeRender defn" class (AllMime list) => AllCTRender (list :: [*]) a where -- If the Accept header can be matched, returns (Just) a tuple of the @@ -235,15 +240,19 @@ class (AllMime list) => AllMimeRender (list :: [*]) a where -> [(M.MediaType, ByteString)] -- content-types/response pairs instance OVERLAPPABLE_ ( MimeRender ctyp a ) => AllMimeRender '[ctyp] a where - allMimeRender _ a = [(contentType pctyp, mimeRender pctyp a)] + allMimeRender _ a = case mimeRenderMaybe pctyp a of + Just bs -> [(contentType pctyp, bs)] + Nothing -> [] where pctyp = Proxy :: Proxy ctyp instance OVERLAPPABLE_ ( MimeRender ctyp a , AllMimeRender (ctyp' ': ctyps) a ) => AllMimeRender (ctyp ': ctyp' ': ctyps) a where - allMimeRender _ a = (contentType pctyp, mimeRender pctyp a) - :(allMimeRender pctyps a) + allMimeRender _ a = case mimeRenderMaybe pctyp a of + Just bs -> (contentType pctyp, bs) + :(allMimeRender pctyps a) + Nothing -> (allMimeRender pctyps a) where pctyp = Proxy :: Proxy ctyp pctyps = Proxy :: Proxy (ctyp' ': ctyps)