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

	removeInstalledConfig

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

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

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

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

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

429
430
431
        let dirs = absoluteInstallDirs pkg_descr lbi NoCopyDest
            relative = prefixRelativeInstallDirs pkg_descr lbi

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

435
436
        info verbosity $ "Using compiler: " ++ showCompilerId comp
        info verbosity $ "Using install prefix: " ++ prefix dirs
437

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

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

455
	return lbi
456

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

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

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

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

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

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

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

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

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

529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
-- -----------------------------------------------------------------------------
-- 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
554
      case simpleParse version of
555
556
        Nothing -> die "parsing output of pkg-config --modversion failed"
        Just v | not (withinRange v range) -> die (badVersion v)
557
               | otherwise                 -> info verbosity (depSatisfied v)
558
559
560
561
562
      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"
563
564
565
                    ++ " system is version " ++ display v
        depSatisfied v = "Dependency " ++ pkg ++ display range
                      ++ ": using version " ++ display v
566
567
568

        versionRequirement
          | range == AnyVersion = ""
569
          | otherwise           = " version " ++ display range
570
571
572

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

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

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

610
611
612
-- -----------------------------------------------------------------------------
-- Determining the compiler details

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

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

632

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

650
-- -----------------------------------------------------------------------------
651
-- Tests
652

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