git.iko.soy/servant
on master help sign in
Allow multiple content-types for single Accept
bf66b2bOleg Grenrus
servant/servant.cabal+1
compare with master
unifiedsplit
@@ -60,6 +60,7 @@ library
60 , http-types >= 0.8 && < 0.10
60 , http-types >= 0.8 && < 0.10
61 , mtl >= 2.0 && < 2.3
61 , mtl >= 2.0 && < 2.3
62 , mmorph >= 1 && < 1.1
62 , mmorph >= 1 && < 1.1
63+ , semigroups >= 0.16 && < 0.19
63 , text >= 1 && < 1.3
64 , text >= 1 && < 1.3
64 , string-conversions >= 0.3 && < 0.5
65 , string-conversions >= 0.3 && < 0.5
65 , network-uri >= 2.6 && < 2.7
66 , network-uri >= 2.6 && < 2.7
servant/src/Servant/API/ContentTypes.hs+29−15
@@ -81,6 +81,7 @@ import qualified Data.ByteString as BS
81import Data.ByteString.Lazy (ByteString, fromStrict,
81import Data.ByteString.Lazy (ByteString, fromStrict,
82 toStrict)
82 toStrict)
83import qualified Data.ByteString.Lazy.Char8 as BC
83import qualified Data.ByteString.Lazy.Char8 as BC
84+import qualified Data.List.NonEmpty as NE
84import Data.Maybe (isJust)
85import Data.Maybe (isJust)
85import Data.String.Conversions (cs)
86import Data.String.Conversions (cs)
86import qualified Data.Text as TextS
87import qualified Data.Text as TextS
@@ -120,6 +121,9 @@ data OctetStream deriving Typeable
120class Accept ctype where
121class Accept ctype where
121 contentType :: Proxy ctype -> M.MediaType
122 contentType :: Proxy ctype -> M.MediaType
122
123
124+ contentTypes :: Proxy ctype -> NE.NonEmpty M.MediaType
125+ contentTypes = (NE.:| []) . contentType
126+
123-- | @application/json@
127-- | @application/json@
124instance Accept JSON where
128instance Accept JSON where
125 contentType _ = "application" M.// "json"
129 contentType _ = "application" M.// "json"
@@ -219,9 +223,10 @@ instance AllMime '[] where
219 allMime _ = []
223 allMime _ = []
220
224
221instance (Accept ctyp, AllMime ctyps) => AllMime (ctyp ': ctyps) where
225instance (Accept ctyp, AllMime ctyps) => AllMime (ctyp ': ctyps) where
222− allMime _ = (contentType pctyp):allMime pctyps
226+ allMime _ = NE.toList (contentTypes pctyp) ++ allMime pctyps
227+ where
223− where pctyp = Proxy :: Proxy ctyp
228+ pctyp = Proxy :: Proxy ctyp
224− pctyps = Proxy :: Proxy ctyps
229+ pctyps = Proxy :: Proxy ctyps
225
230
226canHandleAcceptH :: AllMime list => Proxy list -> AcceptHeader -> Bool
231canHandleAcceptH :: AllMime list => Proxy list -> AcceptHeader -> Bool
227canHandleAcceptH p (AcceptHeader h ) = isJust $ M.matchAccept (allMime p) h
232canHandleAcceptH p (AcceptHeader h ) = isJust $ M.matchAccept (allMime p) h
@@ -235,25 +240,31 @@ class (AllMime list) => AllMimeRender (list :: [*]) a where
235 -> [(M.MediaType, ByteString)] -- content-types/response pairs
240 -> [(M.MediaType, ByteString)] -- content-types/response pairs
236
241
237instance OVERLAPPABLE_ ( MimeRender ctyp a ) => AllMimeRender '[ctyp] a where
242instance OVERLAPPABLE_ ( MimeRender ctyp a ) => AllMimeRender '[ctyp] a where
238− allMimeRender _ a = [(contentType pctyp, mimeRender pctyp a)]
243+ allMimeRender _ a = [ (ct, bs) | ct <- NE.toList $ contentTypes pctyp ]
244+ where
245+ bs = mimeRender pctyp a
239− where pctyp = Proxy :: Proxy ctyp
246+ pctyp = Proxy :: Proxy ctyp
240
247
241instance OVERLAPPABLE_
248instance OVERLAPPABLE_
242 ( MimeRender ctyp a
249 ( MimeRender ctyp a
243 , AllMimeRender (ctyp' ': ctyps) a
250 , AllMimeRender (ctyp' ': ctyps) a
244 ) => AllMimeRender (ctyp ': ctyp' ': ctyps) a where
251 ) => AllMimeRender (ctyp ': ctyp' ': ctyps) a where
252+ allMimeRender _ a =
253+ [ (ct, bs) | ct <- NE.toList $ contentTypes pctyp ]
254+ ++ allMimeRender pctyps a
255+ where
245− allMimeRender _ a = (contentType pctyp, mimeRender pctyp a)
256+ bs = mimeRender pctyp a
246− :(allMimeRender pctyps a)
247− where pctyp = Proxy :: Proxy ctyp
257+ pctyp = Proxy :: Proxy ctyp
248− pctyps = Proxy :: Proxy (ctyp' ': ctyps)
258+ pctyps = Proxy :: Proxy (ctyp' ': ctyps)
249
259
250
260
251-- Ideally we would like to declare a 'MimeRender a NoContent' instance, and
261-- Ideally we would like to declare a 'MimeRender a NoContent' instance, and
252-- then this would be taken care of. However there is no more specific instance
262-- then this would be taken care of. However there is no more specific instance
253-- between that and 'MimeRender JSON a', so we do this instead
263-- between that and 'MimeRender JSON a', so we do this instead
254instance OVERLAPPING_ ( Accept ctyp ) => AllMimeRender '[ctyp] NoContent where
264instance OVERLAPPING_ ( Accept ctyp ) => AllMimeRender '[ctyp] NoContent where
255− allMimeRender _ _ = [(contentType pctyp, "")]
265+ allMimeRender _ _ = [ (ct, "") | ct <- NE.toList $ contentTypes pctyp ]
266+ where
256− where pctyp = Proxy :: Proxy ctyp
267+ pctyp = Proxy :: Proxy ctyp
257
268
258instance OVERLAPPING_
269instance OVERLAPPING_
259 ( AllMime (ctyp ': ctyp' ': ctyps)
270 ( AllMime (ctyp ': ctyp' ': ctyps)
@@ -274,10 +285,13 @@ instance AllMimeUnrender '[] a where
274instance ( MimeUnrender ctyp a
285instance ( MimeUnrender ctyp a
275 , AllMimeUnrender ctyps a
286 , AllMimeUnrender ctyps a
276 ) => AllMimeUnrender (ctyp ': ctyps) a where
287 ) => AllMimeUnrender (ctyp ': ctyps) a where
288+ allMimeUnrender _ bs =
289+ [ (ct, x) | ct <- NE.toList $ contentTypes pctyp ]
290+ ++ allMimeUnrender pctyps bs
291+ where
277− allMimeUnrender _ val = (contentType pctyp, mimeUnrender pctyp val)
292+ x = mimeUnrender pctyp bs
278− :(allMimeUnrender pctyps val)
279− where pctyp = Proxy :: Proxy ctyp
293+ pctyp = Proxy :: Proxy ctyp
280− pctyps = Proxy :: Proxy ctyps
294+ pctyps = Proxy :: Proxy ctyps
281
295
282--------------------------------------------------------------------------
296--------------------------------------------------------------------------
283-- * MimeRender Instances
297-- * MimeRender Instances