{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}

module Distribution.Types.LocalBuildInfo (
    -- * The type

    LocalBuildInfo(..),

    -- * Convenience accessors

    localComponentId,
    localUnitId,
    localCompatPackageKey,
    localPackage,

    -- * Build targets of the 'LocalBuildInfo'.

    componentNameCLBIs,

    -- NB: the primes mean that they take a 'PackageDescription'
    -- which may not match 'localPkgDescr' in 'LocalBuildInfo'.
    -- More logical types would drop this argument, but
    -- at the moment, this is the ONLY supported function, because
    -- 'localPkgDescr' is not guaranteed to match.  At some point
    -- we will fix it and then we can use the (free) unprimed
    -- namespace for the correct commands.
    --
    -- See https://github.com/haskell/cabal/issues/3606 for more
    -- details.

    componentNameTargets',
    unitIdTarget',
    allTargetsInBuildOrder',
    withAllTargetsInBuildOrder',
    neededTargetsInBuildOrder',
    withNeededTargetsInBuildOrder',
    testCoverage,

    -- * Functions you SHOULD NOT USE (yet), but are defined here to
    -- prevent someone from accidentally defining them

    componentNameTargets,
    unitIdTarget,
    allTargetsInBuildOrder,
    withAllTargetsInBuildOrder,
    neededTargetsInBuildOrder,
    withNeededTargetsInBuildOrder,
  ) 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.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.System
import Distribution.Pretty

import Distribution.Compat.Graph (Graph)
import qualified Distribution.Compat.Graph as Graph
import qualified Data.Map as Map

-- | Data cached after configuration step.  See also
-- 'Distribution.Simple.Setup.ConfigFlags'.
data LocalBuildInfo = LocalBuildInfo {
        LocalBuildInfo -> ConfigFlags
configFlags   :: ConfigFlags,
        -- ^ Options passed to the configuration step.
        -- Needed to re-run configuration when .cabal is out of date
        LocalBuildInfo -> FlagAssignment
flagAssignment :: FlagAssignment,
        -- ^ The final set of flags which were picked for this package
        LocalBuildInfo -> ComponentRequestedSpec
componentEnabledSpec :: ComponentRequestedSpec,
        -- ^ What components were enabled during configuration, and why.
        LocalBuildInfo -> [String]
extraConfigArgs     :: [String],
        -- ^ Extra args on the command line for the configuration step.
        -- Needed to re-run configuration when .cabal is out of date
        LocalBuildInfo -> InstallDirTemplates
installDirTemplates :: InstallDirTemplates,
                -- ^ The installation directories for the various different
                -- kinds of files
        --TODO: inplaceDirTemplates :: InstallDirs FilePath
        LocalBuildInfo -> Compiler
compiler      :: Compiler,
                -- ^ The compiler we're building with
        LocalBuildInfo -> Platform
hostPlatform  :: Platform,
                -- ^ The platform we're building for
        LocalBuildInfo -> String
buildDir      :: FilePath,
                -- ^ Where to build the package.
        LocalBuildInfo -> Maybe String
cabalFilePath :: Maybe FilePath,
                -- ^ Path to the cabal file, if given during configuration.
        LocalBuildInfo -> Graph ComponentLocalBuildInfo
componentGraph :: Graph ComponentLocalBuildInfo,
                -- ^ All the components to build, ordered by topological
                -- sort, and with their INTERNAL dependencies over the
                -- intrapackage dependency graph.
                -- TODO: this is assumed to be short; otherwise we want
                -- some sort of ordered map.
        LocalBuildInfo -> Map ComponentName [ComponentLocalBuildInfo]
componentNameMap :: Map ComponentName [ComponentLocalBuildInfo],
                -- ^ A map from component name to all matching
                -- components.  These coincide with 'componentGraph'
        LocalBuildInfo -> InstalledPackageIndex
installedPkgs :: InstalledPackageIndex,
                -- ^ All the info about the installed packages that the
                -- current package depends on (directly or indirectly).
                -- The copy saved on disk does NOT include internal
                -- dependencies (because we just don't have enough
                -- information at this point to have an
                -- 'InstalledPackageInfo' for an internal dep), but we
                -- will often update it with the internal dependencies;
                -- see for example 'Distribution.Simple.Build.build'.
                -- (This admonition doesn't apply for per-component builds.)
        LocalBuildInfo -> Maybe String
pkgDescrFile  :: Maybe FilePath,
                -- ^ the filename containing the .cabal file, if available
        LocalBuildInfo -> PackageDescription
localPkgDescr :: PackageDescription,
                -- ^ WARNING WARNING WARNING Be VERY careful about using
                -- this function; we haven't deprecated it but using it
                -- could introduce subtle bugs related to
                -- 'HookedBuildInfo'.
                --
                -- In principle, this is supposed to contain the
                -- resolved package description, that does not contain
                -- any conditionals.  However, it MAY NOT contain
                -- the description with a 'HookedBuildInfo' applied
                -- to it; see 'HookedBuildInfo' for the whole sordid saga.
                -- As much as possible, Cabal library should avoid using
                -- this parameter.
        LocalBuildInfo -> ProgramDb
withPrograms  :: ProgramDb, -- ^Location and args for all programs
        LocalBuildInfo -> PackageDBStack
withPackageDB :: PackageDBStack,  -- ^What package database to use, global\/user
        LocalBuildInfo -> Bool
withVanillaLib:: Bool,  -- ^Whether to build normal libs.
        LocalBuildInfo -> Bool
withProfLib   :: Bool,  -- ^Whether to build profiling versions of libs.
        LocalBuildInfo -> Bool
withSharedLib :: Bool,  -- ^Whether to build shared versions of libs.
        LocalBuildInfo -> Bool
withStaticLib :: Bool,  -- ^Whether to build static versions of libs (with all other libs rolled in)
        LocalBuildInfo -> Bool
withDynExe    :: Bool,  -- ^Whether to link executables dynamically
        LocalBuildInfo -> Bool
withFullyStaticExe :: Bool,  -- ^Whether to link executables fully statically
        LocalBuildInfo -> Bool
withProfExe   :: Bool,  -- ^Whether to build executables for profiling.
        LocalBuildInfo -> ProfDetailLevel
withProfLibDetail :: ProfDetailLevel, -- ^Level of automatic profile detail.
        LocalBuildInfo -> ProfDetailLevel
withProfExeDetail :: ProfDetailLevel, -- ^Level of automatic profile detail.
        LocalBuildInfo -> OptimisationLevel
withOptimization :: OptimisationLevel, -- ^Whether to build with optimization (if available).
        LocalBuildInfo -> DebugInfoLevel
withDebugInfo :: DebugInfoLevel, -- ^Whether to emit debug info (if available).
        LocalBuildInfo -> Bool
withGHCiLib   :: Bool,  -- ^Whether to build libs suitable for use with GHCi.
        LocalBuildInfo -> Bool
splitSections :: Bool,  -- ^Use -split-sections with GHC, if available
        LocalBuildInfo -> Bool
splitObjs     :: Bool,  -- ^Use -split-objs with GHC, if available
        LocalBuildInfo -> Bool
stripExes     :: Bool,  -- ^Whether to strip executables during install
        LocalBuildInfo -> Bool
stripLibs     :: Bool,  -- ^Whether to strip libraries during install
        LocalBuildInfo -> Bool
exeCoverage :: Bool,  -- ^Whether to enable executable program coverage
        LocalBuildInfo -> Bool
libCoverage :: Bool,  -- ^Whether to enable library program coverage
        LocalBuildInfo -> PathTemplate
progPrefix    :: PathTemplate, -- ^Prefix to be prepended to installed executables
        LocalBuildInfo -> PathTemplate
progSuffix    :: PathTemplate, -- ^Suffix to be appended to installed executables
        LocalBuildInfo -> Bool
relocatable   :: Bool --  ^Whether to build a relocatable package
  } deriving ((forall x. LocalBuildInfo -> Rep LocalBuildInfo x)
-> (forall x. Rep LocalBuildInfo x -> LocalBuildInfo)
-> Generic LocalBuildInfo
forall x. Rep LocalBuildInfo x -> LocalBuildInfo
forall x. LocalBuildInfo -> Rep LocalBuildInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LocalBuildInfo x -> LocalBuildInfo
$cfrom :: forall x. LocalBuildInfo -> Rep LocalBuildInfo x
Generic, ReadPrec [LocalBuildInfo]
ReadPrec LocalBuildInfo
Int -> ReadS LocalBuildInfo
ReadS [LocalBuildInfo]
(Int -> ReadS LocalBuildInfo)
-> ReadS [LocalBuildInfo]
-> ReadPrec LocalBuildInfo
-> ReadPrec [LocalBuildInfo]
-> Read LocalBuildInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LocalBuildInfo]
$creadListPrec :: ReadPrec [LocalBuildInfo]
readPrec :: ReadPrec LocalBuildInfo
$creadPrec :: ReadPrec LocalBuildInfo
readList :: ReadS [LocalBuildInfo]
$creadList :: ReadS [LocalBuildInfo]
readsPrec :: Int -> ReadS LocalBuildInfo
$creadsPrec :: Int -> ReadS LocalBuildInfo
External instance of the constraint type Read PackageDB
External instance of the constraint type Read InstalledPackageInfo
External instance of the constraint type Read ComponentName
External instance of the constraint type Read ComponentLocalBuildInfo
External instance of the constraint type Read PathTemplate
External instance of the constraint type Read Char
External instance of the constraint type Read Char
External instance of the constraint type Read DebugInfoLevel
External instance of the constraint type Read OptimisationLevel
External instance of the constraint type Read ProfDetailLevel
External instance of the constraint type Read ProfDetailLevel
External instance of the constraint type Read Bool
External instance of the constraint type Read Bool
External instance of the constraint type Read PackageDB
External instance of the constraint type Read ProgramDb
External instance of the constraint type Read PackageDescription
External instance of the constraint type Read InstalledPackageInfo
External instance of the constraint type forall a. Read a => Read (PackageIndex a)
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read ComponentLocalBuildInfo
External instance of the constraint type Read ComponentName
External instance of the constraint type forall k e. (Ord k, Read k, Read e) => Read (Map k e)
External instance of the constraint type Show UnitId
External instance of the constraint type Read ComponentLocalBuildInfo
External instance of the constraint type forall a. (IsNode a, Read a, Show (Key a)) => Read (Graph a)
External instance of the constraint type forall a. Read a => Read (Maybe a)
External instance of the constraint type forall a. Read a => Read (Maybe a)
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read Char
External instance of the constraint type Read Platform
External instance of the constraint type Read Compiler
External instance of the constraint type Read PathTemplate
External instance of the constraint type forall dir. Read dir => Read (InstallDirs dir)
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read Char
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read ComponentRequestedSpec
External instance of the constraint type Read FlagAssignment
External instance of the constraint type Read ConfigFlags
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Ord ComponentName
External instance of the constraint type Show UnitId
External instance of the constraint type IsNode ComponentLocalBuildInfo
Instance of class: Read of the constraint type Read LocalBuildInfo
Read, Int -> LocalBuildInfo -> ShowS
[LocalBuildInfo] -> ShowS
LocalBuildInfo -> String
(Int -> LocalBuildInfo -> ShowS)
-> (LocalBuildInfo -> String)
-> ([LocalBuildInfo] -> ShowS)
-> Show LocalBuildInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LocalBuildInfo] -> ShowS
$cshowList :: [LocalBuildInfo] -> ShowS
show :: LocalBuildInfo -> String
$cshow :: LocalBuildInfo -> String
showsPrec :: Int -> LocalBuildInfo -> ShowS
$cshowsPrec :: Int -> LocalBuildInfo -> ShowS
External instance of the constraint type Show PackageDB
External instance of the constraint type Show InstalledPackageInfo
External instance of the constraint type Show ComponentName
External instance of the constraint type Show ComponentLocalBuildInfo
External instance of the constraint type Show PathTemplate
External instance of the constraint type Show Char
External instance of the constraint type Show Char
External instance of the constraint type Show DebugInfoLevel
External instance of the constraint type Show OptimisationLevel
External instance of the constraint type Show ProfDetailLevel
External instance of the constraint type Show ProfDetailLevel
External instance of the constraint type Show Bool
External instance of the constraint type Show Bool
External instance of the constraint type Show PackageDB
External instance of the constraint type Show ProgramDb
External instance of the constraint type Show PackageDescription
External instance of the constraint type Show InstalledPackageInfo
External instance of the constraint type forall a. Show a => Show (PackageIndex a)
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show ComponentLocalBuildInfo
External instance of the constraint type Show ComponentName
External instance of the constraint type forall k a. (Show k, Show a) => Show (Map k a)
External instance of the constraint type Show ComponentLocalBuildInfo
External instance of the constraint type forall a. Show a => Show (Graph a)
External instance of the constraint type forall a. Show a => Show (Maybe a)
External instance of the constraint type forall a. Show a => Show (Maybe a)
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
External instance of the constraint type Show Platform
External instance of the constraint type Show Compiler
External instance of the constraint type Show PathTemplate
External instance of the constraint type forall dir. Show dir => Show (InstallDirs dir)
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show ComponentRequestedSpec
External instance of the constraint type Show FlagAssignment
External instance of the constraint type Show ConfigFlags
External instance of the constraint type Ord Int
Show, Typeable)

