module Distribution.Simple.Program.GHC ( GhcOptions(..), GhcMode(..), GhcOptimisation(..), 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, -- | 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, -------------------- -- 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, ---------------- -- GHCi -- | Extra GHCi startup scripts; the @-ghci-script@ flag ghcOptGHCiScripts :: [FilePath], ------------------------ -- Redirecting outputs ghcOptHiSuffix :: Flag String, ghcOptObjSuffix :: Flag String, ghcOptHiDir :: Flag FilePath, ghcOptObjDir :: Flag FilePath, ghcOptStubDir :: Flag FilePath, -------------------- -- Dynamic linking ghcOptDynamic :: Flag Bool, 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) runGHC :: Verbosity -> ConfiguredProgram -> GhcOptions -> IO () runGHC verbosity ghcProg opts = do runProgramInvocation verbosity (ghcInvocation ghcProg opts) ghcInvocation :: ConfiguredProgram -> GhcOptions -> ProgramInvocation ghcInvocation ConfiguredProgram { programVersion = Nothing } _ = error "ghcInvocation: the programVersion must not be Nothing" ghcInvocation prog@ConfiguredProgram { programVersion = Just ver } opts = programInvocation prog (renderGhcOptions ver opts) renderGhcOptions :: Version -> GhcOptions -> [String] renderGhcOptions version@(Version ver _) opts = 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 ] -------------------- -- Dynamic linking , [ "-shared" | flagBool ghcOptShared ] , [ "-dynamic" | flagBool ghcOptDynamic ] , [ "-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 [ ["-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 ] ------------- -- 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 $ "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 ] --------------- -- Extra , ghcOptExtra opts ] where flag flg = flagToList (flg opts) flags flg = flg opts flagBool flg = fromFlagOrDefault False (flg opts) 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, ghcOptSourcePathClear = mempty, ghcOptSourcePath = mempty, ghcOptPackageName = mempty, ghcOptPackageDBs = mempty, ghcOptPackages = mempty, ghcOptHideAllPackages = mempty, ghcOptNoAutoLinkPackages = mempty, ghcOptLinkLibs = mempty, ghcOptLinkLibPath = mempty, ghcOptLinkOptions = mempty, ghcOptLinkFrameworks = mempty, ghcOptNoLink = mempty, ghcOptCcOptions = mempty, ghcOptCppOptions = mempty, ghcOptCppIncludePath = mempty, ghcOptCppIncludes = mempty, ghcOptFfiIncludes = mempty, ghcOptLanguage = mempty, ghcOptExtensions = mempty, ghcOptExtensionMap = mempty, ghcOptOptimisation = mempty, ghcOptProfilingMode = mempty, ghcOptSplitObjs = mempty, ghcOptGHCiScripts = mempty, ghcOptHiSuffix = mempty, ghcOptObjSuffix = mempty, ghcOptHiDir = mempty, ghcOptObjDir = mempty, ghcOptStubDir = mempty, ghcOptDynamic = 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, 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, 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, ghcOptGHCiScripts = combine ghcOptGHCiScripts, ghcOptHiSuffix = combine ghcOptHiSuffix, ghcOptObjSuffix = combine ghcOptObjSuffix, ghcOptHiDir = combine ghcOptHiDir, ghcOptObjDir = combine ghcOptObjDir, ghcOptStubDir = combine ghcOptStubDir, ghcOptDynamic = combine ghcOptDynamic, ghcOptShared = combine ghcOptShared, ghcOptFPic = combine ghcOptFPic, ghcOptDylibName = combine ghcOptDylibName, ghcOptVerbosity = combine ghcOptVerbosity, ghcOptCabal = combine ghcOptCabal } where combine field = field a `mappend` field b