Merge pull request #3542 from ezyang/enabled-refactor

Introduce new ComponentEnabledSpec, removing testEnabled/benchmarkEna…

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(..),
@@ -176,7 +174,7 @@ data PackageDescription
         -- PackageDescription we are, the contents of this field are
         -- either nonsense, or the collected dependencies of *all* the
         -- components in this package.  buildDepends is initialized by
-        -- 'finalizePackageDescription' and 'flattenPackageDescription';
+        -- 'finalizePD' and 'flattenPackageDescription';
         -- prior to that, dependency info is stored in the 'CondTree'
         -- built around a 'GenericPackageDescription'.  When this
         -- resolution is done, dependency info is written to the inner
@@ -447,8 +445,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)]
@@ -532,7 +534,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)]
@@ -549,13 +554,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)
 
@@ -593,17 +592,15 @@ instance Monoid TestSuite where
     mempty = TestSuite {
         testName      = mempty,
         testInterface = mempty,
-        testBuildInfo = mempty,
-        testEnabled   = False
+        testBuildInfo = mempty
     }
     mappend = (Semi.<>)
 
 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
@@ -627,14 +624,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]
@@ -695,9 +692,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)
 
@@ -731,17 +726,15 @@ instance Monoid Benchmark where
     mempty = Benchmark {
         benchmarkName      = mempty,
         benchmarkInterface = mempty,
-        benchmarkBuildInfo = mempty,
-        benchmarkEnabled   = False
+        benchmarkBuildInfo = mempty
     }
     mappend = (Semi.<>)
 
 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
@@ -765,14 +758,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]
@@ -935,12 +928,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
 

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
@@ -1282,8 +1283,8 @@ checkPackageVersions pkg =
     -- pick a single "typical" configuration and check if that has an
     -- open upper bound. To get a typical configuration we finalise
     -- using no package index and the current platform.
-    finalised = finalizePackageDescription
-                              [] (const True) buildPlatform
+    finalised = finalizePD
+                              [] defaultComponentEnabled (const True) buildPlatform
                               (unknownCompilerInfo
                                 (CompilerId buildCompilerFlavor (Version [] [])) NoAbiTag)
                               [] pkg
@@ -1294,7 +1295,7 @@ checkPackageVersions pkg =
           baseDeps =
             [ vr | Dependency (PackageName "base") vr <- buildDepends pkg' ]
 
-      -- Just in case finalizePackageDescription fails for any reason,
+      -- Just in case finalizePD fails for any reason,
       -- or if the package doesn't depend on the base package at all,
       -- then we will just skip the check, since boundedAbove noVersion = True
       _          -> noVersion

Cabal/Distribution/PackageDescription/Configuration.hs

@@ -11,12 +11,13 @@
 -- Portability :  portable
 --
 -- This is about the cabal configurations feature. It exports
--- 'finalizePackageDescription' and 'flattenPackageDescription' which are
+-- 'finalizePD' and 'flattenPackageDescription' which are
 -- functions for converting 'GenericPackageDescription's down to
 -- 'PackageDescription's. It has code for working with the tree of conditions
 -- and resolving or flattening conditions.
 
 module Distribution.PackageDescription.Configuration (
+    finalizePD,
     finalizePackageDescription,
     flattenPackageDescription,
 
@@ -48,6 +49,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 +213,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 +223,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 +248,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 +419,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 +508,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
@@ -547,8 +554,9 @@ instance Semigroup PDTagged where
 -- On success, it will return the package description and the full flag
 -- assignment chosen.
 --
-finalizePackageDescription ::
+finalizePD ::
      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 +568,7 @@ finalizePackageDescription ::
             (PackageDescription, FlagAssignment)
              -- ^ Either missing dependencies or the resolved package
              -- description along with the flag assignments chosen.
-finalizePackageDescription userflags satisfyDep
+finalizePD userflags enabled satisfyDep
         (Platform arch os) impl constraints
         (GenericPackageDescription pkg flags libs0 exes0 tests0 bms0) =
     case resolveFlags of
@@ -569,7 +577,7 @@ finalizePackageDescription userflags satisfyDep
                     , executables = exes'
                     , testSuites = tests'
                     , benchmarks = bms'
-                    , buildDepends = fromDepMap (overallDependencies targetSet)
+                    , buildDepends = fromDepMap (overallDependencies enabled targetSet)
                     }
               , flagVals )
 
@@ -582,7 +590,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,
@@ -604,6 +612,20 @@ finalizePackageDescription userflags satisfyDep
                       then DepOk
                       else MissingDeps missingDeps
 
+{-# DEPRECATED finalizePackageDescription "This function now always assumes tests and benchmarks are disabled; use finalizePD with ComponentEnabledSpec to specify something more specific." #-}
+finalizePackageDescription ::
+     FlagAssignment  -- ^ Explicitly specified flag assignments
+  -> (Dependency -> Bool) -- ^ Is a given dependency satisfiable from the set of
+                          -- available packages?  If this is unknown then use
+                          -- True.
+  -> Platform      -- ^ The 'Arch' and 'OS'
+  -> CompilerInfo  -- ^ Compiler information
+  -> [Dependency]  -- ^ Additional constraints
+  -> GenericPackageDescription
+  -> Either [Dependency]
+            (PackageDescription, FlagAssignment)
+finalizePackageDescription flags = finalizePD flags defaultComponentEnabled
+
 {-
 let tst_p = (CondNode [1::Int] [Distribution.Package.Dependency "a" AnyVersion] [])
 let tst_p2 = (CondNode [1::Int] [Distribution.Package.Dependency "a" (EarlierVersion (Version [1,0] [])), Distribution.Package.Dependency "a" (LaterVersion (Version [2,0] []))] [])

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

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