{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}

-- | Types used while planning how to build everything in a project.
--
-- Primarily this is the 'ElaboratedInstallPlan'.
module Distribution.Client.ProjectPlanning.Types
  ( SolverInstallPlan

    -- * Elaborated install plan types
  , ElaboratedInstallPlan
  , normaliseConfiguredPackage
  , ElaboratedConfiguredPackage (..)
  , showElaboratedInstallPlan
  , elabDistDirParams
  , elabExeDependencyPaths
  , elabLibDependencies
  , elabOrderLibDependencies
  , elabExeDependencies
  , elabOrderExeDependencies
  , elabSetupDependencies
  , elabPkgConfigDependencies
  , elabInplaceDependencyBuildCacheFiles
  , elabRequiresRegistration
  , dataDirsEnvironmentForPlan
  , elabPlanPackageName
  , elabConfiguredName
  , elabComponentName
  , ElaboratedPackageOrComponent (..)
  , ElaboratedComponent (..)
  , ElaboratedPackage (..)
  , pkgOrderDependencies
  , ElaboratedPlanPackage
  , ElaboratedSharedConfig (..)
  , ElaboratedReadyPackage
  , BuildStyle (..)
  , MemoryOrDisk (..)
  , isInplaceBuildStyle
  , CabalFileText
  , NotPerComponentReason (..)
  , NotPerComponentBuildType (..)
  , whyNotPerComponent

    -- * Build targets
  , ComponentTarget (..)
  , showComponentTarget
  , showTestComponentTarget
  , showBenchComponentTarget
  , SubComponentTarget (..)
  , isSubLibComponentTarget
  , isForeignLibComponentTarget
  , isExeComponentTarget
  , isTestComponentTarget
  , isBenchComponentTarget
  , componentOptionalStanza

    -- * Setup script
  , SetupScriptStyle (..)
  ) where

import Distribution.Client.Compat.Prelude
import Prelude ()

import Distribution.Client.PackageHash
import Distribution.Client.TargetSelector
  ( SubComponentTarget (..)
  )

import Distribution.Client.DistDirLayout
import Distribution.Client.InstallPlan
  ( GenericInstallPlan
  , GenericPlanPackage (..)
  )
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.SolverInstallPlan
  ( SolverInstallPlan
  )
import Distribution.Client.Types

import Distribution.Backpack
import Distribution.Backpack.ModuleShape

import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import Distribution.ModuleName (ModuleName)
import Distribution.Package
import qualified Distribution.PackageDescription as Cabal
import Distribution.Simple.Build.PathsModule (pkgPathEnvVar)
import qualified Distribution.Simple.BuildTarget as Cabal
import Distribution.Simple.Compiler
import Distribution.Simple.InstallDirs (PathTemplate)
import qualified Distribution.Simple.InstallDirs as InstallDirs
import Distribution.Simple.LocalBuildInfo
  ( ComponentName (..)
  , LibraryName (..)
  )
import Distribution.Simple.Program
import Distribution.Simple.Setup
  ( DumpBuildInfo (..)
  , HaddockTarget
  , ReplOptions
  , TestShowDetails
  )
import Distribution.System
import Distribution.Types.ComponentRequestedSpec
import qualified Distribution.Types.LocalBuildConfig as LBC
import Distribution.Types.PackageDescription (PackageDescription (..))
import Distribution.Types.PkgconfigVersion
import Distribution.Verbosity (normal)
import Distribution.Version

import Distribution.Compat.Graph (IsNode (..))
import Distribution.Simple.Utils (ordNub)
import Distribution.Solver.Types.ComponentDeps (ComponentDeps)
import qualified Distribution.Solver.Types.ComponentDeps as CD
import Distribution.Solver.Types.OptionalStanza

import qualified Data.ByteString.Lazy as LBS
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as Map
import qualified Data.Monoid as Mon
import System.FilePath ((</>))
import Text.PrettyPrint (hsep, parens, text)

-- | The combination of an elaborated install plan plus a
-- 'ElaboratedSharedConfig' contains all the details necessary to be able
-- to execute the plan without having to make further policy decisions.
--
-- It does not include dynamic elements such as resources (such as http
-- connections).
type ElaboratedInstallPlan =
  GenericInstallPlan
    InstalledPackageInfo
    ElaboratedConfiguredPackage

type ElaboratedPlanPackage =
  GenericPlanPackage
    InstalledPackageInfo
    ElaboratedConfiguredPackage

-- | User-friendly display string for an 'ElaboratedPlanPackage'.
elabPlanPackageName :: Verbosity -> ElaboratedPlanPackage -> String
elabPlanPackageName :: Verbosity -> ElaboratedPlanPackage -> FilePath
elabPlanPackageName Verbosity
verbosity (PreExisting InstalledPackageInfo
ipkg)
  | Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
<= Verbosity
normal = PackageName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (InstalledPackageInfo -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName InstalledPackageInfo
ipkg)
  | Bool
otherwise = UnitId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (InstalledPackageInfo -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId InstalledPackageInfo
ipkg)
elabPlanPackageName Verbosity
verbosity (Configured ElaboratedConfiguredPackage
elab) =
  Verbosity -> ElaboratedConfiguredPackage -> FilePath
elabConfiguredName Verbosity
verbosity ElaboratedConfiguredPackage
elab
elabPlanPackageName Verbosity
verbosity (Installed ElaboratedConfiguredPackage
elab) =
  Verbosity -> ElaboratedConfiguredPackage -> FilePath
elabConfiguredName Verbosity
verbosity ElaboratedConfiguredPackage
elab

showElaboratedInstallPlan :: ElaboratedInstallPlan -> String
showElaboratedInstallPlan :: ElaboratedInstallPlan -> FilePath
showElaboratedInstallPlan = (ElaboratedPlanPackage -> ShowPlanNode)
-> ElaboratedInstallPlan -> FilePath
forall ipkg srcpkg.
(GenericPlanPackage ipkg srcpkg -> ShowPlanNode)
-> GenericInstallPlan ipkg srcpkg -> FilePath
InstallPlan.showInstallPlan_gen ElaboratedPlanPackage -> ShowPlanNode
forall {ipkg}.
(Key ipkg ~ UnitId, Package ipkg, IsNode ipkg) =>
GenericPlanPackage ipkg ElaboratedConfiguredPackage -> ShowPlanNode
showNode
  where
    showNode :: GenericPlanPackage ipkg ElaboratedConfiguredPackage -> ShowPlanNode
showNode GenericPlanPackage ipkg ElaboratedConfiguredPackage
pkg =
      InstallPlan.ShowPlanNode
        { showPlanHerald :: Doc
InstallPlan.showPlanHerald = Doc
herald
        , showPlanNeighbours :: [Doc]
InstallPlan.showPlanNeighbours = [Doc]
deps
        }
      where
        herald :: Doc
herald =
          ( [Doc] -> Doc
hsep
              [ FilePath -> Doc
text (GenericPlanPackage ipkg ElaboratedConfiguredPackage -> FilePath
forall ipkg srcpkg. GenericPlanPackage ipkg srcpkg -> FilePath
InstallPlan.showPlanPackageTag GenericPlanPackage ipkg ElaboratedConfiguredPackage
pkg)
              , (ipkg -> Doc)
-> (ElaboratedConfiguredPackage -> Doc)
-> GenericPlanPackage ipkg ElaboratedConfiguredPackage
-> Doc
forall ipkg a srcpkg.
(ipkg -> a) -> (srcpkg -> a) -> GenericPlanPackage ipkg srcpkg -> a
InstallPlan.foldPlanPackage (Doc -> ipkg -> Doc
forall a b. a -> b -> a
const Doc
forall a. Monoid a => a
mempty) ElaboratedConfiguredPackage -> Doc
in_mem GenericPlanPackage ipkg ElaboratedConfiguredPackage
pkg
              , PackageIdentifier -> Doc
forall a. Pretty a => a -> Doc
pretty (GenericPlanPackage ipkg ElaboratedConfiguredPackage
-> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId GenericPlanPackage ipkg ElaboratedConfiguredPackage
pkg)
              , Doc -> Doc
parens (UnitId -> Doc
forall a. Pretty a => a -> Doc
pretty (GenericPlanPackage ipkg ElaboratedConfiguredPackage
-> Key (GenericPlanPackage ipkg ElaboratedConfiguredPackage)
forall a. IsNode a => a -> Key a
nodeKey GenericPlanPackage ipkg ElaboratedConfiguredPackage
pkg))
              ]
          )

        in_mem :: ElaboratedConfiguredPackage -> Doc
in_mem ElaboratedConfiguredPackage
elab = case ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
elab of
          BuildInplaceOnly MemoryOrDisk
InMemory -> Doc -> Doc
parens (FilePath -> Doc
text FilePath
"In Memory")
          BuildStyle
_ -> Doc
forall a. Monoid a => a
mempty

        deps :: [Doc]
deps = (ipkg -> [Doc])
-> (ElaboratedConfiguredPackage -> [Doc])
-> GenericPlanPackage ipkg ElaboratedConfiguredPackage
-> [Doc]
forall ipkg a srcpkg.
(ipkg -> a) -> (srcpkg -> a) -> GenericPlanPackage ipkg srcpkg -> a
InstallPlan.foldPlanPackage ipkg -> [Doc]
installed_deps ElaboratedConfiguredPackage -> [Doc]
local_deps GenericPlanPackage ipkg ElaboratedConfiguredPackage
pkg

        installed_deps :: ipkg -> [Doc]
installed_deps = (Key ipkg -> Doc) -> [Key ipkg] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Key ipkg -> Doc
forall a. Pretty a => a -> Doc
pretty ([Key ipkg] -> [Doc]) -> (ipkg -> [Key ipkg]) -> ipkg -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ipkg -> [Key ipkg]
forall a. IsNode a => a -> [Key a]
nodeNeighbors

        local_deps :: ElaboratedConfiguredPackage -> [Doc]
local_deps ElaboratedConfiguredPackage
cfg = [(if Bool
internal then FilePath -> Doc
text FilePath
"+" else Doc
forall a. Monoid a => a
mempty) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ComponentId -> Doc
forall a. Pretty a => a -> Doc
pretty (ConfiguredId -> ComponentId
confInstId ConfiguredId
uid) | (ConfiguredId
uid, Bool
internal) <- ElaboratedConfiguredPackage -> [(ConfiguredId, Bool)]
elabLibDependencies ElaboratedConfiguredPackage
cfg]

-- TODO: [code cleanup] decide if we really need this, there's not much in it, and in principle
--      even platform and compiler could be different if we're building things
--      like a server + client with ghc + ghcjs
data ElaboratedSharedConfig = ElaboratedSharedConfig
  { ElaboratedSharedConfig -> Platform
pkgConfigPlatform :: Platform
  , ElaboratedSharedConfig -> Compiler
pkgConfigCompiler :: Compiler -- TODO: [code cleanup] replace with CompilerInfo
  , ElaboratedSharedConfig -> ProgramDb
pkgConfigCompilerProgs :: ProgramDb
  -- ^ The programs that the compiler configured (e.g. for GHC, the progs
  -- ghc & ghc-pkg). Once constructed, only the 'configuredPrograms' are
  -- used.
  , ElaboratedSharedConfig -> ReplOptions
pkgConfigReplOptions :: ReplOptions
  }
  deriving (Int -> ElaboratedSharedConfig -> ShowS
[ElaboratedSharedConfig] -> ShowS
ElaboratedSharedConfig -> FilePath
(Int -> ElaboratedSharedConfig -> ShowS)
-> (ElaboratedSharedConfig -> FilePath)
-> ([ElaboratedSharedConfig] -> ShowS)
-> Show ElaboratedSharedConfig
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ElaboratedSharedConfig -> ShowS
showsPrec :: Int -> ElaboratedSharedConfig -> ShowS
$cshow :: ElaboratedSharedConfig -> FilePath
show :: ElaboratedSharedConfig -> FilePath
$cshowList :: [ElaboratedSharedConfig] -> ShowS
showList :: [ElaboratedSharedConfig] -> ShowS
Show, (forall x. ElaboratedSharedConfig -> Rep ElaboratedSharedConfig x)
-> (forall x.
    Rep ElaboratedSharedConfig x -> ElaboratedSharedConfig)
-> Generic ElaboratedSharedConfig
forall x. Rep ElaboratedSharedConfig x -> ElaboratedSharedConfig
forall x. ElaboratedSharedConfig -> Rep ElaboratedSharedConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ElaboratedSharedConfig -> Rep ElaboratedSharedConfig x
from :: forall x. ElaboratedSharedConfig -> Rep ElaboratedSharedConfig x
$cto :: forall x. Rep ElaboratedSharedConfig x -> ElaboratedSharedConfig
to :: forall x. Rep ElaboratedSharedConfig x -> ElaboratedSharedConfig
Generic, Typeable)

