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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

275 276 277
        . addConstraints
            -- '--enable-tests' and '--enable-benchmarks' constraints from
            -- command line
278 279 280 281
            [ let pc = PackageConstraintStanzas (packageName pkg) $
                       [ TestStanzas  | testsEnabled ] ++
                       [ BenchStanzas | benchmarksEnabled ]
              in LabeledPackageConstraint pc Nothing
282 283
            ]

284
        $ standardInstallPolicy
285 286
            installedPkgIndex
            (SourcePackageDb mempty packagePrefs)
287
            [SpecificSourcePackage localPkg]
288

289
  return (resolveDependencies platform (compilerInfo comp) solver resolverParams)
290

291

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

  setupWrapper verbosity
    scriptOptions (Just pkg) configureCommand configureFlags extraArgs

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

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