module Distribution.Simple.LocalBuildInfo (
LocalBuildInfo(..),
externalPackageDeps,
inplacePackageId,
Component(..),
ComponentName(..),
showComponentName,
ComponentLocalBuildInfo(..),
LibraryName(..),
foldComponent,
componentName,
componentBuildInfo,
componentEnabled,
componentDisabledReason,
ComponentDisabledReason(..),
pkgComponents,
pkgEnabledComponents,
lookupComponent,
getComponent,
getComponentLocalBuildInfo,
allComponentsInBuildOrder,
componentsInBuildOrder,
checkComponentsCyclic,
withAllComponentsInBuildOrder,
withComponentsInBuildOrder,
withComponentsLBI,
withLibLBI,
withExeLBI,
withTestLBI,
module Distribution.Simple.InstallDirs,
absoluteInstallDirs, prefixRelativeInstallDirs,
substPathTemplate
) where
import Distribution.Simple.InstallDirs hiding (absoluteInstallDirs,
prefixRelativeInstallDirs,
substPathTemplate, )
import qualified Distribution.Simple.InstallDirs as InstallDirs
import Distribution.Simple.Program (ProgramConfiguration)
import Distribution.PackageDescription
( PackageDescription(..), withLib, Library(libBuildInfo), withExe
, Executable(exeName, buildInfo), withTest, TestSuite(..)
, BuildInfo(buildable), Benchmark(..) )
import Distribution.Package
( PackageId, Package(..), InstalledPackageId(..) )
import Distribution.Simple.Compiler
( Compiler(..), PackageDBStack, OptimisationLevel )
import Distribution.Simple.PackageIndex
( PackageIndex )
import Distribution.Simple.Setup
( ConfigFlags )
import Distribution.Text
( display )
import Distribution.System
( Platform )
import Data.List (nub, find)
import Data.Graph
import Data.Tree (flatten)
import Data.Array ((!))
import Data.Maybe
data LocalBuildInfo = LocalBuildInfo {
configFlags :: ConfigFlags,
extraConfigArgs :: [String],
installDirTemplates :: InstallDirTemplates,
compiler :: Compiler,
hostPlatform :: Platform,
buildDir :: FilePath,
scratchDir :: FilePath,
componentsConfigs :: [(ComponentName, ComponentLocalBuildInfo, [ComponentName])],
installedPkgs :: PackageIndex,
pkgDescrFile :: Maybe FilePath,
localPkgDescr :: PackageDescription,
withPrograms :: ProgramConfiguration,
withPackageDB :: PackageDBStack,
withVanillaLib:: Bool,
withProfLib :: Bool,
withSharedLib :: Bool,
withDynExe :: Bool,
withProfExe :: Bool,
withOptimization :: OptimisationLevel,
withGHCiLib :: Bool,
splitObjs :: Bool,
stripExes :: Bool,
progPrefix :: PathTemplate,
progSuffix :: PathTemplate
} deriving (Read, Show)
externalPackageDeps :: LocalBuildInfo -> [(InstalledPackageId, PackageId)]
externalPackageDeps lbi =
nub [ (ipkgid, pkgid)
| (_,clbi,_) <- componentsConfigs lbi
, (ipkgid, pkgid) <- componentPackageDeps clbi
, not (internal pkgid) ]
where
internal pkgid = pkgid == packageId (localPkgDescr lbi)
inplacePackageId :: PackageId -> InstalledPackageId
inplacePackageId pkgid = InstalledPackageId (display pkgid ++ "-inplace")
data Component = CLib Library
| CExe Executable
| CTest TestSuite
| CBench Benchmark
deriving (Show, Eq, Read)
data ComponentName = CLibName
| CExeName String
| CTestName String
| CBenchName String
deriving (Show, Eq, Ord, Read)
showComponentName :: ComponentName -> String
showComponentName CLibName = "library"
showComponentName (CExeName name) = "executable '" ++ name ++ "'"
showComponentName (CTestName name) = "test suite '" ++ name ++ "'"
showComponentName (CBenchName name) = "benchmark '" ++ name ++ "'"
data ComponentLocalBuildInfo
= LibComponentLocalBuildInfo {
componentPackageDeps :: [(InstalledPackageId, PackageId)],
componentLibraries :: [LibraryName]
}
| ExeComponentLocalBuildInfo {
componentPackageDeps :: [(InstalledPackageId, PackageId)]
}
| TestComponentLocalBuildInfo {
componentPackageDeps :: [(InstalledPackageId, PackageId)]
}
| BenchComponentLocalBuildInfo {
componentPackageDeps :: [(InstalledPackageId, PackageId)]
}
deriving (Read, Show)
foldComponent :: (Library -> a)
-> (Executable -> a)
-> (TestSuite -> a)
-> (Benchmark -> a)
-> Component
-> a
foldComponent f _ _ _ (CLib lib) = f lib
foldComponent _ f _ _ (CExe exe) = f exe
foldComponent _ _ f _ (CTest tst) = f tst
foldComponent _ _ _ f (CBench bch) = f bch
data LibraryName = LibraryName String
deriving (Read, Show)
componentBuildInfo :: Component -> BuildInfo
componentBuildInfo =
foldComponent libBuildInfo buildInfo testBuildInfo benchmarkBuildInfo
componentName :: Component -> ComponentName
componentName =
foldComponent (const CLibName)
(CExeName . exeName)
(CTestName . testName)
(CBenchName . benchmarkName)
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 ]
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
lookupComponent :: PackageDescription -> ComponentName -> Maybe Component
lookupComponent pkg CLibName =
fmap CLib $ library pkg
lookupComponent pkg (CExeName name) =
fmap CExe $ find ((name ==) . exeName) (executables pkg)
lookupComponent pkg (CTestName name) =
fmap CTest $ find ((name ==) . testName) (testSuites pkg)
lookupComponent pkg (CBenchName name) =
fmap CBench $ find ((name ==) . benchmarkName) (benchmarks pkg)
getComponent :: PackageDescription -> ComponentName -> Component
getComponent pkg cname =
case lookupComponent pkg cname of
Just cpnt -> cpnt
Nothing -> 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
withLibLBI :: PackageDescription -> LocalBuildInfo
-> (Library -> ComponentLocalBuildInfo -> IO ()) -> IO ()
withLibLBI pkg_descr lbi f =
withLib pkg_descr $ \lib ->
f lib (getComponentLocalBuildInfo lbi CLibName)
withExeLBI :: PackageDescription -> LocalBuildInfo
-> (Executable -> ComponentLocalBuildInfo -> IO ()) -> IO ()
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 ->
f test (getComponentLocalBuildInfo lbi (CTestName (testName test)))
{-# DEPRECATED withComponentsLBI "Use withAllComponentsInBuildOrder" #-}
withComponentsLBI :: PackageDescription -> LocalBuildInfo
-> (Component -> ComponentLocalBuildInfo -> IO ())
-> IO ()
withComponentsLBI = withAllComponentsInBuildOrder
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
(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)
absoluteInstallDirs :: PackageDescription -> LocalBuildInfo -> CopyDest
-> InstallDirs FilePath
absoluteInstallDirs pkg lbi copydest =
InstallDirs.absoluteInstallDirs
(packageId pkg)
(compilerId (compiler lbi))
copydest
(hostPlatform lbi)
(installDirTemplates lbi)
prefixRelativeInstallDirs :: PackageId -> LocalBuildInfo
-> InstallDirs (Maybe FilePath)
prefixRelativeInstallDirs pkg_descr lbi =
InstallDirs.prefixRelativeInstallDirs
(packageId pkg_descr)
(compilerId (compiler lbi))
(hostPlatform lbi)
(installDirTemplates lbi)
substPathTemplate :: PackageId -> LocalBuildInfo
-> PathTemplate -> FilePath
substPathTemplate pkgid lbi = fromPathTemplate
. ( InstallDirs.substPathTemplate env )
where env = initialPathTemplateEnv
pkgid
(compilerId (compiler lbi))
(hostPlatform lbi)