module Distribution.Simple.PreProcess (preprocessComponent, knownSuffixHandlers,
ppSuffixes, PPSuffixHandler, PreProcessor(..),
mkSimplePreProcessor, runSimplePreProcessor,
ppCpp, ppCpp', ppGreenCard, ppC2hs, ppHsc2hs,
ppHappy, ppAlex, ppUnlit
)
where
import Control.Monad
import Distribution.Simple.PreProcess.Unlit (unlit)
import Distribution.Package
( Package(..), PackageName(..) )
import qualified Distribution.ModuleName as ModuleName
import Distribution.PackageDescription as PD
( PackageDescription(..), BuildInfo(..)
, Executable(..)
, Library(..), libModules
, TestSuite(..), testModules
, TestSuiteInterface(..)
, Component(..) )
import qualified Distribution.InstalledPackageInfo as Installed
( InstalledPackageInfo_(..) )
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.Compiler
( CompilerFlavor(..), Compiler(..), compilerFlavor, compilerVersion )
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))
import Distribution.Simple.BuildPaths (autogenModulesDir,cppHeaderName)
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose, withUTF8FileContents, writeUTF8File
, die, setupMessage, intercalate, copyFileVerbose
, findFileWithExtension, findFileWithExtension' )
import Distribution.Simple.Program
( Program(..), ConfiguredProgram(..), programPath
, lookupProgram, requireProgram, requireProgramVersion
, rawSystemProgramConf, rawSystemProgram
, greencardProgram, cpphsProgram, hsc2hsProgram, c2hsProgram
, happyProgram, alexProgram, haddockProgram, ghcProgram, gccProgram )
import Distribution.Simple.Test ( writeSimpleTestStub, stubFilePath, stubName )
import Distribution.System
( OS(OSX, Windows), buildOS )
import Distribution.Text
import Distribution.Version
( Version(..), anyVersion, orLaterVersion )
import Distribution.Verbosity
import Data.Maybe (fromMaybe)
import Data.List (nub)
import System.Directory (getModificationTime, doesFileExist)
import System.Info (os, arch)
import System.FilePath (splitExtension, dropExtensions, (</>), (<.>),
takeDirectory, normalise, replaceExtension)
data runPreProcessor ::
(FilePath, FilePath) -> (FilePath, FilePath) -> Verbosity -> IO ()PreProcessor = PreProcessor {
platformIndependent :: Bool,
runPreProcessor :: (FilePath, FilePath)
-> (FilePath, FilePath)
-> Verbosity
-> IO ()
}
mkSimplePreProcessor :: (FilePath -> FilePath -> Verbosity -> IO ())
-> (FilePath, FilePath)
-> (FilePath, FilePath) -> Verbosity -> IO ()
mkSimplePreProcessor simplePP
(inBaseDir, inRelativeFile)
(outBaseDir, outRelativeFile) verbosity = simplePP :: FilePath -> FilePath -> Verbosity -> IO ()simplePP inFile :: FilePathinFile outFile :: FilePathoutFile verbosity :: Verbosityverbosity
where inFile = normalise :: FilePath -> FilePathnormalise (inBaseDir :: FilePathinBaseDir (</>) :: FilePath -> FilePath -> FilePath</> inRelativeFile :: FilePathinRelativeFile)
outFile = normalise :: FilePath -> FilePathnormalise (outBaseDir :: FilePathoutBaseDir (</>) :: FilePath -> FilePath -> FilePath</> outRelativeFile :: FilePathoutRelativeFile)
runSimplePreProcessor :: PreProcessor -> FilePath -> FilePath -> Verbosity
-> IO ()
runSimplePreProcessor pp inFile outFile verbosity =
runPreProcessor ::
PreProcessor
-> (FilePath, FilePath)
-> (FilePath, FilePath)
-> Verbosity
-> IO ()runPreProcessor pp :: PreProcessorpp (".", inFile :: FilePathinFile) (".", outFile :: FilePathoutFile) verbosity :: Verbosityverbosity
type PPSuffixHandler
= (String, BuildInfo -> LocalBuildInfo -> PreProcessor)
preprocessComponent :: PackageDescription
-> Component
-> LocalBuildInfo
-> Bool
-> Verbosity
-> [PPSuffixHandler]
-> IO ()
preprocessComponent pd comp lbi isSrcDist verbosity handlers = case comp :: Componentcomp of
(CLib lib@Library{ libBuildInfo = bi }) -> do
let dirs = hsSourceDirs :: BuildInfo -> [FilePath]hsSourceDirs bi :: BuildInfobi (++) :: [a] -> [a] -> [a]++ [autogenModulesDir :: LocalBuildInfo -> StringautogenModulesDir lbi :: LocalBuildInfolbi]
setupMessage :: Verbosity -> String -> PackageIdentifier -> IO ()setupMessage verbosity :: Verbosityverbosity "Preprocessing library" (packageId :: Package pkg => pkg -> PackageIdentifierpackageId pd :: PackageDescriptionpd)
forM_ :: Monad m => [a] -> (a -> m b) -> m ()forM_ (map :: (a -> b) -> [a] -> [b]map toFilePath :: ModuleName -> FilePathModuleName.toFilePath ($) :: (a -> b) -> a -> b$ libModules :: Library -> [ModuleName]libModules lib :: Librarylib) ($) :: (a -> b) -> a -> b$
pre ::
[FilePath]
-> FilePath
-> [(String, PreProcessor)]
-> FilePath
-> IO ()pre dirs :: [FilePath]dirs (buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi) (localHandlers :: BuildInfo -> [(String, PreProcessor)]localHandlers bi :: BuildInfobi)
(CExe exe@Executable { buildInfo = bi, exeName = nm }) -> do
let exeDir = buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi (</>) :: FilePath -> FilePath -> FilePath</> nm :: Stringnm (</>) :: FilePath -> FilePath -> FilePath</> nm :: Stringnm (++) :: [a] -> [a] -> [a]++ "-tmp"
dirs = hsSourceDirs :: BuildInfo -> [FilePath]hsSourceDirs bi :: BuildInfobi (++) :: [a] -> [a] -> [a]++ [autogenModulesDir :: LocalBuildInfo -> StringautogenModulesDir lbi :: LocalBuildInfolbi]
unless :: Monad m => Bool -> m () -> m ()unless (null :: [a] -> Boolnull (executables :: PackageDescription -> [Executable]executables pd :: PackageDescriptionpd)) ($) :: (a -> b) -> a -> b$
setupMessage :: Verbosity -> String -> PackageIdentifier -> IO ()setupMessage verbosity :: Verbosityverbosity ("Preprocessing executable '" (++) :: [a] -> [a] -> [a]++ nm :: Stringnm (++) :: [a] -> [a] -> [a]++ "' for") (packageId :: Package pkg => pkg -> PackageIdentifierpackageId pd :: PackageDescriptionpd)
forM_ :: Monad m => [a] -> (a -> m b) -> m ()forM_ (map :: (a -> b) -> [a] -> [b]map toFilePath :: ModuleName -> FilePathModuleName.toFilePath ($) :: (a -> b) -> a -> b$ otherModules :: BuildInfo -> [ModuleName]otherModules bi :: BuildInfobi) ($) :: (a -> b) -> a -> b$
pre ::
[FilePath]
-> FilePath
-> [(String, PreProcessor)]
-> FilePath
-> IO ()pre dirs :: [FilePath]dirs exeDir :: FilePathexeDir (localHandlers :: BuildInfo -> [(String, PreProcessor)]localHandlers bi :: BuildInfobi)
pre ::
[FilePath]
-> FilePath
-> [(String, PreProcessor)]
-> FilePath
-> IO ()pre (hsSourceDirs :: BuildInfo -> [FilePath]hsSourceDirs bi :: BuildInfobi) exeDir :: FilePathexeDir (localHandlers :: BuildInfo -> [(String, PreProcessor)]localHandlers bi :: BuildInfobi) ($) :: (a -> b) -> a -> b$
dropExtensions :: FilePath -> FilePathdropExtensions (modulePath :: Executable -> FilePathmodulePath exe :: Executableexe)
CTst test -> do
unless :: Monad m => Bool -> m () -> m ()unless (null :: [a] -> Boolnull (testSuites :: PackageDescription -> [TestSuite]testSuites pd :: PackageDescriptionpd)) ($) :: (a -> b) -> a -> b$
setupMessage :: Verbosity -> String -> PackageIdentifier -> IO ()setupMessage verbosity :: Verbosityverbosity "Preprocessing test suites for" (packageId :: Package pkg => pkg -> PackageIdentifierpackageId pd :: PackageDescriptionpd)
case testInterface :: TestSuite -> TestSuiteInterfacetestInterface test :: TestSuitetest of
TestSuiteExeV10 _ f ->
preProcessTest :: TestSuite -> FilePath -> FilePath -> IO ()preProcessTest test :: TestSuitetest f :: FilePathf ($) :: (a -> b) -> a -> b$ buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi (</>) :: FilePath -> FilePath -> FilePath</> testName :: TestSuite -> StringtestName test :: TestSuitetest
(</>) :: FilePath -> FilePath -> FilePath</> testName :: TestSuite -> StringtestName test :: TestSuitetest (++) :: [a] -> [a] -> [a]++ "-tmp"
TestSuiteLibV09 _ _ -> do
let testDir = buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi (</>) :: FilePath -> FilePath -> FilePath</> stubName :: TestSuite -> FilePathstubName test :: TestSuitetest
(</>) :: FilePath -> FilePath -> FilePath</> stubName :: TestSuite -> FilePathstubName test :: TestSuitetest (++) :: [a] -> [a] -> [a]++ "-tmp"
writeSimpleTestStub :: TestSuite -> FilePath -> IO ()writeSimpleTestStub test :: TestSuitetest testDir :: FilePathtestDir
preProcessTest :: TestSuite -> FilePath -> FilePath -> IO ()preProcessTest test :: TestSuitetest (stubFilePath :: TestSuite -> FilePathstubFilePath test :: TestSuitetest) testDir :: FilePathtestDir
TestSuiteUnsupported tt -> die :: String -> IO adie ($) :: (a -> b) -> a -> b$ "No support for preprocessing test "
(++) :: [a] -> [a] -> [a]++ "suite type " (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay tt :: TestTypett
where
builtinSuffixes
| NHC :: CompilerFlavorNHC (==) :: Eq a => a -> a -> Bool== compilerFlavor :: Compiler -> CompilerFlavorcompilerFlavor (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi) = ["hs", "lhs", "gc"]
| otherwise :: Boolotherwise = ["hs", "lhs"]
localHandlers bi = [(ext :: Stringext, h :: BuildInfo -> LocalBuildInfo -> PreProcessorh bi :: BuildInfobi lbi :: LocalBuildInfolbi) | (ext, h) <- handlers :: [PPSuffixHandler]handlers]
pre dirs dir lhndlrs fp =
preprocessFile ::
[FilePath]
-> FilePath
-> Bool
-> FilePath
-> Verbosity
-> [String]
-> [(String, PreProcessor)]
-> IO ()preprocessFile dirs :: [FilePath]dirs dir :: FilePathdir isSrcDist :: BoolisSrcDist fp :: FilePathfp verbosity :: Verbosityverbosity builtinSuffixes :: [[Char]]builtinSuffixes lhndlrs :: [(String, PreProcessor)]lhndlrs
preProcessTest test exePath testDir = do
let bi = testBuildInfo :: TestSuite -> BuildInfotestBuildInfo test :: TestSuitetest
biHandlers = localHandlers :: BuildInfo -> [(String, PreProcessor)]localHandlers bi :: BuildInfobi
sourceDirs = hsSourceDirs :: BuildInfo -> [FilePath]hsSourceDirs bi :: BuildInfobi (++) :: [a] -> [a] -> [a]++ [ autogenModulesDir :: LocalBuildInfo -> StringautogenModulesDir lbi :: LocalBuildInfolbi ]
sequence_ :: Monad m => [m a] -> m ()sequence_ [ preprocessFile ::
[FilePath]
-> FilePath
-> Bool
-> FilePath
-> Verbosity
-> [String]
-> [(String, PreProcessor)]
-> IO ()preprocessFile sourceDirs :: [FilePath]sourceDirs (buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi) isSrcDist :: BoolisSrcDist
(toFilePath :: ModuleName -> FilePathModuleName.toFilePath modu :: ModuleNamemodu) verbosity :: Verbosityverbosity builtinSuffixes :: [[Char]]builtinSuffixes
biHandlers :: [(String, PreProcessor)]biHandlers
| modu <- testModules :: TestSuite -> [ModuleName]testModules test :: TestSuitetest ]
preprocessFile ::
[FilePath]
-> FilePath
-> Bool
-> FilePath
-> Verbosity
-> [String]
-> [(String, PreProcessor)]
-> IO ()preprocessFile (testDir :: FilePathtestDir (:) :: a -> [a] -> [a]: (hsSourceDirs :: BuildInfo -> [FilePath]hsSourceDirs bi :: BuildInfobi)) testDir :: FilePathtestDir isSrcDist :: BoolisSrcDist
(dropExtensions :: FilePath -> FilePathdropExtensions ($) :: (a -> b) -> a -> b$ exePath :: FilePathexePath) verbosity :: Verbosityverbosity
builtinSuffixes :: [[Char]]builtinSuffixes biHandlers :: [(String, PreProcessor)]biHandlers
preprocessFile
:: [FilePath]
-> FilePath
-> Bool
-> FilePath
-> Verbosity
-> [String]
-> [(String, PreProcessor)]
-> IO ()
preprocessFile searchLoc buildLoc forSDist baseFile verbosity builtinSuffixes handlers = do
psrcFiles <- findFileWithExtension' ::
[String]
-> [FilePath]
-> FilePath
-> IO (Maybe (FilePath, FilePath))findFileWithExtension' (map :: (a -> b) -> [a] -> [b]map fst :: (a, b) -> afst handlers :: [PPSuffixHandler]handlers) searchLoc :: [FilePath]searchLoc baseFile :: FilePathbaseFile
case psrcFiles :: Maybe (FilePath, FilePath)psrcFiles of
Nothing -> do
bsrcFiles <- findFileWithExtension ::
[String] -> [FilePath] -> FilePath -> IO (Maybe FilePath)findFileWithExtension builtinSuffixes :: [[Char]]builtinSuffixes (buildLoc :: FilePathbuildLoc (:) :: a -> [a] -> [a]: searchLoc :: [FilePath]searchLoc) baseFile :: FilePathbaseFile
case bsrcFiles :: Maybe FilePathbsrcFiles of
Nothing -> die :: String -> IO adie ($) :: (a -> b) -> a -> b$ "can't find source for " (++) :: [a] -> [a] -> [a]++ baseFile :: FilePathbaseFile
(++) :: [a] -> [a] -> [a]++ " in " (++) :: [a] -> [a] -> [a]++ intercalate :: [a] -> [[a]] -> [a]intercalate ", " searchLoc :: [FilePath]searchLoc
_ -> return :: Monad m => forall a. a -> m areturn ()
Just (psrcLoc, psrcRelFile) -> do
let (srcStem, ext) = splitExtension :: FilePath -> (String, String)splitExtension psrcRelFile :: FilePathpsrcRelFile
psrcFile = psrcLoc :: FilePathpsrcLoc (</>) :: FilePath -> FilePath -> FilePath</> psrcRelFile :: FilePathpsrcRelFile
pp = fromMaybe :: a -> Maybe a -> afromMaybe (error :: [Char] -> aerror "Internal error in preProcess module: Just expected")
(lookup :: Eq a => a -> [(a, b)] -> Maybe blookup (tailNotNull :: [a] -> [a]tailNotNull ext :: Stringext) handlers :: [PPSuffixHandler]handlers)
when :: Monad m => Bool -> m () -> m ()when (not :: Bool -> Boolnot forSDist :: BoolforSDist (||) :: Bool -> Bool -> Bool|| forSDist :: BoolforSDist (&&) :: Bool -> Bool -> Bool&& platformIndependent :: PreProcessor -> BoolplatformIndependent pp :: PreProcessorpp) ($) :: (a -> b) -> a -> b$ do
ppsrcFiles <- findFileWithExtension ::
[String] -> [FilePath] -> FilePath -> IO (Maybe FilePath)findFileWithExtension builtinSuffixes :: [[Char]]builtinSuffixes [buildLoc :: FilePathbuildLoc] baseFile :: FilePathbaseFile
recomp <- case ppsrcFiles :: Maybe FilePathppsrcFiles of
Nothing -> return :: Monad m => forall a. a -> m areturn True :: BoolTrue
Just ppsrcFile -> do
btime <- getModificationTime :: FilePath -> IO ClockTimegetModificationTime ppsrcFile :: FilePathppsrcFile
ptime <- getModificationTime :: FilePath -> IO ClockTimegetModificationTime psrcFile :: FilePathpsrcFile
return :: Monad m => forall a. a -> m areturn (btime :: ClockTimebtime (<) :: Ord a => a -> a -> Bool< ptime :: ClockTimeptime)
when :: Monad m => Bool -> m () -> m ()when recomp :: Boolrecomp ($) :: (a -> b) -> a -> b$ do
let destDir = buildLoc :: FilePathbuildLoc (</>) :: FilePath -> FilePath -> FilePath</> dirName :: FilePath -> FilePathdirName srcStem :: StringsrcStem
createDirectoryIfMissingVerbose ::
Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue destDir :: FilePathdestDir
runPreProcessorWithHsBootHack ::
PreProcessor
-> (FilePath, FilePath)
-> (FilePath, FilePath)
-> IO ()runPreProcessorWithHsBootHack pp :: PreProcessorpp
(psrcLoc :: FilePathpsrcLoc, psrcRelFile :: FilePathpsrcRelFile)
(buildLoc :: FilePathbuildLoc, srcStem :: StringsrcStem (<.>) :: FilePath -> String -> FilePath<.> "hs")
where
dirName = takeDirectory :: FilePath -> FilePathtakeDirectory
tailNotNull [] = [] :: [a][]
tailNotNull x = tail :: [a] -> [a]tail x :: [a]x
runPreProcessorWithHsBootHack pp
(inBaseDir, inRelativeFile)
(outBaseDir, outRelativeFile) = do
runPreProcessor ::
PreProcessor
-> (FilePath, FilePath)
-> (FilePath, FilePath)
-> Verbosity
-> IO ()runPreProcessor pp :: PreProcessorpp
(inBaseDir :: FilePathinBaseDir, inRelativeFile :: FilePathinRelativeFile)
(outBaseDir :: FilePathoutBaseDir, outRelativeFile :: FilePathoutRelativeFile) verbosity :: Verbosityverbosity
exists <- doesFileExist :: FilePath -> IO BooldoesFileExist inBoot :: FilePathinBoot
when :: Monad m => Bool -> m () -> m ()when exists :: Boolexists ($) :: (a -> b) -> a -> b$ copyFileVerbose :: Verbosity -> FilePath -> FilePath -> IO ()copyFileVerbose verbosity :: Verbosityverbosity inBoot :: FilePathinBoot outBoot :: FilePathoutBoot
where
inBoot = replaceExtension :: FilePath -> String -> FilePathreplaceExtension inFile :: FilePathinFile "hs-boot"
outBoot = replaceExtension :: FilePath -> String -> FilePathreplaceExtension outFile :: FilePathoutFile "hs-boot"
inFile = normalise :: FilePath -> FilePathnormalise (inBaseDir :: FilePathinBaseDir (</>) :: FilePath -> FilePath -> FilePath</> inRelativeFile :: FilePathinRelativeFile)
outFile = normalise :: FilePath -> FilePathnormalise (outBaseDir :: FilePathoutBaseDir (</>) :: FilePath -> FilePath -> FilePath</> outRelativeFile :: FilePathoutRelativeFile)
ppGreenCard :: BuildInfo -> LocalBuildInfo -> PreProcessor
ppGreenCard _ lbi
= PreProcessor {
platformIndependent = False :: BoolFalse,
runPreProcessor = mkSimplePreProcessor ::
(FilePath -> FilePath -> Verbosity -> IO ())
-> (FilePath, FilePath)
-> (FilePath, FilePath)
-> Verbosity
-> IO ()mkSimplePreProcessor ($) :: (a -> b) -> a -> b$ \inFile outFile verbosity ->
rawSystemProgramConf ::
Verbosity -> Program -> ProgramConfiguration -> [ProgArg] -> IO ()rawSystemProgramConf verbosity :: Verbosityverbosity greencardProgram :: ProgramgreencardProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
(["-tffi", "-o" (++) :: [a] -> [a] -> [a]++ outFile :: FilePathoutFile, inFile :: FilePathinFile])
}
ppUnlit :: PreProcessor
ppUnlit =
PreProcessor {
platformIndependent = True :: BoolTrue,
runPreProcessor = mkSimplePreProcessor ::
(FilePath -> FilePath -> Verbosity -> IO ())
-> (FilePath, FilePath)
-> (FilePath, FilePath)
-> Verbosity
-> IO ()mkSimplePreProcessor ($) :: (a -> b) -> a -> b$ \inFile outFile _verbosity ->
withUTF8FileContents :: FilePath -> (String -> IO a) -> IO awithUTF8FileContents inFile :: FilePathinFile ($) :: (a -> b) -> a -> b$ \contents ->
either :: (a -> c) -> (b -> c) -> Either a b -> ceither (writeUTF8File :: FilePath -> String -> IO ()writeUTF8File outFile :: FilePathoutFile) die :: String -> IO adie (unlit :: FilePath -> String -> Either String Stringunlit inFile :: FilePathinFile contents :: Stringcontents)
}
ppCpp :: BuildInfo -> LocalBuildInfo -> PreProcessor
ppCpp = ppCpp' :: [String] -> BuildInfo -> LocalBuildInfo -> PreProcessorppCpp' [] :: [a][]
ppCpp' :: [String] -> BuildInfo -> LocalBuildInfo -> PreProcessor
ppCpp' extraArgs bi lbi =
case compilerFlavor :: Compiler -> CompilerFlavorcompilerFlavor (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi) of
GHC -> ppGhcCpp :: [String] -> BuildInfo -> LocalBuildInfo -> PreProcessorppGhcCpp (cppArgs :: [String]cppArgs (++) :: [a] -> [a] -> [a]++ extraArgs :: [String]extraArgs) bi :: BuildInfobi lbi :: LocalBuildInfolbi
_ -> ppCpphs :: [String] -> BuildInfo -> LocalBuildInfo -> PreProcessorppCpphs (cppArgs :: [String]cppArgs (++) :: [a] -> [a] -> [a]++ extraArgs :: [String]extraArgs) bi :: BuildInfobi lbi :: LocalBuildInfolbi
where cppArgs = getCppOptions :: BuildInfo -> LocalBuildInfo -> [String]getCppOptions bi :: BuildInfobi lbi :: LocalBuildInfolbi
ppGhcCpp :: [String] -> BuildInfo -> LocalBuildInfo -> PreProcessor
ppGhcCpp extraArgs _bi lbi =
PreProcessor {
platformIndependent = False :: BoolFalse,
runPreProcessor = mkSimplePreProcessor ::
(FilePath -> FilePath -> Verbosity -> IO ())
-> (FilePath, FilePath)
-> (FilePath, FilePath)
-> Verbosity
-> IO ()mkSimplePreProcessor ($) :: (a -> b) -> a -> b$ \inFile outFile verbosity -> do
(ghcProg, ghcVersion, _) <- requireProgramVersion ::
Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)requireProgramVersion verbosity :: Verbosityverbosity
ghcProgram :: ProgramghcProgram anyVersion :: VersionRangeanyVersion (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
rawSystemProgram ::
Verbosity -> ConfiguredProgram -> [ProgArg] -> IO ()rawSystemProgram verbosity :: Verbosityverbosity ghcProg :: ConfiguredProgramghcProg ($) :: (a -> b) -> a -> b$
["-E", "-cpp"]
(++) :: [a] -> [a] -> [a]++ (if ghcVersion :: VersionghcVersion (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [6,6] [] :: [a][] then ["-x", "hs"] else [] :: [a][])
(++) :: [a] -> [a] -> [a]++ (if use_optP_P :: LocalBuildInfo -> Booluse_optP_P lbi :: LocalBuildInfolbi then ["-optP-P"] else [] :: [a][])
(++) :: [a] -> [a] -> [a]++ [ "-optP-include", "-optP"(++) :: [a] -> [a] -> [a]++ (autogenModulesDir :: LocalBuildInfo -> StringautogenModulesDir lbi :: LocalBuildInfolbi (</>) :: FilePath -> FilePath -> FilePath</> cppHeaderName :: StringcppHeaderName) ]
(++) :: [a] -> [a] -> [a]++ ["-o", outFile :: FilePathoutFile, inFile :: FilePathinFile]
(++) :: [a] -> [a] -> [a]++ extraArgs :: [String]extraArgs
}
ppCpphs :: [String] -> BuildInfo -> LocalBuildInfo -> PreProcessor
ppCpphs extraArgs _bi lbi =
PreProcessor {
platformIndependent = False :: BoolFalse,
runPreProcessor = mkSimplePreProcessor ::
(FilePath -> FilePath -> Verbosity -> IO ())
-> (FilePath, FilePath)
-> (FilePath, FilePath)
-> Verbosity
-> IO ()mkSimplePreProcessor ($) :: (a -> b) -> a -> b$ \inFile outFile verbosity -> do
(cpphsProg, cpphsVersion, _) <- requireProgramVersion ::
Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)requireProgramVersion verbosity :: Verbosityverbosity
cpphsProgram :: ProgramcpphsProgram anyVersion :: VersionRangeanyVersion (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
rawSystemProgram ::
Verbosity -> ConfiguredProgram -> [ProgArg] -> IO ()rawSystemProgram verbosity :: Verbosityverbosity cpphsProg :: ConfiguredProgramcpphsProg ($) :: (a -> b) -> a -> b$
("-O" (++) :: [a] -> [a] -> [a]++ outFile :: FilePathoutFile) (:) :: a -> [a] -> [a]: inFile :: FilePathinFile
(:) :: a -> [a] -> [a]: "--noline" (:) :: a -> [a] -> [a]: "--strip"
(:) :: a -> [a] -> [a]: (if cpphsVersion :: VersioncpphsVersion (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [1,6] [] :: [a][]
then ["--include="(++) :: [a] -> [a] -> [a]++ (autogenModulesDir :: LocalBuildInfo -> StringautogenModulesDir lbi :: LocalBuildInfolbi (</>) :: FilePath -> FilePath -> FilePath</> cppHeaderName :: StringcppHeaderName)]
else [] :: [a][])
(++) :: [a] -> [a] -> [a]++ extraArgs :: [String]extraArgs
}
use_optP_P :: LocalBuildInfo -> Bool
use_optP_P lbi
= case lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgramlookupProgram haddockProgram :: ProgramhaddockProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi) of
Just (ConfiguredProgram { programVersion = Just version })
| version :: Versionversion (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [0,8] [] :: [a][] -> False :: BoolFalse
_ -> True :: BoolTrue
ppHsc2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor
ppHsc2hs bi lbi =
PreProcessor {
platformIndependent = False :: BoolFalse,
runPreProcessor = mkSimplePreProcessor ::
(FilePath -> FilePath -> Verbosity -> IO ())
-> (FilePath, FilePath)
-> (FilePath, FilePath)
-> Verbosity
-> IO ()mkSimplePreProcessor ($) :: (a -> b) -> a -> b$ \inFile outFile verbosity -> do
(gccProg, _) <- requireProgram ::
Verbosity
-> Program
-> ProgramDb
-> IO (ConfiguredProgram, ProgramDb)requireProgram verbosity :: Verbosityverbosity gccProgram :: ProgramgccProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
rawSystemProgramConf ::
Verbosity -> Program -> ProgramConfiguration -> [ProgArg] -> IO ()rawSystemProgramConf verbosity :: Verbosityverbosity hsc2hsProgram :: Programhsc2hsProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi) ($) :: (a -> b) -> a -> b$
[ "--cc=" (++) :: [a] -> [a] -> [a]++ programPath :: ConfiguredProgram -> FilePathprogramPath gccProg :: ConfiguredProgramgccProg
, "--ld=" (++) :: [a] -> [a] -> [a]++ programPath :: ConfiguredProgram -> FilePathprogramPath gccProg :: ConfiguredProgramgccProg ]
(++) :: [a] -> [a] -> [a]++ [ "--cflag=" (++) :: [a] -> [a] -> [a]++ opt :: [Char]opt | opt <- programDefaultArgs :: ConfiguredProgram -> [String]programDefaultArgs gccProg :: ConfiguredProgramgccProg
(++) :: [a] -> [a] -> [a]++ programOverrideArgs :: ConfiguredProgram -> [String]programOverrideArgs gccProg :: ConfiguredProgramgccProg ]
(++) :: [a] -> [a] -> [a]++ [ "--lflag=" (++) :: [a] -> [a] -> [a]++ opt :: [Char]opt | opt <- programDefaultArgs :: ConfiguredProgram -> [String]programDefaultArgs gccProg :: ConfiguredProgramgccProg
(++) :: [a] -> [a] -> [a]++ programOverrideArgs :: ConfiguredProgram -> [String]programOverrideArgs gccProg :: ConfiguredProgramgccProg ]
(++) :: [a] -> [a] -> [a]++ [ what :: [Char]what (++) :: [a] -> [a] -> [a]++ "=-F" (++) :: [a] -> [a] -> [a]++ opt :: [Char]opt
| isOSX :: BoolisOSX
, opt <- nub :: Eq a => [a] -> [a]nub (concatMap :: (a -> [b]) -> [a] -> [b]concatMap frameworkDirs :: InstalledPackageInfo_ m -> [FilePath]Installed.frameworkDirs pkgs :: [InstalledPackageInfo]pkgs)
, what <- ["--cflag", "--lflag"] ]
(++) :: [a] -> [a] -> [a]++ [ "--lflag=" (++) :: [a] -> [a] -> [a]++ arg :: [Char]arg
| isOSX :: BoolisOSX
, opt <- frameworks :: BuildInfo -> [String]PD.frameworks bi :: BuildInfobi (++) :: [a] -> [a] -> [a]++ concatMap :: (a -> [b]) -> [a] -> [b]concatMap frameworks :: InstalledPackageInfo_ m -> [String]Installed.frameworks pkgs :: [InstalledPackageInfo]pkgs
, arg <- ["-framework", opt :: [Char]opt] ]
(++) :: [a] -> [a] -> [a]++ [ "--cflag=" (++) :: [a] -> [a] -> [a]++ opt :: [Char]opt | opt <- hcDefines :: Compiler -> [String]hcDefines (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi) ]
(++) :: [a] -> [a] -> [a]++ [ "--cflag=" (++) :: [a] -> [a] -> [a]++ opt :: [Char]opt | opt <- sysDefines :: [String]sysDefines ]
(++) :: [a] -> [a] -> [a]++ [ "--cflag=-I" (++) :: [a] -> [a] -> [a]++ dir :: FilePathdir | dir <- includeDirs :: BuildInfo -> [FilePath]PD.includeDirs bi :: BuildInfobi ]
(++) :: [a] -> [a] -> [a]++ [ "--cflag=" (++) :: [a] -> [a] -> [a]++ opt :: [Char]opt | opt <- ccOptions :: BuildInfo -> [String]PD.ccOptions bi :: BuildInfobi
(++) :: [a] -> [a] -> [a]++ cppOptions :: BuildInfo -> [String]PD.cppOptions bi :: BuildInfobi ]
(++) :: [a] -> [a] -> [a]++ [ "--lflag=-L" (++) :: [a] -> [a] -> [a]++ opt :: [Char]opt | opt <- extraLibDirs :: BuildInfo -> [String]PD.extraLibDirs bi :: BuildInfobi ]
(++) :: [a] -> [a] -> [a]++ [ "--lflag=-Wl,-R," (++) :: [a] -> [a] -> [a]++ opt :: [Char]opt | isELF :: BoolisELF
, opt <- extraLibDirs :: BuildInfo -> [String]PD.extraLibDirs bi :: BuildInfobi ]
(++) :: [a] -> [a] -> [a]++ [ "--lflag=-l" (++) :: [a] -> [a] -> [a]++ opt :: [Char]opt | opt <- extraLibs :: BuildInfo -> [String]PD.extraLibs bi :: BuildInfobi ]
(++) :: [a] -> [a] -> [a]++ [ "--lflag=" (++) :: [a] -> [a] -> [a]++ opt :: [Char]opt | opt <- ldOptions :: BuildInfo -> [String]PD.ldOptions bi :: BuildInfobi ]
(++) :: [a] -> [a] -> [a]++ [ "--cflag=" (++) :: [a] -> [a] -> [a]++ opt :: [Char]opt
| pkg <- pkgs :: [InstalledPackageInfo]pkgs
, opt <- [ "-I" (++) :: [a] -> [a] -> [a]++ opt :: [Char]opt | opt <- includeDirs :: InstalledPackageInfo_ m -> [FilePath]Installed.includeDirs pkg :: InstalledPackageInfopkg ]
(++) :: [a] -> [a] -> [a]++ [ opt :: [Char]opt | opt <- ccOptions :: InstalledPackageInfo_ m -> [String]Installed.ccOptions pkg :: InstalledPackageInfopkg ]
(++) :: [a] -> [a] -> [a]++ [ "-I" (++) :: [a] -> [a] -> [a]++ autogenModulesDir :: LocalBuildInfo -> StringautogenModulesDir lbi :: LocalBuildInfolbi,
"-include", autogenModulesDir :: LocalBuildInfo -> StringautogenModulesDir lbi :: LocalBuildInfolbi (</>) :: FilePath -> FilePath -> FilePath</> cppHeaderName :: StringcppHeaderName ] ]
(++) :: [a] -> [a] -> [a]++ [ "--lflag=" (++) :: [a] -> [a] -> [a]++ opt :: [Char]opt
| pkg <- pkgs :: [InstalledPackageInfo]pkgs
, opt <- [ "-L" (++) :: [a] -> [a] -> [a]++ opt :: [Char]opt | opt <- libraryDirs :: InstalledPackageInfo_ m -> [FilePath]Installed.libraryDirs pkg :: InstalledPackageInfopkg ]
(++) :: [a] -> [a] -> [a]++ [ "-Wl,-R," (++) :: [a] -> [a] -> [a]++ opt :: [Char]opt | isELF :: BoolisELF
, opt <- libraryDirs :: InstalledPackageInfo_ m -> [FilePath]Installed.libraryDirs pkg :: InstalledPackageInfopkg ]
(++) :: [a] -> [a] -> [a]++ [ "-l" (++) :: [a] -> [a] -> [a]++ opt :: [Char]opt | opt <- extraLibraries :: InstalledPackageInfo_ m -> [String]Installed.extraLibraries pkg :: InstalledPackageInfopkg ]
(++) :: [a] -> [a] -> [a]++ [ opt :: [Char]opt | opt <- ldOptions :: InstalledPackageInfo_ m -> [String]Installed.ldOptions pkg :: InstalledPackageInfopkg ] ]
(++) :: [a] -> [a] -> [a]++ ["-o", outFile :: FilePathoutFile, inFile :: FilePathinFile]
}
where
pkgs = topologicalOrder :: PackageIndex -> [InstalledPackageInfo]PackageIndex.topologicalOrder (packageHacks :: PackageIndex -> PackageIndexpackageHacks (installedPkgs :: LocalBuildInfo -> PackageIndexinstalledPkgs lbi :: LocalBuildInfolbi))
isOSX = case buildOS :: OSbuildOS of OSX -> True :: BoolTrue; _ -> False :: BoolFalse
isELF = case buildOS :: OSbuildOS of OSX -> False :: BoolFalse; Windows -> False :: BoolFalse; _ -> True :: BoolTrue;
packageHacks = case compilerFlavor :: Compiler -> CompilerFlavorcompilerFlavor (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi) of
GHC -> hackRtsPackage :: PackageIndex -> PackageIndexhackRtsPackage
_ -> id :: a -> aid
hackRtsPackage index =
case lookupPackageName ::
PackageIndex -> PackageName -> [(Version, [InstalledPackageInfo])]PackageIndex.lookupPackageName index :: PackageIndexindex (PackageName :: String -> PackageNamePackageName "rts") of
[(_, [rts])]
-> insert :: InstalledPackageInfo -> PackageIndex -> PackageIndexPackageIndex.insert rts :: InstalledPackageInforts { Installed.ldOptions = [] :: [a][] } index :: PackageIndexindex
_ -> error :: [Char] -> aerror "No (or multiple) ghc rts package is registered!!"
ppC2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor
ppC2hs bi lbi =
PreProcessor {
platformIndependent = False :: BoolFalse,
runPreProcessor = \(inBaseDir, inRelativeFile)
(outBaseDir, outRelativeFile) verbosity -> do
(c2hsProg, _, _) <- requireProgramVersion ::
Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)requireProgramVersion verbosity :: Verbosityverbosity
c2hsProgram :: Programc2hsProgram (orLaterVersion :: Version -> VersionRangeorLaterVersion (Version :: [Int] -> [String] -> VersionVersion [0,15] [] :: [a][]))
(withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
(gccProg, _) <- requireProgram ::
Verbosity
-> Program
-> ProgramDb
-> IO (ConfiguredProgram, ProgramDb)requireProgram verbosity :: Verbosityverbosity gccProgram :: ProgramgccProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
rawSystemProgram ::
Verbosity -> ConfiguredProgram -> [ProgArg] -> IO ()rawSystemProgram verbosity :: Verbosityverbosity c2hsProg :: ConfiguredProgramc2hsProg ($) :: (a -> b) -> a -> b$
[ "--cpp=" (++) :: [a] -> [a] -> [a]++ programPath :: ConfiguredProgram -> FilePathprogramPath gccProg :: ConfiguredProgramgccProg, "--cppopts=-E" ]
(++) :: [a] -> [a] -> [a]++ [ "--cppopts=" (++) :: [a] -> [a] -> [a]++ opt :: [Char]opt | opt <- getCppOptions :: BuildInfo -> LocalBuildInfo -> [String]getCppOptions bi :: BuildInfobi lbi :: LocalBuildInfolbi ]
(++) :: [a] -> [a] -> [a]++ [ "--include=" (++) :: [a] -> [a] -> [a]++ outBaseDir :: FilePathoutBaseDir ]
(++) :: [a] -> [a] -> [a]++ [ "--cppopts=" (++) :: [a] -> [a] -> [a]++ opt :: [Char]opt
| pkg <- pkgs :: [InstalledPackageInfo]pkgs
, opt <- [ "-I" (++) :: [a] -> [a] -> [a]++ opt :: [Char]opt | opt <- includeDirs :: InstalledPackageInfo_ m -> [FilePath]Installed.includeDirs pkg :: InstalledPackageInfopkg ]
(++) :: [a] -> [a] -> [a]++ [ opt :: [Char]opt | opt@('-':c:_) <- ccOptions :: InstalledPackageInfo_ m -> [String]Installed.ccOptions pkg :: InstalledPackageInfopkg
, c :: Charc elem :: Eq a => a -> [a] -> Bool`elem` "DIU" ] ]
(++) :: [a] -> [a] -> [a]++ [ "--output-dir=" (++) :: [a] -> [a] -> [a]++ outBaseDir :: FilePathoutBaseDir
, "--output=" (++) :: [a] -> [a] -> [a]++ outRelativeFile :: FilePathoutRelativeFile
, inBaseDir :: FilePathinBaseDir (</>) :: FilePath -> FilePath -> FilePath</> inRelativeFile :: FilePathinRelativeFile ]
}
where
pkgs = topologicalOrder :: PackageIndex -> [InstalledPackageInfo]PackageIndex.topologicalOrder (installedPkgs :: LocalBuildInfo -> PackageIndexinstalledPkgs lbi :: LocalBuildInfolbi)
getCppOptions :: BuildInfo -> LocalBuildInfo -> [String]
getCppOptions bi lbi
= hcDefines :: Compiler -> [String]hcDefines (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi)
(++) :: [a] -> [a] -> [a]++ sysDefines :: [String]sysDefines
(++) :: [a] -> [a] -> [a]++ cppOptions :: BuildInfo -> [String]cppOptions bi :: BuildInfobi
(++) :: [a] -> [a] -> [a]++ ["-I" (++) :: [a] -> [a] -> [a]++ dir :: FilePathdir | dir <- includeDirs :: BuildInfo -> [FilePath]PD.includeDirs bi :: BuildInfobi]
(++) :: [a] -> [a] -> [a]++ [opt :: [Char]opt | opt@('-':c:_) <- ccOptions :: BuildInfo -> [String]PD.ccOptions bi :: BuildInfobi, c :: Charc elem :: Eq a => a -> [a] -> Bool`elem` "DIU"]
sysDefines :: [String]
sysDefines = ["-D" (++) :: [a] -> [a] -> [a]++ os :: Stringos (++) :: [a] -> [a] -> [a]++ "_" (++) :: [a] -> [a] -> [a]++ loc :: [Char]loc (++) :: [a] -> [a] -> [a]++ "_OS" | loc <- locations :: [[Char]]locations]
(++) :: [a] -> [a] -> [a]++ ["-D" (++) :: [a] -> [a] -> [a]++ arch :: Stringarch (++) :: [a] -> [a] -> [a]++ "_" (++) :: [a] -> [a] -> [a]++ loc :: [Char]loc (++) :: [a] -> [a] -> [a]++ "_ARCH" | loc <- locations :: [[Char]]locations]
where
locations = ["BUILD", "HOST"]
hcDefines :: Compiler -> [String]
hcDefines comp =
case compilerFlavor :: Compiler -> CompilerFlavorcompilerFlavor comp :: Componentcomp of
GHC -> ["-D__GLASGOW_HASKELL__=" (++) :: [a] -> [a] -> [a]++ versionInt :: Version -> StringversionInt version :: Versionversion]
JHC -> ["-D__JHC__=" (++) :: [a] -> [a] -> [a]++ versionInt :: Version -> StringversionInt version :: Versionversion]
NHC -> ["-D__NHC__=" (++) :: [a] -> [a] -> [a]++ versionInt :: Version -> StringversionInt version :: Versionversion]
Hugs -> ["-D__HUGS__"]
_ -> [] :: [a][]
where version = compilerVersion :: Compiler -> VersioncompilerVersion comp :: Componentcomp
versionInt :: Version -> String
versionInt (Version { versionBranch = [] }) = "1"
versionInt (Version { versionBranch = [n] }) = show :: Show a => a -> Stringshow n :: Intn
versionInt (Version { versionBranch = n1:n2:_ })
=
let s1 = show :: Show a => a -> Stringshow n1 :: Intn1
s2 = show :: Show a => a -> Stringshow n2 :: Intn2
middle = case s2 :: Strings2 of
_ : _ : _ -> ""
_ -> "0"
in s1 :: Strings1 (++) :: [a] -> [a] -> [a]++ middle :: [Char]middle (++) :: [a] -> [a] -> [a]++ s2 :: Strings2
ppHappy :: BuildInfo -> LocalBuildInfo -> PreProcessor
ppHappy _ lbi = pp :: PreProcessorpp { platformIndependent = True :: BoolTrue }
where pp = standardPP :: LocalBuildInfo -> Program -> [String] -> PreProcessorstandardPP lbi :: LocalBuildInfolbi happyProgram :: ProgramhappyProgram (hcFlags :: CompilerFlavor -> [[Char]]hcFlags hc :: CompilerFlavorhc)
hc = compilerFlavor :: Compiler -> CompilerFlavorcompilerFlavor (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi)
hcFlags GHC = ["-agc"]
hcFlags _ = [] :: [a][]
ppAlex :: BuildInfo -> LocalBuildInfo -> PreProcessor
ppAlex _ lbi = pp :: PreProcessorpp { platformIndependent = True :: BoolTrue }
where pp = standardPP :: LocalBuildInfo -> Program -> [String] -> PreProcessorstandardPP lbi :: LocalBuildInfolbi alexProgram :: ProgramalexProgram (hcFlags :: CompilerFlavor -> [[Char]]hcFlags hc :: CompilerFlavorhc)
hc = compilerFlavor :: Compiler -> CompilerFlavorcompilerFlavor (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi)
hcFlags GHC = ["-g"]
hcFlags _ = [] :: [a][]
standardPP :: LocalBuildInfo -> Program -> [String] -> PreProcessor
standardPP lbi prog args =
PreProcessor {
platformIndependent = False :: BoolFalse,
runPreProcessor = mkSimplePreProcessor ::
(FilePath -> FilePath -> Verbosity -> IO ())
-> (FilePath, FilePath)
-> (FilePath, FilePath)
-> Verbosity
-> IO ()mkSimplePreProcessor ($) :: (a -> b) -> a -> b$ \inFile outFile verbosity ->
rawSystemProgramConf ::
Verbosity -> Program -> ProgramConfiguration -> [ProgArg] -> IO ()rawSystemProgramConf verbosity :: Verbosityverbosity prog :: Programprog (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
(args :: [String]args (++) :: [a] -> [a] -> [a]++ ["-o", outFile :: FilePathoutFile, inFile :: FilePathinFile])
}
ppSuffixes :: [ PPSuffixHandler ] -> [String]
ppSuffixes = map :: (a -> b) -> [a] -> [b]map fst :: (a, b) -> afst
knownSuffixHandlers :: [ PPSuffixHandler ]
knownSuffixHandlers =
[ ("gc", ppGreenCard :: BuildInfo -> LocalBuildInfo -> PreProcessorppGreenCard)
, ("chs", ppC2hs :: BuildInfo -> LocalBuildInfo -> PreProcessorppC2hs)
, ("hsc", ppHsc2hs :: BuildInfo -> LocalBuildInfo -> PreProcessorppHsc2hs)
, ("x", ppAlex :: BuildInfo -> LocalBuildInfo -> PreProcessorppAlex)
, ("y", ppHappy :: BuildInfo -> LocalBuildInfo -> PreProcessorppHappy)
, ("ly", ppHappy :: BuildInfo -> LocalBuildInfo -> PreProcessorppHappy)
, ("cpphs", ppCpp :: BuildInfo -> LocalBuildInfo -> PreProcessorppCpp)
]