module Distribution.Simple.Configure
( configure
, writePersistBuildConfig
, getConfigStateFile
, getPersistBuildConfig
, checkPersistBuildConfigOutdated
, tryGetPersistBuildConfig
, maybeGetPersistBuildConfig
, findDistPref, findDistPrefOrDefault
, getInternalPackages
, computeComponentId
, computeCompatPackageKey
, localBuildInfoFile
, getInstalledPackages
, getInstalledPackagesMonitorFiles
, getPackageDBContents
, configCompilerEx, configCompilerAuxEx
, computeEffectiveProfiling
, ccLdOptionsBuildInfo
, checkForeignDeps
, interpretPackageDbFlags
, ConfigStateFileError(..)
, tryGetConfigStateFile
, platformDefines,
) where
import qualified Prelude (tail)
import Distribution.Compat.Prelude
import Distribution.Compiler
import Distribution.Types.IncludeRenaming
import Distribution.Utils.NubList
import Distribution.Simple.Compiler hiding (Flag)
import Distribution.Simple.PreProcess
import Distribution.Package
import qualified Distribution.InstalledPackageInfo as Installed
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import Distribution.PackageDescription as PD hiding (Flag)
import Distribution.Types.PackageDescription as PD
import Distribution.PackageDescription.PrettyPrint
import Distribution.PackageDescription.Configuration
import Distribution.PackageDescription.Check hiding (doesFileExist)
import Distribution.Simple.BuildToolDepends
import Distribution.Simple.Program
import Distribution.Simple.Setup as Setup
import Distribution.Simple.BuildTarget
import Distribution.Simple.LocalBuildInfo
import Distribution.Types.ExeDependency
import Distribution.Types.LegacyExeDependency
import Distribution.Types.PkgconfigVersion
import Distribution.Types.PkgconfigDependency
import Distribution.Types.PkgconfigVersionRange
import Distribution.Types.LocalBuildInfo
import Distribution.Types.LibraryName
import Distribution.Types.LibraryVisibility
import Distribution.Types.ComponentRequestedSpec
import Distribution.Types.ForeignLib
import Distribution.Types.ForeignLibType
import Distribution.Types.ForeignLibOption
import Distribution.Types.GivenComponent
import Distribution.Types.Mixin
import Distribution.Types.UnqualComponentName
import Distribution.Simple.Utils
import Distribution.System
import Distribution.Version
import Distribution.Verbosity
import qualified Distribution.Compat.Graph as Graph
import Distribution.Compat.Stack
import Distribution.Backpack.Configure
import Distribution.Backpack.DescribeUnitId
import Distribution.Backpack.PreExistingComponent
import Distribution.Backpack.ConfiguredComponent (newPackageDepsBehaviour)
import Distribution.Backpack.Id
import Distribution.Utils.LogProgress
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.GHCJS as GHCJS
import qualified Distribution.Simple.UHC as UHC
import qualified Distribution.Simple.HaskellSuite as HaskellSuite
import Control.Exception
( ErrorCall, Exception, evaluate, throw, throwIO, try )
import Control.Monad ( forM, forM_ )
import Data.List.NonEmpty ( nonEmpty )
import Distribution.Utils.Structured ( structuredDecodeOrFailIO, structuredEncode )
import Distribution.Compat.Directory ( listDirectory )
import Data.ByteString.Lazy ( ByteString )
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy.Char8 as BLC8
import Data.List
( (\\), partition, inits, stripPrefix, intersect, dropWhileEnd )
import Data.Either
( partitionEithers )
import qualified Data.Map as Map
import System.Directory
( canonicalizePath, createDirectoryIfMissing, doesFileExist
, getTemporaryDirectory, removeFile)
import System.FilePath
( (</>), isAbsolute, takeDirectory )
import Distribution.Compat.Directory
( doesPathExist )
import qualified System.Info
( compilerName, compilerVersion )
import System.IO
( hPutStrLn, hClose )
import Distribution.Pretty
( pretty, defaultStyle, prettyShow )
import Distribution.Parsec
( simpleParsec )
import Text.PrettyPrint
( Doc, (<+>), ($+$), char, comma, hsep, nest
, punctuate, quotes, render, renderStyle, sep, text )
import Distribution.Compat.Environment ( lookupEnv )
import Distribution.Compat.Exception ( catchExit, catchIO )
import qualified Data.Set as Set
type UseExternalInternalDeps = Bool
data ConfigStateFileError
= ConfigStateFileNoHeader
| ConfigStateFileBadHeader
| ConfigStateFileNoParse
| ConfigStateFileMissing
| ConfigStateFileBadVersion PackageIdentifier PackageIdentifier
(Either ConfigStateFileError LocalBuildInfo)
deriving (Typeable)
dispConfigStateFileError :: ConfigStateFileError -> Doc
dispConfigStateFileError ConfigStateFileNoHeader =
text "Saved package config file header is missing."
<+> text "Re-run the 'configure' command."
dispConfigStateFileError ConfigStateFileBadHeader =
text "Saved package config file header is corrupt."
<+> text "Re-run the 'configure' command."
dispConfigStateFileError ConfigStateFileNoParse =
text "Saved package config file is corrupt."
<+> text "Re-run the 'configure' command."
dispConfigStateFileError ConfigStateFileMissing =
text "Run the 'configure' command first."
dispConfigStateFileError (ConfigStateFileBadVersion oldCabal oldCompiler _) =
text "Saved package config file is outdated:"
$+$ badCabal $+$ badCompiler
$+$ text "Re-run the 'configure' command."
where
badCabal =
text "• the Cabal version changed from"
<+> pretty oldCabal <+> "to" <+> pretty currentCabalId
badCompiler
| oldCompiler == currentCompilerId = mempty
| otherwise =
text "• the compiler changed from"
<+> pretty oldCompiler <+> "to" <+> pretty currentCompilerId
instance Show ConfigStateFileError where
show = renderStyle defaultStyle . dispConfigStateFileError
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 <- structuredDecodeOrFailIO (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
where
_ = callStack
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
-> NoCallStackIO ()
writePersistBuildConfig distPref lbi = do
createDirectoryIfMissing False distPref
writeFileAtomic (localBuildInfoFile distPref) $
BLC8.unlines [showHeader pkgId, structuredEncode lbi]
where
pkgId = localPackage lbi
currentCabalId :: PackageIdentifier
currentCabalId = PackageIdentifier (mkPackageName "Cabal") cabalVersion
currentCompilerId :: PackageIdentifier
currentCompilerId = PackageIdentifier (mkPackageName System.Info.compilerName)
(mkVersion' 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
_ <- simpleParsec (fromUTF8LBS pkgId) :: Maybe PackageIdentifier
cabalId' <- simpleParsec (BLC8.unpack cabalId)
compId' <- simpleParsec (BLC8.unpack compId)
return (cabalId', compId')
_ -> throw ConfigStateFileNoHeader
showHeader :: PackageIdentifier
-> ByteString
showHeader pkgId = BLC8.unwords
[ "Saved", "package", "config", "for"
, toUTF8LBS $ prettyShow pkgId
, "written", "by"
, BLC8.pack $ prettyShow currentCabalId
, "using"
, BLC8.pack $ prettyShow currentCompilerId
]
checkPersistBuildConfigOutdated :: FilePath -> FilePath -> NoCallStackIO Bool
checkPersistBuildConfigOutdated distPref pkg_descr_file =
pkg_descr_file `moreRecentFile` localBuildInfoFile distPref
localBuildInfoFile :: FilePath
-> FilePath
localBuildInfoFile distPref = distPref </> "setup-config"
findDistPref :: FilePath
-> Setup.Flag FilePath
-> NoCallStackIO FilePath
findDistPref defDistPref overrideDistPref = do
envDistPref <- liftM parseEnvDistPref (lookupEnv "CABAL_BUILDDIR")
return $ fromFlagOrDefault defDistPref (mappend envDistPref overrideDistPref)
where
parseEnvDistPref env =
case env of
Just distPref | not (null distPref) -> toFlag distPref
_ -> NoFlag
findDistPrefOrDefault :: Setup.Flag FilePath
-> NoCallStackIO FilePath
findDistPrefOrDefault = findDistPref defaultDistPref
configure :: (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags -> IO LocalBuildInfo
configure (pkg_descr0, pbi) cfg = do
(mb_cname :: Maybe ComponentName) <- do
let flat_pkg_descr = flattenPackageDescription pkg_descr0
targets <- readBuildTargets verbosity flat_pkg_descr (configArgs cfg)
let targets' = [ cname | BuildTargetComponent cname <- targets ]
case targets' of
_ | null (configArgs cfg) -> return Nothing
[cname] -> return (Just cname)
[] -> die' verbosity "No valid component targets found"
_ -> die' verbosity
"Can only configure either single component or all of them"
let use_external_internal_deps = isJust mb_cname
case mb_cname of
Nothing -> setupMessage verbosity "Configuring" (packageId pkg_descr0)
Just cname -> setupMessage' verbosity "Configuring" (packageId pkg_descr0)
cname (Just (configInstantiateWith cfg))
when (isJust (flagToMaybe (configCID cfg)) && isNothing mb_cname) $
die' verbosity "--cid is only supported for per-component configure"
checkDeprecatedFlags verbosity cfg
checkExactConfiguration verbosity pkg_descr0 cfg
let buildDir :: FilePath
buildDir = fromFlag (configDistPref cfg) </> "build"
createDirectoryIfMissingVerbose (lessVerbose verbosity) True buildDir
let packageDbs :: PackageDBStack
packageDbs
= interpretPackageDbFlags
(fromFlag (configUserInstall cfg))
(configPackageDBs cfg)
(comp :: Compiler,
compPlatform :: Platform,
programDb :: ProgramDb)
<- configCompilerEx
(flagToMaybe (configHcFlavor cfg))
(flagToMaybe (configHcPath cfg))
(flagToMaybe (configHcPkg cfg))
(mkProgramDb cfg (configPrograms cfg))
(lessVerbose verbosity)
installedPackageSet :: InstalledPackageIndex
<- getInstalledPackages (lessVerbose verbosity) comp
packageDbs programDb
let internalPackageSet :: Map PackageName (Maybe UnqualComponentName)
internalPackageSet = getInternalPackages pkg_descr0
let enabled :: ComponentRequestedSpec
enabled = case mb_cname of
Just cname -> OneComponentRequestedSpec cname
Nothing -> ComponentRequestedSpec
{ testsRequested = fromFlag (configTests cfg)
, benchmarksRequested =
fromFlag (configBenchmarks cfg) }
when (isJust mb_cname
&& (fromFlag (configTests cfg) || fromFlag (configBenchmarks cfg))) $
die' verbosity $
"--enable-tests/--enable-benchmarks are incompatible with" ++
" explicitly specifying a component to configure."
when (fromFlag (configDynExe cfg) && fromFlag (configFullyStaticExe cfg)) $
die' verbosity $
"--enable-executable-dynamic and --enable-executable-static" ++
" are incompatible with each other."
(allConstraints :: [Dependency],
requiredDepsMap :: Map (PackageName, ComponentName) InstalledPackageInfo)
<- either (die' verbosity) return $
combinedConstraints (configConstraints cfg)
(configDependencies cfg)
installedPackageSet
(pkg_descr :: PackageDescription,
flags :: FlagAssignment)
<- configureFinalizedPackage verbosity cfg enabled
allConstraints
(dependencySatisfiable
use_external_internal_deps
(fromFlagOrDefault False (configExactConfiguration cfg))
(fromFlagOrDefault False (configAllowDependingOnPrivateLibs cfg))
(packageName pkg_descr0)
installedPackageSet
internalPackageSet
requiredDepsMap)
comp
compPlatform
pkg_descr0
debug verbosity $ "Finalized package description:\n"
++ showPackageDescription pkg_descr
let cabalFileDir = maybe "." takeDirectory $
flagToMaybe (configCabalFilePath cfg)
checkCompilerProblems verbosity comp pkg_descr enabled
checkPackageProblems verbosity cabalFileDir pkg_descr0
(updatePackageDescription pbi pkg_descr)
externalPkgDeps :: [PreExistingComponent]
<- configureDependencies
verbosity
use_external_internal_deps
internalPackageSet
installedPackageSet
requiredDepsMap
pkg_descr
enabled
defaultDirs :: InstallDirTemplates
<- defaultInstallDirs' use_external_internal_deps
(compilerFlavor comp)
(fromFlag (configUserInstall cfg))
(hasLibs pkg_descr)
let installDirs :: InstallDirTemplates
installDirs = combineInstallDirs fromFlagOrDefault
defaultDirs (configInstallDirs cfg)
let langlist = nub $ catMaybes $ map defaultLanguage
(enabledBuildInfos pkg_descr enabled)
let langs = unsupportedLanguages comp langlist
when (not (null langs)) $
die' verbosity $ "The package " ++ prettyShow (packageId pkg_descr0)
++ " requires the following languages which are not "
++ "supported by " ++ prettyShow (compilerId comp) ++ ": "
++ intercalate ", " (map prettyShow langs)
let extlist = nub $ concatMap allExtensions
(enabledBuildInfos pkg_descr enabled)
let exts = unsupportedExtensions comp extlist
when (not (null exts)) $
die' verbosity $ "The package " ++ prettyShow (packageId pkg_descr0)
++ " requires the following language extensions which are not "
++ "supported by " ++ prettyShow (compilerId comp) ++ ": "
++ intercalate ", " (map prettyShow exts)
let flibs = [flib | CFLib flib <- enabledComponents pkg_descr enabled]
let unsupportedFLibs = unsupportedForeignLibs comp compPlatform flibs
when (not (null unsupportedFLibs)) $
die' verbosity $ "Cannot build some foreign libraries: "
++ intercalate "," unsupportedFLibs
let requiredBuildTools = do
bi <- enabledBuildInfos pkg_descr enabled
let externBuildToolDeps =
[ LegacyExeDependency (unUnqualComponentName eName) versionRange
| buildTool@(ExeDependency _ eName versionRange)
<- getAllToolDependencies pkg_descr bi
, not $ isInternal pkg_descr buildTool ]
let unknownBuildTools =
[ buildTool
| buildTool <- buildTools bi
, Nothing == desugarBuildTool pkg_descr buildTool ]
externBuildToolDeps ++ unknownBuildTools
programDb' <-
configureAllKnownPrograms (lessVerbose verbosity) programDb
>>= configureRequiredPrograms verbosity requiredBuildTools
(pkg_descr', programDb'') <-
configurePkgconfigPackages verbosity pkg_descr programDb' enabled
(buildComponents :: [ComponentLocalBuildInfo],
packageDependsIndex :: InstalledPackageIndex) <-
runLogProgress verbosity $ configureComponentLocalBuildInfos
verbosity
use_external_internal_deps
enabled
(fromFlagOrDefault False (configDeterministic cfg))
(configIPID cfg)
(configCID cfg)
pkg_descr
externalPkgDeps
(configConfigurationsFlags cfg)
(configInstantiateWith cfg)
installedPackageSet
comp
split_sections :: Bool <-
if not (fromFlag $ configSplitSections cfg)
then return False
else case compilerFlavor comp of
GHC | compilerVersion comp >= mkVersion [8,0]
-> return True
GHCJS
-> return True
_ -> do warn verbosity
("this compiler does not support " ++
"--enable-split-sections; ignoring")
return False
split_objs :: Bool <-
if not (fromFlag $ configSplitObjs cfg)
then return False
else case compilerFlavor comp of
_ | split_sections
-> do warn verbosity
("--enable-split-sections and " ++
"--enable-split-objs are mutually" ++
"exclusive; ignoring the latter")
return False
GHC
-> 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
withStaticLib_ =
fromFlagOrDefault False $ configStaticLib cfg
withDynExe_ = fromFlag $ configDynExe cfg
withFullyStaticExe_ = fromFlag $ configFullyStaticExe 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."
setProfLBI <- configureProfiling verbosity cfg comp
setCoverageLBI <- configureCoverage verbosity cfg comp
let
strip_libexe s f =
let defaultStrip = fromFlagOrDefault True (f cfg)
in case fromFlag (configDebugInfo cfg) of
NoDebugInfo -> return defaultStrip
_ -> case f cfg of
Flag True -> do
warn verbosity $ "Setting debug-info implies "
++ s ++ "-stripping: False"
return False
_ -> return False
strip_lib <- strip_libexe "library" configStripLibs
strip_exe <- strip_libexe "executable" configStripExes
let reloc = fromFlagOrDefault False $ configRelocatable cfg
let buildComponentsMap =
foldl' (\m clbi -> Map.insertWith (++)
(componentLocalName clbi) [clbi] m)
Map.empty buildComponents
let lbi = (setCoverageLBI . setProfLBI)
LocalBuildInfo {
configFlags = cfg,
flagAssignment = flags,
componentEnabledSpec = enabled,
extraConfigArgs = [],
installDirTemplates = installDirs,
compiler = comp,
hostPlatform = compPlatform,
buildDir = buildDir,
cabalFilePath = flagToMaybe (configCabalFilePath cfg),
componentGraph = Graph.fromDistinctList buildComponents,
componentNameMap = buildComponentsMap,
installedPkgs = packageDependsIndex,
pkgDescrFile = Nothing,
localPkgDescr = pkg_descr',
withPrograms = programDb'',
withVanillaLib = fromFlag $ configVanillaLib cfg,
withSharedLib = withSharedLib_,
withStaticLib = withStaticLib_,
withDynExe = withDynExe_,
withFullyStaticExe = withFullyStaticExe_,
withProfLib = False,
withProfLibDetail = ProfDetailNone,
withProfExe = False,
withProfExeDetail = ProfDetailNone,
withOptimization = fromFlag $ configOptimization cfg,
withDebugInfo = fromFlag $ configDebugInfo cfg,
withGHCiLib = fromFlagOrDefault ghciLibByDefault $
configGHCiLib cfg,
splitSections = split_sections,
splitObjs = split_objs,
stripExes = strip_exe,
stripLibs = strip_lib,
exeCoverage = False,
libCoverage = False,
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)
|| "${pkgroot}" `isPrefixOf` prefix dirs) $ die' verbosity $
"expected an absolute directory name for --prefix: " ++ prefix dirs
when ("${pkgroot}" `isPrefixOf` prefix dirs) $
warn verbosity $ "Using ${pkgroot} in prefix " ++ prefix dirs
++ " will not work if you rely on the Path_* module "
++ " or other hard coded paths. Cabal does not yet "
++ " support fully relocatable builds! "
++ " See #462 #2302 #2994 #3305 #3473 #3586 #3909"
++ " #4097 #4291 #4872"
info verbosity $ "Using " ++ prettyShow currentCabalId
++ " compiled by " ++ prettyShow 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 "Executables" (bindir dirs) (bindir relative)
dirinfo "Libraries" (libdir dirs) (libdir relative)
dirinfo "Dynamic Libraries" (dynlibdir dirs) (dynlibdir relative)
dirinfo "Private executables" (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 programDb'' ]
return lbi
where
verbosity = fromFlag (configVerbosity cfg)
mkProgramDb :: ConfigFlags -> ProgramDb -> ProgramDb
mkProgramDb cfg initialProgramDb = programDb
where
programDb = userSpecifyArgss (configProgramArgs cfg)
. userSpecifyPaths (configProgramPaths cfg)
. setProgramSearchPath searchpath
$ initialProgramDb
searchpath = getProgramSearchPath initialProgramDb
++ map ProgramSearchPathDir
(fromNubList $ configProgramPathExtra cfg)
checkDeprecatedFlags :: Verbosity -> ConfigFlags -> IO ()
checkDeprecatedFlags verbosity cfg = do
unless (configProfExe cfg == NoFlag) $ do
let enable | fromFlag (configProfExe cfg) = "enable"
| otherwise = "disable"
warn verbosity
("The flag --" ++ enable ++ "-executable-profiling is deprecated. "
++ "Please use --" ++ enable ++ "-profiling instead.")
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.")
checkExactConfiguration
:: Verbosity -> GenericPackageDescription -> ConfigFlags -> IO ()
checkExactConfiguration verbosity pkg_descr0 cfg =
when (fromFlagOrDefault False (configExactConfiguration cfg)) $ do
let cmdlineFlags = map fst (unFlagAssignment (configConfigurationsFlags cfg))
allFlags = map flagName . genPackageFlags $ pkg_descr0
diffFlags = allFlags \\ cmdlineFlags
when (not . null $ diffFlags) $
die' verbosity $ "'--exact-configuration' was given, "
++ "but the following flags were not specified: "
++ intercalate ", " (map show diffFlags)
getInternalPackages :: GenericPackageDescription
-> Map PackageName (Maybe UnqualComponentName)
getInternalPackages pkg_descr0 =
let pkg_descr = flattenPackageDescription pkg_descr0
f lib = case libName lib of
LMainLibName -> (packageName pkg_descr, Nothing)
LSubLibName n' -> (unqualComponentNameToPackageName n', Just n')
in Map.fromList (map f (allLibraries pkg_descr))
dependencySatisfiable
:: Bool
-> Bool
-> Bool
-> PackageName
-> InstalledPackageIndex
-> Map PackageName (Maybe UnqualComponentName)
-> Map (PackageName, ComponentName) InstalledPackageInfo
-> (Dependency -> Bool)
dependencySatisfiable
use_external_internal_deps
exact_config
allow_private_deps
pn installedPackageSet internalPackageSet requiredDepsMap
(Dependency depName vr sublibs)
| exact_config
= if isInternalDep && not use_external_internal_deps
then True
else
(sublibs == Set.singleton LMainLibName
&& Map.member
(pn, CLibName $ LSubLibName $
packageNameToUnqualComponentName depName)
requiredDepsMap)
|| all visible sublibs
| isInternalDep
= if use_external_internal_deps
then internalDepSatisfiable
else True
| otherwise
= depSatisfiable
where
isInternalDep = Map.member depName internalPackageSet
depSatisfiable =
not . null $ PackageIndex.lookupDependency installedPackageSet depName vr
internalDepSatisfiable =
not . null $ PackageIndex.lookupInternalDependency
installedPackageSet pn vr cn
where
cn | pn == depName
= LMainLibName
| otherwise
= LSubLibName $ packageNameToUnqualComponentName depName
visible lib = maybe
False
(\ipi -> Installed.libVisibility ipi == LibraryVisibilityPublic
|| allow_private_deps
|| pkgName (Installed.sourcePackageId ipi) == pn)
maybeIPI
where maybeIPI = Map.lookup (depName, CLibName lib) requiredDepsMap
configureFinalizedPackage
:: Verbosity
-> ConfigFlags
-> ComponentRequestedSpec
-> [Dependency]
-> (Dependency -> Bool)
-> Compiler
-> Platform
-> GenericPackageDescription
-> IO (PackageDescription, FlagAssignment)
configureFinalizedPackage verbosity cfg enabled
allConstraints satisfies comp compPlatform pkg_descr0 = do
(pkg_descr0', flags) <-
case finalizePD
(configConfigurationsFlags cfg)
enabled
satisfies
compPlatform
(compilerInfo comp)
allConstraints
pkg_descr0
of Right r -> return r
Left missing ->
die' verbosity $ "Encountered missing or private dependencies:\n"
++ (render . nest 4 . sep . punctuate comma
. map (pretty . simplifyDependency)
$ missing)
let pkg_descr = addExtraIncludeLibDirs pkg_descr0'
unless (nullFlagAssignment flags) $
info verbosity $ "Flags chosen: "
++ intercalate ", " [ unFlagName fn ++ "=" ++ prettyShow value
| (fn, value) <- unFlagAssignment flags ]
return (pkg_descr, flags)
where
addExtraIncludeLibDirs pkg_descr =
let extraBi = mempty { extraLibDirs = configExtraLibDirs cfg
, extraFrameworkDirs = configExtraFrameworkDirs cfg
, PD.includeDirs = configExtraIncludeDirs cfg}
modifyLib l = l{ libBuildInfo = libBuildInfo l
`mappend` extraBi }
modifyExecutable e = e{ buildInfo = buildInfo e
`mappend` extraBi}
modifyForeignLib f = f{ foreignLibBuildInfo = foreignLibBuildInfo f
`mappend` extraBi}
modifyTestsuite t = t{ testBuildInfo = testBuildInfo t
`mappend` extraBi}
modifyBenchmark b = b{ benchmarkBuildInfo = benchmarkBuildInfo b
`mappend` extraBi}
in pkg_descr
{ library = modifyLib `fmap` library pkg_descr
, subLibraries = modifyLib `map` subLibraries pkg_descr
, executables = modifyExecutable `map` executables pkg_descr
, foreignLibs = modifyForeignLib `map` foreignLibs pkg_descr
, testSuites = modifyTestsuite `map` testSuites pkg_descr
, benchmarks = modifyBenchmark `map` benchmarks pkg_descr
}
checkCompilerProblems
:: Verbosity -> Compiler -> PackageDescription -> ComponentRequestedSpec -> IO ()
checkCompilerProblems verbosity comp pkg_descr enabled = do
unless (renamingPackageFlagsSupported comp ||
all (all (isDefaultIncludeRenaming . mixinIncludeRenaming) . mixins)
(enabledBuildInfos pkg_descr enabled)) $
die' verbosity $
"Your compiler does not support thinning and renaming on "
++ "package flags. To use this feature you must use "
++ "GHC 7.9 or later."
when (any (not.null.PD.reexportedModules) (PD.allLibraries pkg_descr)
&& not (reexportedModulesSupported comp)) $
die' verbosity $
"Your compiler does not support module re-exports. To use "
++ "this feature you must use GHC 7.9 or later."
when (any (not.null.PD.signatures) (PD.allLibraries pkg_descr)
&& not (backpackSupported comp)) $
die' verbosity $
"Your compiler does not support Backpack. To use "
++ "this feature you must use GHC 8.1 or later."
configureDependencies
:: Verbosity
-> UseExternalInternalDeps
-> Map PackageName (Maybe UnqualComponentName)
-> InstalledPackageIndex
-> Map (PackageName, ComponentName) InstalledPackageInfo
-> PackageDescription
-> ComponentRequestedSpec
-> IO [PreExistingComponent]
configureDependencies verbosity use_external_internal_deps
internalPackageSet installedPackageSet requiredDepsMap pkg_descr enableSpec = do
let failedDeps :: [FailedDependency]
allPkgDeps :: [ResolvedDependency]
(failedDeps, allPkgDeps) = partitionEithers $ concat
[ fmap (\s -> (dep, s)) <$> status
| dep <- enabledBuildDepends pkg_descr enableSpec
, let status = selectDependency (package pkg_descr)
internalPackageSet installedPackageSet
requiredDepsMap use_external_internal_deps dep ]
internalPkgDeps = [ pkgid
| (_, InternalDependency pkgid) <- allPkgDeps ]
externalPkgDeps = [ pec
| (_, ExternalDependency pec) <- allPkgDeps ]
when (not (null internalPkgDeps)
&& not (newPackageDepsBehaviour pkg_descr)) $
die' verbosity $ "The field 'build-depends: "
++ intercalate ", " (map (prettyShow . 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 verbosity failedDeps
reportSelectedDependencies verbosity allPkgDeps
return externalPkgDeps
configureCoverage :: Verbosity -> ConfigFlags -> Compiler
-> IO (LocalBuildInfo -> LocalBuildInfo)
configureCoverage verbosity cfg comp = do
let tryExeCoverage = fromFlagOrDefault False (configCoverage cfg)
tryLibCoverage = fromFlagOrDefault tryExeCoverage
(mappend (configCoverage cfg) (configLibCoverage cfg))
if coverageSupported comp
then do
let apply lbi = lbi { libCoverage = tryLibCoverage
, exeCoverage = tryExeCoverage
}
return apply
else do
let apply lbi = lbi { libCoverage = False
, exeCoverage = False
}
when (tryExeCoverage || tryLibCoverage) $ warn verbosity
("The compiler " ++ showCompilerId comp ++ " does not support "
++ "program coverage. Program coverage has been disabled.")
return apply
computeEffectiveProfiling :: ConfigFlags -> (Bool , Bool )
computeEffectiveProfiling cfg =
let tryExeProfiling = fromFlagOrDefault False
(mappend (configProf cfg) (configProfExe cfg))
tryLibProfiling = fromFlagOrDefault tryExeProfiling
(mappend (configProf cfg) (configProfLib cfg))
in (tryLibProfiling, tryExeProfiling)
configureProfiling :: Verbosity -> ConfigFlags -> Compiler
-> IO (LocalBuildInfo -> LocalBuildInfo)
configureProfiling verbosity cfg comp = do
let (tryLibProfiling, tryExeProfiling) = computeEffectiveProfiling cfg
tryExeProfileLevel = fromFlagOrDefault ProfDetailDefault
(configProfDetail cfg)
tryLibProfileLevel = fromFlagOrDefault ProfDetailDefault
(mappend
(configProfDetail cfg)
(configProfLibDetail cfg))
checkProfileLevel (ProfDetailOther other) = do
warn verbosity
("Unknown profiling detail level '" ++ other
++ "', using default.\nThe profiling detail levels are: "
++ intercalate ", "
[ name | (name, _, _) <- knownProfDetailLevels ])
return ProfDetailDefault
checkProfileLevel other = return other
(exeProfWithoutLibProf, applyProfiling) <-
if profilingSupported comp
then do
exeLevel <- checkProfileLevel tryExeProfileLevel
libLevel <- checkProfileLevel tryLibProfileLevel
let apply lbi = lbi { withProfLib = tryLibProfiling
, withProfLibDetail = libLevel
, withProfExe = tryExeProfiling
, withProfExeDetail = exeLevel
}
return (tryExeProfiling && not tryLibProfiling, apply)
else do
let apply lbi = lbi { withProfLib = False
, withProfLibDetail = ProfDetailNone
, withProfExe = False
, withProfExeDetail = ProfDetailNone
}
when (tryExeProfiling || tryLibProfiling) $ warn verbosity
("The compiler " ++ showCompilerId comp ++ " does not support "
++ "profiling. Profiling has been disabled.")
return (False, apply)
when exeProfWithoutLibProf $ warn verbosity
("Executables will be built with profiling, but library "
++ "profiling is disabled. Linking will fail if any executables "
++ "depend on the library.")
return applyProfiling
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 " ++ prettyShow v
hackageUrl :: String
hackageUrl = "http://hackage.haskell.org/package/"
type ResolvedDependency = (Dependency, DependencyResolution)
data DependencyResolution
= ExternalDependency PreExistingComponent
| InternalDependency PackageId
data FailedDependency = DependencyNotExists PackageName
| DependencyMissingInternal PackageName PackageName
| DependencyNoVersion Dependency
selectDependency :: PackageId
-> Map PackageName (Maybe UnqualComponentName)
-> InstalledPackageIndex
-> Map (PackageName, ComponentName) InstalledPackageInfo
-> UseExternalInternalDeps
-> Dependency
-> [Either FailedDependency DependencyResolution]
selectDependency pkgid internalIndex installedIndex requiredDepsMap
use_external_internal_deps
(Dependency dep_pkgname vr libs) =
case Map.lookup dep_pkgname internalIndex of
Just cname ->
if use_external_internal_deps
then do_external (Just $ maybeToLibraryName cname) <$> Set.toList libs
else do_internal
_ ->
do_external Nothing <$> Set.toList libs
where
do_internal = [Right $ InternalDependency
$ PackageIdentifier dep_pkgname $ packageVersion pkgid]
do_external :: Maybe LibraryName -> LibraryName -> Either FailedDependency DependencyResolution
do_external is_internal lib = do
ipi <- case Map.lookup (dep_pkgname, CLibName lib) requiredDepsMap of
Just pkginstance -> Right pkginstance
Nothing ->
case is_internal of
Nothing -> do_external_external
Just ln -> do_external_internal ln
return $ ExternalDependency $ ipiToPreExistingComponent ipi
do_external_external =
case pickLastIPI $ PackageIndex.lookupDependency installedIndex dep_pkgname vr of
Nothing -> Left (DependencyNotExists dep_pkgname)
Just pkg -> Right pkg
do_external_internal
:: LibraryName -> Either FailedDependency InstalledPackageInfo
do_external_internal ln =
case pickLastIPI $ PackageIndex.lookupInternalDependency installedIndex
(packageName pkgid) vr ln of
Nothing -> Left (DependencyMissingInternal dep_pkgname (packageName pkgid))
Just pkg -> Right pkg
pickLastIPI :: [(Version, [InstalledPackageInfo])] -> Maybe InstalledPackageInfo
pickLastIPI pkgs = safeHead . snd . last =<< nonEmpty pkgs
reportSelectedDependencies :: Verbosity
-> [ResolvedDependency] -> IO ()
reportSelectedDependencies verbosity deps =
info verbosity $ unlines
[ "Dependency " ++ prettyShow (simplifyDependency dep)
++ ": using " ++ prettyShow pkgid
| (dep, resolution) <- deps
, let pkgid = case resolution of
ExternalDependency pkg' -> packageId pkg'
InternalDependency pkgid' -> pkgid' ]
reportFailedDependencies :: Verbosity -> [FailedDependency] -> IO ()
reportFailedDependencies _ [] = return ()
reportFailedDependencies verbosity failed =
die' verbosity (intercalate "\n\n" (map reportFailedDependency failed))
where
reportFailedDependency (DependencyNotExists pkgname) =
"there is no version of " ++ prettyShow pkgname ++ " installed.\n"
++ "Perhaps you need to download and install it from\n"
++ hackageUrl ++ prettyShow pkgname ++ "?"
reportFailedDependency (DependencyMissingInternal pkgname real_pkgname) =
"internal dependency " ++ prettyShow pkgname ++ " not installed.\n"
++ "Perhaps you need to configure and install it first?\n"
++ "(This library was defined by " ++ prettyShow real_pkgname ++ ")"
reportFailedDependency (DependencyNoVersion dep) =
"cannot satisfy dependency " ++ prettyShow (simplifyDependency dep) ++ "\n"
getInstalledPackages :: Verbosity -> Compiler
-> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages verbosity comp packageDBs progdb = do
when (null packageDBs) $
die' verbosity $ "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..."
packageDBs' <- filterM packageDBExists packageDBs
case compilerFlavor comp of
GHC -> GHC.getInstalledPackages verbosity comp packageDBs' progdb
GHCJS -> GHCJS.getInstalledPackages verbosity packageDBs' progdb
UHC -> UHC.getInstalledPackages verbosity comp packageDBs' progdb
HaskellSuite {} ->
HaskellSuite.getInstalledPackages verbosity packageDBs' progdb
flv -> die' verbosity $ "don't know how to find the installed packages for "
++ prettyShow flv
where
packageDBExists (SpecificPackageDB path) = do
exists <- doesPathExist path
unless exists $
warn verbosity $ "Package db " <> path <> " does not exist yet"
return exists
packageDBExists UserPackageDB = pure True
packageDBExists GlobalPackageDB = pure True
getPackageDBContents :: Verbosity -> Compiler
-> PackageDB -> ProgramDb
-> IO InstalledPackageIndex
getPackageDBContents verbosity comp packageDB progdb = do
info verbosity "Reading installed packages..."
case compilerFlavor comp of
GHC -> GHC.getPackageDBContents verbosity packageDB progdb
GHCJS -> GHCJS.getPackageDBContents verbosity packageDB progdb
_ -> getInstalledPackages verbosity comp [packageDB] progdb
getInstalledPackagesMonitorFiles :: Verbosity -> Compiler
-> PackageDBStack
-> ProgramDb -> Platform
-> IO [FilePath]
getInstalledPackagesMonitorFiles verbosity comp packageDBs progdb platform =
case compilerFlavor comp of
GHC -> GHC.getInstalledPackagesMonitorFiles
verbosity platform progdb packageDBs
other -> do
warn verbosity $ "don't know how to find change monitoring files for "
++ "the installed package databases for " ++ prettyShow other
return []
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
combinedConstraints
:: [Dependency]
-> [GivenComponent]
-> InstalledPackageIndex
-> Either String ([Dependency],
Map (PackageName, ComponentName) InstalledPackageInfo)
combinedConstraints constraints dependencies installedPackages = do
when (not (null badComponentIds)) $
Left $ render $ text "The following package dependencies were requested"
$+$ nest 4 (dispDependencies badComponentIds)
$+$ text "however the given installed package instance does not exist."
return (allConstraints, idConstraintMap)
where
allConstraints :: [Dependency]
allConstraints = constraints
++ [ thisPackageVersion (packageId pkg)
| (_, _, _, Just pkg) <- dependenciesPkgInfo ]
idConstraintMap :: Map (PackageName, ComponentName) InstalledPackageInfo
idConstraintMap = Map.fromList
[ ((pn, cname), pkg)
| (pn, cname, _, Just pkg) <- dependenciesPkgInfo ]
dependenciesPkgInfo :: [(PackageName, ComponentName, ComponentId,
Maybe InstalledPackageInfo)]
dependenciesPkgInfo =
[ (pkgname, CLibName lname, cid, mpkg)
| GivenComponent pkgname lname cid <- dependencies
, let mpkg = PackageIndex.lookupComponentId
installedPackages cid
]
badComponentIds =
[ (pkgname, cname, cid)
| (pkgname, cname, cid, Nothing) <- dependenciesPkgInfo ]
dispDependencies deps =
hsep [ text "--dependency="
<<>> quotes
(pretty pkgname
<<>> case cname of
CLibName LMainLibName -> ""
CLibName (LSubLibName n) -> ":" <<>> pretty n
_ -> ":" <<>> pretty cname
<<>> char '='
<<>> pretty cid)
| (pkgname, cname, cid) <- deps ]
configureRequiredPrograms :: Verbosity -> [LegacyExeDependency] -> ProgramDb
-> IO ProgramDb
configureRequiredPrograms verbosity deps progdb =
foldM (configureRequiredProgram verbosity) progdb deps
configureRequiredProgram :: Verbosity -> ProgramDb -> LegacyExeDependency
-> IO ProgramDb
configureRequiredProgram verbosity progdb
(LegacyExeDependency progName verRange) =
case lookupKnownProgram progName progdb of
Nothing ->
configureProgram verbosity (simpleProgram progName) progdb
Just prog
| verRange == anyVersion -> do
(_, progdb') <- requireProgram verbosity prog progdb
return progdb'
| otherwise -> do
(_, _, progdb') <- requireProgramVersion verbosity prog verRange progdb
return progdb'
configurePkgconfigPackages :: Verbosity -> PackageDescription
-> ProgramDb -> ComponentRequestedSpec
-> IO (PackageDescription, ProgramDb)
configurePkgconfigPackages verbosity pkg_descr progdb enabled
| null allpkgs = return (pkg_descr, progdb)
| otherwise = do
(_, _, progdb') <- requireProgramVersion
(lessVerbose verbosity) pkgConfigProgram
(orLaterVersion $ mkVersion [0,9,0]) progdb
traverse_ requirePkg allpkgs
mlib' <- traverse addPkgConfigBILib (library pkg_descr)
libs' <- traverse addPkgConfigBILib (subLibraries pkg_descr)
exes' <- traverse addPkgConfigBIExe (executables pkg_descr)
tests' <- traverse addPkgConfigBITest (testSuites pkg_descr)
benches' <- traverse addPkgConfigBIBench (benchmarks pkg_descr)
let pkg_descr' = pkg_descr { library = mlib',
subLibraries = libs', executables = exes',
testSuites = tests', benchmarks = benches' }
return (pkg_descr', progdb')
where
allpkgs = concatMap pkgconfigDepends (enabledBuildInfos pkg_descr enabled)
pkgconfig = getDbProgramOutput (lessVerbose verbosity)
pkgConfigProgram progdb
requirePkg dep@(PkgconfigDependency pkgn range) = do
version <- pkgconfig ["--modversion", pkg]
`catchIO` (\_ -> die' verbosity notFound)
`catchExit` (\_ -> die' verbosity notFound)
let trim = dropWhile isSpace . dropWhileEnd isSpace
let v = PkgconfigVersion (toUTF8BS $ trim version)
if not (withinPkgconfigVersionRange v range)
then die' verbosity (badVersion v)
else 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 " ++ prettyShow v
depSatisfied v = "Dependency " ++ prettyShow dep
++ ": using version " ++ prettyShow v
versionRequirement
| isAnyPkgconfigVersion range = ""
| otherwise = " version " ++ prettyShow range
pkg = unPkgconfigName pkgn
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 :: [PkgconfigDependency] -> NoCallStackIO BuildInfo
pkgconfigBuildInfo [] = return mempty
pkgconfigBuildInfo pkgdeps = do
let pkgs = nub [ prettyShow pkg | PkgconfigDependency 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, ProgramDb)
configCompilerAuxEx cfg = configCompilerEx (flagToMaybe $ configHcFlavor cfg)
(flagToMaybe $ configHcPath cfg)
(flagToMaybe $ configHcPkg cfg)
programDb
(fromFlag (configVerbosity cfg))
where
programDb = mkProgramDb cfg defaultProgramDb
configCompilerEx :: Maybe CompilerFlavor -> Maybe FilePath -> Maybe FilePath
-> ProgramDb -> Verbosity
-> IO (Compiler, Platform, ProgramDb)
configCompilerEx Nothing _ _ _ verbosity = die' verbosity "Unknown compiler"
configCompilerEx (Just hcFlavor) hcPath hcPkg progdb verbosity = do
(comp, maybePlatform, programDb) <- case hcFlavor of
GHC -> GHC.configure verbosity hcPath hcPkg progdb
GHCJS -> GHCJS.configure verbosity hcPath hcPkg progdb
UHC -> UHC.configure verbosity hcPath hcPkg progdb
HaskellSuite {} -> HaskellSuite.configure verbosity hcPath hcPkg progdb
_ -> die' verbosity "Unknown compiler"
return (comp, fromMaybe buildPlatform maybePlatform, programDb)
checkForeignDeps :: PackageDescription -> LocalBuildInfo -> Verbosity -> IO ()
checkForeignDeps pkg lbi verbosity =
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
checkDuplicateHeaders
ok <- builds (makeProgram headers) args
if ok then success else failure
checkDuplicateHeaders = do
let relIncDirs = filter (not . isAbsolute) (collectField PD.includeDirs)
isHeader = isSuffixOf ".h"
genHeaders <- forM relIncDirs $ \dir ->
fmap (dir </>) . filter isHeader <$>
listDirectory (buildDir lbi </> dir) `catchIO` (\_ -> return [])
srcHeaders <- forM relIncDirs $ \dir ->
fmap (dir </>) . filter isHeader <$>
listDirectory (baseDir lbi </> dir) `catchIO` (\_ -> return [])
let commonHeaders = concat genHeaders `intersect` concat srcHeaders
forM_ commonHeaders $ \hdr -> do
warn verbosity $ "Duplicate header found in "
++ (buildDir lbi </> hdr)
++ " and "
++ (baseDir lbi </> hdr)
++ "; removing "
++ (baseDir lbi </> hdr)
removeFile (baseDir lbi </> hdr)
findOffendingHdr =
ifBuildsWith allHeaders ccArgs
(return Nothing)
(go . Prelude.tail . inits $ allHeaders)
where
go [] = return Nothing
go (hdrs:hdrsInits) =
ifBuildsWith hdrs cppArgs
(ifBuildsWith hdrs ccArgs
(go hdrsInits)
(return . fmap Right . safeLast $ hdrs))
(return . fmap Left . safeLast $ hdrs)
cppArgs = "-E":commonCppArgs
ccArgs = "-c":commonCcArgs
findMissingLibs = ifBuildsWith [] (makeLdArgs allLibs)
(return [])
(filterM (fmap not . libExists) allLibs)
libExists lib = builds (makeProgram []) (makeLdArgs [lib])
baseDir lbi' = fromMaybe "." (takeDirectory <$> cabalFilePath lbi')
commonCppArgs = platformDefines lbi
++ [ "-I" ++ buildDir lbi </> "autogen" ]
++ [ "-I" ++ buildDir lbi </> dir
| dir <- ordNub (collectField PD.includeDirs)
, not (isAbsolute dir)]
++ [ "-I" ++ baseDir lbi </> dir
| dir <- ordNub (collectField PD.includeDirs)
, not (isAbsolute dir)]
++ [ "-I" ++ dir | dir <- ordNub (collectField PD.includeDirs)
, isAbsolute dir]
++ ["-I" ++ baseDir lbi]
++ collectField PD.cppOptions
++ collectField PD.ccOptions
++ [ "-I" ++ dir
| dir <- ordNub [ 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 <- ordNub (collectField PD.extraLibDirs) ]
++ collectField PD.ldOptions
++ [ "-L" ++ dir
| dir <- ordNub [ 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 = enabledBuildInfos pkg (componentEnabledSpec lbi)
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
_ <- getDbProgramOutput 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' verbosity $ 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' verbosity $ 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 (or bad) C library: " ++ lib]
_ -> ["* Missing (or bad) 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."
++ "If the library 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."
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."
++ "If the library files do 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."
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
-> FilePath
-> GenericPackageDescription
-> PackageDescription
-> IO ()
checkPackageProblems verbosity dir gpkg pkg = do
ioChecks <- checkPackageFiles verbosity pkg dir
let pureChecks = checkPackage gpkg (Just pkg)
errors = [ e | PackageBuildImpossible e <- pureChecks ++ ioChecks ]
warnings = [ w | PackageBuildWarning w <- pureChecks ++ ioChecks ]
if null errors
then traverse_ (warn verbosity) warnings
else die' verbosity (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' verbosity $ "Operating system: " ++ prettyShow os ++
", does not support relocatable builds"
where
(Platform _ os) = hostPlatform lbi
checkCompiler
= unless (compilerFlavor comp `elem` [ GHC ])
$ die' verbosity $ "Compiler: " ++ show comp ++
", does not support relocatable builds"
where
comp = compiler lbi
packagePrefixRelative
= unless (relativeInstallDirs installDirs)
$ die' verbosity $ "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 (registrationPackageDB (withPackageDB lbi))
traverse_ (doCheck pkgr) ipkgs
where
doCheck pkgr ipkg
| maybe False (== pkgr) (Installed.pkgRoot ipkg)
= forM_ (Installed.libraryDirs ipkg) $ \libdir -> do
canonicalized <- canonicalizePath libdir
unless (p `isPrefixOf` canonicalized) $
die' verbosity $ msg libdir
| 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
unsupportedForeignLibs :: Compiler -> Platform -> [ForeignLib] -> [String]
unsupportedForeignLibs comp platform =
mapMaybe (checkForeignLibSupported comp platform)
checkForeignLibSupported :: Compiler -> Platform -> ForeignLib -> Maybe String
checkForeignLibSupported comp platform flib = go (compilerFlavor comp)
where
go :: CompilerFlavor -> Maybe String
go GHC
| compilerVersion comp < mkVersion [7,8] = unsupported [
"Building foreign libraires is only supported with GHC >= 7.8"
]
| otherwise = goGhcPlatform platform
go _ = unsupported [
"Building foreign libraries is currently only supported with ghc"
]
goGhcPlatform :: Platform -> Maybe String
goGhcPlatform (Platform X86_64 OSX ) = goGhcOsx (foreignLibType flib)
goGhcPlatform (Platform _ Linux ) = goGhcLinux (foreignLibType flib)
goGhcPlatform (Platform I386 Windows) = goGhcWindows (foreignLibType flib)
goGhcPlatform (Platform X86_64 Windows) = goGhcWindows (foreignLibType flib)
goGhcPlatform _ = unsupported [
"Building foreign libraries is currently only supported on OSX, "
, "Linux and Windows"
]
goGhcOsx :: ForeignLibType -> Maybe String
goGhcOsx ForeignLibNativeShared
| not (null (foreignLibModDefFile flib)) = unsupported [
"Module definition file not supported on OSX"
]
| not (null (foreignLibVersionInfo flib)) = unsupported [
"Foreign library versioning not currently supported on OSX"
]
| otherwise =
Nothing
goGhcOsx _ = unsupported [
"We can currently only build shared foreign libraries on OSX"
]
goGhcLinux :: ForeignLibType -> Maybe String
goGhcLinux ForeignLibNativeShared
| not (null (foreignLibModDefFile flib)) = unsupported [
"Module definition file not supported on Linux"
]
| not (null (foreignLibVersionInfo flib))
&& not (null (foreignLibVersionLinux flib)) = unsupported [
"You must not specify both lib-version-info and lib-version-linux"
]
| otherwise =
Nothing
goGhcLinux _ = unsupported [
"We can currently only build shared foreign libraries on Linux"
]
goGhcWindows :: ForeignLibType -> Maybe String
goGhcWindows ForeignLibNativeShared
| not standalone = unsupported [
"We can currently only build standalone libraries on Windows. Use\n"
, " if os(Windows)\n"
, " options: standalone\n"
, "in your foreign-library stanza."
]
| not (null (foreignLibVersionInfo flib)) = unsupported [
"Foreign library versioning not currently supported on Windows.\n"
, "You can specify module definition files in the mod-def-file field."
]
| otherwise =
Nothing
goGhcWindows _ = unsupported [
"We can currently only build shared foreign libraries on Windows"
]
standalone :: Bool
standalone = ForeignLibStandalone `elem` foreignLibOptions flib
unsupported :: [String] -> Maybe String
unsupported = Just . concat