{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RecordWildCards     #-}

-- | Dealing with Cabal.


module Stack.Package
  ( readDotBuildinfo
  , resolvePackage
  , packageFromPackageDescription
  , Package (..)
  , PackageDescriptionPair (..)
  , GetPackageOpts (..)
  , PackageConfig (..)
  , buildLogPath
  , PackageException (..)
  , resolvePackageDescription
  , packageDependencies
  , applyForceCustomBuild
  ) where

import           Data.List ( unzip )
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import qualified Data.Text as T
import           Distribution.CabalSpecVersion ( cabalSpecToVersionDigits )
import qualified Distribution.Compat.NonEmptySet as NES
import           Distribution.Compiler
                   ( CompilerFlavor (..), PerCompilerFlavor (..) )
import           Distribution.Package ( mkPackageName )
import           Distribution.PackageDescription
                   ( Benchmark (..), BuildInfo (..), BuildType (..)
                   , CondTree (..), Condition (..), ConfVar (..)
                   , Dependency (..), Executable (..), ForeignLib (..)
                   , GenericPackageDescription (..), HookedBuildInfo
                   , Library (..), PackageDescription (..), PackageFlag (..)
                   , SetupBuildInfo (..), TestSuite (..), allLanguages
                   , allLibraries, buildType, depPkgName, depVerRange
                   , libraryNameString, maybeToLibraryName, usedExtensions
                   )
import           Distribution.Pretty ( prettyShow )
import           Distribution.Simple.PackageDescription ( readHookedBuildInfo )
import           Distribution.System ( OS (..), Arch, Platform (..) )
import           Distribution.Text ( display )
import qualified Distribution.Types.CondTree as Cabal
import qualified Distribution.Types.ExeDependency as Cabal
import qualified Distribution.Types.LegacyExeDependency as Cabal
import qualified Distribution.Types.UnqualComponentName as Cabal
import           Distribution.Utils.Path ( getSymbolicPath )
import           Distribution.Verbosity ( silent )
import           Distribution.Version
                   ( anyVersion, mkVersion, orLaterVersion )
import           Path as FL hiding ( replaceExtension )
import           Path.Extra ( concatAndCollapseAbsDir, toFilePathNoTrailingSep )
import           Stack.Constants (relFileCabalMacrosH, relDirLogs)
import           Stack.Constants.Config ( distDirFromDir )
import           Stack.Prelude hiding ( Display (..) )
import           Stack.ComponentFile
                   ( buildDir, componentAutogenDir, componentBuildDir
                   , componentOutputDir, packageAutogenDir
                   )
import           Stack.Types.BuildConfig
                   ( HasBuildConfig (..), getProjectWorkDir )
import           Stack.Types.Compiler ( ActualCompiler (..), getGhcVersion )
import           Stack.Types.CompilerPaths ( cabalVersionL )
import           Stack.Types.Config ( Config (..), HasConfig (..) )
import           Stack.Types.EnvConfig ( HasEnvConfig )
import           Stack.Types.GhcPkgId ( ghcPkgIdString )
import           Stack.Types.NamedComponent
                   ( NamedComponent (..), internalLibComponents )
import           Stack.Types.Package
                   ( BuildInfoOpts (..), ExeName (..), GetPackageOpts (..)
                   , InstallMap, Installed (..), InstalledMap, Package (..)
                   , PackageConfig (..), PackageException (..)
                   , PackageLibraries (..), dotCabalCFilePath, packageIdentifier
                   )
import           Stack.Types.Version
                   ( VersionRange, intersectVersionRanges, withinRange )
import           System.FilePath ( replaceExtension )
import           Stack.Types.Dependency ( DepValue (..), DepType (..) )
import           Stack.Types.PackageFile ( DotCabalPath , GetPackageFiles (..) )
import           Stack.PackageFile ( getPackageFile )

-- | Read @<package>.buildinfo@ ancillary files produced by some Setup.hs hooks.

-- The file includes Cabal file syntax to be merged into the package description

-- derived from the package's Cabal file.

--

-- NOTE: not to be confused with BuildInfo, an Stack-internal datatype.

readDotBuildinfo :: MonadIO m => Path Abs File -> m HookedBuildInfo
readDotBuildinfo :: forall (m :: * -> *).
MonadIO m =>
Path Abs File -> m HookedBuildInfo
readDotBuildinfo Path Abs File
buildinfofp =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Verbosity -> String -> IO HookedBuildInfo
readHookedBuildInfo Verbosity
silent (forall b t. Path b t -> String
toFilePath Path Abs File
buildinfofp)

-- | Resolve a parsed Cabal file into a 'Package', which contains all of the

-- info needed for Stack to build the 'Package' given the current configuration.

resolvePackage :: PackageConfig -> GenericPackageDescription -> Package
resolvePackage :: PackageConfig -> GenericPackageDescription -> Package
resolvePackage PackageConfig
packageConfig GenericPackageDescription
gpkg =
  PackageConfig -> [PackageFlag] -> PackageDescriptionPair -> Package
packageFromPackageDescription
    PackageConfig
packageConfig
    (GenericPackageDescription -> [PackageFlag]
genPackageFlags GenericPackageDescription
gpkg)
    (PackageConfig
-> GenericPackageDescription -> PackageDescriptionPair
resolvePackageDescription PackageConfig
packageConfig GenericPackageDescription
gpkg)

packageFromPackageDescription ::
     PackageConfig
  -> [PackageFlag]
  -> PackageDescriptionPair
  -> Package
packageFromPackageDescription :: PackageConfig -> [PackageFlag] -> PackageDescriptionPair -> Package
packageFromPackageDescription PackageConfig
packageConfig [PackageFlag]
pkgFlags (PackageDescriptionPair PackageDescription
pkgNoMod PackageDescription
pkg) =
  Package
  { packageName :: PackageName
packageName = PackageName
name
  , packageVersion :: Version
packageVersion = PackageIdentifier -> Version
pkgVersion PackageIdentifier
pkgId
  , packageLicense :: Either License License
packageLicense = PackageDescription -> Either License License
licenseRaw PackageDescription
pkg
  , packageDeps :: Map PackageName DepValue
packageDeps = Map PackageName DepValue
deps
  , packageFiles :: GetPackageFiles
packageFiles = GetPackageFiles
pkgFiles
  , packageUnknownTools :: Set ExeName
packageUnknownTools = Set ExeName
unknownTools
  , packageGhcOptions :: [Text]
packageGhcOptions = PackageConfig -> [Text]
packageConfigGhcOptions PackageConfig
packageConfig
  , packageCabalConfigOpts :: [Text]
packageCabalConfigOpts = PackageConfig -> [Text]
packageConfigCabalConfigOpts PackageConfig
packageConfig
  , packageFlags :: Map FlagName Bool
packageFlags = PackageConfig -> Map FlagName Bool
packageConfigFlags PackageConfig
packageConfig
  , packageDefaultFlags :: Map FlagName Bool
packageDefaultFlags = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
      [(PackageFlag -> FlagName
flagName PackageFlag
flag, PackageFlag -> Bool
flagDefault PackageFlag
flag) | PackageFlag
flag <- [PackageFlag]
pkgFlags]
  , packageAllDeps :: Set PackageName
packageAllDeps = forall k a. Map k a -> Set k
M.keysSet Map PackageName DepValue
deps
  , packageSubLibDeps :: Map MungedPackageName DepValue
packageSubLibDeps = Map MungedPackageName DepValue
subLibDeps
  , packageLibraries :: PackageLibraries
packageLibraries =
      let mlib :: Maybe Library
mlib = do
            Library
lib <- PackageDescription -> Maybe Library
library PackageDescription
pkg
            forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ BuildInfo -> Bool
buildable forall a b. (a -> b) -> a -> b
$ Library -> BuildInfo
libBuildInfo Library
lib
            forall a. a -> Maybe a
Just Library
lib
       in
        case Maybe Library
mlib of
          Maybe Library
Nothing -> PackageLibraries
NoLibraries
          Just Library
_ -> Set Text -> PackageLibraries
HasLibraries Set Text
foreignLibNames
  , packageInternalLibraries :: Set Text
packageInternalLibraries = Set Text
subLibNames
  , packageTests :: Map Text TestSuiteInterface
packageTests = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
      [ (String -> Text
T.pack (UnqualComponentName -> String
Cabal.unUnqualComponentName forall a b. (a -> b) -> a -> b
$ TestSuite -> UnqualComponentName
testName TestSuite
t), TestSuite -> TestSuiteInterface
testInterface TestSuite
t)
      | TestSuite
t <- PackageDescription -> [TestSuite]
testSuites PackageDescription
pkgNoMod
      , BuildInfo -> Bool
buildable (TestSuite -> BuildInfo
testBuildInfo TestSuite
t)
      ]
  , packageBenchmarks :: Set Text
packageBenchmarks = forall a. Ord a => [a] -> Set a
S.fromList
      [ String -> Text
T.pack (UnqualComponentName -> String
Cabal.unUnqualComponentName forall a b. (a -> b) -> a -> b
$ Benchmark -> UnqualComponentName
benchmarkName Benchmark
b)
      | Benchmark
b <- PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkgNoMod
      , BuildInfo -> Bool
buildable (Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
b)
      ]
      -- Same comment about buildable applies here too.

  , packageExes :: Set Text
packageExes = forall a. Ord a => [a] -> Set a
S.fromList
      [ String -> Text
T.pack (UnqualComponentName -> String
Cabal.unUnqualComponentName forall a b. (a -> b) -> a -> b
$ Executable -> UnqualComponentName
exeName Executable
biBuildInfo)
      | Executable
biBuildInfo <- PackageDescription -> [Executable]
executables PackageDescription
pkg
      , BuildInfo -> Bool
buildable (Executable -> BuildInfo
buildInfo Executable
biBuildInfo)
      ]
  -- This is an action used to collect info needed for "stack ghci".

  -- This info isn't usually needed, so computation of it is deferred.

  , packageOpts :: GetPackageOpts
packageOpts = (forall env.
 HasEnvConfig env =>
 InstallMap
 -> InstalledMap
 -> [PackageName]
 -> [PackageName]
 -> Path Abs File
 -> RIO
      env
      (Map NamedComponent (Map ModuleName (Path Abs File)),
       Map NamedComponent [DotCabalPath],
       Map NamedComponent BuildInfoOpts))
-> GetPackageOpts
GetPackageOpts forall a b. (a -> b) -> a -> b
$
      \InstallMap
installMap InstalledMap
installedMap [PackageName]
omitPkgs [PackageName]
addPkgs Path Abs File
cabalfp -> do
        (Map NamedComponent (Map ModuleName (Path Abs File))
componentsModules,Map NamedComponent [DotCabalPath]
componentFiles, Set (Path Abs File)
_, [PackageWarning]
_) <- GetPackageFiles
-> forall env.
   HasEnvConfig env =>
   Path Abs File
   -> RIO
        env
        (Map NamedComponent (Map ModuleName (Path Abs File)),
         Map NamedComponent [DotCabalPath], Set (Path Abs File),
         [PackageWarning])
getPackageFiles GetPackageFiles
pkgFiles Path Abs File
cabalfp
        let internals :: [Text]
internals =
              forall a. Set a -> [a]
S.toList forall a b. (a -> b) -> a -> b
$ Set NamedComponent -> Set Text
internalLibComponents forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> Set k
M.keysSet Map NamedComponent (Map ModuleName (Path Abs File))
componentsModules
        [PackageName]
excludedInternals <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *). MonadThrow m => String -> m PackageName
parsePackageNameThrowing forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) [Text]
internals
        [PackageName]
mungedInternals <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
          (forall (m :: * -> *). MonadThrow m => String -> m PackageName
parsePackageNameThrowing forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toInternalPackageMungedName)
          [Text]
internals
        Map NamedComponent BuildInfoOpts
componentsOpts <- forall env (m :: * -> *).
(HasEnvConfig env, MonadThrow m, MonadReader env m, MonadIO m) =>
InstallMap
-> InstalledMap
-> [PackageName]
-> [PackageName]
-> Path Abs File
-> PackageDescription
-> Map NamedComponent [DotCabalPath]
-> m (Map NamedComponent BuildInfoOpts)
generatePkgDescOpts
          InstallMap
installMap
          InstalledMap
installedMap
          ([PackageName]
excludedInternals forall a. [a] -> [a] -> [a]
++ [PackageName]
omitPkgs)
          ([PackageName]
mungedInternals forall a. [a] -> [a] -> [a]
++ [PackageName]
addPkgs)
          Path Abs File
cabalfp
          PackageDescription
pkg
          Map NamedComponent [DotCabalPath]
componentFiles
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map NamedComponent (Map ModuleName (Path Abs File))
componentsModules, Map NamedComponent [DotCabalPath]
componentFiles, Map NamedComponent BuildInfoOpts
componentsOpts)
  , packageHasExposedModules :: Bool
packageHasExposedModules = forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      Bool
False
      (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> [ModuleName]
exposedModules)
      (PackageDescription -> Maybe Library
library PackageDescription
pkg)
  , packageBuildType :: BuildType
packageBuildType = PackageDescription -> BuildType
buildType PackageDescription
pkg
  , packageSetupDeps :: Maybe (Map PackageName VersionRange)
packageSetupDeps = Maybe (Map PackageName VersionRange)
msetupDeps
  , packageCabalSpec :: CabalSpecVersion
packageCabalSpec = PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg
  }
 where
  extraLibNames :: Set Text
extraLibNames = forall a. Ord a => Set a -> Set a -> Set a
S.union Set Text
subLibNames Set Text
foreignLibNames

  subLibNames :: Set Text
subLibNames
    = forall a. Ord a => [a] -> Set a
S.fromList
    forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> String
Cabal.unUnqualComponentName)
    forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (LibraryName -> Maybe UnqualComponentName
libraryNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> LibraryName
libName) -- this is a design bug in the

                                             -- Cabal API: this should

                                             -- statically be known to exist

    forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (BuildInfo -> Bool
buildable forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> BuildInfo
libBuildInfo)
    forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Library]
subLibraries PackageDescription
pkg

  foreignLibNames :: Set Text
foreignLibNames
    = forall a. Ord a => [a] -> Set a
S.fromList
    forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> String
Cabal.unUnqualComponentName forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignLib -> UnqualComponentName
foreignLibName)
    forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (BuildInfo -> Bool
buildable forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignLib -> BuildInfo
foreignLibBuildInfo)
    forall a b. (a -> b) -> a -> b
$ PackageDescription -> [ForeignLib]
foreignLibs PackageDescription
pkg

  toInternalPackageMungedName :: Text -> Text
toInternalPackageMungedName
    = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
prettyShow forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> LibraryName -> MungedPackageName
MungedPackageName (PackageIdentifier -> PackageName
pkgName PackageIdentifier
pkgId)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe UnqualComponentName -> LibraryName
maybeToLibraryName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UnqualComponentName
Cabal.mkUnqualComponentName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

  -- Gets all of the modules, files, build files, and data files that constitute

  -- the package. This is primarily used for dirtiness checking during build, as

  -- well as use by "stack ghci"

  pkgFiles :: GetPackageFiles
pkgFiles = (forall env.
 HasEnvConfig env =>
 Path Abs File
 -> RIO
      env
      (Map NamedComponent (Map ModuleName (Path Abs File)),
       Map NamedComponent [DotCabalPath], Set (Path Abs File),
       [PackageWarning]))
-> GetPackageFiles
GetPackageFiles forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *).
(HasEnvConfig s, MonadReader s m, MonadThrow m, MonadUnliftIO m) =>
PackageDescription
-> Path Abs File
-> m (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], Set (Path Abs File),
      [PackageWarning])
getPackageFile PackageDescription
pkg
  pkgId :: PackageIdentifier
pkgId = PackageDescription -> PackageIdentifier
package PackageDescription
pkg
  name :: PackageName
name = PackageIdentifier -> PackageName
pkgName PackageIdentifier
pkgId

  (Set ExeName
unknownTools, Map PackageName DepValue
knownTools) = PackageDescription -> (Set ExeName, Map PackageName DepValue)
packageDescTools PackageDescription
pkg

  deps :: Map PackageName DepValue
deps = forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> Bool
isMe) (forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith forall a. Semigroup a => a -> a -> a
(<>)
    [ VersionRange -> DepValue
asLibrary forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageConfig -> PackageDescription -> Map PackageName VersionRange
packageDependencies PackageConfig
packageConfig PackageDescription
pkg
    -- We include all custom-setup deps - if present - in the package deps

    -- themselves. Stack always works with the invariant that there will be a

    -- single installed package relating to a package name, and this applies at

    -- the setup dependency level as well.

    , VersionRange -> DepValue
asLibrary forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> Maybe a -> a
fromMaybe forall k a. Map k a
M.empty Maybe (Map PackageName VersionRange)
msetupDeps
    , Map PackageName DepValue
knownTools
    ])

  msetupDeps :: Maybe (Map PackageName VersionRange)