instance Binary LocalBuildInfo
instance Structured LocalBuildInfo

-------------------------------------------------------------------------------
-- Accessor functions

-- TODO: Get rid of these functions, as much as possible.  They are
-- a bit useful in some cases, but you should be very careful!

-- | Extract the 'ComponentId' from the public library component of a
-- 'LocalBuildInfo' if it exists, or make a fake component ID based
-- on the package ID.
localComponentId :: LocalBuildInfo -> ComponentId
localComponentId :: LocalBuildInfo -> ComponentId
localComponentId LocalBuildInfo
lbi =
    case LocalBuildInfo -> ComponentName -> [ComponentLocalBuildInfo]
componentNameCLBIs LocalBuildInfo
lbi (LibraryName -> ComponentName
CLibName LibraryName
LMainLibName) of
        [LibComponentLocalBuildInfo { componentComponentId :: ComponentLocalBuildInfo -> ComponentId
componentComponentId = ComponentId
cid }]
          -> ComponentId
cid
        [ComponentLocalBuildInfo]
_ -> String -> ComponentId
mkComponentId (PackageId -> String
forall a. Pretty a => a -> String
External instance of the constraint type Pretty PackageId
prettyShow (LocalBuildInfo -> PackageId
localPackage LocalBuildInfo
lbi))

