Configure.hs 15.1 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
  ) where

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

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

72
import Control.Monad (unless)
73
#if !MIN_VERSION_base(4,8,0)
74
import Data.Monoid (Monoid(..))
75
#endif
76
import Data.Maybe (isJust, fromMaybe)
77

Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
78 79 80 81 82 83
-- | 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
84 85
    -- Cabal < 1.19.2 doesn't support '--exact-configuration' which is needed
    -- for '--allow-newer' to work.
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
86 87 88 89 90 91 92
    allowNewer = fromFlagOrDefault False $
                 fmap isAllowNewer (configAllowNewer configExFlags)

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

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

107 108
  installedPkgIndex <- getInstalledPackages verbosity comp packageDBs conf
  sourcePkgDb       <- getSourcePackages    verbosity repos
109 110
  checkConfigExFlags verbosity installedPkgIndex
                     (packageIndex sourcePkgDb) configExFlags
111

112
  progress <- planLocalPackage verbosity comp platform configFlags configExFlags
113
                               installedPkgIndex sourcePkgDb
114 115

  notice verbosity "Resolving dependencies..."
116 117
  maybePlan <- foldProgress logMsg (return . Left) (return . Right)
                            progress
118
  case maybePlan of
119
    Left message -> do
120 121 122 123
      info verbosity $
           "Warning: solver failed to find a solution:\n"
        ++ message
        ++ "Trying configure anyway."
124 125
      setupWrapper verbosity (setupScriptOptions installedPkgIndex Nothing)
        Nothing configureCommand (const configFlags) extraArgs
126 127

    Right installPlan -> case InstallPlan.ready installPlan of
128 129 130 131
      [pkg@(ReadyPackage
             (ConfiguredPackage (SourcePackage _ _ (LocalUnpackedPackage _) _)
                                 _ _ _)
             _)] -> do
132
        configurePackage verbosity
133
          platform (compilerInfo comp)
134
          (setupScriptOptions installedPkgIndex (Just pkg))
135 136 137 138 139 140
          configFlags pkg extraArgs

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

  where
141
    setupScriptOptions :: InstalledPackageIndex
142
                       -> Maybe ReadyPackage
143
                       -> SetupScriptOptions
144 145 146 147 148 149 150 151 152 153 154 155 156 157
    setupScriptOptions =
      configureSetupScript
        packageDBs
        comp
        platform
        conf
        (fromFlagOrDefault
           (useDistPref defaultSetupScriptOptions)
           (configDistPref configFlags))
        (chooseCabalVersion
           configExFlags
           (flagToMaybe (configCabalVersion configExFlags)))
        Nothing
        False
158

159 160
    logMsg message rest = debug verbosity message >> rest

161 162 163 164 165 166 167 168 169
configureSetupScript :: PackageDBStack
                     -> Compiler
                     -> Platform
                     -> ProgramConfiguration
                     -> FilePath
                     -> VersionRange
                     -> Maybe Lock
                     -> Bool
                     -> InstalledPackageIndex
170
                     -> Maybe ReadyPackage
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 215 216 217 218 219
                     -> 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)

220
    explicitSetupDeps :: Maybe [(ComponentId, PackageId)]
221
    explicitSetupDeps = do
222 223
      ReadyPackage (ConfiguredPackage (SourcePackage _ gpkg _ _) _ _ _) deps
                 <- mpkg
224 225 226
      -- Check if there is an explicit setup stanza
      _buildInfo <- PkgDesc.setupBuildInfo (PkgDesc.packageDescription gpkg)
      -- Return the setup dependencies computed by the solver
227
      return [ ( Installed.installedComponentId deppkg
228 229 230 231 232
               , Installed.sourcePackageId    deppkg
               )
             | deppkg <- CD.setupDeps deps
             ]

233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257
-- | 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 ++ ")"

258 259 260 261
-- | Make an 'InstallPlan' for the unpacked package in the current directory,
-- and all its dependencies.
--
planLocalPackage :: Verbosity -> Compiler
262
                 -> Platform
263
                 -> ConfigFlags -> ConfigExFlags
264
                 -> InstalledPackageIndex
265
                 -> SourcePackageDb
266
                 -> IO (Progress String String InstallPlan)
267 268
planLocalPackage verbosity comp platform configFlags configExFlags
  installedPkgIndex
269
  (SourcePackageDb _ packagePrefs) = do
