@@ -14,9 +14,11 @@ import Prelude.Compat
1414import Data.Aeson
1515import Data.ByteString.Char8 (ByteString, append, pack)
1616import qualified Data.ByteString.Lazy as BSL
17+import qualified Data.ByteString.Lazy.Char8 as BSL8
1718import Data.Either
1819import Data.Function (on)
1920import Data.List (maximumBy)
21+import qualified Data.List.NonEmpty as NE
2022import Data.Maybe (fromJust, isJust, isNothing)
2123import Data.Proxy
2224import Data.String (IsString (..))
@@ -24,8 +26,10 @@ import Data.String.Conversions (cs)
2426import qualified Data.Text as TextS
2527import qualified Data.Text.Lazy as TextL
2628import GHC.Generics
29+import qualified Network.HTTP.Media as M
2730import Test.Hspec
2831import Test.QuickCheck
32+import Text.Read (readMaybe)
2933import "quickcheck-instances" Test.QuickCheck.Instances ()
3034
3135import Servant.API.ContentTypes
@@ -101,6 +105,14 @@ spec = describe "Servant.API.ContentTypes" $ do
101105 "application/octet-stream" ("content" :: ByteString)
102106 `shouldSatisfy` isJust
103107
108+ it "returns Just if the 'Accept' header matches, with multiple mime types" $ do
109+ handleAcceptH (Proxy :: Proxy '[JSONorText]) "application/json" (3 :: Int)
110+ `shouldSatisfy` isJust
111+ handleAcceptH (Proxy :: Proxy '[JSONorText]) "text/plain" (3 :: Int)
112+ `shouldSatisfy` isJust
113+ handleAcceptH (Proxy :: Proxy '[JSONorText]) "image/jpeg" (3 :: Int)
114+ `shouldBe` Nothing
115+
104116 it "returns the Content-Type as the first element of the tuple" $ do
105117 handleAcceptH (Proxy :: Proxy '[JSON]) "*/*" (3 :: Int)
106118 `shouldSatisfy` ((== "application/json") . fst . fromJust)
@@ -158,6 +170,15 @@ spec = describe "Servant.API.ContentTypes" $ do
158170 (encode val)
159171 `shouldBe` Just (Right val)
160172
173+ it "returns Just (Right val) if the decoding succeeds for either of multiple mime-types" $ do
174+ let val = 42 :: Int
175+ handleCTypeH (Proxy :: Proxy '[JSONorText]) "application/json"
176+ "42" `shouldBe` Just (Right val)
177+ handleCTypeH (Proxy :: Proxy '[JSONorText]) "text/plain"
178+ "42" `shouldBe` Just (Right val)
179+ handleCTypeH (Proxy :: Proxy '[JSONorText]) "image/jpeg"
180+ "42" `shouldBe` (Nothing :: Maybe (Either String Int))
181+
161182#if MIN_VERSION_aeson(0,9,0)
162183 -- aeson >= 0.9 decodes top-level strings
163184 describe "eitherDecodeLenient" $ do
@@ -201,6 +222,18 @@ instance ToJSON ByteString where
201222instance IsString AcceptHeader where
202223 fromString = AcceptHeader . fromString
203224
225+-- To test multiple content types
226+data JSONorText
227+
228+instance Accept JSONorText where
229+ contentTypes _ = "text" M.// "plain" NE.:| [ "application" M.// "json" ]
230+
231+instance MimeRender JSONorText Int where
232+ mimeRender _ = cs . show
233+
234+instance MimeUnrender JSONorText Int where
235+ mimeUnrender _ = maybe (Left "") Right . readMaybe . BSL8.unpack
236+
204237addToAccept :: Accept a => Proxy a -> ZeroToOne -> AcceptHeader -> AcceptHeader
205238addToAccept p (ZeroToOne f) (AcceptHeader h) = AcceptHeader (cont h)
206239 where new = cs (show $ contentType p) `append` "; q=" `append` pack (show f)