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
Duncan Coutts's avatar
Duncan Coutts committed
113
114
    ( Version(..)
    , orLaterVersion, withinRange, isSpecificVersion, isAnyVersion )
115
import Distribution.Verbosity
116
    ( Verbosity, lessVerbose )
117

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

124
import Control.Monad
125
    ( when, unless, foldM )
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
import Distribution.Compat.Exception ( catchExit, catchIO )
147

148
import Prelude hiding (catch)
149

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

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

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

193
194
195
-- |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.
196
197
198
getPersistBuildConfig :: FilePath -> IO LocalBuildInfo
getPersistBuildConfig distPref = do
  lbi <- tryGetPersistBuildConfig distPref
199
200
  either die return lbi

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

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

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

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

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

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

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

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

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

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

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

275
        createDirectoryIfMissingVerbose (lessVerbose verbosity) True distPref
276

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

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

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

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

315
316
317
        -- 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'
318

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

463
        return lbi
464

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

ijones's avatar
ijones committed
476
477
-- |Converts build dependencies to a versioned dependency.  only sets
-- version information for exact versioned dependencies.
478
inventBogusPackageId :: Dependency -> PackageIdentifier
Duncan Coutts's avatar
Duncan Coutts committed
479
480
481
482
483
inventBogusPackageId (Dependency s vr) = case isSpecificVersion vr of
  -- if they specify the exact version, use that:
  Just v -> PackageIdentifier s v
  -- otherwise, just set it to empty
  Nothing -> 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

        versionRequirement
Duncan Coutts's avatar
Duncan Coutts committed
576
577
          | isAnyVersion range = ""
          | 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
-}