Configure.hs 30.8 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.PackageSet as PackageSet
import Distribution.Simple.PackageSet (PackageSet)
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
    , userSpecifyArgs, userSpecifyPath
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
119
120
121
import qualified Distribution.Simple.GHC  as GHC
import qualified Distribution.Simple.JHC  as JHC
import qualified Distribution.Simple.NHC  as NHC
import qualified Distribution.Simple.Hugs as Hugs

122
import Control.Monad
123
    ( when, unless, foldM )
124
125
import Control.Exception as Exception
    ( catch )
126
import Data.List
127
    ( nub, partition, isPrefixOf, maximumBy )
128
import Data.Maybe
129
    ( fromMaybe, isNothing )
130
131
import Data.Monoid
    ( Monoid(..) )
132
import System.Directory
133
    ( doesFileExist, getModificationTime, createDirectoryIfMissing )
134
135
136
import System.Exit
    ( ExitCode(..), exitWith )
import System.FilePath
137
    ( (</>), isAbsolute )
138
import qualified System.Info
139
    ( compilerName, compilerVersion )
140
import System.IO
141
    ( hPutStrLn, stderr )
142
import Distribution.Text
143
    ( Text(disp), display, simpleParse )
144
145
import Text.PrettyPrint.HughesPJ
    ( comma, punctuate, render, nest, sep )
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
        let programsConfig =
277
278
                flip (foldl userSpecifyArgs') (configProgramArgs cfg)
              . flip (foldl userSpecifyPath') (configProgramPaths cfg)
279
              $ configPrograms cfg
280
281
            userSpecifyArgs' conf (prog, args) = userSpecifyArgs prog args conf
            userSpecifyPath' conf (prog, path) = userSpecifyPath prog path conf
282
            userInstall = fromFlag (configUserInstall cfg)
283
284
285
286
            defaultPackageDB | userInstall = UserPackageDB
                             | otherwise   = GlobalPackageDB
            packageDb   = fromFlagOrDefault defaultPackageDB
                                            (configPackageDB cfg)
287

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

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

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

317
318
319
        -- 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'
320

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

326
327
328
        checkPackageProblems verbosity
          (either Just (\_->Nothing) pkg_descr0) --TODO: make the Either go away
          (updatePackageDescription pbi pkg_descr)
329

330
        let packageSet = fromMaybe bogusPackageSet maybePackageSet
331
332
333
334
335
336
337
            -- 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)
338
            bogusPackageSet = PackageSet.fromList
339
340
341
342
343
              [ emptyInstalledPackageInfo {
                  InstalledPackageInfo.package = bogusPackageId
                  -- note that these bogus packages have no other dependencies
                }
              | bogusPackageId <- bogusDependencies ]
344
        dep_pkgs <- case flavor of
345
346
          GHC -> mapM (configDependency verbosity packageSet) (buildDepends pkg_descr)
          JHC -> mapM (configDependency verbosity packageSet) (buildDepends pkg_descr)
347
          _   -> return bogusDependencies
Simon Marlow's avatar
Simon Marlow committed
348

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

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

379
        removeInstalledConfig distPref
Simon Marlow's avatar
Simon Marlow committed
380

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

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

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

398
399
        (pkg_descr', programsConfig''') <- configurePkgconfigPackages verbosity
                                            pkg_descr programsConfig''
400

401
402
403
404
405
406
        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
407
                                         ("this compiler does not support " ++
408
409
410
411
412
413
414
415
                                          "--enable-split-objs; ignoring")
                                    return False

        let lbi = LocalBuildInfo{
                    installDirTemplates = installDirs,
                    compiler            = comp,
                    buildDir            = distPref </> "build",
                    scratchDir          = fromFlagOrDefault
416
417
                                            (distPref </> "scratch")
                                            (configScratchDir cfg),
418
                    packageDeps         = dep_pkgs,
419
                    installedPkgs       = packageDependsIndex,
420
                    pkgDescrFile        = Nothing,
421
422
423
424
425
426
427
428
429
                    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,
430
                    stripExes           = fromFlag $ configStripExes cfg,
431
                    withPackageDB       = packageDb,
432
433
                    progPrefix          = fromFlag $ configProgPrefix cfg,
                    progSuffix          = fromFlag $ configProgSuffix cfg
Duncan Coutts's avatar
Duncan Coutts committed
434
                  }
ijones's avatar
ijones committed
435

436
437
438
        let dirs = absoluteInstallDirs pkg_descr lbi NoCopyDest
            relative = prefixRelativeInstallDirs pkg_descr lbi

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

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

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

455
456
457
458
459
460
461
        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
462
                  | (prog, configuredProg) <- knownPrograms programsConfig''' ]
463

464
        return lbi
465

466
467
468
    where
      addExtraIncludeLibDirs pkg_descr =
          let extraBi = mempty { extraLibDirs = configExtraLibDirs cfg
Malcolm.Wallace's avatar
Malcolm.Wallace committed
469
                               , PD.includeDirs = configExtraIncludeDirs cfg}
470
471
472
473
              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}
474
475
476
-- -----------------------------------------------------------------------------
-- Configuring package dependencies

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

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

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

487
488
489
490
491
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
492
493
494
495
496
    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 -> ""
497
            Just v  -> " version " ++ display v
ijones's avatar
ijones committed
498

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

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

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

524
525
526
527
528
529
530
531
-- -----------------------------------------------------------------------------
-- 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
532
configureRequiredProgram verbosity conf (Dependency (PackageName progName) verRange) =
533
  case lookupKnownProgram progName conf of
Duncan Coutts's avatar
Duncan Coutts committed
534
    Nothing -> die ("Unknown build tool " ++ progName)
535
536
    Just prog -> snd `fmap` requireProgram verbosity prog verRange conf

537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
-- -----------------------------------------------------------------------------
-- 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')
553
554

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

Duncan Coutts's avatar
Duncan Coutts committed
559
    requirePkg dep@(Dependency (PackageName pkg) range) = do
560
561
      version <- pkgconfig ["--modversion", pkg]
                 `Exception.catch` \_ -> 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
589

    pkgconfigBuildInfo :: [Dependency] -> IO BuildInfo
    pkgconfigBuildInfo pkgdeps = do
Duncan Coutts's avatar
Duncan Coutts committed
590
      let pkgs = nub [ display pkg | Dependency pkg _ <- pkgdeps ]
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
      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'
610
  in mempty {
611
612
613
614
615
       PD.includeDirs  = map (drop 2) includeDirs',
       PD.extraLibs    = map (drop 2) extraLibs',
       PD.extraLibDirs = map (drop 2) extraLibDirs',
       PD.ccOptions    = cflags',
       PD.ldOptions    = ldflags''
616
     }
617

618
619
620
-- -----------------------------------------------------------------------------
-- Determining the compiler details

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

628
configCompiler :: Maybe CompilerFlavor -> Maybe FilePath -> Maybe FilePath
629
630
631
632
633
634
635
636
637
               -> 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
      Hugs -> Hugs.configure verbosity hcPath hcPkg conf
      NHC  -> NHC.configure  verbosity hcPath hcPkg conf
638
      _    -> die "Unknown compiler"
ekarttun's avatar
ekarttun committed
639

640

641
-- | Output package check warnings and errors. Exit if any errors.
642
643
644
645
646
647
648
649
650
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
651
652
653
654
655
656
      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)
657

658
-- -----------------------------------------------------------------------------
659
-- Tests
660

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