Configure.hs 29.3 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
import Distribution.PackageDescription.Check
78
79
    ( PackageCheck(..)
    , checkPackage, checkConfiguredPackage, checkPackageFiles )
80
import Distribution.Simple.Program
81
    ( Program(..), ProgramLocation(..), ConfiguredProgram(..)
Duncan Coutts's avatar
Duncan Coutts committed
82
83
    , ProgramConfiguration, defaultProgramConfiguration
    , configureAllKnownPrograms, knownPrograms
84
    , userSpecifyArgs, userSpecifyPath
85
86
    , lookupKnownProgram, requireProgram, pkgConfigProgram
    , rawSystemProgramStdoutConf )
87
import Distribution.Simple.Setup
88
    ( ConfigFlags(..), CopyDest(..), fromFlag, fromFlagOrDefault, flagToMaybe )
89
import Distribution.Simple.InstallDirs
90
    ( InstallDirs(..), defaultInstallDirs, combineInstallDirs )
91
import Distribution.Simple.LocalBuildInfo
92
    ( LocalBuildInfo(..), absoluteInstallDirs
93
    , prefixRelativeInstallDirs )
94
95
import Distribution.Simple.BuildPaths
    ( distPref )
96
import Distribution.Simple.Utils
97
    ( die, warn, info, setupMessage, createDirectoryIfMissingVerbose
98
    , intercalate, comparing, cabalVersion, cabalBootstrapping )
99
100
101
import Distribution.Simple.Register
    ( removeInstalledConfig )
import Distribution.System
102
    ( OS(..), buildOS, buildArch )
103
import Distribution.Version
104
    ( Version(..), VersionRange(..), orLaterVersion, withinRange )
105
import Distribution.Verbosity
106
    ( Verbosity, lessVerbose )
107

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

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

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

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

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

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

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

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

showHeader :: PackageIdentifier -> String
showHeader pkgid =
214
215
216
     "Saved package config for " ++ display pkgid
  ++ " written by " ++ display currentCabalId
  ++      " using " ++ display currentCompilerId
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
  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]
232
233
234
    -> case (simpleParse pkgid :: Maybe PackageIdentifier,
             simpleParse cabalid,
             simpleParse compilerid) of
235
236
237
238
239
        (Just _,
         Just cabalid',
         Just compilerid') -> Just (cabalid', compilerid')
        _                  -> Nothing
  _                        -> Nothing
240

241
242
243
244
245
246
247
248
249
-- |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
250
-- |@dist\/setup-config@
251
localBuildInfoFile :: FilePath
Ross Paterson's avatar
Ross Paterson committed
252
localBuildInfoFile = distPref </> "setup-config"
ijones's avatar
ijones committed
253

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

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

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

269
	createDirectoryIfMissingVerbose (lessVerbose verbosity) True distPref
270

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

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

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

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

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

319
320
321
        checkPackageProblems verbosity
          (either Just (\_->Nothing) pkg_descr0) --TODO: make the Either go away
          (updatePackageDescription pbi pkg_descr)
322

323
324
325
326
327
328
329
330
331
332
333
334
335
336
        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 ]
337
        dep_pkgs <- case flavor of
338
339
          GHC -> mapM (configDependency verbosity packageIndex) (buildDepends pkg_descr)
          JHC -> mapM (configDependency verbosity packageIndex) (buildDepends pkg_descr)
340
          _   -> return bogusDependencies
Simon Marlow's avatar
Simon Marlow committed
341

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

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

	removeInstalledConfig

372
	-- installation directories
373
	defaultDirs <- defaultInstallDirs flavor userInstall (hasLibs pkg_descr)
374
375
	let installDirs = combineInstallDirs fromFlagOrDefault
                            defaultDirs (configInstallDirs cfg)
376

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

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

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

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

427
428
429
        let dirs = absoluteInstallDirs pkg_descr lbi NoCopyDest
            relative = prefixRelativeInstallDirs pkg_descr lbi

430
431
432
        unless (isAbsolute (prefix dirs)) $ die $
            "expected an absolute directory name for --prefix: " ++ prefix dirs

433
434
        info verbosity $ "Using compiler: " ++ showCompilerId comp
        info verbosity $ "Using install prefix: " ++ prefix dirs
435

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

444
445
446
447
448
449
450
        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
451
                  | (prog, configuredProg) <- knownPrograms programsConfig''' ]
452

453
	return lbi
454

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

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

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

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

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

488
489
hackageUrl :: String
hackageUrl = "http://hackage.haskell.org/cgi-bin/hackage-scripts/package/"
490

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

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

514
515
516
517
518
519
520
521
522
523
524
525
526
-- -----------------------------------------------------------------------------
-- 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

527
528
529
530
531
532
533
534
535
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')
        
  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
552
      case simpleParse version of
553
554
        Nothing -> die "parsing output of pkg-config --modversion failed"
        Just v | not (withinRange v range) -> die (badVersion v)
555
               | otherwise                 -> info verbosity (depSatisfied v)
556
557
558
559
560
      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"
561
562
563
                    ++ " system is version " ++ display v
        depSatisfied v = "Dependency " ++ pkg ++ display range
                      ++ ": using version " ++ display v
564
565
566

        versionRequirement
          | range == AnyVersion = ""
567
          | otherwise           = " version " ++ display range
568
569
570

    updateLibrary Nothing    = return Nothing
    updateLibrary (Just lib) = do
571
      bi <- pkgconfigBuildInfo (pkgconfigDepends (libBuildInfo lib))
572
      return $ Just lib { libBuildInfo = libBuildInfo lib `mappend` bi }
573
574

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

    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'
600
  in mempty {
601
602
603
604
605
       PD.includeDirs  = map (drop 2) includeDirs',
       PD.extraLibs    = map (drop 2) extraLibs',
       PD.extraLibDirs = map (drop 2) extraLibDirs',
       PD.ccOptions    = cflags',
       PD.ldOptions    = ldflags''
606
     }
607

608
609
610
-- -----------------------------------------------------------------------------
-- Determining the compiler details

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

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

630

631
-- | Output package check warnings and errors. Exit if any errors.
632
633
634
635
636
637
638
639
640
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
641
642
643
644
645
646
      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)
647

648
-- -----------------------------------------------------------------------------
649
-- Tests
650

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