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

make mimeRender failable

Browse source
This commit is contained in:
Ben Weitzman 2016-11-09 22:32:27 -05:00
parent 4fd31a60fb
commit b5ae9c04fc
1 changed files with 13 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
servant/src/Servant/API/ContentTypes.hs
View file

@ -157,7 +157,12 @@ newtype AcceptHeader = AcceptHeader BS.ByteString
-- > type MyAPI = "path" :> Get '[MyContentType] Int -- > type MyAPI = "path" :> Get '[MyContentType] Int
-- --
class Accept ctype => MimeRender ctype a where 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 class (AllMime list) => AllCTRender (list :: [*]) a where
-- If the Accept header can be matched, returns (Just) a tuple of the -- 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 -> [(M.MediaType, ByteString)] -- content-types/response pairs
instance OVERLAPPABLE_ ( MimeRender ctyp a ) => AllMimeRender '[ctyp] a where 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 where pctyp = Proxy :: Proxy ctyp
instance OVERLAPPABLE_ instance OVERLAPPABLE_
( MimeRender ctyp a ( MimeRender ctyp a
, AllMimeRender (ctyp' ': ctyps) a , AllMimeRender (ctyp' ': ctyps) a
) => AllMimeRender (ctyp ': ctyp' ': ctyps) a where ) => AllMimeRender (ctyp ': ctyp' ': ctyps) a where
allMimeRender _ a = (contentType pctyp, mimeRender pctyp a) allMimeRender _ a = case mimeRenderMaybe pctyp a of
:(allMimeRender pctyps a) Just bs -> (contentType pctyp, bs)
:(allMimeRender pctyps a)
Nothing -> (allMimeRender pctyps a)
where pctyp = Proxy :: Proxy ctyp where pctyp = Proxy :: Proxy ctyp
pctyps = Proxy :: Proxy (ctyp' ': ctyps) pctyps = Proxy :: Proxy (ctyp' ': ctyps)