Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-http-media for openSUSE:Factory checked in at 2023-09-04 22:53:46 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-http-media (Old) and /work/SRC/openSUSE:Factory/.ghc-http-media.new.1766 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-http-media" Mon Sep 4 22:53:46 2023 rev:7 rq:1108867 version:0.8.1.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-http-media/ghc-http-media.changes 2023-04-04 21:20:59.549391374 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-http-media.new.1766/ghc-http-media.changes 2023-09-04 22:54:33.429835263 +0200 @@ -1,0 +2,10 @@ +Sat Sep 2 03:21:41 UTC 2023 - Peter Simons <psim...@suse.com> + +- Update http-media to version 0.8.1.0. + - [ Version 0.8.1.0](https://github.com/zmthy/http-media/releases/tag/v0.8.1.0) + + Exposed `qualityData` accessor. + + Added `isAcceptable` to allow filtering out unacceptable items. + +------------------------------------------------------------------- Old: ---- http-media-0.8.0.0.tar.gz http-media.cabal New: ---- http-media-0.8.1.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-http-media.spec ++++++ --- /var/tmp/diff_new_pack.Aa0a7Y/_old 2023-09-04 22:54:34.533874289 +0200 +++ /var/tmp/diff_new_pack.Aa0a7Y/_new 2023-09-04 22:54:34.537874431 +0200 @@ -20,13 +20,12 @@ %global pkgver %{pkg_name}-%{version} %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.8.0.0 +Version: 0.8.1.0 Release: 0 Summary: Processing HTTP Content-Type and Accept headers License: MIT URL: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz -Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/8.cabal#/%{pkg_name}.cabal BuildRequires: ghc-Cabal-devel BuildRequires: ghc-base-devel BuildRequires: ghc-base-prof @@ -43,10 +42,10 @@ %if %{with tests} BuildRequires: ghc-QuickCheck-devel BuildRequires: ghc-QuickCheck-prof -BuildRequires: ghc-test-framework-devel -BuildRequires: ghc-test-framework-prof -BuildRequires: ghc-test-framework-quickcheck2-devel -BuildRequires: ghc-test-framework-quickcheck2-prof +BuildRequires: ghc-tasty-devel +BuildRequires: ghc-tasty-prof +BuildRequires: ghc-tasty-quickcheck-devel +BuildRequires: ghc-tasty-quickcheck-prof %endif %description @@ -100,7 +99,6 @@ %prep %autosetup -n %{pkg_name}-%{version} -cp -p %{SOURCE1} %{pkg_name}.cabal %build %ghc_lib_build ++++++ http-media-0.8.0.0.tar.gz -> http-media-0.8.1.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-media-0.8.0.0/CHANGES.md new/http-media-0.8.1.0/CHANGES.md --- old/http-media-0.8.0.0/CHANGES.md 2019-04-16 00:59:45.000000000 +0200 +++ new/http-media-0.8.1.0/CHANGES.md 2001-09-09 03:46:40.000000000 +0200 @@ -1,6 +1,12 @@ Changelog ========= +- [ Version 0.8.1.0](https://github.com/zmthy/http-media/releases/tag/v0.8.1.0) + + Exposed `qualityData` accessor. + + Added `isAcceptable` to allow filtering out unacceptable items. + - [Version 0.8.0.0](https://github.com/zmthy/http-media/releases/tag/v0.8.0.0) Removed official support for GHC 7.8. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-media-0.8.0.0/http-media.cabal new/http-media-0.8.1.0/http-media.cabal --- old/http-media-0.8.0.0/http-media.cabal 2019-04-16 00:57:56.000000000 +0200 +++ new/http-media-0.8.1.0/http-media.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,15 +1,24 @@ name: http-media -version: 0.8.0.0 +version: 0.8.1.0 license: MIT license-file: LICENSE author: Timothy Jones maintainer: Timothy Jones <t...@zmthy.net> homepage: https://github.com/zmthy/http-media bug-reports: https://github.com/zmthy/http-media/issues -copyright: (c) 2012-2019 Timothy Jones +copyright: (c) 2012-2023 Timothy Jones category: Web build-type: Simple cabal-version: >= 1.10 +tested-with: + GHC == 8.4.4 + , GHC == 8.6.5 + , GHC == 8.8.4 + , GHC == 8.10.7 + , GHC == 9.0.2 + , GHC == 9.2.8 + , GHC == 9.4.5 + , GHC == 9.6.2 synopsis: Processing HTTP Content-Type and Accept headers description: This library is intended to be a comprehensive solution to parsing and @@ -71,8 +80,8 @@ Network.HTTP.Media.Utils build-depends: - base >= 4.7 && < 4.13, - bytestring >= 0.10 && < 0.11, + base >= 4.8 && < 5, + bytestring >= 0.10 && < 0.12, case-insensitive >= 1.0 && < 1.3, containers >= 0.5 && < 0.7, utf8-string >= 0.3 && < 1.1 @@ -122,14 +131,14 @@ Network.HTTP.Media.Utils build-depends: - base >= 4.7 && < 4.13, - bytestring >= 0.10 && < 0.11, - case-insensitive >= 1.0 && < 1.3, - containers >= 0.5 && < 0.7, - utf8-string >= 0.3 && < 1.1, - QuickCheck >= 2.8 && < 2.14, - test-framework >= 0.8 && < 0.9, - test-framework-quickcheck2 >= 0.3 && < 0.4 + base >= 4.8 && < 5, + bytestring >= 0.10 && < 0.12, + case-insensitive >= 1.0 && < 1.3, + containers >= 0.5 && < 0.7, + utf8-string >= 0.3 && < 1.1, + QuickCheck >= 2.8 && < 2.15, + tasty >= 0.11 && < 1.5, + tasty-quickcheck >= 0.8 && < 0.11 source-repository head type: git diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-media-0.8.0.0/src/Network/HTTP/Media/Quality.hs new/http-media-0.8.1.0/src/Network/HTTP/Media/Quality.hs --- old/http-media-0.8.0.0/src/Network/HTTP/Media/Quality.hs 2019-04-16 00:57:56.000000000 +0200 +++ new/http-media-0.8.1.0/src/Network/HTTP/Media/Quality.hs 2001-09-09 03:46:40.000000000 +0200 @@ -7,6 +7,7 @@ , quality , QualityOrder , qualityOrder + , isAcceptable , maxQuality , minQuality , mostSpecific @@ -54,6 +55,12 @@ newtype QualityOrder = QualityOrder Word16 deriving (Eq, Ord) +------------------------------------------------------------------------------ +-- | Whether the quality value is greater than zero; otherwise the value +-- should never be accepted, even when no other options are available. +isAcceptable :: Quality a -> Bool +isAcceptable (Quality _ 0) = False +isAcceptable (Quality _ _) = True ------------------------------------------------------------------------------ -- | Remove the attached data from a quality value, retaining only the diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-media-0.8.0.0/src/Network/HTTP/Media.hs new/http-media-0.8.1.0/src/Network/HTTP/Media.hs --- old/http-media-0.8.0.0/src/Network/HTTP/Media.hs 2019-04-16 00:57:56.000000000 +0200 +++ new/http-media-0.8.1.0/src/Network/HTTP/Media.hs 2001-09-09 03:46:40.000000000 +0200 @@ -40,10 +40,11 @@ , mapContentLanguage -- * Quality values - , Quality + , Quality (qualityData) , quality , QualityOrder , qualityOrder + , isAcceptable , maxQuality , minQuality , parseQuality @@ -343,16 +344,16 @@ -> Maybe a matchQuality options acceptq = do guard $ not (null options) - Quality m q <- maximumBy (compare `on` fmap qualityOrder) optionsq - guard $ q /= 0 - return m + q <- maximumBy (compare `on` fmap qualityOrder) optionsq + guard $ isAcceptable q + return $ qualityData q where optionsq = reverse $ map addQuality options addQuality opt = withQValue opt <$> foldl' (mfold opt) Nothing acceptq - withQValue opt qv = qv { qualityData = opt } - mfold opt cur acq@(Quality acd _) - | opt `matches` acd = mostSpecific acq <$> cur <|> Just acq - | otherwise = cur + withQValue opt q = q { qualityData = opt } + mfold opt cur q + | opt `matches` qualityData q = mostSpecific q <$> cur <|> Just q + | otherwise = cur ------------------------------------------------------------------------------ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-media-0.8.0.0/test/Network/HTTP/Media/Accept/Tests.hs new/http-media-0.8.1.0/test/Network/HTTP/Media/Accept/Tests.hs --- old/http-media-0.8.0.0/test/Network/HTTP/Media/Accept/Tests.hs 2019-04-16 00:57:56.000000000 +0200 +++ new/http-media-0.8.1.0/test/Network/HTTP/Media/Accept/Tests.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,15 +1,15 @@ ------------------------------------------------------------------------------ module Network.HTTP.Media.Accept.Tests (tests) where -import Test.Framework (Test, testGroup) -import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) import Network.HTTP.Media.Accept import Network.HTTP.Media.Gen ------------------------------------------------------------------------------ -tests :: [Test] +tests :: [TestTree] tests = [ testMatches , testMoreSpecificThan @@ -17,7 +17,7 @@ ------------------------------------------------------------------------------ -testMatches :: Test +testMatches :: TestTree testMatches = testGroup "matches" [ testProperty "Does match" $ do string <- genByteString @@ -32,6 +32,6 @@ ------------------------------------------------------------------------------ -- | Note that this test never actually generates any strings, as they are not -- required for the 'moreSpecificThan' test. -testMoreSpecificThan :: Test +testMoreSpecificThan :: TestTree testMoreSpecificThan = testProperty "moreSpecificThan" $ (not .) . moreSpecificThan <$> genByteString <*> genByteString diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-media-0.8.0.0/test/Network/HTTP/Media/Charset/Tests.hs new/http-media-0.8.1.0/test/Network/HTTP/Media/Charset/Tests.hs --- old/http-media-0.8.0.0/test/Network/HTTP/Media/Charset/Tests.hs 2019-04-16 00:57:56.000000000 +0200 +++ new/http-media-0.8.1.0/test/Network/HTTP/Media/Charset/Tests.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,22 +1,22 @@ ------------------------------------------------------------------------------ module Network.HTTP.Media.Charset.Tests (tests) where -import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.Char8 as BS -import Control.Monad (join) -import Data.String (fromString) -import Test.Framework (Test, testGroup) -import Test.Framework.Providers.QuickCheck2 (testProperty) -import Test.QuickCheck ((===)) +import Control.Monad (join) +import Data.String (fromString) +import Test.QuickCheck ((===)) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) import Network.HTTP.Media.Accept -import Network.HTTP.Media.Charset (Charset) +import Network.HTTP.Media.Charset (Charset) import Network.HTTP.Media.Charset.Gen import Network.HTTP.Media.RenderHeader ------------------------------------------------------------------------------ -tests :: [Test] +tests :: [TestTree] tests = [ testEq , testShow @@ -29,7 +29,7 @@ ------------------------------------------------------------------------------ -- Equality is derived, but we test it here to get 100% coverage. -testEq :: Test +testEq :: TestTree testEq = testGroup "Eq" [ testProperty "==" $ do enc <- genCharset @@ -42,21 +42,21 @@ ------------------------------------------------------------------------------ -testShow :: Test +testShow :: TestTree testShow = testProperty "show" $ do enc <- genCharset return $ parseAccept (BS.pack $ show enc) === Just enc ------------------------------------------------------------------------------ -testFromString :: Test +testFromString :: TestTree testFromString = testProperty "fromString" $ do enc <- genCharset return $ enc === fromString (show enc) ------------------------------------------------------------------------------ -testMatches :: Test +testMatches :: TestTree testMatches = testGroup "matches" [ testProperty "Equal values match" $ join matches <$> genCharset @@ -68,7 +68,7 @@ ------------------------------------------------------------------------------ -testMoreSpecific :: Test +testMoreSpecific :: TestTree testMoreSpecific = testGroup "moreSpecificThan" [ testProperty "Against *" $ flip moreSpecificThan anything <$> genConcreteCharset @@ -80,7 +80,7 @@ ------------------------------------------------------------------------------ -testParseAccept :: Test +testParseAccept :: TestTree testParseAccept = testGroup "parseAccept" [ testProperty "Empty" $ parseAccept "" === (Nothing :: Maybe Charset) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-media-0.8.0.0/test/Network/HTTP/Media/Encoding/Tests.hs new/http-media-0.8.1.0/test/Network/HTTP/Media/Encoding/Tests.hs --- old/http-media-0.8.0.0/test/Network/HTTP/Media/Encoding/Tests.hs 2019-04-16 00:57:56.000000000 +0200 +++ new/http-media-0.8.1.0/test/Network/HTTP/Media/Encoding/Tests.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,13 +1,13 @@ ------------------------------------------------------------------------------ module Network.HTTP.Media.Encoding.Tests (tests) where -import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.Char8 as BS -import Control.Monad (join) -import Data.String (fromString) -import Test.Framework (Test, testGroup) -import Test.Framework.Providers.QuickCheck2 (testProperty) -import Test.QuickCheck ((===)) +import Control.Monad (join) +import Data.String (fromString) +import Test.QuickCheck ((===)) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) import Network.HTTP.Media.Accept import Network.HTTP.Media.Encoding.Gen @@ -15,7 +15,7 @@ ------------------------------------------------------------------------------ -tests :: [Test] +tests :: [TestTree] tests = [ testEq , testShow @@ -28,7 +28,7 @@ ------------------------------------------------------------------------------ -- Equality is derived, but we test it here to get 100% coverage. -testEq :: Test +testEq :: TestTree testEq = testGroup "Eq" [ testProperty "==" $ do enc <- genEncoding @@ -41,21 +41,21 @@ ------------------------------------------------------------------------------ -testShow :: Test +testShow :: TestTree testShow = testProperty "show" $ do enc <- genEncoding return $ parseAccept (BS.pack $ show enc) === Just enc ------------------------------------------------------------------------------ -testFromString :: Test +testFromString :: TestTree testFromString = testProperty "fromString" $ do enc <- genEncoding return $ enc === fromString (show enc) ------------------------------------------------------------------------------ -testMatches :: Test +testMatches :: TestTree testMatches = testGroup "matches" [ testProperty "Equal values match" $ join matches <$> genEncoding @@ -67,7 +67,7 @@ ------------------------------------------------------------------------------ -testMoreSpecific :: Test +testMoreSpecific :: TestTree testMoreSpecific = testGroup "moreSpecificThan" [ testProperty "Against *" $ flip moreSpecificThan anything <$> genConcreteEncoding @@ -79,7 +79,7 @@ ------------------------------------------------------------------------------ -testParseAccept :: Test +testParseAccept :: TestTree testParseAccept = testGroup "parseAccept" [ testProperty "Empty" $ parseAccept "" === Just identity diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-media-0.8.0.0/test/Network/HTTP/Media/Language/Gen.hs new/http-media-0.8.1.0/test/Network/HTTP/Media/Language/Gen.hs --- old/http-media-0.8.0.0/test/Network/HTTP/Media/Language/Gen.hs 2019-04-16 00:57:56.000000000 +0200 +++ new/http-media-0.8.1.0/test/Network/HTTP/Media/Language/Gen.hs 2001-09-09 03:46:40.000000000 +0200 @@ -55,14 +55,14 @@ -- | Generate a Language that has the given language as a prefix. genMatchingLanguage :: Language -> Gen Language genMatchingLanguage (Language pre) = - (Language . (pre ++)) <$> listOf genCIByteString + Language . (pre ++) <$> listOf genCIByteString ------------------------------------------------------------------------------ -- | Generate a Language that has the given language as a proper prefix. genDiffMatchingLanguage :: Language -> Gen Language genDiffMatchingLanguage (Language pre) = - (Language . (pre ++)) <$> listOf1 genCIByteString + Language . (pre ++) <$> listOf1 genCIByteString ------------------------------------------------------------------------------ @@ -105,7 +105,7 @@ ------------------------------------------------------------------------------ genCIByteString :: Gen (CI ByteString) -genCIByteString = resize 8 $ Gen.genCIByteString +genCIByteString = resize 8 Gen.genCIByteString ------------------------------------------------------------------------------ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-media-0.8.0.0/test/Network/HTTP/Media/Language/Tests.hs new/http-media-0.8.1.0/test/Network/HTTP/Media/Language/Tests.hs --- old/http-media-0.8.0.0/test/Network/HTTP/Media/Language/Tests.hs 2019-04-16 00:57:56.000000000 +0200 +++ new/http-media-0.8.1.0/test/Network/HTTP/Media/Language/Tests.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,14 +1,14 @@ ------------------------------------------------------------------------------ module Network.HTTP.Media.Language.Tests (tests) where -import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.Char8 as BS -import Control.Monad (join) -import Data.Monoid ((<>)) -import Data.String (fromString) -import Test.Framework (Test, testGroup) -import Test.Framework.Providers.QuickCheck2 (testProperty) -import Test.QuickCheck ((===)) +import Control.Monad (join) +import Data.Monoid ((<>)) +import Data.String (fromString) +import Test.QuickCheck ((===)) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) import Network.HTTP.Media.Accept import Network.HTTP.Media.Language @@ -17,7 +17,7 @@ ------------------------------------------------------------------------------ -tests :: [Test] +tests :: [TestTree] tests = [ testEq , testShow @@ -30,7 +30,7 @@ ------------------------------------------------------------------------------ -- Equality is derived, but we test it here to get 100% coverage. -testEq :: Test +testEq :: TestTree testEq = testGroup "Eq" [ testProperty "==" $ do lang <- genLanguage @@ -43,21 +43,21 @@ ------------------------------------------------------------------------------ -testShow :: Test +testShow :: TestTree testShow = testProperty "show" $ do lang <- genLanguage return $ parseAccept (BS.pack $ show lang) === Just lang ------------------------------------------------------------------------------ -testFromString :: Test +testFromString :: TestTree testFromString = testProperty "fromString" $ do lang <- genLanguage return $ lang === fromString (show lang) ------------------------------------------------------------------------------ -testMatches :: Test +testMatches :: TestTree testMatches = testGroup "matches" [ testProperty "Equal values match" $ join matches <$> genLanguage @@ -73,7 +73,7 @@ ------------------------------------------------------------------------------ -testMoreSpecific :: Test +testMoreSpecific :: TestTree testMoreSpecific = testGroup "moreSpecificThan" [ testProperty "Against *" $ flip moreSpecificThan anything <$> genConcreteLanguage @@ -89,7 +89,7 @@ ------------------------------------------------------------------------------ -testParseAccept :: Test +testParseAccept :: TestTree testParseAccept = testGroup "parseAccept" [ testProperty "Valid parse"$ do lang <- genLanguage diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-media-0.8.0.0/test/Network/HTTP/Media/MediaType/Gen.hs new/http-media-0.8.1.0/test/Network/HTTP/Media/MediaType/Gen.hs --- old/http-media-0.8.0.0/test/Network/HTTP/Media/MediaType/Gen.hs 2019-04-16 00:57:56.000000000 +0200 +++ new/http-media-0.8.1.0/test/Network/HTTP/Media/MediaType/Gen.hs 2001-09-09 03:46:40.000000000 +0200 @@ -29,7 +29,7 @@ import qualified Data.Map as Map -import Control.Monad (filterM, liftM, liftM2) +import Control.Monad (filterM, liftM2) import Data.ByteString (ByteString) import Data.CaseInsensitive (CI, original) import Data.Foldable (foldlM) @@ -103,8 +103,7 @@ genWithParams = do main <- genCIByteString sub <- genCIByteString - params <- genParameters - return $ MediaType main sub params + MediaType main sub <$> genParameters ------------------------------------------------------------------------------ @@ -146,7 +145,7 @@ ------------------------------------------------------------------------------ -- | Reuse for 'mayParams' and 'someParams'. mkGenParams :: (Gen ParamEntry -> Gen [ParamEntry]) -> Gen Parameters -mkGenParams = liftM fromList . +mkGenParams = fmap fromList . ($ liftM2 (,) (genDiffCIByteString "q") genCIByteString) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-media-0.8.0.0/test/Network/HTTP/Media/MediaType/Tests.hs new/http-media-0.8.1.0/test/Network/HTTP/Media/MediaType/Tests.hs --- old/http-media-0.8.0.0/test/Network/HTTP/Media/MediaType/Tests.hs 2019-04-16 00:57:56.000000000 +0200 +++ new/http-media-0.8.1.0/test/Network/HTTP/Media/MediaType/Tests.hs 2001-09-09 03:46:40.000000000 +0200 @@ -4,15 +4,15 @@ import qualified Data.ByteString.Char8 as BS import qualified Data.Map as Map -import Control.Monad (join, liftM) +import Control.Monad (join) import Data.ByteString (ByteString) import Data.CaseInsensitive (foldedCase) import Data.Monoid ((<>)) import Data.String (fromString) -import Test.Framework (Test, testGroup) -import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck (property, (.&&.), (===)) import Test.QuickCheck.Gen (Gen) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) import Network.HTTP.Media.Accept import Network.HTTP.Media.Gen @@ -23,7 +23,7 @@ ------------------------------------------------------------------------------ -tests :: [Test] +tests :: [TestTree] tests = [ testEq , testShow @@ -38,7 +38,7 @@ ------------------------------------------------------------------------------ -- Equality is derived, but we test it here to get 100% coverage. -testEq :: Test +testEq :: TestTree testEq = testGroup "Eq" [ testProperty "==" $ do media <- genMediaType @@ -51,34 +51,34 @@ ------------------------------------------------------------------------------ -testShow :: Test +testShow :: TestTree testShow = testProperty "show" $ do media <- genMediaType return $ parseAccept (BS.pack $ show media) === Just media ------------------------------------------------------------------------------ -testFromString :: Test +testFromString :: TestTree testFromString = testProperty "fromString" $ do media <- genMediaType return $ media === fromString (show media) ------------------------------------------------------------------------------ -testHas :: Test +testHas :: TestTree testHas = testGroup "(/?)" [ testProperty "True for property it has" $ do media <- genWithParams return $ all ((media /?) . foldedCase) (Map.keys $ parameters media) , testProperty "False for property it doesn't have" $ do media <- genWithParams - return $ all (not . (stripParams media /?) . foldedCase) + return . not $ any ((stripParams media /?) . foldedCase) (Map.keys $ parameters media) ] ------------------------------------------------------------------------------ -testGet :: Test +testGet :: TestTree testGet = testGroup "(/.)" [ testProperty "Retrieves property it has" $ do media <- genWithParams @@ -92,7 +92,7 @@ ------------------------------------------------------------------------------ -testMatches :: Test +testMatches :: TestTree testMatches = testGroup "matches" [ testProperty "Equal values match" $ do media <- genMediaType @@ -108,7 +108,7 @@ return . not $ matches media media { subType = sub } || matches media { subType = sub } media , testProperty "Different parameters don't match" $ - liftM (not . dotJoin matches stripParams) genWithParams + not . dotJoin matches stripParams <$> genWithParams , testProperty "Missing parameters match" $ do media <- genWithParams let media' = stripParams media @@ -116,33 +116,33 @@ , testGroup "*/*" [ testProperty "Matches itself" $ matches anything anything , testProperty "Matches anything on the right" $ - liftM (`matches` anything) genMediaType + (`matches` anything) <$> genMediaType , testProperty "Doesn't match more specific on the left" $ - liftM (not . matches anything) genMaybeSubStar + not . (anything `matches`) <$> genMaybeSubStar ] , testGroup "type/*" - [ testProperty "Matches itself" $ liftM (join matches) genSubStar + [ testProperty "Matches itself" $ join matches <$> genSubStar , testProperty "Matches on the right" $ - liftM (dotJoin (flip matches) subStarOf) genConcreteMediaType + dotJoin (flip matches) subStarOf <$> genConcreteMediaType , testProperty "Doesn't match on the left" $ - liftM (not . dotJoin matches subStarOf) genConcreteMediaType + not . dotJoin matches subStarOf <$> genConcreteMediaType ] ] ------------------------------------------------------------------------------ -testMoreSpecificThan :: Test +testMoreSpecificThan :: TestTree testMoreSpecificThan = testGroup "moreSpecificThan" [ testProperty "Against */*" $ - liftM (`moreSpecificThan` anything) genMaybeSubStar + (`moreSpecificThan` anything) <$> genMaybeSubStar , testProperty "With */*" $ - liftM (not . moreSpecificThan anything) genMaybeSubStar + not . (anything `moreSpecificThan`) <$> genMaybeSubStar , testProperty "Against type/*" $ - liftM (dotJoin (flip moreSpecificThan) subStarOf) genConcreteMediaType + dotJoin (flip moreSpecificThan) subStarOf <$> genConcreteMediaType , testProperty "With type/*" $ - liftM (not . dotJoin moreSpecificThan subStarOf) genConcreteMediaType + not . dotJoin moreSpecificThan subStarOf <$> genConcreteMediaType , testProperty "With parameters" $ - liftM (dotJoin (flip moreSpecificThan) stripParams) genWithParams + dotJoin (flip moreSpecificThan) stripParams <$> genWithParams , testProperty "Different types" $ do media <- genWithoutParams media' <- genDiffMediaTypeWith genWithoutParams media @@ -156,7 +156,7 @@ ------------------------------------------------------------------------------ -testParseAccept :: Test +testParseAccept :: TestTree testParseAccept = testGroup "parseAccept" [ testProperty "Valid parse" $ do media <- genMediaType diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-media-0.8.0.0/test/Network/HTTP/Media/Tests.hs new/http-media-0.8.1.0/test/Network/HTTP/Media/Tests.hs --- old/http-media-0.8.0.0/test/Network/HTTP/Media/Tests.hs 2019-04-16 00:57:56.000000000 +0200 +++ new/http-media-0.8.1.0/test/Network/HTTP/Media/Tests.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,3 +1,5 @@ +{-# LANGUAGE TupleSections #-} + ------------------------------------------------------------------------------ module Network.HTTP.Media.Tests (tests) where @@ -8,9 +10,9 @@ import Data.Map (empty) import Data.Monoid ((<>)) import Data.Word (Word16) -import Test.Framework (Test, testGroup) -import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) import Network.HTTP.Media hiding (parameters, subType) @@ -21,7 +23,7 @@ ------------------------------------------------------------------------------ -tests :: [Test] +tests :: [TestTree] tests = [ testParse , testMatchAccept @@ -34,7 +36,7 @@ ------------------------------------------------------------------------------ -testParse :: Test +testParse :: TestTree testParse = testGroup "parseQuality" [ testProperty "Without quality" $ do media <- medias @@ -64,17 +66,17 @@ ------------------------------------------------------------------------------ -testMatchAccept :: Test +testMatchAccept :: TestTree testMatchAccept = testMatch "Accept" matchAccept renderHeader ------------------------------------------------------------------------------ -testMapAccept :: Test +testMapAccept :: TestTree testMapAccept = testMap "Accept" mapAccept renderHeader ------------------------------------------------------------------------------ -testMatchContent :: Test +testMatchContent :: TestTree testMatchContent = testGroup "matchContent" [ testProperty "Matches" $ do media <- genMediaType @@ -95,7 +97,7 @@ ------------------------------------------------------------------------------ -testMapContent :: Test +testMapContent :: TestTree testMapContent = testGroup "mapContent" [ testProperty "Matches" $ do media <- genMediaType @@ -108,12 +110,12 @@ ------------------------------------------------------------------------------ -testMatchQuality :: Test +testMatchQuality :: TestTree testMatchQuality = testMatch "Quality" matchQuality id ------------------------------------------------------------------------------ -testMapQuality :: Test +testMapQuality :: TestTree testMapQuality = testMap "Quality" mapQuality id @@ -122,7 +124,7 @@ :: String -> ([MediaType] -> a -> Maybe MediaType) -> ([Quality MediaType] -> a) - -> Test + -> TestTree testMatch name match qToI = testGroup ("match" ++ name) [ testProperty "Most specific" $ do media <- genConcreteMediaType @@ -158,7 +160,7 @@ testQuality :: ([MediaType] -> a -> Maybe MediaType) -> ([Quality MediaType] -> a) - -> Test + -> TestTree testQuality match qToI = testGroup "Quality" [ testProperty "Highest quality" $ do server <- genServer @@ -180,7 +182,7 @@ testQ0 :: ([MediaType] -> a -> Maybe MediaType) -> ([Quality MediaType] -> a) - -> Test + -> TestTree testQ0 match qToI = testGroup "q=0" [ testProperty "Does not choose a q=0" $ do server <- genConcreteMediaType @@ -212,7 +214,7 @@ :: String -> ([(MediaType, MediaType)] -> a -> Maybe MediaType) -> ([Quality MediaType] -> a) - -> Test + -> TestTree testMap name mapf qToI = testGroup ("map" ++ name) [ testProperty "Matches" $ do server <- genServer @@ -224,7 +226,7 @@ Just (qualityData $ foldr1 qmax client) , testProperty "Nothing" $ do (server, client) <- genServerAndClient - let zipped = zip server $ repeat "*/*" + let zipped = map (, "*/*") server return $ mapf zipped (qToI $ map maxQuality client) === Nothing ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-media-0.8.0.0/test/Test.hs new/http-media-0.8.1.0/test/Test.hs --- old/http-media-0.8.0.0/test/Test.hs 2019-04-16 00:57:56.000000000 +0200 +++ new/http-media-0.8.1.0/test/Test.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ module Main (main) where -import Test.Framework (defaultMain, testGroup) +import Test.Tasty (defaultMain, testGroup) import qualified Network.HTTP.Media.Accept.Tests as Accept import qualified Network.HTTP.Media.Charset.Tests as Charset @@ -13,7 +13,7 @@ ------------------------------------------------------------------------------ main :: IO () -main = defaultMain +main = defaultMain $ testGroup "http-media" [ testGroup "Accept" Accept.tests , testGroup "Charset" Charset.tests , testGroup "Encoding" Encoding.tests