-- | Extract the 'PackageIdentifier' of a 'LocalBuildInfo'.
-- This is a "safe" use of 'localPkgDescr'
localPackage :: LocalBuildInfo -> PackageId
localPackage :: LocalBuildInfo -> PackageId
localPackage LocalBuildInfo
lbi = PackageDescription -> PackageId
package (LocalBuildInfo -> PackageDescription
localPkgDescr LocalBuildInfo
lbi)

-- | Extract the 'UnitId' from the library component of a
-- 'LocalBuildInfo' if it exists, or make a fake unit ID based on
-- the package ID.
localUnitId :: LocalBuildInfo -> UnitId
localUnitId :: LocalBuildInfo -> UnitId
localUnitId LocalBuildInfo
lbi =
    case LocalBuildInfo -> ComponentName -> [ComponentLocalBuildInfo]
componentNameCLBIs LocalBuildInfo
lbi (LibraryName -> ComponentName
CLibName LibraryName
LMainLibName) of
        [LibComponentLocalBuildInfo { componentUnitId :: ComponentLocalBuildInfo -> UnitId
componentUnitId = UnitId
uid }]
          -> UnitId
uid
        [ComponentLocalBuildInfo]
_ -> PackageId -> UnitId
mkLegacyUnitId (PackageId -> UnitId) -> PackageId -> UnitId
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> PackageId
localPackage LocalBuildInfo
lbi

