7 patches for repository darcs.haskell.org:/srv/darcs/cabal: Tue Feb 7 20:39:58 CET 2012 Thomas Tuegel * Handle test and benchmark dependencies through the resolver properly. Previously, test and benchmark dependencies were handled by editing the package description to include or exclude those stanzas before running the dependency resolver. Test and benchmark dependencies could only be installed for source packages because no package description is available for named packages before dependency resolution. Now, test and benchmark stanzas are enabled or disabled through constraints passed to the dependency resolver. This way, we can install dependencies for the test suites of target packages without propagating '--enable-tests' through the entire dependency tree; i.e., tests and benchmarks, when enabled, are built only for target packages. Later, this will allow us to automatically run test suites and, e.g., install only upon their success. Tue Feb 7 20:45:43 CET 2012 Thomas Tuegel * Update types in modular dependency solver to compile with new test/benchmark dependency constraints. Tue Feb 7 20:48:52 CET 2012 Thomas Tuegel * Don't build benchmarks, even if installing benchmark dependencies. Wed Feb 8 07:57:01 CET 2012 Thomas Tuegel * Enable tests and benchmarks in cabal-install without modifications to the Cabal library. Sat Feb 11 16:41:19 CET 2012 Andres Loeh * Added a missing case. Sat Feb 11 16:59:29 CET 2012 Andres Loeh * show optional stanzas when printing install plans Sun Feb 12 12:35:24 CET 2012 Andres Loeh * stanza support in modular solver New patches: [Handle test and benchmark dependencies through the resolver properly. Thomas Tuegel **20120207193958 Ignore-this: 99e675795396fc9f64741417f6d7afd5 Previously, test and benchmark dependencies were handled by editing the package description to include or exclude those stanzas before running the dependency resolver. Test and benchmark dependencies could only be installed for source packages because no package description is available for named packages before dependency resolution. Now, test and benchmark stanzas are enabled or disabled through constraints passed to the dependency resolver. This way, we can install dependencies for the test suites of target packages without propagating '--enable-tests' through the entire dependency tree; i.e., tests and benchmarks, when enabled, are built only for target packages. Later, this will allow us to automatically run test suites and, e.g., install only upon their success. ] { hunk ./cabal-install/Distribution/Client/BuildReports/Anonymous.hs 125 new :: OS -> Arch -> CompilerId -- -> Version -> ConfiguredPackage -> BR.BuildResult -> BuildReport -new os' arch' comp (ConfiguredPackage pkg flags deps) result = +new os' arch' comp (ConfiguredPackage pkg flags _ deps) result = BuildReport { package = packageId pkg, os = os', hunk ./cabal-install/Distribution/Client/BuildReports/Storage.hs 120 fromPlanPackage (Platform arch os) comp planPackage = case planPackage of InstallPlan.Installed pkg@(ConfiguredPackage (SourcePackage { - packageSource = RepoTarballPackage repo _ _ }) _ _) result + packageSource = RepoTarballPackage repo _ _ }) _ _ _) result -> Just $ (BuildReport.new os arch comp pkg (Right result), repo) InstallPlan.Failed pkg@(ConfiguredPackage (SourcePackage { hunk ./cabal-install/Distribution/Client/BuildReports/Storage.hs 124 - packageSource = RepoTarballPackage repo _ _ }) _ _) result + packageSource = RepoTarballPackage repo _ _ }) _ _ _) result -> Just $ (BuildReport.new os arch comp pkg (Left result), repo) _ -> Nothing hunk ./cabal-install/Distribution/Client/Configure.hs 85 configureCommand (const configFlags) extraArgs Right installPlan -> case InstallPlan.ready installPlan of - [pkg@(ConfiguredPackage (SourcePackage _ _ (LocalUnpackedPackage _)) _ _)] -> + [pkg@(ConfiguredPackage (SourcePackage _ _ (LocalUnpackedPackage _)) _ _ _)] -> configurePackage verbosity (InstallPlan.planPlatform installPlan) (InstallPlan.planCompiler installPlan) hunk ./cabal-install/Distribution/Client/Configure.hs 180 -> [String] -> IO () configurePackage verbosity platform comp scriptOptions configFlags - (ConfiguredPackage (SourcePackage _ gpkg _) flags deps) extraArgs = + (ConfiguredPackage (SourcePackage _ gpkg _) flags stanzas deps) extraArgs = setupWrapper verbosity scriptOptions (Just pkg) configureCommand configureFlags extraArgs hunk ./cabal-install/Distribution/Client/Configure.hs 189 configureFlags = filterConfigureFlags configFlags { configConfigurationsFlags = flags, configConstraints = map thisPackageVersion deps, - configVerbosity = toFlag verbosity + configVerbosity = toFlag verbosity, + configBenchmarks = toFlag (BenchStanzas `elem` stanzas), + configTests = toFlag (TestStanzas `elem` stanzas) } pkg = case finalizePackageDescription flags hunk ./cabal-install/Distribution/Client/Configure.hs 196 (const True) - platform comp [] gpkg of + platform comp [] (enableStanzas stanzas gpkg) of Left _ -> error "finalizePackageDescription ConfiguredPackage failed" Right (desc, _) -> desc hunk ./cabal-install/Distribution/Client/Dependency/TopDown.hs 27 import Distribution.Client.InstallPlan ( PlanPackage(..) ) import Distribution.Client.Types - ( SourcePackage(..), ConfiguredPackage(..), InstalledPackage(..) ) + ( SourcePackage(..), ConfiguredPackage(..), InstalledPackage(..) + , enableStanzas ) import Distribution.Client.Dependency.Types ( DependencyResolver, PackageConstraint(..) , PackagePreferences(..), InstalledPreference(..) hunk ./cabal-install/Distribution/Client/Dependency/TopDown.hs 112 where topSortNumber choice = case fst (head choice) of InstalledOnly (InstalledPackageEx _ i _) -> i - SourceOnly (UnconfiguredPackage _ i _) -> i - InstalledAndSource _ (UnconfiguredPackage _ i _) -> i + SourceOnly (UnconfiguredPackage _ i _ _) -> i + InstalledAndSource _ (UnconfiguredPackage _ i _ _) -> i bestByPref pkgname = case packageInstalledPreference of PreferLatest -> hunk ./cabal-install/Distribution/Client/Dependency/TopDown.hs 201 installedConstraints (InstalledPackageEx _ _ deps) = [ (thisPackageVersion dep, True) | dep <- deps ] - availableConstraints (SemiConfiguredPackage _ _ deps) = + availableConstraints (SemiConfiguredPackage _ _ _ deps) = [ (dep, False) | dep <- deps ] addDeps :: Constraints -> [PackageName] -> Constraints hunk ./cabal-install/Distribution/Client/Dependency/TopDown.hs 343 ConflictsWith conflicts -> Fail (TopLevelInstallConstraintConflict pkg SourceConstraint conflicts) +addTopLevelConstraints (PackageConstraintStanzas _ _ : deps) cs = + addTopLevelConstraints deps cs + -- | Add exclusion on available packages that cannot be configured. -- pruneBottomUp :: Platform -> CompilerId hunk ./cabal-install/Distribution/Client/Dependency/TopDown.hs 371 [ (dep, Constraints.conflicting cs dep) | dep <- missing ] - configure cs (UnconfiguredPackage (SourcePackage _ pkg _) _ flags) = + configure cs (UnconfiguredPackage (SourcePackage _ pkg _) _ flags stanzas) = finalizePackageDescription flags (dependencySatisfiable cs) hunk ./cabal-install/Distribution/Client/Dependency/TopDown.hs 373 - platform comp [] pkg + platform comp [] (enableStanzas stanzas pkg) dependencySatisfiable cs = not . null . PackageIndex.lookupDependency (Constraints.choices cs) hunk ./cabal-install/Distribution/Client/Dependency/TopDown.hs 385 . Constraints.choices topSortNumber (InstalledOnly (InstalledPackageEx _ i _)) = i - topSortNumber (SourceOnly (UnconfiguredPackage _ i _)) = i - topSortNumber (InstalledAndSource _ (UnconfiguredPackage _ i _)) = i + topSortNumber (SourceOnly (UnconfiguredPackage _ i _ _)) = i + topSortNumber (InstalledAndSource _ (UnconfiguredPackage _ i _ _)) = i getSourcePkg (InstalledOnly _ ) = Nothing getSourcePkg (SourceOnly spkg) = Just spkg hunk ./cabal-install/Distribution/Client/Dependency/TopDown.hs 400 InstalledAndSource ipkg apkg -> fmap (InstalledAndSource ipkg) (configure apkg) where - configure (UnconfiguredPackage apkg@(SourcePackage _ p _) _ flags) = + configure (UnconfiguredPackage apkg@(SourcePackage _ p _) _ flags stanzas) = case finalizePackageDescription flags dependencySatisfiable hunk ./cabal-install/Distribution/Client/Dependency/TopDown.hs 402 - platform comp [] p of + platform comp [] (enableStanzas stanzas p) of Left missing -> Left missing Right (pkg, flags') -> Right $ hunk ./cabal-install/Distribution/Client/Dependency/TopDown.hs 405 - SemiConfiguredPackage apkg flags' (externalBuildDepends pkg) + SemiConfiguredPackage apkg flags' stanzas (externalBuildDepends pkg) dependencySatisfiable = not . null . PackageIndex.lookupDependency available hunk ./cabal-install/Distribution/Client/Dependency/TopDown.hs 434 -> PackageIndex UnconfiguredPackage annotateSourcePackages constraints dfsNumber sourcePkgIndex = PackageIndex.fromList - [ UnconfiguredPackage pkg (dfsNumber name) (flagsFor name) + [ UnconfiguredPackage pkg (dfsNumber name) (flagsFor name) (stanzasFor name) | pkg <- PackageIndex.allPackages sourcePkgIndex , let name = packageName pkg ] where hunk ./cabal-install/Distribution/Client/Dependency/TopDown.hs 442 flagsMap = Map.fromList [ (name, flags) | PackageConstraintFlags name flags <- constraints ] + stanzasFor = fromMaybe [] . flip Map.lookup stanzasMap + stanzasMap = Map.fromList + [ (name, stanzas) + | PackageConstraintStanzas name stanzas <- constraints ] -- | One of the heuristics we use when guessing which path to take in the -- search space is an ordering on the choices we make. It's generally better hunk ./cabal-install/Distribution/Client/Dependency/TopDown.hs 557 Just (InstalledAndSource _ _) -> finaliseSource (Just ipkg) apkg finaliseInstalled (InstalledPackageEx pkg _ _) = InstallPlan.PreExisting pkg - finaliseSource mipkg (SemiConfiguredPackage pkg flags deps) = - InstallPlan.Configured (ConfiguredPackage pkg flags deps') + finaliseSource mipkg (SemiConfiguredPackage pkg flags stanzas deps) = + InstallPlan.Configured (ConfiguredPackage pkg flags stanzas deps') where deps' = map (packageId . pickRemaining mipkg) deps hunk ./cabal-install/Distribution/Client/Dependency/TopDown/Types.hs 16 module Distribution.Client.Dependency.TopDown.Types where import Distribution.Client.Types - ( SourcePackage(..), InstalledPackage ) + ( SourcePackage(..), InstalledPackage, OptionalStanza ) import Distribution.Package ( PackageIdentifier, Dependency hunk ./cabal-install/Distribution/Client/Dependency/TopDown/Types.hs 53 SourcePackage !TopologicalSortNumber FlagAssignment + [OptionalStanza] data SemiConfiguredPackage = SemiConfiguredPackage hunk ./cabal-install/Distribution/Client/Dependency/TopDown/Types.hs 59 SourcePackage -- package info FlagAssignment -- total flag assignment for the package + [OptionalStanza] -- enabled optional stanzas [Dependency] -- dependencies we end up with when we apply -- the flag assignment hunk ./cabal-install/Distribution/Client/Dependency/TopDown/Types.hs 70 depends (InstalledPackageEx _ _ deps) = deps instance Package UnconfiguredPackage where - packageId (UnconfiguredPackage p _ _) = packageId p + packageId (UnconfiguredPackage p _ _ _) = packageId p instance Package SemiConfiguredPackage where hunk ./cabal-install/Distribution/Client/Dependency/TopDown/Types.hs 73 - packageId (SemiConfiguredPackage p _ _) = packageId p + packageId (SemiConfiguredPackage p _ _ _) = packageId p instance (Package installed, Package source) => Package (InstalledOrSource installed source) where hunk ./cabal-install/Distribution/Client/Dependency/Types.hs 37 ( Monoid(..) ) import Distribution.Client.Types - ( SourcePackage(..) ) + ( OptionalStanza, SourcePackage(..) ) import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Compat.ReadP hunk ./cabal-install/Distribution/Client/Dependency/Types.hs 119 | PackageConstraintInstalled PackageName | PackageConstraintSource PackageName | PackageConstraintFlags PackageName FlagAssignment + | PackageConstraintStanzas PackageName [OptionalStanza] deriving (Show,Eq) -- | A per-package preference on the version. It is a soft constraint that the hunk ./cabal-install/Distribution/Client/Fetch.hs 134 -- that are in the 'InstallPlan.Configured' state. return [ pkg - | (InstallPlan.Configured (InstallPlan.ConfiguredPackage pkg _ _)) + | (InstallPlan.Configured (InstallPlan.ConfiguredPackage pkg _ _ _)) <- InstallPlan.toList installPlan ] | otherwise = hunk ./cabal-install/Distribution/Client/Install.hs 106 , Dependency(..), thisPackageVersion ) import qualified Distribution.PackageDescription as PackageDescription import Distribution.PackageDescription - ( Benchmark(..), PackageDescription, GenericPackageDescription(..) - , TestSuite(..), Flag(..), FlagName(..), FlagAssignment ) + ( PackageDescription, GenericPackageDescription(..), Flag(..) + , FlagName(..), FlagAssignment ) import Distribution.PackageDescription.Configuration hunk ./cabal-install/Distribution/Client/Install.hs 109 - ( finalizePackageDescription, mapTreeData ) + ( finalizePackageDescription ) import Distribution.Version ( Version, anyVersion, thisVersion ) import Distribution.Simple.Utils as Utils hunk ./cabal-install/Distribution/Client/Install.hs 269 [ PackageConstraintFlags (pkgSpecifierTarget pkgSpecifier) flags | let flags = configConfigurationsFlags configFlags , not (null flags) - , pkgSpecifier <- pkgSpecifiers'' ] + , pkgSpecifier <- pkgSpecifiers ] + + . addConstraints + [ PackageConstraintStanzas (pkgSpecifierTarget pkgSpecifier) stanzas + | pkgSpecifier <- pkgSpecifiers ] . (if reinstall then reinstallTargets else id) hunk ./cabal-install/Distribution/Client/Install.hs 277 - $ standardInstallPolicy installedPkgIndex sourcePkgDb pkgSpecifiers'' + $ standardInstallPolicy installedPkgIndex sourcePkgDb pkgSpecifiers hunk ./cabal-install/Distribution/Client/Install.hs 279 - -- Mark test suites as enabled if invoked with '--enable-tests'. This - -- ensures that test suite dependencies are included. - pkgSpecifiers' = map enableTests pkgSpecifiers + stanzas = concat + [ if testsEnabled then [TestStanzas] else [] + , if benchmarksEnabled then [BenchStanzas] else [] + ] testsEnabled = fromFlagOrDefault False $ configTests configFlags hunk ./cabal-install/Distribution/Client/Install.hs 284 - enableTests (SpecificSourcePackage pkg) = - let pkgDescr = Source.packageDescription pkg - suites = condTestSuites pkgDescr - enable = mapTreeData (\t -> t { testEnabled = testsEnabled }) - in SpecificSourcePackage $ pkg { Source.packageDescription = pkgDescr - { condTestSuites = map (\(n, t) -> (n, enable t)) suites } } - enableTests x = x - - -- Mark benchmarks as enabled if invoked with - -- '--enable-benchmarks'. This ensures that benchmark dependencies - -- are included. - pkgSpecifiers'' = map enableBenchmarks pkgSpecifiers' benchmarksEnabled = fromFlagOrDefault False $ configBenchmarks configFlags hunk ./cabal-install/Distribution/Client/Install.hs 285 - enableBenchmarks (SpecificSourcePackage pkg) = - let pkgDescr = Source.packageDescription pkg - bms = condBenchmarks pkgDescr - enable = mapTreeData (\t -> t { benchmarkEnabled = benchmarksEnabled }) - in SpecificSourcePackage $ pkg { Source.packageDescription = pkgDescr - { condBenchmarks = map (\(n, t) -> (n, enable t)) bms } } - enableBenchmarks x = x --TODO: this is a general feature and should be moved to D.C.Dependency -- Also, the InstallPlan.remove should return info more precise to the hunk ./cabal-install/Distribution/Client/Install.hs 445 toFlagAssignment = map (\ f -> (flagName f, flagDefault f)) nonDefaultFlags :: ConfiguredPackage -> FlagAssignment - nonDefaultFlags (ConfiguredPackage spkg fa _) = + nonDefaultFlags (ConfiguredPackage spkg fa _ _) = let defaultAssignment = toFlagAssignment (genPackageFlags (Source.packageDescription spkg)) hunk ./cabal-install/Distribution/Client/Install.hs 771 -> PackageDescription -> a) -> a installConfiguredPackage platform comp configFlags - (ConfiguredPackage (SourcePackage _ gpkg source) flags deps) + (ConfiguredPackage (SourcePackage _ gpkg source) flags stanzas deps) installPkg = installPkg configFlags { configConfigurationsFlags = flags, hunk ./cabal-install/Distribution/Client/Install.hs 774 - configConstraints = map thisPackageVersion deps + configConstraints = map thisPackageVersion deps, + configBenchmarks = toFlag (BenchStanzas `elem` stanzas), + configTests = toFlag (TestStanzas `elem` stanzas) } source pkg where pkg = case finalizePackageDescription flags hunk ./cabal-install/Distribution/Client/Install.hs 781 (const True) - platform comp [] gpkg of + platform comp [] (enableStanzas stanzas gpkg) of Left _ -> error "finalizePackageDescription ConfiguredPackage failed" Right (desc, _) -> desc hunk ./cabal-install/Distribution/Client/InstallPlan.hs 49 import Distribution.Client.Types ( SourcePackage(packageDescription), ConfiguredPackage(..) - , InstalledPackage - , BuildFailure, BuildSuccess ) + , InstalledPackage, BuildFailure, BuildSuccess, enableStanzas ) import Distribution.Package ( PackageIdentifier(..), PackageName(..), Package(..), packageName , PackageFixedDeps(..), Dependency(..) ) hunk ./cabal-install/Distribution/Client/InstallPlan.hs 474 configuredPackageProblems :: Platform -> CompilerId -> ConfiguredPackage -> [PackageProblem] configuredPackageProblems platform comp - (ConfiguredPackage pkg specifiedFlags specifiedDeps) = + (ConfiguredPackage pkg specifiedFlags stanzas specifiedDeps) = [ DuplicateFlag flag | ((flag,_):_) <- duplicates specifiedFlags ] ++ [ MissingFlag flag | OnlyInLeft flag <- mergedFlags ] ++ [ ExtraFlag flag | OnlyInRight flag <- mergedFlags ] hunk ./cabal-install/Distribution/Client/InstallPlan.hs 508 (const True) platform comp [] - (packageDescription pkg) of + (enableStanzas stanzas $ packageDescription pkg) of Right (resolvedPkg, _) -> externalBuildDepends resolvedPkg Left _ -> error "configuredPackageInvalidDeps internal error" hunk ./cabal-install/Distribution/Client/InstallSymlink.hs 43 #else import Distribution.Client.Types - ( SourcePackage(..), ConfiguredPackage(..) ) + ( SourcePackage(..), ConfiguredPackage(..), enableStanzas ) import Distribution.Client.Setup ( InstallFlags(installSymlinkBinDir) ) import qualified Distribution.Client.InstallPlan as InstallPlan hunk ./cabal-install/Distribution/Client/InstallSymlink.hs 135 , PackageDescription.buildable (PackageDescription.buildInfo exe) ] pkgDescription :: ConfiguredPackage -> PackageDescription - pkgDescription (ConfiguredPackage (SourcePackage _ pkg _) flags _) = + pkgDescription (ConfiguredPackage (SourcePackage _ pkg _) flags stanzas _) = case finalizePackageDescription flags (const True) hunk ./cabal-install/Distribution/Client/InstallSymlink.hs 138 - platform compilerId [] pkg of + platform compilerId [] (enableStanzas stanzas pkg) of Left _ -> error "finalizePackageDescription ConfiguredPackage failed" Right (desc, _) -> desc hunk ./cabal-install/Distribution/Client/Targets.hs 693 PackageConstraintInstalled _ -> PackageConstraintInstalled name PackageConstraintSource _ -> PackageConstraintSource name PackageConstraintFlags _ flags -> PackageConstraintFlags name flags + PackageConstraintStanzas _ stanzas -> PackageConstraintStanzas name stanzas readUserConstraint :: String -> Either String UserConstraint readUserConstraint str = hunk ./cabal-install/Distribution/Client/Types.hs 22 ( InstalledPackageInfo ) import Distribution.PackageDescription ( GenericPackageDescription, FlagAssignment ) +import Distribution.PackageDescription.Configuration + ( enableBenchmarks, enableTests ) import Distribution.Client.PackageIndex ( PackageIndex ) import Distribution.Version hunk ./cabal-install/Distribution/Client/Types.hs 79 data ConfiguredPackage = ConfiguredPackage SourcePackage -- package info, including repo FlagAssignment -- complete flag assignment for the package + [OptionalStanza] -- list of enabled optional stanzas for the package [PackageId] -- set of exact dependencies. These must be -- consistent with the 'buildDepends' in the -- 'PackageDescription' that you'd get by applying hunk ./cabal-install/Distribution/Client/Types.hs 83 - -- the flag assignment. + -- the flag assignment and optional stanzas. deriving Show instance Package ConfiguredPackage where hunk ./cabal-install/Distribution/Client/Types.hs 87 - packageId (ConfiguredPackage pkg _ _) = packageId pkg + packageId (ConfiguredPackage pkg _ _ _) = packageId pkg instance PackageFixedDeps ConfiguredPackage where hunk ./cabal-install/Distribution/Client/Types.hs 90 - depends (ConfiguredPackage _ _ deps) = deps + depends (ConfiguredPackage _ _ _ deps) = deps -- | A package description along with the location of the package sources. hunk ./cabal-install/Distribution/Client/Types.hs 104 instance Package SourcePackage where packageId = packageInfoId +data OptionalStanza + = TestStanzas + | BenchStanzas + deriving (Eq, Show) + +enableStanzas + :: [OptionalStanza] + -> GenericPackageDescription + -> GenericPackageDescription +enableStanzas stanzas + = enableTests (TestStanzas `elem` stanzas) + . enableBenchmarks (BenchStanzas `elem` stanzas) + -- ------------------------------------------------------------ -- * Package locations and repositories -- ------------------------------------------------------------ } [Update types in modular dependency solver to compile with new test/benchmark dependency constraints. Thomas Tuegel **20120207194543 Ignore-this: ddfdb45064df125b176ade0ba19bbbbb ] { hunk ./cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs 13 import Prelude hiding (pi) import Distribution.PackageDescription (FlagAssignment) -- from Cabal +import Distribution.Client.Types (OptionalStanza) import Distribution.Client.Dependency.Modular.Configured import Distribution.Client.Dependency.Modular.Dependency hunk ./cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs 32 -- and in the extreme case fix a concrete instance. type PPreAssignment = Map QPN (CI QPN) type FAssignment = Map QFN Bool +type SAssignment = Map QPN [OptionalStanza] -- | A (partial) assignment of variables. hunk ./cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs 35 -data Assignment = A PAssignment FAssignment +data Assignment = A PAssignment FAssignment SAssignment deriving (Show, Eq) -- | A preassignment comprises knowledge about variables, but not hunk ./cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs 69 -- of one package version chosen by the solver, which will lead to -- clashes. toCPs :: Assignment -> RevDepMap -> [CP QPN] -toCPs (A pa fa) rdm = +toCPs (A pa fa sa) rdm = let -- get hold of the graph g :: Graph hunk ./cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs 104 in L.map (\ pi@(PI qpn _) -> CP pi (M.findWithDefault [] qpn fapp) + (M.findWithDefault [] qpn sa) (depp qpn)) ps hunk ./cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs 112 -- -- This is preliminary, and geared towards output right now. finalize :: Index -> Assignment -> RevDepMap -> IO () -finalize idx (A pa fa) rdm = +finalize idx (A pa fa _) rdm = let -- get hold of the graph g :: Graph hunk ./cabal-install/Distribution/Client/Dependency/Modular/Configured.hs 4 module Distribution.Client.Dependency.Modular.Configured where import Distribution.PackageDescription (FlagAssignment) -- from Cabal +import Distribution.Client.Types (OptionalStanza) import Distribution.Client.Dependency.Modular.Package hunk ./cabal-install/Distribution/Client/Dependency/Modular/Configured.hs 10 -- | A configured package is a package instance together with -- a flag assignment and complete dependencies. -data CP qpn = CP (PI qpn) FlagAssignment [PI qpn] +data CP qpn = CP (PI qpn) FlagAssignment [OptionalStanza] [PI qpn] hunk ./cabal-install/Distribution/Client/Dependency/Modular/ConfiguredConversion.hs 24 convCP :: SI.PackageIndex -> CI.PackageIndex SourcePackage -> CP QPN -> PlanPackage -convCP iidx sidx (CP qpi fa ds) = +convCP iidx sidx (CP qpi fa es ds) = case convPI qpi of Left pi -> PreExisting $ InstalledPackage (fromJust $ SI.lookupInstalledPackageId iidx pi) hunk ./cabal-install/Distribution/Client/Dependency/Modular/ConfiguredConversion.hs 32 Right pi -> Configured $ ConfiguredPackage (fromJust $ CI.lookupPackageId sidx pi) fa + es (map convPI' ds) convPI :: PI QPN -> Either InstalledPackageId PackageId hunk ./cabal-install/Distribution/Client/Dependency/Modular/Explore.hs 77 where go (FailF _ _) _ = A.empty go (DoneF rdm) a = pure (a, rdm) - go (PChoiceF qpn _ ts) (A pa fa) = + go (PChoiceF qpn _ ts) (A pa fa sa) = asum $ -- try children in order, P.mapWithKey -- when descending ... hunk ./cabal-install/Distribution/Client/Dependency/Modular/Explore.hs 80 - (\ k r -> r (A (M.insert qpn k pa) fa)) $ -- record the pkg choice + (\ k r -> r (A (M.insert qpn k pa) fa sa)) $ -- record the pkg choice ts hunk ./cabal-install/Distribution/Client/Dependency/Modular/Explore.hs 82 - go (FChoiceF qfn _ _ ts) (A pa fa) = + go (FChoiceF qfn _ _ ts) (A pa fa sa) = asum $ -- try children in order, P.mapWithKey -- when descending ... hunk ./cabal-install/Distribution/Client/Dependency/Modular/Explore.hs 85 - (\ k r -> r (A pa (M.insert qfn k fa))) $ -- record the flag choice + (\ k r -> r (A pa (M.insert qfn k fa) sa)) $ -- record the flag choice ts go (GoalChoiceF ts) a = casePSQ ts A.empty -- empty goal choice is an internal error hunk ./cabal-install/Distribution/Client/Dependency/Modular/Explore.hs 97 where go (FailF c fr) _ = failWith (Failure c fr) go (DoneF rdm) a = succeedWith Success (a, rdm) - go (PChoiceF qpn c ts) (A pa fa) = + go (PChoiceF qpn c ts) (A pa fa sa) = backjumpInfo c $ asum $ -- try children in order, P.mapWithKey -- when descending ... hunk ./cabal-install/Distribution/Client/Dependency/Modular/Explore.hs 102 (\ k r -> tryWith (TryP (PI qpn k)) $ -- log and ... - r (A (M.insert qpn k pa) fa)) -- record the pkg choice + r (A (M.insert qpn k pa) fa sa)) -- record the pkg choice ts hunk ./cabal-install/Distribution/Client/Dependency/Modular/Explore.hs 104 - go (FChoiceF qfn c _ ts) (A pa fa) = + go (FChoiceF qfn c _ ts) (A pa fa sa) = backjumpInfo c $ asum $ -- try children in order, P.mapWithKey -- when descending ... hunk ./cabal-install/Distribution/Client/Dependency/Modular/Explore.hs 109 (\ k r -> tryWith (TryF qfn k) $ -- log and ... - r (A pa (M.insert qfn k fa))) -- record the pkg choice + r (A pa (M.insert qfn k fa) sa)) -- record the pkg choice ts go (GoalChoiceF ts) a = casePSQ ts hunk ./cabal-install/Distribution/Client/Dependency/Modular/Explore.hs 129 -- | Interface. exploreTree :: Alternative m => Tree a -> m (Assignment, RevDepMap) -exploreTree t = explore t (A M.empty M.empty) +exploreTree t = explore t (A M.empty M.empty M.empty) -- | Interface. exploreTreeLog :: Tree (Maybe (ConflictSet QPN)) -> Log Message (Assignment, RevDepMap) hunk ./cabal-install/Distribution/Client/Dependency/Modular/Explore.hs 133 -exploreTreeLog t = exploreLog t (A M.empty M.empty) +exploreTreeLog t = exploreLog t (A M.empty M.empty M.empty) } [Don't build benchmarks, even if installing benchmark dependencies. Thomas Tuegel **20120207194852 Ignore-this: 994177542d8d746f5e9035450059164e ] hunk ./cabal-install/Distribution/Client/Install.hs 775 installPkg = installPkg configFlags { configConfigurationsFlags = flags, configConstraints = map thisPackageVersion deps, - configBenchmarks = toFlag (BenchStanzas `elem` stanzas), + configBenchmarks = toFlag False, configTests = toFlag (TestStanzas `elem` stanzas) } source pkg where [Enable tests and benchmarks in cabal-install without modifications to the Cabal library. Thomas Tuegel **20120208065701 Ignore-this: 66273287bbae4fd47a8bc16734e4b305 ] { hunk ./cabal-install/Distribution/Client/Types.hs 21 import Distribution.InstalledPackageInfo ( InstalledPackageInfo ) import Distribution.PackageDescription - ( GenericPackageDescription, FlagAssignment ) + ( Benchmark(..), GenericPackageDescription(..), FlagAssignment + , TestSuite(..) ) import Distribution.PackageDescription.Configuration hunk ./cabal-install/Distribution/Client/Types.hs 24 - ( enableBenchmarks, enableTests ) + ( mapTreeData ) import Distribution.Client.PackageIndex ( PackageIndex ) import Distribution.Version hunk ./cabal-install/Distribution/Client/Types.hs 114 :: [OptionalStanza] -> GenericPackageDescription -> GenericPackageDescription -enableStanzas stanzas - = enableTests (TestStanzas `elem` stanzas) - . enableBenchmarks (BenchStanzas `elem` stanzas) +enableStanzas stanzas gpkg = gpkg + { condBenchmarks = flagBenchmarks $ condBenchmarks gpkg + , condTestSuites = flagTests $ condTestSuites gpkg + } + where + enableTest t = t { testEnabled = TestStanzas `elem` stanzas } + enableBenchmark bm = bm { benchmarkEnabled = BenchStanzas `elem` stanzas } + flagBenchmarks = map (\(n, bm) -> (n, mapTreeData enableBenchmark bm)) + flagTests = map (\(n, t) -> (n, mapTreeData enableTest t)) -- ------------------------------------------------------------ -- * Package locations and repositories } [Added a missing case. Andres Loeh **20120211154119 Ignore-this: 449e59fec67c986ea2804642bf02b8c3 ] hunk ./cabal-install/Distribution/Client/Dependency/Modular.hs 58 pcName (PackageConstraintInstalled pn ) = pn pcName (PackageConstraintSource pn ) = pn pcName (PackageConstraintFlags pn _) = pn + pcName (PackageConstraintStanzas pn _) = pn [show optional stanzas when printing install plans Andres Loeh **20120211155929 Ignore-this: b9d3b404ce7e58eb9368ee28670d31ae ] { hunk ./cabal-install/Distribution/Client/Install.hs 433 : map (display . packageId) (map fst pkgs) where showPkgAndReason (pkg', pr) = display (packageId pkg') ++ - showFlagAssignment (nonDefaultFlags pkg') ++ " " ++ + showFlagAssignment (nonDefaultFlags pkg') ++ + showStanzas (stanzas pkg') ++ " " ++ case pr of NewPackage -> "(new package)" NewVersion _ -> "(new version)" hunk ./cabal-install/Distribution/Client/Install.hs 452 (genPackageFlags (Source.packageDescription spkg)) in fa \\ defaultAssignment + stanzas :: ConfiguredPackage -> [OptionalStanza] + stanzas (ConfiguredPackage _ _ sts _) = sts + + showStanzas :: [OptionalStanza] -> String + showStanzas = concatMap ((' ' :) . showStanza) + showStanza TestStanzas = "*test" + showStanza BenchStanzas = "*bench" + -- FIXME: this should be a proper function in a proper place hunk ./cabal-install/Distribution/Client/Install.hs 461 + showFlagAssignment :: FlagAssignment -> String showFlagAssignment = concatMap ((' ' :) . showFlagValue) showFlagValue (f, True) = '+' : showFlagName f showFlagValue (f, False) = '-' : showFlagName f } [stanza support in modular solver Andres Loeh **20120212113524 Ignore-this: 9697a66807ddee3ea2de811458c2fa5a ] { hunk ./cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs 32 -- and in the extreme case fix a concrete instance. type PPreAssignment = Map QPN (CI QPN) type FAssignment = Map QFN Bool -type SAssignment = Map QPN [OptionalStanza] +type SAssignment = Map QSN Bool -- | A (partial) assignment of variables. data Assignment = A PAssignment FAssignment SAssignment hunk ./cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs 40 -- | A preassignment comprises knowledge about variables, but not -- necessarily fixed values. -data PreAssignment = PA PPreAssignment FAssignment +data PreAssignment = PA PPreAssignment FAssignment SAssignment -- | Extend a package preassignment. -- hunk ./cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs 94 L.map (\ ((FN (PI qpn _) fn), b) -> (qpn, [(fn, b)])) $ M.toList $ fa + -- Stanzas per package. + sapp :: Map QPN [OptionalStanza] + sapp = M.fromListWith (++) $ + L.map (\ ((SN (PI qpn _) sn), b) -> (qpn, if b then [sn] else [])) $ + M.toList $ + sa -- Dependencies per package. depp :: QPN -> [PI QPN] depp qpn = let v :: Vertex hunk ./cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs 110 in L.map (\ pi@(PI qpn _) -> CP pi (M.findWithDefault [] qpn fapp) - (M.findWithDefault [] qpn sa) + (M.findWithDefault [] qpn sapp) (depp qpn)) ps hunk ./cabal-install/Distribution/Client/Dependency/Modular/Builder.hs 35 where go g o [] = s { rdeps = g, open = o } go g o (ng@(OpenGoal (Flagged _ _ _ _) _gr) : ngs) = go g (cons ng () o) ngs + go g o (ng@(OpenGoal (Stanza _ _ ) _gr) : ngs) = go g (cons ng () o) ngs go g o (ng@(OpenGoal (Simple (Dep qpn _)) _gr) : ngs) | qpn == qpn' = go g o ngs -- we ignore self-dependencies at this point; TODO: more care may be needed hunk ./cabal-install/Distribution/Client/Dependency/Modular/Builder.hs 94 -- that is indicated by the flag default. -- -- TODO: Should we include the flag default in the tree? - go bs@(BS { scope = sc, next = OneGoal (OpenGoal (Flagged qfn b t f) gr) }) = + go bs@(BS { scope = sc, next = OneGoal (OpenGoal (Flagged qfn@(FN (PI qpn _) _) b t f) gr) }) = FChoiceF qfn (gr, sc) trivial (P.fromList (reorder b hunk ./cabal-install/Distribution/Client/Dependency/Modular/Builder.hs 96 - [(True, (extendOpen (getPN qfn) (L.map (flip OpenGoal (FDependency qfn True : gr)) t) bs) { next = Goals }), - (False, (extendOpen (getPN qfn) (L.map (flip OpenGoal (FDependency qfn False : gr)) f) bs) { next = Goals })])) + [(True, (extendOpen qpn (L.map (flip OpenGoal (FDependency qfn True : gr)) t) bs) { next = Goals }), + (False, (extendOpen qpn (L.map (flip OpenGoal (FDependency qfn False : gr)) f) bs) { next = Goals })])) where reorder True = id reorder False = reverse hunk ./cabal-install/Distribution/Client/Dependency/Modular/Builder.hs 103 trivial = L.null t && L.null f + go bs@(BS { scope = sc, next = OneGoal (OpenGoal (Stanza qsn@(SN (PI qpn _) _) t) gr) }) = + SChoiceF qsn (gr, sc) trivial (P.fromList + [(False, bs { next = Goals }), + (True, (extendOpen qpn (L.map (flip OpenGoal (SDependency qsn : gr)) t) bs) { next = Goals })]) + where + trivial = L.null t + -- For a particular instance, we change the state: we update the scope, -- and furthermore we update the set of goals. -- hunk ./cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs 3 module Distribution.Client.Dependency.Modular.Dependency where +import Prelude hiding (pi) + import Data.List as L import Data.Map as M import Data.Set as S hunk ./cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs 15 -- | The type of variables that play a role in the solver. -- Note that the tree currently does not use this type directly, --- and rather has two separate tree nodes for the two types of +-- and rather has separate tree nodes for the different types of -- variables. This fits better with the fact that in most cases, -- these have to be treated differently. -- hunk ./cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs 21 -- TODO: This isn't the ideal location to declare the type, -- but we need them for constrained instances. -data Var qpn = P qpn | F (FN qpn) +data Var qpn = P qpn | F (FN qpn) | S (SN qpn) deriving (Eq, Ord, Show) showVar :: Var QPN -> String hunk ./cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs 27 showVar (P qpn) = showQPN qpn showVar (F qfn) = showQFN qfn +showVar (S qsn) = showQSN qsn instance Functor Var where fmap f (P n) = P (f n) hunk ./cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs 32 fmap f (F fn) = F (fmap f fn) + fmap f (S sn) = S (fmap f sn) type ConflictSet qpn = Set (Var qpn) hunk ./cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs 99 -- or flag-dependent dependency trees. data FlaggedDep qpn = Flagged (FN qpn) FDefault (TrueFlaggedDeps qpn) (FalseFlaggedDeps qpn) + | Stanza (SN qpn) (TrueFlaggedDeps qpn) | Simple (Dep qpn) deriving (Eq, Show) hunk ./cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs 106 instance Functor FlaggedDep where fmap f (Flagged x y tt ff) = Flagged (fmap f x) y (fmap (fmap f) tt) (fmap (fmap f) ff) + fmap f (Stanza x tt) = Stanza (fmap f x) (fmap (fmap f) tt) fmap f (Simple d) = Simple (fmap f d) type TrueFlaggedDeps qpn = FlaggedDeps qpn hunk ./cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs 156 deriving (Eq, Show) -- | Reasons why a goal can be added to a goal set. -data GoalReason qpn = UserGoal | PDependency (PI qpn) | FDependency (FN qpn) Bool +data GoalReason qpn = + UserGoal + | PDependency (PI qpn) + | FDependency (FN qpn) Bool + | SDependency (SN qpn) deriving (Eq, Show) instance Functor GoalReason where hunk ./cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs 164 - fmap f UserGoal = UserGoal + fmap _ UserGoal = UserGoal fmap f (PDependency pi) = PDependency (fmap f pi) fmap f (FDependency fn b) = FDependency (fmap f fn) b hunk ./cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs 167 + fmap f (SDependency sn) = SDependency (fmap f sn) -- | The first element is the immediate reason. The rest are the reasons -- for the reasons ... hunk ./cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs 179 goalReasonToVars UserGoal = S.empty goalReasonToVars (PDependency (PI qpn _)) = S.singleton (P qpn) goalReasonToVars (FDependency qfn _) = S.singleton (F qfn) +goalReasonToVars (SDependency qsn) = S.singleton (S qsn) goalReasonsToVars :: Ord qpn => GoalReasons qpn -> ConflictSet qpn goalReasonsToVars = S.unions . L.map goalReasonToVars hunk ./cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs 189 close :: OpenGoal -> Goal QPN close (OpenGoal (Simple (Dep qpn _)) gr) = Goal (P qpn) gr close (OpenGoal (Flagged qfn _ _ _ ) gr) = Goal (F qfn) gr +close (OpenGoal (Stanza qsn _) gr) = Goal (S qsn) gr -- | Compute a conflic set from a goal. The conflict set contains the -- closure of goal reasons as well as the variable of the goal itself. hunk ./cabal-install/Distribution/Client/Dependency/Modular/Explore.hs 33 go (FChoiceF qfn _ b ts) = (c, FChoice qfn c b (P.fromList ts')) where ~(c, ts') = combine (F qfn) (P.toList ts) S.empty + go (SChoiceF qsn _ b ts) = (c, SChoice qsn c b (P.fromList ts')) + where + ~(c, ts') = combine (S qsn) (P.toList ts) S.empty go (GoalChoiceF ts) = (c, GoalChoice (P.fromList ts')) where ~(cs, ts') = unzip $ L.map (\ (k, (x, v)) -> (x, (k, v))) $ P.toList ts hunk ./cabal-install/Distribution/Client/Dependency/Modular/Explore.hs 90 P.mapWithKey -- when descending ... (\ k r -> r (A pa (M.insert qfn k fa) sa)) $ -- record the flag choice ts + go (SChoiceF qsn _ _ ts) (A pa fa sa) = + asum $ -- try children in order, + P.mapWithKey -- when descending ... + (\ k r -> r (A pa fa (M.insert qsn k sa))) $ -- record the flag choice + ts go (GoalChoiceF ts) a = casePSQ ts A.empty -- empty goal choice is an internal error (\ _k v _xs -> v a) -- commit to the first goal choice hunk ./cabal-install/Distribution/Client/Dependency/Modular/Explore.hs 119 (\ k r -> tryWith (TryF qfn k) $ -- log and ... r (A pa (M.insert qfn k fa) sa)) -- record the pkg choice ts + go (SChoiceF qsn c _ ts) (A pa fa sa) = + backjumpInfo c $ + asum $ -- try children in order, + P.mapWithKey -- when descending ... + (\ k r -> tryWith (TryS qsn k) $ -- log and ... + r (A pa fa (M.insert qsn k sa))) -- record the pkg choice + ts go (GoalChoiceF ts) a = casePSQ ts (failWith (Failure S.empty EmptyGoalChoice)) -- empty goal choice is an internal error hunk ./cabal-install/Distribution/Client/Dependency/Modular/Flag.hs 9 import Distribution.PackageDescription hiding (Flag) -- from Cabal import Distribution.Client.Dependency.Modular.Package +import Distribution.Client.Types (OptionalStanza(..)) -- | Flag name. Consists of a package instance and the flag identifier itself. data FN qpn = FN (PI qpn) Flag hunk ./cabal-install/Distribution/Client/Dependency/Modular/Flag.hs 37 -- | Qualified flag name. type QFN = FN QPN +-- | Stanza name. Paired with a package name, much like a flag. +data SN qpn = SN (PI qpn) OptionalStanza + deriving (Eq, Ord, Show) + +instance Functor SN where + fmap f (SN x y) = SN (fmap f x) y + +-- | Qualified stanza name. +type QSN = SN QPN + +unStanza :: OptionalStanza -> String +unStanza TestStanzas = "test" +unStanza BenchStanzas = "bench" + showQFNBool :: QFN -> Bool -> String showQFNBool qfn@(FN pi _f) b = showPI pi ++ ":" ++ showFBool qfn b hunk ./cabal-install/Distribution/Client/Dependency/Modular/Flag.hs 54 +showQSNBool :: QSN -> Bool -> String +showQSNBool qsn@(SN pi _f) b = showPI pi ++ ":" ++ showSBool qsn b + showFBool :: FN qpn -> Bool -> String showFBool (FN _ f) True = "+" ++ unFlag f showFBool (FN _ f) False = "-" ++ unFlag f hunk ./cabal-install/Distribution/Client/Dependency/Modular/Flag.hs 61 +showSBool :: SN qpn -> Bool -> String +showSBool (SN _ s) True = "*" ++ unStanza s +showSBool (SN _ s) False = "!" ++ unStanza s + showQFN :: QFN -> String showQFN (FN pi f) = showPI pi ++ ":" ++ unFlag f hunk ./cabal-install/Distribution/Client/Dependency/Modular/Flag.hs 67 + +showQSN :: QSN -> String +showQSN (SN pi f) = showPI pi ++ ":" ++ unStanza f hunk ./cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs 85 -- executable and test components. This does not quite seem fair. convGPD :: OS -> Arch -> CompilerId -> PI PN -> GenericPackageDescription -> PInfo -convGPD os arch cid - pi@(PI _pn _i) +convGPD os arch cid pi (GenericPackageDescription _ flags libs exes tests benchs) = let fds = flagDefaults flags hunk ./cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs 91 in PInfo - (maybe [] (convCondTree os arch cid pi fds (const True) ) libs ++ - concatMap (convCondTree os arch cid pi fds (const True) . snd) exes ++ - concatMap (convCondTree os arch cid pi fds testEnabled . snd) tests ++ - concatMap (convCondTree os arch cid pi fds benchmarkEnabled . snd) benchs) + (maybe [] (convCondTree os arch cid pi fds (const True) ) libs ++ + concatMap (convCondTree os arch cid pi fds (const True) . snd) exes ++ + (prefix (Stanza (SN pi TestStanzas)) + (concatMap (convCondTree os arch cid pi fds (const True) . snd) tests)) ++ + (prefix (Stanza (SN pi BenchStanzas)) + (concatMap (convCondTree os arch cid pi fds (const True) . snd) benchs))) fds [] -- TODO: add encaps hunk ./cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs 100 +prefix :: (FlaggedDeps qpn -> FlaggedDep qpn) -> FlaggedDeps qpn -> FlaggedDeps qpn +prefix _ [] = [] +prefix f fds = [f fds] + -- | Convert flag information. flagDefaults :: [PD.Flag] -> FlagDefaults flagDefaults = M.fromList . L.map (\ (MkFlag fn _ b _) -> (fn, b)) hunk ./cabal-install/Distribution/Client/Dependency/Modular/Message.hs 18 | Leave -- ^ decrease indentation level | TryP (PI QPN) | TryF QFN Bool + | TryS QSN Bool | Next (Goal QPN) | Success | Failure (ConflictSet QPN) FailReason hunk ./cabal-install/Distribution/Client/Dependency/Modular/Message.hs 43 -- complex patterns go v l (TryP (PI qpn i) : Enter : Failure c fr : Leave : ms) = goPReject v l qpn [i] c fr ms go v l (TryF qfn b : Enter : Failure c fr : Leave : ms) = (atLevel (F qfn : v) l $ "rejecting: " ++ showQFNBool qfn b ++ showFR c fr) (go v l ms) + go v l (TryS qsn b : Enter : Failure c fr : Leave : ms) = (atLevel (S qsn : v) l $ "rejecting: " ++ showQSNBool qsn b ++ showFR c fr) (go v l ms) go v l (Next (Goal (P qpn) gr) : TryP pi : ms@(Enter : Next _ : _)) = (atLevel (P qpn : v) l $ "trying: " ++ showPI pi ++ showGRs gr) (go (P qpn : v) l ms) go v l (Failure c Backjump : ms@(Leave : Failure c' Backjump : _)) | c == c' = go v l ms -- standard display hunk ./cabal-install/Distribution/Client/Dependency/Modular/Message.hs 51 go v l (Leave : ms) = go (drop 1 v) (l-1) ms go v l (TryP pi@(PI qpn _) : ms) = (atLevel (P qpn : v) l $ "trying: " ++ showPI pi) (go (P qpn : v) l ms) go v l (TryF qfn b : ms) = (atLevel (F qfn : v) l $ "trying: " ++ showQFNBool qfn b) (go (F qfn : v) l ms) + go v l (TryS qsn b : ms) = (atLevel (S qsn : v) l $ "trying: " ++ showQSNBool qsn b) (go (S qsn : v) l ms) go v l (Next (Goal (P qpn) gr) : ms) = (atLevel (P qpn : v) l $ "next goal: " ++ showQPN qpn ++ showGRs gr) (go v l ms) go v l (Next _ : ms) = go v l ms -- ignore flag goals in the log go v l (Success : ms) = (atLevel v l $ "done") (go v l ms) hunk ./cabal-install/Distribution/Client/Dependency/Modular/Message.hs 75 showGR :: GoalReason QPN -> String showGR UserGoal = " (user goal)" -showGR (PDependency pi) = " (dependency of " ++ showPI pi ++ ")" -showGR (FDependency qfn b) = " (dependency of " ++ showQFNBool qfn b ++ ")" +showGR (PDependency pi) = " (dependency of " ++ showPI pi ++ ")" +showGR (FDependency qfn b) = " (dependency of " ++ showQFNBool qfn b ++ ")" +showGR (SDependency qsn) = " (dependency of " ++ showQSNBool qsn True ++ ")" showFR :: ConflictSet QPN -> FailReason -> String showFR _ InconsistentInitialConstraints = " (inconsistent initial constraints)" hunk ./cabal-install/Distribution/Client/Dependency/Modular/Preference.hs 12 import Distribution.Client.Dependency.Types ( PackageConstraint(..), PackagePreferences(..), InstalledPreference(..) ) +import Distribution.Client.Types + ( OptionalStanza(..) ) import Distribution.Client.Dependency.Modular.Dependency import Distribution.Client.Dependency.Modular.Flag hunk ./cabal-install/Distribution/Client/Dependency/Modular/Preference.hs 95 | otherwise -> Fail c GlobalConstraintFlag processPackageConstraintF _ _ _ _ r = r +-- | Helper function that tries to enforce a single package constraint on a +-- given flag setting for an F-node. Translates the constraint into a +-- tree-transformer that either leaves the subtree untouched, or replaces it +-- with an appropriate failure node. +processPackageConstraintS :: OptionalStanza -> ConflictSet QPN -> Bool -> PackageConstraint -> Tree a -> Tree a +processPackageConstraintS s c b' (PackageConstraintStanzas _ ss) r = + if not b' && s `elem` ss then Fail c GlobalConstraintFlag + else r +processPackageConstraintS _ _ _ _ r = r + -- | Traversal that tries to establish various kinds of user constraints. Works hunk ./cabal-install/Distribution/Client/Dependency/Modular/Preference.hs 106 --- by selectively disabling choices that have been rules out by global user +-- by selectively disabling choices that have been ruled out by global user -- constraints. enforcePackageConstraints :: M.Map PN [PackageConstraint] -> Tree QGoalReasons -> Tree QGoalReasons enforcePackageConstraints pcs = trav go hunk ./cabal-install/Distribution/Client/Dependency/Modular/Preference.hs 123 g = \ b -> foldl (\ h pc -> h . processPackageConstraintF f c b pc) id (M.findWithDefault [] pn pcs) in FChoiceF qfn gr tr (P.mapWithKey g ts) + go (SChoiceF qsn@(SN (PI (Q _ pn) _) f) gr tr ts) = + let c = toConflictSet (Goal (S qsn) gr) + -- compose the transformation functions for each of the relevant constraint + g = \ b -> foldl (\ h pc -> h . processPackageConstraintS f c b pc) id + (M.findWithDefault [] pn pcs) + in SChoiceF qsn gr tr (P.mapWithKey g ts) go x = x -- | Prefer installed packages over non-installed packages, generally. hunk ./cabal-install/Distribution/Client/Dependency/Modular/Tree.hs 19 data Tree a = PChoice QPN a (PSQ I (Tree a)) | FChoice QFN a Bool (PSQ Bool (Tree a)) -- Bool indicates whether it's trivial + | SChoice QSN a Bool (PSQ Bool (Tree a)) -- Bool indicates whether it's trivial | GoalChoice (PSQ OpenGoal (Tree a)) -- PSQ should never be empty | Done RevDepMap | Fail (ConflictSet QPN) FailReason hunk ./cabal-install/Distribution/Client/Dependency/Modular/Tree.hs 24 deriving (Eq, Show) + -- Above, a choice is called trivial if it clearly does not matter. The + -- special case of triviality we actually consider is if there are no new + -- dependencies introduced by this node. instance Functor Tree where fmap f (PChoice qpn i xs) = PChoice qpn (f i) (fmap (fmap f) xs) hunk ./cabal-install/Distribution/Client/Dependency/Modular/Tree.hs 30 - fmap f (FChoice qpn i b xs) = FChoice qpn (f i) b (fmap (fmap f) xs) + fmap f (FChoice qfn i b xs) = FChoice qfn (f i) b (fmap (fmap f) xs) + fmap f (SChoice qsn i b xs) = SChoice qsn (f i) b (fmap (fmap f) xs) fmap f (GoalChoice xs) = GoalChoice (fmap (fmap f) xs) fmap _f (Done rdm ) = Done rdm fmap _f (Fail cs fr ) = Fail cs fr hunk ./cabal-install/Distribution/Client/Dependency/Modular/Tree.hs 46 | GlobalConstraintFlag | BuildFailureNotInIndex PN | MalformedFlagChoice QFN + | MalformedStanzaChoice QSN | EmptyGoalChoice | Backjump deriving (Eq, Show) hunk ./cabal-install/Distribution/Client/Dependency/Modular/Tree.hs 55 data TreeF a b = PChoiceF QPN a (PSQ I b) | FChoiceF QFN a Bool (PSQ Bool b) + | SChoiceF QSN a Bool (PSQ Bool b) | GoalChoiceF (PSQ OpenGoal b) | DoneF RevDepMap | FailF (ConflictSet QPN) FailReason hunk ./cabal-install/Distribution/Client/Dependency/Modular/Tree.hs 63 out :: Tree a -> TreeF a (Tree a) out (PChoice p i ts) = PChoiceF p i ts out (FChoice p i b ts) = FChoiceF p i b ts +out (SChoice p i b ts) = SChoiceF p i b ts out (GoalChoice ts) = GoalChoiceF ts out (Done x ) = DoneF x out (Fail c x ) = FailF c x hunk ./cabal-install/Distribution/Client/Dependency/Modular/Tree.hs 71 inn :: TreeF a (Tree a) -> Tree a inn (PChoiceF p i ts) = PChoice p i ts inn (FChoiceF p i b ts) = FChoice p i b ts +inn (SChoiceF p i b ts) = SChoice p i b ts inn (GoalChoiceF ts) = GoalChoice ts inn (DoneF x ) = Done x inn (FailF c x ) = Fail c x hunk ./cabal-install/Distribution/Client/Dependency/Modular/Tree.hs 79 instance Functor (TreeF a) where fmap f (PChoiceF p i ts) = PChoiceF p i (fmap f ts) fmap f (FChoiceF p i b ts) = FChoiceF p i b (fmap f ts) + fmap f (SChoiceF p i b ts) = SChoiceF p i b (fmap f ts) fmap f (GoalChoiceF ts) = GoalChoiceF (fmap f ts) fmap _ (DoneF x ) = DoneF x fmap _ (FailF c x ) = FailF c x hunk ./cabal-install/Distribution/Client/Dependency/Modular/Tree.hs 87 instance Foldable (TreeF a) where foldr op e (PChoiceF _ _ ts) = foldr op e ts foldr op e (FChoiceF _ _ _ ts) = foldr op e ts + foldr op e (SChoiceF _ _ _ ts) = foldr op e ts foldr op e (GoalChoiceF ts) = foldr op e ts foldr _ e (DoneF _ ) = e foldr _ e (FailF _ _ ) = e hunk ./cabal-install/Distribution/Client/Dependency/Modular/Tree.hs 95 instance Traversable (TreeF a) where traverse f (PChoiceF p i ts) = PChoiceF <$> pure p <*> pure i <*> traverse f ts traverse f (FChoiceF p i b ts) = FChoiceF <$> pure p <*> pure i <*> pure b <*> traverse f ts + traverse f (SChoiceF p i b ts) = SChoiceF <$> pure p <*> pure i <*> pure b <*> traverse f ts traverse f (GoalChoiceF ts) = GoalChoiceF <$> traverse f ts traverse _ (DoneF x ) = DoneF <$> pure x traverse _ (FailF c x ) = FailF <$> pure c <*> pure x hunk ./cabal-install/Distribution/Client/Dependency/Modular/Tree.hs 110 choices :: Tree a -> Int choices (PChoice _ _ ts) = P.length (P.filter active ts) choices (FChoice _ _ _ ts) = P.length (P.filter active ts) +choices (SChoice _ _ _ ts) = P.length (P.filter active ts) choices (GoalChoice _ ) = 1 choices (Done _ ) = 1 choices (Fail _ _ ) = 0 hunk ./cabal-install/Distribution/Client/Dependency/Modular/Tree.hs 120 lchoices :: Tree a -> Int lchoices (PChoice _ _ ts) = P.llength (P.filter active ts) lchoices (FChoice _ _ _ ts) = P.llength (P.filter active ts) +lchoices (SChoice _ _ _ ts) = P.llength (P.filter active ts) lchoices (GoalChoice _ ) = 1 lchoices (Done _ ) = 1 lchoices (Fail _ _ ) = 0 hunk ./cabal-install/Distribution/Client/Dependency/Modular/Validate.hs 94 -- Flag choices may occur repeatedly (because they can introduce new constraints -- in various places). However, subsequent choices must be consistent. We thereby -- collapse repeated flag choice nodes. - PA _ pfa <- asks pa -- obtain current flag-preassignment + PA _ pfa _ <- asks pa -- obtain current flag-preassignment case M.lookup qfn pfa of Just rb -> -- flag has already been assigned; collapse choice to the correct branch case P.lookup rb ts of hunk ./cabal-install/Distribution/Client/Dependency/Modular/Validate.hs 102 Nothing -> return $ Fail (toConflictSet (Goal (F qfn) gr)) (MalformedFlagChoice qfn) Nothing -> -- flag choice is new, follow both branches FChoice qfn gr b <$> sequence (P.mapWithKey (goF qfn gr) ts) + go (SChoiceF qsn (gr, _sc) b ts) = + do + -- Optional stanza choices are very similar to flag choices. + PA _ _ psa <- asks pa -- obtain current stanza-preassignment + case M.lookup qsn psa of + Just rb -> -- stanza choice has already been made; collapse choice to the correct branch + case P.lookup rb ts of + Just t -> goS qsn gr rb t + Nothing -> return $ Fail (toConflictSet (Goal (S qsn) gr)) (MalformedStanzaChoice qsn) + Nothing -> -- stanza choice is new, follow both branches + SChoice qsn gr b <$> sequence (P.mapWithKey (goS qsn gr) ts) -- We don't need to do anything for goal choices or failure nodes. go (GoalChoiceF ts) = GoalChoice <$> sequence ts hunk ./cabal-install/Distribution/Client/Dependency/Modular/Validate.hs 122 -- What to do for package nodes ... goP :: QPN -> QGoalReasons -> Scope -> I -> Validate (Tree QGoalReasons) -> Validate (Tree QGoalReasons) goP qpn@(Q _pp pn) gr sc i r = do - PA ppa pfa <- asks pa -- obtain current preassignment - idx <- asks index -- obtain the index - svd <- asks saved -- obtain saved dependencies + PA ppa pfa psa <- asks pa -- obtain current preassignment + idx <- asks index -- obtain the index + svd <- asks saved -- obtain saved dependencies let (PInfo deps _ _) = idx ! pn ! i -- obtain dependencies introduced by the choice let qdeps = L.map (fmap (qualify sc)) deps -- qualify the deps in the current scope -- the new active constraints are given by the instance we have chosen, hunk ./cabal-install/Distribution/Client/Dependency/Modular/Validate.hs 130 -- plus the dependency information we have for that instance let goal = Goal (P qpn) gr - let newactives = Dep qpn (Fixed i goal) : L.map (resetGoal goal) (extractDeps pfa qdeps) + let newactives = Dep qpn (Fixed i goal) : L.map (resetGoal goal) (extractDeps pfa psa qdeps) -- We now try to extend the partial assignment with the new active constraints. let mnppa = extend (P qpn) ppa newactives -- In case we continue, we save the scoped dependencies hunk ./cabal-install/Distribution/Client/Dependency/Modular/Validate.hs 139 Left (c, d) -> -- We have an inconsistency. We can stop. return (Fail c (Conflicting d)) Right nppa -> -- We have an updated partial assignment for the recursive validation. - local (\ s -> s { pa = PA nppa pfa, saved = nsvd }) r + local (\ s -> s { pa = PA nppa pfa psa, saved = nsvd }) r -- What to do for flag nodes ... goF :: QFN -> QGoalReasons -> Bool -> Validate (Tree QGoalReasons) -> Validate (Tree QGoalReasons) hunk ./cabal-install/Distribution/Client/Dependency/Modular/Validate.hs 144 goF qfn@(FN (PI qpn _i) _f) gr b r = do - PA ppa pfa <- asks pa -- obtain current preassignment - svd <- asks saved -- obtain saved dependencies + PA ppa pfa psa <- asks pa -- obtain current preassignment + svd <- asks saved -- obtain saved dependencies -- Note that there should be saved dependencies for the package in question, -- because while building, we do not choose flags before we see the packages -- that define them. hunk ./cabal-install/Distribution/Client/Dependency/Modular/Validate.hs 157 let npfa = M.insert qfn b pfa -- We now try to get the new active dependencies we might learn about because -- we have chosen a new flag. - let newactives = extractNewFlagDeps qfn gr b npfa qdeps + let newactives = extractNewDeps (F qfn) gr b npfa psa qdeps -- As in the package case, we try to extend the partial assignment. case extend (F qfn) ppa newactives of Left (c, d) -> return (Fail c (Conflicting d)) -- inconsistency found hunk ./cabal-install/Distribution/Client/Dependency/Modular/Validate.hs 161 - Right nppa -> local (\ s -> s { pa = PA nppa npfa }) r + Right nppa -> local (\ s -> s { pa = PA nppa npfa psa }) r + + -- What to do for stanza nodes (similar to flag nodes) ... + goS :: QSN -> QGoalReasons -> Bool -> Validate (Tree QGoalReasons) -> Validate (Tree QGoalReasons) + goS qsn@(SN (PI qpn _i) _f) gr b r = do + PA ppa pfa psa <- asks pa -- obtain current preassignment + svd <- asks saved -- obtain saved dependencies + -- Note that there should be saved dependencies for the package in question, + -- because while building, we do not choose flags before we see the packages + -- that define them. + let qdeps = svd ! qpn + -- We take the *saved* dependencies, because these have been qualified in the + -- correct scope. + -- + -- Extend the flag assignment + let npsa = M.insert qsn b psa + -- We now try to get the new active dependencies we might learn about because + -- we have chosen a new flag. + let newactives = extractNewDeps (S qsn) gr b pfa npsa qdeps + -- As in the package case, we try to extend the partial assignment. + case extend (S qsn) ppa newactives of + Left (c, d) -> return (Fail c (Conflicting d)) -- inconsistency found + Right nppa -> local (\ s -> s { pa = PA nppa pfa npsa }) r -- | We try to extract as many concrete dependencies from the given flagged -- dependencies as possible. We make use of all the flag knowledge we have hunk ./cabal-install/Distribution/Client/Dependency/Modular/Validate.hs 188 -- already acquired. -extractDeps :: FAssignment -> FlaggedDeps QPN -> [Dep QPN] -extractDeps fa deps = do +extractDeps :: FAssignment -> SAssignment -> FlaggedDeps QPN -> [Dep QPN] +extractDeps fa sa deps = do d <- deps case d of Simple sd -> return sd hunk ./cabal-install/Distribution/Client/Dependency/Modular/Validate.hs 195 Flagged qfn _ td fd -> case M.lookup qfn fa of Nothing -> mzero - Just True -> extractDeps fa td - Just False -> extractDeps fa fd + Just True -> extractDeps fa sa td + Just False -> extractDeps fa sa fd + Stanza qsn td -> case M.lookup qsn sa of + Nothing -> mzero + Just True -> extractDeps fa sa td + Just False -> [] -- | We try to find new dependencies that become available due to the given hunk ./cabal-install/Distribution/Client/Dependency/Modular/Validate.hs 203 --- flag choice. We therefore look for the flag in question, and then call +-- flag or stanza choice. We therefore look for the choice in question, and then call -- 'extractDeps' for everything underneath. hunk ./cabal-install/Distribution/Client/Dependency/Modular/Validate.hs 205 -extractNewFlagDeps :: QFN -> QGoalReasons -> Bool -> FAssignment -> FlaggedDeps QPN -> [Dep QPN] -extractNewFlagDeps qfn gr b fa = go +extractNewDeps :: Var QPN -> QGoalReasons -> Bool -> FAssignment -> SAssignment -> FlaggedDeps QPN -> [Dep QPN] +extractNewDeps v gr b fa sa = go where go deps = do d <- deps hunk ./cabal-install/Distribution/Client/Dependency/Modular/Validate.hs 213 case d of Simple _ -> mzero Flagged qfn' _ td fd - | qfn == qfn' -> L.map (resetGoal (Goal (F qfn) gr)) $ - if b then extractDeps fa td else extractDeps fa fd + | v == F qfn' -> L.map (resetGoal (Goal v gr)) $ + if b then extractDeps fa sa td else extractDeps fa sa fd | otherwise -> case M.lookup qfn' fa of Nothing -> mzero Just True -> go td hunk ./cabal-install/Distribution/Client/Dependency/Modular/Validate.hs 219 Just False -> go fd + Stanza qsn' td + | v == S qsn' -> L.map (resetGoal (Goal v gr)) $ + if b then extractDeps fa sa td else [] + | otherwise -> case M.lookup qsn' sa of + Nothing -> mzero + Just True -> go td + Just False -> [] -- | Interface. validateTree :: Index -> Tree (QGoalReasons, Scope) -> Tree QGoalReasons hunk ./cabal-install/Distribution/Client/Dependency/Modular/Validate.hs 229 -validateTree idx t = runReader (validate t) (VS idx M.empty (PA M.empty M.empty)) +validateTree idx t = runReader (validate t) (VS idx M.empty (PA M.empty M.empty M.empty)) hunk ./cabal-install/Distribution/Client/Types.hs 108 data OptionalStanza = TestStanzas | BenchStanzas - deriving (Eq, Show) + deriving (Eq, Ord, Show) enableStanzas :: [OptionalStanza] } Context: [updating dependencies in bootstrap.sh Andres Loeh **20120110203053 Ignore-this: e48d474f85eb4fd8383c0e8ded858260 Thanks to Tuncer Ayaz. ] [fix compilation with ghc-7.4 Andres Loeh **20120110200356 Ignore-this: c949a5ef384fb9a47fd6c6c3d1b0010 Thanks to Tuncer Ayaz. ] [Update dependencies Ian Lynagh **20111212214606 Ignore-this: ccc7ed3096d33aae6115a671a0996867 ] [Bump version to 1.14.0 Ian Lynagh **20111212214416 Ignore-this: 59dcc4f7ec38576350aa2d3d5e730394 ] [Added a comment. Andres Loeh **20120109080907 Ignore-this: 6f16ea76d8c01423cdfb3cb1601bdf04 ] [removing trailing whitespace Andres Loeh **20120101153235 Ignore-this: a5345cf959661ea4fca5d00d25f08129 ] [removing datatype contexts Andres Loeh **20111216144355 Ignore-this: d64302ae49aaffb4e713eeecadad4689 ] [Now require mtl-2 Duncan Coutts **20111117001719 Ignore-this: fd7314e32766ab9a0aa84c2138d5e393 ] [Include testsuites and benchmarks in external deps when enabled Duncan Coutts **20111116191455 Ignore-this: a6fd90e7645cbac6e5d9ad64b5991dad In particular this should fix ticket #871 where the cabal_macros.h is missing info for testsuite components. ] [When running haddock, only pass package deps for the component only Duncan Coutts **20111116191139 Ignore-this: a489d34257850af9b0b90718ed99fbcf rather than for the union of all components in the package. ] [Note in the README that you can install using the cabal program Duncan Coutts **20111111133113 Ignore-this: cbd5b54d3d120ac354bbcaed2e323e59 ] [changed --override-reinstall-check to --force-reinstalls Andres Loeh **20111107150713 Ignore-this: 8120844dc8479f7169cc8c0eb3e7bf97 Also adapted the message for the failed check. ] [do not print reinstall warning if --override-reinstall-check has been specified Andres Loeh **20111107101501 Ignore-this: 79634b89056c38a0c87ea1409762c893 ] [slightly modify a debug message in the new solver Andres Loeh **20111107101437 Ignore-this: eabc3949b3cb86235f3c2eb881ad25d8 ] [Fix fallout of Num / Show class changes in ghc-7.4 Duncan Coutts **20111104002510 Ignore-this: 2b646b5b5e73d692192576cab62f0565 ] [change solver default to TopDown for now Andres Loeh **20111103205744 Ignore-this: 10c65a306dd53948eb025bbd8645ee11 ] [removing dead code Andres Loeh **20111029141133 Ignore-this: b86c2a8dd2890059a069e54ef1a2be7 ] [goal choice heuristic in modular solver: choose base as early as possible Andres Loeh **20111029140041 Ignore-this: 4a4113b878e041d901deed7e42837286 ] [bugfix: wrong flag choice was sometimes shown in goal reasons Andres Loeh **20111029122324 Ignore-this: 6d0ea0605d767712e7d6116afd25269f ] [when printing the install plan, show non-default flag assignments Andres Loeh **20111029121515 Ignore-this: 4686e5efaf543c19b3435e3098609d8 ] [remove trailing whitespace Andres Loeh **20111029112245 Ignore-this: be59e8a32bf881f1d34f35aae84b8fc ] [proper fix for default solver option handling Andres Loeh **20111028112358 Ignore-this: 5e5816f9eddb4cdb14196d65e3501b00 Suggested by Duncan. ] [removing wrong option handling fix Andres Loeh **20111028111231 Ignore-this: a1cf3dedde8b6c535be11ae8dcac6fec ] [fixed a strange options handling bug Andres Loeh **20111028091727 Ignore-this: 6896824671481e929d7732b71d2a3d67 ] [revised solver flag configuration Andres Loeh **20111028073729 Ignore-this: 5497056c8815bd43d287ce38a1ad3589 ] [make solver configurable via command-line flag Andres Loeh **20111027212705 Ignore-this: d11264b74257f61720ab58fd1f04a50d ] [reactivate (but not use) the top-down resolver Andres Loeh **20111027190304 Ignore-this: 9741619c2052d21e8a7e28d2e941b6d5 ] [restore the index conversion utility function, but as a top-level function Andres Loeh **20111027190152 Ignore-this: 26dcf713c8075fb58f895cc55db00e98 ] [collapse repeated flag choices Andres Loeh **20111027161120 Ignore-this: 4b6f35c49675014002c4506eb7425fd In the build phase, we allow the same flag choice to occur multiple times. This makes it easy to handle the situation where the same flag occurs several times in the condition tree, and hence new goals and dependencies might be introduced depending on the choice. Previously, we have ensured during validation that repeated flag choices are consistent. This behaviour has now been replaced by the new approach to collapse repeated flag choice nodes completely during validation. The advantage is that the tree is less deep, and that the trace output looks less strange. Repeated flag choices are no longer seen, which I think avoids confusion. ] [fixing warnings Andres Loeh **20111027160944 Ignore-this: 2f99859d1585045fb292c69b4431e76f ] [adding a lookup function for PSQs Andres Loeh **20111027160924 Ignore-this: b404d9055ba4237fc4410ff8c102eb65 ] [minor clarification in naming Andres Loeh **20111027134534 Ignore-this: 2bd081c6adb7a8c5c888c8069696d1ae ] [removing dead code for global flag enforcement Andres Loeh **20111027133309 Ignore-this: 52be852bb715be5d83cf2e1db6169e8 This is all covered by the function that enforces package constraints, as global flag constraints are translated into package-specific flag constraints outside of the solver. ] [there may be more than one package constraint per package Andres Loeh **20111027133108 Ignore-this: 44ba0feece724fce97f498d22bd56c93 ] [in parsing user constraints, require a space to separate the initial package name Andres Loeh **20111027133021 Ignore-this: 335b77cc0e2ffadd1315a8ed42925d45 ] [add --override-reinstall-check option Jens Petersen **20111026124024 Ignore-this: 176b70d8e72e4ce6b65ad21611426069 This option flag overrides the new destructive reinstalls check, allowing forcing overwriting already installed library versions. The patch also documents this flag and other softer options in the output of printPlanMessages, which is renamed to checkPrintPlan. ] [treat ghc-prim like base as non-upgradeable in modular solver Andres Loeh **20111025063820 Ignore-this: 68acee21bcc5df42f4295f61a93a367d ] [merging changes from HEAD into modular-solver branch Andres Loeh **20111025063632 Ignore-this: 35fb9a9d8736d4b2bca35e36004d24c4 ] [Added a check for destructive reinstalls. Andres Loeh **20111021120831 Ignore-this: f343899c19a1b18156c8498cc1183d08 Some refactoring in Distribution.Client.Install: * the linear representation of an install plan is now typed * it can be checked for the presence of destructive reinstalls Currently, Cabal will stop if destructive reinstalls are encountered. While this should become default behaviour, there has to be a flag that overrides it. ] [merging modular solver with main branch Andres Loeh **20111021071736 Ignore-this: 57d24e3c979872682ee66abecbf808b2 ] [Added flag --independent-goals (not yet functioning correctly) Andres Loeh **20110709083556 Ignore-this: d420a08623f173a3483b1f8382d7af27 ] [Fixing a few warnings. Andres Loeh **20110708074744 Ignore-this: 395c2f791da6046c3e0b4ac73392f438 ] [make max backjumps configurable Andres Loeh **20110707092854 Ignore-this: e57965fad997f248e5c811040b4c511b ] [introduce backjump limit, and produce error messages Andres Loeh **20110705141536 Ignore-this: dce6d6d474f71e46a20c6bfc6633ee46 ] [Generalized the type of traversals. Andres Loeh **20110704184550 Ignore-this: f10a367f6c95b722f381afa4396adb9 ] [Added a Functor instance for search trees. Andres Loeh **20110704184533 Ignore-this: f872a3349ccbe64de991106476586188 ] [Rewrite traversals using a new combinator. Andres Loeh **20110704182930 Ignore-this: f989ec7fced87c9389fcd1a3e23b8896 The hope is that sooner or later we can apply fusion. ] [Refactoring: write traversals in a nicer way Andres Loeh **20110704175631 Ignore-this: 7f9942f74e237b165c2be6c9c28431fe ] [layout Andres Loeh **20110704173553 Ignore-this: 12c8ab24e372068fdfbb2e9cc04a1590 ] [Added a --reorder-goals flag. Andres Loeh **20110703143656 Ignore-this: c5a797b71d5050ac68ce4bb08b6f8bbd ] [switch goal reordering off by default Andres Loeh **20110703135217 Ignore-this: c7bc5a87f89c49793f9171cbb8aaac6a It surprised me somewhat, but goal reordering seems to slow things down, even for backtracking packages. It was supposed to speed things up, but it's possible that backjumping works so nicely that it more than compensates for the effects. More systematic testing might be needed. ] [switch to less precise, more efficient goal reordering Andres Loeh **20110703134359 Ignore-this: b9d1c7c8ce62480fb5885ef61c388677 ] [Refactoring: use toConflictSet Andres Loeh **20110703132011 Ignore-this: e5c90d6c2dfe391d8becef3e6b667e00 ] [better conflict reporting Andres Loeh **20110703131435 Ignore-this: f331ae416dc2606a903b7a563406a4c1 ] [Keep better track of goal reasons. Andres Loeh **20110703101721 Ignore-this: d8b77e6b03fd089dd70095620ee49039 ] [typo Andres Loeh **20110630121901 Ignore-this: 78cd22e1681dd9ddd9280acd764b0795 ] [Refactoring: moving goals to Dependency module Andres Loeh **20110630121018 Ignore-this: 3f3e5a8debd4d6fd095f5f267a4710c7 ] [adding a command-line flag to avoid reinstalls Andres Loeh **20110630101721 Ignore-this: e18974fd5c10e5b6e0a2450299b4f8a3 ] [make conflict sets slightly larger Andres Loeh **20110621140618 Ignore-this: a17f29faddb8e955bd1c0c0a2ded71f7 This is slower, however seems more correct. Larger conflict sets typically mean fewer possibilities to cut the search space. On the other hand, cutting too much risks incompleteness. At some later stage, we might want to try hard to think about how/if conflict sets could be reduced in size. ] [more compact output for multiple subsequently rejected packages Andres Loeh **20110621133231 Ignore-this: f2cdeac0e73501ac600ff6e29daf7605 ] [debug output for backjumping Andres Loeh **20110621113210 Ignore-this: 6353021aec10f411abb2447534a151c9 ] [documentation for backjumping Andres Loeh **20110621094547 Ignore-this: cf54c33b4bb632ad7dcc5429ae46189 ] [maintain chains of GoalReasons Andres Loeh **20110621075136 Ignore-this: 3a1301ad75703a892e10b1796d7012ac Bugfix: conflict sets now contain the transitive closure of goal reasons, which is required for completeness. We now finally have sufficient info to produce good error messages, too. At a failure site, we can trace which parts of the tree are relevant to the failure, via the correctly generated conflict sets. ] [refactoring: conflict sets are now sets instead of lists Andres Loeh **20110620213330 Ignore-this: 5b428bd4bb4cce656fc05762bd10aa88 ] [implemented a version of backjumping Andres Loeh **20110620171957 Ignore-this: e4125293151373f684be57d233b7f536 ] [annotate with goal reason throughout reordering phase Andres Loeh **20110620150603 Ignore-this: d35069fa5f8da4bfdbb816e2e357675c ] [no annotations needed in goal choices Andres Loeh **20110620144923 Ignore-this: 6aa29a706003651994b6493a1520af1f ] [refactoring: change the way tree annotations are handled Andres Loeh **20110620143641 Ignore-this: 9ea74e5fed8b63b363d468f585efade2 ] [build conflict sets Andres Loeh **20110620143443 Ignore-this: c648018f1a948f48bfd4780e1aab7cdd ] [provide more info about conflicts Andres Loeh **20110620130453 Ignore-this: d83f29eb56377129b40f6038cc6b1643 ] [proper constraint origins also for flag-introduced dependencies Andres Loeh **20110620100852 Ignore-this: 6cc63c642dbb2fb01c58de558c98c7b9 ] [store origin info in constrained instances Andres Loeh **20110620095808 Ignore-this: 59cf77a2c8009d3061dd9bbbff3e24b6 ] [Ignore self-dependencies (of executables on libraries). Andres Loeh **20110620073104 Ignore-this: 843b67aba3b1d5d888d57445633c8161 ] [Reactivate output of changes for reinstalled pkgs in install plan Andres Loeh **20110619163520 Ignore-this: 6058ad537ea93399ce1dadf677360943 ] [Bugfix: wrong flag name was used while adding new dependencies Andres Loeh **20110619154841 Ignore-this: 6d5fb52890b518bd33f9bf0c5e274c72 ] [Bugfix: ignore broken packages. Andres Loeh **20110616065422 Ignore-this: acba4e209ac0603c295f05153c0d1dd8 ] [produce a bit more compact debugging output Andres Loeh **20110615114213 Ignore-this: d1f134808e33a47ccfe3d431eb3af44c ] [fix package ordering bug Andres Loeh **20110615073630 Ignore-this: 945f696c0467974e9463c4b8efb1d1d2 ] [change avoidReinstalls default, to match old Cabal solver Andres Loeh **20110615072835 Ignore-this: cf1e95a0f3cf1d8ea2186dae35e35861 ] [integrate the modular solver into cabal-install repo Andres Loeh **20110615070720 Ignore-this: c9dd7139bf2d29114991b2f23a9989f3 ] [New solver now respects preferences. Andres Loeh **20110615070343 Ignore-this: 9442ddf244f28a0447560a54ffe3928b ] [updated Cabal file Andres Loeh **20110614213015 Ignore-this: a0a208a6c8d57efb50a6ef28b9b9f80c ] [properly translate package constraints Andres Loeh **20110614212736 Ignore-this: 518cb0e05af8e163235528c495d4ec4 ] [whitespace Andres Loeh **20110614101908 Ignore-this: a6215083dd56f50cf21ff813d8d9a7b2 ] [modular resolver now standard Andres Loeh **20110614101850 Ignore-this: fcf6d1d7443720e26f4ad5d9b8f944bb ] [use InstalledPackageIndex throughout Andres Loeh **20110614101525 Ignore-this: 6a86fd2d78b38815be8026314488c5db ] [started the solver interface conversion Andres Loeh **20110605125221 Ignore-this: 24e988891e3b3a91645763f1a54c3de1 ] [added a module for the interface to the new solver Andres Loeh **20110605124213 Ignore-this: 1b43f04a29a8f4c88b94cb9d20fa0854 ] [integrated index conversion functions Andres Loeh **20110605122430 Ignore-this: c6a3427e1e068b6bec8aba54c9e587e4 ] [added Progress instances Andres Loeh **20110605112809 Ignore-this: 9ec44d6bceb4fd8310d2770843d818a6 ] [reordering Andres Loeh **20110605110341 Ignore-this: bb889dea57cc8b9dbf63a8a3685d2433 ] [include the new solver in the dependency hierarchy Andres Loeh **20110605110052 Ignore-this: 5d8dc387d44ffe7917d70d92bccf34ee ] [moving PackagesPreferenceDefault Andres Loeh **20110605110028 Ignore-this: a2e86dd13af1622856626a7f8cbb909c ] [updated Cabal file to include modular solver modules Andres Loeh **20110605100942 Ignore-this: 2a99b8c12681530e795cd16450877de6 ] [Bump major version to 1.13 Duncan Coutts **20111026204346 Ignore-this: 143bf697f22b7225757c9907b37d8fbb Since 1.12 got released with ghc-7.2.x ] [Register 'bench' command with the CLI Johan Tibell **20111026005309 Ignore-this: 69168a6e951f5dcea6e9826704487d47 ] [Briefly document 'cabal test' and 'cabal bench' Johan Tibell **20111026002738 Ignore-this: ccfb88fa6bec02eef62cf2dee34807c2 ] [Small doc fix in Benchmarks section Bas van Dijk **20111025184055 Ignore-this: 5512c7f5d959335d73a8b9c427193d36 ] [typos in benchmarks documentation/help Simon Meier **20111025183032 Ignore-this: 3f6ecc518bce2d1d07380e35c1b7f160 ] [Describe benchmark sections in the user guide Johan Tibell **20111019153233 Ignore-this: 349a426ca769cfea19c5f784846e8a95 ] [Fix source repo subdir name after cabal->Cabal dir rename Duncan Coutts **20111023214425 Ignore-this: e1e0327576da9bfc45056ef69c74e28a ] [Add a source package index cache to speed up reading Duncan Coutts **20111023213253 Ignore-this: d35c7eeaba12305fc9a5f1b1c146c902 e.g. about 3x faster for cabal info pkgname ] [Bump versions of Cabal and cabal-install Duncan Coutts **20111023213924 Ignore-this: b298e60d9b5eada94f0f40edf942f031 Latest cabal-install requires latest Cabal due to api addition ] [Fail gracefully if 'cabal bench' is run before 'cabal build' Johan Tibell **20111013232847 Ignore-this: 9c73bb0b650fe4b06a5515bef7587cfd ] [Add unit test for 'cabal bench' command-line flags Johan Tibell **20111013232109 Ignore-this: fc3e53a768c3c971a8f5e3a6e187ba2d ] [Implement 'cabal bench' command Johan Tibell **20111013225615 Ignore-this: 34a2e6e5bdc13d16eaadc48a2efe2d75 The only implement benchmark interface so far is exitcode-stdio-1.0, which forwards the output of the benchmark executable being run to the parent process' stdout/stderr. ] [Add package checks for benchmarks Johan Tibell **20111012201604 Ignore-this: ce4094004ab81b6f60d69a30f6f16247 Refactor duplicate names check to avoid having to manually write all O(n^2) possible collision cases between executables, test suites, and benchmarks. ] [Uploading build reports shouldn't fail if there are no reports Max Bolingbroke **20111016143819 Ignore-this: 7423a9c3a67a581c04502912fc08f460 ] [Add a (substituted) flag to allow configuration of Haddock's --use-contents flag Max Bolingbroke **20111016110852 Ignore-this: 33d1cc9683e9e3e421c2ca54dc745de0 ] [Allow Haddock to be configured from the 'install' command Max Bolingbroke **20111015170101 Ignore-this: af173867f239b0259490445f27756ad9 ] [Rename the cabal directory to Cabal Ian Lynagh **20111023151002 Ignore-this: ff444b152bfc981496c6e2d2206a4953 Makes things a little simpler in GHC's build system if libraries are in the same directory as their name. ] [Change Safe Haskell package trust default to untrusted David Terei **20111018033319 Ignore-this: 2b7ea14f983abf92b8c7dca67b280d4a ] [Install phase pulls in benchmark dependencies when necessary Johan Tibell **20111012210035 Ignore-this: 9b055441a6fec970fbb2aaa6f4cb4406 ] [Include benchmarks in product of 'setup sdist' Johan Tibell **20111012205036 Ignore-this: 216583b2d9ae5312aaf3da043bf45b6 ] [Add unit test for building benchmarks Johan Tibell **20111012154138 Ignore-this: b66404f7b8829e67223c0222cbc98b10 ] [Build executable benchmarks Johan Tibell **20111012143034 Ignore-this: 26ba0c0ab2476bef33c2e4c0b2e0c8d9 Benchmarks are treated just like test suites in that a dummy Executable is created and built. ] [Add unit test for benchmark section Johan Tibell **20111011195847 Ignore-this: 672f8848e5ce9cb2e321894506176b3e ] [Implement 'configure' and preprocessing for benchmarks Johan Tibell **20111011194838 Ignore-this: 519cfe1fd6bb6ac0ccc4f10d2d037897 ] [Parse the --{enable,disable}-benchmarks command line flag Johan Tibell **20111011192349 Ignore-this: 268674c925d07184b6efc11a38d65d6f ] [Parse 'benchmark' sections and handle configurations (flags) for benchmarks Johan Tibell **20111011191515 Ignore-this: e6b671538374a5db09b995ab1a233ce2 ] [Add a Benchmark data type for representing 'benchmark' sections Johan Tibell **20111011175849 Ignore-this: aba4698167e15db635302e577b871b1b ] [Use the configured proxy even for uploading build reports Max Bolingbroke **20110928210859 Ignore-this: 189a21577bfe5a651850feda891955e2 ] [GHC 7.2+ no longer generates _stub.o files Duncan Coutts **20110910195329 Ignore-this: e7b432affc79e4d7c418c03be7e55acc So stop looking for them. This could otherwise cause problems if one switches ghc version without cleaning the build dir since we'll pick up the old _stub.o files and end up with duplicate linker symbols. ] [Use a PVP-style version as the default for cabal init Duncan Coutts **20110925021722 Ignore-this: 58c054d082254c4bcf26cd4601317f2 ] [Filter autogenerated modules from test suite build info when doing sdist. Thomas Tuegel **20110923201806 Ignore-this: 6f1eb9a1af8fad0442544d05d2568db9 ] [Change extension name to "ConstraintKinds" Duncan Coutts **20110908220819 Ignore-this: a5faf4ded03ba1394278c810a8136bf2 For consistency with the rest of the extensions. Requested by SPJ. ] [Add the ConstraintKind extension Max Bolingbroke **20110906094145 Ignore-this: 838aa67afada51bc8f023a24531a0d0d ] [Fix a typo in a QA message Duncan Coutts **20110905001515 Ignore-this: e906b589e4acea1121ac193998696751 ] [Better error message for unknown build types Duncan Coutts **20110901114046 Ignore-this: 91989561ff78edbe3d72b7d569db4561 ] [Consistent import of Text.PrettyPrint David Terei **20110825180411 Ignore-this: 785b7c0aaad8b997678c1e68b90502f8 ] [Drop assertion checking in the old solver Duncan Coutts **20110818172118 Ignore-this: a516461e7f19e2aa2109fc905ac85 Make it a bit faster. ] [Update version constraint on the Cabal library, for 1.12 release. Duncan Coutts **20110818171955 Ignore-this: 870a523382e1e0cec2b5cd033c778359 ] [Add cabal sdist --zip flag for creating zip archives Duncan Coutts **20110818171721 Ignore-this: 86469c0f4f4b72d58b6278c3ef692901 Handy if you want to send sources to people who do not grok .tar.gz Requires that the 'zip' program be installed (unlike for .tar.gz where we do it internally so that it works on all systems). ] [Relax cabal-install's deps for ghc-7.2 Duncan Coutts **20110812110846 Ignore-this: 1524732bffa5cc04e5d475ec4c4f12d8 ] [Fix the repo location Duncan Coutts **20110812110820 Ignore-this: 1ed9152864fc3336c82495904b1e5612 ] [Improve the error message emitted when multiple .cabal files are found Duncan Coutts **20110508223014 Ignore-this: 1c96d4f42fe55094f07b0573bb80fda1 ] [Add Safe Haskell flags to known extensions David Terei **20110810201543 Ignore-this: 9e0a42de1539e1a56d72f9a7ecdf554c ] [Change trusted property to be true by default David Terei **20110808223228 Ignore-this: c46cf169c46b809cf457678f77e02b20 ] [Fix for intra-package build-tools dependencies Duncan Coutts **20110808165045 Ignore-this: 83f148981c7d8d3c616027975ee8f59a ] [Simplify some code in Program.Hpc slightly Duncan Coutts **20110726001531 Ignore-this: d7ea77d1f072f7071fc709e0c9a38ded ] [Added Distribution.Simple.Program.Hpc. Thomas Tuegel **20110719004251 Ignore-this: a988f4262e4f52c8ae0a3ca5715a636e ] [Restore graceful failure upon invoking "cabal test" before "cabal build". Thomas Tuegel **20110719002218 Ignore-this: 2096a4cfad17eb67ef26bb15a8b3a066 ] [Fix executable test suite unit test for improved HPC interface. Thomas Tuegel **20110718033150 Ignore-this: b543b01721940b23aac7bd46282425b1 ] [Generate aggregate coverage statistics from all test suites in package. Thomas Tuegel **20110718050448 Ignore-this: bff5f3167ab61da015b8fcb7c4f77cdc ] [Invoke HPC using D.S.Program utilities. Thomas Tuegel **20110718045949 Ignore-this: 37e1f01f594dd522c5328b397ac0e94d This patch also reorganizes the HPC output directories for consistency. All files related to HPC are now located in the "dist/hpc" directory. ] [Fix cabal haddock for packages with internal dependencies Duncan Coutts **20110718235728 Ignore-this: 86cdab6325a86875e9ae592881b4f54f ] [Update cabal sdist to follow the changes in the Cabal lib Duncan Coutts **20110717223648 Ignore-this: 1136aa98cb024a10250ea75ec8633a2c ] [Added unit test for test options. Thomas Tuegel **20110521164529 Ignore-this: 3dc94c06cdfacf20cf000682370fbf3 ] [Fixed crash on Windows due to file handle leak. Thomas Tuegel **20110518030422 Ignore-this: c94eb903aef9ffcf52394a821d245dda Ticket #843. Cabal test crashed when trying to delete a temporary log file because 'readFile' reads unnecessarily lazily and was keeping a file handle open during attempted deletion. This patch forces the entire file to be read so the handle will be closed. ] [Stop cabal-install from duplicating test options. Thomas Tuegel **20110521232047 Ignore-this: 55b98ab47306178e355cacedc7a5a6d2 ] [Fix use of multiple test options. Thomas Tuegel **20110521223029 Ignore-this: c694ad21faab23abb7157ccec700ccf2 ] [Don't prefix test output with ">>>". Thomas Tuegel **20110708035007 Ignore-this: a9d417eb836c641339a0203d1c36e82e Ticket #848. Removing the prefix brings "cabal test" in line with other cabal commands, which do not prefix their output, either. Prior to this patch, the summary notices which appear before and after each test suite were written to the temporary log file along with the stdio from the test executable; this would lead to duplicate notices when the contents of the temporary log file are read onto the console. After this patch, the summary notices are never written to the temporary log file, only to the console and the final log file (which is never read by Cabal), removing the confusing duplicate notices. ] [Fail gracefully when running "setup test" before "setup build". Thomas Tuegel **20110303164611 Ignore-this: a4d818cd7702ddbbbbffc8679abeb85d ] [Bump cabal-install version Duncan Coutts **20110708013248 Ignore-this: 16626faad564787fc5ae3808d1e6ccc9 ] [Bump Cabal lib version Duncan Coutts **20110708013245 Ignore-this: e01c7efbb68856167c227ba118ddce33 ] [Couple of trivial code changes Duncan Coutts **20110708013012 Ignore-this: b98aaac9e33f8c684cefedcd05d37ee2 ] [Fix withComponentsLBI and move Components to LocalBuildInfo module Duncan Coutts **20110708012122 Ignore-this: 57217119f7825c9bcd3824a34ecd0c8f An annoyance of the current Simple build system is that each phase (build, install, etc) can be passed additional HookedBuildInfo which gets merged into the PackageDescription. This means that we cannot process the PackageDescription up front at configure time and just store and reuse it later, we have to work from it each time afresh. The recent addition of Components (libs, exes, test suites) and a topoligical sort of the components in the LocalBuildInfo fell foul of this annoyance. The LocalBuildInfo stored the entire component which meant they were not updated with the HookedBuildInfo. This broke packages with custom Setup.hs scripts that took advantage of the HookedBuildInfo feature, including those with configure scripts. The solution is to store not the list of whole components but the list of component names. Then withComponentsLBI retrieves the actual components from the PackageDescription which thus includes the HookedBuildInfo. Also moved the Components into an internal module because (for the moment at least) it is part of the Simple build system, not part of the package description. ] [Relax some dependencies Ian Lynagh **20110706192619 Ignore-this: 6353c1d64a2fff3cef3ca0d8a9f2e95e ] [Add files needed by the GHC build system Ian Lynagh **20110624003654 Ignore-this: a40dd98104e994d1a1648c3ce2676a45 ] [Add a dash separator for pid in createTempDirectory and openBinaryTempFile too Jens Petersen **20110519021658 Ignore-this: ee0c842388212326579309ac6f93408f ] [Update changelog for 1.10.2.0 Duncan Coutts **20110618190748 Ignore-this: 64129f45dd16d2d93c82097530dc15d1 ] [TAG cabal-install merged Duncan Coutts **20110619135228 Ignore-this: 58d670de46a24046d0b869dc2b88e13a We now have both the Cabal library and the cabal-install tool together in the same repo, each in a subdir. The idea is that this will make splitting packages and moving code between package rather easier in future. ] Patch bundle hash: c8deb17be548c4d2a39de98c3a79d523d1644a90