270
  pkg <- readPackageDescription verbosity =<< defaultPackageDesc verbosity
271 272
  solver <- chooseSolver verbosity (fromFlag $ configSolver configExFlags)
            (compilerInfo comp)
273 274

  let -- We create a local package and ask to resolve a dependency on it
275 276 277
      localPkg = SourcePackage {
        packageInfoId             = packageId pkg,
        Source.packageDescription = pkg,
278 279
        packageSource             = LocalUnpackedPackage ".",
        packageDescrOverride      = Nothing
280
      }
281

282 283 284 285
      testsEnabled = fromFlagOrDefault False $ configTests configFlags
      benchmarksEnabled =
        fromFlagOrDefault False $ configBenchmarks configFlags

286
      resolverParams =
287 288
          removeUpperBounds (fromFlagOrDefault AllowNewerNone $
                             configAllowNewer configExFlags)
289

290
        . addPreferences
291 292 293 294 295 296
            -- 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
297 298
            -- TODO: should warn or error on constraints that are not on direct
            -- deps or flag constraints not on the package in question.
299
            [ LabeledPackageConstraint (userToPackageConstraint uc) src
300
            | (uc, src) <- configExConstraints configExFlags ]
301 302 303

        . addConstraints
            -- package flags from the config file or command line
304 305
            [ let pc = PackageConstraintFlags (packageName pkg)
                       (configConfigurationsFlags configFlags)
306 307
              in LabeledPackageConstraint pc ConstraintSourceConfigFlagOrTarget
            ]
308

309 310
        . addConstraints
            -- '--enable-tests' and '--enable-benchmarks' constraints from
311
            -- the config file or command line
312 313 314
            [ let pc = PackageConstraintStanzas (packageName pkg) $
                       [ TestStanzas  | testsEnabled ] ++
                       [ BenchStanzas | benchmarksEnabled ]
315
              in LabeledPackageConstraint pc ConstraintSourceConfigFlagOrTarget
316 317
            ]

318
        $ standardInstallPolicy
319 320
            installedPkgIndex
            (SourcePackageDb mempty packagePrefs)
321
            [SpecificSourcePackage localPkg]
322

323
  return (resolveDependencies platform (compilerInfo comp) solver resolverParams)
324

325

326
-- | Call an installer for an 'SourcePackage' but override the configure
327 328
-- flags with the ones given by the 'ReadyPackage'. In particular the
-- 'ReadyPackage' specifies an exact 'FlagAssignment' and exactly
329 330 331
-- versioned package dependencies. So we ignore any previous partial flag
-- assignment or dependency constraints and use the new ones.
--
332 333
-- NB: when updating this function, don't forget to also update
-- 'installReadyPackage' in D.C.Install.
334
configurePackage :: Verbosity
335
                 -> Platform -> CompilerInfo
336
                 -> SetupScriptOptions
337
                 -> ConfigFlags
338
                 -> ReadyPackage
339 340
                 -> [String]
                 -> IO ()
341
configurePackage verbosity platform comp scriptOptions configFlags
342 343 344 345
                 (ReadyPackage (ConfiguredPackage (SourcePackage _ gpkg _ _)
                                                  flags stanzas _)
                               deps)
                 extraArgs =
346 347 348 349 350 351

  setupWrapper verbosity
    scriptOptions (Just pkg) configureCommand configureFlags extraArgs

  where
    configureFlags   = filterConfigureFlags configFlags {
352
      configConfigurationsFlags = flags,
353 354 355 356
      -- 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)
357
                           | deppkg <- CD.nonSetupDeps deps ],
358
      configDependencies = [ (packageName (Installed.sourcePackageId deppkg),
359
                              Installed.installedComponentId deppkg)
360
                           | deppkg <- CD.nonSetupDeps deps ],
361 362
      -- Use '--exact-configuration' if supported.
      configExactConfiguration = toFlag True,
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
363 364 365
      configVerbosity          = toFlag verbosity,
      configBenchmarks         = toFlag (BenchStanzas `elem` stanzas),
      configTests              = toFlag (TestStanzas `elem` stanzas)
366 367 368
    }

    pkg = case finalizePackageDescription flags
369
           (const True)
370
           platform comp [] (enableStanzas stanzas gpkg) of
371
      Left _ -> error "finalizePackageDescription ReadyPackage failed"
372
      Right (desc, _) -> desc