-- | Extract the compatibility package key from the public library component of a
-- 'LocalBuildInfo' if it exists, or make a fake package key based
-- on the package ID.
localCompatPackageKey :: LocalBuildInfo -> String
localCompatPackageKey :: LocalBuildInfo -> String
localCompatPackageKey LocalBuildInfo
lbi =
    case LocalBuildInfo -> ComponentName -> [ComponentLocalBuildInfo]
componentNameCLBIs LocalBuildInfo
lbi (LibraryName -> ComponentName
CLibName LibraryName
LMainLibName) of
        [LibComponentLocalBuildInfo { componentCompatPackageKey :: ComponentLocalBuildInfo -> String
componentCompatPackageKey = String
pk }]
          -> String
pk
        [ComponentLocalBuildInfo]
_ -> PackageId -> String
forall a. Pretty a => a -> String
External instance of the constraint type Pretty PackageId
prettyShow (LocalBuildInfo -> PackageId
localPackage LocalBuildInfo
lbi)

-- | Convenience function to generate a default 'TargetInfo' from a
-- 'ComponentLocalBuildInfo'.  The idea is to call this once, and then
-- use 'TargetInfo' everywhere else.  Private to this module.
mkTargetInfo :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> TargetInfo
mkTargetInfo :: PackageDescription
-> LocalBuildInfo -> ComponentLocalBuildInfo -> TargetInfo
mkTargetInfo PackageDescription
pkg_descr LocalBuildInfo
_lbi ComponentLocalBuildInfo
clbi =
    TargetInfo :: ComponentLocalBuildInfo -> Component -> TargetInfo
TargetInfo {
        targetCLBI :: ComponentLocalBuildInfo
targetCLBI = ComponentLocalBuildInfo
clbi,
        -- NB: @pkg_descr@, not @localPkgDescr lbi@!
        targetComponent :: Component
targetComponent = PackageDescription -> ComponentName -> Component
getComponent PackageDescription
pkg_descr
                                       (ComponentLocalBuildInfo -> ComponentName
componentLocalName ComponentLocalBuildInfo
clbi)
     }

-- | Return all 'TargetInfo's associated with 'ComponentName'.
-- In the presence of Backpack there may be more than one!
-- Has a prime because it takes a 'PackageDescription' argument
-- which may disagree with 'localPkgDescr' in 'LocalBuildInfo'.
componentNameTargets' :: PackageDescription -> LocalBuildInfo -> ComponentName -> [TargetInfo]
componentNameTargets' :: PackageDescription
-> LocalBuildInfo -> ComponentName -> [TargetInfo]
componentNameTargets' PackageDescription
pkg_descr LocalBuildInfo
lbi ComponentName
cname =
    case ComponentName
-> Map ComponentName [ComponentLocalBuildInfo]
-> Maybe [ComponentLocalBuildInfo]
forall k a. Ord k => k -> Map k a -> Maybe a
External instance of the constraint type Ord ComponentName
Map.lookup ComponentName
cname (LocalBuildInfo -> Map ComponentName [ComponentLocalBuildInfo]
componentNameMap LocalBuildInfo
lbi) of
        Just [ComponentLocalBuildInfo]
clbis -> (ComponentLocalBuildInfo -> TargetInfo)
-> [ComponentLocalBuildInfo] -> [TargetInfo]
forall a b. (a -> b) -> [a] -> [b]
map (PackageDescription
-> LocalBuildInfo -> ComponentLocalBuildInfo -> TargetInfo
mkTargetInfo PackageDescription
pkg_descr LocalBuildInfo
lbi) [ComponentLocalBuildInfo]
clbis
        Maybe [ComponentLocalBuildInfo]
