Configure.hs 8.46 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
-----------------------------------------------------------------------------
-- |
-- 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,
  ) where

import Distribution.Client.Dependency
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.InstallPlan (InstallPlan)
import Distribution.Client.IndexUtils as IndexUtils
21
         ( getSourcePackages, getInstalledPackages )
22
import Distribution.Client.Setup
23
         ( ConfigExFlags(..), configureCommand, filterConfigureFlags )
24
import Distribution.Client.Types as Source
25
26
import Distribution.Client.SetupWrapper
         ( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions )
27
28
import Distribution.Client.Targets
         ( userToPackageConstraint )
29
30

import Distribution.Simple.Compiler
31
32
         ( CompilerId(..), Compiler(compilerId)
         , PackageDB(..), PackageDBStack )
33
import Distribution.Simple.Program (ProgramConfiguration )
34
import Distribution.Simple.Setup
35
         ( ConfigFlags(..), fromFlag, toFlag, flagToMaybe, fromFlagOrDefault )
36
import Distribution.Simple.PackageIndex (PackageIndex)
37
38
39
import Distribution.Simple.Utils
         ( defaultPackageDesc )
import Distribution.Package
40
         ( Package(..), packageName, Dependency(..), thisPackageVersion )
41
42
43
44
45
import Distribution.PackageDescription.Parse
         ( readPackageDescription )
import Distribution.PackageDescription.Configuration
         ( finalizePackageDescription )
import Distribution.Version
46
         ( anyVersion, thisVersion )
47
import Distribution.Simple.Utils as Utils
48
         ( notice, debug, die )
49
import Distribution.System
50
         ( Platform )
51
52
53
import Distribution.Verbosity as Verbosity
         ( Verbosity )

54
55
import Data.Monoid (Monoid(..))

56
57
-- | Configure the package found in the local directory
configure :: Verbosity
58
          -> PackageDBStack
59
60
          -> [Repo]
          -> Compiler
61
          -> Platform
62
          -> ProgramConfiguration
63
          -> ConfigFlags
64
          -> ConfigExFlags
65
66
          -> [String]
          -> IO ()
67
configure verbosity packageDBs repos comp platform conf
68
69
  configFlags configExFlags extraArgs = do

70
71
  installedPkgIndex <- getInstalledPackages verbosity comp packageDBs conf
  sourcePkgDb       <- getSourcePackages    verbosity repos
72

73
  progress <- planLocalPackage verbosity comp platform configFlags configExFlags
74
                               installedPkgIndex sourcePkgDb
75
76

  notice verbosity "Resolving dependencies..."
77
78
  maybePlan <- foldProgress logMsg (return . Left) (return . Right)
                            progress
79
  case maybePlan of
80
    Left message -> die message
81
82

    Right installPlan -> case InstallPlan.ready installPlan of
83
      [pkg@(ConfiguredPackage (SourcePackage _ _ (LocalUnpackedPackage _) _) _ _ _)] ->
84
85
86
        configurePackage verbosity
          (InstallPlan.planPlatform installPlan)
          (InstallPlan.planCompiler installPlan)
87
          (setupScriptOptions installedPkgIndex)
88
89
90
91
92
93
94
          configFlags pkg extraArgs

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

  where
    setupScriptOptions index = SetupScriptOptions {
Duncan Coutts's avatar
Duncan Coutts committed
95
      useCabalVersion  = maybe anyVersion thisVersion
96
                         (flagToMaybe (configCabalVersion configExFlags)),
97
      useCompiler      = Just comp,
98
      usePlatform      = Just platform,
Duncan Coutts's avatar
Duncan Coutts committed
99
100
      usePackageDB     = packageDBs',
      usePackageIndex  = index',
101
      useProgramConfig = conf,
102
      useDistPref      = fromFlagOrDefault
103
                           (useDistPref defaultSetupScriptOptions)
104
                           (configDistPref configFlags),
105
      useLoggingHandle = Nothing,
106
      useWorkingDir    = Nothing,
refold's avatar
refold committed
107
      forceExternalSetupMethod = False,
refold's avatar
refold committed
108
      setupCacheLock   = Nothing
109
    }
