diff --git a/Cabal/Distribution/PackageDescription.hs b/Cabal/Distribution/PackageDescription.hs index 7131c6ff643..12f4157151e 100644 --- a/Cabal/Distribution/PackageDescription.hs +++ b/Cabal/Distribution/PackageDescription.hs @@ -64,7 +64,6 @@ module Distribution.PackageDescription ( hasTests, withTest, testModules, - enabledTests, -- * Benchmarks Benchmark(..), @@ -76,7 +75,6 @@ module Distribution.PackageDescription ( hasBenchmarks, withBenchmark, benchmarkModules, - enabledBenchmarks, -- * Build information BuildInfo(..), @@ -450,8 +448,12 @@ hasPublicLib p = any f (libraries p) hasLibs :: PackageDescription -> Bool hasLibs p = any (buildable . libBuildInfo) (libraries p) --- |If the package description has a library section, call the given --- function with the library build info as argument. +-- | If the package description has a buildable library section, +-- call the given function with the library build info as argument. +-- You probably want 'withLibLBI' if you have a 'LocalBuildInfo', +-- see the note in +-- "Distribution.Simple.LocalBuildInfo#buildable_vs_enabled_components" +-- for more information. withLib :: PackageDescription -> (Library -> IO ()) -> IO () withLib pkg_descr f = sequence_ [f lib | lib <- libraries pkg_descr, buildable (libBuildInfo lib)] @@ -536,7 +538,10 @@ hasExes :: PackageDescription -> Bool hasExes p = any (buildable . buildInfo) (executables p) -- | Perform the action on each buildable 'Executable' in the package --- description. +-- description. You probably want 'withExeLBI' if you have a +-- 'LocalBuildInfo', see the note in +-- "Distribution.Simple.LocalBuildInfo#buildable_vs_enabled_components" +-- for more information. withExe :: PackageDescription -> (Executable -> IO ()) -> IO () withExe pkg_descr f = sequence_ [f exe | exe <- executables pkg_descr, buildable (buildInfo exe)] @@ -553,13 +558,7 @@ exeModules exe = otherModules (buildInfo exe) data TestSuite = TestSuite { testName :: String, testInterface :: TestSuiteInterface, - testBuildInfo :: BuildInfo, - testEnabled :: Bool - -- TODO: By having a 'testEnabled' field in the PackageDescription, we - -- are mixing build status information (i.e., arguments to 'configure') - -- with static package description information. This is undesirable, but - -- a better solution is waiting on the next overhaul to the - -- GenericPackageDescription -> PackageDescription resolution process. + testBuildInfo :: BuildInfo } deriving (Generic, Show, Read, Eq, Typeable, Data) @@ -597,8 +596,7 @@ instance Monoid TestSuite where mempty = TestSuite { testName = mempty, testInterface = mempty, - testBuildInfo = mempty, - testEnabled = False + testBuildInfo = mempty } mappend = (Semi.<>) @@ -606,8 +604,7 @@ instance Semigroup TestSuite where a <> b = TestSuite { testName = combine' testName, testInterface = combine testInterface, - testBuildInfo = combine testBuildInfo, - testEnabled = testEnabled a || testEnabled b + testBuildInfo = combine testBuildInfo } where combine field = field a `mappend` field b combine' f = case (f a, f b) of @@ -631,14 +628,14 @@ emptyTestSuite = mempty hasTests :: PackageDescription -> Bool hasTests = any (buildable . testBuildInfo) . testSuites --- | Get all the enabled test suites from a package. -enabledTests :: PackageDescription -> [TestSuite] -enabledTests = filter testEnabled . testSuites - -- | Perform an action on each buildable 'TestSuite' in a package. +-- You probably want 'withTestLBI' if you have a 'LocalBuildInfo', see the note in +-- "Distribution.Simple.LocalBuildInfo#buildable_vs_enabled_components" +-- for more information. + withTest :: PackageDescription -> (TestSuite -> IO ()) -> IO () withTest pkg_descr f = - mapM_ f $ filter (buildable . testBuildInfo) $ enabledTests pkg_descr + sequence_ [ f test | test <- testSuites pkg_descr, buildable (testBuildInfo test) ] -- | Get all the module names from a test suite. testModules :: TestSuite -> [ModuleName] @@ -699,9 +696,7 @@ testType test = case testInterface test of data Benchmark = Benchmark { benchmarkName :: String, benchmarkInterface :: BenchmarkInterface, - benchmarkBuildInfo :: BuildInfo, - benchmarkEnabled :: Bool - -- TODO: See TODO for 'testEnabled'. + benchmarkBuildInfo :: BuildInfo } deriving (Generic, Show, Read, Eq, Typeable, Data) @@ -735,8 +730,7 @@ instance Monoid Benchmark where mempty = Benchmark { benchmarkName = mempty, benchmarkInterface = mempty, - benchmarkBuildInfo = mempty, - benchmarkEnabled = False + benchmarkBuildInfo = mempty } mappend = (Semi.<>) @@ -744,8 +738,7 @@ instance Semigroup Benchmark where a <> b = Benchmark { benchmarkName = combine' benchmarkName, benchmarkInterface = combine benchmarkInterface, - benchmarkBuildInfo = combine benchmarkBuildInfo, - benchmarkEnabled = benchmarkEnabled a || benchmarkEnabled b + benchmarkBuildInfo = combine benchmarkBuildInfo } where combine field = field a `mappend` field b combine' f = case (f a, f b) of @@ -769,14 +762,14 @@ emptyBenchmark = mempty hasBenchmarks :: PackageDescription -> Bool hasBenchmarks = any (buildable . benchmarkBuildInfo) . benchmarks --- | Get all the enabled benchmarks from a package. -enabledBenchmarks :: PackageDescription -> [Benchmark] -enabledBenchmarks = filter benchmarkEnabled . benchmarks - -- | Perform an action on each buildable 'Benchmark' in a package. +-- You probably want 'withBenchLBI' if you have a 'LocalBuildInfo', see the note in +-- "Distribution.Simple.LocalBuildInfo#buildable_vs_enabled_components" +-- for more information. + withBenchmark :: PackageDescription -> (Benchmark -> IO ()) -> IO () withBenchmark pkg_descr f = - mapM_ f $ filter (buildable . benchmarkBuildInfo) $ enabledBenchmarks pkg_descr + sequence_ [f bench | bench <- benchmarks pkg_descr, buildable (benchmarkBuildInfo bench)] -- | Get all the module names from a benchmark. benchmarkModules :: Benchmark -> [ModuleName] @@ -939,12 +932,10 @@ allBuildInfo pkg_descr = [ bi | lib <- libraries pkg_descr , buildable bi ] ++ [ bi | tst <- testSuites pkg_descr , let bi = testBuildInfo tst - , buildable bi - , testEnabled tst ] + , buildable bi ] ++ [ bi | tst <- benchmarks pkg_descr , let bi = benchmarkBuildInfo tst - , buildable bi - , benchmarkEnabled tst ] + , buildable bi ] --FIXME: many of the places where this is used, we actually want to look at -- unbuildable bits too, probably need separate functions diff --git a/Cabal/Distribution/PackageDescription/Check.hs b/Cabal/Distribution/PackageDescription/Check.hs index 2d57fa42d9e..382c0152dd5 100644 --- a/Cabal/Distribution/PackageDescription/Check.hs +++ b/Cabal/Distribution/PackageDescription/Check.hs @@ -43,6 +43,7 @@ import Distribution.Simple.Utils hiding (findPackageDesc, notice) import Distribution.Version import Distribution.Package import Distribution.Text +import Distribution.Simple.LocalBuildInfo hiding (compiler) import Language.Haskell.Extension import Data.Maybe @@ -1288,7 +1289,7 @@ checkPackageVersions pkg = -- open upper bound. To get a typical configuration we finalise -- using no package index and the current platform. finalised = finalizePackageDescription - [] (const True) buildPlatform + [] defaultComponentEnabled (const True) buildPlatform (unknownCompilerInfo (CompilerId buildCompilerFlavor (Version [] [])) NoAbiTag) [] pkg diff --git a/Cabal/Distribution/PackageDescription/Configuration.hs b/Cabal/Distribution/PackageDescription/Configuration.hs index 961dae9e201..643f4ed2410 100644 --- a/Cabal/Distribution/PackageDescription/Configuration.hs +++ b/Cabal/Distribution/PackageDescription/Configuration.hs @@ -48,6 +48,7 @@ import Distribution.Text import Distribution.Compat.ReadP as ReadP hiding ( char ) import qualified Distribution.Compat.ReadP as ReadP ( char ) import Distribution.Compat.Semigroup as Semi +import Distribution.Simple.LocalBuildInfo import Control.Arrow (first) import Data.Char ( isAlphaNum ) @@ -211,6 +212,7 @@ instance Semigroup d => Semigroup (DepTestRslt d) where resolveWithFlags :: [(FlagName,[Bool])] -- ^ Domain for each flag name, will be tested in order. + -> ComponentEnabledSpec -> OS -- ^ OS as returned by Distribution.System.buildOS -> Arch -- ^ Arch as returned by Distribution.System.buildArch -> CompilerInfo -- ^ Compiler information @@ -220,7 +222,7 @@ resolveWithFlags :: -> Either [Dependency] (TargetSet PDTagged, FlagAssignment) -- ^ Either the missing dependencies (error case), or a pair of -- (set of build targets with dependencies, chosen flag assignments) -resolveWithFlags dom os arch impl constrs trees checkDeps = +resolveWithFlags dom enabled os arch impl constrs trees checkDeps = either (Left . fromDepMapUnion) Right $ explore (build [] dom) where extraConstrs = toDepMap constrs @@ -245,7 +247,7 @@ resolveWithFlags dom os arch impl constrs trees checkDeps = -- apply additional constraints to all dependencies first (`constrainBy` extraConstrs) . simplifyCondTree (env flags) - deps = overallDependencies targetSet + deps = overallDependencies enabled targetSet in case checkDeps (fromDepMap deps) of DepOk | null ts -> Right (targetSet, flags) | otherwise -> tryAll $ map explore ts @@ -416,15 +418,15 @@ newtype TargetSet a = TargetSet [(DependencyMap, a)] -- | Combine the target-specific dependencies in a TargetSet to give the -- dependencies for the package as a whole. -overallDependencies :: TargetSet PDTagged -> DependencyMap -overallDependencies (TargetSet targets) = mconcat depss +overallDependencies :: ComponentEnabledSpec -> TargetSet PDTagged -> DependencyMap +overallDependencies enabled (TargetSet targets) = mconcat depss where (depss, _) = unzip $ filter (removeDisabledSections . snd) targets removeDisabledSections :: PDTagged -> Bool - removeDisabledSections (Lib _ l) = buildable (libBuildInfo l) - removeDisabledSections (Exe _ e) = buildable (buildInfo e) - removeDisabledSections (Test _ t) = testEnabled t && buildable (testBuildInfo t) - removeDisabledSections (Bench _ b) = benchmarkEnabled b && buildable (benchmarkBuildInfo b) + removeDisabledSections (Lib _ l) = componentEnabled enabled (CLib l) + removeDisabledSections (Exe _ e) = componentEnabled enabled (CExe e) + removeDisabledSections (Test _ t) = componentEnabled enabled (CTest t) + removeDisabledSections (Bench _ b) = componentEnabled enabled (CBench b) removeDisabledSections PDNull = True -- Apply extra constraints to a dependency map. @@ -505,6 +507,10 @@ flattenTaggedTargets (TargetSet targets) = foldr untag ([], [], [], []) targets -- Convert GenericPackageDescription to PackageDescription -- +-- ezyang: Arguably, this should be: +-- data PDTagged = PDComp String Component +-- | PDNull +-- Also, what the heck is the String? The componentName? data PDTagged = Lib String Library | Exe String Executable | Test String TestSuite @@ -549,6 +555,7 @@ instance Semigroup PDTagged where -- finalizePackageDescription :: FlagAssignment -- ^ Explicitly specified flag assignments + -> ComponentEnabledSpec -> (Dependency -> Bool) -- ^ Is a given dependency satisfiable from the set of -- available packages? If this is unknown then use -- True. @@ -560,7 +567,7 @@ finalizePackageDescription :: (PackageDescription, FlagAssignment) -- ^ Either missing dependencies or the resolved package -- description along with the flag assignments chosen. -finalizePackageDescription userflags satisfyDep +finalizePackageDescription userflags enabled satisfyDep (Platform arch os) impl constraints (GenericPackageDescription pkg flags libs0 exes0 tests0 bms0) = case resolveFlags of @@ -569,7 +576,7 @@ finalizePackageDescription userflags satisfyDep , executables = exes' , testSuites = tests' , benchmarks = bms' - , buildDepends = fromDepMap (overallDependencies targetSet) + , buildDepends = fromDepMap (overallDependencies enabled targetSet) } , flagVals ) @@ -582,7 +589,7 @@ finalizePackageDescription userflags satisfyDep ++ map (\(name,tree) -> mapTreeData (Bench name) tree) bms0 resolveFlags = - case resolveWithFlags flagChoices os arch impl constraints condTrees check of + case resolveWithFlags flagChoices enabled os arch impl constraints condTrees check of Right (targetSet, fs) -> let (libs, exes, tests, bms) = flattenTaggedTargets targetSet in Right ( (map (\(n,l) -> (libFillInDefaults l) { libName = n }) libs, diff --git a/Cabal/Distribution/PackageDescription/PrettyPrint.hs b/Cabal/Distribution/PackageDescription/PrettyPrint.hs index 297219769a1..94e8b887136 100644 --- a/Cabal/Distribution/PackageDescription/PrettyPrint.hs +++ b/Cabal/Distribution/PackageDescription/PrettyPrint.hs @@ -152,10 +152,10 @@ ppTestSuites suites = maybeTestType | testInterface testsuite == mempty = Nothing | otherwise = Just (testType testsuite) - ppTestSuite (TestSuite _ _ buildInfo' _) - (Just (TestSuite _ _ buildInfo2 _)) = - ppDiffFields binfoFieldDescrs buildInfo' buildInfo2 - $+$ ppCustomFields (customFieldsBI buildInfo') + ppTestSuite test' (Just test2) = + ppDiffFields binfoFieldDescrs + (testBuildInfo test') (testBuildInfo test2) + $+$ ppCustomFields (customFieldsBI (testBuildInfo test')) testSuiteMainIs test = case testInterface test of TestSuiteExeV10 _ f -> Just f @@ -182,10 +182,10 @@ ppBenchmarks suites = maybeBenchmarkType | benchmarkInterface benchmark == mempty = Nothing | otherwise = Just (benchmarkType benchmark) - ppBenchmark (Benchmark _ _ buildInfo' _) - (Just (Benchmark _ _ buildInfo2 _)) = - ppDiffFields binfoFieldDescrs buildInfo' buildInfo2 - $+$ ppCustomFields (customFieldsBI buildInfo') + ppBenchmark bench' (Just bench2) = + ppDiffFields binfoFieldDescrs + (benchmarkBuildInfo bench') (benchmarkBuildInfo bench2) + $+$ ppCustomFields (customFieldsBI (benchmarkBuildInfo bench')) benchmarkMainIs benchmark = case benchmarkInterface benchmark of BenchmarkExeV10 _ f -> Just f diff --git a/Cabal/Distribution/Simple/Bench.hs b/Cabal/Distribution/Simple/Bench.hs index f4f255a3146..d30d614bfe2 100644 --- a/Cabal/Distribution/Simple/Bench.hs +++ b/Cabal/Distribution/Simple/Bench.hs @@ -40,9 +40,7 @@ bench args pkg_descr lbi flags = do let verbosity = fromFlag $ benchmarkVerbosity flags benchmarkNames = args pkgBenchmarks = PD.benchmarks pkg_descr - enabledBenchmarks = [ t | t <- pkgBenchmarks - , PD.benchmarkEnabled t - , PD.buildable (PD.benchmarkBuildInfo t) ] + enabledBenchmarks = map fst (LBI.enabledBenchLBIs pkg_descr lbi) -- Run the benchmark doBench :: PD.Benchmark -> IO ExitCode diff --git a/Cabal/Distribution/Simple/Build.hs b/Cabal/Distribution/Simple/Build.hs index cd9a3d0f0dd..15a19ee05e3 100644 --- a/Cabal/Distribution/Simple/Build.hs +++ b/Cabal/Distribution/Simple/Build.hs @@ -81,7 +81,7 @@ build pkg_descr lbi flags suffixes -- a --assume-deps-up-to-date with multiple arguments. Arguably, we should -- error early in this case. targets <- readBuildTargets pkg_descr (buildArgs flags) - (cname, _) <- checkBuildTargets verbosity pkg_descr targets >>= \r -> case r of + (cname, _) <- checkBuildTargets verbosity pkg_descr lbi targets >>= \r -> case r of [] -> die "In --assume-deps-up-to-date mode you must specify a target" [target'] -> return target' _ -> die "In --assume-deps-up-to-date mode you can only build a single target" @@ -106,7 +106,7 @@ build pkg_descr lbi flags suffixes lbi' suffixes comp clbi distPref | otherwise = do targets <- readBuildTargets pkg_descr (buildArgs flags) - targets' <- checkBuildTargets verbosity pkg_descr targets + targets' <- checkBuildTargets verbosity pkg_descr lbi targets let componentsToBuild = componentsInBuildOrder lbi (map fst targets') info verbosity $ "Component build order: " ++ intercalate ", " (map (showComponentName . componentLocalName) componentsToBuild) @@ -145,9 +145,10 @@ repl pkg_descr lbi flags suffixes args = do targets <- readBuildTargets pkg_descr args targets' <- case targets of + -- This seems DEEPLY questionable. [] -> return $ take 1 [ componentName c - | c <- pkgEnabledComponents pkg_descr ] - [target] -> fmap (map fst) (checkBuildTargets verbosity pkg_descr [target]) + | c <- pkgBuildableComponents pkg_descr ] + [target] -> fmap (map fst) (checkBuildTargets verbosity pkg_descr lbi [target]) _ -> die $ "The 'repl' command does not support multiple targets at once." let componentsToBuild = componentsInBuildOrder lbi targets' componentForRepl = last componentsToBuild diff --git a/Cabal/Distribution/Simple/BuildTarget.hs b/Cabal/Distribution/Simple/BuildTarget.hs index aec56e6a4cf..9cc29242f2e 100644 --- a/Cabal/Distribution/Simple/BuildTarget.hs +++ b/Cabal/Distribution/Simple/BuildTarget.hs @@ -947,16 +947,17 @@ caseFold = lowercase -- -- Also swizzle into a more convenient form. -- -checkBuildTargets :: Verbosity -> PackageDescription -> [BuildTarget] +checkBuildTargets :: Verbosity -> PackageDescription -> LocalBuildInfo -> [BuildTarget] -> IO [(ComponentName, Maybe (Either ModuleName FilePath))] -checkBuildTargets _ pkg [] = - return [ (componentName c, Nothing) | c <- pkgEnabledComponents pkg ] +checkBuildTargets _ pkg lbi [] = + return [ (componentName c, Nothing) | c <- enabledComponents pkg lbi ] -checkBuildTargets verbosity pkg targets = do +checkBuildTargets verbosity pkg lbi targets = do let (enabled, disabled) = partitionEithers - [ case componentDisabledReason (getComponent pkg cname) of + [ case componentDisabledReason (componentEnabledSpec lbi) + (getComponent pkg cname) of Nothing -> Left target' Just reason -> Right (cname, reason) | target <- targets diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index 645bb5697f8..94dc3adc17c 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -373,6 +373,12 @@ configure (pkg_descr0', pbi) cfg = do let internalPackageSet :: InstalledPackageIndex internalPackageSet = getInternalPackages pkg_descr0 + -- Make a data structure describing what components are enabled. + let enabled :: ComponentEnabledSpec + enabled = ComponentEnabledSpec + { testsEnabled = fromFlag (configTests cfg) + , benchmarksEnabled = fromFlag (configBenchmarks cfg) } + -- allConstraints: The set of all 'Dependency's we have. Used ONLY -- to 'configureFinalizedPackage'. -- requiredDepsMap: A map from 'PackageName' to the specifically @@ -410,7 +416,7 @@ configure (pkg_descr0', pbi) cfg = do -- cleaner to then configure the dependencies afterwards. (pkg_descr :: PackageDescription, flags :: FlagAssignment) - <- configureFinalizedPackage verbosity cfg + <- configureFinalizedPackage verbosity cfg enabled allConstraints (dependencySatisfiable (fromFlagOrDefault False (configExactConfiguration cfg)) @@ -571,7 +577,7 @@ configure (pkg_descr0', pbi) cfg = do -- From there, we build a ComponentLocalBuildInfo for each of the -- components, which lets us actually build each component. buildComponents <- - case mkComponentsGraph pkg_descr internalPkgDeps of + case mkComponentsGraph enabled pkg_descr internalPkgDeps of Left componentCycle -> reportComponentCycle componentCycle Right comps -> mkComponentsLocalBuildInfo cfg comp packageDependsIndex pkg_descr @@ -668,6 +674,7 @@ configure (pkg_descr0', pbi) cfg = do let lbi = LocalBuildInfo { configFlags = cfg', flagAssignment = flags, + componentEnabledSpec = enabled, extraConfigArgs = [], -- Currently configure does not -- take extra args, but if it -- did they would go here. @@ -892,6 +899,7 @@ relaxPackageDeps (RelaxDepsSome allowNewerDeps') gpd = configureFinalizedPackage :: Verbosity -> ConfigFlags + -> ComponentEnabledSpec -> [Dependency] -> (Dependency -> Bool) -- ^ tests if a dependency is satisfiable. -- Might say it's satisfiable even when not. @@ -899,27 +907,18 @@ configureFinalizedPackage -> Platform -> GenericPackageDescription -> IO (PackageDescription, FlagAssignment) -configureFinalizedPackage verbosity cfg +configureFinalizedPackage verbosity cfg enabled allConstraints satisfies comp compPlatform pkg_descr0 = do - let enableTest t = t { testEnabled = fromFlag (configTests cfg) } - flaggedTests = map (\(n, t) -> (n, mapTreeData enableTest t)) - (condTestSuites pkg_descr0) - enableBenchmark bm = bm { benchmarkEnabled = - fromFlag (configBenchmarks cfg) } - flaggedBenchmarks = map (\(n, bm) -> - (n, mapTreeData enableBenchmark bm)) - (condBenchmarks pkg_descr0) - pkg_descr0'' = pkg_descr0 { condTestSuites = flaggedTests - , condBenchmarks = flaggedBenchmarks } (pkg_descr0', flags) <- case finalizePackageDescription (configConfigurationsFlags cfg) + enabled satisfies compPlatform (compilerInfo comp) allConstraints - pkg_descr0'' + pkg_descr0 of Right r -> return r Left missing -> die $ "Encountered missing dependencies:\n" @@ -1435,13 +1434,15 @@ configCompilerAux = fmap (\(a,_,b) -> (a,b)) . configCompilerAuxEx -- (although it is in the absence of Backpack.) -- -- TODO: tighten up the type of 'internalPkgDeps' -mkComponentsGraph :: PackageDescription +mkComponentsGraph :: ComponentEnabledSpec + -> PackageDescription -> [PackageId] -> Either [ComponentName] [(Component, [ComponentName])] -mkComponentsGraph pkg_descr internalPkgDeps = +mkComponentsGraph enabled pkg_descr internalPkgDeps = let graph = [ (c, componentName c, componentDeps c) - | c <- pkgEnabledComponents pkg_descr ] + | c <- pkgBuildableComponents pkg_descr + , componentEnabled enabled c ] in case checkComponentsCyclic graph of Just ccycle -> Left [ cname | (_,cname,_) <- ccycle ] Nothing -> Right [ (c, cdeps) | (c, _, cdeps) <- topSortFromEdges graph ] diff --git a/Cabal/Distribution/Simple/Install.hs b/Cabal/Distribution/Simple/Install.hs index 0bec0e9fb9d..1773b9d5e8c 100644 --- a/Cabal/Distribution/Simple/Install.hs +++ b/Cabal/Distribution/Simple/Install.hs @@ -61,7 +61,7 @@ install pkg_descr lbi flags | fromFlag (copyAssumeDepsUpToDate flags) = do checkHasLibsOrExes targets <- readBuildTargets pkg_descr (copyArgs flags) - targets' <- checkBuildTargets verbosity pkg_descr targets + targets' <- checkBuildTargets verbosity pkg_descr lbi targets case targets' of _ | null (copyArgs flags) -> copyPackage verbosity pkg_descr lbi distPref copydest @@ -74,7 +74,7 @@ install pkg_descr lbi flags | otherwise = do checkHasLibsOrExes targets <- readBuildTargets pkg_descr (copyArgs flags) - targets' <- checkBuildTargets verbosity pkg_descr targets + targets' <- checkBuildTargets verbosity pkg_descr lbi targets copyPackage verbosity pkg_descr lbi distPref copydest diff --git a/Cabal/Distribution/Simple/LocalBuildInfo.hs b/Cabal/Distribution/Simple/LocalBuildInfo.hs index b241ac71f43..222dd065432 100644 --- a/Cabal/Distribution/Simple/LocalBuildInfo.hs +++ b/Cabal/Distribution/Simple/LocalBuildInfo.hs @@ -38,11 +38,9 @@ module Distribution.Simple.LocalBuildInfo ( foldComponent, componentName, componentBuildInfo, - componentEnabled, - componentDisabledReason, - ComponentDisabledReason(..), + componentBuildable, pkgComponents, - pkgEnabledComponents, + pkgBuildableComponents, lookupComponent, getComponent, maybeGetDefaultLibraryLocalBuildInfo, @@ -58,7 +56,19 @@ module Distribution.Simple.LocalBuildInfo ( withComponentsLBI, withLibLBI, withExeLBI, + withBenchLBI, withTestLBI, + enabledTestLBIs, + enabledBenchLBIs, + enabledComponents, + + -- $buildable_vs_enabled_components + + ComponentEnabledSpec(..), + defaultComponentEnabled, + componentEnabled, + componentDisabledReason, + ComponentDisabledReason(..), -- * Installation directories module Distribution.Simple.InstallDirs, @@ -102,6 +112,8 @@ data LocalBuildInfo = LocalBuildInfo { -- Needed to re-run configuration when .cabal is out of date flagAssignment :: FlagAssignment, -- ^ The final set of flags which were picked for this package + componentEnabledSpec :: ComponentEnabledSpec, + -- ^ What components were enabled during configuration, and why. extraConfigArgs :: [String], -- ^ Extra args on the command line for the configuration step. -- Needed to re-run configuration when .cabal is out of date @@ -152,6 +164,76 @@ data LocalBuildInfo = LocalBuildInfo { instance Binary LocalBuildInfo +-- $buildable_vs_enabled_components +-- #buildable_vs_enabled_components# +-- +-- = Note: Buildable versus enabled components +-- What's the difference between a buildable component (ala +-- 'componentBuildable') versus enabled component (ala +-- 'componentEnabled')? +-- +-- A component is __buildable__ if, after resolving flags and +-- conditionals, there is no @buildable: False@ property in it. +-- This is a /static/ property that arises from the +-- Cabal file and the package description flattening; once we have +-- a 'PackageDescription' buildability is known. +-- +-- A component is __enabled__ if it is buildable, and the user +-- configured (@./Setup configure@) the package to build it, +-- e.g., using @--enable-tests@ or @--enable-benchmarks@. +-- Once we have a 'LocalBuildInfo', whether or not a component +-- is enabled is known. +-- +-- Generally speaking, most Cabal API code cares if a component +-- is enabled, as opposed to buildable. (For example, if you +-- want to run a preprocessor on each component prior to building +-- them, you want to run this on each /enabled/ component.) + +-- | Describes what components are enabled by user-interaction. +-- See also this note in +-- "Distribution.Simple.LocalBuildInfo#buildable_vs_enabled_components". +-- +-- @since 1.26.0.0 +data ComponentEnabledSpec + = ComponentEnabledSpec { + testsEnabled :: Bool, + benchmarksEnabled :: Bool + } + deriving (Generic, Read, Show) +instance Binary ComponentEnabledSpec + +-- | The default set of enabled components. Historically tests and +-- benchmarks are NOT enabled by default. +-- +-- @since 1.26.0.0 +defaultComponentEnabled :: ComponentEnabledSpec +defaultComponentEnabled = ComponentEnabledSpec False False + +-- | Is this component enabled? See also this note in +-- "Distribution.Simple.LocalBuildInfo#buildable_vs_enabled_components". +-- +-- @since 1.26.0.0 +componentEnabled :: ComponentEnabledSpec -> Component -> Bool +componentEnabled enabled = isNothing . componentDisabledReason enabled + +-- | Is this component disabled, and if so, why? +-- +-- @since 1.26.0.0 +componentDisabledReason :: ComponentEnabledSpec -> Component + -> Maybe ComponentDisabledReason +componentDisabledReason enabled (CTest _) + | not (testsEnabled enabled) = Just DisabledAllTests +componentDisabledReason enabled (CBench _) + | not (benchmarksEnabled enabled) = Just DisabledAllBenchmarks +componentDisabledReason _ _ = Nothing + +-- | A reason explaining why a component is disabled. +-- +-- @since 1.26.0.0 +data ComponentDisabledReason = DisabledComponent + | DisabledAllTests + | DisabledAllBenchmarks + -- TODO: Get rid of these functions, as much as possible. They are -- a bit useful in some cases, but you should be very careful! @@ -245,7 +327,7 @@ componentName = (CTestName . testName) (CBenchName . benchmarkName) --- | All the components in the package (libs, exes, or test suites). +-- | All the components in the package. -- pkgComponents :: PackageDescription -> [Component] pkgComponents pkg = @@ -254,32 +336,24 @@ pkgComponents pkg = ++ [ CTest tst | tst <- testSuites pkg ] ++ [ CBench bm | bm <- benchmarks pkg ] --- | All the components in the package that are buildable and enabled. --- Thus this excludes non-buildable components and test suites or benchmarks --- that have been disabled. +-- | A list of all components in the package that are buildable, +-- i.e., were not marked with @buildable: False@. This does NOT +-- indicate if we are actually going to build the component, +-- see 'enabledComponents' instead. -- -pkgEnabledComponents :: PackageDescription -> [Component] -pkgEnabledComponents = filter componentEnabled . pkgComponents - -componentEnabled :: Component -> Bool -componentEnabled = isNothing . componentDisabledReason - -data ComponentDisabledReason = DisabledComponent - | DisabledAllTests - | DisabledAllBenchmarks +-- @since 1.26.0.0 +-- +pkgBuildableComponents :: PackageDescription -> [Component] +pkgBuildableComponents = filter componentBuildable . pkgComponents -componentDisabledReason :: Component -> Maybe ComponentDisabledReason -componentDisabledReason (CLib lib) - | not (buildable (libBuildInfo lib)) = Just DisabledComponent -componentDisabledReason (CExe exe) - | not (buildable (buildInfo exe)) = Just DisabledComponent -componentDisabledReason (CTest tst) - | not (buildable (testBuildInfo tst)) = Just DisabledComponent - | not (testEnabled tst) = Just DisabledAllTests -componentDisabledReason (CBench bm) - | not (buildable (benchmarkBuildInfo bm)) = Just DisabledComponent - | not (benchmarkEnabled bm) = Just DisabledAllBenchmarks -componentDisabledReason _ = Nothing +-- | Is a component buildable (i.e., not marked with @buildable: False@)? +-- See also this note in +-- "Distribution.Simple.LocalBuildInfo#buildable_vs_enabled_components". +-- +-- @since 1.26.0.0 +-- +componentBuildable :: Component -> Bool +componentBuildable = buildable . componentBuildInfo lookupComponent :: PackageDescription -> ComponentName -> Maybe Component lookupComponent pkg (CLibName "") = lookupComponent pkg (defaultLibName (package pkg)) @@ -416,9 +490,8 @@ componentNameToUnitIds lbi cname = | (clbi, _) <- componentsConfigs lbi , componentName (getLocalComponent (localPkgDescr lbi) clbi) == cname ] --- | Perform the action on each buildable 'library' in the package --- description. Extended version of 'withLib' that also gives --- corresponding build info. +-- | Perform the action on each enabled 'library' in the package +-- description with the 'ComponentLocalBuildInfo'. withLibLBI :: PackageDescription -> LocalBuildInfo -> (Library -> ComponentLocalBuildInfo -> IO ()) -> IO () withLibLBI pkg lbi f = @@ -427,7 +500,7 @@ withLibLBI pkg lbi f = | (clbi@LibComponentLocalBuildInfo{}, _) <- componentsConfigs lbi , CLib lib <- [getComponent pkg (componentLocalName clbi)] ] --- | Perform the action on each buildable 'Executable' in the package +-- | Perform the action on each enabled 'Executable' in the package -- description. Extended version of 'withExe' that also gives corresponding -- build info. withExeLBI :: PackageDescription -> LocalBuildInfo @@ -438,14 +511,43 @@ withExeLBI pkg lbi f = | (clbi@ExeComponentLocalBuildInfo{}, _) <- componentsConfigs lbi , CExe exe <- [getComponent pkg (componentLocalName clbi)] ] +-- | Perform the action on each enabled 'Benchmark' in the package +-- description. +withBenchLBI :: PackageDescription -> LocalBuildInfo + -> (Benchmark -> ComponentLocalBuildInfo -> IO ()) -> IO () +withBenchLBI pkg lbi f = + sequence_ [ f test clbi | (test, clbi) <- enabledBenchLBIs pkg lbi ] + withTestLBI :: PackageDescription -> LocalBuildInfo -> (TestSuite -> ComponentLocalBuildInfo -> IO ()) -> IO () withTestLBI pkg lbi f = - sequence_ - [ f test clbi + sequence_ [ f test clbi | (test, clbi) <- enabledTestLBIs pkg lbi ] + +enabledTestLBIs :: PackageDescription -> LocalBuildInfo + -> [(TestSuite, ComponentLocalBuildInfo)] +enabledTestLBIs pkg lbi = + [ (test, clbi) | (clbi@TestComponentLocalBuildInfo{}, _) <- componentsConfigs lbi , CTest test <- [getComponent pkg (componentLocalName clbi)] ] +enabledBenchLBIs :: PackageDescription -> LocalBuildInfo + -> [(Benchmark, ComponentLocalBuildInfo)] +enabledBenchLBIs pkg lbi = + [ (test, clbi) + | (clbi@BenchComponentLocalBuildInfo{}, _) <- componentsConfigs lbi + , CBench test <- [getComponent pkg (componentLocalName clbi)] ] + +-- | Get a list of all enabled 'Component's (both buildable and +-- requested by the user at configure-time). +-- +-- @since 1.26.0.0 +enabledComponents :: PackageDescription -> LocalBuildInfo + -> [Component] +enabledComponents pkg lbi = + [ getComponent pkg (componentLocalName clbi) + | (clbi, _) <- componentsConfigs lbi ] + + {-# DEPRECATED withComponentsLBI "Use withAllComponentsInBuildOrder" #-} withComponentsLBI :: PackageDescription -> LocalBuildInfo -> (Component -> ComponentLocalBuildInfo -> IO ()) diff --git a/Cabal/Distribution/Simple/Register.hs b/Cabal/Distribution/Simple/Register.hs index 24d636e539b..b04c2adf3a3 100644 --- a/Cabal/Distribution/Simple/Register.hs +++ b/Cabal/Distribution/Simple/Register.hs @@ -91,7 +91,7 @@ register pkg_descr lbi flags = when (hasPublicLib pkg_descr) doRegister -- packages, we'll have to relax this. doRegister = do targets <- readBuildTargets pkg_descr (regArgs flags) - targets' <- checkBuildTargets verbosity pkg_descr targets + targets' <- checkBuildTargets verbosity pkg_descr lbi targets -- It's important to register in build order, because ghc-pkg -- will complain if a dependency is not registered. diff --git a/Cabal/Distribution/Simple/Test.hs b/Cabal/Distribution/Simple/Test.hs index f7cd437f220..efa2cdc8cfd 100644 --- a/Cabal/Distribution/Simple/Test.hs +++ b/Cabal/Distribution/Simple/Test.hs @@ -49,9 +49,7 @@ test args pkg_descr lbi flags = do testLogDir = distPref "test" testNames = args pkgTests = PD.testSuites pkg_descr - enabledTests = [ t | t <- pkgTests - , PD.testEnabled t - , PD.buildable (PD.testBuildInfo t) ] + enabledTests = (map fst) (LBI.enabledTestLBIs pkg_descr lbi) doTest :: (PD.TestSuite, Maybe TestSuiteLog) -> IO TestSuiteLog doTest (suite, _) = diff --git a/Cabal/changelog b/Cabal/changelog index a3e39251f01..c4955f22b1a 100644 --- a/Cabal/changelog +++ b/Cabal/changelog @@ -19,6 +19,25 @@ only the macros for the library, and is not generated if a package has no library; to find the macros for an executable named 'foobar', look in 'dist/build/foobar/autogen/cabal_macros.h'. + * Backwards incompatible change to 'Component': 'TestSuite' and + 'Benchmark' no longer have 'testEnabled' and + 'benchmarkEnabled'. If you used + 'enabledTests' or 'enabledBenchmarks', please instead use + 'enabledTestLBIs' and 'enabledBenchLBIs' + (you will need a 'LocalBuildInfo' for these functions.) + Additionally, the semantics of 'withTest' and 'withBench' + have changed: they now iterate over all buildable + such components, regardless of whether or not they have + been enabled; if you only want enabled components, + use 'withTestLBI' and 'withBenchLBI'. + 'componentEnabled', 'enabledComponents' and + 'finalizePackageDescription' now takes an extra argument + 'ComponentEnabledSpec' which specifies what components + are to be enabled: use this instead of modifying the + 'Component' in a 'GenericPackageDescription'. + If you only need to test if a component is buildable + (i.e., it is marked buildable in the Cabal file) + use the new function 'componentBuildable'. * Improved an error message for process output decoding errors (#3408). diff --git a/cabal-install/Distribution/Client/Configure.hs b/cabal-install/Distribution/Client/Configure.hs index b144ee56135..8146d3c5c03 100644 --- a/cabal-install/Distribution/Client/Configure.hs +++ b/cabal-install/Distribution/Client/Configure.hs @@ -386,8 +386,8 @@ configurePackage verbosity platform comp scriptOptions configFlags configTests = toFlag (TestStanzas `elem` stanzas) } - pkg = case finalizePackageDescription flags + pkg = case finalizePackageDescription flags (enableStanzas stanzas) (const True) - platform comp [] (enableStanzas stanzas gpkg) of + platform comp [] gpkg of Left _ -> error "finalizePackageDescription ReadyPackage failed" Right (desc, _) -> desc diff --git a/cabal-install/Distribution/Client/Dependency.hs b/cabal-install/Distribution/Client/Dependency.hs index 2a604b52e3b..cd5a013bc36 100644 --- a/cabal-install/Distribution/Client/Dependency.hs +++ b/cabal-install/Distribution/Client/Dependency.hs @@ -74,8 +74,7 @@ import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Client.InstallPlan (SolverInstallPlan) import Distribution.Client.Types ( SourcePackageDb(SourcePackageDb) - , UnresolvedPkgLoc, UnresolvedSourcePackage - , enableStanzas ) + , UnresolvedPkgLoc, UnresolvedSourcePackage ) import Distribution.Client.Dependency.Types ( PreSolver(..), Solver(..) , PackagesPreferenceDefault(..) ) @@ -852,10 +851,11 @@ configuredPackageProblems platform cinfo requiredDeps = --TODO: use something lower level than finalizePackageDescription case finalizePackageDescription specifiedFlags + (enableStanzas stanzas) (const True) platform cinfo [] - (enableStanzas stanzas $ packageDescription pkg) of + (packageDescription pkg) of Right (resolvedPkg, _) -> externalBuildDepends resolvedPkg ++ maybe [] PD.setupDepends (PD.setupBuildInfo resolvedPkg) diff --git a/cabal-install/Distribution/Client/Dependency/TopDown.hs b/cabal-install/Distribution/Client/Dependency/TopDown.hs index 4bdd5f44fe3..3c3e92718ea 100644 --- a/cabal-install/Distribution/Client/Dependency/TopDown.hs +++ b/cabal-install/Distribution/Client/Dependency/TopDown.hs @@ -21,7 +21,7 @@ import Distribution.Client.Dependency.TopDown.Constraints ( Satisfiable(..) ) import Distribution.Client.Types ( UnresolvedPkgLoc - , UnresolvedSourcePackage, enableStanzas ) + , UnresolvedSourcePackage ) import qualified Distribution.Simple.PackageIndex as InstalledPackageIndex import Distribution.Simple.PackageIndex (InstalledPackageIndex) @@ -54,6 +54,7 @@ import qualified Distribution.Solver.Types.ComponentDeps as CD import Distribution.Solver.Types.DependencyResolver import Distribution.Solver.Types.InstalledPreference import Distribution.Solver.Types.LabeledPackageConstraint +import Distribution.Solver.Types.OptionalStanza import Distribution.Solver.Types.PackageConstraint import qualified Distribution.Solver.Types.PackageIndex as PackageIndex import Distribution.Solver.Types.PackageIndex (PackageIndex) @@ -391,8 +392,8 @@ pruneBottomUp platform comp constraints = | dep <- missing ] configure cs (UnconfiguredPackage (SourcePackage _ pkg _ _) _ flags stanzas) = - finalizePackageDescription flags (dependencySatisfiable cs) - platform comp [] (enableStanzas stanzas pkg) + finalizePackageDescription flags (enableStanzas stanzas) (dependencySatisfiable cs) + platform comp [] pkg dependencySatisfiable cs = not . null . PackageIndex.lookupDependency (Constraints.choices cs) @@ -420,9 +421,8 @@ configurePackage platform cinfo available spkg = case spkg of (configure apkg) where configure (UnconfiguredPackage apkg@(SourcePackage _ p _ _) _ flags stanzas) = - case finalizePackageDescription flags dependencySatisfiable - platform cinfo [] - (enableStanzas stanzas p) of + case finalizePackageDescription flags (enableStanzas stanzas) dependencySatisfiable + platform cinfo [] p of Left missing -> Left missing Right (pkg, flags') -> Right $ SemiConfiguredPackage apkg flags' stanzas (externalBuildDepends pkg) diff --git a/cabal-install/Distribution/Client/GenBounds.hs b/cabal-install/Distribution/Client/GenBounds.hs index 3f8eed8ef16..e554004be7a 100644 --- a/cabal-install/Distribution/Client/GenBounds.hs +++ b/cabal-install/Distribution/Client/GenBounds.hs @@ -33,6 +33,8 @@ import Distribution.PackageDescription.Configuration ( finalizePackageDescription ) import Distribution.PackageDescription.Parse ( readPackageDescription ) +import Distribution.Simple.LocalBuildInfo + ( defaultComponentEnabled ) import Distribution.Simple.Compiler ( Compiler, PackageDBStack, compilerInfo ) import Distribution.Simple.Program @@ -107,7 +109,10 @@ genBounds verbosity packageDBs repoCtxt comp platform conf mSandboxPkgInfo cwd <- getCurrentDirectory path <- tryFindPackageDesc cwd gpd <- readPackageDescription verbosity path - let epd = finalizePackageDescription [] (const True) platform cinfo [] gpd + -- NB: We don't enable tests or benchmarks, since often they + -- don't really have useful bounds. + let epd = finalizePackageDescription [] defaultComponentEnabled + (const True) platform cinfo [] gpd case epd of Left _ -> putStrLn "finalizePackageDescription failed" Right (pd,_) -> do diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs index c83578e07fb..66145afed67 100644 --- a/cabal-install/Distribution/Client/Install.hs +++ b/cabal-install/Distribution/Client/Install.hs @@ -1300,9 +1300,9 @@ installReadyPackage platform cinfo configFlags configTests = toFlag (TestStanzas `elem` stanzas) } source pkg pkgoverride where - pkg = case finalizePackageDescription flags + pkg = case finalizePackageDescription flags (enableStanzas stanzas) (const True) - platform cinfo [] (enableStanzas stanzas gpkg) of + platform cinfo [] gpkg of Left _ -> error "finalizePackageDescription ReadyPackage failed" Right (desc, _) -> desc diff --git a/cabal-install/Distribution/Client/InstallSymlink.hs b/cabal-install/Distribution/Client/InstallSymlink.hs index 875466dc116..0025a7605e2 100644 --- a/cabal-install/Distribution/Client/InstallSymlink.hs +++ b/cabal-install/Distribution/Client/InstallSymlink.hs @@ -38,7 +38,7 @@ symlinkBinary _ _ _ _ = fail "Symlinking feature not available on Windows" #else import Distribution.Client.Types - ( GenericReadyPackage(..), ReadyPackage, enableStanzas + ( GenericReadyPackage(..), ReadyPackage , ConfiguredPackage(..)) import Distribution.Client.Setup ( InstallFlags(installSymlinkBinDir) ) @@ -46,6 +46,7 @@ import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Client.InstallPlan (InstallPlan) import Distribution.Solver.Types.SourcePackage +import Distribution.Solver.Types.OptionalStanza import Distribution.Package ( PackageIdentifier, Package(packageId), UnitId(..), installedUnitId ) @@ -144,9 +145,9 @@ symlinkBinaries platform comp configFlags installFlags plan = pkgDescription (ReadyPackage (ConfiguredPackage _ (SourcePackage _ pkg _ _) flags stanzas _)) = - case finalizePackageDescription flags + case finalizePackageDescription flags (enableStanzas stanzas) (const True) - platform cinfo [] (enableStanzas stanzas pkg) of + platform cinfo [] pkg of Left _ -> error "finalizePackageDescription ReadyPackage failed" Right (desc, _) -> desc diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index 134c84a74fc..d4effc4fe7b 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -1070,7 +1070,7 @@ elaborateInstallPlan platform compiler compilerprogdb pkgSourceId = pkgid pkgDescription = let Right (desc, _) = PD.finalizePackageDescription - flags (const True) + flags enabled (const True) platform (compilerInfo compiler) [] gdesc in desc @@ -1078,6 +1078,7 @@ elaborateInstallPlan platform compiler compilerprogdb pkgFlagDefaults = [ (Cabal.flagName flag, Cabal.flagDefault flag) | flag <- PD.genPackageFlags gdesc ] pkgDependencies = deps + enabled = enableStanzas stanzas pkgStanzasAvailable = Set.fromList stanzas pkgStanzasRequested = -- NB: even if a package stanza is requested, if the package diff --git a/cabal-install/Distribution/Client/Types.hs b/cabal-install/Distribution/Client/Types.hs index 40d9f382875..368acf41eda 100644 --- a/cabal-install/Distribution/Client/Types.hs +++ b/cabal-install/Distribution/Client/Types.hs @@ -24,10 +24,7 @@ import Distribution.Package import Distribution.InstalledPackageInfo ( InstalledPackageInfo ) import Distribution.PackageDescription - ( Benchmark(..), GenericPackageDescription(..), FlagAssignment - , TestSuite(..) ) -import Distribution.PackageDescription.Configuration - ( mapTreeData ) + ( FlagAssignment ) import Distribution.Version ( VersionRange ) @@ -148,20 +145,6 @@ type ReadyPackage = GenericReadyPackage (ConfiguredPackage UnresolvedPkgLoc) -- | Convenience alias for 'SourcePackage UnresolvedPkgLoc'. type UnresolvedSourcePackage = SourcePackage UnresolvedPkgLoc -enableStanzas - :: [OptionalStanza] - -> GenericPackageDescription - -> GenericPackageDescription -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 -- ------------------------------------------------------------ diff --git a/cabal-install/Distribution/Solver/Types/OptionalStanza.hs b/cabal-install/Distribution/Solver/Types/OptionalStanza.hs index 001918ee614..e7c9894178e 100644 --- a/cabal-install/Distribution/Solver/Types/OptionalStanza.hs +++ b/cabal-install/Distribution/Solver/Types/OptionalStanza.hs @@ -1,14 +1,25 @@ {-# LANGUAGE DeriveGeneric #-} module Distribution.Solver.Types.OptionalStanza ( OptionalStanza(..) + , enableStanzas ) where import GHC.Generics (Generic) import Distribution.Compat.Binary (Binary(..)) +import Distribution.Simple.LocalBuildInfo (ComponentEnabledSpec(..), defaultComponentEnabled) +import Data.List (foldl') data OptionalStanza = TestStanzas | BenchStanzas deriving (Eq, Ord, Enum, Bounded, Show, Generic) +-- | Convert a list of 'OptionalStanza' into the corresponding +-- 'ComponentEnabledSpec' which records what components are enabled. +enableStanzas :: [OptionalStanza] -> ComponentEnabledSpec +enableStanzas = foldl' addStanza defaultComponentEnabled + where + addStanza enabled TestStanzas = enabled { testsEnabled = True } + addStanza enabled BenchStanzas = enabled { benchmarksEnabled = True } + instance Binary OptionalStanza