Configure.hs 31.1 KB
Newer Older
1
2
-----------------------------------------------------------------------------
-- |
ijones's avatar
ijones committed
3
-- Module      :  Distribution.Simple.Configure
4
-- Copyright   :  Isaac Jones 2003-2005
5
--
Duncan Coutts's avatar
Duncan Coutts committed
6
-- Maintainer  :  cabal-devel@haskell.org
ijones's avatar
ijones committed
7
-- Portability :  portable
8
--
Duncan Coutts's avatar
Duncan Coutts committed
9
10
11
12
13
14
15
16
17
18
19
20
21
-- This deals with the /configure/ phase. It provides the 'configure' action
-- which is given the package description and configure flags. It then tries
-- to: configure the compiler; resolves any conditionals in the package
-- description; resolve the package dependencies; check if all the extensions
-- used by this package are supported by the compiler; check that all the build
-- tools are available (including version checks if appropriate); checks for
-- any required @pkg-config@ packages (updating the 'BuildInfo' with the
-- results)
-- 
-- Then based on all this it saves the info in the 'LocalBuildInfo' and writes
-- it out to the @dist\/setup-config@ file. It also displays various details to
-- the user, the amount of information displayed depending on the verbosity
-- level.
22

ijones's avatar
ijones committed
23
{- All rights reserved.
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:

    * Redistributions of source code must retain the above copyright
      notice, this list of conditions and the following disclaimer.

    * Redistributions in binary form must reproduce the above
      copyright notice, this list of conditions and the following
      disclaimer in the documentation and/or other materials provided
      with the distribution.

    * Neither the name of Isaac Jones nor the names of other
      contributors may be used to endorse or promote products derived
      from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}

ijones's avatar
ijones committed
53
54
module Distribution.Simple.Configure (configure,
                                      writePersistBuildConfig,
ijones's avatar
ijones committed
55
                                      getPersistBuildConfig,
56
                                      checkPersistBuildConfig,
57
                                      maybeGetPersistBuildConfig,
58
--                                      getConfiguredPkgDescr,
ijones's avatar
ijones committed
59
                                      localBuildInfoFile,
60
                                      getInstalledPackages,
61
                                      configDependency,
62
                                      configCompiler, configCompilerAux,
63
                                      ccLdOptionsBuildInfo,
jpbernardy's avatar
jpbernardy committed
64
                                      tryGetConfigStateFile,
ijones's avatar
ijones committed
65
                                     )
ijones's avatar
ijones committed
66
    where
67

68
import Distribution.Simple.Compiler
69
    ( CompilerFlavor(..), Compiler(compilerId), compilerFlavor, compilerVersion
70
    , showCompilerId, unsupportedExtensions, PackageDB(..) )
71
import Distribution.Package
Duncan Coutts's avatar
Duncan Coutts committed
72
73
    ( PackageName(PackageName), PackageIdentifier(PackageIdentifier)
    , packageVersion, Package(..), Dependency(Dependency) )
74
import Distribution.InstalledPackageInfo
75
    ( InstalledPackageInfo, emptyInstalledPackageInfo )
76
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
77
    ( InstalledPackageInfo_(package,depends) )
78
79
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.PackageIndex (PackageIndex)
80
import Distribution.PackageDescription as PD
81
    ( PackageDescription(..), GenericPackageDescription(..)
82
    , Library(..), hasLibs, Executable(..), BuildInfo(..)
83
84
    , HookedBuildInfo, updatePackageDescription, allBuildInfo
    , FlagName(..) )
85
import Distribution.PackageDescription.Configuration
86
    ( finalizePackageDescription )
87
import Distribution.PackageDescription.Check
88
89
    ( PackageCheck(..)
    , checkPackage, checkConfiguredPackage, checkPackageFiles )
90
import Distribution.Simple.Program
91
    ( Program(..), ProgramLocation(..), ConfiguredProgram(..)
Duncan Coutts's avatar
Duncan Coutts committed
92
93
    , ProgramConfiguration, defaultProgramConfiguration
    , configureAllKnownPrograms, knownPrograms
94
    , userSpecifyArgss, userSpecifyPaths
95
96
    , lookupKnownProgram, requireProgram, pkgConfigProgram
    , rawSystemProgramStdoutConf )
97
import Distribution.Simple.Setup
98
    ( ConfigFlags(..), CopyDest(..), fromFlag, fromFlagOrDefault, flagToMaybe )
99
import Distribution.Simple.InstallDirs
100
    ( InstallDirs(..), defaultInstallDirs, combineInstallDirs )
