module Distribution.Simple.Configure (configure,
writePersistBuildConfig,
getConfigStateFile,
getPersistBuildConfig,
checkPersistBuildConfigOutdated,
tryGetPersistBuildConfig,
maybeGetPersistBuildConfig,
localBuildInfoFile,
getInstalledPackages, getPackageDBContents,
configCompiler, configCompilerAux,
configCompilerEx, configCompilerAuxEx,
ccLdOptionsBuildInfo,
checkForeignDeps,
interpretPackageDbFlags,
ConfigStateFileError(..),
tryGetConfigStateFile,
platformDefines,
)
where
import Distribution.Compiler
( CompilerId(..) )
import Distribution.Utils.NubList
import Distribution.Simple.Compiler
( CompilerFlavor(..), Compiler(..), compilerFlavor, compilerVersion
, compilerInfo
, showCompilerId, unsupportedLanguages, unsupportedExtensions
, PackageDB(..), PackageDBStack, reexportedModulesSupported
, packageKeySupported, renamingPackageFlagsSupported )
import Distribution.Simple.PreProcess ( platformDefines )
import Distribution.Package
( PackageName(PackageName), PackageIdentifier(..), PackageId
, packageName, packageVersion, Package(..)
, Dependency(Dependency), simplifyDependency
, InstalledPackageId(..), thisPackageVersion
, mkPackageKey, PackageKey(..), packageKeyLibraryName )
import qualified Distribution.InstalledPackageInfo as Installed
import Distribution.InstalledPackageInfo (InstalledPackageInfo, emptyInstalledPackageInfo)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import Distribution.PackageDescription as PD
( PackageDescription(..), specVersion, GenericPackageDescription(..)
, Library(..), hasLibs, Executable(..), BuildInfo(..), allExtensions
, HookedBuildInfo, updatePackageDescription, allBuildInfo
, Flag(flagName), FlagName(..), TestSuite(..), Benchmark(..)
, ModuleReexport(..) , defaultRenaming )
import Distribution.ModuleName
( ModuleName )
import Distribution.PackageDescription.Configuration
( finalizePackageDescription, mapTreeData )
import Distribution.PackageDescription.Check
( PackageCheck(..), checkPackage, checkPackageFiles )
import Distribution.Simple.Program
( Program(..), ProgramLocation(..), ConfiguredProgram(..)
, ProgramConfiguration, defaultProgramConfiguration
, ProgramSearchPathEntry(..), getProgramSearchPath, setProgramSearchPath
, configureAllKnownPrograms, knownPrograms, lookupKnownProgram
, userSpecifyArgss, userSpecifyPaths
, lookupProgram, requireProgram, requireProgramVersion
, pkgConfigProgram, gccProgram, rawSystemProgramStdoutConf )
import Distribution.Simple.Setup
( ConfigFlags(..), CopyDest(..), Flag(..), fromFlag, fromFlagOrDefault
, flagToMaybe )
import Distribution.Simple.InstallDirs
( InstallDirs(..), defaultInstallDirs, combineInstallDirs )
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), Component(..), ComponentLocalBuildInfo(..)
, LibraryName(..)
, absoluteInstallDirs, prefixRelativeInstallDirs, inplacePackageId
, ComponentName(..), showComponentName, pkgEnabledComponents
, componentBuildInfo, componentName, checkComponentsCyclic )
import Distribution.Simple.BuildPaths
( autogenModulesDir )
import Distribution.Simple.Utils
( die, warn, info, setupMessage
, createDirectoryIfMissingVerbose, moreRecentFile
, intercalate, cabalVersion
, writeFileAtomic
, withTempFile )
import Distribution.System
( OS(..), buildOS, Platform (..), buildPlatform )
import Distribution.Version
( Version(..), anyVersion, orLaterVersion, withinRange, isAnyVersion )
import Distribution.Verbosity
( Verbosity, lessVerbose )
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.GHCJS as GHCJS
import qualified Distribution.Simple.JHC as JHC
import qualified Distribution.Simple.LHC as LHC
import qualified Distribution.Simple.UHC as UHC
import qualified Distribution.Simple.HaskellSuite as HaskellSuite
import Prelude hiding ( mapM )
import Control.Exception
( ErrorCall(..), Exception, evaluate, throw, throwIO, try )
import Control.Monad
( liftM, when, unless, foldM, filterM )
import Distribution.Compat.Binary ( decodeOrFailIO, encode )
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy.Char8 as BLC8
import Data.List
( (\\), nub, partition, isPrefixOf, inits, stripPrefix )
import Data.Maybe
( isNothing, catMaybes, fromMaybe, isJust )
import Data.Either
( partitionEithers )
import qualified Data.Set as Set
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid
( Monoid(..) )
#endif
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Traversable
( mapM )
import Data.Typeable
import System.Directory
( doesFileExist, createDirectoryIfMissing, getTemporaryDirectory )
import System.FilePath
( (</>), isAbsolute )
import qualified System.Info
( compilerName, compilerVersion )
import System.IO
( hPutStrLn, hClose )
import Distribution.Text
( Text(disp), display, simpleParse )
import Text.PrettyPrint
( render, (<>), ($+$), char, text, comma
, quotes, punctuate, nest, sep, hsep )
import Distribution.Compat.Exception ( catchExit, catchIO )
data ConfigStateFileError
= ConfigStateFileNoHeader
| ConfigStateFileBadHeader
| ConfigStateFileNoParse
| ConfigStateFileMissing
| ConfigStateFileBadVersion PackageIdentifier PackageIdentifier (Either ConfigStateFileError LocalBuildInfo)
deriving (Typeable)
instance Show ConfigStateFileError where
show ConfigStateFileNoHeader =
"Saved package config file header is missing. "
++ "Try re-running the 'configure' command."
show ConfigStateFileBadHeader =
"Saved package config file header is corrupt. "
++ "Try re-running the 'configure' command."
show ConfigStateFileNoParse =
"Saved package config file body is corrupt. "
++ "Try re-running the 'configure' command."
show ConfigStateFileMissing = "Run the 'configure' command first."
show (ConfigStateFileBadVersion oldCabal oldCompiler _) =
"You need to re-run the 'configure' command. "
++ "The version of Cabal being used has changed (was "
++ display oldCabal ++ ", now "
++ display currentCabalId ++ ")."
++ badCompiler
where
badCompiler
| oldCompiler == currentCompilerId = ""
| otherwise =
" Additionally the compiler is different (was "
++ display oldCompiler ++ ", now "
++ display currentCompilerId
++ ") which is probably the cause of the problem."
instance Exception ConfigStateFileError
getConfigStateFile :: FilePath -> IO LocalBuildInfo
getConfigStateFile filename = do
exists <- doesFileExist filename
unless exists $ throwIO ConfigStateFileMissing
contents <- BS.readFile filename
let (header, body) = BLC8.span (/='\n') (BLC8.fromChunks [contents])
headerParseResult <- try $ evaluate $ parseHeader header
let (cabalId, compId) =
case headerParseResult of
Left (ErrorCall _) -> throw ConfigStateFileBadHeader
Right x -> x
let getStoredValue = do
result <- decodeOrFailIO (BLC8.tail body)
case result of
Left _ -> throw ConfigStateFileNoParse
Right x -> return x
deferErrorIfBadVersion act
| cabalId /= currentCabalId = do
eResult <- try act
throw $ ConfigStateFileBadVersion cabalId compId eResult
| otherwise = act
deferErrorIfBadVersion getStoredValue
tryGetConfigStateFile :: FilePath
-> IO (Either ConfigStateFileError LocalBuildInfo)
tryGetConfigStateFile = try . getConfigStateFile
tryGetPersistBuildConfig :: FilePath
-> IO (Either ConfigStateFileError LocalBuildInfo)
tryGetPersistBuildConfig = try . getPersistBuildConfig
getPersistBuildConfig :: FilePath -> IO LocalBuildInfo
getPersistBuildConfig = getConfigStateFile . localBuildInfoFile
maybeGetPersistBuildConfig :: FilePath -> IO (Maybe LocalBuildInfo)
maybeGetPersistBuildConfig =
liftM (either (const Nothing) Just) . tryGetPersistBuildConfig
writePersistBuildConfig :: FilePath -> LocalBuildInfo -> IO ()
writePersistBuildConfig distPref lbi = do
createDirectoryIfMissing False distPref
writeFileAtomic (localBuildInfoFile distPref) $
BLC8.unlines [showHeader pkgId, encode lbi]
where
pkgId = packageId $ localPkgDescr lbi
currentCabalId :: PackageIdentifier
currentCabalId = PackageIdentifier (PackageName "Cabal") cabalVersion
currentCompilerId :: PackageIdentifier
currentCompilerId = PackageIdentifier (PackageName System.Info.compilerName)
System.Info.compilerVersion
parseHeader :: ByteString -> (PackageIdentifier, PackageIdentifier)
parseHeader header = case BLC8.words header of
["Saved", "package", "config", "for", pkgId, "written", "by", cabalId, "using", compId] ->
fromMaybe (throw ConfigStateFileBadHeader) $ do
_ <- simpleParse (BLC8.unpack pkgId) :: Maybe PackageIdentifier
cabalId' <- simpleParse (BLC8.unpack cabalId)
compId' <- simpleParse (BLC8.unpack compId)
return (cabalId', compId')
_ -> throw ConfigStateFileNoHeader
showHeader :: PackageIdentifier -> ByteString
showHeader pkgId = BLC8.unwords
[ "Saved", "package", "config", "for"
, BLC8.pack $ display pkgId
, "written", "by"
, BLC8.pack $ display currentCabalId
, "using"
, BLC8.pack $ display currentCompilerId
]
checkPersistBuildConfigOutdated :: FilePath -> FilePath -> IO Bool
checkPersistBuildConfigOutdated distPref pkg_descr_file = do
pkg_descr_file `moreRecentFile` (localBuildInfoFile distPref)
localBuildInfoFile :: FilePath -> FilePath
localBuildInfoFile distPref = distPref </> "setup-config"
configure :: (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags -> IO LocalBuildInfo
configure (pkg_descr0, pbi) cfg
= do let distPref = fromFlag (configDistPref cfg)
buildDir' = distPref </> "build"
verbosity = fromFlag (configVerbosity cfg)
setupMessage verbosity "Configuring" (packageId pkg_descr0)
unless (configLibCoverage cfg == NoFlag) $ do
let enable | fromFlag (configLibCoverage cfg) = "enable"
| otherwise = "disable"
warn verbosity
("The flag --" ++ enable ++ "-library-coverage is deprecated. "
++ "Please use --" ++ enable ++ "-coverage instead.")
createDirectoryIfMissingVerbose (lessVerbose verbosity) True distPref
let programsConfig = mkProgramsConfig cfg (configPrograms cfg)
userInstall = fromFlag (configUserInstall cfg)
packageDbs = interpretPackageDbFlags userInstall
(configPackageDBs cfg)
(comp, compPlatform, programsConfig') <- configCompilerEx
(flagToMaybe $ configHcFlavor cfg)
(flagToMaybe $ configHcPath cfg) (flagToMaybe $ configHcPkg cfg)
programsConfig (lessVerbose verbosity)
let version = compilerVersion comp
flavor = compilerFlavor comp
let pid = packageId pkg_descr0
internalPackage = emptyInstalledPackageInfo {
Installed.installedPackageId =
InstalledPackageId $ display $ pid,
Installed.sourcePackageId = pid
}
internalPackageSet = PackageIndex.fromList [internalPackage]
installedPackageSet <- getInstalledPackages (lessVerbose verbosity) comp
packageDbs programsConfig'
(allConstraints, requiredDepsMap) <- either die return $
combinedConstraints (configConstraints cfg)
(configDependencies cfg)
installedPackageSet
let exactConf = fromFlagOrDefault False (configExactConfiguration cfg)
dependencySatisfiable d@(Dependency depName verRange)
| exactConf =
(depName `Map.member` requiredDepsMap) || isInternalDep
| otherwise =
not . null . PackageIndex.lookupDependency pkgs' $ d
where
pkgs' = PackageIndex.insert internalPackage installedPackageSet
isInternalDep = pkgName pid == depName
&& pkgVersion pid `withinRange` verRange
enableTest t = t { testEnabled = fromFlag (configTests cfg) }
flaggedTests = map (\(n, t) -> (n, mapTreeData enableTest t))
(condTestSuites pkg_descr0)
enableBenchmark bm = bm { benchmarkEnabled =
fromFlag (configBenchmarks cfg) }
flaggedBenchmarks = map (\(n, bm) ->
(n, mapTreeData enableBenchmark bm))
(condBenchmarks pkg_descr0)
pkg_descr0'' = pkg_descr0 { condTestSuites = flaggedTests
, condBenchmarks = flaggedBenchmarks }
(pkg_descr0', flags) <-
case finalizePackageDescription
(configConfigurationsFlags cfg)
dependencySatisfiable
compPlatform
(compilerInfo comp)
allConstraints
pkg_descr0''
of Right r -> return r
Left missing ->
die $ "At least the following dependencies are missing:\n"
++ (render . nest 4 . sep . punctuate comma
. map (disp . simplifyDependency)
$ missing)
when exactConf $ do
let cmdlineFlags = map fst (configConfigurationsFlags cfg)
allFlags = map flagName . genPackageFlags $ pkg_descr0
diffFlags = allFlags \\ cmdlineFlags
when (not . null $ diffFlags) $
die $ "'--exact-conf' was given, "
++ "but the following flags were not specified: "
++ intercalate ", " (map show diffFlags)
let pkg_descr = addExtraIncludeLibDirs pkg_descr0'
unless (renamingPackageFlagsSupported comp ||
and [ rn == defaultRenaming
| bi <- allBuildInfo pkg_descr
, rn <- Map.elems (targetBuildRenaming bi)]) $
die $ "Your compiler does not support thinning and renaming on "
++ "package flags. To use this feature you probably must use "
++ "GHC 7.9 or later."
when (not (null flags)) $
info verbosity $ "Flags chosen: "
++ intercalate ", " [ name ++ "=" ++ display value
| (FlagName name, value) <- flags ]
when (maybe False (not.null.PD.reexportedModules) (PD.library pkg_descr)
&& not (reexportedModulesSupported comp)) $ do
die $ "Your compiler does not support module re-exports. To use "
++ "this feature you probably must use GHC 7.9 or later."
checkPackageProblems verbosity pkg_descr0
(updatePackageDescription pbi pkg_descr)
(holeDeps, hole_insts) <- configureInstantiateWith pkg_descr cfg installedPackageSet
let selectDependencies :: [Dependency] ->
([FailedDependency], [ResolvedDependency])
selectDependencies =
(\xs -> ([ x | Left x <- xs ], [ x | Right x <- xs ]))
. map (selectDependency internalPackageSet installedPackageSet
requiredDepsMap)
(failedDeps, allPkgDeps) =
selectDependencies (buildDepends pkg_descr)
internalPkgDeps = [ pkgid
| InternalDependency _ pkgid <- allPkgDeps ]
externalPkgDeps = [ pkg
| ExternalDependency _ pkg <- allPkgDeps ]
when (not (null internalPkgDeps)
&& not (newPackageDepsBehaviour pkg_descr)) $
die $ "The field 'build-depends: "
++ intercalate ", " (map (display . packageName) internalPkgDeps)
++ "' refers to a library which is defined within the same "
++ "package. To use this feature the package must specify at "
++ "least 'cabal-version: >= 1.8'."
reportFailedDependencies failedDeps
reportSelectedDependencies verbosity allPkgDeps
let installDeps = Map.elems
. Map.fromList
. map (\v -> (Installed.installedPackageId v, v))
$ externalPkgDeps ++ holeDeps
packageDependsIndex <-
case PackageIndex.dependencyClosure installedPackageSet
(map Installed.installedPackageId installDeps) of
Left packageDependsIndex -> return packageDependsIndex
Right broken ->
die $ "The following installed packages are broken because other"
++ " packages they depend on are missing. These broken "
++ "packages must be rebuilt before they can be used.\n"
++ unlines [ "package "
++ display (packageId pkg)
++ " is broken due to missing package "
++ intercalate ", " (map display deps)
| (pkg, deps) <- broken ]
let pseudoTopPkg = emptyInstalledPackageInfo {
Installed.installedPackageId =
InstalledPackageId (display (packageId pkg_descr)),
Installed.sourcePackageId = packageId pkg_descr,
Installed.depends =
map Installed.installedPackageId installDeps
}
case PackageIndex.dependencyInconsistencies
. PackageIndex.insert pseudoTopPkg
$ packageDependsIndex of
[] -> return ()
inconsistencies ->
warn verbosity $
"This package indirectly depends on multiple versions of the same "
++ "package. This is highly likely to cause a compile failure.\n"
++ unlines [ "package " ++ display pkg ++ " requires "
++ display (PackageIdentifier name ver)
| (name, uses) <- inconsistencies
, (pkg, ver) <- uses ]
let pkg_key = mkPackageKey (packageKeySupported comp)
(package pkg_descr)
(map Installed.packageKey externalPkgDeps)
(map (\(k,(p,m)) -> (k,(Installed.packageKey p,m))) hole_insts)
buildComponents <-
case mkComponentsGraph pkg_descr internalPkgDeps of
Left componentCycle -> reportComponentCycle componentCycle
Right components ->
case mkComponentsLocalBuildInfo packageDependsIndex pkg_descr
internalPkgDeps externalPkgDeps holeDeps
(Map.fromList hole_insts)
pkg_key components of
Left problems -> reportModuleReexportProblems problems
Right components' -> return components'
defaultDirs <- defaultInstallDirs flavor userInstall (hasLibs pkg_descr)
let installDirs = combineInstallDirs fromFlagOrDefault
defaultDirs (configInstallDirs cfg)
let langlist = nub $ catMaybes $ map defaultLanguage
(allBuildInfo pkg_descr)
let langs = unsupportedLanguages comp langlist
when (not (null langs)) $
die $ "The package " ++ display (packageId pkg_descr0)
++ " requires the following languages which are not "
++ "supported by " ++ display (compilerId comp) ++ ": "
++ intercalate ", " (map display langs)
let extlist = nub $ concatMap allExtensions (allBuildInfo pkg_descr)
let exts = unsupportedExtensions comp extlist
when (not (null exts)) $
die $ "The package " ++ display (packageId pkg_descr0)
++ " requires the following language extensions which are not "
++ "supported by " ++ display (compilerId comp) ++ ": "
++ intercalate ", " (map display exts)
let requiredBuildTools =
[ buildTool
| let exeNames = map exeName (executables pkg_descr)
, bi <- allBuildInfo pkg_descr
, buildTool@(Dependency (PackageName toolName) reqVer)
<- buildTools bi
, let isInternal =
toolName `elem` exeNames
&& packageVersion pkg_descr `withinRange` reqVer
, not isInternal ]
programsConfig'' <-
configureAllKnownPrograms (lessVerbose verbosity) programsConfig'
>>= configureRequiredPrograms verbosity requiredBuildTools
(pkg_descr', programsConfig''') <-
configurePkgconfigPackages verbosity pkg_descr programsConfig''
split_objs <-
if not (fromFlag $ configSplitObjs cfg)
then return False
else case flavor of
GHC | version >= Version [6,5] [] -> return True
GHCJS -> return True
_ -> do warn verbosity
("this compiler does not support " ++
"--enable-split-objs; ignoring")
return False
let ghciLibByDefault =
case compilerId comp of
CompilerId GHC _ ->
not (GHC.isDynamic comp)
CompilerId GHCJS _ ->
not (GHCJS.isDynamic comp)
_ -> False
let sharedLibsByDefault
| fromFlag (configDynExe cfg) =
True
| otherwise = case compilerId comp of
CompilerId GHC _ ->
GHC.isDynamic comp
CompilerId GHCJS _ ->
GHCJS.isDynamic comp
_ -> False
withSharedLib_ =
fromFlagOrDefault sharedLibsByDefault $ configSharedLib cfg
withDynExe_ = fromFlag $ configDynExe cfg
when (withDynExe_ && not withSharedLib_) $ warn verbosity $
"Executables will use dynamic linking, but a shared library "
++ "is not being built. Linking will fail if any executables "
++ "depend on the library."
let withProfExe_ = fromFlagOrDefault False $ configProfExe cfg
withProfLib_ = fromFlagOrDefault withProfExe_ $ configProfLib cfg
when (withProfExe_ && not withProfLib_) $ warn verbosity $
"Executables will be built with profiling, but library "
++ "profiling is disabled. Linking will fail if any executables "
++ "depend on the library."
let configCoverage_ =
mappend (configCoverage cfg) (configLibCoverage cfg)
cfg' = cfg { configCoverage = configCoverage_ }
reloc <-
if not (fromFlag $ configRelocatable cfg)
then return False
else return True
let lbi = LocalBuildInfo {
configFlags = cfg',
extraConfigArgs = [],
installDirTemplates = installDirs,
compiler = comp,
hostPlatform = compPlatform,
buildDir = buildDir',
componentsConfigs = buildComponents,
installedPkgs = packageDependsIndex,
pkgDescrFile = Nothing,
localPkgDescr = pkg_descr',
pkgKey = pkg_key,
instantiatedWith = hole_insts,
withPrograms = programsConfig''',
withVanillaLib = fromFlag $ configVanillaLib cfg,
withProfLib = withProfLib_,
withSharedLib = withSharedLib_,
withDynExe = withDynExe_,
withProfExe = withProfExe_,
withOptimization = fromFlag $ configOptimization cfg,
withDebugInfo = fromFlag $ configDebugInfo cfg,
withGHCiLib = fromFlagOrDefault ghciLibByDefault $
configGHCiLib cfg,
splitObjs = split_objs,
stripExes = fromFlag $ configStripExes cfg,
stripLibs = fromFlag $ configStripLibs cfg,
withPackageDB = packageDbs,
progPrefix = fromFlag $ configProgPrefix cfg,
progSuffix = fromFlag $ configProgSuffix cfg,
relocatable = reloc
}
when reloc (checkRelocatable verbosity pkg_descr lbi)
let dirs = absoluteInstallDirs pkg_descr lbi NoCopyDest
relative = prefixRelativeInstallDirs (packageId pkg_descr) lbi
unless (isAbsolute (prefix dirs)) $ die $
"expected an absolute directory name for --prefix: " ++ prefix dirs
info verbosity $ "Using " ++ display currentCabalId
++ " compiled by " ++ display currentCompilerId
info verbosity $ "Using compiler: " ++ showCompilerId comp
info verbosity $ "Using install prefix: " ++ prefix dirs
let dirinfo name dir isPrefixRelative =
info verbosity $ name ++ " installed in: " ++ dir ++ relNote
where relNote = case buildOS of
Windows | not (hasLibs pkg_descr)
&& isNothing isPrefixRelative
-> " (fixed location)"
_ -> ""
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)
dirinfo "Configuration files" (sysconfdir dirs) (sysconfdir relative)
sequence_ [ reportProgram verbosity prog configuredProg
| (prog, configuredProg) <- knownPrograms programsConfig''' ]
return lbi
where
addExtraIncludeLibDirs pkg_descr =
let extraBi = mempty { extraLibDirs = configExtraLibDirs cfg
, PD.includeDirs = configExtraIncludeDirs cfg}
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}
mkProgramsConfig :: ConfigFlags -> ProgramConfiguration -> ProgramConfiguration
mkProgramsConfig cfg initialProgramsConfig = programsConfig
where
programsConfig = userSpecifyArgss (configProgramArgs cfg)
. userSpecifyPaths (configProgramPaths cfg)
. setProgramSearchPath searchpath
$ initialProgramsConfig
searchpath = getProgramSearchPath (initialProgramsConfig)
++ map ProgramSearchPathDir (fromNubList $ configProgramPathExtra cfg)
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
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 -> ""
Just v -> " version " ++ display v
hackageUrl :: String
hackageUrl = "http://hackage.haskell.org/package/"
data ResolvedDependency = ExternalDependency Dependency InstalledPackageInfo
| InternalDependency Dependency PackageId
data FailedDependency = DependencyNotExists PackageName
| DependencyNoVersion Dependency
selectDependency :: InstalledPackageIndex
-> InstalledPackageIndex
-> Map PackageName InstalledPackageInfo
-> Dependency
-> Either FailedDependency ResolvedDependency
selectDependency internalIndex installedIndex requiredDepsMap
dep@(Dependency pkgname vr) =
case PackageIndex.lookupPackageName internalIndex pkgname of
[(_,[pkg])] | packageVersion pkg `withinRange` vr
-> Right $ InternalDependency dep (packageId pkg)
_ -> case Map.lookup pkgname requiredDepsMap of
Just pkginstance -> Right (ExternalDependency dep pkginstance)
Nothing -> case PackageIndex.lookupDependency installedIndex dep of
[] -> Left $ DependencyNotExists pkgname
pkgs -> Right $ ExternalDependency dep $
case last pkgs of
(_ver, pkginstances) -> head pkginstances
reportSelectedDependencies :: Verbosity
-> [ResolvedDependency] -> IO ()
reportSelectedDependencies verbosity deps =
info verbosity $ unlines
[ "Dependency " ++ display (simplifyDependency dep)
++ ": using " ++ display pkgid
| resolved <- deps
, let (dep, pkgid) = case resolved of
ExternalDependency dep' pkg' -> (dep', packageId pkg')
InternalDependency dep' pkgid' -> (dep', pkgid') ]
reportFailedDependencies :: [FailedDependency] -> IO ()
reportFailedDependencies [] = return ()
reportFailedDependencies failed =
die (intercalate "\n\n" (map reportFailedDependency failed))
where
reportFailedDependency (DependencyNotExists pkgname) =
"there is no version of " ++ display pkgname ++ " installed.\n"
++ "Perhaps you need to download and install it from\n"
++ hackageUrl ++ display pkgname ++ "?"
reportFailedDependency (DependencyNoVersion dep) =
"cannot satisfy dependency " ++ display (simplifyDependency dep) ++ "\n"
getInstalledPackages :: Verbosity -> Compiler
-> PackageDBStack -> ProgramConfiguration
-> IO InstalledPackageIndex
getInstalledPackages verbosity comp packageDBs progconf = do
when (null packageDBs) $
die $ "No package databases have been specified. If you use "
++ "--package-db=clear, you must follow it with --package-db= "
++ "with 'global', 'user' or a specific file."
info verbosity "Reading installed packages..."
case compilerFlavor comp of
GHC -> GHC.getInstalledPackages verbosity packageDBs progconf
GHCJS -> GHCJS.getInstalledPackages verbosity packageDBs progconf
JHC -> JHC.getInstalledPackages verbosity packageDBs progconf
LHC -> LHC.getInstalledPackages verbosity packageDBs progconf
UHC -> UHC.getInstalledPackages verbosity comp packageDBs progconf
HaskellSuite {} ->
HaskellSuite.getInstalledPackages verbosity packageDBs progconf
flv -> die $ "don't know how to find the installed packages for "
++ display flv
getPackageDBContents :: Verbosity -> Compiler
-> PackageDB -> ProgramConfiguration
-> IO InstalledPackageIndex
getPackageDBContents verbosity comp packageDB progconf = do
info verbosity "Reading installed packages..."
case compilerFlavor comp of
GHC -> GHC.getPackageDBContents verbosity packageDB progconf
GHCJS -> GHCJS.getPackageDBContents verbosity packageDB progconf
_ -> getInstalledPackages verbosity comp [packageDB] progconf
interpretPackageDbFlags :: Bool -> [Maybe PackageDB] -> PackageDBStack
interpretPackageDbFlags userInstall specificDBs =
extra initialStack specificDBs
where
initialStack | userInstall = [GlobalPackageDB, UserPackageDB]
| otherwise = [GlobalPackageDB]
extra dbs' [] = dbs'
extra _ (Nothing:dbs) = extra [] dbs
extra dbs' (Just db:dbs) = extra (dbs' ++ [db]) dbs
newPackageDepsBehaviourMinVersion :: Version
newPackageDepsBehaviourMinVersion = Version [1,7,1] []
newPackageDepsBehaviour :: PackageDescription -> Bool
newPackageDepsBehaviour pkg =
specVersion pkg >= newPackageDepsBehaviourMinVersion
combinedConstraints :: [Dependency] ->
[(PackageName, InstalledPackageId)] ->
InstalledPackageIndex ->
Either String ([Dependency],
Map PackageName InstalledPackageInfo)
combinedConstraints constraints dependencies installedPackages = do
when (not (null badInstalledPackageIds)) $
Left $ render $ text "The following package dependencies were requested"
$+$ nest 4 (dispDependencies badInstalledPackageIds)
$+$ text "however the given installed package instance does not exist."
when (not (null badNames)) $
Left $ render $ text "The following package dependencies were requested"
$+$ nest 4 (dispDependencies badNames)
$+$ text "however the installed package's name does not match the name given."
return (allConstraints, idConstraintMap)
where
allConstraints :: [Dependency]
allConstraints = constraints
++ [ thisPackageVersion (packageId pkg)
| (_, _, Just pkg) <- dependenciesPkgInfo ]
idConstraintMap :: Map PackageName InstalledPackageInfo
idConstraintMap = Map.fromList
[ (packageName pkg, pkg)
| (_, _, Just pkg) <- dependenciesPkgInfo ]
dependenciesPkgInfo :: [(PackageName, InstalledPackageId,
Maybe InstalledPackageInfo)]
dependenciesPkgInfo =
[ (pkgname, ipkgid, mpkg)
| (pkgname, ipkgid) <- dependencies
, let mpkg = PackageIndex.lookupInstalledPackageId
installedPackages ipkgid
]
badInstalledPackageIds =
[ (pkgname, ipkgid)
| (pkgname, ipkgid, Nothing) <- dependenciesPkgInfo ]
badNames =
[ (requestedPkgName, ipkgid)
| (requestedPkgName, ipkgid, Just pkg) <- dependenciesPkgInfo
, let foundPkgName = packageName pkg
, requestedPkgName /= foundPkgName ]
dispDependencies deps =
hsep [ text "--dependency="
<> quotes (disp pkgname <> char '=' <> disp ipkgid)
| (pkgname, ipkgid) <- deps ]
configureInstantiateWith :: PackageDescription
-> ConfigFlags
-> InstalledPackageIndex
-> IO ([InstalledPackageInfo],
[(ModuleName, (InstalledPackageInfo, ModuleName))])
configureInstantiateWith pkg_descr cfg installedPackageSet = do
let signatures =
maybe [] (\lib -> requiredSignatures lib ++ exposedSignatures lib)
(PD.library pkg_descr)
signatureSet = Set.fromList signatures
instantiateMap = Map.fromList (configInstantiateWith cfg)
missing_impls = filter (not . flip Map.member instantiateMap) signatures
hole_insts0 = filter (\(k,_) -> Set.member k signatureSet) (configInstantiateWith cfg)
when (not (null missing_impls)) $
die $ "Missing signature implementations for these modules: "
++ intercalate ", " (map display missing_impls)
let selectHoleDependency (k,(i,m)) =
case PackageIndex.lookupInstalledPackageId installedPackageSet i of
Just pkginst -> Right (k,(pkginst, m))
Nothing -> Left i
(failed_hmap, hole_insts) = partitionEithers (map selectHoleDependency hole_insts0)
holeDeps = map (fst.snd) hole_insts
when (not (null failed_hmap)) $
die $ "Could not resolve these package IDs (from signature implementations): "
++ intercalate ", " (map display failed_hmap)
return (holeDeps, hole_insts)
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 (PackageName progName) verRange) =
case lookupKnownProgram progName conf of
Nothing -> die ("Unknown build tool " ++ progName)
Just prog
| verRange == anyVersion -> do
(_, conf') <- requireProgram verbosity prog conf
return conf'
| otherwise -> do
(_, _, conf') <- requireProgramVersion verbosity prog verRange conf
return conf'
configurePkgconfigPackages :: Verbosity -> PackageDescription
-> ProgramConfiguration
-> IO (PackageDescription, ProgramConfiguration)
configurePkgconfigPackages verbosity pkg_descr conf
| null allpkgs = return (pkg_descr, conf)
| otherwise = do
(_, _, conf') <- requireProgramVersion
(lessVerbose verbosity) pkgConfigProgram
(orLaterVersion $ Version [0,9,0] []) conf
mapM_ requirePkg allpkgs
lib' <- mapM addPkgConfigBILib (library pkg_descr)
exes' <- mapM addPkgConfigBIExe (executables pkg_descr)
tests' <- mapM addPkgConfigBITest (testSuites pkg_descr)
benches' <- mapM addPkgConfigBIBench (benchmarks pkg_descr)
let pkg_descr' = pkg_descr { library = lib', executables = exes',
testSuites = tests', benchmarks = benches' }
return (pkg_descr', conf')
where
allpkgs = concatMap pkgconfigDepends (allBuildInfo pkg_descr)
pkgconfig = rawSystemProgramStdoutConf (lessVerbose verbosity)
pkgConfigProgram conf
requirePkg dep@(Dependency (PackageName pkg) range) = do
version <- pkgconfig ["--modversion", pkg]
`catchIO` (\_ -> die notFound)
`catchExit` (\_ -> die notFound)
case simpleParse version of
Nothing -> die "parsing output of pkg-config --modversion failed"
Just v | not (withinRange v range) -> die (badVersion v)
| otherwise -> info verbosity (depSatisfied v)
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"
++ " system is version " ++ display v
depSatisfied v = "Dependency " ++ display dep
++ ": using version " ++ display v
versionRequirement
| isAnyVersion range = ""
| otherwise = " version " ++ display range
addPkgConfigBI compBI setCompBI comp = do
bi <- pkgconfigBuildInfo (pkgconfigDepends (compBI comp))
return $ setCompBI comp (compBI comp `mappend` bi)
addPkgConfigBILib = addPkgConfigBI libBuildInfo $
\lib bi -> lib { libBuildInfo = bi }
addPkgConfigBIExe = addPkgConfigBI buildInfo $
\exe bi -> exe { buildInfo = bi }
addPkgConfigBITest = addPkgConfigBI testBuildInfo $
\test bi -> test { testBuildInfo = bi }
addPkgConfigBIBench = addPkgConfigBI benchmarkBuildInfo $
\bench bi -> bench { benchmarkBuildInfo = bi }
pkgconfigBuildInfo :: [Dependency] -> IO BuildInfo
pkgconfigBuildInfo [] = return mempty
pkgconfigBuildInfo pkgdeps = do
let pkgs = nub [ display pkg | Dependency pkg _ <- pkgdeps ]
ccflags <- pkgconfig ("--cflags" : pkgs)
ldflags <- pkgconfig ("--libs" : pkgs)
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'
in mempty {
PD.includeDirs = map (drop 2) includeDirs',
PD.extraLibs = map (drop 2) extraLibs',
PD.extraLibDirs = map (drop 2) extraLibDirs',
PD.ccOptions = cflags',
PD.ldOptions = ldflags''
}
configCompilerAuxEx :: ConfigFlags
-> IO (Compiler, Platform, ProgramConfiguration)
configCompilerAuxEx cfg = configCompilerEx (flagToMaybe $ configHcFlavor cfg)
(flagToMaybe $ configHcPath cfg)
(flagToMaybe $ configHcPkg cfg)
programsConfig
(fromFlag (configVerbosity cfg))
where
programsConfig = mkProgramsConfig cfg defaultProgramConfiguration
configCompilerEx :: Maybe CompilerFlavor -> Maybe FilePath -> Maybe FilePath
-> ProgramConfiguration -> Verbosity
-> IO (Compiler, Platform, ProgramConfiguration)
configCompilerEx Nothing _ _ _ _ = die "Unknown compiler"
configCompilerEx (Just hcFlavor) hcPath hcPkg conf verbosity = do
(comp, maybePlatform, programsConfig) <- case hcFlavor of
GHC -> GHC.configure verbosity hcPath hcPkg conf
GHCJS -> GHCJS.configure verbosity hcPath hcPkg conf
JHC -> JHC.configure verbosity hcPath hcPkg conf
LHC -> do (_, _, ghcConf) <- GHC.configure verbosity Nothing hcPkg conf
LHC.configure verbosity hcPath Nothing ghcConf
UHC -> UHC.configure verbosity hcPath hcPkg conf
HaskellSuite {} -> HaskellSuite.configure verbosity hcPath hcPkg conf
_ -> die "Unknown compiler"
return (comp, fromMaybe buildPlatform maybePlatform, programsConfig)
configCompiler :: Maybe CompilerFlavor -> Maybe FilePath -> Maybe FilePath
-> ProgramConfiguration -> Verbosity
-> IO (Compiler, ProgramConfiguration)
configCompiler mFlavor hcPath hcPkg conf verbosity =
fmap (\(a,_,b) -> (a,b)) $ configCompilerEx mFlavor hcPath hcPkg conf verbosity
configCompilerAux :: ConfigFlags
-> IO (Compiler, ProgramConfiguration)
configCompilerAux = fmap (\(a,_,b) -> (a,b)) . configCompilerAuxEx
mkComponentsGraph :: PackageDescription
-> [PackageId]
-> Either [ComponentName]
[(Component, [ComponentName])]
mkComponentsGraph pkg_descr internalPkgDeps =
let graph = [ (c, componentName c, componentDeps c)
| c <- pkgEnabledComponents pkg_descr ]
in case checkComponentsCyclic graph of
Just ccycle -> Left [ cname | (_,cname,_) <- ccycle ]
Nothing -> Right [ (c, cdeps) | (c, _, cdeps) <- graph ]
where
componentDeps component =
[ CExeName toolname | Dependency (PackageName toolname) _
<- buildTools bi
, toolname `elem` map exeName
(executables pkg_descr) ]
++ [ CLibName | Dependency pkgname _ <- targetBuildDepends bi
, pkgname `elem` map packageName internalPkgDeps ]
where
bi = componentBuildInfo component
reportComponentCycle :: [ComponentName] -> IO a
reportComponentCycle cnames =
die $ "Components in the package depend on each other in a cyclic way:\n "
++ intercalate " depends on "
[ "'" ++ showComponentName cname ++ "'"
| cname <- cnames ++ [head cnames] ]
mkComponentsLocalBuildInfo :: InstalledPackageIndex
-> PackageDescription
-> [PackageId]
-> [InstalledPackageInfo]
-> [InstalledPackageInfo]
-> Map ModuleName (InstalledPackageInfo, ModuleName)
-> PackageKey
-> [(Component, [ComponentName])]
-> Either [(ModuleReexport, String)]
[(ComponentName, ComponentLocalBuildInfo,
[ComponentName])]
mkComponentsLocalBuildInfo installedPackages pkg_descr
internalPkgDeps externalPkgDeps holePkgDeps hole_insts
pkg_key graph =
sequence
[ do clbi <- componentLocalBuildInfo c
return (componentName c, clbi, cdeps)
| (c, cdeps) <- graph ]
where
componentLocalBuildInfo component =
case component of
CLib lib -> do
let exports = map (\n -> Installed.ExposedModule n Nothing Nothing)
(PD.exposedModules lib)
esigs = map (\n -> Installed.ExposedModule n Nothing
(fmap (\(pkg,m) -> Installed.OriginalModule
(Installed.installedPackageId pkg) m)
(Map.lookup n hole_insts)))
(PD.exposedSignatures lib)
reexports <- resolveModuleReexports installedPackages
(packageId pkg_descr)
externalPkgDeps lib
return LibComponentLocalBuildInfo {
componentPackageDeps = cpds,
componentLibraries = [ LibraryName ("HS" ++ packageKeyLibraryName (package pkg_descr) pkg_key) ],
componentPackageRenaming = cprns,
componentExposedModules = exports ++ reexports ++ esigs
}
CExe _ ->
return ExeComponentLocalBuildInfo {
componentPackageDeps = cpds,
componentPackageRenaming = cprns
}
CTest _ ->
return TestComponentLocalBuildInfo {
componentPackageDeps = cpds,
componentPackageRenaming = cprns
}
CBench _ ->
return BenchComponentLocalBuildInfo {
componentPackageDeps = cpds,
componentPackageRenaming = cprns
}
where
bi = componentBuildInfo component
dedup = Map.toList . Map.fromList
cpds = if newPackageDepsBehaviour pkg_descr
then dedup $
[ (Installed.installedPackageId pkg, packageId pkg)
| pkg <- selectSubset bi externalPkgDeps ]
++ [ (inplacePackageId pkgid, pkgid)
| pkgid <- selectSubset bi internalPkgDeps ]
++ [ (Installed.installedPackageId pkg, packageId pkg)
| pkg <- holePkgDeps ]
else [ (Installed.installedPackageId pkg, packageId pkg)
| pkg <- externalPkgDeps ]
cprns = if newPackageDepsBehaviour pkg_descr
then Map.unionWith mappend
(Map.fromList [(packageName pkg, mempty) | pkg <- holePkgDeps])
(targetBuildRenaming bi)
else Map.fromList (map (\(_,pid) -> (packageName pid, defaultRenaming)) cpds)
selectSubset :: Package pkg => BuildInfo -> [pkg] -> [pkg]
selectSubset bi pkgs =
[ pkg | pkg <- pkgs, packageName pkg `elem` names bi ]
names bi = [ name | Dependency name _ <- targetBuildDepends bi ]
resolveModuleReexports :: InstalledPackageIndex
-> PackageId
-> [InstalledPackageInfo]
-> Library
-> Either [(ModuleReexport, String)]
[Installed.ExposedModule]
resolveModuleReexports installedPackages srcpkgid externalPkgDeps lib =
case partitionEithers (map resolveModuleReexport (PD.reexportedModules lib)) of
([], ok) -> Right ok
(errs, _) -> Left errs
where
visibleModules :: Map ModuleName [(PackageName, Installed.ExposedModule)]
visibleModules =
Map.fromListWith (++) $
[ (Installed.exposedName exposedModule, [(exportingPackageName,
exposedModule)])
| let directDeps = Set.fromList (map Installed.installedPackageId externalPkgDeps)
, pkg <- PackageIndex.allPackages installedPackages
, Installed.installedPackageId pkg `Set.member` directDeps
, let exportingPackageName = packageName pkg
, exposedModule <- visibleModuleDetails pkg
]
++ [ (visibleModuleName, [(exportingPackageName, exposedModule)])
| visibleModuleName <- PD.exposedModules lib
++ otherModules (libBuildInfo lib)
, let exportingPackageName = packageName srcpkgid
definingModuleName = visibleModuleName
definingPackageId = InstalledPackageId ""
originalModule = Installed.OriginalModule definingPackageId
definingModuleName
exposedModule = Installed.ExposedModule visibleModuleName
(Just originalModule)
Nothing
]
visibleModuleDetails :: InstalledPackageInfo -> [Installed.ExposedModule]
visibleModuleDetails pkg = do
exposedModule <- Installed.exposedModules pkg
case Installed.exposedReexport exposedModule of
Nothing -> return exposedModule { Installed.exposedReexport =
Just (Installed.OriginalModule (Installed.installedPackageId pkg)
(Installed.exposedName exposedModule)) }
Just _ -> return exposedModule
resolveModuleReexport reexport@ModuleReexport {
moduleReexportOriginalPackage = moriginalPackageName,
moduleReexportOriginalName = originalName,
moduleReexportName = newName
} =
let filterForSpecificPackage =
case moriginalPackageName of
Nothing -> id
Just originalPackageName ->
filter (\(pkgname, _) -> pkgname == originalPackageName)
matches = filterForSpecificPackage
(Map.findWithDefault [] originalName visibleModules)
in
case (matches, moriginalPackageName) of
((_, exposedModule):rest, _)
| all (\(_, exposedModule') -> Installed.exposedReexport exposedModule
== Installed.exposedReexport exposedModule') rest
-> Right exposedModule { Installed.exposedName = newName }
([], Just originalPackageName)
-> Left $ (,) reexport
$ "The package " ++ display originalPackageName
++ " does not export a module " ++ display originalName
([], Nothing)
-> Left $ (,) reexport
$ "The module " ++ display originalName
++ " is not exported by any suitable package (this package "
++ "itself nor any of its 'build-depends' dependencies)."
(ms, _)
-> Left $ (,) reexport
$ "The module " ++ display originalName ++ " is exported "
++ "by more than one package ("
++ intercalate ", " [ display pkgname | (pkgname,_) <- ms ]
++ ") and so the re-export is ambiguous. The ambiguity can "
++ "be resolved by qualifying by the package name. The "
++ "syntax is 'packagename:moduleName [as newname]'."
reportModuleReexportProblems :: [(ModuleReexport, String)] -> IO a
reportModuleReexportProblems reexportProblems =
die $ unlines
[ "Problem with the module re-export '" ++ display reexport ++ "': " ++ msg
| (reexport, msg) <- reexportProblems ]
checkForeignDeps :: PackageDescription -> LocalBuildInfo -> Verbosity -> IO ()
checkForeignDeps pkg lbi verbosity = do
ifBuildsWith allHeaders (commonCcArgs ++ makeLdArgs allLibs)
(return ())
(do missingLibs <- findMissingLibs
missingHdr <- findOffendingHdr
explainErrors missingHdr missingLibs)
where
allHeaders = collectField PD.includes
allLibs = collectField PD.extraLibs
ifBuildsWith headers args success failure = do
ok <- builds (makeProgram headers) args
if ok then success else failure
findOffendingHdr =
ifBuildsWith allHeaders ccArgs
(return Nothing)
(go . tail . inits $ allHeaders)
where
go [] = return Nothing
go (hdrs:hdrsInits) =
ifBuildsWith hdrs cppArgs
(ifBuildsWith hdrs ccArgs
(go hdrsInits)
(return . Just . Right . last $ hdrs))
(return . Just . Left . last $ hdrs)
cppArgs = "-E":commonCppArgs
ccArgs = "-c":commonCcArgs
findMissingLibs = ifBuildsWith [] (makeLdArgs allLibs)
(return [])
(filterM (fmap not . libExists) allLibs)
libExists lib = builds (makeProgram []) (makeLdArgs [lib])
commonCppArgs = platformDefines lbi
++ [ "-I" ++ autogenModulesDir lbi ]
++ [ "-I" ++ dir | dir <- collectField PD.includeDirs ]
++ ["-I."]
++ collectField PD.cppOptions
++ collectField PD.ccOptions
++ [ "-I" ++ dir
| dep <- deps
, dir <- Installed.includeDirs dep ]
++ [ opt
| dep <- deps
, opt <- Installed.ccOptions dep ]
commonCcArgs = commonCppArgs
++ collectField PD.ccOptions
++ [ opt
| dep <- deps
, opt <- Installed.ccOptions dep ]
commonLdArgs = [ "-L" ++ dir | dir <- collectField PD.extraLibDirs ]
++ collectField PD.ldOptions
++ [ "-L" ++ dir
| dep <- deps
, dir <- Installed.libraryDirs dep ]
makeLdArgs libs = [ "-l"++lib | lib <- libs ] ++ commonLdArgs
makeProgram hdrs = unlines $
[ "#include \"" ++ hdr ++ "\"" | hdr <- hdrs ] ++
["int main(int argc, char** argv) { return 0; }"]
collectField f = concatMap f allBi
allBi = allBuildInfo pkg
deps = PackageIndex.topologicalOrder (installedPkgs lbi)
builds program args = do
tempDir <- getTemporaryDirectory
withTempFile tempDir ".c" $ \cName cHnd ->
withTempFile tempDir "" $ \oNname oHnd -> do
hPutStrLn cHnd program
hClose cHnd
hClose oHnd
_ <- rawSystemProgramStdoutConf verbosity
gccProgram (withPrograms lbi) (cName:"-o":oNname:args)
return True
`catchIO` (\_ -> return False)
`catchExit` (\_ -> return False)
explainErrors Nothing [] = return ()
explainErrors _ _
| isNothing . lookupProgram gccProgram . withPrograms $ lbi
= die $ unlines $
[ "No working gcc",
"This package depends on foreign library but we cannot "
++ "find a working C compiler. If you have it in a "
++ "non-standard location you can use the --with-gcc "
++ "flag to specify it." ]
explainErrors hdr libs = die $ unlines $
[ if plural
then "Missing dependencies on foreign libraries:"
else "Missing dependency on a foreign library:"
| missing ]
++ case hdr of
Just (Left h) -> ["* Missing (or bad) header file: " ++ h ]
_ -> []
++ case libs of
[] -> []
[lib] -> ["* Missing C library: " ++ lib]
_ -> ["* Missing C libraries: " ++ intercalate ", " libs]
++ [if plural then messagePlural else messageSingular | missing]
++ case hdr of
Just (Left _) -> [ headerCppMessage ]
Just (Right h) -> [ (if missing then "* " else "")
++ "Bad header file: " ++ h
, headerCcMessage ]
_ -> []
where
plural = length libs >= 2
missing = not (null libs)
|| case hdr of Just (Left _) -> True; _ -> False
messageSingular =
"This problem can usually be solved by installing the system "
++ "package that provides this library (you may need the "
++ "\"-dev\" version). If the library is already installed "
++ "but in a non-standard location then you can use the flags "
++ "--extra-include-dirs= and --extra-lib-dirs= to specify "
++ "where it is."
messagePlural =
"This problem can usually be solved by installing the system "
++ "packages that provide these libraries (you may need the "
++ "\"-dev\" versions). If the libraries are already installed "
++ "but in a non-standard location then you can use the flags "
++ "--extra-include-dirs= and --extra-lib-dirs= to specify "
++ "where they are."
headerCppMessage =
"If the header file does exist, it may contain errors that "
++ "are caught by the C compiler at the preprocessing stage. "
++ "In this case you can re-run configure with the verbosity "
++ "flag -v3 to see the error messages."
headerCcMessage =
"The header file contains a compile error. "
++ "You can re-run configure with the verbosity flag "
++ "-v3 to see the error messages from the C compiler."
checkPackageProblems :: Verbosity
-> GenericPackageDescription
-> PackageDescription
-> IO ()
checkPackageProblems verbosity gpkg pkg = do
ioChecks <- checkPackageFiles pkg "."
let pureChecks = checkPackage gpkg (Just pkg)
errors = [ e | PackageBuildImpossible e <- pureChecks ++ ioChecks ]
warnings = [ w | PackageBuildWarning w <- pureChecks ++ ioChecks ]
if null errors
then mapM_ (warn verbosity) warnings
else die (intercalate "\n\n" errors)
checkRelocatable :: Verbosity
-> PackageDescription
-> LocalBuildInfo
-> IO ()
checkRelocatable verbosity pkg lbi
= sequence_ [ checkOS
, checkCompiler
, packagePrefixRelative
, depsPrefixRelative
]
where
checkOS
= unless (os `elem` [ OSX, Linux ])
$ die $ "Operating system: " ++ display os ++
", does not support relocatable builds"
where
(Platform _ os) = hostPlatform lbi
checkCompiler
= unless (compilerFlavor comp `elem` [ GHC ])
$ die $ "Compiler: " ++ show comp ++
", does not support relocatable builds"
where
comp = compiler lbi
packagePrefixRelative
= unless (relativeInstallDirs installDirs)
$ die $ "Installation directories are not prefix_relative:\n" ++
show installDirs
where
installDirs = absoluteInstallDirs pkg lbi NoCopyDest
p = prefix installDirs
relativeInstallDirs (InstallDirs {..}) =
all isJust
(fmap (stripPrefix p)
[ bindir, libdir, dynlibdir, libexecdir, includedir, datadir
, docdir, mandir, htmldir, haddockdir, sysconfdir] )
depsPrefixRelative = do
pkgr <- GHC.pkgRoot verbosity lbi (last (withPackageDB lbi))
mapM_ (doCheck pkgr) ipkgs
where
doCheck pkgr ipkg
| maybe False (== pkgr) (Installed.pkgRoot ipkg)
= mapM_ (\l -> when (isNothing $ stripPrefix p l) (die (msg l)))
(Installed.libraryDirs ipkg)
| otherwise
= return ()
installDirs = absoluteInstallDirs pkg lbi NoCopyDest
p = prefix installDirs
ipkgs = PackageIndex.allPackages (installedPkgs lbi)
msg l = "Library directory of a dependency: " ++ show l ++
"\nis not relative to the installation prefix:\n" ++
show p