msetupDeps = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Dependency -> PackageName
depPkgName forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Dependency -> VersionRange
depVerRange) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SetupBuildInfo -> [Dependency]
setupDepends)
    (PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo PackageDescription
pkg)

  subLibDeps :: Map MungedPackageName DepValue
subLibDeps = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
    (\(Dependency PackageName
n VersionRange
vr NonEmptySet LibraryName
libs) -> forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (PackageName
-> VersionRange
-> LibraryName
-> Maybe (MungedPackageName, DepValue)
getSubLibName PackageName
n VersionRange
vr) (forall a. NonEmptySet a -> [a]
NES.toList NonEmptySet LibraryName
libs))
    (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [Dependency]
targetBuildDepends (PackageDescription -> [BuildInfo]
allBuildInfo' PackageDescription
pkg))

  getSubLibName :: PackageName
-> VersionRange
-> LibraryName
-> Maybe (MungedPackageName, DepValue)
getSubLibName PackageName
pn VersionRange
vr lib :: LibraryName
lib@(LSubLibName UnqualComponentName
_) =
    forall a. a -> Maybe a
Just (PackageName -> LibraryName -> MungedPackageName
MungedPackageName PackageName
pn LibraryName
lib, VersionRange -> DepValue
asLibrary VersionRange
vr)
  getSubLibName PackageName
_ VersionRange
_ LibraryName
_ = forall a. Maybe a
Nothing

  asLibrary :: VersionRange -> DepValue
asLibrary VersionRange
range = DepValue
    { dvVersionRange :: VersionRange
dvVersionRange = VersionRange
range
    , dvType :: DepType
dvType = DepType
AsLibrary
    }

  -- Is the package dependency mentioned here me: either the package name

  -- itself, or the name of one of the sub libraries

  isMe :: PackageName -> Bool
isMe PackageName
name' =  PackageName
name' forall a. Eq a => a -> a -> Bool
== PackageName
name
             Bool -> Bool -> Bool
|| forall a. IsString a => String -> a
fromString (PackageName -> String
packageNameString PackageName
name') forall a. Ord a => a -> Set a -> Bool
`S.member` Set Text
extraLibNames

-- | Generate GHC options for the package's components, and a list of options

-- which apply generally to the package, not one specific component.

generatePkgDescOpts ::
     (HasEnvConfig env, MonadThrow m, MonadReader env m, MonadIO m)
  => InstallMap
  -> InstalledMap
  -> [PackageName]
     -- ^ Packages to omit from the "-package" / "-package-id" flags

  -> [PackageName]
     -- ^ Packages to add to the "-package" flags

  -> Path Abs File
  -> PackageDescription
  -> Map NamedComponent [DotCabalPath]
  -> m (Map NamedComponent BuildInfoOpts)
generatePkgDescOpts :: forall env (m :: * -> *).
(HasEnvConfig env, MonadThrow m, MonadReader env m, MonadIO m) =>
InstallMap
-> InstalledMap
-> [PackageName]
-> [PackageName]
-> Path Abs File
-> PackageDescription
-> Map NamedComponent [DotCabalPath]
-> m (Map NamedComponent BuildInfoOpts)
generatePkgDescOpts InstallMap
installMap InstalledMap
installedMap [PackageName]
omitPkgs [PackageName]
addPkgs Path Abs File
cabalfp PackageDescription
pkg Map NamedComponent [DotCabalPath]
componentPaths = do
  Config
config <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env Config
configL
  Version
cabalVer <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasCompiler env => SimpleGetter env Version
cabalVersionL
  Path Abs Dir
distDir <- forall (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
Path Abs Dir -> m (Path Abs Dir)
distDirFromDir Path Abs Dir
cabalDir
  let generate :: NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts)
generate NamedComponent
namedComponent BuildInfo
binfo =
        ( NamedComponent
namedComponent
        , BioInput -> BuildInfoOpts
generateBuildInfoOpts BioInput
            { biInstallMap :: InstallMap
biInstallMap = InstallMap
installMap
            , biInstalledMap :: InstalledMap
biInstalledMap = InstalledMap
installedMap
            , biCabalDir :: Path Abs Dir
biCabalDir = Path Abs Dir
cabalDir
            , biDistDir :: Path Abs Dir
biDistDir = Path Abs Dir
distDir
            , biOmitPackages :: [PackageName]
biOmitPackages = [PackageName]
omitPkgs
            , biAddPackages :: [PackageName]
biAddPackages = [PackageName]
addPkgs
            , biBuildInfo :: BuildInfo
biBuildInfo = BuildInfo
binfo
            , biDotCabalPaths :: [DotCabalPath]
biDotCabalPaths =
                forall a. a -> Maybe a -> a
fromMaybe [] (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup NamedComponent
namedComponent Map NamedComponent [DotCabalPath]
componentPaths)
            , biConfigLibDirs :: [String]
biConfigLibDirs = Config -> [String]
configExtraLibDirs Config
config
            , biConfigIncludeDirs :: [String]
biConfigIncludeDirs = Config -> [String]
configExtraIncludeDirs Config
config
            , biComponentName :: NamedComponent
biComponentName = NamedComponent
namedComponent
            , biCabalVersion :: Version
biCabalVersion = Version
cabalVer
            }
        )
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
        ( forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                []
                (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts)
generate NamedComponent
CLib forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> BuildInfo
libBuildInfo)
                (PackageDescription -> Maybe Library
library PackageDescription
pkg)
            , forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
                (\Library
sublib -> do
                  let maybeLib :: Maybe NamedComponent
maybeLib =
                        Text -> NamedComponent
CInternalLib forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> String
Cabal.unUnqualComponentName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                          (LibraryName -> Maybe UnqualComponentName
libraryNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> LibraryName
libName) Library
sublib
                  forall a b c. (a -> b -> c) -> b -> a -> c
flip NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts)
generate  (Library -> BuildInfo
libBuildInfo Library
sublib) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe NamedComponent
maybeLib
                 )
                (PackageDescription -> [Library]
subLibraries PackageDescription
pkg)
            , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                (\Executable
exe ->
                  NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts)
generate
                    (Text -> NamedComponent
CExe (String -> Text
T.pack (UnqualComponentName -> String
Cabal.unUnqualComponentName (Executable -> UnqualComponentName
exeName Executable
exe))))
                    (Executable -> BuildInfo
buildInfo Executable
exe)
                )
                (PackageDescription -> [Executable]
executables PackageDescription
pkg)
            , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                (\Benchmark
bench ->
                  NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts)
generate
                    (Text -> NamedComponent
CBench
                      (String -> Text
T.pack (UnqualComponentName -> String
Cabal.unUnqualComponentName (Benchmark -> UnqualComponentName
benchmarkName Benchmark
bench)))
                    )
                    (Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
bench)
                )
                (PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg)
            , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                (\TestSuite
test ->
                  NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts)
generate
                    (Text -> NamedComponent
CTest (String -> Text
T.pack (UnqualComponentName -> String
Cabal.unUnqualComponentName (TestSuite -> UnqualComponentName
testName TestSuite
test))))
                    (TestSuite -> BuildInfo
testBuildInfo TestSuite
test)
                )
                (PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg)
            ]
        )
    )
 where
  cabalDir :: Path Abs Dir
cabalDir = forall b t. Path b t -> Path b Dir
parent Path Abs File
cabalfp

-- | Input to 'generateBuildInfoOpts'

data BioInput = BioInput
  { BioInput -> InstallMap
biInstallMap :: !InstallMap
  , BioInput -> InstalledMap
biInstalledMap :: !InstalledMap
  , BioInput -> Path Abs Dir
biCabalDir :: !(Path Abs Dir)
  , BioInput -> Path Abs Dir
biDistDir :: !(Path Abs Dir)
  , BioInput -> [PackageName]
biOmitPackages :: ![PackageName]
  , BioInput -> [PackageName]
biAddPackages :: ![PackageName]
  , BioInput -> BuildInfo
biBuildInfo :: !BuildInfo
  , BioInput -> [DotCabalPath]
biDotCabalPaths :: ![DotCabalPath]
  , BioInput -> [String]
biConfigLibDirs :: ![FilePath]
  , BioInput -> [String]
biConfigIncludeDirs :: ![FilePath]
  , BioInput -> NamedComponent
biComponentName :: !NamedComponent
  , BioInput -> Version
biCabalVersion :: !Version
  }