101
import Distribution.Simple.LocalBuildInfo
102
    ( LocalBuildInfo(..), absoluteInstallDirs
103
    , prefixRelativeInstallDirs )
104
import Distribution.Simple.Utils
105
    ( die, warn, info, setupMessage, createDirectoryIfMissingVerbose
106
107
    , intercalate, comparing, cabalVersion, cabalBootstrapping
    , withFileContents, writeFileAtomic )
108
109
110
import Distribution.Simple.Register
    ( removeInstalledConfig )
import Distribution.System
111
    ( OS(..), buildOS, buildArch )
112
import Distribution.Version
113
    ( Version(..), VersionRange(..), orLaterVersion, withinRange )
114
import Distribution.Verbosity
115
    ( Verbosity, lessVerbose )
116

117
118
import qualified Distribution.Simple.GHC  as GHC
import qualified Distribution.Simple.JHC  as JHC
David Himmelstrup's avatar
David Himmelstrup committed
119
import qualified Distribution.Simple.LHC  as LHC
120
121
122
import qualified Distribution.Simple.NHC  as NHC
import qualified Distribution.Simple.Hugs as Hugs

123
import Control.Monad
124
    ( when, unless, foldM )
125
import Data.List
126
    ( nub, partition, isPrefixOf, maximumBy )
127
import Data.Maybe
128
    ( fromMaybe, isNothing )
129
130
import Data.Monoid
    ( Monoid(..) )
131
import System.Directory
132
    ( doesFileExist, getModificationTime, createDirectoryIfMissing )
133
134
135
import System.Exit
    ( ExitCode(..), exitWith )
import System.FilePath
136
    ( (</>), isAbsolute )
137
import qualified System.Info
138
    ( compilerName, compilerVersion )
139
import System.IO
140
    ( hPutStrLn, stderr )
141
import Distribution.Text
142
    ( Text(disp), display, simpleParse )
143
144
import Text.PrettyPrint.HughesPJ
    ( comma, punctuate, render, nest, sep )
145
import Distribution.Compat.Exception ( catchExit, catchIO )
146

147
import Prelude hiding (catch)
148

149
150
tryGetConfigStateFile :: (Read a) => FilePath -> IO (Either String a)
tryGetConfigStateFile filename = do
151
152
153
  exists <- doesFileExist filename
  if not exists
    then return (Left missing)
154
155
    else withFileContents filename $ \str ->
      case lines str of
156
        [headder, rest] -> case checkHeader headder of
157
          Just msg -> return (Left msg)
158
          Nothing  -> case reads rest of
159
160
161
            [(bi,_)] -> return (Right bi)
            _        -> return (Left cantParse)
        _            -> return (Left cantParse)
162
163
164
  where
    checkHeader :: String -> Maybe String
    checkHeader header = case parseHeader header of
165
      Just (cabalId, compId)
166
167
        | cabalId
       == currentCabalId -> Nothing
168
        | otherwise      -> Just (badVersion cabalId compId)
169
170
171
172
173
      Nothing            -> Just cantParse

    missing   = "Run the 'configure' command first."
    cantParse = "Saved package config file seems to be corrupt. "
             ++ "Try re-running the 'configure' command."
174
    badVersion cabalId compId
175
176
              = "You need to re-run the 'configure' command. "
             ++ "The version of Cabal being used has changed (was "
177
178
             ++ display cabalId ++ ", now "
             ++ display currentCabalId ++ ")."
179
180
181
             ++ badcompiler compId
    badcompiler compId | compId == currentCompilerId = ""
                       | otherwise
182
              = " Additionally the compiler is different (was "
183
             ++ display compId ++ ", now "
184
             ++ display currentCompilerId
185
             ++ ") which is probably the cause of the problem."
186

187
-- internal function
188
189
190
tryGetPersistBuildConfig :: FilePath -> IO (Either String LocalBuildInfo)
tryGetPersistBuildConfig distPref
    = tryGetConfigStateFile (localBuildInfoFile distPref)
191

192
193
194
-- |Read the 'localBuildInfoFile'.  Error if it doesn't exist.  Also
-- fail if the file containing LocalBuildInfo is older than the .cabal
-- file, indicating that a re-configure is required.
195
196
197
getPersistBuildConfig :: FilePath -> IO LocalBuildInfo
getPersistBuildConfig distPref = do
  lbi <- tryGetPersistBuildConfig distPref
198
199
  either die return lbi

