Configure.hs 16.5 KB
Newer Older
1
{-# LANGUAGE CPP #-}
2 3 4 5 6 7 8 9 10 11 12 13 14 15
-----------------------------------------------------------------------------
-- |
-- 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,
16
    configureSetupScript,
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
17
    chooseCabalVersion,
18
    checkConfigExFlags
19 20 21 22
  ) where

import Distribution.Client.Dependency
import qualified Distribution.Client.InstallPlan as InstallPlan
23
import Distribution.Client.SolverInstallPlan (SolverInstallPlan)
24
import Distribution.Client.IndexUtils as IndexUtils
25
         ( getSourcePackages, getInstalledPackages )
26
import Distribution.Client.Setup
Edsko de Vries's avatar
Edsko de Vries committed
27 28
         ( ConfigExFlags(..), configureCommand, filterConfigureFlags
         , RepoContext(..) )
29
import Distribution.Client.Types as Source
30 31
import Distribution.Client.SetupWrapper
         ( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions )
32
import Distribution.Client.Targets
33
         ( userToPackageConstraint, userConstraintPackageName )
34 35
import Distribution.Package (PackageId)
import Distribution.Client.JobControl (Lock)
36

37
import qualified Distribution.Solver.Types.ComponentDeps as CD
38
import           Distribution.Solver.Types.ConstraintSource
39
import           Distribution.Solver.Types.LabeledPackageConstraint
40 41 42 43 44 45 46
import           Distribution.Solver.Types.OptionalStanza
import           Distribution.Solver.Types.PackageIndex
                   ( PackageIndex, elemByPackageName )
import           Distribution.Solver.Types.PkgConfigDb
                   (PkgConfigDb, readPkgConfigDb)
import           Distribution.Solver.Types.SourcePackage

47
import Distribution.Simple.Compiler
48
         ( Compiler, CompilerInfo, compilerInfo, PackageDB(..), PackageDBStack )
49
import Distribution.Simple.Program (ProgramDb )
50
import Distribution.Simple.Setup
51
         ( ConfigFlags(..), AllowNewer(..), AllowOlder(..), RelaxDeps(..)
52
         , fromFlag, toFlag, flagToMaybe, fromFlagOrDefault )
53 54
import Distribution.Simple.PackageIndex
         ( InstalledPackageIndex, lookupPackageName )
55 56 57
import Distribution.Simple.Utils
         ( defaultPackageDesc )
import Distribution.Package
58
         ( Package(..), packageName
59 60 61
         , Dependency(..), thisPackageVersion
         )
import qualified Distribution.PackageDescription as PkgDesc
62 63 64
import Distribution.PackageDescription.Parse
         ( readPackageDescription )
import Distribution.PackageDescription.Configuration
65
         ( finalizePD )
66
import Distribution.Version
67
         ( anyVersion, thisVersion )
68
import Distribution.Simple.Utils as Utils
69
         ( warn, notice, debug, die )
70
import Distribution.Simple.Setup
71
         ( isRelaxDeps )
72
import Distribution.System
73
         ( Platform )
74
import Distribution.Text ( display )
75 76
import Distribution.Verbosity as Verbosity
         ( Verbosity )
77
import Distribution.Version
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
78
         ( Version(..), VersionRange, orLaterVersion )
79

80
import Control.Monad (unless)
81
#if !MIN_VERSION_base(4,8,0)
82
import Data.Monoid (Monoid(..))
83
#endif
84
import Data.Maybe (isJust, fromMaybe)
85

Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
86 87
-- | Choose the Cabal version such that the setup scripts compiled against this
-- version will support the given command-line flags.
88 89
chooseCabalVersion :: ConfigFlags -> Maybe Version -> VersionRange
chooseCabalVersion configFlags maybeVersion =
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
90 91
  maybe defaultVersionRange thisVersion maybeVersion
  where
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
92 93
    -- Cabal < 1.19.2 doesn't support '--exact-configuration' which is needed
    -- for '--allow-newer' to work.
94 95
    allowNewer = isRelaxDeps
                 (maybe RelaxDepsNone unAllowNewer $ configAllowNewer configFlags)
96 97
    allowOlder = isRelaxDeps
                 (maybe RelaxDepsNone unAllowOlder $ configAllowOlder configFlags)
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
98