Nothing -> []

unitIdTarget' :: PackageDescription -> LocalBuildInfo -> UnitId -> Maybe TargetInfo
unitIdTarget' :: PackageDescription -> LocalBuildInfo -> UnitId -> Maybe TargetInfo
unitIdTarget' PackageDescription
pkg_descr LocalBuildInfo
lbi UnitId
uid =
    case Key ComponentLocalBuildInfo
-> Graph ComponentLocalBuildInfo -> Maybe ComponentLocalBuildInfo
forall a. IsNode a => Key a -> Graph a -> Maybe a
External instance of the constraint type IsNode ComponentLocalBuildInfo
Graph.lookup Key ComponentLocalBuildInfo
UnitId
uid (LocalBuildInfo -> Graph ComponentLocalBuildInfo
componentGraph LocalBuildInfo
lbi) of
        Just ComponentLocalBuildInfo
clbi -> TargetInfo -> Maybe TargetInfo
forall a. a -> Maybe a
Just (PackageDescription
-> LocalBuildInfo -> ComponentLocalBuildInfo -> TargetInfo
mkTargetInfo PackageDescription
pkg_descr LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi)
        Maybe ComponentLocalBuildInfo
Nothing -> Maybe TargetInfo
forall a. Maybe a
Nothing

-- | Return all 'ComponentLocalBuildInfo's associated with 'ComponentName'.
-- In the presence of Backpack there may be more than one!
componentNameCLBIs :: LocalBuildInfo -> ComponentName -> [ComponentLocalBuildInfo]
componentNameCLBIs :: LocalBuildInfo -> ComponentName -> [ComponentLocalBuildInfo]
componentNameCLBIs LocalBuildInfo
lbi ComponentName
cname =
    case ComponentName
-> Map ComponentName [ComponentLocalBuildInfo]
-> Maybe [ComponentLocalBuildInfo]
forall k a. Ord k => k -> Map k a -> Maybe a
External instance of the constraint type Ord ComponentName
Map.lookup ComponentName
cname (LocalBuildInfo -> Map ComponentName [ComponentLocalBuildInfo]
componentNameMap LocalBuildInfo
lbi) of
        Just [ComponentLocalBuildInfo]
clbis -> [ComponentLocalBuildInfo]
clbis
        Maybe [ComponentLocalBuildInfo]
Nothing -> []

-- TODO: Maybe cache topsort (Graph can do this)

-- | Return the list of default 'TargetInfo's associated with a
-- configured package, in the order they need to be built.
-- Has a prime because it takes a 'PackageDescription' argument
-- which may disagree with 'localPkgDescr' in 'LocalBuildInfo'.
allTargetsInBuildOrder' :: PackageDescription -> LocalBuildInfo -> [TargetInfo]
allTargetsInBuildOrder' :: PackageDescription -> LocalBuildInfo -> [TargetInfo]
allTargetsInBuildOrder' PackageDescription
pkg_descr LocalBuildInfo
lbi
    = (ComponentLocalBuildInfo -> TargetInfo)
-> [ComponentLocalBuildInfo] -> [TargetInfo]
forall a b. (a -> b) -> [a] -> [b]
map (PackageDescription
-> LocalBuildInfo -> ComponentLocalBuildInfo -> TargetInfo
mkTargetInfo PackageDescription
pkg_descr LocalBuildInfo
lbi) (Graph ComponentLocalBuildInfo -> [ComponentLocalBuildInfo]
forall a. Graph a -> [a]
Graph.revTopSort (LocalBuildInfo -> Graph ComponentLocalBuildInfo
componentGraph LocalBuildInfo
lbi))

