{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}

module Distribution.Types.LocalBuildInfo
  ( -- * The types
    LocalBuildInfo
      ( LocalBuildInfo
      , configFlags
      , flagAssignment
      , componentEnabledSpec
      , extraConfigArgs
      , installDirTemplates
      , compiler
      , hostPlatform
      , pkgDescrFile
      , componentGraph
      , componentNameMap
      , promisedPkgs
      , installedPkgs
      , localPkgDescr
      , withPrograms
      , withPackageDB
      , withVanillaLib
      , withProfLib
      , withProfLibShared
      , withDynExe
      , withFullyStaticExe
      , withProfExe
      , withSharedLib
      , withStaticLib
      , withProfLibDetail
      , withProfExeDetail
      , withOptimization
      , withDebugInfo
      , withGHCiLib
      , splitSections
      , splitObjs
      , stripExes
      , stripLibs
      , exeCoverage
      , libCoverage
      , extraCoverageFor
      , relocatable
      , ..
      )

    -- * Convenience accessors
  , localComponentId
  , localUnitId
  , localCompatPackageKey
  , localPackage
  , buildDir
  , buildDirPBD
  , setupFlagsBuildDir
  , distPrefLBI
  , packageRoot
  , progPrefix
  , progSuffix

    -- * 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
  , buildWays

    -- * 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 Distribution.Compat.Prelude
import Prelude ()

import Distribution.Types.ComponentId
import Distribution.Types.ComponentLocalBuildInfo
import Distribution.Types.ComponentRequestedSpec
import Distribution.Types.GivenComponent
import qualified Distribution.Types.LocalBuildConfig as LBC
import Distribution.Types.PackageDescription
import Distribution.Types.PackageId
import Distribution.Types.TargetInfo
import Distribution.Types.UnitId

import Distribution.Utils.Path

import Distribution.PackageDescription
import Distribution.Pretty
import Distribution.Simple.BuildWay
import Distribution.Simple.Compiler
import Distribution.Simple.Flag
import Distribution.Simple.InstallDirs hiding
  ( absoluteInstallDirs
  , prefixRelativeInstallDirs
  , substPathTemplate
  )
import Distribution.Simple.PackageIndex
import Distribution.Simple.Program
import Distribution.Simple.Setup.Common
import Distribution.Simple.Setup.Config
import Distribution.System

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

import qualified System.FilePath as FilePath (takeDirectory)

-- | Data cached after configuration step.  See also
-- 'Distribution.Simple.Setup.ConfigFlags'.
data LocalBuildInfo = NewLocalBuildInfo
  { LocalBuildInfo -> LocalBuildDescr
localBuildDescr :: LBC.LocalBuildDescr
  -- ^ Information about a package determined by Cabal
  -- after the configuration step.
  , LocalBuildInfo -> LocalBuildConfig
localBuildConfig :: LBC.LocalBuildConfig
  -- ^ Information about a package configuration
  -- that can be modified by the user at configuration time.
  }
  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
$cfrom :: forall x. LocalBuildInfo -> Rep LocalBuildInfo x
from :: forall x. LocalBuildInfo -> Rep LocalBuildInfo x
$cto :: forall x. Rep LocalBuildInfo x -> LocalBuildInfo
to :: forall x. Rep LocalBuildInfo x -> LocalBuildInfo
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
$creadsPrec :: Int -> ReadS LocalBuildInfo
readsPrec :: Int -> ReadS LocalBuildInfo
$creadList :: ReadS [LocalBuildInfo]
readList :: ReadS [LocalBuildInfo]
$creadPrec :: ReadPrec LocalBuildInfo
readPrec :: ReadPrec LocalBuildInfo
$creadListPrec :: ReadPrec [LocalBuildInfo]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> LocalBuildInfo -> ShowS
showsPrec :: Int -> LocalBuildInfo -> ShowS
$cshow :: LocalBuildInfo -> String
show :: LocalBuildInfo -> String
$cshowList :: [LocalBuildInfo] -> ShowS
showList :: [LocalBuildInfo] -> ShowS
Show, Typeable)

