From e45b013fd0fb7a56c41d55ea91bf2cf73cf9a2c9 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 16 Mar 2020 13:55:36 +0200 Subject: [PATCH] Add Described to IndexState (incl. tests). - Writing a regex to parse dates is awful. - Add ShortText conversions to PackageName and UnqualComponentName - Add mkDependency, which maintains the invariant - Remove VersionRangeParens - it's not preserved by parsec . pretty roundtrip - Move moree instances into Cabal-quickcheck, use the package in cabal-install tests --- .../src/Test/QuickCheck/Instances/Cabal.hs | 73 ++++++++- Cabal/Distribution/Types/Dependency.hs | 120 ++++++++------ Cabal/Distribution/Types/PackageName.hs | 17 +- .../Distribution/Types/UnqualComponentName.hs | 10 +- Cabal/Distribution/Types/VersionRange.hs | 8 +- .../Types/VersionRange/Internal.hs | 11 +- .../ParserTests/regressions/encoding-0.8.expr | 18 +-- .../regressions/encoding-0.8.format | 2 +- .../tests/UnitTests/Distribution/Described.hs | 23 ++- .../Distribution/Utils/Structured.hs | 4 +- Cabal/tests/UnitTests/Distribution/Version.hs | 15 +- .../Client/IndexUtils/Timestamp.hs | 122 ++++++++++++++ cabal-install/Distribution/Deprecated/Text.hs | 3 +- cabal-install/cabal-install.cabal.pp | 3 + cabal-install/tests/UnitTests.hs | 2 + .../Distribution/Client/ArbitraryInstances.hs | 122 ++------------ .../Distribution/Client/Described.hs | 150 ++++++++++++++++++ cabal.project.validate | 2 + 18 files changed, 501 insertions(+), 204 deletions(-) create mode 100644 cabal-install/tests/UnitTests/Distribution/Client/Described.hs diff --git a/Cabal/Cabal-quickcheck/src/Test/QuickCheck/Instances/Cabal.hs b/Cabal/Cabal-quickcheck/src/Test/QuickCheck/Instances/Cabal.hs index 621d0a3a73c..5ccdc171d79 100644 --- a/Cabal/Cabal-quickcheck/src/Test/QuickCheck/Instances/Cabal.hs +++ b/Cabal/Cabal-quickcheck/src/Test/QuickCheck/Instances/Cabal.hs @@ -9,8 +9,14 @@ import Test.QuickCheck import Distribution.SPDX import Distribution.Version +import Distribution.Types.Dependency +import Distribution.Types.UnqualComponentName +import Distribution.Simple.Flag (Flag (..)) +import Distribution.Types.LibraryName import Distribution.Types.PackageName import Distribution.Types.VersionRange.Internal +import Distribution.System +import Distribution.Verbosity #if !MIN_VERSION_base(4,8,0) import Control.Applicative (pure, (<$>), (<*>)) @@ -64,7 +70,6 @@ instance Arbitrary VersionRange where , (1, fmap orEarlierVersion' arbitrary) , (1, fmap withinVersion arbitrary) , (1, fmap majorBoundVersion arbitrary) - , (2, fmap VersionRangeParens arbitrary) ] ++ if n == 0 then [] else [ (2, liftA2 unionVersionRanges verRangeExp2 verRangeExp2) , (2, liftA2 intersectVersionRanges verRangeExp2 verRangeExp2) @@ -85,7 +90,6 @@ instance Arbitrary VersionRange where shrink (OrEarlierVersion v) = EarlierVersion v : map OrEarlierVersion (shrink v) shrink (WildcardVersion v) = map WildcardVersion ( shrink v) shrink (MajorBoundVersion v) = map MajorBoundVersion (shrink v) - shrink (VersionRangeParens vr) = vr : map VersionRangeParens (shrink vr) shrink (UnionVersionRanges a b) = a : b : map (uncurry UnionVersionRanges) (shrink (a, b)) shrink (IntersectVersionRanges a b) = a : b : map (uncurry IntersectVersionRanges) (shrink (a, b)) @@ -122,6 +126,71 @@ instance Arbitrary VersionIntervals where instance Arbitrary Bound where arbitrary = elements [ExclusiveBound, InclusiveBound] +------------------------------------------------------------------------------- +-- Dependency +------------------------------------------------------------------------------- + +instance Arbitrary Dependency where + arbitrary = mkDependency + <$> arbitrary + <*> arbitrary + <*> (arbitrary `suchThat` const True) -- should be (not . null) + + shrink (Dependency pn vr lb) = + [ mkDependency pn' vr' lb' + | (pn', vr', lb') <- shrink (pn, vr, lb) + ] + +------------------------------------------------------------------------------- +-- System +------------------------------------------------------------------------------- + +instance Arbitrary OS where + arbitrary = elements knownOSs + +instance Arbitrary Arch where + arbitrary = elements knownArches + +instance Arbitrary Platform where + arbitrary = Platform <$> arbitrary <*> arbitrary + +------------------------------------------------------------------------------- +-- Various names +------------------------------------------------------------------------------- + +instance Arbitrary UnqualComponentName where + -- same rules as package names + arbitrary = packageNameToUnqualComponentName <$> arbitrary + +instance Arbitrary LibraryName where + arbitrary = oneof + [ LSubLibName <$> arbitrary + , pure LMainLibName + ] + + shrink (LSubLibName _) = [LMainLibName] + shrink _ = [] + +instance Arbitrary a => Arbitrary (Flag a) where + arbitrary = arbitrary1 + + shrink NoFlag = [] + shrink (Flag x) = NoFlag : [ Flag x' | x' <- shrink x ] + +instance Arbitrary1 Flag where + liftArbitrary genA = sized $ \sz -> + if sz <= 0 + then pure NoFlag + else frequency [ (1, pure NoFlag) + , (3, Flag <$> genA) ] + +------------------------------------------------------------------------------- +-- Verbosity +------------------------------------------------------------------------------- + +instance Arbitrary Verbosity where + arbitrary = elements [minBound..maxBound] + ------------------------------------------------------------------------------- -- SPDX ------------------------------------------------------------------------------- diff --git a/Cabal/Distribution/Types/Dependency.hs b/Cabal/Distribution/Types/Dependency.hs index 561b48d629e..d1a05308c10 100644 --- a/Cabal/Distribution/Types/Dependency.hs +++ b/Cabal/Distribution/Types/Dependency.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} module Distribution.Types.Dependency ( Dependency(..) + , mkDependency , depPkgName , depVerRange , depLibraries @@ -33,6 +34,9 @@ import qualified Text.PrettyPrint as PP -- | Describes a dependency on a source package (API) -- +-- /Invariant:/ package name does not appear as 'LSubLibName' in +-- set of library names. +-- data Dependency = Dependency PackageName VersionRange @@ -51,35 +55,37 @@ depVerRange (Dependency _ vr _) = vr depLibraries :: Dependency -> Set LibraryName depLibraries (Dependency _ _ cs) = cs +-- | Smart constructor of 'Dependency'. +-- +-- If 'PackageName' is appears as 'LSubLibName' in a set of sublibraries, +-- it is automatically converted to 'LMainLibName'. +-- +-- @since 3.4.0.0 +-- +mkDependency :: PackageName -> VersionRange -> Set LibraryName -> Dependency +mkDependency pn vr lb = Dependency pn vr (Set.map conv lb) + where + pn' = packageNameToUnqualComponentName pn + + conv l@LMainLibName = l + conv l@(LSubLibName ln) | ln == pn' = LMainLibName + | otherwise = l + instance Binary Dependency instance Structured Dependency instance NFData Dependency where rnf = genericRnf instance Pretty Dependency where - pretty (Dependency name ver sublibs) = pretty name - <<>> optionalMonoid - (sublibs /= Set.singleton LMainLibName) - (PP.colon <<>> PP.braces prettySublibs) - <+> pretty ver + pretty (Dependency name ver sublibs) = withSubLibs (pretty name) <+> pretty ver where - optionalMonoid True x = x - optionalMonoid False _ = mempty + withSubLibs doc + | sublibs == mainLib = doc + | otherwise = doc <<>> PP.colon <<>> PP.braces prettySublibs + prettySublibs = PP.hsep $ PP.punctuate PP.comma $ prettySublib <$> Set.toList sublibs - prettySublib LMainLibName = PP.text $ unPackageName name - prettySublib (LSubLibName un) = PP.text $ unUnqualComponentName un -versionGuardMultilibs :: (Monad m, CabalParsing m) => m a -> m a -versionGuardMultilibs expr = do - csv <- askCabalSpecVersion - if csv < CabalSpecV3_0 - then fail $ unwords - [ "Sublibrary dependency syntax used." - , "To use this syntax the package needs to specify at least 'cabal-version: 3.0'." - , "Alternatively, if you are depending on an internal library, you can write" - , "directly the library name as it were a package." - ] - else - expr + prettySublib LMainLibName = PP.text $ unPackageName name + prettySublib (LSubLibName un) = PP.text $ unUnqualComponentName un -- | -- @@ -98,58 +104,77 @@ versionGuardMultilibs expr = do -- >>> simpleParsec "mylib:{ } ^>= 42" :: Maybe Dependency -- Just (Dependency (PackageName "mylib") (MajorBoundVersion (mkVersion [42])) (fromList [])) -- --- Spaces around colon are not allowed: +-- >>> traverse_ print (map simpleParsec ["mylib:mylib", "mylib:{mylib}", "mylib:{mylib,sublib}" ] :: [Maybe Dependency]) +-- Just (Dependency (PackageName "mylib") AnyVersion (fromList [LMainLibName])) +-- Just (Dependency (PackageName "mylib") AnyVersion (fromList [LMainLibName])) +-- Just (Dependency (PackageName "mylib") AnyVersion (fromList [LMainLibName,LSubLibName (UnqualComponentName "sublib")])) -- --- >>> simpleParsec "mylib: sub" :: Maybe Dependency --- Nothing +-- Spaces around colon are not allowed: -- --- >>> simpleParsec "mylib :sub" :: Maybe Dependency --- Nothing +-- >>> map simpleParsec ["mylib: sub", "mylib :sub", "mylib: {sub1,sub2}", "mylib :{sub1,sub2}"] :: [Maybe Dependency] +-- [Nothing,Nothing,Nothing,Nothing] -- --- >>> simpleParsec "mylib: {sub1,sub2}" :: Maybe Dependency --- Nothing +-- Sublibrary syntax is accepted since @cabal-version: 3.0@ -- --- >>> simpleParsec "mylib :{sub1,sub2}" :: Maybe Dependency --- Nothing +-- >>> map (`simpleParsec'` "mylib:sub") [CabalSpecV2_4, CabalSpecV3_0] :: [Maybe Dependency] +-- [Nothing,Just (Dependency (PackageName "mylib") AnyVersion (fromList [LSubLibName (UnqualComponentName "sub")]))] -- instance Parsec Dependency where parsec = do name <- parsec - libs <- option [LMainLibName] - $ (char ':' *>) - $ versionGuardMultilibs - $ pure <$> parseLib name <|> parseMultipleLibs name + libs <- option mainLib $ do + _ <- char ':' + versionGuardMultilibs + Set.singleton <$> parseLib <|> parseMultipleLibs spaces -- https://github.com/haskell/cabal/issues/5846 ver <- parsec <|> pure anyVersion - return $ Dependency name ver $ Set.fromList libs - where makeLib pn ln | unPackageName pn == ln = LMainLibName - | otherwise = LSubLibName $ mkUnqualComponentName ln - parseLib pn = makeLib pn <$> parsecUnqualComponentName - parseMultipleLibs pn = between (char '{' *> spaces) - (spaces <* char '}') - $ parsecCommaList $ parseLib pn + return $ mkDependency name ver libs + where + parseLib = LSubLibName <$> parsec + parseMultipleLibs = between + (char '{' *> spaces) + (spaces *> char '}') + (Set.fromList <$> parsecCommaList parseLib) + +versionGuardMultilibs :: CabalParsing m => m () +versionGuardMultilibs = do + csv <- askCabalSpecVersion + when (csv < CabalSpecV3_0) $ fail $ unwords + [ "Sublibrary dependency syntax used." + , "To use this syntax the package needs to specify at least 'cabal-version: 3.0'." + , "Alternatively, if you are depending on an internal library, you can write" + , "directly the library name as it were a package." + ] + +-- | Library set with main library. +mainLib :: Set LibraryName +mainLib = Set.singleton LMainLibName instance Described Dependency where describe _ = REAppend [ RENamed "pkg-name" (describe (Proxy :: Proxy PackageName)) , REOpt $ - RESpaces - <> reChar ':' - <> RESpaces + reChar ':' <> REUnion [ reUnqualComponent , REAppend [ reChar '{' , RESpaces - , RECommaList reUnqualComponent + -- no leading or trailing comma + , REMunch reSpacedComma reUnqualComponent , RESpaces , reChar '}' ] ] - , REOpt $ RESpaces <> vr + -- TODO: RESpaces1 should be just RESpaces, but we are able + -- to generate non-parseable strings without mandatory space + -- + -- https://github.com/haskell/cabal/issues/6589 + -- + , REOpt $ RESpaces1 <> vr ] where vr = RENamed "version-range" (describe (Proxy :: Proxy VersionRange)) @@ -157,6 +182,9 @@ instance Described Dependency where -- mempty should never be in a Dependency-as-dependency. -- This is only here until the Dependency-as-constraint problem is solved #5570. -- Same for below. +-- +-- Note: parser allows for empty set! +-- thisPackageVersion :: PackageIdentifier -> Dependency thisPackageVersion (PackageIdentifier n v) = Dependency n (thisVersion v) Set.empty diff --git a/Cabal/Distribution/Types/PackageName.hs b/Cabal/Distribution/Types/PackageName.hs index ca2b3fa2495..13846811602 100644 --- a/Cabal/Distribution/Types/PackageName.hs +++ b/Cabal/Distribution/Types/PackageName.hs @@ -2,7 +2,9 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} module Distribution.Types.PackageName - ( PackageName, unPackageName, mkPackageName + ( PackageName + , unPackageName, mkPackageName + , unPackageNameST, mkPackageNameST ) where import Prelude () @@ -29,6 +31,10 @@ newtype PackageName = PackageName ShortText unPackageName :: PackageName -> String unPackageName (PackageName s) = fromShortText s +-- | @since 3.4.0.0 +unPackageNameST :: PackageName -> ShortText +unPackageNameST (PackageName s) = s + -- | Construct a 'PackageName' from a 'String' -- -- 'mkPackageName' is the inverse to 'unPackageName' @@ -40,6 +46,15 @@ unPackageName (PackageName s) = fromShortText s mkPackageName :: String -> PackageName mkPackageName = PackageName . toShortText +-- | Construct a 'PackageName' from a 'ShortText' +-- +-- Note: No validations are performed to ensure that the resulting +-- 'PackageName' is valid +-- +-- @since 3.4.0.0 +mkPackageNameST :: ShortText -> PackageName +mkPackageNameST = PackageName + -- | 'mkPackageName' -- -- @since 2.0.0.2 diff --git a/Cabal/Distribution/Types/UnqualComponentName.hs b/Cabal/Distribution/Types/UnqualComponentName.hs index 09f7bbfec2a..67b1af7d985 100644 --- a/Cabal/Distribution/Types/UnqualComponentName.hs +++ b/Cabal/Distribution/Types/UnqualComponentName.hs @@ -2,7 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Distribution.Types.UnqualComponentName - ( UnqualComponentName, unUnqualComponentName, mkUnqualComponentName + ( UnqualComponentName, unUnqualComponentName, unUnqualComponentNameST, mkUnqualComponentName , packageNameToUnqualComponentName, unqualComponentNameToPackageName ) where @@ -32,6 +32,10 @@ newtype UnqualComponentName = UnqualComponentName ShortText unUnqualComponentName :: UnqualComponentName -> String unUnqualComponentName (UnqualComponentName s) = fromShortText s +-- | @since 3.4.0.0 +unUnqualComponentNameST :: UnqualComponentName -> ShortText +unUnqualComponentNameST (UnqualComponentName s) = s + -- | Construct a 'UnqualComponentName' from a 'String' -- -- 'mkUnqualComponentName' is the inverse to 'unUnqualComponentName' @@ -78,7 +82,7 @@ instance NFData UnqualComponentName where -- -- @since 2.0.0.2 packageNameToUnqualComponentName :: PackageName -> UnqualComponentName -packageNameToUnqualComponentName = mkUnqualComponentName . unPackageName +packageNameToUnqualComponentName = UnqualComponentName . unPackageNameST -- | Converts an unqualified component name to a package name -- @@ -90,4 +94,4 @@ packageNameToUnqualComponentName = mkUnqualComponentName . unPackageName -- -- @since 2.0.0.2 unqualComponentNameToPackageName :: UnqualComponentName -> PackageName -unqualComponentNameToPackageName = mkPackageName . unUnqualComponentName +unqualComponentNameToPackageName = mkPackageNameST . unUnqualComponentNameST diff --git a/Cabal/Distribution/Types/VersionRange.hs b/Cabal/Distribution/Types/VersionRange.hs index e069d8eb882..7ef2286ca2c 100644 --- a/Cabal/Distribution/Types/VersionRange.hs +++ b/Cabal/Distribution/Types/VersionRange.hs @@ -71,7 +71,6 @@ foldVersionRange anyv this later earlier union intersect = fold alg (MajorBoundVersionF v) = fold (majorBound v) alg (UnionVersionRangesF v1 v2) = union v1 v2 alg (IntersectVersionRangesF v1 v2) = intersect v1 v2 - alg (VersionRangeParensF v) = v wildcard v = intersectVersionRanges (orLaterVersion v) @@ -104,12 +103,11 @@ normaliseVersionRange = hyloVersionRange embed projectVersionRange -- | Remove 'VersionRangeParens' constructors. -- +-- Since version 3.4 this function is 'id', there aren't 'VersionRangeParens' constructor in 'VersionRange' anymore. +-- -- @since 2.2 stripParensVersionRange :: VersionRange -> VersionRange -stripParensVersionRange = hyloVersionRange embed projectVersionRange - where - embed (VersionRangeParensF vr) = vr - embed vr = embedVersionRange vr +stripParensVersionRange = id -- | Does this version fall within the given range? -- diff --git a/Cabal/Distribution/Types/VersionRange/Internal.hs b/Cabal/Distribution/Types/VersionRange/Internal.hs index 98c0d8b0e60..43e67c567ba 100644 --- a/Cabal/Distribution/Types/VersionRange/Internal.hs +++ b/Cabal/Distribution/Types/VersionRange/Internal.hs @@ -58,7 +58,6 @@ data VersionRange | MajorBoundVersion Version -- @^>= ver@ (same as >= ver && < MAJ(ver)+1) | UnionVersionRanges VersionRange VersionRange | IntersectVersionRanges VersionRange VersionRange - | VersionRangeParens VersionRange -- just '(exp)' parentheses syntax deriving ( Data, Eq, Generic, Read, Show, Typeable ) instance Binary VersionRange @@ -180,7 +179,6 @@ data VersionRangeF a | MajorBoundVersionF Version -- @^>= ver@ (same as >= ver && < MAJ(ver)+1) | UnionVersionRangesF a a | IntersectVersionRangesF a a - | VersionRangeParensF a deriving ( Data, Eq, Generic, Read, Show, Typeable , Functor, Foldable, Traversable ) @@ -196,7 +194,6 @@ projectVersionRange (WildcardVersion v) = WildcardVersionF v projectVersionRange (MajorBoundVersion v) = MajorBoundVersionF v projectVersionRange (UnionVersionRanges a b) = UnionVersionRangesF a b projectVersionRange (IntersectVersionRanges a b) = IntersectVersionRangesF a b -projectVersionRange (VersionRangeParens a) = VersionRangeParensF a -- | Fold 'VersionRange'. -- @@ -216,7 +213,6 @@ embedVersionRange (WildcardVersionF v) = WildcardVersion v embedVersionRange (MajorBoundVersionF v) = MajorBoundVersion v embedVersionRange (UnionVersionRangesF a b) = UnionVersionRanges a b embedVersionRange (IntersectVersionRangesF a b) = IntersectVersionRanges a b -embedVersionRange (VersionRangeParensF a) = VersionRangeParens a -- | Unfold 'VersionRange'. -- @@ -251,8 +247,6 @@ instance Pretty VersionRange where (punct 1 p1 r1 <+> Disp.text "||" <+> punct 2 p2 r2 , 2) alg (IntersectVersionRangesF (r1, p1) (r2, p2)) = (punct 0 p1 r1 <+> Disp.text "&&" <+> punct 1 p2 r2 , 1) - alg (VersionRangeParensF (r, _)) = - (Disp.parens r, 0) dispWild ver = Disp.hcat (Disp.punctuate (Disp.char '.') @@ -492,9 +486,10 @@ versionRangeParser digitParser csv = expr parens p = P.between ((P.char '(' P. "opening paren") >> P.spaces) (P.char ')' >> P.spaces) - (do a <- p + $ do + a <- p P.spaces - return (VersionRangeParens a)) + return a tags :: CabalParsing m => m () tags = do diff --git a/Cabal/tests/ParserTests/regressions/encoding-0.8.expr b/Cabal/tests/ParserTests/regressions/encoding-0.8.expr index 32fc912232e..06da6ff365b 100644 --- a/Cabal/tests/ParserTests/regressions/encoding-0.8.expr +++ b/Cabal/tests/ParserTests/regressions/encoding-0.8.expr @@ -7,10 +7,9 @@ GenericPackageDescription {condTreeComponents = [], condTreeConstraints = [Dependency `PackageName "base"` - (VersionRangeParens - (UnionVersionRanges - (LaterVersion `mkVersion [4,4]`) - (ThisVersion `mkVersion [4,4]`))) + (UnionVersionRanges + (LaterVersion `mkVersion [4,4]`) + (ThisVersion `mkVersion [4,4]`)) (Set.fromList [LMainLibName])], condTreeData = Library {exposedModules = [`ModuleName ["Data","Encoding"]`], @@ -64,12 +63,11 @@ GenericPackageDescription staticOptions = PerCompilerFlavor [] [], targetBuildDepends = [Dependency `PackageName "base"` - (VersionRangeParens - (UnionVersionRanges - (LaterVersion - `mkVersion [4,4]`) - (ThisVersion - `mkVersion [4,4]`))) + (UnionVersionRanges + (LaterVersion + `mkVersion [4,4]`) + (ThisVersion + `mkVersion [4,4]`)) (Set.fromList [LMainLibName])], virtualModules = []}, diff --git a/Cabal/tests/ParserTests/regressions/encoding-0.8.format b/Cabal/tests/ParserTests/regressions/encoding-0.8.format index 1b5a897f786..a56495c0915 100644 --- a/Cabal/tests/ParserTests/regressions/encoding-0.8.format +++ b/Cabal/tests/ParserTests/regressions/encoding-0.8.format @@ -15,4 +15,4 @@ custom-setup library exposed-modules: Data.Encoding ghc-options: -Wall -O2 -threaded -rtsopts "-with-rtsopts=-N1 -A64m" - build-depends: base (>4.4 || ==4.4) + build-depends: base >4.4 || ==4.4 diff --git a/Cabal/tests/UnitTests/Distribution/Described.hs b/Cabal/tests/UnitTests/Distribution/Described.hs index 27a0488b024..65234d776f7 100644 --- a/Cabal/tests/UnitTests/Distribution/Described.hs +++ b/Cabal/tests/UnitTests/Distribution/Described.hs @@ -17,6 +17,7 @@ import Distribution.Pretty (prettyShow) import qualified Distribution.Utils.CharSet as CS +import Distribution.Types.Dependency (Dependency) import Distribution.Types.PackageName (PackageName) import Distribution.Types.Version (Version) import Distribution.Types.VersionRange (VersionRange) @@ -29,18 +30,24 @@ import Test.QuickCheck.Instances.Cabal () tests :: TestTree tests = testGroup "Described" - [ testDescribed (Proxy :: Proxy PackageName) + [ testDescribed (Proxy :: Proxy Dependency) + , testDescribed (Proxy :: Proxy PackageName) , testDescribed (Proxy :: Proxy Version) , testDescribed (Proxy :: Proxy VersionRange) ] +------------------------------------------------------------------------------- +-- Described/Pretty/Parsec tests +------------------------------------------------------------------------------- + testDescribed - :: forall a. (Arbitrary a, Described a, Typeable a, Show a) + :: forall a. (Arbitrary a, Described a, Typeable a, Eq a, Show a) => Proxy a -> TestTree testDescribed _ = testGroup name [ testProperty "parsec" propParsec , testProperty "pretty" propPretty + , testProperty "roundtrip" propRoundtrip ] where name = show (typeOf (undefined :: a)) @@ -61,6 +68,14 @@ testDescribed _ = testGroup name where str = prettyShow x + propRoundtrip :: a -> Property + propRoundtrip x = counterexample (show (res, str)) $ case res of + Right y -> x == y + Left _ -> False + where + str = prettyShow x + res = eitherParsec str + newtype Ex a = Example String deriving (Show) @@ -71,6 +86,10 @@ instance Described a => Arbitrary (Ex a) where $ RE.generate 10 5 $ convert $ describe (Proxy :: Proxy a) + shrink (Example s) + | '\n' `elem` s = [ Example $ map (\c -> if c == '\n' then ' ' else c) s ] + | otherwise = [] + genInt :: Int -> Int -> Gen Int genInt lo hi = choose (lo, hi) diff --git a/Cabal/tests/UnitTests/Distribution/Utils/Structured.hs b/Cabal/tests/UnitTests/Distribution/Utils/Structured.hs index 8f6abb64967..40e826779d9 100644 --- a/Cabal/tests/UnitTests/Distribution/Utils/Structured.hs +++ b/Cabal/tests/UnitTests/Distribution/Utils/Structured.hs @@ -19,10 +19,10 @@ import UnitTests.Orphans () tests :: TestTree tests = testGroup "Distribution.Utils.Structured" -- This test also verifies that structureHash doesn't loop. - [ testCase "VersionRange" $ structureHash (Proxy :: Proxy VersionRange) @?= Fingerprint 0x3827faffd22242bf 0xfd0c337e60fc808b + [ testCase "VersionRange" $ structureHash (Proxy :: Proxy VersionRange) @?= Fingerprint 0x6a33c568c9307696 0xe383268b2389a958 , testCase "SPDX.License" $ structureHash (Proxy :: Proxy License) @?= Fingerprint 0xd3d4a09f517f9f75 0xbc3d16370d5a853a -- The difference is in encoding of newtypes #if MIN_VERSION_base(4,7,0) - , testCase "LocalBuildInfo" $ structureHash (Proxy :: Proxy LocalBuildInfo) @?= Fingerprint 0xb48ff44b0e5d96ff 0xfc099544337e90ab + , testCase "LocalBuildInfo" $ structureHash (Proxy :: Proxy LocalBuildInfo) @?= Fingerprint 0x57e3e6dcec2cf371 0x00ef351fd0f41443 #endif ] diff --git a/Cabal/tests/UnitTests/Distribution/Version.hs b/Cabal/tests/UnitTests/Distribution/Version.hs index c308b749ea3..58b3d3edfe3 100644 --- a/Cabal/tests/UnitTests/Distribution/Version.hs +++ b/Cabal/tests/UnitTests/Distribution/Version.hs @@ -15,7 +15,7 @@ import Distribution.Utils.Generic import Data.Typeable (typeOf) import Math.NumberTheory.Logarithms (intLog2) -import Text.PrettyPrint as Disp (text, render, parens, hcat +import Text.PrettyPrint as Disp (text, render, hcat ,punctuate, int, char, (<+>)) import Test.Tasty import Test.Tasty.QuickCheck @@ -284,7 +284,6 @@ prop_foldVersionRange range = UnionVersionRanges (expandVR v1) (expandVR v2) expandVR (IntersectVersionRanges v1 v2) = IntersectVersionRanges (expandVR v1) (expandVR v2) - expandVR (VersionRangeParens v) = expandVR v expandVR v = v upper = alterVersion $ \numbers -> case unsnoc numbers of @@ -598,15 +597,7 @@ prop_parse_disp vr = counterexample (show (prettyShow vr')) $ prop_parse_disp1 :: VersionRange -> Bool prop_parse_disp1 vr = - fmap stripParens (simpleParsec (prettyShow vr)) == Just (normaliseVersionRange vr) - where - stripParens :: VersionRange -> VersionRange - stripParens (VersionRangeParens v) = stripParens v - stripParens (UnionVersionRanges v1 v2) = - UnionVersionRanges (stripParens v1) (stripParens v2) - stripParens (IntersectVersionRanges v1 v2) = - IntersectVersionRanges (stripParens v1) (stripParens v2) - stripParens v = v + simpleParsec (prettyShow vr) == Just (normaliseVersionRange vr) prop_parse_disp2 :: VersionRange -> Property prop_parse_disp2 vr = @@ -662,8 +653,6 @@ displayRaw = alg (MajorBoundVersionF v) = Disp.text "^>=" <<>> pretty v alg (UnionVersionRangesF r1 r2) = r1 <+> Disp.text "||" <+> r2 alg (IntersectVersionRangesF r1 r2) = r1 <+> Disp.text "&&" <+> r2 - alg (VersionRangeParensF r) = Disp.parens r -- parens - dispWild v = Disp.hcat (Disp.punctuate (Disp.char '.') diff --git a/cabal-install/Distribution/Client/IndexUtils/Timestamp.hs b/cabal-install/Distribution/Client/IndexUtils/Timestamp.hs index 27fd8a7c207..216ebdc18fc 100644 --- a/cabal-install/Distribution/Client/IndexUtils/Timestamp.hs +++ b/cabal-install/Distribution/Client/IndexUtils/Timestamp.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} ----------------------------------------------------------------------------- @@ -31,6 +32,8 @@ import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) import Distribution.Parsec (Parsec (..)) import Distribution.Pretty (Pretty (..)) +import Distribution.FieldGrammar.Described + import qualified Codec.Archive.Tar.Entry as Tar import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp @@ -102,6 +105,119 @@ instance Structured Timestamp instance Pretty Timestamp where pretty = Disp.text . showTimestamp +instance Described Timestamp where + describe _ = REUnion + [ posix + , utc + ] + where + posix = reChar '@' <> reMunch1CS "0123456789" + utc = RENamed "date" date <> reChar 'T' <> RENamed "time" time <> reChar 'Z' + + date = REOpt digit <> REUnion + [ leapYear <> reChar '-' <> leapMD + , commonYear <> reChar '-' <> commonMD + ] + + -- leap year: either + -- * divisible by 400 + -- * not divisible by 100 and divisible by 4 + leapYear = REUnion + [ div4 <> "00" + , digit <> digit <> div4not0 + ] + + -- common year: either + -- * not divisible by 400 but divisible by 100 + -- * not divisible by 4 + commonYear = REUnion + [ notDiv4 <> "00" + , digit <> digit <> notDiv4 + ] + + div4 = REUnion + [ "0" <> reChars "048" + , "1" <> reChars "26" + , "2" <> reChars "048" + , "3" <> reChars "26" + , "4" <> reChars "048" + , "5" <> reChars "26" + , "6" <> reChars "048" + , "7" <> reChars "26" + , "8" <> reChars "048" + , "9" <> reChars "26" + ] + + div4not0 = REUnion + [ "0" <> reChars "48" -- no zero + , "1" <> reChars "26" + , "2" <> reChars "048" + , "3" <> reChars "26" + , "4" <> reChars "048" + , "5" <> reChars "26" + , "6" <> reChars "048" + , "7" <> reChars "26" + , "8" <> reChars "048" + , "9" <> reChars "26" + ] + + notDiv4 = REUnion + [ "0" <> reChars "1235679" + , "1" <> reChars "01345789" + , "2" <> reChars "1235679" + , "3" <> reChars "01345789" + , "4" <> reChars "1235679" + , "5" <> reChars "01345789" + , "6" <> reChars "1235679" + , "7" <> reChars "01345789" + , "8" <> reChars "1235679" + , "9" <> reChars "01345789" + ] + + leapMD = REUnion + [ jan, fe', mar, apr, may, jun, jul, aug, sep, oct, nov, dec ] + + commonMD = REUnion + [ jan, feb, mar, apr, may, jun, jul, aug, sep, oct, nov, dec ] + + jan = "01-" <> d31 + feb = "02-" <> d28 + fe' = "02-" <> d29 + mar = "03-" <> d31 + apr = "04-" <> d30 + may = "05-" <> d31 + jun = "06-" <> d30 + jul = "07-" <> d31 + aug = "08-" <> d31 + sep = "09-" <> d30 + oct = "10-" <> d31 + nov = "11-" <> d30 + dec = "12-" <> d31 + + d28 = REUnion + [ "0" <> digit1, "1" <> digit, "2" <> reChars "012345678" ] + d29 = REUnion + [ "0" <> digit1, "1" <> digit, "2" <> digit ] + d30 = REUnion + [ "0" <> digit1, "1" <> digit, "2" <> digit, "30" ] + d31 = REUnion + [ "0" <> digit1, "1" <> digit, "2" <> digit, "30", "31" ] + + time = ho <> reChar ':' <> minSec <> reChar ':' <> minSec + + -- 0..23 + ho = REUnion + [ "0" <> digit + , "1" <> digit + , "2" <> reChars "0123" + ] + + -- 0..59 + minSec = reChars "012345" <> digit + + digit = reChars "0123456789" + digit1 = reChars "123456789" + instance Parsec Timestamp where parsec = parsePosix <|> parseUTC where @@ -184,3 +300,9 @@ instance Parsec IndexState where parsec = parseHead <|> parseTime where parseHead = IndexStateHead <$ P.string "HEAD" parseTime = IndexStateTime <$> parsec + +instance Described IndexState where + describe _ = REUnion + [ "HEAD" + , RENamed "timestamp" (describe (Proxy :: Proxy Timestamp)) + ] diff --git a/cabal-install/Distribution/Deprecated/Text.hs b/cabal-install/Distribution/Deprecated/Text.hs index c16bcb59eb0..4761bff2190 100644 --- a/cabal-install/Distribution/Deprecated/Text.hs +++ b/cabal-install/Distribution/Deprecated/Text.hs @@ -47,7 +47,6 @@ import qualified Distribution.Types.PackageVersionConstraint as D import qualified Distribution.Types.SourceRepo as D import qualified Distribution.Types.UnqualComponentName as D import qualified Distribution.Version as D -import qualified Distribution.Types.VersionRange.Internal as D import qualified Language.Haskell.Extension as E -- | /Note:/ this class will soon be deprecated. @@ -340,7 +339,7 @@ instance Text D.VersionRange where (Parse.char ')' >> Parse.skipSpaces) (do a <- p Parse.skipSpaces - return (D.VersionRangeParens a)) + return a) digits = do firstDigit <- Parse.satisfy isDigit if firstDigit == '0' diff --git a/cabal-install/cabal-install.cabal.pp b/cabal-install/cabal-install.cabal.pp index 324c12dc7f3..e1294b839ab 100644 --- a/cabal-install/cabal-install.cabal.pp +++ b/cabal-install/cabal-install.cabal.pp @@ -450,6 +450,7 @@ ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -main-is UnitTests other-modules: UnitTests.Distribution.Client.ArbitraryInstances + UnitTests.Distribution.Client.Described UnitTests.Distribution.Client.Targets UnitTests.Distribution.Client.FileMonitor UnitTests.Distribution.Client.Get @@ -482,6 +483,7 @@ cabal-lib-client, cabal-install-solver-dsl, Cabal, + Cabal-quickcheck, containers, deepseq, mtl, @@ -491,6 +493,7 @@ tar, time, zlib, + rere >=0.1 && <0.2, network-uri < 2.6.2.0, network, tasty >= 1.2.3 && <1.3, diff --git a/cabal-install/tests/UnitTests.hs b/cabal-install/tests/UnitTests.hs index 345e9d6053a..3fe50a63414 100644 --- a/cabal-install/tests/UnitTests.hs +++ b/cabal-install/tests/UnitTests.hs @@ -13,6 +13,7 @@ import qualified UnitTests.Distribution.Solver.Modular.Builder import qualified UnitTests.Distribution.Solver.Modular.WeightedPSQ import qualified UnitTests.Distribution.Solver.Modular.Solver import qualified UnitTests.Distribution.Solver.Modular.RetryLog +import qualified UnitTests.Distribution.Client.Described import qualified UnitTests.Distribution.Client.FileMonitor import qualified UnitTests.Distribution.Client.Glob import qualified UnitTests.Distribution.Client.GZipUtils @@ -78,6 +79,7 @@ tests mtimeChangeCalibrated = UnitTests.Distribution.Client.VCS.tests mtimeChange , testGroup "UnitTests.Distribution.Client.Get" UnitTests.Distribution.Client.Get.tests + , UnitTests.Distribution.Client.Described.tests ] main :: IO () diff --git a/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs b/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs index 6379b1a639b..7d6a2bafa12 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module UnitTests.Distribution.Client.ArbitraryInstances ( @@ -12,23 +11,10 @@ module UnitTests.Distribution.Client.ArbitraryInstances ( NoShrink(..), ) where -import Data.Char -import Data.List -#if !MIN_VERSION_base(4,8,0) -import Data.Monoid -import Control.Applicative -#endif -import Control.Monad - -import Distribution.Version -import Distribution.Types.VersionRange.Internal -import Distribution.Types.Dependency +import Distribution.Client.Compat.Prelude +import Prelude () + import Distribution.Types.PackageVersionConstraint -import Distribution.Types.UnqualComponentName -import Distribution.Types.LibraryName -import Distribution.Package -import Distribution.System -import Distribution.Verbosity import Distribution.Simple.Setup import Distribution.Simple.InstallDirs @@ -39,7 +25,7 @@ import Distribution.Client.Types import Distribution.Client.IndexUtils.Timestamp import Test.QuickCheck - +import Test.QuickCheck.Instances.Cabal () adjustSize :: (Int -> Int) -> Gen a -> Gen a adjustSize adjust gen = sized (\n -> resize (adjust n) gen) @@ -68,110 +54,20 @@ instance Arbitrary ShortToken where -- accepting Haskell list syntax [], ['a'] etc, just allow String syntax. -- Workaround, don't generate [] as this does not round trip. - shrink (ShortToken cs) = [ ShortToken cs' | cs' <- shrink cs, not (null cs') ] arbitraryShortToken :: Gen String arbitraryShortToken = getShortToken <$> arbitrary -instance Arbitrary Version where - arbitrary = do - branch <- shortListOf1 4 $ - frequency [(3, return 0) - ,(3, return 1) - ,(2, return 2) - ,(1, return 3)] - return (mkVersion branch) - where - - shrink ver = [ mkVersion branch' | branch' <- shrink (versionNumbers ver) - , not (null branch') ] - -instance Arbitrary VersionRange where - arbitrary = canonicaliseVersionRange <$> sized verRangeExp - where - verRangeExp n = frequency $ - [ (2, return anyVersion) - , (1, liftM thisVersion arbitrary) - , (1, liftM laterVersion arbitrary) - , (1, liftM orLaterVersion arbitrary) - , (1, liftM orLaterVersion' arbitrary) - , (1, liftM earlierVersion arbitrary) - , (1, liftM orEarlierVersion arbitrary) - , (1, liftM orEarlierVersion' arbitrary) - , (1, liftM withinVersion arbitrary) - , (2, liftM VersionRangeParens arbitrary) - ] ++ if n == 0 then [] else - [ (2, liftM2 unionVersionRanges verRangeExp2 verRangeExp2) - , (2, liftM2 intersectVersionRanges verRangeExp2 verRangeExp2) - ] - where - verRangeExp2 = verRangeExp (n `div` 2) - - orLaterVersion' v = - unionVersionRanges (laterVersion v) (thisVersion v) - orEarlierVersion' v = - unionVersionRanges (earlierVersion v) (thisVersion v) - - canonicaliseVersionRange = fromVersionIntervals . toVersionIntervals - -instance Arbitrary PackageName where - arbitrary = mkPackageName . intercalate "-" <$> shortListOf1 2 nameComponent - where - nameComponent = shortListOf1 5 (elements packageChars) - `suchThat` (not . all isDigit) - packageChars = filter isAlphaNum ['\0'..'\127'] - -instance Arbitrary Dependency where - arbitrary = Dependency - <$> arbitrary - <*> arbitrary - <*> fmap getNonMEmpty arbitrary - instance Arbitrary PackageVersionConstraint where arbitrary = PackageVersionConstraint <$> arbitrary <*> arbitrary -instance Arbitrary UnqualComponentName where - -- same rules as package names - arbitrary = packageNameToUnqualComponentName <$> arbitrary - -instance Arbitrary LibraryName where - arbitrary = - elements - =<< sequenceA [ LSubLibName <$> arbitrary - , pure LMainLibName ] - -instance Arbitrary OS where - arbitrary = elements knownOSs - -instance Arbitrary Arch where - arbitrary = elements knownArches - -instance Arbitrary Platform where - arbitrary = Platform <$> arbitrary <*> arbitrary - -instance Arbitrary a => Arbitrary (Flag a) where - arbitrary = arbitraryFlag arbitrary - shrink NoFlag = [] - shrink (Flag x) = NoFlag : [ Flag x' | x' <- shrink x ] - -arbitraryFlag :: Gen a -> Gen (Flag a) -arbitraryFlag genA = - sized $ \sz -> - case sz of - 0 -> pure NoFlag - _ -> frequency [ (1, pure NoFlag) - , (3, Flag <$> genA) ] - - instance (Arbitrary a, Ord a) => Arbitrary (NubList a) where arbitrary = toNubList <$> arbitrary shrink xs = [ toNubList [] | (not . null) (fromNubList xs) ] -- try empty, otherwise don't shrink as it can loop -instance Arbitrary Verbosity where - arbitrary = elements [minBound..maxBound] instance Arbitrary PathTemplate where arbitrary = toPathTemplate <$> arbitraryShortToken @@ -195,7 +91,12 @@ instance Arbitrary a => Arbitrary (NoShrink a) where shrink _ = [] instance Arbitrary Timestamp where - arbitrary = (maybe (toEnum 0) id . epochTimeToTimestamp) <$> arbitrary + -- note: no negative timestamps + -- + -- >>> utcTimeToPOSIXSeconds $ UTCTime (fromGregorian 100000 01 01) 0 + -- >>> 3093527980800s + -- + arbitrary = maybe (toEnum 0) id . epochTimeToTimestamp . (`mod` 3093527980800) . abs <$> arbitrary instance Arbitrary IndexState where arbitrary = frequency [ (1, pure IndexStateHead) @@ -204,3 +105,6 @@ instance Arbitrary IndexState where instance Arbitrary WriteGhcEnvironmentFilesPolicy where arbitrary = arbitraryBoundedEnum + +arbitraryFlag :: Gen a -> Gen (Flag a) +arbitraryFlag = liftArbitrary diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Described.hs b/cabal-install/tests/UnitTests/Distribution/Client/Described.hs new file mode 100644 index 00000000000..de6a05e5c58 --- /dev/null +++ b/cabal-install/tests/UnitTests/Distribution/Client/Described.hs @@ -0,0 +1,150 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -fno-warn-deprecations #-} +module UnitTests.Distribution.Client.Described where + +import Distribution.Client.Compat.Prelude +import Prelude () +import UnitTests.Distribution.Client.ArbitraryInstances () + +import Data.Typeable (typeOf) +import Test.QuickCheck (Arbitrary (..), Gen, Property, choose, counterexample) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import Distribution.FieldGrammar.Described (Described (..), Regex (..), reComma, reSpacedComma, reSpacedList) +import Distribution.Parsec (eitherParsec) +import Distribution.Pretty (prettyShow) + +import qualified Distribution.Utils.CharSet as CS + +import Distribution.Client.IndexUtils.Timestamp (IndexState, Timestamp) + +import qualified RERE as RE +import qualified RERE.CharSet as RE + +-- instances +import Test.QuickCheck.Instances.Cabal () + +tests :: TestTree +tests = testGroup "Described" + [ testDescribed (Proxy :: Proxy Timestamp) + , testDescribed (Proxy :: Proxy IndexState) + ] + +------------------------------------------------------------------------------- +-- Described/Pretty/Parsec tests +------------------------------------------------------------------------------- + +testDescribed + :: forall a. (Arbitrary a, Described a, Typeable a, Eq a, Show a) + => Proxy a + -> TestTree +testDescribed _ = testGroup name + [ testProperty "parsec" propParsec + , testProperty "pretty" propPretty + , testProperty "roundtrip" propRoundtrip + ] + where + name = show (typeOf (undefined :: a)) + + propParsec :: Ex a -> Property + propParsec (Example str) = counterexample (show res) $ case res of + Right _ -> True + Left _ -> False + where + res :: Either String a + res = eitherParsec str + + rr :: RE.RE Void + rr = convert $ describe (Proxy :: Proxy a) + + propPretty :: a -> Property + propPretty x = counterexample str $ RE.matchR rr str + where + str = prettyShow x + + propRoundtrip :: a -> Property + propRoundtrip x = counterexample (show (res, str)) $ case res of + + Right y -> x == y + Left _ -> False + where + str = prettyShow x + res = eitherParsec str + +newtype Ex a = Example String + deriving (Show) + +instance Described a => Arbitrary (Ex a) where + arbitrary + = fmap Example + $ fromMaybe (return "") + $ RE.generate 10 5 + $ convert $ describe (Proxy :: Proxy a) + + shrink (Example s) + | '\n' `elem` s = [ Example $ map (\c -> if c == '\n' then ' ' else c) s ] + | otherwise = [] + +genInt :: Int -> Int -> Gen Int +genInt lo hi = choose (lo, hi) + +------------------------------------------------------------------------------- +-- Conversion +------------------------------------------------------------------------------- + +convert :: Regex Void -> RE.RE Void +convert = go id . vacuous where + go :: Ord b => (a -> b) -> Regex a -> RE.RE b + go f (REAppend rs) = foldr (\r acc -> go f r <> acc) RE.Eps rs + go f (REUnion rs) = foldr (\r acc -> go f r RE.\/ acc) RE.Null rs + go _ (RECharSet cs) = RE.Ch (convertCS cs) + go _ (REString str) = RE.string_ str + + go f (REMunch sep r) = RE.Eps RE.\/ r' <> RE.star_ (sep' <> r') where + sep' = go f sep + r' = go f r + go f (REMunch1 sep r) = r' <> RE.star_ (sep' <> r') where + sep' = go f sep + r' = go f r + go f (REMunchR n sep r) + | n <= 0 = RE.Eps + | otherwise = RE.Eps RE.\/ r' <> go' (pred n) + where + sep' = go f sep + r' = go f r + + go' m | m <= 0 = RE.Eps + | otherwise = RE.Eps RE.\/ sep' <> r' <> go' (pred m) + + go f (REOpt r) = RE.Eps RE.\/ go f r + + go f (REVar a) = RE.Var (f a) + go f (RENamed _ r) = go f r + go f (RERec n r) = RE.fix_ (fromString n) + (go (maybe RE.B (RE.F . f)) r) + + go _ RESpaces = RE.Eps RE.\/ RE.ch_ ' ' RE.\/ " " RE.\/ "\n" + go _ RESpaces1 = RE.ch_ ' ' RE.\/ " " RE.\/ "\n" + + go f (RECommaList r) = go f (expandedCommaList r) + go f (REOptCommaList r) = go f (expandedOptCommaList r) + + go _ RETodo = RE.Null + +expandedCommaList :: Regex a -> Regex a +expandedCommaList = REUnion . expandedCommaList' + +expandedCommaList' :: Regex a -> [Regex a] +expandedCommaList' r = + [ REMunch reSpacedComma r + , reComma <> RESpaces <> REMunch1 reSpacedComma r + , REMunch1 reSpacedComma r <> RESpaces <> reComma + ] + +expandedOptCommaList :: Regex a -> Regex a +expandedOptCommaList r = REUnion $ reSpacedList r : expandedCommaList' r + +convertCS :: CS.CharSet -> RE.CharSet +convertCS = RE.fromIntervalList . CS.toIntervalList diff --git a/cabal.project.validate b/cabal.project.validate index a52f80931dc..e4432a98b49 100644 --- a/cabal.project.validate +++ b/cabal.project.validate @@ -1,6 +1,8 @@ packages: Cabal/ cabal-testsuite/ cabal-install/ solver-benchmarks/ tests: True +packages: Cabal/Cabal-quickcheck/ + write-ghc-environment-files: never package Cabal