{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | 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
import           Distribution.Compiler
import           Distribution.Package
                   hiding
                     ( Package, packageName, packageVersion, PackageIdentifier )
import           Distribution.PackageDescription hiding ( FlagName )
#if !MIN_VERSION_Cabal(3,8,1)
import           Distribution.PackageDescription.Parsec
#endif
import           Distribution.Pretty ( prettyShow )
#if MIN_VERSION_Cabal(3,8,1)
import           Distribution.Simple.PackageDescription ( readHookedBuildInfo )
#endif
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           Distribution.Types.MungedPackageName
import qualified Distribution.Types.UnqualComponentName as Cabal
import           Distribution.Utils.Path ( getSymbolicPath )
import           Distribution.Verbosity ( silent )
import           Distribution.Version ( mkVersion, orLaterVersion, anyVersion )
import           Path as FL hiding ( replaceExtension )
import           Path.Extra
import           Path.IO hiding ( findFiles )
import           Stack.Build.Installed
import           Stack.Constants
import           Stack.Constants.Config
import           Stack.Prelude hiding ( Display (..) )
import           Stack.Types.Compiler
import           Stack.Types.Config
import           Stack.Types.GhcPkgId
import           Stack.Types.NamedComponent
import           Stack.Types.Package
import           Stack.Types.Version
import           System.FilePath ( replaceExtension )
import           Stack.Types.Dependency ( DepValue (..), DepType (..) )
import           Stack.Types.PackageFile
                   ( GetPackageFileContext (..), DotCabalPath
                   , GetPackageFiles (..)
                   )
import           Stack.PackageFile ( packageDescModulesAndFiles )
import           Stack.ComponentFile
-- | 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 =
    IO HookedBuildInfo -> m HookedBuildInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HookedBuildInfo -> m HookedBuildInfo)
-> IO HookedBuildInfo -> m HookedBuildInfo
forall a b. (a -> b) -> a -> b
$ Verbosity -> String -> IO HookedBuildInfo
readHookedBuildInfo Verbosity
silent (Path Abs File -> String
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 = [(FlagName, Bool)] -> Map FlagName Bool
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 = Map PackageName DepValue -> Set PackageName
forall k a. Map k a -> Set k
M.keysSet Map PackageName DepValue
deps
    , packageLibraries :: PackageLibraries
packageLibraries =
        let mlib :: Maybe Library
mlib = do
              Library
lib <- PackageDescription -> Maybe Library
library PackageDescription
pkg
              Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ BuildInfo -> Bool
buildable (BuildInfo -> Bool) -> BuildInfo -> Bool
forall a b. (a -> b) -> a -> b
$ Library -> BuildInfo
libBuildInfo Library
lib
              Library -> Maybe Library
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 = [(Text, TestSuiteInterface)] -> Map Text TestSuiteInterface
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
      [(String -> Text
T.pack (UnqualComponentName -> String
Cabal.unUnqualComponentName (UnqualComponentName -> String) -> UnqualComponentName -> String
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 = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList
      [String -> Text
T.pack (UnqualComponentName -> String
Cabal.unUnqualComponentName (UnqualComponentName -> String) -> UnqualComponentName -> String
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 = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList
      [String -> Text
T.pack (UnqualComponentName -> String
Cabal.unUnqualComponentName (UnqualComponentName -> String) -> UnqualComponentName -> String
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 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)
-> (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
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 = Set Text -> [Text]
forall a. Set a -> [a]
S.toList (Set Text -> [Text]) -> Set Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Set NamedComponent -> Set Text
internalLibComponents (Set NamedComponent -> Set Text) -> Set NamedComponent -> Set Text
forall a b. (a -> b) -> a -> b
$ Map NamedComponent (Map ModuleName (Path Abs File))
-> Set NamedComponent
forall k a. Map k a -> Set k
M.keysSet Map NamedComponent (Map ModuleName (Path Abs File))
componentsModules
              [PackageName]
excludedInternals <- (Text -> RIO env PackageName) -> [Text] -> RIO env [PackageName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (String -> RIO env PackageName
forall (m :: * -> *). MonadThrow m => String -> m PackageName
parsePackageNameThrowing (String -> RIO env PackageName)
-> (Text -> String) -> Text -> RIO env PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) [Text]
internals
              [PackageName]
mungedInternals <- (Text -> RIO env PackageName) -> [Text] -> RIO env [PackageName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (String -> RIO env PackageName
forall (m :: * -> *). MonadThrow m => String -> m PackageName
parsePackageNameThrowing (String -> RIO env PackageName)
-> (Text -> String) -> Text -> RIO env PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                       Text -> Text
toInternalPackageMungedName) [Text]
internals
              Map NamedComponent BuildInfoOpts
componentsOpts <-
                  InstallMap
-> InstalledMap
-> [PackageName]
-> [PackageName]
-> Path Abs File
-> PackageDescription
-> Map NamedComponent [DotCabalPath]
-> RIO env (Map NamedComponent BuildInfoOpts)
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 [PackageName] -> [PackageName] -> [PackageName]
forall a. [a] -> [a] -> [a]
++ [PackageName]
omitPkgs) ([PackageName]
mungedInternals [PackageName] -> [PackageName] -> [PackageName]
forall a. [a] -> [a] -> [a]
++ [PackageName]
addPkgs)
                  Path Abs File
cabalfp PackageDescription
pkg Map NamedComponent [DotCabalPath]
componentFiles
              (Map NamedComponent (Map ModuleName (Path Abs File)),
 Map NamedComponent [DotCabalPath],
 Map NamedComponent BuildInfoOpts)
-> RIO
     env
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath],
      Map NamedComponent BuildInfoOpts)
forall a. a -> RIO env a
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 = Bool -> (Library -> Bool) -> Maybe Library -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          Bool
False
          (Bool -> Bool
not (Bool -> Bool) -> (Library -> Bool) -> Library -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ModuleName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ModuleName] -> Bool)
-> (Library -> [ModuleName]) -> Library -> Bool
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 = Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
S.union Set Text
subLibNames Set Text
foreignLibNames

    subLibNames :: Set Text
subLibNames
      = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList
      ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ (UnqualComponentName -> Text) -> [UnqualComponentName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text)
-> (UnqualComponentName -> String) -> UnqualComponentName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> String
Cabal.unUnqualComponentName)
      ([UnqualComponentName] -> [Text])
-> [UnqualComponentName] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Library -> Maybe UnqualComponentName)
-> [Library] -> [UnqualComponentName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (LibraryName -> Maybe UnqualComponentName
libraryNameString (LibraryName -> Maybe UnqualComponentName)
-> (Library -> LibraryName) -> Library -> Maybe UnqualComponentName
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

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

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

    toInternalPackageMungedName :: Text -> Text
toInternalPackageMungedName
      = String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MungedPackageName -> String
forall a. Pretty a => a -> String
prettyShow (MungedPackageName -> String)
-> (Text -> MungedPackageName) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> LibraryName -> MungedPackageName
MungedPackageName (PackageIdentifier -> PackageName
pkgName PackageIdentifier
pkgId)
      (LibraryName -> MungedPackageName)
-> (Text -> LibraryName) -> Text -> MungedPackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe UnqualComponentName -> LibraryName
maybeToLibraryName (Maybe UnqualComponentName -> LibraryName)
-> (Text -> Maybe UnqualComponentName) -> Text -> LibraryName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> Maybe UnqualComponentName
forall a. a -> Maybe a
Just (UnqualComponentName -> Maybe UnqualComponentName)
-> (Text -> UnqualComponentName)
-> Text
-> Maybe UnqualComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UnqualComponentName
Cabal.mkUnqualComponentName (String -> UnqualComponentName)
-> (Text -> String) -> Text -> UnqualComponentName
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 env.
  HasEnvConfig env =>
  Path Abs File
  -> RIO
       env
       (Map NamedComponent (Map ModuleName (Path Abs File)),
        Map NamedComponent [DotCabalPath], 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
forall a b. (a -> b) -> a -> b
$
        \Path Abs File
cabalfp -> StyleDoc
-> RIO
     env
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], Set (Path Abs File),
      [PackageWarning])
-> RIO
     env
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], Set (Path Abs File),
      [PackageWarning])
forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m,
 MonadUnliftIO m) =>
StyleDoc -> m a -> m a
debugBracket (StyleDoc
"getPackageFiles" StyleDoc -> StyleDoc -> StyleDoc
<+> Path Abs File -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty Path Abs File
cabalfp) (RIO
   env
   (Map NamedComponent (Map ModuleName (Path Abs File)),
    Map NamedComponent [DotCabalPath], Set (Path Abs File),
    [PackageWarning])
 -> RIO
      env
      (Map NamedComponent (Map ModuleName (Path Abs File)),
       Map NamedComponent [DotCabalPath], Set (Path Abs File),
       [PackageWarning]))
-> RIO
     env
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], Set (Path Abs File),
      [PackageWarning])
-> RIO
     env
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], Set (Path Abs File),
      [PackageWarning])
forall a b. (a -> b) -> a -> b
$ do
             let pkgDir :: Path Abs Dir
pkgDir = Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs File
cabalfp
             Path Abs Dir
distDir <- Path Abs Dir -> RIO env (Path Abs Dir)
forall (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
Path Abs Dir -> m (Path Abs Dir)
distDirFromDir Path Abs Dir
pkgDir
             BuildConfig
bc <- Getting BuildConfig env BuildConfig -> RIO env BuildConfig
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting BuildConfig env BuildConfig
forall env. HasBuildConfig env => Lens' env BuildConfig
Lens' env BuildConfig
buildConfigL
             Version
cabalVer <- Getting Version env Version -> RIO env Version
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Version env Version
forall env. HasCompiler env => SimpleGetter env Version
SimpleGetter env Version
cabalVersionL
             (Map NamedComponent (Map ModuleName (Path Abs File))
componentModules,Map NamedComponent [DotCabalPath]
componentFiles,Set (Path Abs File)
dataFiles',[PackageWarning]
warnings) <-
                 GetPackageFileContext
-> RIO
     GetPackageFileContext
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], Set (Path Abs File),
      [PackageWarning])
-> RIO
     env
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], Set (Path Abs File),
      [PackageWarning])
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO
                     (Path Abs File
-> Path Abs Dir -> BuildConfig -> Version -> GetPackageFileContext
GetPackageFileContext Path Abs File
cabalfp Path Abs Dir
distDir BuildConfig
bc Version
cabalVer)
                     (PackageDescription
-> RIO
     GetPackageFileContext
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], Set (Path Abs File),
      [PackageWarning])
packageDescModulesAndFiles PackageDescription
pkg)
             Set (Path Abs File)
setupFiles <-
                 if PackageDescription -> BuildType
buildType PackageDescription
pkg BuildType -> BuildType -> Bool
forall a. Eq a => a -> a -> Bool
== BuildType
Custom
                 then do
                     let setupHsPath :: Path Abs File
setupHsPath = Path Abs Dir
pkgDir Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFileSetupHs
                         setupLhsPath :: Path Abs File
setupLhsPath = Path Abs Dir
pkgDir Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFileSetupLhs
                     Bool
setupHsExists <- Path Abs File -> RIO env Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
setupHsPath
                     if Bool
setupHsExists then Set (Path Abs File) -> RIO env (Set (Path Abs File))
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs File -> Set (Path Abs File)
forall a. a -> Set a
S.singleton Path Abs File
setupHsPath) else do
                         Bool
setupLhsExists <- Path Abs File -> RIO env Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
setupLhsPath
                         if Bool
setupLhsExists then Set (Path Abs File) -> RIO env (Set (Path Abs File))
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs File -> Set (Path Abs File)
forall a. a -> Set a
S.singleton Path Abs File
setupLhsPath) else Set (Path Abs File) -> RIO env (Set (Path Abs File))
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set (Path Abs File)
forall a. Set a
S.empty
                 else Set (Path Abs File) -> RIO env (Set (Path Abs File))
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set (Path Abs File)
forall a. Set a
S.empty
             Set (Path Abs File)
buildFiles <- (Set (Path Abs File) -> Set (Path Abs File))
-> RIO env (Set (Path Abs File)) -> RIO env (Set (Path Abs File))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Path Abs File -> Set (Path Abs File) -> Set (Path Abs File)
forall a. Ord a => a -> Set a -> Set a
S.insert Path Abs File
cabalfp (Set (Path Abs File) -> Set (Path Abs File))
-> (Set (Path Abs File) -> Set (Path Abs File))
-> Set (Path Abs File)
-> Set (Path Abs File)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Path Abs File) -> Set (Path Abs File) -> Set (Path Abs File)
forall a. Ord a => Set a -> Set a -> Set a
S.union Set (Path Abs File)
setupFiles) (RIO env (Set (Path Abs File)) -> RIO env (Set (Path Abs File)))
-> RIO env (Set (Path Abs File)) -> RIO env (Set (Path Abs File))
forall a b. (a -> b) -> a -> b
$ do
                 let hpackPath :: Path Abs File
hpackPath = Path Abs Dir
pkgDir Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFileHpackPackageConfig
                 Bool
hpackExists <- Path Abs File -> RIO env Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
hpackPath
                 Set (Path Abs File) -> RIO env (Set (Path Abs File))
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set (Path Abs File) -> RIO env (Set (Path Abs File)))
-> Set (Path Abs File) -> RIO env (Set (Path Abs File))
forall a b. (a -> b) -> a -> b
$ if Bool
hpackExists then Path Abs File -> Set (Path Abs File)
forall a. a -> Set a
S.singleton Path Abs File
hpackPath else Set (Path Abs File)
forall a. Set a
S.empty
             (Map NamedComponent (Map ModuleName (Path Abs File)),
 Map NamedComponent [DotCabalPath], Set (Path Abs File),
 [PackageWarning])
-> RIO
     env
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], Set (Path Abs File),
      [PackageWarning])
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map NamedComponent (Map ModuleName (Path Abs File))
componentModules, Map NamedComponent [DotCabalPath]
componentFiles, Set (Path Abs File)
buildFiles Set (Path Abs File) -> Set (Path Abs File) -> Set (Path Abs File)
forall a. Semigroup a => a -> a -> a
<> Set (Path Abs File)
dataFiles', [PackageWarning]
warnings)
    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 = (PackageName -> DepValue -> Bool)
-> Map PackageName DepValue -> Map PackageName DepValue
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (Bool -> DepValue -> Bool
forall a b. a -> b -> a
const (Bool -> DepValue -> Bool)
-> (PackageName -> Bool) -> PackageName -> DepValue -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> (PackageName -> Bool) -> PackageName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> Bool
isMe) ((DepValue -> DepValue -> DepValue)
-> [Map PackageName DepValue] -> Map PackageName DepValue
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith DepValue -> DepValue -> DepValue
forall a. Semigroup a => a -> a -> a
(<>)
        [ VersionRange -> DepValue
asLibrary (VersionRange -> DepValue)
-> Map PackageName VersionRange -> Map PackageName DepValue
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 (VersionRange -> DepValue)
-> Map PackageName VersionRange -> Map PackageName DepValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map PackageName VersionRange
-> Maybe (Map PackageName VersionRange)
-> Map PackageName VersionRange
forall a. a -> Maybe a -> a
fromMaybe Map PackageName VersionRange
forall k a. Map k a
M.empty Maybe (Map PackageName VersionRange)
msetupDeps
        , Map PackageName DepValue
knownTools
        ])
    msetupDeps :: Maybe (Map PackageName VersionRange)
