Configure.hs 29 KB
Newer Older
1
2
-----------------------------------------------------------------------------
-- |
ijones's avatar
ijones committed
3
-- Module      :  Distribution.Simple.Configure
4
-- Copyright   :  Isaac Jones 2003-2005
5
6
7
-- 
-- Maintainer  :  Isaac Jones <ijones@syntaxpolice.org>
-- Stability   :  alpha
ijones's avatar
ijones committed
8
-- Portability :  portable
9
--
ijones's avatar
ijones committed
10
-- Explanation: Perform the \"@.\/setup configure@\" action.
Ross Paterson's avatar
Ross Paterson committed
11
-- Outputs the @dist\/setup-config@ file.
12

ijones's avatar
ijones committed
13
{- All rights reserved.
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42

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
43
44
module Distribution.Simple.Configure (configure,
                                      writePersistBuildConfig,
ijones's avatar
ijones committed
45
                                      getPersistBuildConfig,
46
                                      checkPersistBuildConfig,
47
                                      maybeGetPersistBuildConfig,
48
--                                      getConfiguredPkgDescr,
ijones's avatar
ijones committed
49
                                      localBuildInfoFile,
50
                                      getInstalledPackages,
Simon Marlow's avatar
Simon Marlow committed
51
				      configDependency,
52
                                      configCompiler, configCompilerAux,
53
                                      ccLdOptionsBuildInfo,
jpbernardy's avatar
jpbernardy committed
54
                                      tryGetConfigStateFile,
ijones's avatar
ijones committed
55
                                     )
ijones's avatar
ijones committed
56
    where
57

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

107
108
109
110
111
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

112
import Control.Monad
113
    ( when, unless, foldM )
114
115
import Control.Exception as Exception
    ( catch )
116
import Data.List
117
    ( nub, partition, isPrefixOf, maximumBy )
118
import Data.Maybe
119
    ( fromMaybe, isNothing )
120
121
import Data.Monoid
    ( Monoid(..) )
122
import System.Directory
123
    ( doesFileExist, getModificationTime, createDirectoryIfMissing )
124
125
126
import System.Exit
    ( ExitCode(..), exitWith )
import System.FilePath
127
    ( (</>), isAbsolute )
128
import qualified System.Info
129
    ( compilerName, compilerVersion )
130
import System.IO
131
    ( hPutStrLn, stderr, hGetContents, openFile, hClose, IOMode(ReadMode) )
132
import Distribution.Text
133
    ( Text(disp), display, simpleParse )
134
135
136
import Text.PrettyPrint.HughesPJ
    ( comma, punctuate, render, nest, sep )
    
137
import Prelude hiding (catch)
138

139
140
tryGetConfigStateFile :: (Read a) => FilePath -> IO (Either String a)
tryGetConfigStateFile filename = do
141
142
143
  exists <- doesFileExist filename
  if not exists
    then return (Left missing)
144
145
    else do
      str <- readFileStrict filename
146
147
148
149
150
151
152
153
      return $ case lines str of
        [headder, rest] -> case checkHeader headder of
          Just msg -> Left msg
          Nothing  -> case reads rest of
            [(bi,_)] -> Right bi
            _        -> Left cantParse
        _            -> Left cantParse
  where
154
155
156
157
158
    readFileStrict name = do 
      h <- openFile name ReadMode
      str <- hGetContents h >>= \str -> length str `seq` return str 
      hClose h
      return str
159
160
    checkHeader :: String -> Maybe String
    checkHeader header = case parseHeader header of
161
      Just (cabalId, compId)
162
163
        | cabalId
       == currentCabalId -> Nothing
164
        | otherwise      -> Just (badVersion cabalId compId)
165
166
167
168
169
      Nothing            -> Just cantParse

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

183
184
185
186
-- internal function
tryGetPersistBuildConfig :: IO (Either String LocalBuildInfo)
tryGetPersistBuildConfig = tryGetConfigStateFile localBuildInfoFile

187
188
189
-- |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.
190
191
192
193
194
getPersistBuildConfig :: IO LocalBuildInfo
getPersistBuildConfig = do
  lbi <- tryGetPersistBuildConfig
  either die return lbi

ijones's avatar
ijones committed
195
-- |Try to read the 'localBuildInfoFile'.
196
197
198
199
maybeGetPersistBuildConfig :: IO (Maybe LocalBuildInfo)
maybeGetPersistBuildConfig = do
  lbi <- tryGetPersistBuildConfig
  return $ either (const Nothing) Just lbi
ijones's avatar
ijones committed
200

ijones's avatar
ijones committed
201
202
-- |After running configure, output the 'LocalBuildInfo' to the
-- 'localBuildInfoFile'.
ijones's avatar
ijones committed
203
writePersistBuildConfig :: LocalBuildInfo -> IO ()
204
writePersistBuildConfig lbi = do
Ross Paterson's avatar
Ross Paterson committed
205
  createDirectoryIfMissing False distPref
206
207
208
209
210
211
212
  writeFile localBuildInfoFile $ showHeader pkgid
                              ++ '\n' : show lbi
  where
    pkgid   = packageId (localPkgDescr lbi)

showHeader :: PackageIdentifier -> String
showHeader pkgid =
213
214
215
     "Saved package config for " ++ display pkgid
  ++ " written by " ++ display currentCabalId
  ++      " using " ++ display currentCompilerId
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
  where

currentCabalId :: PackageIdentifier
currentCabalId = PackageIdentifier "Cabal" currentVersion
  where currentVersion | cabalBootstrapping = Version [0] []
                       | otherwise          = cabalVersion

currentCompilerId :: PackageIdentifier
currentCompilerId = PackageIdentifier System.Info.compilerName
                                      System.Info.compilerVersion

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

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

Ross Paterson's avatar
Ross Paterson committed
249
-- |@dist\/setup-config@
250
localBuildInfoFile :: FilePath
Ross Paterson's avatar
Ross Paterson committed
251
localBuildInfoFile = distPref </> "setup-config"
ijones's avatar
ijones committed
252

253
-- -----------------------------------------------------------------------------
ijones's avatar
ijones committed
254
255
-- * Configuration
-- -----------------------------------------------------------------------------
256

257
258
-- |Perform the \"@.\/setup configure@\" action.
-- Returns the @.setup-config@ file.
259
configure :: ( Either GenericPackageDescription PackageDescription
260
             , HookedBuildInfo) 
261
          -> ConfigFlags -> IO LocalBuildInfo
262
configure (pkg_descr0, pbi) cfg
263
  = do  let verbosity = fromFlag (configVerbosity cfg)
264
265

	setupMessage verbosity "Configuring"
266
                     (packageId (either packageDescription id pkg_descr0))
267

268
	createDirectoryIfMissingVerbose (lessVerbose verbosity) True distPref
269

270
271
272
273
        let programsConfig = 
                flip (foldr (uncurry userSpecifyArgs)) (configProgramArgs cfg)
              . flip (foldr (uncurry userSpecifyPath)) (configProgramPaths cfg)
              $ configPrograms cfg
274
275
276
277
278
            userInstall = fromFlag (configUserInstall cfg)
	    defaultPackageDB | userInstall = UserPackageDB
	                     | otherwise   = GlobalPackageDB
	    packageDb   = fromFlagOrDefault defaultPackageDB
	                                    (configPackageDB cfg)
279

280
	-- detect compiler
281
282
283
284
	(comp, programsConfig') <- configCompiler
          (flagToMaybe $ configHcFlavor cfg)
          (flagToMaybe $ configHcPath cfg) (flagToMaybe $ configHcPkg cfg)
          programsConfig (lessVerbose verbosity)
285
286
        let version = compilerVersion comp
            flavor  = compilerFlavor comp
287

Simon Marlow's avatar
Simon Marlow committed
288
        -- FIXME: currently only GHC has hc-pkg
289
290
        maybePackageIndex <- getInstalledPackages (lessVerbose verbosity) comp
                               packageDb programsConfig'
291

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

313
        when (not (null flags)) $
314
315
316
          info verbosity $ "Flags chosen: "
                        ++ intercalate ", " [ name ++ "=" ++ display value
                                            | (FlagName name, value) <- flags ]
317

318
        checkPackageProblems verbosity (updatePackageDescription pbi pkg_descr)
319

320
321
322
323
324
325
326
327
328
329
330
331
332
333
        let packageIndex = fromMaybe bogusPackageIndex maybePackageIndex
            -- 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)
            bogusPackageIndex = PackageIndex.fromList
              [ emptyInstalledPackageInfo {
                  InstalledPackageInfo.package = bogusPackageId
                  -- note that these bogus packages have no other dependencies
                }
              | bogusPackageId <- bogusDependencies ]
334
        dep_pkgs <- case flavor of
335
336
          GHC -> mapM (configDependency verbosity packageIndex) (buildDepends pkg_descr)
          JHC -> mapM (configDependency verbosity packageIndex) (buildDepends pkg_descr)
337
          _   -> return bogusDependencies
Simon Marlow's avatar
Simon Marlow committed
338

339
        packageDependsIndex <-
340
          case PackageIndex.dependencyClosure packageIndex dep_pkgs of
341
342
343
            Left packageDependsIndex -> return packageDependsIndex
            Right broken ->
              die $ "The following installed packages are broken because other"
344
345
                 ++ " packages they depend on are missing. These broken "
                 ++ "packages must be rebuilt before they can be used.\n"
346
                 ++ unlines [ "package "
347
                           ++ display (packageId pkg)
348
                           ++ " is broken due to missing package "
349
                           ++ intercalate ", " (map display deps)
350
351
                            | (pkg, deps) <- broken ]

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

	removeInstalledConfig

369
	-- installation directories
370
	defaultDirs <- defaultInstallDirs flavor userInstall (hasLibs pkg_descr)
371
372
	let installDirs = combineInstallDirs fromFlagOrDefault
                            defaultDirs (configInstallDirs cfg)
373

374
        -- check extensions
375
        let extlist = nub $ concatMap extensions (allBuildInfo pkg_descr)
376
        let exts = unsupportedExtensions comp extlist
377
        unless (null exts) $ warn verbosity $ -- Just warn, FIXME: Should this be an error?
378
            display flavor ++ " does not support the following extensions: " ++
379
            intercalate ", " (map display exts)
380

381
        let requiredBuildTools = concatMap buildTools (allBuildInfo pkg_descr)
382
383
        programsConfig'' <-
              configureAllKnownPrograms (lessVerbose verbosity) programsConfig'
384
          >>= configureRequiredPrograms verbosity requiredBuildTools
385
        
386
387
        (pkg_descr', programsConfig''') <- configurePkgconfigPackages verbosity
                                            pkg_descr programsConfig''
388

389
	split_objs <- 
390
	   if not (fromFlag $ configSplitObjs cfg)
391
		then return False
392
393
		else case flavor of
			    GHC | version >= Version [6,5] [] -> return True
394
	    		    _ -> do warn verbosity
Ian Lynagh's avatar
Ian Lynagh committed
395
396
                                         ("this compiler does not support " ++
					  "--enable-split-objs; ignoring")
397
398
				    return False

399
	let lbi = LocalBuildInfo{
400
401
		    installDirTemplates = installDirs,
		    compiler            = comp,
Duncan Coutts's avatar
Duncan Coutts committed
402
		    buildDir            = distPref </> "build",
403
404
405
		    scratchDir          = fromFlagOrDefault
                                            (distPref </> "scratch")
                                            (configScratchDir cfg),
406
		    packageDeps         = dep_pkgs,
407
                    installedPkgs       = packageDependsIndex,
408
                    pkgDescrFile        = Nothing,
409
		    localPkgDescr       = pkg_descr',
410
411
412
413
414
415
416
		    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,
Duncan Coutts's avatar
Duncan Coutts committed
417
		    splitObjs           = split_objs,
418
                    stripExes           = fromFlag $ configStripExes cfg,
419
420
421
		    withPackageDB       = packageDb,
                    progPrefix          = fromFlag $ configProgPrefix cfg,
                    progSuffix          = fromFlag $ configProgSuffix cfg
Duncan Coutts's avatar
Duncan Coutts committed
422
                  }
ijones's avatar
ijones committed
423

424
425
426
        let dirs = absoluteInstallDirs pkg_descr lbi NoCopyDest
            relative = prefixRelativeInstallDirs pkg_descr lbi

427
428
429
        unless (isAbsolute (prefix dirs)) $ die $
            "expected an absolute directory name for --prefix: " ++ prefix dirs

430
431
        info verbosity $ "Using compiler: " ++ showCompilerId comp
        info verbosity $ "Using install prefix: " ++ prefix dirs
432

433
434
        let dirinfo name dir isPrefixRelative =
              info verbosity $ name ++ " installed in: " ++ dir ++ relNote
435
436
437
438
439
              where relNote = case buildOS of
                      Windows | not (hasLibs pkg_descr)
                             && isNothing isPrefixRelative
                             -> "  (fixed location)"
                      _      -> ""
440

441
442
443
444
445
446
447
        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
448
                  | (prog, configuredProg) <- knownPrograms programsConfig''' ]
449

450
	return lbi
451

452
453
454
    where
      addExtraIncludeLibDirs pkg_descr =
          let extraBi = mempty { extraLibDirs = configExtraLibDirs cfg
Malcolm.Wallace's avatar
Malcolm.Wallace committed
455
                               , PD.includeDirs = configExtraIncludeDirs cfg}
456
457
458
459
              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}
460
461
462
-- -----------------------------------------------------------------------------
-- Configuring package dependencies

ijones's avatar
ijones committed
463
464
-- |Converts build dependencies to a versioned dependency.  only sets
-- version information for exact versioned dependencies.
465
inventBogusPackageId :: Dependency -> PackageIdentifier
ijones's avatar
ijones committed
466
467

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

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

473
474
475
476
477
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
478
479
480
481
482
    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 -> ""
483
            Just v  -> " version " ++ display v
ijones's avatar
ijones committed
484

485
486
hackageUrl :: String
hackageUrl = "http://hackage.haskell.org/cgi-bin/hackage-scripts/package/"
487

ijones's avatar
ijones committed
488
-- | Test for a package dependency and record the version we have installed.
489
configDependency :: Verbosity -> PackageIndex InstalledPackageInfo -> Dependency -> IO PackageIdentifier
490
configDependency verbosity index dep@(Dependency pkgname vrange) =
491
492
  case PackageIndex.lookupDependency index dep of
        [] -> die $ "cannot satisfy dependency "
493
                      ++ pkgname ++ display vrange ++ "\n"
Duncan Coutts's avatar
Duncan Coutts committed
494
495
                      ++ "Perhaps you need to download and install it from\n"
                      ++ hackageUrl ++ pkgname ++ "?"
496
        pkgs -> do let pkgid = maximumBy (comparing packageVersion) (map packageId pkgs)
497
                   info verbosity $ "Dependency " ++ pkgname
498
                                ++ display vrange
499
                                ++ ": using " ++ display pkgid
500
                   return pkgid
ijones's avatar
ijones committed
501

502
getInstalledPackages :: Verbosity -> Compiler -> PackageDB -> ProgramConfiguration
503
                     -> IO (Maybe (PackageIndex InstalledPackageInfo))
504
getInstalledPackages verbosity comp packageDb progconf = do
505
  info verbosity "Reading installed packages..."
506
  case compilerFlavor comp of
507
    GHC -> Just `fmap` GHC.getInstalledPackages verbosity packageDb progconf
508
509
    JHC -> Just `fmap` JHC.getInstalledPackages verbosity packageDb progconf
    _   -> return Nothing
ekarttun's avatar
ekarttun committed
510

511
512
513
514
515
516
517
518
519
520
521
522
523
-- -----------------------------------------------------------------------------
-- Configuring program dependencies

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

configureRequiredProgram :: Verbosity -> ProgramConfiguration -> Dependency -> IO ProgramConfiguration
configureRequiredProgram verbosity conf (Dependency progName verRange) =
  case lookupKnownProgram progName conf of
    Nothing -> die ("Unknown build tool " ++ show progName)
    Just prog -> snd `fmap` requireProgram verbosity prog verRange conf

524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
-- -----------------------------------------------------------------------------
-- 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')
        
  where 
    allpkgs = concatMap pkgconfigDepends (allBuildInfo pkg_descr)
    pkgconfig = rawSystemProgramStdoutConf (lessVerbose verbosity)
                  pkgConfigProgram conf

    requirePkg (Dependency pkg range) = do
      version <- pkgconfig ["--modversion", pkg]
                 `Exception.catch` \_ -> die notFound
549
      case simpleParse version of
550
551
        Nothing -> die "parsing output of pkg-config --modversion failed"
        Just v | not (withinRange v range) -> die (badVersion v)
552
               | otherwise                 -> info verbosity (depSatisfied v)
553
554
555
556
557
      where 
        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"
558
559
560
                    ++ " system is version " ++ display v
        depSatisfied v = "Dependency " ++ pkg ++ display range
                      ++ ": using version " ++ display v
561
562
563

        versionRequirement
          | range == AnyVersion = ""
564
          | otherwise           = " version " ++ display range
565
566
567

    updateLibrary Nothing    = return Nothing
    updateLibrary (Just lib) = do
568
      bi <- pkgconfigBuildInfo (pkgconfigDepends (libBuildInfo lib))
569
      return $ Just lib { libBuildInfo = libBuildInfo lib `mappend` bi }
570
571

    updateExecutable exe = do
572
      bi <- pkgconfigBuildInfo (pkgconfigDepends (buildInfo exe))
573
      return exe { buildInfo = buildInfo exe `mappend` bi }
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596

    pkgconfigBuildInfo :: [Dependency] -> IO BuildInfo
    pkgconfigBuildInfo pkgdeps = do
      let pkgs = nub [ pkg | Dependency pkg _ <- pkgdeps ]
      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'
597
  in mempty {
598
599
600
601
602
       PD.includeDirs  = map (drop 2) includeDirs',
       PD.extraLibs    = map (drop 2) extraLibs',
       PD.extraLibDirs = map (drop 2) extraLibDirs',
       PD.ccOptions    = cflags',
       PD.ldOptions    = ldflags''
603
     }
604

605
606
607
-- -----------------------------------------------------------------------------
-- Determining the compiler details

608
configCompilerAux :: ConfigFlags -> IO (Compiler, ProgramConfiguration)
609
610
611
configCompilerAux cfg = configCompiler (flagToMaybe $ configHcFlavor cfg)
                                       (flagToMaybe $ configHcPath cfg)
                                       (flagToMaybe $ configHcPkg cfg)
Duncan Coutts's avatar
Duncan Coutts committed
612
                                       defaultProgramConfiguration
613
                                       (fromFlag (configVerbosity cfg))
614

615
configCompiler :: Maybe CompilerFlavor -> Maybe FilePath -> Maybe FilePath
616
617
618
619
620
621
622
623
624
               -> 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
625
      _    -> die "Unknown compiler"
ekarttun's avatar
ekarttun committed
626

627

628
629
630
631
632
633
634
635
636
637
638
-- | Output package check warnings and errors. Exit if any errors.
checkPackageProblems :: Verbosity -> PackageDescription -> IO ()
checkPackageProblems verbosity pkg_descr = do
  ioChecks      <- checkPackageFiles pkg_descr "."
  let pureChecks = checkPackage      pkg_descr
      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)
639

640
-- -----------------------------------------------------------------------------
641
-- Tests
642

643
{- Too specific:
644
hunitTests :: [Test]
simonmar's avatar
simonmar committed
645
hunitTests = []
ijones's avatar
ijones committed
646
packageID = PackageIdentifier "Foo" (Version [1] [])
647
    = [TestCase $
ijones's avatar
ijones committed
648
649
650
       do let simonMarGHCLoc = "/usr/bin/ghc"
          simonMarGHC <- configure emptyPackageDescription {package=packageID}
                                       (Just GHC,
651
				       Just simonMarGHCLoc,
ijones's avatar
ijones committed
652
				       Nothing, Nothing)
653
	  assertEqual "finding ghc, etc on simonMar's machine failed"
654
             (LocalBuildInfo "/usr" (Compiler GHC 
simonmar's avatar
simonmar committed
655
	                    (Version [6,2,2] []) simonMarGHCLoc 
ijones's avatar
ijones committed
656
 			    (simonMarGHCLoc ++ "-pkg")) [] [])
657
658
             simonMarGHC
      ]
simonmar's avatar
simonmar committed
659
-}