ijones's avatar
ijones committed
200
-- |Try to read the 'localBuildInfoFile'.
201
202
203
maybeGetPersistBuildConfig :: FilePath -> IO (Maybe LocalBuildInfo)
maybeGetPersistBuildConfig distPref = do
  lbi <- tryGetPersistBuildConfig distPref
204
  return $ either (const Nothing) Just lbi
ijones's avatar
ijones committed
205

ijones's avatar
ijones committed
206
207
-- |After running configure, output the 'LocalBuildInfo' to the
-- 'localBuildInfoFile'.
208
209
writePersistBuildConfig :: FilePath -> LocalBuildInfo -> IO ()
writePersistBuildConfig distPref lbi = do
Ross Paterson's avatar
Ross Paterson committed
210
  createDirectoryIfMissing False distPref
211
212
  writeFileAtomic (localBuildInfoFile distPref)
                  (showHeader pkgid ++ '\n' : show lbi)
213
214
215
216
217
  where
    pkgid   = packageId (localPkgDescr lbi)

showHeader :: PackageIdentifier -> String
showHeader pkgid =
218
219
220
     "Saved package config for " ++ display pkgid
  ++ " written by " ++ display currentCabalId
  ++      " using " ++ display currentCompilerId
221
222
223
  where

currentCabalId :: PackageIdentifier
Duncan Coutts's avatar
Duncan Coutts committed
224
currentCabalId = PackageIdentifier (PackageName "Cabal") currentVersion
225
226
227
228
  where currentVersion | cabalBootstrapping = Version [0] []
                       | otherwise          = cabalVersion

currentCompilerId :: PackageIdentifier
Duncan Coutts's avatar
Duncan Coutts committed
229
currentCompilerId = PackageIdentifier (PackageName System.Info.compilerName)
230
231
                                      System.Info.compilerVersion

232
parseHeader :: String -> Maybe (PackageIdentifier, PackageIdentifier)
233
234
235
parseHeader header = case words header of
  ["Saved", "package", "config", "for", pkgid,
   "written", "by", cabalid, "using", compilerid]
236
237
238
    -> case (simpleParse pkgid :: Maybe PackageIdentifier,
             simpleParse cabalid,
             simpleParse compilerid) of
