From e6fe4424d58465e7fe030dbc6f6de22d0cbc1d53 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 8 May 2020 13:16:35 +0300 Subject: [PATCH] Add Described PackageVersionConstraint First step towards https://github.com/haskell/cabal/issues/5570 --- .../src/Test/QuickCheck/Instances/Cabal.hs | 24 +++++++++-- .../Types/PackageVersionConstraint.hs | 42 +++++++++++++++---- .../tests/UnitTests/Distribution/Described.hs | 17 ++++---- .../Distribution/Client/ArbitraryInstances.hs | 5 --- 4 files changed, 65 insertions(+), 23 deletions(-) diff --git a/Cabal/Cabal-quickcheck/src/Test/QuickCheck/Instances/Cabal.hs b/Cabal/Cabal-quickcheck/src/Test/QuickCheck/Instances/Cabal.hs index 0c3d9affd2c..d2ef7fd86e7 100644 --- a/Cabal/Cabal-quickcheck/src/Test/QuickCheck/Instances/Cabal.hs +++ b/Cabal/Cabal-quickcheck/src/Test/QuickCheck/Instances/Cabal.hs @@ -9,20 +9,22 @@ import Distribution.Utils.Generic (lowercase) import Test.QuickCheck import Distribution.CabalSpecVersion -import Distribution.Simple.Flag (Flag (..)) +import Distribution.ModuleName +import Distribution.Parsec.Newtypes +import Distribution.Simple.Flag (Flag (..)) import Distribution.SPDX import Distribution.System import Distribution.Types.Dependency -import Distribution.Types.Flag (FlagAssignment, FlagName, mkFlagName, mkFlagAssignment) +import Distribution.Types.Flag + (FlagAssignment, FlagName, mkFlagAssignment, mkFlagName) import Distribution.Types.LibraryName import Distribution.Types.PackageName +import Distribution.Types.PackageVersionConstraint import Distribution.Types.SourceRepo import Distribution.Types.UnqualComponentName -import Distribution.ModuleName import Distribution.Types.VersionRange.Internal import Distribution.Verbosity import Distribution.Version -import Distribution.Parsec.Newtypes #if !MIN_VERSION_base(4,8,0) import Control.Applicative (pure, (<$>), (<*>)) @@ -169,6 +171,20 @@ instance Arbitrary Dependency where | (pn', vr', lb') <- shrink (pn, vr, lb) ] +------------------------------------------------------------------------------- +-- PackageVersionConstraint +------------------------------------------------------------------------------- + +instance Arbitrary PackageVersionConstraint where + arbitrary = PackageVersionConstraint + <$> arbitrary + <*> arbitrary + + shrink (PackageVersionConstraint pn vr) = + [ PackageVersionConstraint pn' vr' + | (pn', vr') <- shrink (pn, vr) + ] + ------------------------------------------------------------------------------- -- System ------------------------------------------------------------------------------- diff --git a/Cabal/Distribution/Types/PackageVersionConstraint.hs b/Cabal/Distribution/Types/PackageVersionConstraint.hs index 41347e844ee..60b4f02f8e9 100644 --- a/Cabal/Distribution/Types/PackageVersionConstraint.hs +++ b/Cabal/Distribution/Types/PackageVersionConstraint.hs @@ -10,7 +10,10 @@ import Prelude () import Distribution.Parsec import Distribution.Pretty import Distribution.Types.PackageName -import Distribution.Types.VersionRange +import Distribution.Types.PackageId +import Distribution.Types.Version +import Distribution.Types.VersionRange.Internal +import Distribution.FieldGrammar.Described import qualified Distribution.Compat.CharParsing as P import Text.PrettyPrint ((<+>)) @@ -28,13 +31,38 @@ instance Structured PackageVersionConstraint instance NFData PackageVersionConstraint where rnf = genericRnf instance Pretty PackageVersionConstraint where - pretty (PackageVersionConstraint name ver) = pretty name <+> pretty ver + pretty (PackageVersionConstraint name (ThisVersion ver)) = + pretty (PackageIdentifier name ver) + pretty (PackageVersionConstraint name ver) = + pretty name <+> pretty ver +-- | +-- +-- >>> simpleParsec "foo" :: Maybe PackageVersionConstraint +-- Just (PackageVersionConstraint (PackageName "foo") (OrLaterVersion (mkVersion [0]))) +-- +-- >>> simpleParsec "foo >=2.0" :: Maybe PackageVersionConstraint +-- Just (PackageVersionConstraint (PackageName "foo") (OrLaterVersion (mkVersion [2,0]))) +-- +-- >>> simpleParsec "foo-2.0" :: Maybe PackageVersionConstraint +-- Just (PackageVersionConstraint (PackageName "foo") (ThisVersion (mkVersion [2,0]))) +-- instance Parsec PackageVersionConstraint where parsec = do - name <- parsec - P.spaces - ver <- parsec <|> return anyVersion - P.spaces - return (PackageVersionConstraint name ver) + PackageIdentifier name ver <- parsec + if ver == nullVersion + then do + P.spaces + vr <- parsec <|> return anyVersion + P.spaces + return (PackageVersionConstraint name vr) + else + pure (PackageVersionConstraint name (thisVersion ver)) +instance Described PackageVersionConstraint where + describe _ = describe (Proxy :: Proxy PackageName) <> REUnion + [ fromString "-" <> describe (Proxy :: Proxy Version) + -- TODO: change to RESpaces when -any and -none are removed + -- Related https://github.com/haskell/cabal/issues/6760 + , RESpaces1 <> describe (Proxy :: Proxy VersionRange) + ] diff --git a/Cabal/tests/UnitTests/Distribution/Described.hs b/Cabal/tests/UnitTests/Distribution/Described.hs index a5741e8acac..001fb032d9a 100644 --- a/Cabal/tests/UnitTests/Distribution/Described.hs +++ b/Cabal/tests/UnitTests/Distribution/Described.hs @@ -11,18 +11,20 @@ import Test.QuickCheck (Arbitrary (..), Gen, Property, choose, counterexam import Test.Tasty (TestTree, testGroup) import Test.Tasty.QuickCheck (testProperty) -import Distribution.FieldGrammar.Described (Described (..), GrammarRegex (..), reComma, reSpacedComma, reSpacedList) +import Distribution.FieldGrammar.Described + (Described (..), GrammarRegex (..), reComma, reSpacedComma, reSpacedList) import Distribution.Parsec (eitherParsec) import Distribution.Pretty (prettyShow) import qualified Distribution.Utils.CharSet as CS -import Distribution.ModuleName (ModuleName) -import Distribution.Types.Dependency (Dependency) -import Distribution.Types.Flag (FlagName) -import Distribution.Types.PackageName (PackageName) -import Distribution.Types.Version (Version) -import Distribution.Types.VersionRange (VersionRange) +import Distribution.ModuleName (ModuleName) +import Distribution.Types.Dependency (Dependency) +import Distribution.Types.Flag (FlagName) +import Distribution.Types.PackageName (PackageName) +import Distribution.Types.PackageVersionConstraint (PackageVersionConstraint) +import Distribution.Types.Version (Version) +import Distribution.Types.VersionRange (VersionRange) import qualified RERE as RE import qualified RERE.CharSet as RE @@ -34,6 +36,7 @@ tests :: TestTree tests = testGroup "Described" [ testDescribed (Proxy :: Proxy Dependency) , testDescribed (Proxy :: Proxy PackageName) + , testDescribed (Proxy :: Proxy PackageVersionConstraint) , testDescribed (Proxy :: Proxy Version) , testDescribed (Proxy :: Proxy VersionRange) , testDescribed (Proxy :: Proxy FlagName) diff --git a/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs b/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs index 0d6833a4eca..7ec131017e5 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs @@ -20,8 +20,6 @@ module UnitTests.Distribution.Client.ArbitraryInstances ( import Distribution.Client.Compat.Prelude import Prelude () -import Distribution.Types.PackageVersionConstraint - import Distribution.Simple.InstallDirs import Distribution.Simple.Setup @@ -139,9 +137,6 @@ instance Arbitrary ShortToken where arbitraryShortToken :: Gen String arbitraryShortToken = getShortToken <$> arbitrary -instance Arbitrary PackageVersionConstraint where - arbitrary = PackageVersionConstraint <$> arbitrary <*> arbitrary - instance (Arbitrary a, Ord a) => Arbitrary (NubList a) where arbitrary = toNubList <$> arbitrary shrink xs = [ toNubList [] | (not . null) (fromNubList xs) ]