diff --git a/Cabal-QuickCheck/src/Test/QuickCheck/Instances/Cabal.hs b/Cabal-QuickCheck/src/Test/QuickCheck/Instances/Cabal.hs index 2976d34b557..92a4b0ad4ce 100644 --- a/Cabal-QuickCheck/src/Test/QuickCheck/Instances/Cabal.hs +++ b/Cabal-QuickCheck/src/Test/QuickCheck/Instances/Cabal.hs @@ -3,13 +3,13 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.Cabal () where -import Control.Applicative (liftA2) import Data.Bits (shiftR) import Data.Char (isAlphaNum, isDigit, toLower) import Data.List (intercalate, (\\)) import Data.List.NonEmpty (NonEmpty (..)) import Distribution.Utils.Generic (lowercase) import Test.QuickCheck +import Control.Applicative (liftA2) #if MIN_VERSION_base(4,8,0) import Data.Bits (countLeadingZeros, finiteBitSize, shiftL) @@ -206,6 +206,23 @@ instance Arbitrary Dependency where | (pn', vr', lb') <- shrink (pn, vr, lb) ] +------------------------------------------------------------------------------- +-- Private Dependency +------------------------------------------------------------------------------- + +instance Arbitrary PrivateAlias where + arbitrary = PrivateAlias <$> arbitrary + shrink (PrivateAlias al) = PrivateAlias <$> shrink al +instance Arbitrary PrivateDependency where + arbitrary = PrivateDependency + <$> arbitrary + <*> arbitrary + + shrink (PrivateDependency al dps) = + [ PrivateDependency al' dps' + | (al', dps') <- shrink (al, dps) + ] + ------------------------------------------------------------------------------- -- PackageVersionConstraint ------------------------------------------------------------------------------- diff --git a/Cabal-described/src/Distribution/Described.hs b/Cabal-described/src/Distribution/Described.hs index b158fe02a77..af3db4b7144 100644 --- a/Cabal-described/src/Distribution/Described.hs +++ b/Cabal-described/src/Distribution/Described.hs @@ -76,7 +76,7 @@ import Distribution.Types.AbiDependency (AbiDependency) import Distribution.Types.AbiHash (AbiHash) import Distribution.Types.BenchmarkType (BenchmarkType) import Distribution.Types.BuildType (BuildType) -import Distribution.Types.Dependency (Dependency) +import Distribution.Types.Dependency (Dependency, PrivateAlias(..), PrivateDependency) import Distribution.Types.ExecutableScope (ExecutableScope) import Distribution.Types.ExeDependency (ExeDependency) import Distribution.Types.ExposedModule (ExposedModule) @@ -370,7 +370,7 @@ instance Described CompilerId where <> describe (Proxy :: Proxy Version) instance Described Dependency where - describe _ = REAppend + describe _ = REAppend [ RENamed "pkg-name" (describe (Proxy :: Proxy PackageName)) , REOpt $ reChar ':' @@ -391,6 +391,19 @@ instance Described Dependency where where vr = RENamed "version-range" (describe (Proxy :: Proxy VersionRange)) +instance Described PrivateDependency where + describe _ = REAppend + [ RENamed "alias" (describe (Proxy :: Proxy PrivateAlias)) + , RESpaces1 + , "with" + , RESpaces1 + , reChar '(' + , RESpaces + , REMunch reSpacedComma (describe (Proxy :: Proxy Dependency)) + , RESpaces + , reChar ')' + ] + instance Described ExecutableScope where describe _ = REUnion ["public","private"] @@ -446,6 +459,9 @@ instance Described ModuleName where describe _ = REMunch1 (reChar '.') component where component = RECharSet csUpper <> REMunch reEps (REUnion [RECharSet csAlphaNum, RECharSet (fromString "_'")]) +instance Described PrivateAlias where + describe _ = describe (Proxy :: Proxy ModuleName) + instance Described ModuleReexport where describe _ = RETodo @@ -591,4 +607,4 @@ instance Described CompatLicenseFile where describe _ = describe ([] :: [Token]) instance Described CompatFilePath where - describe _ = describe ([] :: [Token]) \ No newline at end of file + describe _ = describe ([] :: [Token]) diff --git a/Cabal-syntax/src/Distribution/FieldGrammar/Class.hs b/Cabal-syntax/src/Distribution/FieldGrammar/Class.hs index 65e0a69edd3..df8b69414f2 100644 --- a/Cabal-syntax/src/Distribution/FieldGrammar/Class.hs +++ b/Cabal-syntax/src/Distribution/FieldGrammar/Class.hs @@ -133,20 +133,6 @@ class -- ^ lens into the field -> g s a - -- | Like monoidalFieldAla but the field-name can have a parsed suffix - monoidalFieldPrefixAla - :: (c b, c d, Monoid a) - => FieldName - -- ^ field name prefix - -- b = parsing rest of prefix field - -- d = parsing contents of field - -> (a -> [(b, d)]) - -> ([(b, d)] -> a) - -- ^ 'pack' - -> ALens' s a - -- ^ lens into the field - -> g s a - -- | Parser matching all fields with a name starting with a prefix. prefixedFields :: FieldName diff --git a/Cabal-syntax/src/Distribution/FieldGrammar/Parsec.hs b/Cabal-syntax/src/Distribution/FieldGrammar/Parsec.hs index 827db58a09d..bce432e4e4e 100644 --- a/Cabal-syntax/src/Distribution/FieldGrammar/Parsec.hs +++ b/Cabal-syntax/src/Distribution/FieldGrammar/Parsec.hs @@ -1,9 +1,9 @@ {-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE ScopedTypeVariables #-} -- | This module provides a 'FieldGrammarParser', one way to parse -- @.cabal@ -like files. @@ -75,7 +75,6 @@ import Distribution.Utils.String (trim) import Prelude () import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as BS8 import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as Map import qualified Data.Set as Set @@ -90,9 +89,6 @@ import Distribution.Fields.ParseResult import Distribution.Parsec import Distribution.Parsec.FieldLineStream import Distribution.Parsec.Position (positionCol, positionRow) -import Distribution.Compat.Lens -import Distribution.Compat.CharParsing (CharParsing(..), spaces) -import Distribution.Types.Dependency (PrivateAlias(..)) ------------------------------------------------------------------------------- -- Auxiliary types @@ -271,45 +267,6 @@ instance FieldGrammar Parsec ParsecFieldGrammar where parseOne v (MkNamelessField pos fls) = runFieldParser pos parsec v fls - monoidalFieldPrefixAla :: (Parsec b, Parsec d, Monoid a) - => FieldName - -> (a -> [(b, d)]) - -> ([(b, d)] -> a) - -> ALens' s a - -> ParsecFieldGrammar s a - monoidalFieldPrefixAla fnPfx _unpack _pack _extract = ParsecFG mempty (Set.singleton fnPfx) parser - - where - parser :: CabalSpecVersion -> Fields Position -> ParseResult _ - parser v values = process v $ filter match $ Map.toList values - - process v xs = case xs of - [] -> pure mempty - xs -> foldMap _pack <$> traverse (parseStanza v) xs - - parseStanza v (header, fls) = do - traceShowM (header, fls) - let mn = BS.drop (BS.length fnPfx + 1) header --- let name'' = PrivateAlias (fromString (map toUpper (BS8.unpack mn))) - name'' <- runFieldParser' [] parsec v (fieldLineStreamFromBS mn) - dls <- traverse (parseOne v) fls - return $ [(name'', d) | d <- dls] - - - parseOne v (MkNamelessField pos fls) = do - runFieldParser pos parsec v fls - - match (fn, _) = fnPfx `BS.isPrefixOf` fn - -{- - convert (fn, fields) = - [ (pos, (fromUTF8BS fn, trim $ fromUTF8BS $ fieldlinesToBS fls)) - | MkNamelessField pos fls <- fields - ] - -- hack: recover the order of prefixed fields - reorder = map snd . sortBy (comparing fst) - -} - prefixedFields fnPfx _extract = ParsecFG mempty (Set.singleton fnPfx) (\_ fs -> pure (parser fs)) where parser :: Fields Position -> [(String, String)] diff --git a/Cabal-syntax/src/Distribution/FieldGrammar/Pretty.hs b/Cabal-syntax/src/Distribution/FieldGrammar/Pretty.hs index 61880f09768..a35d8f361f4 100644 --- a/Cabal-syntax/src/Distribution/FieldGrammar/Pretty.hs +++ b/Cabal-syntax/src/Distribution/FieldGrammar/Pretty.hs @@ -86,16 +86,6 @@ instance FieldGrammar Pretty PrettyFieldGrammar where where pp v s = ppField fn (prettyVersioned v (pack' _pack (aview l s))) - monoidalFieldPrefixAla fnPfx _pack _unpack l = PrettyFG pp - where - pp v s = - let d = _pack (aview l s) - in concatMap (doOne v) d - - doOne v (h, l) = - let pfxString = PP.render (prettyVersioned v h) - in ppField (fnPfx <> fromString " " <> toUTF8BS pfxString) (prettyVersioned v l) - prefixedFields _fnPfx l = PrettyFG (\_ -> pp . aview l) where pp xs = diff --git a/Cabal-syntax/src/Distribution/ModuleName.hs b/Cabal-syntax/src/Distribution/ModuleName.hs index 90082d29f06..bdaf4e0d10e 100644 --- a/Cabal-syntax/src/Distribution/ModuleName.hs +++ b/Cabal-syntax/src/Distribution/ModuleName.hs @@ -99,12 +99,6 @@ validModuleComponent (c : cs) = isUpper c && all validModuleChar cs instance IsString ModuleName where fromString = ModuleName . toShortText --- | Construct a 'ModuleName' from valid module components, i.e. parts --- separated by dots. -fromComponents :: [String] -> ModuleName -fromComponents comps = fromString (intercalate "." comps) -{-# DEPRECATED fromComponents "Exists for cabal-install only" #-} - -- | The module name @Main@. main :: ModuleName main = ModuleName (fromString "Main") @@ -119,6 +113,13 @@ components mn = split (unModuleName mn) (chunk, []) -> chunk : [] (chunk, _ : rest) -> chunk : split rest +-- | Construct a 'ModuleName' from valid module components, i.e. parts +-- separated by dots. +-- +-- Inverse of 'components', i.e. @fromComponents (components x) = x@ +fromComponents :: [String] -> ModuleName +fromComponents comps = fromString (intercalate "." comps) + -- | Convert a module name to a file path, but without any file extension. -- For example: -- diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Configuration.hs b/Cabal-syntax/src/Distribution/PackageDescription/Configuration.hs index 03526d7f923..2e35597b16d 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/Configuration.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/Configuration.hs @@ -339,17 +339,20 @@ unionVersionRanges' (vr, cs) (vr', cs') = (unionVersionRanges vr vr', cs <> cs') toDepMapUnion :: Dependencies -> DepMapUnion toDepMapUnion ds = - DepMapUnion $ Map.fromListWith unionVersionRanges' - ([((p, Public), (vr, cs)) | Dependency p vr cs <- publicDependencies ds] - ++ [((p, Private (private_alias d, pns)), (vr, cs)) | d <- privateDependencies ds, let pns = map depPkgName (private_depends d), Dependency p vr cs <- private_depends d]) + DepMapUnion $ + Map.fromListWith + unionVersionRanges' + ( [((p, Public), (vr, cs)) | Dependency p vr cs <- publicDependencies ds] + ++ [((p, Private (private_alias d)), (vr, cs)) | d <- privateDependencies ds, Dependency p vr cs <- private_depends d] + ) fromDepMapUnion :: DepMapUnion -> Dependencies fromDepMapUnion m = Dependencies [Dependency p vr cs | ((p, Public), (vr, cs)) <- Map.toList (unDepMapUnion m)] [PrivateDependency alias deps | (alias, deps) <- Map.toList priv_deps] - where - priv_deps = Map.fromListWith (++) [(sn, [Dependency p vr cs]) | ((p, Private (sn, _)), (vr, cs)) <- Map.toList (unDepMapUnion m)] + where + priv_deps = Map.fromListWith (++) [(sn, [Dependency p vr cs]) | ((p, Private sn), (vr, cs)) <- Map.toList (unDepMapUnion m)] freeVars :: CondTree ConfVar c a -> [FlagName] freeVars t = [f | PackageFlag f <- freeVars' t] @@ -534,8 +537,10 @@ finalizePD | otherwise -> [b, not b] -- flagDefaults = map (\(n,x:_) -> (n,x)) flagChoices check ds = - let missingDeps = Dependencies (filter (not . satisfyDep Nothing) (publicDependencies ds)) - (mapMaybe (\(PrivateDependency priv ds) -> case filter (not . satisfyDep (Just priv)) ds of { [] -> Nothing; ds' -> Just (PrivateDependency priv ds') }) (privateDependencies ds)) + let missingDeps = + Dependencies + (filter (not . satisfyDep Nothing) (publicDependencies ds)) + (mapMaybe (\(PrivateDependency priv pds) -> case filter (not . satisfyDep (Just priv)) pds of [] -> Nothing; pds' -> Just (PrivateDependency priv pds')) (privateDependencies ds)) in if null (publicDependencies missingDeps) && null (privateDependencies missingDeps) then DepOk else MissingDeps missingDeps diff --git a/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs b/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs index ec671c6837c..a853cb03fe3 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs @@ -677,7 +677,7 @@ buildInfoFieldGrammar = <*> pure mempty -- static-options ??? <*> prefixedFields "x-" L.customFieldsBI <*> monoidalFieldAla "build-depends" formatDependencyList L.targetBuildDepends - <*> monoidalFieldAla "private-build-depends" formatPrivateDependencyList L.targetPrivateBuildDepends --(map (\(PrivateDependency a ds) -> (a, formatDependencyList ds))) (map (\(alias, ds) -> PrivateDependency alias (unpack' formatDependencyList ds))) L.targetPrivateBuildDepends + <*> monoidalFieldAla "private-build-depends" formatPrivateDependencyList L.targetPrivateBuildDepends -- (map (\(PrivateDependency a ds) -> (a, formatDependencyList ds))) (map (\(alias, ds) -> PrivateDependency alias (unpack' formatDependencyList ds))) L.targetPrivateBuildDepends <*> monoidalFieldAla "mixins" formatMixinList L.mixins ^^^ availableSince CabalSpecV2_0 [] {-# SPECIALIZE buildInfoFieldGrammar :: ParsecFieldGrammar' BuildInfo #-} diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs index 6110561afc2..0cbb32df6c5 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs @@ -1,9 +1,9 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE BangPatterns #-} ----------------------------------------------------------------------------- @@ -65,13 +65,13 @@ import qualified Data.Set as Set import qualified Distribution.Compat.Newtype as Newtype import qualified Distribution.Compat.NonEmptySet as NES import qualified Distribution.Types.BuildInfo.Lens as L +import qualified Distribution.Types.Dependency.Lens as L import qualified Distribution.Types.Executable.Lens as L import qualified Distribution.Types.ForeignLib.Lens as L import qualified Distribution.Types.GenericPackageDescription.Lens as L import qualified Distribution.Types.PackageDescription.Lens as L import qualified Distribution.Types.SetupBuildInfo.Lens as L import qualified Text.Parsec as P -import qualified Distribution.Types.Dependency.Lens as L ------------------------------------------------------------------------------ diff --git a/Cabal-syntax/src/Distribution/PackageDescription/PrettyPrint.hs b/Cabal-syntax/src/Distribution/PackageDescription/PrettyPrint.hs index 47caa8b4877..425b273aeb2 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/PrettyPrint.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/PrettyPrint.hs @@ -275,7 +275,7 @@ preProcessInternalDeps specVer gpd transformD (Dependency pn vr ln) | pn == thisPn = if LMainLibName `NES.member` ln - then Dependency thisPn vr mainLibSet: sublibs + then Dependency thisPn vr mainLibSet : sublibs else sublibs where sublibs = diff --git a/Cabal-syntax/src/Distribution/Types/ComponentName.hs b/Cabal-syntax/src/Distribution/Types/ComponentName.hs index ff7318fb4e5..2b791bb50cc 100644 --- a/Cabal-syntax/src/Distribution/Types/ComponentName.hs +++ b/Cabal-syntax/src/Distribution/Types/ComponentName.hs @@ -8,8 +8,7 @@ module Distribution.Types.ComponentName , componentNameRaw , componentNameStanza , componentNameString - - , NotLibComponentName(..) + , NotLibComponentName (..) ) where import Distribution.Compat.Prelude diff --git a/Cabal-syntax/src/Distribution/Types/Dependency.hs b/Cabal-syntax/src/Distribution/Types/Dependency.hs index 841bf9d3f7b..a50c863d6bd 100644 --- a/Cabal-syntax/src/Distribution/Types/Dependency.hs +++ b/Cabal-syntax/src/Distribution/Types/Dependency.hs @@ -11,13 +11,11 @@ module Distribution.Types.Dependency , depLibraries , simplifyDependency , mainLibSet - , PrivateDependency(..) - , PrivateAlias(..) - - , Dependencies(..) - , IsPrivate(..) + , PrivateDependency (..) + , PrivateAlias (..) + , Dependencies (..) + , IsPrivate (..) , mapDependencies - , allDependencies ) where import Distribution.Compat.Prelude @@ -27,7 +25,7 @@ import Distribution.Types.VersionRange (isAnyVersionLight) import Distribution.Version (VersionRange, anyVersion, simplifyVersionRange) import Distribution.CabalSpecVersion -import Distribution.Compat.CharParsing (char, spaces, CharParsing (string), anyChar, satisfy) +import Distribution.Compat.CharParsing (char, spaces) import Distribution.Compat.Parsing (between, option) import Distribution.Parsec import Distribution.Pretty @@ -35,14 +33,14 @@ import Distribution.Types.LibraryName import Distribution.Types.PackageName import Distribution.Types.UnqualComponentName +import qualified Distribution.Compat.CharParsing as P import qualified Distribution.Compat.NonEmptySet as NES -import qualified Text.PrettyPrint as PP import Distribution.ModuleName -import qualified Distribution.Compat.CharParsing as P +import qualified Text.PrettyPrint as PP -data IsPrivate = Private (PrivateAlias, [PackageName]) | Public deriving (Show, Ord, Read, Eq) +data IsPrivate = Private PrivateAlias | Public deriving (Show, Ord, Read, Eq) -data Dependencies = Dependencies { publicDependencies :: [Dependency], privateDependencies :: [PrivateDependency] } deriving (Eq, Show, Generic, Data) +data Dependencies = Dependencies {publicDependencies :: [Dependency], privateDependencies :: [PrivateDependency]} deriving (Eq, Show, Generic, Data) newtype PrivateAlias = PrivateAlias ModuleName deriving (Show, Eq, Generic, Data, Read, Ord) @@ -52,14 +50,21 @@ instance Pretty PrivateAlias where instance Parsec PrivateAlias where parsec = PrivateAlias <$> parsec +-- | Construct a 'PrivateAlias' from a valid module name 'String'. +-- +-- This is just a convenience function intended for valid module strings. It is +-- an error if it is used with a string that is not a valid module name. If you +-- are parsing user input then use 'Distribution.Text.simpleParse' instead. +instance IsString PrivateAlias where + fromString = PrivateAlias . fromString -data PrivateDependency = PrivateDependency { private_alias :: PrivateAlias, private_depends :: [Dependency] } deriving (Eq, Show, Generic, Data, Read, Ord) +data PrivateDependency = PrivateDependency {private_alias :: PrivateAlias, private_depends :: [Dependency]} deriving (Eq, Show, Generic, Data, Read, Ord) instance Parsec PrivateDependency where parsec = do alias <- parsec P.spaces - P.string "with" + _ <- P.string "with" P.spaces let parensLax p = P.between (P.char '(' >> P.spaces) (P.char ')' >> P.spaces) p deps <- parensLax (parsecCommaList parsec) @@ -68,14 +73,6 @@ instance Parsec PrivateDependency where instance Pretty PrivateDependency where pretty (PrivateDependency alias deps) = PP.hsep [pretty alias, PP.text "with", PP.parens (PP.hsep (PP.punctuate PP.comma (map pretty deps)))] --- Footgun -flattenPrivateDepends :: Dependencies -> [Dependency] -flattenPrivateDepends (Dependencies _ priv) = concatMap private_depends priv - --- Footgun -allDependencies :: Dependencies -> [Dependency] -allDependencies (Dependencies pub priv) = pub ++ concatMap private_depends priv - instance Semigroup Dependencies where (Dependencies p1 pr1) <> (Dependencies p2 pr2) = Dependencies (p1 <> p2) (pr1 <> pr2) @@ -83,7 +80,7 @@ instance Monoid Dependencies where mempty = Dependencies mempty mempty mapDependencies :: (Dependency -> Dependency) -> Dependencies -> Dependencies -mapDependencies f (Dependencies pub priv) = Dependencies (map f pub) (map (\d -> d { private_depends = map f (private_depends d) }) priv) +mapDependencies f (Dependencies pub priv) = Dependencies (map f pub) (map (\d -> d{private_depends = map f (private_depends d)}) priv) -- | Describes a dependency on a source package (API) -- @@ -143,6 +140,7 @@ instance NFData PrivateAlias where rnf = genericRnf instance Binary Dependencies instance Structured Dependencies instance NFData Dependencies where rnf = genericRnf + -- | -- -- >>> prettyShow $ Dependency (mkPackageName "pkg") anyVersion mainLibSet @@ -206,7 +204,7 @@ instance Pretty Dependency where -- >>> map (`simpleParsec'` "mylib:sub") [CabalSpecV2_4, CabalSpecV3_0] :: [Maybe Dependency] -- [Nothing,Just (Dependency (PackageName "mylib") (OrLaterVersion (mkVersion [0])) (fromNonEmpty (LSubLibName (UnqualComponentName "sub") :| [])))] instance Parsec Dependency where - parsec :: forall m . CabalParsing m => m Dependency + parsec :: forall m. CabalParsing m => m Dependency parsec = do name <- parsec diff --git a/Cabal-syntax/src/Distribution/Types/Dependency/Lens.hs b/Cabal-syntax/src/Distribution/Types/Dependency/Lens.hs index a5030c6e777..8dfb9d5bd27 100644 --- a/Cabal-syntax/src/Distribution/Types/Dependency/Lens.hs +++ b/Cabal-syntax/src/Distribution/Types/Dependency/Lens.hs @@ -11,4 +11,4 @@ import Distribution.Types.Dependency (Dependency, PrivateDependency) import qualified Distribution.Types.Dependency as T private_depends :: Lens' PrivateDependency [Dependency] -private_depends f d = fmap (\x -> d { T.private_depends = x}) (f (T.private_depends d)) +private_depends f d = fmap (\x -> d{T.private_depends = x}) (f (T.private_depends d)) diff --git a/Cabal-syntax/src/Distribution/Types/DependencyMap.hs b/Cabal-syntax/src/Distribution/Types/DependencyMap.hs index 80f373d42af..8357155e16a 100644 --- a/Cabal-syntax/src/Distribution/Types/DependencyMap.hs +++ b/Cabal-syntax/src/Distribution/Types/DependencyMap.hs @@ -38,16 +38,20 @@ intersectVersionRangesAndJoinComponents (va, ca) (vb, cb) = toDepMap :: Dependencies -> DependencyMap toDepMap ds = - DependencyMap $ Map.fromListWith intersectVersionRangesAndJoinComponents - ( [((p, Public), (vr, cs)) | Dependency p vr cs <- publicDependencies ds] - ++ [((p, Private (pn, map depPkgName pds)), (vr, cs)) | PrivateDependency pn pds <- privateDependencies ds , Dependency p vr cs <- pds ] ) + DependencyMap $ + Map.fromListWith + intersectVersionRangesAndJoinComponents + ( [((p, Public), (vr, cs)) | Dependency p vr cs <- publicDependencies ds] + ++ [((p, Private pn), (vr, cs)) | PrivateDependency pn pds <- privateDependencies ds, Dependency p vr cs <- pds] + ) fromDepMap :: DependencyMap -> Dependencies -fromDepMap m = Dependencies - [Dependency p vr cs | ((p, Public), (vr, cs)) <- Map.toList (unDependencyMap m)] - [PrivateDependency alias deps | (alias, deps) <- Map.toList priv_deps] - where - priv_deps = Map.fromListWith (++) [(sn, [Dependency p vr cs]) | ((p, (Private (sn, _))), (vr, cs)) <- Map.toList (unDependencyMap m)] +fromDepMap m = + Dependencies + [Dependency p vr cs | ((p, Public), (vr, cs)) <- Map.toList (unDependencyMap m)] + [PrivateDependency alias deps | (alias, deps) <- Map.toList priv_deps] + where + priv_deps = Map.fromListWith (++) [(sn, [Dependency p vr cs]) | ((p, (Private sn)), (vr, cs)) <- Map.toList (unDependencyMap m)] -- Apply extra constraints to a dependency map. -- Combines dependencies where the result will only contain keys from the left diff --git a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs index dcebacc0f5d..9d6ad5d2a2b 100644 --- a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs +++ b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs @@ -22,7 +22,7 @@ import Distribution.System (Arch, OS) import Distribution.Types.Benchmark (Benchmark) import Distribution.Types.CondTree (CondTree) import Distribution.Types.ConfVar (ConfVar (..)) -import Distribution.Types.Dependency (Dependency, Dependencies) +import Distribution.Types.Dependency (Dependencies) import Distribution.Types.Executable (Executable) import Distribution.Types.Flag (FlagName, PackageFlag (MkPackageFlag)) import Distribution.Types.ForeignLib (ForeignLib) diff --git a/Cabal-syntax/src/Distribution/Types/PackageDescription.hs b/Cabal-syntax/src/Distribution/Types/PackageDescription.hs index 936f8734e2a..9c9966d63c5 100644 --- a/Cabal-syntax/src/Distribution/Types/PackageDescription.hs +++ b/Cabal-syntax/src/Distribution/Types/PackageDescription.hs @@ -59,8 +59,6 @@ module Distribution.Types.PackageDescription import Distribution.Compat.Prelude import Prelude () -import Control.Monad ((<=<)) - -- lens import Distribution.Types.Benchmark @@ -362,8 +360,8 @@ enabledBuildInfos pkg enabled = allBuildDepends :: PackageDescription -> [(Maybe PrivateAlias, Dependency)] allBuildDepends pd = do bi <- allBuildInfo pd - [(Nothing, d) | d <- targetBuildDepends bi ] - ++ [(Just p, d) | PrivateDependency p ds <- targetPrivateBuildDepends bi, d <- ds ] + [(Nothing, d) | d <- targetBuildDepends bi] + ++ [(Just p, d) | PrivateDependency p ds <- targetPrivateBuildDepends bi, d <- ds] -- | Get the combined build-depends entries of all enabled components, per the -- given request spec. @@ -371,8 +369,8 @@ enabledBuildDepends :: PackageDescription -> ComponentRequestedSpec -> [(Maybe P enabledBuildDepends spec pd = do bi <- enabledBuildInfos spec pd - [(Nothing, d) | d <- targetBuildDepends bi ] - ++ [(Just p, d) | PrivateDependency p ds <- targetPrivateBuildDepends bi, d <- ds ] + [(Nothing, d) | d <- targetBuildDepends bi] + ++ [(Just p, d) | PrivateDependency p ds <- targetPrivateBuildDepends bi, d <- ds] updatePackageDescription :: HookedBuildInfo -> PackageDescription -> PackageDescription updatePackageDescription (mb_lib_bi, exe_bi) p = diff --git a/Cabal-tests/tests/CheckTests.hs b/Cabal-tests/tests/CheckTests.hs index 220cc7d1458..aa2f1e9b041 100644 --- a/Cabal-tests/tests/CheckTests.hs +++ b/Cabal-tests/tests/CheckTests.hs @@ -3,7 +3,6 @@ module Main ) where import Test.Tasty -import Test.Tasty.ExpectedFailure import Test.Tasty.Golden.Advanced (goldenTest) import Data.Algorithm.Diff (PolyDiff (..), getGroupedDiff) diff --git a/Cabal-tests/tests/NoThunks.hs b/Cabal-tests/tests/NoThunks.hs index f388ae1d012..d0700ab28c3 100644 --- a/Cabal-tests/tests/NoThunks.hs +++ b/Cabal-tests/tests/NoThunks.hs @@ -80,6 +80,8 @@ instance NoThunks LibraryVisibility instance NoThunks ForeignLibType instance NoThunks GenericPackageDescription instance NoThunks Dependencies +instance NoThunks PrivateDependency +instance NoThunks PrivateAlias instance NoThunks KnownRepoType instance NoThunks Library instance NoThunks LibraryName diff --git a/Cabal-tests/tests/ParserTests/regressions/Octree-0.5.expr b/Cabal-tests/tests/ParserTests/regressions/Octree-0.5.expr index d754955f46d..3e03a2b0b88 100644 --- a/Cabal-tests/tests/ParserTests/regressions/Octree-0.5.expr +++ b/Cabal-tests/tests/ParserTests/regressions/Octree-0.5.expr @@ -154,26 +154,30 @@ GenericPackageDescription { (OrLaterVersion (mkVersion [2, 4, 0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [4, 0])) + (EarlierVersion + (mkVersion [4, 7]))) + mainLibSet, + Dependency + (PackageName "AC-Vector") (OrLaterVersion - (mkVersion [4, 0])) - (EarlierVersion - (mkVersion [4, 7]))) - mainLibSet, - Dependency - (PackageName "AC-Vector") - (OrLaterVersion - (mkVersion [2, 3, 0])) - mainLibSet, - Dependency - (PackageName "QuickCheck") - (OrLaterVersion - (mkVersion [2, 4, 0])) - mainLibSet], + (mkVersion [2, 3, 0])) + mainLibSet, + Dependency + (PackageName "QuickCheck") + (OrLaterVersion + (mkVersion [2, 4, 0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condSubLibraries = [], condForeignLibs = [], @@ -259,27 +263,31 @@ GenericPackageDescription { (OrLaterVersion (mkVersion [2, 4, 0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [4, 0])) + (EarlierVersion + (mkVersion [4, 7]))) + mainLibSet, + Dependency + (PackageName "AC-Vector") (OrLaterVersion - (mkVersion [4, 0])) - (EarlierVersion - (mkVersion [4, 7]))) - mainLibSet, - Dependency - (PackageName "AC-Vector") - (OrLaterVersion - (mkVersion [2, 3, 0])) - mainLibSet, - Dependency - (PackageName "QuickCheck") - (OrLaterVersion - (mkVersion [2, 4, 0])) - mainLibSet], + (mkVersion [2, 3, 0])) + mainLibSet, + Dependency + (PackageName "QuickCheck") + (OrLaterVersion + (mkVersion [2, 4, 0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, _×_ (UnqualComponentName "readme") @@ -364,30 +372,34 @@ GenericPackageDescription { (PackageName "markdown-unlit") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [4, 0])) + (EarlierVersion + (mkVersion [4, 7]))) + mainLibSet, + Dependency + (PackageName "AC-Vector") (OrLaterVersion - (mkVersion [4, 0])) - (EarlierVersion - (mkVersion [4, 7]))) - mainLibSet, - Dependency - (PackageName "AC-Vector") - (OrLaterVersion - (mkVersion [2, 3, 0])) - mainLibSet, - Dependency - (PackageName "QuickCheck") - (OrLaterVersion - (mkVersion [2, 4, 0])) - mainLibSet, - Dependency - (PackageName "markdown-unlit") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + (mkVersion [2, 3, 0])) + mainLibSet, + Dependency + (PackageName "QuickCheck") + (OrLaterVersion + (mkVersion [2, 4, 0])) + mainLibSet, + Dependency + (PackageName "markdown-unlit") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}], condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/anynone.expr b/Cabal-tests/tests/ParserTests/regressions/anynone.expr index 17e61add696..610851d0f90 100644 --- a/Cabal-tests/tests/ParserTests/regressions/anynone.expr +++ b/Cabal-tests/tests/ParserTests/regressions/anynone.expr @@ -103,12 +103,16 @@ GenericPackageDescription { (PackageName "base") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condSubLibraries = [], condForeignLibs = [], diff --git a/Cabal-tests/tests/ParserTests/regressions/big-version.expr b/Cabal-tests/tests/ParserTests/regressions/big-version.expr index 943e723c191..5e093f14d59 100644 --- a/Cabal-tests/tests/ParserTests/regressions/big-version.expr +++ b/Cabal-tests/tests/ParserTests/regressions/big-version.expr @@ -100,8 +100,12 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = []}, condSubLibraries = [], condForeignLibs = [], diff --git a/Cabal-tests/tests/ParserTests/regressions/common-conditional.expr b/Cabal-tests/tests/ParserTests/regressions/common-conditional.expr index 874b4964267..5b35b025cf7 100644 --- a/Cabal-tests/tests/ParserTests/regressions/common-conditional.expr +++ b/Cabal-tests/tests/ParserTests/regressions/common-conditional.expr @@ -120,12 +120,16 @@ GenericPackageDescription { (PackageName "ghc-prim") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "ghc-prim") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "ghc-prim") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = [ CondBranch { condBranchCondition = @@ -203,20 +207,24 @@ GenericPackageDescription { (PackageName "containers") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [4, 10])) - (EarlierVersion - (mkVersion [4, 11]))) - mainLibSet, - Dependency - (PackageName "containers") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [4, 10])) + (EarlierVersion + (mkVersion [4, 11]))) + mainLibSet, + Dependency + (PackageName "containers") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = [ CondBranch { condBranchCondition = @@ -286,12 +294,16 @@ GenericPackageDescription { (PackageName "Win32") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "Win32") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "Win32") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}]}, condBranchIfFalse = Nothing}]}, @@ -364,13 +376,17 @@ GenericPackageDescription { (PackageName "HUnit") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [ - Dependency - (PackageName "HUnit") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "HUnit") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = [ CondBranch { condBranchCondition = @@ -436,9 +452,13 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}, CondBranch { @@ -517,21 +537,25 @@ GenericPackageDescription { (PackageName "containers") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [4, 10])) - (EarlierVersion - (mkVersion [4, 11]))) - mainLibSet, - Dependency - (PackageName "containers") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [4, 10])) + (EarlierVersion + (mkVersion [4, 11]))) + mainLibSet, + Dependency + (PackageName "containers") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = [ CondBranch { condBranchCondition = @@ -601,13 +625,17 @@ GenericPackageDescription { (PackageName "Win32") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [ - Dependency - (PackageName "Win32") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "Win32") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}, CondBranch { @@ -678,13 +706,17 @@ GenericPackageDescription { (PackageName "Win32") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [ - Dependency - (PackageName "Win32") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "Win32") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}]}, condBranchIfFalse = Nothing}]}], diff --git a/Cabal-tests/tests/ParserTests/regressions/common.expr b/Cabal-tests/tests/ParserTests/regressions/common.expr index 9a1c7a53df0..1f6ad22a4df 100644 --- a/Cabal-tests/tests/ParserTests/regressions/common.expr +++ b/Cabal-tests/tests/ParserTests/regressions/common.expr @@ -118,12 +118,16 @@ GenericPackageDescription { (PackageName "ghc-prim") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "ghc-prim") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "ghc-prim") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condSubLibraries = [], condForeignLibs = [], @@ -194,12 +198,16 @@ GenericPackageDescription { (PackageName "HUnit") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [ - Dependency - (PackageName "HUnit") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "HUnit") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}], condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/common2.expr b/Cabal-tests/tests/ParserTests/regressions/common2.expr index f74c75224ef..1edc9af4939 100644 --- a/Cabal-tests/tests/ParserTests/regressions/common2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/common2.expr @@ -126,24 +126,28 @@ GenericPackageDescription { (PackageName "ghc-prim") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [4, 10])) - (EarlierVersion - (mkVersion [4, 11]))) - mainLibSet, - Dependency - (PackageName "containers") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "ghc-prim") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [4, 10])) + (EarlierVersion + (mkVersion [4, 11]))) + mainLibSet, + Dependency + (PackageName "containers") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "ghc-prim") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = [ CondBranch { condBranchCondition = @@ -213,12 +217,16 @@ GenericPackageDescription { (PackageName "Win32") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "Win32") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "Win32") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}]}, condSubLibraries = [ @@ -305,24 +313,28 @@ GenericPackageDescription { (PackageName "ghc-prim") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [4, 10])) - (EarlierVersion - (mkVersion [4, 11]))) - mainLibSet, - Dependency - (PackageName "containers") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "ghc-prim") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [4, 10])) + (EarlierVersion + (mkVersion [4, 11]))) + mainLibSet, + Dependency + (PackageName "containers") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "ghc-prim") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = [ CondBranch { condBranchCondition = @@ -394,12 +406,16 @@ GenericPackageDescription { (PackageName "Win32") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "Win32") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "Win32") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}]}], condForeignLibs = [], @@ -482,25 +498,29 @@ GenericPackageDescription { (PackageName "HUnit") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [4, 10])) - (EarlierVersion - (mkVersion [4, 11]))) - mainLibSet, - Dependency - (PackageName "containers") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "HUnit") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [4, 10])) + (EarlierVersion + (mkVersion [4, 11]))) + mainLibSet, + Dependency + (PackageName "containers") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "HUnit") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = [ CondBranch { condBranchCondition = @@ -570,13 +590,17 @@ GenericPackageDescription { (PackageName "Win32") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [ - Dependency - (PackageName "Win32") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "Win32") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}, CondBranch { @@ -647,13 +671,17 @@ GenericPackageDescription { (PackageName "Win32") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [ - Dependency - (PackageName "Win32") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "Win32") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}, CondBranch { @@ -720,9 +748,13 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}]}], condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/common3.expr b/Cabal-tests/tests/ParserTests/regressions/common3.expr index 91c43cb0755..fd4bec507a9 100644 --- a/Cabal-tests/tests/ParserTests/regressions/common3.expr +++ b/Cabal-tests/tests/ParserTests/regressions/common3.expr @@ -118,12 +118,16 @@ GenericPackageDescription { (PackageName "ghc-prim") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "ghc-prim") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "ghc-prim") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condSubLibraries = [], condForeignLibs = [], @@ -206,24 +210,28 @@ GenericPackageDescription { (PackageName "HUnit") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [4, 10])) - (EarlierVersion - (mkVersion [4, 11]))) - mainLibSet, - Dependency - (PackageName "containers") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "HUnit") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [4, 10])) + (EarlierVersion + (mkVersion [4, 11]))) + mainLibSet, + Dependency + (PackageName "containers") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "HUnit") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}], condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/elif.expr b/Cabal-tests/tests/ParserTests/regressions/elif.expr index b9ea1f18bc9..2baf32ef0ef 100644 --- a/Cabal-tests/tests/ParserTests/regressions/elif.expr +++ b/Cabal-tests/tests/ParserTests/regressions/elif.expr @@ -1,184 +1,203 @@ -GenericPackageDescription - {condBenchmarks = [], - condExecutables = [], - condForeignLibs = [], - condLibrary = Just - CondNode - {condTreeComponents = [CondBranch - {condBranchCondition = `Var (OS Linux)`, - condBranchIfFalse = Nothing, - condBranchIfTrue = CondNode - {condTreeComponents = [], - condTreeConstraints = [Dependency - (PackageName - "unix") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet], - condTreeData = Library - {exposedModules = [], - libBuildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = True, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Nothing, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [], - oldExtensions = [], - options = PerCompilerFlavor - [] - [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor - [] - [], - sharedOptions = PerCompilerFlavor - [] - [], - staticOptions = PerCompilerFlavor - [] - [], - targetBuildDepends = [Dependency - (PackageName - "unix") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet], - virtualModules = []}, - libExposed = True, - libName = LMainLibName, - libVisibility = LibraryVisibilityPublic, - reexportedModules = [], - signatures = []}}}], - condTreeConstraints = [], - condTreeData = Library - {exposedModules = [ModuleName "ElseIf"], - libBuildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = True, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Just Haskell2010, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [], - oldExtensions = [], - options = PerCompilerFlavor [] [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor [] [], - sharedOptions = PerCompilerFlavor [] [], - staticOptions = PerCompilerFlavor [] [], - targetBuildDepends = [], - virtualModules = []}, - libExposed = True, - libName = LMainLibName, - libVisibility = LibraryVisibilityPublic, - reexportedModules = [], - signatures = []}}, - condSubLibraries = [], - condTestSuites = [], - genPackageFlags = [], - gpdScannedVersion = Nothing, - packageDescription = PackageDescription - {author = "", - benchmarks = [], - bugReports = "", - buildTypeRaw = Just Simple, - category = "", - copyright = "", - customFieldsPD = [], - dataDir = ".", - dataFiles = [], - description = "", - executables = [], - extraDocFiles = [], - extraSrcFiles = [], - extraTmpFiles = [], - foreignLibs = [], - homepage = "", - library = Nothing, - licenseFiles = [], - licenseRaw = Left NONE, - maintainer = "", - package = PackageIdentifier - {pkgName = PackageName "elif", pkgVersion = mkVersion [0]}, - pkgUrl = "", - setupBuildInfo = Nothing, - sourceRepos = [SourceRepo - {repoBranch = Nothing, - repoKind = RepoHead, - repoLocation = Just "https://github.com/hvr/-.git", - repoModule = Nothing, - repoSubdir = Nothing, - repoTag = Nothing, - repoType = Just (KnownRepoType Git)}], - specVersion = CabalSpecV1_10, - stability = "", - subLibraries = [], - synopsis = "The elif demo", - testSuites = [], - testedWith = []}} +GenericPackageDescription { + packageDescription = + PackageDescription { + specVersion = CabalSpecV1_10, + package = PackageIdentifier { + pkgName = PackageName "elif", + pkgVersion = mkVersion [0]}, + licenseRaw = Left NONE, + licenseFiles = [], + copyright = "", + maintainer = "", + author = "", + stability = "", + testedWith = [], + homepage = "", + pkgUrl = "", + bugReports = "", + sourceRepos = [ + SourceRepo { + repoKind = RepoHead, + repoType = Just + (KnownRepoType Git), + repoLocation = Just + "https://github.com/hvr/-.git", + repoModule = Nothing, + repoBranch = Nothing, + repoTag = Nothing, + repoSubdir = Nothing}], + synopsis = "The elif demo", + description = "", + category = "", + customFieldsPD = [], + buildTypeRaw = Just Simple, + setupBuildInfo = Nothing, + library = Nothing, + subLibraries = [], + executables = [], + foreignLibs = [], + testSuites = [], + benchmarks = [], + dataFiles = [], + dataDir = ".", + extraSrcFiles = [], + extraTmpFiles = [], + extraDocFiles = []}, + gpdScannedVersion = Nothing, + genPackageFlags = [], + condLibrary = Just + CondNode { + condTreeData = Library { + libName = LMainLibName, + exposedModules = [ + ModuleName "ElseIf"], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPublic, + libBuildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Just + Haskell2010, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [], + targetPrivateBuildDepends = [], + mixins = []}}, + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, + condTreeComponents = [ + CondBranch { + condBranchCondition = + `Var (OS Linux)`, + condBranchIfTrue = CondNode { + condTreeData = Library { + libName = LMainLibName, + exposedModules = [], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPublic, + libBuildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Nothing, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [ + Dependency + (PackageName "unix") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + targetPrivateBuildDepends = [], + mixins = []}}, + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "unix") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, + condTreeComponents = []}, + condBranchIfFalse = Nothing}]}, + condSubLibraries = [], + condForeignLibs = [], + condExecutables = [], + condTestSuites = [], + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/elif2.expr b/Cabal-tests/tests/ParserTests/regressions/elif2.expr index b4e7be7dc75..05f0f3852b1 100644 --- a/Cabal-tests/tests/ParserTests/regressions/elif2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/elif2.expr @@ -1,393 +1,419 @@ -GenericPackageDescription - {condBenchmarks = [], - condExecutables = [], - condForeignLibs = [], - condLibrary = Just - CondNode - {condTreeComponents = [CondBranch - {condBranchCondition = `Var (OS Linux)`, - condBranchIfFalse = Just - CondNode - {condTreeComponents = [CondBranch - {condBranchCondition = `Var (OS Windows)`, - condBranchIfFalse = Just - CondNode - {condTreeComponents = [], - condTreeConstraints = [], - condTreeData = Library - {exposedModules = [], - libBuildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = False, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Nothing, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [], - oldExtensions = [], - options = PerCompilerFlavor - [] - [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor - [] - [], - sharedOptions = PerCompilerFlavor - [] - [], - staticOptions = PerCompilerFlavor - [] - [], - targetBuildDepends = [], - virtualModules = []}, - libExposed = True, - libName = LMainLibName, - libVisibility = LibraryVisibilityPublic, - reexportedModules = [], - signatures = []}}, - condBranchIfTrue = CondNode - {condTreeComponents = [], - condTreeConstraints = [Dependency - (PackageName - "Win32") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet], - condTreeData = Library - {exposedModules = [], - libBuildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = True, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Nothing, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [], - oldExtensions = [], - options = PerCompilerFlavor - [] - [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor - [] - [], - sharedOptions = PerCompilerFlavor - [] - [], - staticOptions = PerCompilerFlavor - [] - [], - targetBuildDepends = [Dependency - (PackageName - "Win32") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet], - virtualModules = []}, - libExposed = True, - libName = LMainLibName, - libVisibility = LibraryVisibilityPublic, - reexportedModules = [], - signatures = []}}}], - condTreeConstraints = [], - condTreeData = Library - {exposedModules = [], - libBuildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = True, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Nothing, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [], - oldExtensions = [], - options = PerCompilerFlavor - [] - [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor - [] - [], - sharedOptions = PerCompilerFlavor - [] - [], - staticOptions = PerCompilerFlavor - [] - [], - targetBuildDepends = [], - virtualModules = []}, - libExposed = True, - libName = LMainLibName, - libVisibility = LibraryVisibilityPublic, - reexportedModules = [], - signatures = []}}, - condBranchIfTrue = CondNode - {condTreeComponents = [], - condTreeConstraints = [Dependency - (PackageName - "unix") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet], - condTreeData = Library - {exposedModules = [], - libBuildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = True, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Nothing, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [], - oldExtensions = [], - options = PerCompilerFlavor - [] - [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor - [] - [], - sharedOptions = PerCompilerFlavor - [] - [], - staticOptions = PerCompilerFlavor - [] - [], - targetBuildDepends = [Dependency - (PackageName - "unix") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet], - virtualModules = []}, - libExposed = True, - libName = LMainLibName, - libVisibility = LibraryVisibilityPublic, - reexportedModules = [], - signatures = []}}}], - condTreeConstraints = [], - condTreeData = Library - {exposedModules = [ModuleName "ElseIf"], - libBuildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = True, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Just Haskell2010, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [], - oldExtensions = [], - options = PerCompilerFlavor [] [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor [] [], - sharedOptions = PerCompilerFlavor [] [], - staticOptions = PerCompilerFlavor [] [], - targetBuildDepends = [], - virtualModules = []}, - libExposed = True, - libName = LMainLibName, - libVisibility = LibraryVisibilityPublic, - reexportedModules = [], - signatures = []}}, - condSubLibraries = [], - condTestSuites = [], - genPackageFlags = [], - gpdScannedVersion = Nothing, - packageDescription = PackageDescription - {author = "", - benchmarks = [], - bugReports = "", - buildTypeRaw = Just Simple, - category = "", - copyright = "", - customFieldsPD = [], - dataDir = ".", - dataFiles = [], - description = "", - executables = [], - extraDocFiles = [], - extraSrcFiles = [], - extraTmpFiles = [], - foreignLibs = [], - homepage = "", - library = Nothing, - licenseFiles = [], - licenseRaw = Left NONE, - maintainer = "", - package = PackageIdentifier - {pkgName = PackageName "elif", pkgVersion = mkVersion [0]}, - pkgUrl = "", - setupBuildInfo = Nothing, - sourceRepos = [SourceRepo - {repoBranch = Nothing, - repoKind = RepoHead, - repoLocation = Just "https://github.com/hvr/-.git", - repoModule = Nothing, - repoSubdir = Nothing, - repoTag = Nothing, - repoType = Just (KnownRepoType Git)}], - specVersion = CabalSpecV2_2, - stability = "", - subLibraries = [], - synopsis = "The elif demo", - testSuites = [], - testedWith = []}} +GenericPackageDescription { + packageDescription = + PackageDescription { + specVersion = CabalSpecV2_2, + package = PackageIdentifier { + pkgName = PackageName "elif", + pkgVersion = mkVersion [0]}, + licenseRaw = Left NONE, + licenseFiles = [], + copyright = "", + maintainer = "", + author = "", + stability = "", + testedWith = [], + homepage = "", + pkgUrl = "", + bugReports = "", + sourceRepos = [ + SourceRepo { + repoKind = RepoHead, + repoType = Just + (KnownRepoType Git), + repoLocation = Just + "https://github.com/hvr/-.git", + repoModule = Nothing, + repoBranch = Nothing, + repoTag = Nothing, + repoSubdir = Nothing}], + synopsis = "The elif demo", + description = "", + category = "", + customFieldsPD = [], + buildTypeRaw = Just Simple, + setupBuildInfo = Nothing, + library = Nothing, + subLibraries = [], + executables = [], + foreignLibs = [], + testSuites = [], + benchmarks = [], + dataFiles = [], + dataDir = ".", + extraSrcFiles = [], + extraTmpFiles = [], + extraDocFiles = []}, + gpdScannedVersion = Nothing, + genPackageFlags = [], + condLibrary = Just + CondNode { + condTreeData = Library { + libName = LMainLibName, + exposedModules = [ + ModuleName "ElseIf"], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPublic, + libBuildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Just + Haskell2010, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [], + targetPrivateBuildDepends = [], + mixins = []}}, + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, + condTreeComponents = [ + CondBranch { + condBranchCondition = + `Var (OS Linux)`, + condBranchIfTrue = CondNode { + condTreeData = Library { + libName = LMainLibName, + exposedModules = [], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPublic, + libBuildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Nothing, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [ + Dependency + (PackageName "unix") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + targetPrivateBuildDepends = [], + mixins = []}}, + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "unix") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, + condTreeComponents = []}, + condBranchIfFalse = Just + CondNode { + condTreeData = Library { + libName = LMainLibName, + exposedModules = [], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPublic, + libBuildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Nothing, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [], + targetPrivateBuildDepends = [], + mixins = []}}, + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, + condTreeComponents = [ + CondBranch { + condBranchCondition = + `Var (OS Windows)`, + condBranchIfTrue = CondNode { + condTreeData = Library { + libName = LMainLibName, + exposedModules = [], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPublic, + libBuildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Nothing, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [ + Dependency + (PackageName "Win32") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + targetPrivateBuildDepends = [], + mixins = []}}, + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "Win32") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, + condTreeComponents = []}, + condBranchIfFalse = Just + CondNode { + condTreeData = Library { + libName = LMainLibName, + exposedModules = [], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPublic, + libBuildInfo = BuildInfo { + buildable = False, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Nothing, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [], + targetPrivateBuildDepends = [], + mixins = []}}, + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, + condTreeComponents = []}}]}}]}, + condSubLibraries = [], + condForeignLibs = [], + condExecutables = [], + condTestSuites = [], + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/encoding-0.8.expr b/Cabal-tests/tests/ParserTests/regressions/encoding-0.8.expr index f5447429927..ce2eaaa3ade 100644 --- a/Cabal-tests/tests/ParserTests/regressions/encoding-0.8.expr +++ b/Cabal-tests/tests/ParserTests/regressions/encoding-0.8.expr @@ -1,130 +1,148 @@ -GenericPackageDescription - {condBenchmarks = [], - condExecutables = [], - condForeignLibs = [], - condLibrary = Just - CondNode - {condTreeComponents = [], - condTreeConstraints = [Dependency - (PackageName "base") - (UnionVersionRanges - (LaterVersion (mkVersion [4, 4])) - (ThisVersion (mkVersion [4, 4]))) - mainLibSet], - condTreeData = Library - {exposedModules = [ModuleName "Data.Encoding"], - libBuildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = True, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Nothing, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [], - oldExtensions = [], - options = PerCompilerFlavor - ["-Wall", - "-O2", - "-threaded", - "-rtsopts", - "-with-rtsopts=-N1 -A64m"] - [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor [] [], - sharedOptions = PerCompilerFlavor [] [], - staticOptions = PerCompilerFlavor [] [], - targetBuildDepends = [Dependency - (PackageName - "base") - (UnionVersionRanges - (LaterVersion - (mkVersion - [4, 4])) - (ThisVersion - (mkVersion - [4, 4]))) - mainLibSet], - virtualModules = []}, - libExposed = True, - libName = LMainLibName, - libVisibility = LibraryVisibilityPublic, - reexportedModules = [], - signatures = []}}, - condSubLibraries = [], - condTestSuites = [], - genPackageFlags = [], - gpdScannedVersion = Nothing, - packageDescription = PackageDescription - {author = "", - benchmarks = [], - bugReports = "", - buildTypeRaw = Nothing, - category = "", - copyright = "", - customFieldsPD = [], - dataDir = ".", - dataFiles = [], - description = "", - executables = [], - extraDocFiles = [], - extraSrcFiles = ["README.md", "--", "--"], - extraTmpFiles = [], - foreignLibs = [], - homepage = "", - library = Nothing, - licenseFiles = [], - licenseRaw = Left NONE, - maintainer = "", - package = PackageIdentifier - {pkgName = PackageName "encoding", - pkgVersion = mkVersion [0, 8]}, - pkgUrl = "", - setupBuildInfo = Just - SetupBuildInfo - {defaultSetupDepends = False, - setupDepends = [Dependency - (PackageName "base") - (EarlierVersion (mkVersion [5])) - mainLibSet, - Dependency - (PackageName "ghc-prim") - (OrLaterVersion (mkVersion [0])) - mainLibSet]}, - sourceRepos = [], - specVersion = CabalSpecV1_12, - stability = "", - subLibraries = [], - synopsis = "", - testSuites = [], - testedWith = []}} +GenericPackageDescription { + packageDescription = + PackageDescription { + specVersion = CabalSpecV1_12, + package = PackageIdentifier { + pkgName = PackageName + "encoding", + pkgVersion = mkVersion [0, 8]}, + licenseRaw = Left NONE, + licenseFiles = [], + copyright = "", + maintainer = "", + author = "", + stability = "", + testedWith = [], + homepage = "", + pkgUrl = "", + bugReports = "", + sourceRepos = [], + synopsis = "", + description = "", + category = "", + customFieldsPD = [], + buildTypeRaw = Nothing, + setupBuildInfo = Just + SetupBuildInfo { + setupDepends = [ + Dependency + (PackageName "base") + (EarlierVersion (mkVersion [5])) + mainLibSet, + Dependency + (PackageName "ghc-prim") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + defaultSetupDepends = False}, + library = Nothing, + subLibraries = [], + executables = [], + foreignLibs = [], + testSuites = [], + benchmarks = [], + dataFiles = [], + dataDir = ".", + extraSrcFiles = [ + "README.md", + "--", + "--"], + extraTmpFiles = [], + extraDocFiles = []}, + gpdScannedVersion = Nothing, + genPackageFlags = [], + condLibrary = Just + CondNode { + condTreeData = Library { + libName = LMainLibName, + exposedModules = [ + ModuleName "Data.Encoding"], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPublic, + libBuildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Nothing, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [ + "-Wall", + "-O2", + "-threaded", + "-rtsopts", + "-with-rtsopts=-N1 -A64m"] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [ + Dependency + (PackageName "base") + (UnionVersionRanges + (LaterVersion + (mkVersion [4, 4])) + (ThisVersion + (mkVersion [4, 4]))) + mainLibSet], + targetPrivateBuildDepends = [], + mixins = []}}, + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (UnionVersionRanges + (LaterVersion + (mkVersion [4, 4])) + (ThisVersion + (mkVersion [4, 4]))) + mainLibSet], + privateDependencies = []}, + condTreeComponents = []}, + condSubLibraries = [], + condForeignLibs = [], + condExecutables = [], + condTestSuites = [], + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/generics-sop.expr b/Cabal-tests/tests/ParserTests/regressions/generics-sop.expr index b549eb51f71..0354aa58cf5 100644 --- a/Cabal-tests/tests/ParserTests/regressions/generics-sop.expr +++ b/Cabal-tests/tests/ParserTests/regressions/generics-sop.expr @@ -278,40 +278,44 @@ GenericPackageDescription { (EarlierVersion (mkVersion [1, 5]))) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [4, 7])) - (EarlierVersion - (mkVersion [5]))) - mainLibSet, - Dependency - (PackageName "template-haskell") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [2, 8])) - (EarlierVersion - (mkVersion [2, 13]))) - mainLibSet, - Dependency - (PackageName "ghc-prim") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [0, 3])) - (EarlierVersion - (mkVersion [0, 6]))) - mainLibSet, - Dependency - (PackageName "deepseq") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [1, 3])) - (EarlierVersion - (mkVersion [1, 5]))) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [4, 7])) + (EarlierVersion + (mkVersion [5]))) + mainLibSet, + Dependency + (PackageName "template-haskell") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [2, 8])) + (EarlierVersion + (mkVersion [2, 13]))) + mainLibSet, + Dependency + (PackageName "ghc-prim") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [0, 3])) + (EarlierVersion + (mkVersion [0, 6]))) + mainLibSet, + Dependency + (PackageName "deepseq") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [1, 3])) + (EarlierVersion + (mkVersion [1, 5]))) + mainLibSet], + privateDependencies = []}, condTreeComponents = [ CondBranch { condBranchCondition = @@ -385,16 +389,20 @@ GenericPackageDescription { (EarlierVersion (mkVersion [0, 9]))) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "tagged") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [0, 7])) - (EarlierVersion - (mkVersion [0, 9]))) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "tagged") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [0, 7])) + (EarlierVersion + (mkVersion [0, 9]))) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}, CondBranch { @@ -478,25 +486,29 @@ GenericPackageDescription { (EarlierVersion (mkVersion [0, 6]))) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName - "transformers-compat") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [0, 3])) - (EarlierVersion - (mkVersion [0, 6]))) - mainLibSet, - Dependency - (PackageName "transformers") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [0, 3])) - (EarlierVersion - (mkVersion [0, 6]))) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName + "transformers-compat") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [0, 3])) + (EarlierVersion + (mkVersion [0, 6]))) + mainLibSet, + Dependency + (PackageName "transformers") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [0, 3])) + (EarlierVersion + (mkVersion [0, 6]))) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}, CondBranch { @@ -565,8 +577,12 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}, CondBranch { @@ -635,8 +651,12 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}]}, condSubLibraries = [], @@ -721,21 +741,25 @@ GenericPackageDescription { (EarlierVersion (mkVersion [0, 14]))) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "doctest") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [0, 13])) - (EarlierVersion - (mkVersion [0, 14]))) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "doctest") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [0, 13])) + (EarlierVersion + (mkVersion [0, 14]))) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, _×_ (UnqualComponentName @@ -814,20 +838,24 @@ GenericPackageDescription { (PackageName "generics-sop") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [4, 6])) - (EarlierVersion - (mkVersion [5]))) - mainLibSet, - Dependency - (PackageName "generics-sop") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [4, 6])) + (EarlierVersion + (mkVersion [5]))) + mainLibSet, + Dependency + (PackageName "generics-sop") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}], condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/hasktorch.expr b/Cabal-tests/tests/ParserTests/regressions/hasktorch.expr index 92b76bbb0eb..be30742e678 100644 --- a/Cabal-tests/tests/ParserTests/regressions/hasktorch.expr +++ b/Cabal-tests/tests/ParserTests/regressions/hasktorch.expr @@ -398,80 +398,84 @@ GenericPackageDescription { (EarlierVersion (mkVersion [0, 0, 2]))) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (UnionVersionRanges + (ThisVersion (mkVersion [4, 7])) + (LaterVersion + (mkVersion [4, 7]))) + (EarlierVersion + (mkVersion [5]))) + mainLibSet, + Dependency + (PackageName "dimensions") (UnionVersionRanges - (ThisVersion (mkVersion [4, 7])) + (ThisVersion (mkVersion [1, 0])) (LaterVersion - (mkVersion [4, 7]))) - (EarlierVersion - (mkVersion [5]))) - mainLibSet, - Dependency - (PackageName "dimensions") - (UnionVersionRanges - (ThisVersion (mkVersion [1, 0])) - (LaterVersion - (mkVersion [1, 0]))) - mainLibSet, - Dependency - (PackageName "safe-exceptions") - (UnionVersionRanges - (ThisVersion - (mkVersion [0, 1, 0])) - (LaterVersion - (mkVersion [0, 1, 0]))) - mainLibSet, - Dependency - (PackageName "singletons") - (UnionVersionRanges - (ThisVersion (mkVersion [2, 2])) - (LaterVersion - (mkVersion [2, 2]))) - mainLibSet, - Dependency - (PackageName "text") - (UnionVersionRanges - (ThisVersion - (mkVersion [1, 2, 2])) - (LaterVersion - (mkVersion [1, 2, 2]))) - mainLibSet, - Dependency - (PackageName "hasktorch") - (OrLaterVersion (mkVersion [0])) - (NonEmptySet.fromNonEmpty - (NE.fromList - [ - LSubLibName - (UnqualComponentName - "hasktorch-cpu")])), - Dependency - (PackageName "hasktorch-ffi-th") - (IntersectVersionRanges + (mkVersion [1, 0]))) + mainLibSet, + Dependency + (PackageName "safe-exceptions") (UnionVersionRanges (ThisVersion - (mkVersion [0, 0, 1])) + (mkVersion [0, 1, 0])) + (LaterVersion + (mkVersion [0, 1, 0]))) + mainLibSet, + Dependency + (PackageName "singletons") + (UnionVersionRanges + (ThisVersion (mkVersion [2, 2])) (LaterVersion - (mkVersion [0, 0, 1]))) - (EarlierVersion - (mkVersion [0, 0, 2]))) - mainLibSet, - Dependency - (PackageName - "hasktorch-types-th") - (IntersectVersionRanges + (mkVersion [2, 2]))) + mainLibSet, + Dependency + (PackageName "text") (UnionVersionRanges (ThisVersion - (mkVersion [0, 0, 1])) + (mkVersion [1, 2, 2])) (LaterVersion - (mkVersion [0, 0, 1]))) - (EarlierVersion - (mkVersion [0, 0, 2]))) - mainLibSet], + (mkVersion [1, 2, 2]))) + mainLibSet, + Dependency + (PackageName "hasktorch") + (OrLaterVersion (mkVersion [0])) + (NonEmptySet.fromNonEmpty + (NE.fromList + [ + LSubLibName + (UnqualComponentName + "hasktorch-cpu")])), + Dependency + (PackageName "hasktorch-ffi-th") + (IntersectVersionRanges + (UnionVersionRanges + (ThisVersion + (mkVersion [0, 0, 1])) + (LaterVersion + (mkVersion [0, 0, 1]))) + (EarlierVersion + (mkVersion [0, 0, 2]))) + mainLibSet, + Dependency + (PackageName + "hasktorch-types-th") + (IntersectVersionRanges + (UnionVersionRanges + (ThisVersion + (mkVersion [0, 0, 1])) + (LaterVersion + (mkVersion [0, 0, 1]))) + (EarlierVersion + (mkVersion [0, 0, 2]))) + mainLibSet], + privateDependencies = []}, condTreeComponents = [ CondBranch { condBranchCondition = @@ -646,8 +650,12 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}, CondBranch { @@ -897,17 +905,21 @@ GenericPackageDescription { LSubLibName (UnqualComponentName "hasktorch-gpu")]))], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "hasktorch") - (OrLaterVersion (mkVersion [0])) - (NonEmptySet.fromNonEmpty - (NE.fromList - [ - LSubLibName - (UnqualComponentName - "hasktorch-gpu")]))], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "hasktorch") + (OrLaterVersion (mkVersion [0])) + (NonEmptySet.fromNonEmpty + (NE.fromList + [ + LSubLibName + (UnqualComponentName + "hasktorch-gpu")]))], + privateDependencies = []}, condTreeComponents = [ CondBranch { condBranchCondition = @@ -1088,8 +1100,12 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}]}, condBranchIfFalse = Nothing}]}, @@ -1535,6 +1551,7 @@ GenericPackageDescription { LSubLibName (UnqualComponentName "hasktorch-indef-signed")]))], + targetPrivateBuildDepends = [], mixins = [ Mixin { @@ -2582,100 +2599,103 @@ GenericPackageDescription { "Torch.Sig.Tensor.Random.THC") (ModuleName "Torch.Undefined.Double.Tensor.Random.THC")]}}]}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (UnionVersionRanges + (ThisVersion (mkVersion [4, 7])) + (LaterVersion + (mkVersion [4, 7]))) + (EarlierVersion + (mkVersion [5]))) + mainLibSet, + Dependency + (PackageName + "hasktorch-types-th") + (IntersectVersionRanges + (UnionVersionRanges + (ThisVersion + (mkVersion [0, 0, 1])) + (LaterVersion + (mkVersion [0, 0, 1]))) + (EarlierVersion + (mkVersion [0, 0, 2]))) + mainLibSet, + Dependency + (PackageName "dimensions") (UnionVersionRanges - (ThisVersion (mkVersion [4, 7])) + (ThisVersion (mkVersion [1, 0])) (LaterVersion - (mkVersion [4, 7]))) - (EarlierVersion - (mkVersion [5]))) - mainLibSet, - Dependency - (PackageName - "hasktorch-types-th") - (IntersectVersionRanges + (mkVersion [1, 0]))) + mainLibSet, + Dependency + (PackageName "hasktorch-ffi-th") + (IntersectVersionRanges + (UnionVersionRanges + (ThisVersion + (mkVersion [0, 0, 1])) + (LaterVersion + (mkVersion [0, 0, 1]))) + (EarlierVersion + (mkVersion [0, 0, 2]))) + mainLibSet, + Dependency + (PackageName + "hasktorch-types-th") + (IntersectVersionRanges + (UnionVersionRanges + (ThisVersion + (mkVersion [0, 0, 1])) + (LaterVersion + (mkVersion [0, 0, 1]))) + (EarlierVersion + (mkVersion [0, 0, 2]))) + mainLibSet, + Dependency + (PackageName "safe-exceptions") (UnionVersionRanges (ThisVersion - (mkVersion [0, 0, 1])) + (mkVersion [0, 1, 0])) (LaterVersion - (mkVersion [0, 0, 1]))) - (EarlierVersion - (mkVersion [0, 0, 2]))) - mainLibSet, - Dependency - (PackageName "dimensions") - (UnionVersionRanges - (ThisVersion (mkVersion [1, 0])) - (LaterVersion - (mkVersion [1, 0]))) - mainLibSet, - Dependency - (PackageName "hasktorch-ffi-th") - (IntersectVersionRanges + (mkVersion [0, 1, 0]))) + mainLibSet, + Dependency + (PackageName "singletons") (UnionVersionRanges - (ThisVersion - (mkVersion [0, 0, 1])) + (ThisVersion (mkVersion [2, 2])) (LaterVersion - (mkVersion [0, 0, 1]))) - (EarlierVersion - (mkVersion [0, 0, 2]))) - mainLibSet, - Dependency - (PackageName - "hasktorch-types-th") - (IntersectVersionRanges + (mkVersion [2, 2]))) + mainLibSet, + Dependency + (PackageName "text") (UnionVersionRanges (ThisVersion - (mkVersion [0, 0, 1])) + (mkVersion [1, 2, 2])) (LaterVersion - (mkVersion [0, 0, 1]))) - (EarlierVersion - (mkVersion [0, 0, 2]))) - mainLibSet, - Dependency - (PackageName "safe-exceptions") - (UnionVersionRanges - (ThisVersion - (mkVersion [0, 1, 0])) - (LaterVersion - (mkVersion [0, 1, 0]))) - mainLibSet, - Dependency - (PackageName "singletons") - (UnionVersionRanges - (ThisVersion (mkVersion [2, 2])) - (LaterVersion - (mkVersion [2, 2]))) - mainLibSet, - Dependency - (PackageName "text") - (UnionVersionRanges - (ThisVersion - (mkVersion [1, 2, 2])) - (LaterVersion - (mkVersion [1, 2, 2]))) - mainLibSet, - Dependency - (PackageName "hasktorch") - (OrLaterVersion (mkVersion [0])) - (NonEmptySet.fromNonEmpty - (NE.fromList - [ - LSubLibName - (UnqualComponentName - "hasktorch-indef-floating")])), - Dependency - (PackageName "hasktorch") - (OrLaterVersion (mkVersion [0])) - (NonEmptySet.fromNonEmpty - (NE.fromList - [ - LSubLibName - (UnqualComponentName - "hasktorch-indef-signed")]))], + (mkVersion [1, 2, 2]))) + mainLibSet, + Dependency + (PackageName "hasktorch") + (OrLaterVersion (mkVersion [0])) + (NonEmptySet.fromNonEmpty + (NE.fromList + [ + LSubLibName + (UnqualComponentName + "hasktorch-indef-floating")])), + Dependency + (PackageName "hasktorch") + (OrLaterVersion (mkVersion [0])) + (NonEmptySet.fromNonEmpty + (NE.fromList + [ + LSubLibName + (UnqualComponentName + "hasktorch-indef-signed")]))], + privateDependencies = []}, condTreeComponents = [ CondBranch { @@ -2744,8 +2764,12 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Just @@ -2842,6 +2866,7 @@ GenericPackageDescription { LSubLibName (UnqualComponentName "hasktorch-indef-unsigned")]))], + targetPrivateBuildDepends = [], mixins = [ Mixin { @@ -4840,16 +4865,19 @@ GenericPackageDescription { "Torch.Sig.Tensor.Random.THC") (ModuleName "Torch.Undefined.Float.Tensor.Random.THC")]}}]}}, - condTreeConstraints = [ - Dependency - (PackageName "hasktorch") - (OrLaterVersion (mkVersion [0])) - (NonEmptySet.fromNonEmpty - (NE.fromList - [ - LSubLibName - (UnqualComponentName - "hasktorch-indef-unsigned")]))], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "hasktorch") + (OrLaterVersion (mkVersion [0])) + (NonEmptySet.fromNonEmpty + (NE.fromList + [ + LSubLibName + (UnqualComponentName + "hasktorch-indef-unsigned")]))], + privateDependencies = []}, condTreeComponents = []}}]}, _×_ (UnqualComponentName @@ -5193,6 +5221,7 @@ GenericPackageDescription { (EarlierVersion (mkVersion [0, 0, 2]))) mainLibSet], + targetPrivateBuildDepends = [], mixins = [ Mixin { @@ -6242,124 +6271,127 @@ GenericPackageDescription { "Torch.Sig.Tensor.Random.THC") (ModuleName "Torch.FFI.THC.Double.TensorRandom")]}}]}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges - (UnionVersionRanges - (ThisVersion (mkVersion [4, 7])) - (LaterVersion - (mkVersion [4, 7]))) - (EarlierVersion - (mkVersion [5]))) - mainLibSet, - Dependency - (PackageName - "hasktorch-types-th") - (IntersectVersionRanges - (UnionVersionRanges - (ThisVersion - (mkVersion [0, 0, 1])) - (LaterVersion - (mkVersion [0, 0, 1]))) - (EarlierVersion - (mkVersion [0, 0, 2]))) - mainLibSet, - Dependency - (PackageName "dimensions") - (UnionVersionRanges - (ThisVersion (mkVersion [1, 0])) - (LaterVersion - (mkVersion [1, 0]))) - mainLibSet, - Dependency - (PackageName "hasktorch-ffi-th") - (IntersectVersionRanges + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (UnionVersionRanges + (ThisVersion (mkVersion [4, 7])) + (LaterVersion + (mkVersion [4, 7]))) + (EarlierVersion + (mkVersion [5]))) + mainLibSet, + Dependency + (PackageName + "hasktorch-types-th") + (IntersectVersionRanges + (UnionVersionRanges + (ThisVersion + (mkVersion [0, 0, 1])) + (LaterVersion + (mkVersion [0, 0, 1]))) + (EarlierVersion + (mkVersion [0, 0, 2]))) + mainLibSet, + Dependency + (PackageName "dimensions") (UnionVersionRanges - (ThisVersion - (mkVersion [0, 0, 1])) + (ThisVersion (mkVersion [1, 0])) (LaterVersion - (mkVersion [0, 0, 1]))) - (EarlierVersion - (mkVersion [0, 0, 2]))) - mainLibSet, - Dependency - (PackageName - "hasktorch-types-th") - (IntersectVersionRanges + (mkVersion [1, 0]))) + mainLibSet, + Dependency + (PackageName "hasktorch-ffi-th") + (IntersectVersionRanges + (UnionVersionRanges + (ThisVersion + (mkVersion [0, 0, 1])) + (LaterVersion + (mkVersion [0, 0, 1]))) + (EarlierVersion + (mkVersion [0, 0, 2]))) + mainLibSet, + Dependency + (PackageName + "hasktorch-types-th") + (IntersectVersionRanges + (UnionVersionRanges + (ThisVersion + (mkVersion [0, 0, 1])) + (LaterVersion + (mkVersion [0, 0, 1]))) + (EarlierVersion + (mkVersion [0, 0, 2]))) + mainLibSet, + Dependency + (PackageName "safe-exceptions") (UnionVersionRanges (ThisVersion - (mkVersion [0, 0, 1])) + (mkVersion [0, 1, 0])) (LaterVersion - (mkVersion [0, 0, 1]))) - (EarlierVersion - (mkVersion [0, 0, 2]))) - mainLibSet, - Dependency - (PackageName "safe-exceptions") - (UnionVersionRanges - (ThisVersion - (mkVersion [0, 1, 0])) - (LaterVersion - (mkVersion [0, 1, 0]))) - mainLibSet, - Dependency - (PackageName "singletons") - (UnionVersionRanges - (ThisVersion (mkVersion [2, 2])) - (LaterVersion - (mkVersion [2, 2]))) - mainLibSet, - Dependency - (PackageName "text") - (UnionVersionRanges - (ThisVersion - (mkVersion [1, 2, 2])) - (LaterVersion - (mkVersion [1, 2, 2]))) - mainLibSet, - Dependency - (PackageName "hasktorch") - (OrLaterVersion (mkVersion [0])) - (NonEmptySet.fromNonEmpty - (NE.fromList - [ - LSubLibName - (UnqualComponentName - "hasktorch-indef-floating")])), - Dependency - (PackageName "hasktorch") - (OrLaterVersion (mkVersion [0])) - (NonEmptySet.fromNonEmpty - (NE.fromList - [ - LSubLibName - (UnqualComponentName - "hasktorch-indef-signed")])), - Dependency - (PackageName - "hasktorch-ffi-thc") - (IntersectVersionRanges + (mkVersion [0, 1, 0]))) + mainLibSet, + Dependency + (PackageName "singletons") (UnionVersionRanges - (ThisVersion - (mkVersion [0, 0, 1])) + (ThisVersion (mkVersion [2, 2])) (LaterVersion - (mkVersion [0, 0, 1]))) - (EarlierVersion - (mkVersion [0, 0, 2]))) - mainLibSet, - Dependency - (PackageName - "hasktorch-types-thc") - (IntersectVersionRanges + (mkVersion [2, 2]))) + mainLibSet, + Dependency + (PackageName "text") (UnionVersionRanges (ThisVersion - (mkVersion [0, 0, 1])) + (mkVersion [1, 2, 2])) (LaterVersion - (mkVersion [0, 0, 1]))) - (EarlierVersion - (mkVersion [0, 0, 2]))) - mainLibSet], + (mkVersion [1, 2, 2]))) + mainLibSet, + Dependency + (PackageName "hasktorch") + (OrLaterVersion (mkVersion [0])) + (NonEmptySet.fromNonEmpty + (NE.fromList + [ + LSubLibName + (UnqualComponentName + "hasktorch-indef-floating")])), + Dependency + (PackageName "hasktorch") + (OrLaterVersion (mkVersion [0])) + (NonEmptySet.fromNonEmpty + (NE.fromList + [ + LSubLibName + (UnqualComponentName + "hasktorch-indef-signed")])), + Dependency + (PackageName + "hasktorch-ffi-thc") + (IntersectVersionRanges + (UnionVersionRanges + (ThisVersion + (mkVersion [0, 0, 1])) + (LaterVersion + (mkVersion [0, 0, 1]))) + (EarlierVersion + (mkVersion [0, 0, 2]))) + mainLibSet, + Dependency + (PackageName + "hasktorch-types-thc") + (IntersectVersionRanges + (UnionVersionRanges + (ThisVersion + (mkVersion [0, 0, 1])) + (LaterVersion + (mkVersion [0, 0, 1]))) + (EarlierVersion + (mkVersion [0, 0, 2]))) + mainLibSet], + privateDependencies = []}, condTreeComponents = [ CondBranch { @@ -6428,8 +6460,12 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Just @@ -6527,6 +6563,7 @@ GenericPackageDescription { LSubLibName (UnqualComponentName "hasktorch-indef-unsigned")]))], + targetPrivateBuildDepends = [], mixins = [ Mixin { @@ -7823,16 +7860,19 @@ GenericPackageDescription { "Torch.Sig.Tensor.Math.Pointwise.Signed") (ModuleName "Torch.FFI.THC.Int.TensorMathPointwise")]}}]}}, - condTreeConstraints = [ - Dependency - (PackageName "hasktorch") - (OrLaterVersion (mkVersion [0])) - (NonEmptySet.fromNonEmpty - (NE.fromList - [ - LSubLibName - (UnqualComponentName - "hasktorch-indef-unsigned")]))], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "hasktorch") + (OrLaterVersion (mkVersion [0])) + (NonEmptySet.fromNonEmpty + (NE.fromList + [ + LSubLibName + (UnqualComponentName + "hasktorch-indef-unsigned")]))], + privateDependencies = []}, condTreeComponents = []}}]}, _×_ (UnqualComponentName @@ -8212,6 +8252,7 @@ GenericPackageDescription { (PackageName "hasktorch-indef") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = [ Mixin { mixinPackageName = PackageName @@ -8278,33 +8319,36 @@ GenericPackageDescription { "Torch.Sig.Tensor.Random.THC") (ModuleName "Torch.Undefined.Tensor.Random.THC")]}}]}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges - (UnionVersionRanges - (ThisVersion (mkVersion [4, 7])) - (LaterVersion - (mkVersion [4, 7]))) - (EarlierVersion - (mkVersion [5]))) - mainLibSet, - Dependency - (PackageName - "hasktorch-signatures-partial") - (IntersectVersionRanges - (UnionVersionRanges - (ThisVersion - (mkVersion [0, 0, 1])) - (LaterVersion - (mkVersion [0, 0, 1]))) - (EarlierVersion - (mkVersion [0, 0, 2]))) - mainLibSet, - Dependency - (PackageName "hasktorch-indef") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (UnionVersionRanges + (ThisVersion (mkVersion [4, 7])) + (LaterVersion + (mkVersion [4, 7]))) + (EarlierVersion + (mkVersion [5]))) + mainLibSet, + Dependency + (PackageName + "hasktorch-signatures-partial") + (IntersectVersionRanges + (UnionVersionRanges + (ThisVersion + (mkVersion [0, 0, 1])) + (LaterVersion + (mkVersion [0, 0, 1]))) + (EarlierVersion + (mkVersion [0, 0, 2]))) + mainLibSet, + Dependency + (PackageName "hasktorch-indef") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, _×_ (UnqualComponentName @@ -8700,6 +8744,7 @@ GenericPackageDescription { (PackageName "hasktorch-indef") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = [ Mixin { mixinPackageName = PackageName @@ -8761,33 +8806,36 @@ GenericPackageDescription { "Torch.Sig.Tensor.Random.THC") (ModuleName "Torch.Undefined.Tensor.Random.THC")]}}]}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges - (UnionVersionRanges - (ThisVersion (mkVersion [4, 7])) - (LaterVersion - (mkVersion [4, 7]))) - (EarlierVersion - (mkVersion [5]))) - mainLibSet, - Dependency - (PackageName - "hasktorch-signatures-partial") - (IntersectVersionRanges - (UnionVersionRanges - (ThisVersion - (mkVersion [0, 0, 1])) - (LaterVersion - (mkVersion [0, 0, 1]))) - (EarlierVersion - (mkVersion [0, 0, 2]))) - mainLibSet, - Dependency - (PackageName "hasktorch-indef") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (UnionVersionRanges + (ThisVersion (mkVersion [4, 7])) + (LaterVersion + (mkVersion [4, 7]))) + (EarlierVersion + (mkVersion [5]))) + mainLibSet, + Dependency + (PackageName + "hasktorch-signatures-partial") + (IntersectVersionRanges + (UnionVersionRanges + (ThisVersion + (mkVersion [0, 0, 1])) + (LaterVersion + (mkVersion [0, 0, 1]))) + (EarlierVersion + (mkVersion [0, 0, 2]))) + mainLibSet, + Dependency + (PackageName "hasktorch-indef") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, _×_ (UnqualComponentName @@ -9463,34 +9511,38 @@ GenericPackageDescription { (EarlierVersion (mkVersion [0, 0, 2]))) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges - (UnionVersionRanges - (ThisVersion (mkVersion [4, 7])) - (LaterVersion - (mkVersion [4, 7]))) - (EarlierVersion - (mkVersion [5]))) - mainLibSet, - Dependency - (PackageName "hasktorch-indef") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName - "hasktorch-signatures-partial") - (IntersectVersionRanges - (UnionVersionRanges - (ThisVersion - (mkVersion [0, 0, 1])) - (LaterVersion - (mkVersion [0, 0, 1]))) - (EarlierVersion - (mkVersion [0, 0, 2]))) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (UnionVersionRanges + (ThisVersion (mkVersion [4, 7])) + (LaterVersion + (mkVersion [4, 7]))) + (EarlierVersion + (mkVersion [5]))) + mainLibSet, + Dependency + (PackageName "hasktorch-indef") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName + "hasktorch-signatures-partial") + (IntersectVersionRanges + (UnionVersionRanges + (ThisVersion + (mkVersion [0, 0, 1])) + (LaterVersion + (mkVersion [0, 0, 1]))) + (EarlierVersion + (mkVersion [0, 0, 2]))) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}], condForeignLibs = [], condExecutables = [ @@ -9576,27 +9628,31 @@ GenericPackageDescription { LSubLibName (UnqualComponentName "hasktorch-cpu")]))], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges - (UnionVersionRanges - (ThisVersion (mkVersion [4, 7])) - (LaterVersion - (mkVersion [4, 7]))) - (EarlierVersion - (mkVersion [5]))) - mainLibSet, - Dependency - (PackageName "hasktorch") - (OrLaterVersion (mkVersion [0])) - (NonEmptySet.fromNonEmpty - (NE.fromList - [ - LSubLibName - (UnqualComponentName - "hasktorch-cpu")]))], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (UnionVersionRanges + (ThisVersion (mkVersion [4, 7])) + (LaterVersion + (mkVersion [4, 7]))) + (EarlierVersion + (mkVersion [5]))) + mainLibSet, + Dependency + (PackageName "hasktorch") + (OrLaterVersion (mkVersion [0])) + (NonEmptySet.fromNonEmpty + (NE.fromList + [ + LSubLibName + (UnqualComponentName + "hasktorch-cpu")]))], + privateDependencies = []}, condTreeComponents = []}, _×_ (UnqualComponentName @@ -9680,27 +9736,31 @@ GenericPackageDescription { LSubLibName (UnqualComponentName "hasktorch-gpu")]))], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges - (UnionVersionRanges - (ThisVersion (mkVersion [4, 7])) - (LaterVersion - (mkVersion [4, 7]))) - (EarlierVersion - (mkVersion [5]))) - mainLibSet, - Dependency - (PackageName "hasktorch") - (OrLaterVersion (mkVersion [0])) - (NonEmptySet.fromNonEmpty - (NE.fromList - [ - LSubLibName - (UnqualComponentName - "hasktorch-gpu")]))], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (UnionVersionRanges + (ThisVersion (mkVersion [4, 7])) + (LaterVersion + (mkVersion [4, 7]))) + (EarlierVersion + (mkVersion [5]))) + mainLibSet, + Dependency + (PackageName "hasktorch") + (OrLaterVersion (mkVersion [0])) + (NonEmptySet.fromNonEmpty + (NE.fromList + [ + LSubLibName + (UnqualComponentName + "hasktorch-gpu")]))], + privateDependencies = []}, condTreeComponents = []}, _×_ (UnqualComponentName @@ -9779,22 +9839,26 @@ GenericPackageDescription { (PackageName "hasktorch") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges - (UnionVersionRanges - (ThisVersion (mkVersion [4, 7])) - (LaterVersion - (mkVersion [4, 7]))) - (EarlierVersion - (mkVersion [5]))) - mainLibSet, - Dependency - (PackageName "hasktorch") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (UnionVersionRanges + (ThisVersion (mkVersion [4, 7])) + (LaterVersion + (mkVersion [4, 7]))) + (EarlierVersion + (mkVersion [5]))) + mainLibSet, + Dependency + (PackageName "hasktorch") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, _×_ (UnqualComponentName "memcheck") @@ -9872,22 +9936,26 @@ GenericPackageDescription { (PackageName "hasktorch") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges - (UnionVersionRanges - (ThisVersion (mkVersion [4, 7])) - (LaterVersion - (mkVersion [4, 7]))) - (EarlierVersion - (mkVersion [5]))) - mainLibSet, - Dependency - (PackageName "hasktorch") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (UnionVersionRanges + (ThisVersion (mkVersion [4, 7])) + (LaterVersion + (mkVersion [4, 7]))) + (EarlierVersion + (mkVersion [5]))) + mainLibSet, + Dependency + (PackageName "hasktorch") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}], condTestSuites = [ _×_ @@ -10080,110 +10148,114 @@ GenericPackageDescription { (PackageName "generic-lens") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [ - Dependency - (PackageName "QuickCheck") - (UnionVersionRanges - (ThisVersion - (mkVersion [2, 11])) - (LaterVersion - (mkVersion [2, 11]))) - mainLibSet, - Dependency - (PackageName "backprop") - (UnionVersionRanges - (ThisVersion - (mkVersion [0, 2, 5])) - (LaterVersion - (mkVersion [0, 2, 5]))) - mainLibSet, - Dependency - (PackageName "base") - (IntersectVersionRanges + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "QuickCheck") (UnionVersionRanges - (ThisVersion (mkVersion [4, 7])) + (ThisVersion + (mkVersion [2, 11])) (LaterVersion - (mkVersion [4, 7]))) - (EarlierVersion - (mkVersion [5]))) - mainLibSet, - Dependency - (PackageName "dimensions") - (UnionVersionRanges - (ThisVersion (mkVersion [1, 0])) - (LaterVersion - (mkVersion [1, 0]))) - mainLibSet, - Dependency - (PackageName - "ghc-typelits-natnormalise") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "hasktorch") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "hspec") - (UnionVersionRanges - (ThisVersion - (mkVersion [2, 4, 4])) - (LaterVersion - (mkVersion [2, 4, 4]))) - mainLibSet, - Dependency - (PackageName "singletons") - (UnionVersionRanges - (ThisVersion (mkVersion [2, 2])) - (LaterVersion - (mkVersion [2, 2]))) - mainLibSet, - Dependency - (PackageName "mtl") - (UnionVersionRanges - (ThisVersion - (mkVersion [2, 2, 2])) - (LaterVersion - (mkVersion [2, 2, 2]))) - mainLibSet, - Dependency - (PackageName - "microlens-platform") - (UnionVersionRanges - (ThisVersion - (mkVersion [0, 3, 10])) - (LaterVersion - (mkVersion [0, 3, 10]))) - mainLibSet, - Dependency - (PackageName "monad-loops") - (UnionVersionRanges - (ThisVersion - (mkVersion [0, 4, 3])) - (LaterVersion - (mkVersion [0, 4, 3]))) - mainLibSet, - Dependency - (PackageName "time") - (UnionVersionRanges - (ThisVersion - (mkVersion [1, 8, 0])) - (LaterVersion - (mkVersion [1, 8, 0]))) - mainLibSet, - Dependency - (PackageName "transformers") - (UnionVersionRanges - (ThisVersion - (mkVersion [0, 5, 5])) - (LaterVersion - (mkVersion [0, 5, 5]))) - mainLibSet, - Dependency - (PackageName "generic-lens") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + (mkVersion [2, 11]))) + mainLibSet, + Dependency + (PackageName "backprop") + (UnionVersionRanges + (ThisVersion + (mkVersion [0, 2, 5])) + (LaterVersion + (mkVersion [0, 2, 5]))) + mainLibSet, + Dependency + (PackageName "base") + (IntersectVersionRanges + (UnionVersionRanges + (ThisVersion (mkVersion [4, 7])) + (LaterVersion + (mkVersion [4, 7]))) + (EarlierVersion + (mkVersion [5]))) + mainLibSet, + Dependency + (PackageName "dimensions") + (UnionVersionRanges + (ThisVersion (mkVersion [1, 0])) + (LaterVersion + (mkVersion [1, 0]))) + mainLibSet, + Dependency + (PackageName + "ghc-typelits-natnormalise") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "hasktorch") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "hspec") + (UnionVersionRanges + (ThisVersion + (mkVersion [2, 4, 4])) + (LaterVersion + (mkVersion [2, 4, 4]))) + mainLibSet, + Dependency + (PackageName "singletons") + (UnionVersionRanges + (ThisVersion (mkVersion [2, 2])) + (LaterVersion + (mkVersion [2, 2]))) + mainLibSet, + Dependency + (PackageName "mtl") + (UnionVersionRanges + (ThisVersion + (mkVersion [2, 2, 2])) + (LaterVersion + (mkVersion [2, 2, 2]))) + mainLibSet, + Dependency + (PackageName + "microlens-platform") + (UnionVersionRanges + (ThisVersion + (mkVersion [0, 3, 10])) + (LaterVersion + (mkVersion [0, 3, 10]))) + mainLibSet, + Dependency + (PackageName "monad-loops") + (UnionVersionRanges + (ThisVersion + (mkVersion [0, 4, 3])) + (LaterVersion + (mkVersion [0, 4, 3]))) + mainLibSet, + Dependency + (PackageName "time") + (UnionVersionRanges + (ThisVersion + (mkVersion [1, 8, 0])) + (LaterVersion + (mkVersion [1, 8, 0]))) + mainLibSet, + Dependency + (PackageName "transformers") + (UnionVersionRanges + (ThisVersion + (mkVersion [0, 5, 5])) + (LaterVersion + (mkVersion [0, 5, 5]))) + mainLibSet, + Dependency + (PackageName "generic-lens") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}], condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/hidden-main-lib.expr b/Cabal-tests/tests/ParserTests/regressions/hidden-main-lib.expr index bcb1f1f5bbb..88ae0e7b2b9 100644 --- a/Cabal-tests/tests/ParserTests/regressions/hidden-main-lib.expr +++ b/Cabal-tests/tests/ParserTests/regressions/hidden-main-lib.expr @@ -1,108 +1,123 @@ -GenericPackageDescription - {condBenchmarks = [], - condExecutables = [], - condForeignLibs = [], - condLibrary = Just - CondNode - {condTreeComponents = [], - condTreeConstraints = [Dependency - (PackageName "base") - (OrLaterVersion (mkVersion [0])) - mainLibSet], - condTreeData = Library - {exposedModules = [ModuleName "ElseIf"], - libBuildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = True, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Just Haskell2010, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [], - oldExtensions = [], - options = PerCompilerFlavor [] [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor [] [], - sharedOptions = PerCompilerFlavor [] [], - staticOptions = PerCompilerFlavor [] [], - targetBuildDepends = [Dependency - (PackageName - "base") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet], - virtualModules = []}, - libExposed = True, - libName = LMainLibName, - libVisibility = LibraryVisibilityPublic, - reexportedModules = [], - signatures = []}}, - condSubLibraries = [], - condTestSuites = [], - genPackageFlags = [], - gpdScannedVersion = Nothing, - packageDescription = PackageDescription - {author = "", - benchmarks = [], - bugReports = "", - buildTypeRaw = Just Simple, - category = "", - copyright = "", - customFieldsPD = [], - dataDir = ".", - dataFiles = [], - description = "", - executables = [], - extraDocFiles = [], - extraSrcFiles = [], - extraTmpFiles = [], - foreignLibs = [], - homepage = "", - library = Nothing, - licenseFiles = [], - licenseRaw = Left NONE, - maintainer = "", - package = PackageIdentifier - {pkgName = PackageName "hidden-main-lib", - pkgVersion = mkVersion [0]}, - pkgUrl = "", - setupBuildInfo = Nothing, - sourceRepos = [], - specVersion = CabalSpecV3_0, - stability = "", - subLibraries = [], - synopsis = "main lib have to be visible", - testSuites = [], - testedWith = []}} +GenericPackageDescription { + packageDescription = + PackageDescription { + specVersion = CabalSpecV3_0, + package = PackageIdentifier { + pkgName = PackageName + "hidden-main-lib", + pkgVersion = mkVersion [0]}, + licenseRaw = Left NONE, + licenseFiles = [], + copyright = "", + maintainer = "", + author = "", + stability = "", + testedWith = [], + homepage = "", + pkgUrl = "", + bugReports = "", + sourceRepos = [], + synopsis = + "main lib have to be visible", + description = "", + category = "", + customFieldsPD = [], + buildTypeRaw = Just Simple, + setupBuildInfo = Nothing, + library = Nothing, + subLibraries = [], + executables = [], + foreignLibs = [], + testSuites = [], + benchmarks = [], + dataFiles = [], + dataDir = ".", + extraSrcFiles = [], + extraTmpFiles = [], + extraDocFiles = []}, + gpdScannedVersion = Nothing, + genPackageFlags = [], + condLibrary = Just + CondNode { + condTreeData = Library { + libName = LMainLibName, + exposedModules = [ + ModuleName "ElseIf"], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPublic, + libBuildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Just + Haskell2010, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [ + Dependency + (PackageName "base") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + targetPrivateBuildDepends = [], + mixins = []}}, + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, + condTreeComponents = []}, + condSubLibraries = [], + condForeignLibs = [], + condExecutables = [], + condTestSuites = [], + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/indentation.expr b/Cabal-tests/tests/ParserTests/regressions/indentation.expr index 2b747fd1b8e..de2ae5a925b 100644 --- a/Cabal-tests/tests/ParserTests/regressions/indentation.expr +++ b/Cabal-tests/tests/ParserTests/regressions/indentation.expr @@ -1,109 +1,124 @@ -GenericPackageDescription - {condBenchmarks = [], - condExecutables = [], - condForeignLibs = [], - condLibrary = Just - CondNode - {condTreeComponents = [], - condTreeConstraints = [], - condTreeData = Library - {exposedModules = [], - libBuildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = True, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Just Haskell2010, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [], - oldExtensions = [], - options = PerCompilerFlavor [] [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor [] [], - sharedOptions = PerCompilerFlavor [] [], - staticOptions = PerCompilerFlavor [] [], - targetBuildDepends = [], - virtualModules = []}, - libExposed = True, - libName = LMainLibName, - libVisibility = LibraryVisibilityPublic, - reexportedModules = [], - signatures = []}}, - condSubLibraries = [], - condTestSuites = [], - genPackageFlags = [], - gpdScannedVersion = Nothing, - packageDescription = PackageDescription - {author = "", - benchmarks = [], - bugReports = "", - buildTypeRaw = Nothing, - category = "", - copyright = "", - customFieldsPD = [], - dataDir = ".", - dataFiles = [], - description = concat - ["* foo\n", - "\n", - " * foo-bar\n", - "\n", - " * foo-baz\n", - "\n", - ".\n", - ".\n", - ".\n", - "some dots"], - executables = [], - extraDocFiles = [], - extraSrcFiles = [], - extraTmpFiles = [], - foreignLibs = [], - homepage = "", - library = Nothing, - licenseFiles = [], - licenseRaw = Left NONE, - maintainer = "", - package = PackageIdentifier - {pkgName = PackageName "indentation", - pkgVersion = mkVersion [0]}, - pkgUrl = "", - setupBuildInfo = Nothing, - sourceRepos = [], - specVersion = CabalSpecV3_0, - stability = "", - subLibraries = [], - synopsis = "", - testSuites = [], - testedWith = []}} +GenericPackageDescription { + packageDescription = + PackageDescription { + specVersion = CabalSpecV3_0, + package = PackageIdentifier { + pkgName = PackageName + "indentation", + pkgVersion = mkVersion [0]}, + licenseRaw = Left NONE, + licenseFiles = [], + copyright = "", + maintainer = "", + author = "", + stability = "", + testedWith = [], + homepage = "", + pkgUrl = "", + bugReports = "", + sourceRepos = [], + synopsis = "", + description = concat + [ + "* foo\n", + "\n", + " * foo-bar\n", + "\n", + " * foo-baz\n", + "\n", + ".\n", + ".\n", + ".\n", + "some dots"], + category = "", + customFieldsPD = [], + buildTypeRaw = Nothing, + setupBuildInfo = Nothing, + library = Nothing, + subLibraries = [], + executables = [], + foreignLibs = [], + testSuites = [], + benchmarks = [], + dataFiles = [], + dataDir = ".", + extraSrcFiles = [], + extraTmpFiles = [], + extraDocFiles = []}, + gpdScannedVersion = Nothing, + genPackageFlags = [], + condLibrary = Just + CondNode { + condTreeData = Library { + libName = LMainLibName, + exposedModules = [], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPublic, + libBuildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Just + Haskell2010, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [], + targetPrivateBuildDepends = [], + mixins = []}}, + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, + condTreeComponents = []}, + condSubLibraries = [], + condForeignLibs = [], + condExecutables = [], + condTestSuites = [], + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/indentation2.expr b/Cabal-tests/tests/ParserTests/regressions/indentation2.expr index 56f23f26d0e..5a0f309339d 100644 --- a/Cabal-tests/tests/ParserTests/regressions/indentation2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/indentation2.expr @@ -1,99 +1,117 @@ -GenericPackageDescription - {condBenchmarks = [], - condExecutables = [], - condForeignLibs = [], - condLibrary = Just - CondNode - {condTreeComponents = [], - condTreeConstraints = [], - condTreeData = Library - {exposedModules = [], - libBuildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = True, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Just Haskell2010, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [], - oldExtensions = [], - options = PerCompilerFlavor [] [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor [] [], - sharedOptions = PerCompilerFlavor [] [], - staticOptions = PerCompilerFlavor [] [], - targetBuildDepends = [], - virtualModules = []}, - libExposed = True, - libName = LMainLibName, - libVisibility = LibraryVisibilityPublic, - reexportedModules = [], - signatures = []}}, - condSubLibraries = [], - condTestSuites = [], - genPackageFlags = [], - gpdScannedVersion = Nothing, - packageDescription = PackageDescription - {author = "", - benchmarks = [], - bugReports = "", - buildTypeRaw = Nothing, - category = "", - copyright = "", - customFieldsPD = [], - dataDir = ".", - dataFiles = [], - description = concat ["foo\n", " indent2\n", " indent4"], - executables = [], - extraDocFiles = [], - extraSrcFiles = [], - extraTmpFiles = [], - foreignLibs = [], - homepage = "", - library = Nothing, - licenseFiles = [], - licenseRaw = Left NONE, - maintainer = "", - package = PackageIdentifier - {pkgName = PackageName "indentation", - pkgVersion = mkVersion [0]}, - pkgUrl = "", - setupBuildInfo = Nothing, - sourceRepos = [], - specVersion = CabalSpecV3_0, - stability = "", - subLibraries = [], - synopsis = "", - testSuites = [], - testedWith = []}} +GenericPackageDescription { + packageDescription = + PackageDescription { + specVersion = CabalSpecV3_0, + package = PackageIdentifier { + pkgName = PackageName + "indentation", + pkgVersion = mkVersion [0]}, + licenseRaw = Left NONE, + licenseFiles = [], + copyright = "", + maintainer = "", + author = "", + stability = "", + testedWith = [], + homepage = "", + pkgUrl = "", + bugReports = "", + sourceRepos = [], + synopsis = "", + description = concat + [ + "foo\n", + " indent2\n", + " indent4"], + category = "", + customFieldsPD = [], + buildTypeRaw = Nothing, + setupBuildInfo = Nothing, + library = Nothing, + subLibraries = [], + executables = [], + foreignLibs = [], + testSuites = [], + benchmarks = [], + dataFiles = [], + dataDir = ".", + extraSrcFiles = [], + extraTmpFiles = [], + extraDocFiles = []}, + gpdScannedVersion = Nothing, + genPackageFlags = [], + condLibrary = Just + CondNode { + condTreeData = Library { + libName = LMainLibName, + exposedModules = [], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPublic, + libBuildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Just + Haskell2010, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [], + targetPrivateBuildDepends = [], + mixins = []}}, + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, + condTreeComponents = []}, + condSubLibraries = [], + condForeignLibs = [], + condExecutables = [], + condTestSuites = [], + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/indentation3.expr b/Cabal-tests/tests/ParserTests/regressions/indentation3.expr index f7ed51e79fa..b45872ae92e 100644 --- a/Cabal-tests/tests/ParserTests/regressions/indentation3.expr +++ b/Cabal-tests/tests/ParserTests/regressions/indentation3.expr @@ -1,104 +1,119 @@ -GenericPackageDescription - {condBenchmarks = [], - condExecutables = [], - condForeignLibs = [], - condLibrary = Just - CondNode - {condTreeComponents = [], - condTreeConstraints = [], - condTreeData = Library - {exposedModules = [], - libBuildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = True, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Just Haskell2010, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [], - oldExtensions = [], - options = PerCompilerFlavor [] [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor [] [], - sharedOptions = PerCompilerFlavor [] [], - staticOptions = PerCompilerFlavor [] [], - targetBuildDepends = [], - virtualModules = []}, - libExposed = True, - libName = LMainLibName, - libVisibility = LibraryVisibilityPublic, - reexportedModules = [], - signatures = []}}, - condSubLibraries = [], - condTestSuites = [], - genPackageFlags = [], - gpdScannedVersion = Nothing, - packageDescription = PackageDescription - {author = "", - benchmarks = [], - bugReports = "", - buildTypeRaw = Nothing, - category = "", - copyright = "", - customFieldsPD = [], - dataDir = ".", - dataFiles = [], - description = concat - ["indent0\n", - "\n", - " indent2\n", - "indent0\n", - " indent2"], - executables = [], - extraDocFiles = [], - extraSrcFiles = [], - extraTmpFiles = [], - foreignLibs = [], - homepage = "", - library = Nothing, - licenseFiles = [], - licenseRaw = Left NONE, - maintainer = "", - package = PackageIdentifier - {pkgName = PackageName "indentation", - pkgVersion = mkVersion [0]}, - pkgUrl = "", - setupBuildInfo = Nothing, - sourceRepos = [], - specVersion = CabalSpecV3_0, - stability = "", - subLibraries = [], - synopsis = "", - testSuites = [], - testedWith = []}} +GenericPackageDescription { + packageDescription = + PackageDescription { + specVersion = CabalSpecV3_0, + package = PackageIdentifier { + pkgName = PackageName + "indentation", + pkgVersion = mkVersion [0]}, + licenseRaw = Left NONE, + licenseFiles = [], + copyright = "", + maintainer = "", + author = "", + stability = "", + testedWith = [], + homepage = "", + pkgUrl = "", + bugReports = "", + sourceRepos = [], + synopsis = "", + description = concat + [ + "indent0\n", + "\n", + " indent2\n", + "indent0\n", + " indent2"], + category = "", + customFieldsPD = [], + buildTypeRaw = Nothing, + setupBuildInfo = Nothing, + library = Nothing, + subLibraries = [], + executables = [], + foreignLibs = [], + testSuites = [], + benchmarks = [], + dataFiles = [], + dataDir = ".", + extraSrcFiles = [], + extraTmpFiles = [], + extraDocFiles = []}, + gpdScannedVersion = Nothing, + genPackageFlags = [], + condLibrary = Just + CondNode { + condTreeData = Library { + libName = LMainLibName, + exposedModules = [], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPublic, + libBuildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Just + Haskell2010, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [], + targetPrivateBuildDepends = [], + mixins = []}}, + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, + condTreeComponents = []}, + condSubLibraries = [], + condForeignLibs = [], + condExecutables = [], + condTestSuites = [], + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-5055.expr b/Cabal-tests/tests/ParserTests/regressions/issue-5055.expr index be5e955442b..bd2677aeb8c 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-5055.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-5055.expr @@ -111,16 +111,20 @@ GenericPackageDescription { (EarlierVersion (mkVersion [5]))) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [4, 8])) - (EarlierVersion - (mkVersion [5]))) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [4, 8])) + (EarlierVersion + (mkVersion [5]))) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}], condTestSuites = [ _×_ @@ -194,17 +198,21 @@ GenericPackageDescription { (EarlierVersion (mkVersion [5]))) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [4, 8])) - (EarlierVersion - (mkVersion [5]))) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [4, 8])) + (EarlierVersion + (mkVersion [5]))) + mainLibSet], + privateDependencies = []}, condTreeComponents = [ CondBranch { condBranchCondition = @@ -270,9 +278,13 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}]}], condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-5846.expr b/Cabal-tests/tests/ParserTests/regressions/issue-5846.expr index 996d49e6625..7321101016d 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-5846.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-5846.expr @@ -134,44 +134,48 @@ GenericPackageDescription { (UnqualComponentName "a"), LSubLibName (UnqualComponentName "b")]))], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "lib1") - (OrLaterVersion (mkVersion [0])) - (NonEmptySet.fromNonEmpty - (NE.fromList - [ - LSubLibName - (UnqualComponentName "a"), - LSubLibName - (UnqualComponentName "b")])), - Dependency - (PackageName "lib2") - (OrLaterVersion (mkVersion [0])) - (NonEmptySet.fromNonEmpty - (NE.fromList - [ - LSubLibName - (UnqualComponentName "c")])), - Dependency - (PackageName "lib3") - (OrLaterVersion (mkVersion [1])) - (NonEmptySet.fromNonEmpty - (NE.fromList - [ - LSubLibName - (UnqualComponentName "d")])), - Dependency - (PackageName "lib4") - (OrLaterVersion (mkVersion [1])) - (NonEmptySet.fromNonEmpty - (NE.fromList - [ - LSubLibName - (UnqualComponentName "a"), - LSubLibName - (UnqualComponentName "b")]))], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "lib1") + (OrLaterVersion (mkVersion [0])) + (NonEmptySet.fromNonEmpty + (NE.fromList + [ + LSubLibName + (UnqualComponentName "a"), + LSubLibName + (UnqualComponentName "b")])), + Dependency + (PackageName "lib2") + (OrLaterVersion (mkVersion [0])) + (NonEmptySet.fromNonEmpty + (NE.fromList + [ + LSubLibName + (UnqualComponentName "c")])), + Dependency + (PackageName "lib3") + (OrLaterVersion (mkVersion [1])) + (NonEmptySet.fromNonEmpty + (NE.fromList + [ + LSubLibName + (UnqualComponentName "d")])), + Dependency + (PackageName "lib4") + (OrLaterVersion (mkVersion [1])) + (NonEmptySet.fromNonEmpty + (NE.fromList + [ + LSubLibName + (UnqualComponentName "a"), + LSubLibName + (UnqualComponentName "b")]))], + privateDependencies = []}, condTreeComponents = []}, condSubLibraries = [], condForeignLibs = [], diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-6083-a.expr b/Cabal-tests/tests/ParserTests/regressions/issue-6083-a.expr index aa4f6492cd7..c8e7a85a387 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-6083-a.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-6083-a.expr @@ -111,21 +111,25 @@ GenericPackageDescription { LSubLibName (UnqualComponentName "sublib")]))], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "issue") - (OrLaterVersion (mkVersion [0])) - (NonEmptySet.fromNonEmpty - (NE.fromList - [ - LSubLibName - (UnqualComponentName - "sublib")]))], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "issue") + (OrLaterVersion (mkVersion [0])) + (NonEmptySet.fromNonEmpty + (NE.fromList + [ + LSubLibName + (UnqualComponentName + "sublib")]))], + privateDependencies = []}, condTreeComponents = []}, condSubLibraries = [ _×_ @@ -193,8 +197,12 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = []}], condForeignLibs = [], condExecutables = [ @@ -266,16 +274,20 @@ GenericPackageDescription { (PackageName "sublib") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "issue") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "sublib") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "issue") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "sublib") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, _×_ (UnqualComponentName "demo-b") @@ -350,21 +362,25 @@ GenericPackageDescription { LSubLibName (UnqualComponentName "sublib")]))], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "issue") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "issue") - (OrLaterVersion (mkVersion [0])) - (NonEmptySet.fromNonEmpty - (NE.fromList - [ - LSubLibName - (UnqualComponentName - "sublib")]))], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "issue") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "issue") + (OrLaterVersion (mkVersion [0])) + (NonEmptySet.fromNonEmpty + (NE.fromList + [ + LSubLibName + (UnqualComponentName + "sublib")]))], + privateDependencies = []}, condTreeComponents = []}], condTestSuites = [], condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-6083-b.expr b/Cabal-tests/tests/ParserTests/regressions/issue-6083-b.expr index 208e17e41f0..293212cd72f 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-6083-b.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-6083-b.expr @@ -111,21 +111,25 @@ GenericPackageDescription { LSubLibName (UnqualComponentName "sublib")]))], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "issue") - (OrLaterVersion (mkVersion [0])) - (NonEmptySet.fromNonEmpty - (NE.fromList - [ - LSubLibName - (UnqualComponentName - "sublib")]))], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "issue") + (OrLaterVersion (mkVersion [0])) + (NonEmptySet.fromNonEmpty + (NE.fromList + [ + LSubLibName + (UnqualComponentName + "sublib")]))], + privateDependencies = []}, condTreeComponents = []}, condSubLibraries = [ _×_ @@ -193,8 +197,12 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = []}], condForeignLibs = [], condExecutables = [ @@ -271,21 +279,25 @@ GenericPackageDescription { LSubLibName (UnqualComponentName "sublib")]))], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "issue") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "issue") - (OrLaterVersion (mkVersion [0])) - (NonEmptySet.fromNonEmpty - (NE.fromList - [ - LSubLibName - (UnqualComponentName - "sublib")]))], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "issue") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "issue") + (OrLaterVersion (mkVersion [0])) + (NonEmptySet.fromNonEmpty + (NE.fromList + [ + LSubLibName + (UnqualComponentName + "sublib")]))], + privateDependencies = []}, condTreeComponents = []}, _×_ (UnqualComponentName "demo-b") @@ -360,21 +372,25 @@ GenericPackageDescription { LSubLibName (UnqualComponentName "sublib")]))], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "issue") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "issue") - (OrLaterVersion (mkVersion [0])) - (NonEmptySet.fromNonEmpty - (NE.fromList - [ - LSubLibName - (UnqualComponentName - "sublib")]))], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "issue") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "issue") + (OrLaterVersion (mkVersion [0])) + (NonEmptySet.fromNonEmpty + (NE.fromList + [ + LSubLibName + (UnqualComponentName + "sublib")]))], + privateDependencies = []}, condTreeComponents = []}], condTestSuites = [], condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-6083-c.expr b/Cabal-tests/tests/ParserTests/regressions/issue-6083-c.expr index 5cf5a7c1db8..07a38ed038f 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-6083-c.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-6083-c.expr @@ -111,21 +111,25 @@ GenericPackageDescription { LSubLibName (UnqualComponentName "sublib")]))], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "issue") - (OrLaterVersion (mkVersion [0])) - (NonEmptySet.fromNonEmpty - (NE.fromList - [ - LSubLibName - (UnqualComponentName - "sublib")]))], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "issue") + (OrLaterVersion (mkVersion [0])) + (NonEmptySet.fromNonEmpty + (NE.fromList + [ + LSubLibName + (UnqualComponentName + "sublib")]))], + privateDependencies = []}, condTreeComponents = []}, condSubLibraries = [ _×_ @@ -193,8 +197,12 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = []}], condForeignLibs = [], condExecutables = [], diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr b/Cabal-tests/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr index b436742cd03..7d5c42c7749 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr @@ -106,16 +106,20 @@ GenericPackageDescription { (PackageName "freetype") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "freetype") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "freetype") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "freetype") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "freetype") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condSubLibraries = [], condForeignLibs = [], diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-774.expr b/Cabal-tests/tests/ParserTests/regressions/issue-774.expr index af63d8cd9f0..7360f7edb59 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-774.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-774.expr @@ -1,111 +1,126 @@ -GenericPackageDescription - {condBenchmarks = [], - condExecutables = [], - condForeignLibs = [], - condLibrary = Just - CondNode - {condTreeComponents = [], - condTreeConstraints = [], - condTreeData = Library - {exposedModules = [ModuleName "Issue"], - libBuildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = True, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Just Haskell2010, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [], - oldExtensions = [], - options = PerCompilerFlavor - ["-Wall", - "-threaded", - "-with-rtsopts=-N -s -M1G -c", - "-rtsopts"] - [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor [] [], - sharedOptions = PerCompilerFlavor [] [], - staticOptions = PerCompilerFlavor [] [], - targetBuildDepends = [], - virtualModules = []}, - libExposed = True, - libName = LMainLibName, - libVisibility = LibraryVisibilityPublic, - reexportedModules = [], - signatures = []}}, - condSubLibraries = [], - condTestSuites = [], - genPackageFlags = [], - gpdScannedVersion = Nothing, - packageDescription = PackageDescription - {author = "", - benchmarks = [], - bugReports = "", - buildTypeRaw = Just Simple, - category = "", - copyright = "", - customFieldsPD = [], - dataDir = ".", - dataFiles = [], - description = concat - ["Here is some C code:\n", - "\n", - "> for(i = 0; i < 100; i++) {\n", - "> printf(\"%d\\n\",i);\n", - "> }\n", - "\n", - "What does it look like?"], - executables = [], - extraDocFiles = [], - extraSrcFiles = [], - extraTmpFiles = [], - foreignLibs = [], - homepage = "", - library = Nothing, - licenseFiles = [], - licenseRaw = Left NONE, - maintainer = "", - package = PackageIdentifier - {pkgName = PackageName "issue", - pkgVersion = mkVersion [744]}, - pkgUrl = "", - setupBuildInfo = Nothing, - sourceRepos = [], - specVersion = CabalSpecV1_12, - stability = "", - subLibraries = [], - synopsis = "Package description parser interprets curly braces in the description field", - testSuites = [], - testedWith = []}} +GenericPackageDescription { + packageDescription = + PackageDescription { + specVersion = CabalSpecV1_12, + package = PackageIdentifier { + pkgName = PackageName "issue", + pkgVersion = mkVersion [744]}, + licenseRaw = Left NONE, + licenseFiles = [], + copyright = "", + maintainer = "", + author = "", + stability = "", + testedWith = [], + homepage = "", + pkgUrl = "", + bugReports = "", + sourceRepos = [], + synopsis = + "Package description parser interprets curly braces in the description field", + description = concat + [ + "Here is some C code:\n", + "\n", + "> for(i = 0; i < 100; i++) {\n", + "> printf(\"%d\\n\",i);\n", + "> }\n", + "\n", + "What does it look like?"], + category = "", + customFieldsPD = [], + buildTypeRaw = Just Simple, + setupBuildInfo = Nothing, + library = Nothing, + subLibraries = [], + executables = [], + foreignLibs = [], + testSuites = [], + benchmarks = [], + dataFiles = [], + dataDir = ".", + extraSrcFiles = [], + extraTmpFiles = [], + extraDocFiles = []}, + gpdScannedVersion = Nothing, + genPackageFlags = [], + condLibrary = Just + CondNode { + condTreeData = Library { + libName = LMainLibName, + exposedModules = [ + ModuleName "Issue"], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPublic, + libBuildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Just + Haskell2010, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [ + "-Wall", + "-threaded", + "-with-rtsopts=-N -s -M1G -c", + "-rtsopts"] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [], + targetPrivateBuildDepends = [], + mixins = []}}, + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, + condTreeComponents = []}, + condSubLibraries = [], + condForeignLibs = [], + condExecutables = [], + condTestSuites = [], + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/jaeger-flamegraph.expr b/Cabal-tests/tests/ParserTests/regressions/jaeger-flamegraph.expr index aac1a2153e6..dd4f49d30b7 100644 --- a/Cabal-tests/tests/ParserTests/regressions/jaeger-flamegraph.expr +++ b/Cabal-tests/tests/ParserTests/regressions/jaeger-flamegraph.expr @@ -156,21 +156,25 @@ GenericPackageDescription { (MajorBoundVersion (mkVersion [2, 12, 6, 1])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (UnionVersionRanges - (MajorBoundVersion - (mkVersion [4, 11, 1, 0])) + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (UnionVersionRanges + (MajorBoundVersion + (mkVersion [4, 11, 1, 0])) + (MajorBoundVersion + (mkVersion [4, 12, 0, 0]))) + mainLibSet, + Dependency + (PackageName "QuickCheck") (MajorBoundVersion - (mkVersion [4, 12, 0, 0]))) - mainLibSet, - Dependency - (PackageName "QuickCheck") - (MajorBoundVersion - (mkVersion [2, 12, 6, 1])) - mainLibSet], + (mkVersion [2, 12, 6, 1])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condSubLibraries = [], condForeignLibs = [], @@ -285,52 +289,56 @@ GenericPackageDescription { (MajorBoundVersion (mkVersion [1, 2, 3, 1])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (UnionVersionRanges + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (UnionVersionRanges + (MajorBoundVersion + (mkVersion [4, 11, 1, 0])) + (MajorBoundVersion + (mkVersion [4, 12, 0, 0]))) + mainLibSet, + Dependency + (PackageName + "jaeger-flamegraph") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "bytestring") (MajorBoundVersion - (mkVersion [4, 11, 1, 0])) + (mkVersion [0, 10, 8, 2])) + mainLibSet, + Dependency + (PackageName "containers") (MajorBoundVersion - (mkVersion [4, 12, 0, 0]))) - mainLibSet, - Dependency - (PackageName - "jaeger-flamegraph") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "bytestring") - (MajorBoundVersion - (mkVersion [0, 10, 8, 2])) - mainLibSet, - Dependency - (PackageName "containers") - (MajorBoundVersion - (mkVersion [0, 6, 0, 1])) - mainLibSet, - Dependency - (PackageName "extra") - (MajorBoundVersion - (mkVersion [1, 6, 13])) - mainLibSet, - Dependency - (PackageName "aeson") - (MajorBoundVersion - (mkVersion [1, 4, 1, 0])) - mainLibSet, - Dependency - (PackageName - "optparse-applicative") - (MajorBoundVersion - (mkVersion [0, 14, 3, 0])) - mainLibSet, - Dependency - (PackageName "text") - (MajorBoundVersion - (mkVersion [1, 2, 3, 1])) - mainLibSet], + (mkVersion [0, 6, 0, 1])) + mainLibSet, + Dependency + (PackageName "extra") + (MajorBoundVersion + (mkVersion [1, 6, 13])) + mainLibSet, + Dependency + (PackageName "aeson") + (MajorBoundVersion + (mkVersion [1, 4, 1, 0])) + mainLibSet, + Dependency + (PackageName + "optparse-applicative") + (MajorBoundVersion + (mkVersion [0, 14, 3, 0])) + mainLibSet, + Dependency + (PackageName "text") + (MajorBoundVersion + (mkVersion [1, 2, 3, 1])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}], condTestSuites = [ _×_ @@ -434,36 +442,40 @@ GenericPackageDescription { (MajorBoundVersion (mkVersion [0, 10])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (UnionVersionRanges + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (UnionVersionRanges + (MajorBoundVersion + (mkVersion [4, 11, 1, 0])) + (MajorBoundVersion + (mkVersion [4, 12, 0, 0]))) + mainLibSet, + Dependency + (PackageName + "jaeger-flamegraph") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "tasty") (MajorBoundVersion - (mkVersion [4, 11, 1, 0])) + (mkVersion [1, 1, 0, 4])) + mainLibSet, + Dependency + (PackageName "tasty-hspec") (MajorBoundVersion - (mkVersion [4, 12, 0, 0]))) - mainLibSet, - Dependency - (PackageName - "jaeger-flamegraph") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "tasty") - (MajorBoundVersion - (mkVersion [1, 1, 0, 4])) - mainLibSet, - Dependency - (PackageName "tasty-hspec") - (MajorBoundVersion - (mkVersion [1, 1, 5])) - mainLibSet, - Dependency - (PackageName "tasty-quickcheck") - (MajorBoundVersion - (mkVersion [0, 10])) - mainLibSet], + (mkVersion [1, 1, 5])) + mainLibSet, + Dependency + (PackageName "tasty-quickcheck") + (MajorBoundVersion + (mkVersion [0, 10])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}], condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/leading-comma-2.expr b/Cabal-tests/tests/ParserTests/regressions/leading-comma-2.expr index 6fc8dafb3e8..bd116b235c7 100644 --- a/Cabal-tests/tests/ParserTests/regressions/leading-comma-2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/leading-comma-2.expr @@ -1,170 +1,170 @@ -GenericPackageDescription - {condBenchmarks = [], - condExecutables = [], - condForeignLibs = [], - condLibrary = Just - CondNode - {condTreeComponents = [], - condTreeConstraints = [Dependency - (PackageName "base") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "containers") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "deepseq") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "transformers") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "filepath") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "directory") - (OrLaterVersion (mkVersion [0])) - mainLibSet], - condTreeData = Library - {exposedModules = [ModuleName "LeadingComma", - ModuleName "LeadingComma2", - ModuleName "TrailingComma", - ModuleName "TrailingComma", - ModuleName "Comma", - ModuleName "InBetween", - ModuleName "NoCommas", - ModuleName "NoCommas"], - libBuildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = True, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Just Haskell2010, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [], - oldExtensions = [], - options = PerCompilerFlavor [] [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor [] [], - sharedOptions = PerCompilerFlavor [] [], - staticOptions = PerCompilerFlavor [] [], - targetBuildDepends = [Dependency - (PackageName - "base") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet, - Dependency - (PackageName - "containers") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet, - Dependency - (PackageName - "deepseq") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet, - Dependency - (PackageName - "transformers") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet, - Dependency - (PackageName - "filepath") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet, - Dependency - (PackageName - "directory") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet], - virtualModules = []}, - libExposed = True, - libName = LMainLibName, - libVisibility = LibraryVisibilityPublic, - reexportedModules = [], - signatures = []}}, - condSubLibraries = [], - condTestSuites = [], - genPackageFlags = [], - gpdScannedVersion = Nothing, - packageDescription = PackageDescription - {author = "", - benchmarks = [], - bugReports = "", - buildTypeRaw = Just Simple, - category = "", - copyright = "", - customFieldsPD = [], - dataDir = ".", - dataFiles = [], - description = "", - executables = [], - extraDocFiles = [], - extraSrcFiles = [], - extraTmpFiles = [], - foreignLibs = [], - homepage = "", - library = Nothing, - licenseFiles = [], - licenseRaw = Left NONE, - maintainer = "", - package = PackageIdentifier - {pkgName = PackageName "leading-comma", - pkgVersion = mkVersion [0]}, - pkgUrl = "", - setupBuildInfo = Nothing, - sourceRepos = [], - specVersion = CabalSpecV3_0, - stability = "", - subLibraries = [], - synopsis = "leading comma, trailing comma, or ordinary", - testSuites = [], - testedWith = []}} +GenericPackageDescription { + packageDescription = + PackageDescription { + specVersion = CabalSpecV3_0, + package = PackageIdentifier { + pkgName = PackageName + "leading-comma", + pkgVersion = mkVersion [0]}, + licenseRaw = Left NONE, + licenseFiles = [], + copyright = "", + maintainer = "", + author = "", + stability = "", + testedWith = [], + homepage = "", + pkgUrl = "", + bugReports = "", + sourceRepos = [], + synopsis = + "leading comma, trailing comma, or ordinary", + description = "", + category = "", + customFieldsPD = [], + buildTypeRaw = Just Simple, + setupBuildInfo = Nothing, + library = Nothing, + subLibraries = [], + executables = [], + foreignLibs = [], + testSuites = [], + benchmarks = [], + dataFiles = [], + dataDir = ".", + extraSrcFiles = [], + extraTmpFiles = [], + extraDocFiles = []}, + gpdScannedVersion = Nothing, + genPackageFlags = [], + condLibrary = Just + CondNode { + condTreeData = Library { + libName = LMainLibName, + exposedModules = [ + ModuleName "LeadingComma", + ModuleName "LeadingComma2", + ModuleName "TrailingComma", + ModuleName "TrailingComma", + ModuleName "Comma", + ModuleName "InBetween", + ModuleName "NoCommas", + ModuleName "NoCommas"], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPublic, + libBuildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Just + Haskell2010, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [ + Dependency + (PackageName "base") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "containers") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "deepseq") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "transformers") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "filepath") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "directory") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + targetPrivateBuildDepends = [], + mixins = []}}, + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "containers") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "deepseq") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "transformers") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "filepath") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "directory") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, + condTreeComponents = []}, + condSubLibraries = [], + condForeignLibs = [], + condExecutables = [], + condTestSuites = [], + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/leading-comma.expr b/Cabal-tests/tests/ParserTests/regressions/leading-comma.expr index c813d8b5668..fa772835cfb 100644 --- a/Cabal-tests/tests/ParserTests/regressions/leading-comma.expr +++ b/Cabal-tests/tests/ParserTests/regressions/leading-comma.expr @@ -1,163 +1,163 @@ -GenericPackageDescription - {condBenchmarks = [], - condExecutables = [], - condForeignLibs = [], - condLibrary = Just - CondNode - {condTreeComponents = [], - condTreeConstraints = [Dependency - (PackageName "base") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "containers") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "deepseq") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "transformers") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "filepath") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "directory") - (OrLaterVersion (mkVersion [0])) - mainLibSet], - condTreeData = Library - {exposedModules = [ModuleName "LeadingComma"], - libBuildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = True, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Just Haskell2010, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [], - oldExtensions = [], - options = PerCompilerFlavor [] [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor [] [], - sharedOptions = PerCompilerFlavor [] [], - staticOptions = PerCompilerFlavor [] [], - targetBuildDepends = [Dependency - (PackageName - "base") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet, - Dependency - (PackageName - "containers") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet, - Dependency - (PackageName - "deepseq") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet, - Dependency - (PackageName - "transformers") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet, - Dependency - (PackageName - "filepath") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet, - Dependency - (PackageName - "directory") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet], - virtualModules = []}, - libExposed = True, - libName = LMainLibName, - libVisibility = LibraryVisibilityPublic, - reexportedModules = [], - signatures = []}}, - condSubLibraries = [], - condTestSuites = [], - genPackageFlags = [], - gpdScannedVersion = Nothing, - packageDescription = PackageDescription - {author = "", - benchmarks = [], - bugReports = "", - buildTypeRaw = Just Simple, - category = "", - copyright = "", - customFieldsPD = [], - dataDir = ".", - dataFiles = [], - description = "", - executables = [], - extraDocFiles = [], - extraSrcFiles = [], - extraTmpFiles = [], - foreignLibs = [], - homepage = "", - library = Nothing, - licenseFiles = [], - licenseRaw = Left NONE, - maintainer = "", - package = PackageIdentifier - {pkgName = PackageName "leading-comma", - pkgVersion = mkVersion [0]}, - pkgUrl = "", - setupBuildInfo = Nothing, - sourceRepos = [], - specVersion = CabalSpecV2_2, - stability = "", - subLibraries = [], - synopsis = "leading comma, trailing comma, or ordinary", - testSuites = [], - testedWith = []}} +GenericPackageDescription { + packageDescription = + PackageDescription { + specVersion = CabalSpecV2_2, + package = PackageIdentifier { + pkgName = PackageName + "leading-comma", + pkgVersion = mkVersion [0]}, + licenseRaw = Left NONE, + licenseFiles = [], + copyright = "", + maintainer = "", + author = "", + stability = "", + testedWith = [], + homepage = "", + pkgUrl = "", + bugReports = "", + sourceRepos = [], + synopsis = + "leading comma, trailing comma, or ordinary", + description = "", + category = "", + customFieldsPD = [], + buildTypeRaw = Just Simple, + setupBuildInfo = Nothing, + library = Nothing, + subLibraries = [], + executables = [], + foreignLibs = [], + testSuites = [], + benchmarks = [], + dataFiles = [], + dataDir = ".", + extraSrcFiles = [], + extraTmpFiles = [], + extraDocFiles = []}, + gpdScannedVersion = Nothing, + genPackageFlags = [], + condLibrary = Just + CondNode { + condTreeData = Library { + libName = LMainLibName, + exposedModules = [ + ModuleName "LeadingComma"], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPublic, + libBuildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Just + Haskell2010, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [ + Dependency + (PackageName "base") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "containers") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "deepseq") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "transformers") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "filepath") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "directory") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + targetPrivateBuildDepends = [], + mixins = []}}, + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "containers") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "deepseq") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "transformers") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "filepath") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "directory") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, + condTreeComponents = []}, + condSubLibraries = [], + condForeignLibs = [], + condExecutables = [], + condTestSuites = [], + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/libpq1.expr b/Cabal-tests/tests/ParserTests/regressions/libpq1.expr index 954c378122c..1866869619d 100644 --- a/Cabal-tests/tests/ParserTests/regressions/libpq1.expr +++ b/Cabal-tests/tests/ParserTests/regressions/libpq1.expr @@ -207,24 +207,28 @@ GenericPackageDescription { (EarlierVersion (mkVersion [0, 11]))) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [4, 3])) - (EarlierVersion - (mkVersion [4, 13]))) - mainLibSet, - Dependency - (PackageName "bytestring") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [0, 9, 1, 0])) - (EarlierVersion - (mkVersion [0, 11]))) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [4, 3])) + (EarlierVersion + (mkVersion [4, 13]))) + mainLibSet, + Dependency + (PackageName "bytestring") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [0, 9, 1, 0])) + (EarlierVersion + (mkVersion [0, 11]))) + mainLibSet], + privateDependencies = []}, condTreeComponents = [ CondBranch { condBranchCondition = @@ -298,16 +302,20 @@ GenericPackageDescription { (EarlierVersion (mkVersion [2, 8]))) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "unix") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [2, 4, 2, 0])) - (EarlierVersion - (mkVersion [2, 8]))) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "unix") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [2, 4, 2, 0])) + (EarlierVersion + (mkVersion [2, 8]))) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}, CondBranch { @@ -382,16 +390,20 @@ GenericPackageDescription { (EarlierVersion (mkVersion [2, 7]))) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "Win32") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [2, 2, 0, 2])) - (EarlierVersion - (mkVersion [2, 7]))) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "Win32") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [2, 2, 0, 2])) + (EarlierVersion + (mkVersion [2, 7]))) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}, CondBranch { @@ -465,8 +477,12 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Just CondNode { @@ -530,8 +546,12 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = [ CondBranch { condBranchCondition = @@ -597,8 +617,12 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Just CondNode { @@ -662,8 +686,12 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = [ CondBranch { condBranchCondition = @@ -729,8 +757,12 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}]}}]}}]}, diff --git a/Cabal-tests/tests/ParserTests/regressions/libpq2.expr b/Cabal-tests/tests/ParserTests/regressions/libpq2.expr index 0b1c1ccd528..15de6cd0897 100644 --- a/Cabal-tests/tests/ParserTests/regressions/libpq2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/libpq2.expr @@ -212,24 +212,28 @@ GenericPackageDescription { (EarlierVersion (mkVersion [0, 11]))) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [4, 3])) - (EarlierVersion - (mkVersion [4, 13]))) - mainLibSet, - Dependency - (PackageName "bytestring") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [0, 9, 1, 0])) - (EarlierVersion - (mkVersion [0, 11]))) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [4, 3])) + (EarlierVersion + (mkVersion [4, 13]))) + mainLibSet, + Dependency + (PackageName "bytestring") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [0, 9, 1, 0])) + (EarlierVersion + (mkVersion [0, 11]))) + mainLibSet], + privateDependencies = []}, condTreeComponents = [ CondBranch { condBranchCondition = @@ -303,16 +307,20 @@ GenericPackageDescription { (EarlierVersion (mkVersion [2, 8]))) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "unix") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [2, 4, 2, 0])) - (EarlierVersion - (mkVersion [2, 8]))) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "unix") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [2, 4, 2, 0])) + (EarlierVersion + (mkVersion [2, 8]))) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}, CondBranch { @@ -387,16 +395,20 @@ GenericPackageDescription { (EarlierVersion (mkVersion [2, 7]))) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "Win32") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [2, 2, 0, 2])) - (EarlierVersion - (mkVersion [2, 7]))) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "Win32") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [2, 2, 0, 2])) + (EarlierVersion + (mkVersion [2, 7]))) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}, CondBranch { @@ -467,8 +479,12 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Just CondNode { @@ -532,8 +548,12 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = [ CondBranch { condBranchCondition = @@ -599,8 +619,12 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Just CondNode { @@ -664,8 +688,12 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = [ CondBranch { condBranchCondition = @@ -731,8 +759,12 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}]}}]}}]}, diff --git a/Cabal-tests/tests/ParserTests/regressions/mixin-1.expr b/Cabal-tests/tests/ParserTests/regressions/mixin-1.expr index 2878577225b..a62b3c7f0b2 100644 --- a/Cabal-tests/tests/ParserTests/regressions/mixin-1.expr +++ b/Cabal-tests/tests/ParserTests/regressions/mixin-1.expr @@ -1,151 +1,164 @@ -GenericPackageDescription - {condBenchmarks = [], - condExecutables = [_×_ - (UnqualComponentName "str-example") - CondNode - {condTreeComponents = [], - condTreeConstraints = [Dependency - (PackageName "base") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "str-string") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "str-bytestring") - (OrLaterVersion (mkVersion [0])) - mainLibSet], - condTreeData = Executable - {buildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = True, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Nothing, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [SymbolicPath - "str-example"], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [Mixin - {mixinIncludeRenaming = IncludeRenaming - {includeProvidesRn = ModuleRenaming - [_×_ - (ModuleName - "Str") - (ModuleName - "Str.String")], - includeRequiresRn = DefaultRenaming}, - mixinLibraryName = LMainLibName, - mixinPackageName = PackageName - "str-string"}, - Mixin - {mixinIncludeRenaming = IncludeRenaming - {includeProvidesRn = ModuleRenaming - [_×_ - (ModuleName - "Str") - (ModuleName - "Str.ByteString")], - includeRequiresRn = DefaultRenaming}, - mixinLibraryName = LMainLibName, - mixinPackageName = PackageName - "str-bytestring"}], - oldExtensions = [], - options = PerCompilerFlavor [] [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor [] [], - sharedOptions = PerCompilerFlavor [] [], - staticOptions = PerCompilerFlavor [] [], - targetBuildDepends = [Dependency - (PackageName - "base") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet, - Dependency - (PackageName - "str-string") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet, - Dependency - (PackageName - "str-bytestring") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet], - virtualModules = []}, - exeName = UnqualComponentName "str-example", - exeScope = ExecutablePublic, - modulePath = "Main.hs"}}], - condForeignLibs = [], - condLibrary = Nothing, - condSubLibraries = [], - condTestSuites = [], - genPackageFlags = [], - gpdScannedVersion = Nothing, - packageDescription = PackageDescription - {author = "", - benchmarks = [], - bugReports = "", - buildTypeRaw = Just Simple, - category = "", - copyright = "", - customFieldsPD = [], - dataDir = ".", - dataFiles = [], - description = "", - executables = [], - extraDocFiles = [], - extraSrcFiles = [], - extraTmpFiles = [], - foreignLibs = [], - homepage = "", - library = Nothing, - licenseFiles = [], - licenseRaw = Left NONE, - maintainer = "", - package = PackageIdentifier - {pkgName = PackageName "mixin", pkgVersion = mkVersion [0]}, - pkgUrl = "", - setupBuildInfo = Nothing, - sourceRepos = [], - specVersion = CabalSpecV2_0, - stability = "", - subLibraries = [], - synopsis = "", - testSuites = [], - testedWith = []}} +GenericPackageDescription { + packageDescription = + PackageDescription { + specVersion = CabalSpecV2_0, + package = PackageIdentifier { + pkgName = PackageName "mixin", + pkgVersion = mkVersion [0]}, + licenseRaw = Left NONE, + licenseFiles = [], + copyright = "", + maintainer = "", + author = "", + stability = "", + testedWith = [], + homepage = "", + pkgUrl = "", + bugReports = "", + sourceRepos = [], + synopsis = "", + description = "", + category = "", + customFieldsPD = [], + buildTypeRaw = Just Simple, + setupBuildInfo = Nothing, + library = Nothing, + subLibraries = [], + executables = [], + foreignLibs = [], + testSuites = [], + benchmarks = [], + dataFiles = [], + dataDir = ".", + extraSrcFiles = [], + extraTmpFiles = [], + extraDocFiles = []}, + gpdScannedVersion = Nothing, + genPackageFlags = [], + condLibrary = Nothing, + condSubLibraries = [], + condForeignLibs = [], + condExecutables = [ + _×_ + (UnqualComponentName + "str-example") + CondNode { + condTreeData = Executable { + exeName = UnqualComponentName + "str-example", + modulePath = "Main.hs", + exeScope = ExecutablePublic, + buildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [ + SymbolicPath "str-example"], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Nothing, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [ + Dependency + (PackageName "base") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "str-string") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "str-bytestring") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + targetPrivateBuildDepends = [], + mixins = [ + Mixin { + mixinPackageName = PackageName + "str-string", + mixinLibraryName = LMainLibName, + mixinIncludeRenaming = + IncludeRenaming { + includeProvidesRn = + ModuleRenaming + [ + _×_ + (ModuleName "Str") + (ModuleName "Str.String")], + includeRequiresRn = + DefaultRenaming}}, + Mixin { + mixinPackageName = PackageName + "str-bytestring", + mixinLibraryName = LMainLibName, + mixinIncludeRenaming = + IncludeRenaming { + includeProvidesRn = + ModuleRenaming + [ + _×_ + (ModuleName "Str") + (ModuleName "Str.ByteString")], + includeRequiresRn = + DefaultRenaming}}]}}, + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "str-string") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "str-bytestring") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, + condTreeComponents = []}], + condTestSuites = [], + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/mixin-2.expr b/Cabal-tests/tests/ParserTests/regressions/mixin-2.expr index b2866d4a5e0..d5c8a00a681 100644 --- a/Cabal-tests/tests/ParserTests/regressions/mixin-2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/mixin-2.expr @@ -1,151 +1,164 @@ -GenericPackageDescription - {condBenchmarks = [], - condExecutables = [_×_ - (UnqualComponentName "str-example") - CondNode - {condTreeComponents = [], - condTreeConstraints = [Dependency - (PackageName "base") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "str-string") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "str-bytestring") - (OrLaterVersion (mkVersion [0])) - mainLibSet], - condTreeData = Executable - {buildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = True, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Nothing, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [SymbolicPath - "str-example"], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [Mixin - {mixinIncludeRenaming = IncludeRenaming - {includeProvidesRn = ModuleRenaming - [_×_ - (ModuleName - "Str") - (ModuleName - "Str.String")], - includeRequiresRn = DefaultRenaming}, - mixinLibraryName = LMainLibName, - mixinPackageName = PackageName - "str-string"}, - Mixin - {mixinIncludeRenaming = IncludeRenaming - {includeProvidesRn = ModuleRenaming - [_×_ - (ModuleName - "Str") - (ModuleName - "Str.ByteString")], - includeRequiresRn = DefaultRenaming}, - mixinLibraryName = LMainLibName, - mixinPackageName = PackageName - "str-bytestring"}], - oldExtensions = [], - options = PerCompilerFlavor [] [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor [] [], - sharedOptions = PerCompilerFlavor [] [], - staticOptions = PerCompilerFlavor [] [], - targetBuildDepends = [Dependency - (PackageName - "base") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet, - Dependency - (PackageName - "str-string") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet, - Dependency - (PackageName - "str-bytestring") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet], - virtualModules = []}, - exeName = UnqualComponentName "str-example", - exeScope = ExecutablePublic, - modulePath = "Main.hs"}}], - condForeignLibs = [], - condLibrary = Nothing, - condSubLibraries = [], - condTestSuites = [], - genPackageFlags = [], - gpdScannedVersion = Nothing, - packageDescription = PackageDescription - {author = "", - benchmarks = [], - bugReports = "", - buildTypeRaw = Nothing, - category = "", - copyright = "", - customFieldsPD = [], - dataDir = ".", - dataFiles = [], - description = "", - executables = [], - extraDocFiles = [], - extraSrcFiles = [], - extraTmpFiles = [], - foreignLibs = [], - homepage = "", - library = Nothing, - licenseFiles = [], - licenseRaw = Left NONE, - maintainer = "", - package = PackageIdentifier - {pkgName = PackageName "mixin", pkgVersion = mkVersion [0]}, - pkgUrl = "", - setupBuildInfo = Nothing, - sourceRepos = [], - specVersion = CabalSpecV3_0, - stability = "", - subLibraries = [], - synopsis = "", - testSuites = [], - testedWith = []}} +GenericPackageDescription { + packageDescription = + PackageDescription { + specVersion = CabalSpecV3_0, + package = PackageIdentifier { + pkgName = PackageName "mixin", + pkgVersion = mkVersion [0]}, + licenseRaw = Left NONE, + licenseFiles = [], + copyright = "", + maintainer = "", + author = "", + stability = "", + testedWith = [], + homepage = "", + pkgUrl = "", + bugReports = "", + sourceRepos = [], + synopsis = "", + description = "", + category = "", + customFieldsPD = [], + buildTypeRaw = Nothing, + setupBuildInfo = Nothing, + library = Nothing, + subLibraries = [], + executables = [], + foreignLibs = [], + testSuites = [], + benchmarks = [], + dataFiles = [], + dataDir = ".", + extraSrcFiles = [], + extraTmpFiles = [], + extraDocFiles = []}, + gpdScannedVersion = Nothing, + genPackageFlags = [], + condLibrary = Nothing, + condSubLibraries = [], + condForeignLibs = [], + condExecutables = [ + _×_ + (UnqualComponentName + "str-example") + CondNode { + condTreeData = Executable { + exeName = UnqualComponentName + "str-example", + modulePath = "Main.hs", + exeScope = ExecutablePublic, + buildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [ + SymbolicPath "str-example"], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Nothing, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [ + Dependency + (PackageName "base") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "str-string") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "str-bytestring") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + targetPrivateBuildDepends = [], + mixins = [ + Mixin { + mixinPackageName = PackageName + "str-string", + mixinLibraryName = LMainLibName, + mixinIncludeRenaming = + IncludeRenaming { + includeProvidesRn = + ModuleRenaming + [ + _×_ + (ModuleName "Str") + (ModuleName "Str.String")], + includeRequiresRn = + DefaultRenaming}}, + Mixin { + mixinPackageName = PackageName + "str-bytestring", + mixinLibraryName = LMainLibName, + mixinIncludeRenaming = + IncludeRenaming { + includeProvidesRn = + ModuleRenaming + [ + _×_ + (ModuleName "Str") + (ModuleName "Str.ByteString")], + includeRequiresRn = + DefaultRenaming}}]}}, + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "str-string") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "str-bytestring") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, + condTreeComponents = []}], + condTestSuites = [], + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/mixin-3.expr b/Cabal-tests/tests/ParserTests/regressions/mixin-3.expr index 1a02247a87a..89bb90baae7 100644 --- a/Cabal-tests/tests/ParserTests/regressions/mixin-3.expr +++ b/Cabal-tests/tests/ParserTests/regressions/mixin-3.expr @@ -1,136 +1,147 @@ -GenericPackageDescription - {condBenchmarks = [], - condExecutables = [_×_ - (UnqualComponentName "str-example") - CondNode - {condTreeComponents = [], - condTreeConstraints = [Dependency - (PackageName "base") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "str-string") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "str-bytestring") - (OrLaterVersion (mkVersion [0])) - mainLibSet], - condTreeData = Executable - {buildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = True, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Nothing, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [SymbolicPath - "str-example"], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [Mixin - {mixinIncludeRenaming = IncludeRenaming - {includeProvidesRn = HidingRenaming - [ModuleName - "Foo"], - includeRequiresRn = DefaultRenaming}, - mixinLibraryName = LMainLibName, - mixinPackageName = PackageName - "str"}], - oldExtensions = [], - options = PerCompilerFlavor [] [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor [] [], - sharedOptions = PerCompilerFlavor [] [], - staticOptions = PerCompilerFlavor [] [], - targetBuildDepends = [Dependency - (PackageName - "base") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet, - Dependency - (PackageName - "str-string") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet, - Dependency - (PackageName - "str-bytestring") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet], - virtualModules = []}, - exeName = UnqualComponentName "str-example", - exeScope = ExecutablePublic, - modulePath = "Main.hs"}}], - condForeignLibs = [], - condLibrary = Nothing, - condSubLibraries = [], - condTestSuites = [], - genPackageFlags = [], - gpdScannedVersion = Nothing, - packageDescription = PackageDescription - {author = "", - benchmarks = [], - bugReports = "", - buildTypeRaw = Nothing, - category = "", - copyright = "", - customFieldsPD = [], - dataDir = ".", - dataFiles = [], - description = "", - executables = [], - extraDocFiles = [], - extraSrcFiles = [], - extraTmpFiles = [], - foreignLibs = [], - homepage = "", - library = Nothing, - licenseFiles = [], - licenseRaw = Left NONE, - maintainer = "", - package = PackageIdentifier - {pkgName = PackageName "mixin", pkgVersion = mkVersion [0]}, - pkgUrl = "", - setupBuildInfo = Nothing, - sourceRepos = [], - specVersion = CabalSpecV3_0, - stability = "", - subLibraries = [], - synopsis = "", - testSuites = [], - testedWith = []}} +GenericPackageDescription { + packageDescription = + PackageDescription { + specVersion = CabalSpecV3_0, + package = PackageIdentifier { + pkgName = PackageName "mixin", + pkgVersion = mkVersion [0]}, + licenseRaw = Left NONE, + licenseFiles = [], + copyright = "", + maintainer = "", + author = "", + stability = "", + testedWith = [], + homepage = "", + pkgUrl = "", + bugReports = "", + sourceRepos = [], + synopsis = "", + description = "", + category = "", + customFieldsPD = [], + buildTypeRaw = Nothing, + setupBuildInfo = Nothing, + library = Nothing, + subLibraries = [], + executables = [], + foreignLibs = [], + testSuites = [], + benchmarks = [], + dataFiles = [], + dataDir = ".", + extraSrcFiles = [], + extraTmpFiles = [], + extraDocFiles = []}, + gpdScannedVersion = Nothing, + genPackageFlags = [], + condLibrary = Nothing, + condSubLibraries = [], + condForeignLibs = [], + condExecutables = [ + _×_ + (UnqualComponentName + "str-example") + CondNode { + condTreeData = Executable { + exeName = UnqualComponentName + "str-example", + modulePath = "Main.hs", + exeScope = ExecutablePublic, + buildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [ + SymbolicPath "str-example"], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Nothing, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [ + Dependency + (PackageName "base") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "str-string") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "str-bytestring") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + targetPrivateBuildDepends = [], + mixins = [ + Mixin { + mixinPackageName = PackageName + "str", + mixinLibraryName = LMainLibName, + mixinIncludeRenaming = + IncludeRenaming { + includeProvidesRn = + HidingRenaming + [ModuleName "Foo"], + includeRequiresRn = + DefaultRenaming}}]}}, + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "str-string") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "str-bytestring") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, + condTreeComponents = []}], + condTestSuites = [], + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/monad-param.expr b/Cabal-tests/tests/ParserTests/regressions/monad-param.expr index 0f94cf3be9d..7868dfeb98d 100644 --- a/Cabal-tests/tests/ParserTests/regressions/monad-param.expr +++ b/Cabal-tests/tests/ParserTests/regressions/monad-param.expr @@ -136,20 +136,24 @@ GenericPackageDescription { (PackageName "stm") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "mtl") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "stm") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "mtl") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "stm") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condSubLibraries = [], condForeignLibs = [], diff --git a/Cabal-tests/tests/ParserTests/regressions/multiple-libs-2.expr b/Cabal-tests/tests/ParserTests/regressions/multiple-libs-2.expr index 2af5d422e3b..40dbfdf5b9c 100644 --- a/Cabal-tests/tests/ParserTests/regressions/multiple-libs-2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/multiple-libs-2.expr @@ -1,178 +1,204 @@ -GenericPackageDescription - {condBenchmarks = [], - condExecutables = [], - condForeignLibs = [], - condLibrary = Just - CondNode - {condTreeComponents = [], - condTreeConstraints = [Dependency - (PackageName "base") - (OrLaterVersion (mkVersion [0])) - mainLibSet], - condTreeData = Library - {exposedModules = [ModuleName "ElseIf"], - libBuildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = True, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Just Haskell2010, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [], - oldExtensions = [], - options = PerCompilerFlavor [] [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor [] [], - sharedOptions = PerCompilerFlavor [] [], - staticOptions = PerCompilerFlavor [] [], - targetBuildDepends = [Dependency - (PackageName - "base") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet], - virtualModules = []}, - libExposed = True, - libName = LMainLibName, - libVisibility = LibraryVisibilityPublic, - reexportedModules = [], - signatures = []}}, - condSubLibraries = [_×_ - (UnqualComponentName "public") - CondNode - {condTreeComponents = [], - condTreeConstraints = [Dependency - (PackageName "base") - (OrLaterVersion (mkVersion [0])) - mainLibSet], - condTreeData = Library - {exposedModules = [ModuleName "ElseIf2"], - libBuildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = True, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Just Haskell2010, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [], - oldExtensions = [], - options = PerCompilerFlavor [] [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor - [] [], - sharedOptions = PerCompilerFlavor - [] [], - staticOptions = PerCompilerFlavor - [] [], - targetBuildDepends = [Dependency - (PackageName - "base") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet], - virtualModules = []}, - libExposed = True, - libName = LSubLibName (UnqualComponentName "public"), - libVisibility = LibraryVisibilityPrivate, - reexportedModules = [], - signatures = []}}], - condTestSuites = [], - genPackageFlags = [], - gpdScannedVersion = Nothing, - packageDescription = PackageDescription - {author = "", - benchmarks = [], - bugReports = "", - buildTypeRaw = Just Simple, - category = "", - copyright = "", - customFieldsPD = [], - dataDir = ".", - dataFiles = [], - description = "", - executables = [], - extraDocFiles = [], - extraSrcFiles = [], - extraTmpFiles = [], - foreignLibs = [], - homepage = "", - library = Nothing, - licenseFiles = [], - licenseRaw = Left NONE, - maintainer = "", - package = PackageIdentifier - {pkgName = PackageName "multiple-libs", - pkgVersion = mkVersion [0]}, - pkgUrl = "", - setupBuildInfo = Nothing, - sourceRepos = [], - specVersion = CabalSpecV2_0, - stability = "", - subLibraries = [], - synopsis = "visible flag only since 3.0", - testSuites = [], - testedWith = []}} +GenericPackageDescription { + packageDescription = + PackageDescription { + specVersion = CabalSpecV2_0, + package = PackageIdentifier { + pkgName = PackageName + "multiple-libs", + pkgVersion = mkVersion [0]}, + licenseRaw = Left NONE, + licenseFiles = [], + copyright = "", + maintainer = "", + author = "", + stability = "", + testedWith = [], + homepage = "", + pkgUrl = "", + bugReports = "", + sourceRepos = [], + synopsis = + "visible flag only since 3.0", + description = "", + category = "", + customFieldsPD = [], + buildTypeRaw = Just Simple, + setupBuildInfo = Nothing, + library = Nothing, + subLibraries = [], + executables = [], + foreignLibs = [], + testSuites = [], + benchmarks = [], + dataFiles = [], + dataDir = ".", + extraSrcFiles = [], + extraTmpFiles = [], + extraDocFiles = []}, + gpdScannedVersion = Nothing, + genPackageFlags = [], + condLibrary = Just + CondNode { + condTreeData = Library { + libName = LMainLibName, + exposedModules = [ + ModuleName "ElseIf"], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPublic, + libBuildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Just + Haskell2010, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [ + Dependency + (PackageName "base") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + targetPrivateBuildDepends = [], + mixins = []}}, + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, + condTreeComponents = []}, + condSubLibraries = [ + _×_ + (UnqualComponentName "public") + CondNode { + condTreeData = Library { + libName = LSubLibName + (UnqualComponentName "public"), + exposedModules = [ + ModuleName "ElseIf2"], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPrivate, + libBuildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Just + Haskell2010, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [ + Dependency + (PackageName "base") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + targetPrivateBuildDepends = [], + mixins = []}}, + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, + condTreeComponents = []}], + condForeignLibs = [], + condExecutables = [], + condTestSuites = [], + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/noVersion.expr b/Cabal-tests/tests/ParserTests/regressions/noVersion.expr index e96ca1efb35..07c4796388e 100644 --- a/Cabal-tests/tests/ParserTests/regressions/noVersion.expr +++ b/Cabal-tests/tests/ParserTests/regressions/noVersion.expr @@ -1,108 +1,123 @@ -GenericPackageDescription - {condBenchmarks = [], - condExecutables = [], - condForeignLibs = [], - condLibrary = Just - CondNode - {condTreeComponents = [], - condTreeConstraints = [Dependency - (PackageName "bad-package") - (EarlierVersion (mkVersion [0])) - mainLibSet], - condTreeData = Library - {exposedModules = [ModuleName "ElseIf"], - libBuildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = True, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Just Haskell2010, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [], - oldExtensions = [], - options = PerCompilerFlavor [] [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor [] [], - sharedOptions = PerCompilerFlavor [] [], - staticOptions = PerCompilerFlavor [] [], - targetBuildDepends = [Dependency - (PackageName - "bad-package") - (EarlierVersion - (mkVersion - [0])) - mainLibSet], - virtualModules = []}, - libExposed = True, - libName = LMainLibName, - libVisibility = LibraryVisibilityPublic, - reexportedModules = [], - signatures = []}}, - condSubLibraries = [], - condTestSuites = [], - genPackageFlags = [], - gpdScannedVersion = Nothing, - packageDescription = PackageDescription - {author = "", - benchmarks = [], - bugReports = "", - buildTypeRaw = Just Simple, - category = "", - copyright = "", - customFieldsPD = [], - dataDir = ".", - dataFiles = [], - description = "", - executables = [], - extraDocFiles = [], - extraSrcFiles = [], - extraTmpFiles = [], - foreignLibs = [], - homepage = "", - library = Nothing, - licenseFiles = [], - licenseRaw = Left NONE, - maintainer = "", - package = PackageIdentifier - {pkgName = PackageName "noVersion", - pkgVersion = mkVersion [0]}, - pkgUrl = "", - setupBuildInfo = Nothing, - sourceRepos = [], - specVersion = CabalSpecV1_22, - stability = "", - subLibraries = [], - synopsis = "-none in build-depends", - testSuites = [], - testedWith = []}} +GenericPackageDescription { + packageDescription = + PackageDescription { + specVersion = CabalSpecV1_22, + package = PackageIdentifier { + pkgName = PackageName + "noVersion", + pkgVersion = mkVersion [0]}, + licenseRaw = Left NONE, + licenseFiles = [], + copyright = "", + maintainer = "", + author = "", + stability = "", + testedWith = [], + homepage = "", + pkgUrl = "", + bugReports = "", + sourceRepos = [], + synopsis = + "-none in build-depends", + description = "", + category = "", + customFieldsPD = [], + buildTypeRaw = Just Simple, + setupBuildInfo = Nothing, + library = Nothing, + subLibraries = [], + executables = [], + foreignLibs = [], + testSuites = [], + benchmarks = [], + dataFiles = [], + dataDir = ".", + extraSrcFiles = [], + extraTmpFiles = [], + extraDocFiles = []}, + gpdScannedVersion = Nothing, + genPackageFlags = [], + condLibrary = Just + CondNode { + condTreeData = Library { + libName = LMainLibName, + exposedModules = [ + ModuleName "ElseIf"], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPublic, + libBuildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Just + Haskell2010, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [ + Dependency + (PackageName "bad-package") + (EarlierVersion (mkVersion [0])) + mainLibSet], + targetPrivateBuildDepends = [], + mixins = []}}, + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "bad-package") + (EarlierVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, + condTreeComponents = []}, + condSubLibraries = [], + condForeignLibs = [], + condExecutables = [], + condTestSuites = [], + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.expr b/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.expr index 650054bcf00..6eef65764df 100644 --- a/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.expr +++ b/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.expr @@ -1,176 +1,202 @@ -GenericPackageDescription - {condBenchmarks = [], - condExecutables = [], - condForeignLibs = [], - condLibrary = Just - CondNode - {condTreeComponents = [CondBranch - {condBranchCondition = `CNot (Var (PackageFlag (FlagName "\\28961")))`, - condBranchIfFalse = Nothing, - condBranchIfTrue = CondNode - {condTreeComponents = [], - condTreeConstraints = [], - condTreeData = Library - {exposedModules = [], - libBuildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = False, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Nothing, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [], - oldExtensions = [], - options = PerCompilerFlavor - [] - [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor - [] - [], - sharedOptions = PerCompilerFlavor - [] - [], - staticOptions = PerCompilerFlavor - [] - [], - targetBuildDepends = [], - virtualModules = []}, - libExposed = True, - libName = LMainLibName, - libVisibility = LibraryVisibilityPublic, - reexportedModules = [], - signatures = []}}}], - condTreeConstraints = [], - condTreeData = Library - {exposedModules = [ModuleName "\937"], - libBuildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = True, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Just Haskell2010, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [], - oldExtensions = [], - options = PerCompilerFlavor [] [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor [] [], - sharedOptions = PerCompilerFlavor [] [], - staticOptions = PerCompilerFlavor [] [], - targetBuildDepends = [], - virtualModules = []}, - libExposed = True, - libName = LMainLibName, - libVisibility = LibraryVisibilityPublic, - reexportedModules = [], - signatures = []}}, - condSubLibraries = [], - condTestSuites = [], - genPackageFlags = [MkPackageFlag - {flagDefault = True, - flagDescription = "\28961", - flagManual = False, - flagName = FlagName "\28961"}], - gpdScannedVersion = Nothing, - packageDescription = PackageDescription - {author = "", - benchmarks = [], - bugReports = "", - buildTypeRaw = Just Simple, - category = "", - copyright = "", - customFieldsPD = [_×_ "x-\28961" "\28961"], - dataDir = ".", - dataFiles = [], - description = "", - executables = [], - extraDocFiles = [], - extraSrcFiles = [], - extraTmpFiles = [], - foreignLibs = [], - homepage = "", - library = Nothing, - licenseFiles = [], - licenseRaw = Left NONE, - maintainer = "", - package = PackageIdentifier - {pkgName = PackageName "\28961", pkgVersion = mkVersion [0]}, - pkgUrl = "", - setupBuildInfo = Nothing, - sourceRepos = [SourceRepo - {repoBranch = Nothing, - repoKind = RepoHead, - repoLocation = Just "https://github.com/hvr/-.git", - repoModule = Nothing, - repoSubdir = Nothing, - repoTag = Nothing, - repoType = Just (KnownRepoType Git)}], - specVersion = CabalSpecV1_10, - stability = "", - subLibraries = [], - synopsis = "The canonical non-package \28961", - testSuites = [], - testedWith = []}} +GenericPackageDescription { + packageDescription = + PackageDescription { + specVersion = CabalSpecV1_10, + package = PackageIdentifier { + pkgName = PackageName "\28961", + pkgVersion = mkVersion [0]}, + licenseRaw = Left NONE, + licenseFiles = [], + copyright = "", + maintainer = "", + author = "", + stability = "", + testedWith = [], + homepage = "", + pkgUrl = "", + bugReports = "", + sourceRepos = [ + SourceRepo { + repoKind = RepoHead, + repoType = Just + (KnownRepoType Git), + repoLocation = Just + "https://github.com/hvr/-.git", + repoModule = Nothing, + repoBranch = Nothing, + repoTag = Nothing, + repoSubdir = Nothing}], + synopsis = + "The canonical non-package \28961", + description = "", + category = "", + customFieldsPD = [ + _×_ "x-\28961" "\28961"], + buildTypeRaw = Just Simple, + setupBuildInfo = Nothing, + library = Nothing, + subLibraries = [], + executables = [], + foreignLibs = [], + testSuites = [], + benchmarks = [], + dataFiles = [], + dataDir = ".", + extraSrcFiles = [], + extraTmpFiles = [], + extraDocFiles = []}, + gpdScannedVersion = Nothing, + genPackageFlags = [ + MkPackageFlag { + flagName = FlagName "\28961", + flagDescription = "\28961", + flagDefault = True, + flagManual = False}], + condLibrary = Just + CondNode { + condTreeData = Library { + libName = LMainLibName, + exposedModules = [ + ModuleName "\937"], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPublic, + libBuildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Just + Haskell2010, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [], + targetPrivateBuildDepends = [], + mixins = []}}, + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, + condTreeComponents = [ + CondBranch { + condBranchCondition = + `CNot (Var (PackageFlag (FlagName "\\28961")))`, + condBranchIfTrue = CondNode { + condTreeData = Library { + libName = LMainLibName, + exposedModules = [], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPublic, + libBuildInfo = BuildInfo { + buildable = False, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Nothing, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [], + targetPrivateBuildDepends = [], + mixins = []}}, + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, + condTreeComponents = []}, + condBranchIfFalse = Nothing}]}, + condSubLibraries = [], + condForeignLibs = [], + condExecutables = [], + condTestSuites = [], + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/shake.expr b/Cabal-tests/tests/ParserTests/regressions/shake.expr index 30e0f9077c1..5ef299e1cbb 100644 --- a/Cabal-tests/tests/ParserTests/regressions/shake.expr +++ b/Cabal-tests/tests/ParserTests/regressions/shake.expr @@ -357,81 +357,85 @@ GenericPackageDescription { (OrLaterVersion (mkVersion [1, 1])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (OrLaterVersion - (mkVersion [4, 5])) - mainLibSet, - Dependency - (PackageName "directory") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "hashable") - (OrLaterVersion - (mkVersion [1, 1, 2, 3])) - mainLibSet, - Dependency - (PackageName "binary") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "filepath") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "process") - (OrLaterVersion - (mkVersion [1, 1])) - mainLibSet, - Dependency - (PackageName - "unordered-containers") - (OrLaterVersion - (mkVersion [0, 2, 1])) - mainLibSet, - Dependency - (PackageName "bytestring") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "utf8-string") - (OrLaterVersion - (mkVersion [0, 3])) - mainLibSet, - Dependency - (PackageName "time") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "random") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "js-jquery") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "js-flot") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "transformers") - (OrLaterVersion - (mkVersion [0, 2])) - mainLibSet, - Dependency - (PackageName "extra") - (OrLaterVersion - (mkVersion [1, 4, 8])) - mainLibSet, - Dependency - (PackageName "deepseq") - (OrLaterVersion - (mkVersion [1, 1])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (OrLaterVersion + (mkVersion [4, 5])) + mainLibSet, + Dependency + (PackageName "directory") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "hashable") + (OrLaterVersion + (mkVersion [1, 1, 2, 3])) + mainLibSet, + Dependency + (PackageName "binary") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "filepath") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "process") + (OrLaterVersion + (mkVersion [1, 1])) + mainLibSet, + Dependency + (PackageName + "unordered-containers") + (OrLaterVersion + (mkVersion [0, 2, 1])) + mainLibSet, + Dependency + (PackageName "bytestring") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "utf8-string") + (OrLaterVersion + (mkVersion [0, 3])) + mainLibSet, + Dependency + (PackageName "time") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "random") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "js-jquery") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "js-flot") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "transformers") + (OrLaterVersion + (mkVersion [0, 2])) + mainLibSet, + Dependency + (PackageName "extra") + (OrLaterVersion + (mkVersion [1, 4, 8])) + mainLibSet, + Dependency + (PackageName "deepseq") + (OrLaterVersion + (mkVersion [1, 1])) + mainLibSet], + privateDependencies = []}, condTreeComponents = [ CondBranch { condBranchCondition = @@ -497,8 +501,12 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = [ CondBranch { condBranchCondition = @@ -568,12 +576,16 @@ GenericPackageDescription { (PackageName "old-time") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "old-time") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "old-time") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}]}, condBranchIfFalse = Just @@ -638,8 +650,12 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = [ CondBranch { condBranchCondition = @@ -710,13 +726,17 @@ GenericPackageDescription { (OrLaterVersion (mkVersion [2, 5, 1])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "unix") - (OrLaterVersion - (mkVersion [2, 5, 1])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "unix") + (OrLaterVersion + (mkVersion [2, 5, 1])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}]}}, CondBranch { @@ -787,12 +807,16 @@ GenericPackageDescription { (PackageName "unix") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "unix") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "unix") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}]}, condSubLibraries = [], @@ -1038,87 +1062,91 @@ GenericPackageDescription { (PackageName "primitive") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges - (OrLaterVersion (mkVersion [4])) - (EarlierVersion - (mkVersion [5]))) - mainLibSet, - Dependency - (PackageName "directory") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "hashable") - (OrLaterVersion - (mkVersion [1, 1, 2, 3])) - mainLibSet, - Dependency - (PackageName "binary") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "filepath") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "process") - (OrLaterVersion - (mkVersion [1, 1])) - mainLibSet, - Dependency - (PackageName - "unordered-containers") - (OrLaterVersion - (mkVersion [0, 2, 1])) - mainLibSet, - Dependency - (PackageName "bytestring") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "utf8-string") - (OrLaterVersion - (mkVersion [0, 3])) - mainLibSet, - Dependency - (PackageName "time") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "random") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "js-jquery") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "js-flot") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "transformers") - (OrLaterVersion - (mkVersion [0, 2])) - mainLibSet, - Dependency - (PackageName "extra") - (OrLaterVersion - (mkVersion [1, 4, 8])) - mainLibSet, - Dependency - (PackageName "deepseq") - (OrLaterVersion - (mkVersion [1, 1])) - mainLibSet, - Dependency - (PackageName "primitive") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (OrLaterVersion (mkVersion [4])) + (EarlierVersion + (mkVersion [5]))) + mainLibSet, + Dependency + (PackageName "directory") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "hashable") + (OrLaterVersion + (mkVersion [1, 1, 2, 3])) + mainLibSet, + Dependency + (PackageName "binary") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "filepath") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "process") + (OrLaterVersion + (mkVersion [1, 1])) + mainLibSet, + Dependency + (PackageName + "unordered-containers") + (OrLaterVersion + (mkVersion [0, 2, 1])) + mainLibSet, + Dependency + (PackageName "bytestring") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "utf8-string") + (OrLaterVersion + (mkVersion [0, 3])) + mainLibSet, + Dependency + (PackageName "time") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "random") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "js-jquery") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "js-flot") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "transformers") + (OrLaterVersion + (mkVersion [0, 2])) + mainLibSet, + Dependency + (PackageName "extra") + (OrLaterVersion + (mkVersion [1, 4, 8])) + mainLibSet, + Dependency + (PackageName "deepseq") + (OrLaterVersion + (mkVersion [1, 1])) + mainLibSet, + Dependency + (PackageName "primitive") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = [ CondBranch { condBranchCondition = @@ -1183,8 +1211,12 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}, CondBranch { @@ -1248,8 +1280,12 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = [ CondBranch { condBranchCondition = @@ -1316,12 +1352,16 @@ GenericPackageDescription { (PackageName "old-time") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "old-time") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "old-time") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}]}, condBranchIfFalse = Just @@ -1383,8 +1423,12 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = [ CondBranch { condBranchCondition = @@ -1452,13 +1496,17 @@ GenericPackageDescription { (OrLaterVersion (mkVersion [2, 5, 1])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "unix") - (OrLaterVersion - (mkVersion [2, 5, 1])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "unix") + (OrLaterVersion + (mkVersion [2, 5, 1])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}]}}, CondBranch { @@ -1526,12 +1574,16 @@ GenericPackageDescription { (PackageName "unix") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "unix") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "unix") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}]}], condTestSuites = [ @@ -1821,89 +1873,93 @@ GenericPackageDescription { (OrLaterVersion (mkVersion [2, 0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges - (OrLaterVersion (mkVersion [4])) - (EarlierVersion - (mkVersion [5]))) - mainLibSet, - Dependency - (PackageName "directory") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "hashable") - (OrLaterVersion - (mkVersion [1, 1, 2, 3])) - mainLibSet, - Dependency - (PackageName "binary") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "filepath") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "process") - (OrLaterVersion - (mkVersion [1, 1])) - mainLibSet, - Dependency - (PackageName - "unordered-containers") - (OrLaterVersion - (mkVersion [0, 2, 1])) - mainLibSet, - Dependency - (PackageName "bytestring") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "utf8-string") - (OrLaterVersion - (mkVersion [0, 3])) - mainLibSet, - Dependency - (PackageName "time") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "random") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "js-jquery") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "js-flot") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "transformers") - (OrLaterVersion - (mkVersion [0, 2])) - mainLibSet, - Dependency - (PackageName "deepseq") - (OrLaterVersion - (mkVersion [1, 1])) - mainLibSet, - Dependency - (PackageName "extra") - (OrLaterVersion - (mkVersion [1, 4, 8])) - mainLibSet, - Dependency - (PackageName "QuickCheck") - (OrLaterVersion - (mkVersion [2, 0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (OrLaterVersion (mkVersion [4])) + (EarlierVersion + (mkVersion [5]))) + mainLibSet, + Dependency + (PackageName "directory") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "hashable") + (OrLaterVersion + (mkVersion [1, 1, 2, 3])) + mainLibSet, + Dependency + (PackageName "binary") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "filepath") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "process") + (OrLaterVersion + (mkVersion [1, 1])) + mainLibSet, + Dependency + (PackageName + "unordered-containers") + (OrLaterVersion + (mkVersion [0, 2, 1])) + mainLibSet, + Dependency + (PackageName "bytestring") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "utf8-string") + (OrLaterVersion + (mkVersion [0, 3])) + mainLibSet, + Dependency + (PackageName "time") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "random") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "js-jquery") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "js-flot") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "transformers") + (OrLaterVersion + (mkVersion [0, 2])) + mainLibSet, + Dependency + (PackageName "deepseq") + (OrLaterVersion + (mkVersion [1, 1])) + mainLibSet, + Dependency + (PackageName "extra") + (OrLaterVersion + (mkVersion [1, 4, 8])) + mainLibSet, + Dependency + (PackageName "QuickCheck") + (OrLaterVersion + (mkVersion [2, 0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = [ CondBranch { condBranchCondition = @@ -1969,9 +2025,13 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}, CondBranch { @@ -2038,9 +2098,13 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}, CondBranch { @@ -2107,9 +2171,13 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = [ CondBranch { condBranchCondition = @@ -2179,13 +2247,17 @@ GenericPackageDescription { (PackageName "old-time") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [ - Dependency - (PackageName "old-time") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "old-time") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}]}, condBranchIfFalse = Just @@ -2250,9 +2322,13 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = [ CondBranch { condBranchCondition = @@ -2323,14 +2399,18 @@ GenericPackageDescription { (OrLaterVersion (mkVersion [2, 5, 1])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [ - Dependency - (PackageName "unix") - (OrLaterVersion - (mkVersion [2, 5, 1])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "unix") + (OrLaterVersion + (mkVersion [2, 5, 1])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}]}}, CondBranch { @@ -2401,13 +2481,17 @@ GenericPackageDescription { (PackageName "unix") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [ - Dependency - (PackageName "unix") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "unix") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}]}], condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/spdx-1.expr b/Cabal-tests/tests/ParserTests/regressions/spdx-1.expr index 29b85215c1a..129a44c7d56 100644 --- a/Cabal-tests/tests/ParserTests/regressions/spdx-1.expr +++ b/Cabal-tests/tests/ParserTests/regressions/spdx-1.expr @@ -1,98 +1,113 @@ -GenericPackageDescription - {condBenchmarks = [], - condExecutables = [], - condForeignLibs = [], - condLibrary = Just - CondNode - {condTreeComponents = [], - condTreeConstraints = [], - condTreeData = Library - {exposedModules = [], - libBuildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = True, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Just Haskell2010, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [], - oldExtensions = [], - options = PerCompilerFlavor [] [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor [] [], - sharedOptions = PerCompilerFlavor [] [], - staticOptions = PerCompilerFlavor [] [], - targetBuildDepends = [], - virtualModules = []}, - libExposed = True, - libName = LMainLibName, - libVisibility = LibraryVisibilityPublic, - reexportedModules = [], - signatures = []}}, - condSubLibraries = [], - condTestSuites = [], - genPackageFlags = [], - gpdScannedVersion = Nothing, - packageDescription = PackageDescription - {author = "", - benchmarks = [], - bugReports = "", - buildTypeRaw = Just Simple, - category = "", - copyright = "", - customFieldsPD = [], - dataDir = ".", - dataFiles = [], - description = "", - executables = [], - extraDocFiles = [], - extraSrcFiles = [], - extraTmpFiles = [], - foreignLibs = [], - homepage = "", - library = Nothing, - licenseFiles = [], - licenseRaw = Right BSD3, - maintainer = "", - package = PackageIdentifier - {pkgName = PackageName "spdx", pkgVersion = mkVersion [0]}, - pkgUrl = "", - setupBuildInfo = Nothing, - sourceRepos = [], - specVersion = CabalSpecV2_0, - stability = "", - subLibraries = [], - synopsis = "testing positive parsing of spdx identifiers", - testSuites = [], - testedWith = []}} +GenericPackageDescription { + packageDescription = + PackageDescription { + specVersion = CabalSpecV2_0, + package = PackageIdentifier { + pkgName = PackageName "spdx", + pkgVersion = mkVersion [0]}, + licenseRaw = Right BSD3, + licenseFiles = [], + copyright = "", + maintainer = "", + author = "", + stability = "", + testedWith = [], + homepage = "", + pkgUrl = "", + bugReports = "", + sourceRepos = [], + synopsis = + "testing positive parsing of spdx identifiers", + description = "", + category = "", + customFieldsPD = [], + buildTypeRaw = Just Simple, + setupBuildInfo = Nothing, + library = Nothing, + subLibraries = [], + executables = [], + foreignLibs = [], + testSuites = [], + benchmarks = [], + dataFiles = [], + dataDir = ".", + extraSrcFiles = [], + extraTmpFiles = [], + extraDocFiles = []}, + gpdScannedVersion = Nothing, + genPackageFlags = [], + condLibrary = Just + CondNode { + condTreeData = Library { + libName = LMainLibName, + exposedModules = [], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPublic, + libBuildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Just + Haskell2010, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [], + targetPrivateBuildDepends = [], + mixins = []}}, + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, + condTreeComponents = []}, + condSubLibraries = [], + condForeignLibs = [], + condExecutables = [], + condTestSuites = [], + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/spdx-2.expr b/Cabal-tests/tests/ParserTests/regressions/spdx-2.expr index 427f0eb21ca..8ffc8d6d859 100644 --- a/Cabal-tests/tests/ParserTests/regressions/spdx-2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/spdx-2.expr @@ -1,99 +1,117 @@ -GenericPackageDescription - {condBenchmarks = [], - condExecutables = [], - condForeignLibs = [], - condLibrary = Just - CondNode - {condTreeComponents = [], - condTreeConstraints = [], - condTreeData = Library - {exposedModules = [], - libBuildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = True, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Just Haskell2010, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [], - oldExtensions = [], - options = PerCompilerFlavor [] [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor [] [], - sharedOptions = PerCompilerFlavor [] [], - staticOptions = PerCompilerFlavor [] [], - targetBuildDepends = [], - virtualModules = []}, - libExposed = True, - libName = LMainLibName, - libVisibility = LibraryVisibilityPublic, - reexportedModules = [], - signatures = []}}, - condSubLibraries = [], - condTestSuites = [], - genPackageFlags = [], - gpdScannedVersion = Nothing, - packageDescription = PackageDescription - {author = "", - benchmarks = [], - bugReports = "", - buildTypeRaw = Just Simple, - category = "", - copyright = "", - customFieldsPD = [], - dataDir = ".", - dataFiles = [], - description = "", - executables = [], - extraDocFiles = [], - extraSrcFiles = [], - extraTmpFiles = [], - foreignLibs = [], - homepage = "", - library = Nothing, - licenseFiles = [], - licenseRaw = Left - (License (ELicense (ELicenseId AGPL_1_0) Nothing)), - maintainer = "", - package = PackageIdentifier - {pkgName = PackageName "spdx", pkgVersion = mkVersion [0]}, - pkgUrl = "", - setupBuildInfo = Nothing, - sourceRepos = [], - specVersion = CabalSpecV2_2, - stability = "", - subLibraries = [], - synopsis = "testing positive parsing of spdx identifiers", - testSuites = [], - testedWith = []}} +GenericPackageDescription { + packageDescription = + PackageDescription { + specVersion = CabalSpecV2_2, + package = PackageIdentifier { + pkgName = PackageName "spdx", + pkgVersion = mkVersion [0]}, + licenseRaw = Left + (License + (ELicense + (ELicenseId AGPL_1_0) + Nothing)), + licenseFiles = [], + copyright = "", + maintainer = "", + author = "", + stability = "", + testedWith = [], + homepage = "", + pkgUrl = "", + bugReports = "", + sourceRepos = [], + synopsis = + "testing positive parsing of spdx identifiers", + description = "", + category = "", + customFieldsPD = [], + buildTypeRaw = Just Simple, + setupBuildInfo = Nothing, + library = Nothing, + subLibraries = [], + executables = [], + foreignLibs = [], + testSuites = [], + benchmarks = [], + dataFiles = [], + dataDir = ".", + extraSrcFiles = [], + extraTmpFiles = [], + extraDocFiles = []}, + gpdScannedVersion = Nothing, + genPackageFlags = [], + condLibrary = Just + CondNode { + condTreeData = Library { + libName = LMainLibName, + exposedModules = [], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPublic, + libBuildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Just + Haskell2010, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [], + targetPrivateBuildDepends = [], + mixins = []}}, + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, + condTreeComponents = []}, + condSubLibraries = [], + condForeignLibs = [], + condExecutables = [], + condTestSuites = [], + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/spdx-3.expr b/Cabal-tests/tests/ParserTests/regressions/spdx-3.expr index b7b57e34bf1..81825160646 100644 --- a/Cabal-tests/tests/ParserTests/regressions/spdx-3.expr +++ b/Cabal-tests/tests/ParserTests/regressions/spdx-3.expr @@ -1,99 +1,117 @@ -GenericPackageDescription - {condBenchmarks = [], - condExecutables = [], - condForeignLibs = [], - condLibrary = Just - CondNode - {condTreeComponents = [], - condTreeConstraints = [], - condTreeData = Library - {exposedModules = [], - libBuildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = True, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Just Haskell2010, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [], - oldExtensions = [], - options = PerCompilerFlavor [] [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor [] [], - sharedOptions = PerCompilerFlavor [] [], - staticOptions = PerCompilerFlavor [] [], - targetBuildDepends = [], - virtualModules = []}, - libExposed = True, - libName = LMainLibName, - libVisibility = LibraryVisibilityPublic, - reexportedModules = [], - signatures = []}}, - condSubLibraries = [], - condTestSuites = [], - genPackageFlags = [], - gpdScannedVersion = Nothing, - packageDescription = PackageDescription - {author = "", - benchmarks = [], - bugReports = "", - buildTypeRaw = Just Simple, - category = "", - copyright = "", - customFieldsPD = [], - dataDir = ".", - dataFiles = [], - description = "", - executables = [], - extraDocFiles = [], - extraSrcFiles = [], - extraTmpFiles = [], - foreignLibs = [], - homepage = "", - library = Nothing, - licenseFiles = [], - licenseRaw = Left - (License (ELicense (ELicenseId AGPL_1_0_only) Nothing)), - maintainer = "", - package = PackageIdentifier - {pkgName = PackageName "spdx", pkgVersion = mkVersion [0]}, - pkgUrl = "", - setupBuildInfo = Nothing, - sourceRepos = [], - specVersion = CabalSpecV2_4, - stability = "", - subLibraries = [], - synopsis = "testing positive parsing of spdx identifiers", - testSuites = [], - testedWith = []}} +GenericPackageDescription { + packageDescription = + PackageDescription { + specVersion = CabalSpecV2_4, + package = PackageIdentifier { + pkgName = PackageName "spdx", + pkgVersion = mkVersion [0]}, + licenseRaw = Left + (License + (ELicense + (ELicenseId AGPL_1_0_only) + Nothing)), + licenseFiles = [], + copyright = "", + maintainer = "", + author = "", + stability = "", + testedWith = [], + homepage = "", + pkgUrl = "", + bugReports = "", + sourceRepos = [], + synopsis = + "testing positive parsing of spdx identifiers", + description = "", + category = "", + customFieldsPD = [], + buildTypeRaw = Just Simple, + setupBuildInfo = Nothing, + library = Nothing, + subLibraries = [], + executables = [], + foreignLibs = [], + testSuites = [], + benchmarks = [], + dataFiles = [], + dataDir = ".", + extraSrcFiles = [], + extraTmpFiles = [], + extraDocFiles = []}, + gpdScannedVersion = Nothing, + genPackageFlags = [], + condLibrary = Just + CondNode { + condTreeData = Library { + libName = LMainLibName, + exposedModules = [], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPublic, + libBuildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Just + Haskell2010, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [], + targetPrivateBuildDepends = [], + mixins = []}}, + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, + condTreeComponents = []}, + condSubLibraries = [], + condForeignLibs = [], + condExecutables = [], + condTestSuites = [], + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/th-lift-instances.expr b/Cabal-tests/tests/ParserTests/regressions/th-lift-instances.expr index f714c7a0fe4..77f50ad335b 100644 --- a/Cabal-tests/tests/ParserTests/regressions/th-lift-instances.expr +++ b/Cabal-tests/tests/ParserTests/regressions/th-lift-instances.expr @@ -180,57 +180,61 @@ GenericPackageDescription { (EarlierVersion (mkVersion [0, 11]))) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [4, 4])) - (EarlierVersion - (mkVersion [5]))) - mainLibSet, - Dependency - (PackageName "template-haskell") - (EarlierVersion - (mkVersion [2, 10])) - mainLibSet, - Dependency - (PackageName "th-lift") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "containers") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [0, 4])) - (EarlierVersion - (mkVersion [0, 6]))) - mainLibSet, - Dependency - (PackageName "vector") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [0, 9])) - (EarlierVersion - (mkVersion [0, 11]))) - mainLibSet, - Dependency - (PackageName "text") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [0, 11])) - (EarlierVersion - (mkVersion [1, 3]))) - mainLibSet, - Dependency - (PackageName "bytestring") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [0, 9])) + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [4, 4])) + (EarlierVersion + (mkVersion [5]))) + mainLibSet, + Dependency + (PackageName "template-haskell") (EarlierVersion - (mkVersion [0, 11]))) - mainLibSet], + (mkVersion [2, 10])) + mainLibSet, + Dependency + (PackageName "th-lift") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "containers") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [0, 4])) + (EarlierVersion + (mkVersion [0, 6]))) + mainLibSet, + Dependency + (PackageName "vector") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [0, 9])) + (EarlierVersion + (mkVersion [0, 11]))) + mainLibSet, + Dependency + (PackageName "text") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [0, 11])) + (EarlierVersion + (mkVersion [1, 3]))) + mainLibSet, + Dependency + (PackageName "bytestring") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [0, 9])) + (EarlierVersion + (mkVersion [0, 11]))) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, condSubLibraries = [], condForeignLibs = [], @@ -356,63 +360,67 @@ GenericPackageDescription { (EarlierVersion (mkVersion [2, 8]))) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "template-haskell") - (EarlierVersion - (mkVersion [2, 10])) - mainLibSet, - Dependency - (PackageName "containers") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [0, 4])) - (EarlierVersion - (mkVersion [0, 6]))) - mainLibSet, - Dependency - (PackageName "vector") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [0, 9])) - (EarlierVersion - (mkVersion [0, 11]))) - mainLibSet, - Dependency - (PackageName "text") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [0, 11])) - (EarlierVersion - (mkVersion [1, 2]))) - mainLibSet, - Dependency - (PackageName "bytestring") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [0, 9])) - (EarlierVersion - (mkVersion [0, 11]))) - mainLibSet, - Dependency - (PackageName - "th-lift-instances") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "QuickCheck") - (IntersectVersionRanges - (OrLaterVersion - (mkVersion [2, 6])) + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "template-haskell") (EarlierVersion - (mkVersion [2, 8]))) - mainLibSet], + (mkVersion [2, 10])) + mainLibSet, + Dependency + (PackageName "containers") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [0, 4])) + (EarlierVersion + (mkVersion [0, 6]))) + mainLibSet, + Dependency + (PackageName "vector") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [0, 9])) + (EarlierVersion + (mkVersion [0, 11]))) + mainLibSet, + Dependency + (PackageName "text") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [0, 11])) + (EarlierVersion + (mkVersion [1, 2]))) + mainLibSet, + Dependency + (PackageName "bytestring") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [0, 9])) + (EarlierVersion + (mkVersion [0, 11]))) + mainLibSet, + Dependency + (PackageName + "th-lift-instances") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "QuickCheck") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [2, 6])) + (EarlierVersion + (mkVersion [2, 8]))) + mainLibSet], + privateDependencies = []}, condTreeComponents = []}, _×_ (UnqualComponentName "doctests") @@ -495,27 +503,31 @@ GenericPackageDescription { (PackageName "filepath") (OrLaterVersion (mkVersion [0])) mainLibSet], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [ - Dependency - (PackageName "base") - (OrLaterVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "directory") - (OrLaterVersion - (mkVersion [1, 0])) - mainLibSet, - Dependency - (PackageName "doctest") - (OrLaterVersion - (mkVersion [0, 9, 1])) - mainLibSet, - Dependency - (PackageName "filepath") - (OrLaterVersion (mkVersion [0])) - mainLibSet], + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "directory") + (OrLaterVersion + (mkVersion [1, 0])) + mainLibSet, + Dependency + (PackageName "doctest") + (OrLaterVersion + (mkVersion [0, 9, 1])) + mainLibSet, + Dependency + (PackageName "filepath") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, condTreeComponents = [ CondBranch { condBranchCondition = @@ -581,9 +593,13 @@ GenericPackageDescription { PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [], + targetPrivateBuildDepends = [], mixins = []}, testCodeGenerators = []}, - condTreeConstraints = [], + condTreeConstraints = + Dependencies { + publicDependencies = [], + privateDependencies = []}, condTreeComponents = []}, condBranchIfFalse = Nothing}]}], condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/version-sets.expr b/Cabal-tests/tests/ParserTests/regressions/version-sets.expr index f3c993b7b7b..15c953fbccd 100644 --- a/Cabal-tests/tests/ParserTests/regressions/version-sets.expr +++ b/Cabal-tests/tests/ParserTests/regressions/version-sets.expr @@ -1,286 +1,267 @@ -GenericPackageDescription - {condBenchmarks = [], - condExecutables = [], - condForeignLibs = [], - condLibrary = Just - CondNode - {condTreeComponents = [], - condTreeConstraints = [Dependency - (PackageName "network") - (MajorBoundVersion (mkVersion [0])) - mainLibSet, - Dependency - (PackageName "base") - (ThisVersion (mkVersion [1])) - mainLibSet, - Dependency - (PackageName "base") - (ThisVersion (mkVersion [1])) - mainLibSet, - Dependency - (PackageName "base") - (UnionVersionRanges - (ThisVersion (mkVersion [1])) - (ThisVersion (mkVersion [2]))) - mainLibSet, - Dependency - (PackageName "base") - (ThisVersion (mkVersion [1, 2])) - mainLibSet, - Dependency - (PackageName "base") - (UnionVersionRanges - (ThisVersion (mkVersion [1, 2])) - (ThisVersion (mkVersion [3, 4]))) - mainLibSet, - Dependency - (PackageName "ghc") - (UnionVersionRanges - (ThisVersion (mkVersion [8, 6, 3])) - (UnionVersionRanges - (ThisVersion (mkVersion [8, 4, 4])) - (UnionVersionRanges - (ThisVersion (mkVersion [8, 2, 2])) - (UnionVersionRanges - (ThisVersion (mkVersion [8, 0, 2])) - (UnionVersionRanges - (ThisVersion (mkVersion [7, 10, 3])) - (UnionVersionRanges - (ThisVersion (mkVersion [7, 8, 4])) - (UnionVersionRanges - (ThisVersion - (mkVersion [7, 6, 3])) - (ThisVersion - (mkVersion [7, 4, 2]))))))))) - mainLibSet, - Dependency - (PackageName "Cabal") - (UnionVersionRanges - (MajorBoundVersion (mkVersion [2, 4, 1, 1])) - (MajorBoundVersion (mkVersion [2, 2, 0, 0]))) - mainLibSet], - condTreeData = Library - {exposedModules = [], - libBuildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = True, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Just Haskell2010, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [], - oldExtensions = [], - options = PerCompilerFlavor [] [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor [] [], - sharedOptions = PerCompilerFlavor [] [], - staticOptions = PerCompilerFlavor [] [], - targetBuildDepends = [Dependency - (PackageName - "network") - (MajorBoundVersion - (mkVersion - [0])) - mainLibSet, - Dependency - (PackageName - "base") - (ThisVersion - (mkVersion - [1])) - mainLibSet, - Dependency - (PackageName - "base") - (ThisVersion - (mkVersion - [1])) - mainLibSet, - Dependency - (PackageName - "base") - (UnionVersionRanges - (ThisVersion - (mkVersion - [1])) - (ThisVersion - (mkVersion - [2]))) - mainLibSet, - Dependency - (PackageName - "base") - (ThisVersion - (mkVersion - [1, 2])) - mainLibSet, - Dependency - (PackageName - "base") - (UnionVersionRanges - (ThisVersion - (mkVersion - [1, 2])) - (ThisVersion - (mkVersion - [3, 4]))) - mainLibSet, - Dependency - (PackageName - "ghc") - (UnionVersionRanges - (ThisVersion - (mkVersion - [8, - 6, - 3])) - (UnionVersionRanges - (ThisVersion - (mkVersion - [8, - 4, - 4])) - (UnionVersionRanges - (ThisVersion - (mkVersion - [8, - 2, - 2])) - (UnionVersionRanges - (ThisVersion - (mkVersion - [8, - 0, - 2])) - (UnionVersionRanges - (ThisVersion - (mkVersion - [7, - 10, - 3])) - (UnionVersionRanges - (ThisVersion - (mkVersion - [7, - 8, - 4])) - (UnionVersionRanges - (ThisVersion - (mkVersion - [7, - 6, - 3])) - (ThisVersion - (mkVersion - [7, - 4, - 2]))))))))) - mainLibSet, - Dependency - (PackageName - "Cabal") - (UnionVersionRanges - (MajorBoundVersion - (mkVersion - [2, - 4, - 1, - 1])) - (MajorBoundVersion - (mkVersion - [2, - 2, - 0, - 0]))) - mainLibSet], - virtualModules = []}, - libExposed = True, - libName = LMainLibName, - libVisibility = LibraryVisibilityPublic, - reexportedModules = [], - signatures = []}}, - condSubLibraries = [], - condTestSuites = [], - genPackageFlags = [], - gpdScannedVersion = Nothing, - packageDescription = PackageDescription - {author = "", - benchmarks = [], - bugReports = "", - buildTypeRaw = Nothing, - category = "", - copyright = "", - customFieldsPD = [], - dataDir = ".", - dataFiles = [], - description = "", - executables = [], - extraDocFiles = [], - extraSrcFiles = [], - extraTmpFiles = [], - foreignLibs = [], - homepage = "", - library = Nothing, - licenseFiles = [], - licenseRaw = Left NONE, - maintainer = "", - package = PackageIdentifier - {pkgName = PackageName "version-sets", - pkgVersion = mkVersion [0]}, - pkgUrl = "", - setupBuildInfo = Nothing, - sourceRepos = [], - specVersion = CabalSpecV3_0, - stability = "", - subLibraries = [], - synopsis = "version set notation", - testSuites = [], - testedWith = [_×_ - GHC - (UnionVersionRanges - (ThisVersion (mkVersion [8, 6, 3])) - (UnionVersionRanges - (ThisVersion (mkVersion [8, 4, 4])) - (UnionVersionRanges - (ThisVersion (mkVersion [8, 2, 2])) - (UnionVersionRanges - (ThisVersion (mkVersion [8, 0, 2])) - (UnionVersionRanges - (ThisVersion (mkVersion [7, 10, 3])) - (UnionVersionRanges - (ThisVersion (mkVersion [7, 8, 4])) - (UnionVersionRanges - (ThisVersion (mkVersion [7, 6, 3])) - (ThisVersion - (mkVersion [7, 4, 2])))))))))]}} +GenericPackageDescription { + packageDescription = + PackageDescription { + specVersion = CabalSpecV3_0, + package = PackageIdentifier { + pkgName = PackageName + "version-sets", + pkgVersion = mkVersion [0]}, + licenseRaw = Left NONE, + licenseFiles = [], + copyright = "", + maintainer = "", + author = "", + stability = "", + testedWith = [ + _×_ + GHC + (UnionVersionRanges + (ThisVersion + (mkVersion [8, 6, 3])) + (UnionVersionRanges + (ThisVersion + (mkVersion [8, 4, 4])) + (UnionVersionRanges + (ThisVersion + (mkVersion [8, 2, 2])) + (UnionVersionRanges + (ThisVersion + (mkVersion [8, 0, 2])) + (UnionVersionRanges + (ThisVersion + (mkVersion [7, 10, 3])) + (UnionVersionRanges + (ThisVersion + (mkVersion [7, 8, 4])) + (UnionVersionRanges + (ThisVersion + (mkVersion [7, 6, 3])) + (ThisVersion + (mkVersion [7, 4, 2])))))))))], + homepage = "", + pkgUrl = "", + bugReports = "", + sourceRepos = [], + synopsis = + "version set notation", + description = "", + category = "", + customFieldsPD = [], + buildTypeRaw = Nothing, + setupBuildInfo = Nothing, + library = Nothing, + subLibraries = [], + executables = [], + foreignLibs = [], + testSuites = [], + benchmarks = [], + dataFiles = [], + dataDir = ".", + extraSrcFiles = [], + extraTmpFiles = [], + extraDocFiles = []}, + gpdScannedVersion = Nothing, + genPackageFlags = [], + condLibrary = Just + CondNode { + condTreeData = Library { + libName = LMainLibName, + exposedModules = [], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPublic, + libBuildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Just + Haskell2010, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [ + Dependency + (PackageName "network") + (MajorBoundVersion + (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "base") + (ThisVersion (mkVersion [1])) + mainLibSet, + Dependency + (PackageName "base") + (ThisVersion (mkVersion [1])) + mainLibSet, + Dependency + (PackageName "base") + (UnionVersionRanges + (ThisVersion (mkVersion [1])) + (ThisVersion (mkVersion [2]))) + mainLibSet, + Dependency + (PackageName "base") + (ThisVersion (mkVersion [1, 2])) + mainLibSet, + Dependency + (PackageName "base") + (UnionVersionRanges + (ThisVersion (mkVersion [1, 2])) + (ThisVersion + (mkVersion [3, 4]))) + mainLibSet, + Dependency + (PackageName "ghc") + (UnionVersionRanges + (ThisVersion + (mkVersion [8, 6, 3])) + (UnionVersionRanges + (ThisVersion + (mkVersion [8, 4, 4])) + (UnionVersionRanges + (ThisVersion + (mkVersion [8, 2, 2])) + (UnionVersionRanges + (ThisVersion + (mkVersion [8, 0, 2])) + (UnionVersionRanges + (ThisVersion + (mkVersion [7, 10, 3])) + (UnionVersionRanges + (ThisVersion + (mkVersion [7, 8, 4])) + (UnionVersionRanges + (ThisVersion + (mkVersion [7, 6, 3])) + (ThisVersion + (mkVersion [7, 4, 2]))))))))) + mainLibSet, + Dependency + (PackageName "Cabal") + (UnionVersionRanges + (MajorBoundVersion + (mkVersion [2, 4, 1, 1])) + (MajorBoundVersion + (mkVersion [2, 2, 0, 0]))) + mainLibSet], + targetPrivateBuildDepends = [], + mixins = []}}, + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "network") + (MajorBoundVersion + (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "base") + (ThisVersion (mkVersion [1])) + mainLibSet, + Dependency + (PackageName "base") + (ThisVersion (mkVersion [1])) + mainLibSet, + Dependency + (PackageName "base") + (UnionVersionRanges + (ThisVersion (mkVersion [1])) + (ThisVersion (mkVersion [2]))) + mainLibSet, + Dependency + (PackageName "base") + (ThisVersion (mkVersion [1, 2])) + mainLibSet, + Dependency + (PackageName "base") + (UnionVersionRanges + (ThisVersion (mkVersion [1, 2])) + (ThisVersion + (mkVersion [3, 4]))) + mainLibSet, + Dependency + (PackageName "ghc") + (UnionVersionRanges + (ThisVersion + (mkVersion [8, 6, 3])) + (UnionVersionRanges + (ThisVersion + (mkVersion [8, 4, 4])) + (UnionVersionRanges + (ThisVersion + (mkVersion [8, 2, 2])) + (UnionVersionRanges + (ThisVersion + (mkVersion [8, 0, 2])) + (UnionVersionRanges + (ThisVersion + (mkVersion [7, 10, 3])) + (UnionVersionRanges + (ThisVersion + (mkVersion [7, 8, 4])) + (UnionVersionRanges + (ThisVersion + (mkVersion [7, 6, 3])) + (ThisVersion + (mkVersion [7, 4, 2]))))))))) + mainLibSet, + Dependency + (PackageName "Cabal") + (UnionVersionRanges + (MajorBoundVersion + (mkVersion [2, 4, 1, 1])) + (MajorBoundVersion + (mkVersion [2, 2, 0, 0]))) + mainLibSet], + privateDependencies = []}, + condTreeComponents = []}, + condSubLibraries = [], + condForeignLibs = [], + condExecutables = [], + condTestSuites = [], + condBenchmarks = []} diff --git a/Cabal-tests/tests/ParserTests/regressions/wl-pprint-indef.expr b/Cabal-tests/tests/ParserTests/regressions/wl-pprint-indef.expr index edbbeed7483..e552eab5296 100644 --- a/Cabal-tests/tests/ParserTests/regressions/wl-pprint-indef.expr +++ b/Cabal-tests/tests/ParserTests/regressions/wl-pprint-indef.expr @@ -1,225 +1,246 @@ -GenericPackageDescription - {condBenchmarks = [], - condExecutables = [_×_ - (UnqualComponentName "wl-pprint-string-example") - CondNode - {condTreeComponents = [], - condTreeConstraints = [Dependency - (PackageName "base") - (EarlierVersion (mkVersion [5])) - mainLibSet, - Dependency - (PackageName "str-string") - (OrLaterVersion (mkVersion [0, 1, 0, 0])) - mainLibSet, - Dependency - (PackageName "wl-pprint-indef") - (OrLaterVersion (mkVersion [0])) - mainLibSet], - condTreeData = Executable - {buildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = True, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Nothing, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [SymbolicPath - "example-string"], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [], - oldExtensions = [], - options = PerCompilerFlavor [] [], - otherExtensions = [], - otherLanguages = [], - otherModules = [ModuleName - "StringImpl"], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor [] [], - sharedOptions = PerCompilerFlavor [] [], - staticOptions = PerCompilerFlavor [] [], - targetBuildDepends = [Dependency - (PackageName - "base") - (EarlierVersion - (mkVersion - [5])) - mainLibSet, - Dependency - (PackageName - "str-string") - (OrLaterVersion - (mkVersion - [0, - 1, - 0, - 0])) - mainLibSet, - Dependency - (PackageName - "wl-pprint-indef") - (OrLaterVersion - (mkVersion - [0])) - mainLibSet], - virtualModules = []}, - exeName = UnqualComponentName - "wl-pprint-string-example", - exeScope = ExecutablePublic, - modulePath = "Main.hs"}}], - condForeignLibs = [], - condLibrary = Just - CondNode - {condTreeComponents = [], - condTreeConstraints = [Dependency - (PackageName "base") - (EarlierVersion (mkVersion [5])) - mainLibSet, - Dependency - (PackageName "str-sig") - (OrLaterVersion (mkVersion [0, 1, 0, 0])) - mainLibSet], - condTreeData = Library - {exposedModules = [ModuleName "Text.PrettyPrint.Leijen"], - libBuildInfo = BuildInfo - {asmOptions = [], - asmSources = [], - autogenIncludes = [], - autogenModules = [], - buildToolDepends = [], - buildTools = [], - buildable = True, - cSources = [], - ccOptions = [], - cmmOptions = [], - cmmSources = [], - cppOptions = [], - customFieldsBI = [], - cxxOptions = [], - cxxSources = [], - defaultExtensions = [], - defaultLanguage = Nothing, - extraBundledLibs = [], - extraDynLibFlavours = [], - extraFrameworkDirs = [], - extraGHCiLibs = [], - extraLibDirs = [], - extraLibDirsStatic = [], - extraLibFlavours = [], - extraLibs = [], - extraLibsStatic = [], - frameworks = [], - hsSourceDirs = [], - hsc2hsOptions = [], - includeDirs = [], - includes = [], - installIncludes = [], - jsSources = [], - ldOptions = [], - mixins = [], - oldExtensions = [], - options = PerCompilerFlavor [] [], - otherExtensions = [], - otherLanguages = [], - otherModules = [], - pkgconfigDepends = [], - profOptions = PerCompilerFlavor [] [], - sharedOptions = PerCompilerFlavor [] [], - staticOptions = PerCompilerFlavor [] [], - targetBuildDepends = [Dependency - (PackageName - "base") - (EarlierVersion - (mkVersion - [5])) - mainLibSet, - Dependency - (PackageName - "str-sig") - (OrLaterVersion - (mkVersion - [0, - 1, - 0, - 0])) - mainLibSet], - virtualModules = []}, - libExposed = True, - libName = LMainLibName, - libVisibility = LibraryVisibilityPublic, - reexportedModules = [], - signatures = []}}, - condSubLibraries = [], - condTestSuites = [], - genPackageFlags = [], - gpdScannedVersion = Nothing, - packageDescription = PackageDescription - {author = "Daan Leijen", - benchmarks = [], - bugReports = "", - buildTypeRaw = Just Simple, - category = "Text", - copyright = "", - customFieldsPD = [], - dataDir = ".", - dataFiles = [], - description = concat - ["This is a pretty printing library based on Wadler's paper \"A Prettier\n", - "Printer\". See the haddocks for full info. This version allows the\n", - "library user to declare overlapping instances of the 'Pretty' class."], - executables = [], - extraDocFiles = [], - extraSrcFiles = [], - extraTmpFiles = [], - foreignLibs = [], - homepage = "", - library = Nothing, - licenseFiles = [SymbolicPath "LICENSE"], - licenseRaw = Right BSD3, - maintainer = "Noam Lewis ", - package = PackageIdentifier - {pkgName = PackageName "wl-pprint-indef", - pkgVersion = mkVersion [1, 2]}, - pkgUrl = "", - setupBuildInfo = Nothing, - sourceRepos = [SourceRepo - {repoBranch = Nothing, - repoKind = RepoHead, - repoLocation = Just - "git@github.com:danidiaz/wl-pprint-indef.git", - repoModule = Nothing, - repoSubdir = Nothing, - repoTag = Nothing, - repoType = Just (KnownRepoType Git)}], - specVersion = CabalSpecV1_6, - stability = "", - subLibraries = [], - synopsis = "The Wadler/Leijen Pretty Printer", - testSuites = [], - testedWith = []}} +GenericPackageDescription { + packageDescription = + PackageDescription { + specVersion = CabalSpecV1_6, + package = PackageIdentifier { + pkgName = PackageName + "wl-pprint-indef", + pkgVersion = mkVersion [1, 2]}, + licenseRaw = Right BSD3, + licenseFiles = [ + SymbolicPath "LICENSE"], + copyright = "", + maintainer = + "Noam Lewis ", + author = "Daan Leijen", + stability = "", + testedWith = [], + homepage = "", + pkgUrl = "", + bugReports = "", + sourceRepos = [ + SourceRepo { + repoKind = RepoHead, + repoType = Just + (KnownRepoType Git), + repoLocation = Just + "git@github.com:danidiaz/wl-pprint-indef.git", + repoModule = Nothing, + repoBranch = Nothing, + repoTag = Nothing, + repoSubdir = Nothing}], + synopsis = + "The Wadler/Leijen Pretty Printer", + description = + concat + [ + "This is a pretty printing library based on Wadler's paper \"A Prettier\n", + "Printer\". See the haddocks for full info. This version allows the\n", + "library user to declare overlapping instances of the 'Pretty' class."], + category = "Text", + customFieldsPD = [], + buildTypeRaw = Just Simple, + setupBuildInfo = Nothing, + library = Nothing, + subLibraries = [], + executables = [], + foreignLibs = [], + testSuites = [], + benchmarks = [], + dataFiles = [], + dataDir = ".", + extraSrcFiles = [], + extraTmpFiles = [], + extraDocFiles = []}, + gpdScannedVersion = Nothing, + genPackageFlags = [], + condLibrary = Just + CondNode { + condTreeData = Library { + libName = LMainLibName, + exposedModules = [ + ModuleName + "Text.PrettyPrint.Leijen"], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPublic, + libBuildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Nothing, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [ + Dependency + (PackageName "base") + (EarlierVersion (mkVersion [5])) + mainLibSet, + Dependency + (PackageName "str-sig") + (OrLaterVersion + (mkVersion [0, 1, 0, 0])) + mainLibSet], + targetPrivateBuildDepends = [], + mixins = []}}, + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (EarlierVersion (mkVersion [5])) + mainLibSet, + Dependency + (PackageName "str-sig") + (OrLaterVersion + (mkVersion [0, 1, 0, 0])) + mainLibSet], + privateDependencies = []}, + condTreeComponents = []}, + condSubLibraries = [], + condForeignLibs = [], + condExecutables = [ + _×_ + (UnqualComponentName + "wl-pprint-string-example") + CondNode { + condTreeData = Executable { + exeName = UnqualComponentName + "wl-pprint-string-example", + modulePath = "Main.hs", + exeScope = ExecutablePublic, + buildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [ + SymbolicPath "example-string"], + otherModules = [ + ModuleName "StringImpl"], + virtualModules = [], + autogenModules = [], + defaultLanguage = Nothing, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [ + Dependency + (PackageName "base") + (EarlierVersion (mkVersion [5])) + mainLibSet, + Dependency + (PackageName "str-string") + (OrLaterVersion + (mkVersion [0, 1, 0, 0])) + mainLibSet, + Dependency + (PackageName "wl-pprint-indef") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + targetPrivateBuildDepends = [], + mixins = []}}, + condTreeConstraints = + Dependencies { + publicDependencies = [ + Dependency + (PackageName "base") + (EarlierVersion (mkVersion [5])) + mainLibSet, + Dependency + (PackageName "str-string") + (OrLaterVersion + (mkVersion [0, 1, 0, 0])) + mainLibSet, + Dependency + (PackageName "wl-pprint-indef") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + privateDependencies = []}, + condTreeComponents = []}], + condTestSuites = [], + condBenchmarks = []} diff --git a/Cabal-tests/tests/UnitTests/Distribution/Described.hs b/Cabal-tests/tests/UnitTests/Distribution/Described.hs index 2c73c805c71..4e041c6d380 100644 --- a/Cabal-tests/tests/UnitTests/Distribution/Described.hs +++ b/Cabal-tests/tests/UnitTests/Distribution/Described.hs @@ -12,7 +12,7 @@ import Test.Tasty (TestTree, testGroup) import Distribution.Compiler (CompilerFlavor, CompilerId) import Distribution.ModuleName (ModuleName) import Distribution.System (Arch, OS) -import Distribution.Types.Dependency (Dependency) +import Distribution.Types.Dependency (Dependency, PrivateDependency) import Distribution.Types.Flag (FlagAssignment, FlagName) import Distribution.Types.IncludeRenaming (IncludeRenaming) import Distribution.Types.Mixin (Mixin) @@ -30,6 +30,7 @@ import Test.QuickCheck.Instances.Cabal () tests :: TestTree tests = testGroup "Described" [ testDescribed (Proxy :: Proxy Dependency) + , testDescribed (Proxy :: Proxy PrivateDependency) , testDescribed (Proxy :: Proxy PackageName) , testDescribed (Proxy :: Proxy PackageIdentifier) , testDescribed (Proxy :: Proxy PackageVersionConstraint) diff --git a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs index 64fff30e0d1..b63f526c001 100644 --- a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs +++ b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs @@ -33,15 +33,15 @@ md5Check proxy md5Int = structureHash proxy @?= md5FromInteger md5Int md5CheckGenericPackageDescription :: Proxy GenericPackageDescription -> Assertion md5CheckGenericPackageDescription proxy = md5Check proxy #if MIN_VERSION_base(4,19,0) - 0x4136daf844669c3c272845160cb5a908 + 0x3836b3b3818f20e4705b6b49a17cb254 #else - 0x196b441722dfe556ed5b5d1d874741b3 + 0xd882766e6f39885f0486ccd4ef357fa6 #endif md5CheckLocalBuildInfo :: Proxy LocalBuildInfo -> Assertion md5CheckLocalBuildInfo proxy = md5Check proxy #if MIN_VERSION_base(4,19,0) - 0x8a30fa23374160aac9cdd1996dc5112b + 0x1f8991209aaf600f8b70c852f11f5e1e #else - 0x2e959a7f1da8f0d11f6923831ab6ab55 + 0xc795c0bae0181f0123b5cf4641820ae9 #endif diff --git a/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs b/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs index 002e5778c45..ac6cfb49277 100644 --- a/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs +++ b/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs @@ -24,7 +24,6 @@ import Distribution.Simple.InstallDirs.Internal import Distribution.Simple.Setup (HaddockTarget, TestShowDetails) import Distribution.System import Distribution.Types.AbiHash (AbiHash) -import Distribution.Types.ComponentName import Distribution.Types.ComponentId (ComponentId) import Distribution.Types.DumpBuildInfo (DumpBuildInfo) import Distribution.Types.PackageVersionConstraint diff --git a/Cabal/src/Distribution/Backpack/Configure.hs b/Cabal/src/Distribution/Backpack/Configure.hs index a90538175ca..43b75db0408 100644 --- a/Cabal/src/Distribution/Backpack/Configure.hs +++ b/Cabal/src/Distribution/Backpack/Configure.hs @@ -57,7 +57,6 @@ import qualified Data.Map as Map import qualified Data.Set as Set import Distribution.Pretty import Text.PrettyPrint -import Distribution.Simple.Setup ------------------------------------------------------------------------------ -- Pipeline @@ -119,7 +118,8 @@ configureComponentLocalBuildInfos `Map.union` Map.fromListWith Map.union [ ( (pkg, alias) - , Map.singleton (ann_cname aid) aid) + , Map.singleton (ann_cname aid) aid + ) | PromisedComponent pkg aid alias <- promisedPkgDeps ] graph1 <- diff --git a/Cabal/src/Distribution/Backpack/ConfiguredComponent.hs b/Cabal/src/Distribution/Backpack/ConfiguredComponent.hs index 51d22bd0ed7..a542bc98dcb 100644 --- a/Cabal/src/Distribution/Backpack/ConfiguredComponent.hs +++ b/Cabal/src/Distribution/Backpack/ConfiguredComponent.hs @@ -39,8 +39,6 @@ import qualified Distribution.Compat.NonEmptySet as NonEmptySet import Distribution.Pretty import Text.PrettyPrint (Doc, hang, hsep, quotes, text, vcat, ($$)) import qualified Text.PrettyPrint as PP -import Distribution.ModuleName -import Distribution.InstalledPackageInfo -- | A configured component, we know exactly what its 'ComponentId' is, -- and the 'ComponentId's of the things it depends on. @@ -122,8 +120,8 @@ mkConfiguredComponent pkg_descr this_cid lib_deps exe_deps component = do { ci_ann_id = aid , ci_renaming = rns , ci_implicit = False - -- Mixins can't be private - , ci_alias = Nothing + , -- Mixins can't be private + ci_alias = Nothing } -- Any @build-depends@ which is not explicitly mentioned in @@ -131,7 +129,7 @@ mkConfiguredComponent pkg_descr this_cid lib_deps exe_deps component = do let used_explicitly = Set.fromList (map ci_id explicit_includes) implicit_includes = map - ( \(aid, alias)-> + ( \(aid, alias) -> ComponentInclude { ci_ann_id = aid , ci_renaming = defaultIncludeRenaming @@ -186,14 +184,15 @@ toConfiguredComponent pkg_descr this_cid lib_dep_map exe_dep_map component = do lib_deps <- if newPackageDepsBehaviour pkg_descr then fmap concat $ - forM ([ (d, Nothing) | d <- targetBuildDepends bi] ++ [ (d, Just alias) | (PrivateDependency alias ds) <- targetPrivateBuildDepends bi, d <- ds]) $ + forM ([(d, Nothing) | d <- targetBuildDepends bi] ++ [(d, Just alias) | (PrivateDependency alias ds) <- targetPrivateBuildDepends bi, d <- ds]) $ \((Dependency name _ sublibs), alias) -> do case Map.lookup (name, alias) lib_dep_map of Nothing -> dieProgress $ text "Dependency on unbuildable" <+> text "package" - <+> pretty name <+> maybe mempty pretty alias + <+> pretty name + <+> maybe mempty pretty alias <+> text (show lib_dep_map) Just pkg -> do -- Return all library components @@ -205,7 +204,8 @@ toConfiguredComponent pkg_descr this_cid lib_dep_map exe_dep_map component = do text "Dependency on unbuildable" <+> text (showLibraryName lib) <+> text "from" - <+> pretty name <+> maybe mempty pretty alias + <+> pretty name + <+> maybe mempty pretty alias Just v -> return (v, alias) else return old_style_lib_deps mkConfiguredComponent diff --git a/Cabal/src/Distribution/Backpack/LinkedComponent.hs b/Cabal/src/Distribution/Backpack/LinkedComponent.hs index b181e0b19a1..924945d0cb9 100644 --- a/Cabal/src/Distribution/Backpack/LinkedComponent.hs +++ b/Cabal/src/Distribution/Backpack/LinkedComponent.hs @@ -1,6 +1,6 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE BangPatterns #-} -- | See module Distribution.Backpack.LinkedComponent @@ -151,7 +151,6 @@ toLinkedComponent _ -> ([], [], []) src_hidden = otherModules (componentBuildInfo component) - -- HERE?? -- Take each included ComponentId and resolve it into an -- \*unlinked* unit identity. We will use unification (relying diff --git a/Cabal/src/Distribution/Backpack/ModuleScope.hs b/Cabal/src/Distribution/Backpack/ModuleScope.hs index 831b1c6ac48..40b68513149 100644 --- a/Cabal/src/Distribution/Backpack/ModuleScope.hs +++ b/Cabal/src/Distribution/Backpack/ModuleScope.hs @@ -69,7 +69,8 @@ import Text.PrettyPrint data ModuleScope = ModuleScope { modScopeProvides :: ModuleProvides , modScopeRequires :: ModuleRequires - } deriving Show + } + deriving (Show) -- | An empty 'ModuleScope'. emptyModuleScope :: ModuleScope @@ -92,7 +93,7 @@ data ModuleSource | FromExposedModules ModuleName | FromOtherModules ModuleName | FromSignatures ModuleName - deriving Show + deriving (Show) -- We don't have line numbers, but if we did, we'd want to record that -- too diff --git a/Cabal/src/Distribution/Backpack/UnifyM.hs b/Cabal/src/Distribution/Backpack/UnifyM.hs index e0f8ad7b0f8..b66632b5d09 100644 --- a/Cabal/src/Distribution/Backpack/UnifyM.hs +++ b/Cabal/src/Distribution/Backpack/UnifyM.hs @@ -625,25 +625,19 @@ convertInclude -- Expand the alias let prepend_alias mn = case alias of - Just (PrivateAlias alias_mn) -> fromComponents (components alias_mn ++ components mn) - Nothing -> mn - + Just (PrivateAlias alias_mn) -> fromComponents (components alias_mn ++ components mn) + Nothing -> mn let pre_prov_scope' = map (first prepend_alias) pre_prov_scope let prov_rns'' = - case prov_rns' of - DefaultRenaming -> case alias of - Nothing -> DefaultRenaming - Just {} -> ModuleRenaming (map ((\x -> (x, prepend_alias x)) . fst) (pre_prov_scope)) - - - ModuleRenaming rn -> ModuleRenaming (map (\(x, y) -> (x, prepend_alias y)) rn) - -- Can't happen, expanded avove - HidingRenaming {} -> error "unreachabel" - - - + case prov_rns' of + DefaultRenaming -> case alias of + Nothing -> DefaultRenaming + Just{} -> ModuleRenaming (map ((\x -> (x, prepend_alias x)) . fst) (pre_prov_scope)) + ModuleRenaming rn -> ModuleRenaming (map (\(x, y) -> (x, prepend_alias y)) rn) + -- Can't happen, expanded avove + HidingRenaming{} -> error "unreachabel" let prov_scope = modSubst req_subst $ diff --git a/Cabal/src/Distribution/PackageDescription/Check/Conditional.hs b/Cabal/src/Distribution/PackageDescription/Check/Conditional.hs index f9c335b6e1f..60ffd13477a 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Conditional.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Conditional.hs @@ -117,13 +117,13 @@ crossAnnotateBranches :: forall a . (Eq a, Monoid a) => [PackageFlag] -- `default: true` flags. - -> [CondBranch ConfVar [Dependency] (TargetAnnotation a)] - -> [CondBranch ConfVar [Dependency] (TargetAnnotation a)] + -> [CondBranch ConfVar Dependencies (TargetAnnotation a)] + -> [CondBranch ConfVar Dependencies (TargetAnnotation a)] crossAnnotateBranches fs bs = map crossAnnBranch bs where crossAnnBranch - :: CondBranch ConfVar [Dependency] (TargetAnnotation a) - -> CondBranch ConfVar [Dependency] (TargetAnnotation a) + :: CondBranch ConfVar Dependencies (TargetAnnotation a) + -> CondBranch ConfVar Dependencies (TargetAnnotation a) crossAnnBranch wr = let rs = filter (/= wr) bs @@ -131,7 +131,7 @@ crossAnnotateBranches fs bs = map crossAnnBranch bs in updateTargetAnnBranch (mconcat ts) wr - realiseBranch :: CondBranch ConfVar [Dependency] (TargetAnnotation a) -> Maybe a + realiseBranch :: CondBranch ConfVar Dependencies (TargetAnnotation a) -> Maybe a realiseBranch b = let -- We are only interested in True by default package flags. @@ -144,8 +144,8 @@ crossAnnotateBranches fs bs = map crossAnnBranch bs updateTargetAnnBranch :: a - -> CondBranch ConfVar [Dependency] (TargetAnnotation a) - -> CondBranch ConfVar [Dependency] (TargetAnnotation a) + -> CondBranch ConfVar Dependencies (TargetAnnotation a) + -> CondBranch ConfVar Dependencies (TargetAnnotation a) updateTargetAnnBranch a (CondBranch k t mt) = let updateTargetAnnTree (CondNode ka c wbs) = (CondNode (updateTargetAnnotation a ka) c wbs) diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs index da6d7a62f7e..b97c16c225a 100644 --- a/Cabal/src/Distribution/Simple/Configure.hs +++ b/Cabal/src/Distribution/Simple/Configure.hs @@ -696,9 +696,9 @@ computeLocalBuildConfig cfg comp programDb = do data PackageInfo = PackageInfo { internalPackageSet :: Set LibraryName - , promisedDepsSet :: Map (PackageName, ComponentName) ComponentId + , promisedDepsSet :: Map (PackageName, ComponentName, Maybe PrivateAlias) ComponentId , installedPackageSet :: InstalledPackageIndex - , requiredDepsMap :: Map (PackageName, ComponentName) InstalledPackageInfo + , requiredDepsMap :: Map (PackageName, ComponentName, Maybe PrivateAlias) InstalledPackageInfo } configurePackage @@ -2020,7 +2020,7 @@ combinedConstraints constraints dependencies installedPackages = do -- NB: do NOT use the packageName from -- dependenciesPkgInfo! [ ((pn, cname, alias), pkg) - | (pn, cname, alias, _, Just pkg) <- dependenciesPkgInfo + | (pn, cname, alias, _, Just pkg) <- dependenciesPkgInfo ] -- The dependencies along with the installed package info, if it exists diff --git a/Cabal/src/Distribution/Simple/Errors.hs b/Cabal/src/Distribution/Simple/Errors.hs index 03b88112713..50e6afd7bcd 100644 --- a/Cabal/src/Distribution/Simple/Errors.hs +++ b/Cabal/src/Distribution/Simple/Errors.hs @@ -556,6 +556,8 @@ exceptionMessage e = case e of . allDependencies $ missing ) + where + allDependencies (Dependencies pub priv) = pub ++ concatMap private_depends priv CompilerDoesn'tSupportThinning -> "Your compiler does not support thinning and renaming on " ++ "package flags. To use this feature you must use " diff --git a/Cabal/src/Distribution/Simple/Setup.hs b/Cabal/src/Distribution/Simple/Setup.hs index fbb345cb921..b2a79d7a4fd 100644 --- a/Cabal/src/Distribution/Simple/Setup.hs +++ b/Cabal/src/Distribution/Simple/Setup.hs @@ -41,7 +41,7 @@ module Distribution.Simple.Setup , ConfigFlags (..) , emptyConfigFlags , defaultConfigFlags - , AliasDependency(..) + , AliasDependency (..) , configureCommand , configPrograms , configAbsolutePaths diff --git a/Cabal/src/Distribution/Simple/Setup/Config.hs b/Cabal/src/Distribution/Simple/Setup/Config.hs index 6442ef81482..38b71f836f5 100644 --- a/Cabal/src/Distribution/Simple/Setup/Config.hs +++ b/Cabal/src/Distribution/Simple/Setup/Config.hs @@ -31,9 +31,8 @@ module Distribution.Simple.Setup.Config , configureArgs , configureOptions , installDirsOptions - -- TODO: Move - , AliasDependency(..) + , AliasDependency (..) ) where import Distribution.Compat.Prelude hiding (get) @@ -752,7 +751,6 @@ configureOptions showOrParseArgs = (parsecToReadE (const "dependency expected") ((\x -> [x]) `fmap` parsec)) (map prettyShow) ) - , option "" ["dependency"] @@ -902,15 +900,15 @@ showProfDetailLevelFlag :: Flag ProfDetailLevel -> [String] showProfDetailLevelFlag NoFlag = [] showProfDetailLevelFlag (Flag dl) = [showProfDetailLevel dl] -parsecAliasDependency :: ParsecParser AliasDependency -parsecAliasDependency = do +_parsecAliasDependency :: ParsecParser AliasDependency +_parsecAliasDependency = do pn <- parsec _ <- P.char '=' gc <- parsecGivenComponent return $ AliasDependency pn gc -prettyAliasDependency :: AliasDependency -> String -prettyAliasDependency (AliasDependency pn gc) = +_prettyAliasDependency :: AliasDependency -> String +_prettyAliasDependency (AliasDependency pn gc) = prettyShow pn ++ "=" ++ prettyGivenComponent gc @@ -928,8 +926,8 @@ parsecGivenComponent = do _ <- P.char '=' cid <- parsec alias <- P.option Nothing $ do - _ <- P.char '=' - Just <$> parsec + _ <- P.char '=' + Just <$> parsec return $ GivenComponent pn ln cid alias prettyGivenComponent :: GivenComponent -> String diff --git a/Cabal/src/Distribution/Types/ComponentInclude.hs b/Cabal/src/Distribution/Types/ComponentInclude.hs index 8db67002322..3efcc635054 100644 --- a/Cabal/src/Distribution/Types/ComponentInclude.hs +++ b/Cabal/src/Distribution/Types/ComponentInclude.hs @@ -7,10 +7,8 @@ module Distribution.Types.ComponentInclude import Distribution.Types.AnnotatedId import Distribution.Types.ComponentName -import Distribution.Types.PackageId -import Distribution.Types.PackageName -import Distribution.ModuleName import Distribution.Types.Dependency (PrivateAlias) +import Distribution.Types.PackageId -- Once ci_id is refined to an 'OpenUnitId' or 'DefUnitId', -- the 'includeRequiresRn' is not so useful (because it @@ -23,7 +21,8 @@ data ComponentInclude id rn = ComponentInclude , ci_alias :: Maybe PrivateAlias -- ^ Did this come from an entry in @mixins@, or -- was implicitly generated by @build-depends@? - } deriving Show + } + deriving (Show) ci_id :: ComponentInclude id rn -> id ci_id = ann_id . ci_ann_id diff --git a/Cabal/src/Distribution/Types/ComponentLocalBuildInfo.hs b/Cabal/src/Distribution/Types/ComponentLocalBuildInfo.hs index 430f2fdcde7..8af914467c8 100644 --- a/Cabal/src/Distribution/Types/ComponentLocalBuildInfo.hs +++ b/Cabal/src/Distribution/Types/ComponentLocalBuildInfo.hs @@ -22,7 +22,6 @@ import Distribution.Types.MungedPackageName import Distribution.Types.UnitId import qualified Distribution.InstalledPackageInfo as Installed -import Distribution.Package -- | The first five fields are common across all algebraic variants. data ComponentLocalBuildInfo diff --git a/Cabal/src/Distribution/Types/GivenComponent.hs b/Cabal/src/Distribution/Types/GivenComponent.hs index f1a55360d3b..eaab3e8e713 100644 --- a/Cabal/src/Distribution/Types/GivenComponent.hs +++ b/Cabal/src/Distribution/Types/GivenComponent.hs @@ -8,9 +8,9 @@ module Distribution.Types.GivenComponent import Distribution.Compat.Prelude import Distribution.Types.ComponentId +import Distribution.Types.Dependency import Distribution.Types.LibraryName import Distribution.Types.PackageName -import Distribution.Types.Dependency -- | A 'GivenComponent' represents a library depended on and explicitly -- specified by the user/client with @--dependency@ diff --git a/Cabal/src/Distribution/Types/LocalBuildInfo.hs b/Cabal/src/Distribution/Types/LocalBuildInfo.hs index 1c3aeef0161..7124216957f 100644 --- a/Cabal/src/Distribution/Types/LocalBuildInfo.hs +++ b/Cabal/src/Distribution/Types/LocalBuildInfo.hs @@ -151,7 +151,7 @@ pattern LocalBuildInfo -> Maybe FilePath -> Graph ComponentLocalBuildInfo -> Map ComponentName [ComponentLocalBuildInfo] - -> Map (PackageName, ComponentName) ComponentId + -> Map (PackageName, ComponentName, Maybe PrivateAlias) ComponentId -> InstalledPackageIndex -> PackageDescription -> ProgramDb diff --git a/cabal-hooks-demo/Makefile b/cabal-hooks-demo/Makefile deleted file mode 100644 index 14ff252ef13..00000000000 --- a/cabal-hooks-demo/Makefile +++ /dev/null @@ -1,34 +0,0 @@ -CABAL="/home/matt/cabal/dist-newstyle/build/x86_64-linux/ghc-9.6.2/cabal-install-3.11.0.0/x/cabal/build/cabal/cabal" - -clean: - rm -rf repo/ - -init: clean - mkdir -p repo/ - $(eval PDIR := $(shell pwd)) - $(eval TMP := $(shell mktemp -d)) - cd $(TMP); cp -r $(PDIR)/lib-0.1 "lib01-0.1.0.0" - cd $(TMP); mkdir -p repo - cd $(TMP); tar -czvf repo/lib01-0.1.0.0.tar.gz "lib01-0.1.0.0" - cd $(TMP); cp -r $(PDIR)/lib-0.2 "lib01-0.2.0.0" - cd $(TMP); mkdir -p repo - cd $(TMP); tar -czvf repo/lib01-0.2.0.0.tar.gz "lib01-0.2.0.0" - #tar -czvf repo/lib01-0.2.0.0.tar.gz lib-0.2 \ - ls $(TMP) - mv "$(TMP)/repo" . - $(CABAL) update - -build: - $(CABAL) build all - -run: build - $(CABAL) build exe:hooks-exe --constraint="private.hooks-exe.L01:lib01 == 0.1.0.0" - $(eval HOOKS_EXE := $(shell $(CABAL) list-bin exe:hooks-exe)) - PATH=$(shell dirname $(HOOKS_EXE)):$$PATH $(CABAL) run exe:main-prog - - $(CABAL) build exe:hooks-exe --constraint="private.hooks-exe.L01:lib01 == 0.2.0.0" - $(eval HOOKS_EXE := $(shell $(CABAL) list-bin exe:hooks-exe)) - PATH=$(shell dirname $(HOOKS_EXE)):$$PATH $(CABAL) run exe:main-prog - - - diff --git a/cabal-hooks-demo/cabal.project b/cabal-hooks-demo/cabal.project deleted file mode 100644 index 68e61756167..00000000000 --- a/cabal-hooks-demo/cabal.project +++ /dev/null @@ -1 +0,0 @@ -packages: hooks-exe, hooks-lib, main-prog diff --git a/cabal-hooks-demo/lib01-0.1.0.0/CHANGELOG.md b/cabal-hooks-demo/lib01-0.1.0.0/CHANGELOG.md deleted file mode 100644 index 6a8c7fe311e..00000000000 --- a/cabal-hooks-demo/lib01-0.1.0.0/CHANGELOG.md +++ /dev/null @@ -1,5 +0,0 @@ -# Revision history for lib01 - -## 0.1.0.0 -- YYYY-mm-dd - -* First version. Released on an unsuspecting world. diff --git a/cabal-hooks-demo/lib01-0.1.0.0/lib-0.1/CHANGELOG.md b/cabal-hooks-demo/lib01-0.1.0.0/lib-0.1/CHANGELOG.md deleted file mode 100644 index 6a8c7fe311e..00000000000 --- a/cabal-hooks-demo/lib01-0.1.0.0/lib-0.1/CHANGELOG.md +++ /dev/null @@ -1,5 +0,0 @@ -# Revision history for lib01 - -## 0.1.0.0 -- YYYY-mm-dd - -* First version. Released on an unsuspecting world. diff --git a/cabal-hooks-demo/lib01-0.1.0.0/lib-0.1/lib01.cabal b/cabal-hooks-demo/lib01-0.1.0.0/lib-0.1/lib01.cabal deleted file mode 100644 index 41badc0247e..00000000000 --- a/cabal-hooks-demo/lib01-0.1.0.0/lib-0.1/lib01.cabal +++ /dev/null @@ -1,18 +0,0 @@ -cabal-version: 3.0 -name: lib01 -version: 0.1.0.0 -license: NONE -author: matthewtpickering@gmail.com -maintainer: Matthew Pickering -build-type: Simple -extra-doc-files: CHANGELOG.md - -common warnings - ghc-options: -Wall - -library - import: warnings - exposed-modules: Lib - build-depends: base ^>=4.18.0.0, binary - hs-source-dirs: src - default-language: Haskell2010 diff --git a/cabal-hooks-demo/lib01-0.1.0.0/lib-0.1/src/Lib.hs b/cabal-hooks-demo/lib01-0.1.0.0/lib-0.1/src/Lib.hs deleted file mode 100644 index 5c3bf43eabc..00000000000 --- a/cabal-hooks-demo/lib01-0.1.0.0/lib-0.1/src/Lib.hs +++ /dev/null @@ -1,16 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE DeriveAnyClass #-} -module Lib(A(..), inc) where - -import Data.Binary -import GHC.Generics - -data A = A | B deriving (Show, Generic) - -deriving instance Binary A - -inc :: A -> A -inc A = B -inc B = B - diff --git a/cabal-hooks-demo/lib01-0.1.0.0/lib01.cabal b/cabal-hooks-demo/lib01-0.1.0.0/lib01.cabal deleted file mode 100644 index 41badc0247e..00000000000 --- a/cabal-hooks-demo/lib01-0.1.0.0/lib01.cabal +++ /dev/null @@ -1,18 +0,0 @@ -cabal-version: 3.0 -name: lib01 -version: 0.1.0.0 -license: NONE -author: matthewtpickering@gmail.com -maintainer: Matthew Pickering -build-type: Simple -extra-doc-files: CHANGELOG.md - -common warnings - ghc-options: -Wall - -library - import: warnings - exposed-modules: Lib - build-depends: base ^>=4.18.0.0, binary - hs-source-dirs: src - default-language: Haskell2010 diff --git a/cabal-hooks-demo/lib01-0.1.0.0/src/Lib.hs b/cabal-hooks-demo/lib01-0.1.0.0/src/Lib.hs deleted file mode 100644 index 5c3bf43eabc..00000000000 --- a/cabal-hooks-demo/lib01-0.1.0.0/src/Lib.hs +++ /dev/null @@ -1,16 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE DeriveAnyClass #-} -module Lib(A(..), inc) where - -import Data.Binary -import GHC.Generics - -data A = A | B deriving (Show, Generic) - -deriving instance Binary A - -inc :: A -> A -inc A = B -inc B = B - diff --git a/cabal-install-solver/cabal-install-solver.cabal b/cabal-install-solver/cabal-install-solver.cabal index e692c79ce88..ba0e8c165c6 100644 --- a/cabal-install-solver/cabal-install-solver.cabal +++ b/cabal-install-solver/cabal-install-solver.cabal @@ -69,6 +69,7 @@ library Distribution.Solver.Modular.MessageUtils Distribution.Solver.Modular.Package Distribution.Solver.Modular.Preference + Distribution.Solver.Modular.PrivateScopeClosure Distribution.Solver.Modular.PSQ Distribution.Solver.Modular.RetryLog Distribution.Solver.Modular.Solver diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Builder.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Builder.hs index d1ff90d6d25..95373cbd473 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Builder.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Builder.hs @@ -100,12 +100,12 @@ extendOpen qpn' gs s@(BS { rdeps = gs', open = o' }) = go gs' o' gs -- | Given the current scope, qualify all the package names in the given set of -- dependencies and then extend the set of open goals accordingly. -scopedExtendOpen :: QPN -> FlaggedDeps PN -> FlagInfo -> +scopedExtendOpen :: RevDepMap -> QPN -> FlaggedDeps PN -> FlagInfo -> BuildState -> BuildState -scopedExtendOpen qpn fdeps fdefs s = extendOpen qpn gs s +scopedExtendOpen rdm qpn fdeps fdefs s = extendOpen qpn gs s where -- Qualify all package names - qfdeps = qualifyDeps (qualifyOptions s) qpn fdeps + qfdeps = qualifyDeps (qualifyOptions s) rdm qpn fdeps -- Introduce all package flags qfdefs = L.map (\ (fn, b) -> Flagged (FN qpn fn) b [] []) $ M.toList fdefs -- Combine new package and flag goals @@ -179,8 +179,8 @@ addChildren bs@(BS { rdeps = rdm, next = OneGoal (StanzaGoal qsn@(SN qpn _) t gr -- and furthermore we update the set of goals. -- -- TODO: We could inline this above. -addChildren bs@(BS { next = Instance qpn (PInfo fdeps _ fdefs _) }) = - addChildren ((scopedExtendOpen qpn fdeps fdefs bs) +addChildren bs@(BS { rdeps = rdm, next = Instance qpn (PInfo fdeps _ fdefs _) }) = + addChildren ((scopedExtendOpen rdm qpn fdeps fdefs bs) { next = Goals }) {------------------------------------------------------------------------------- diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs index 91d0e74f26b..86928083faf 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs @@ -20,7 +20,6 @@ import Distribution.Solver.Types.SolverId import Distribution.Solver.Types.SolverPackage import Distribution.Solver.Types.InstSolverPackage import Distribution.Solver.Types.SourcePackage -import Distribution.ModuleName import Distribution.Types.Dependency (PrivateAlias) -- | Converts from the solver specific result @CP QPN@ into @@ -34,16 +33,17 @@ convCP iidx sidx (CP qpi fa es ds) = Left pi -> PreExisting $ InstSolverPackage { instSolverPkgIPI = fromJust $ SI.lookupUnitId iidx pi, - instSolverPkgLibDeps = fmap (\(b, _) -> map fst b) (ds' Nothing), - instSolverPkgExeDeps = fmap (\(_, c) -> c) (ds' Nothing) + instSolverPkgLibDeps = fmap fst (ds' Nothing), + instSolverPkgExeDeps = fmap snd (ds' Nothing) } Right pi -> Configured $ - SolverPackage { + let libAndExeDeps = ds' (Just (pkgName pi)) + in SolverPackage { solverPkgSource = srcpkg, solverPkgFlags = fa, solverPkgStanzas = es, - solverPkgLibDeps = fmap (\(b, _) -> b) (ds' (Just (pkgName pi))), - solverPkgExeDeps = fmap (\(_, c) -> c) (ds' (Just (pkgName pi))) + solverPkgLibDeps = fmap fst libAndExeDeps, + solverPkgExeDeps = fmap snd libAndExeDeps } where srcpkg = fromMaybe (error "convCP: lookupPackageId failed") $ CI.lookupPackageId sidx pi @@ -61,19 +61,32 @@ partitionDeps (dep:deps) = NormalPkg sid -> ((sid, Nothing) :p, e) NormalExe sid -> (p, sid:e) - - convPI :: PI QPN -> Either UnitId PackageId convPI (PI _ (I _ (Inst pi))) = Left pi convPI (PI (Q _ pn) (I v _)) = Right (PackageIdentifier pn v) data Converted = NormalPkg SolverId | NormalExe SolverId | AliasPkg SolverId PrivateAlias + deriving Show convConfId :: Maybe PackageName -> PI QPN -> Converted convConfId parent (PI (Q (PackagePath ns qn) pn) (I v loc)) = case loc of - Inst pi -> NormalPkg (PreExistingId sourceId pi) + Inst pi + -- As below, we need to identify where `AliasPkg` applies. This is + -- needed to qualify `solverPkgLibDeps` since we may have multiple + -- instances of the same package qualified. + | QualAlias pn' _ alias <- qn + , parent == Just pn' -> AliasPkg (PreExistingId sourceId pi) alias + + | otherwise + -> NormalPkg (PreExistingId sourceId pi) _otherwise + -- Same reasoning as for exes, the "top" qualified goal is the one + -- which is private and needs to be aliased, but there might be other goals underneath which + -- are solved in the same scope (but are not private) + | QualAlias pn' _ alias <- qn + , parent == Just pn' -> AliasPkg (PlannedId sourceId) alias + | IndependentBuildTool _ pn' <- ns -- NB: the dependencies of the executable are also -- qualified. So the way to tell if this is an executable @@ -82,10 +95,7 @@ convConfId parent (PI (Q (PackagePath ns qn) pn) (I v loc)) = -- silly and didn't allow arbitrarily nested build-tools -- dependencies, so a shallow check works. , pn == pn' -> NormalExe (PlannedId sourceId) - -- Same reasoning as for exes, the "top" qualified goal is the one - -- which is private and needs to be aliased, but there might be other goals underneath which - -- are solved in the same scope (but are not private) - | QualAlias pn' _ alias _ <- qn, parent == Just pn' -> AliasPkg (PlannedId sourceId) alias + | otherwise -> NormalPkg (PlannedId sourceId) where sourceId = PackageIdentifier pn v diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/ConflictSet.hs b/cabal-install-solver/src/Distribution/Solver/Modular/ConflictSet.hs index 00cf15b466f..6c9b4280986 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/ConflictSet.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/ConflictSet.hs @@ -74,6 +74,15 @@ data Conflict = -- means that package y's constraint 'x >= 2.0' excluded some version of x. | VersionConflict QPN OrderedVersionRange + -- | The conflict set variable represents a package that was excluded for + -- violating the closure property of a private-scope, because that package is part of + -- the closure of the private scope, but it itself is not + -- included in it. For example, the conflict set entry '(P pkgC, + -- PrivateScopeClosureConflict pkgA:lib:G0:pkgB pkgA:lib:G0:pkgD)' means + -- that pkgC is in the (private-deps) closure from pkgA:lib:G0:pkgB to + -- pkgA:lib:G0:pkgD, but pkgC is not included in the private scope pkgA:lib:G0. + | PrivateScopeClosureConflict QPN QPN + -- | Any other conflict. | OtherConflict deriving (Eq, Ord, Show) diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Dependency.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Dependency.hs index 9b1f3af00d9..88c5016920d 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Dependency.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Dependency.hs @@ -175,8 +175,8 @@ data QualifyOptions = QO { -- -- NOTE: It's the _dependencies_ of a package that may or may not be independent -- from the package itself. Package flag choices must of course be consistent. -qualifyDeps :: QualifyOptions -> QPN -> FlaggedDeps PN -> FlaggedDeps QPN -qualifyDeps QO{..} (Q pp@(PackagePath ns q) pn) = go +qualifyDeps :: QualifyOptions -> RevDepMap -> QPN -> FlaggedDeps PN -> FlaggedDeps QPN +qualifyDeps QO{..} rdm (Q pp@(PackagePath ns q) pn) = go where go :: FlaggedDeps PN -> FlaggedDeps QPN go = map go1 @@ -204,7 +204,7 @@ qualifyDeps QO{..} (Q pp@(PackagePath ns q) pn) = go goD (Dep dep@(PkgComponent qpn (ExposedExe _)) is_private ci) _ = Dep (Q (PackagePath (IndependentBuildTool pn qpn) QualToplevel) <$> dep) is_private ci goD (Dep dep@(PkgComponent qpn (ExposedLib _)) is_private ci) comp - | Private (qpn, pkgs) <- is_private = Dep (Q (PackagePath ns (QualAlias pn comp qpn pkgs)) <$> dep) is_private ci + | Private pq <- is_private = Dep (Q (PackagePath ns (QualAlias pn comp pq)) <$> dep) is_private ci | qBase qpn = Dep (Q (PackagePath ns (QualBase pn)) <$> dep) is_private ci | qSetup comp = Dep (Q (PackagePath (IndependentComponent pn ComponentSetup) QualToplevel) <$> dep) is_private ci | otherwise = Dep (Q (PackagePath ns (inheritedQ qpn) ) <$> dep) is_private ci @@ -222,7 +222,6 @@ qualifyDeps QO{..} (Q pp@(PackagePath ns q) pn) = go -- Solution: Namespace = (BTD-namespace pkg lib-foo happy-btd) - -- If P has a setup dependency on Q, and Q has a regular dependency on R, then -- we say that the 'Setup' qualifier is inherited: P has an (indirect) setup -- dependency on R. We do not do this for the base qualifier however. @@ -231,15 +230,18 @@ qualifyDeps QO{..} (Q pp@(PackagePath ns q) pn) = go -- and base dependencies we override the existing qualifier. See #3160 for -- a detailed discussion. inheritedQ :: PackageName -> Qualifier - inheritedQ pn = case q of + inheritedQ pnx = case q of QualToplevel -> QualToplevel QualBase {} -> QualToplevel - -- MP: TODO, check if package name is in same scope (if so, persist) - QualAlias _ _ _ pkgs -> - if pn `elem` pkgs - then traceShow ("INHERITED", pn, pkgs) q - else QualToplevel --- traceShow (alias, pkgs) QualToplevel + -- check if package name is in same private scope (if so, persist) + QualAlias {} -> + -- Lookup this dependency in the reverse dependency map + -- with the package-path of the package that introduced + -- this dependency, which will match if this dependency is + -- included in the same private scope. + case M.lookup (Q pp pnx) rdm of + Just _x -> q -- found, use same private qualifier + Nothing -> QualToplevel -- not found, use top level qual -- Should we qualify this goal with the 'Base' package path? qBase :: PN -> Bool diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs index dc892d9c231..fe54752771d 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs @@ -220,9 +220,9 @@ exploreLog mbj enableBj fineGrainedConflicts (CountConflicts countConflicts) idx let es' = es { esConflictMap = updateCM c (esConflictMap es) } in failWith (Failure c fr) (NoSolution c es') go (DoneF rdm a) = \ _ -> succeedWith Success (a, rdm) - go (PChoiceF qpn _ gr ts) = + go (PChoiceF qpn rdm gr ts) = backjump mbj enableBj fineGrainedConflicts - (couldResolveConflicts qpn) + (couldResolveConflicts rdm qpn) (logSkippedPackage qpn) (P qpn) (avoidSet (P qpn) gr) $ -- try children in order, W.mapWithKey -- when descending ... @@ -267,13 +267,14 @@ exploreLog mbj enableBj fineGrainedConflicts (CountConflicts countConflicts) idx -- is true, because it is always safe to explore a package instance. -- Skipping it is an optimization. If false, it returns a new conflict set -- to be merged with the previous one. - couldResolveConflicts :: QPN -> POption -> S.Set CS.Conflict -> Maybe ConflictSet - couldResolveConflicts currentQPN@(Q _ pn) (POption i@(I v _) _) conflicts = + couldResolveConflicts :: RevDepMap -> QPN -> POption -> S.Set CS.Conflict -> Maybe ConflictSet + couldResolveConflicts rdm currentQPN@(Q _ pn) (POption i@(I v _) _) conflicts = let (PInfo deps _ _ _) = idx M.! pn M.! i - qdeps = qualifyDeps (defaultQualifyOptions idx) currentQPN deps + qdeps = qualifyDeps (defaultQualifyOptions idx) rdm currentQPN deps couldBeResolved :: CS.Conflict -> Maybe ConflictSet couldBeResolved CS.OtherConflict = Nothing + couldBeResolved (CS.PrivateScopeClosureConflict _ _) = Nothing -- Could we optimise here? couldBeResolved (CS.GoalConflict conflictingDep) = -- Check whether this package instance also has 'conflictingDep' -- as a dependency (ignoring flag and stanza choices). diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Index.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Index.hs index 6075061e75b..0c17ff731e3 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Index.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Index.hs @@ -18,7 +18,6 @@ import Distribution.Solver.Modular.Dependency import Distribution.Solver.Modular.Flag import Distribution.Solver.Modular.Package import Distribution.Solver.Modular.Tree -import Distribution.Solver.Types.PackagePath -- | An index contains information about package instances. This is a nested -- dictionary. Package names are mapped to instances, which in turn is mapped diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs index 1f61abec660..278b8d358c9 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs @@ -41,7 +41,6 @@ import Distribution.Solver.Modular.Index import Distribution.Solver.Modular.Package import Distribution.Solver.Modular.Tree import Distribution.Solver.Modular.Version -import Distribution.Solver.Types.PackagePath -- | Convert both the installed package index and the source package -- index into one uniform solver index. @@ -560,11 +559,8 @@ convLibDeps dr (Dependency pn vr libs) = convLibDepsAs :: DependencyReason PN -> PrivateDependency -> [LDep PN] convLibDepsAs dr (PrivateDependency alias deps) = - [ LDep dr $ Dep (PkgComponent pn (ExposedLib lib)) (Private (alias, scope)) (Constrained vr) + [ LDep dr $ Dep (PkgComponent pn (ExposedLib lib)) (Private alias) (Constrained vr) | Dependency pn vr libs <- deps, lib <- NonEmptySet.toList libs ] - where - scope = map depPkgName deps - -- | Convert a Cabal dependency on an executable (build-tools) to a solver-specific dependency. convExeDep :: DependencyReason PN -> ExeDependency -> LDep PN diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Linking.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Linking.hs index bba8246ecc1..6e9b2f3ae86 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Linking.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Linking.hs @@ -85,11 +85,11 @@ validateLinking index = (`runReader` initVS) . go go :: Tree d c -> Validate (Tree d c) go (PChoice qpn rdm gr cs) = - PChoice qpn rdm gr <$> W.traverseWithKey (goP qpn) (fmap go cs) + PChoice qpn rdm gr <$> W.traverseWithKey (goP rdm qpn) (fmap go cs) go (FChoice qfn rdm gr t m d cs) = - FChoice qfn rdm gr t m d <$> W.traverseWithKey (goF qfn) (fmap go cs) + FChoice qfn rdm gr t m d <$> W.traverseWithKey (goF rdm qfn) (fmap go cs) go (SChoice qsn rdm gr t cs) = - SChoice qsn rdm gr t <$> W.traverseWithKey (goS qsn) (fmap go cs) + SChoice qsn rdm gr t <$> W.traverseWithKey (goS rdm qsn) (fmap go cs) -- For the other nodes we just recurse go (GoalChoice rdm cs) = GoalChoice rdm <$> T.traverse go cs @@ -97,29 +97,29 @@ validateLinking index = (`runReader` initVS) . go go (Fail conflictSet failReason) = return $ Fail conflictSet failReason -- Package choices - goP :: QPN -> POption -> Validate (Tree d c) -> Validate (Tree d c) - goP qpn@(Q _pp pn) opt@(POption i _) r = do + goP :: RevDepMap -> QPN -> POption -> Validate (Tree d c) -> Validate (Tree d c) + goP rdm qpn@(Q _pp pn) opt@(POption i _) r = do vs <- ask let PInfo deps _ _ _ = vsIndex vs ! pn ! i - qdeps = qualifyDeps (vsQualifyOptions vs) qpn deps + qdeps = qualifyDeps (vsQualifyOptions vs) rdm qpn deps newSaved = M.insert qpn qdeps (vsSaved vs) - case execUpdateState (pickPOption qpn opt qdeps) vs of + case execUpdateState (pickPOption rdm qpn opt qdeps) vs of Left (cs, err) -> return $ Fail cs (DependenciesNotLinked err) Right vs' -> local (const vs' { vsSaved = newSaved }) r -- Flag choices - goF :: QFN -> Bool -> Validate (Tree d c) -> Validate (Tree d c) - goF qfn b r = do + goF :: RevDepMap -> QFN -> Bool -> Validate (Tree d c) -> Validate (Tree d c) + goF rdm qfn b r = do vs <- ask - case execUpdateState (pickFlag qfn b) vs of + case execUpdateState (pickFlag rdm qfn b) vs of Left (cs, err) -> return $ Fail cs (DependenciesNotLinked err) Right vs' -> local (const vs') r -- Stanza choices (much the same as flag choices) - goS :: QSN -> Bool -> Validate (Tree d c) -> Validate (Tree d c) - goS qsn b r = do + goS :: RevDepMap -> QSN -> Bool -> Validate (Tree d c) -> Validate (Tree d c) + goS rdm qsn b r = do vs <- ask - case execUpdateState (pickStanza qsn b) vs of + case execUpdateState (pickStanza rdm qsn b) vs of Left (cs, err) -> return $ Fail cs (DependenciesNotLinked err) Right vs' -> local (const vs') r @@ -159,9 +159,9 @@ conflict = lift' . Left execUpdateState :: UpdateState () -> ValidateState -> Either Conflict ValidateState execUpdateState = execStateT . unUpdateState -pickPOption :: QPN -> POption -> FlaggedDeps QPN -> UpdateState () -pickPOption qpn (POption i Nothing) _deps = pickConcrete qpn i -pickPOption qpn (POption i (Just pp')) deps = pickLink qpn i pp' deps +pickPOption :: RevDepMap -> QPN -> POption -> FlaggedDeps QPN -> UpdateState () +pickPOption _rdm qpn (POption i Nothing) _deps = pickConcrete qpn i +pickPOption rdm qpn (POption i (Just pp')) deps = pickLink rdm qpn i pp' deps pickConcrete :: QPN -> I -> UpdateState () pickConcrete qpn@(Q pp _) i = do @@ -177,8 +177,8 @@ pickConcrete qpn@(Q pp _) i = do Just lg -> makeCanonical lg qpn i -pickLink :: QPN -> I -> PackagePath -> FlaggedDeps QPN -> UpdateState () -pickLink qpn@(Q _pp pn) i pp' deps = do +pickLink :: RevDepMap -> QPN -> I -> PackagePath -> FlaggedDeps QPN -> UpdateState () +pickLink rdm qpn@(Q _pp pn) i pp' deps = do vs <- get -- The package might already be in a link group @@ -209,7 +209,7 @@ pickLink qpn@(Q _pp pn) i pp' deps = do updateLinkGroup lgTarget' -- Make sure all dependencies are linked as well - linkDeps target deps + linkDeps rdm target deps makeCanonical :: LinkGroup -> QPN -> I -> UpdateState () makeCanonical lg qpn@(Q pp _) i = @@ -233,8 +233,8 @@ makeCanonical lg qpn@(Q pp _) i = -- because having the direct dependencies in a link group means that we must -- have already made or will make sooner or later a link choice for one of these -- as well, and cover their dependencies at that point. -linkDeps :: QPN -> FlaggedDeps QPN -> UpdateState () -linkDeps target = \deps -> do +linkDeps :: RevDepMap -> QPN -> FlaggedDeps QPN -> UpdateState () +linkDeps rdm target = \deps -> do -- linkDeps is called in two places: when we first link one package to -- another, and when we discover more dependencies of an already linked -- package after doing some flag assignment. It is therefore important that @@ -276,19 +276,19 @@ linkDeps target = \deps -> do requalify :: FlaggedDeps QPN -> UpdateState (FlaggedDeps QPN) requalify deps = do vs <- get - return $ qualifyDeps (vsQualifyOptions vs) target (unqualifyDeps deps) + return $ qualifyDeps (vsQualifyOptions vs) rdm target (unqualifyDeps deps) -pickFlag :: QFN -> Bool -> UpdateState () -pickFlag qfn b = do +pickFlag :: RevDepMap -> QFN -> Bool -> UpdateState () +pickFlag rdm qfn b = do modify $ \vs -> vs { vsFlags = M.insert qfn b (vsFlags vs) } verifyFlag qfn - linkNewDeps (F qfn) b + linkNewDeps rdm (F qfn) b -pickStanza :: QSN -> Bool -> UpdateState () -pickStanza qsn b = do +pickStanza :: RevDepMap -> QSN -> Bool -> UpdateState () +pickStanza rdm qsn b = do modify $ \vs -> vs { vsStanzas = M.insert qsn b (vsStanzas vs) } verifyStanza qsn - linkNewDeps (S qsn) b + linkNewDeps rdm (S qsn) b -- | Link dependencies that we discover after making a flag or stanza choice. -- @@ -297,15 +297,15 @@ pickStanza qsn b = do -- non-trivial link group, then these new dependencies have to be linked as -- well. In linkNewDeps, we compute such new dependencies and make sure they are -- linked. -linkNewDeps :: Var QPN -> Bool -> UpdateState () -linkNewDeps var b = do +linkNewDeps :: RevDepMap -> Var QPN -> Bool -> UpdateState () +linkNewDeps rdm var b = do vs <- get let qpn@(Q pp pn) = varPN var qdeps = vsSaved vs ! qpn lg = vsLinks vs ! qpn newDeps = findNewDeps vs qdeps linkedTo = S.delete pp (lgMembers lg) - forM_ (S.toList linkedTo) $ \pp' -> linkDeps (Q pp' pn) newDeps + forM_ (S.toList linkedTo) $ \pp' -> linkDeps rdm (Q pp' pn) newDeps where findNewDeps :: ValidateState -> FlaggedDeps QPN -> FlaggedDeps QPN findNewDeps vs = concatMap (findNewDeps' vs) diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs index 11fa7ca874d..ec188b14cde 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs @@ -180,6 +180,7 @@ showConflicts conflicts = Just (qpn, MergedPackageConflict False [v] Nothing) toMergedConflict (CS.VersionConflict qpn (CS.OrderedVersionRange vr)) = Just (qpn, MergedPackageConflict False [] (Just vr)) + toMergedConflict (CS.PrivateScopeClosureConflict _ _) = Nothing toMergedConflict CS.OtherConflict = Nothing showConflict :: QPN -> MergedPackageConflict -> String @@ -320,6 +321,7 @@ showFR c Backjump = " (backjumping, conflict set: " ++ s showFR _ MultipleInstances = " (multiple instances)" showFR c (DependenciesNotLinked msg) = " (dependencies not linked: " ++ msg ++ "; conflict set: " ++ showConflictSet c ++ ")" showFR c CyclicDependencies = " (cyclic dependencies; conflict set: " ++ showConflictSet c ++ ")" +showFR c (InvalidPrivateScope qual) = " (private scopes must contain its closure, but package " ++ showConflictSet c ++ " is not included in the private scope " ++ prettyShow qual ++ ")" showFR _ (UnsupportedSpecVer ver) = " (unsupported spec-version " ++ prettyShow ver ++ ")" -- The following are internal failures. They should not occur. In the -- interest of not crashing unnecessarily, we still just print an error diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/PrivateScopeClosure.hs b/cabal-install-solver/src/Distribution/Solver/Modular/PrivateScopeClosure.hs new file mode 100644 index 00000000000..23bb0413c89 --- /dev/null +++ b/cabal-install-solver/src/Distribution/Solver/Modular/PrivateScopeClosure.hs @@ -0,0 +1,127 @@ +{-# LANGUAGE TupleSections #-} +module Distribution.Solver.Modular.PrivateScopeClosure where + +import Control.Exception (assert) +import Prelude hiding (cycle) +import qualified Data.Map as M + +import Distribution.Solver.Modular.Dependency +import Distribution.Solver.Modular.Flag +import Distribution.Solver.Modular.Tree +import qualified Distribution.Solver.Modular.ConflictSet as CS +import Distribution.Solver.Types.PackagePath + +-- | Find and reject any nodes that would violate the private-dependencies +-- closure property, which states that all packages within the closure of a +-- private scope must also be included in the private scope. +detectInvalidPrivateScopesPhase :: Tree d c -> Tree d c +detectInvalidPrivateScopesPhase = go + where + -- Similar to detectCyclesPhase, maybe we could deduplicate + go :: Tree d c -> Tree d c + go (PChoice qpn rdm gr cs) = + PChoice qpn rdm gr $ fmap (checkChild qpn) (fmap go cs) + go (FChoice qfn@(FN qpn _) rdm gr w m d cs) = + FChoice qfn rdm gr w m d $ fmap (checkChild qpn) (fmap go cs) + go (SChoice qsn@(SN qpn _) rdm gr w cs) = + SChoice qsn rdm gr w $ fmap (checkChild qpn) (fmap go cs) + go (GoalChoice rdm cs) = GoalChoice rdm (fmap go cs) + go x@(Fail _ _) = x + go x@(Done _ _) = x + + checkChild :: QPN -> Tree d c -> Tree d c + checkChild qpn x@(PChoice _ rdm _ _) = failIfBadClosure qpn rdm x + checkChild qpn x@(FChoice _ rdm _ _ _ _ _) = failIfBadClosure qpn rdm x + checkChild qpn x@(SChoice _ rdm _ _ _) = failIfBadClosure qpn rdm x + checkChild qpn x@(GoalChoice rdm _) = failIfBadClosure qpn rdm x + checkChild _ x@(Fail _ _) = x + checkChild qpn x@(Done rdm _) = failIfBadClosure qpn rdm x + + failIfBadClosure :: QPN -> RevDepMap -> Tree d c -> Tree d c + -- An already qualified package can't violate the closure property + failIfBadClosure (Q (PackagePath _ (QualAlias _ _ _)) _) _ x = x + failIfBadClosure qpn rdm x = + case findBadClosures qpn rdm of + Nothing -> x + Just (relSet, qual) -> Fail relSet (InvalidPrivateScope qual) + +-- | Given the reverse dependency map from a node in the tree, check if the +-- solution has any bad closures. If it is, return the conflict set containing +-- the variables violating private deps closures. +findBadClosures :: QPN -> RevDepMap -> Maybe (ConflictSet, Qualifier) +findBadClosures pkg rdm = + case concatMap (\root@(Q (PackagePath _ ps) _) -> (root,) <$> concatMap (step ps False . snd) (findRevDepsTopLevel root)) roots of + (closureBegin@(Q (PackagePath _ ql) _), closureEnd@(Q (PackagePath _ ql') _)):_ -> + assert (ql == ql') $ + return (CS.singletonWithConflict (P pkg) (CS.PrivateScopeClosureConflict closureBegin closureEnd), ql) + [] -> Nothing + where + + -- Roots of the rev dep map with QualAlias/private scope + roots :: [QPN] + roots = flip M.foldMapWithKey rdm $ + \key _ -> case key of + Q (PackagePath _ (QualAlias _ _ _)) _ -> [key] + _ -> [] + + -- Traverse up from a root until a reverse dep in the same private scope is + -- found. We only traverse up until we find another private dep in the same + -- scope because that is sufficient to complete a "local closure", and + -- because we traverse from all root deps in private scopes, we will + -- traverse all the "local" closures thus the full closure of each scope... REWRITE and RENAME + step :: Qualifier -- ^ This root's qualifier/private scope + -> Bool -- ^ Have we found the "goal" package in the "local" closure + -> QPN -- ^ Next package in the closure traversal + -> [QPN] + -- ^ The terminal nodes for each closure violated by this package. + -- Empty if the closure property is kept. + step rootQual hasFoundGoal next + -- We stop at any qualified reverse dep, even if it does not belong to + -- the same scope as the one we are checking for the closure property. + -- By case analysis: + -- * If it is the same scope, we've reached the end of the local + -- closure, and if the package has been seen as non-qualified then the + -- property is violated + -- + -- * If it is not the same scope, that means "next" in that branch is a + -- dep of a private scope goal, but it may not violate the closure + -- property for that one. Even if it were to violate the property + -- outside of a nested private scope, it doesn't matter because within a + -- (nested) private scope it just has to be consistent in + -- itself......... + | Q (PackagePath _ ps@(QualAlias _ _ _)) _ <- next + = if ps == rootQual && hasFoundGoal + then [next] + else [] + | otherwise + = case findRevDepsTopLevel next of + -- If there are no more deps (meaning we didn't stop at any rev-dep in + -- a private scope), then we don't have a private scope closure and the + -- property is preserved. + [] -> [] + -- Step through all the next reverse deps, failing (by adding terminal + -- nodes to the result) if any of the steps violates the closure + -- property + xs -> + -- If the next pkg is our goal, we recurse with "hasFoundGoal = + -- True", otherwise with what we had previously + let hasFoundGoal' = next == pkg || hasFoundGoal + in concatMap (step rootQual hasFoundGoal' . snd) xs + + -- Find the reverse dependencies of this QPN, but in the top-level scope. + -- When constructing the closure, starting from a qualified root, we need + -- to take into account that the dependencies introduced by the + -- private-scoped-depends will be in the top level scope... + findRevDepsTopLevel qpn@(Q (PackagePath namespace _) pn) = + case (Q (PackagePath namespace QualToplevel) pn) `M.lookup` rdm of + Nothing -> + -- This means the package we are looking up in the map has only been + -- introduced qualified, not at the QualToplevel. This means we look + -- it up as is. + case qpn `M.lookup` rdm of + Nothing -> findError "cannot find node" + Just rdeps -> rdeps + Just rdeps -> rdeps + + findError = error . ("Distribution.Solver.Modular.PrivateScopeClosure.findBadClosures: " ++) + diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs index 5e17e3f76ba..4ebfaac0132 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs @@ -36,6 +36,7 @@ import Distribution.Solver.Modular.Log import Distribution.Solver.Modular.Message import Distribution.Solver.Modular.Package import qualified Distribution.Solver.Modular.Preference as P +import Distribution.Solver.Modular.PrivateScopeClosure import Distribution.Solver.Modular.Validate import Distribution.Solver.Modular.Linking import Distribution.Solver.Modular.PSQ (PSQ) @@ -98,6 +99,8 @@ solve :: SolverConfig -- ^ solver parameters -> RetryLog Message SolverFailure (Assignment, RevDepMap) solve sc cinfo idx pkgConfigDB userPrefs userConstraints userGoals = explorePhase . + traceTree "invalid-scopes.json" id . + detectInvalidPrivateScopesPhase . traceTree "cycles.json" id . detectCycles . traceTree "heuristics.json" id . diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Tree.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Tree.hs index 357609d85f5..e249b3fba34 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Tree.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Tree.hs @@ -128,6 +128,7 @@ data FailReason = UnsupportedExtension Extension | MultipleInstances | DependenciesNotLinked String | CyclicDependencies + | InvalidPrivateScope Qualifier | UnsupportedSpecVer Ver deriving (Eq, Show) diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs index 9606dcc75f7..7b9d8a8bf3f 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs @@ -158,7 +158,7 @@ validate = go where go :: Tree d c -> Validate (Tree d c) - go (PChoice qpn rdm gr ts) = PChoice qpn rdm gr <$> W.traverseWithKey (\k -> goP qpn k . go) ts + go (PChoice qpn rdm gr ts) = PChoice qpn rdm gr <$> W.traverseWithKey (\k -> goP rdm qpn k . go) ts go (FChoice qfn rdm gr b m d ts) = do -- Flag choices may occur repeatedly (because they can introduce new constraints @@ -190,8 +190,8 @@ validate = go go (Fail c fr ) = pure (Fail c fr) -- What to do for package nodes ... - goP :: QPN -> POption -> Validate (Tree d c) -> Validate (Tree d c) - goP qpn@(Q _pp pn) (POption i _) r = do + goP :: RevDepMap -> QPN -> POption -> Validate (Tree d c) -> Validate (Tree d c) + goP rdm qpn@(Q _pp pn) (POption i _) r = do PA ppa pfa psa <- asks pa -- obtain current preassignment extSupported <- asks supportedExt -- obtain the supported extensions langSupported <- asks supportedLang -- obtain the supported languages @@ -204,7 +204,7 @@ validate = go -- obtain dependencies and index-dictated exclusions introduced by the choice let (PInfo deps comps _ mfr) = idx ! pn ! i -- qualify the deps in the current scope - let qdeps = qualifyDeps qo qpn deps + let qdeps = qualifyDeps qo rdm qpn deps -- the new active constraints are given by the instance we have chosen, -- plus the dependency information we have for that instance let newactives = extractAllDeps pfa psa qdeps diff --git a/cabal-install-solver/src/Distribution/Solver/Types/InstSolverPackage.hs b/cabal-install-solver/src/Distribution/Solver/Types/InstSolverPackage.hs index 871a0dd15a9..5e76b6a7a24 100644 --- a/cabal-install-solver/src/Distribution/Solver/Types/InstSolverPackage.hs +++ b/cabal-install-solver/src/Distribution/Solver/Types/InstSolverPackage.hs @@ -6,7 +6,7 @@ module Distribution.Solver.Types.InstSolverPackage import Distribution.Solver.Compat.Prelude import Prelude () -import Distribution.Package ( Package(..), HasMungedPackageId(..), HasUnitId(..) ) +import Distribution.Package ( Package(..), HasMungedPackageId(..), HasUnitId(..), PrivateAlias ) import Distribution.Solver.Types.ComponentDeps ( ComponentDeps ) import Distribution.Solver.Types.SolverId import Distribution.Types.MungedPackageId @@ -18,7 +18,7 @@ import Distribution.InstalledPackageInfo (InstalledPackageInfo) -- specified by the dependency solver. data InstSolverPackage = InstSolverPackage { instSolverPkgIPI :: InstalledPackageInfo, - instSolverPkgLibDeps :: ComponentDeps [SolverId], + instSolverPkgLibDeps :: ComponentDeps [(SolverId, Maybe PrivateAlias)], instSolverPkgExeDeps :: ComponentDeps [SolverId] } deriving (Eq, Show, Generic) diff --git a/cabal-install-solver/src/Distribution/Solver/Types/PackageConstraint.hs b/cabal-install-solver/src/Distribution/Solver/Types/PackageConstraint.hs index c9385bceda2..6632290416f 100644 --- a/cabal-install-solver/src/Distribution/Solver/Types/PackageConstraint.hs +++ b/cabal-install-solver/src/Distribution/Solver/Types/PackageConstraint.hs @@ -23,7 +23,7 @@ import Distribution.Solver.Compat.Prelude import Prelude () import Distribution.Package (PackageName) -import Distribution.PackageDescription (FlagAssignment, dispFlagAssignment, ComponentName) +import Distribution.PackageDescription (FlagAssignment, dispFlagAssignment) import Distribution.Pretty (flatStyle, pretty) import Distribution.Types.PackageVersionConstraint (PackageVersionConstraint (..)) import Distribution.Version (VersionRange, simplifyVersionRange) @@ -32,7 +32,7 @@ import Distribution.Solver.Types.OptionalStanza import Distribution.Solver.Types.PackagePath import qualified Text.PrettyPrint as Disp -import Distribution.Solver.Types.ComponentDeps (Component(..), componentNameToComponent) +import Distribution.Solver.Types.ComponentDeps (Component(..)) import Distribution.Types.Dependency @@ -50,10 +50,12 @@ data ConstraintScope -- solving is implemented, and remove this special case for targets. = ScopeTarget PackageName -- | The package with the specified name and qualifier. - | ScopeQualified Namespace PackageName + | ScopeQualified Namespace Qualifier PackageName - - -- Apply a constraint to a private-build-depends scope + -- TODO Better Comment: Apply a constraint to a private-build-depends scope + -- It is not sufficient to have ScopeQualified because we don't have enough + -- information in the constraint syntax to fill in the `Component` field of + -- `QualAlias` | ScopePrivate PackageName PrivateAlias PackageName -- | The package with the specified name when it has a -- setup qualifier. @@ -67,33 +69,34 @@ data ConstraintScope -- the package with the specified name when that package is a -- top-level dependency in the default namespace. scopeToplevel :: PackageName -> ConstraintScope -scopeToplevel = ScopeQualified DefaultNamespace +scopeToplevel = ScopeQualified DefaultNamespace QualToplevel -- | Returns the package name associated with a constraint scope. scopeToPackageName :: ConstraintScope -> PackageName scopeToPackageName (ScopeTarget pn) = pn -scopeToPackageName (ScopeQualified _ pn) = pn +scopeToPackageName (ScopeQualified _ _ pn) = pn scopeToPackageName (ScopeAnySetupQualifier pn) = pn scopeToPackageName (ScopeAnyQualifier pn) = pn scopeToPackageName (ScopePrivate _ _ pn) = pn --- TOOD: Crucial +-- TODO: Crucial (RM: Why did you write this Matthew?!) constraintScopeMatches :: ConstraintScope -> QPN -> Bool ---constraintScopeMatches cs qpn | traceShow (cs, qpn) False = undefined constraintScopeMatches (ScopeTarget pn) (Q (PackagePath ns q) pn') = let namespaceMatches DefaultNamespace = True namespaceMatches (Independent namespacePn) = pn == namespacePn namespaceMatches (IndependentComponent {}) = False namespaceMatches (IndependentBuildTool {}) = False in namespaceMatches ns && q == QualToplevel && pn == pn' -constraintScopeMatches (ScopePrivate spn alias c_pn) (Q (PackagePath qual_ns q) c_pn') = - let qualMatches (QualAlias qual_pn _ qual_alias _) = spn == qual_pn && alias == qual_alias +constraintScopeMatches (ScopePrivate spn alias c_pn) (Q (PackagePath _qual_ns q) c_pn') = + let qualMatches (QualAlias qual_pn _ qual_alias) = spn == qual_pn && alias == qual_alias qualMatches _ = False - -- TODO: Check whether any ns should subsume qual_ns + -- TODO: Check whether any ns should subsume qual_ns (if private constraint scopes grow namespaces...) in qualMatches q && c_pn == c_pn' -constraintScopeMatches (ScopeQualified {}) _ = False +constraintScopeMatches (ScopeQualified ns cq cpn) (Q (PackagePath qual_ns q) cpn') = + ns == qual_ns && cq == q && cpn == cpn' + constraintScopeMatches (ScopeAnySetupQualifier pn) (Q pp pn') = - let setup (PackagePath (IndependentComponent _ ComponentSetup) x) = True + let setup (PackagePath (IndependentComponent _ ComponentSetup) _) = True setup _ = False in setup pp && pn == pn' constraintScopeMatches (ScopeAnyQualifier pn) (Q _ pn') = pn == pn' @@ -101,8 +104,8 @@ constraintScopeMatches (ScopeAnyQualifier pn) (Q _ pn') = pn == pn' -- | Pretty-prints a constraint scope. dispConstraintScope :: ConstraintScope -> Disp.Doc dispConstraintScope (ScopeTarget pn) = pretty pn <<>> Disp.text "." <<>> pretty pn -dispConstraintScope (ScopeQualified ns pn) = dispNamespace ns <<>> pretty pn -dispConstraintScope (ScopePrivate pn alias p) = Disp.text "private." <<>> pretty pn <<>> Disp.text "." <<>> pretty @PrivateAlias alias <<>> Disp.text "." <<>> pretty p +dispConstraintScope (ScopeQualified ns _q pn) = dispNamespace ns <<>> pretty pn +dispConstraintScope (ScopePrivate pn alias p) = Disp.text "private." <<>> pretty pn <<>> Disp.text "." <<>> pretty @PrivateAlias alias <<>> Disp.text ":" <<>> pretty p dispConstraintScope (ScopeAnySetupQualifier pn) = Disp.text "setup." <<>> pretty pn dispConstraintScope (ScopeAnyQualifier pn) = Disp.text "any." <<>> pretty pn diff --git a/cabal-install-solver/src/Distribution/Solver/Types/PackagePath.hs b/cabal-install-solver/src/Distribution/Solver/Types/PackagePath.hs index 9d334b68d9e..11e0e49edd6 100644 --- a/cabal-install-solver/src/Distribution/Solver/Types/PackagePath.hs +++ b/cabal-install-solver/src/Distribution/Solver/Types/PackagePath.hs @@ -12,11 +12,9 @@ module Distribution.Solver.Types.PackagePath import Distribution.Solver.Compat.Prelude import Prelude () import Distribution.Package (PackageName, PrivateAlias) -import Distribution.Pretty (pretty, flatStyle) +import Distribution.Pretty (Pretty, pretty, flatStyle) import qualified Text.PrettyPrint as Disp -import Distribution.Types.ComponentName import Distribution.Solver.Types.ComponentDeps -import Distribution.ModuleName -- | A package path consists of a namespace and a package path inside that -- namespace. @@ -65,7 +63,7 @@ data Qualifier = | QualBase PackageName -- A goal which is solved per-component - | QualAlias PackageName Component PrivateAlias [PackageName] + | QualAlias PackageName Component PrivateAlias -- package: qux @@ -94,8 +92,17 @@ data Qualifier = -- =>>> PackagePath DefaultNamespace QualTopLevel "baz" =>> 0.6 -- -- --- package a --- :private-build-depends: G0 with (b, d) +-- package pkg-a +-- :private-build-depends: G0 with (b==1, d) +-- build-depends: b==2, d +-- +-- privatescope: b,d +-- b -> c +-- c -> d +-- +-- enclosure +-- anything from G0 cannot be exposed by pkg-a +-- solver -- -- package b-0.1 -- :build-depends: x @@ -119,8 +126,6 @@ data Qualifier = -- -- -- --- --- -- PackagePath DefaultNamespace (QualAlias "qux" "MainLib" "G1" ) "foo" -- PackagePath DefaultNamespace (QualAlias "qux" "MainLib" "G1") "baz" -- @@ -185,7 +190,10 @@ data Qualifier = dispQualifier :: Qualifier -> Disp.Doc dispQualifier QualToplevel = Disp.empty dispQualifier (QualBase pn) = pretty pn <<>> Disp.text ".bb." -dispQualifier (QualAlias pn c alias _) = pretty pn <<>> Disp.text ":" <<>> pretty c <<>> Disp.text ":" <<>> pretty alias <<>> Disp.text "." +dispQualifier (QualAlias pn c alias) = pretty pn <<>> Disp.text ":" <<>> pretty c <<>> Disp.text ":" <<>> pretty alias <<>> Disp.text "." + +instance Pretty Qualifier where + pretty = dispQualifier -- | A qualified entity. Pairs a package path with the entity. data Qualified a = Q PackagePath a diff --git a/cabal-install-solver/src/Distribution/Solver/Types/ResolverPackage.hs b/cabal-install-solver/src/Distribution/Solver/Types/ResolverPackage.hs index fb5c2855a3b..f34e5944596 100644 --- a/cabal-install-solver/src/Distribution/Solver/Types/ResolverPackage.hs +++ b/cabal-install-solver/src/Distribution/Solver/Types/ResolverPackage.hs @@ -15,9 +15,8 @@ import Distribution.Solver.Types.SolverPackage import qualified Distribution.Solver.Types.ComponentDeps as CD import Distribution.Compat.Graph (IsNode(..)) -import Distribution.Package (Package(..), HasUnitId(..), PackageName) +import Distribution.Package (Package(..), HasUnitId(..)) import Distribution.Simple.Utils (ordNub) -import Distribution.ModuleName import Distribution.Types.Dependency (PrivateAlias) -- | The dependency resolver picks either pre-existing installed packages @@ -37,7 +36,7 @@ instance Package (ResolverPackage loc) where packageId (Configured spkg) = packageId spkg resolverPackageLibDeps :: ResolverPackage loc -> CD.ComponentDeps [(SolverId, Maybe PrivateAlias)] -resolverPackageLibDeps (PreExisting ipkg) = map (\x -> (x,Nothing)) <$> instSolverPkgLibDeps ipkg +resolverPackageLibDeps (PreExisting ipkg) = instSolverPkgLibDeps ipkg resolverPackageLibDeps (Configured spkg) = solverPkgLibDeps spkg resolverPackageExeDeps :: ResolverPackage loc -> CD.ComponentDeps [SolverId] diff --git a/cabal-install-solver/src/Distribution/Solver/Types/SolverPackage.hs b/cabal-install-solver/src/Distribution/Solver/Types/SolverPackage.hs index 218da4a0a42..85148db46b5 100644 --- a/cabal-install-solver/src/Distribution/Solver/Types/SolverPackage.hs +++ b/cabal-install-solver/src/Distribution/Solver/Types/SolverPackage.hs @@ -6,13 +6,12 @@ module Distribution.Solver.Types.SolverPackage import Distribution.Solver.Compat.Prelude import Prelude () -import Distribution.Package ( Package(..), PackageName ) +import Distribution.Package ( Package(..) ) import Distribution.PackageDescription ( FlagAssignment ) import Distribution.Solver.Types.ComponentDeps ( ComponentDeps ) import Distribution.Solver.Types.OptionalStanza import Distribution.Solver.Types.SolverId import Distribution.Solver.Types.SourcePackage -import Distribution.ModuleName import Distribution.Types.Dependency (PrivateAlias) -- | A 'SolverPackage' is a package specified by the dependency solver. diff --git a/cabal-install/main/Main.hs b/cabal-install/main/Main.hs index 72b2fae5aee..767da7d0118 100644 --- a/cabal-install/main/Main.hs +++ b/cabal-install/main/Main.hs @@ -7,6 +7,5 @@ import System.Environment (getArgs) import qualified Distribution.Client.Main as Client - main :: IO () main = getArgs >>= Client.main diff --git a/cabal-install/src/Distribution/Client/CmdOutdated.hs b/cabal-install/src/Distribution/Client/CmdOutdated.hs index 5cf2a79486c..e5cb74be4b1 100644 --- a/cabal-install/src/Distribution/Client/CmdOutdated.hs +++ b/cabal-install/src/Distribution/Client/CmdOutdated.hs @@ -455,8 +455,12 @@ depsFromPkgDesc verbosity comp platform = do debug verbosity "Reading the list of dependencies from the package description" - return $ map toPVC bd --(error "todo") + return $ map toPVC bd where + -- It doesn't seem critical that we report the scope in which the package + -- is outdated, because, in order for that report to be consistent with the + -- rest of Cabal, we must first consider how cabal outdated and cabal + -- freeze work wrt private dependencies (TODO). toPVC (_alias, (Dependency pn vr _)) = PackageVersionConstraint pn vr -- | Various knobs for customising the behaviour of 'listOutdated'. diff --git a/cabal-install/src/Distribution/Client/CmdRepl.hs b/cabal-install/src/Distribution/Client/CmdRepl.hs index 0d11fd2c09b..da509bf72ca 100644 --- a/cabal-install/src/Distribution/Client/CmdRepl.hs +++ b/cabal-install/src/Distribution/Client/CmdRepl.hs @@ -132,7 +132,8 @@ import Distribution.Types.CondTree ) import Distribution.Types.Dependency ( Dependencies (..) - , mainLibSet, Dependency(..) + , Dependency (..) + , mainLibSet ) import Distribution.Types.Library ( Library (..) diff --git a/cabal-install/src/Distribution/Client/Dependency.hs b/cabal-install/src/Distribution/Client/Dependency.hs index e28ce872f4b..3d8ae3d70ad 100644 --- a/cabal-install/src/Distribution/Client/Dependency.hs +++ b/cabal-install/src/Distribution/Client/Dependency.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TupleSections #-} + ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- @@ -894,7 +896,7 @@ validateSolverResult -> [ResolverPackage UnresolvedPkgLoc] -> SolverInstallPlan validateSolverResult platform comp indepGoals pkgs = - case [] of --planPackagesProblems platform comp pkgs of + case planPackagesProblems platform comp pkgs of [] -> case SolverInstallPlan.new indepGoals graph of Right plan -> plan Left problems -> error (formatPlanProblems problems) @@ -960,10 +962,10 @@ data PackageProblem = DuplicateFlag PD.FlagName | MissingFlag PD.FlagName | ExtraFlag PD.FlagName - | DuplicateDeps [PackageId] - | MissingDep Dependency - | ExtraDep PackageId - | InvalidDep Dependency PackageId + | DuplicateDeps [(PackageId, Maybe PrivateAlias)] + | MissingDep Dependency (Maybe PrivateAlias) + | ExtraDep PackageId (Maybe PrivateAlias) + | InvalidDep Dependency PackageId (Maybe PrivateAlias) showPackageProblem :: PackageProblem -> String showPackageProblem (DuplicateFlag flag) = @@ -974,20 +976,23 @@ showPackageProblem (ExtraFlag flag) = "extra flag given that is not used by the package: " ++ PD.unFlagName flag showPackageProblem (DuplicateDeps pkgids) = "duplicate packages specified as selected dependencies: " - ++ intercalate ", " (map prettyShow pkgids) -showPackageProblem (MissingDep dep) = + ++ intercalate ", " (map (\(x, y) -> maybe "" ((<> ".") . prettyShow) y <> prettyShow x) pkgids) +showPackageProblem (MissingDep dep palias) = "the package has a dependency " + ++ maybe "" ((<> ".") . prettyShow) palias ++ prettyShow dep ++ " but no package has been selected to satisfy it." -showPackageProblem (ExtraDep pkgid) = +showPackageProblem (ExtraDep pkgid palias) = "the package configuration specifies " + ++ maybe "" ((<> ".") . prettyShow) palias ++ prettyShow pkgid ++ " but (with the given flag assignment) the package does not actually" ++ " depend on any version of that package." -showPackageProblem (InvalidDep dep pkgid) = +showPackageProblem (InvalidDep dep pkgid palias) = "the package depends on " ++ prettyShow dep ++ " but the configuration specifies " + ++ maybe "" ((<> ".") . prettyShow) palias ++ prettyShow pkgid ++ " which does not satisfy the dependency." @@ -1012,13 +1017,18 @@ configuredPackageProblems | pkgs <- CD.nonSetupDeps ( fmap - (duplicatesBy (comparing packageName)) + (duplicatesBy (comparing (\(x, y) -> (packageName x, y)))) specifiedDeps1 ) ] - ++ [MissingDep dep | OnlyInLeft dep <- mergedDeps] - ++ [ExtraDep pkgid | OnlyInRight pkgid <- mergedDeps] - ++ [ InvalidDep dep pkgid | InBoth dep pkgid <- mergedDeps, not (packageSatisfiesDependency pkgid dep) + ++ [MissingDep dep alias | OnlyInLeft (dep, alias) <- mergedDeps] + ++ [ExtraDep pkgid palias | OnlyInRight (pkgid, palias) <- mergedDeps] + ++ [ InvalidDep dep pkgid palias + | InBoth (dep, palias) (pkgid, _palias) <- mergedDeps + , assert + (palias == _palias) + not + (packageSatisfiesDependency pkgid dep) ] where -- TODO: sanity tests on executable deps @@ -1026,10 +1036,10 @@ configuredPackageProblems thisPkgName :: PackageName thisPkgName = packageName (srcpkgDescription pkg) - specifiedDeps1 :: ComponentDeps [PackageId] - specifiedDeps1 = fmap (map (solverSrcId . fst)) specifiedDeps0 + specifiedDeps1 :: ComponentDeps [(PackageId, Maybe PrivateAlias)] + specifiedDeps1 = fmap (map (first solverSrcId)) specifiedDeps0 - specifiedDeps :: [PackageId] + specifiedDeps :: [(PackageId, Maybe PrivateAlias)] specifiedDeps = CD.flatDeps specifiedDeps1 mergedFlags :: [MergeResult PD.FlagName PD.FlagName] @@ -1047,19 +1057,19 @@ configuredPackageProblems dependencyName (Dependency name _ _) = name - mergedDeps :: [MergeResult Dependency PackageId] + mergedDeps :: [MergeResult (Dependency, Maybe PrivateAlias) (PackageId, Maybe PrivateAlias)] mergedDeps = mergeDeps requiredDeps specifiedDeps mergeDeps - :: [Dependency] - -> [PackageId] - -> [MergeResult Dependency PackageId] + :: [(Dependency, Maybe PrivateAlias)] + -> [(PackageId, Maybe PrivateAlias)] + -> [MergeResult (Dependency, Maybe PrivateAlias) (PackageId, Maybe PrivateAlias)] mergeDeps required specified = let sortNubOn f = nubBy ((==) `on` f) . sortBy (compare `on` f) in mergeBy - (\dep pkgid -> dependencyName dep `compare` packageName pkgid) - (sortNubOn dependencyName required) - (sortNubOn packageName specified) + (\(dep, alias1) (pkgid, alias2) -> (dependencyName dep, alias1) `compare` (packageName pkgid, alias2)) + (sortNubOn (first dependencyName) required) + (sortNubOn (first packageName) specified) compSpec = enableStanzas stanzas -- TODO: It would be nicer to use ComponentDeps here so we can be more @@ -1068,7 +1078,7 @@ configuredPackageProblems -- have to allow for duplicates when we fold specifiedDeps; once we have -- proper ComponentDeps here we should get rid of the `nubOn` in -- `mergeDeps`. - requiredDeps :: [Dependency] + requiredDeps :: [(Dependency, Maybe PrivateAlias)] requiredDeps = -- TODO: use something lower level than finalizePD case finalizePD @@ -1079,7 +1089,7 @@ configuredPackageProblems cinfo [] (srcpkgDescription pkg) of - Right (resolvedPkg, _) -> error "todo" + Right (resolvedPkg, _) -> -- we filter self/internal dependencies. They are still there. -- This is INCORRECT. -- @@ -1087,12 +1097,12 @@ configuredPackageProblems -- but no finalizePDs picks components we are not building, eg. exes. -- See #3775 -- - {- filter - ((/= thisPkgName) . dependencyName) - (PD.enabledBuildDepends resolvedPkg compSpec) - ++ maybe [] PD.setupDepends (PD.setupBuildInfo resolvedPkg) - -} + ((/= thisPkgName) . dependencyName . fst) + ( map (\(x, y) -> (y, x)) $ + PD.enabledBuildDepends resolvedPkg compSpec + ) + ++ maybe [] (map (,Nothing) . PD.setupDepends) (PD.setupBuildInfo resolvedPkg) Left _ -> error "configuredPackageInvalidDeps internal error" diff --git a/cabal-install/src/Distribution/Client/GenBounds.hs b/cabal-install/src/Distribution/Client/GenBounds.hs index b187b914e68..cfcec78801b 100644 --- a/cabal-install/src/Distribution/Client/GenBounds.hs +++ b/cabal-install/src/Distribution/Client/GenBounds.hs @@ -39,9 +39,6 @@ import Distribution.Package , packageVersion , unPackageName ) -import Distribution.PackageDescription - ( enabledBuildDepends - ) import Distribution.PackageDescription.Configuration ( finalizePD ) @@ -67,6 +64,7 @@ import Distribution.Types.ComponentRequestedSpec ( defaultComponentRequestedSpec ) import Distribution.Types.Dependency +import Distribution.Types.PackageDescription import Distribution.Version ( LowerBound (..) , UpperBound (..) @@ -150,9 +148,13 @@ genBounds verbosity packageDBs repoCtxt comp platform progdb globalFlags freezeF Left _ -> putStrLn "finalizePD failed" Right (pd, _) -> do let needBounds = - map depName $ error "todo" --- filter (not . hasUpperBound . depVersion) $ --- enabledBuildDepends pd defaultComponentRequestedSpec + -- ROMES:TODO: This is not quite right for gen-bounds when private + -- dependencies are included: comparing package names is no longer + -- sufficient because some packages "duplicated" by also being + -- present within some private scope + map (depName . snd) $ + filter (not . hasUpperBound . depVersion . snd) $ + enabledBuildDepends pd defaultComponentRequestedSpec pkgs <- getFreezePkgs diff --git a/cabal-install/src/Distribution/Client/InstallPlan.hs b/cabal-install/src/Distribution/Client/InstallPlan.hs index 0fe529995b8..ffafbaf071b 100644 --- a/cabal-install/src/Distribution/Client/InstallPlan.hs +++ b/cabal-install/src/Distribution/Client/InstallPlan.hs @@ -630,7 +630,11 @@ configureInstallPlan configFlags solverPlan = -- NB: no support for executable dependencies } where - deps = error "todo" --fmap (concatMap (map configuredId . mapDep)) (solverPkgLibDeps spkg) + -- If the private alias of a given dependency matters to the configured + -- package deps we should instead add it to the datatype rather than + -- discarding it here. However, we probably only care about the + -- dependencies as a whole here (right?), so we simply discard the scope. + deps = fmap (concatMap (map configuredId . mapDep . fst)) (solverPkgLibDeps spkg) -- ------------------------------------------------------------ @@ -757,22 +761,23 @@ failed -> ([srcpkg], Processing) failed plan (Processing processingSet completedSet failedSet) pkgid = assert (pkgid `Set.member` processingSet) $ - assert (all (`Set.notMember` processingSet) (drop 1 newlyFailedIds)) $ - assert (all (`Set.notMember` completedSet) (drop 1 newlyFailedIds)) $ + assert (all (`Set.notMember` processingSet) newlyFailedIds) $ + assert (all (`Set.notMember` completedSet) newlyFailedIds) $ -- but note that some newlyFailed may already be in the failed set -- since one package can depend on two packages that both fail and -- so would be in the rev-dep closure for both. assert (processingInvariant plan processing') $ - ( map asConfiguredPackage (drop 1 newlyFailed) + ( map asConfiguredPackage newlyFailed , processing' ) where processingSet' = Set.delete pkgid processingSet - failedSet' = failedSet `Set.union` Set.fromList newlyFailedIds + failedSet' = failedSet `Set.union` Set.fromList newlyFailedIds `Set.union` Set.singleton pkgid newlyFailedIds = map nodeKey newlyFailed - newlyFailed = - fromMaybe (internalError "failed" "package not in graph") $ - Graph.revClosure (planGraph plan) [pkgid] + newlyFailed = case fromMaybe (internalError "failed" "package not in graph") $ + Graph.revClosure (planGraph plan) [pkgid] of + [] -> error "impossible" + _ : tail' -> tail' processing' = Processing processingSet' completedSet failedSet' asConfiguredPackage (Configured pkg) = pkg diff --git a/cabal-install/src/Distribution/Client/List.hs b/cabal-install/src/Distribution/Client/List.hs index 3adf87b3f9b..d8bfa969ba7 100644 --- a/cabal-install/src/Distribution/Client/List.hs +++ b/cabal-install/src/Distribution/Client/List.hs @@ -651,8 +651,9 @@ mergePackageInfo versionPref installedPkgs sourcePkgs selectedPkg showVer = source , dependencies = combine - ( map (SourceDependency . simplifyDependency) - . error "todo" -- Source.allBuildDepends + -- We discard info (with `snd`) about private scopes because we don't yet report them in cabal list or cabal info (TODO). + ( map (SourceDependency . simplifyDependency . snd) + . Source.allBuildDepends ) source (map InstalledDependency . Installed.depends) diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs index 13d5975c3d0..f5ae8279c2d 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig.hs @@ -1158,7 +1158,6 @@ fetchAndReadSourcePackages projectConfigShared projectConfigBuildOnly pkgLocations = do - liftIO $ info verbosity "Project settings changed, reconfiguring7..." liftIO $ info verbosity (show pkgLocations) pkgsLocalDirectory <- @@ -1234,7 +1233,6 @@ readSourcePackageLocalDirectory -- ^ The package @.cabal@ file -> Rebuild (PackageSpecifier (SourcePackage UnresolvedPkgLoc)) readSourcePackageLocalDirectory verbosity dir cabalFile = do - liftIO $ info verbosity (show cabalFile) monitorFiles [monitorFileHashed cabalFile] root <- askRoot @@ -1527,7 +1525,6 @@ readSourcePackageCabalFile readSourcePackageCabalFile verbosity pkgfilename content = case runParseResult (parseGenericPackageDescription content) of (warnings, Right pkg) -> do - liftIO $ info verbosity "RIGHT" unless (null warnings) $ info verbosity (formatWarnings warnings) diff --git a/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs b/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs index cc224734a1e..9a35bd27b7a 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs @@ -194,7 +194,7 @@ encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig = J.object $ [ comp2str c J..= J.object - ( [ "depends" J..= map (jdisplay . confInstId) (map (\(p,_, _) -> p) ldeps) + ( [ "depends" J..= map (jdisplay . confInstId) (map (\(p, _, _) -> p) ldeps) , "exe-depends" J..= map (jdisplay . confInstId) edeps ] ++ bin_file c diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 0e0c0b964c3..4e25d64daa7 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -5,8 +5,10 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE NoMonoLocalBinds #-} -- | -- /Elaborated: worked out with great care and nicety of detail; executed with great minuteness: elaborate preparations; elaborate care./ @@ -1758,7 +1760,7 @@ elaborateInstallPlan let do_ cid = let cid' = annotatedIdToConfiguredId . ci_ann_id $ cid - in (cid', False, ci_alias cid ) -- filled in later in pruneInstallPlanPhase2) + in (cid', False, ci_alias cid) -- filled in later in pruneInstallPlanPhase2) -- 2. Read out the dependencies from the ConfiguredComponent cc0 let compLibDependencies = -- Nub because includes can show up multiple times @@ -1873,17 +1875,16 @@ elaborateInstallPlan external_lib_dep_sids = CD.select (== compSolverName) deps0 external_exe_dep_sids = CD.select (== compSolverName) exe_deps0 - external_lib_dep_pkgs = Debug.Trace.traceShow ("SIDS", external_lib_dep_sids) [ (d, alias) | (sid, alias) <- external_lib_dep_sids, d <- mapDep sid ] - - external_exe_dep_pkgs_raw = [ (d, Nothing) | sid <- external_exe_dep_sids, d <- mapDep sid ] + external_exe_dep_sids_raw = [(sid, Nothing) | sid <- external_exe_dep_sids] -- Combine library and build-tool dependencies, for backwards -- compatibility (See issue #5412 and the documentation for -- InstallPlan.fromSolverInstallPlan), but prefer the versions -- specified as build-tools. external_exe_dep_pkgs = - ordNubBy (pkgName . packageId . fst) $ - external_exe_dep_pkgs_raw ++ external_lib_dep_pkgs + [(d, alias) | (sid, alias) <- ordNubBy (pkgName . packageId . fst) $ external_exe_dep_sids_raw ++ external_lib_dep_sids, d <- mapDep sid] + + external_lib_dep_pkgs = [(d, alias) | (sid, alias) <- external_lib_dep_sids, d <- mapDep sid] external_exe_map = Map.fromList $ @@ -1902,7 +1903,7 @@ elaborateInstallPlan Map.fromList $ map mkShapeMapping $ -- MP: TODO... should these aliases work here as well - (map fst external_lib_dep_pkgs ++ map fst external_exe_dep_pkgs_raw) + (map fst external_lib_dep_pkgs ++ concatMap (mapDep . fst) external_exe_dep_sids_raw) compPkgConfigDependencies = [ ( pn @@ -2454,42 +2455,43 @@ matchElabPkg p elab = mkCCMapping :: (ElaboratedPlanPackage, Maybe PrivateAlias) -> ((PackageName, Maybe PrivateAlias), Map ComponentName ((AnnotatedId ComponentId))) -mkCCMapping (ep, alias) = fold ep +mkCCMapping (ep, alias) = foldpp ep where - fold = - InstallPlan.foldPlanPackage - ( \ipkg -> - ( (packageName ipkg, alias) - , Map.singleton - (ipiComponentName ipkg) - -- TODO: libify - ( AnnotatedId - { ann_id = IPI.installedComponentId ipkg - , ann_pid = packageId ipkg - , ann_cname = IPI.sourceComponentName ipkg - } ) - ) - ) - $ \elab -> - let mk_aid cn = - ( AnnotatedId - { ann_id = elabComponentId elab - , ann_pid = packageId elab - , ann_cname = cn - } - ) - in ( (packageName elab, alias) - , case elabPkgOrComp elab of - ElabComponent comp -> - case compComponentName comp of - Nothing -> Map.empty - Just n -> Map.singleton n (mk_aid n) - ElabPackage _ -> - Map.fromList $ - map - (\comp -> let cn = Cabal.componentName comp in (cn, mk_aid cn)) - (Cabal.pkgBuildableComponents (elabPkgDescription elab)) - ) + foldpp = + InstallPlan.foldPlanPackage + ( \ipkg -> + ( (packageName ipkg, alias) + , Map.singleton + (ipiComponentName ipkg) + -- TODO: libify + ( AnnotatedId + { ann_id = IPI.installedComponentId ipkg + , ann_pid = packageId ipkg + , ann_cname = IPI.sourceComponentName ipkg + } + ) + ) + ) + $ \elab -> + let mk_aid cn = + ( AnnotatedId + { ann_id = elabComponentId elab + , ann_pid = packageId elab + , ann_cname = cn + } + ) + in ( (packageName elab, alias) + , case elabPkgOrComp elab of + ElabComponent comp -> + case compComponentName comp of + Nothing -> Map.empty + Just n -> Map.singleton n (mk_aid n) + ElabPackage _ -> + Map.fromList $ + map + (\comp -> let cn = Cabal.componentName comp in (cn, mk_aid cn)) + (Cabal.pkgBuildableComponents (elabPkgDescription elab)) + ) -- | Given an 'ElaboratedPlanPackage', generate the mapping from 'ComponentId' -- to the shape of this package, as per mix-in linking. diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning/SetupPolicy.hs b/cabal-install/src/Distribution/Client/ProjectPlanning/SetupPolicy.hs index bd24d4b6cfd..d2fc113e21e 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning/SetupPolicy.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning/SetupPolicy.hs @@ -176,7 +176,7 @@ instance IsNode NonSetupLibDepSolverPlanPackage where nodeKey spkg nodeNeighbors (NonSetupLibDepSolverPlanPackage spkg) = - ordNub $ (map fst $ CD.nonSetupDeps (resolverPackageLibDeps spkg)) + ordNub $ map fst (CD.nonSetupDeps (resolverPackageLibDeps spkg)) -- | Work out which version of the Cabal we will be using to talk to the -- Setup.hs interface for this package. diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs index 90a5af32414..6d7801cbf43 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs @@ -179,7 +179,13 @@ showElaboratedInstallPlan = InstallPlan.showInstallPlan_gen showNode installed_deps = map pretty . nodeNeighbors - local_deps cfg = [(if internal then text "+" else mempty) <> pretty (confInstId uid) | (uid, internal, alias) <- elabLibDependencies cfg] + local_deps cfg = + [ (if internal then text "+" else mempty) <> mpalias <> pretty (confInstId uid) + | (uid, internal, alias) <- elabLibDependencies cfg + , let mpalias = case alias of + Nothing -> mempty + Just al -> pretty al <> text "." + ] -- TODO: [code cleanup] decide if we really need this, there's not much in it, and in principle -- even platform and compiler could be different if we're building things diff --git a/cabal-install/src/Distribution/Client/ScriptUtils.hs b/cabal-install/src/Distribution/Client/ScriptUtils.hs index a3485925abe..ff6e75cb279 100644 --- a/cabal-install/src/Distribution/Client/ScriptUtils.hs +++ b/cabal-install/src/Distribution/Client/ScriptUtils.hs @@ -100,7 +100,8 @@ import Distribution.Fields , readFields ) import Distribution.PackageDescription - ( ignoreConditions, Dependencies(..) + ( Dependencies (..) + , ignoreConditions ) import Distribution.PackageDescription.FieldGrammar ( executableFieldGrammar diff --git a/cabal-install/src/Distribution/Client/SolverInstallPlan.hs b/cabal-install/src/Distribution/Client/SolverInstallPlan.hs index 9ff5287c108..a0a8fcd0baa 100644 --- a/cabal-install/src/Distribution/Client/SolverInstallPlan.hs +++ b/cabal-install/src/Distribution/Client/SolverInstallPlan.hs @@ -60,6 +60,7 @@ import Distribution.Package , PackageId , PackageIdentifier (..) , PackageName + , PrivateAlias (..) , packageName , packageVersion ) @@ -81,6 +82,7 @@ import Distribution.Solver.Types.SolverPackage import Data.Array ((!)) import qualified Data.Foldable as Foldable import qualified Data.Graph as OldGraph +import qualified Data.List as List import qualified Data.Map as Map import Distribution.Compat.Graph (Graph, IsNode (..)) import qualified Distribution.Compat.Graph as Graph @@ -255,10 +257,10 @@ problems indepGoals index = ++ [ PackageCycle cycleGroup | cycleGroup <- Graph.cycles index ] - -- ++ [ PackageInconsistency name inconsistencies - -- | (name, inconsistencies) <- - -- dependencyInconsistencies indepGoals index - -- ] + ++ [ PackageInconsistency name inconsistencies + | (name, inconsistencies) <- + dependencyInconsistencies indepGoals index + ] ++ [ PackageStateInvalid pkg pkg' | pkg <- Foldable.toList index , Just pkg' <- @@ -365,35 +367,49 @@ dependencyInconsistencies' :: SolverPlanIndex -> [(PackageName, [(PackageIdentifier, Version)])] dependencyInconsistencies' index = - [ (name, [(pid, packageVersion dep) | (dep, pids) <- uses, pid <- pids]) + [ (name, [(pid, packageVersion dep) | (dep, pids) <- map snd uses, pid <- pids]) | (name, ipid_map) <- Map.toList inverseIndex - , let uses = Map.elems ipid_map - , reallyIsInconsistent (map fst uses) + , let uses = Map.toAscList ipid_map -- We need a sorted list with (aliases, packages) (aliases before packages) to call groupBy on. + , any (reallyIsInconsistent . map (fst . snd)) $ + -- We group together all packages without a private alias, and those with + -- private aliases by its scope name AND the SolverId of the package + -- (because, across packages, there may exist scopes with the same name). + List.groupBy + ( \x y -> case (x, y) of + (((Nothing, _), _), (_, _)) -> False + ((_, _), ((Nothing, _), _)) -> False + (((aliasA, sidA), _), ((aliasB, sidB), _)) + | aliasA == aliasB -> + sidA == sidB + | otherwise -> + False + ) + uses ] where -- For each package name (of a dependency, somewhere) -- and each installed ID of that package -- the associated package instance - -- and a list of reverse dependencies (as source IDs) - inverseIndex :: Map PackageName (Map SolverId (SolverPlanPackage, [PackageId])) + -- and a list of reverse dependencies (as source IDs) and the possible private scope of each revdep + inverseIndex :: Map PackageName (Map (Maybe PrivateAlias, SolverId) (SolverPlanPackage, [PackageId])) inverseIndex = Map.fromListWith (Map.unionWith (\(a, b) (_, b') -> (a, b ++ b'))) - [ (packageName dep, Map.fromList [(sid, (dep, [packageId pkg]))]) + [ (packageName dep, Map.fromList [((palias, sid), (dep, [(packageId pkg)]))]) | -- For each package @pkg@ pkg <- Foldable.toList index , -- Find out which @sid@ @pkg@ depends on - (sid, _) <- CD.nonSetupDeps (resolverPackageLibDeps pkg) + (sid, palias) <- CD.nonSetupDeps (resolverPackageLibDeps pkg) , -- And look up those @sid@ (i.e., @sid@ is the ID of @dep@) Just dep <- [Graph.lookup sid index] ] -- If, in a single install plan, we depend on more than one version of a - -- package, then this is ONLY okay in the (rather special) case that we - -- depend on precisely two versions of that package, and one of them - -- depends on the other. This is necessary for example for the base where - -- we have base-3 depending on base-4. - reallyIsInconsistent :: [SolverPlanPackage] -> Bool + -- package in the same top-level or private scope, then this is ONLY okay + -- in the (rather special) case that we depend on precisely two versions of + -- that package, and one of them depends on the other. This is necessary + -- for example for the base where we have base-3 depending on base-4. + reallyIsInconsistent :: ([SolverPlanPackage]) -> Bool reallyIsInconsistent [] = False reallyIsInconsistent [_p] = False reallyIsInconsistent [p1, p2] = diff --git a/cabal-install/src/Distribution/Client/Targets.hs b/cabal-install/src/Distribution/Client/Targets.hs index e384f5e28ad..a3b8cd9ce0d 100644 --- a/cabal-install/src/Distribution/Client/Targets.hs +++ b/cabal-install/src/Distribution/Client/Targets.hs @@ -84,7 +84,8 @@ import Distribution.Types.PackageVersionConstraint ) import Distribution.PackageDescription - ( GenericPackageDescription, ComponentName + ( ComponentName + , GenericPackageDescription ) import Distribution.Simple.Utils ( dieWithException @@ -109,6 +110,8 @@ import qualified Data.Map as Map import Distribution.Client.Errors import qualified Distribution.Client.GZipUtils as GZipUtils import qualified Distribution.Compat.CharParsing as P +import Distribution.Solver.Types.ComponentDeps +import Distribution.Types.Dependency import Network.URI ( URI (..) , URIAuth (..) @@ -124,8 +127,6 @@ import System.FilePath , takeDirectory , takeExtension ) -import Distribution.Solver.Types.ComponentDeps -import Distribution.Types.Dependency -- ------------------------------------------------------------ @@ -619,9 +620,7 @@ data UserQualifier UserQualSetup PackageName | -- | Executable dependency. UserQualExe PackageName PackageName - - | - UserQualComp PackageName ComponentName + | UserQualComp PackageName ComponentName deriving (Eq, Show, Generic) instance Binary UserQualifier @@ -650,7 +649,7 @@ fromUserQualifier (UserQualComp pn cn) = IndependentComponent pn (componentNameT fromUserConstraintScope :: UserConstraintScope -> ConstraintScope fromUserConstraintScope (UserQualified q pn) = - ScopeQualified (fromUserQualifier q) pn + ScopeQualified (fromUserQualifier q) QualToplevel pn fromUserConstraintScope (UserPrivateQualifier pn alias cpn) = ScopePrivate pn alias cpn fromUserConstraintScope (UserAnySetupQualifier pn) = ScopeAnySetupQualifier pn fromUserConstraintScope (UserAnyQualifier pn) = ScopeAnyQualifier pn @@ -721,9 +720,9 @@ instance Parsec UserConstraint where | pn == mkPackageName "setup" = UserAnySetupQualifier <$> parsec | pn == mkPackageName "private" = do qpn <- parsec - P.char '.' + _ <- P.char '.' alias <- parsec - P.char ':' + _ <- P.char ':' cpn <- parsec return $ UserPrivateQualifier qpn alias cpn | otherwise = P.unexpected $ "constraint scope: " ++ unPackageName pn diff --git a/cabal-install/src/Distribution/Client/Types/ConfiguredPackage.hs b/cabal-install/src/Distribution/Client/Types/ConfiguredPackage.hs index 0b7d62e7e77..aefb7bee26f 100644 --- a/cabal-install/src/Distribution/Client/Types/ConfiguredPackage.hs +++ b/cabal-install/src/Distribution/Client/Types/ConfiguredPackage.hs @@ -41,7 +41,7 @@ data ConfiguredPackage loc = ConfiguredPackage , confPkgDeps :: CD.ComponentDeps [ConfiguredId] -- ^ set of exact dependencies (installed or source). -- - -- These must be consistent with the 'buildDepends' + -- These must be consistent with the 'buildDepends' and 'privateBuildDepends' -- in the 'PackageDescription' that you'd get by -- applying the flag assignment and optional stanzas. } diff --git a/cabal-install/tests/UnitTests.hs b/cabal-install/tests/UnitTests.hs index 8434f623e82..a7d94e93890 100644 --- a/cabal-install/tests/UnitTests.hs +++ b/cabal-install/tests/UnitTests.hs @@ -24,11 +24,12 @@ import qualified UnitTests.Distribution.Solver.Modular.RetryLog import qualified UnitTests.Distribution.Solver.Modular.Solver import qualified UnitTests.Distribution.Solver.Modular.WeightedPSQ import qualified UnitTests.Distribution.Solver.Types.OptionalStanza +import UnitTests.Options (extraOptions) main :: IO () main = do initTests <- UnitTests.Distribution.Client.Init.tests - defaultMain $ + defaultMainWithIngredients (includingOptions extraOptions : defaultIngredients) $ testGroup "Unit Tests" [ testGroup diff --git a/cabal-install/tests/UnitTests/Distribution/Client/DescribedInstances.hs b/cabal-install/tests/UnitTests/Distribution/Client/DescribedInstances.hs index 7e52d25173f..a1b34671a04 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/DescribedInstances.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/DescribedInstances.hs @@ -8,6 +8,7 @@ import Distribution.Client.Compat.Prelude import Data.List ((\\)) import Distribution.Described +import Distribution.Types.Dependency (PrivateAlias) import Distribution.Types.PackageId (PackageIdentifier) import Distribution.Types.PackageName (PackageName) import Distribution.Types.VersionRange (VersionRange) @@ -164,6 +165,7 @@ instance Described UserConstraint where REUnion [ "any." <> describePN , "setup." <> describePN + , "private." <> describePN <> "." <> describe (Proxy :: Proxy PrivateAlias) <> ":" <> describePN , describePN , describePN <> ":setup." <> describePN ] diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs index 64354af84af..319a5644668 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs @@ -1,8 +1,8 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE PatternSynonyms #-} -- | DSL for testing the modular solver module UnitTests.Distribution.Solver.Modular.DSL @@ -143,6 +143,7 @@ import Distribution.Solver.Types.Variable -------------------------------------------------------------------------------} type ExamplePkgName = String +type ExamplePrivateAlias = String type ExamplePkgVersion = Int type ExamplePkgHash = String -- for example "installed" packages type ExampleFlagName = String @@ -185,35 +186,35 @@ unbuildableDependencies :: Dependencies unbuildableDependencies = mempty{depsIsBuildable = False} pattern ExAny :: ExamplePkgName -> ExampleDependency -pattern ExAny p = ExAnyD False p +pattern ExAny p = ExAnyD Nothing p pattern ExFix :: ExamplePkgName -> ExamplePkgVersion -> ExampleDependency -pattern ExFix p v = ExFixD False p v +pattern ExFix p v = ExFixD Nothing p v pattern ExRange :: ExamplePkgName -> ExamplePkgVersion -> ExamplePkgVersion -> ExampleDependency -pattern ExRange p v1 v2 = ExRangeD False p v1 v2 +pattern ExRange p v1 v2 = ExRangeD Nothing p v1 v2 pattern ExSubLibAny :: ExamplePkgName -> ExampleSubLibName -> ExampleDependency -pattern ExSubLibAny e l = ExSubLibAnyD False e l +pattern ExSubLibAny e l = ExSubLibAnyD Nothing e l pattern ExSubLibFix :: ExamplePkgName -> ExampleSubLibName -> ExamplePkgVersion -> ExampleDependency -pattern ExSubLibFix e l v = ExSubLibFixD False e l v +pattern ExSubLibFix e l v = ExSubLibFixD Nothing e l v -pattern ExAnyPriv :: ExamplePkgName -> ExampleDependency -pattern ExAnyPriv p = ExAnyD True p -pattern ExFixPriv :: ExamplePkgName -> ExamplePkgVersion -> ExampleDependency -pattern ExFixPriv p v = ExFixD True p v +pattern ExAnyPriv :: ExamplePrivateAlias -> ExamplePkgName -> ExampleDependency +pattern ExAnyPriv alias p = ExAnyD (Just alias) p +pattern ExFixPriv :: ExamplePrivateAlias -> ExamplePkgName -> ExamplePkgVersion -> ExampleDependency +pattern ExFixPriv alias p v = ExFixD (Just alias) p v data ExampleDependency = -- | Simple dependency on any version - ExAnyD Bool ExamplePkgName + ExAnyD (Maybe ExamplePrivateAlias) ExamplePkgName | -- | Simple dependency on a fixed version - ExFixD Bool ExamplePkgName ExamplePkgVersion + ExFixD (Maybe ExamplePrivateAlias) ExamplePkgName ExamplePkgVersion | -- | Simple dependency on a range of versions, with an inclusive lower bound -- and an exclusive upper bound. - ExRangeD Bool ExamplePkgName ExamplePkgVersion ExamplePkgVersion + ExRangeD (Maybe ExamplePrivateAlias) ExamplePkgName ExamplePkgVersion ExamplePkgVersion | -- | Sub-library dependency - ExSubLibAnyD Bool ExamplePkgName ExampleSubLibName + ExSubLibAnyD (Maybe ExamplePrivateAlias) ExamplePkgName ExampleSubLibName | -- | Sub-library dependency on a fixed version - ExSubLibFixD Bool ExamplePkgName ExampleSubLibName ExamplePkgVersion + ExSubLibFixD (Maybe ExamplePrivateAlias) ExamplePkgName ExampleSubLibName ExamplePkgVersion | -- | Build-tool-depends dependency ExBuildToolAny ExamplePkgName ExampleExeName | -- | Build-tool-depends dependency on a fixed version @@ -293,13 +294,12 @@ data ExampleQualifier = QualNone | QualIndep ExamplePkgName | QualSetup ExamplePkgName - | -- The two package names are the build target and the package containing the - -- setup script. - QualIndepSetup ExamplePkgName ExamplePkgName | -- The two package names are the package depending on the exe and the -- package containing the exe. QualExe ExamplePkgName ExamplePkgName +-- ROMES:TODO: Add QualPrivateAlias? + -- | Whether to enable tests in all packages in a test case. newtype EnableAllTests = EnableAllTests Bool deriving (BooleanFlag) @@ -606,11 +606,11 @@ exAvSrcPkg ex = extractFlags deps = concatMap go (depsExampleDependencies deps) where go :: ExampleDependency -> [ExampleFlagName] - go (ExAnyD {}) = [] - go (ExFixD {}) = [] - go (ExRangeD {}) = [] - go (ExSubLibAnyD {}) = [] - go (ExSubLibFixD {}) = [] + go (ExAnyD{}) = [] + go (ExFixD{}) = [] + go (ExRangeD{}) = [] + go (ExSubLibAnyD{}) = [] + go (ExSubLibFixD{}) = [] go (ExBuildToolAny _ _) = [] go (ExBuildToolFix _ _ _) = [] go (ExLegacyBuildToolAny _) = [] @@ -640,7 +640,7 @@ exAvSrcPkg ex = mkCondTree mkComponent deps = let (libraryDeps, exts, mlang, pcpkgs, buildTools, legacyBuildTools) = splitTopLevel (depsExampleDependencies deps) (allDirectDeps, flaggedDeps) = splitDeps libraryDeps - (privateDeps, directDeps) = partition (\(_, _, _, is_private) -> is_private) allDirectDeps + (privateDeps, directDeps) = partition (\(_, _, _, is_private) -> isJust is_private) allDirectDeps component = mkComponent (depsVisibility deps) bi bi = mempty @@ -667,16 +667,20 @@ exAvSrcPkg ex = , -- TODO: Arguably, build-tools dependencies should also -- effect constraints on conditional tree. But no way to -- distinguish between them - C.condTreeConstraints = mempty { C.publicDependencies = map mkDirect directDeps - , C.privateDependencies = map mkDirectD privateDeps } + C.condTreeConstraints = + mempty + { C.publicDependencies = map mkDirect directDeps + , C.privateDependencies = map mkDirectD privateDeps + } , C.condTreeComponents = map (mkFlagged mkComponent) flaggedDeps } - mkDirect :: (ExamplePkgName, C.LibraryName, C.VersionRange, Bool) -> C.Dependency + mkDirect :: (ExamplePkgName, C.LibraryName, C.VersionRange, Maybe ExamplePrivateAlias) -> C.Dependency mkDirect (dep, name, vr, _) = C.Dependency (C.mkPackageName dep) vr (NonEmptySet.singleton name) - mkDirectD :: (ExamplePkgName, C.LibraryName, C.VersionRange, Bool) -> C.Dependency - mkDirectD (dep, name, vr, _) = (C.Dependency (C.mkPackageName dep) vr (NonEmptySet.singleton name) ) + mkDirectD :: (ExamplePkgName, C.LibraryName, C.VersionRange, Maybe ExamplePrivateAlias) -> C.PrivateDependency + mkDirectD (dep, name, vr, Just alias) = C.PrivateDependency (C.PrivateAlias (fromString alias)) [C.Dependency (C.mkPackageName dep) vr (NonEmptySet.singleton name)] + mkDirectD (_, _, _, Nothing) = error "mkDirectD: private deps are never Nothing since we partition them by 'isJust' above" mkFlagged :: (C.LibraryVisibility -> C.BuildInfo -> a) @@ -695,11 +699,11 @@ exAvSrcPkg ex = -- guarded by a flag. splitDeps :: [ExampleDependency] - -> ( [(ExamplePkgName, C.LibraryName, C.VersionRange, Bool)] + -> ( [(ExamplePkgName, C.LibraryName, C.VersionRange, Maybe ExamplePrivateAlias)] , [(ExampleFlagName, Dependencies, Dependencies)] ) splitDeps [] = - ([], []) + ([], []) splitDeps (ExAnyD is_priv p : deps) = let (directDeps, flaggedDeps) = splitDeps deps in ((p, C.LMainLibName, C.anyVersion, is_priv) : directDeps, flaggedDeps) @@ -725,7 +729,7 @@ exAvSrcPkg ex = mkSetupDeps deps = case splitDeps deps of (directDeps, []) -> - if any (\(_, _, _, p) -> p) directDeps + if any (\(_, _, _, p) -> isJust p) directDeps then error "mkSetupDeps: custom setup has private deps" else map mkDirect directDeps _ -> error "mkSetupDeps: custom setup has non-simple deps" @@ -871,7 +875,7 @@ exResolve fmap ( \p -> PackageConstraint - (scopeToplevel (C.mkPackageName p)) + (ScopeAnyQualifier (C.mkPackageName p)) (PackagePropertyStanzas [TestStanzas]) ) (exDbPkgs db) diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL/TestCaseUtils.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL/TestCaseUtils.hs index 83f1b981fa0..d3a7b5f2c76 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL/TestCaseUtils.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL/TestCaseUtils.hs @@ -19,6 +19,7 @@ module UnitTests.Distribution.Solver.Modular.DSL.TestCaseUtils , preferences , setVerbose , enableAllTests + , solverResult , solverSuccess , solverFailure , anySolverFailure @@ -47,8 +48,8 @@ import Language.Haskell.Extension (Extension (..), Language (..)) -- cabal-install import Distribution.Client.Dependency (foldProgress) -import qualified Distribution.Solver.Types.PackagePath as P import qualified Distribution.Solver.Types.ComponentDeps as C +import qualified Distribution.Solver.Types.PackagePath as P import Distribution.Solver.Types.PkgConfigDb (PkgConfigDb (..), pkgConfigDbFromList) import Distribution.Solver.Types.Settings import Distribution.Solver.Types.Variable @@ -150,8 +151,11 @@ data SolverResult = SolverResult -- the given plan. } +solverResult :: ([String] -> Bool) -> [(String, Int)] -> SolverResult +solverResult slog r = SolverResult slog (Right r) + solverSuccess :: [(String, Int)] -> SolverResult -solverSuccess = SolverResult (const False) . Right +solverSuccess = SolverResult (const True) . Right solverFailure :: (String -> Bool) -> SolverResult solverFailure = SolverResult (const True) . Left @@ -236,7 +240,7 @@ mkTestExtLangPC exts langs mPkgConfigDb db label targets result = , testConstraints = [] , testUserConstraints = [] , testSoftConstraints = [] - , testVerbosity = verbose + , testVerbosity = normal , testDb = db , testSupportedExts = exts , testSupportedLangs = langs @@ -324,14 +328,7 @@ runTest SolverTest{..} = askOption $ \(OptionShowSolverLog showSolverLog) -> P.PackagePath (P.IndependentComponent (C.mkPackageName s) C.ComponentSetup) (P.QualToplevel) - {- - QualIndepSetup p s -> - P.PackagePath - (P.Independent $ C.mkPackageName p) - (P.QualSetup (C.mkPackageName s)) - -} QualExe p1 p2 -> P.PackagePath (P.IndependentBuildTool (C.mkPackageName p1) (C.mkPackageName p2)) P.QualToplevel - diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs index 3d5db7dfc3e..13faefb5f31 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs @@ -24,6 +24,8 @@ import Distribution.Utils.ShortText (ShortText) import Distribution.Client.Setup (defaultMaxBackjumps) +import Distribution.ModuleName +import Distribution.Types.Dependency (PrivateAlias (..)) import Distribution.Types.LibraryVisibility import Distribution.Types.PackageName import Distribution.Types.UnqualComponentName @@ -34,10 +36,10 @@ import Distribution.Solver.Types.ComponentDeps , ComponentDeps ) import qualified Distribution.Solver.Types.ComponentDeps as CD +import qualified Distribution.Solver.Types.ComponentDeps as P import Distribution.Solver.Types.OptionalStanza import Distribution.Solver.Types.PackageConstraint import qualified Distribution.Solver.Types.PackagePath as P -import qualified Distribution.Solver.Types.ComponentDeps as P import Distribution.Solver.Types.PkgConfigDb ( pkgConfigDbFromList ) @@ -76,7 +78,8 @@ tests = ReverseOrder -> reverse targets in counterexample (showResults r1 r2) $ noneReachedBackjumpLimit [r1, r2] ==> - isRight (resultPlan r1) === isRight (resultPlan r2) + isRight (resultPlan r1) + === isRight (resultPlan r2) , testPropertyWithSeed "solvable without --independent-goals => solvable with --independent-goals" $ \test reorderGoals -> @@ -93,7 +96,8 @@ tests = Nothing in counterexample (showResults r1 r2) $ noneReachedBackjumpLimit [r1, r2] ==> - isRight (resultPlan r1) `implies` isRight (resultPlan r2) + isRight (resultPlan r1) + `implies` isRight (resultPlan r2) , testPropertyWithSeed "backjumping does not affect solvability" $ \test reorderGoals indepGoals -> let r1 = solve' (EnableBackjumping True) test @@ -109,7 +113,8 @@ tests = Nothing in counterexample (showResults r1 r2) $ noneReachedBackjumpLimit [r1, r2] ==> - isRight (resultPlan r1) === isRight (resultPlan r2) + isRight (resultPlan r1) + === isRight (resultPlan r2) , testPropertyWithSeed "fine-grained conflicts does not affect solvability" $ \test reorderGoals indepGoals -> let r1 = solve' (FineGrainedConflicts True) test @@ -125,7 +130,8 @@ tests = Nothing in counterexample (showResults r1 r2) $ noneReachedBackjumpLimit [r1, r2] ==> - isRight (resultPlan r1) === isRight (resultPlan r2) + isRight (resultPlan r1) + === isRight (resultPlan r2) , testPropertyWithSeed "prefer oldest does not affect solvability" $ \test reorderGoals indepGoals -> let r1 = solve' (PreferOldest True) test @@ -141,7 +147,8 @@ tests = Nothing in counterexample (showResults r1 r2) $ noneReachedBackjumpLimit [r1, r2] ==> - isRight (resultPlan r1) === isRight (resultPlan r2) + isRight (resultPlan r1) + === isRight (resultPlan r2) , -- The next two tests use --no-count-conflicts, because the goal order used -- with --count-conflicts depends on the total set of conflicts seen by the -- solver. The solver explores more of the tree and encounters more @@ -166,7 +173,8 @@ tests = Nothing in counterexample (showResults r1 r2) $ noneReachedBackjumpLimit [r1, r2] ==> - resultPlan r1 === resultPlan r2 + resultPlan r1 + === resultPlan r2 , testPropertyWithSeed "fine-grained conflicts does not affect the result (with static goal order)" $ \test reorderGoals indepGoals -> @@ -183,7 +191,8 @@ tests = Nothing in counterexample (showResults r1 r2) $ noneReachedBackjumpLimit [r1, r2] ==> - resultPlan r1 === resultPlan r2 + resultPlan r1 + === resultPlan r2 ] where noneReachedBackjumpLimit :: [Result] -> Bool @@ -620,6 +629,8 @@ instance Hashable OptionalStanza instance Hashable FlagName instance Hashable PackageName instance Hashable ShortText +instance Hashable ModuleName +instance Hashable PrivateAlias deriving instance Generic (Variable pn) deriving instance Generic (P.Qualified a) diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs index bbf55cc7fdb..2df5492ce3d 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs @@ -23,14 +23,14 @@ import Language.Haskell.Extension ) -- cabal-install + +import qualified Distribution.Solver.Types.ComponentDeps as P import Distribution.Solver.Types.Flag import Distribution.Solver.Types.OptionalStanza import Distribution.Solver.Types.PackageConstraint import qualified Distribution.Solver.Types.PackagePath as P -import qualified Distribution.Solver.Types.ComponentDeps as P import UnitTests.Distribution.Solver.Modular.DSL import UnitTests.Distribution.Solver.Modular.DSL.TestCaseUtils -import Debug.Trace tests :: [TF.TestTree] tests = @@ -94,7 +94,7 @@ tests = , testGroup "Qualified manual flag constraints" [ let name = "Top-level flag constraint does not constrain setup dep's flag" - cs = [ExFlagConstraint (ScopeQualified P.DefaultNamespace "B") "flag" False] + cs = [ExFlagConstraint (ScopeQualified P.DefaultNamespace P.QualToplevel "B") "flag" False] in runTest $ constraints cs $ mkTest dbSetupDepWithManualFlag name ["A"] $ @@ -107,7 +107,7 @@ tests = ] , let name = "Solver can toggle setup dep's flag to match top-level constraint" cs = - [ ExFlagConstraint (ScopeQualified P.DefaultNamespace "B") "flag" False + [ ExFlagConstraint (ScopeQualified P.DefaultNamespace P.QualToplevel "B") "flag" False , ExVersionConstraint (ScopeAnyQualifier "b-2-true-dep") V.noVersion ] in runTest $ @@ -122,8 +122,8 @@ tests = ] , let name = "User can constrain flags separately with qualified constraints" cs = - [ ExFlagConstraint (ScopeQualified P.DefaultNamespace "B") "flag" True - , ExFlagConstraint (ScopeQualified (P.IndependentComponent "A" P.ComponentSetup) "B") "flag" False + [ ExFlagConstraint (ScopeQualified P.DefaultNamespace P.QualToplevel "B") "flag" True + , ExFlagConstraint (ScopeQualified (P.IndependentComponent "A" P.ComponentSetup) P.QualToplevel "B") "flag" False ] in runTest $ constraints cs $ @@ -137,15 +137,15 @@ tests = ] , -- Regression test for #4299 let name = "Solver can link deps when only one has constrained manual flag" - cs = [ExFlagConstraint (ScopeQualified P.DefaultNamespace "B") "flag" False] + cs = [ExFlagConstraint (ScopeQualified P.DefaultNamespace P.QualToplevel "B") "flag" False] in runTest $ constraints cs $ mkTest dbLinkedSetupDepWithManualFlag name ["A"] $ solverSuccess [("A", 1), ("B", 1), ("b-1-false-dep", 1)] , let name = "Solver cannot link deps that have conflicting manual flag constraints" cs = - [ ExFlagConstraint (ScopeQualified P.DefaultNamespace "B") "flag" True - , ExFlagConstraint (ScopeQualified (P.IndependentComponent "A" P.ComponentSetup) "B") "flag" False + [ ExFlagConstraint (ScopeQualified P.DefaultNamespace P.QualToplevel "B") "flag" True + , ExFlagConstraint (ScopeQualified (P.IndependentComponent "A" P.ComponentSetup) P.QualToplevel "B") "flag" False ] failureReason = "(constraint from unknown source requires opposite flag selection)" checkFullLog lns = @@ -282,8 +282,8 @@ tests = mkTest dbConstraints "force older versions with unqualified constraint" ["A", "B", "C"] $ solverSuccess [("A", 1), ("B", 2), ("C", 3), ("D", 1), ("D", 2), ("D", 3)] , let cs = - [ ExVersionConstraint (ScopeQualified P.DefaultNamespace "D") $ mkVersionRange 1 4 - , ExVersionConstraint (ScopeQualified (P.IndependentComponent "B" P.ComponentSetup) "D") $ mkVersionRange 4 7 + [ ExVersionConstraint (ScopeQualified P.DefaultNamespace P.QualToplevel "D") $ mkVersionRange 1 4 + , ExVersionConstraint (ScopeQualified (P.IndependentComponent "B" P.ComponentSetup) P.QualToplevel "D") $ mkVersionRange 4 7 ] in runTest $ constraints cs $ @@ -862,13 +862,27 @@ tests = SolverResult (isInfixOf msg) $ Right [("A", 1), ("B", 1)] ] - , testGroup "Private dependencies" - [ runTest privDep1 - , runTest privDep2 - , runTest privDep3 - , runTest privDep4 - , runTest privDep5 - ] + , testGroup + "Private dependencies" + [ runTest privDep1 + , runTest privDep2 + , runTest privDep3 + , runTest privDep4 + , runTest privDep5 + , runTest privDep6 + , runTest privDep7 + , runTest privDep7a + , runTest privDep8 + , runTest privDep8a + , runTest privDep9 + , runTest privDep10 + , runTest privDep11 + , runTest privDep12 + , runTest privDep13 + , runTest privDep14 + , runTest privDep15 + , runTest privDep16 + ] , -- Tests for the contents of the solver's log testGroup "Solver log" @@ -2599,64 +2613,242 @@ setupStanzaTest3 = -- -- Private Dependency tests - -- Test 1: A and B can choose different versions of C because C is a private dependency of A priv_db1 :: ExampleDb -priv_db1 = [ Left $ exInst "C" 1 "C-1" [] - , Left $ exInst "C" 2 "C-2" [] - , Right $ exAv "A" 1 [ExFixPriv "C" 1] - , Right $ exAv "B" 1 [ExFix "C" 2 ] - , Right $ exAv "D" 1 [ExAny "A", ExAny "B"] - ] +priv_db1 = + [ Left $ exInst "C" 1 "C-1" [] + , Left $ exInst "C" 2 "C-2" [] + , Right $ exAv "A" 1 [ExFixPriv "G0" "C" 1] + , Right $ exAv "B" 1 [ExFix "C" 2] + , Right $ exAv "D" 1 [ExAny "A", ExAny "B"] + ] privDep1 :: SolverTest -privDep1 = setVerbose $ mkTest priv_db1 "private-dependencies-1" ["D"] (solverSuccess []) +privDep1 = setVerbose $ mkTest priv_db1 "private-dependencies-1" ["D"] (solverSuccess [("A", 1), ("B", 1), ("D", 1)]) -- Test 2: A depends on both C publically and privately, directly priv_db2 :: ExampleDb -priv_db2 = [ Left $ exInst "C" 1 "C-1" [] - , Right $ exAv "A" 1 [ExFix "C" 1, ExFixPriv "C" 1] - ] +priv_db2 = + [ Left $ exInst "C" 1 "C-1" [] + , Right $ exAv "A" 1 [ExFix "C" 1, ExFixPriv "G0" "C" 1] + ] privDep2 :: SolverTest -privDep2 = setVerbose $ mkTest priv_db2 "private-dependencies-2" ["A"] anySolverFailure +privDep2 = setVerbose $ mkTest priv_db2 "private-dependencies-2" ["A"] (solverSuccess [("A", 1)]) -- Test 3: A depends on both C publically and privately, transitively priv_db3 :: ExampleDb -priv_db3 = [ Left $ exInst "C" 1 "C-1" [] - , Right $ exAv "D" 1 [ExFix "C" 1] - , Right $ exAv "A" 1 [ExFix "D" 1, ExFixPriv "C" 1] - ] +priv_db3 = + [ Left $ exInst "C" 1 "C-1" [] + , Right $ exAv "D" 1 [ExFix "C" 1] + , Right $ exAv "A" 1 [ExFix "D" 1, ExFixPriv "G0" "C" 1] + ] privDep3 :: SolverTest -privDep3 = setVerbose $ mkTest priv_db3 "private-dependencies-3" ["A"] (solverSuccess []) +privDep3 = setVerbose $ mkTest priv_db3 "private-dependencies-3" ["A"] (solverSuccess [("A", 1), ("D", 1)]) --- Test 4: Private dependency applies transitively, so we choose two versions of C and hence two versions of E +-- Test 4: Private dependency do not apply transitively, so we fail because the +-- version of E must match priv_db4 :: ExampleDb -priv_db4 = [ Left $ exInst "E" 1 "E-1" [] - , Left $ exInst "E" 2 "E-2" [] - , Right $ exAv "C" 1 [ ExFix "E" 1 ] - , Right $ exAv "C" 2 [ ExFix "E" 2] - , Right $ exAv "A" 1 [ExFixPriv "C" 1] - , Right $ exAv "B" 1 [ExFix "C" 2 ] - , Right $ exAv "D" 1 [ExAny "A", ExAny "B"] - ] +priv_db4 = + [ Left $ exInst "E" 1 "E-1" [] + , Left $ exInst "E" 2 "E-2" [] + , Right $ exAv "C" 1 [ExFix "E" 1] + , Right $ exAv "C" 2 [ExFix "E" 2] + , Right $ exAv "A" 1 [ExFixPriv "G0" "C" 1] + , Right $ exAv "B" 1 [ExFix "C" 2] + , Right $ exAv "D" 1 [ExAny "A", ExAny "B"] + ] privDep4 :: SolverTest -privDep4 = setVerbose $ mkTest priv_db4 "private-dependencies-4" ["D"] (solverSuccess []) +privDep4 = setVerbose $ mkTest priv_db4 "private-dependencies-4" ["D"] (solverFailure ("(conflict: E==2.0.0/installed-2, A:lib:G0.C => E==1.0.0)" `isInfixOf`)) -- Test 5: Private dependencies and setup dependencies can choose different versions priv_db5 :: ExampleDb -priv_db5 = [ Left $ exInst "E" 1 "E-1" [] - , Left $ exInst "E" 2 "E-2" [] - , Right $ exAv "A" 1 [ExFixPriv "E" 1] `withSetupDeps` [ExFix "E" 2] - ] +priv_db5 = + [ Left $ exInst "E" 1 "E-1" [] + , Left $ exInst "E" 2 "E-2" [] + , Right $ exAv "A" 1 [ExFixPriv "G0" "E" 1] `withSetupDeps` [ExFix "E" 2] + ] privDep5 :: SolverTest -privDep5 = setVerbose $ mkTest priv_db5 "private-dependencies-5" ["A"] (solverSuccess []) +privDep5 = setVerbose $ mkTest priv_db5 "private-dependencies-5" ["A"] (solverSuccess [("A", 1)]) + +-- Private scope, with two dependencies +priv_db6 :: ExampleDb +priv_db6 = + let f1 = exInst "F" 1 "F-1" [] + f2 = exInst "F" 2 "F-2" [] + in [ Left $ exInst "E" 1 "E-1" [f1] + , Left $ exInst "E" 2 "E-2" [f2] + , Left f1 + , Left f2 + , Right $ exAv "A" 1 [ExFix "E" 2, ExFixPriv "G0" "E" 1, ExAnyPriv "G0" "F"] + ] + +privDep6 :: SolverTest +privDep6 = setVerbose $ mkTest priv_db6 "private-dependencies-6" ["A"] (solverSuccess [("A", 1)]) + +-- A dependency structure which violates the closure property for private dependency scopes +priv_db7 :: ExampleDb +priv_db7 = + [ Right $ exAv "A" 1 [ExAny "B"] + , Right $ exAv "B" 1 [ExAny "C"] + , Right $ exAv "C" 1 [] + , Right $ exAv "P" 1 [ExFixPriv "G0" "A" 1, ExAnyPriv "G0" "C"] + ] + +privDep7 :: SolverTest +privDep7 = setVerbose $ mkTest priv_db7 "private-dependencies-7" ["P"] (solverFailure ("private scopes must contain its closure, but package B is not included in the private scope P:lib:G0." `isInfixOf`)) +-- Closure property with external deps +priv_db7a :: ExampleDb +priv_db7a = + let a = exInst "A" 1 "A-1" [b] + b = exInst "B" 1 "B-1" [c] + c = exInst "C" 1 "C-1" [] + in [ Left a + , Left b + , Left c + , Right $ exAv "P" 1 [ExFixPriv "G0" "A" 1, ExAnyPriv "G0" "C"] + ] +privDep7a :: SolverTest +privDep7a = setVerbose $ mkTest priv_db7a "private-dependencies-7a" ["P"] (solverFailure ("private scopes must contain its closure, but package B is not included in the private scope P:lib:G0." `isInfixOf`)) + +priv_db8 :: ExampleDb +priv_db8 = + [ Right $ exAv "A" 1 [ExAny "B"] + , Right $ exAv "B" 1 [ExAny "C"] + , Right $ exAv "C" 1 [] + , Right $ exAv "P" 1 [ExFixPriv "G0" "A" 1, ExAnyPriv "G0" "B", ExAnyPriv "G0" "C"] + ] + +privDep8 :: SolverTest +privDep8 = setVerbose $ mkTest priv_db8 "private-dependencies-8" ["P"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("P", 1)]) + +priv_db8a :: ExampleDb +priv_db8a = + let a = exInst "A" 1 "A-1" [b] + b = exInst "B" 1 "B-1" [c] + c = exInst "C" 1 "C-1" [] + in [ Left a + , Left b + , Left c + , Right $ exAv "P" 1 [ExFixPriv "G0" "A" 1, ExAnyPriv "G0" "B", ExAnyPriv "G0" "C"] + ] + +privDep8a :: SolverTest +privDep8a = setVerbose $ mkTest priv_db8a "private-dependencies-8a" ["P"] (solverSuccess [("P", 1)]) + +-- Two different private scopes can have two different versions +priv_db9 :: ExampleDb +priv_db9 = + let a = exInst "A" 1 "A-1" [] + b = exInst "A" 2 "A-2" [] + in [ Left a + , Left b + , Right $ exAv "P" 1 [ExFixPriv "G0" "A" 1, ExFixPriv "G1" "A" 2] + ] + +privDep9 :: SolverTest +privDep9 = setVerbose $ mkTest priv_db9 "private-dependencies-9" ["P"] (solverSuccess [("P", 1)]) + +-- Backtrack when closure property is violated +priv_db10 :: ExampleDb +priv_db10 = + let a2 = exInst "A" 2 "A-2" [b] + a1 = exInst "A" 1 "A-1" [] + b = exInst "B" 1 "B-1" [c] + c = exInst "C" 1 "C-1" [] + in [ Left a1 + , Left a2 + , Left b + , Left c + , Right $ exAv "P" 1 [ExAnyPriv "G0" "A", ExAnyPriv "G0" "C"] + ] + +privDep10 :: SolverTest +privDep10 = + setVerbose $ + mkTest + priv_db10 + "private-dependencies-10" + ["P"] + (solverResult (any ("private scopes must contain its closure, but package B is not included in the private scope P:lib:G0." `isInfixOf`)) [("P", 1)]) + +-- Testing constraints DON'T apply to private dependencies +priv_db11 :: ExampleDb +priv_db11 = + [ Left (exInst "A" 1 "A-1" []) + , Right $ exAv "P" 1 [ExAnyPriv "G0" "A"] + ] + +privDep11 :: SolverTest +privDep11 = + setVerbose $ + constraints [ExVersionConstraint (ScopeQualified P.DefaultNamespace P.QualToplevel "A") (V.thisVersion (V.mkVersion [2]))] $ + mkTest priv_db11 "private-dependencies-11" ["P"] (solverSuccess [("P", 1)]) + +-- Testing suitably scoped constraints do apply to private dependencies +privDep12 :: SolverTest +privDep12 = + setVerbose $ + constraints [ExVersionConstraint (ScopePrivate "P" "G0" "A") (V.thisVersion (V.mkVersion [2]))] $ + mkTest priv_db11 "private-dependencies-12" ["P"] (solverFailure ("constraint from unknown source requires ==2" `isInfixOf`)) + +-- Testing that `any` qualifier applies to private deps +privDep13 :: SolverTest +privDep13 = + setVerbose $ + constraints [ExVersionConstraint (ScopeAnyQualifier "A") (V.thisVersion (V.mkVersion [2]))] $ + mkTest priv_db11 "private-dependencies-13" ["P"] (solverFailure ("constraint from unknown source requires ==2" `isInfixOf`)) + +-- Testing nested private scopes +priv_db14 :: ExampleDb +priv_db14 = + priv_db6 -- uses A depends on E, F pkg names. + ++ [ Left $ exInst "B" 1 "B-1" [] + , Right $ exAv "P" 1 [ExAnyPriv "G0" "A", ExAnyPriv "G0" "B"] + ] + +privDep14 :: SolverTest +privDep14 = + setVerbose $ + mkTest priv_db14 "private-dependencies-14" ["P"] (solverSuccess [("A", 1), ("P", 1)]) + +-- Testing nested private scopes, where outer private scope includes deps of nested private scope. +priv_db15 :: ExampleDb +priv_db15 = + let f1 = exInst "F" 1 "F-1" [] + f2 = exInst "F" 2 "F-2" [] + in [ Left $ exInst "E" 1 "E-1" [f1] + , Left $ exInst "E" 2 "E-2" [f2] + , Left f1 + , Left f2 + , Right $ exAv "A" 1 [ExFix "E" 2, ExFixPriv "G0" "E" 1, ExAnyPriv "G0" "F"] + , Right $ exAv "P" 1 [ExAnyPriv "G0" "A", ExAnyPriv "G0" "E"] + ] + +privDep15 :: SolverTest +privDep15 = + setVerbose $ + mkTest priv_db15 "private-dependencies-15" ["P"] (solverSuccess [("A", 1), ("P", 1)]) + +privDep16 :: SolverTest +privDep16 = setVerbose $ mkTest priv_db16 "private-dependencies-16" ["A"] (solverSuccess [("A", 1), ("build-tool-pkg", 1), ("build-tool-pkg", 2)]) + +priv_db16 :: ExampleDb +priv_db16 = + [ Right $ exAv "build-tool-pkg" 1 [] `withExe` exExe "build-tool-exe" [] + , Right $ exAv "build-tool-pkg" 2 [] `withExe` exExe "build-tool-exe" [] + , Right $ + exAvNoLibrary "A" 1 + `withExe` exExe + "my-exe" + [ExFix "build-tool-pkg" 1, ExBuildToolFix "build-tool-pkg" "build-tool-exe" 2] + ] -- | Returns true if the second list contains all elements of the first list, in -- order. diff --git a/cabal-hooks-demo/README.md b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/README.md similarity index 83% rename from cabal-hooks-demo/README.md rename to cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/README.md index b4bcfe2a650..bc40cd6f9a5 100644 --- a/cabal-hooks-demo/README.md +++ b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/README.md @@ -1,4 +1,5 @@ -Proof of concept for Cabal hooks compatability scheme +Proof of concept for Cabal hooks compatability scheme, which tests private +dependencies * `lib01` - The library which defines the hooks interface, which can have different versions. diff --git a/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/cabal.project b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/cabal.project new file mode 100644 index 00000000000..e25e053a3c0 --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/cabal.project @@ -0,0 +1 @@ +packages: hooks-exe hooks-lib main-prog diff --git a/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/cabal.test.hs b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/cabal.test.hs new file mode 100644 index 00000000000..de74350e18a --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/cabal.test.hs @@ -0,0 +1,20 @@ +import Test.Cabal.Prelude + +main = + cabalTest $ recordMode DoNotRecord $ + withProjectFile "cabal.project" $ + withRepo "repo" $ do + cabal "build" ["exe:hooks-exe", "--constraint=private.hooks-exe.L01:lib01 == 0.1.0.0"] + exePath <- withPlan $ planExePath "hooks-exe" "hooks-exe" + out1 <- cabal' "run" ["exe:main-prog", "--", exePath] + + assertOutputContains "0.1.0.0" out1 + assertOutputContains "hooks_show: A" out1 + assertOutputContains "hooks_inc: B" out1 + + cabal "build" ["exe:hooks-exe", "--constraint=private.hooks-exe.L01:lib01 == 0.2.0.0"] + out2 <- cabal' "run" ["exe:main-prog", "--", exePath] + + assertOutputContains "0.2.0.0" out2 + assertOutputContains "hooks_show: A {value = 5}" out2 + assertOutputContains "hooks_inc: B" out2 diff --git a/cabal-hooks-demo/hooks-exe/CHANGELOG.md b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/hooks-exe/CHANGELOG.md similarity index 100% rename from cabal-hooks-demo/hooks-exe/CHANGELOG.md rename to cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/hooks-exe/CHANGELOG.md diff --git a/cabal-hooks-demo/hooks-exe/app/Main.hs b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/hooks-exe/app/Main.hs similarity index 93% rename from cabal-hooks-demo/hooks-exe/app/Main.hs rename to cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/hooks-exe/app/Main.hs index c4ab3b1d930..38dc9f85525 100644 --- a/cabal-hooks-demo/hooks-exe/app/Main.hs +++ b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/hooks-exe/app/Main.hs @@ -25,11 +25,11 @@ main = do "show" -> do s <- getContents let a1 :: A = decode s - res <- return $ show a1 + res = show a1 putStr (encode res) "inc" -> do s <- getContents let a1 :: A = decode s - res <- return $ inc a1 + res = inc a1 putStr (encode res) _ -> error "Hook not yet implemented" diff --git a/cabal-hooks-demo/hooks-exe/hooks-exe.cabal b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/hooks-exe/hooks-exe.cabal similarity index 86% rename from cabal-hooks-demo/hooks-exe/hooks-exe.cabal rename to cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/hooks-exe/hooks-exe.cabal index f0fbc11cddf..b03865b863a 100644 --- a/cabal-hooks-demo/hooks-exe/hooks-exe.cabal +++ b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/hooks-exe/hooks-exe.cabal @@ -13,7 +13,7 @@ common warnings executable hooks-exe import: warnings main-is: Main.hs - build-depends: base ^>=4.18.0.0, bytestring, binary, directory + build-depends: base, bytestring, binary, directory private-build-depends: L01 with (lib01) hs-source-dirs: app default-language: Haskell2010 diff --git a/cabal-hooks-demo/hooks-lib/CHANGELOG.md b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/hooks-lib/CHANGELOG.md similarity index 100% rename from cabal-hooks-demo/hooks-lib/CHANGELOG.md rename to cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/hooks-lib/CHANGELOG.md diff --git a/cabal-hooks-demo/hooks-lib/hooks-lib.cabal b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/hooks-lib/hooks-lib.cabal similarity index 82% rename from cabal-hooks-demo/hooks-lib/hooks-lib.cabal rename to cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/hooks-lib/hooks-lib.cabal index c7371abf7c2..bb5efe62961 100644 --- a/cabal-hooks-demo/hooks-lib/hooks-lib.cabal +++ b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/hooks-lib/hooks-lib.cabal @@ -13,7 +13,7 @@ common warnings library import: warnings exposed-modules: HooksLib - build-depends: base ^>=4.18.0.0, lib01 == 0.2.0.0, mtl, process, binary, bytestring, deepseq + build-depends: base, lib01 == 0.2.0.0, mtl, process, binary, bytestring, deepseq private-build-depends: V01 with (lib01 == 0.1.0.0), V02 with (lib01 == 0.2.0.0) hs-source-dirs: src default-language: Haskell2010 diff --git a/cabal-hooks-demo/hooks-lib/src/HooksLib.hs b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/hooks-lib/src/HooksLib.hs similarity index 97% rename from cabal-hooks-demo/hooks-lib/src/HooksLib.hs rename to cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/hooks-lib/src/HooksLib.hs index 038f00bdac9..aae813b46f5 100644 --- a/cabal-hooks-demo/hooks-lib/src/HooksLib.hs +++ b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/hooks-lib/src/HooksLib.hs @@ -68,14 +68,14 @@ revertA2 L2.B = L.B hooks_show :: L.A -> HooksM String hooks_show a = do - ver <- hooksVersion <$> ask + ver <- asks hooksVersion case ver of V01 -> readHooksExe "show" (convertA1 a) V02 -> readHooksExe "show" (convertA2 a) hooks_inc :: L.A -> HooksM L.A hooks_inc a = do - ver <- hooksVersion <$> ask + ver <- asks hooksVersion case ver of V01 -> revertA1 <$> (readHooksExe "inc" (convertA1 a)) V02 -> revertA2 <$> (readHooksExe "inc" (convertA2 a)) @@ -88,7 +88,7 @@ hooks_inc a = do readHooksExe :: (Binary a, Binary b) => String -> a -> HooksM b readHooksExe hook args = do - exe <- hooksExe <$> ask + exe <- asks hooksExe liftIO $ readHooksExe_ exe hook args withForkWait :: IO () -> (IO () -> IO a) -> IO a diff --git a/cabal-hooks-demo/hooks-lib/src/MyLib.hs b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/hooks-lib/src/MyLib.hs similarity index 100% rename from cabal-hooks-demo/hooks-lib/src/MyLib.hs rename to cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/hooks-lib/src/MyLib.hs diff --git a/cabal-hooks-demo/main-prog/CHANGELOG.md b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/main-prog/CHANGELOG.md similarity index 100% rename from cabal-hooks-demo/main-prog/CHANGELOG.md rename to cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/main-prog/CHANGELOG.md diff --git a/cabal-hooks-demo/main-prog/app/Main.hs b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/main-prog/app/Main.hs similarity index 81% rename from cabal-hooks-demo/main-prog/app/Main.hs rename to cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/main-prog/app/Main.hs index 94d6019e0b3..8cd9037f565 100644 --- a/cabal-hooks-demo/main-prog/app/Main.hs +++ b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/main-prog/app/Main.hs @@ -6,10 +6,12 @@ import System.Directory import Lib import HooksLib import Control.Monad.IO.Class +import System.Environment main :: IO () main = do - Just hooks_exe <- findExecutable "hooks-exe" + -- Receive the path to the hooks_exe as an argument + [hooks_exe] <- getArgs withHooksExe hooks_exe $ do liftIO $ putStr "hooks_show: " rendered <- hooks_show (A 5) diff --git a/cabal-hooks-demo/main-prog/main-prog.cabal b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/main-prog/main-prog.cabal similarity index 85% rename from cabal-hooks-demo/main-prog/main-prog.cabal rename to cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/main-prog/main-prog.cabal index b1da77699f6..56f5ddfa5e5 100644 --- a/cabal-hooks-demo/main-prog/main-prog.cabal +++ b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/main-prog/main-prog.cabal @@ -13,6 +13,6 @@ common warnings executable main-prog import: warnings main-is: Main.hs - build-depends: base ^>=4.18.0.0, lib01, directory, hooks-lib + build-depends: base, lib01, directory, hooks-lib hs-source-dirs: app default-language: Haskell2010 diff --git a/cabal-hooks-demo/lib-0.1/CHANGELOG.md b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/repo/lib01-0.1.0.0/CHANGELOG.md similarity index 100% rename from cabal-hooks-demo/lib-0.1/CHANGELOG.md rename to cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/repo/lib01-0.1.0.0/CHANGELOG.md diff --git a/cabal-hooks-demo/lib-0.1/lib01.cabal b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/repo/lib01-0.1.0.0/lib01.cabal similarity index 89% rename from cabal-hooks-demo/lib-0.1/lib01.cabal rename to cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/repo/lib01-0.1.0.0/lib01.cabal index 41badc0247e..1fc1ad750b9 100644 --- a/cabal-hooks-demo/lib-0.1/lib01.cabal +++ b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/repo/lib01-0.1.0.0/lib01.cabal @@ -13,6 +13,6 @@ common warnings library import: warnings exposed-modules: Lib - build-depends: base ^>=4.18.0.0, binary + build-depends: base, binary hs-source-dirs: src default-language: Haskell2010 diff --git a/cabal-hooks-demo/lib-0.1/src/Lib.hs b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/repo/lib01-0.1.0.0/src/Lib.hs similarity index 100% rename from cabal-hooks-demo/lib-0.1/src/Lib.hs rename to cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/repo/lib01-0.1.0.0/src/Lib.hs diff --git a/cabal-hooks-demo/lib-0.2/CHANGELOG.md b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/repo/lib01-0.2.0.0/CHANGELOG.md similarity index 100% rename from cabal-hooks-demo/lib-0.2/CHANGELOG.md rename to cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/repo/lib01-0.2.0.0/CHANGELOG.md diff --git a/cabal-hooks-demo/lib-0.2/lib01.cabal b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/repo/lib01-0.2.0.0/lib01.cabal similarity index 89% rename from cabal-hooks-demo/lib-0.2/lib01.cabal rename to cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/repo/lib01-0.2.0.0/lib01.cabal index 1fdb9fe3cd3..da908f3f043 100644 --- a/cabal-hooks-demo/lib-0.2/lib01.cabal +++ b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/repo/lib01-0.2.0.0/lib01.cabal @@ -13,6 +13,6 @@ common warnings library import: warnings exposed-modules: Lib - build-depends: base ^>=4.18.0.0, binary + build-depends: base, binary hs-source-dirs: src default-language: Haskell2010 diff --git a/cabal-hooks-demo/lib-0.2/src/Lib.hs b/cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/repo/lib01-0.2.0.0/src/Lib.hs similarity index 100% rename from cabal-hooks-demo/lib-0.2/src/Lib.hs rename to cabal-testsuite/PackageTests/PrivateDeps/cabal-hooks-demo/repo/lib01-0.2.0.0/src/Lib.hs diff --git a/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/README.md b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/README.md new file mode 100644 index 00000000000..573957a03fa --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/README.md @@ -0,0 +1,30 @@ +Closure property test + +package a-0.1 + :private-build-depends: G0 with (b, d) + +package a-0.2 + :build-depends: c + :private-build-depends: G0 with (b, d) + +package b-0.1 + :build-depends: x + +package b-0.2 + :build-depends: x, d + +package b-0.3 + :build-depends: x, c, d + +package c-0.1 + :build-depends: x + +package c-0.2 + :build-depends: x, d + + +Closure property violated by `b == 0.3` and `c == 0.2` THEN closure property is violated. + +Need to be able to implicitly introduce c into the private scope so that the closure property holds. +Or otherwise pick an older version of C which does not depend on D + diff --git a/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/cabal.project.1 b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/cabal.project.1 new file mode 100644 index 00000000000..1d6fdeb5c43 --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/cabal.project.1 @@ -0,0 +1 @@ +packages: libA-0.1.0.0 diff --git a/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/cabal.project.2 b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/cabal.project.2 new file mode 100644 index 00000000000..6a6ab0dcb42 --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/cabal.project.2 @@ -0,0 +1 @@ +packages: libA-0.2.0.0 diff --git a/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/cabal.project.3 b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/cabal.project.3 new file mode 100644 index 00000000000..50ad944ca45 --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/cabal.project.3 @@ -0,0 +1 @@ +packages: libA-0.3.0.0 diff --git a/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/cabal.project.4 b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/cabal.project.4 new file mode 100644 index 00000000000..a62ce97ac49 --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/cabal.project.4 @@ -0,0 +1 @@ +packages: libA-0.4.0.0 diff --git a/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/cabal.test.hs b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/cabal.test.hs new file mode 100644 index 00000000000..13215233402 --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/cabal.test.hs @@ -0,0 +1,29 @@ +import Test.Cabal.Prelude + +main = do + cabalTest $ recordMode DoNotRecord $ do + + -- Will violate closure property + withProjectFile "cabal.project.1" $ + withRepo "repo" $ + fails (cabal' "v2-build" ["libA"]) + >>= assertOutputContains "private scopes must contain its closure, but package libC is not included in the private scope libA:lib:G0" + + -- Must pick libC == 0.1 + withProjectFile "cabal.project.2" $ + withRepo "repo" $ + cabal' "v2-build" ["libA"] + >>= assertOutputContains "libC-0.1.0.0" + + -- Shouldn't pick libB == 0.3 because it violates closure property + withProjectFile "cabal.project.3" $ + withRepo "repo" $ + cabal' "v2-build" ["libA"] + >>= assertOutputDoesNotContain "libB-0.3.0.0" + + -- Will be OKay with libB == 0.3 and libC == 0.2 because libC is in the closure + withProjectFile "cabal.project.4" $ + withRepo "repo" $ do + o <- cabal' "v2-build" ["libA"] + assertOutputContains "libC-0.2.0.0" o + assertOutputContains "libB-0.3.0.0" o diff --git a/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/libA-0.1.0.0/MyLib.hs b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/libA-0.1.0.0/MyLib.hs new file mode 100644 index 00000000000..dc2cb96275e --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/libA-0.1.0.0/MyLib.hs @@ -0,0 +1,3 @@ +module MyLib (someFunc) where + +someFunc = "" diff --git a/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/libA-0.1.0.0/libA.cabal b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/libA-0.1.0.0/libA.cabal new file mode 100644 index 00000000000..f92995fdacf --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/libA-0.1.0.0/libA.cabal @@ -0,0 +1,13 @@ +cabal-version: 3.0 +name: libA +version: 0.1.0.0 +license: NONE +build-type: Simple + +library + exposed-modules: MyLib + -- Will violate closure property + private-build-depends: G0 with (libB == 0.1.0.0,libD) + hs-source-dirs: . + default-language: Haskell2010 + default-extensions: NoImplicitPrelude diff --git a/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/libA-0.2.0.0/MyLib.hs b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/libA-0.2.0.0/MyLib.hs new file mode 100644 index 00000000000..6c63822a95f --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/libA-0.2.0.0/MyLib.hs @@ -0,0 +1,3 @@ +module MyLib (someFunc) where + +someFunc = "someFunc" diff --git a/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/libA-0.2.0.0/libA.cabal b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/libA-0.2.0.0/libA.cabal new file mode 100644 index 00000000000..56bdf19a058 --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/libA-0.2.0.0/libA.cabal @@ -0,0 +1,14 @@ +cabal-version: 3.0 +name: libA +version: 0.2.0.0 +license: NONE +build-type: Simple + +library + exposed-modules: MyLib + build-depends: libC + -- Must pick libC == 0.1 + private-build-depends: G0 with (libB == 0.2.0.0,libD) + hs-source-dirs: . + default-language: Haskell2010 + default-extensions: NoImplicitPrelude diff --git a/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/libA-0.3.0.0/MyLib.hs b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/libA-0.3.0.0/MyLib.hs new file mode 100644 index 00000000000..6c63822a95f --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/libA-0.3.0.0/MyLib.hs @@ -0,0 +1,3 @@ +module MyLib (someFunc) where + +someFunc = "someFunc" diff --git a/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/libA-0.3.0.0/libA.cabal b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/libA-0.3.0.0/libA.cabal new file mode 100644 index 00000000000..90f84cd5a36 --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/libA-0.3.0.0/libA.cabal @@ -0,0 +1,14 @@ +cabal-version: 3.0 +name: libA +version: 0.3.0.0 +license: NONE +build-type: Simple + +library + exposed-modules: MyLib + build-depends: libC + -- Shouldn't pick libB == 0.3 because it violates closure property + private-build-depends: G0 with (libB,libD) + hs-source-dirs: . + default-language: Haskell2010 + default-extensions: NoImplicitPrelude diff --git a/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/libA-0.4.0.0/MyLib.hs b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/libA-0.4.0.0/MyLib.hs new file mode 100644 index 00000000000..6c63822a95f --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/libA-0.4.0.0/MyLib.hs @@ -0,0 +1,3 @@ +module MyLib (someFunc) where + +someFunc = "someFunc" diff --git a/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/libA-0.4.0.0/libA.cabal b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/libA-0.4.0.0/libA.cabal new file mode 100644 index 00000000000..ec556d108ac --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/libA-0.4.0.0/libA.cabal @@ -0,0 +1,13 @@ +cabal-version: 3.0 +name: libA +version: 0.4.0.0 +license: NONE +build-type: Simple + +library + exposed-modules: MyLib + -- Will be OKay with libB == 0.3 and libC == 0.2 because libC is in the closure + private-build-depends: G0 with (libB == 0.3.0.0, libC, libD) + hs-source-dirs: . + default-language: Haskell2010 + default-extensions: NoImplicitPrelude diff --git a/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libB-0.1.0.0/MyLib.hs b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libB-0.1.0.0/MyLib.hs new file mode 100644 index 00000000000..6c63822a95f --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libB-0.1.0.0/MyLib.hs @@ -0,0 +1,3 @@ +module MyLib (someFunc) where + +someFunc = "someFunc" diff --git a/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libB-0.1.0.0/libB.cabal b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libB-0.1.0.0/libB.cabal new file mode 100644 index 00000000000..0b368f60db2 --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libB-0.1.0.0/libB.cabal @@ -0,0 +1,12 @@ +cabal-version: 3.0 +name: libB +version: 0.1.0.0 +license: NONE +build-type: Simple + +library + exposed-modules: MyLib + build-depends: libC == 0.2.0.0 + hs-source-dirs: . + default-language: Haskell2010 + default-extensions: NoImplicitPrelude diff --git a/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libB-0.2.0.0/MyLib.hs b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libB-0.2.0.0/MyLib.hs new file mode 100644 index 00000000000..6c63822a95f --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libB-0.2.0.0/MyLib.hs @@ -0,0 +1,3 @@ +module MyLib (someFunc) where + +someFunc = "someFunc" diff --git a/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libB-0.2.0.0/libB.cabal b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libB-0.2.0.0/libB.cabal new file mode 100644 index 00000000000..010de751424 --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libB-0.2.0.0/libB.cabal @@ -0,0 +1,12 @@ +cabal-version: 3.0 +name: libB +version: 0.2.0.0 +license: NONE +build-type: Simple + +library + exposed-modules: MyLib + build-depends: libC + hs-source-dirs: . + default-language: Haskell2010 + default-extensions: NoImplicitPrelude diff --git a/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libB-0.3.0.0/MyLib.hs b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libB-0.3.0.0/MyLib.hs new file mode 100644 index 00000000000..6c63822a95f --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libB-0.3.0.0/MyLib.hs @@ -0,0 +1,3 @@ +module MyLib (someFunc) where + +someFunc = "someFunc" diff --git a/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libB-0.3.0.0/libB.cabal b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libB-0.3.0.0/libB.cabal new file mode 100644 index 00000000000..cb0ff52869e --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libB-0.3.0.0/libB.cabal @@ -0,0 +1,12 @@ +cabal-version: 3.0 +name: libB +version: 0.3.0.0 +license: NONE +build-type: Simple + +library + exposed-modules: MyLib + build-depends: libC == 0.2.0.0, libD + hs-source-dirs: . + default-language: Haskell2010 + default-extensions: NoImplicitPrelude diff --git a/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libC-0.1.0.0/MyLib.hs b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libC-0.1.0.0/MyLib.hs new file mode 100644 index 00000000000..6c63822a95f --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libC-0.1.0.0/MyLib.hs @@ -0,0 +1,3 @@ +module MyLib (someFunc) where + +someFunc = "someFunc" diff --git a/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libC-0.1.0.0/libC.cabal b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libC-0.1.0.0/libC.cabal new file mode 100644 index 00000000000..abb9ae3482a --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libC-0.1.0.0/libC.cabal @@ -0,0 +1,11 @@ +cabal-version: 3.0 +name: libC +version: 0.1.0.0 +license: NONE +build-type: Simple + +library + exposed-modules: MyLib + hs-source-dirs: . + default-language: Haskell2010 + default-extensions: NoImplicitPrelude diff --git a/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libC-0.2.0.0/MyLib.hs b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libC-0.2.0.0/MyLib.hs new file mode 100644 index 00000000000..6c63822a95f --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libC-0.2.0.0/MyLib.hs @@ -0,0 +1,3 @@ +module MyLib (someFunc) where + +someFunc = "someFunc" diff --git a/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libC-0.2.0.0/libC.cabal b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libC-0.2.0.0/libC.cabal new file mode 100644 index 00000000000..3dd472acc3a --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libC-0.2.0.0/libC.cabal @@ -0,0 +1,12 @@ +cabal-version: 3.0 +name: libC +version: 0.2.0.0 +license: NONE +build-type: Simple + +library + exposed-modules: MyLib + build-depends: libD + hs-source-dirs: . + default-language: Haskell2010 + default-extensions: NoImplicitPrelude diff --git a/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libD-0.1.0.0/MyLib.hs b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libD-0.1.0.0/MyLib.hs new file mode 100644 index 00000000000..6c63822a95f --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libD-0.1.0.0/MyLib.hs @@ -0,0 +1,3 @@ +module MyLib (someFunc) where + +someFunc = "someFunc" diff --git a/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libD-0.1.0.0/libD.cabal b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libD-0.1.0.0/libD.cabal new file mode 100644 index 00000000000..117350487c7 --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/closure-property-test/repo/libD-0.1.0.0/libD.cabal @@ -0,0 +1,11 @@ +cabal-version: 3.0 +name: libD +version: 0.1.0.0 +license: NONE +build-type: Simple + +library + exposed-modules: MyLib + hs-source-dirs: . + default-language: Haskell2010 + default-extensions: NoImplicitPrelude diff --git a/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/README.md b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/README.md new file mode 100644 index 00000000000..57d9e02f886 --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/README.md @@ -0,0 +1,15 @@ +Backpack + Private Dependencies test + +exeA + main-is: Main.hs + private-build-depends: G1 with (libB == 0.1.0.0) + private-build-depends: G2 with (libB == 0.2.0.0) + build-depends: libB == 0.3.0.0 + mixins: + libA (A as A.G1) requires (AHole as G1.Fill) + libA (A as A.G2) requires (AHole as G2.Fill) + libA (A as A.NoScope) requires (AHole as Fill) + +libA + exposed-modules: A + signatures: AHole diff --git a/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/cabal.project b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/cabal.project new file mode 100644 index 00000000000..827fcfc78cf --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/cabal.project @@ -0,0 +1 @@ +packages: libA diff --git a/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/cabal.test.hs b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/cabal.test.hs new file mode 100644 index 00000000000..c740c372052 --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/cabal.test.hs @@ -0,0 +1,9 @@ +import Test.Cabal.Prelude + +main = + cabalTest $ + expectBroken 0 $ + withProjectFile "cabal.project" $ + withRepo "repo" $ + cabal "v2-build" ["libA"] + diff --git a/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/libA/app/Main.hs b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/libA/app/Main.hs new file mode 100644 index 00000000000..6d78a77a66a --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/libA/app/Main.hs @@ -0,0 +1,8 @@ +import qualified A.G1 +import qualified A.G2 +import qualified A.NoScope + +main = do + print (A.G1.fillhole) + print (A.G2.fillhole) + print (A.NoScope.fillhole) diff --git a/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/libA/libA.cabal b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/libA/libA.cabal new file mode 100644 index 00000000000..4e9ec21c5cb --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/libA/libA.cabal @@ -0,0 +1,22 @@ +cabal-version: 3.0 +name: libA +version: 0.1.0.0 +license: NONE +build-type: Simple + +executable exeA + main-is: Main.hs + build-depends: libA, libB == 0.3.0.0 + private-build-depends: G1 with (libB == 0.1.0.0) + private-build-depends: G2 with (libB == 0.2.0.0) + mixins: + libA (A as A.G1) requires (AHole as G1.Fill), + libA (A as A.G2) requires (AHole as G2.Fill), + libA (A as A.NoScope) requires (AHole as Fill) + default-extensions: NoImplicitPrelude + +library + exposed-modules: A + signatures: AHole + hs-source-dirs: src + default-extensions: NoImplicitPrelude diff --git a/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/libA/src/A.hs b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/libA/src/A.hs new file mode 100644 index 00000000000..d1a60e710e2 --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/libA/src/A.hs @@ -0,0 +1,3 @@ +module A (fillhole) where + +import AHole (fillhole) diff --git a/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/libA/src/AHole.hsig b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/libA/src/AHole.hsig new file mode 100644 index 00000000000..9ceafbd086e --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/libA/src/AHole.hsig @@ -0,0 +1,3 @@ +signature AHole where + +fillhole :: Int diff --git a/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/repo/libB-0.1.0.0/Fill.hs b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/repo/libB-0.1.0.0/Fill.hs new file mode 100644 index 00000000000..fef98a6ce08 --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/repo/libB-0.1.0.0/Fill.hs @@ -0,0 +1,4 @@ +module Fill where + +fillhole :: Int +fillhole = 1 diff --git a/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/repo/libB-0.1.0.0/libB.cabal b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/repo/libB-0.1.0.0/libB.cabal new file mode 100644 index 00000000000..e5937452a61 --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/repo/libB-0.1.0.0/libB.cabal @@ -0,0 +1,10 @@ +cabal-version: 3.0 +name: libB +version: 0.1.0.0 +license: NONE +build-type: Simple + +library + exposed-modules: Fill + default-language: Haskell2010 + default-extensions: NoImplicitPrelude diff --git a/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/repo/libB-0.1.0.0/tags b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/repo/libB-0.1.0.0/tags new file mode 100644 index 00000000000..1a01b2d1ce5 --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/repo/libB-0.1.0.0/tags @@ -0,0 +1,2 @@ +!_TAG_FILE_SORTED 1 // +fillhole Fill.hs 3;" f diff --git a/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/repo/libB-0.2.0.0/Fill.hs b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/repo/libB-0.2.0.0/Fill.hs new file mode 100644 index 00000000000..fd4cd35d6d6 --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/repo/libB-0.2.0.0/Fill.hs @@ -0,0 +1,4 @@ +module Fill where + +fillhole :: Int +fillhole = 2 diff --git a/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/repo/libB-0.2.0.0/libB.cabal b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/repo/libB-0.2.0.0/libB.cabal new file mode 100644 index 00000000000..0f8cd48746f --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/repo/libB-0.2.0.0/libB.cabal @@ -0,0 +1,10 @@ +cabal-version: 3.0 +name: libB +version: 0.2.0.0 +license: NONE +build-type: Simple + +library + exposed-modules: Fill + default-language: Haskell2010 + default-extensions: NoImplicitPrelude diff --git a/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/repo/libB-0.2.0.0/tags b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/repo/libB-0.2.0.0/tags new file mode 100644 index 00000000000..1a01b2d1ce5 --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/repo/libB-0.2.0.0/tags @@ -0,0 +1,2 @@ +!_TAG_FILE_SORTED 1 // +fillhole Fill.hs 3;" f diff --git a/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/repo/libB-0.3.0.0/Fill.hs b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/repo/libB-0.3.0.0/Fill.hs new file mode 100644 index 00000000000..234f38660cb --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/repo/libB-0.3.0.0/Fill.hs @@ -0,0 +1,4 @@ +module Fill where + +fillhole :: Int +fillhole = 3 diff --git a/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/repo/libB-0.3.0.0/libB.cabal b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/repo/libB-0.3.0.0/libB.cabal new file mode 100644 index 00000000000..5f7b5cc4f98 --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/repo/libB-0.3.0.0/libB.cabal @@ -0,0 +1,10 @@ +cabal-version: 3.0 +name: libB +version: 0.3.0.0 +license: NONE +build-type: Simple + +library + exposed-modules: Fill + default-language: Haskell2010 + default-extensions: NoImplicitPrelude diff --git a/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/repo/libB-0.3.0.0/tags b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/repo/libB-0.3.0.0/tags new file mode 100644 index 00000000000..1a01b2d1ce5 --- /dev/null +++ b/cabal-testsuite/PackageTests/PrivateDeps/pd-backpack/repo/libB-0.3.0.0/tags @@ -0,0 +1,2 @@ +!_TAG_FILE_SORTED 1 // +fillhole Fill.hs 3;" f diff --git a/cabal-testsuite/PackageTests/WarnEarlyOverwrite/clean-install-by-copy.test.hs b/cabal-testsuite/PackageTests/WarnEarlyOverwrite/clean-install-by-copy.test.hs index 7395d2abca7..710878ce1f0 100644 --- a/cabal-testsuite/PackageTests/WarnEarlyOverwrite/clean-install-by-copy.test.hs +++ b/cabal-testsuite/PackageTests/WarnEarlyOverwrite/clean-install-by-copy.test.hs @@ -11,4 +11,4 @@ main = cabalTest $ withShorterPathForNewBuildStore $ do -- +Warning: The directory /incoming/new-2448/Users/RUNNER~1/AppData/Local/Temp/cabal-test-store-28260/ghc-/WarnEarlyOver_-0.1.0.0-4c19059e06a32b93b2812983631117e77a2d3833/bin is not in the system search path. -- +Copying 'warn-early-overwrite' to '' skipIfWindows - cabalG options "v2-install" ["--install-method=copy"] \ No newline at end of file + cabalG options "v2-install" ["--install-method=copy"] diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index 87a30c867fa..54eefc8d8b9 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -379,7 +379,9 @@ runPlanExe' pkg_name cname args = do recordHeader [pkg_name, cname] runM exePath args Nothing -planExePath :: String {- package name -} -> String {- component name -} +-- | Get the path to an executable built from a package. Requires 'withPlan' +-- to have been run so that we can find the dist dir. +planExePath :: String {-^ package name -} -> String {-^ component name -} -> TestM FilePath planExePath pkg_name cname = do Just plan <- testPlan `fmap` getTestEnv @@ -1105,7 +1107,7 @@ findDependencyInStore :: String -- ^package name prefix findDependencyInStore pkgName = do storeDir <- testStoreDir <$> getTestEnv liftIO $ do - storeDirForGhcVersion <- head <$> listDirectory storeDir + (storeDirForGhcVersion:_) <- listDirectory storeDir packageDirs <- listDirectory (storeDir storeDirForGhcVersion) -- Ideally, we should call 'hashedInstalledPackageId' from 'Distribution.Client.PackageHash'. -- But 'PackageHashInputs', especially 'PackageHashConfigInputs', is too hard to construct. diff --git a/cabal.project b/cabal.project index 4acbfedded3..ad6e8bf419f 100644 --- a/cabal.project +++ b/cabal.project @@ -1,7 +1,7 @@ import: cabal.project.latest-ghc packages: Cabal/ ---packages: cabal-testsuite/ +packages: cabal-testsuite/ packages: Cabal-syntax/ packages: cabal-install/ packages: cabal-install-solver/ @@ -27,3 +27,4 @@ constraints: these -assoc program-options ghc-options: -fno-ignore-asserts +allow-newer: tracetree:* diff --git a/doc/buildinfo-fields-reference.rst b/doc/buildinfo-fields-reference.rst index 338bbddbc11..58ca8c6a915 100644 --- a/doc/buildinfo-fields-reference.rst +++ b/doc/buildinfo-fields-reference.rst @@ -510,6 +510,13 @@ pkgconfig-depends .. math:: \mathrm{commalist}\mathsf{\color{red}{TODO}} +private-build-depends + * Monoidal field + * Documentation of :pkg-field:`library:private-build-depends` + + .. math:: + \mathrm{commalist}\left(\mathop{\mathit{alias}}\bullet\mathop{\mathord{``}\mathtt{with}\mathord{"}}\bullet\mathop{\mathord{``}\mathtt{\text{(}}\mathord{"}}\circ{\left(\mathop{\mathit{pkg\text{-}name}}{\left(\mathop{\mathord{``}\mathtt{\text{:}}\mathord{"}}\left\{ \mathop{\mathit{unqual\text{-}name}}\mid\mathop{\mathord{``}\mathtt{\{}\mathord{"}}\circ{\mathop{\mathit{unqual\text{-}name}}}^+_{\left(\circ\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}\circ\right)}\circ\mathop{\mathord{``}\mathtt{\}}\mathord{"}} \right\}\right)}^?{\left(\circ\mathop{\mathit{version\text{-}range}}\right)}^?\right)}^\ast_{\left(\circ\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}\circ\right)}\circ\mathop{\mathord{``}\mathtt{\text{)}}\mathord{"}}\right) + virtual-modules * Monoidal field * Available since ``cabal-version: 2.2``.