-- TODO: [code cleanup] no Eq instance

instance Binary ElaboratedSharedConfig
instance Structured ElaboratedSharedConfig

data ElaboratedConfiguredPackage = ElaboratedConfiguredPackage
  { ElaboratedConfiguredPackage -> UnitId
elabUnitId :: UnitId
  -- ^ The 'UnitId' which uniquely identifies this item in a build plan
  , ElaboratedConfiguredPackage -> ComponentId
elabComponentId :: ComponentId
  , ElaboratedConfiguredPackage -> Map ModuleName Module
elabInstantiatedWith :: Map ModuleName Module
  , ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
  , ElaboratedConfiguredPackage -> Bool
elabIsCanonical :: Bool
  -- ^ This is true if this is an indefinite package, or this is a
  -- package with no signatures.  (Notably, it's not true for instantiated
  -- packages.)  The motivation for this is if you ask to build
  -- @foo-indef@, this probably means that you want to typecheck
  -- it, NOT that you want to rebuild all of the various
  -- instantiations of it.
  , ElaboratedConfiguredPackage -> PackageIdentifier
elabPkgSourceId :: PackageId
  -- ^ The 'PackageId' of the originating package
  , ElaboratedConfiguredPackage -> ModuleShape
elabModuleShape :: ModuleShape
  -- ^ Shape of the package/component, for Backpack.
  , ElaboratedConfiguredPackage -> FlagAssignment
elabFlagAssignment :: Cabal.FlagAssignment
  -- ^ A total flag assignment for the package.
  -- TODO: Actually this can be per-component if we drop
  -- all flags that don't affect a component.
  , ElaboratedConfiguredPackage -> FlagAssignment
elabFlagDefaults :: Cabal.FlagAssignment
  -- ^ The original default flag assignment, used only for reporting.
  , ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription :: Cabal.PackageDescription
  , ElaboratedConfiguredPackage -> PackageLocation (Maybe FilePath)
elabPkgSourceLocation :: PackageLocation (Maybe FilePath)
  -- ^ Where the package comes from, e.g. tarball, local dir etc. This
  --   is not the same as where it may be unpacked to for the build.
  , ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabPkgSourceHash :: Maybe PackageSourceHash
  -- ^ The hash of the source, e.g. the tarball. We don't have this for
  -- local source dir packages.
  , ElaboratedConfiguredPackage -> Bool
elabLocalToProject :: Bool
  -- ^ Is this package one of the ones specified by location in the
  -- project file? (As opposed to a dependency, or a named package pulled
  -- in)
  , ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle :: BuildStyle
  -- ^ Are we going to build and install this package to the store, or are
  -- we going to build it and register it locally.
  , ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabEnabledSpec :: ComponentRequestedSpec
  -- ^ Another way of phrasing 'pkgStanzasAvailable'.
  , ElaboratedConfiguredPackage -> OptionalStanzaSet
elabStanzasAvailable :: OptionalStanzaSet
  -- ^ Which optional stanzas (ie testsuites, benchmarks) can be built.
  -- This means the solver produced a plan that has them available.
  -- This doesn't necessary mean we build them by default.
  , ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
  -- ^ Which optional stanzas the user explicitly asked to enable or
  -- to disable. This tells us which ones we build by default, and
  -- helps with error messages when the user asks to build something
  -- they explicitly disabled.
  --
  -- TODO: The 'Bool' here should be refined into an ADT with three
  -- cases: NotRequested, ExplicitlyRequested and
  -- ImplicitlyRequested.  A stanza is explicitly requested if
  -- the user asked, for this *specific* package, that the stanza
  -- be enabled; it's implicitly requested if the user asked for
  -- all global packages to have this stanza enabled.  The
  -- difference between an explicit and implicit request is
  -- error reporting behavior: if a user asks for tests to be
  -- enabled for a specific package that doesn't have any tests,
  -- we should warn them about it, but we shouldn't complain
  -- that a user enabled tests globally, and some local packages
  -- just happen not to have any tests.  (But perhaps we should
  -- warn if ALL local packages don't have any tests.)
  , ElaboratedConfiguredPackage -> [Maybe PackageDB]
elabPackageDbs :: [Maybe PackageDB]
  , ElaboratedConfiguredPackage -> PackageDBStack
elabSetupPackageDBStack :: PackageDBStack
  , ElaboratedConfiguredPackage -> PackageDBStack
elabBuildPackageDBStack :: PackageDBStack
  , ElaboratedConfiguredPackage -> PackageDBStack
elabRegisterPackageDBStack :: PackageDBStack
  , ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceSetupPackageDBStack :: PackageDBStack
  , ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceBuildPackageDBStack :: PackageDBStack
  , ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceRegisterPackageDBStack :: PackageDBStack
  , ElaboratedConfiguredPackage -> Maybe CabalFileText
elabPkgDescriptionOverride :: Maybe CabalFileText
  , -- TODO: make per-component variants of these flags
    ElaboratedConfiguredPackage -> BuildOptions
elabBuildOptions :: LBC.BuildOptions
  , ElaboratedConfiguredPackage -> DumpBuildInfo
elabDumpBuildInfo :: DumpBuildInfo
  , ElaboratedConfiguredPackage -> Map FilePath FilePath
elabProgramPaths :: Map String FilePath
  , ElaboratedConfiguredPackage -> Map FilePath [FilePath]
elabProgramArgs :: Map String [String]
  , ElaboratedConfiguredPackage -> [FilePath]
elabProgramPathExtra :: [FilePath]
  , ElaboratedConfiguredPackage -> [FilePath]
elabConfigureScriptArgs :: [String]
  , ElaboratedConfiguredPackage -> [FilePath]
elabExtraLibDirs :: [FilePath]
  , ElaboratedConfiguredPackage -> [FilePath]
elabExtraLibDirsStatic :: [FilePath]
  , ElaboratedConfiguredPackage -> [FilePath]
elabExtraFrameworkDirs :: [FilePath]
  , ElaboratedConfiguredPackage -> [FilePath]
elabExtraIncludeDirs :: [FilePath]
  , ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgPrefix :: Maybe PathTemplate
  , ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgSuffix :: Maybe PathTemplate
  , ElaboratedConfiguredPackage -> InstallDirs FilePath
elabInstallDirs :: InstallDirs.InstallDirs FilePath
  , ElaboratedConfiguredPackage -> Bool
elabHaddockHoogle :: Bool
  , ElaboratedConfiguredPackage -> Bool
elabHaddockHtml :: Bool
  , ElaboratedConfiguredPackage -> Maybe FilePath
elabHaddockHtmlLocation :: Maybe String
  , ElaboratedConfiguredPackage -> Bool
elabHaddockForeignLibs :: Bool
  , ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockForHackage :: HaddockTarget
  , ElaboratedConfiguredPackage -> Bool
elabHaddockExecutables :: Bool
  , ElaboratedConfiguredPackage -> Bool
elabHaddockTestSuites :: Bool
  , ElaboratedConfiguredPackage -> Bool
elabHaddockBenchmarks :: Bool
  , ElaboratedConfiguredPackage -> Bool
elabHaddockInternal :: Bool
  , ElaboratedConfiguredPackage -> Maybe FilePath
elabHaddockCss :: Maybe FilePath
  , ElaboratedConfiguredPackage -> Bool
elabHaddockLinkedSource :: Bool
  , ElaboratedConfiguredPackage -> Bool
elabHaddockQuickJump :: Bool
  , ElaboratedConfiguredPackage -> Maybe FilePath
elabHaddockHscolourCss :: Maybe FilePath
  , ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockContents :: Maybe PathTemplate
  , ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockIndex :: Maybe PathTemplate
  , ElaboratedConfiguredPackage -> Maybe FilePath
elabHaddockBaseUrl :: Maybe String
  , ElaboratedConfiguredPackage -> Maybe FilePath
elabHaddockLib :: Maybe String
  , ElaboratedConfiguredPackage -> Maybe FilePath
elabHaddockOutputDir :: Maybe FilePath
  , ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestMachineLog :: Maybe PathTemplate
  , ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestHumanLog :: Maybe PathTemplate
  , ElaboratedConfiguredPackage -> Maybe TestShowDetails
elabTestShowDetails :: Maybe TestShowDetails
  , ElaboratedConfiguredPackage -> Bool
elabTestKeepTix :: Bool
  , ElaboratedConfiguredPackage -> Maybe FilePath
elabTestWrapper :: Maybe FilePath
  , ElaboratedConfiguredPackage -> Bool
elabTestFailWhenNoTestSuites :: Bool
  , ElaboratedConfiguredPackage -> [PathTemplate]
elabTestTestOptions :: [PathTemplate]
  , ElaboratedConfiguredPackage -> [PathTemplate]
elabBenchmarkOptions :: [PathTemplate]
  , -- Setup.hs related things:

    ElaboratedConfiguredPackage -> SetupScriptStyle
elabSetupScriptStyle :: SetupScriptStyle
  -- ^ One of four modes for how we build and interact with the Setup.hs
  -- script, based on whether it's a build-type Custom, with or without
  -- explicit deps and the cabal spec version the .cabal file needs.
  , ElaboratedConfiguredPackage -> Version
elabSetupScriptCliVersion :: Version
  -- ^ The version of the Cabal command line interface that we are using
  -- for this package. This is typically the version of the Cabal lib
  -- that the Setup.hs is built against.
  --
  -- TODO: We might want to turn this into a enum,
  -- yet different enum than 'CabalSpecVersion'.
  , -- Build time related:
    ElaboratedConfiguredPackage -> [ComponentTarget]
elabConfigureTargets :: [ComponentTarget]
  , ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
  , ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets :: [ComponentTarget]
  , ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets :: [ComponentTarget]
  , ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget :: [ComponentTarget]
  , ElaboratedConfiguredPackage -> [ComponentTarget]
elabHaddockTargets :: [ComponentTarget]
  , ElaboratedConfiguredPackage -> Bool
elabBuildHaddocks :: Bool
  , -- pkgSourceDir ? -- currently passed in later because they can use temp locations
    -- pkgBuildDir  ? -- but could in principle still have it here, with optional instr to use temp loc

    ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp :: ElaboratedPackageOrComponent
  -- ^ Component/package specific information
  }
  deriving (ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage -> Bool
(ElaboratedConfiguredPackage
 -> ElaboratedConfiguredPackage -> Bool)
-> (ElaboratedConfiguredPackage
    -> ElaboratedConfiguredPackage -> Bool)
-> Eq ElaboratedConfiguredPackage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage -> Bool
== :: ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage -> Bool
$c/= :: ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage -> Bool
/= :: ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage -> Bool
Eq, Int -> ElaboratedConfiguredPackage -> ShowS
[ElaboratedConfiguredPackage] -> ShowS
ElaboratedConfiguredPackage -> FilePath
(Int -> ElaboratedConfiguredPackage -> ShowS)
-> (ElaboratedConfiguredPackage -> FilePath)
-> ([ElaboratedConfiguredPackage] -> ShowS)
-> Show ElaboratedConfiguredPackage
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ElaboratedConfiguredPackage -> ShowS
showsPrec :: Int -> ElaboratedConfiguredPackage -> ShowS
$cshow :: ElaboratedConfiguredPackage -> FilePath
show :: ElaboratedConfiguredPackage -> FilePath
$cshowList :: [ElaboratedConfiguredPackage] -> ShowS
showList :: [ElaboratedConfiguredPackage] -> ShowS
Show, (forall x.
 ElaboratedConfiguredPackage -> Rep ElaboratedConfiguredPackage x)
-> (forall x.
    Rep ElaboratedConfiguredPackage x -> ElaboratedConfiguredPackage)
-> Generic ElaboratedConfiguredPackage
forall x.
Rep ElaboratedConfiguredPackage x -> ElaboratedConfiguredPackage
forall x.
ElaboratedConfiguredPackage -> Rep ElaboratedConfiguredPackage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ElaboratedConfiguredPackage -> Rep ElaboratedConfiguredPackage x
from :: forall x.
ElaboratedConfiguredPackage -> Rep ElaboratedConfiguredPackage x
$cto :: forall x.
Rep ElaboratedConfiguredPackage x -> ElaboratedConfiguredPackage
to :: forall x.
Rep ElaboratedConfiguredPackage x -> ElaboratedConfiguredPackage
Generic, Typeable)

normaliseConfiguredPackage
  :: ElaboratedSharedConfig
  -> ElaboratedConfiguredPackage
  -> ElaboratedConfiguredPackage
normaliseConfiguredPackage :: ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
normaliseConfiguredPackage ElaboratedSharedConfig{ProgramDb
pkgConfigCompilerProgs :: ElaboratedSharedConfig -> ProgramDb
pkgConfigCompilerProgs :: ProgramDb
pkgConfigCompilerProgs} ElaboratedConfiguredPackage
pkg =
  ElaboratedConfiguredPackage
pkg{elabProgramArgs = Map.mapMaybeWithKey lookupFilter (elabProgramArgs pkg)}
  where
    knownProgramDb :: ProgramDb
knownProgramDb = [Program] -> ProgramDb -> ProgramDb
addKnownPrograms [Program]
builtinPrograms ProgramDb
pkgConfigCompilerProgs

    pkgDesc :: PackageDescription
    pkgDesc :: PackageDescription
pkgDesc = ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
pkg

    removeEmpty :: [String] -> Maybe [String]
    removeEmpty :: [FilePath] -> Maybe [FilePath]
removeEmpty [] = Maybe [FilePath]
forall a. Maybe a
Nothing
    removeEmpty [FilePath]
xs = [FilePath] -> Maybe [FilePath]
forall a. a -> Maybe a
Just [FilePath]
xs

    lookupFilter :: String -> [String] -> Maybe [String]
    lookupFilter :: FilePath -> [FilePath] -> Maybe [FilePath]
lookupFilter FilePath
n [FilePath]
args = [FilePath] -> Maybe [FilePath]
removeEmpty ([FilePath] -> Maybe [FilePath]) -> [FilePath] -> Maybe [FilePath]
forall a b. (a -> b) -> a -> b
$ case FilePath -> ProgramDb -> Maybe Program
lookupKnownProgram FilePath
n ProgramDb
knownProgramDb of
      Just Program
p -> Program
-> Maybe Version -> PackageDescription -> [FilePath] -> [FilePath]
programNormaliseArgs Program
p (Program -> Maybe Version
getVersion Program
p) PackageDescription
pkgDesc [FilePath]
args
      Maybe Program
Nothing -> [FilePath]
args

    getVersion :: Program -> Maybe Version
    getVersion :: Program -> Maybe Version
getVersion Program
p = Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
p ProgramDb
knownProgramDb Maybe ConfiguredProgram
-> (ConfiguredProgram -> Maybe Version) -> Maybe Version
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConfiguredProgram -> Maybe Version
programVersion

-- | The package/component contains/is a library and so must be registered
elabRequiresRegistration :: ElaboratedConfiguredPackage -> Bool
elabRequiresRegistration :: ElaboratedConfiguredPackage -> Bool
elabRequiresRegistration ElaboratedConfiguredPackage
elab =
  case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
elab of
    ElabComponent ElaboratedComponent
comp ->
      case ElaboratedComponent -> Maybe ComponentName
compComponentName ElaboratedComponent
comp of
        Just ComponentName
cn -> ComponentName -> Bool
is_lib ComponentName
cn Bool -> Bool -> Bool
&& Bool
build_target
        Maybe ComponentName
_ -> Bool
False
    ElabPackage ElaboratedPackage
pkg ->
      -- Tricky! Not only do we have to test if the user selected
      -- a library as a build target, we also have to test if
      -- the library was TRANSITIVELY depended upon, since we will
      -- also require a register in this case.
      --
      -- NB: It would have been far nicer to just unconditionally
      -- register in all cases, but some Custom Setups will fall
      -- over if you try to do that, ESPECIALLY if there actually is
      -- a library but they hadn't built it.
      --
      -- However, as the case of `cpphs-1.20.8` has shown in
      -- #5379, in cases when a monolithic package gets
      -- installed due to its executable components
      -- (i.e. exe:cpphs) into the store we *have* to register
      -- if there's a buildable public library (i.e. lib:cpphs)
      -- that was built and installed into the same store folder
      -- as otherwise this will cause build failures once a
      -- target actually depends on lib:cpphs.
      Bool
build_target
        Bool -> Bool -> Bool
|| ( ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
elab BuildStyle -> BuildStyle -> Bool
forall a. Eq a => a -> a -> Bool
== BuildStyle
BuildAndInstall
              Bool -> Bool -> Bool
&& PackageDescription -> Bool
Cabal.hasPublicLib (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
elab)
           )
        -- the next sub-condition below is currently redundant
        -- (see discussion in #5604 for more details), but it's
        -- being kept intentionally here as a safeguard because if
        -- internal libraries ever start working with
        -- non-per-component builds this condition won't be
        -- redundant anymore.
        Bool -> Bool -> Bool
|| (ComponentTarget -> Bool) -> [ComponentTarget] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ElaboratedPackage -> ComponentTarget -> Bool
depends_on_lib ElaboratedPackage
pkg) (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets ElaboratedConfiguredPackage
elab)
  where
    depends_on_lib :: ElaboratedPackage -> ComponentTarget -> Bool
depends_on_lib ElaboratedPackage
pkg (ComponentTarget ComponentName
cn SubComponentTarget
_) =
      Bool -> Bool
not
        ( [()] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
            ( (Component -> Bool) -> ComponentDeps [()] -> [()]
forall a. Monoid a => (Component -> Bool) -> ComponentDeps a -> a
CD.select
                (Component -> Component -> Bool
forall a. Eq a => a -> a -> Bool
== ComponentName -> Component
CD.componentNameToComponent ComponentName
cn)
                (ElaboratedPackage -> ComponentDeps [()]
pkgDependsOnSelfLib ElaboratedPackage
pkg)
            )
        )
    build_target :: Bool
build_target =
      if Bool -> Bool
not ([ComponentTarget] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets ElaboratedConfiguredPackage
elab))
        then (ComponentTarget -> Bool) -> [ComponentTarget] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ComponentTarget -> Bool
is_lib_target (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets ElaboratedConfiguredPackage
elab)
        else -- Empty build targets mean we build /everything/;
        -- that means we have to look more carefully to see
        -- if there is anything to register
          PackageDescription -> Bool
Cabal.hasLibs (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
elab)
    -- NB: this means we DO NOT reregister if you just built a
    -- single file
    is_lib_target :: ComponentTarget -> Bool
is_lib_target (ComponentTarget ComponentName
cn SubComponentTarget
WholeComponent) = ComponentName -> Bool
is_lib ComponentName
cn
    is_lib_target ComponentTarget
_ = Bool
False
    is_lib :: ComponentName -> Bool
is_lib (CLibName LibraryName
_) = Bool
True
    is_lib ComponentName
_ = Bool
False

-- | Construct the environment needed for the data files to work.
-- This consists of a separate @*_datadir@ variable for each
-- inplace package in the plan.
dataDirsEnvironmentForPlan
  :: DistDirLayout
  -> ElaboratedInstallPlan
  -> [(String, Maybe FilePath)]
dataDirsEnvironmentForPlan :: DistDirLayout
-> ElaboratedInstallPlan -> [(FilePath, Maybe FilePath)]
dataDirsEnvironmentForPlan DistDirLayout
distDirLayout =
  [Maybe (FilePath, Maybe FilePath)] -> [(FilePath, Maybe FilePath)]
forall a. [Maybe a] -> [a]
catMaybes
    ([Maybe (FilePath, Maybe FilePath)]
 -> [(FilePath, Maybe FilePath)])
-> (ElaboratedInstallPlan -> [Maybe (FilePath, Maybe FilePath)])
-> ElaboratedInstallPlan
-> [(FilePath, Maybe FilePath)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ElaboratedPlanPackage -> Maybe (FilePath, Maybe FilePath))
-> [ElaboratedPlanPackage] -> [Maybe (FilePath, Maybe FilePath)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      ( (InstalledPackageInfo -> Maybe (FilePath, Maybe FilePath))
-> (ElaboratedConfiguredPackage
    -> Maybe (FilePath, Maybe FilePath))
-> ElaboratedPlanPackage
-> Maybe (FilePath, Maybe FilePath)
forall ipkg a srcpkg.
(ipkg -> a) -> (srcpkg -> a) -> GenericPlanPackage ipkg srcpkg -> a
InstallPlan.foldPlanPackage
          (Maybe (FilePath, Maybe FilePath)
-> InstalledPackageInfo -> Maybe (FilePath, Maybe FilePath)
forall a b. a -> b -> a
const Maybe (FilePath, Maybe FilePath)
forall a. Maybe a
Nothing)
          (DistDirLayout
-> ElaboratedConfiguredPackage -> Maybe (FilePath, Maybe FilePath)
dataDirEnvVarForPackage DistDirLayout
distDirLayout)
      )
    ([ElaboratedPlanPackage] -> [Maybe (FilePath, Maybe FilePath)])
-> (ElaboratedInstallPlan -> [ElaboratedPlanPackage])
-> ElaboratedInstallPlan
-> [Maybe (FilePath, Maybe FilePath)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedInstallPlan -> [ElaboratedPlanPackage]
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.toList

-- | Construct an environment variable that points
-- the package's datadir to its correct location.
-- This might be:
-- * 'Just' the package's source directory plus the data subdirectory
--   for inplace packages.
-- * 'Nothing' for packages installed in the store (the path was
--   already included in the package at install/build time).
dataDirEnvVarForPackage
  :: DistDirLayout
  -> ElaboratedConfiguredPackage
  -> Maybe (String, Maybe FilePath)
dataDirEnvVarForPackage :: DistDirLayout
-> ElaboratedConfiguredPackage -> Maybe (FilePath, Maybe FilePath)
dataDirEnvVarForPackage DistDirLayout
distDirLayout ElaboratedConfiguredPackage
pkg =
  case ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
pkg of
    BuildStyle
BuildAndInstall -> Maybe (FilePath, Maybe FilePath)
forall a. Maybe a
Nothing
    BuildInplaceOnly{} ->
      (FilePath, Maybe FilePath) -> Maybe (FilePath, Maybe FilePath)
forall a. a -> Maybe a
Just
        ( PackageDescription -> ShowS
pkgPathEnvVar (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
pkg) FilePath
"datadir"
        , FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$
            PackageLocation (Maybe FilePath) -> FilePath
srcPath (ElaboratedConfiguredPackage -> PackageLocation (Maybe FilePath)
elabPkgSourceLocation ElaboratedConfiguredPackage
pkg)
              FilePath -> ShowS
</> PackageDescription -> FilePath
dataDir (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
pkg)
        )
  where
    srcPath :: PackageLocation (Maybe FilePath) -> FilePath
srcPath (LocalUnpackedPackage FilePath
path) = FilePath
path
    srcPath (LocalTarballPackage FilePath
_path) = FilePath
unpackedPath
    srcPath (RemoteTarballPackage URI
_uri Maybe FilePath
_localTar) = FilePath
unpackedPath
    srcPath (RepoTarballPackage Repo
_repo PackageIdentifier
_packageId Maybe FilePath
_localTar) = FilePath
unpackedPath
    srcPath (RemoteSourceRepoPackage SourceRepoMaybe
_sourceRepo (Just FilePath
localCheckout)) = FilePath
localCheckout
    -- TODO: see https://github.com/haskell/cabal/wiki/Potential-Refactors#unresolvedpkgloc
    srcPath (RemoteSourceRepoPackage SourceRepoMaybe
_sourceRepo Maybe FilePath
Nothing) =
      ShowS
forall a. HasCallStack => FilePath -> a
error
        FilePath
"calling dataDirEnvVarForPackage on a not-downloaded repo is an error"
    unpackedPath :: FilePath
unpackedPath =
      DistDirLayout -> PackageIdentifier -> FilePath
distUnpackedSrcDirectory DistDirLayout
distDirLayout (PackageIdentifier -> FilePath) -> PackageIdentifier -> FilePath
forall a b. (a -> b) -> a -> b
$ ElaboratedConfiguredPackage -> PackageIdentifier
elabPkgSourceId ElaboratedConfiguredPackage
pkg

instance Package ElaboratedConfiguredPackage where
  packageId :: ElaboratedConfiguredPackage -> PackageIdentifier
packageId = ElaboratedConfiguredPackage -> PackageIdentifier
elabPkgSourceId

instance HasConfiguredId ElaboratedConfiguredPackage where
  configuredId :: ElaboratedConfiguredPackage -> ConfiguredId
configuredId ElaboratedConfiguredPackage
elab =
    PackageIdentifier
-> Maybe ComponentName -> ComponentId -> ConfiguredId
ConfiguredId (ElaboratedConfiguredPackage -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ElaboratedConfiguredPackage
elab) (ElaboratedConfiguredPackage -> Maybe ComponentName
elabComponentName ElaboratedConfiguredPackage
elab) (ElaboratedConfiguredPackage -> ComponentId
elabComponentId ElaboratedConfiguredPackage
elab)

instance HasUnitId ElaboratedConfiguredPackage where
  installedUnitId :: ElaboratedConfiguredPackage -> UnitId
installedUnitId = ElaboratedConfiguredPackage -> UnitId
elabUnitId

instance IsNode ElaboratedConfiguredPackage where
  type Key ElaboratedConfiguredPackage = UnitId
  nodeKey :: ElaboratedConfiguredPackage -> Key ElaboratedConfiguredPackage
nodeKey = ElaboratedConfiguredPackage -> UnitId
ElaboratedConfiguredPackage -> Key ElaboratedConfiguredPackage
elabUnitId
  nodeNeighbors :: ElaboratedConfiguredPackage -> [Key ElaboratedConfiguredPackage]
nodeNeighbors = ElaboratedConfiguredPackage -> [UnitId]
ElaboratedConfiguredPackage -> [Key ElaboratedConfiguredPackage]
elabOrderDependencies

instance Binary ElaboratedConfiguredPackage
instance Structured ElaboratedConfiguredPackage

data ElaboratedPackageOrComponent
  = ElabPackage ElaboratedPackage
  | ElabComponent ElaboratedComponent
  deriving (ElaboratedPackageOrComponent
-> ElaboratedPackageOrComponent -> Bool
(ElaboratedPackageOrComponent
 -> ElaboratedPackageOrComponent -> Bool)
-> (ElaboratedPackageOrComponent
    -> ElaboratedPackageOrComponent -> Bool)
-> Eq ElaboratedPackageOrComponent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ElaboratedPackageOrComponent
-> ElaboratedPackageOrComponent -> Bool
== :: ElaboratedPackageOrComponent
-> ElaboratedPackageOrComponent -> Bool
$c/= :: ElaboratedPackageOrComponent
-> ElaboratedPackageOrComponent -> Bool
/= :: ElaboratedPackageOrComponent
-> ElaboratedPackageOrComponent -> Bool
Eq, Int -> ElaboratedPackageOrComponent -> ShowS
[ElaboratedPackageOrComponent] -> ShowS
ElaboratedPackageOrComponent -> FilePath
(Int -> ElaboratedPackageOrComponent -> ShowS)
-> (ElaboratedPackageOrComponent -> FilePath)
-> ([ElaboratedPackageOrComponent] -> ShowS)
-> Show ElaboratedPackageOrComponent
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ElaboratedPackageOrComponent -> ShowS
showsPrec :: Int -> ElaboratedPackageOrComponent -> ShowS
$cshow :: ElaboratedPackageOrComponent -> FilePath
show :: ElaboratedPackageOrComponent -> FilePath
$cshowList :: [ElaboratedPackageOrComponent] -> ShowS
showList :: [ElaboratedPackageOrComponent] -> ShowS
Show, (forall x.
 ElaboratedPackageOrComponent -> Rep ElaboratedPackageOrComponent x)
-> (forall x.
    Rep ElaboratedPackageOrComponent x -> ElaboratedPackageOrComponent)
-> Generic ElaboratedPackageOrComponent
forall x.
Rep ElaboratedPackageOrComponent x -> ElaboratedPackageOrComponent
forall x.
ElaboratedPackageOrComponent -> Rep ElaboratedPackageOrComponent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ElaboratedPackageOrComponent -> Rep ElaboratedPackageOrComponent x
from :: forall x.
ElaboratedPackageOrComponent -> Rep ElaboratedPackageOrComponent x
$cto :: forall x.
Rep ElaboratedPackageOrComponent x -> ElaboratedPackageOrComponent
to :: forall x.
Rep ElaboratedPackageOrComponent x -> ElaboratedPackageOrComponent
Generic)

instance Binary ElaboratedPackageOrComponent
instance Structured ElaboratedPackageOrComponent

elabComponentName :: ElaboratedConfiguredPackage -> Maybe ComponentName
elabComponentName :: ElaboratedConfiguredPackage -> Maybe ComponentName
elabComponentName ElaboratedConfiguredPackage
elab =
  case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
elab of
    ElabPackage ElaboratedPackage
_ -> ComponentName -> Maybe ComponentName
forall a. a -> Maybe a
Just (ComponentName -> Maybe ComponentName)
-> ComponentName -> Maybe ComponentName
forall a b. (a -> b) -> a -> b
$ LibraryName -> ComponentName
CLibName LibraryName
LMainLibName -- there could be more, but default this
    ElabComponent ElaboratedComponent
comp -> ElaboratedComponent -> Maybe ComponentName
compComponentName ElaboratedComponent
comp

-- | A user-friendly descriptor for an 'ElaboratedConfiguredPackage'.
elabConfiguredName :: Verbosity -> ElaboratedConfiguredPackage -> String
elabConfiguredName :: Verbosity -> ElaboratedConfiguredPackage -> FilePath
elabConfiguredName Verbosity
verbosity ElaboratedConfiguredPackage
elab
  | Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
<= Verbosity
normal =
      ( case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
elab of
          ElabPackage ElaboratedPackage
_ -> FilePath
""
          ElabComponent ElaboratedComponent
comp ->
            case ElaboratedComponent -> Maybe ComponentName
compComponentName ElaboratedComponent
comp of
              Maybe ComponentName
Nothing -> FilePath
"setup from "
              Just (CLibName LibraryName
LMainLibName) -> FilePath
""
              Just ComponentName
cname -> ComponentName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow ComponentName
cname FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" from "
      )
        FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageIdentifier -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (ElaboratedConfiguredPackage -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ElaboratedConfiguredPackage
elab)
  | Bool
otherwise =
      UnitId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (ElaboratedConfiguredPackage -> UnitId
elabUnitId ElaboratedConfiguredPackage
elab)

elabDistDirParams :: ElaboratedSharedConfig -> ElaboratedConfiguredPackage -> DistDirParams
elabDistDirParams :: ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> DistDirParams
elabDistDirParams ElaboratedSharedConfig
shared ElaboratedConfiguredPackage
elab =
  DistDirParams
    { distParamUnitId :: UnitId
distParamUnitId = ElaboratedConfiguredPackage -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedConfiguredPackage
elab
    , distParamComponentId :: ComponentId
distParamComponentId = ElaboratedConfiguredPackage -> ComponentId
elabComponentId ElaboratedConfiguredPackage
elab
    , distParamPackageId :: PackageIdentifier
distParamPackageId = ElaboratedConfiguredPackage -> PackageIdentifier
elabPkgSourceId ElaboratedConfiguredPackage
elab
    , distParamComponentName :: Maybe ComponentName
distParamComponentName = case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
elab of
        ElabComponent ElaboratedComponent
comp -> ElaboratedComponent -> Maybe ComponentName
compComponentName ElaboratedComponent
comp
        ElabPackage ElaboratedPackage
_ -> Maybe ComponentName
forall a. Maybe a
Nothing
    , distParamCompilerId :: CompilerId
distParamCompilerId = Compiler -> CompilerId
compilerId (ElaboratedSharedConfig -> Compiler
pkgConfigCompiler ElaboratedSharedConfig
shared)
    , distParamPlatform :: Platform
distParamPlatform = ElaboratedSharedConfig -> Platform
pkgConfigPlatform ElaboratedSharedConfig
shared
    , distParamOptimization :: OptimisationLevel
distParamOptimization = BuildOptions -> OptimisationLevel
LBC.withOptimization (BuildOptions -> OptimisationLevel)
-> BuildOptions -> OptimisationLevel
forall a b. (a -> b) -> a -> b
$ ElaboratedConfiguredPackage -> BuildOptions
elabBuildOptions ElaboratedConfiguredPackage
elab
    }

-- | The full set of dependencies which dictate what order we
-- need to build things in the install plan: "order dependencies"
-- balls everything together.  This is mostly only useful for
-- ordering; if you are, for example, trying to compute what
-- @--dependency@ flags to pass to a Setup script, you need to
-- use 'elabLibDependencies'.  This method is the same as
-- 'nodeNeighbors'.
--
-- NB: this method DOES include setup deps.
elabOrderDependencies :: ElaboratedConfiguredPackage -> [UnitId]
elabOrderDependencies :: ElaboratedConfiguredPackage -> [UnitId]
elabOrderDependencies ElaboratedConfiguredPackage
elab =
  case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
elab of
    -- Important not to have duplicates: otherwise InstallPlan gets
    -- confused.
    ElabPackage ElaboratedPackage
pkg -> [UnitId] -> [UnitId]
forall a. Ord a => [a] -> [a]
ordNub (ComponentDeps [UnitId] -> [UnitId]
forall a. Monoid a => ComponentDeps a -> a
CD.flatDeps (ElaboratedPackage -> ComponentDeps [UnitId]
pkgOrderDependencies ElaboratedPackage
pkg))
    ElabComponent ElaboratedComponent
comp -> ElaboratedComponent -> [UnitId]
compOrderDependencies ElaboratedComponent
comp

-- | Like 'elabOrderDependencies', but only returns dependencies on
-- libraries.
elabOrderLibDependencies :: ElaboratedConfiguredPackage -> [UnitId]
elabOrderLibDependencies :: ElaboratedConfiguredPackage -> [UnitId]
elabOrderLibDependencies ElaboratedConfiguredPackage
elab =
  case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
elab of
    ElabPackage ElaboratedPackage
pkg ->
      (ConfiguredId -> UnitId) -> [ConfiguredId] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map (ComponentId -> UnitId
newSimpleUnitId (ComponentId -> UnitId)
-> (ConfiguredId -> ComponentId) -> ConfiguredId -> UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfiguredId -> ComponentId
confInstId) ([ConfiguredId] -> [UnitId]) -> [ConfiguredId] -> [UnitId]
forall a b. (a -> b) -> a -> b
$
        [ConfiguredId] -> [ConfiguredId]
forall a. Ord a => [a] -> [a]
ordNub ([ConfiguredId] -> [ConfiguredId])
-> [ConfiguredId] -> [ConfiguredId]
forall a b. (a -> b) -> a -> b
$
          ComponentDeps [ConfiguredId] -> [ConfiguredId]
forall a. Monoid a => ComponentDeps a -> a
CD.flatDeps (((ConfiguredId, Bool) -> ConfiguredId)
-> [(ConfiguredId, Bool)] -> [ConfiguredId]
forall a b. (a -> b) -> [a] -> [b]
map (ConfiguredId, Bool) -> ConfiguredId
forall a b. (a, b) -> a
fst ([(ConfiguredId, Bool)] -> [ConfiguredId])
-> ComponentDeps [(ConfiguredId, Bool)]
-> ComponentDeps [ConfiguredId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ElaboratedPackage -> ComponentDeps [(ConfiguredId, Bool)]
pkgLibDependencies ElaboratedPackage
pkg)
    ElabComponent ElaboratedComponent
comp -> ElaboratedComponent -> [UnitId]
compOrderLibDependencies ElaboratedComponent
comp

-- | The library dependencies (i.e., the libraries we depend on, NOT
-- the dependencies of the library), NOT including setup dependencies.
-- These are passed to the @Setup@ script via @--dependency@ or @--promised-dependency@.
elabLibDependencies :: ElaboratedConfiguredPackage -> [(ConfiguredId, Bool)]
elabLibDependencies :: ElaboratedConfiguredPackage -> [(ConfiguredId, Bool)]
elabLibDependencies ElaboratedConfiguredPackage
elab =
  case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
elab of
    ElabPackage ElaboratedPackage
pkg -> [(ConfiguredId, Bool)] -> [(ConfiguredId, Bool)]
forall a. Ord a => [a] -> [a]
ordNub (ComponentDeps [(ConfiguredId, Bool)] -> [(ConfiguredId, Bool)]
forall a. Monoid a => ComponentDeps a -> a
CD.nonSetupDeps (ElaboratedPackage -> ComponentDeps [(ConfiguredId, Bool)]
pkgLibDependencies ElaboratedPackage
pkg))
    ElabComponent ElaboratedComponent
comp -> ElaboratedComponent -> [(ConfiguredId, Bool)]
compLibDependencies ElaboratedComponent
comp

-- | Like 'elabOrderDependencies', but only returns dependencies on
-- executables.  (This coincides with 'elabExeDependencies'.)
elabOrderExeDependencies :: ElaboratedConfiguredPackage -> [UnitId]
elabOrderExeDependencies :: ElaboratedConfiguredPackage -> [UnitId]
elabOrderExeDependencies =
  (ComponentId -> UnitId) -> [ComponentId] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map ComponentId -> UnitId
newSimpleUnitId ([ComponentId] -> [UnitId])
-> (ElaboratedConfiguredPackage -> [ComponentId])
-> ElaboratedConfiguredPackage
-> [UnitId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedConfiguredPackage -> [ComponentId]
elabExeDependencies

-- | The executable dependencies (i.e., the executables we depend on);
-- these are the executables we must add to the PATH before we invoke
-- the setup script.
elabExeDependencies :: ElaboratedConfiguredPackage -> [ComponentId]
elabExeDependencies :: ElaboratedConfiguredPackage -> [ComponentId]
elabExeDependencies ElaboratedConfiguredPackage
elab = (ConfiguredId -> ComponentId) -> [ConfiguredId] -> [ComponentId]
forall a b. (a -> b) -> [a] -> [b]
map ConfiguredId -> ComponentId
confInstId ([ConfiguredId] -> [ComponentId])
-> [ConfiguredId] -> [ComponentId]
forall a b. (a -> b) -> a -> b
$
  case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
elab of
    ElabPackage ElaboratedPackage
pkg -> ComponentDeps [ConfiguredId] -> [ConfiguredId]
forall a. Monoid a => ComponentDeps a -> a
CD.nonSetupDeps (ElaboratedPackage -> ComponentDeps [ConfiguredId]
pkgExeDependencies ElaboratedPackage
pkg)
    ElabComponent ElaboratedComponent
comp -> ElaboratedComponent -> [ConfiguredId]
compExeDependencies ElaboratedComponent
comp

-- | This returns the paths of all the executables we depend on; we
-- must add these paths to PATH before invoking the setup script.
-- (This is usually what you want, not 'elabExeDependencies', if you
-- actually want to build something.)
elabExeDependencyPaths :: ElaboratedConfiguredPackage -> [FilePath]
elabExeDependencyPaths :: ElaboratedConfiguredPackage -> [FilePath]
elabExeDependencyPaths ElaboratedConfiguredPackage
elab =
  case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
elab of
    ElabPackage ElaboratedPackage
pkg -> ((ConfiguredId, FilePath) -> FilePath)
-> [(ConfiguredId, FilePath)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (ConfiguredId, FilePath) -> FilePath
forall a b. (a, b) -> b
snd ([(ConfiguredId, FilePath)] -> [FilePath])
-> [(ConfiguredId, FilePath)] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ComponentDeps [(ConfiguredId, FilePath)]
-> [(ConfiguredId, FilePath)]
forall a. Monoid a => ComponentDeps a -> a
CD.nonSetupDeps (ElaboratedPackage -> ComponentDeps [(ConfiguredId, FilePath)]
pkgExeDependencyPaths ElaboratedPackage
pkg)
    ElabComponent ElaboratedComponent
comp -> ((ConfiguredId, FilePath) -> FilePath)
-> [(ConfiguredId, FilePath)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (ConfiguredId, FilePath) -> FilePath
forall a b. (a, b) -> b
snd (ElaboratedComponent -> [(ConfiguredId, FilePath)]
compExeDependencyPaths ElaboratedComponent
comp)

-- | The setup dependencies (the library dependencies of the setup executable;
-- note that it is not legal for setup scripts to have executable
-- dependencies at the moment.)
elabSetupDependencies :: ElaboratedConfiguredPackage -> [(ConfiguredId, Bool)]
elabSetupDependencies :: ElaboratedConfiguredPackage -> [(ConfiguredId, Bool)]
elabSetupDependencies ElaboratedConfiguredPackage
elab =
  case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
elab of
    ElabPackage ElaboratedPackage
pkg -> ComponentDeps [(ConfiguredId, Bool)] -> [(ConfiguredId, Bool)]
forall a. Monoid a => ComponentDeps a -> a
CD.setupDeps (ElaboratedPackage -> ComponentDeps [(ConfiguredId, Bool)]
pkgLibDependencies ElaboratedPackage
pkg)
    -- TODO: Custom setups not supported for components yet.  When
    -- they are, need to do this differently
    ElabComponent ElaboratedComponent
_ -> []

elabPkgConfigDependencies :: ElaboratedConfiguredPackage -> [(PkgconfigName, Maybe PkgconfigVersion)]
elabPkgConfigDependencies :: ElaboratedConfiguredPackage
-> [(PkgconfigName, Maybe PkgconfigVersion)]
elabPkgConfigDependencies ElaboratedConfiguredPackage{elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp = ElabPackage ElaboratedPackage
pkg} =
  ElaboratedPackage -> [(PkgconfigName, Maybe PkgconfigVersion)]
pkgPkgConfigDependencies ElaboratedPackage
pkg
elabPkgConfigDependencies ElaboratedConfiguredPackage{elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp = ElabComponent ElaboratedComponent
comp} =
  ElaboratedComponent -> [(PkgconfigName, Maybe PkgconfigVersion)]
compPkgConfigDependencies ElaboratedComponent
comp

-- | The cache files of all our inplace dependencies which,
-- when updated, require us to rebuild.  See #4202 for
-- more details.  Essentially, this is a list of filepaths
-- that, if our dependencies get rebuilt, will themselves
-- get updated.
--
-- Note: the hash of these cache files gets built into
-- the build cache ourselves, which means that we end
-- up tracking transitive dependencies!
--
-- Note: This tracks the "build" cache file, but not
-- "registration" or "config" cache files.  Why not?
-- Arguably we should...
--
-- Note: This is a bit of a hack, because it is not really
-- the hashes of the SOURCES of our (transitive) dependencies
-- that we should use to decide whether or not to rebuild,
-- but the output BUILD PRODUCTS.  The strategy we use
-- here will never work if we want to implement unchanging
-- rebuilds.
elabInplaceDependencyBuildCacheFiles
  :: DistDirLayout
  -> ElaboratedSharedConfig
  -> ElaboratedInstallPlan
  -> ElaboratedConfiguredPackage
  -> [FilePath]
elabInplaceDependencyBuildCacheFiles :: DistDirLayout
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedConfiguredPackage
-> [FilePath]
elabInplaceDependencyBuildCacheFiles DistDirLayout
layout ElaboratedSharedConfig
sconf ElaboratedInstallPlan
plan ElaboratedConfiguredPackage
root_elab =
  ElaboratedPlanPackage -> [FilePath]
go (ElaboratedPlanPackage -> [FilePath])
-> [ElaboratedPlanPackage] -> [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ElaboratedInstallPlan -> UnitId -> [ElaboratedPlanPackage]
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg
-> UnitId -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.directDeps ElaboratedInstallPlan
plan (ElaboratedConfiguredPackage -> Key ElaboratedConfiguredPackage
forall a. IsNode a => a -> Key a
nodeKey ElaboratedConfiguredPackage
root_elab)
  where
    go :: ElaboratedPlanPackage -> [FilePath]
go = (InstalledPackageInfo -> [FilePath])
-> (ElaboratedConfiguredPackage -> [FilePath])
-> ElaboratedPlanPackage
-> [FilePath]
forall ipkg a srcpkg.
(ipkg -> a) -> (srcpkg -> a) -> GenericPlanPackage ipkg srcpkg -> a
InstallPlan.foldPlanPackage ([FilePath] -> InstalledPackageInfo -> [FilePath]
forall a b. a -> b -> a
const []) ((ElaboratedConfiguredPackage -> [FilePath])
 -> ElaboratedPlanPackage -> [FilePath])
-> (ElaboratedConfiguredPackage -> [FilePath])
-> ElaboratedPlanPackage
-> [FilePath]
forall a b. (a -> b) -> a -> b
$ \ElaboratedConfiguredPackage
elab -> do
      Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (BuildStyle -> Bool
isInplaceBuildStyle (ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
elab))
      FilePath -> [FilePath]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ DistDirLayout -> DistDirParams -> ShowS
distPackageCacheFile DistDirLayout
layout (ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> DistDirParams
elabDistDirParams ElaboratedSharedConfig
sconf ElaboratedConfiguredPackage
elab) FilePath
"build"

-- | Some extra metadata associated with an
-- 'ElaboratedConfiguredPackage' which indicates that the "package"
-- in question is actually a single component to be built.  Arguably
-- it would be clearer if there were an ADT which branched into
-- package work items and component work items, but I've structured
-- it this way to minimize change to the existing code (which I
-- don't feel qualified to rewrite.)
data ElaboratedComponent = ElaboratedComponent
  { ElaboratedComponent -> Component
compSolverName :: CD.Component
  -- ^ The name of the component to be built according to the solver
  , ElaboratedComponent -> Maybe ComponentName
compComponentName :: Maybe ComponentName
  -- ^ The name of the component to be built.  Nothing if
  -- it's a setup dep.
  , ElaboratedComponent -> [(ConfiguredId, Bool)]
compLibDependencies :: [(ConfiguredId, Bool)]
  -- ^ The *external* library dependencies of this component.  We
  -- pass this to the configure script. The Bool indicates whether the
  -- dependency is a promised dependency (True) or not (False).
  , ElaboratedComponent -> [OpenUnitId]
compLinkedLibDependencies :: [OpenUnitId]
  -- ^ In a component prior to instantiation, this list specifies
  -- the 'OpenUnitId's which, after instantiation, are the
  -- actual dependencies of this package.  Note that this does
  -- NOT include signature packages, which do not turn into real
  -- ordering dependencies when we instantiate.  This is intended to be
  -- a purely temporary field, to carry some information to the
  -- instantiation phase. It's more precise than
  -- 'compLibDependencies', and also stores information about internal
  -- dependencies.
  , ElaboratedComponent -> [ConfiguredId]
compExeDependencies :: [ConfiguredId]
  -- ^ The executable dependencies of this component (including
  -- internal executables).
  , ElaboratedComponent -> [(PkgconfigName, Maybe PkgconfigVersion)]
compPkgConfigDependencies :: [(PkgconfigName, Maybe PkgconfigVersion)]
  -- ^ The @pkg-config@ dependencies of the component
  , ElaboratedComponent -> [(ConfiguredId, FilePath)]
compExeDependencyPaths :: [(ConfiguredId, FilePath)]
  -- ^ The paths all our executable dependencies will be installed
  -- to once they are installed.
  , ElaboratedComponent -> [UnitId]
compOrderLibDependencies :: [UnitId]
  -- ^ The UnitIds of the libraries (identifying elaborated packages/
  -- components) that must be built before this project.  This
  -- is used purely for ordering purposes.  It can contain both
  -- references to definite and indefinite packages; an indefinite
  -- UnitId indicates that we must typecheck that indefinite package
  -- before we can build this one.
  }
  deriving (ElaboratedComponent -> ElaboratedComponent -> Bool
(ElaboratedComponent -> ElaboratedComponent -> Bool)
-> (ElaboratedComponent -> ElaboratedComponent -> Bool)
-> Eq ElaboratedComponent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ElaboratedComponent -> ElaboratedComponent -> Bool
== :: ElaboratedComponent -> ElaboratedComponent -> Bool
$c/= :: ElaboratedComponent -> ElaboratedComponent -> Bool
/= :: ElaboratedComponent -> ElaboratedComponent -> Bool
Eq, Int -> ElaboratedComponent -> ShowS
[ElaboratedComponent] -> ShowS
ElaboratedComponent -> FilePath
(Int -> ElaboratedComponent -> ShowS)
-> (ElaboratedComponent -> FilePath)
-> ([ElaboratedComponent] -> ShowS)
-> Show ElaboratedComponent
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ElaboratedComponent -> ShowS
showsPrec :: Int -> ElaboratedComponent -> ShowS
$cshow :: ElaboratedComponent -> FilePath
show :: ElaboratedComponent -> FilePath
$cshowList :: [ElaboratedComponent] -> ShowS
showList :: [ElaboratedComponent] -> ShowS
Show, (forall x. ElaboratedComponent -> Rep ElaboratedComponent x)
-> (forall x. Rep ElaboratedComponent x -> ElaboratedComponent)
-> Generic ElaboratedComponent
forall x. Rep ElaboratedComponent x -> ElaboratedComponent
forall x. ElaboratedComponent -> Rep ElaboratedComponent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ElaboratedComponent -> Rep ElaboratedComponent x
from :: forall x. ElaboratedComponent -> Rep ElaboratedComponent x
$cto :: forall x. Rep ElaboratedComponent x -> ElaboratedComponent
to :: forall x. Rep ElaboratedComponent x -> ElaboratedComponent
Generic)

instance Binary ElaboratedComponent
instance Structured ElaboratedComponent

-- | See 'elabOrderDependencies'.
compOrderDependencies :: ElaboratedComponent -> [UnitId]
compOrderDependencies :: ElaboratedComponent -> [UnitId]
compOrderDependencies ElaboratedComponent
comp =
  ElaboratedComponent -> [UnitId]
compOrderLibDependencies ElaboratedComponent
comp
    [UnitId] -> [UnitId] -> [UnitId]
forall a. [a] -> [a] -> [a]
++ ElaboratedComponent -> [UnitId]
compOrderExeDependencies ElaboratedComponent
comp

-- | See 'elabOrderExeDependencies'.
compOrderExeDependencies :: ElaboratedComponent -> [UnitId]
compOrderExeDependencies :: ElaboratedComponent -> [UnitId]
compOrderExeDependencies = (ConfiguredId -> UnitId) -> [ConfiguredId] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map (ComponentId -> UnitId
newSimpleUnitId (ComponentId -> UnitId)
-> (ConfiguredId -> ComponentId) -> ConfiguredId -> UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfiguredId -> ComponentId
confInstId) ([ConfiguredId] -> [UnitId])
-> (ElaboratedComponent -> [ConfiguredId])
-> ElaboratedComponent
-> [UnitId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedComponent -> [ConfiguredId]
compExeDependencies

data ElaboratedPackage = ElaboratedPackage
  { ElaboratedPackage -> ComponentId
pkgInstalledId :: InstalledPackageId
  , ElaboratedPackage -> ComponentDeps [(ConfiguredId, Bool)]
pkgLibDependencies :: ComponentDeps [(ConfiguredId, Bool)]
  -- ^ The exact dependencies (on other plan packages)
  -- The boolean value indicates whether the dependency is a promised dependency
  -- or not.
  , ElaboratedPackage -> ComponentDeps [()]
pkgDependsOnSelfLib :: ComponentDeps [()]
  -- ^ Components which depend (transitively) on an internally
  -- defined library.  These are used by 'elabRequiresRegistration',
  -- to determine if a user-requested build is going to need
  -- a library registration
  , ElaboratedPackage -> ComponentDeps [ConfiguredId]
pkgExeDependencies :: ComponentDeps [ConfiguredId]
  -- ^ Dependencies on executable packages.
  , ElaboratedPackage -> ComponentDeps [(ConfiguredId, FilePath)]
pkgExeDependencyPaths :: ComponentDeps [(ConfiguredId, FilePath)]
  -- ^ Paths where executable dependencies live.
  , ElaboratedPackage -> [(PkgconfigName, Maybe PkgconfigVersion)]
pkgPkgConfigDependencies :: [(PkgconfigName, Maybe PkgconfigVersion)]
  -- ^ Dependencies on @pkg-config@ packages.
  -- NB: this is NOT per-component (although it could be)
  -- because Cabal library does not track per-component
  -- pkg-config depends; it always does them all at once.
  , ElaboratedPackage -> OptionalStanzaSet
pkgStanzasEnabled :: OptionalStanzaSet
  -- ^ Which optional stanzas (ie testsuites, benchmarks) will actually
  -- be enabled during the package configure step.
  , ElaboratedPackage -> NonEmpty NotPerComponentReason
pkgWhyNotPerComponent :: NE.NonEmpty NotPerComponentReason
  -- ^ Why is this not a per-component build?
  }
  deriving (ElaboratedPackage -> ElaboratedPackage -> Bool
(ElaboratedPackage -> ElaboratedPackage -> Bool)
-> (ElaboratedPackage -> ElaboratedPackage -> Bool)
-> Eq ElaboratedPackage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ElaboratedPackage -> ElaboratedPackage -> Bool
== :: ElaboratedPackage -> ElaboratedPackage -> Bool
$c/= :: ElaboratedPackage -> ElaboratedPackage -> Bool
/= :: ElaboratedPackage -> ElaboratedPackage -> Bool
Eq, Int -> ElaboratedPackage -> ShowS
[ElaboratedPackage] -> ShowS
ElaboratedPackage -> FilePath
(Int -> ElaboratedPackage -> ShowS)
-> (ElaboratedPackage -> FilePath)
-> ([ElaboratedPackage] -> ShowS)
-> Show ElaboratedPackage
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ElaboratedPackage -> ShowS
showsPrec :: Int -> ElaboratedPackage -> ShowS
$cshow :: ElaboratedPackage -> FilePath
show :: ElaboratedPackage -> FilePath
$cshowList :: [ElaboratedPackage] -> ShowS
showList :: [ElaboratedPackage] -> ShowS
Show, (forall x. ElaboratedPackage -> Rep ElaboratedPackage x)
-> (forall x. Rep ElaboratedPackage x -> ElaboratedPackage)
-> Generic ElaboratedPackage
forall x. Rep ElaboratedPackage x -> ElaboratedPackage
forall x. ElaboratedPackage -> Rep ElaboratedPackage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ElaboratedPackage -> Rep ElaboratedPackage x
from :: forall x. ElaboratedPackage -> Rep ElaboratedPackage x
$cto :: forall x. Rep ElaboratedPackage x -> ElaboratedPackage
to :: forall x. Rep ElaboratedPackage x -> ElaboratedPackage
Generic)

instance Binary ElaboratedPackage
instance Structured ElaboratedPackage

-- | Why did we fall-back to a per-package build, instead of using
-- a per-component build?
data NotPerComponentReason
  = -- | The build-type does not support per-component builds.
    CuzBuildType !NotPerComponentBuildType
  | -- | The Cabal spec version is too old for per-component builds.
    CuzCabalSpecVersion
  | -- | There are no buildable components, so we fall-back to a per-package
    -- build for error-reporting purposes.
    CuzNoBuildableComponents
  | -- | The user passed @--disable-per-component@.
    CuzDisablePerComponent
  deriving (NotPerComponentReason -> NotPerComponentReason -> Bool
(NotPerComponentReason -> NotPerComponentReason -> Bool)
-> (NotPerComponentReason -> NotPerComponentReason -> Bool)
-> Eq NotPerComponentReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NotPerComponentReason -> NotPerComponentReason -> Bool
== :: NotPerComponentReason -> NotPerComponentReason -> Bool
$c/= :: NotPerComponentReason -> NotPerComponentReason -> Bool
/= :: NotPerComponentReason -> NotPerComponentReason -> Bool
Eq, Int -> NotPerComponentReason -> ShowS
[NotPerComponentReason] -> ShowS
NotPerComponentReason -> FilePath
(Int -> NotPerComponentReason -> ShowS)
-> (NotPerComponentReason -> FilePath)
-> ([NotPerComponentReason] -> ShowS)
-> Show NotPerComponentReason
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NotPerComponentReason -> ShowS
showsPrec :: Int -> NotPerComponentReason -> ShowS
$cshow :: NotPerComponentReason -> FilePath
show :: NotPerComponentReason -> FilePath
$cshowList :: [NotPerComponentReason] -> ShowS
showList :: [NotPerComponentReason] -> ShowS
Show, (forall x. NotPerComponentReason -> Rep NotPerComponentReason x)
-> (forall x. Rep NotPerComponentReason x -> NotPerComponentReason)
-> Generic NotPerComponentReason
forall x. Rep NotPerComponentReason x -> NotPerComponentReason
forall x. NotPerComponentReason -> Rep NotPerComponentReason x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NotPerComponentReason -> Rep NotPerComponentReason x
from :: forall x. NotPerComponentReason -> Rep NotPerComponentReason x
$cto :: forall x. Rep NotPerComponentReason x -> NotPerComponentReason
to :: forall x. Rep NotPerComponentReason x -> NotPerComponentReason
Generic)

data NotPerComponentBuildType
  = CuzConfigureBuildType
  | CuzCustomBuildType
  | CuzMakeBuildType
  deriving (NotPerComponentBuildType -> NotPerComponentBuildType -> Bool
(NotPerComponentBuildType -> NotPerComponentBuildType -> Bool)
-> (NotPerComponentBuildType -> NotPerComponentBuildType -> Bool)
-> Eq NotPerComponentBuildType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NotPerComponentBuildType -> NotPerComponentBuildType -> Bool
== :: NotPerComponentBuildType -> NotPerComponentBuildType -> Bool
$c/= :: NotPerComponentBuildType -> NotPerComponentBuildType -> Bool
/= :: NotPerComponentBuildType -> NotPerComponentBuildType -> Bool
Eq, Int -> NotPerComponentBuildType -> ShowS
[NotPerComponentBuildType] -> ShowS
NotPerComponentBuildType -> FilePath
(Int -> NotPerComponentBuildType -> ShowS)
-> (NotPerComponentBuildType -> FilePath)
-> ([NotPerComponentBuildType] -> ShowS)
-> Show NotPerComponentBuildType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NotPerComponentBuildType -> ShowS
showsPrec :: Int -> NotPerComponentBuildType -> ShowS
$cshow :: NotPerComponentBuildType -> FilePath
show :: NotPerComponentBuildType -> FilePath
$cshowList :: [NotPerComponentBuildType] -> ShowS
showList :: [NotPerComponentBuildType] -> ShowS
Show, (forall x.
 NotPerComponentBuildType -> Rep NotPerComponentBuildType x)
-> (forall x.
    Rep NotPerComponentBuildType x -> NotPerComponentBuildType)
-> Generic NotPerComponentBuildType
forall x.
Rep NotPerComponentBuildType x -> NotPerComponentBuildType
forall x.
NotPerComponentBuildType -> Rep NotPerComponentBuildType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
NotPerComponentBuildType -> Rep NotPerComponentBuildType x
from :: forall x.
NotPerComponentBuildType -> Rep NotPerComponentBuildType x
$cto :: forall x.
Rep NotPerComponentBuildType x -> NotPerComponentBuildType
to :: forall x.
Rep NotPerComponentBuildType x -> NotPerComponentBuildType
Generic)

instance Binary NotPerComponentBuildType
instance Structured NotPerComponentBuildType

instance Binary NotPerComponentReason
instance Structured NotPerComponentReason

-- | Display the reason we had to fall-back to a per-package build instead
-- of a per-component build.
whyNotPerComponent :: NotPerComponentReason -> String
whyNotPerComponent :: NotPerComponentReason -> FilePath
whyNotPerComponent = \case
  CuzBuildType NotPerComponentBuildType
bt ->
    FilePath
"build-type is " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ case NotPerComponentBuildType
bt of
      NotPerComponentBuildType
CuzConfigureBuildType -> FilePath
"Configure"
      NotPerComponentBuildType
CuzCustomBuildType -> FilePath
"Custom"
      NotPerComponentBuildType
CuzMakeBuildType -> FilePath
"Make"
  NotPerComponentReason
CuzCabalSpecVersion -> FilePath
"cabal-version is less than 1.8"
  NotPerComponentReason
CuzNoBuildableComponents -> FilePath
"there are no buildable components"
  NotPerComponentReason
CuzDisablePerComponent -> FilePath
"you passed --disable-per-component"

-- | See 'elabOrderDependencies'.  This gives the unflattened version,
-- which can be useful in some circumstances.
pkgOrderDependencies :: ElaboratedPackage -> ComponentDeps [UnitId]
pkgOrderDependencies :: ElaboratedPackage -> ComponentDeps [UnitId]
pkgOrderDependencies ElaboratedPackage
pkg =
  ([ConfiguredId] -> [UnitId])
-> ComponentDeps [ConfiguredId] -> ComponentDeps [UnitId]
forall a b. (a -> b) -> ComponentDeps a -> ComponentDeps b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ConfiguredId -> UnitId) -> [ConfiguredId] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map (ComponentId -> UnitId
newSimpleUnitId (ComponentId -> UnitId)
-> (ConfiguredId -> ComponentId) -> ConfiguredId -> UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfiguredId -> ComponentId
confInstId)) (((ConfiguredId, Bool) -> ConfiguredId)
-> [(ConfiguredId, Bool)] -> [ConfiguredId]
forall a b. (a -> b) -> [a] -> [b]
map (ConfiguredId, Bool) -> ConfiguredId
forall a b. (a, b) -> a
fst ([(ConfiguredId, Bool)] -> [ConfiguredId])
-> ComponentDeps [(ConfiguredId, Bool)]
-> ComponentDeps [ConfiguredId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ElaboratedPackage -> ComponentDeps [(ConfiguredId, Bool)]
pkgLibDependencies ElaboratedPackage
pkg)
    ComponentDeps [UnitId]
-> ComponentDeps [UnitId] -> ComponentDeps [UnitId]
forall a. Monoid a => a -> a -> a
`Mon.mappend` ([ConfiguredId] -> [UnitId])
-> ComponentDeps [ConfiguredId] -> ComponentDeps [UnitId]
forall a b. (a -> b) -> ComponentDeps a -> ComponentDeps b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ConfiguredId -> UnitId) -> [ConfiguredId] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map (ComponentId -> UnitId
newSimpleUnitId (ComponentId -> UnitId)
-> (ConfiguredId -> ComponentId) -> ConfiguredId -> UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfiguredId -> ComponentId
confInstId)) (ElaboratedPackage -> ComponentDeps [ConfiguredId]
pkgExeDependencies ElaboratedPackage
pkg)

-- | This is used in the install plan to indicate how the package will be
-- built.
data BuildStyle
  = -- | The classic approach where the package is built, then the files
    -- installed into some location and the result registered in a package db.
    --
    -- If the package came from a tarball then it's built in a temp dir and
    -- the results discarded.
    BuildAndInstall
  | -- | For 'OnDisk': The package is built, but the files are not installed anywhere,
    -- rather the build dir is kept and the package is registered inplace.
    --
    -- Such packages can still subsequently be installed.
    --
    -- Typically 'BuildAndInstall' packages will only depend on other
    -- 'BuildAndInstall' style packages and not on 'BuildInplaceOnly' ones.
    --
    -- For 'InMemory':  Built in-memory only using GHC multi-repl, they are not built or installed
    -- anywhere on disk. BuildInMemory packages can't be depended on by BuildAndInstall nor BuildInplaceOnly packages
    -- (because they don't exist on disk) but can depend on other BuildStyles.
    --
    -- At the moment @'BuildInplaceOnly' 'InMemory'@ is only used by the 'repl' command.
    --
    -- We use single constructor 'BuildInplaceOnly' as for most cases
    -- inplace packages are handled similarly.
    BuildInplaceOnly MemoryOrDisk
  deriving (BuildStyle -> BuildStyle -> Bool
(BuildStyle -> BuildStyle -> Bool)
-> (BuildStyle -> BuildStyle -> Bool) -> Eq BuildStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BuildStyle -> BuildStyle -> Bool
== :: BuildStyle -> BuildStyle -> Bool
$c/= :: BuildStyle -> BuildStyle -> Bool
/= :: BuildStyle -> BuildStyle -> Bool
Eq, Eq BuildStyle
Eq BuildStyle =>
(BuildStyle -> BuildStyle -> Ordering)
-> (BuildStyle -> BuildStyle -> Bool)
-> (BuildStyle -> BuildStyle -> Bool)
-> (BuildStyle -> BuildStyle -> Bool)
-> (BuildStyle -> BuildStyle -> Bool)
-> (BuildStyle -> BuildStyle -> BuildStyle)
-> (BuildStyle -> BuildStyle -> BuildStyle)
-> Ord BuildStyle
BuildStyle -> BuildStyle -> Bool
BuildStyle -> BuildStyle -> Ordering
BuildStyle -> BuildStyle -> BuildStyle
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BuildStyle -> BuildStyle -> Ordering
compare :: BuildStyle -> BuildStyle -> Ordering
$c< :: BuildStyle -> BuildStyle -> Bool
< :: BuildStyle -> BuildStyle -> Bool
$c<= :: BuildStyle -> BuildStyle -> Bool
<= :: BuildStyle -> BuildStyle -> Bool
$c> :: BuildStyle -> BuildStyle -> Bool
> :: BuildStyle -> BuildStyle -> Bool
$c>= :: BuildStyle -> BuildStyle -> Bool
>= :: BuildStyle -> BuildStyle -> Bool
$cmax :: BuildStyle -> BuildStyle -> BuildStyle
max :: BuildStyle -> BuildStyle -> BuildStyle
$cmin :: BuildStyle -> BuildStyle -> BuildStyle
min :: BuildStyle -> BuildStyle -> BuildStyle
Ord, Int -> BuildStyle -> ShowS
[BuildStyle] -> ShowS
BuildStyle -> FilePath
(Int -> BuildStyle -> ShowS)
-> (BuildStyle -> FilePath)
-> ([BuildStyle] -> ShowS)
-> Show BuildStyle
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BuildStyle -> ShowS
showsPrec :: Int -> BuildStyle -> ShowS
$cshow :: BuildStyle -> FilePath
show :: BuildStyle -> FilePath
$cshowList :: [BuildStyle] -> ShowS
showList :: [BuildStyle] -> ShowS
Show, (forall x. BuildStyle -> Rep BuildStyle x)
-> (forall x. Rep BuildStyle x -> BuildStyle) -> Generic BuildStyle
forall x. Rep BuildStyle x -> BuildStyle
forall x. BuildStyle -> Rep BuildStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BuildStyle -> Rep BuildStyle x
from :: forall x. BuildStyle -> Rep BuildStyle x
$cto :: forall x. Rep BuildStyle x -> BuildStyle
to :: forall x. Rep BuildStyle x -> BuildStyle
Generic)

-- | How 'BuildInplaceOnly' component is built.
data MemoryOrDisk
  = OnDisk
  | InMemory
  deriving (MemoryOrDisk -> MemoryOrDisk -> Bool
(MemoryOrDisk -> MemoryOrDisk -> Bool)
-> (MemoryOrDisk -> MemoryOrDisk -> Bool) -> Eq MemoryOrDisk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MemoryOrDisk -> MemoryOrDisk -> Bool
== :: MemoryOrDisk -> MemoryOrDisk -> Bool
$c/= :: MemoryOrDisk -> MemoryOrDisk -> Bool
/= :: MemoryOrDisk -> MemoryOrDisk -> Bool
Eq, Eq MemoryOrDisk
Eq MemoryOrDisk =>
(MemoryOrDisk -> MemoryOrDisk -> Ordering)
-> (MemoryOrDisk -> MemoryOrDisk -> Bool)
-> (MemoryOrDisk -> MemoryOrDisk -> Bool)
-> (MemoryOrDisk -> MemoryOrDisk -> Bool)
-> (MemoryOrDisk -> MemoryOrDisk -> Bool)
-> (MemoryOrDisk -> MemoryOrDisk -> MemoryOrDisk)
-> (MemoryOrDisk -> MemoryOrDisk -> MemoryOrDisk)
-> Ord MemoryOrDisk
MemoryOrDisk -> MemoryOrDisk -> Bool
MemoryOrDisk -> MemoryOrDisk -> Ordering
MemoryOrDisk -> MemoryOrDisk -> MemoryOrDisk
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MemoryOrDisk -> MemoryOrDisk -> Ordering
compare :: MemoryOrDisk -> MemoryOrDisk -> Ordering
$c< :: MemoryOrDisk -> MemoryOrDisk -> Bool
< :: MemoryOrDisk -> MemoryOrDisk -> Bool
$c<= :: MemoryOrDisk -> MemoryOrDisk -> Bool
<= :: MemoryOrDisk -> MemoryOrDisk -> Bool
$c> :: MemoryOrDisk -> MemoryOrDisk -> Bool
> :: MemoryOrDisk -> MemoryOrDisk -> Bool
$c>= :: MemoryOrDisk -> MemoryOrDisk -> Bool
>= :: MemoryOrDisk -> MemoryOrDisk -> Bool
$cmax :: MemoryOrDisk -> MemoryOrDisk -> MemoryOrDisk
max :: MemoryOrDisk -> MemoryOrDisk -> MemoryOrDisk
$cmin :: MemoryOrDisk -> MemoryOrDisk -> MemoryOrDisk
min :: MemoryOrDisk -> MemoryOrDisk -> MemoryOrDisk
Ord, Int -> MemoryOrDisk -> ShowS
[MemoryOrDisk] -> ShowS
MemoryOrDisk -> FilePath
(Int -> MemoryOrDisk -> ShowS)
-> (MemoryOrDisk -> FilePath)
-> ([MemoryOrDisk] -> ShowS)
-> Show MemoryOrDisk
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MemoryOrDisk -> ShowS
showsPrec :: Int -> MemoryOrDisk -> ShowS
$cshow :: MemoryOrDisk -> FilePath
show :: MemoryOrDisk -> FilePath
$cshowList :: [MemoryOrDisk] -> ShowS
showList :: [MemoryOrDisk] -> ShowS
Show, (forall x. MemoryOrDisk -> Rep MemoryOrDisk x)
-> (forall x. Rep MemoryOrDisk x -> MemoryOrDisk)
-> Generic MemoryOrDisk
forall x. Rep MemoryOrDisk x -> MemoryOrDisk
forall x. MemoryOrDisk -> Rep MemoryOrDisk x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MemoryOrDisk -> Rep MemoryOrDisk x
from :: forall x. MemoryOrDisk -> Rep MemoryOrDisk x
$cto :: forall x. Rep MemoryOrDisk x -> MemoryOrDisk
to :: forall x. Rep MemoryOrDisk x -> MemoryOrDisk
Generic)

-- Note: order of 'BuildStyle' and 'MemoryOrDisk' matters for 'Semigroup' / 'Monoid' instances

isInplaceBuildStyle :: BuildStyle -> Bool
isInplaceBuildStyle :: BuildStyle -> Bool
isInplaceBuildStyle (BuildInplaceOnly{}) = Bool
True
isInplaceBuildStyle BuildStyle
BuildAndInstall = Bool
False

instance Binary MemoryOrDisk
instance Structured MemoryOrDisk

instance Semigroup BuildStyle where
  -- 'BuildAndInstall' i.e. the smallest / first constructor is the unit.
  <> :: BuildStyle -> BuildStyle -> BuildStyle
(<>) = BuildStyle -> BuildStyle -> BuildStyle
forall a. Ord a => a -> a -> a
max

instance Monoid BuildStyle where
  mempty :: BuildStyle
mempty = BuildStyle
BuildAndInstall

instance Binary BuildStyle
instance Structured BuildStyle

type CabalFileText = LBS.ByteString

type ElaboratedReadyPackage = GenericReadyPackage ElaboratedConfiguredPackage

---------------------------
-- Build targets
--

-- | Specific targets within a package or component to act on e.g. to build,
-- haddock or open a repl.
data ComponentTarget = ComponentTarget ComponentName SubComponentTarget
  deriving (ComponentTarget -> ComponentTarget -> Bool
(ComponentTarget -> ComponentTarget -> Bool)
-> (ComponentTarget -> ComponentTarget -> Bool)
-> Eq ComponentTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ComponentTarget -> ComponentTarget -> Bool
== :: ComponentTarget -> ComponentTarget -> Bool
$c/= :: ComponentTarget -> ComponentTarget -> Bool
/= :: ComponentTarget -> ComponentTarget -> Bool
Eq, Eq ComponentTarget
Eq ComponentTarget =>
(ComponentTarget -> ComponentTarget -> Ordering)
-> (ComponentTarget -> ComponentTarget -> Bool)
-> (ComponentTarget -> ComponentTarget -> Bool)
-> (ComponentTarget -> ComponentTarget -> Bool)
-> (ComponentTarget -> ComponentTarget -> Bool)
-> (ComponentTarget -> ComponentTarget -> ComponentTarget)
-> (ComponentTarget -> ComponentTarget -> ComponentTarget)
-> Ord ComponentTarget
ComponentTarget -> ComponentTarget -> Bool
ComponentTarget -> ComponentTarget -> Ordering
ComponentTarget -> ComponentTarget -> ComponentTarget
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ComponentTarget -> ComponentTarget -> Ordering
compare :: ComponentTarget -> ComponentTarget -> Ordering
$c< :: ComponentTarget -> ComponentTarget -> Bool
< :: ComponentTarget -> ComponentTarget -> Bool
$c<= :: ComponentTarget -> ComponentTarget -> Bool
<= :: ComponentTarget -> ComponentTarget -> Bool
$c> :: ComponentTarget -> ComponentTarget -> Bool
> :: ComponentTarget -> ComponentTarget -> Bool
$c>= :: ComponentTarget -> ComponentTarget -> Bool
>= :: ComponentTarget -> ComponentTarget -> Bool
$cmax :: ComponentTarget -> ComponentTarget -> ComponentTarget
max :: ComponentTarget -> ComponentTarget -> ComponentTarget
$cmin :: ComponentTarget -> ComponentTarget -> ComponentTarget
min :: ComponentTarget -> ComponentTarget -> ComponentTarget
Ord, Int -> ComponentTarget -> ShowS
[ComponentTarget] -> ShowS
ComponentTarget -> FilePath
(Int -> ComponentTarget -> ShowS)
-> (ComponentTarget -> FilePath)
-> ([ComponentTarget] -> ShowS)
-> Show ComponentTarget
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ComponentTarget -> ShowS
showsPrec :: Int -> ComponentTarget -> ShowS
$cshow :: ComponentTarget -> FilePath
show :: ComponentTarget -> FilePath
$cshowList :: [ComponentTarget] -> ShowS
showList :: [ComponentTarget] -> ShowS
Show, (forall x. ComponentTarget -> Rep ComponentTarget x)
-> (forall x. Rep ComponentTarget x -> ComponentTarget)
-> Generic ComponentTarget
forall x. Rep ComponentTarget x -> ComponentTarget
forall x. ComponentTarget -> Rep ComponentTarget x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ComponentTarget -> Rep ComponentTarget x
from :: forall x. ComponentTarget -> Rep ComponentTarget x
$cto :: forall x. Rep ComponentTarget x -> ComponentTarget
to :: forall x. Rep ComponentTarget x -> ComponentTarget
Generic)

instance Binary ComponentTarget
instance Structured ComponentTarget

-- | Unambiguously render a 'ComponentTarget', e.g., to pass
-- to a Cabal Setup script.
showComponentTarget :: PackageId -> ComponentTarget -> String
showComponentTarget :: PackageIdentifier -> ComponentTarget -> FilePath
showComponentTarget PackageIdentifier
pkgid =
  PackageIdentifier -> BuildTarget -> FilePath
Cabal.showBuildTarget PackageIdentifier
pkgid (BuildTarget -> FilePath)
-> (ComponentTarget -> BuildTarget) -> ComponentTarget -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComponentTarget -> BuildTarget
toBuildTarget
  where
    toBuildTarget :: ComponentTarget -> Cabal.BuildTarget
    toBuildTarget :: ComponentTarget -> BuildTarget
toBuildTarget (ComponentTarget ComponentName
cname SubComponentTarget
subtarget) =
      case SubComponentTarget
subtarget of
        SubComponentTarget
WholeComponent -> ComponentName -> BuildTarget
Cabal.BuildTargetComponent ComponentName
cname
        ModuleTarget ModuleName
mname -> ComponentName -> ModuleName -> BuildTarget
Cabal.BuildTargetModule ComponentName
cname ModuleName
mname
        FileTarget FilePath
fname -> ComponentName -> FilePath -> BuildTarget
Cabal.BuildTargetFile ComponentName
cname FilePath
fname

showTestComponentTarget :: PackageId -> ComponentTarget -> Maybe String
showTestComponentTarget :: PackageIdentifier -> ComponentTarget -> Maybe FilePath
showTestComponentTarget PackageIdentifier
_ (ComponentTarget (CTestName UnqualComponentName
n) SubComponentTarget
_) = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ UnqualComponentName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow UnqualComponentName
n
showTestComponentTarget PackageIdentifier
_ ComponentTarget
_ = Maybe FilePath
forall a. Maybe a
Nothing

isTestComponentTarget :: ComponentTarget -> Bool
isTestComponentTarget :: ComponentTarget -> Bool
isTestComponentTarget (ComponentTarget (CTestName UnqualComponentName
_) SubComponentTarget
_) = Bool
True
isTestComponentTarget ComponentTarget
_ = Bool
False

showBenchComponentTarget :: PackageId -> ComponentTarget -> Maybe String
showBenchComponentTarget :: PackageIdentifier -> ComponentTarget -> Maybe FilePath
showBenchComponentTarget PackageIdentifier
_ (ComponentTarget (CBenchName UnqualComponentName
n) SubComponentTarget
_) = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ UnqualComponentName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow UnqualComponentName
n
showBenchComponentTarget PackageIdentifier
_ ComponentTarget
_ = Maybe FilePath
forall a. Maybe a
Nothing

isBenchComponentTarget :: ComponentTarget -> Bool
isBenchComponentTarget :: ComponentTarget -> Bool
isBenchComponentTarget (ComponentTarget (CBenchName UnqualComponentName
_) SubComponentTarget
_) = Bool
True
isBenchComponentTarget ComponentTarget
_ = Bool
False

isForeignLibComponentTarget :: ComponentTarget -> Bool
isForeignLibComponentTarget :: ComponentTarget -> Bool
isForeignLibComponentTarget (ComponentTarget (CFLibName UnqualComponentName
_) SubComponentTarget
_) = Bool
True
isForeignLibComponentTarget ComponentTarget
_ = Bool
False

isExeComponentTarget :: ComponentTarget -> Bool
isExeComponentTarget :: ComponentTarget -> Bool
isExeComponentTarget (ComponentTarget (CExeName UnqualComponentName
_) SubComponentTarget
_) = Bool
True
isExeComponentTarget ComponentTarget
_ = Bool
False

isSubLibComponentTarget :: ComponentTarget -> Bool
isSubLibComponentTarget :: ComponentTarget -> Bool
isSubLibComponentTarget (ComponentTarget (CLibName (LSubLibName UnqualComponentName
_)) SubComponentTarget
_) = Bool
True
isSubLibComponentTarget ComponentTarget
_ = Bool
False

componentOptionalStanza :: CD.Component -> Maybe OptionalStanza
componentOptionalStanza :: Component -> Maybe OptionalStanza
componentOptionalStanza (CD.ComponentTest UnqualComponentName
_) = OptionalStanza -> Maybe OptionalStanza
forall a. a -> Maybe a
Just OptionalStanza
TestStanzas
componentOptionalStanza (CD.ComponentBench UnqualComponentName
_) = OptionalStanza -> Maybe OptionalStanza
forall a. a -> Maybe a
Just OptionalStanza
BenchStanzas
componentOptionalStanza Component
_ = Maybe OptionalStanza
forall a. Maybe a
Nothing

---------------------------
-- Setup.hs script policy
--

-- | There are four major cases for Setup.hs handling:
--
--  1. @build-type@ Custom with a @custom-setup@ section
--  2. @build-type@ Custom without a @custom-setup@ section
--  3. @build-type@ not Custom with @cabal-version >  $our-cabal-version@
--  4. @build-type@ not Custom with @cabal-version <= $our-cabal-version@
--
-- It's also worth noting that packages specifying @cabal-version: >= 1.23@
-- or later that have @build-type@ Custom will always have a @custom-setup@
-- section. Therefore in case 2, the specified @cabal-version@ will always be
-- less than 1.23.
--
-- In cases 1 and 2 we obviously have to build an external Setup.hs script,
-- while in case 4 we can use the internal library API. In case 3 we also have
-- to build an external Setup.hs script because the package needs a later
-- Cabal lib version than we can support internally.
data SetupScriptStyle
  = SetupCustomExplicitDeps
  | SetupCustomImplicitDeps
  | SetupNonCustomExternalLib
  | SetupNonCustomInternalLib
  deriving (SetupScriptStyle -> SetupScriptStyle -> Bool
(SetupScriptStyle -> SetupScriptStyle -> Bool)
-> (SetupScriptStyle -> SetupScriptStyle -> Bool)
-> Eq SetupScriptStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SetupScriptStyle -> SetupScriptStyle -> Bool
== :: SetupScriptStyle -> SetupScriptStyle -> Bool
$c/= :: SetupScriptStyle -> SetupScriptStyle -> Bool
/= :: SetupScriptStyle -> SetupScriptStyle -> Bool
Eq, Int -> SetupScriptStyle -> ShowS
[SetupScriptStyle] -> ShowS
SetupScriptStyle -> FilePath
(Int -> SetupScriptStyle -> ShowS)
-> (SetupScriptStyle -> FilePath)
-> ([SetupScriptStyle] -> ShowS)
-> Show SetupScriptStyle
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SetupScriptStyle -> ShowS
showsPrec :: Int -> SetupScriptStyle -> ShowS
$cshow :: SetupScriptStyle -> FilePath
show :: SetupScriptStyle -> FilePath
$cshowList :: [SetupScriptStyle] -> ShowS
showList :: [SetupScriptStyle] -> ShowS
Show, (forall x. SetupScriptStyle -> Rep SetupScriptStyle x)
-> (forall x. Rep SetupScriptStyle x -> SetupScriptStyle)
-> Generic SetupScriptStyle
forall x. Rep SetupScriptStyle x -> SetupScriptStyle
forall x. SetupScriptStyle -> Rep SetupScriptStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SetupScriptStyle -> Rep SetupScriptStyle x
from :: forall x. SetupScriptStyle -> Rep SetupScriptStyle x
$cto :: forall x. Rep SetupScriptStyle x -> SetupScriptStyle
to :: forall x. Rep SetupScriptStyle x -> SetupScriptStyle
Generic, Typeable)

instance Binary SetupScriptStyle
instance Structured SetupScriptStyle