{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Client.Configure
-- Copyright   :  (c) David Himmelstrup 2005,
--                    Duncan Coutts 2005
-- License     :  BSD-like
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- High level interface to configuring a package.
-----------------------------------------------------------------------------
module Distribution.Client.Configure (
    configure,
    configureSetupScript,
    chooseCabalVersion,
    checkConfigExFlags,
    -- * Saved configure flags
    readConfigFlagsFrom, readConfigFlags,
    cabalConfigFlagsFile,
    writeConfigFlagsTo, writeConfigFlags,
  ) where

import Prelude ()
import Distribution.Client.Compat.Prelude
import Distribution.Utils.Generic (safeHead)

import Distribution.Client.Dependency
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.SolverInstallPlan (SolverInstallPlan)
import Distribution.Client.IndexUtils as IndexUtils
         ( getSourcePackages, getInstalledPackages )
import Distribution.Client.Setup
         ( ConfigExFlags(..), RepoContext(..)
         , configureCommand, configureExCommand, filterConfigureFlags )
import Distribution.Client.Types as Source
import Distribution.Client.SetupWrapper
         ( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions )
import Distribution.Client.Targets
         ( userToPackageConstraint, userConstraintPackageName )
import Distribution.Client.JobControl (Lock)

import qualified Distribution.Solver.Types.ComponentDeps as CD
import           Distribution.Solver.Types.Settings
import           Distribution.Solver.Types.ConstraintSource
import           Distribution.Solver.Types.LabeledPackageConstraint
import           Distribution.Solver.Types.OptionalStanza
import           Distribution.Solver.Types.PackageIndex
                   ( PackageIndex, elemByPackageName )
import           Distribution.Solver.Types.PkgConfigDb
                   (PkgConfigDb, readPkgConfigDb)
import           Distribution.Solver.Types.SourcePackage

import Distribution.Simple.Compiler
         ( Compiler, CompilerInfo, compilerInfo, PackageDB(..), PackageDBStack )
import Distribution.Simple.Program (ProgramDb)
import Distribution.Client.SavedFlags ( readCommandFlags, writeCommandFlags )
import Distribution.Simple.Setup
         ( ConfigFlags(..)
         , fromFlag, toFlag, flagToMaybe, fromFlagOrDefault )
import Distribution.Simple.PackageDescription
         ( readGenericPackageDescription )
import Distribution.Simple.PackageIndex as PackageIndex
         ( InstalledPackageIndex, lookupPackageName )
import Distribution.Package
         ( Package(..), packageName, PackageId )
import Distribution.Types.GivenComponent
         ( GivenComponent(..) )
import Distribution.Types.PackageVersionConstraint
         ( PackageVersionConstraint(..), thisPackageVersionConstraint )
import qualified Distribution.PackageDescription as PkgDesc
import Distribution.PackageDescription.Configuration
         ( finalizePD )
import Distribution.Version
         ( Version, mkVersion, anyVersion, thisVersion
         , VersionRange, orLaterVersion )
import Distribution.Simple.Utils as Utils
         ( warn, notice, debug, die'
         , defaultPackageDesc )
import Distribution.System
         ( Platform )

import System.FilePath ( (</>) )

-- | Choose the Cabal version such that the setup scripts compiled against this
-- version will support the given command-line flags.
chooseCabalVersion :: ConfigExFlags -> Maybe Version -> VersionRange
chooseCabalVersion :: ConfigExFlags -> Maybe Version -> VersionRange
chooseCabalVersion ConfigExFlags
configExFlags Maybe Version
maybeVersion =
  VersionRange
-> (Version -> VersionRange) -> Maybe Version -> VersionRange
forall b a. b -> (a -> b) -> Maybe a -> b
maybe VersionRange
defaultVersionRange Version -> VersionRange
thisVersion Maybe Version
maybeVersion
  where
    -- Cabal < 1.19.2 doesn't support '--exact-configuration' which is needed
    -- for '--allow-newer' to work.
    allowNewer :: Bool
allowNewer = RelaxDeps -> Bool
isRelaxDeps
                 (RelaxDeps
-> (AllowNewer -> RelaxDeps) -> Maybe AllowNewer -> RelaxDeps
forall b a. b -> (a -> b) -> Maybe a -> b
maybe RelaxDeps
forall a. Monoid a => a
mempty AllowNewer -> RelaxDeps
unAllowNewer (Maybe AllowNewer -> RelaxDeps) -> Maybe AllowNewer -> RelaxDeps
forall a b. (a -> b) -> a -> b
$ ConfigExFlags -> Maybe AllowNewer
configAllowNewer ConfigExFlags
configExFlags)
    allowOlder :: Bool
allowOlder = RelaxDeps -> Bool
isRelaxDeps
                 (RelaxDeps
-> (AllowOlder -> RelaxDeps) -> Maybe AllowOlder -> RelaxDeps
forall b a. b -> (a -> b) -> Maybe a -> b
maybe RelaxDeps
forall a. Monoid a => a
mempty AllowOlder -> RelaxDeps
unAllowOlder (Maybe AllowOlder -> RelaxDeps) -> Maybe AllowOlder -> RelaxDeps
forall a b. (a -> b) -> a -> b
$ ConfigExFlags -> Maybe AllowOlder
configAllowOlder ConfigExFlags
configExFlags)

    defaultVersionRange :: VersionRange
defaultVersionRange = if Bool
allowOlder Bool -> Bool -> Bool
|| Bool
allowNewer
                          then Version -> VersionRange
orLaterVersion ([Int] -> Version
mkVersion [Int
1,Int
19,Int
2])
                          else VersionRange
anyVersion

-- | Configure the package found in the local directory
configure :: Verbosity
          -> PackageDBStack
          -> RepoContext
          -> Compiler
          -> Platform
          -> ProgramDb
          -> ConfigFlags
          -> ConfigExFlags
          -> [String]
          -> IO ()
configure :: Verbosity
-> PackageDBStack
-> RepoContext
-> Compiler
-> Platform
-> ProgramDb
-> ConfigFlags
-> ConfigExFlags
-> [String]
-> IO ()
configure Verbosity
verbosity PackageDBStack
packageDBs RepoContext
repoCtxt Compiler
comp Platform
platform ProgramDb
progdb
  ConfigFlags
configFlags ConfigExFlags
configExFlags [String]
extraArgs = do

  InstalledPackageIndex
installedPkgIndex <- Verbosity
-> Compiler
-> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages Verbosity
verbosity Compiler
comp PackageDBStack
packageDBs ProgramDb
progdb
  SourcePackageDb
sourcePkgDb       <- Verbosity -> RepoContext -> IO SourcePackageDb
getSourcePackages    Verbosity
verbosity RepoContext
repoCtxt
  PkgConfigDb
pkgConfigDb       <- Verbosity -> ProgramDb -> IO PkgConfigDb
readPkgConfigDb      Verbosity
verbosity ProgramDb
progdb

  Verbosity
-> InstalledPackageIndex
-> PackageIndex UnresolvedSourcePackage
-> ConfigExFlags
-> IO ()
forall pkg.
Package pkg =>
Verbosity
-> InstalledPackageIndex
-> PackageIndex pkg
-> ConfigExFlags
-> IO ()
checkConfigExFlags Verbosity
verbosity InstalledPackageIndex
installedPkgIndex
                     (SourcePackageDb -> PackageIndex UnresolvedSourcePackage
packageIndex SourcePackageDb
sourcePkgDb) ConfigExFlags
configExFlags

  Progress String String SolverInstallPlan
progress <- Verbosity
-> Compiler
-> Platform
-> ConfigFlags
-> ConfigExFlags
-> InstalledPackageIndex
-> SourcePackageDb
-> PkgConfigDb
-> IO (Progress String String SolverInstallPlan)
planLocalPackage Verbosity
verbosity Compiler
comp Platform
platform ConfigFlags
configFlags ConfigExFlags
configExFlags
                               InstalledPackageIndex
installedPkgIndex SourcePackageDb
sourcePkgDb PkgConfigDb
pkgConfigDb

  Verbosity -> String -> IO ()
notice Verbosity
verbosity String
"Resolving dependencies..."
  Either String SolverInstallPlan
maybePlan <- (String
 -> IO (Either String SolverInstallPlan)
 -> IO (Either String SolverInstallPlan))
-> (String -> IO (Either String SolverInstallPlan))
-> (SolverInstallPlan -> IO (Either String SolverInstallPlan))
-> Progress String String SolverInstallPlan
-> IO (Either String SolverInstallPlan)
forall step a fail done.
(step -> a -> a)
-> (fail -> a) -> (done -> a) -> Progress step fail done -> a
foldProgress String
-> IO (Either String SolverInstallPlan)
-> IO (Either String SolverInstallPlan)
forall b. String -> IO b -> IO b
logMsg (Either String SolverInstallPlan
-> IO (Either String SolverInstallPlan)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String SolverInstallPlan
 -> IO (Either String SolverInstallPlan))
-> (String -> Either String SolverInstallPlan)
-> String
-> IO (Either String SolverInstallPlan)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String SolverInstallPlan
forall a b. a -> Either a b
Left) (Either String SolverInstallPlan
-> IO (Either String SolverInstallPlan)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String SolverInstallPlan
 -> IO (Either String SolverInstallPlan))
-> (SolverInstallPlan -> Either String SolverInstallPlan)
-> SolverInstallPlan
-> IO (Either String SolverInstallPlan)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SolverInstallPlan -> Either String SolverInstallPlan
forall a b. b -> Either a b
Right)
                            Progress String String SolverInstallPlan
progress
  case Either String SolverInstallPlan
maybePlan of
    Left String
message -> do
      Verbosity -> String -> IO ()
warn Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
           String
"solver failed to find a solution:\n"
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
message
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\nTrying configure anyway."
      Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI ConfigFlags
-> (Version -> ConfigFlags)
-> (Version -> [String])
-> IO ()
forall flags.
Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
-> (Version -> flags)
-> (Version -> [String])
-> IO ()
setupWrapper Verbosity
verbosity (InstalledPackageIndex -> Maybe ReadyPackage -> SetupScriptOptions
setupScriptOptions InstalledPackageIndex
installedPkgIndex Maybe ReadyPackage
forall a. Maybe a
Nothing)
        Maybe PackageDescription
forall a. Maybe a
Nothing CommandUI ConfigFlags
configureCommand (ConfigFlags -> Version -> ConfigFlags
forall a b. a -> b -> a
const ConfigFlags
configFlags) ([String] -> Version -> [String]
forall a b. a -> b -> a
const [String]
extraArgs)

    Right SolverInstallPlan
installPlan0 ->
     let installPlan :: InstallPlan
installPlan = ConfigFlags -> SolverInstallPlan -> InstallPlan
InstallPlan.configureInstallPlan ConfigFlags
configFlags SolverInstallPlan
installPlan0
     in case ([ReadyPackage], Processing) -> [ReadyPackage]
forall a b. (a, b) -> a
fst (InstallPlan -> ([ReadyPackage], Processing)
forall ipkg srcpkg.
(IsUnit ipkg, IsUnit srcpkg) =>
GenericInstallPlan ipkg srcpkg
-> ([GenericReadyPackage srcpkg], Processing)
InstallPlan.ready InstallPlan
installPlan) of
      [pkg :: ReadyPackage
pkg@(ReadyPackage
              (ConfiguredPackage InstalledPackageId
_ (SourcePackage PackageId
_ GenericPackageDescription
_ (LocalUnpackedPackage String
_) PackageDescriptionOverride
_)
                                 FlagAssignment
_ OptionalStanzaSet
_ ComponentDeps [ConfiguredId]
_))] -> do
        Verbosity
-> Platform
-> CompilerInfo
-> SetupScriptOptions
-> ConfigFlags
-> ReadyPackage
-> [String]
-> IO ()
configurePackage Verbosity
verbosity
          Platform
platform (Compiler -> CompilerInfo
compilerInfo Compiler
comp)
          (InstalledPackageIndex -> Maybe ReadyPackage -> SetupScriptOptions
setupScriptOptions InstalledPackageIndex
installedPkgIndex (ReadyPackage -> Maybe ReadyPackage
forall a. a -> Maybe a
Just ReadyPackage
pkg))
          ConfigFlags
configFlags ReadyPackage
pkg [String]
extraArgs

      [ReadyPackage]
_ -> Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"internal error: configure install plan should have exactly "
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"one local ready package."

  where
    setupScriptOptions :: InstalledPackageIndex
                       -> Maybe ReadyPackage
                       -> SetupScriptOptions
    setupScriptOptions :: InstalledPackageIndex -> Maybe ReadyPackage -> SetupScriptOptions
setupScriptOptions =
      PackageDBStack
-> Compiler
-> Platform
-> ProgramDb
-> String
-> VersionRange
-> Maybe Lock
-> Bool
-> InstalledPackageIndex
-> Maybe ReadyPackage
-> SetupScriptOptions
configureSetupScript
        PackageDBStack
packageDBs
        Compiler
comp
        Platform
platform
        ProgramDb
progdb
        (String -> Flag String -> String
forall a. a -> Flag a -> a
fromFlagOrDefault
           (SetupScriptOptions -> String
useDistPref SetupScriptOptions
defaultSetupScriptOptions)
           (ConfigFlags -> Flag String
configDistPref ConfigFlags
configFlags))
        (ConfigExFlags -> Maybe Version -> VersionRange
chooseCabalVersion
           ConfigExFlags
configExFlags
           (Flag Version -> Maybe Version
forall a. Flag a -> Maybe a
flagToMaybe (ConfigExFlags -> Flag Version
configCabalVersion ConfigExFlags
configExFlags)))
        Maybe Lock
forall a. Maybe a
Nothing
        Bool
False

    logMsg :: String -> IO b -> IO b
logMsg String
message IO b
rest = Verbosity -> String -> IO ()
debug Verbosity
verbosity String
message IO () -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO b
rest

configureSetupScript :: PackageDBStack
                     -> Compiler
                     -> Platform
                     -> ProgramDb
                     -> FilePath
                     -> VersionRange
                     -> Maybe Lock
                     -> Bool
                     -> InstalledPackageIndex
                     -> Maybe ReadyPackage
                     -> SetupScriptOptions
configureSetupScript :: PackageDBStack
-> Compiler
-> Platform
-> ProgramDb
-> String
-> VersionRange
-> Maybe Lock
-> Bool
-> InstalledPackageIndex
-> Maybe ReadyPackage
-> SetupScriptOptions
configureSetupScript PackageDBStack
packageDBs
                     Compiler
comp
                     Platform
platform
                     ProgramDb
progdb
                     String
distPref
                     VersionRange
cabalVersion
                     Maybe Lock
lock
                     Bool
forceExternal
                     InstalledPackageIndex
index
                     Maybe ReadyPackage
mpkg
  = SetupScriptOptions :: VersionRange
-> Maybe Version
-> Maybe Compiler
-> Maybe Platform
-> PackageDBStack
-> Maybe InstalledPackageIndex
-> ProgramDb
-> String
-> Maybe Handle
-> Maybe String
-> [String]
-> [(String, Maybe String)]
-> Bool
-> [(InstalledPackageId, PackageId)]
-> Bool
-> Bool
-> Bool
-> Maybe Lock
-> Bool
-> SetupScriptOptions
SetupScriptOptions {
      useCabalVersion :: VersionRange
useCabalVersion          = VersionRange
cabalVersion
    , useCabalSpecVersion :: Maybe Version
useCabalSpecVersion      = Maybe Version
forall a. Maybe a
Nothing
    , useCompiler :: Maybe Compiler
useCompiler              = Compiler -> Maybe Compiler
forall a. a -> Maybe a
Just Compiler
comp
    , usePlatform :: Maybe Platform
usePlatform              = Platform -> Maybe Platform
forall a. a -> Maybe a
Just Platform
platform
    , usePackageDB :: PackageDBStack
usePackageDB             = PackageDBStack
packageDBs'
    , usePackageIndex :: Maybe InstalledPackageIndex
usePackageIndex          = Maybe InstalledPackageIndex
index'
    , useProgramDb :: ProgramDb
useProgramDb             = ProgramDb
progdb
    , useDistPref :: String
useDistPref              = String
distPref
    , useLoggingHandle :: Maybe Handle
useLoggingHandle         = Maybe Handle
forall a. Maybe a
Nothing
    , useWorkingDir :: Maybe String
useWorkingDir            = Maybe String
forall a. Maybe a
Nothing
    , useExtraPathEnv :: [String]
useExtraPathEnv          = []
    , useExtraEnvOverrides :: [(String, Maybe String)]
useExtraEnvOverrides     = []
    , setupCacheLock :: Maybe Lock
setupCacheLock           = Maybe Lock
lock
    , useWin32CleanHack :: Bool
useWin32CleanHack        = Bool
False
    , forceExternalSetupMethod :: Bool
forceExternalSetupMethod = Bool
forceExternal
      -- If we have explicit setup dependencies, list them; otherwise, we give
      -- the empty list of dependencies; ideally, we would fix the version of
      -- Cabal here, so that we no longer need the special case for that in
      -- `compileSetupExecutable` in `externalSetupMethod`, but we don't yet
      -- know the version of Cabal at this point, but only find this there.
      -- Therefore, for now, we just leave this blank.
    , useDependencies :: [(InstalledPackageId, PackageId)]
useDependencies          = [(InstalledPackageId, PackageId)]
-> Maybe [(InstalledPackageId, PackageId)]
-> [(InstalledPackageId, PackageId)]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [(InstalledPackageId, PackageId)]
explicitSetupDeps
    , useDependenciesExclusive :: Bool
useDependenciesExclusive = Bool -> Bool
not Bool
defaultSetupDeps Bool -> Bool -> Bool
&& Maybe [(InstalledPackageId, PackageId)] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [(InstalledPackageId, PackageId)]
explicitSetupDeps
    , useVersionMacros :: Bool
useVersionMacros         = Bool -> Bool
not Bool
defaultSetupDeps Bool -> Bool -> Bool
&& Maybe [(InstalledPackageId, PackageId)] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [(InstalledPackageId, PackageId)]
explicitSetupDeps
    , isInteractive :: Bool
isInteractive            = Bool
False
    }
  where
    -- When we are compiling a legacy setup script without an explicit
    -- setup stanza, we typically want to allow the UserPackageDB for
    -- finding the Cabal lib when compiling any Setup.hs even if we're doing
    -- a global install. However we also allow looking in a specific package
    -- db.
    packageDBs' :: PackageDBStack
    index'      :: Maybe InstalledPackageIndex
    (PackageDBStack
packageDBs', Maybe InstalledPackageIndex
index') =
      case PackageDBStack
packageDBs of
        (PackageDB
GlobalPackageDB:PackageDBStack
dbs) | PackageDB
UserPackageDB PackageDB -> PackageDBStack -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` PackageDBStack
dbs
                              , Maybe [(InstalledPackageId, PackageId)]
Nothing <- Maybe [(InstalledPackageId, PackageId)]
explicitSetupDeps
            -> (PackageDB
GlobalPackageDBPackageDB -> PackageDBStack -> PackageDBStack
forall a. a -> [a] -> [a]
:PackageDB
UserPackageDBPackageDB -> PackageDBStack -> PackageDBStack
forall a. a -> [a] -> [a]
:PackageDBStack
dbs, Maybe InstalledPackageIndex
forall a. Maybe a
Nothing)
        -- but if the user is using an odd db stack, don't touch it
        PackageDBStack
_otherwise -> (PackageDBStack
packageDBs, InstalledPackageIndex -> Maybe InstalledPackageIndex
forall a. a -> Maybe a
Just InstalledPackageIndex
index)

    maybeSetupBuildInfo :: Maybe PkgDesc.SetupBuildInfo
    maybeSetupBuildInfo :: Maybe SetupBuildInfo
maybeSetupBuildInfo = do
      ReadyPackage ConfiguredPackage UnresolvedPkgLoc
cpkg <- Maybe ReadyPackage
mpkg
      let gpkg :: GenericPackageDescription
gpkg = UnresolvedSourcePackage -> GenericPackageDescription
forall loc. SourcePackage loc -> GenericPackageDescription
srcpkgDescription (ConfiguredPackage UnresolvedPkgLoc -> UnresolvedSourcePackage
forall loc. ConfiguredPackage loc -> SourcePackage loc
confPkgSource ConfiguredPackage UnresolvedPkgLoc
cpkg)
      PackageDescription -> Maybe SetupBuildInfo
PkgDesc.setupBuildInfo (GenericPackageDescription -> PackageDescription
PkgDesc.packageDescription GenericPackageDescription
gpkg)

    -- Was a default 'custom-setup' stanza added by 'cabal-install' itself? If
    -- so, 'setup-depends' must not be exclusive. See #3199.
    defaultSetupDeps :: Bool
    defaultSetupDeps :: Bool
defaultSetupDeps = Bool -> (SetupBuildInfo -> Bool) -> Maybe SetupBuildInfo -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False SetupBuildInfo -> Bool
PkgDesc.defaultSetupDepends
                       Maybe SetupBuildInfo
maybeSetupBuildInfo

    explicitSetupDeps :: Maybe [(InstalledPackageId, PackageId)]
    explicitSetupDeps :: Maybe [(InstalledPackageId, PackageId)]
explicitSetupDeps = do
      -- Check if there is an explicit setup stanza.
      SetupBuildInfo
_buildInfo <- Maybe SetupBuildInfo
maybeSetupBuildInfo
      -- Return the setup dependencies computed by the solver
      ReadyPackage ConfiguredPackage UnresolvedPkgLoc
cpkg <- Maybe ReadyPackage
mpkg
      [(InstalledPackageId, PackageId)]
-> Maybe [(InstalledPackageId, PackageId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [ ( InstalledPackageId
cid, PackageId
srcid )
             | ConfiguredId PackageId
srcid
               (Just (PkgDesc.CLibName LibraryName
PkgDesc.LMainLibName)) InstalledPackageId
cid
                 <- ComponentDeps [ConfiguredId] -> [ConfiguredId]
forall a. Monoid a => ComponentDeps a -> a
CD.setupDeps (ConfiguredPackage UnresolvedPkgLoc -> ComponentDeps [ConfiguredId]
forall loc. ConfiguredPackage loc -> ComponentDeps [ConfiguredId]
confPkgDeps ConfiguredPackage UnresolvedPkgLoc
cpkg)
             ]

-- | Warn if any constraints or preferences name packages that are not in the
-- source package index or installed package index.
checkConfigExFlags :: Package pkg
                   => Verbosity
                   -> InstalledPackageIndex
                   -> PackageIndex pkg
                   -> ConfigExFlags
                   -> IO ()
checkConfigExFlags :: Verbosity
-> InstalledPackageIndex
-> PackageIndex pkg
-> ConfigExFlags
-> IO ()
checkConfigExFlags Verbosity
verbosity InstalledPackageIndex
installedPkgIndex PackageIndex pkg
sourcePkgIndex ConfigExFlags
flags = do
  Maybe (UserConstraint, ConstraintSource)
-> ((UserConstraint, ConstraintSource) -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([(UserConstraint, ConstraintSource)]
-> Maybe (UserConstraint, ConstraintSource)
forall a. [a] -> Maybe a
safeHead [(UserConstraint, ConstraintSource)]
unknownConstraints) (((UserConstraint, ConstraintSource) -> IO ()) -> IO ())
-> ((UserConstraint, ConstraintSource) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(UserConstraint, ConstraintSource)
h ->
    Verbosity -> String -> IO ()
warn Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Constraint refers to an unknown package: "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ (UserConstraint, ConstraintSource) -> String
forall a. Pretty a => (a, ConstraintSource) -> String
showConstraint (UserConstraint, ConstraintSource)
h
  Maybe PackageVersionConstraint
-> (PackageVersionConstraint -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([PackageVersionConstraint] -> Maybe PackageVersionConstraint
forall a. [a] -> Maybe a
safeHead [PackageVersionConstraint]
unknownPreferences) ((PackageVersionConstraint -> IO ()) -> IO ())
-> (PackageVersionConstraint -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PackageVersionConstraint
h ->
    Verbosity -> String -> IO ()
warn Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Preference refers to an unknown package: "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ PackageVersionConstraint -> String
forall a. Pretty a => a -> String
prettyShow PackageVersionConstraint
h
  where
    unknownConstraints :: [(UserConstraint, ConstraintSource)]
unknownConstraints = ((UserConstraint, ConstraintSource) -> Bool)
-> [(UserConstraint, ConstraintSource)]
-> [(UserConstraint, ConstraintSource)]
forall a. (a -> Bool) -> [a] -> [a]
filter (PackageName -> Bool
unknown (PackageName -> Bool)
-> ((UserConstraint, ConstraintSource) -> PackageName)
-> (UserConstraint, ConstraintSource)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserConstraint -> PackageName
userConstraintPackageName (UserConstraint -> PackageName)
-> ((UserConstraint, ConstraintSource) -> UserConstraint)
-> (UserConstraint, ConstraintSource)
-> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UserConstraint, ConstraintSource) -> UserConstraint
forall a b. (a, b) -> a
fst) ([(UserConstraint, ConstraintSource)]
 -> [(UserConstraint, ConstraintSource)])
-> [(UserConstraint, ConstraintSource)]
-> [(UserConstraint, ConstraintSource)]
forall a b. (a -> b) -> a -> b
$
                         ConfigExFlags -> [(UserConstraint, ConstraintSource)]
configExConstraints ConfigExFlags
flags
    unknownPreferences :: [PackageVersionConstraint]
unknownPreferences = (PackageVersionConstraint -> Bool)
-> [PackageVersionConstraint] -> [PackageVersionConstraint]
forall a. (a -> Bool) -> [a] -> [a]
filter (PackageName -> Bool
unknown (PackageName -> Bool)
-> (PackageVersionConstraint -> PackageName)
-> PackageVersionConstraint
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \(PackageVersionConstraint PackageName
name VersionRange
_) -> PackageName
name) ([PackageVersionConstraint] -> [PackageVersionConstraint])
-> [PackageVersionConstraint] -> [PackageVersionConstraint]
forall a b. (a -> b) -> a -> b
$
                         ConfigExFlags -> [PackageVersionConstraint]
configPreferences ConfigExFlags
flags
    unknown :: PackageName -> Bool
unknown PackageName
pkg = [(Version, [InstalledPackageInfo])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (InstalledPackageIndex
-> PackageName -> [(Version, [InstalledPackageInfo])]
forall a. PackageIndex a -> PackageName -> [(Version, [a])]
PackageIndex.lookupPackageName InstalledPackageIndex
installedPkgIndex PackageName
pkg)
               Bool -> Bool -> Bool
&& Bool -> Bool
not (PackageIndex pkg -> PackageName -> Bool
forall pkg. Package pkg => PackageIndex pkg -> PackageName -> Bool
elemByPackageName PackageIndex pkg
sourcePkgIndex PackageName
pkg)
    showConstraint :: (a, ConstraintSource) -> String
showConstraint (a
uc, ConstraintSource
src) =
        a -> String
forall a. Pretty a => a -> String
prettyShow a
uc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ConstraintSource -> String
showConstraintSource ConstraintSource
src String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

-- | Make an 'InstallPlan' for the unpacked package in the current directory,
-- and all its dependencies.
--
planLocalPackage :: Verbosity -> Compiler
                 -> Platform
                 -> ConfigFlags -> ConfigExFlags
                 -> InstalledPackageIndex
                 -> SourcePackageDb
                 -> PkgConfigDb
                 -> IO (Progress String String SolverInstallPlan)
planLocalPackage :: Verbosity
-> Compiler
-> Platform
-> ConfigFlags
-> ConfigExFlags
-> InstalledPackageIndex
-> SourcePackageDb
-> PkgConfigDb
-> IO (Progress String String SolverInstallPlan)
planLocalPackage Verbosity
verbosity Compiler
comp Platform
platform ConfigFlags
configFlags ConfigExFlags
configExFlags
  InstalledPackageIndex
installedPkgIndex (SourcePackageDb PackageIndex UnresolvedSourcePackage
_ Map PackageName VersionRange
packagePrefs) PkgConfigDb
pkgConfigDb = do
  GenericPackageDescription
pkg <- Verbosity -> String -> IO GenericPackageDescription
readGenericPackageDescription Verbosity
verbosity (String -> IO GenericPackageDescription)
-> IO String -> IO GenericPackageDescription
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
            case Flag String -> Maybe String
forall a. Flag a -> Maybe a
flagToMaybe (ConfigFlags -> Flag String
configCabalFilePath ConfigFlags
configFlags) of
                Maybe String
Nothing -> Verbosity -> IO String
defaultPackageDesc Verbosity
verbosity
                Just String
fp -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
fp
  Solver
solver <- Verbosity -> PreSolver -> CompilerInfo -> IO Solver
chooseSolver Verbosity
verbosity (Flag PreSolver -> PreSolver
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag PreSolver -> PreSolver) -> Flag PreSolver -> PreSolver
forall a b. (a -> b) -> a -> b
$ ConfigExFlags -> Flag PreSolver
configSolver ConfigExFlags
configExFlags)
            (Compiler -> CompilerInfo
compilerInfo Compiler
comp)

  let -- We create a local package and ask to resolve a dependency on it
      localPkg :: SourcePackage (PackageLocation local)
localPkg = SourcePackage :: forall loc.
PackageId
-> GenericPackageDescription
-> loc
-> PackageDescriptionOverride
-> SourcePackage loc
SourcePackage {
        srcpkgPackageId :: PackageId
srcpkgPackageId          = GenericPackageDescription -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId GenericPackageDescription
pkg,
        srcpkgDescription :: GenericPackageDescription
srcpkgDescription        = GenericPackageDescription
pkg,
        srcpkgSource :: PackageLocation local
srcpkgSource             = String -> PackageLocation local
forall local. String -> PackageLocation local
LocalUnpackedPackage String
".",
        srcpkgDescrOverride :: PackageDescriptionOverride
srcpkgDescrOverride      = PackageDescriptionOverride
forall a. Maybe a
Nothing
      }

      testsEnabled :: Bool
      testsEnabled :: Bool
testsEnabled = Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (Flag Bool -> Bool) -> Flag Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag Bool
configTests ConfigFlags
configFlags
      benchmarksEnabled :: Bool
      benchmarksEnabled :: Bool
benchmarksEnabled =
        Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (Flag Bool -> Bool) -> Flag Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag Bool
configBenchmarks ConfigFlags
configFlags

      resolverParams :: DepResolverParams
      resolverParams :: DepResolverParams
resolverParams =
          AllowOlder -> DepResolverParams -> DepResolverParams
removeLowerBounds
          (AllowOlder -> Maybe AllowOlder -> AllowOlder
forall a. a -> Maybe a -> a
fromMaybe (RelaxDeps -> AllowOlder
AllowOlder RelaxDeps
forall a. Monoid a => a
mempty) (Maybe AllowOlder -> AllowOlder) -> Maybe AllowOlder -> AllowOlder
forall a b. (a -> b) -> a -> b
$ ConfigExFlags -> Maybe AllowOlder
configAllowOlder ConfigExFlags
configExFlags)
        (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllowNewer -> DepResolverParams -> DepResolverParams
removeUpperBounds
          (AllowNewer -> Maybe AllowNewer -> AllowNewer
forall a. a -> Maybe a -> a
fromMaybe (RelaxDeps -> AllowNewer
AllowNewer RelaxDeps
forall a. Monoid a => a
mempty) (Maybe AllowNewer -> AllowNewer) -> Maybe AllowNewer -> AllowNewer
forall a b. (a -> b) -> a -> b
$ ConfigExFlags -> Maybe AllowNewer
configAllowNewer ConfigExFlags
configExFlags)

        (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PackagePreference] -> DepResolverParams -> DepResolverParams
addPreferences
            -- preferences from the config file or command line
            [ PackageName -> VersionRange -> PackagePreference
PackageVersionPreference PackageName
name VersionRange
ver
            | PackageVersionConstraint PackageName
name VersionRange
ver <- ConfigExFlags -> [PackageVersionConstraint]
configPreferences ConfigExFlags
configExFlags ]

        (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LabeledPackageConstraint]
-> DepResolverParams -> DepResolverParams
addConstraints
            -- version constraints from the config file or command line
            -- TODO: should warn or error on constraints that are not on direct
            -- deps or flag constraints not on the package in question.
            [ PackageConstraint -> ConstraintSource -> LabeledPackageConstraint
LabeledPackageConstraint (UserConstraint -> PackageConstraint
userToPackageConstraint UserConstraint
uc) ConstraintSource
src
            | (UserConstraint
uc, ConstraintSource
src) <- ConfigExFlags -> [(UserConstraint, ConstraintSource)]
configExConstraints ConfigExFlags
configExFlags ]

        (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LabeledPackageConstraint]
-> DepResolverParams -> DepResolverParams
addConstraints
            -- package flags from the config file or command line
            [ let pc :: PackageConstraint
pc = ConstraintScope -> PackageProperty -> PackageConstraint
PackageConstraint
                       (PackageName -> ConstraintScope
scopeToplevel (PackageName -> ConstraintScope) -> PackageName -> ConstraintScope
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName GenericPackageDescription
pkg)
                       (FlagAssignment -> PackageProperty
PackagePropertyFlags (FlagAssignment -> PackageProperty)
-> FlagAssignment -> PackageProperty
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> FlagAssignment
configConfigurationsFlags ConfigFlags
configFlags)
              in PackageConstraint -> ConstraintSource -> LabeledPackageConstraint
LabeledPackageConstraint PackageConstraint
pc ConstraintSource
ConstraintSourceConfigFlagOrTarget
            ]

        (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LabeledPackageConstraint]
-> DepResolverParams -> DepResolverParams
addConstraints
            -- '--enable-tests' and '--enable-benchmarks' constraints from
            -- the config file or command line
            [ let pc :: PackageConstraint
pc = ConstraintScope -> PackageProperty -> PackageConstraint
PackageConstraint (PackageName -> ConstraintScope
scopeToplevel (PackageName -> ConstraintScope) -> PackageName -> ConstraintScope
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName GenericPackageDescription
pkg) (PackageProperty -> PackageConstraint)
-> ([OptionalStanza] -> PackageProperty)
-> [OptionalStanza]
-> PackageConstraint
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                       [OptionalStanza] -> PackageProperty
PackagePropertyStanzas ([OptionalStanza] -> PackageConstraint)
-> [OptionalStanza] -> PackageConstraint
forall a b. (a -> b) -> a -> b
$
                       [ OptionalStanza
TestStanzas  | Bool
testsEnabled ] [OptionalStanza] -> [OptionalStanza] -> [OptionalStanza]
forall a. [a] -> [a] -> [a]
++
                       [ OptionalStanza
BenchStanzas | Bool
benchmarksEnabled ]
              in PackageConstraint -> ConstraintSource -> LabeledPackageConstraint
LabeledPackageConstraint PackageConstraint
pc ConstraintSource
ConstraintSourceConfigFlagOrTarget
            ]

            -- Don't solve for executables, since we use an empty source
            -- package database and executables never show up in the
            -- installed package index
        (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SolveExecutables -> DepResolverParams -> DepResolverParams
setSolveExecutables (Bool -> SolveExecutables
SolveExecutables Bool
False)

        (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> DepResolverParams -> DepResolverParams
setSolverVerbosity Verbosity
verbosity

        (DepResolverParams -> DepResolverParams)
-> DepResolverParams -> DepResolverParams
forall a b. (a -> b) -> a -> b
$ InstalledPackageIndex
-> SourcePackageDb
-> [PackageSpecifier UnresolvedSourcePackage]
-> DepResolverParams
standardInstallPolicy
            InstalledPackageIndex
installedPkgIndex
            -- NB: We pass in an *empty* source package database,
            -- because cabal configure assumes that all dependencies
            -- have already been installed
            (PackageIndex UnresolvedSourcePackage
-> Map PackageName VersionRange -> SourcePackageDb
SourcePackageDb PackageIndex UnresolvedSourcePackage
forall a. Monoid a => a
mempty Map PackageName VersionRange
packagePrefs)
            [UnresolvedSourcePackage -> PackageSpecifier UnresolvedSourcePackage
forall pkg. pkg -> PackageSpecifier pkg
SpecificSourcePackage UnresolvedSourcePackage
forall local. SourcePackage (PackageLocation local)
localPkg]

  Progress String String SolverInstallPlan
-> IO (Progress String String SolverInstallPlan)
forall (m :: * -> *) a. Monad m => a -> m a
return (Platform
-> CompilerInfo
-> PkgConfigDb
-> Solver
-> DepResolverParams
-> Progress String String SolverInstallPlan
resolveDependencies Platform
platform (Compiler -> CompilerInfo
compilerInfo Compiler
comp) PkgConfigDb
pkgConfigDb Solver
solver DepResolverParams
resolverParams)


-- | Call an installer for an 'SourcePackage' but override the configure
-- flags with the ones given by the 'ReadyPackage'. In particular the
-- 'ReadyPackage' specifies an exact 'FlagAssignment' and exactly
-- versioned package dependencies. So we ignore any previous partial flag
-- assignment or dependency constraints and use the new ones.
--
-- NB: when updating this function, don't forget to also update
-- 'installReadyPackage' in D.C.Install.
configurePackage :: Verbosity
                 -> Platform -> CompilerInfo
                 -> SetupScriptOptions
                 -> ConfigFlags
                 -> ReadyPackage
                 -> [String]
                 -> IO ()
configurePackage :: Verbosity
-> Platform
-> CompilerInfo
-> SetupScriptOptions
-> ConfigFlags
-> ReadyPackage
-> [String]
-> IO ()
configurePackage Verbosity
verbosity Platform
platform CompilerInfo
comp SetupScriptOptions
scriptOptions ConfigFlags
configFlags
                 (ReadyPackage (ConfiguredPackage InstalledPackageId
ipid UnresolvedSourcePackage
spkg FlagAssignment
flags OptionalStanzaSet
stanzas ComponentDeps [ConfiguredId]
deps))
                 [String]
extraArgs =

  Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI ConfigFlags
-> (Version -> ConfigFlags)
-> (Version -> [String])
-> IO ()
forall flags.
Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
-> (Version -> flags)
-> (Version -> [String])
-> IO ()
setupWrapper Verbosity
verbosity
    SetupScriptOptions
scriptOptions (PackageDescription -> Maybe PackageDescription
forall a. a -> Maybe a
Just PackageDescription
pkg) CommandUI ConfigFlags
configureCommand Version -> ConfigFlags
configureFlags ([String] -> Version -> [String]
forall a b. a -> b -> a
const [String]
extraArgs)

  where
    gpkg :: PkgDesc.GenericPackageDescription
    gpkg :: GenericPackageDescription
gpkg = UnresolvedSourcePackage -> GenericPackageDescription
forall loc. SourcePackage loc -> GenericPackageDescription
srcpkgDescription UnresolvedSourcePackage
spkg
    configureFlags :: Version -> ConfigFlags
    configureFlags :: Version -> ConfigFlags
configureFlags   = ConfigFlags -> Version -> ConfigFlags
filterConfigureFlags ConfigFlags
configFlags {
      configIPID :: Flag String
configIPID = if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Flag String -> Maybe String
forall a. Flag a -> Maybe a
flagToMaybe (ConfigFlags -> Flag String
configIPID ConfigFlags
configFlags))
                    -- Make sure cabal configure --ipid works.
                    then ConfigFlags -> Flag String
configIPID ConfigFlags
configFlags
                    else String -> Flag String
forall a. a -> Flag a
toFlag (InstalledPackageId -> String
forall a. Pretty a => a -> String
prettyShow InstalledPackageId
ipid),
      configConfigurationsFlags :: FlagAssignment
configConfigurationsFlags = FlagAssignment
flags,
      -- We generate the legacy constraints as well as the new style precise
      -- deps.  In the end only one set gets passed to Setup.hs configure,
      -- depending on the Cabal version we are talking to.
      configConstraints :: [PackageVersionConstraint]
configConstraints  = [ PackageId -> PackageVersionConstraint
thisPackageVersionConstraint PackageId
srcid
                           | ConfiguredId PackageId
srcid (Just (PkgDesc.CLibName LibraryName
PkgDesc.LMainLibName)) InstalledPackageId
_uid
                               <- ComponentDeps [ConfiguredId] -> [ConfiguredId]
forall a. Monoid a => ComponentDeps a -> a
CD.nonSetupDeps ComponentDeps [ConfiguredId]
deps ],
      configDependencies :: [GivenComponent]
configDependencies = [ PackageName -> LibraryName -> InstalledPackageId -> GivenComponent
GivenComponent (PackageId -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
srcid) LibraryName
cname InstalledPackageId
uid
                           | ConfiguredId PackageId
srcid (Just (PkgDesc.CLibName LibraryName
cname)) InstalledPackageId
uid
                               <- ComponentDeps [ConfiguredId] -> [ConfiguredId]
forall a. Monoid a => ComponentDeps a -> a
CD.nonSetupDeps ComponentDeps [ConfiguredId]
deps ],
      -- Use '--exact-configuration' if supported.
      configExactConfiguration :: Flag Bool
configExactConfiguration = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
      configVerbosity :: Flag Verbosity
configVerbosity          = Verbosity -> Flag Verbosity
forall a. a -> Flag a
toFlag Verbosity
verbosity,
      -- NB: if the user explicitly specified
      -- --enable-tests/--enable-benchmarks, always respect it.
      -- (But if they didn't, let solver decide.)
      configBenchmarks :: Flag Bool
configBenchmarks         = Bool -> Flag Bool
forall a. a -> Flag a
toFlag (OptionalStanza
BenchStanzas OptionalStanza -> OptionalStanzaSet -> Bool
`optStanzaSetMember` OptionalStanzaSet
stanzas)
                                    Flag Bool -> Flag Bool -> Flag Bool
forall a. Monoid a => a -> a -> a
`mappend` ConfigFlags -> Flag Bool
configBenchmarks ConfigFlags
configFlags,
      configTests :: Flag Bool
configTests              = Bool -> Flag Bool
forall a. a -> Flag a
toFlag (OptionalStanza
TestStanzas OptionalStanza -> OptionalStanzaSet -> Bool
`optStanzaSetMember` OptionalStanzaSet
stanzas)
                                    Flag Bool -> Flag Bool -> Flag Bool
forall a. Monoid a => a -> a -> a
`mappend` ConfigFlags -> Flag Bool
configTests ConfigFlags
configFlags
    }

    pkg :: PkgDesc.PackageDescription
    pkg :: PackageDescription
pkg = case FlagAssignment
-> ComponentRequestedSpec
-> (Dependency -> Bool)
-> Platform
-> CompilerInfo
-> [PackageVersionConstraint]
-> GenericPackageDescription
-> Either [Dependency] (PackageDescription, FlagAssignment)
finalizePD FlagAssignment
flags (OptionalStanzaSet -> ComponentRequestedSpec
enableStanzas OptionalStanzaSet
stanzas)
           (Bool -> Dependency -> Bool
forall a b. a -> b -> a
const Bool
True)
           Platform
platform CompilerInfo
comp [] GenericPackageDescription
gpkg of
      Left [Dependency]
_ -> String -> PackageDescription
forall a. HasCallStack => String -> a
error String
"finalizePD ReadyPackage failed"
      Right (PackageDescription
desc, FlagAssignment
_) -> PackageDescription
desc

-- -----------------------------------------------------------------------------
-- * Saved configure environments and flags
-- -----------------------------------------------------------------------------

-- | Read saved configure flags and restore the saved environment from the
-- specified files.
readConfigFlagsFrom :: FilePath  -- ^ path to saved flags file
                    -> IO (ConfigFlags, ConfigExFlags)
readConfigFlagsFrom :: String -> IO (ConfigFlags, ConfigExFlags)
readConfigFlagsFrom String
flags = do
  String
-> CommandUI (ConfigFlags, ConfigExFlags)
-> IO (ConfigFlags, ConfigExFlags)
forall flags. String -> CommandUI flags -> IO flags
readCommandFlags String
flags CommandUI (ConfigFlags, ConfigExFlags)
configureExCommand

-- | The path (relative to @--build-dir@) where the arguments to @configure@
-- should be saved.
cabalConfigFlagsFile :: FilePath -> FilePath
cabalConfigFlagsFile :: String -> String
cabalConfigFlagsFile String
dist = String
dist String -> String -> String
</> String
"cabal-config-flags"

-- | Read saved configure flags and restore the saved environment from the
-- usual location.
readConfigFlags :: FilePath  -- ^ @--build-dir@
                -> IO (ConfigFlags, ConfigExFlags)
readConfigFlags :: String -> IO (ConfigFlags, ConfigExFlags)
readConfigFlags String
dist =
  String -> IO (ConfigFlags, ConfigExFlags)
readConfigFlagsFrom (String -> String
cabalConfigFlagsFile String
dist)

-- | Save the configure flags and environment to the specified files.
writeConfigFlagsTo :: FilePath  -- ^ path to saved flags file
                   -> Verbosity -> (ConfigFlags, ConfigExFlags)
                   -> IO ()
writeConfigFlagsTo :: String -> Verbosity -> (ConfigFlags, ConfigExFlags) -> IO ()
writeConfigFlagsTo String
file Verbosity
verb (ConfigFlags, ConfigExFlags)
flags = do
  Verbosity
-> String
-> CommandUI (ConfigFlags, ConfigExFlags)
-> (ConfigFlags, ConfigExFlags)
-> IO ()
forall flags.
Verbosity -> String -> CommandUI flags -> flags -> IO ()
writeCommandFlags Verbosity
verb String
file CommandUI (ConfigFlags, ConfigExFlags)
configureExCommand (ConfigFlags, ConfigExFlags)
flags

-- | Save the build flags to the usual location.
writeConfigFlags :: Verbosity
                 -> FilePath  -- ^ @--build-dir@
                 -> (ConfigFlags, ConfigExFlags) -> IO ()
writeConfigFlags :: Verbosity -> String -> (ConfigFlags, ConfigExFlags) -> IO ()
writeConfigFlags Verbosity
verb String
dist =
  String -> Verbosity -> (ConfigFlags, ConfigExFlags) -> IO ()
writeConfigFlagsTo (String -> String
cabalConfigFlagsFile String
dist) Verbosity
verb