Commit 1c20a632 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Fix withComponentsLBI and move Components to LocalBuildInfo module

An annoyance of the current Simple build system is that each phase
(build, install, etc) can be passed additional HookedBuildInfo which
gets merged into the PackageDescription. This means that we cannot
process the PackageDescription up front at configure time and just
store and reuse it later, we have to work from it each time afresh.

The recent addition of Components (libs, exes, test suites) and a
topoligical sort of the components in the LocalBuildInfo fell foul
of this annoyance. The LocalBuildInfo stored the entire component
which meant they were not updated with the HookedBuildInfo. This
broke packages with custom Setup.hs scripts that took advantage of
the HookedBuildInfo feature, including those with configure scripts.

The solution is to store not the list of whole components but the
list of component names. Then withComponentsLBI retrieves the actual
components from the PackageDescription which thus includes the
HookedBuildInfo.

Also moved the Components into an internal module because (for the
moment at least) it is part of the Simple build system, not part of
the package description.
parent a200ac6d
......@@ -59,10 +59,6 @@ module Distribution.PackageDescription (
BuildType(..),
knownBuildTypes,
-- ** Primary Components
Component(..),
compSel,
-- ** Libraries
Library(..),
emptyLibrary,
......@@ -93,7 +89,6 @@ module Distribution.PackageDescription (
BuildInfo(..),
emptyBuildInfo,
allBuildInfo,
allComponentsBy,
allLanguages,
allExtensions,
usedExtensions,
......@@ -608,43 +603,19 @@ emptyBuildInfo = mempty
-- | The 'BuildInfo' for the library (if there is one and it's buildable), and
-- all buildable executables and test suites. Useful for gathering dependencies.
allBuildInfo :: PackageDescription -> [BuildInfo]
allBuildInfo = flip allComponentsBy
$ compSel libBuildInfo buildInfo testBuildInfo
allBuildInfo pkg_descr = [ bi | Just lib <- [library pkg_descr]
, let bi = libBuildInfo lib
, buildable bi ]
++ [ bi | exe <- executables pkg_descr
, let bi = buildInfo exe
, buildable bi ]
++ [ bi | tst <- testSuites pkg_descr
, let bi = testBuildInfo tst
, buildable bi
, testEnabled tst ]
--FIXME: many of the places where this is used, we actually want to look at
-- unbuildable bits too, probably need separate functions
data Component = CLib Library
| CExe Executable
| CTst TestSuite
deriving (Show, Eq, Read)
compSel :: (Library -> a)
-> (Executable -> a)
-> (TestSuite -> a)
-> Component
-> a
compSel f _ _ (CLib l) = f l
compSel _ f _ (CExe e) = f e
compSel _ _ f (CTst t) = f t
-- | 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 l) | Just l <- [library pkg_descr]
, buildable (libBuildInfo l)
]
++
[ f (CExe e) | e <- executables pkg_descr
, buildable (buildInfo e)
]
++
[ f (CTst t) | t <- testSuites pkg_descr
, buildable (testBuildInfo t)
, testEnabled t
]
-- | The 'Language's used by this component
--
allLanguages :: BuildInfo -> [Language]
......
......@@ -69,7 +69,7 @@ import Distribution.Simple.Compiler
( CompilerFlavor(..), compilerFlavor, PackageDB(..) )
import Distribution.PackageDescription
( PackageDescription(..), BuildInfo(..), Library(..), Executable(..)
, TestSuite(..), TestSuiteInterface(..), Component(..) )
, TestSuite(..), TestSuiteInterface(..) )
import qualified Distribution.InstalledPackageInfo as IPI
import qualified Distribution.ModuleName as ModuleName
......@@ -79,7 +79,7 @@ import Distribution.Simple.PreProcess
( preprocessComponent, PPSuffixHandler )
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(compiler, buildDir, withPackageDB)
, ComponentLocalBuildInfo(..), withComponentsLBI
, Component(..), ComponentLocalBuildInfo(..), withComponentsLBI
, inplacePackageId )
import Distribution.Simple.BuildPaths
( autogenModulesDir, autogenModuleName, cppHeaderName )
......@@ -123,7 +123,7 @@ build pkg_descr lbi flags suffixes = do
let pre c = preprocessComponent pkg_descr c lbi False verbosity suffixes
lbi' = lbi {withPackageDB = withPackageDB lbi ++ [internalPackageDB]}
-- Use the internal package DB for the exes.
withComponentsLBI lbi $ \comp clbi -> do
withComponentsLBI pkg_descr lbi $ \comp clbi -> do
pre comp
case comp of
CLib lib -> do
......@@ -147,7 +147,7 @@ build pkg_descr lbi flags suffixes = do
info verbosity $ "Building executable " ++ exeName exe ++ "..."
buildExe verbosity pkg_descr lbi' exe clbi
CTst test -> do
CTest test -> do
case testInterface test of
TestSuiteExeV10 _ f -> do
let exe = Executable
......
......@@ -82,8 +82,7 @@ import Distribution.PackageDescription as PD
( PackageDescription(..), specVersion, GenericPackageDescription(..)
, Library(..), hasLibs, Executable(..), BuildInfo(..), allExtensions
, HookedBuildInfo, updatePackageDescription, allBuildInfo
, FlagName(..), TestSuite(..)
, allComponentsBy, Component(..), compSel )
, FlagName(..), TestSuite(..) )
import Distribution.PackageDescription.Configuration
( finalizePackageDescription, mapTreeData )
import Distribution.PackageDescription.Check
......@@ -102,7 +101,8 @@ import Distribution.Simple.InstallDirs
( InstallDirs(..), defaultInstallDirs, combineInstallDirs )
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), ComponentLocalBuildInfo(..)
, absoluteInstallDirs, prefixRelativeInstallDirs, inplacePackageId )
, absoluteInstallDirs, prefixRelativeInstallDirs, inplacePackageId
, allComponentsBy, Component(..), foldComponent, ComponentName(..) )
import Distribution.Simple.BuildPaths
( autogenModulesDir )
import Distribution.Simple.Utils
......@@ -485,7 +485,7 @@ configure (pkg_descr0, pbi) cfg
mapMaybe exeDepToComp (buildTools bi)
++ mapMaybe libDepToComp (targetBuildDepends bi)
where
bi = compSel libBuildInfo buildInfo testBuildInfo $ component
bi = foldComponent libBuildInfo buildInfo testBuildInfo component
exeDepToComp (Dependency (PackageName name) _) =
CExe `fmap` find ((==) name . exeName)
(executables pkg_descr')
......@@ -498,11 +498,14 @@ configure (pkg_descr0, pbi) cfg
where (g, lkup, _) = graphFromEdges
$ allComponentsBy pkg_descr'
$ \c -> (c, key c, map key (ipDeps c))
key = compSel (const "library") exeName testName
key = foldComponent (const "library") exeName testName
-- check for cycles in the dependency graph
buildOrder <- forM sccs $ \scc -> case scc of
AcyclicSCC (c,_,_) -> return c
AcyclicSCC (c,_,_) -> return (foldComponent (const CLibName)
(CExeName . exeName)
(CTestName . testName)
c)
CyclicSCC vs ->
die $ "Found cycle in intrapackage dependency graph:\n "
++ intercalate " depends on "
......
......@@ -56,7 +56,7 @@ import Distribution.Package
import qualified Distribution.ModuleName as ModuleName
import Distribution.PackageDescription as PD
( PackageDescription(..), BuildInfo(..), allExtensions
, Library(..), hasLibs, Executable(..), Component(..) )
, Library(..), hasLibs, Executable(..) )
import Distribution.Simple.Compiler
( Compiler(..), compilerVersion )
import Distribution.Simple.GHC ( ghcLibDir )
......@@ -78,7 +78,7 @@ import Distribution.Simple.InstallDirs (InstallDirs(..), PathTemplate,
initialPathTemplateEnv)
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), externalPackageDeps
, ComponentLocalBuildInfo(..), withComponentsLBI )
, Component(..), ComponentLocalBuildInfo(..), withComponentsLBI )
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 lbi $ \comp clbi -> do
withComponentsLBI pkg_descr lbi $ \comp clbi -> do
pre comp
case comp of
CLib lib -> do
......@@ -505,7 +505,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 lbi $ \comp _ -> do
withComponentsLBI pkg_descr lbi $ \comp _ -> do
pre comp
case comp of
CLib lib -> do
......
......@@ -48,11 +48,18 @@ module Distribution.Simple.LocalBuildInfo (
LocalBuildInfo(..),
externalPackageDeps,
inplacePackageId,
-- * Buildable package components
Component(..),
foldComponent,
allComponentsBy,
ComponentName(..),
ComponentLocalBuildInfo(..),
withComponentsLBI,
withLibLBI,
withExeLBI,
withComponentsLBI,
withTestLBI,
ComponentLocalBuildInfo(..),
-- * Installation directories
module Distribution.Simple.InstallDirs,
absoluteInstallDirs, prefixRelativeInstallDirs,
......@@ -66,9 +73,9 @@ import Distribution.Simple.InstallDirs hiding (absoluteInstallDirs,
import qualified Distribution.Simple.InstallDirs as InstallDirs
import Distribution.Simple.Program (ProgramConfiguration)
import Distribution.PackageDescription
( PackageDescription(..), withLib, Library, withExe
, Executable(exeName), withTest, TestSuite(..)
, Component(..) )
( PackageDescription(..), withLib, Library(libBuildInfo), withExe
, Executable(exeName, buildInfo), withTest, TestSuite(..)
, BuildInfo(buildable) )
import Distribution.Package
( PackageId, Package(..), InstalledPackageId(..) )
import Distribution.Simple.Compiler
......@@ -82,7 +89,7 @@ import Distribution.Simple.Setup
import Distribution.Text
( display )
import Data.List (nub)
import Data.List (nub, find)
-- | Data cached after configuration step. See also
-- 'Distribution.Simple.Setup.ConfigFlags'.
......@@ -106,7 +113,7 @@ data LocalBuildInfo = LocalBuildInfo {
-- ^ Where to put the result of the Hugs build.
libraryConfig :: Maybe ComponentLocalBuildInfo,
executableConfigs :: [(String, ComponentLocalBuildInfo)],
compBuildOrder :: [Component],
compBuildOrder :: [ComponentName],
-- ^ All the components to build, ordered by topological sort
-- over the intrapackage dependency graph
testSuiteConfigs :: [(String, ComponentLocalBuildInfo)],
......@@ -133,15 +140,6 @@ data LocalBuildInfo = LocalBuildInfo {
progSuffix :: PathTemplate -- ^Suffix to be appended to installed executables
} deriving (Read, Show)
data ComponentLocalBuildInfo = ComponentLocalBuildInfo {
-- | Resolved internal and external package dependencies for this component.
-- The 'BuildInfo' specifies a set of build dependencies that must be
-- satisfied in terms of version ranges. This field fixes those dependencies
-- to the specific versions available on this machine for this compiler.
componentPackageDeps :: [(InstalledPackageId, PackageId)]
}
deriving (Read, Show)
-- | External package dependencies for the package as a whole, the union of the
-- individual 'targetPackageDeps'.
externalPackageDeps :: LocalBuildInfo -> [(InstalledPackageId, PackageId)]
......@@ -156,6 +154,51 @@ externalPackageDeps lbi = nub $
inplacePackageId :: PackageId -> InstalledPackageId
inplacePackageId pkgid = InstalledPackageId (display pkgid ++ "-inplace")
-- -----------------------------------------------------------------------------
-- Buildable components
data Component = CLib Library
| CExe Executable
| CTest TestSuite
deriving (Show, Eq, Read)
data ComponentName = CLibName -- currently only a single lib
| CExeName String
| CTestName String
deriving (Show, Eq, Read)
data ComponentLocalBuildInfo = ComponentLocalBuildInfo {
-- | Resolved internal and external package dependencies for this component.
-- The 'BuildInfo' specifies a set of build dependencies that must be
-- satisfied in terms of version ranges. This field fixes those dependencies
-- to the specific versions available on this machine for this compiler.
componentPackageDeps :: [(InstalledPackageId, PackageId)]
}
deriving (Read, Show)
foldComponent :: (Library -> a)
-> (Executable -> a)
-> (TestSuite -> a)
-> Component
-> a
foldComponent f _ _ (CLib lib) = f lib
foldComponent _ f _ (CExe exe) = f exe
foldComponent _ _ f (CTest tst) = f tst
-- | 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 ]
-- |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.
......@@ -164,8 +207,7 @@ withLibLBI :: PackageDescription -> LocalBuildInfo
withLibLBI pkg_descr lbi f = withLib pkg_descr $ \lib ->
case libraryConfig lbi of
Just clbi -> f lib clbi
Nothing -> die $ "internal error: the package contains a library "
++ "but there is no corresponding configuration data"
Nothing -> die missingLibConf
-- | Perform the action on each buildable 'Executable' in the package
-- description. Extended version of 'withExe' that also gives corresponding
......@@ -175,45 +217,63 @@ withExeLBI :: PackageDescription -> LocalBuildInfo
withExeLBI pkg_descr lbi f = withExe pkg_descr $ \exe ->
case lookup (exeName exe) (executableConfigs lbi) of
Just clbi -> f exe clbi
Nothing -> die $ "internal error: the package contains an executable "
++ exeName exe ++ " but there is no corresponding "
++ "configuration data"
Nothing -> die (missingExeConf (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))
-- | 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'
withComponentsLBI :: LocalBuildInfo
withComponentsLBI :: PackageDescription -> LocalBuildInfo
-> (Component -> ComponentLocalBuildInfo -> IO ())
-> IO ()
withComponentsLBI lbi f = mapM_ compF (compBuildOrder lbi)
withComponentsLBI pkg_descr lbi f = mapM_ compF (compBuildOrder lbi)
where
compF l@(CLib _lib) =
case libraryConfig lbi of
Just clbi -> f l clbi
Nothing -> die $ "internal error: the package contains a library "
++ "but there is no corresponding configuration data"
compF r@(CExe exe) =
case lookup (exeName exe) (executableConfigs lbi) of
Just clbi -> f r clbi
Nothing -> die $ "internal error: the package contains an executable "
++ exeName exe ++ " but there is no corresponding "
++ "configuration data"
compF t@(CTst test) =
case lookup (testName test) (testSuiteConfigs lbi) of
Just clbi -> f t clbi
Nothing -> die $ "internal error: the package contains a test suite "
++ testName test ++ " but there is no corresponding "
++ "configuration data"
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."
missingLibConf :: String
missingExeConf, missingTestConf :: 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"
withTestLBI :: PackageDescription -> LocalBuildInfo
-> (TestSuite -> ComponentLocalBuildInfo -> IO ()) -> IO ()
withTestLBI pkg_descr lbi f =
let wrapper test = case lookup (testName test) (testSuiteConfigs lbi) of
Just clbi -> f test clbi
Nothing -> die $ "internal error: the package contains a test suite "
++ testName test ++ " but there is no corresponding "
++ "configuration data"
in withTest pkg_descr wrapper
-- -----------------------------------------------------------------------------
-- Wrappers for a couple functions from InstallDirs
......
......@@ -66,14 +66,14 @@ import Distribution.PackageDescription as PD
, Executable(..)
, Library(..), libModules
, TestSuite(..), testModules
, TestSuiteInterface(..)
, Component(..) )
, TestSuiteInterface(..) )
import qualified Distribution.InstalledPackageInfo as Installed
( InstalledPackageInfo_(..) )
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.Compiler
( CompilerFlavor(..), Compiler(..), compilerFlavor, compilerVersion )
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), Component(..) )
import Distribution.Simple.BuildPaths (autogenModulesDir,cppHeaderName)
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose, withUTF8FileContents, writeUTF8File
......@@ -197,7 +197,7 @@ preprocessComponent pd comp lbi isSrcDist verbosity handlers = case comp of
pre dirs exeDir (localHandlers bi)
pre (hsSourceDirs bi) exeDir (localHandlers bi) $
dropExtensions (modulePath exe)
CTst test -> do
CTest test -> do
unless (null (testSuites pd)) $
setupMessage verbosity "Preprocessing test suites for" (packageId pd)
case testInterface test of
......
......@@ -227,7 +227,7 @@ prepareTree verbosity pkg_descr0 mb_lbi distPref targetDir pps = do
case mb_lbi of
Just lbi | not (null pps) -> do
let lbi' = lbi{ buildDir = targetDir </> buildDir lbi }
withComponentsLBI lbi' $ \c _ ->
withComponentsLBI pkg_descr lbi' $ \c _ ->
preprocessComponent pkg_descr c lbi' True verbosity pps
_ -> return ()
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment