{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Distribution.Types.LocalBuildInfo (
LocalBuildInfo(..),
localComponentId,
localUnitId,
localCompatPackageKey,
localPackage,
componentNameCLBIs,
componentNameTargets',
unitIdTarget',
allTargetsInBuildOrder',
withAllTargetsInBuildOrder',
neededTargetsInBuildOrder',
withNeededTargetsInBuildOrder',
testCoverage,
componentNameTargets,
unitIdTarget,
allTargetsInBuildOrder,
withAllTargetsInBuildOrder,
neededTargetsInBuildOrder,
withNeededTargetsInBuildOrder,
componentsConfigs,
externalPackageDeps,
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Types.PackageDescription
import Distribution.Types.ComponentLocalBuildInfo
import Distribution.Types.ComponentRequestedSpec
import Distribution.Types.ComponentId
import Distribution.Types.MungedPackageId
import Distribution.Types.PackageId
import Distribution.Types.UnitId
import Distribution.Types.TargetInfo
import Distribution.Simple.InstallDirs hiding (absoluteInstallDirs,
prefixRelativeInstallDirs,
substPathTemplate, )
import Distribution.Simple.Program
import Distribution.PackageDescription
import Distribution.Simple.Compiler
import Distribution.Simple.PackageIndex
import Distribution.Simple.Setup
import Distribution.Text
import Distribution.System
import Distribution.Compat.Graph (Graph)
import qualified Distribution.Compat.Graph as Graph
import qualified Data.Map as Map
data LocalBuildInfo = LocalBuildInfo {
configFlags :: ConfigFlags,
flagAssignment :: FlagAssignment,
componentEnabledSpec :: ComponentRequestedSpec,
extraConfigArgs :: [String],
installDirTemplates :: InstallDirTemplates,
compiler :: Compiler,
hostPlatform :: Platform,
buildDir :: FilePath,
cabalFilePath :: Maybe FilePath,
componentGraph :: Graph ComponentLocalBuildInfo,
componentNameMap :: Map ComponentName [ComponentLocalBuildInfo],
installedPkgs :: InstalledPackageIndex,
pkgDescrFile :: Maybe FilePath,
localPkgDescr :: PackageDescription,
withPrograms :: ProgramDb,
withPackageDB :: PackageDBStack,
withVanillaLib:: Bool,
withProfLib :: Bool,
withSharedLib :: Bool,
withStaticLib :: Bool,
withDynExe :: Bool,
withProfExe :: Bool,
withProfLibDetail :: ProfDetailLevel,
withProfExeDetail :: ProfDetailLevel,
withOptimization :: OptimisationLevel,
withDebugInfo :: DebugInfoLevel,
withGHCiLib :: Bool,
splitSections :: Bool,
splitObjs :: Bool,
stripExes :: Bool,
stripLibs :: Bool,
exeCoverage :: Bool,
libCoverage :: Bool,
progPrefix :: PathTemplate,
progSuffix :: PathTemplate,
relocatable :: Bool
} deriving (Generic, Read, Show)
instance Binary LocalBuildInfo
localComponentId :: LocalBuildInfo -> ComponentId
localComponentId lbi =
case componentNameCLBIs lbi CLibName of
[LibComponentLocalBuildInfo { componentComponentId = cid }]
-> cid
_ -> mkComponentId (display (localPackage lbi))
localPackage :: LocalBuildInfo -> PackageId
localPackage lbi = package (localPkgDescr lbi)
localUnitId :: LocalBuildInfo -> UnitId
localUnitId lbi =
case componentNameCLBIs lbi CLibName of
[LibComponentLocalBuildInfo { componentUnitId = uid }]
-> uid
_ -> mkLegacyUnitId $ localPackage lbi
localCompatPackageKey :: LocalBuildInfo -> String
localCompatPackageKey lbi =
case componentNameCLBIs lbi CLibName of
[LibComponentLocalBuildInfo { componentCompatPackageKey = pk }]
-> pk
_ -> display (localPackage lbi)
mkTargetInfo :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> TargetInfo
mkTargetInfo pkg_descr _lbi clbi =
TargetInfo {
targetCLBI = clbi,
targetComponent = getComponent pkg_descr
(componentLocalName clbi)
}
componentNameTargets' :: PackageDescription -> LocalBuildInfo -> ComponentName -> [TargetInfo]
componentNameTargets' pkg_descr lbi cname =
case Map.lookup cname (componentNameMap lbi) of
Just clbis -> map (mkTargetInfo pkg_descr lbi) clbis
Nothing -> []
unitIdTarget' :: PackageDescription -> LocalBuildInfo -> UnitId -> Maybe TargetInfo
unitIdTarget' pkg_descr lbi uid =
case Graph.lookup uid (componentGraph lbi) of
Just clbi -> Just (mkTargetInfo pkg_descr lbi clbi)
Nothing -> Nothing
componentNameCLBIs :: LocalBuildInfo -> ComponentName -> [ComponentLocalBuildInfo]
componentNameCLBIs lbi cname =
case Map.lookup cname (componentNameMap lbi) of
Just clbis -> clbis
Nothing -> []
allTargetsInBuildOrder' :: PackageDescription -> LocalBuildInfo -> [TargetInfo]
allTargetsInBuildOrder' pkg_descr lbi
= map (mkTargetInfo pkg_descr lbi) (Graph.revTopSort (componentGraph lbi))
withAllTargetsInBuildOrder' :: PackageDescription -> LocalBuildInfo -> (TargetInfo -> IO ()) -> IO ()
withAllTargetsInBuildOrder' pkg_descr lbi f
= sequence_ [ f target | target <- allTargetsInBuildOrder' pkg_descr lbi ]
neededTargetsInBuildOrder' :: PackageDescription -> LocalBuildInfo -> [UnitId] -> [TargetInfo]
neededTargetsInBuildOrder' pkg_descr lbi uids =
case Graph.closure (componentGraph lbi) uids of
Nothing -> error $ "localBuildPlan: missing uids " ++ intercalate ", " (map display uids)
Just clos -> map (mkTargetInfo pkg_descr lbi) (Graph.revTopSort (Graph.fromDistinctList clos))
withNeededTargetsInBuildOrder' :: PackageDescription -> LocalBuildInfo -> [UnitId] -> (TargetInfo -> IO ()) -> IO ()
withNeededTargetsInBuildOrder' pkg_descr lbi uids f
= sequence_ [ f target | target <- neededTargetsInBuildOrder' pkg_descr lbi uids ]
testCoverage :: LocalBuildInfo -> Bool
testCoverage lbi = exeCoverage lbi && libCoverage lbi
{-# WARNING componentNameTargets, unitIdTarget, allTargetsInBuildOrder, withAllTargetsInBuildOrder, neededTargetsInBuildOrder, withNeededTargetsInBuildOrder "By using this function, you may be introducing a bug where you retrieve a 'Component' which does not have 'HookedBuildInfo' applied to it. See the documentation for 'HookedBuildInfo' for an explanation of the issue. If you have a 'PakcageDescription' handy (NOT from the 'LocalBuildInfo'), try using the primed version of the function, which takes it as an extra argument." #-}
componentNameTargets :: LocalBuildInfo -> ComponentName -> [TargetInfo]
componentNameTargets lbi = componentNameTargets' (localPkgDescr lbi) lbi
unitIdTarget :: LocalBuildInfo -> UnitId -> Maybe TargetInfo
unitIdTarget lbi = unitIdTarget' (localPkgDescr lbi) lbi
allTargetsInBuildOrder :: LocalBuildInfo -> [TargetInfo]
allTargetsInBuildOrder lbi = allTargetsInBuildOrder' (localPkgDescr lbi) lbi
withAllTargetsInBuildOrder :: LocalBuildInfo -> (TargetInfo -> IO ()) -> IO ()
withAllTargetsInBuildOrder lbi = withAllTargetsInBuildOrder' (localPkgDescr lbi) lbi
neededTargetsInBuildOrder :: LocalBuildInfo -> [UnitId] -> [TargetInfo]
neededTargetsInBuildOrder lbi = neededTargetsInBuildOrder' (localPkgDescr lbi) lbi
withNeededTargetsInBuildOrder :: LocalBuildInfo -> [UnitId] -> (TargetInfo -> IO ()) -> IO ()
withNeededTargetsInBuildOrder lbi = withNeededTargetsInBuildOrder' (localPkgDescr lbi) lbi
{-# DEPRECATED componentsConfigs "Use 'componentGraph' instead; you can get a list of 'ComponentLocalBuildInfo' with 'Distribution.Compat.Graph.toList'. There's not a good way to get the list of 'ComponentName's the 'ComponentLocalBuildInfo' depends on because this query doesn't make sense; the graph is indexed by 'UnitId' not 'ComponentName'. Given a 'UnitId' you can lookup the 'ComponentLocalBuildInfo' ('getCLBI') and then get the 'ComponentName' ('componentLocalName]). To be removed in Cabal 3.0" #-}
componentsConfigs :: LocalBuildInfo -> [(ComponentName, ComponentLocalBuildInfo, [ComponentName])]
componentsConfigs lbi =
[ (componentLocalName clbi,
clbi,
mapMaybe (fmap componentLocalName . flip Graph.lookup g)
(componentInternalDeps clbi))
| clbi <- Graph.toList g ]
where
g = componentGraph lbi
{-# DEPRECATED externalPackageDeps "You almost certainly don't want this function, which agglomerates the dependencies of ALL enabled components. If you're using this to write out information on your dependencies, read off the dependencies directly from the actual component in question. To be removed in Cabal 3.0" #-}
externalPackageDeps :: LocalBuildInfo -> [(UnitId, MungedPackageId)]
externalPackageDeps lbi =
nub [ (ipkgid, pkgid)
| clbi <- Graph.toList (componentGraph lbi)
, (ipkgid, pkgid) <- componentPackageDeps clbi
, not (internal ipkgid) ]
where
internal ipkgid = any ((==ipkgid) . componentUnitId) (Graph.toList (componentGraph lbi))