-- | Generate GHC options for the target. Since Cabal also figures out these

-- options, currently this is only used for invoking GHCI (via stack ghci).

generateBuildInfoOpts :: BioInput -> BuildInfoOpts
generateBuildInfoOpts :: BioInput -> BuildInfoOpts
generateBuildInfoOpts BioInput {[String]
[PackageName]
[DotCabalPath]
BuildInfo
InstallMap
InstalledMap
Version
Path Abs Dir
NamedComponent
biCabalVersion :: Version
biComponentName :: NamedComponent
biConfigIncludeDirs :: [String]
biConfigLibDirs :: [String]
biDotCabalPaths :: [DotCabalPath]
biBuildInfo :: BuildInfo
biAddPackages :: [PackageName]
biOmitPackages :: [PackageName]
biDistDir :: Path Abs Dir
biCabalDir :: Path Abs Dir
biInstalledMap :: InstalledMap
biInstallMap :: InstallMap
biCabalVersion :: BioInput -> Version
biComponentName :: BioInput -> NamedComponent
biConfigIncludeDirs :: BioInput -> [String]
biConfigLibDirs :: BioInput -> [String]
biDotCabalPaths :: BioInput -> [DotCabalPath]
biBuildInfo :: BioInput -> BuildInfo
biAddPackages :: BioInput -> [PackageName]
biOmitPackages :: BioInput -> [PackageName]
biDistDir :: BioInput -> Path Abs Dir
biCabalDir :: BioInput -> Path Abs Dir
biInstalledMap :: BioInput -> InstalledMap
biInstallMap :: BioInput -> InstallMap
..} =
  BuildInfoOpts
    { bioOpts :: [String]
bioOpts = [String]
ghcOpts forall a. [a] -> [a] -> [a]
++ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
"-optP" <>) (BuildInfo -> [String]
cppOptions BuildInfo
biBuildInfo)
    -- NOTE for future changes: Due to this use of nubOrd (and other uses

    -- downstream), these generated options must not rely on multiple

    -- argument sequences.  For example, ["--main-is", "Foo.hs", "--main-

    -- is", "Bar.hs"] would potentially break due to the duplicate

    -- "--main-is" being removed.

    --

    -- See https://github.com/commercialhaskell/stack/issues/1255

    , bioOneWordOpts :: [String]
bioOneWordOpts = forall a. Ord a => [a] -> [a]
nubOrd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [[String]
extOpts, [String]
srcOpts, [String]
includeOpts, [String]
libOpts, [String]
fworks, [String]
cObjectFiles]
    , bioPackageFlags :: [String]
bioPackageFlags = [String]
deps
    , bioCabalMacros :: Path Abs File
bioCabalMacros = Path Abs Dir
componentAutogen forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFileCabalMacrosH
    }
 where
  cObjectFiles :: [String]
cObjectFiles =
    forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b t. Path b t -> String
toFilePath forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              forall (m :: * -> *).
MonadThrow m =>
Path Abs Dir
-> NamedComponent
-> Path Abs Dir
-> Path Abs File
-> m (Path Abs File)
makeObjectFilePathFromC Path Abs Dir
biCabalDir NamedComponent
biComponentName Path Abs Dir
biDistDir)
             [Path Abs File]
cfiles
  cfiles :: [Path Abs File]
cfiles = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DotCabalPath -> Maybe (Path Abs File)
dotCabalCFilePath [DotCabalPath]
biDotCabalPaths
  installVersion :: (a, b) -> b
installVersion = forall a b. (a, b) -> b
snd
  -- Generates: -package=base -package=base16-bytestring-0.1.1.6 ...

  deps :: [String]
deps =
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PackageName
name InstalledMap
biInstalledMap of
          Just (InstallLocation
_, Stack.Types.Package.Library PackageIdentifier
_ident GhcPkgId
ipid Maybe (Either License License)
_) ->
            [String
"-package-id=" forall a. Semigroup a => a -> a -> a
<> GhcPkgId -> String
ghcPkgIdString GhcPkgId
ipid]
          Maybe (InstallLocation, Installed)
_ -> [String
"-package=" forall a. Semigroup a => a -> a -> a
<> PackageName -> String
packageNameString PackageName
name forall a. Semigroup a => a -> a -> a
<>
            forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" -- This empty case applies to e.g. base.

              (((String
"-" <>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> String
versionString) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
installVersion)
              (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PackageName
name InstallMap
biInstallMap)]
      | PackageName
name <- [PackageName]
pkgs
      ]
  pkgs :: [PackageName]
pkgs =
    [PackageName]
biAddPackages forall a. [a] -> [a] -> [a]
++
    [ PackageName
name
    | Dependency PackageName
name VersionRange
_ NonEmptySet LibraryName
_ <- BuildInfo -> [Dependency]
targetBuildDepends BuildInfo
biBuildInfo
      -- TODO: cabal 3 introduced multiple public libraries in a single dependency

    , PackageName
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [PackageName]
biOmitPackages
    ]
  PerCompilerFlavor [String]
ghcOpts [String]
_ = BuildInfo -> PerCompilerFlavor [String]
options BuildInfo
biBuildInfo
  extOpts :: [String]
extOpts =
       forall a b. (a -> b) -> [a] -> [b]
map ((String
"-X" ++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
display) (BuildInfo -> [Language]
allLanguages BuildInfo
biBuildInfo)
    forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map ((String
"-X" ++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
display) (BuildInfo -> [Extension]
usedExtensions BuildInfo
biBuildInfo)
  srcOpts :: [String]
srcOpts =
    forall a b. (a -> b) -> [a] -> [b]
map ((String
"-i" <>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall loc. Path loc Dir -> String
toFilePathNoTrailingSep)
      (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [ Version -> NamedComponent -> Path Abs Dir -> Path Abs Dir
componentBuildDir Version
biCabalVersion NamedComponent
biComponentName Path Abs Dir
biDistDir ]
        , [ Path Abs Dir
biCabalDir
          | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
biBuildInfo)
          ]
        , forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String -> Maybe (Path Abs Dir)
toIncludeDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall from to. SymbolicPath from to -> String
getSymbolicPath) (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
biBuildInfo)
        , [ Path Abs Dir
componentAutogen ]
        , forall a. Maybe a -> [a]
maybeToList (Version -> Path Abs Dir -> Maybe (Path Abs Dir)
packageAutogenDir Version
biCabalVersion Path Abs Dir
biDistDir)
        , [ NamedComponent -> Path Abs Dir -> Path Abs Dir
componentOutputDir NamedComponent
biComponentName Path Abs Dir
biDistDir ]
        ]) forall a. [a] -> [a] -> [a]
++
    [ String
"-stubdir=" forall a. [a] -> [a] -> [a]
++ forall loc. Path loc Dir -> String
toFilePathNoTrailingSep (Path Abs Dir -> Path Abs Dir
buildDir Path Abs Dir
biDistDir) ]
  componentAutogen :: Path Abs Dir
componentAutogen = Version -> NamedComponent -> Path Abs Dir -> Path Abs Dir
componentAutogenDir Version
biCabalVersion NamedComponent
biComponentName Path Abs Dir
biDistDir
  toIncludeDir :: String -> Maybe (Path Abs Dir)
toIncludeDir String
"." = forall a. a -> Maybe a
Just Path Abs Dir
biCabalDir
  toIncludeDir String
relDir = forall (m :: * -> *).
MonadThrow m =>
Path Abs Dir -> String -> m (Path Abs Dir)
concatAndCollapseAbsDir Path Abs Dir
biCabalDir String
relDir
  includeOpts :: [String]
includeOpts =
    forall a b. (a -> b) -> [a] -> [b]
map (String
"-I" <>) ([String]
biConfigIncludeDirs forall a. Semigroup a => a -> a -> a
<> [String]
pkgIncludeOpts)
  pkgIncludeOpts :: [String]
pkgIncludeOpts =
    [ forall loc. Path loc Dir -> String
toFilePathNoTrailingSep Path Abs Dir
absDir
    | String
dir <- BuildInfo -> [String]
includeDirs BuildInfo
biBuildInfo
    , Path Abs Dir
absDir <- String -> [Path Abs Dir]
handleDir String
dir
    ]
  libOpts :: [String]
