module Distribution.Simple.LocalBuildInfo (
LocalBuildInfo(..),
externalPackageDeps,
localComponentId,
localUnitId,
localCompatPackageKey,
Component(..),
ComponentName(..),
defaultLibName,
showComponentName,
componentNameString,
ComponentLocalBuildInfo(..),
componentBuildDir,
foldComponent,
componentName,
componentBuildInfo,
componentBuildable,
pkgComponents,
pkgBuildableComponents,
lookupComponent,
getComponent,
getComponentLocalBuildInfo,
allComponentsInBuildOrder,
componentsInBuildOrder,
depLibraryPaths,
allLibModules,
withAllComponentsInBuildOrder,
withComponentsInBuildOrder,
withComponentsLBI,
withLibLBI,
withExeLBI,
withBenchLBI,
withTestLBI,
enabledTestLBIs,
enabledBenchLBIs,
module Distribution.Simple.InstallDirs,
absoluteInstallDirs, prefixRelativeInstallDirs,
absoluteComponentInstallDirs, prefixRelativeComponentInstallDirs,
substPathTemplate,
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Types.Component
import Distribution.Types.PackageId
import Distribution.Types.UnitId
import Distribution.Types.ComponentName
import Distribution.Types.UnqualComponentName
import Distribution.Types.PackageDescription
import Distribution.Types.ComponentLocalBuildInfo
import Distribution.Types.LocalBuildInfo
import Distribution.Types.TargetInfo
import Distribution.Simple.InstallDirs hiding (absoluteInstallDirs,
prefixRelativeInstallDirs,
substPathTemplate, )
import qualified Distribution.Simple.InstallDirs as InstallDirs
import Distribution.PackageDescription
import qualified Distribution.InstalledPackageInfo as Installed
import Distribution.Package
import Distribution.ModuleName
import Distribution.Simple.Compiler
import Distribution.Simple.PackageIndex
import Distribution.Simple.Utils
import Distribution.Text
import qualified Distribution.Compat.Graph as Graph
import Data.List (stripPrefix)
import System.FilePath
import qualified Data.Map as Map
import System.Directory (doesDirectoryExist, canonicalizePath)
componentBuildDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> FilePath
componentBuildDir lbi clbi
= buildDir lbi </>
case componentLocalName clbi of
CLibName ->
if display (componentUnitId clbi) == display (componentComponentId clbi)
then ""
else display (componentUnitId clbi)
CSubLibName s ->
if display (componentUnitId clbi) == display (componentComponentId clbi)
then unUnqualComponentName s
else display (componentUnitId clbi)
CFLibName s -> unUnqualComponentName s
CExeName s -> unUnqualComponentName s
CTestName s -> unUnqualComponentName s
CBenchName s -> unUnqualComponentName s
getComponentLocalBuildInfo :: LocalBuildInfo -> ComponentName -> ComponentLocalBuildInfo
getComponentLocalBuildInfo lbi cname =
case componentNameCLBIs lbi cname of
[clbi] -> clbi
[] ->
error $ "internal error: there is no configuration data "
++ "for component " ++ show cname
clbis ->
error $ "internal error: the component name " ++ show cname
++ "is ambiguous. Refers to: "
++ intercalate ", " (map (display . componentUnitId) clbis)
withLibLBI :: PackageDescription -> LocalBuildInfo
-> (Library -> ComponentLocalBuildInfo -> IO ()) -> IO ()
withLibLBI pkg lbi f =
withAllTargetsInBuildOrder' pkg lbi $ \target ->
case targetComponent target of
CLib lib -> f lib (targetCLBI target)
_ -> return ()
withExeLBI :: PackageDescription -> LocalBuildInfo
-> (Executable -> ComponentLocalBuildInfo -> IO ()) -> IO ()
withExeLBI pkg lbi f =
withAllTargetsInBuildOrder' pkg lbi $ \target ->
case targetComponent target of
CExe exe -> f exe (targetCLBI target)
_ -> return ()
withBenchLBI :: PackageDescription -> LocalBuildInfo
-> (Benchmark -> ComponentLocalBuildInfo -> IO ()) -> IO ()
withBenchLBI pkg lbi f =
sequence_ [ f test clbi | (test, clbi) <- enabledBenchLBIs pkg lbi ]
withTestLBI :: PackageDescription -> LocalBuildInfo
-> (TestSuite -> ComponentLocalBuildInfo -> IO ()) -> IO ()
withTestLBI pkg lbi f =
sequence_ [ f test clbi | (test, clbi) <- enabledTestLBIs pkg lbi ]
enabledTestLBIs :: PackageDescription -> LocalBuildInfo
-> [(TestSuite, ComponentLocalBuildInfo)]
enabledTestLBIs pkg lbi =
[ (test, targetCLBI target)
| target <- allTargetsInBuildOrder' pkg lbi
, CTest test <- [targetComponent target] ]
enabledBenchLBIs :: PackageDescription -> LocalBuildInfo
-> [(Benchmark, ComponentLocalBuildInfo)]
enabledBenchLBIs pkg lbi =
[ (bench, targetCLBI target)
| target <- allTargetsInBuildOrder' pkg lbi
, CBench bench <- [targetComponent target] ]
withComponentsLBI :: PackageDescription -> LocalBuildInfo
-> (Component -> ComponentLocalBuildInfo -> IO ())
-> IO ()
withComponentsLBI = withAllComponentsInBuildOrder
withAllComponentsInBuildOrder :: PackageDescription -> LocalBuildInfo
-> (Component -> ComponentLocalBuildInfo -> IO ())
-> IO ()
withAllComponentsInBuildOrder pkg lbi f =
withAllTargetsInBuildOrder' pkg lbi $ \target ->
f (targetComponent target) (targetCLBI target)
withComponentsInBuildOrder :: PackageDescription -> LocalBuildInfo
-> [ComponentName]
-> (Component -> ComponentLocalBuildInfo -> IO ())
-> IO ()
withComponentsInBuildOrder pkg lbi cnames f =
withNeededTargetsInBuildOrder' pkg lbi uids $ \target ->
f (targetComponent target) (targetCLBI target)
where uids = concatMap (componentNameToUnitIds lbi) cnames
allComponentsInBuildOrder :: LocalBuildInfo
-> [ComponentLocalBuildInfo]
allComponentsInBuildOrder lbi =
Graph.topSort (componentGraph lbi)
componentNameToUnitIds :: LocalBuildInfo -> ComponentName -> [UnitId]
componentNameToUnitIds lbi cname =
case Map.lookup cname (componentNameMap lbi) of
Just clbis -> map componentUnitId clbis
Nothing -> error $ "componentNameToUnitIds " ++ display cname
componentsInBuildOrder :: LocalBuildInfo -> [ComponentName]
-> [ComponentLocalBuildInfo]
componentsInBuildOrder lbi cnames
= map targetCLBI (neededTargetsInBuildOrder' (localPkgDescr lbi) lbi uids)
where uids = concatMap (componentNameToUnitIds lbi) cnames
depLibraryPaths :: Bool
-> Bool
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> NoCallStackIO [FilePath]
depLibraryPaths inplace relative lbi clbi = do
let pkgDescr = localPkgDescr lbi
installDirs = absoluteComponentInstallDirs pkgDescr lbi (componentUnitId clbi) NoCopyDest
executable = case clbi of
ExeComponentLocalBuildInfo {} -> True
_ -> False
relDir | executable = bindir installDirs
| otherwise = libdir installDirs
let
internalDeps = [ uid
| (uid, _) <- componentPackageDeps clbi
, sub_target <- allTargetsInBuildOrder' pkgDescr lbi
, componentUnitId (targetCLBI (sub_target)) == uid ]
internalLibs = [ getLibDir (targetCLBI sub_target)
| sub_target <- neededTargetsInBuildOrder'
pkgDescr lbi internalDeps ]
getLibDir sub_clbi
| inplace = componentBuildDir lbi sub_clbi
| otherwise = dynlibdir (absoluteComponentInstallDirs pkgDescr lbi (componentUnitId sub_clbi) NoCopyDest)
let external_ipkgs = filter is_external (allPackages (installedPkgs lbi))
is_external ipkg = not (installedUnitId ipkg `elem` internalDeps)
getDynDir pkg = case Installed.libraryDynDirs pkg of
[] -> Installed.libraryDirs pkg
d -> d
allDepLibDirs = concatMap getDynDir external_ipkgs
allDepLibDirs' = internalLibs ++ allDepLibDirs
allDepLibDirsC <- traverse canonicalizePathNoFail allDepLibDirs'
let p = prefix installDirs
prefixRelative l = isJust (stripPrefix p l)
libPaths
| relative &&
prefixRelative relDir = map (\l ->
if prefixRelative l
then shortRelativePath relDir l
else l
) allDepLibDirsC
| otherwise = allDepLibDirsC
return libPaths
where
canonicalizePathNoFail p = do
exists <- doesDirectoryExist p
if exists
then canonicalizePath p
else return p
allLibModules :: Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules lib clbi =
ordNub $
explicitLibModules lib ++
case clbi of
LibComponentLocalBuildInfo { componentInstantiatedWith = insts } -> map fst insts
_ -> []
absoluteInstallDirs :: PackageDescription -> LocalBuildInfo
-> CopyDest
-> InstallDirs FilePath
absoluteInstallDirs pkg lbi copydest =
absoluteComponentInstallDirs pkg lbi (localUnitId lbi) copydest
absoluteComponentInstallDirs :: PackageDescription -> LocalBuildInfo
-> UnitId
-> CopyDest
-> InstallDirs FilePath
absoluteComponentInstallDirs pkg lbi uid copydest =
InstallDirs.absoluteInstallDirs
(packageId pkg)
uid
(compilerInfo (compiler lbi))
copydest
(hostPlatform lbi)
(installDirTemplates lbi)
prefixRelativeInstallDirs :: PackageId -> LocalBuildInfo
-> InstallDirs (Maybe FilePath)
prefixRelativeInstallDirs pkg_descr lbi =
prefixRelativeComponentInstallDirs pkg_descr lbi (localUnitId lbi)
prefixRelativeComponentInstallDirs :: PackageId -> LocalBuildInfo
-> UnitId
-> InstallDirs (Maybe FilePath)
prefixRelativeComponentInstallDirs pkg_descr lbi uid =
InstallDirs.prefixRelativeInstallDirs
(packageId pkg_descr)
uid
(compilerInfo (compiler lbi))
(hostPlatform lbi)
(installDirTemplates lbi)
substPathTemplate :: PackageId -> LocalBuildInfo
-> UnitId
-> PathTemplate -> FilePath
substPathTemplate pkgid lbi uid = fromPathTemplate
. ( InstallDirs.substPathTemplate env )
where env = initialPathTemplateEnv
pkgid
uid
(compilerInfo (compiler lbi))
(hostPlatform lbi)