Commit 2c27ddfc authored by Oleg Grenrus's avatar Oleg Grenrus

Add Described PackageVersionConstraint

First step towards https://github.com/haskell/cabal/issues/5570
parent 72a3962a
......@@ -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
-------------------------------------------------------------------------------
......
......@@ -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,41 @@ instance Structured PackageVersionConstraint
instance NFData PackageVersionConstraint where rnf = genericRnf
instance Pretty PackageVersionConstraint where
pretty (PackageVersionConstraint name ver) = pretty name <+> pretty ver
-- Cannot do: PackageVersionConstraint have to be parseable
-- as Dependency, due roundtrip problems. (e.g. talking to old ./Setup).
--
-- 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)
]
......@@ -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)
......
......@@ -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) ]
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment