Cabal-3.18.1.0: src/Distribution/Simple/GHC.hs
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Simple.GHC
-- Copyright : Isaac Jones 2003-2007
-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
--
-- This is a fairly large module. It contains most of the GHC-specific code for
-- configuring, building and installing packages. It also exports a function
-- for finding out what packages are already installed. Configuring involves
-- finding the @ghc@ and @ghc-pkg@ programs, finding what language extensions
-- this version of ghc supports and returning a 'Compiler' value.
--
-- 'getInstalledPackages' involves calling the @ghc-pkg@ program to find out
-- what packages are installed.
--
-- Building is somewhat complex as there is quite a bit of information to take
-- into account. We have to build libs and programs, possibly for profiling and
-- shared libs. We have to support building libraries that will be usable by
-- GHCi and also ghc's @-split-objs@ feature. We have to compile any C files
-- using ghc. Linking, especially for @split-objs@ is remarkably complex,
-- partly because there tend to be 1,000's of @.o@ files and this can often be
-- more than we can pass to the @ld@ or @ar@ programs in one go.
--
-- Installing for libs and exes involves finding the right files and copying
-- them to the right places. One of the more tricky things about this module is
-- remembering the layout of files in the build directory (which is not
-- explicitly documented) and thus what search dirs are used for various kinds
-- of files.
module Distribution.Simple.GHC
( getGhcInfo
, configure
, configureCompiler
, compilerProgramDb
, getInstalledPackages
, getInstalledPackagesMonitorFiles
, getPackageDBContents
, buildLib
, buildFLib
, buildExe
, replLib
, replFLib
, replExe
, startInterpreter
, installLib
, installFLib
, installExe
, libAbiHash
, hcPkgInfo
, registerPackage
, Internal.componentGhcOptions
, getGhcAppDir
, getLibDir
, compilerBuildWay
, getGlobalPackageDB
, pkgRoot
-- * Constructing and deconstructing GHC environment files
, Internal.GhcEnvironmentFileEntry (..)
, Internal.simpleGhcEnvironmentFile
, Internal.renderGhcEnvironmentFile
, Internal.writeGhcEnvironmentFile
, Internal.ghcPlatformAndVersionString
, readGhcEnvironmentFile
, parseGhcEnvironmentFile
, ParseErrorExc (..)
-- * Version-specific implementation quirks
, getImplInfo
, GhcImplInfo (..)
) where
import Distribution.Compat.Prelude
import Prelude ()
import Control.Arrow ((***))
import Control.Monad (forM_)
import qualified Data.Map as Map
import Data.Maybe (fromJust)
import Distribution.CabalSpecVersion
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import Distribution.Package
import Distribution.PackageDescription as PD
import Distribution.Pretty
import Distribution.Simple.Build.Inputs (PreBuildComponentInputs (..))
import Distribution.Simple.BuildPaths
import Distribution.Simple.Compiler
import Distribution.Simple.Errors
import Distribution.Simple.Flag
import qualified Distribution.Simple.GHC.Build as GHC
import Distribution.Simple.GHC.Build.Modules (BuildWay (..))
import Distribution.Simple.GHC.Build.Utils
import Distribution.Simple.GHC.EnvironmentParser
import Distribution.Simple.GHC.ImplInfo
import qualified Distribution.Simple.GHC.Internal as Internal
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.PreProcess.Types
import Distribution.Simple.Program
import Distribution.Simple.Program.Builtin (runghcProgram)
import Distribution.Simple.Program.GHC
import qualified Distribution.Simple.Program.HcPkg as HcPkg
import qualified Distribution.Simple.Program.Strip as Strip
import Distribution.Simple.Setup.Common
import Distribution.Simple.Setup.Repl
import Distribution.Simple.Utils
import Distribution.System
import Distribution.Types.ComponentLocalBuildInfo
import Distribution.Types.ParStrat
import Distribution.Types.TargetInfo
import Distribution.Utils.NubList
import Distribution.Utils.Path
import Distribution.Verbosity
import Distribution.Version
import Language.Haskell.Extension
import System.FilePath
( isRelative
, takeDirectory
)
import qualified System.Info
#ifndef mingw32_HOST_OS
import System.Posix (createSymbolicLink)
#endif /* mingw32_HOST_OS */
{- FOURMOLU_DISABLE -}
import System.Directory
( canonicalizePath
, createDirectoryIfMissing
, doesDirectoryExist
, doesFileExist
, getAppUserDataDirectory
, listDirectory
#ifndef mingw32_HOST_OS
, renameFile
#endif
)
{- FOURMOLU_ENABLE -}
import Distribution.Simple.Setup (BuildingWhat (..))
import Distribution.Simple.Setup.Build
-- -----------------------------------------------------------------------------
-- Configuring
-- | Configure GHC, and then auxiliary programs such as @ghc-pkg@, @haddock@
-- as well as toolchain programs such as @ar@, @ld.
configure
:: Verbosity
-> Maybe FilePath
-- ^ user-specified @ghc@ path (optional)
-> Maybe FilePath
-- ^ user-specified @ghc-pkg@ path (optional)
-> ProgramDb
-> IO (Compiler, Maybe Platform, ProgramDb)
configure verbosity hcPath hcPkgPath conf0 = do
(comp, compPlatform, progdb1) <- configureCompiler verbosity hcPath conf0
compProgDb <- compilerProgramDb verbosity comp progdb1 hcPkgPath
return (comp, compPlatform, compProgDb)
-- | Configure GHC.
configureCompiler
:: Verbosity
-> Maybe FilePath
-- ^ user-specified @ghc@ path (optional)
-> ProgramDb
-> IO (Compiler, Maybe Platform, ProgramDb)
configureCompiler verbosity hcPath conf0 = do
(ghcProg, ghcVersion, progdb1) <-
requireProgramVersion
verbosity
ghcProgram
(orLaterVersion (mkVersion [7, 0, 1]))
(userMaybeSpecifyPath "ghc" hcPath conf0)
-- Cabal currently supports GHC less than `maxGhcVersion`
let maxGhcVersion = mkVersion [10, 2]
unless (ghcVersion < maxGhcVersion) $
info verbosity $
"Unknown/unsupported 'ghc' version detected "
++ "(Cabal "
++ prettyShow cabalVersion
++ " supports 'ghc' version < "
++ prettyShow maxGhcVersion
++ "): "
++ programPath ghcProg
++ " is version "
++ prettyShow ghcVersion
let implInfo = ghcVersionImplInfo ghcVersion
languages <- Internal.getLanguages implInfo
extensions0 <- Internal.getExtensions verbosity ghcProg
ghcInfo <- Internal.getGhcInfo verbosity implInfo ghcProg
let ghcInfoMap = Map.fromList ghcInfo
filterJS = if ghcVersion < mkVersion [9, 8] then filterExt JavaScriptFFI else id
extensions =
-- workaround https://gitlab.haskell.org/ghc/ghc/-/issues/11214
-- see 'filterExtTH' comment below
filterJS $ filterExtTH extensions0
-- starting with GHC 8.0, `TemplateHaskell` will be omitted from
-- `--supported-extensions` when it's not available.
-- for older GHCs we can use the "Have interpreter" property to
-- filter out `TemplateHaskell`
filterExtTH
| ghcVersion < mkVersion [8]
, Just "NO" <- Map.lookup "Have interpreter" ghcInfoMap =
filterExt TemplateHaskell
| otherwise = id
filterExt ext = filter ((/= EnableExtension ext) . fst)
compilerId :: CompilerId
compilerId = CompilerId GHC ghcVersion
projectUnitId :: Maybe String
projectUnitId = Map.lookup "Project Unit Id" ghcInfoMap
-- The @AbiTag@ is the @Project Unit Id@ but with redundant information from the compiler version removed.
-- For development versions of the compiler these look like:
-- @Project Unit Id@: "ghc-9.13-inplace"
-- @compilerId@: "ghc-9.13.20250413"
-- So, we need to be careful to only strip the /common/ prefix.
-- In this example, @AbiTag@ is "inplace".
-- If the @Project Unit Id@ exactly matches @compilerId@, stripping the
-- common prefix yields the empty string, which should be treated as
-- @NoAbiTag@ rather than @AbiTag ""@.
compilerAbiTag :: AbiTag
compilerAbiTag =
let abiTagSuffix =
dropWhile (== '-') . stripCommonPrefix (prettyShow compilerId)
<$> projectUnitId
in case abiTagSuffix of
Nothing -> NoAbiTag
Just "" -> NoAbiTag
Just tag -> AbiTag tag
wiredInUnitIds = do
ghcInternalUnitId <- Map.lookup "ghc-internal Unit Id" ghcInfoMap
ghcUnitId <- projectUnitId
pure
[ (mkPackageName "ghc", mkUnitId ghcUnitId)
, (mkPackageName "ghc-internal", mkUnitId ghcInternalUnitId)
]
let comp =
Compiler
{ compilerId
, compilerAbiTag
, compilerCompat = []
, compilerLanguages = languages
, compilerExtensions = extensions
, compilerProperties = ghcInfoMap
, compilerWiredInUnitIds = wiredInUnitIds
}
compPlatform = Internal.targetPlatform ghcInfo
return (comp, compPlatform, progdb1)
-- | Given a configured @ghc@ program, configure auxiliary programs such
-- as @ghc-pkg@ or @haddock@, as well as toolchain programs such as @ar@, @ld@,
-- based on:
--
-- - the location of the @ghc@ executable,
-- - toolchain information in the GHC settings file.
compilerProgramDb
:: Verbosity
-> Compiler
-> ProgramDb
-> Maybe FilePath
-- ^ user-specified @ghc-pkg@ path (optional)
-> IO ProgramDb
compilerProgramDb verbosity comp progdb1 hcPkgPath = do
-- Likewise we try to find the matching hsc2hs and haddock programs.
let hsc2hsProgram' =
hsc2hsProgram
{ programFindLocation = guessHsc2hsFromGhcPath ghcProg
}
haddockProgram' =
haddockProgram
{ programFindLocation = guessHaddockFromGhcPath ghcProg
}
hpcProgram' =
hpcProgram
{ programFindLocation = guessHpcFromGhcPath ghcProg
}
runghcProgram' =
runghcProgram
{ programFindLocation = guessRunghcFromGhcPath ghcProg
}
ghcPkgProgram' =
ghcPkgProgram
{ programFindLocation = guessGhcPkgFromGhcPath ghcProg
}
progdb2 =
-- The knownPrograms are populated before userMaybeSpecifyPath
-- in the case that ProgramDb has been restored from a cache and is empty
-- See #11373 for where this went wrong before
userMaybeSpecifyPath "ghc-pkg" hcPkgPath $
addKnownProgram haddockProgram' $
addKnownProgram hsc2hsProgram' $
addKnownProgram hpcProgram' $
addKnownProgram runghcProgram' $
addKnownProgram
ghcPkgProgram'
progdb1
ghcProg = fromJust $ lookupProgram ghcProgram progdb1
ghcVersion = compilerVersion comp
-- configure gcc, ld, ar etc... based on the paths stored
-- in the GHC settings file
progdb3 =
Internal.configureToolchain
(ghcVersionImplInfo ghcVersion)
ghcProg
(compilerProperties comp)
progdb2
-- This is slightly tricky, we have to configure ghc first, then we use the
-- location of ghc to help find ghc-pkg in the case that the user did not
-- specify the location of ghc-pkg directly:
(ghcPkgProg, ghcPkgVersion, progdb4) <-
requireProgramVersion
verbosity
ghcPkgProgram'
anyVersion
progdb3
when (ghcVersion /= ghcPkgVersion) $
dieWithException verbosity $
VersionMismatchGHC (programPath ghcProg) ghcVersion (programPath ghcPkgProg) ghcPkgVersion
return progdb4
-- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find
-- the corresponding tool; e.g. if the tool is ghc-pkg, we try looking
-- for a versioned or unversioned ghc-pkg in the same dir, that is:
--
-- > /usr/local/bin/ghc-pkg-ghc-6.6.1(.exe)
-- > /usr/local/bin/ghc-pkg-6.6.1(.exe)
-- > /usr/local/bin/ghc-pkg(.exe)
guessToolFromGhcPath
:: Program
-> ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcPath tool ghcProg verbosity searchpath =
do
let toolname = programName tool
given_path = programPath ghcProg
given_dir = takeDirectory given_path
real_path <- canonicalizePath given_path
let real_dir = takeDirectory real_path
versionSuffix path = takeVersionSuffix (dropExeExtension path)
given_suf = versionSuffix given_path
real_suf = versionSuffix real_path
guessNormal dir = dir </> toolname <.> exeExtension buildPlatform
guessGhcVersioned dir suf =
dir
</> (toolname ++ "-ghc" ++ suf)
<.> exeExtension buildPlatform
guessVersioned dir suf =
dir
</> (toolname ++ suf)
<.> exeExtension buildPlatform
mkGuesses dir suf
| null suf = [guessNormal dir]
| otherwise =
[ guessGhcVersioned dir suf
, guessVersioned dir suf
, guessNormal dir
]
-- order matters here, see https://github.com/haskell/cabal/issues/7390
guesses =
( if real_path == given_path
then []
else mkGuesses real_dir real_suf
)
++ mkGuesses given_dir given_suf
info verbosity $
"looking for tool "
++ toolname
++ " near compiler in "
++ given_dir
debug verbosity $ "candidate locations: " ++ show guesses
exists <- traverse doesFileExist guesses
case [file | (file, True) <- zip guesses exists] of
-- If we can't find it near ghc, fall back to the usual
-- method.
[] -> programFindLocation tool verbosity searchpath
(fp : _) -> do
info verbosity $ "found " ++ toolname ++ " in " ++ fp
let lookedAt =
map fst
. takeWhile (\(_file, exist) -> not exist)
$ zip guesses exists
return (Just (fp, lookedAt))
where
takeVersionSuffix :: FilePath -> String
takeVersionSuffix = takeWhileEndLE isSuffixChar
isSuffixChar :: Char -> Bool
isSuffixChar c = isDigit c || c == '.' || c == '-'
-- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
-- corresponding ghc-pkg, we try looking for both a versioned and unversioned
-- ghc-pkg in the same dir, that is:
--
-- > /usr/local/bin/ghc-pkg-ghc-6.6.1(.exe)
-- > /usr/local/bin/ghc-pkg-6.6.1(.exe)
-- > /usr/local/bin/ghc-pkg(.exe)
guessGhcPkgFromGhcPath
:: ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessGhcPkgFromGhcPath = guessToolFromGhcPath ghcPkgProgram
-- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
-- corresponding hsc2hs, we try looking for both a versioned and unversioned
-- hsc2hs in the same dir, that is:
--
-- > /usr/local/bin/hsc2hs-ghc-6.6.1(.exe)
-- > /usr/local/bin/hsc2hs-6.6.1(.exe)
-- > /usr/local/bin/hsc2hs(.exe)
guessHsc2hsFromGhcPath
:: ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHsc2hsFromGhcPath = guessToolFromGhcPath hsc2hsProgram
-- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
-- corresponding haddock, we try looking for both a versioned and unversioned
-- haddock in the same dir, that is:
--
-- > /usr/local/bin/haddock-ghc-6.6.1(.exe)
-- > /usr/local/bin/haddock-6.6.1(.exe)
-- > /usr/local/bin/haddock(.exe)
guessHaddockFromGhcPath
:: ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHaddockFromGhcPath = guessToolFromGhcPath haddockProgram
guessHpcFromGhcPath
:: ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHpcFromGhcPath = guessToolFromGhcPath hpcProgram
guessRunghcFromGhcPath
:: ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessRunghcFromGhcPath = guessToolFromGhcPath runghcProgram
getGhcInfo :: Verbosity -> ConfiguredProgram -> IO [(String, String)]
getGhcInfo verbosity ghcProg = Internal.getGhcInfo verbosity implInfo ghcProg
where
version = fromMaybe (error "GHC.getGhcInfo: no ghc version") $ programVersion ghcProg
implInfo = ghcVersionImplInfo version
-- | Given a single package DB, return all installed packages.
getPackageDBContents
:: Verbosity
-> Maybe (SymbolicPath CWD (Dir from))
-> PackageDBX (SymbolicPath from (Dir PkgDB))
-> ProgramDb
-> IO InstalledPackageIndex
getPackageDBContents verbosity mbWorkDir packagedb progdb = do
pkgss <- getInstalledPackages' verbosity mbWorkDir [packagedb] progdb
toPackageIndex verbosity pkgss progdb
-- | Given a package DB stack, return all installed packages.
getInstalledPackages
:: Verbosity
-> Maybe (SymbolicPath CWD (Dir from))
-> PackageDBStackX (SymbolicPath from (Dir PkgDB))
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages verbosity mbWorkDir packagedbs progdb = do
checkPackageDbEnvVar verbosity
checkPackageDbStack verbosity packagedbs
pkgss <- getInstalledPackages' verbosity mbWorkDir packagedbs progdb
index <- toPackageIndex verbosity pkgss progdb
return $! hackRtsPackage index
where
hackRtsPackage index =
case PackageIndex.lookupPackageName index (mkPackageName "rts") of
[(_, [rts])] ->
PackageIndex.insert rts index
_ -> index -- No (or multiple) ghc rts package is registered!!
-- Feh, whatever, the ghc test suite does some crazy stuff.
-- | Given a list of @(PackageDB, InstalledPackageInfo)@ pairs, produce a
-- @PackageIndex@. Helper function used by 'getPackageDBContents' and
-- 'getInstalledPackages'.
toPackageIndex
:: Verbosity
-> [(PackageDBX a, [InstalledPackageInfo])]
-> ProgramDb
-> IO InstalledPackageIndex
toPackageIndex verbosity pkgss progdb = do
-- On Windows, various fields have $topdir/foo rather than full
-- paths. We need to substitute the right value in so that when
-- we, for example, call gcc, we have proper paths to give it.
topDir <- getLibDir' verbosity ghcProg
let indices =
[ PackageIndex.fromList (map (Internal.substTopDir topDir) pkgs)
| (_, pkgs) <- pkgss
]
return $! mconcat indices
where
ghcProg = fromMaybe (error "GHC.toPackageIndex: no ghc program") $ lookupProgram ghcProgram progdb
-- | Return the 'FilePath' to the GHC application data directory.
--
-- @since 3.4.0.0
getGhcAppDir :: IO FilePath
getGhcAppDir = getAppUserDataDirectory "ghc"
getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath
getLibDir verbosity lbi =
dropWhileEndLE isSpace
`fmap` getDbProgramOutput
verbosity
ghcProgram
(withPrograms lbi)
["--print-libdir"]
getLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath
getLibDir' verbosity ghcProg =
dropWhileEndLE isSpace
`fmap` getProgramOutput verbosity ghcProg ["--print-libdir"]
-- | Return the 'FilePath' to the global GHC package database.
getGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath
getGlobalPackageDB verbosity ghcProg =
dropWhileEndLE isSpace
`fmap` getProgramOutput verbosity ghcProg ["--print-global-package-db"]
-- | Return the 'FilePath' to the per-user GHC package database.
getUserPackageDB
:: Verbosity -> ConfiguredProgram -> Platform -> IO FilePath
getUserPackageDB _verbosity ghcProg platform = do
-- It's rather annoying that we have to reconstruct this, because ghc
-- hides this information from us otherwise. But for certain use cases
-- like change monitoring it really can't remain hidden.
appdir <- getGhcAppDir
return (appdir </> platformAndVersion </> packageConfFileName)
where
platformAndVersion =
Internal.ghcPlatformAndVersionString
platform
ghcVersion
packageConfFileName = "package.conf.d"
ghcVersion = fromMaybe (error "GHC.getUserPackageDB: no ghc version") $ programVersion ghcProg
checkPackageDbEnvVar :: Verbosity -> IO ()
checkPackageDbEnvVar verbosity =
Internal.checkPackageDbEnvVar verbosity "GHC" "GHC_PACKAGE_PATH"
checkPackageDbStack :: Eq fp => Verbosity -> PackageDBStackX fp -> IO ()
checkPackageDbStack _ (GlobalPackageDB : rest)
| GlobalPackageDB `notElem` rest = return ()
checkPackageDbStack verbosity rest
| GlobalPackageDB `elem` rest =
dieWithException verbosity CheckPackageDbStack
checkPackageDbStack _ _ = return ()
-- | Get the packages from specific PackageDBs, not cumulative.
getInstalledPackages'
:: Verbosity
-> Maybe (SymbolicPath CWD (Dir from))
-> [PackageDBX (SymbolicPath from (Dir PkgDB))]
-> ProgramDb
-> IO [(PackageDBX (SymbolicPath from (Dir PkgDB)), [InstalledPackageInfo])]
getInstalledPackages' verbosity mbWorkDir packagedbs progdb =
sequenceA
[ do
pkgs <- HcPkg.dump (hcPkgInfo progdb) verbosity mbWorkDir packagedb
return (packagedb, pkgs)
| packagedb <- packagedbs
]
getInstalledPackagesMonitorFiles
:: forall from
. Verbosity
-> Maybe (SymbolicPath CWD (Dir from))
-> Platform
-> ProgramDb
-> [PackageDBS from]
-> IO [FilePath]
getInstalledPackagesMonitorFiles verbosity mbWorkDir platform progdb =
traverse getPackageDBPath
where
getPackageDBPath :: PackageDBS from -> IO FilePath
getPackageDBPath GlobalPackageDB =
selectMonitorFile =<< getGlobalPackageDB verbosity ghcProg
getPackageDBPath UserPackageDB =
selectMonitorFile =<< getUserPackageDB verbosity ghcProg platform
getPackageDBPath (SpecificPackageDB path) = selectMonitorFile (interpretSymbolicPath mbWorkDir path)
-- GHC has old style file dbs, and new style directory dbs.
-- Note that for dir style dbs, we only need to monitor the cache file, not
-- the whole directory. The ghc program itself only reads the cache file
-- so it's safe to only monitor this one file.
selectMonitorFile path0 = do
let path =
if isRelative path0
then interpretSymbolicPath mbWorkDir (makeRelativePathEx path0)
else path0
isFileStyle <- doesFileExist path
if isFileStyle
then return path
else return (path </> "package.cache")
ghcProg = fromMaybe (error "GHC.toPackageIndex: no ghc program") $ lookupProgram ghcProgram progdb
-- -----------------------------------------------------------------------------
-- Building a library
buildLib
:: VerbosityHandles
-> BuildFlags
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildLib verbHandles flags numJobs pkg lbi lib clbi =
GHC.build numJobs verbHandles pkg $
PreBuildComponentInputs
{ buildingWhat = BuildNormal flags
, localBuildInfo = lbi
, targetInfo = TargetInfo clbi (CLib lib)
}
replLib
:: VerbosityHandles
-> ReplFlags
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
replLib verbHandles flags numJobs pkg lbi lib clbi =
GHC.build numJobs verbHandles pkg $
PreBuildComponentInputs
{ buildingWhat = BuildRepl flags
, localBuildInfo = lbi
, targetInfo = TargetInfo clbi (CLib lib)
}
-- | Start a REPL without loading any source files.
startInterpreter
:: Verbosity
-> ProgramDb
-> Compiler
-> Platform
-> PackageDBStack
-> IO ()
startInterpreter verbosity progdb comp platform packageDBs = do
let replOpts =
mempty
{ ghcOptMode = toFlag GhcModeInteractive
, ghcOptPackageDBs = packageDBs
}
checkPackageDbStack verbosity packageDBs
(ghcProg, _) <- requireProgram verbosity ghcProgram progdb
-- This doesn't pass source file arguments to GHC, so we don't have to worry
-- about using a response file here.
runGHC verbosity ghcProg comp platform Nothing replOpts
-- -----------------------------------------------------------------------------
-- Building an executable or foreign library
-- | Build a foreign library
buildFLib
:: Verbosity
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO ()
buildFLib v numJobs pkg lbi flib clbi =
GHC.build numJobs (verbosityHandles v) pkg $
PreBuildComponentInputs
{ buildingWhat =
BuildNormal $
mempty
{ buildCommonFlags =
mempty{setupVerbosity = toFlag $ verbosityFlags v}
}
, localBuildInfo = lbi
, targetInfo = TargetInfo clbi (CFLib flib)
}
replFLib
:: VerbosityHandles
-> ReplFlags
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO ()
replFLib verbHandles replFlags njobs pkg lbi flib clbi =
GHC.build njobs verbHandles pkg $
PreBuildComponentInputs
{ buildingWhat = BuildRepl replFlags
, localBuildInfo = lbi
, targetInfo = TargetInfo clbi (CFLib flib)
}
-- | Build an executable with GHC.
buildExe
:: Verbosity
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
buildExe v njobs pkg lbi exe clbi =
GHC.build njobs (verbosityHandles v) pkg $
PreBuildComponentInputs
{ buildingWhat =
BuildNormal $
mempty
{ buildCommonFlags =
mempty{setupVerbosity = toFlag $ verbosityFlags v}
}
, localBuildInfo = lbi
, targetInfo = TargetInfo clbi (CExe exe)
}
replExe
:: VerbosityHandles
-> ReplFlags
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
replExe verbHandles replFlags njobs pkg lbi exe clbi =
GHC.build njobs verbHandles pkg $
PreBuildComponentInputs
{ buildingWhat = BuildRepl replFlags
, localBuildInfo = lbi
, targetInfo = TargetInfo clbi (CExe exe)
}
-- | Extracts a String representing a hash of the ABI of a built
-- library. It can fail if the library has not yet been built.
libAbiHash
:: Verbosity
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO String
libAbiHash verbosity _pkg_descr lbi lib clbi = do
let
libBi = libBuildInfo lib
comp = compiler lbi
platform = hostPlatform lbi
mbWorkDir = mbWorkDirLBI lbi
vanillaArgs =
Internal.componentGhcOptions (verbosityLevel verbosity) lbi libBi clbi (componentBuildDir lbi clbi)
`mappend` mempty
{ ghcOptMode = toFlag GhcModeAbiHash
, ghcOptInputModules = toNubListR $ exposedModules lib
}
sharedArgs =
vanillaArgs
`mappend` mempty
{ ghcOptDynLinkMode = toFlag GhcDynamicOnly
, ghcOptFPic = toFlag True
, ghcOptHiSuffix = toFlag "dyn_hi"
, ghcOptObjSuffix = toFlag "dyn_o"
, ghcOptExtra = hcSharedOptions GHC libBi
}
profArgs =
vanillaArgs
`mappend` mempty
{ ghcOptProfilingMode = toFlag True
, ghcOptProfilingAuto =
Internal.profDetailLevelFlag
True
(withProfLibDetail lbi)
, ghcOptHiSuffix = toFlag "p_hi"
, ghcOptObjSuffix = toFlag "p_o"
, ghcOptExtra = hcProfOptions GHC libBi
}
profDynArgs =
vanillaArgs
`mappend` mempty
{ ghcOptProfilingMode = toFlag True
, ghcOptProfilingAuto =
Internal.profDetailLevelFlag
True
(withProfLibDetail lbi)
, ghcOptDynLinkMode = toFlag GhcDynamicOnly
, ghcOptFPic = toFlag True
, ghcOptHiSuffix = toFlag "p_dyn_hi"
, ghcOptObjSuffix = toFlag "p_dyn_o"
, ghcOptExtra = hcProfSharedOptions GHC libBi
}
ghcArgs =
let (libWays, _, _) = buildWays lbi
in case libWays (componentIsIndefinite clbi) of
(ProfDynWay : _) -> profDynArgs
(ProfWay : _) -> profArgs
(StaticWay : _) -> vanillaArgs
(DynWay : _) -> sharedArgs
_ -> error "libAbiHash: Can't find an enabled library way"
(ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
hash <-
getProgramInvocationOutput
verbosity
=<< ghcInvocation verbosity ghcProg comp platform mbWorkDir ghcArgs
return (takeWhile (not . isSpace) hash)
-- -----------------------------------------------------------------------------
-- Installing
-- | Install executables for GHC.
installExe
:: Verbosity
-> LocalBuildInfo
-> FilePath
-- ^ Where to copy the files to
-> FilePath
-- ^ Build location
-> (FilePath, FilePath)
-- ^ Executable (prefix,suffix)
-> PackageDescription
-> Executable
-> IO ()
installExe
verbosity
lbi
binDir
buildPref
(progprefix, progsuffix)
_pkg
exe = do
createDirectoryIfMissingVerbose verbosity True binDir
let exeName' = unUnqualComponentName $ exeName exe
exeFileName = exeTargetName (hostPlatform lbi) (exeName exe)
fixedExeBaseName = progprefix ++ exeName' ++ progsuffix
installBinary dest = do
installExecutableFile
verbosity
(buildPref </> exeName' </> exeFileName)
(dest <.> exeExtension (hostPlatform lbi))
when (stripExes lbi) $
Strip.stripExe
verbosity
(hostPlatform lbi)
(withPrograms lbi)
(dest <.> exeExtension (hostPlatform lbi))
installBinary (binDir </> fixedExeBaseName)
-- | Install foreign library for GHC.
installFLib
:: Verbosity
-> LocalBuildInfo
-> FilePath
-- ^ install location
-> FilePath
-- ^ Build location
-> PackageDescription
-> ForeignLib
-> IO ()
installFLib verbosity lbi targetDir builtDir _pkg flib =
install
(foreignLibIsShared flib)
builtDir
targetDir
(flibTargetName lbi flib)
where
install isShared srcDir dstDir name = do
let src = srcDir </> name
dst = dstDir </> name
createDirectoryIfMissingVerbose verbosity True targetDir
-- TODO: Should we strip? (stripLibs lbi)
if isShared
then installExecutableFile verbosity src dst
else installOrdinaryFile verbosity src dst
-- Now install appropriate symlinks if library is versioned
let (Platform _ os) = hostPlatform lbi
unless (null (foreignLibVersion flib os)) $ do
when (os /= Linux) $ dieWithException verbosity CantInstallForeignLib
#ifndef mingw32_HOST_OS
-- 'createSymbolicLink file1 file2' creates a symbolic link
-- named 'file2' which points to the file 'file1'.
-- Note that we do want a symlink to 'name' rather than
-- 'dst', because the symlink will be relative to the
-- directory it's created in.
-- Finally, we first create the symlinks in a temporary
-- directory and then rename to simulate 'ln --force'.
withTempDirectory dstDir nm $ \tmpDir -> do
let link1 = flibBuildName lbi flib
link2 = "lib" ++ nm <.> "so"
createSymbolicLink name (tmpDir </> link1)
renameFile (tmpDir </> link1) (dstDir </> link1)
createSymbolicLink name (tmpDir </> link2)
renameFile (tmpDir </> link2) (dstDir </> link2)
where
nm :: String
nm = unUnqualComponentName $ foreignLibName flib
#endif /* mingw32_HOST_OS */
-- | Install for ghc, .hi, .a, .so, .bytecodelib and, if --with-ghci given, .o
installLib
:: Verbosity
-> LocalBuildInfo
-> FilePath
-- ^ install location
-> FilePath
-- ^ install location for dynamic libraries
-> FilePath
-- ^ install location for bytecode libraries
-> FilePath
-- ^ Build location
-> PackageDescription
-> Library
-> ComponentLocalBuildInfo
-> IO ()
installLib verbosity lbi targetDir dynlibTargetDir bytecodeTargetDir _builtDir pkg lib clbi = do
let
(wantedLibWays, _, _) = buildWays lbi
isIndef = componentIsIndefinite clbi
libWays = wantedLibWays isIndef
info verbosity ("Wanted install ways: " ++ show libWays)
-- copy .hi files over:
forM_ (wantedLibWays isIndef) $ \case
StaticWay -> copyModuleFiles (Suffix "hi")
DynWay -> copyModuleFiles (Suffix "dyn_hi")
ProfWay -> copyModuleFiles (Suffix "p_hi")
ProfDynWay -> copyModuleFiles (Suffix "p_dyn_hi")
-- copy extra compilation artifacts that ghc plugins may produce
copyDirectoryIfExists extraCompilationArtifacts
-- copy the built library files over:
when (has_code && hasLib) $ do
-- Bytecode libraries are installed in bytecodelibdir and are copied
-- without stripping; see doc/internal/bytecode-libraries.md.
whenBytecodeLib $ installOrdinaryNoStrip builtDir bytecodeTargetDir bytecodeLibName
forM_ libWays $ \case
StaticWay -> do
sequence_
[ installOrdinary
builtDir
targetDir
(mkGenericStaticLibName (l ++ f))
| l <-
getHSLibraryName
(componentUnitId clbi)
: extraBundledLibs (libBuildInfo lib)
, f <- "" : extraLibFlavours (libBuildInfo lib)
]
whenGHCi $ installOrdinary builtDir targetDir ghciLibName
ProfWay -> do
installOrdinary builtDir targetDir profileLibName
whenGHCi $ installOrdinary builtDir targetDir ghciProfLibName
ProfDynWay -> do
installShared
builtDir
dynlibTargetDir
(mkProfSharedLibName platform compiler_id uid)
DynWay -> do
if
-- The behavior for "extra-bundled-libraries" changed in version 2.5.0.
-- See ghc issue #15837 and Cabal PR #5855.
| specVersion pkg < CabalSpecV3_0 -> do
sequence_
[ installShared
builtDir
dynlibTargetDir
(mkGenericSharedLibName platform compiler_id (l ++ f))
| l <- getHSLibraryName uid : extraBundledLibs (libBuildInfo lib)
, f <- "" : extraDynLibFlavours (libBuildInfo lib)
]
| otherwise -> do
sequence_
[ installShared
builtDir
dynlibTargetDir
( mkGenericSharedLibName
platform
compiler_id
(getHSLibraryName uid ++ f)
)
| f <- "" : extraDynLibFlavours (libBuildInfo lib)
]
sequence_
[ do
files <- listDirectory (i builtDir)
let l' =
mkGenericSharedBundledLibName
platform
compiler_id
(l ++ f)
forM_ files $ \file ->
when (l' `isPrefixOf` file) $ do
isFile <- doesFileExist (i $ builtDir </> makeRelativePathEx file)
when isFile $ do
installShared
builtDir
dynlibTargetDir
file
| l <- extraBundledLibs (libBuildInfo lib)
, f <- "" : extraDynLibFlavours (libBuildInfo lib)
]
where
-- See Note [Symbolic paths] in Distribution.Utils.Path
i = interpretSymbolicPathLBI lbi
builtDir = componentBuildDir lbi clbi
mbWorkDir = mbWorkDirLBI lbi
install isShared shouldStrip srcDir dstDir name = do
let src = i $ srcDir </> makeRelativePathEx name
dst = dstDir </> name
createDirectoryIfMissingVerbose verbosity True dstDir
if isShared
then installExecutableFile verbosity src dst
else installOrdinaryFile verbosity src dst
when (shouldStrip && stripLibs lbi) $
Strip.stripLib
verbosity
platform
(withPrograms lbi)
dst
installOrdinary = install False True
installOrdinaryNoStrip = install False False
installShared = install True True
copyModuleFiles ext = do
files <- findModuleFilesCwd verbosity mbWorkDir [builtDir] [ext] (allLibModules lib clbi)
let files' = map (i *** getSymbolicPath) files
installOrdinaryFiles verbosity targetDir files'
copyDirectoryIfExists :: RelativePath Build (Dir Artifacts) -> IO ()
copyDirectoryIfExists dirName = do
let src = i $ builtDir </> dirName
dst = targetDir </> getSymbolicPath dirName
dirExists <- doesDirectoryExist src
when dirExists $ copyDirectoryRecursive verbosity src dst
compiler_id = compilerId (compiler lbi)
platform = hostPlatform lbi
uid = componentUnitId clbi
profileLibName = mkProfLibName uid
bytecodeLibName = mkBytecodeLibName compiler_id uid
ghciLibName = Internal.mkGHCiLibName uid
ghciProfLibName = Internal.mkGHCiProfLibName uid
hasLib =
not $
null (allLibModules lib clbi)
&& null (cSources (libBuildInfo lib))
&& null (cxxSources (libBuildInfo lib))
&& null (cmmSources (libBuildInfo lib))
&& null (asmSources (libBuildInfo lib))
&& (null (jsSources (libBuildInfo lib)) || not hasJsSupport)
hasJsSupport = case hostPlatform lbi of
Platform JavaScript _ -> True
_ -> False
has_code = not (componentIsIndefinite clbi)
whenGHCi = when (hasLib && withGHCiLib lbi && has_code)
whenBytecodeLib = when (hasLib && withBytecodeLib lbi && has_code)
-- -----------------------------------------------------------------------------
-- Registering
hcPkgInfo :: ProgramDb -> HcPkg.ConfiguredProgram
hcPkgInfo progdb =
fromMaybe (error "GHC.hcPkgInfo: no ghc program") $ lookupProgram ghcPkgProgram progdb
registerPackage
:: Verbosity
-> ProgramDb
-> Maybe (SymbolicPath CWD (Dir from))
-> PackageDBStackS from
-> InstalledPackageInfo
-> HcPkg.RegisterOptions
-> IO ()
registerPackage verbosity progdb mbWorkDir packageDbs installedPkgInfo registerOptions =
HcPkg.register
(hcPkgInfo progdb)
verbosity
mbWorkDir
packageDbs
installedPkgInfo
registerOptions
pkgRoot :: Verbosity -> LocalBuildInfo -> PackageDB -> IO (SymbolicPath CWD (Dir Pkg))
pkgRoot verbosity lbi = fmap makeSymbolicPath . pkgRoot'
where
pkgRoot' GlobalPackageDB =
let ghcProg = fromMaybe (error "GHC.pkgRoot: no ghc program") $ lookupProgram ghcProgram (withPrograms lbi)
in fmap takeDirectory (getGlobalPackageDB verbosity ghcProg)
pkgRoot' UserPackageDB = do
appDir <- getGhcAppDir
let ver = compilerVersion (compiler lbi)
subdir =
System.Info.arch
++ '-'
: System.Info.os
++ '-'
: prettyShow ver
rootDir = appDir </> subdir
-- We must create the root directory for the user package database if it
-- does not yet exist. Otherwise '${pkgroot}' will resolve to a
-- directory at the time of 'ghc-pkg register', and registration will
-- fail.
createDirectoryIfMissing True rootDir
return rootDir
pkgRoot' (SpecificPackageDB fp) =
return $
takeDirectory $
interpretSymbolicPathLBI lbi fp