LocalBuildInfo.hs

{-# 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 {
        configFlags   :: ConfigFlags,
        -- ^ Options passed to the configuration step.
        -- Needed to re-run configuration when .cabal is out of date
        flagAssignment :: FlagAssignment,
        -- ^ The final set of flags which were picked for this package
        componentEnabledSpec :: ComponentRequestedSpec,
        -- ^ What components were enabled during configuration, and why.
        extraConfigArgs     :: [String],
        -- ^ Extra args on the command line for the configuration step.
        -- Needed to re-run configuration when .cabal is out of date
        installDirTemplates :: InstallDirTemplates,
                -- ^ The installation directories for the various different
                -- kinds of files
        --TODO: inplaceDirTemplates :: InstallDirs FilePath
        compiler      :: Compiler,
                -- ^ The compiler we're building with
        hostPlatform  :: Platform,
                -- ^ The platform we're building for
        buildDir      :: FilePath,
                -- ^ Where to build the package.
        cabalFilePath :: Maybe FilePath,
                -- ^ Path to the cabal file, if given during configuration.
        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.
        componentNameMap :: Map ComponentName [ComponentLocalBuildInfo],
                -- ^ A map from component name to all matching
                -- components.  These coincide with 'componentGraph'
        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.)
        pkgDescrFile  :: Maybe FilePath,
                -- ^ the filename containing the .cabal file, if available
        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 wtih a 'HookedBuildInfo' applied
                -- to it; see 'HookedBuildInfo' for the whole sordid saga.
                -- As much as possible, Cabal library should avoid using
                -- this parameter.
        withPrograms  :: ProgramDb, -- ^Location and args for all programs
        withPackageDB :: PackageDBStack,  -- ^What package database to use, global\/user
        withVanillaLib:: Bool,  -- ^Whether to build normal libs.
        withProfLib   :: Bool,  -- ^Whether to build profiling versions of libs.
        withSharedLib :: Bool,  -- ^Whether to build shared versions of libs.
        withStaticLib :: Bool,  -- ^Whether to build static versions of libs (with all other libs rolled in)
        withDynExe    :: Bool,  -- ^Whether to link executables dynamically
        withFullyStaticExe :: Bool,  -- ^Whether to link executables fully statically
        withProfExe   :: Bool,  -- ^Whether to build executables for profiling.
        withProfLibDetail :: ProfDetailLevel, -- ^Level of automatic profile detail.
        withProfExeDetail :: ProfDetailLevel, -- ^Level of automatic profile detail.
        withOptimization :: OptimisationLevel, -- ^Whether to build with optimization (if available).
        withDebugInfo :: DebugInfoLevel, -- ^Whether to emit debug info (if available).
        withGHCiLib   :: Bool,  -- ^Whether to build libs suitable for use with GHCi.
        splitSections :: Bool,  -- ^Use -split-sections with GHC, if available
        splitObjs     :: Bool,  -- ^Use -split-objs with GHC, if available
        stripExes     :: Bool,  -- ^Whether to strip executables during install
        stripLibs     :: Bool,  -- ^Whether to strip libraries during install
        exeCoverage :: Bool,  -- ^Whether to enable executable program coverage
        libCoverage :: Bool,  -- ^Whether to enable library program coverage
        progPrefix    :: PathTemplate, -- ^Prefix to be prepended to installed executables
        progSuffix    :: PathTemplate, -- ^Suffix to be appended to installed executables
        relocatable   :: Bool --  ^Whether to build a relocatable package
  } deriving (Generic, Read, Show)

instance Binary 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 lbi =
    case componentNameCLBIs lbi (CLibName LMainLibName) of
        [LibComponentLocalBuildInfo { componentComponentId = cid }]
          -> cid
        _ -> mkComponentId (prettyShow (localPackage lbi))

-- | Extract the 'PackageIdentifier' of a 'LocalBuildInfo'.
-- This is a "safe" use of 'localPkgDescr'
localPackage :: LocalBuildInfo -> PackageId
localPackage lbi = package (localPkgDescr 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 lbi =
    case componentNameCLBIs lbi (CLibName LMainLibName) of
        [LibComponentLocalBuildInfo { componentUnitId = uid }]
          -> uid
        _ -> mkLegacyUnitId $ localPackage 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 lbi =
    case componentNameCLBIs lbi (CLibName LMainLibName) of
        [LibComponentLocalBuildInfo { componentCompatPackageKey = pk }]
          -> pk
        _ -> prettyShow (localPackage 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 pkg_descr _lbi clbi =
    TargetInfo {
        targetCLBI = clbi,
        -- NB: @pkg_descr@, not @localPkgDescr lbi@!
        targetComponent = getComponent pkg_descr
                                       (componentLocalName 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' 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

-- | Return all 'ComponentLocalBuildInfo's associated with 'ComponentName'.
-- In the presence of Backpack there may be more than one!
componentNameCLBIs :: LocalBuildInfo -> ComponentName -> [ComponentLocalBuildInfo]
componentNameCLBIs lbi cname =
    case Map.lookup cname (componentNameMap lbi) of
        Just clbis -> clbis
        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' pkg_descr lbi
    = map (mkTargetInfo pkg_descr lbi) (Graph.revTopSort (componentGraph 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' pkg_descr lbi f
    = sequence_ [ f target | target <- allTargetsInBuildOrder' pkg_descr 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' pkg_descr lbi uids =
  case Graph.closure (componentGraph lbi) uids of
    Nothing -> error $ "localBuildPlan: missing uids " ++ intercalate ", " (map prettyShow uids)
    Just clos -> map (mkTargetInfo pkg_descr lbi) (Graph.revTopSort (Graph.fromDistinctList 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' pkg_descr lbi uids f
    = sequence_ [ f target | target <- neededTargetsInBuildOrder' pkg_descr lbi uids ]

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