@@ -81,6 +81,7 @@ import qualified Data.ByteString as BS
8181import Data.ByteString.Lazy (ByteString, fromStrict,
8282 toStrict)
8383import qualified Data.ByteString.Lazy.Char8 as BC
84+import qualified Data.List.NonEmpty as NE
8485import Data.Maybe (isJust)
8586import Data.String.Conversions (cs)
8687import qualified Data.Text as TextS
@@ -120,6 +121,9 @@ data OctetStream deriving Typeable
120121class Accept ctype where
121122 contentType :: Proxy ctype -> M.MediaType
122123
124+ contentTypes :: Proxy ctype -> NE.NonEmpty M.MediaType
125+ contentTypes = (NE.:| []) . contentType
126+
123127-- | @application/json@
124128instance Accept JSON where
125129 contentType _ = "application" M.// "json"
@@ -219,9 +223,10 @@ instance AllMime '[] where
219223 allMime _ = []
220224
221225instance (Accept ctyp, AllMime ctyps) => AllMime (ctyp ': ctyps) where
222− allMime _ = (contentType pctyp):allMime pctyps
223− where pctyp = Proxy :: Proxy ctyp
224− pctyps = Proxy :: Proxy ctyps
226+ allMime _ = NE.toList (contentTypes pctyp) ++ allMime pctyps
227+ where
228+ pctyp = Proxy :: Proxy ctyp
229+ pctyps = Proxy :: Proxy ctyps
225230
226231canHandleAcceptH :: AllMime list => Proxy list -> AcceptHeader -> Bool
227232canHandleAcceptH p (AcceptHeader h ) = isJust $ M.matchAccept (allMime p) h
@@ -235,25 +240,31 @@ class (AllMime list) => AllMimeRender (list :: [*]) a where
235240 -> [(M.MediaType, ByteString)] -- content-types/response pairs
236241
237242instance OVERLAPPABLE_ ( MimeRender ctyp a ) => AllMimeRender '[ctyp] a where
238− allMimeRender _ a = [(contentType pctyp, mimeRender pctyp a)]
239− where pctyp = Proxy :: Proxy ctyp
243+ allMimeRender _ a = [ (ct, bs) | ct <- NE.toList $ contentTypes pctyp ]
244+ where
245+ bs = mimeRender pctyp a
246+ pctyp = Proxy :: Proxy ctyp
240247
241248instance OVERLAPPABLE_
242249 ( MimeRender ctyp a
243250 , AllMimeRender (ctyp' ': ctyps) a
244251 ) => AllMimeRender (ctyp ': ctyp' ': ctyps) a where
245− allMimeRender _ a = (contentType pctyp, mimeRender pctyp a)
246− :(allMimeRender pctyps a)
247− where pctyp = Proxy :: Proxy ctyp
248− pctyps = Proxy :: Proxy (ctyp' ': ctyps)
252+ allMimeRender _ a =
253+ [ (ct, bs) | ct <- NE.toList $ contentTypes pctyp ]
254+ ++ allMimeRender pctyps a
255+ where
256+ bs = mimeRender pctyp a
257+ pctyp = Proxy :: Proxy ctyp
258+ pctyps = Proxy :: Proxy (ctyp' ': ctyps)
249259
250260
251261-- Ideally we would like to declare a 'MimeRender a NoContent' instance, and
252262-- then this would be taken care of. However there is no more specific instance
253263-- between that and 'MimeRender JSON a', so we do this instead
254264instance OVERLAPPING_ ( Accept ctyp ) => AllMimeRender '[ctyp] NoContent where
255− allMimeRender _ _ = [(contentType pctyp, "")]
256− where pctyp = Proxy :: Proxy ctyp
265+ allMimeRender _ _ = [ (ct, "") | ct <- NE.toList $ contentTypes pctyp ]
266+ where
267+ pctyp = Proxy :: Proxy ctyp
257268
258269instance OVERLAPPING_
259270 ( AllMime (ctyp ': ctyp' ': ctyps)
@@ -274,10 +285,13 @@ instance AllMimeUnrender '[] a where
274285instance ( MimeUnrender ctyp a
275286 , AllMimeUnrender ctyps a
276287 ) => AllMimeUnrender (ctyp ': ctyps) a where
277− allMimeUnrender _ val = (contentType pctyp, mimeUnrender pctyp val)
278− :(allMimeUnrender pctyps val)
279− where pctyp = Proxy :: Proxy ctyp
280− pctyps = Proxy :: Proxy ctyps
288+ allMimeUnrender _ bs =
289+ [ (ct, x) | ct <- NE.toList $ contentTypes pctyp ]
290+ ++ allMimeUnrender pctyps bs
291+ where
292+ x = mimeUnrender pctyp bs
293+ pctyp = Proxy :: Proxy ctyp
294+ pctyps = Proxy :: Proxy ctyps
281295
282296--------------------------------------------------------------------------
283297-- * MimeRender Instances