git.iko.soy/typeable/servant
on master help sign in
Merge pull request #615 from phadej/mime-unrender-multiple

Mime unrender multiple

commit6234eae2ac1673825c67c355b79853048100f7ed authorAlp Mestanogullari <alpmestan@gmail.com> dateSun 1 Jan 2017, 22:17 (10 years ago) parente8ba6704d4bc8e
4 files changed+31−6
compare with master
unifiedsplit
servant/servant.cabal+1−1 servant/src/Servant/API/ContentTypes.hs+12−2 servant/test/Servant/API/ContentTypesSpec.hs+17−3 stack-ghc-7.8.4.yaml+1
servant/servant.cabal+1−1
@@ -111,10 +111,10 @@ test-suite spec
111111 base == 4.*
112112 , base-compat
113113 , aeson
114+ , aeson-compat >=0.3.3 && <0.4
114115 , attoparsec
115116 , bytestring
116117 , hspec == 2.*
117− , http-media
118118 , QuickCheck
119119 , quickcheck-instances
120120 , servant
servant/src/Servant/API/ContentTypes.hs+12−2
@@ -206,6 +206,16 @@ instance OVERLAPPABLE_
206206--
207207class Accept ctype => MimeUnrender ctype a where
208208 mimeUnrender :: Proxy ctype -> ByteString -> Either String a
209+ mimeUnrender p = mimeUnrenderWithType p (contentType p)
210+
211+ -- | Variant which is given the actual 'M.MediaType' provided by the other party.
212+ --
213+ -- In the most cases you don't want to branch based on the 'M.MediaType'.
214+ -- See <https://github.com/haskell-servant/servant/pull/552 pr552> for a motivating example.
215+ mimeUnrenderWithType :: Proxy ctype -> M.MediaType -> ByteString -> Either String a
216+ mimeUnrenderWithType p _ = mimeUnrender p
217+
218+ {-# MINIMAL mimeUnrender | mimeUnrenderWithType #-}
209219
210220class AllCTUnrender (list :: [*]) a where
211221 handleCTypeH :: Proxy list
@@ -290,10 +300,10 @@ instance ( MimeUnrender ctyp a
290300 , AllMimeUnrender ctyps a
291301 ) => AllMimeUnrender (ctyp ': ctyps) a where
292302 allMimeUnrender _ bs =
293− (map (, x) $ NE.toList $ contentTypes pctyp)
303+ (map mk $ NE.toList $ contentTypes pctyp)
294304 ++ allMimeUnrender pctyps bs
295305 where
296− x = mimeUnrender pctyp bs
306+ mk ct = (ct, mimeUnrenderWithType pctyp ct bs)
297307 pctyp = Proxy :: Proxy ctyp
298308 pctyps = Proxy :: Proxy ctyps
299309
servant/test/Servant/API/ContentTypesSpec.hs+17−3
@@ -11,7 +11,7 @@ module Servant.API.ContentTypesSpec where
1111import Prelude ()
1212import Prelude.Compat
1313
14−import Data.Aeson
14+import Data.Aeson.Compat
1515import Data.ByteString.Char8 (ByteString, append, pack)
1616import qualified Data.ByteString.Lazy as BSL
1717import qualified Data.ByteString.Lazy.Char8 as BSL8
@@ -24,9 +24,9 @@ import Data.Proxy
2424import Data.String (IsString (..))
2525import Data.String.Conversions (cs)
2626import qualified Data.Text as TextS
27+import qualified Data.Text.Encoding as TextSE
2728import qualified Data.Text.Lazy as TextL
2829import GHC.Generics
29−import qualified Network.HTTP.Media as M
3030import Test.Hspec
3131import Test.QuickCheck
3232import Text.Read (readMaybe)
@@ -179,6 +179,15 @@ spec = describe "Servant.API.ContentTypes" $ do
179179 handleCTypeH (Proxy :: Proxy '[JSONorText]) "image/jpeg"
180180 "42" `shouldBe` (Nothing :: Maybe (Either String Int))
181181
182+ it "passes content-type to mimeUnrenderWithType" $ do
183+ let val = "foobar" :: TextS.Text
184+ handleCTypeH (Proxy :: Proxy '[JSONorText]) "application/json"
185+ "\"foobar\"" `shouldBe` Just (Right val)
186+ handleCTypeH (Proxy :: Proxy '[JSONorText]) "text/plain"
187+ "foobar" `shouldBe` Just (Right val)
188+ handleCTypeH (Proxy :: Proxy '[JSONorText]) "image/jpeg"
189+ "foobar" `shouldBe` (Nothing :: Maybe (Either String Int))
190+
182191#if MIN_VERSION_aeson(0,9,0)
183192 -- aeson >= 0.9 decodes top-level strings
184193 describe "eitherDecodeLenient" $ do
@@ -226,7 +235,7 @@ instance IsString AcceptHeader where
226235data JSONorText
227236
228237instance Accept JSONorText where
229− contentTypes _ = "text" M.// "plain" NE.:| [ "application" M.// "json" ]
238+ contentTypes _ = "text/plain" NE.:| [ "application/json" ]
230239
231240instance MimeRender JSONorText Int where
232241 mimeRender _ = cs . show
@@ -234,6 +243,11 @@ instance MimeRender JSONorText Int where
234243instance MimeUnrender JSONorText Int where
235244 mimeUnrender _ = maybe (Left "") Right . readMaybe . BSL8.unpack
236245
246+instance MimeUnrender JSONorText TextS.Text where
247+ mimeUnrenderWithType _ mt
248+ | mt == "application/json" = maybe (Left "") Right . decode
249+ | otherwise = Right . TextSE.decodeUtf8 . BSL.toStrict
250+
237251addToAccept :: Accept a => Proxy a -> ZeroToOne -> AcceptHeader -> AcceptHeader
238252addToAccept p (ZeroToOne f) (AcceptHeader h) = AcceptHeader (cont h)
239253 where new = cs (show $ contentType p) `append` "; q=" `append` pack (show f)
stack-ghc-7.8.4.yaml+1
@@ -6,6 +6,7 @@ packages:
66- servant-foreign/
77- servant-server/
88extra-deps:
9+- aeson-compat-0.3.6
910- base-compat-0.9.1
1011- control-monad-omega-0.3.1
1112- cryptonite-0.6