Configure.hs 13.6 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 19 20
  ) where

import Distribution.Client.Dependency
21
import Distribution.Client.Dependency.Types
22 23
         ( AllowNewer(..), isAllowNewer, ConstraintSource(..)
         , LabeledPackageConstraint(..) )
24 25 26
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.InstallPlan (InstallPlan)
import Distribution.Client.IndexUtils as IndexUtils
27
         ( getSourcePackages, getInstalledPackages )
28
import Distribution.Client.Setup
29
         ( ConfigExFlags(..), configureCommand, filterConfigureFlags )
30
import Distribution.Client.Types as Source
31 32
import Distribution.Client.SetupWrapper
         ( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions )
33 34
import Distribution.Client.Targets
         ( userToPackageConstraint )
35
import qualified Distribution.Client.ComponentDeps as CD
36 37
import Distribution.Package (PackageId)
import Distribution.Client.JobControl (Lock)
38 39

import Distribution.Simple.Compiler
40
         ( Compiler, CompilerInfo, compilerInfo, PackageDB(..), PackageDBStack )
41
import Distribution.Simple.Program (ProgramConfiguration )
42
import Distribution.Simple.Setup
43
         ( ConfigFlags(..), fromFlag, toFlag, flagToMaybe, fromFlagOrDefault )
44
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
45 46
import Distribution.Simple.Utils
         ( defaultPackageDesc )
47
import qualified Distribution.InstalledPackageInfo as Installed
48
import Distribution.Package
49 50 51 52
         ( Package(..), InstalledPackageId, packageName
         , Dependency(..), thisPackageVersion
         )
import qualified Distribution.PackageDescription as PkgDesc
53 54 55 56 57
import Distribution.PackageDescription.Parse
         ( readPackageDescription )
import Distribution.PackageDescription.Configuration
         ( finalizePackageDescription )
import Distribution.Version
58
         ( anyVersion, thisVersion )
59
import Distribution.Simple.Utils as Utils
60
         ( notice, info, debug, die )
61
import Distribution.System
62
         ( Platform )
63 64
import Distribution.Verbosity as Verbosity
         ( Verbosity )
65
import Distribution.Version
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
66
         ( Version(..), VersionRange, orLaterVersion )
67

68
#if !MIN_VERSION_base(4,8,0)
69
import Data.Monoid (Monoid(..))
70
#endif
71
import Data.Maybe (isJust, fromMaybe)
72

Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
73 74 75 76 77 78
-- | 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 maybeVersion =
  maybe defaultVersionRange thisVersion maybeVersion
  where
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
79 80
    -- Cabal < 1.19.2 doesn't support '--exact-configuration' which is needed
    -- for '--allow-newer' to work.
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
81 82 83 84 85 86 87
    allowNewer = fromFlagOrDefault False $
                 fmap isAllowNewer (configAllowNewer configExFlags)

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

88 89
-- | Configure the package found in the local directory
configure :: Verbosity
90
          -> PackageDBStack
91 92
          -> [Repo]
          -> Compiler
93
          -> Platform
94
          -> ProgramConfiguration
95
          -> ConfigFlags
96
          -> ConfigExFlags
97 98
          -> [String]
          -> IO ()
99
configure verbosity packageDBs repos comp platform conf
100 101
  configFlags configExFlags extraArgs = do

102 103
  installedPkgIndex <- getInstalledPackages verbosity comp packageDBs conf
  sourcePkgDb       <- getSourcePackages    verbosity repos
104

105
  progress <- planLocalPackage verbosity comp platform configFlags configExFlags
106
                               installedPkgIndex sourcePkgDb
107 108

  notice verbosity "Resolving dependencies..."
109 110
  maybePlan <- foldProgress logMsg (return . Left) (return . Right)
                            progress
111
  case maybePlan of
112
    Left message -> do
113 114 115 116
      info verbosity $
           "Warning: solver failed to find a solution:\n"
        ++ message
        ++ "Trying configure anyway."
117 118
      setupWrapper verbosity (setupScriptOptions installedPkgIndex Nothing)
        Nothing configureCommand (const configFlags) extraArgs
119 120

    Right installPlan -> case InstallPlan.ready installPlan of
121 122 123 124
      [pkg@(ReadyPackage
             (ConfiguredPackage (SourcePackage _ _ (LocalUnpackedPackage _) _)
                                 _ _ _)
             _)] -> do
125
        configurePackage verbosity
126
          platform (compilerInfo comp)
127
          (setupScriptOptions installedPkgIndex (Just pkg))
128 129 130 131 132 133
          configFlags pkg extraArgs

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

  where
134
    setupScriptOptions :: InstalledPackageIndex
135
                       -> Maybe ReadyPackage
136
                       -> SetupScriptOptions
137 138 139 140 141 142 143 144 145 146 147 148 149 150
    setupScriptOptions =
      configureSetupScript
        packageDBs
        comp
        platform
        conf
        (fromFlagOrDefault
           (useDistPref defaultSetupScriptOptions)
           (configDistPref configFlags))
        (chooseCabalVersion
           configExFlags
           (flagToMaybe (configCabalVersion configExFlags)))
        Nothing
        False
151

152 153
    logMsg message rest = debug verbosity message >> rest

154 155 156 157 158 159 160 161 162
configureSetupScript :: PackageDBStack
                     -> Compiler
                     -> Platform
                     -> ProgramConfiguration
                     -> FilePath
                     -> VersionRange
                     -> Maybe Lock
                     -> Bool
                     -> InstalledPackageIndex
163
                     -> Maybe ReadyPackage
164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214
                     -> SetupScriptOptions
configureSetupScript packageDBs
                     comp
                     platform
                     conf
                     distPref
                     cabalVersion
                     lock
                     forceExternal
                     index
                     mpkg
  = SetupScriptOptions {
      useCabalVersion   = cabalVersion
    , useCompiler       = Just comp
    , usePlatform       = Just platform
    , usePackageDB      = packageDBs'
    , usePackageIndex   = index'
    , useProgramConfig  = conf
    , useDistPref       = distPref
    , useLoggingHandle  = Nothing
    , useWorkingDir     = Nothing
    , setupCacheLock    = lock
    , useWin32CleanHack = False
    , 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
    , useDependenciesExclusive = isJust explicitSetupDeps
    }
  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)

    explicitSetupDeps :: Maybe [(InstalledPackageId, PackageId)]
    explicitSetupDeps = do
215 216
      ReadyPackage (ConfiguredPackage (SourcePackage _ gpkg _ _) _ _ _) deps
                 <- mpkg
217 218 219 220 221 222 223 224 225
      -- Check if there is an explicit setup stanza
      _buildInfo <- PkgDesc.setupBuildInfo (PkgDesc.packageDescription gpkg)
      -- Return the setup dependencies computed by the solver
      return [ ( Installed.installedPackageId deppkg
               , Installed.sourcePackageId    deppkg
               )
             | deppkg <- CD.setupDeps deps
             ]

226 227 228 229
-- | Make an 'InstallPlan' for the unpacked package in the current directory,
-- and all its dependencies.
--
planLocalPackage :: Verbosity -> Compiler
230
                 -> Platform
231
                 -> ConfigFlags -> ConfigExFlags
232
                 -> InstalledPackageIndex
233
                 -> SourcePackageDb
234
                 -> IO (Progress String String InstallPlan)
235 236
planLocalPackage verbosity comp platform configFlags configExFlags
  installedPkgIndex
237
  (SourcePackageDb _ packagePrefs) = do
238
  pkg <- readPackageDescription verbosity =<< defaultPackageDesc verbosity
239 240
  solver <- chooseSolver verbosity (fromFlag $ configSolver configExFlags)
            (compilerInfo comp)
241 242

  let -- We create a local package and ask to resolve a dependency on it
243 244 245
      localPkg = SourcePackage {
        packageInfoId             = packageId pkg,
        Source.packageDescription = pkg,
246 247
        packageSource             = LocalUnpackedPackage ".",
        packageDescrOverride      = Nothing
248
      }