-- | Execute @f@ for every 'TargetInfo' in the package, respecting the
-- build dependency order.  (TODO: We should use Shake!)
-- Has a prime because it takes a 'PackageDescription' argument
-- which may disagree with 'localPkgDescr' in 'LocalBuildInfo'.
withAllTargetsInBuildOrder' :: PackageDescription -> LocalBuildInfo -> (TargetInfo -> IO ()) -> IO ()
withAllTargetsInBuildOrder' :: PackageDescription
-> LocalBuildInfo -> (TargetInfo -> IO ()) -> IO ()
withAllTargetsInBuildOrder' PackageDescription
pkg_descr LocalBuildInfo
lbi TargetInfo -> IO ()
f
    = [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
External instance of the constraint type Monad IO
External instance of the constraint type Foldable []
sequence_ [ TargetInfo -> IO ()
f TargetInfo
target | TargetInfo
target <- PackageDescription -> LocalBuildInfo -> [TargetInfo]
allTargetsInBuildOrder' PackageDescription
pkg_descr LocalBuildInfo
lbi ]

-- | Return the list of all targets needed to build the @uids@, in
-- the order they need to be built.
-- Has a prime because it takes a 'PackageDescription' argument
-- which may disagree with 'localPkgDescr' in 'LocalBuildInfo'.
neededTargetsInBuildOrder' :: PackageDescription -> LocalBuildInfo -> [UnitId] -> [TargetInfo]
neededTargetsInBuildOrder' :: PackageDescription -> LocalBuildInfo -> [UnitId] -> [TargetInfo]
neededTargetsInBuildOrder' PackageDescription
pkg_descr LocalBuildInfo
lbi [UnitId]
uids =
  case Graph ComponentLocalBuildInfo
-> [Key ComponentLocalBuildInfo] -> Maybe [ComponentLocalBuildInfo]
forall a. Graph a -> [Key a] -> Maybe [a]
Graph.closure (LocalBuildInfo -> Graph ComponentLocalBuildInfo
componentGraph LocalBuildInfo
lbi) [Key ComponentLocalBuildInfo]
[UnitId]
uids of
    Maybe [ComponentLocalBuildInfo]
Nothing -> String -> [TargetInfo]
forall a. HasCallStack => String -> a
error (String -> [TargetInfo]) -> String -> [TargetInfo]
forall a b. (a -> b) -> a -> b
$ String
"localBuildPlan: missing uids " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((UnitId -> String) -> [UnitId] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map UnitId -> String
forall a. Pretty a => a -> String
External instance of the constraint type Pretty UnitId
prettyShow [UnitId]
uids)
    Just [ComponentLocalBuildInfo]
clos -> (ComponentLocalBuildInfo -> TargetInfo)
-> [ComponentLocalBuildInfo] -> [TargetInfo]
forall a b. (a -> b) -> [a] -> [b]
map (PackageDescription
-> LocalBuildInfo -> ComponentLocalBuildInfo -> TargetInfo
mkTargetInfo PackageDescription
pkg_descr LocalBuildInfo
lbi) (Graph ComponentLocalBuildInfo -> [ComponentLocalBuildInfo]
forall a. Graph a -> [a]
Graph.revTopSort ([ComponentLocalBuildInfo] -> Graph ComponentLocalBuildInfo
forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
External instance of the constraint type Show UnitId
External instance of the constraint type IsNode ComponentLocalBuildInfo
Graph.fromDistinctList [ComponentLocalBuildInfo]
clos))

-- | Execute @f@ for every 'TargetInfo' needed to build @uid@s, respecting
-- the build dependency order.
-- Has a prime because it takes a 'PackageDescription' argument
-- which may disagree with 'localPkgDescr' in 'LocalBuildInfo'.
withNeededTargetsInBuildOrder' :: PackageDescription -> LocalBuildInfo -> [UnitId] -> (TargetInfo -> IO ()) -> IO ()
withNeededTargetsInBuildOrder' :: PackageDescription
-> LocalBuildInfo -> [UnitId] -> (TargetInfo -> IO ()) -> IO ()
withNeededTargetsInBuildOrder' PackageDescription
pkg_descr LocalBuildInfo
lbi [UnitId]
uids TargetInfo -> IO ()
f
    = [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
External instance of the constraint type Monad IO
External instance of the constraint type Foldable []
sequence_ [ TargetInfo -> IO ()
f TargetInfo
target | TargetInfo
target <- PackageDescription -> LocalBuildInfo -> [UnitId] -> [TargetInfo]
neededTargetsInBuildOrder' PackageDescription
pkg_descr LocalBuildInfo
lbi [UnitId]
uids ]

-- | Is coverage enabled for test suites? In practice, this requires library
-- and executable profiling to be enabled.
testCoverage :: LocalBuildInfo -> Bool
testCoverage :: LocalBuildInfo -> Bool
testCoverage LocalBuildInfo
lbi = LocalBuildInfo -> Bool
exeCoverage LocalBuildInfo
lbi Bool -> Bool -> Bool
&& LocalBuildInfo -> Bool
libCoverage LocalBuildInfo
lbi

-------------------------------------------------------------------------------
-- Stub functions to prevent someone from accidentally defining them

{-# 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 :: LocalBuildInfo -> ComponentName -> [TargetInfo]
componentNameTargets LocalBuildInfo
lbi = PackageDescription
-> LocalBuildInfo -> ComponentName -> [TargetInfo]
componentNameTargets' (LocalBuildInfo -> PackageDescription
localPkgDescr LocalBuildInfo
lbi) LocalBuildInfo
lbi

unitIdTarget :: LocalBuildInfo -> UnitId -> Maybe TargetInfo
unitIdTarget :: LocalBuildInfo -> UnitId -> Maybe TargetInfo
unitIdTarget LocalBuildInfo
lbi = PackageDescription -> LocalBuildInfo -> UnitId -> Maybe TargetInfo
unitIdTarget' (LocalBuildInfo -> PackageDescription
localPkgDescr LocalBuildInfo
lbi) LocalBuildInfo
lbi

allTargetsInBuildOrder :: LocalBuildInfo -> [TargetInfo]
allTargetsInBuildOrder :: LocalBuildInfo -> [TargetInfo]
allTargetsInBuildOrder LocalBuildInfo
lbi = PackageDescription -> LocalBuildInfo -> [TargetInfo]
allTargetsInBuildOrder' (LocalBuildInfo -> PackageDescription
localPkgDescr LocalBuildInfo
lbi) LocalBuildInfo
lbi