libOpts =
    forall a b. (a -> b) -> [a] -> [b]
map (String
"-l" <>) (BuildInfo -> [String]
extraLibs BuildInfo
biBuildInfo) forall a. Semigroup a => a -> a -> a
<>
    forall a b. (a -> b) -> [a] -> [b]
map (String
"-L" <>) ([String]
biConfigLibDirs forall a. Semigroup a => a -> a -> a
<> [String]
pkgLibDirs)
  pkgLibDirs :: [String]
pkgLibDirs =
    [ forall loc. Path loc Dir -> String
toFilePathNoTrailingSep Path Abs Dir
absDir
    | String
dir <- BuildInfo -> [String]
extraLibDirs BuildInfo
biBuildInfo
    , Path Abs Dir
absDir <- String -> [Path Abs Dir]
handleDir String
dir
    ]
  handleDir :: String -> [Path Abs Dir]
handleDir String
dir = case (forall (m :: * -> *). MonadThrow m => String -> m (Path Abs Dir)
parseAbsDir String
dir, forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir String
dir) of
    (Just Path Abs Dir
ab, Maybe (Path Rel Dir)
_       ) -> [Path Abs Dir
ab]
    (Maybe (Path Abs Dir)
_      , Just Path Rel Dir
rel) -> [Path Abs Dir
biCabalDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
rel]
    (Maybe (Path Abs Dir)
Nothing, Maybe (Path Rel Dir)
Nothing ) -> []
  fworks :: [String]
fworks = forall a b. (a -> b) -> [a] -> [b]
map (String
"-framework=" <>) (BuildInfo -> [String]
frameworks BuildInfo
biBuildInfo)

-- | Make the .o path from the .c file path for a component. Example:

--

-- @

-- executable FOO

--   c-sources:        cbits/text_search.c

-- @

--

-- Produces

--

-- <dist-dir>/build/FOO/FOO-tmp/cbits/text_search.o

--

-- Example:

--

-- λ> makeObjectFilePathFromC

--     $(mkAbsDir "/Users/chris/Repos/hoogle")

--     CLib

--     $(mkAbsDir "/Users/chris/Repos/hoogle/.stack-work/Cabal-x.x.x/dist")

--     $(mkAbsFile "/Users/chris/Repos/hoogle/cbits/text_search.c")

-- Just "/Users/chris/Repos/hoogle/.stack-work/Cabal-x.x.x/dist/build/cbits/text_search.o"

-- λ> makeObjectFilePathFromC

--     $(mkAbsDir "/Users/chris/Repos/hoogle")

--     (CExe "hoogle")

--     $(mkAbsDir "/Users/chris/Repos/hoogle/.stack-work/Cabal-x.x.x/dist")

--     $(mkAbsFile "/Users/chris/Repos/hoogle/cbits/text_search.c")

-- Just "/Users/chris/Repos/hoogle/.stack-work/Cabal-x.x.x/dist/build/hoogle/hoogle-tmp/cbits/text_search.o"

-- λ>

makeObjectFilePathFromC ::
     MonadThrow m
  => Path Abs Dir      -- ^ The cabal directory.

  -> NamedComponent    -- ^ The name of the component.

  -> Path Abs Dir      -- ^ Dist directory.

  -> Path Abs File     -- ^ The path to the .c file.

  -> m (Path Abs File) -- ^ The path to the .o file for the component.

makeObjectFilePathFromC :: forall (m :: * -> *).
MonadThrow m =>
Path Abs Dir
-> NamedComponent
-> Path Abs Dir
-> Path Abs File
-> m (Path Abs File)
makeObjectFilePathFromC Path Abs Dir
cabalDir NamedComponent
namedComponent Path Abs Dir
distDir Path Abs File
cFilePath = do
  Path Rel File
relCFilePath <- forall (m :: * -> *) b t.
MonadThrow m =>
Path b Dir -> Path b t -> m (Path Rel t)
stripProperPrefix Path Abs Dir
cabalDir Path Abs File
cFilePath
  Path Rel File
relOFilePath <-
    forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile (String -> String -> String
replaceExtension (forall b t. Path b t -> String
toFilePath Path Rel File
relCFilePath) String
"o")
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedComponent -> Path Abs Dir -> Path Abs Dir
componentOutputDir NamedComponent
namedComponent Path Abs Dir
distDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relOFilePath)

-- | Get all dependencies of the package (buildable targets only).

--

-- Note that for Cabal versions 1.22 and earlier, there is a bug where Cabal

-- requires dependencies for non-buildable components to be present. We're going

-- to use GHC version as a proxy for Cabal library version in this case for

-- simplicity, so we'll check for GHC being 7.10 or earlier. This obviously

-- makes our function a lot more fun to write...

packageDependencies ::
     PackageConfig
  -> PackageDescription
  -> Map PackageName VersionRange
packageDependencies :: PackageConfig -> PackageDescription -> Map PackageName VersionRange
packageDependencies PackageConfig
pkgConfig PackageDescription
pkg' =
  forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith VersionRange -> VersionRange -> VersionRange
intersectVersionRanges forall a b. (a -> b) -> a -> b
$
  forall a b. (a -> b) -> [a] -> [b]
map (Dependency -> PackageName
depPkgName forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Dependency -> VersionRange
depVerRange) forall a b. (a -> b) -> a -> b
$
  forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [Dependency]
targetBuildDepends (PackageDescription -> [BuildInfo]
allBuildInfo' PackageDescription
pkg) forall a. [a] -> [a] -> [a]
++
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] SetupBuildInfo -> [Dependency]
setupDepends (PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo PackageDescription
pkg)
 where
  pkg :: PackageDescription
pkg
    | ActualCompiler -> Version
getGhcVersion (PackageConfig -> ActualCompiler
packageConfigCompilerVersion PackageConfig
pkgConfig) forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
8, Int
0] = PackageDescription
pkg'
    -- Set all components to buildable. Only need to worry  library, exe, test,

    -- and bench, since others didn't exist in older Cabal versions

    | Bool
otherwise = PackageDescription
pkg'
      { library :: Maybe Library
library =
          (\Library
c -> Library
c { libBuildInfo :: BuildInfo
libBuildInfo = BuildInfo -> BuildInfo
go (Library -> BuildInfo
libBuildInfo Library
c) }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> Maybe Library
library PackageDescription
pkg'
      , executables :: [Executable]
executables =
          (\Executable
c -> Executable
c { buildInfo :: BuildInfo
buildInfo = BuildInfo -> BuildInfo
go (Executable -> BuildInfo
buildInfo Executable
c) }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [Executable]
executables PackageDescription
pkg'
      , testSuites :: [TestSuite]
testSuites =
          if PackageConfig -> Bool
packageConfigEnableTests PackageConfig
pkgConfig
            then (\TestSuite
c -> TestSuite
c { testBuildInfo :: BuildInfo
testBuildInfo = BuildInfo -> BuildInfo
go (TestSuite -> BuildInfo
testBuildInfo TestSuite
c) }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                   PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg'
            else PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg'
      , benchmarks :: [Benchmark]
benchmarks =
          if PackageConfig -> Bool
packageConfigEnableBenchmarks PackageConfig
pkgConfig
            then (\Benchmark
c -> Benchmark
c { benchmarkBuildInfo :: BuildInfo
benchmarkBuildInfo = BuildInfo -> BuildInfo
go (Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
c) }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                   PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg'
            else PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg'
      }

  go :: BuildInfo -> BuildInfo
go BuildInfo
bi = BuildInfo
bi { buildable :: Bool
buildable = Bool
True }

-- | Get all dependencies of the package (buildable targets only).

--

-- This uses both the new 'buildToolDepends' and old 'buildTools' information.

packageDescTools ::
     PackageDescription
  -> (Set ExeName, Map PackageName DepValue)
packageDescTools :: PackageDescription -> (Set ExeName, Map PackageName DepValue)
packageDescTools PackageDescription
pd =
  (forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ExeName]]
unknowns, forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith forall a. Semigroup a => a -> a -> a
(<>) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(PackageName, DepValue)]]
knowns)
 where
  ([[ExeName]]
unknowns, [[(PackageName, DepValue)]]
knowns) = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map BuildInfo -> ([ExeName], [(PackageName, DepValue)])
perBI forall a b. (a -> b) -> a -> b
$ PackageDescription -> [BuildInfo]
allBuildInfo' PackageDescription
pd

  perBI :: BuildInfo -> ([ExeName], [(PackageName, DepValue)])
  perBI :: BuildInfo -> ([ExeName], [(PackageName, DepValue)])