{-# COMPLETE LocalBuildInfo #-}

-- | This pattern synonym is for backwards compatibility, to adapt
-- to 'LocalBuildInfo' being split into 'LocalBuildDescr' and 'LocalBuildConfig'.
pattern LocalBuildInfo
  :: ConfigFlags
  -> FlagAssignment
  -> ComponentRequestedSpec
  -> [String]
  -> InstallDirTemplates
  -> Compiler
  -> Platform
  -> Maybe (SymbolicPath Pkg File)
  -> Graph ComponentLocalBuildInfo
  -> Map ComponentName [ComponentLocalBuildInfo]
  -> Map (PackageName, ComponentName) PromisedComponent
  -> InstalledPackageIndex
  -> PackageDescription
  -> ProgramDb
  -> PackageDBStack
  -> Bool
  -> Bool
  -> Bool
  -> Bool
  -> Bool
  -> Bool
  -> Bool
  -> Bool
  -> ProfDetailLevel
  -> ProfDetailLevel
  -> OptimisationLevel
  -> DebugInfoLevel
  -> Bool
  -> Bool
  -> Bool
  -> Bool
  -> Bool
  -> Bool
  -> Bool
  -> [UnitId]
  -> Bool
  -> LocalBuildInfo
pattern $mLocalBuildInfo :: forall {r}.
LocalBuildInfo
-> (ConfigFlags
    -> FlagAssignment
    -> ComponentRequestedSpec
    -> [String]
    -> InstallDirTemplates
    -> Compiler
    -> Platform
    -> Maybe (SymbolicPath Pkg 'File)
    -> Graph ComponentLocalBuildInfo
    -> Map ComponentName [ComponentLocalBuildInfo]
    -> Map (PackageName, ComponentName) PromisedComponent
    -> InstalledPackageIndex
    -> PackageDescription
    -> ProgramDb
    -> PackageDBStack
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> ProfDetailLevel
    -> ProfDetailLevel
    -> OptimisationLevel
    -> DebugInfoLevel
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> [UnitId]
    -> Bool
    -> r)
-> ((# #) -> r)
-> r
$bLocalBuildInfo :: ConfigFlags
-> FlagAssignment
-> ComponentRequestedSpec
-> [String]
-> InstallDirTemplates
-> Compiler
-> Platform
-> Maybe (SymbolicPath Pkg 'File)
-> Graph ComponentLocalBuildInfo
-> Map ComponentName [ComponentLocalBuildInfo]
-> Map (PackageName, ComponentName) PromisedComponent
-> InstalledPackageIndex
-> PackageDescription
-> ProgramDb
-> PackageDBStack
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> ProfDetailLevel
-> ProfDetailLevel
-> OptimisationLevel
-> DebugInfoLevel
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> [UnitId]
-> Bool
-> LocalBuildInfo
LocalBuildInfo
  { LocalBuildInfo -> ConfigFlags
configFlags
  , LocalBuildInfo -> FlagAssignment
flagAssignment
  , LocalBuildInfo -> ComponentRequestedSpec
componentEnabledSpec
  , LocalBuildInfo -> [String]
extraConfigArgs
  , LocalBuildInfo -> InstallDirTemplates
installDirTemplates
  , LocalBuildInfo -> Compiler
compiler
  , LocalBuildInfo -> Platform
hostPlatform
  , LocalBuildInfo -> Maybe (SymbolicPath Pkg 'File)
pkgDescrFile
  , LocalBuildInfo -> Graph ComponentLocalBuildInfo
componentGraph
  , LocalBuildInfo -> Map ComponentName [ComponentLocalBuildInfo]
componentNameMap
  , LocalBuildInfo
-> Map (PackageName, ComponentName) PromisedComponent
promisedPkgs
  , LocalBuildInfo -> InstalledPackageIndex
installedPkgs
  , LocalBuildInfo -> PackageDescription
localPkgDescr
  , LocalBuildInfo -> ProgramDb
withPrograms
  , LocalBuildInfo -> PackageDBStack
withPackageDB
  , LocalBuildInfo -> Bool
withVanillaLib
  , LocalBuildInfo -> Bool
withProfLib
  , LocalBuildInfo -> Bool
withProfLibShared
  , LocalBuildInfo -> Bool
withSharedLib
  , LocalBuildInfo -> Bool
withStaticLib
  , LocalBuildInfo -> Bool
withDynExe
  , LocalBuildInfo -> Bool
withFullyStaticExe
  , LocalBuildInfo -> Bool
withProfExe
  , LocalBuildInfo -> ProfDetailLevel
withProfLibDetail
  , LocalBuildInfo -> ProfDetailLevel
withProfExeDetail
  , LocalBuildInfo -> OptimisationLevel
withOptimization
  , LocalBuildInfo -> DebugInfoLevel
withDebugInfo
  , LocalBuildInfo -> Bool
withGHCiLib
  , LocalBuildInfo -> Bool
splitSections
  , LocalBuildInfo -> Bool
splitObjs
  , LocalBuildInfo -> Bool
stripExes
  , LocalBuildInfo -> Bool
stripLibs
  , LocalBuildInfo -> Bool
exeCoverage
  , LocalBuildInfo -> Bool
libCoverage
  , LocalBuildInfo -> [UnitId]
extraCoverageFor
  , LocalBuildInfo -> Bool
relocatable
  } =
  NewLocalBuildInfo
    { localBuildDescr =
      LBC.LocalBuildDescr
        { packageBuildDescr =
          LBC.PackageBuildDescr
            { configFlags
            , flagAssignment
            , componentEnabledSpec
            , compiler
            , hostPlatform
            , localPkgDescr
            , installDirTemplates
            , withPackageDB
            , pkgDescrFile
            , extraCoverageFor
            }
        , componentBuildDescr =
          LBC.ComponentBuildDescr
            { componentGraph
            , componentNameMap
            , promisedPkgs
            , installedPkgs
            }
        }
    , localBuildConfig =
      LBC.LocalBuildConfig
        { extraConfigArgs
        , withPrograms
        , withBuildOptions =
          LBC.BuildOptions
            { withVanillaLib
            , withProfLib
            , withProfLibShared
            , withSharedLib
            , withStaticLib
            , withDynExe
            , withFullyStaticExe
            , withProfExe
            , withProfLibDetail
            , withProfExeDetail
            , withOptimization
            , withDebugInfo
            , withGHCiLib
            , splitSections
            , splitObjs
            , stripExes
            , stripLibs
            , exeCoverage
            , libCoverage
            , relocatable
            }
        }
    }

instance Binary LocalBuildInfo
instance Structured LocalBuildInfo

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

buildDir :: LocalBuildInfo -> SymbolicPath Pkg (Dir Build)
buildDir :: LocalBuildInfo -> SymbolicPath Pkg ('Dir Build)
buildDir LocalBuildInfo
lbi =
  PackageBuildDescr -> SymbolicPath Pkg ('Dir Build)
buildDirPBD (PackageBuildDescr -> SymbolicPath Pkg ('Dir Build))
-> PackageBuildDescr -> SymbolicPath Pkg ('Dir Build)
forall a b. (a -> b) -> a -> b
$ LocalBuildDescr -> PackageBuildDescr
LBC.packageBuildDescr (LocalBuildDescr -> PackageBuildDescr)
-> LocalBuildDescr -> PackageBuildDescr
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> LocalBuildDescr
localBuildDescr LocalBuildInfo
lbi

buildDirPBD :: LBC.PackageBuildDescr -> SymbolicPath Pkg (Dir Build)
buildDirPBD :: PackageBuildDescr -> SymbolicPath Pkg ('Dir Build)
buildDirPBD (LBC.PackageBuildDescr{configFlags :: PackageBuildDescr -> ConfigFlags
configFlags = ConfigFlags
cfg}) =
  CommonSetupFlags -> SymbolicPath Pkg ('Dir Build)
setupFlagsBuildDir (CommonSetupFlags -> SymbolicPath Pkg ('Dir Build))
-> CommonSetupFlags -> SymbolicPath Pkg ('Dir Build)
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> CommonSetupFlags
configCommonFlags ConfigFlags
cfg

setupFlagsBuildDir :: CommonSetupFlags -> SymbolicPath Pkg (Dir Build)
setupFlagsBuildDir :: CommonSetupFlags -> SymbolicPath Pkg ('Dir Build)
setupFlagsBuildDir CommonSetupFlags
cfg = Flag (SymbolicPath Pkg ('Dir Dist)) -> SymbolicPath Pkg ('Dir Dist)
forall a. WithCallStack (Flag a -> a)
fromFlag (CommonSetupFlags -> Flag (SymbolicPath Pkg ('Dir Dist))
setupDistPref CommonSetupFlags
cfg) SymbolicPath Pkg ('Dir Dist)
-> RelativePath Dist ('Dir Build) -> SymbolicPath Pkg ('Dir Build)
forall p q r. PathLike p q r => p -> q -> r
</> String -> RelativePath Dist ('Dir Build)
forall from (to :: FileOrDir).
HasCallStack =>
String -> RelativePath from to
makeRelativePathEx String
"build"

distPrefLBI :: LocalBuildInfo -> SymbolicPath Pkg (Dir Dist)
distPrefLBI :: LocalBuildInfo -> SymbolicPath Pkg ('Dir Dist)
distPrefLBI = Flag (SymbolicPath Pkg ('Dir Dist)) -> SymbolicPath Pkg ('Dir Dist)
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag (SymbolicPath Pkg ('Dir Dist))
 -> SymbolicPath Pkg ('Dir Dist))
-> (LocalBuildInfo -> Flag (SymbolicPath Pkg ('Dir Dist)))
-> LocalBuildInfo
-> SymbolicPath Pkg ('Dir Dist)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonSetupFlags -> Flag (SymbolicPath Pkg ('Dir Dist))
setupDistPref (CommonSetupFlags -> Flag (SymbolicPath Pkg ('Dir Dist)))
-> (LocalBuildInfo -> CommonSetupFlags)
-> LocalBuildInfo
-> Flag (SymbolicPath Pkg ('Dir Dist))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigFlags -> CommonSetupFlags
configCommonFlags (ConfigFlags -> CommonSetupFlags)
-> (LocalBuildInfo -> ConfigFlags)
-> LocalBuildInfo
-> CommonSetupFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageBuildDescr -> ConfigFlags
LBC.configFlags (PackageBuildDescr -> ConfigFlags)
-> (LocalBuildInfo -> PackageBuildDescr)
-> LocalBuildInfo
-> ConfigFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalBuildDescr -> PackageBuildDescr
LBC.packageBuildDescr (LocalBuildDescr -> PackageBuildDescr)
-> (LocalBuildInfo -> LocalBuildDescr)
-> LocalBuildInfo
-> PackageBuildDescr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalBuildInfo -> LocalBuildDescr
localBuildDescr

-- | The (relative or absolute) path to the package root, based on
--
--  - the working directory flag
--  - the @.cabal@ path
packageRoot :: CommonSetupFlags -> FilePath
packageRoot :: CommonSetupFlags -> String
packageRoot CommonSetupFlags
cfg =
  case Flag (SymbolicPath Pkg 'File) -> Maybe (SymbolicPath Pkg 'File)
forall a. Flag a -> Maybe a
flagToMaybe (CommonSetupFlags -> Flag (SymbolicPath Pkg 'File)
setupCabalFilePath CommonSetupFlags
cfg) of
    Just SymbolicPath Pkg 'File
cabalPath -> ShowS
FilePath.takeDirectory ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg 'File -> String
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> String
interpretSymbolicPath Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPath Pkg 'File
cabalPath
    Maybe (SymbolicPath Pkg 'File)
Nothing -> String
-> (SymbolicPath CWD ('Dir Pkg) -> String)
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"." SymbolicPath CWD ('Dir Pkg) -> String
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> String
getSymbolicPath Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir
  where
    mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a. Flag a -> Maybe a
flagToMaybe (Flag (SymbolicPath CWD ('Dir Pkg))
 -> Maybe (SymbolicPath CWD ('Dir Pkg)))
-> Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a b. (a -> b) -> a -> b
$ CommonSetupFlags -> Flag (SymbolicPath CWD ('Dir Pkg))
setupWorkingDir CommonSetupFlags
cfg

progPrefix, progSuffix :: LocalBuildInfo -> PathTemplate
progPrefix :: LocalBuildInfo -> PathTemplate
progPrefix (LocalBuildInfo{configFlags :: LocalBuildInfo -> ConfigFlags
configFlags = ConfigFlags
cfg}) =
  Flag PathTemplate -> PathTemplate
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag PathTemplate -> PathTemplate)
-> Flag PathTemplate -> PathTemplate
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag PathTemplate
configProgPrefix ConfigFlags
cfg
progSuffix :: LocalBuildInfo -> PathTemplate
progSuffix (LocalBuildInfo{configFlags :: LocalBuildInfo -> ConfigFlags
configFlags = ConfigFlags
cfg}) =
  Flag PathTemplate -> PathTemplate
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag PathTemplate -> PathTemplate)
-> Flag PathTemplate -> PathTemplate
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag PathTemplate
configProgSuffix ConfigFlags
cfg

-- 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
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{localPkgDescr :: LocalBuildInfo -> PackageDescription
localPkgDescr = PackageDescription
pkg}) = PackageDescription -> PackageId
package PackageDescription
pkg

-- | 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
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
    { 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 lbi :: LocalBuildInfo
lbi@(LocalBuildInfo{componentNameMap :: LocalBuildInfo -> Map ComponentName [ComponentLocalBuildInfo]
componentNameMap = Map ComponentName [ComponentLocalBuildInfo]
comps}) ComponentName
cname =
  case ComponentName
-> Map ComponentName [ComponentLocalBuildInfo]
-> Maybe [ComponentLocalBuildInfo]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ComponentName
cname Map ComponentName [ComponentLocalBuildInfo]
comps 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 lbi :: LocalBuildInfo
lbi@(LocalBuildInfo{componentGraph :: LocalBuildInfo -> Graph ComponentLocalBuildInfo
componentGraph = Graph ComponentLocalBuildInfo
compsGraph}) UnitId
uid =
  case Key ComponentLocalBuildInfo
-> Graph ComponentLocalBuildInfo -> Maybe ComponentLocalBuildInfo
forall a. IsNode a => Key a -> Graph a -> Maybe a
Graph.lookup Key ComponentLocalBuildInfo
UnitId
uid Graph ComponentLocalBuildInfo
compsGraph 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{componentNameMap :: LocalBuildInfo -> Map ComponentName [ComponentLocalBuildInfo]
componentNameMap = Map ComponentName [ComponentLocalBuildInfo]
comps}) ComponentName
cname =
  case ComponentName
-> Map ComponentName [ComponentLocalBuildInfo]
-> Maybe [ComponentLocalBuildInfo]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ComponentName
cname Map ComponentName [ComponentLocalBuildInfo]
comps 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 lbi :: LocalBuildInfo
lbi@(LocalBuildInfo{componentGraph :: LocalBuildInfo -> Graph ComponentLocalBuildInfo
componentGraph = Graph ComponentLocalBuildInfo
compsGraph}) =
  (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 Graph ComponentLocalBuildInfo
compsGraph)

-- | 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 ()
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 lbi :: LocalBuildInfo
lbi@(LocalBuildInfo{componentGraph :: LocalBuildInfo -> Graph ComponentLocalBuildInfo
componentGraph = Graph ComponentLocalBuildInfo
compsGraph}) [UnitId]
uids =
  case Graph ComponentLocalBuildInfo
-> [Key ComponentLocalBuildInfo] -> Maybe [ComponentLocalBuildInfo]
forall a. Graph a -> [Key a] -> Maybe [a]
Graph.closure Graph ComponentLocalBuildInfo
compsGraph [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
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
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 ()
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{exeCoverage :: LocalBuildInfo -> Bool
exeCoverage = Bool
exes, libCoverage :: LocalBuildInfo -> Bool
libCoverage = Bool
libs}) =
  Bool
exes Bool -> Bool -> Bool
&& Bool
libs

-- | Returns a list of ways, in the order which they should be built, and the
-- way we build executable and foreign library components.
--
-- Ideally all this info should be fixed at configure time and not dependent on
-- additional info but `LocalBuildInfo` is per package (not per component) so it's
-- currently not possible to configure components to be built in certain ways.
buildWays :: LocalBuildInfo -> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
buildWays :: LocalBuildInfo -> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
buildWays LocalBuildInfo
lbi =
  let
    -- enable-library-profiling (enable (static profiling way)) .p_o
    -- enable-shared (enabled dynamic way)  .dyn_o
    -- enable-profiling-shared (enable dyanmic profilng way) .p_dyn_o
    -- enable-library-vanilla (enable vanilla way) .o
    --
    -- enable-executable-dynamic => build dynamic executables
    -- => --enable-profiling + --enable-executable-dynamic => build dynamic profiled executables
    -- => --enable-profiling => build vanilla profiled executables

    wantedLibWays :: Bool -> [BuildWay]
wantedLibWays Bool
is_indef =
      [BuildWay
ProfDynWay | LocalBuildInfo -> Bool
withProfLibShared LocalBuildInfo
lbi Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
is_indef]
        [BuildWay] -> [BuildWay] -> [BuildWay]
forall a. Semigroup a => a -> a -> a
<> [BuildWay
ProfWay | LocalBuildInfo -> Bool
withProfLib LocalBuildInfo
lbi]
        -- I don't see why we shouldn't build with dynamic-- indefinite components.
        [BuildWay] -> [BuildWay] -> [BuildWay]
forall a. Semigroup a => a -> a -> a
<> [BuildWay
DynWay | LocalBuildInfo -> Bool
withSharedLib LocalBuildInfo
lbi Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
is_indef]
        -- MP: Ideally we should have `BuildOptions` on a per component basis, in
        -- which case this `is_indef` check could be moved to configure time.
        [BuildWay] -> [BuildWay] -> [BuildWay]
forall a. Semigroup a => a -> a -> a
<> [BuildWay
StaticWay | LocalBuildInfo -> Bool
withVanillaLib LocalBuildInfo
lbi Bool -> Bool -> Bool
|| LocalBuildInfo -> Bool
withStaticLib LocalBuildInfo
lbi]

    wantedFLibWay :: Bool -> BuildWay
wantedFLibWay Bool
is_dyn_flib =
      case (Bool
is_dyn_flib, LocalBuildInfo -> Bool
withProfExe LocalBuildInfo
lbi) of
        (Bool
True, Bool
True) -> BuildWay
ProfDynWay
        (Bool
False, Bool
True) -> BuildWay
ProfWay
        (Bool
True, Bool
False) -> BuildWay
DynWay
        (Bool
False, Bool
False) -> BuildWay
StaticWay

    wantedExeWay :: BuildWay
wantedExeWay =
      case (LocalBuildInfo -> Bool
withDynExe LocalBuildInfo
lbi, LocalBuildInfo -> Bool
withProfExe LocalBuildInfo
lbi) of
        (Bool
True, Bool
True) -> BuildWay
ProfDynWay
        (Bool
True, Bool
False) -> BuildWay
DynWay
        (Bool
False, Bool
True) -> BuildWay
ProfWay
        (Bool
False, Bool
False) -> BuildWay
StaticWay
   in
    (Bool -> [BuildWay]
wantedLibWays, Bool -> BuildWay
wantedFLibWay, BuildWay
wantedExeWay)

-------------------------------------------------------------------------------
-- 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 'PackageDescription' 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 lbi :: LocalBuildInfo
lbi@(LocalBuildInfo{localPkgDescr :: LocalBuildInfo -> PackageDescription
localPkgDescr = PackageDescription
pkg}) =
  PackageDescription
-> LocalBuildInfo -> ComponentName -> [TargetInfo]
componentNameTargets' PackageDescription
pkg LocalBuildInfo
lbi
unitIdTarget :: LocalBuildInfo -> UnitId -> Maybe TargetInfo
unitIdTarget :: LocalBuildInfo -> UnitId -> Maybe TargetInfo
unitIdTarget lbi :: LocalBuildInfo
lbi@(LocalBuildInfo{localPkgDescr :: LocalBuildInfo -> PackageDescription
localPkgDescr = PackageDescription
pkg}) =
  PackageDescription -> LocalBuildInfo -> UnitId -> Maybe TargetInfo
unitIdTarget' PackageDescription
pkg LocalBuildInfo
lbi
allTargetsInBuildOrder :: LocalBuildInfo -> [TargetInfo]
allTargetsInBuildOrder :: LocalBuildInfo -> [TargetInfo]
allTargetsInBuildOrder lbi :: LocalBuildInfo
lbi@(LocalBuildInfo{localPkgDescr :: LocalBuildInfo -> PackageDescription
localPkgDescr = PackageDescription
pkg}) =
  PackageDescription -> LocalBuildInfo -> [TargetInfo]
allTargetsInBuildOrder' PackageDescription
pkg LocalBuildInfo
lbi
withAllTargetsInBuildOrder :: LocalBuildInfo -> (TargetInfo -> IO ()) -> IO ()
withAllTargetsInBuildOrder :: LocalBuildInfo -> (TargetInfo -> IO ()) -> IO ()
withAllTargetsInBuildOrder lbi :: LocalBuildInfo
lbi@(LocalBuildInfo{localPkgDescr :: LocalBuildInfo -> PackageDescription
localPkgDescr = PackageDescription
pkg}) =
  PackageDescription
-> LocalBuildInfo -> (TargetInfo -> IO ()) -> IO ()
withAllTargetsInBuildOrder' PackageDescription
pkg LocalBuildInfo
lbi
neededTargetsInBuildOrder :: LocalBuildInfo -> [UnitId] -> [TargetInfo]
neededTargetsInBuildOrder :: LocalBuildInfo -> [UnitId] -> [TargetInfo]
neededTargetsInBuildOrder lbi :: LocalBuildInfo
lbi@(LocalBuildInfo{localPkgDescr :: LocalBuildInfo -> PackageDescription
localPkgDescr = PackageDescription
pkg}) =
  PackageDescription -> LocalBuildInfo -> [UnitId] -> [TargetInfo]
neededTargetsInBuildOrder' PackageDescription
pkg LocalBuildInfo
lbi
withNeededTargetsInBuildOrder :: LocalBuildInfo -> [UnitId] -> (TargetInfo -> IO ()) -> IO ()
withNeededTargetsInBuildOrder :: LocalBuildInfo -> [UnitId] -> (TargetInfo -> IO ()) -> IO ()
withNeededTargetsInBuildOrder lbi :: LocalBuildInfo
lbi@(LocalBuildInfo{localPkgDescr :: LocalBuildInfo -> PackageDescription
localPkgDescr = PackageDescription
pkg}) =
  PackageDescription
-> LocalBuildInfo -> [UnitId] -> (TargetInfo -> IO ()) -> IO ()
withNeededTargetsInBuildOrder' PackageDescription
pkg LocalBuildInfo
lbi