withAllTargetsInBuildOrder :: LocalBuildInfo -> (TargetInfo -> IO ()) -> IO ()
withAllTargetsInBuildOrder :: LocalBuildInfo -> (TargetInfo -> IO ()) -> IO ()
withAllTargetsInBuildOrder LocalBuildInfo
lbi = PackageDescription
-> LocalBuildInfo -> (TargetInfo -> IO ()) -> IO ()
withAllTargetsInBuildOrder' (LocalBuildInfo -> PackageDescription
localPkgDescr LocalBuildInfo
lbi) LocalBuildInfo
lbi

neededTargetsInBuildOrder :: LocalBuildInfo -> [UnitId] -> [TargetInfo]
neededTargetsInBuildOrder :: LocalBuildInfo -> [UnitId] -> [TargetInfo]
neededTargetsInBuildOrder LocalBuildInfo
lbi = PackageDescription -> LocalBuildInfo -> [UnitId] -> [TargetInfo]
neededTargetsInBuildOrder' (LocalBuildInfo -> PackageDescription
localPkgDescr LocalBuildInfo
lbi) LocalBuildInfo
lbi

withNeededTargetsInBuildOrder :: LocalBuildInfo -> [UnitId] -> (TargetInfo -> IO ()) -> IO ()
withNeededTargetsInBuildOrder :: LocalBuildInfo -> [UnitId] -> (TargetInfo -> IO ()) -> IO ()
withNeededTargetsInBuildOrder LocalBuildInfo
lbi = PackageDescription
-> LocalBuildInfo -> [UnitId] -> (TargetInfo -> IO ()) -> IO ()
withNeededTargetsInBuildOrder' (LocalBuildInfo -> PackageDescription
localPkgDescr LocalBuildInfo
lbi) LocalBuildInfo
lbi