Duncan Coutts's avatar
Duncan Coutts committed
110
111
112
113
114
115
116
117
118
119
      where
        -- Hack: 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', index') =
          case packageDBs of
            (GlobalPackageDB:dbs) | UserPackageDB `notElem` dbs
                -> (GlobalPackageDB:UserPackageDB:dbs, Nothing)
            -- but if the user is using an odd db stack, don't touch it
            dbs -> (dbs, Just index)
120

121
122
    logMsg message rest = debug verbosity message >> rest

123
124
125
126
-- | Make an 'InstallPlan' for the unpacked package in the current directory,
-- and all its dependencies.
--
planLocalPackage :: Verbosity -> Compiler
127
                 -> Platform
128
                 -> ConfigFlags -> ConfigExFlags
129
                 -> PackageIndex
130
                 -> SourcePackageDb
131
                 -> IO (Progress String String InstallPlan)
132
planLocalPackage verbosity comp platform configFlags configExFlags installedPkgIndex
133
  (SourcePackageDb _ packagePrefs) = do
134
  pkg <- readPackageDescription verbosity =<< defaultPackageDesc verbosity
135
  solver <- chooseSolver verbosity (fromFlag $ configSolver configExFlags) (compilerId comp)
136
137

  let -- We create a local package and ask to resolve a dependency on it
138
139
140
      localPkg = SourcePackage {
        packageInfoId             = packageId pkg,
        Source.packageDescription = pkg,
141
142
        packageSource             = LocalUnpackedPackage ".",
        packageDescrOverride      = Nothing
143
      }
144

145
146
147
148
      testsEnabled = fromFlagOrDefault False $ configTests configFlags
      benchmarksEnabled =
        fromFlagOrDefault False $ configBenchmarks configFlags

149
150
151
152
153
154
155
156
157
      resolverParams =

          addPreferences
            -- 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
158
159
160
            -- TODO: should warn or error on constraints that are not on direct deps
            -- or flag constraints not on the package in question.
            (map userToPackageConstraint (configExConstraints configExFlags))
161
162
163

        . addConstraints
            -- package flags from the config file or command line
164
            [ PackageConstraintFlags (packageName pkg)
165
166
                                     (configConfigurationsFlags configFlags) ]

167
168
169
        . addConstraints
            -- '--enable-tests' and '--enable-benchmarks' constraints from
            -- command line
EyalLotem's avatar
EyalLotem committed
170
171
172
            [ PackageConstraintStanzas (packageName pkg) $
                [ TestStanzas  | testsEnabled ] ++
                [ BenchStanzas | benchmarksEnabled ]
173
174
            ]

175
        $ standardInstallPolicy
176
177
            installedPkgIndex
            (SourcePackageDb mempty packagePrefs)
178
            [SpecificSourcePackage localPkg]
179

180
  return (resolveDependencies platform (compilerId comp) solver resolverParams)
181

182

183
-- | Call an installer for an 'SourcePackage' but override the configure
184
185
186
187
188
189
190
191
-- flags with the ones given by the 'ConfiguredPackage'. In particular the
-- 'ConfiguredPackage' specifies an exact 'FlagAssignment' and exactly
-- versioned package dependencies. So we ignore any previous partial flag
-- assignment or dependency constraints and use the new ones.
--
configurePackage :: Verbosity
                 -> Platform -> CompilerId
                 -> SetupScriptOptions
192
                 -> ConfigFlags
193
194
195
                 -> ConfiguredPackage
                 -> [String]
                 -> IO ()
196
configurePackage verbosity platform comp scriptOptions configFlags
197
  (ConfiguredPackage (SourcePackage _ gpkg _ _) flags stanzas deps) extraArgs =
198
199
200
201
202
203

  setupWrapper verbosity
    scriptOptions (Just pkg) configureCommand configureFlags extraArgs

  where
    configureFlags   = filterConfigureFlags configFlags {
204
205
      configConfigurationsFlags = flags,
      configConstraints         = map thisPackageVersion deps,
206
207
208
      configVerbosity           = toFlag verbosity,
      configBenchmarks          = toFlag (BenchStanzas `elem` stanzas),
      configTests               = toFlag (TestStanzas `elem` stanzas)
209
210
211
    }

    pkg = case finalizePackageDescription flags
212
           (const True)
213
           platform comp [] (enableStanzas stanzas gpkg) of
214
215
      Left _ -> error "finalizePackageDescription ConfiguredPackage failed"
      Right (desc, _) -> desc