msetupDeps = (SetupBuildInfo -> Map PackageName VersionRange)
-> Maybe SetupBuildInfo -> Maybe (Map PackageName VersionRange)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        ([(PackageName, VersionRange)] -> Map PackageName VersionRange
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(PackageName, VersionRange)] -> Map PackageName VersionRange)
-> (SetupBuildInfo -> [(PackageName, VersionRange)])
-> SetupBuildInfo
-> Map PackageName VersionRange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dependency -> (PackageName, VersionRange))
-> [Dependency] -> [(PackageName, VersionRange)]
forall a b. (a -> b) -> [a] -> [b]
map (Dependency -> PackageName
depPkgName (Dependency -> PackageName)
-> (Dependency -> VersionRange)
-> Dependency
-> (PackageName, VersionRange)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Dependency -> VersionRange
depVerRange) ([Dependency] -> [(PackageName, VersionRange)])
-> (SetupBuildInfo -> [Dependency])
-> SetupBuildInfo
-> [(PackageName, VersionRange)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SetupBuildInfo -> [Dependency]
setupDepends)
        (PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo PackageDescription
pkg)

    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' PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName
name Bool -> Bool -> Bool
|| String -> Text
forall a. IsString a => String -> a
fromString (PackageName -> String
packageNameString PackageName
name') Text -> Set Text -> Bool
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 <- Getting Config env Config -> m Config
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Config env Config
forall env. HasConfig env => Lens' env Config
Lens' env Config
configL
    Version
cabalVer <- Getting Version env Version -> m Version
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Version env Version
forall env. HasCompiler env => SimpleGetter env Version
SimpleGetter env Version
cabalVersionL
    Path Abs Dir
distDir <- Path Abs Dir -> m (Path Abs Dir)
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 = [DotCabalPath] -> Maybe [DotCabalPath] -> [DotCabalPath]
forall a. a -> Maybe a -> a
fromMaybe [] (NamedComponent
-> Map NamedComponent [DotCabalPath] -> Maybe [DotCabalPath]
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
                }
            )
    Map NamedComponent BuildInfoOpts
-> m (Map NamedComponent BuildInfoOpts)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( [(NamedComponent, BuildInfoOpts)]
-> Map NamedComponent BuildInfoOpts
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
              ([[(NamedComponent, BuildInfoOpts)]]
-> [(NamedComponent, BuildInfoOpts)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                   [ [(NamedComponent, BuildInfoOpts)]
-> (Library -> [(NamedComponent, BuildInfoOpts)])
-> Maybe Library
-> [(NamedComponent, BuildInfoOpts)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                         []
                         ((NamedComponent, BuildInfoOpts)
-> [(NamedComponent, BuildInfoOpts)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((NamedComponent, BuildInfoOpts)
 -> [(NamedComponent, BuildInfoOpts)])
-> (Library -> (NamedComponent, BuildInfoOpts))
-> Library
-> [(NamedComponent, BuildInfoOpts)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts)
generate NamedComponent
CLib (BuildInfo -> (NamedComponent, BuildInfoOpts))
-> (Library -> BuildInfo)
-> Library
-> (NamedComponent, BuildInfoOpts)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> BuildInfo
libBuildInfo)
                         (PackageDescription -> Maybe Library
library PackageDescription
pkg)
                   , (Library -> Maybe (NamedComponent, BuildInfoOpts))
-> [Library] -> [(NamedComponent, BuildInfoOpts)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
                         (\Library
sublib -> do
                            let maybeLib :: Maybe NamedComponent
maybeLib = Text -> NamedComponent
CInternalLib (Text -> NamedComponent)
-> (UnqualComponentName -> Text)
-> UnqualComponentName
-> NamedComponent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text)
-> (UnqualComponentName -> String) -> UnqualComponentName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> String
Cabal.unUnqualComponentName (UnqualComponentName -> NamedComponent)
-> Maybe UnqualComponentName -> Maybe NamedComponent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LibraryName -> Maybe UnqualComponentName
libraryNameString (LibraryName -> Maybe UnqualComponentName)
-> (Library -> LibraryName) -> Library -> Maybe UnqualComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> LibraryName
libName) Library
sublib
                            (NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts))
-> BuildInfo -> NamedComponent -> (NamedComponent, BuildInfoOpts)
forall a b c. (a -> b -> c) -> b -> a -> c
flip NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts)
generate  (Library -> BuildInfo
libBuildInfo Library
sublib) (NamedComponent -> (NamedComponent, BuildInfoOpts))
-> Maybe NamedComponent -> Maybe (NamedComponent, BuildInfoOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe NamedComponent
maybeLib
                          )
                         (PackageDescription -> [Library]
subLibraries PackageDescription
pkg)
                   , (Executable -> (NamedComponent, BuildInfoOpts))
-> [Executable] -> [(NamedComponent, BuildInfoOpts)]
forall a b. (a -> b) -> [a] -> [b]
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)
                   , (Benchmark -> (NamedComponent, BuildInfoOpts))
-> [Benchmark] -> [(NamedComponent, BuildInfoOpts)]
forall a b. (a -> b) -> [a] -> [b]
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)
                   , (TestSuite -> (NamedComponent, BuildInfoOpts))
-> [TestSuite] -> [(NamedComponent, BuildInfoOpts)]
forall a b. (a -> b) -> [a] -> [b]
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 = Path Abs File -> Path Abs Dir
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]
InstallMap
InstalledMap
Path Abs Dir
Version
BuildInfo
NamedComponent
biInstallMap :: BioInput -> InstallMap
biInstalledMap :: BioInput -> InstalledMap
biCabalDir :: BioInput -> Path Abs Dir
biDistDir :: BioInput -> Path Abs Dir
biOmitPackages :: BioInput -> [PackageName]
biAddPackages :: BioInput -> [PackageName]
biBuildInfo :: BioInput -> BuildInfo
biDotCabalPaths :: BioInput -> [DotCabalPath]
biConfigLibDirs :: BioInput -> [String]
biConfigIncludeDirs :: BioInput -> [String]
biComponentName :: BioInput -> NamedComponent
biCabalVersion :: BioInput -> Version
biInstallMap :: InstallMap
biInstalledMap :: InstalledMap
biCabalDir :: Path Abs Dir
biDistDir :: Path Abs Dir
biOmitPackages :: [PackageName]
biAddPackages :: [PackageName]
biBuildInfo :: BuildInfo
biDotCabalPaths :: [DotCabalPath]
biConfigLibDirs :: [String]
biConfigIncludeDirs :: [String]
biComponentName :: NamedComponent
biCabalVersion :: Version
..} =
    BuildInfoOpts
        { bioOpts :: [String]
bioOpts = [String]
ghcOpts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
"-optP" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (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 = [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
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 Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFileCabalMacrosH
        }
  where
    cObjectFiles :: [String]
cObjectFiles =
        (Path Abs File -> Maybe String) -> [Path Abs File] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Path Abs File -> String) -> Maybe (Path Abs File) -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Path Abs File -> String
forall b t. Path b t -> String
toFilePath (Maybe (Path Abs File) -> Maybe String)
-> (Path Abs File -> Maybe (Path Abs File))
-> Path Abs File
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  Path Abs Dir
-> NamedComponent
-> Path Abs Dir
-> Path Abs File
-> Maybe (Path Abs File)
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 = (DotCabalPath -> Maybe (Path Abs File))
-> [DotCabalPath] -> [Path Abs File]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DotCabalPath -> Maybe (Path Abs File)
dotCabalCFilePath [DotCabalPath]
biDotCabalPaths
    installVersion :: (a, b) -> b
installVersion = (a, b) -> b
forall a b. (a, b) -> b
snd
    -- Generates: -package=base -package=base16-bytestring-0.1.1.6 ...

    deps :: [String]
deps =
        [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ case PackageName -> InstalledMap -> Maybe (InstallLocation, Installed)
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=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> GhcPkgId -> String
ghcPkgIdString GhcPkgId
ipid]
                Maybe (InstallLocation, Installed)
_ -> [String
"-package=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> PackageName -> String
packageNameString PackageName
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
                 String
-> ((InstallLocation, Version) -> String)
-> Maybe (InstallLocation, Version)
-> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" -- This empty case applies to e.g. base.

                     (((String
"-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (String -> String) -> (Version -> String) -> Version -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> String
versionString) (Version -> String)
-> ((InstallLocation, Version) -> Version)
-> (InstallLocation, Version)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InstallLocation, Version) -> Version
forall a b. (a, b) -> b
installVersion)
                     (PackageName -> InstallMap -> Maybe (InstallLocation, Version)
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 [PackageName] -> [PackageName] -> [PackageName]
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 PackageName -> [PackageName] -> Bool
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 = (Extension -> String) -> [Extension] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String
"-X" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Extension -> String) -> Extension -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> String
forall a. Pretty a => a -> String
display) (BuildInfo -> [Extension]
usedExtensions BuildInfo
biBuildInfo)
    srcOpts :: [String]
srcOpts =
        (Path Abs Dir -> String) -> [Path Abs Dir] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String
"-i" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (String -> String)
-> (Path Abs Dir -> String) -> Path Abs Dir -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> String
forall loc. Path loc Dir -> String
toFilePathNoTrailingSep)
            ([[Path Abs Dir]] -> [Path Abs Dir]
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
                | [SymbolicPath PackageDir SourceDir] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
biBuildInfo)
                ]
              , (SymbolicPath PackageDir SourceDir -> Maybe (Path Abs Dir))
-> [SymbolicPath PackageDir SourceDir] -> [Path Abs Dir]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String -> Maybe (Path Abs Dir)
toIncludeDir (String -> Maybe (Path Abs Dir))
-> (SymbolicPath PackageDir SourceDir -> String)
-> SymbolicPath PackageDir SourceDir
-> Maybe (Path Abs Dir)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPath PackageDir SourceDir -> String
forall from to. SymbolicPath from to -> String
getSymbolicPath) (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
biBuildInfo)
              , [ Path Abs Dir
componentAutogen ]
              , Maybe (Path Abs Dir) -> [Path Abs Dir]
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 ]
              ]) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
        [ String
"-stubdir=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Path Abs Dir -> String
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
"." = Path Abs Dir -> Maybe (Path Abs Dir)
forall a. a -> Maybe a
Just Path Abs Dir
biCabalDir
    toIncludeDir String
relDir = Path Abs Dir -> String -> Maybe (Path Abs Dir)
forall (m :: * -> *).
MonadThrow m =>
Path Abs Dir -> String -> m (Path Abs Dir)
concatAndCollapseAbsDir Path Abs Dir
biCabalDir String
relDir
    includeOpts :: [String]
includeOpts =
        (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"-I" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) ([String]
biConfigIncludeDirs [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
pkgIncludeOpts)
    pkgIncludeOpts :: [String]
pkgIncludeOpts =
        [ Path Abs Dir -> String
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 =
        (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"-l" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (BuildInfo -> [String]
extraLibs BuildInfo
biBuildInfo) [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<>
        (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"-L" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) ([String]
biConfigLibDirs [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
pkgLibDirs)
    pkgLibDirs :: [String]
pkgLibDirs =
        [ Path Abs Dir -> String
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 (String -> Maybe (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => String -> m (Path Abs Dir)
parseAbsDir String
dir, String -> Maybe (Path Rel 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 Path Abs Dir -> Path Rel Dir -> Path Abs Dir
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 = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
fwk -> String
"-framework=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
fwk) (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 <- Path Abs Dir -> Path Abs File -> m (Path Rel File)
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 <-
        String -> m (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile (String -> String -> String
replaceExtension (Path Rel File -> String
forall b t. Path b t -> String
toFilePath Path Rel File
relCFilePath) String
"o")
    Path Abs File -> m (Path Abs File)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedComponent -> Path Abs Dir -> Path Abs Dir
componentOutputDir NamedComponent
namedComponent Path Abs Dir
distDir Path Abs Dir -> Path Rel File -> Path Abs File
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' =
  (VersionRange -> VersionRange -> VersionRange)
-> [(PackageName, VersionRange)] -> Map PackageName VersionRange
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith VersionRange -> VersionRange -> VersionRange
intersectVersionRanges ([(PackageName, VersionRange)] -> Map PackageName VersionRange)
-> [(PackageName, VersionRange)] -> Map PackageName VersionRange
forall a b. (a -> b) -> a -> b
$
  (Dependency -> (PackageName, VersionRange))
-> [Dependency] -> [(PackageName, VersionRange)]
forall a b. (a -> b) -> [a] -> [b]
map (Dependency -> PackageName
depPkgName (Dependency -> PackageName)
-> (Dependency -> VersionRange)
-> Dependency
-> (PackageName, VersionRange)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Dependency -> VersionRange
depVerRange) ([Dependency] -> [(PackageName, VersionRange)])
-> [Dependency] -> [(PackageName, VersionRange)]
forall a b. (a -> b) -> a -> b
$
  (BuildInfo -> [Dependency]) -> [BuildInfo] -> [Dependency]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [Dependency]
targetBuildDepends (PackageDescription -> [BuildInfo]
allBuildInfo' PackageDescription
pkg) [Dependency] -> [Dependency] -> [Dependency]
forall a. [a] -> [a] -> [a]
++
  [Dependency]
-> (SetupBuildInfo -> [Dependency])
-> Maybe SetupBuildInfo
-> [Dependency]
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) Version -> Version -> Bool
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 about

      -- 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) }) (Library -> Library) -> Maybe Library -> Maybe Library
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) }) (Executable -> Executable) -> [Executable] -> [Executable]
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) }) (TestSuite -> TestSuite) -> [TestSuite] -> [TestSuite]
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) }) (Benchmark -> Benchmark) -> [Benchmark] -> [Benchmark]
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 =
    ([ExeName] -> Set ExeName
forall a. Ord a => [a] -> Set a
S.fromList ([ExeName] -> Set ExeName) -> [ExeName] -> Set ExeName
forall a b. (a -> b) -> a -> b
$ [[ExeName]] -> [ExeName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ExeName]]
unknowns, (DepValue -> DepValue -> DepValue)
-> [(PackageName, DepValue)] -> Map PackageName DepValue
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith DepValue -> DepValue -> DepValue
forall a. Semigroup a => a -> a -> a
(<>) ([(PackageName, DepValue)] -> Map PackageName DepValue)
-> [(PackageName, DepValue)] -> Map PackageName DepValue
forall a b. (a -> b) -> a -> b
$ [[(PackageName, DepValue)]] -> [(PackageName, DepValue)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(PackageName, DepValue)]]
knowns)
  where
    ([[ExeName]]
unknowns, [[(PackageName, DepValue)]]
knowns) = [([ExeName], [(PackageName, DepValue)])]
-> ([[ExeName]], [[(PackageName, DepValue)]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([([ExeName], [(PackageName, DepValue)])]
 -> ([[ExeName]], [[(PackageName, DepValue)]]))
-> [([ExeName], [(PackageName, DepValue)])]
-> ([[ExeName]], [[(PackageName, DepValue)]])
forall a b. (a -> b) -> a -> b
$ (BuildInfo -> ([ExeName], [(PackageName, DepValue)]))
-> [BuildInfo] -> [([ExeName], [(PackageName, DepValue)])]
forall a b. (a -> b) -> [a] -> [b]
map BuildInfo -> ([ExeName], [(PackageName, DepValue)])
perBI ([BuildInfo] -> [([ExeName], [(PackageName, DepValue)])])
-> [BuildInfo] -> [([ExeName], [(PackageName, DepValue)])]
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) = [Either ExeName ExeDependency] -> ([ExeName], [ExeDependency])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either ExeName ExeDependency] -> ([ExeName], [ExeDependency]))
-> [Either ExeName ExeDependency] -> ([ExeName], [ExeDependency])
forall a b. (a -> b) -> a -> b
$ (LegacyExeDependency -> Either ExeName ExeDependency)
-> [LegacyExeDependency] -> [Either ExeName ExeDependency]
forall a b. (a -> b) -> [a] -> [b]
map LegacyExeDependency -> Either ExeName ExeDependency
go1 (BuildInfo -> [LegacyExeDependency]
buildTools BuildInfo
bi)

        tools :: [(PackageName, DepValue)]
tools = (ExeDependency -> Maybe (PackageName, DepValue))
-> [ExeDependency] -> [(PackageName, DepValue)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ExeDependency -> Maybe (PackageName, DepValue)
go2 ([ExeDependency]
knownTools [ExeDependency] -> [ExeDependency] -> [ExeDependency]
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 String -> Map String PackageName -> Maybe PackageName
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
name Map String PackageName
hardCodedMap of
            Just PackageName
pkgName -> ExeDependency -> Either ExeName ExeDependency
forall a b. b -> Either a b
Right (ExeDependency -> Either ExeName ExeDependency)
-> ExeDependency -> Either ExeName ExeDependency
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 -> ExeName -> Either ExeName ExeDependency
forall a b. a -> Either a b
Left (ExeName -> Either ExeName ExeDependency)
-> ExeName -> Either ExeName ExeDependency
forall a b. (a -> b) -> a -> b
$ Text -> ExeName
ExeName (Text -> ExeName) -> Text -> 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 PackageName -> Set PackageName -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set PackageName
preInstalledPackages = Maybe (PackageName, DepValue)
forall a. Maybe a
Nothing
          | Bool
otherwise = (PackageName, DepValue) -> Maybe (PackageName, DepValue)
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 = [(String, PackageName)] -> Map String PackageName
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 = [PackageName] -> Set PackageName
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

-- 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 ]
                       [BuildInfo] -> [BuildInfo] -> [BuildInfo]
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 ]
                       [BuildInfo] -> [BuildInfo] -> [BuildInfo]
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 ]
                       [BuildInfo] -> [BuildInfo] -> [BuildInfo]
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 ]
                       [BuildInfo] -> [BuildInfo] -> [BuildInfo]
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.

--

-- MSS 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 =
                  (CondTree ConfVar [Dependency] Library -> Library)
-> Maybe (CondTree ConfVar [Dependency] Library) -> Maybe Library
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ResolveConditions
-> (Library -> [Dependency] -> Library)
-> CondTree ConfVar [Dependency] Library
-> Library
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 =
                  ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
 -> Library)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [Library]
forall a b. (a -> b) -> [a] -> [b]
map (\(UnqualComponentName
n, CondTree ConfVar [Dependency] Library
v) -> (ResolveConditions
-> (Library -> [Dependency] -> Library)
-> CondTree ConfVar [Dependency] Library
-> Library
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 =
                  ((UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
 -> ForeignLib)
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
-> [ForeignLib]
forall a b. (a -> b) -> [a] -> [b]
map (\(UnqualComponentName
n, CondTree ConfVar [Dependency] ForeignLib
v) -> (ResolveConditions
-> (ForeignLib -> [Dependency] -> ForeignLib)
-> CondTree ConfVar [Dependency] ForeignLib
-> ForeignLib
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 =
                  ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
 -> Executable)
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> [Executable]
forall a b. (a -> b) -> [a] -> [b]
map (\(UnqualComponentName
n, CondTree ConfVar [Dependency] Executable
v) -> (ResolveConditions
-> (Executable -> [Dependency] -> Executable)
-> CondTree ConfVar [Dependency] Executable
-> Executable
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 =
                  ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
 -> TestSuite)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [TestSuite]
forall a b. (a -> b) -> [a] -> [b]
map (\(UnqualComponentName
n,CondTree ConfVar [Dependency] TestSuite
v) -> (ResolveConditions
-> (TestSuite -> [Dependency] -> TestSuite)
-> CondTree ConfVar [Dependency] TestSuite
-> TestSuite
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 =
                  ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
 -> Benchmark)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [Benchmark]
forall a b. (a -> b) -> [a] -> [b]
map (\(UnqualComponentName
n,CondTree ConfVar [Dependency] Benchmark
v) -> (ResolveConditions
-> (Benchmark -> [Dependency] -> Benchmark)
-> CondTree ConfVar [Dependency] Benchmark
-> Benchmark
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 =
          Map FlagName Bool -> Map FlagName Bool -> Map FlagName Bool
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/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
&& (if Bool
modBuildable then PackageConfig -> Bool
packageConfigEnableTests PackageConfig
packageConfig else Bool
True)
                }
           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
&& (if Bool
modBuildable then PackageConfig -> Bool
packageConfigEnableBenchmarks PackageConfig
packageConfig else Bool
True)
                }
           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 = [(FlagName, Bool)] -> Map FlagName Bool
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(FlagName, Bool)] -> Map FlagName Bool)
-> ([PackageFlag] -> [(FlagName, Bool)])
-> [PackageFlag]
-> Map FlagName Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PackageFlag -> (FlagName, Bool))
-> [PackageFlag] -> [(FlagName, Bool)]
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 (PackageFlag -> FlagName)
-> (PackageFlag -> Bool) -> PackageFlag -> (FlagName, Bool)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
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 target -> target -> target
forall a. Semigroup a => a -> a -> a
<> target
children
  where basic :: target
basic = target -> cs -> target
addDeps target
lib cs
deps
        children :: target
children = [target] -> target
forall a. Monoid a => [a] -> a
mconcat ((CondBranch ConfVar cs target -> target)
-> [CondBranch ConfVar cs target] -> [target]
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 ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
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 target
-> (CondTree ConfVar cs target -> target)
-> Maybe (CondTree ConfVar cs target)
-> target
forall b a. b -> (a -> b) -> Maybe a -> b
maybe target
forall a. Monoid a => a
mempty (ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
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 OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== ResolveConditions -> OS
rcOS ResolveConditions
rc
                    Arch Arch
arch -> Arch
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== ResolveConditions -> Arch
rcArch ResolveConditions
rc
                    PackageFlag FlagName
flag ->
                      Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FlagName -> Map FlagName Bool -> Maybe Bool
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 <- m env
forall r (m :: * -> *). MonadReader r m => m r
ask
  let stack :: Path Abs Dir
stack = env -> Path Abs Dir
forall env (m :: * -> *).
(HasBuildConfig env, MonadReader env m) =>
m (Path Abs Dir)
getProjectWorkDir env
env
  Path Rel File
fp <- String -> m (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile (String -> m (Path Rel File)) -> String -> m (Path Rel File)
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
    PackageIdentifier -> String
packageIdentifierString (Package -> PackageIdentifier
packageIdentifier Package
package') String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
    ([String] -> [String])
-> (String -> [String] -> [String])
-> Maybe String
-> [String]
-> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [String] -> [String]
forall a. a -> a
id (\String
suffix -> (String
"-" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
suffix String -> [String] -> [String]
forall a. a -> [a] -> [a]
:)) Maybe String
msuffix [String
".log"]
  Path Abs File -> m (Path Abs File)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs File -> m (Path Abs File))
-> Path Abs File -> m (Path Abs File)
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
stack Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirLogs Path Rel Dir -> Path Rel File -> Path Rel File
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 = (DepValue -> DepValue -> DepValue)
-> PackageName
-> DepValue
-> Map PackageName DepValue
-> Map PackageName DepValue
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith DepValue -> DepValue -> DepValue
forall a. Semigroup a => a -> a -> a
(<>) PackageName
"Cabal" (VersionRange -> DepType -> DepValue
DepValue VersionRange
cabalVersionRange DepType
AsLibrary)
                        (Map PackageName DepValue -> Map PackageName DepValue)
-> Map PackageName DepValue -> Map PackageName DepValue
forall a b. (a -> b) -> a -> b
$ Package -> Map PackageName DepValue
packageDeps Package
package
          , packageSetupDeps :: Maybe (Map PackageName VersionRange)
packageSetupDeps = Map PackageName VersionRange
-> Maybe (Map PackageName VersionRange)
forall a. a -> Maybe a
Just (Map PackageName VersionRange
 -> Maybe (Map PackageName VersionRange))
-> Map PackageName VersionRange
-> Maybe (Map PackageName VersionRange)
forall a b. (a -> b) -> a -> b
$ [(PackageName, VersionRange)] -> Map PackageName VersionRange
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 (Version -> VersionRange) -> Version -> VersionRange
forall a b. (a -> b) -> a -> b
$ [Int] -> Version
mkVersion ([Int] -> Version) -> [Int] -> Version
forall a b. (a -> b) -> a -> b
$ CabalSpecVersion -> [Int]
cabalSpecToVersionDigits (CabalSpecVersion -> [Int]) -> CabalSpecVersion -> [Int]
forall a b. (a -> b) -> a -> b
$
        Package -> CabalSpecVersion
packageCabalSpec Package
package
    forceCustomBuild :: Bool
forceCustomBuild =
      Package -> BuildType
packageBuildType Package
package BuildType -> BuildType -> Bool
forall a. Eq a => a -> a -> Bool
== BuildType
Simple Bool -> Bool -> Bool
&&
      Bool -> Bool
not (Version
cabalVersion Version -> VersionRange -> Bool
`withinRange` VersionRange
cabalVersionRange)