249

250 251 252 253
      testsEnabled = fromFlagOrDefault False $ configTests configFlags
      benchmarksEnabled =
        fromFlagOrDefault False $ configBenchmarks configFlags

254
      resolverParams =
255 256
          removeUpperBounds (fromFlagOrDefault AllowNewerNone $
                             configAllowNewer configExFlags)
257

258
        . addPreferences
259 260 261 262 263 264
            -- 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
265 266
            -- TODO: should warn or error on constraints that are not on direct
            -- deps or flag constraints not on the package in question.
267
            [ LabeledPackageConstraint (userToPackageConstraint uc) src
268
            | (uc, src) <- configExConstraints configExFlags ]
269 270 271

        . addConstraints
            -- package flags from the config file or command line
272 273
            [ let pc = PackageConstraintFlags (packageName pkg)
                       (configConfigurationsFlags configFlags)
274 275
              in LabeledPackageConstraint pc ConstraintSourceConfigFlagOrTarget
            ]
276

277 278
        . addConstraints
            -- '--enable-tests' and '--enable-benchmarks' constraints from
279
            -- the config file or command line
280 281 282
            [ let pc = PackageConstraintStanzas (packageName pkg) $
                       [ TestStanzas  | testsEnabled ] ++
                       [ BenchStanzas | benchmarksEnabled ]
283
              in LabeledPackageConstraint pc ConstraintSourceConfigFlagOrTarget
284 285
            ]

286
        $ standardInstallPolicy
287 288
            installedPkgIndex
            (SourcePackageDb mempty packagePrefs)
289
            [SpecificSourcePackage localPkg]
290

291
  return (resolveDependencies platform (compilerInfo comp) solver resolverParams)
292

293

294
-- | Call an installer for an 'SourcePackage' but override the configure
295 296
-- flags with the ones given by the 'ReadyPackage'. In particular the
-- 'ReadyPackage' specifies an exact 'FlagAssignment' and exactly
297 298 299
-- versioned package dependencies. So we ignore any previous partial flag
-- assignment or dependency constraints and use the new ones.
--
300 301
-- NB: when updating this function, don't forget to also update
-- 'installReadyPackage' in D.C.Install.
302
configurePackage :: Verbosity
303
                 -> Platform -> CompilerInfo
304
                 -> SetupScriptOptions
305
                 -> ConfigFlags
306
                 -> ReadyPackage
307 308
                 -> [String]
                 -> IO ()
309
configurePackage verbosity platform comp scriptOptions configFlags
310 311 312 313
                 (ReadyPackage (ConfiguredPackage (SourcePackage _ gpkg _ _)
                                                  flags stanzas _)
                               deps)
                 extraArgs =
314 315 316 317 318 319

  setupWrapper verbosity
    scriptOptions (Just pkg) configureCommand configureFlags extraArgs

  where
    configureFlags   = filterConfigureFlags configFlags {
320
      configConfigurationsFlags = flags,
321 322 323 324
      -- 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  = [ thisPackageVersion (packageId deppkg)
325
                           | deppkg <- CD.nonSetupDeps deps ],
326 327
      configDependencies = [ (packageName (Installed.sourcePackageId deppkg),
                              Installed.installedPackageId deppkg)
328
                           | deppkg <- CD.nonSetupDeps deps ],
329 330
      -- Use '--exact-configuration' if supported.
      configExactConfiguration = toFlag True,
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
331 332 333
      configVerbosity          = toFlag verbosity,
      configBenchmarks         = toFlag (BenchStanzas `elem` stanzas),
      configTests              = toFlag (TestStanzas `elem` stanzas)
334 335 336
    }

    pkg = case finalizePackageDescription flags
337
           (const True)
338
           platform comp [] (enableStanzas stanzas gpkg) of
339
      Left _ -> error "finalizePackageDescription ReadyPackage failed"
340
      Right (desc, _) -> desc