Cabal-1.20.0.0: Distribution/Simple/Program/GHC.hs
module Distribution.Simple.Program.GHC (
GhcOptions(..),
GhcMode(..),
GhcOptimisation(..),
GhcDynLinkMode(..),
ghcInvocation,
renderGhcOptions,
runGHC,
) where
import Distribution.Package
import Distribution.ModuleName
import Distribution.Simple.Compiler hiding (Flag)
import Distribution.Simple.Setup ( Flag(..), flagToMaybe, fromFlagOrDefault,
flagToList )
--import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Program.Types
import Distribution.Simple.Program.Run
import Distribution.Text
import Distribution.Verbosity
import Distribution.Version
import Language.Haskell.Extension ( Language(..), Extension(..) )
import Data.Monoid
-- | A structured set of GHC options/flags
--
data GhcOptions = GhcOptions {
-- | The major mode for the ghc invocation.
ghcOptMode :: Flag GhcMode,
-- | Any extra options to pass directly to ghc. These go at the end and hence
-- override other stuff.
ghcOptExtra :: [String],
-- | Extra default flags to pass directly to ghc. These go at the beginning
-- and so can be overridden by other stuff.
ghcOptExtraDefault :: [String],
-----------------------
-- Inputs and outputs
-- | The main input files; could be .hs, .hi, .c, .o, depending on mode.
ghcOptInputFiles :: [FilePath],
-- | The names of input Haskell modules, mainly for @--make@ mode.
ghcOptInputModules :: [ModuleName],
-- | Location for output file; the @ghc -o@ flag.
ghcOptOutputFile :: Flag FilePath,
-- | Location for dynamic output file in 'GhcStaticAndDynamic' mode;
-- the @ghc -dyno@ flag.
ghcOptOutputDynFile :: Flag FilePath,
-- | Start with an empty search path for Haskell source files;
-- the @ghc -i@ flag (@-i@ on it's own with no path argument).
ghcOptSourcePathClear :: Flag Bool,
-- | Search path for Haskell source files; the @ghc -i@ flag.
ghcOptSourcePath :: [FilePath],
-------------
-- Packages
-- | The package name the modules will belong to; the @ghc -package-name@ flag
ghcOptPackageName :: Flag PackageId,
-- | GHC package databases to use, the @ghc -package-conf@ flag
ghcOptPackageDBs :: PackageDBStack,
-- | The GHC packages to use. For compatability with old and new ghc, this
-- requires both the short and long form of the package id;
-- the @ghc -package@ or @ghc -package-id@ flags.
ghcOptPackages :: [(InstalledPackageId, PackageId)],
-- | Start with a clean package set; the @ghc -hide-all-packages@ flag
ghcOptHideAllPackages :: Flag Bool,
-- | Don't automatically link in Haskell98 etc; the @ghc -no-auto-link-packages@ flag.
ghcOptNoAutoLinkPackages :: Flag Bool,
-----------------
-- Linker stuff
-- | Names of libraries to link in; the @ghc -l@ flag.
ghcOptLinkLibs :: [FilePath],
-- | Search path for libraries to link in; the @ghc -L@ flag.
ghcOptLinkLibPath :: [FilePath],
-- | Options to pass through to the linker; the @ghc -optl@ flag.
ghcOptLinkOptions :: [String],
-- | OSX only: frameworks to link in; the @ghc -framework@ flag.
ghcOptLinkFrameworks :: [String],
-- | Don't do the link step, useful in make mode; the @ghc -no-link@ flag.
ghcOptNoLink :: Flag Bool,
-- | Don't link in the normal RTS @main@ entry point; the @ghc -no-hs-main@ flag.
ghcOptLinkNoHsMain :: Flag Bool,
--------------------
-- C and CPP stuff
-- | Options to pass through to the C compiler; the @ghc -optc@ flag.
ghcOptCcOptions :: [String],
-- | Options to pass through to CPP; the @ghc -optP@ flag.
ghcOptCppOptions :: [String],
-- | Search path for CPP includes like header files; the @ghc -I@ flag.
ghcOptCppIncludePath :: [FilePath],
-- | Extra header files to include at CPP stage; the @ghc -optP-include@ flag.
ghcOptCppIncludes :: [FilePath],
-- | Extra header files to include for old-style FFI; the @ghc -#include@ flag.
ghcOptFfiIncludes :: [FilePath],
----------------------------
-- Language and extensions
-- | The base language; the @ghc -XHaskell98@ or @-XHaskell2010@ flag.
ghcOptLanguage :: Flag Language,
-- | The language extensions; the @ghc -X@ flag.
ghcOptExtensions :: [Extension],
-- | A GHC version-dependent mapping of extensions to flags. This must be
-- set to be able to make use of the 'ghcOptExtensions'.
ghcOptExtensionMap :: [(Extension, String)],
----------------
-- Compilation
-- | What optimisation level to use; the @ghc -O@ flag.
ghcOptOptimisation :: Flag GhcOptimisation,
-- | Compile in profiling mode; the @ghc -prof@ flag.
ghcOptProfilingMode :: Flag Bool,
-- | Use the \"split object files\" feature; the @ghc -split-objs@ flag.
ghcOptSplitObjs :: Flag Bool,
-- | Run N jobs simultaneously (if possible).
ghcOptNumJobs :: Flag Int,
----------------
-- GHCi
-- | Extra GHCi startup scripts; the @-ghci-script@ flag
ghcOptGHCiScripts :: [FilePath],
------------------------
-- Redirecting outputs
ghcOptHiSuffix :: Flag String,
ghcOptObjSuffix :: Flag String,
ghcOptDynHiSuffix :: Flag String, -- ^ only in 'GhcStaticAndDynamic' mode
ghcOptDynObjSuffix :: Flag String, -- ^ only in 'GhcStaticAndDynamic' mode
ghcOptHiDir :: Flag FilePath,
ghcOptObjDir :: Flag FilePath,
ghcOptOutputDir :: Flag FilePath,
ghcOptStubDir :: Flag FilePath,
--------------------
-- Dynamic linking
ghcOptDynLinkMode :: Flag GhcDynLinkMode,
ghcOptShared :: Flag Bool,
ghcOptFPic :: Flag Bool,
ghcOptDylibName :: Flag String,
---------------
-- Misc flags
-- | Get GHC to be quiet or verbose with what it's doing; the @ghc -v@ flag.
ghcOptVerbosity :: Flag Verbosity,
-- | Let GHC know that it is Cabal that's calling it.
-- Modifies some of the GHC error messages.
ghcOptCabal :: Flag Bool
} deriving Show
data GhcMode = GhcModeCompile -- ^ @ghc -c@
| GhcModeLink -- ^ @ghc@
| GhcModeMake -- ^ @ghc --make@
| GhcModeInteractive -- ^ @ghci@ \/ @ghc --interactive@
| GhcModeAbiHash -- ^ @ghc --abi-hash@
-- | GhcModeDepAnalysis -- ^ @ghc -M@
-- | GhcModeEvaluate -- ^ @ghc -e@
deriving (Show, Eq)
data GhcOptimisation = GhcNoOptimisation -- ^ @-O0@
| GhcNormalOptimisation -- ^ @-O@
| GhcMaximumOptimisation -- ^ @-O2@
| GhcSpecialOptimisation String -- ^ e.g. @-Odph@
deriving (Show, Eq)
data GhcDynLinkMode = GhcStaticOnly -- ^ @-static@
| GhcDynamicOnly -- ^ @-dynamic@
| GhcStaticAndDynamic -- ^ @-static -dynamic-too@
deriving (Show, Eq)
runGHC :: Verbosity -> ConfiguredProgram -> Compiler -> GhcOptions -> IO ()
runGHC verbosity ghcProg comp opts = do
runProgramInvocation verbosity (ghcInvocation ghcProg comp opts)
ghcInvocation :: ConfiguredProgram -> Compiler -> GhcOptions -> ProgramInvocation
ghcInvocation prog comp opts =
programInvocation prog (renderGhcOptions comp opts)
renderGhcOptions :: Compiler -> GhcOptions -> [String]
renderGhcOptions comp opts
| compilerFlavor comp /= GHC =
error $ "Distribution.Simple.Program.GHC.renderGhcOptions: "
++ "compiler flavor must be 'GHC'!"
| otherwise =
concat
[ case flagToMaybe (ghcOptMode opts) of
Nothing -> []
Just GhcModeCompile -> ["-c"]
Just GhcModeLink -> []
Just GhcModeMake -> ["--make"]
Just GhcModeInteractive -> ["--interactive"]
Just GhcModeAbiHash -> ["--abi-hash"]
-- Just GhcModeDepAnalysis -> ["-M"]
-- Just GhcModeEvaluate -> ["-e", expr]
, flags ghcOptExtraDefault
, [ "-no-link" | flagBool ghcOptNoLink ]
---------------
-- Misc flags
, maybe [] verbosityOpts (flagToMaybe (ghcOptVerbosity opts))
, [ "-fbuilding-cabal-package" | flagBool ghcOptCabal, ver >= [6,11] ]
----------------
-- Compilation
, case flagToMaybe (ghcOptOptimisation opts) of
Nothing -> []
Just GhcNoOptimisation -> ["-O0"]
Just GhcNormalOptimisation -> ["-O"]
Just GhcMaximumOptimisation -> ["-O2"]
Just (GhcSpecialOptimisation s) -> ["-O" ++ s] -- eg -Odph
, [ "-prof" | flagBool ghcOptProfilingMode ]
, [ "-split-objs" | flagBool ghcOptSplitObjs ]
, if parmakeSupported comp
then
let numJobs = fromFlagOrDefault 1 (ghcOptNumJobs opts)
in if numJobs > 1 then ["-j" ++ show numJobs] else []
else []
--------------------
-- Dynamic linking
, [ "-shared" | flagBool ghcOptShared ]
, case flagToMaybe (ghcOptDynLinkMode opts) of
Nothing -> []
Just GhcStaticOnly -> ["-static"]
Just GhcDynamicOnly -> ["-dynamic"]
Just GhcStaticAndDynamic -> ["-static", "-dynamic-too"]
, [ "-fPIC" | flagBool ghcOptFPic ]
, concat [ ["-dylib-install-name", libname] | libname <- flag ghcOptDylibName ]
------------------------
-- Redirecting outputs
, concat [ ["-osuf", suf] | suf <- flag ghcOptObjSuffix ]
, concat [ ["-hisuf", suf] | suf <- flag ghcOptHiSuffix ]
, concat [ ["-dynosuf", suf] | suf <- flag ghcOptDynObjSuffix ]
, concat [ ["-dynhisuf",suf] | suf <- flag ghcOptDynHiSuffix ]
, concat [ ["-outputdir", dir] | dir <- flag ghcOptOutputDir, ver >= [6,10] ]
, concat [ ["-odir", dir] | dir <- flag ghcOptObjDir ]
, concat [ ["-hidir", dir] | dir <- flag ghcOptHiDir ]
, concat [ ["-stubdir", dir] | dir <- flag ghcOptStubDir, ver >= [6,8] ]
-----------------------
-- Source search path
, [ "-i" | flagBool ghcOptSourcePathClear ]
, [ "-i" ++ dir | dir <- flags ghcOptSourcePath ]
--------------------
-- C and CPP stuff
, [ "-I" ++ dir | dir <- flags ghcOptCppIncludePath ]
, [ "-optP" ++ opt | opt <- flags ghcOptCppOptions ]
, concat [ [ "-optP-include", "-optP" ++ inc] | inc <- flags ghcOptCppIncludes ]
, [ "-#include \"" ++ inc ++ "\"" | inc <- flags ghcOptFfiIncludes, ver < [6,11] ]
, [ "-optc" ++ opt | opt <- flags ghcOptCcOptions ]
-----------------
-- Linker stuff
, [ "-optl" ++ opt | opt <- flags ghcOptLinkOptions ]
, ["-l" ++ lib | lib <- flags ghcOptLinkLibs ]
, ["-L" ++ dir | dir <- flags ghcOptLinkLibPath ]
, concat [ ["-framework", fmwk] | fmwk <- flags ghcOptLinkFrameworks ]
, [ "-no-hs-main" | flagBool ghcOptLinkNoHsMain ]
-------------
-- Packages
, concat [ ["-package-name", display pkgid] | pkgid <- flag ghcOptPackageName ]
, [ "-hide-all-packages" | flagBool ghcOptHideAllPackages ]
, [ "-no-auto-link-packages" | flagBool ghcOptNoAutoLinkPackages ]
, packageDbArgs version (flags ghcOptPackageDBs)
, concat $ if ver >= [6,11]
then [ ["-package-id", display ipkgid] | (ipkgid,_) <- flags ghcOptPackages ]
else [ ["-package", display pkgid] | (_,pkgid) <- flags ghcOptPackages ]
----------------------------
-- Language and extensions
, if ver >= [7]
then [ "-X" ++ display lang | lang <- flag ghcOptLanguage ]
else []
, [ case lookup ext (ghcOptExtensionMap opts) of
Just arg -> arg
Nothing -> error $ "Distribution.Simple.Program.GHC.renderGhcOptions: "
++ display ext ++ " not present in ghcOptExtensionMap."
| ext <- ghcOptExtensions opts ]
----------------
-- GHCi
, concat [ [ "-ghci-script", script ] | script <- flags ghcOptGHCiScripts
, ver >= [7,2] ]
---------------
-- Inputs
, [ display modu | modu <- flags ghcOptInputModules ]
, ghcOptInputFiles opts
, concat [ [ "-o", out] | out <- flag ghcOptOutputFile ]
, concat [ [ "-dyno", out] | out <- flag ghcOptOutputDynFile ]
---------------
-- Extra
, ghcOptExtra opts
]
where
flag flg = flagToList (flg opts)
flags flg = flg opts
flagBool flg = fromFlagOrDefault False (flg opts)
version@(Version ver _) = compilerVersion comp
verbosityOpts :: Verbosity -> [String]
verbosityOpts verbosity
| verbosity >= deafening = ["-v"]
| verbosity >= normal = []
| otherwise = ["-w", "-v0"]
packageDbArgs :: Version -> PackageDBStack -> [String]
packageDbArgs (Version ver _) dbstack = case dbstack of
(GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs
(GlobalPackageDB:dbs) -> ("-no-user-" ++ packageDbFlag)
: concatMap specific dbs
_ -> ierror
where
specific (SpecificPackageDB db) = [ '-':packageDbFlag , db ]
specific _ = ierror
ierror = error $ "internal error: unexpected package db stack: "
++ show dbstack
packageDbFlag
| ver < [7,5]
= "package-conf"
| otherwise
= "package-db"
-- -----------------------------------------------------------------------------
-- Boilerplate Monoid instance for GhcOptions
instance Monoid GhcOptions where
mempty = GhcOptions {
ghcOptMode = mempty,
ghcOptExtra = mempty,
ghcOptExtraDefault = mempty,
ghcOptInputFiles = mempty,
ghcOptInputModules = mempty,
ghcOptOutputFile = mempty,
ghcOptOutputDynFile = mempty,
ghcOptSourcePathClear = mempty,
ghcOptSourcePath = mempty,
ghcOptPackageName = mempty,
ghcOptPackageDBs = mempty,
ghcOptPackages = mempty,
ghcOptHideAllPackages = mempty,
ghcOptNoAutoLinkPackages = mempty,
ghcOptLinkLibs = mempty,
ghcOptLinkLibPath = mempty,
ghcOptLinkOptions = mempty,
ghcOptLinkFrameworks = mempty,
ghcOptNoLink = mempty,
ghcOptLinkNoHsMain = mempty,
ghcOptCcOptions = mempty,
ghcOptCppOptions = mempty,
ghcOptCppIncludePath = mempty,
ghcOptCppIncludes = mempty,
ghcOptFfiIncludes = mempty,
ghcOptLanguage = mempty,
ghcOptExtensions = mempty,
ghcOptExtensionMap = mempty,
ghcOptOptimisation = mempty,
ghcOptProfilingMode = mempty,
ghcOptSplitObjs = mempty,
ghcOptNumJobs = mempty,
ghcOptGHCiScripts = mempty,
ghcOptHiSuffix = mempty,
ghcOptObjSuffix = mempty,
ghcOptDynHiSuffix = mempty,
ghcOptDynObjSuffix = mempty,
ghcOptHiDir = mempty,
ghcOptObjDir = mempty,
ghcOptOutputDir = mempty,
ghcOptStubDir = mempty,
ghcOptDynLinkMode = mempty,
ghcOptShared = mempty,
ghcOptFPic = mempty,
ghcOptDylibName = mempty,
ghcOptVerbosity = mempty,
ghcOptCabal = mempty
}
mappend a b = GhcOptions {
ghcOptMode = combine ghcOptMode,
ghcOptExtra = combine ghcOptExtra,
ghcOptExtraDefault = combine ghcOptExtraDefault,
ghcOptInputFiles = combine ghcOptInputFiles,
ghcOptInputModules = combine ghcOptInputModules,
ghcOptOutputFile = combine ghcOptOutputFile,
ghcOptOutputDynFile = combine ghcOptOutputDynFile,
ghcOptSourcePathClear = combine ghcOptSourcePathClear,
ghcOptSourcePath = combine ghcOptSourcePath,
ghcOptPackageName = combine ghcOptPackageName,
ghcOptPackageDBs = combine ghcOptPackageDBs,
ghcOptPackages = combine ghcOptPackages,
ghcOptHideAllPackages = combine ghcOptHideAllPackages,
ghcOptNoAutoLinkPackages = combine ghcOptNoAutoLinkPackages,
ghcOptLinkLibs = combine ghcOptLinkLibs,
ghcOptLinkLibPath = combine ghcOptLinkLibPath,
ghcOptLinkOptions = combine ghcOptLinkOptions,
ghcOptLinkFrameworks = combine ghcOptLinkFrameworks,
ghcOptNoLink = combine ghcOptNoLink,
ghcOptLinkNoHsMain = combine ghcOptLinkNoHsMain,
ghcOptCcOptions = combine ghcOptCcOptions,
ghcOptCppOptions = combine ghcOptCppOptions,
ghcOptCppIncludePath = combine ghcOptCppIncludePath,
ghcOptCppIncludes = combine ghcOptCppIncludes,
ghcOptFfiIncludes = combine ghcOptFfiIncludes,
ghcOptLanguage = combine ghcOptLanguage,
ghcOptExtensions = combine ghcOptExtensions,
ghcOptExtensionMap = combine ghcOptExtensionMap,
ghcOptOptimisation = combine ghcOptOptimisation,
ghcOptProfilingMode = combine ghcOptProfilingMode,
ghcOptSplitObjs = combine ghcOptSplitObjs,
ghcOptNumJobs = combine ghcOptNumJobs,
ghcOptGHCiScripts = combine ghcOptGHCiScripts,
ghcOptHiSuffix = combine ghcOptHiSuffix,
ghcOptObjSuffix = combine ghcOptObjSuffix,
ghcOptDynHiSuffix = combine ghcOptDynHiSuffix,
ghcOptDynObjSuffix = combine ghcOptDynObjSuffix,
ghcOptHiDir = combine ghcOptHiDir,
ghcOptObjDir = combine ghcOptObjDir,
ghcOptOutputDir = combine ghcOptOutputDir,
ghcOptStubDir = combine ghcOptStubDir,
ghcOptDynLinkMode = combine ghcOptDynLinkMode,
ghcOptShared = combine ghcOptShared,
ghcOptFPic = combine ghcOptFPic,
ghcOptDylibName = combine ghcOptDylibName,
ghcOptVerbosity = combine ghcOptVerbosity,
ghcOptCabal = combine ghcOptCabal
}
where
combine field = field a `mappend` field b