Add Distribution.Compat.Graph, fixes #3521.

The intent is for this to be used to replace most of
the current PackageIndex and InstallPlan implementations.

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>

Cabal/Cabal.cabal

@@ -273,6 +273,7 @@ library
     Distribution.Compat.CreatePipe
     Distribution.Compat.Environment
     Distribution.Compat.Exception
+    Distribution.Compat.Graph
     Distribution.Compat.Internal.TempFile
     Distribution.Compat.ReadP
     Distribution.Compat.Semigroup
@@ -377,6 +378,7 @@ test-suite unit-tests
     UnitTests.Distribution.Compat.CreatePipe
     UnitTests.Distribution.Compat.ReadP
     UnitTests.Distribution.Compat.Time
+    UnitTests.Distribution.Compat.Graph
     UnitTests.Distribution.Simple.Program.Internal
     UnitTests.Distribution.Simple.Utils
     UnitTests.Distribution.System
@@ -384,7 +386,9 @@ test-suite unit-tests
     UnitTests.Distribution.Version
   main-is: UnitTests.hs
   build-depends:
+    array,
     base,
+    containers,
     directory,
     filepath,
     tasty,

Cabal/Distribution/Compat/Graph.hs

+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE BangPatterns #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Distribution.Compat.Graph
+-- Copyright   :  (c) Edward Z. Yang 2016
+-- License     :  BSD3
+--
+-- Maintainer  :  cabal-dev@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- A data type representing directed graphs, backed by "Data.Graph".
+-- It is strict in the node type.
+--
+-- This is an alternative interface to "Data.Graph".  In this interface,
+-- nodes (identified by the 'IsNode' type class) are associated with a
+-- key and record the keys of their neighbors.  This interface is more
+-- convenient than 'Data.Graph.Graph', which requires vertices to be
+-- explicitly handled by integer indexes.
+--
+-- The current implementation has somewhat peculiar performance
+-- characteristics.  The asymptotics of all map-like operations mirror
+-- their counterparts in "Data.Map".  However, to perform a graph
+-- operation, we first must build the "Data.Graph" representation, an
+-- operation that takes /O(V + E log V)/.  However, this operation can
+-- be amortized across all queries on that particular graph.
+--
+-- Some nodes may be broken, i.e., refer to neighbors which are not
+-- stored in the graph.  In our graph algorithms, we transparently
+-- ignore such edges; however, you can easily query for the broken
+-- vertices of a graph using 'broken' (and should, e.g., to ensure that
+-- a closure of a graph is well-formed.)  It's possible to take a closed
+-- subset of a broken graph and get a well-formed graph.
+--
+-----------------------------------------------------------------------------
+
+module Distribution.Compat.Graph (
+    -- * Graph type
+    Graph,
+    IsNode(..),
+    -- * Query
+    null,
+    size,
+    lookup,
+    -- * Construction
+    empty,
+    insert,
+    deleteKey,
+    deleteLookup,
+    -- * Combine
+    unionLeft,
+    unionRight,
+    -- * Graph algorithms
+    stronglyConnComp,
+    SCC(..),
+    cycles,
+    broken,
+    closure,
+    revClosure,
+    topSort,
+    revTopSort,
+    -- * Conversions
+    -- ** Maps
+    toMap,
+    -- ** Lists
+    fromList,
+    toList,
+    keys,
+    -- ** Graphs
+    toGraph,
+    -- * Node type
+    Node(..),
+    nodeValue,
+) where
+
+import qualified Prelude as Prelude
+import Prelude hiding (lookup, null)
+import Data.Graph (SCC(..))
+import qualified Data.Graph as G
+import Data.Map (Map)
+import qualified Data.Map as Map
+import qualified Data.Array as Array
+import Data.Array ((!))
+import qualified Data.Tree as Tree
+import Data.Either
+import Data.Typeable
+import qualified Data.Foldable as Foldable
+import Control.DeepSeq
+import Distribution.Compat.Binary (Binary(..))
+
+-- | A graph of nodes @a@.  The nodes are expected to have instance
+-- of class 'IsNode'.
+data Graph a
+    = Graph {
+        graphMap          :: !(Map (Key a) a),
+        -- Lazily cached graph representation
+        graphForward      :: G.Graph,
+        graphAdjoint      :: G.Graph,
+        graphVertexToNode :: G.Vertex -> a,
+        graphKeyToVertex  :: Key a -> Maybe G.Vertex,
+        graphBroken       :: [(a, [Key a])]
+    }
+    deriving (Typeable)
+
+-- NB: Not a Functor! (or Traversable), because you need
+-- to restrict Key a ~ Key b.  We provide our own mapping
+-- functions.
+
+-- General strategy is most operations are deferred to the
+-- Map representation.
+
+instance Show a => Show (Graph a) where
+    show = show . toList
+
+instance (IsNode a, Read a) => Read (Graph a) where
+    readsPrec d s = map (\(a,r) -> (fromList a, r)) (readsPrec d s)
+
+instance (IsNode a, Binary a) => Binary (Graph a) where
+    put x = put (toList x)
+    get = fmap fromList get
+
+instance (Eq (Key a), Eq a) => Eq (Graph a) where
+    g1 == g2 = graphMap g1 == graphMap g2
+
+instance Foldable.Foldable Graph where
+    fold = Foldable.fold . graphMap
+    foldr f z = Foldable.foldr f z . graphMap
+    foldl f z = Foldable.foldl f z . graphMap
+    foldMap f = Foldable.foldMap f . graphMap
+#ifdef MIN_VERSION_base
+#if MIN_VERSION_base(4,6,0)
+    foldl' f z = Foldable.foldl' f z . graphMap
+    foldr' f z = Foldable.foldr' f z . graphMap
+#endif
+#if MIN_VERSION_base(4,8,0)
+    length = Foldable.length . graphMap
+    null   = Foldable.null   . graphMap
+    toList = Foldable.toList . graphMap
+    elem x = Foldable.elem x . graphMap
+    maximum = Foldable.maximum . graphMap
+    minimum = Foldable.minimum . graphMap
+    sum     = Foldable.sum     . graphMap
+    product = Foldable.product . graphMap
+#endif
+#endif
+
+instance (NFData a, NFData (Key a)) => NFData (Graph a) where
+    rnf Graph {
+        graphMap = m,
+        graphForward = gf,
+        graphAdjoint = ga,
+        graphVertexToNode = vtn,
+        graphKeyToVertex = ktv,
+        graphBroken = b
+    } = gf `seq` ga `seq` vtn `seq` ktv `seq` b `seq` rnf m
+
+-- TODO: Data instance?
+
+-- | The 'IsNode' class is used for datatypes which represent directed
+-- graph nodes.  A node of type @a@ is associated with some unique key of
+-- type @'Key' a@; given a node we can determine its key ('nodeKey')
+-- and the keys of its neighbors ('nodeNeighbors').
+class Ord (Key a) => IsNode a where
+    type Key a :: *
+    nodeKey :: a -> Key a
+    nodeNeighbors :: a -> [Key a]
+
+-- | A simple, trivial data type which admits an 'IsNode' instance.
+data Node k a = N a k [k]
+    deriving (Show, Eq)
+
+-- | Get the value from a 'Node'.
+nodeValue :: Node k a -> a
+nodeValue (N a _ _) = a
+
+instance Functor (Node k) where
+    fmap f (N a k ks) = N (f a) k ks
+
+instance Ord k => IsNode (Node k a) where
+    type Key (Node k a) = k
+    nodeKey (N _ k _) = k
+    nodeNeighbors (N _ _ ks) = ks
+
+-- TODO: Maybe introduce a typeclass for items with just
+-- keys (so, Key associated type, and nodeKey method).  But
+-- I didn't need it here, so I didn't introduce it.
+
+-- Query
+
+-- | /O(1)/. Is the graph empty?
+null :: Graph a -> Bool
+null = Map.null . toMap
+
+-- | /O(1)/. The number of nodes in the graph.
+size :: Graph a -> Int
+size = Map.size . toMap
+
+-- | /O(log V)/. Lookup the node at a key in the graph.
+lookup :: IsNode a => Key a -> Graph a -> Maybe a
+lookup k g = Map.lookup k (toMap g)
+
+-- Construction
+
+-- | /O(1)/. The empty graph.
+empty :: IsNode a => Graph a
+empty = fromMap Map.empty
+
+-- | /O(log V)/. Insert a node into a graph.
+insert :: IsNode a => a -> Graph a -> Graph a
+insert !n g = fromMap (Map.insert (nodeKey n) n (toMap g))
+
+-- | /O(log V)/. Delete the node at a key from the graph.
+deleteKey :: IsNode a => Key a -> Graph a -> Graph a
+deleteKey k g = fromMap (Map.delete k (toMap g))
+
+-- | /O(log V)/. Lookup and delete.  This function returns the deleted
+-- value if it existed.
+deleteLookup :: IsNode a => Key a -> Graph a -> (Maybe a, Graph a)
+deleteLookup k g =
+    let (r, m') = Map.updateLookupWithKey (\_ _ -> Nothing) k (toMap g)
+    in (r, fromMap m')
+
+-- Combining
+
+-- | /O(V + V')/. Right-biased union, preferring entries
+-- from the second map when conflicts occur.
+-- @'nodeKey' x = 'nodeKey' (f x)@.
+unionRight :: IsNode a => Graph a -> Graph a -> Graph a
+unionRight g g' = fromMap (Map.union (toMap g') (toMap g))
+
+-- | /O(V + V')/. Left-biased union, preferring entries from
+-- the first map when conflicts occur.
+unionLeft :: IsNode a => Graph a -> Graph a -> Graph a
+unionLeft g g' = fromMap (Map.union (toMap g) (toMap g'))
+
+-- Graph-like operations
+
+-- | /Ω(V + E)/. Compute the strongly connected components of a graph.
+-- Requires amortized construction of graph.
+stronglyConnComp :: Graph a -> [SCC a]
+stronglyConnComp g = map decode forest
+  where
+    forest = G.scc (graphForward g)
+    decode (Tree.Node v [])
+        | mentions_itself v = CyclicSCC  [graphVertexToNode g v]
+        | otherwise         = AcyclicSCC (graphVertexToNode g v)
+    decode other = CyclicSCC (dec other [])
+        where dec (Tree.Node v ts) vs
+                = graphVertexToNode g v : foldr dec vs ts
+    mentions_itself v = v `elem` (graphForward g ! v)
+-- Implementation copied from 'stronglyConnCompR' in 'Data.Graph'.
+
+-- | /Ω(V + E)/. Compute the cycles of a graph.
+-- Requires amortized construction of graph.
+cycles :: Graph a -> [[a]]
+cycles g = [ vs | CyclicSCC vs <- stronglyConnComp g ]
+
+-- | /O(1)/.  Return a list of nodes paired with their broken
+-- neighbors (i.e., neighbor keys which are not in the graph).
+-- Requires amortized construction of graph.
+broken :: Graph a -> [(a, [Key a])]
+broken g = graphBroken g
+
+-- | Compute the subgraph which is the closure of some set of keys.
+-- Returns @Nothing@ if one (or more) keys are not present in
+-- the graph.
+-- Requires amortized construction of graph.
+closure :: Graph a -> [Key a] -> Maybe [a]
+closure g ks = do
+    vs <- mapM (graphKeyToVertex g) ks
+    return (decodeVertexForest g (G.dfs (graphForward g) vs))
+
+-- | Compute the reverse closure of a graph from some set
+-- of keys.  Returns @Nothing@ if one (or more) keys are not present in
+-- the graph.
+-- Requires amortized construction of graph.
+revClosure :: Graph a -> [Key a] -> Maybe [a]
+revClosure g ks = do
+    vs <- mapM (graphKeyToVertex g) ks
+    return (decodeVertexForest g (G.dfs (graphAdjoint g) vs))
+
+flattenForest :: Tree.Forest a -> [a]
+flattenForest = concatMap Tree.flatten
+
+decodeVertexForest :: Graph a -> Tree.Forest G.Vertex -> [a]
+decodeVertexForest g = map (graphVertexToNode g) . flattenForest
+
+-- | Topologically sort the nodes of a graph.
+-- Requires amortized construction of graph.
+topSort :: Graph a -> [a]
+topSort g = map (graphVertexToNode g) $ G.topSort (graphForward g)
+
+-- | Reverse topologically sort the nodes of a graph.
+-- Requires amortized construction of graph.
+revTopSort :: Graph a -> [a]
+revTopSort g = map (graphVertexToNode g) $ G.topSort (graphAdjoint g)
+
+-- Conversions
+
+-- | /O(1)/. Convert a map from keys to nodes into a graph.
+-- The map must satisfy the invariant that
+-- @'fromMap' m == 'fromList' ('Data.Map.elems' m)@;
+-- if you can't fulfill this invariant use @'fromList' ('Data.Map.elems' m)@
+-- instead.  The values of the map are assumed to already
+-- be in WHNF.
+fromMap :: IsNode a => Map (Key a) a -> Graph a
+fromMap m
+    = Graph { graphMap = m
+            -- These are lazily computed!
+            , graphForward = g
+            , graphAdjoint = G.transposeG g
+            , graphVertexToNode = vertex_to_node
+            , graphKeyToVertex = key_to_vertex
+            , graphBroken = broke
+            }
+  where
+    try_key_to_vertex k = maybe (Left k) Right (key_to_vertex k)
+
+    (brokenEdges, edges)
+        = unzip
+        $ [ partitionEithers (map try_key_to_vertex (nodeNeighbors n))
+          | n <- ns ]
+    broke = filter (not . Prelude.null . snd) (zip ns brokenEdges)
+
+    g = Array.listArray bounds edges
+
+    ns              = Map.elems m -- sorted ascending
+    vertices        = zip (map nodeKey ns) [0..]
+    vertex_map      = Map.fromAscList vertices
+    key_to_vertex k = Map.lookup k vertex_map
+
+    vertex_to_node vertex = nodeTable ! vertex
+
+    nodeTable   = Array.listArray bounds ns
+    bounds = (0, Map.size m - 1)
+
+-- | /O(V log V)/. Convert a list of nodes into a graph.
+fromList :: IsNode a => [a] -> Graph a
+fromList ns = fromMap
+            . Map.fromList
+            . map (\n -> n `seq` (nodeKey n, n))
+            $ ns
+
+-- Map-like operations
+
+-- | /O(V)/. Convert a graph into a list of nodes.
+toList :: Graph a -> [a]
+toList g = Map.elems (toMap g)
+
+-- | /O(V)/. Convert a graph into a list of keys.
+keys :: Graph a -> [Key a]
+keys g = Map.keys (toMap g)
+
+-- | /O(1)/. Convert a graph into a map from keys to nodes.
+-- The resulting map @m@ is guaranteed to have the property that
+-- @'Prelude.all' (\(k,n) -> k == 'nodeKey' n) ('Data.Map.toList' m)@.
+toMap :: Graph a -> Map (Key a) a
+toMap = graphMap
+
+-- Graph-like operations
+
+-- | /O(1)/. Convert a graph into a 'Data.Graph.Graph'.
+-- Requires amortized construction of graph.
+toGraph :: Graph a -> (G.Graph, G.Vertex -> a, Key a -> Maybe G.Vertex)
+toGraph g = (graphForward g, graphVertexToNode g, graphKeyToVertex g)

Cabal/Distribution/PackageDescription.hs

@@ -62,9 +62,7 @@ module Distribution.PackageDescription (
         knownTestTypes,
         emptyTestSuite,
         hasTests,
-        withTest,
         testModules,
-        enabledTests,
 
         -- * Benchmarks
         Benchmark(..),
@@ -74,9 +72,7 @@ module Distribution.PackageDescription (
         knownBenchmarkTypes,
         emptyBenchmark,
         hasBenchmarks,
-        withBenchmark,
         benchmarkModules,
-        enabledBenchmarks,
 
         -- * Build information
         BuildInfo(..),
@@ -553,13 +549,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 +587,7 @@ instance Monoid TestSuite where
     mempty = TestSuite {
         testName      = mempty,
         testInterface = mempty,
-        testBuildInfo = mempty,
-        testEnabled   = False
+        testBuildInfo = mempty
     }
     mappend = (Semi.<>)
 
@@ -606,8 +595,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,15 +619,6 @@ 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.
-withTest :: PackageDescription -> (TestSuite -> IO ()) -> IO ()
-withTest pkg_descr f =
-    mapM_ f $ filter (buildable . testBuildInfo) $ enabledTests pkg_descr
-
 -- | Get all the module names from a test suite.
 testModules :: TestSuite -> [ModuleName]
 testModules test = (case testInterface test of
@@ -699,9 +678,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 +712,7 @@ instance Monoid Benchmark where
     mempty = Benchmark {
         benchmarkName      = mempty,
         benchmarkInterface = mempty,
-        benchmarkBuildInfo = mempty,
-        benchmarkEnabled   = False
+        benchmarkBuildInfo = mempty
     }
     mappend = (Semi.<>)
 
@@ -744,8 +720,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,15 +744,6 @@ 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.
-withBenchmark :: PackageDescription -> (Benchmark -> IO ()) -> IO ()
-withBenchmark pkg_descr f =
-    mapM_ f $ filter (buildable . benchmarkBuildInfo) $ enabledBenchmarks pkg_descr
-
 -- | Get all the module names from a benchmark.
 benchmarkModules :: Benchmark -> [ModuleName]
 benchmarkModules benchmark = otherModules (benchmarkBuildInfo benchmark)
@@ -939,12 +905,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/Simple/LocalBuildInfo.hs

@@ -38,11 +38,9 @@ module Distribution.Simple.LocalBuildInfo (
         foldComponent,
         componentName,
         componentBuildInfo,
-        componentEnabled,
-        componentDisabledReason,
-        ComponentDisabledReason(..),
+        componentBuildable,
         pkgComponents,
-        pkgEnabledComponents,
+        pkgBuildableComponents,
         lookupComponent,
         getComponent,
         maybeGetDefaultLibraryLocalBuildInfo,
@@ -59,6 +57,7 @@ module Distribution.Simple.LocalBuildInfo (
         withLibLBI,
         withExeLBI,
         withTestLBI,
+        testLBIs,
 
         -- * Installation directories
         module Distribution.Simple.InstallDirs,
@@ -258,28 +257,11 @@ pkgComponents pkg =
 -- Thus this excludes non-buildable components and test suites or benchmarks
 -- that have been disabled.
 --
-pkgEnabledComponents :: PackageDescription -> [Component]
-pkgEnabledComponents = filter componentEnabled . pkgComponents
-
-componentEnabled :: Component -> Bool
-componentEnabled = isNothing . componentDisabledReason
-
-data ComponentDisabledReason = DisabledComponent
-                             | DisabledAllTests
-                             | DisabledAllBenchmarks
-
-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
+pkgBuildableComponents :: PackageDescription -> [Component]
+pkgBuildableComponents = filter componentBuildable . pkgComponents
+
+componentBuildable :: Component -> Bool
+componentBuildable = buildable . componentBuildInfo
 
 lookupComponent :: PackageDescription -> ComponentName -> Maybe Component
 lookupComponent pkg (CLibName "") = lookupComponent pkg (defaultLibName (package pkg))
@@ -446,6 +428,9 @@ withTestLBI pkg lbi f =
         | (clbi@TestComponentLocalBuildInfo{}, _) <- componentsConfigs lbi
         , CTest test <- [getComponent pkg (componentLocalName clbi)] ]
 
+testLBIs :: LocalBuildInfo -> [ComponentLocalBuildInfo]
+testLBIs lbi = [ clbi | (clbi@TestComponentLocalBuildInfo{}, _) <- componentsConfigs lbi ]
+
 {-# DEPRECATED withComponentsLBI "Use withAllComponentsInBuildOrder" #-}
 withComponentsLBI :: PackageDescription -> LocalBuildInfo
                   -> (Component -> ComponentLocalBuildInfo -> IO ())

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) ]
+        enabledTestLBIs = testLBIs lbi
 
         doTest :: (PD.TestSuite, Maybe TestSuiteLog) -> IO TestSuiteLog
         doTest (suite, _) =
@@ -78,10 +76,17 @@ test args pkg_descr lbi flags = do
         notice verbosity "Package has no test suites."
         exitWith ExitSuccess
 
-    when (PD.hasTests pkg_descr && null enabledTests) $
+    -- TODO: When we support configuring only a single component, we
+    -- should refine the message here
+    when (PD.hasTests pkg_descr && null enabledTestLBIs) $
         die $ "No test suites enabled. Did you remember to configure with "
               ++ "\'--enable-tests\'?"
 
+    targets <- readBuildTargets pkg_descr args