eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

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

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

4
servant-client-core/servant-client-core.cabal
View file

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

2
servant-client-ghcjs/servant-client-ghcjs.cabal
View file

@ -45,7 +45,7 @@ library
, exceptions >=0.8 && <0.11 , exceptions >=0.8 && <0.11
, ghcjs-base >=0.2.0.0 && <0.3.0.0 , ghcjs-base >=0.2.0.0 && <0.3.0.0
, ghcjs-prim >=0.1.0.0 && <0.2.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 , http-types >=0.12 && <0.13
, monad-control >=1.0.0.4 && <1.1 , monad-control >=1.0.0.4 && <1.1
, mtl >=2.2.2 && <2.3 , mtl >=2.2.2 && <2.3

4
servant-client/servant-client.cabal
View file

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

2
servant-docs/servant-docs.cabal
View file

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

4
servant-http-streams/servant-http-streams.cabal
View file

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

4
servant-server/servant-server.cabal
View file

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

7
servant/servant.cabal
View file

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

2
servant/src/Servant/Types/SourceT.hs
View file

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

21
servant/test/Servant/API/ContentTypesSpec.hs
View file

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
@ -20,7 +21,7 @@ import Data.Either
import Data.Function import Data.Function
(on) (on)
import Data.List import Data.List
(maximumBy) (sortBy)
import qualified Data.List.NonEmpty as NE import qualified Data.List.NonEmpty as NE
import Data.Maybe import Data.Maybe
(fromJust, isJust, isNothing) (fromJust, isJust, isNothing)
@ -134,17 +135,29 @@ spec = describe "Servant.API.ContentTypes" $ do
== Just ("application/json;charset=utf-8", encode x) == Just ("application/json;charset=utf-8", encode x)
it "respects the Accept spec ordering" $ do 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/octet-stream", a)
, ("application/json;charset=utf-8", b) , ("application/json;charset=utf-8", b)
, ("text/plain;charset=utf-8", c) , ("text/plain;charset=utf-8", c)
] ]
#endif
let acceptH a b c = addToAccept (Proxy :: Proxy OctetStream) a $ let acceptH a b c = addToAccept (Proxy :: Proxy OctetStream) a $
addToAccept (Proxy :: Proxy JSON) b $ 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]) let val a b c i = handleAcceptH (Proxy :: Proxy '[OctetStream, JSON, PlainText])
(acceptH a b c) (i :: Int) (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 describe "handleCTypeH" $ do