Skip to content

GitLab

Commit 321815bd authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Keep the full build component dependency graph 

Plus add functions for finding all the deps of one or more
components, in dependency order. This will be useful for
building individual targets, e.g. cabal build foo.
parent a079a1af
Hide whitespace changes
Inline Side-by-side
Showing with 262 additions and 183 deletions
Cabal/Distribution/Simple/Build.hs
View file @ 321815bd
......@@ -80,7 +80,8 @@ import Distribution.Simple.PreProcess
( preprocessComponent, PPSuffixHandler )
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(compiler, buildDir, withPackageDB, withPrograms)
, Component(..), ComponentLocalBuildInfo(..), withComponentsLBI
, Component(..), ComponentLocalBuildInfo(..)
, withAllComponentsInBuildOrder
, componentBuildInfo, inplacePackageId )
import Distribution.Simple.Program.Types
import Distribution.Simple.Program.Db
......@@ -125,7 +126,7 @@ build pkg_descr lbi flags suffixes = do
internalPackageDB <- createInternalPackageDB distPref
withComponentsLBI pkg_descr lbi $ \comp clbi ->
withAllComponentsInBuildOrder pkg_descr lbi $ \comp clbi ->
let bi = componentBuildInfo comp
progs' = addInternalBuildTools pkg_descr lbi bi (withPrograms lbi)
lbi' = lbi {
......
Cabal/Distribution/Simple/Configure.hs
View file @ 321815bd
......@@ -105,7 +105,8 @@ import Distribution.Simple.InstallDirs
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), ComponentLocalBuildInfo(..)
, absoluteInstallDirs, prefixRelativeInstallDirs, inplacePackageId
, allComponentsBy, Component(..), foldComponent, ComponentName(..) )
, ComponentName(..), pkgEnabledComponents, componentBuildInfo, componentName
, checkComponentsCyclic )
import Distribution.Simple.BuildPaths
( autogenModulesDir )
import Distribution.Simple.Utils
......@@ -132,15 +133,13 @@ import qualified Distribution.Simple.Hugs as Hugs
import qualified Distribution.Simple.UHC as UHC
import Control.Monad
( when, unless, foldM, filterM, forM )
( when, unless, foldM, filterM )
import Data.List
( nub, partition, isPrefixOf, inits, find )
( nub, partition, isPrefixOf, inits )
import Data.Maybe
( isNothing, catMaybes, mapMaybe )
( isNothing, catMaybes )
import Data.Monoid
( Monoid(..) )
import Data.Graph
( SCC(..), graphFromEdges, transposeG, vertices, stronglyConnCompR )
import System.Directory
( doesFileExist, getModificationTime, createDirectoryIfMissing, getTemporaryDirectory )
import System.Exit
......@@ -419,6 +418,13 @@ configure (pkg_descr0, pbi) cfg
| (name, uses) <- inconsistencies
, (pkg, ver) <- uses ]
-- internal component graph
buildComponents <-
case mkComponentsLocalBuildInfo pkg_descr
internalPkgDeps externalPkgDeps of
Left componentCycle -> reportComponentCycle componentCycle
Right components -> return components
-- installation directories
defaultDirs <- defaultInstallDirs flavor userInstall (hasLibs pkg_descr)
let installDirs = combineInstallDirs fromFlagOrDefault
......@@ -471,66 +477,6 @@ configure (pkg_descr0, pbi) cfg
"--enable-split-objs; ignoring")
return False
-- The allPkgDeps contains all the package deps for the whole package
-- but we need to select the subset for this specific component.
-- we just take the subset for the package names this component
-- needs. Note, this only works because we cannot yet depend on two
-- versions of the same package.
let configLib lib = configComponent (libBuildInfo lib)
configExe exe = (exeName exe, configComponent (buildInfo exe))
configTest test = (testName test,
configComponent(testBuildInfo test))
configBenchmark bm = (benchmarkName bm,
configComponent(benchmarkBuildInfo bm))
configComponent bi = ComponentLocalBuildInfo {
componentPackageDeps =
if newPackageDepsBehaviour pkg_descr'
then [ (installedPackageId pkg, packageId pkg)
| pkg <- selectSubset bi externalPkgDeps ]
++ [ (inplacePackageId pkgid, pkgid)
| pkgid <- selectSubset bi internalPkgDeps ]
else [ (installedPackageId pkg, packageId pkg)
| pkg <- externalPkgDeps ]
}
selectSubset :: Package pkg => BuildInfo -> [pkg] -> [pkg]
selectSubset bi pkgs =
[ pkg | pkg <- pkgs, packageName pkg `elem` names ]
where
names = [ name | Dependency name _ <- targetBuildDepends bi ]
-- Obtains the intrapackage dependencies for the given component
let ipDeps component =
mapMaybe exeDepToComp (buildTools bi)
++ mapMaybe libDepToComp (targetBuildDepends bi)
where
bi = foldComponent libBuildInfo buildInfo testBuildInfo
benchmarkBuildInfo component
exeDepToComp (Dependency (PackageName name) _) =
CExe `fmap` find ((==) name . exeName)
(executables pkg_descr')
libDepToComp (Dependency pn _)
| pn `elem` map packageName internalPkgDeps =
CLib `fmap` library pkg_descr'
libDepToComp _ = Nothing
let sccs = (stronglyConnCompR . map lkup . vertices . transposeG) g
where (g, lkup, _) = graphFromEdges
$ allComponentsBy pkg_descr'
$ \c -> (c, key c, map key (ipDeps c))
key = foldComponent (const "library") exeName
testName benchmarkName
-- check for cycles in the dependency graph
buildOrder <- forM sccs $ \scc -> case scc of
AcyclicSCC (c,_,_) -> return (foldComponent (const CLibName)
(CExeName . exeName)
(CTestName . testName)
(CBenchName . benchmarkName)
c)
CyclicSCC vs ->
die $ "Found cycle in intrapackage dependency graph:\n "
++ intercalate " depends on "
(map (\(_,k,_) -> "'" ++ k ++ "'") (vs ++ [head vs]))
sharedLibsByDefault <-
case compilerId comp of
......@@ -552,11 +498,7 @@ configure (pkg_descr0, pbi) cfg
scratchDir = fromFlagOrDefault
(distPref </> "scratch")
(configScratchDir cfg),
libraryConfig = configLib `fmap` library pkg_descr',
executableConfigs = configExe `fmap` executables pkg_descr',
testSuiteConfigs = configTest `fmap` testSuites pkg_descr',
benchmarkConfigs = configBenchmark `fmap` benchmarks pkg_descr',
compBuildOrder = buildOrder,
componentsConfigs = buildComponents,
installedPkgs = packageDependsIndex,
pkgDescrFile = Nothing,
localPkgDescr = pkg_descr',
......@@ -879,6 +821,74 @@ configCompiler (Just hcFlavor) hcPath hcPkg conf verbosity = do
_ -> die "Unknown compiler"
-- -----------------------------------------------------------------------------
-- Making the internal component graph
mkComponentsLocalBuildInfo :: PackageDescription
-> [PackageId] -> [InstalledPackageInfo]
-> Either [ComponentName]
[(ComponentName, ComponentLocalBuildInfo, [ComponentName])]
mkComponentsLocalBuildInfo pkg_descr internalPkgDeps externalPkgDeps =
let graph = [ (c, componentName c, componentDeps c)
| c <- pkgEnabledComponents pkg_descr ]
in case checkComponentsCyclic graph of
Just ccycle -> Left [ cname | (_,cname,_) <- ccycle ]
Nothing -> Right [ (cname, clbi, cdeps)
| (c, cname, cdeps) <- graph
, let clbi = componentLocalBuildInfo c ]
where
-- The dependencies for the given component
componentDeps component =
[ CExeName toolname | Dependency (PackageName toolname) _ <- buildTools bi
, toolname `elem` map exeName (executables pkg_descr) ]
++ [ CLibName | Dependency pkgname _ <- targetBuildDepends bi
, pkgname `elem` map packageName internalPkgDeps ]
where
bi = componentBuildInfo component
-- The allPkgDeps contains all the package deps for the whole package
-- but we need to select the subset for this specific component.
-- we just take the subset for the package names this component
-- needs. Note, this only works because we cannot yet depend on two
-- versions of the same package.
componentLocalBuildInfo component =
ComponentLocalBuildInfo {
componentPackageDeps =
if newPackageDepsBehaviour pkg_descr
then [ (installedPackageId pkg, packageId pkg)
| pkg <- selectSubset bi externalPkgDeps ]
++ [ (inplacePackageId pkgid, pkgid)
| pkgid <- selectSubset bi internalPkgDeps ]
else [ (installedPackageId pkg, packageId pkg)
| pkg <- externalPkgDeps ]
}
where
bi = componentBuildInfo component
selectSubset :: Package pkg => BuildInfo -> [pkg] -> [pkg]
selectSubset bi pkgs =
[ pkg | pkg <- pkgs, packageName pkg `elem` names ]
where
names = [ name | Dependency name _ <- targetBuildDepends bi ]
reportComponentCycle :: [ComponentName] -> IO a
reportComponentCycle cnames =
die $ "Components in the package depend on each other in a cyclic way:\n "
++ intercalate " depends on "
[ "'" ++ showComponentName cname ++ "'"
| cname <- cnames ++ [head cnames] ]
where
showComponentName CLibName = "library"
showComponentName (CExeName name) = "executable " ++ name
showComponentName (CTestName name) = "test suite " ++ name
showComponentName (CBenchName name) = "benchmark " ++ name
-- -----------------------------------------------------------------------------
-- Testing C lib and header dependencies
-- Try to build a test C program which includes every header and links every
-- lib. If that fails, try to narrow it down by preprocessing (only) and linking
-- with individual headers and libs. If none is the obvious culprit then give a
......
Cabal/Distribution/Simple/Haddock.hs
View file @ 321815bd
......@@ -79,7 +79,7 @@ import Distribution.Simple.InstallDirs (InstallDirs(..), PathTemplateEnv, PathTe
initialPathTemplateEnv)
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), Component(..), ComponentLocalBuildInfo(..)
, withComponentsLBI )
, withAllComponentsInBuildOrder )
import Distribution.Simple.BuildPaths ( haddockName,
hscolourPref, autogenModulesDir,
)
......@@ -201,7 +201,7 @@ haddock pkg_descr lbi suffixes flags = do
, fromPackageDescription pkg_descr ]
let pre c = preprocessComponent pkg_descr c lbi False verbosity suffixes
withComponentsLBI pkg_descr lbi $ \comp clbi -> do
withAllComponentsInBuildOrder pkg_descr lbi $ \comp clbi -> do
pre comp
case comp of
CLib lib -> do
......@@ -555,7 +555,7 @@ hscolour' pkg_descr lbi suffixes flags = do
createDirectoryIfMissingVerbose verbosity True $ hscolourPref distPref pkg_descr
let pre c = preprocessComponent pkg_descr c lbi False verbosity suffixes
withComponentsLBI pkg_descr lbi $ \comp _ -> do
withAllComponentsInBuildOrder pkg_descr lbi $ \comp _ -> do
pre comp
case comp of
CLib lib -> do
......
Cabal/Distribution/Simple/LocalBuildInfo.hs
View file @ 321815bd
......@@ -51,11 +51,21 @@ module Distribution.Simple.LocalBuildInfo (
-- * Buildable package components
Component(..),
foldComponent,
componentBuildInfo,
allComponentsBy,
ComponentName(..),
ComponentLocalBuildInfo(..),
foldComponent,
componentName,
componentBuildInfo,
pkgComponents,
pkgEnabledComponents,
getComponent,
getComponentLocalBuildInfo,
allComponentsInBuildOrder,
componentsInBuildOrder,
checkComponentsCyclic,
withAllComponentsInBuildOrder,
withComponentsInBuildOrder,
withComponentsLBI,
withLibLBI,
withExeLBI,
......@@ -83,14 +93,16 @@ import Distribution.Simple.Compiler
( Compiler(..), PackageDBStack, OptimisationLevel )
import Distribution.Simple.PackageIndex
( PackageIndex )
import Distribution.Simple.Utils
( die )
import Distribution.Simple.Setup
( ConfigFlags )
import Distribution.Text
( display )
import Data.List (nub, find)
import Data.List (nub)
import Data.Graph
import Data.Tree (flatten)
import Data.Array ((!))
import Data.Maybe
-- | Data cached after configuration step. See also
-- 'Distribution.Simple.Setup.ConfigFlags'.
......@@ -112,13 +124,9 @@ data LocalBuildInfo = LocalBuildInfo {
--TODO: eliminate hugs's scratchDir, use builddir
scratchDir :: FilePath,
-- ^ Where to put the result of the Hugs build.
libraryConfig :: Maybe ComponentLocalBuildInfo,
executableConfigs :: [(String, ComponentLocalBuildInfo)],
compBuildOrder :: [ComponentName],
-- ^ All the components to build, ordered by topological sort
componentsConfigs :: [(ComponentName, ComponentLocalBuildInfo, [ComponentName])],
-- ^ All the components to build, ordered by topological sort, and with their dependencies
-- over the intrapackage dependency graph
testSuiteConfigs :: [(String, ComponentLocalBuildInfo)],
benchmarkConfigs :: [(String, ComponentLocalBuildInfo)],
installedPkgs :: PackageIndex,
-- ^ All the info about the installed packages that the
-- current package depends on (directly or indirectly).
......@@ -145,12 +153,12 @@ data LocalBuildInfo = LocalBuildInfo {
-- | External package dependencies for the package as a whole. This is the
-- union of the individual 'componentPackageDeps', less any internal deps.
externalPackageDeps :: LocalBuildInfo -> [(InstalledPackageId, PackageId)]
externalPackageDeps lbi = filter (not . internal . snd) $ nub $
-- TODO: what about non-buildable components?
maybe [] componentPackageDeps (libraryConfig lbi)
++ concatMap (componentPackageDeps . snd) (executableConfigs lbi)
++ concatMap (componentPackageDeps . snd) (testSuiteConfigs lbi)
++ concatMap (componentPackageDeps . snd) (benchmarkConfigs lbi)
externalPackageDeps lbi =
-- TODO: what about non-buildable components?
nub [ (ipkgid, pkgid)
| (_,clbi,_) <- componentsConfigs lbi
, (ipkgid, pkgid) <- componentPackageDeps clbi
, not (internal pkgid) ]
where
-- True if this dependency is an internal one (depends on the library
-- defined in the same package).
......@@ -175,7 +183,7 @@ data ComponentName = CLibName -- currently only a single lib
| CExeName String
| CTestName String
| CBenchName String
deriving (Show, Eq, Read)
deriving (Show, Eq, Ord, Read)
data ComponentLocalBuildInfo = ComponentLocalBuildInfo {
-- | Resolved internal and external package dependencies for this component.
......@@ -201,109 +209,168 @@ componentBuildInfo :: Component -> BuildInfo
componentBuildInfo =
foldComponent libBuildInfo buildInfo testBuildInfo benchmarkBuildInfo
-- | Obtains all components (libs, exes, or test suites), transformed by the
-- given function. Useful for gathering dependencies with component context.
allComponentsBy :: PackageDescription
-> (Component -> a)
-> [a]
allComponentsBy pkg_descr f =
[ f (CLib lib) | Just lib <- [library pkg_descr]
, buildable (libBuildInfo lib) ]
++ [ f (CExe exe) | exe <- executables pkg_descr
, buildable (buildInfo exe) ]
++ [ f (CTest tst) | tst <- testSuites pkg_descr
, buildable (testBuildInfo tst)
, testEnabled tst ]
++ [ f (CBench bm) | bm <- benchmarks pkg_descr
, buildable (benchmarkBuildInfo bm)
, benchmarkEnabled bm ]
componentName :: Component -> ComponentName
componentName =
foldComponent (const CLibName)
(CExeName . exeName)
(CTestName . testName)
(CBenchName . benchmarkName)
-- | All the components in the package (libs, exes, or test suites).
--
pkgComponents :: PackageDescription -> [Component]
pkgComponents pkg =
[ CLib lib | Just lib <- [library pkg] ]
++ [ CExe exe | exe <- executables 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.
--
pkgEnabledComponents :: PackageDescription -> [Component]
pkgEnabledComponents pkg =
[ CLib lib | Just lib <- [library pkg]
, buildable (libBuildInfo lib) ]
++ [ CExe exe | exe <- executables pkg
, buildable (buildInfo exe) ]
++ [ CTest tst | tst <- testSuites pkg
, buildable (testBuildInfo tst)
, testEnabled tst ]
++ [ CBench bm | bm <- benchmarks pkg
, buildable (benchmarkBuildInfo bm)
, benchmarkEnabled bm ]
getComponent :: PackageDescription -> ComponentName -> Component
getComponent pkg cname =
case cname of
CLibName ->
case library pkg of
Just lib -> CLib lib
Nothing -> missingComponent
CExeName name ->
case [ exe | exe <- executables pkg, exeName exe == name ] of
[exe] -> CExe exe
_ -> missingComponent
CTestName name ->
case [ tst | tst <- testSuites pkg, testName tst == name ] of
[tst] -> CTest tst
_ -> missingComponent
CBenchName name ->
case [ bch | bch <- benchmarks pkg, benchmarkName bch == name ] of
[bch] -> CBench bch
_ -> missingComponent
where
missingComponent =
error $ "internal error: the package description contains no "
++ "component corresponding to " ++ show cname
getComponentLocalBuildInfo :: LocalBuildInfo -> ComponentName -> ComponentLocalBuildInfo
getComponentLocalBuildInfo lbi cname =
case [ clbi
| (cname', clbi, _) <- componentsConfigs lbi
, cname == cname' ] of
[clbi] -> clbi
_ -> missingComponent
where
missingComponent =
error $ "internal error: there is no configuration data "
++ "for component " ++ show cname
-- |If the package description has a library section, call the given
-- function with the library build info as argument. Extended version of
-- 'withLib' that also gives corresponding build info.
withLibLBI :: PackageDescription -> LocalBuildInfo
-> (Library -> ComponentLocalBuildInfo -> IO ()) -> IO ()
withLibLBI pkg_descr lbi f = withLib pkg_descr $ \lib ->
case libraryConfig lbi of
Just clbi -> f lib clbi
Nothing -> die missingLibConf
withLibLBI pkg_descr lbi f =
withLib pkg_descr $ \lib ->
f lib (getComponentLocalBuildInfo lbi CLibName)
-- | Perform the action on each buildable 'Executable' in the package
-- description. Extended version of 'withExe' that also gives corresponding
-- build info.
withExeLBI :: PackageDescription -> LocalBuildInfo
-> (Executable -> ComponentLocalBuildInfo -> IO ()) -> IO ()
withExeLBI pkg_descr lbi f = withExe pkg_descr $ \exe ->
case lookup (exeName exe) (executableConfigs lbi) of
Just clbi -> f exe clbi
Nothing -> die (missingExeConf (exeName exe))
withExeLBI pkg_descr lbi f =
withExe pkg_descr $ \exe ->
f exe (getComponentLocalBuildInfo lbi (CExeName (exeName exe)))
withTestLBI :: PackageDescription -> LocalBuildInfo
-> (TestSuite -> ComponentLocalBuildInfo -> IO ()) -> IO ()
withTestLBI pkg_descr lbi f = withTest pkg_descr $ \test ->
case lookup (testName test) (testSuiteConfigs lbi) of
Just clbi -> f test clbi
Nothing -> die (missingTestConf (testName test))
withTestLBI pkg_descr lbi f =
withTest pkg_descr $ \test ->
f test (getComponentLocalBuildInfo lbi (CTestName (testName test)))
-- | Perform the action on each buildable 'Library' or 'Executable' (Component)
-- in the PackageDescription, subject to the build order specified by the
-- 'compBuildOrder' field of the given 'LocalBuildInfo'
{-# DEPRECATED withComponentsLBI "Use withAllComponentsInBuildOrder" #-}
withComponentsLBI :: PackageDescription -> LocalBuildInfo
-> (Component -> ComponentLocalBuildInfo -> IO ())
-> IO ()
withComponentsLBI pkg_descr lbi f = mapM_ compF (compBuildOrder lbi)
withComponentsLBI = withAllComponentsInBuildOrder
-- | Perform the action on each buildable 'Library' or 'Executable' (Component)
-- in the PackageDescription, subject to the build order specified by the
-- 'compBuildOrder' field of the given 'LocalBuildInfo'
withAllComponentsInBuildOrder :: PackageDescription -> LocalBuildInfo
-> (Component -> ComponentLocalBuildInfo -> IO ())
-> IO ()
withAllComponentsInBuildOrder pkg lbi f =
sequence_
[ f (getComponent pkg cname) clbi
| (cname, clbi) <- allComponentsInBuildOrder lbi ]
withComponentsInBuildOrder :: PackageDescription -> LocalBuildInfo
-> [ComponentName]
-> (Component -> ComponentLocalBuildInfo -> IO ())
-> IO ()
withComponentsInBuildOrder pkg lbi cnames f =
sequence_
[ f (getComponent pkg cname') clbi
| (cname', clbi) <- componentsInBuildOrder lbi cnames ]
allComponentsInBuildOrder :: LocalBuildInfo
-> [(ComponentName, ComponentLocalBuildInfo)]
allComponentsInBuildOrder lbi =
componentsInBuildOrder lbi
[ cname | (cname, _, _) <- componentsConfigs lbi ]
componentsInBuildOrder :: LocalBuildInfo -> [ComponentName]
-> [(ComponentName, ComponentLocalBuildInfo)]
componentsInBuildOrder lbi cnames =
map ((\(clbi,cname,_) -> (cname,clbi)) . vertexToNode)
. postOrder graph
. map (\cname -> fromMaybe (noSuchComp cname) (keyToVertex cname))
$ cnames
where
compF CLibName =
case library pkg_descr of
Nothing -> die missinglib
Just lib -> case libraryConfig lbi of
Nothing -> die missingLibConf
Just clbi -> f (CLib lib) clbi
where
missinglib = "internal error: component list includes a library "
++ "but the package description contains no library"
compF (CExeName name) =
case find (\exe -> exeName exe == name) (executables pkg_descr) of
Nothing -> die missingexe
Just exe -> case lookup name (executableConfigs lbi) of
Nothing -> die (missingExeConf name)
Just clbi -> f (CExe exe) clbi
where
missingexe = "internal error: component list includes an executable "
++ name ++ " but the package contains no such executable."
compF (CTestName name) =
case find (\tst -> testName tst == name) (testSuites pkg_descr) of
Nothing -> die missingtest
Just tst -> case lookup name (testSuiteConfigs lbi) of
Nothing -> die (missingTestConf name)
Just clbi -> f (CTest tst) clbi
where
missingtest = "internal error: component list includes a test suite "
++ name ++ " but the package contains no such test suite."
compF (CBenchName name) =
case find (\bch -> benchmarkName bch == name) (benchmarks pkg_descr) of
Nothing -> die missingbench
Just bch -> case lookup name (benchmarkConfigs lbi) of
Nothing -> die (missingBenchConf name)
Just clbi -> f (CBench bch) clbi
where
missingbench = "internal error: component list includes a benchmark "
++ name ++ " but the package contains no such benchmark."
missingLibConf :: String
missingExeConf, missingTestConf, missingBenchConf :: String -> String
missingLibConf = "internal error: the package contains a library "
++ "but there is no corresponding configuration data"
missingExeConf name = "internal error: the package contains an executable "
++ name ++ " but there is no corresponding configuration data"
missingTestConf name = "internal error: the package contains a test suite "
++ name ++ " but there is no corresponding configuration data"
missingBenchConf name = "internal error: the package contains a benchmark "
++ name ++ " but there is no corresponding configuration data"
(graph, vertexToNode, keyToVertex) =
graphFromEdges (map (\(a,b,c) -> (b,a,c)) (componentsConfigs lbi))
noSuchComp cname = error $ "internal error: componentsInBuildOrder: "
++ "no such component: " ++ show cname
postOrder :: Graph -> [Vertex] -> [Vertex]
postOrder g vs = postorderF (dfs g vs) []
postorderF :: Forest a -> [a] -> [a]
postorderF ts = foldr (.) id $ map postorderT ts
postorderT :: Tree a -> [a] -> [a]
postorderT (Node a ts) = postorderF ts . (a :)
checkComponentsCyclic :: Ord key => [(node, key, [key])]
-> Maybe [(node, key, [key])]
checkComponentsCyclic es =
let (graph, vertexToNode, _) = graphFromEdges es
cycles = [ flatten c | c <- scc graph, isCycle c ]
isCycle (Node v []) = selfCyclic v
isCycle _ = True
selfCyclic v = v `elem` graph ! v
in case cycles of
[] -> Nothing
(c:_) -> Just (map vertexToNode c)
-- -----------------------------------------------------------------------------
......
Cabal/Distribution/Simple/Register.hs
View file @ 321815bd
......@@ -67,6 +67,7 @@ module Distribution.Simple.Register (
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), ComponentLocalBuildInfo(..)
, ComponentName(..), getComponentLocalBuildInfo
, InstallDirs(..), absoluteInstallDirs )
import Distribution.Simple.BuildPaths (haddockName)
import qualified Distribution.Simple.GHC as GHC
......@@ -123,10 +124,9 @@ import qualified Data.ByteString.Lazy.Char8 as BS.Char8
register :: PackageDescription -> LocalBuildInfo
-> RegisterFlags -- ^Install in the user's database?; verbose
-> IO ()