Merge pull request #1173 from haskell-servant/http-media-0.8-master

Http media 0.8 master
This commit is contained in:
Oleg Grenrus 2019-04-16 14:29:22 +03:00 committed by GitHub
commit d4788fb508
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
9 changed files with 34 additions and 18 deletions

View file

@ -77,7 +77,7 @@ library
, base64-bytestring >= 1.0.0.1 && < 1.1
, exceptions >= 0.10.0 && < 0.11
, free >= 5.1 && < 5.2
, http-media >= 0.7.1.3 && < 0.8
, http-media >= 0.7.1.3 && < 0.9
, http-types >= 0.12.2 && < 0.13
, network-uri >= 2.6.1.0 && < 2.7
, safe >= 0.3.17 && < 0.4
@ -105,7 +105,7 @@ test-suite spec
build-depends:
deepseq >= 1.4.2.0 && < 1.5
, hspec >= 2.6.0 && < 2.8
, QuickCheck >= 2.12.6.1 && < 2.13
, QuickCheck >= 2.12.6.1 && < 2.14
build-tool-depends:
hspec-discover:hspec-discover >= 2.6.0 && <2.8

View file

@ -45,7 +45,7 @@ library
, exceptions >=0.8 && <0.11
, ghcjs-base >=0.2.0.0 && <0.3.0.0
, ghcjs-prim >=0.1.0.0 && <0.2.0.0
, http-media >=0.6.2 && <0.8
, http-media >=0.6.2 && <0.9
, http-types >=0.12 && <0.13
, monad-control >=1.0.0.4 && <1.1
, mtl >=2.2.2 && <2.3

View file

@ -69,7 +69,7 @@ library
build-depends:
base-compat >= 0.10.5 && < 0.11
, http-client >= 0.5.13.1 && < 0.7
, http-media >= 0.7.1.3 && < 0.8
, http-media >= 0.7.1.3 && < 0.9
, http-types >= 0.12.2 && < 0.13
, exceptions >= 0.10.0 && < 0.11
, kan-extensions >= 5.2 && < 5.3
@ -125,7 +125,7 @@ test-suite spec
, hspec >= 2.6.0 && < 2.8
, HUnit >= 1.6.0.0 && < 1.7
, network >= 2.8.0.0 && < 3.1
, QuickCheck >= 2.12.6.1 && < 2.13
, QuickCheck >= 2.12.6.1 && < 2.14
, servant == 0.16.*
, servant-server == 0.16.*
, tdigest >= 0.2 && < 0.3

View file

@ -63,7 +63,7 @@ library
, case-insensitive >= 1.2.0.11 && < 1.3
, control-monad-omega >= 0.3.1 && < 0.4
, hashable >= 1.2.7.0 && < 1.3
, http-media >= 0.7.1.3 && < 0.8
, http-media >= 0.7.1.3 && < 0.9
, http-types >= 0.12.2 && < 0.13
, lens >= 4.17 && < 4.18
, string-conversions >= 0.4.0.1 && < 0.5

View file

@ -67,7 +67,7 @@ library
base-compat >= 0.10.5 && < 0.11
, case-insensitive
, http-streams >= 0.8.6.1 && < 0.9
, http-media >= 0.7.1.3 && < 0.8
, http-media >= 0.7.1.3 && < 0.9
, io-streams >= 1.5.0.1 && < 1.6
, http-types >= 0.12.2 && < 0.13
, http-common >= 0.8.2.0 && < 0.9
@ -119,7 +119,7 @@ test-suite spec
, hspec >= 2.6.0 && < 2.8
, HUnit >= 1.6.0.0 && < 1.7
, network >= 2.8.0.0 && < 3.1
, QuickCheck >= 2.12.6.1 && < 2.13
, QuickCheck >= 2.12.6.1 && < 2.14
, servant == 0.16.*
, servant-server == 0.16.*
, tdigest >= 0.2 && < 0.3

View file