99
    defaultVersionRange = if allowOlder || allowNewer
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
100 101 102
                          then orLaterVersion (Version [1,19,2] [])
                          else anyVersion

103 104
-- | Configure the package found in the local directory
configure :: Verbosity
105
          -> PackageDBStack
Edsko de Vries's avatar
Edsko de Vries committed
106
          -> RepoContext
107
          -> Compiler
108
          -> Platform
109
          -> ProgramDb
110
          -> ConfigFlags
111
          -> ConfigExFlags
112 113
          -> [String]
          -> IO ()
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
114
configure verbosity packageDBs repoCtxt comp platform progdb
115 116
  configFlags configExFlags extraArgs = do

Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
117
  installedPkgIndex <- getInstalledPackages verbosity comp packageDBs progdb
Edsko de Vries's avatar
Edsko de Vries committed
118
  sourcePkgDb       <- getSourcePackages    verbosity repoCtxt
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
119
  pkgConfigDb       <- readPkgConfigDb      verbosity progdb
120

121 122
  checkConfigExFlags verbosity installedPkgIndex
                     (packageIndex sourcePkgDb) configExFlags
123

124
  progress <- planLocalPackage verbosity comp platform configFlags configExFlags
125
                               installedPkgIndex sourcePkgDb pkgConfigDb
126 127

  notice verbosity "Resolving dependencies..."
128 129
  maybePlan <- foldProgress logMsg (return . Left) (return . Right)
                            progress
130
  case maybePlan of
131
    Left message -> do
132 133
      warn verbosity $
           "solver failed to find a solution:\n"
134 135
        ++ message
        ++ "Trying configure anyway."
136 137
      setupWrapper verbosity (setupScriptOptions installedPkgIndex Nothing)
        Nothing configureCommand (const configFlags) extraArgs
138

139
    Right installPlan0 ->
140
     let installPlan = InstallPlan.configureInstallPlan installPlan0
141
     in case fst (InstallPlan.ready installPlan) of
142
      [pkg@(ReadyPackage
Edward Z. Yang's avatar
Edward Z. Yang committed
143
              (ConfiguredPackage _ (SourcePackage _ _ (LocalUnpackedPackage _) _)
144
                                 _ _ _))] -> do
145
        configurePackage verbosity
146
          platform (compilerInfo comp)
147
          (setupScriptOptions installedPkgIndex (Just pkg))
148 149 150 151 152 153
          configFlags pkg extraArgs

      _ -> die $ "internal error: configure install plan should have exactly "
              ++ "one local ready package."

  where
154
    setupScriptOptions :: InstalledPackageIndex
155
                       -> Maybe ReadyPackage
156
                       -> SetupScriptOptions
157 158 159 160 161
    setupScriptOptions =
      configureSetupScript
        packageDBs
        comp
        platform
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
162
        progdb
163 164 165 166
        (fromFlagOrDefault
           (useDistPref defaultSetupScriptOptions)
           (configDistPref configFlags))
        (chooseCabalVersion
167
           configFlags
168 169 170
           (flagToMaybe (configCabalVersion configExFlags)))
        Nothing
        False
171

172 173
    logMsg message rest = debug verbosity message >> rest

174 175 176
configureSetupScript :: PackageDBStack
                     -> Compiler
                     -> Platform
177
                     -> ProgramDb
178 179 180 181 182
                     -> FilePath
                     -> VersionRange
                     -> Maybe Lock
                     -> Bool
                     -> InstalledPackageIndex
183
                     -> Maybe ReadyPackage
184 185 186 187
                     -> SetupScriptOptions
configureSetupScript packageDBs
                     comp
                     platform
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
188
                     progdb
189 190 191 192 193 194 195
                     distPref
                     cabalVersion
                     lock
                     forceExternal
                     index
                     mpkg
  = SetupScriptOptions {
196 197 198 199 200 201
      useCabalVersion          = cabalVersion
    , useCabalSpecVersion      = Nothing
    , useCompiler              = Just comp
    , usePlatform              = Just platform
    , usePackageDB             = packageDBs'
    , usePackageIndex          = index'
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
202
    , useProgramDb             = progdb
203 204 205
    , useDistPref              = distPref
    , useLoggingHandle         = Nothing
    , useWorkingDir            = Nothing
206
    , useExtraPathEnv          = []
207 208
    , setupCacheLock           = lock
    , useWin32CleanHack        = False
209 210 211 212 213 214 215 216
    , forceExternalSetupMethod = 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          = fromMaybe [] explicitSetupDeps
217 218
    , useDependenciesExclusive = not defaultSetupDeps && isJust explicitSetupDeps
    , useVersionMacros         = not defaultSetupDeps && isJust explicitSetupDeps
219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235
    }
  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
    (packageDBs', index') =
      case packageDBs of
        (GlobalPackageDB:dbs) | UserPackageDB `notElem` dbs
                              , Nothing <- explicitSetupDeps
            -> (GlobalPackageDB:UserPackageDB:dbs, Nothing)
        -- but if the user is using an odd db stack, don't touch it
        _otherwise -> (packageDBs, Just index)

236 237
    maybeSetupBuildInfo :: Maybe PkgDesc.SetupBuildInfo
    maybeSetupBuildInfo = do
238
      ReadyPackage cpkg <- mpkg
239
      let gpkg = packageDescription (confPkgSource cpkg)
240 241 242 243 244 245 246 247
      PkgDesc.setupBuildInfo (PkgDesc.packageDescription 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 = maybe False PkgDesc.defaultSetupDepends
                       maybeSetupBuildInfo

248
    explicitSetupDeps :: Maybe [(InstalledPackageId, PackageId)]
249 250 251
    explicitSetupDeps = do
      -- Check if there is an explicit setup stanza.
      _buildInfo <- maybeSetupBuildInfo
252
      -- Return the setup dependencies computed by the solver
253
      ReadyPackage cpkg <- mpkg
254 255
      return [ ( cid, srcid )
             | ConfiguredId srcid cid <- CD.setupDeps (confPkgDeps cpkg)
256 257
             ]

258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282
-- | 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 installedPkgIndex sourcePkgIndex flags = do
  unless (null unknownConstraints) $ warn verbosity $
             "Constraint refers to an unknown package: "
          ++ showConstraint (head unknownConstraints)
  unless (null unknownPreferences) $ warn verbosity $
             "Preference refers to an unknown package: "
          ++ display (head unknownPreferences)
  where
    unknownConstraints = filter (unknown . userConstraintPackageName . fst) $
                         configExConstraints flags
    unknownPreferences = filter (unknown . \(Dependency name _) -> name) $
                         configPreferences flags
    unknown pkg = null (lookupPackageName installedPkgIndex pkg)
               && not (elemByPackageName sourcePkgIndex pkg)
    showConstraint (uc, src) =
        display uc ++ " (" ++ showConstraintSource src ++ ")"

283 284 285 286
-- | Make an 'InstallPlan' for the unpacked package in the current directory,
-- and all its dependencies.
--
planLocalPackage :: Verbosity -> Compiler
287
                 -> Platform
288
                 -> ConfigFlags -> ConfigExFlags
289
                 -> InstalledPackageIndex
290
                 -> SourcePackageDb
291
                 -> PkgConfigDb
292
                 -> IO (Progress String String SolverInstallPlan)
293
planLocalPackage verbosity comp platform configFlags configExFlags
294
  installedPkgIndex (SourcePackageDb _ packagePrefs) pkgConfigDb = do
295
  pkg <- readPackageDescription verbosity =<< defaultPackageDesc verbosity
296 297
  solver <- chooseSolver verbosity (fromFlag $ configSolver configExFlags)
            (compilerInfo comp)
298 299

  let -- We create a local package and ask to resolve a dependency on it
300 301
      localPkg = SourcePackage {
        packageInfoId             = packageId pkg,
302
        packageDescription        = pkg,
303 304
        packageSource             = LocalUnpackedPackage ".",
        packageDescrOverride      = Nothing
305
      }
306

307 308 309 310
      testsEnabled = fromFlagOrDefault False $ configTests configFlags
      benchmarksEnabled =
        fromFlagOrDefault False $ configBenchmarks configFlags

311
      resolverParams =
312 313 314 315
          removeLowerBounds
          (fromMaybe (AllowOlder RelaxDepsNone) $ configAllowOlder configFlags)
        . removeUpperBounds
          (fromMaybe (AllowNewer RelaxDepsNone) $ configAllowNewer configFlags)
316

317
        . addPreferences
318 319 320 321 322 323
            -- preferences from the config file or command line
            [ PackageVersionPreference name ver
            | Dependency name ver <- configPreferences configExFlags ]

        . addConstraints
            -- version constraints from the config file or command line
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
324 325
            -- TODO: should warn or error on constraints that are not on direct
            -- deps or flag constraints not on the package in question.
326
            [ LabeledPackageConstraint (userToPackageConstraint uc) src
327
            | (uc, src) <- configExConstraints configExFlags ]
328 329 330

        . addConstraints
            -- package flags from the config file or command line
331 332
            [ let pc = PackageConstraintFlags (packageName pkg)
                       (configConfigurationsFlags configFlags)
333 334
              in LabeledPackageConstraint pc ConstraintSourceConfigFlagOrTarget
            ]
335

336 337
        . addConstraints
            -- '--enable-tests' and '--enable-benchmarks' constraints from
338
            -- the config file or command line
339 340 341
            [ let pc = PackageConstraintStanzas (packageName pkg) $
                       [ TestStanzas  | testsEnabled ] ++
                       [ BenchStanzas | benchmarksEnabled ]
342
              in LabeledPackageConstraint pc ConstraintSourceConfigFlagOrTarget
343 344
            ]

345
        $ standardInstallPolicy
346 347
            installedPkgIndex
            (SourcePackageDb mempty packagePrefs)
348
            [SpecificSourcePackage localPkg]
349

350
  return (resolveDependencies platform (compilerInfo comp) pkgConfigDb solver resolverParams)
351

352

353
-- | Call an installer for an 'SourcePackage' but override the configure
354 355
-- flags with the ones given by the 'ReadyPackage'. In particular the
-- 'ReadyPackage' specifies an exact 'FlagAssignment' and exactly
356 357 358
-- versioned package dependencies. So we ignore any previous partial flag
-- assignment or dependency constraints and use the new ones.
--
359 360
-- NB: when updating this function, don't forget to also update
-- 'installReadyPackage' in D.C.Install.
361
configurePackage :: Verbosity
362
                 -> Platform -> CompilerInfo
363
                 -> SetupScriptOptions
364
                 -> ConfigFlags
365
                 -> ReadyPackage
366 367
                 -> [String]
                 -> IO ()
368
configurePackage verbosity platform comp scriptOptions configFlags
Edward Z. Yang's avatar
Edward Z. Yang committed
369
                 (ReadyPackage (ConfiguredPackage ipid spkg flags stanzas deps))
370
                 extraArgs =
371 372 373 374 375

  setupWrapper verbosity
    scriptOptions (Just pkg) configureCommand configureFlags extraArgs

  where
376
    gpkg = packageDescription spkg
377
    configureFlags   = filterConfigureFlags configFlags {
Edward Z. Yang's avatar
Edward Z. Yang committed
378
      configIPID = toFlag (display ipid),
379
      configConfigurationsFlags = flags,
380 381 382
      -- 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.
383 384 385 386
      configConstraints  = [ thisPackageVersion srcid
                           | ConfiguredId srcid _uid <- CD.nonSetupDeps deps ],
      configDependencies = [ (packageName srcid, uid)
                           | ConfiguredId srcid uid <- CD.nonSetupDeps deps ],
387 388
      -- Use '--exact-configuration' if supported.
      configExactConfiguration = toFlag True,
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
389
      configVerbosity          = toFlag verbosity,
390 391 392 393 394
      -- NB: if the user explicitly specified
      -- --enable-tests/--enable-benchmarks, always respect it.
      -- (But if they didn't, let solver decide.)
      configBenchmarks         = toFlag (BenchStanzas `elem` stanzas)
                                    `mappend` configBenchmarks configFlags,
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
395
      configTests              = toFlag (TestStanzas `elem` stanzas)
396
                                    `mappend` configTests configFlags
397 398
    }

399
    pkg = case finalizePD flags (enableStanzas stanzas)
400
           (const True)
401
           platform comp [] gpkg of
402
      Left _ -> error "finalizePD ReadyPackage failed"
403
      Right (desc, _) -> desc