Configure.hs 16 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 (ProgramConfiguration )
50
import Distribution.Simple.Setup
51
         ( ConfigFlags(..), AllowNewer(..), 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(..), UnitId, 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)
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
96 97 98 99 100

    defaultVersionRange = if allowNewer
                          then orLaterVersion (Version [1,19,2] [])
                          else anyVersion

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

115
  installedPkgIndex <- getInstalledPackages verbosity comp packageDBs conf
Edsko de Vries's avatar
Edsko de Vries committed
116
  sourcePkgDb       <- getSourcePackages    verbosity repoCtxt
117 118
  pkgConfigDb       <- readPkgConfigDb      verbosity conf

119 120
  checkConfigExFlags verbosity installedPkgIndex
                     (packageIndex sourcePkgDb) configExFlags
121

122
  progress <- planLocalPackage verbosity comp platform configFlags configExFlags
123
                               installedPkgIndex sourcePkgDb pkgConfigDb
124 125

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

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

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

  where
152
    setupScriptOptions :: InstalledPackageIndex
153
                       -> Maybe ReadyPackage
154
                       -> SetupScriptOptions
155 156 157 158 159 160 161 162 163 164
    setupScriptOptions =
      configureSetupScript
        packageDBs
        comp
        platform
        conf
        (fromFlagOrDefault
           (useDistPref defaultSetupScriptOptions)
           (configDistPref configFlags))
        (chooseCabalVersion
165
           configFlags
166 167 168
           (flagToMaybe (configCabalVersion configExFlags)))
        Nothing
        False
169

170 171
    logMsg message rest = debug verbosity message >> rest

172 173 174 175 176 177 178 179 180
configureSetupScript :: PackageDBStack
                     -> Compiler
                     -> Platform
                     -> ProgramConfiguration
                     -> FilePath
                     -> VersionRange
                     -> Maybe Lock
                     -> Bool
                     -> InstalledPackageIndex
181
                     -> Maybe ReadyPackage
182 183 184 185 186 187 188 189 190 191 192 193
                     -> SetupScriptOptions
configureSetupScript packageDBs
                     comp
                     platform
                     conf
                     distPref
                     cabalVersion
                     lock
                     forceExternal
                     index
                     mpkg
  = SetupScriptOptions {
194 195 196 197 198 199 200 201 202 203 204 205
      useCabalVersion          = cabalVersion
    , useCabalSpecVersion      = Nothing
    , useCompiler              = Just comp
    , usePlatform              = Just platform
    , usePackageDB             = packageDBs'
    , usePackageIndex          = index'
    , useProgramConfig         = conf
    , useDistPref              = distPref
    , useLoggingHandle         = Nothing
    , useWorkingDir            = Nothing
    , setupCacheLock           = lock
    , useWin32CleanHack        = False
206 207 208 209 210 211 212 213
    , 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
214 215
    , useDependenciesExclusive = not defaultSetupDeps && isJust explicitSetupDeps
    , useVersionMacros         = not defaultSetupDeps && isJust explicitSetupDeps
216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232
    }
  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)

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

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

255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279
-- | 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 ++ ")"

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

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

304 305 306 307
      testsEnabled = fromFlagOrDefault False $ configTests configFlags
      benchmarksEnabled =
        fromFlagOrDefault False $ configBenchmarks configFlags

308
      resolverParams =
309
          removeUpperBounds
310
          (maybe RelaxDepsNone unAllowNewer $ configAllowNewer configFlags)
311

312
        . addPreferences
313 314 315 316 317 318
            -- 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
319 320
            -- TODO: should warn or error on constraints that are not on direct
            -- deps or flag constraints not on the package in question.
321
            [ LabeledPackageConstraint (userToPackageConstraint uc) src
322
            | (uc, src) <- configExConstraints configExFlags ]
323 324 325

        . addConstraints
            -- package flags from the config file or command line
326 327
            [ let pc = PackageConstraintFlags (packageName pkg)
                       (configConfigurationsFlags configFlags)
328 329
              in LabeledPackageConstraint pc ConstraintSourceConfigFlagOrTarget
            ]
330

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

340
        $ standardInstallPolicy
341 342
            installedPkgIndex
            (SourcePackageDb mempty packagePrefs)
343
            [SpecificSourcePackage localPkg]
344

345
  return (resolveDependencies platform (compilerInfo comp) pkgConfigDb solver resolverParams)
346

347

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

  setupWrapper verbosity
    scriptOptions (Just pkg) configureCommand configureFlags extraArgs

  where
371
    gpkg = packageDescription spkg
372
    configureFlags   = filterConfigureFlags configFlags {
Edward Z. Yang's avatar
Edward Z. Yang committed
373
      configIPID = toFlag (display ipid),
374
      configConfigurationsFlags = flags,
375 376 377
      -- 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.
378 379 380 381
      configConstraints  = [ thisPackageVersion srcid
                           | ConfiguredId srcid _uid <- CD.nonSetupDeps deps ],
      configDependencies = [ (packageName srcid, uid)
                           | ConfiguredId srcid uid <- CD.nonSetupDeps deps ],
382 383
      -- Use '--exact-configuration' if supported.
      configExactConfiguration = toFlag True,
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
384 385 386
      configVerbosity          = toFlag verbosity,
      configBenchmarks         = toFlag (BenchStanzas `elem` stanzas),
      configTests              = toFlag (TestStanzas `elem` stanzas)
387 388
    }

389
    pkg = case finalizePD flags (enableStanzas stanzas)
390
           (const True)
391
           platform comp [] gpkg of
392
      Left _ -> error "finalizePD ReadyPackage failed"
393
      Right (desc, _) -> desc