@ -88,7 +88,7 @@ library
base-compat >= 0.10.5 && < 0.11
, base64-bytestring >= 1.0.0.1 && < 1.1
, exceptions >= 0.10.0 && < 0.11
, http-media >= 0.7.1.3 && < 0.8
, http-media >= 0.7.1.3 && < 0.9
, http-types >= 0.12.2 && < 0.13
, network-uri >= 2.6.1.0 && < 2.8
, monad-control >= 1.0.2.3 && < 1.1
@ -165,7 +165,7 @@ test-suite spec
, directory >= 1.3.0.0 && < 1.4
, hspec >= 2.6.0 && < 2.8
, hspec-wai >= 0.9.0 && < 0.10
, QuickCheck >= 2.12.6.1 && < 2.13
, QuickCheck >= 2.12.6.1 && < 2.14
, should-not-typecheck >= 2.1.0 && < 2.2
, temporary >= 1.3 && < 1.4
, wai-extra >= 3.0.24.3 && < 3.1

View file

@ -110,11 +110,11 @@ library
, bifunctors >= 5.5.3 && < 5.6
, case-insensitive >= 1.2.0.11 && < 1.3
, deepseq >= 1.4.2.0 && < 1.5
, http-media >= 0.7.1.3 && < 0.8
, http-media >= 0.7.1.3 && < 0.9
, http-types >= 0.12.2 && < 0.13
, mmorph >= 1.1.2 && < 1.2
, network-uri >= 2.6.1.0 && < 2.7
, QuickCheck >= 2.12.6.1 && <2.13
, QuickCheck >= 2.12.6.1 && < 2.14
, string-conversions >= 0.4.0.1 && < 0.5
, tagged >= 0.8.6 && < 0.9
, vault >= 0.3.1.2 && < 0.4
@ -161,6 +161,7 @@ test-suite spec
, base-compat
, aeson
, bytestring
, http-media
, mtl
, servant
, string-conversions
@ -170,7 +171,7 @@ test-suite spec
-- Additonal dependencies
build-depends:
hspec >= 2.6.0 && < 2.8
, QuickCheck >= 2.12.6.1 && < 2.13
, QuickCheck >= 2.12.6.1 && < 2.14
, quickcheck-instances >= 0.3.19 && < 0.4
build-tool-depends:

View file

@ -102,6 +102,7 @@ instance Functor m => Semigroup (SourceT m a) where
-- fromStepT (Effect (Just Stop))
instance Functor m => Monoid (SourceT m a) where
mempty = fromStepT mempty
mappend = (<>)
-- | Doesn't generate 'Error' constructors. 'SourceT' doesn't shrink.
instance (QC.Arbitrary a, Monad m) => QC.Arbitrary (SourceT m a) where
@ -179,6 +180,7 @@ instance Functor m => Semigroup (StepT m a) where
--
instance Functor m => Monoid (StepT m a) where
mempty = Stop
mappend = (<>)
-- | Doesn't generate 'Error' constructors.
instance (QC.Arbitrary a, Monad m) => QC.Arbitrary (StepT m a) where

View file

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
@ -20,7 +21,7 @@ import Data.Either
import Data.Function
(on)
import Data.List
(maximumBy)
(sortBy)
import qualified Data.List.NonEmpty as NE
import Data.Maybe
(fromJust, isJust, isNothing)
@ -134,17 +135,29 @@ spec = describe "Servant.API.ContentTypes" $ do
== Just ("application/json;charset=utf-8", encode x)
it "respects the Accept spec ordering" $ do
let highest a b c = maximumBy (compare `on` snd)
let highest a b c = last $ sortBy (compare `on` snd)
-- when qualities are same, http-media-0.8 picks first; 0.7 last.
#if MIN_VERSION_http_media(0,8,0)
[ ("text/plain;charset=utf-8", c)
, ("application/json;charset=utf-8", b)
, ("application/octet-stream", a)
]
#else
[ ("application/octet-stream", a)
, ("application/json;charset=utf-8", b)
, ("text/plain;charset=utf-8", c)
]
#endif
let acceptH a b c = addToAccept (Proxy :: Proxy OctetStream) a $
addToAccept (Proxy :: Proxy JSON) b $
addToAccept (Proxy :: Proxy PlainText ) c ""
addToAccept (Proxy :: Proxy PlainText ) c $
""
let val a b c i = handleAcceptH (Proxy :: Proxy '[OctetStream, JSON, PlainText])
(acceptH a b c) (i :: Int)
property $ \a b c i -> fst (fromJust $ val a b c i) == fst (highest a b c)
property $ \a b c i ->
let acc = acceptH a b c
in counterexample (show acc) $
fst (fromJust $ val a b c i) === fst (highest a b c)
describe "handleCTypeH" $ do