Configure.hs 13.2 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 (AllowNewer(..), isAllowNewer)
22 23 24
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.InstallPlan (InstallPlan)
import Distribution.Client.IndexUtils as IndexUtils
25
         ( getSourcePackages, getInstalledPackages )
26
import Distribution.Client.Setup
27
         ( ConfigExFlags(..), configureCommand, filterConfigureFlags )
28
import Distribution.Client.Types as Source
29 30
import Distribution.Client.SetupWrapper
         ( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions )
31 32
import Distribution.Client.Targets
         ( userToPackageConstraint )
33
import qualified Distribution.Client.ComponentDeps as CD
34 35
import Distribution.Package (PackageId)
import Distribution.Client.JobControl (Lock)
36 37

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

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

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

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

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

100 101
  installedPkgIndex <- getInstalledPackages verbosity comp packageDBs conf
  sourcePkgDb       <- getSourcePackages    verbosity repos
102

103
  progress <- planLocalPackage verbosity comp platform configFlags configExFlags
104
                               installedPkgIndex sourcePkgDb
105 106

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

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

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

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

150 151
    logMsg message rest = debug verbosity message >> rest

152 153 154 155 156 157 158 159 160
configureSetupScript :: PackageDBStack
                     -> Compiler
                     -> Platform
                     -> ProgramConfiguration
                     -> FilePath
                     -> VersionRange
                     -> Maybe Lock
                     -> Bool
                     -> InstalledPackageIndex
161
                     -> Maybe ReadyPackage
162 163 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
                     -> 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
213 214
      ReadyPackage (ConfiguredPackage (SourcePackage _ gpkg _ _) _ _ _) deps
                 <- mpkg
215 216 217 218 219 220 221 222 223
      -- 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
             ]

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

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

248 249 250 251
      testsEnabled = fromFlagOrDefault False $ configTests configFlags
      benchmarksEnabled =
        fromFlagOrDefault False $ configBenchmarks configFlags

252
      resolverParams =
253 254
          removeUpperBounds (fromFlagOrDefault AllowNewerNone $
                             configAllowNewer configExFlags)
255

256
        . addPreferences
257 258 259 260 261 262
            -- 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
263 264
            -- TODO: should warn or error on constraints that are not on direct
            -- deps or flag constraints not on the package in question.
265
            (map userToPackageConstraint (configExConstraints configExFlags))
266 267 268

        . addConstraints
            -- package flags from the config file or command line
269
            [ PackageConstraintFlags (packageName pkg)
270 271
                                     (configConfigurationsFlags configFlags) ]

272 273 274
        . addConstraints
            -- '--enable-tests' and '--enable-benchmarks' constraints from
            -- command line
EyalLotem's avatar
EyalLotem committed
275 276 277
            [ PackageConstraintStanzas (packageName pkg) $
                [ TestStanzas  | testsEnabled ] ++
                [ BenchStanzas | benchmarksEnabled ]
278 279
            ]

280
        $ standardInstallPolicy
281 282
            installedPkgIndex
            (SourcePackageDb mempty packagePrefs)
283
            [SpecificSourcePackage localPkg]
284

285
  return (resolveDependencies platform (compilerInfo comp) solver resolverParams)
286

287

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

  setupWrapper verbosity
    scriptOptions (Just pkg) configureCommand configureFlags extraArgs

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

    pkg = case finalizePackageDescription flags
331
           (const True)
332
           platform comp [] (enableStanzas stanzas gpkg) of
333
      Left _ -> error "finalizePackageDescription ReadyPackage failed"
334
      Right (desc, _) -> desc