239
240
241
242
243
        (Just _,
         Just cabalid',
         Just compilerid') -> Just (cabalid', compilerid')
        _                  -> Nothing
  _                        -> Nothing
244

245
246
-- |Check that localBuildInfoFile is up-to-date with respect to the
-- .cabal file.
247
248
checkPersistBuildConfig :: FilePath -> FilePath -> IO ()
checkPersistBuildConfig distPref pkg_descr_file = do
249
  t0 <- getModificationTime pkg_descr_file
250
  t1 <- getModificationTime $ localBuildInfoFile distPref
251
252
253
  when (t0 > t1) $
    die (pkg_descr_file ++ " has been changed, please re-configure.")

Ross Paterson's avatar
Ross Paterson committed
254
-- |@dist\/setup-config@
255
256
localBuildInfoFile :: FilePath -> FilePath
localBuildInfoFile distPref = distPref </> "setup-config"
ijones's avatar
ijones committed
257

258
-- -----------------------------------------------------------------------------
ijones's avatar
ijones committed
259
260
-- * Configuration
-- -----------------------------------------------------------------------------
261

262
263
-- |Perform the \"@.\/setup configure@\" action.
-- Returns the @.setup-config@ file.
264
configure :: ( Either GenericPackageDescription PackageDescription
265
             , HookedBuildInfo)
266
          -> ConfigFlags -> IO LocalBuildInfo
267
configure (pkg_descr0, pbi) cfg
268
269
  = do  let distPref = fromFlag (configDistPref cfg)
            verbosity = fromFlag (configVerbosity cfg)
270

271
        setupMessage verbosity "Configuring"
272
                     (packageId (either packageDescription id pkg_descr0))
273

274
        createDirectoryIfMissingVerbose (lessVerbose verbosity) True distPref
275

276
277
278
        let programsConfig = userSpecifyArgss (configProgramArgs cfg)
                           . userSpecifyPaths (configProgramPaths cfg)
                           $ configPrograms cfg
279
            userInstall = fromFlag (configUserInstall cfg)
280
281
282
283
            defaultPackageDB | userInstall = UserPackageDB
                             | otherwise   = GlobalPackageDB
            packageDb   = fromFlagOrDefault defaultPackageDB
                                            (configPackageDB cfg)
284

285
286
        -- detect compiler
        (comp, programsConfig') <- configCompiler
287
288
289
          (flagToMaybe $ configHcFlavor cfg)
          (flagToMaybe $ configHcPath cfg) (flagToMaybe $ configHcPkg cfg)
          programsConfig (lessVerbose verbosity)
290
291
        let version = compilerVersion comp
            flavor  = compilerFlavor comp
292

Simon Marlow's avatar
Simon Marlow committed
293
        -- FIXME: currently only GHC has hc-pkg
294
        maybePackageSet <- getInstalledPackages (lessVerbose verbosity) comp
295
                               packageDb programsConfig'
296

297
        (pkg_descr0', flags) <- case pkg_descr0 of
298
299
            Left ppd ->
                case finalizePackageDescription
300
                       (configConfigurationsFlags cfg)
301
                       maybePackageSet
302
                       Distribution.System.buildOS
303
                       Distribution.System.buildArch
304
                       (compilerId comp)
305
                       (configConstraints cfg)
306
307
                       ppd
                of Right r -> return r
308
                   Left missing ->
309
                       die $ "At least the following dependencies are missing:\n"
310
                         ++ (render . nest 4 . sep . punctuate comma $
311
                             map disp missing)
312
            Right pd -> return (pd,[])
313

314
315
316
        -- add extra include/lib dirs as specified in cfg
        -- we do it here so that those get checked too
        let pkg_descr = addExtraIncludeLibDirs pkg_descr0'
317

318
        when (not (null flags)) $
319
320
321
          info verbosity $ "Flags chosen: "
                        ++ intercalate ", " [ name ++ "=" ++ display value
                                            | (FlagName name, value) <- flags ]
322

323
324
325
        checkPackageProblems verbosity
          (either Just (\_->Nothing) pkg_descr0) --TODO: make the Either go away
          (updatePackageDescription pbi pkg_descr)
326

327
        let packageSet = fromMaybe bogusPackageSet maybePackageSet
328
329
330
331
332
333
334
            -- FIXME: For Hugs, nhc98 and other compilers we do not know what
            -- packages are already installed, so we just make some up, pretend
            -- that they do exist and just hope for the best. We make them up
            -- based on what other package the package we're currently building
            -- happens to depend on. See 'inventBogusPackageId' below.
            -- Let's hope they really are installed... :-)
            bogusDependencies = map inventBogusPackageId (buildDepends pkg_descr)
335
            bogusPackageSet = PackageIndex.fromList
336
337
338
339
340
              [ emptyInstalledPackageInfo {
                  InstalledPackageInfo.package = bogusPackageId
                  -- note that these bogus packages have no other dependencies
                }
              | bogusPackageId <- bogusDependencies ]
341
        dep_pkgs <- case flavor of
342
343
          GHC -> mapM (configDependency verbosity packageSet) (buildDepends pkg_descr)
          JHC -> mapM (configDependency verbosity packageSet) (buildDepends pkg_descr)
David Himmelstrup's avatar
David Himmelstrup committed
344
          LHC -> mapM (configDependency verbosity packageSet) (buildDepends pkg_descr)
345
          _   -> return bogusDependencies
Simon Marlow's avatar
Simon Marlow committed
346

347
        packageDependsIndex <-
348
          case PackageIndex.dependencyClosure packageSet dep_pkgs of
349
350
351
            Left packageDependsIndex -> return packageDependsIndex
            Right broken ->
              die $ "The following installed packages are broken because other"
352
353
                 ++ " packages they depend on are missing. These broken "
                 ++ "packages must be rebuilt before they can be used.\n"
354
                 ++ unlines [ "package "
355
                           ++ display (packageId pkg)
356
                           ++ " is broken due to missing package "
357
                           ++ intercalate ", " (map display deps)
358
359
                            | (pkg, deps) <- broken ]

360
361
362
363
        let pseudoTopPkg = emptyInstalledPackageInfo {
                InstalledPackageInfo.package = packageId pkg_descr,
                InstalledPackageInfo.depends = dep_pkgs
              }
364
365
        case PackageIndex.dependencyInconsistencies
           . PackageIndex.insert pseudoTopPkg
366
           $ packageDependsIndex of
367
368
369
          [] -> return ()
          inconsistencies ->
            warn verbosity $
370
                 "This package indirectly depends on multiple versions of the same "
371
              ++ "package. This is highly likely to cause a compile failure.\n"
372
373
              ++ unlines [ "package " ++ display pkg ++ " requires "
                        ++ display (PackageIdentifier name ver)
374
375
                         | (name, uses) <- inconsistencies
                         , (pkg, ver) <- uses ]
Simon Marlow's avatar
Simon Marlow committed
376

377
        removeInstalledConfig distPref
Simon Marlow's avatar
Simon Marlow committed
378

379
380
381
        -- installation directories
        defaultDirs <- defaultInstallDirs flavor userInstall (hasLibs pkg_descr)
        let installDirs = combineInstallDirs fromFlagOrDefault
382
                            defaultDirs (configInstallDirs cfg)
383

384
        -- check extensions
385
        let extlist = nub $ concatMap extensions (allBuildInfo pkg_descr)
386
        let exts = unsupportedExtensions comp extlist
387
        unless (null exts) $ warn verbosity $ -- Just warn, FIXME: Should this be an error?
388
            display flavor ++ " does not support the following extensions: " ++
389
            intercalate ", " (map display exts)
390

391
        let requiredBuildTools = concatMap buildTools (allBuildInfo pkg_descr)
392
393
        programsConfig'' <-
              configureAllKnownPrograms (lessVerbose verbosity) programsConfig'
394
          >>= configureRequiredPrograms verbosity requiredBuildTools
395

396
397
        (pkg_descr', programsConfig''') <- configurePkgconfigPackages verbosity
                                            pkg_descr programsConfig''
398

399
400
401
402
403
404
        split_objs <-
           if not (fromFlag $ configSplitObjs cfg)
                then return False
                else case flavor of
                            GHC | version >= Version [6,5] [] -> return True
                            _ -> do warn verbosity
Ian Lynagh's avatar
Ian Lynagh committed
405
                                         ("this compiler does not support " ++
406
407
408
409
410
411
412
413
                                          "--enable-split-objs; ignoring")
                                    return False

        let lbi = LocalBuildInfo{
                    installDirTemplates = installDirs,
                    compiler            = comp,
                    buildDir            = distPref </> "build",
                    scratchDir          = fromFlagOrDefault
414
415
                                            (distPref </> "scratch")
                                            (configScratchDir cfg),
416
                    packageDeps         = dep_pkgs,
417
                    installedPkgs       = packageDependsIndex,
418
                    pkgDescrFile        = Nothing,
419
420
421
422
423
424
425
426
427
                    localPkgDescr       = pkg_descr',
                    withPrograms        = programsConfig''',
                    withVanillaLib      = fromFlag $ configVanillaLib cfg,
                    withProfLib         = fromFlag $ configProfLib cfg,
                    withSharedLib       = fromFlag $ configSharedLib cfg,
                    withProfExe         = fromFlag $ configProfExe cfg,
                    withOptimization    = fromFlag $ configOptimization cfg,
                    withGHCiLib         = fromFlag $ configGHCiLib cfg,
                    splitObjs           = split_objs,
428
                    stripExes           = fromFlag $ configStripExes cfg,
429
                    withPackageDB       = packageDb,
430
431
                    progPrefix          = fromFlag $ configProgPrefix cfg,
                    progSuffix          = fromFlag $ configProgSuffix cfg
Duncan Coutts's avatar
Duncan Coutts committed
432
                  }
ijones's avatar
ijones committed
433

434
435
436
        let dirs = absoluteInstallDirs pkg_descr lbi NoCopyDest
            relative = prefixRelativeInstallDirs pkg_descr lbi

437
438
439
        unless (isAbsolute (prefix dirs)) $ die $
            "expected an absolute directory name for --prefix: " ++ prefix dirs

440
441
        info verbosity $ "Using " ++ display currentCabalId
                      ++ " compiled by " ++ display currentCompilerId
442
443
        info verbosity $ "Using compiler: " ++ showCompilerId comp
        info verbosity $ "Using install prefix: " ++ prefix dirs
444

445
446
        let dirinfo name dir isPrefixRelative =
              info verbosity $ name ++ " installed in: " ++ dir ++ relNote
447
448
449
450
451
              where relNote = case buildOS of
                      Windows | not (hasLibs pkg_descr)
                             && isNothing isPrefixRelative
                             -> "  (fixed location)"
                      _      -> ""
452

453
454
455
456
457
458
459
        dirinfo "Binaries"         (bindir dirs)     (bindir relative)
        dirinfo "Libraries"        (libdir dirs)     (libdir relative)
        dirinfo "Private binaries" (libexecdir dirs) (libexecdir relative)
        dirinfo "Data files"       (datadir dirs)    (datadir relative)
        dirinfo "Documentation"    (docdir dirs)     (docdir relative)

        sequence_ [ reportProgram verbosity prog configuredProg
460
                  | (prog, configuredProg) <- knownPrograms programsConfig''' ]
461

462
        return lbi
463

464
465
466
    where
      addExtraIncludeLibDirs pkg_descr =
          let extraBi = mempty { extraLibDirs = configExtraLibDirs cfg
Malcolm.Wallace's avatar
Malcolm.Wallace committed
467
                               , PD.includeDirs = configExtraIncludeDirs cfg}
468
469
470
471
              modifyLib l        = l{ libBuildInfo = libBuildInfo l `mappend` extraBi }
              modifyExecutable e = e{ buildInfo    = buildInfo e    `mappend` extraBi}
          in pkg_descr{ library     = modifyLib        `fmap` library pkg_descr
                      , executables = modifyExecutable  `map` executables pkg_descr}
472
473
474
-- -----------------------------------------------------------------------------
-- Configuring package dependencies

ijones's avatar
ijones committed
475
476
-- |Converts build dependencies to a versioned dependency.  only sets
-- version information for exact versioned dependencies.
477
inventBogusPackageId :: Dependency -> PackageIdentifier
ijones's avatar
ijones committed
478
479

-- if they specify the exact version, use that:
480
inventBogusPackageId (Dependency s (ThisVersion v)) = PackageIdentifier s v
ijones's avatar
ijones committed
481
482

-- otherwise, just set it to empty
483
inventBogusPackageId (Dependency s _) = PackageIdentifier s (Version [] [])
ijones's avatar
ijones committed
484

485
486
487
488
489
reportProgram :: Verbosity -> Program -> Maybe ConfiguredProgram -> IO ()
reportProgram verbosity prog Nothing
    = info verbosity $ "No " ++ programName prog ++ " found"
reportProgram verbosity prog (Just configuredProg)
    = info verbosity $ "Using " ++ programName prog ++ version ++ location
490
491
492
493
494
    where location = case programLocation configuredProg of
            FoundOnSystem p -> " found on system at: " ++ p
            UserSpecified p -> " given by user at: " ++ p
          version = case programVersion configuredProg of
            Nothing -> ""
495
            Just v  -> " version " ++ display v
ijones's avatar
ijones committed
496

497
498
hackageUrl :: String
hackageUrl = "http://hackage.haskell.org/cgi-bin/hackage-scripts/package/"
499

ijones's avatar
ijones committed
500
-- | Test for a package dependency and record the version we have installed.
501
configDependency :: Verbosity -> PackageIndex InstalledPackageInfo -> Dependency -> IO PackageIdentifier
Duncan Coutts's avatar
Duncan Coutts committed
502
configDependency verbosity index dep@(Dependency pkgname _) =
503
  case PackageIndex.lookupDependency index dep of
504
        [] -> die $ "cannot satisfy dependency "
Duncan Coutts's avatar
Duncan Coutts committed
505
                      ++ display dep ++ "\n"
Duncan Coutts's avatar
Duncan Coutts committed
506
                      ++ "Perhaps you need to download and install it from\n"
Duncan Coutts's avatar
Duncan Coutts committed
507
                      ++ hackageUrl ++ display pkgname ++ "?"
508
        pkgs -> do let pkgid = maximumBy (comparing packageVersion) (map packageId pkgs)
Duncan Coutts's avatar
Duncan Coutts committed
509
                   info verbosity $ "Dependency " ++ display dep
510
                                ++ ": using " ++ display pkgid
511
                   return pkgid
ijones's avatar
ijones committed
512

513
getInstalledPackages :: Verbosity -> Compiler -> PackageDB -> ProgramConfiguration
514
                     -> IO (Maybe (PackageIndex InstalledPackageInfo))
515
getInstalledPackages verbosity comp packageDb progconf = do
516
  info verbosity "Reading installed packages..."
517
  case compilerFlavor comp of
518
    GHC -> Just `fmap` GHC.getInstalledPackages verbosity packageDb progconf
519
    JHC -> Just `fmap` JHC.getInstalledPackages verbosity packageDb progconf
David Himmelstrup's avatar
David Himmelstrup committed
520
    LHC -> Just `fmap` LHC.getInstalledPackages verbosity packageDb progconf
521
    _   -> return Nothing
ekarttun's avatar
ekarttun committed
522

523
524
525
526
527
528
529
530
-- -----------------------------------------------------------------------------
-- Configuring program dependencies

configureRequiredPrograms :: Verbosity -> [Dependency] -> ProgramConfiguration -> IO ProgramConfiguration
configureRequiredPrograms verbosity deps conf =
  foldM (configureRequiredProgram verbosity) conf deps

configureRequiredProgram :: Verbosity -> ProgramConfiguration -> Dependency -> IO ProgramConfiguration
Duncan Coutts's avatar
Duncan Coutts committed
531
configureRequiredProgram verbosity conf (Dependency (PackageName progName) verRange) =
532
  case lookupKnownProgram progName conf of
Duncan Coutts's avatar
Duncan Coutts committed
533
    Nothing -> die ("Unknown build tool " ++ progName)
534
535
    Just prog -> snd `fmap` requireProgram verbosity prog verRange conf

536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
-- -----------------------------------------------------------------------------
-- Configuring pkg-config package dependencies

configurePkgconfigPackages :: Verbosity -> PackageDescription
                           -> ProgramConfiguration
                           -> IO (PackageDescription, ProgramConfiguration)
configurePkgconfigPackages verbosity pkg_descr conf
  | null allpkgs = return (pkg_descr, conf)
  | otherwise    = do
    (_, conf') <- requireProgram (lessVerbose verbosity) pkgConfigProgram
                    (orLaterVersion $ Version [0,9,0] []) conf
    mapM_ requirePkg allpkgs
    lib'  <- updateLibrary (library pkg_descr)
    exes' <- mapM updateExecutable (executables pkg_descr)
    let pkg_descr' = pkg_descr { library = lib', executables = exes' }
    return (pkg_descr', conf')
552
553

  where
554
555
556
557
    allpkgs = concatMap pkgconfigDepends (allBuildInfo pkg_descr)
    pkgconfig = rawSystemProgramStdoutConf (lessVerbose verbosity)
                  pkgConfigProgram conf

Duncan Coutts's avatar
Duncan Coutts committed
558
    requirePkg dep@(Dependency (PackageName pkg) range) = do
559
      version <- pkgconfig ["--modversion", pkg]
560
561
                 `catchIO`   (\_ -> die notFound)
                 `catchExit` (\_ -> die notFound)
562
      case simpleParse version of
563
564
        Nothing -> die "parsing output of pkg-config --modversion failed"
        Just v | not (withinRange v range) -> die (badVersion v)
565
               | otherwise                 -> info verbosity (depSatisfied v)
566
      where
567
568
569
570
        notFound     = "The pkg-config package " ++ pkg ++ versionRequirement
                    ++ " is required but it could not be found."
        badVersion v = "The pkg-config package " ++ pkg ++ versionRequirement
                    ++ " is required but the version installed on the"
571
                    ++ " system is version " ++ display v
Duncan Coutts's avatar
Duncan Coutts committed
572
        depSatisfied v = "Dependency " ++ display dep
573
                      ++ ": using version " ++ display v
574
575
576

        versionRequirement
          | range == AnyVersion = ""
577
          | otherwise           = " version " ++ display range
578
579
580

    updateLibrary Nothing    = return Nothing
    updateLibrary (Just lib) = do
581
      bi <- pkgconfigBuildInfo (pkgconfigDepends (libBuildInfo lib))
582
      return $ Just lib { libBuildInfo = libBuildInfo lib `mappend` bi }
583
584

    updateExecutable exe = do
585
      bi <- pkgconfigBuildInfo (pkgconfigDepends (buildInfo exe))
586
      return exe { buildInfo = buildInfo exe `mappend` bi }
587
588

    pkgconfigBuildInfo :: [Dependency] -> IO BuildInfo
589
590
591
    pkgconfigBuildInfo []      = return mempty
    pkgconfigBuildInfo pkgdeps = do
      let pkgs = nub [ display pkg | Dependency pkg _ <- pkgdeps ]
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
      ccflags <- pkgconfig ("--cflags" : pkgs)
      ldflags <- pkgconfig ("--libs"   : pkgs)
      return (ccLdOptionsBuildInfo (words ccflags) (words ldflags))

-- | Makes a 'BuildInfo' from C compiler and linker flags.
--
-- This can be used with the output from configuration programs like pkg-config
-- and similar package-specific programs like mysql-config, freealut-config etc.
-- For example:
--
-- > ccflags <- rawSystemProgramStdoutConf verbosity prog conf ["--cflags"]
-- > ldflags <- rawSystemProgramStdoutConf verbosity prog conf ["--libs"]
-- > return (ccldOptionsBuildInfo (words ccflags) (words ldflags))
--
ccLdOptionsBuildInfo :: [String] -> [String] -> BuildInfo
ccLdOptionsBuildInfo cflags ldflags =
  let (includeDirs',  cflags')   = partition ("-I" `isPrefixOf`) cflags
      (extraLibs',    ldflags')  = partition ("-l" `isPrefixOf`) ldflags
      (extraLibDirs', ldflags'') = partition ("-L" `isPrefixOf`) ldflags'
611
  in mempty {
612
613
614
615
616
       PD.includeDirs  = map (drop 2) includeDirs',
       PD.extraLibs    = map (drop 2) extraLibs',
       PD.extraLibDirs = map (drop 2) extraLibDirs',
       PD.ccOptions    = cflags',
       PD.ldOptions    = ldflags''
617
     }
618

619
620
621
-- -----------------------------------------------------------------------------
-- Determining the compiler details

622
configCompilerAux :: ConfigFlags -> IO (Compiler, ProgramConfiguration)
623
624
625
configCompilerAux cfg = configCompiler (flagToMaybe $ configHcFlavor cfg)
                                       (flagToMaybe $ configHcPath cfg)
                                       (flagToMaybe $ configHcPkg cfg)
Duncan Coutts's avatar
Duncan Coutts committed
626
                                       defaultProgramConfiguration
627
                                       (fromFlag (configVerbosity cfg))
628

629
configCompiler :: Maybe CompilerFlavor -> Maybe FilePath -> Maybe FilePath
630
631
632
633
634
635
636
               -> ProgramConfiguration -> Verbosity
               -> IO (Compiler, ProgramConfiguration)
configCompiler Nothing _ _ _ _ = die "Unknown compiler"
configCompiler (Just hcFlavor) hcPath hcPkg conf verbosity = do
  case hcFlavor of
      GHC  -> GHC.configure  verbosity hcPath hcPkg conf
      JHC  -> JHC.configure  verbosity hcPath hcPkg conf
David Himmelstrup's avatar
David Himmelstrup committed
637
638
      LHC  -> do (_,ghcConf) <- GHC.configure  verbosity Nothing hcPkg conf
                 LHC.configure  verbosity hcPath Nothing ghcConf
639
640
      Hugs -> Hugs.configure verbosity hcPath hcPkg conf
      NHC  -> NHC.configure  verbosity hcPath hcPkg conf
641
      _    -> die "Unknown compiler"
ekarttun's avatar
ekarttun committed
642

643

644
-- | Output package check warnings and errors. Exit if any errors.
645
646
647
648
649
650
651
652
653
checkPackageProblems :: Verbosity
                     -> Maybe GenericPackageDescription
                     -> PackageDescription
                     -> IO ()
checkPackageProblems verbosity mgpkg pkg = do
  ioChecks      <- checkPackageFiles pkg "."
  let pureChecks = case mgpkg of
                     Just gpkg -> checkPackage gpkg (Just pkg)
                     Nothing   -> checkConfiguredPackage pkg
654
655
656
657
658
659
      errors   = [ e | PackageBuildImpossible e <- pureChecks ++ ioChecks ]
      warnings = [ w | PackageBuildWarning    w <- pureChecks ++ ioChecks ]
  if null errors
    then mapM_ (warn verbosity) warnings
    else do mapM_ (hPutStrLn stderr . ("Error: " ++)) errors
            exitWith (ExitFailure 1)
660

661
-- -----------------------------------------------------------------------------
662
-- Tests
663

664
{- Too specific:
665
hunitTests :: [Test]
simonmar's avatar
simonmar committed
666
hunitTests = []
ijones's avatar
ijones committed
667
packageID = PackageIdentifier "Foo" (Version [1] [])
668
    = [TestCase $
ijones's avatar
ijones committed
669
670
671
       do let simonMarGHCLoc = "/usr/bin/ghc"
          simonMarGHC <- configure emptyPackageDescription {package=packageID}
                                       (Just GHC,
672
673
674
675
676
677
                                       Just simonMarGHCLoc,
                                       Nothing, Nothing)
          assertEqual "finding ghc, etc on simonMar's machine failed"
             (LocalBuildInfo "/usr" (Compiler GHC
                            (Version [6,2,2] []) simonMarGHCLoc
                            (simonMarGHCLoc ++ "-pkg")) [] [])
678
679
             simonMarGHC
      ]
simonmar's avatar
simonmar committed
680
-}