perBI BuildInfo
bi =
    ([ExeName]
unknownTools, [(PackageName, DepValue)]
tools)
   where
    ([ExeName]
unknownTools, [ExeDependency]
knownTools) = forall a b. [Either a b] -> ([a], [b])
partitionEithers forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map LegacyExeDependency -> Either ExeName ExeDependency
go1 (BuildInfo -> [LegacyExeDependency]
buildTools BuildInfo
bi)

    tools :: [(PackageName, DepValue)]
tools = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ExeDependency -> Maybe (PackageName, DepValue)
go2 ([ExeDependency]
knownTools forall a. [a] -> [a] -> [a]
++ BuildInfo -> [ExeDependency]
buildToolDepends BuildInfo
bi)

    -- This is similar to desugarBuildTool from Cabal, however it

    -- uses our own hard-coded map which drops tools shipped with

    -- GHC (like hsc2hs), and includes some tools from Stackage.

    go1 :: Cabal.LegacyExeDependency -> Either ExeName Cabal.ExeDependency
    go1 :: LegacyExeDependency -> Either ExeName ExeDependency
go1 (Cabal.LegacyExeDependency String
name VersionRange
range) =
      case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
name Map String PackageName
hardCodedMap of
        Just PackageName
pkgName ->
          forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
            PackageName -> UnqualComponentName -> VersionRange -> ExeDependency
Cabal.ExeDependency PackageName
pkgName (String -> UnqualComponentName
Cabal.mkUnqualComponentName String
name) VersionRange
range
        Maybe PackageName
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> ExeName
ExeName forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
name

    go2 :: Cabal.ExeDependency -> Maybe (PackageName, DepValue)
    go2 :: ExeDependency -> Maybe (PackageName, DepValue)
go2 (Cabal.ExeDependency PackageName
pkg UnqualComponentName
_name VersionRange
range)
      | PackageName
pkg forall a. Ord a => a -> Set a -> Bool
`S.member` Set PackageName
preInstalledPackages = forall a. Maybe a
Nothing
      | Bool
otherwise = forall a. a -> Maybe a
Just
          ( PackageName
pkg
          , DepValue
              { dvVersionRange :: VersionRange
dvVersionRange = VersionRange
range
              , dvType :: DepType
dvType = DepType
AsBuildTool
              }
          )

-- | A hard-coded map for tool dependencies

hardCodedMap :: Map String PackageName
hardCodedMap :: Map String PackageName
hardCodedMap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (String
"alex", String -> PackageName
Distribution.Package.mkPackageName String
"alex")
  , (String
"happy", String -> PackageName
Distribution.Package.mkPackageName String
"happy")
  , (String
"cpphs", String -> PackageName
Distribution.Package.mkPackageName String
"cpphs")
  , (String
"greencard", String -> PackageName
Distribution.Package.mkPackageName String
"greencard")
  , (String
"c2hs", String -> PackageName
Distribution.Package.mkPackageName String
"c2hs")
  , (String
"hscolour", String -> PackageName
Distribution.Package.mkPackageName String
"hscolour")
  , (String
"hspec-discover", String -> PackageName
Distribution.Package.mkPackageName String
"hspec-discover")
  , (String
"hsx2hs", String -> PackageName
Distribution.Package.mkPackageName String
"hsx2hs")
  , (String
"gtk2hsC2hs", String -> PackageName
Distribution.Package.mkPackageName String
"gtk2hs-buildtools")
  , (String
"gtk2hsHookGenerator", String -> PackageName
Distribution.Package.mkPackageName String
"gtk2hs-buildtools")
  , (String
"gtk2hsTypeGen", String -> PackageName
Distribution.Package.mkPackageName String
"gtk2hs-buildtools")
  ]

-- | Executable-only packages which come pre-installed with GHC and do not need

-- to be built. Without this exception, we would either end up unnecessarily

-- rebuilding these packages, or failing because the packages do not appear in

-- the Stackage snapshot.

preInstalledPackages :: Set PackageName
preInstalledPackages :: Set PackageName
preInstalledPackages = forall a. Ord a => [a] -> Set a
S.fromList
  [ String -> PackageName
mkPackageName String
"hsc2hs"
  , String -> PackageName
mkPackageName String
"haddock"
  ]

-- | Variant of 'allBuildInfo' from Cabal that, like versions before Cabal 2.2

-- only includes buildable components.

allBuildInfo' :: PackageDescription -> [BuildInfo]
allBuildInfo' :: PackageDescription -> [BuildInfo]
allBuildInfo' PackageDescription
pkg_descr = [ BuildInfo
bi | Library
lib <- PackageDescription -> [Library]
allLibraries PackageDescription
pkg_descr
                               , let bi :: BuildInfo
bi = Library -> BuildInfo
libBuildInfo Library
lib
                               , BuildInfo -> Bool
buildable BuildInfo
bi ]
                       forall a. [a] -> [a] -> [a]
++ [ BuildInfo
bi | ForeignLib
flib <- PackageDescription -> [ForeignLib]
foreignLibs PackageDescription
pkg_descr
                               , let bi :: BuildInfo
bi = ForeignLib -> BuildInfo
foreignLibBuildInfo ForeignLib
flib
                               , BuildInfo -> Bool
buildable BuildInfo
bi ]
                       forall a. [a] -> [a] -> [a]
++ [ BuildInfo
bi | Executable
exe <- PackageDescription -> [Executable]
executables PackageDescription
pkg_descr
                               , let bi :: BuildInfo
bi = Executable -> BuildInfo
buildInfo Executable
exe
                               , BuildInfo -> Bool
buildable BuildInfo
bi ]
                       forall a. [a] -> [a] -> [a]
++ [ BuildInfo
bi | TestSuite
tst <- PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg_descr
                               , let bi :: BuildInfo
bi = TestSuite -> BuildInfo
testBuildInfo TestSuite
tst
                               , BuildInfo -> Bool
buildable BuildInfo
bi ]
                       forall a. [a] -> [a] -> [a]
++ [ BuildInfo
bi | Benchmark
tst <- PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg_descr
                               , let bi :: BuildInfo
bi = Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
tst
                               , BuildInfo -> Bool
buildable BuildInfo
bi ]

-- | A pair of package descriptions: one which modified the buildable values of

-- test suites and benchmarks depending on whether they are enabled, and one

-- which does not.

--

-- Fields are intentionally lazy, we may only need one or the other value.

--

-- Michael S Snoyman 2017-08-29: The very presence of this data type is terribly

-- ugly, it represents the fact that the Cabal 2.0 upgrade did _not_ go well.

-- Specifically, we used to have a field to indicate whether a component was

-- enabled in addition to buildable, but that's gone now, and this is an ugly

-- proxy. We should at some point clean up the mess of Package, LocalPackage,

-- etc, and probably pull in the definition of PackageDescription from Cabal

-- with our additionally needed metadata. But this is a good enough hack for the

-- moment. Odds are, you're reading this in the year 2024 and thinking "wtf?"

data PackageDescriptionPair = PackageDescriptionPair
  { PackageDescriptionPair -> PackageDescription
pdpOrigBuildable :: PackageDescription
  , PackageDescriptionPair -> PackageDescription
pdpModifiedBuildable :: PackageDescription
  }

-- | Evaluates the conditions of a 'GenericPackageDescription', yielding

-- a resolved 'PackageDescription'.

resolvePackageDescription ::
     PackageConfig
  -> GenericPackageDescription
  -> PackageDescriptionPair
resolvePackageDescription :: PackageConfig
-> GenericPackageDescription -> PackageDescriptionPair
resolvePackageDescription
  PackageConfig
packageConfig
  ( GenericPackageDescription
      PackageDescription
desc Maybe Version
_ [PackageFlag]
defaultFlags Maybe (CondTree ConfVar [Dependency] Library)
mlib [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
subLibs [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
foreignLibs' [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
exes [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
tests [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
benches
  )
  =
  PackageDescriptionPair
    { pdpOrigBuildable :: PackageDescription
pdpOrigBuildable = Bool -> PackageDescription
go Bool
False
    , pdpModifiedBuildable :: PackageDescription
pdpModifiedBuildable = Bool -> PackageDescription
go Bool
True
    }
 where
  go :: Bool -> PackageDescription
go Bool
modBuildable = PackageDescription
desc
    { library :: Maybe Library
library = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall target cs.
(Semigroup target, Monoid target, Show target) =>
ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
resolveConditions ResolveConditions
rc Library -> [Dependency] -> Library
updateLibDeps) Maybe (CondTree ConfVar [Dependency] Library)
mlib
    , subLibraries :: [Library]
subLibraries = forall a b. (a -> b) -> [a] -> [b]
map
        (\(UnqualComponentName
n, CondTree ConfVar [Dependency] Library
v) -> (forall target cs.
(Semigroup target, Monoid target, Show target) =>
ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
resolveConditions ResolveConditions
rc Library -> [Dependency] -> Library
updateLibDeps CondTree ConfVar [Dependency] Library
v){libName :: LibraryName
libName=UnqualComponentName -> LibraryName
LSubLibName UnqualComponentName
n})
        [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
subLibs
    , foreignLibs :: [ForeignLib]
foreignLibs = forall a b. (a -> b) -> [a] -> [b]
map
        (\(UnqualComponentName
n, CondTree ConfVar [Dependency] ForeignLib
v) -> (forall target cs.
(Semigroup target, Monoid target, Show target) =>
ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
resolveConditions ResolveConditions
rc ForeignLib -> [Dependency] -> ForeignLib
updateForeignLibDeps CondTree ConfVar [Dependency] ForeignLib
v){foreignLibName :: UnqualComponentName
foreignLibName=UnqualComponentName
n})
        [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
foreignLibs'
    , executables :: [Executable]
executables = forall a b. (a -> b) -> [a] -> [b]
map
        (\(UnqualComponentName
n, CondTree ConfVar [Dependency] Executable
v) -> (forall target cs.
(Semigroup target, Monoid target, Show target) =>
ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
resolveConditions ResolveConditions
rc Executable -> [Dependency] -> Executable
updateExeDeps CondTree ConfVar [Dependency] Executable
v){exeName :: UnqualComponentName
exeName=UnqualComponentName
n})
        [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
exes
    , testSuites :: [TestSuite]
testSuites = forall a b. (a -> b) -> [a] -> [b]
map
        (\(UnqualComponentName
n, CondTree ConfVar [Dependency] TestSuite
v) -> (forall target cs.
(Semigroup target, Monoid target, Show target) =>
ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
resolveConditions ResolveConditions
rc (Bool -> TestSuite -> [Dependency] -> TestSuite
updateTestDeps Bool
modBuildable) CondTree ConfVar [Dependency] TestSuite
v){testName :: UnqualComponentName
testName=UnqualComponentName
n})
        [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
tests
    , benchmarks :: [Benchmark]
benchmarks = forall a b. (a -> b) -> [a] -> [b]
map
        (\(UnqualComponentName
n, CondTree ConfVar [Dependency] Benchmark
v) -> (forall target cs.
(Semigroup target, Monoid target, Show target) =>
ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
resolveConditions ResolveConditions
rc (Bool -> Benchmark -> [Dependency] -> Benchmark
updateBenchmarkDeps Bool
modBuildable) CondTree ConfVar [Dependency] Benchmark
v){benchmarkName :: UnqualComponentName
benchmarkName=UnqualComponentName
n})
        [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
benches
    }

  flags :: Map FlagName Bool
flags = forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union (PackageConfig -> Map FlagName Bool
packageConfigFlags PackageConfig
packageConfig) ([PackageFlag] -> Map FlagName Bool
flagMap [PackageFlag]
defaultFlags)

  rc :: ResolveConditions
rc = ActualCompiler
-> Platform -> Map FlagName Bool -> ResolveConditions
mkResolveConditions
         (PackageConfig -> ActualCompiler
packageConfigCompilerVersion PackageConfig
packageConfig)
         (PackageConfig -> Platform
packageConfigPlatform PackageConfig
packageConfig)
         Map FlagName Bool
flags

  updateLibDeps :: Library -> [Dependency] -> Library
updateLibDeps Library
lib [Dependency]
deps = Library
lib
    { libBuildInfo :: BuildInfo
libBuildInfo = (Library -> BuildInfo
libBuildInfo Library
lib) {targetBuildDepends :: [Dependency]
targetBuildDepends = [Dependency]
deps} }
  updateForeignLibDeps :: ForeignLib -> [Dependency] -> ForeignLib
updateForeignLibDeps ForeignLib
lib [Dependency]
deps = ForeignLib
lib
    { foreignLibBuildInfo :: BuildInfo
foreignLibBuildInfo =
        (ForeignLib -> BuildInfo
foreignLibBuildInfo ForeignLib
lib) {targetBuildDepends :: [Dependency]
targetBuildDepends = [Dependency]
deps}
    }
  updateExeDeps :: Executable -> [Dependency] -> Executable
updateExeDeps Executable
exe [Dependency]
deps = Executable
exe
    { buildInfo :: BuildInfo
buildInfo = (Executable -> BuildInfo
buildInfo Executable
exe) {targetBuildDepends :: [Dependency]
targetBuildDepends = [Dependency]
deps} }

  -- Note that, prior to moving to Cabal 2.0, we would set testEnabled or

  -- benchmarkEnabled here. These fields no longer exist, so we modify buildable

  -- instead here. The only wrinkle in the Cabal 2.0 story is

  -- https://github.com/haskell/cabal/issues/1725, where older versions of Cabal

  -- (which may be used for actually building code) don't properly exclude

  -- build-depends for non-buildable components. Testing indicates that

  -- everything is working fine, and that this comment can be completely

  -- ignored. I'm leaving the comment anyway in case something breaks and you,

  -- poor reader, are investigating.

  updateTestDeps :: Bool -> TestSuite -> [Dependency] -> TestSuite
updateTestDeps Bool
modBuildable TestSuite
test [Dependency]
deps =
    let bi :: BuildInfo
bi = TestSuite -> BuildInfo
testBuildInfo TestSuite
test
        bi' :: BuildInfo
bi' = BuildInfo
bi
          { targetBuildDepends :: [Dependency]
targetBuildDepends = [Dependency]
deps
          , buildable :: Bool
buildable =
                 BuildInfo -> Bool
buildable BuildInfo
bi
              Bool -> Bool -> Bool
&& (  Bool -> Bool
not Bool
modBuildable
                 Bool -> Bool -> Bool
|| PackageConfig -> Bool
packageConfigEnableTests PackageConfig
packageConfig
                 )
          }
    in  TestSuite
test { testBuildInfo :: BuildInfo
testBuildInfo = BuildInfo
bi' }
  updateBenchmarkDeps :: Bool -> Benchmark -> [Dependency] -> Benchmark
updateBenchmarkDeps Bool
modBuildable Benchmark
benchmark [Dependency]
deps =
    let bi :: BuildInfo
bi = Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
benchmark
        bi' :: BuildInfo
bi' = BuildInfo
bi
          { targetBuildDepends :: [Dependency]
targetBuildDepends = [Dependency]
deps
          , buildable :: Bool
buildable =
                 BuildInfo -> Bool
buildable BuildInfo
bi
              Bool -> Bool -> Bool
&& (  Bool -> Bool
not Bool
modBuildable
                 Bool -> Bool -> Bool
|| PackageConfig -> Bool
packageConfigEnableBenchmarks PackageConfig
packageConfig
                 )
          }
    in  Benchmark
benchmark { benchmarkBuildInfo :: BuildInfo
benchmarkBuildInfo = BuildInfo
bi' }

-- | Make a map from a list of flag specifications.

--

-- What is @flagManual@ for?

flagMap :: [PackageFlag] -> Map FlagName Bool
flagMap :: [PackageFlag] -> Map FlagName Bool
flagMap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map PackageFlag -> (FlagName, Bool)
pair
 where
  pair :: PackageFlag -> (FlagName, Bool)
  pair :: PackageFlag -> (FlagName, Bool)
pair = PackageFlag -> FlagName
flagName forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& PackageFlag -> Bool
flagDefault

data ResolveConditions = ResolveConditions
  { ResolveConditions -> Map FlagName Bool
rcFlags :: Map FlagName Bool
  , ResolveConditions -> ActualCompiler
rcCompilerVersion :: ActualCompiler
  , ResolveConditions -> OS
rcOS :: OS
  , ResolveConditions -> Arch
rcArch :: Arch
  }

-- | Generic a @ResolveConditions@ using sensible defaults.

mkResolveConditions ::
     ActualCompiler -- ^ Compiler version

  -> Platform -- ^ installation target platform

  -> Map FlagName Bool -- ^ enabled flags

  -> ResolveConditions
mkResolveConditions :: ActualCompiler
-> Platform -> Map FlagName Bool -> ResolveConditions
mkResolveConditions ActualCompiler
compilerVersion (Platform Arch
arch OS
os) Map FlagName Bool
flags = ResolveConditions
  { rcFlags :: Map FlagName Bool
rcFlags = Map FlagName Bool
flags
  , rcCompilerVersion :: ActualCompiler
rcCompilerVersion = ActualCompiler
compilerVersion
  , rcOS :: OS
rcOS = OS
os
  , rcArch :: Arch
rcArch = Arch
arch
  }

-- | Resolve the condition tree for the library.

resolveConditions ::
     (Semigroup target, Monoid target, Show target)
  => ResolveConditions
  -> (target -> cs -> target)
  -> CondTree ConfVar cs target
  -> target
resolveConditions :: forall target cs.
(Semigroup target, Monoid target, Show target) =>
ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
resolveConditions ResolveConditions
rc target -> cs -> target
addDeps (CondNode target
lib cs
deps [CondBranch ConfVar cs target]
cs) = target
basic forall a. Semigroup a => a -> a -> a
<> target
children
 where
  basic :: target
basic = target -> cs -> target
addDeps target
lib cs
deps
  children :: target
children = forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map CondBranch ConfVar cs target -> target
apply [CondBranch ConfVar cs target]
cs)
   where
    apply :: CondBranch ConfVar cs target -> target
apply (Cabal.CondBranch Condition ConfVar
cond CondTree ConfVar cs target
node Maybe (CondTree ConfVar cs target)
mcs) =
      if Condition ConfVar -> Bool
condSatisfied Condition ConfVar
cond
         then forall target cs.
(Semigroup target, Monoid target, Show target) =>
ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
resolveConditions ResolveConditions
rc target -> cs -> target
addDeps CondTree ConfVar cs target
node
         else forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall target cs.
(Semigroup target, Monoid target, Show target) =>
ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
resolveConditions ResolveConditions
rc target -> cs -> target
addDeps) Maybe (CondTree ConfVar cs target)
mcs
    condSatisfied :: Condition ConfVar -> Bool
condSatisfied Condition ConfVar
c =
      case Condition ConfVar
c of
        Var ConfVar
v -> ConfVar -> Bool
varSatisfied ConfVar
v
        Lit Bool
b -> Bool
b
        CNot Condition ConfVar
c' -> Bool -> Bool
not (Condition ConfVar -> Bool
condSatisfied Condition ConfVar
c')
        COr Condition ConfVar
cx Condition ConfVar
cy -> Condition ConfVar -> Bool
condSatisfied Condition ConfVar
cx Bool -> Bool -> Bool
|| Condition ConfVar -> Bool
condSatisfied Condition ConfVar
cy
        CAnd Condition ConfVar
cx Condition ConfVar
cy -> Condition ConfVar -> Bool
condSatisfied Condition ConfVar
cx Bool -> Bool -> Bool
&& Condition ConfVar -> Bool
condSatisfied Condition ConfVar
cy
    varSatisfied :: ConfVar -> Bool
varSatisfied ConfVar
v =
      case ConfVar
v of
        OS OS
os -> OS
os forall a. Eq a => a -> a -> Bool
== ResolveConditions -> OS
rcOS ResolveConditions
rc
        Arch Arch
arch -> Arch
arch forall a. Eq a => a -> a -> Bool
== ResolveConditions -> Arch
rcArch ResolveConditions
rc
        PackageFlag FlagName
flag -> forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FlagName
flag (ResolveConditions -> Map FlagName Bool
rcFlags ResolveConditions
rc)
        -- NOTE:  ^^^^^ This should never happen, as all flags which are used

        -- must be declared. Defaulting to False.

        Impl CompilerFlavor
flavor VersionRange
range ->
          case (CompilerFlavor
flavor, ResolveConditions -> ActualCompiler
rcCompilerVersion ResolveConditions
rc) of
            (CompilerFlavor
GHC, ACGhc Version
vghc) -> Version
vghc Version -> VersionRange -> Bool
`withinRange` VersionRange
range
            (CompilerFlavor, ActualCompiler)
_ -> Bool
False

-- | Path for the package's build log.

buildLogPath ::
     (MonadReader env m, HasBuildConfig env, MonadThrow m)
  => Package
  -> Maybe String
  -> m (Path Abs File)
buildLogPath :: forall env (m :: * -> *).
(MonadReader env m, HasBuildConfig env, MonadThrow m) =>
Package -> Maybe String -> m (Path Abs File)
buildLogPath Package
package' Maybe String
msuffix = do
  env
env <- forall r (m :: * -> *). MonadReader r m => m r
ask
  let stack :: Path Abs Dir
stack = forall env (m :: * -> *).
(HasBuildConfig env, MonadReader env m) =>
m (Path Abs Dir)
getProjectWorkDir env
env
  Path Rel File
fp <- forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$
    PackageIdentifier -> String
packageIdentifierString (Package -> PackageIdentifier
packageIdentifier Package
package') forall a. a -> [a] -> [a]
:
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\String
suffix -> (String
"-" :) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
suffix :)) Maybe String
msuffix [String
".log"]
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Path Abs Dir
stack forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirLogs forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
fp

    {- FIXME
-- | Create a 'ProjectPackage' from a directory containing a package.
mkProjectPackage
  :: forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
  => PrintWarnings
  -> ResolvedPath Dir
  -> RIO env ProjectPackage
mkProjectPackage printWarnings dir = do
  (gpd, name, cabalfp) <- loadCabalFilePath (resolvedAbsolute dir)
  pure ProjectPackage
    { ppCabalFP = cabalfp
    , ppGPD' = gpd printWarnings
    , ppResolvedDir = dir
    , ppName = name
    }

-- | Create a 'DepPackage' from a 'PackageLocation'
mkDepPackage
  :: forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
  => PackageLocation
  -> RIO env DepPackage
mkDepPackage pl = do
  (name, gpdio) <-
    case pl of
      PLMutable dir -> do
        (gpdio, name, _cabalfp) <- loadCabalFilePath (resolvedAbsolute dir)
        pure (name, gpdio NoPrintWarnings)
      PLImmutable pli -> do
        PackageIdentifier name _ <- getPackageLocationIdent pli
        run <- askRunInIO
        pure (name, run $ loadCabalFileImmutable pli)
  pure DepPackage
    { dpGPD' = gpdio
    , dpLocation = pl
    , dpName = name
    }

    -}

-- | Force a package to be treated as a custom build type, see

-- <https://github.com/commercialhaskell/stack/issues/4488>

applyForceCustomBuild ::
     Version -- ^ global Cabal version

  -> Package
  -> Package
applyForceCustomBuild :: Version -> Package -> Package
applyForceCustomBuild Version
cabalVersion Package
package
  | Bool
forceCustomBuild =
      Package
package
        { packageBuildType :: BuildType
packageBuildType = BuildType
Custom
        , packageDeps :: Map PackageName DepValue
packageDeps =
            forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall a. Semigroup a => a -> a -> a
(<>) PackageName
"Cabal" (VersionRange -> DepType -> DepValue
DepValue VersionRange
cabalVersionRange DepType
AsLibrary) forall a b. (a -> b) -> a -> b
$
              Package -> Map PackageName DepValue
packageDeps Package
package
        , packageSetupDeps :: Maybe (Map PackageName VersionRange)
packageSetupDeps = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [ (PackageName
"Cabal", VersionRange
cabalVersionRange)
            , (PackageName
"base", VersionRange
anyVersion)
            ]
        }
  | Bool
otherwise = Package
package
 where
  cabalVersionRange :: VersionRange
cabalVersionRange =
    Version -> VersionRange
orLaterVersion forall a b. (a -> b) -> a -> b
$ [Int] -> Version
mkVersion forall a b. (a -> b) -> a -> b
$ CabalSpecVersion -> [Int]
cabalSpecToVersionDigits forall a b. (a -> b) -> a -> b
$
      Package -> CabalSpecVersion
packageCabalSpec Package
package
  forceCustomBuild :: Bool
forceCustomBuild =
       Package -> BuildType
packageBuildType Package
package forall a. Eq a => a -> a -> Bool
== BuildType
Simple
    Bool -> Bool -> Bool
&& Bool -> Bool
not (Version
cabalVersion Version -> VersionRange -> Bool
`withinRange` VersionRange
cabalVersionRange)