{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Distribution.Simple.PreProcess (preprocessComponent, preprocessExtras,
knownSuffixHandlers, ppSuffixes,
PPSuffixHandler, PreProcessor(..),
mkSimplePreProcessor, runSimplePreProcessor,
ppCpp, ppCpp', ppGreenCard, ppC2hs, ppHsc2hs,
ppHappy, ppAlex, ppUnlit, platformDefines
)
where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Compat.Stack
import Distribution.Simple.PreProcess.Unlit
import Distribution.Backpack.DescribeUnitId
import Distribution.Package
import qualified Distribution.ModuleName as ModuleName
import Distribution.ModuleName (ModuleName)
import Distribution.PackageDescription as PD
import qualified Distribution.InstalledPackageInfo as Installed
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.CCompiler
import Distribution.Simple.Compiler
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.BuildPaths
import Distribution.Simple.Utils
import Distribution.Simple.Program
import Distribution.Simple.Program.ResponseFile
import Distribution.Simple.Test.LibV09
import Distribution.System
import Distribution.Pretty
import Distribution.Version
import Distribution.Verbosity
import Distribution.Utils.Path
import System.Directory (doesFileExist)
import System.Info (os, arch)
import System.FilePath (splitExtension, dropExtensions, (</>), (<.>),
takeDirectory, normalise, replaceExtension,
takeExtensions)
data PreProcessor = PreProcessor {
PreProcessor -> Bool
platformIndependent :: Bool,
PreProcessor
-> (String, String) -> (String, String) -> Verbosity -> IO ()
runPreProcessor :: (FilePath, FilePath)
-> (FilePath, FilePath)
-> Verbosity
-> IO ()
}
type = FilePath -> IO [FilePath]
mkSimplePreProcessor :: (FilePath -> FilePath -> Verbosity -> IO ())
-> (FilePath, FilePath)
-> (FilePath, FilePath) -> Verbosity -> IO ()
mkSimplePreProcessor :: (String -> String -> Verbosity -> IO ())
-> (String, String) -> (String, String) -> Verbosity -> IO ()
mkSimplePreProcessor String -> String -> Verbosity -> IO ()
simplePP
(String
inBaseDir, String
inRelativeFile)
(String
outBaseDir, String
outRelativeFile) Verbosity
verbosity = String -> String -> Verbosity -> IO ()
simplePP String
inFile String
outFile Verbosity
verbosity
where inFile :: String
inFile = String -> String
normalise (String
inBaseDir String -> String -> String
</> String
inRelativeFile)
outFile :: String
outFile = String -> String
normalise (String
outBaseDir String -> String -> String
</> String
outRelativeFile)
runSimplePreProcessor :: PreProcessor -> FilePath -> FilePath -> Verbosity
-> IO ()
runSimplePreProcessor :: PreProcessor -> String -> String -> Verbosity -> IO ()
runSimplePreProcessor PreProcessor
pp String
inFile String
outFile Verbosity
verbosity =
PreProcessor
-> (String, String) -> (String, String) -> Verbosity -> IO ()
runPreProcessor PreProcessor
pp (String
".", String
inFile) (String
".", String
outFile) Verbosity
verbosity
type PPSuffixHandler
= (String, BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor)
preprocessComponent :: PackageDescription
-> Component
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Bool
-> Verbosity
-> [PPSuffixHandler]
-> IO ()
preprocessComponent :: PackageDescription
-> Component
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Bool
-> Verbosity
-> [PPSuffixHandler]
-> IO ()
preprocessComponent PackageDescription
pd Component
comp LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi Bool
isSrcDist Verbosity
verbosity [PPSuffixHandler]
handlers = do
forall a.
Pretty a =>
Verbosity
-> String
-> PackageIdentifier
-> ComponentName
-> Maybe [(ModuleName, a)]
-> IO ()
setupMessage' Verbosity
verbosity String
"Preprocessing" (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pd)
(ComponentLocalBuildInfo -> ComponentName
componentLocalName ComponentLocalBuildInfo
clbi) (forall a. Maybe a
Nothing :: Maybe [(ModuleName, Module)])
case Component
comp of
(CLib lib :: Library
lib@Library{ libBuildInfo :: Library -> BuildInfo
libBuildInfo = BuildInfo
bi }) -> do
let dirs :: [String]
dirs = forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> String
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi) forall a. [a] -> [a] -> [a]
++
[ LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi ,LocalBuildInfo -> String
autogenPackageModulesDir LocalBuildInfo
lbi]
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> String
ModuleName.toFilePath forall a b. (a -> b) -> a -> b
$ Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi) forall a b. (a -> b) -> a -> b
$
[String] -> String -> [(String, PreProcessor)] -> String -> IO ()
pre [String]
dirs (LocalBuildInfo -> ComponentLocalBuildInfo -> String
componentBuildDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi) (BuildInfo -> [(String, PreProcessor)]
localHandlers BuildInfo
bi)
(CFLib flib :: ForeignLib
flib@ForeignLib { foreignLibBuildInfo :: ForeignLib -> BuildInfo
foreignLibBuildInfo = BuildInfo
bi, foreignLibName :: ForeignLib -> UnqualComponentName
foreignLibName = UnqualComponentName
nm }) -> do
let nm' :: String
nm' = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
nm
let flibDir :: String
flibDir = LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
nm' String -> String -> String
</> String
nm' forall a. [a] -> [a] -> [a]
++ String
"-tmp"
dirs :: [String]
dirs = forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> String
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi) forall a. [a] -> [a] -> [a]
++ [LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
,LocalBuildInfo -> String
autogenPackageModulesDir LocalBuildInfo
lbi]
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> String
ModuleName.toFilePath forall a b. (a -> b) -> a -> b
$ ForeignLib -> [ModuleName]
foreignLibModules ForeignLib
flib) forall a b. (a -> b) -> a -> b
$
[String] -> String -> [(String, PreProcessor)] -> String -> IO ()
pre [String]
dirs String
flibDir (BuildInfo -> [(String, PreProcessor)]
localHandlers BuildInfo
bi)
(CExe exe :: Executable
exe@Executable { buildInfo :: Executable -> BuildInfo
buildInfo = BuildInfo
bi, exeName :: Executable -> UnqualComponentName
exeName = UnqualComponentName
nm }) -> do
let nm' :: String
nm' = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
nm
let exeDir :: String
exeDir = LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
nm' String -> String -> String
</> String
nm' forall a. [a] -> [a] -> [a]
++ String
"-tmp"
dirs :: [String]
dirs = forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> String
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi) forall a. [a] -> [a] -> [a]
++ [LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
,LocalBuildInfo -> String
autogenPackageModulesDir LocalBuildInfo
lbi]
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> String
ModuleName.toFilePath forall a b. (a -> b) -> a -> b
$ BuildInfo -> [ModuleName]
otherModules BuildInfo
bi) forall a b. (a -> b) -> a -> b
$
[String] -> String -> [(String, PreProcessor)] -> String -> IO ()
pre [String]
dirs String
exeDir (BuildInfo -> [(String, PreProcessor)]
localHandlers BuildInfo
bi)
[String] -> String -> [(String, PreProcessor)] -> String -> IO ()
pre (forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> String
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi)) String
exeDir (BuildInfo -> [(String, PreProcessor)]
localHandlers BuildInfo
bi) forall a b. (a -> b) -> a -> b
$
String -> String
dropExtensions (Executable -> String
modulePath Executable
exe)
CTest test :: TestSuite
test@TestSuite{ testName :: TestSuite -> UnqualComponentName
testName = UnqualComponentName
nm } -> do
let nm' :: String
nm' = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
nm
case TestSuite -> TestSuiteInterface
testInterface TestSuite
test of
TestSuiteExeV10 Version
_ String
f ->
TestSuite -> String -> String -> IO ()
preProcessTest TestSuite
test String
f forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
nm' String -> String -> String
</> String
nm' forall a. [a] -> [a] -> [a]
++ String
"-tmp"
TestSuiteLibV09 Version
_ ModuleName
_ -> do
let testDir :: String
testDir = LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> TestSuite -> String
stubName TestSuite
test
String -> String -> String
</> TestSuite -> String
stubName TestSuite
test forall a. [a] -> [a] -> [a]
++ String
"-tmp"
TestSuite -> String -> IO ()
writeSimpleTestStub TestSuite
test String
testDir
TestSuite -> String -> String -> IO ()
preProcessTest TestSuite
test (TestSuite -> String
stubFilePath TestSuite
test) String
testDir
TestSuiteUnsupported TestType
tt ->
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"No support for preprocessing test "
forall a. [a] -> [a] -> [a]
++ String
"suite type " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow TestType
tt
CBench bm :: Benchmark
bm@Benchmark{ benchmarkName :: Benchmark -> UnqualComponentName
benchmarkName = UnqualComponentName
nm } -> do
let nm' :: String
nm' = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
nm
case Benchmark -> BenchmarkInterface
benchmarkInterface Benchmark
bm of
BenchmarkExeV10 Version
_ String
f ->
Benchmark -> String -> String -> IO ()
preProcessBench Benchmark
bm String
f forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
nm' String -> String -> String
</> String
nm' forall a. [a] -> [a] -> [a]
++ String
"-tmp"
BenchmarkUnsupported BenchmarkType
tt ->
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"No support for preprocessing benchmark "
forall a. [a] -> [a] -> [a]
++ String
"type " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow BenchmarkType
tt
where
builtinHaskellSuffixes :: [String]
builtinHaskellSuffixes = [String
"hs", String
"lhs", String
"hsig", String
"lhsig"]
builtinCSuffixes :: [String]
builtinCSuffixes = [String]
cSourceExtensions
builtinSuffixes :: [String]
builtinSuffixes = [String]
builtinHaskellSuffixes forall a. [a] -> [a] -> [a]
++ [String]
builtinCSuffixes
localHandlers :: BuildInfo -> [(String, PreProcessor)]
localHandlers BuildInfo
bi = [(String
ext, BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
h BuildInfo
bi LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi) | (String
ext, BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
h) <- [PPSuffixHandler]
handlers]
pre :: [String] -> String -> [(String, PreProcessor)] -> String -> IO ()
pre [String]
dirs String
dir [(String, PreProcessor)]
lhndlrs String
fp =
[SymbolicPath PackageDir SourceDir]
-> String
-> Bool
-> String
-> Verbosity
-> [String]
-> [(String, PreProcessor)]
-> IO ()
preprocessFile (forall a b. (a -> b) -> [a] -> [b]
map forall from to. String -> SymbolicPath from to
unsafeMakeSymbolicPath [String]
dirs) String
dir Bool
isSrcDist String
fp Verbosity
verbosity [String]
builtinSuffixes [(String, PreProcessor)]
lhndlrs
preProcessTest :: TestSuite -> String -> String -> IO ()
preProcessTest TestSuite
test = BuildInfo -> [ModuleName] -> String -> String -> IO ()
preProcessComponent (TestSuite -> BuildInfo
testBuildInfo TestSuite
test)
(TestSuite -> [ModuleName]
testModules TestSuite
test)
preProcessBench :: Benchmark -> String -> String -> IO ()
preProcessBench Benchmark
bm = BuildInfo -> [ModuleName] -> String -> String -> IO ()
preProcessComponent (Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
bm)
(Benchmark -> [ModuleName]
benchmarkModules Benchmark
bm)
preProcessComponent
:: BuildInfo
-> [ModuleName]
-> FilePath
-> FilePath
-> IO ()
preProcessComponent :: BuildInfo -> [ModuleName] -> String -> String -> IO ()
preProcessComponent BuildInfo
bi [ModuleName]
modules String
exePath String
dir = do
let biHandlers :: [(String, PreProcessor)]
biHandlers = BuildInfo -> [(String, PreProcessor)]
localHandlers BuildInfo
bi
sourceDirs :: [String]
sourceDirs = forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> String
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi) forall a. [a] -> [a] -> [a]
++ [ LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
, LocalBuildInfo -> String
autogenPackageModulesDir LocalBuildInfo
lbi ]
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ [SymbolicPath PackageDir SourceDir]
-> String
-> Bool
-> String
-> Verbosity
-> [String]
-> [(String, PreProcessor)]
-> IO ()
preprocessFile (forall a b. (a -> b) -> [a] -> [b]
map forall from to. String -> SymbolicPath from to
unsafeMakeSymbolicPath [String]
sourceDirs) String
dir Bool
isSrcDist
(ModuleName -> String
ModuleName.toFilePath ModuleName
modu) Verbosity
verbosity [String]
builtinSuffixes
[(String, PreProcessor)]
biHandlers
| ModuleName
modu <- [ModuleName]
modules ]
[SymbolicPath PackageDir SourceDir]
-> String
-> Bool
-> String
-> Verbosity
-> [String]
-> [(String, PreProcessor)]
-> IO ()
preprocessFile (forall from to. String -> SymbolicPath from to
unsafeMakeSymbolicPath String
dir forall a. a -> [a] -> [a]
: BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi) String
dir Bool
isSrcDist
(String -> String
dropExtensions forall a b. (a -> b) -> a -> b
$ String
exePath) Verbosity
verbosity
[String]
builtinSuffixes [(String, PreProcessor)]
biHandlers
preprocessFile
:: [SymbolicPath PackageDir SourceDir]
-> FilePath
-> Bool
-> FilePath
-> Verbosity
-> [String]
-> [(String, PreProcessor)]
-> IO ()
preprocessFile :: [SymbolicPath PackageDir SourceDir]
-> String
-> Bool
-> String
-> Verbosity
-> [String]
-> [(String, PreProcessor)]
-> IO ()
preprocessFile [SymbolicPath PackageDir SourceDir]
searchLoc String
buildLoc Bool
forSDist String
baseFile Verbosity
verbosity [String]
builtinSuffixes [(String, PreProcessor)]
handlers = do
Maybe (String, String)
psrcFiles <- [String] -> [String] -> String -> IO (Maybe (String, String))
findFileWithExtension' (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(String, PreProcessor)]
handlers) (forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> String
getSymbolicPath [SymbolicPath PackageDir SourceDir]
searchLoc) String
baseFile
case Maybe (String, String)
psrcFiles of
Maybe (String, String)
Nothing -> do
Maybe String
bsrcFiles <- [String] -> [String] -> String -> IO (Maybe String)
findFileWithExtension [String]
builtinSuffixes (String
buildLoc forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> String
getSymbolicPath [SymbolicPath PackageDir SourceDir]
searchLoc) String
baseFile
case Maybe String
bsrcFiles of
Maybe String
Nothing ->
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"can't find source for " forall a. [a] -> [a] -> [a]
++ String
baseFile
forall a. [a] -> [a] -> [a]
++ String
" in " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> String
getSymbolicPath [SymbolicPath PackageDir SourceDir]
searchLoc)
Maybe String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (String
psrcLoc, String
psrcRelFile) -> do
let (String
srcStem, String
ext) = String -> (String, String)
splitExtension String
psrcRelFile
psrcFile :: String
psrcFile = String
psrcLoc String -> String -> String
</> String
psrcRelFile
pp :: PreProcessor
pp = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"Distribution.Simple.PreProcess: Just expected")
(forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (forall a. [a] -> [a]
safeTail String
ext) [(String, PreProcessor)]
handlers)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
forSDist Bool -> Bool -> Bool
|| Bool
forSDist Bool -> Bool -> Bool
&& PreProcessor -> Bool
platformIndependent PreProcessor
pp) forall a b. (a -> b) -> a -> b
$ do
Maybe String
ppsrcFiles <- [String] -> [String] -> String -> IO (Maybe String)
findFileWithExtension [String]
builtinSuffixes [String
buildLoc] String
baseFile
Bool
recomp <- case Maybe String
ppsrcFiles of
Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Just String
ppsrcFile ->
String
psrcFile String -> String -> IO Bool
`moreRecentFile` String
ppsrcFile
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
recomp forall a b. (a -> b) -> a -> b
$ do
let destDir :: String
destDir = String
buildLoc String -> String -> String
</> String -> String
dirName String
srcStem
Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True String
destDir
PreProcessor -> (String, String) -> (String, String) -> IO ()
runPreProcessorWithHsBootHack PreProcessor
pp
(String
psrcLoc, String
psrcRelFile)
(String
buildLoc, String
srcStem String -> String -> String
<.> String
"hs")
where
dirName :: String -> String
dirName = String -> String
takeDirectory
runPreProcessorWithHsBootHack :: PreProcessor -> (String, String) -> (String, String) -> IO ()
runPreProcessorWithHsBootHack PreProcessor
pp
(String
inBaseDir, String
inRelativeFile)
(String
outBaseDir, String
outRelativeFile) = do
PreProcessor
-> (String, String) -> (String, String) -> Verbosity -> IO ()
runPreProcessor PreProcessor
pp
(String
inBaseDir, String
inRelativeFile)
(String
outBaseDir, String
outRelativeFile) Verbosity
verbosity
Bool
exists <- String -> IO Bool
doesFileExist String
inBoot
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists forall a b. (a -> b) -> a -> b
$ Verbosity -> String -> String -> IO ()
copyFileVerbose Verbosity
verbosity String
inBoot String
outBoot
where
inBoot :: String
inBoot = String -> String -> String
replaceExtension String
inFile String
"hs-boot"
outBoot :: String
outBoot = String -> String -> String
replaceExtension String
outFile String
"hs-boot"
inFile :: String
inFile = String -> String
normalise (String
inBaseDir String -> String -> String
</> String
inRelativeFile)
outFile :: String
outFile = String -> String
normalise (String
outBaseDir String -> String -> String
</> String
outRelativeFile)
ppGreenCard :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppGreenCard :: BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppGreenCard BuildInfo
_ LocalBuildInfo
lbi ComponentLocalBuildInfo
_
= PreProcessor {
platformIndependent :: Bool
platformIndependent = Bool
False,
runPreProcessor :: (String, String) -> (String, String) -> Verbosity -> IO ()
runPreProcessor = (String -> String -> Verbosity -> IO ())
-> (String, String) -> (String, String) -> Verbosity -> IO ()
mkSimplePreProcessor forall a b. (a -> b) -> a -> b
$ \String
inFile String
outFile Verbosity
verbosity ->
Verbosity -> Program -> ProgramDb -> [String] -> IO ()
runDbProgram Verbosity
verbosity Program
greencardProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
([String
"-tffi", String
"-o" forall a. [a] -> [a] -> [a]
++ String
outFile, String
inFile])
}
ppUnlit :: PreProcessor
ppUnlit :: PreProcessor
ppUnlit =
PreProcessor {
platformIndependent :: Bool
platformIndependent = Bool
True,
runPreProcessor :: (String, String) -> (String, String) -> Verbosity -> IO ()
runPreProcessor = (String -> String -> Verbosity -> IO ())
-> (String, String) -> (String, String) -> Verbosity -> IO ()
mkSimplePreProcessor forall a b. (a -> b) -> a -> b
$ \String
inFile String
outFile Verbosity
verbosity ->
forall a. String -> (String -> IO a) -> IO a
withUTF8FileContents String
inFile forall a b. (a -> b) -> a -> b
$ \String
contents ->
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> String -> IO ()
writeUTF8File String
outFile) (forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity) (String -> String -> Either String String
unlit String
inFile String
contents)
}
ppCpp :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppCpp :: BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppCpp = [String]
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> PreProcessor
ppCpp' []
ppCpp' :: [String] -> BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppCpp' :: [String]
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> PreProcessor
ppCpp' [String]
extraArgs BuildInfo
bi LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi =
case Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) of
CompilerFlavor
GHC -> Program
-> (Version -> Bool)
-> [String]
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> PreProcessor
ppGhcCpp Program
ghcProgram (forall a b. a -> b -> a
const Bool
True) [String]
args BuildInfo
bi LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
CompilerFlavor
GHCJS -> Program
-> (Version -> Bool)
-> [String]
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> PreProcessor
ppGhcCpp Program
ghcjsProgram (forall a b. a -> b -> a
const Bool
True) [String]
args BuildInfo
bi LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
CompilerFlavor
_ -> [String]
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> PreProcessor
ppCpphs [String]
args BuildInfo
bi LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
where cppArgs :: [String]
cppArgs = BuildInfo -> LocalBuildInfo -> [String]
getCppOptions BuildInfo
bi LocalBuildInfo
lbi
args :: [String]
args = [String]
cppArgs forall a. [a] -> [a] -> [a]
++ [String]
extraArgs
ppGhcCpp :: Program -> (Version -> Bool)
-> [String] -> BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppGhcCpp :: Program
-> (Version -> Bool)
-> [String]
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> PreProcessor
ppGhcCpp Program
program Version -> Bool
xHs [String]
extraArgs BuildInfo
_bi LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi =
PreProcessor {
platformIndependent :: Bool
platformIndependent = Bool
False,
runPreProcessor :: (String, String) -> (String, String) -> Verbosity -> IO ()
runPreProcessor = (String -> String -> Verbosity -> IO ())
-> (String, String) -> (String, String) -> Verbosity -> IO ()
mkSimplePreProcessor forall a b. (a -> b) -> a -> b
$ \String
inFile String
outFile Verbosity
verbosity -> do
(ConfiguredProgram
prog, Version
version, ProgramDb
_) <- Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)
requireProgramVersion Verbosity
verbosity
Program
program VersionRange
anyVersion (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
Verbosity -> ConfiguredProgram -> [String] -> IO ()
runProgram Verbosity
verbosity ConfiguredProgram
prog forall a b. (a -> b) -> a -> b
$
[String
"-E", String
"-cpp"]
forall a. [a] -> [a] -> [a]
++ (if Version -> Bool
xHs Version
version then [String
"-x", String
"hs"] else [])
forall a. [a] -> [a] -> [a]
++ [ String
"-optP-include", String
"-optP"forall a. [a] -> [a] -> [a]
++ (LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi String -> String -> String
</> String
cppHeaderName) ]
forall a. [a] -> [a] -> [a]
++ [String
"-o", String
outFile, String
inFile]
forall a. [a] -> [a] -> [a]
++ [String]
extraArgs
}
ppCpphs :: [String] -> BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppCpphs :: [String]
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> PreProcessor
ppCpphs [String]
extraArgs BuildInfo
_bi LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi =
PreProcessor {
platformIndependent :: Bool
platformIndependent = Bool
False,
runPreProcessor :: (String, String) -> (String, String) -> Verbosity -> IO ()
runPreProcessor = (String -> String -> Verbosity -> IO ())
-> (String, String) -> (String, String) -> Verbosity -> IO ()
mkSimplePreProcessor forall a b. (a -> b) -> a -> b
$ \String
inFile String
outFile Verbosity
verbosity -> do
(ConfiguredProgram
cpphsProg, Version
cpphsVersion, ProgramDb
_) <- Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)
requireProgramVersion Verbosity
verbosity
Program
cpphsProgram VersionRange
anyVersion (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
Verbosity -> ConfiguredProgram -> [String] -> IO ()
runProgram Verbosity
verbosity ConfiguredProgram
cpphsProg forall a b. (a -> b) -> a -> b
$
(String
"-O" forall a. [a] -> [a] -> [a]
++ String
outFile) forall a. a -> [a] -> [a]
: String
inFile
forall a. a -> [a] -> [a]
: String
"--noline" forall a. a -> [a] -> [a]
: String
"--strip"
forall a. a -> [a] -> [a]
: (if Version
cpphsVersion forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
1,Int
6]
then [String
"--include="forall a. [a] -> [a] -> [a]
++ (LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi String -> String -> String
</> String
cppHeaderName)]
else [])
forall a. [a] -> [a] -> [a]
++ [String]
extraArgs
}
ppHsc2hs :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppHsc2hs :: BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppHsc2hs BuildInfo
bi LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi =
PreProcessor {
platformIndependent :: Bool
platformIndependent = Bool
False,
runPreProcessor :: (String, String) -> (String, String) -> Verbosity -> IO ()
runPreProcessor = (String -> String -> Verbosity -> IO ())
-> (String, String) -> (String, String) -> Verbosity -> IO ()
mkSimplePreProcessor forall a b. (a -> b) -> a -> b
$ \String
inFile String
outFile Verbosity
verbosity -> do
(ConfiguredProgram
gccProg, ProgramDb
_) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
gccProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
(ConfiguredProgram
hsc2hsProg, Version
hsc2hsVersion, ProgramDb
_) <- Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)
requireProgramVersion Verbosity
verbosity
Program
hsc2hsProgram VersionRange
anyVersion (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
let isCross :: Bool
isCross = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi forall a. Eq a => a -> a -> Bool
/= Platform
buildPlatform
prependCrossFlags :: [String] -> [String]
prependCrossFlags = if Bool
isCross then (String
"-x"forall a. a -> [a] -> [a]
:) else forall a. a -> a
id
let hsc2hsSupportsResponseFiles :: Bool
hsc2hsSupportsResponseFiles = Version
hsc2hsVersion forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
0,Int
68,Int
4]
pureArgs :: [String]
pureArgs = Version -> ConfiguredProgram -> String -> String -> [String]
genPureArgs Version
hsc2hsVersion ConfiguredProgram
gccProg String
inFile String
outFile
if Bool
hsc2hsSupportsResponseFiles
then forall a.
Verbosity
-> TempFileOptions
-> String
-> String
-> Maybe TextEncoding
-> [String]
-> (String -> IO a)
-> IO a
withResponseFile
Verbosity
verbosity
TempFileOptions
defaultTempFileOptions
(String -> String
takeDirectory String
outFile)
String
"hsc2hs-response.txt"
forall a. Maybe a
Nothing
[String]
pureArgs
(\String
responseFileName ->
Verbosity -> ConfiguredProgram -> [String] -> IO ()
runProgram Verbosity
verbosity ConfiguredProgram
hsc2hsProg ([String] -> [String]
prependCrossFlags [String
"@"forall a. [a] -> [a] -> [a]
++ String
responseFileName]))
else Verbosity -> ConfiguredProgram -> [String] -> IO ()
runProgram Verbosity
verbosity ConfiguredProgram
hsc2hsProg ([String] -> [String]
prependCrossFlags [String]
pureArgs)
}
where
genPureArgs :: Version -> ConfiguredProgram -> String -> String -> [String]
genPureArgs :: Version -> ConfiguredProgram -> String -> String -> [String]
genPureArgs Version
hsc2hsVersion ConfiguredProgram
gccProg String
inFile String
outFile =
[ String
"--cflag=" forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- ConfiguredProgram -> [String]
programDefaultArgs ConfiguredProgram
gccProg
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> [String]
programOverrideArgs ConfiguredProgram
gccProg ]
forall a. [a] -> [a] -> [a]
++ [ String
"--lflag=" forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- ConfiguredProgram -> [String]
programDefaultArgs ConfiguredProgram
gccProg
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> [String]
programOverrideArgs ConfiguredProgram
gccProg ]
forall a. [a] -> [a] -> [a]
++ [ String
what forall a. [a] -> [a] -> [a]
++ String
"=-F" forall a. [a] -> [a] -> [a]
++ String
opt
| Bool
isOSX
, String
opt <- forall a. Eq a => [a] -> [a]
nub (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap InstalledPackageInfo -> [String]
Installed.frameworkDirs [InstalledPackageInfo]
pkgs)
, String
what <- [String
"--cflag", String
"--lflag"] ]
forall a. [a] -> [a] -> [a]
++ [ String
"--lflag=" forall a. [a] -> [a] -> [a]
++ String
arg
| Bool
isOSX
, String
opt <- BuildInfo -> [String]
PD.frameworks BuildInfo
bi forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap InstalledPackageInfo -> [String]
Installed.frameworks [InstalledPackageInfo]
pkgs
, String
arg <- [String
"-framework", String
opt] ]
forall a. [a] -> [a] -> [a]
++ [ String
"--cflag=" forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- LocalBuildInfo -> [String]
platformDefines LocalBuildInfo
lbi ]
forall a. [a] -> [a] -> [a]
++ [ String
"--cflag=-I" forall a. [a] -> [a] -> [a]
++ String
dir | String
dir <- BuildInfo -> [String]
PD.includeDirs BuildInfo
bi ]
forall a. [a] -> [a] -> [a]
++ [ String
"--cflag=-I" forall a. [a] -> [a] -> [a]
++ LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
dir | String
dir <- BuildInfo -> [String]
PD.includeDirs BuildInfo
bi ]
forall a. [a] -> [a] -> [a]
++ [ String
"--cflag=" forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- BuildInfo -> [String]
PD.ccOptions BuildInfo
bi
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
PD.cppOptions BuildInfo
bi
]
forall a. [a] -> [a] -> [a]
++ [ String
"--cflag=" forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <-
[ String
"-I" forall a. [a] -> [a] -> [a]
++ LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi,
String
"-I" forall a. [a] -> [a] -> [a]
++ LocalBuildInfo -> String
autogenPackageModulesDir LocalBuildInfo
lbi,
String
"-include", LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi String -> String -> String
</> String
cppHeaderName ] ]
forall a. [a] -> [a] -> [a]
++ [ String
"--lflag=-L" forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- BuildInfo -> [String]
PD.extraLibDirs BuildInfo
bi ]
forall a. [a] -> [a] -> [a]
++ [ String
"--lflag=-Wl,-R," forall a. [a] -> [a] -> [a]
++ String
opt | Bool
isELF
, String
opt <- BuildInfo -> [String]
PD.extraLibDirs BuildInfo
bi ]
forall a. [a] -> [a] -> [a]
++ [ String
"--lflag=-l" forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- BuildInfo -> [String]
PD.extraLibs BuildInfo
bi ]
forall a. [a] -> [a] -> [a]
++ [ String
"--lflag=" forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- BuildInfo -> [String]
PD.ldOptions BuildInfo
bi ]
forall a. [a] -> [a] -> [a]
++ [ String
"--cflag=" forall a. [a] -> [a] -> [a]
++ String
opt
| InstalledPackageInfo
pkg <- [InstalledPackageInfo]
pkgs
, String
opt <- [ String
"-I" forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- InstalledPackageInfo -> [String]
Installed.includeDirs InstalledPackageInfo
pkg ]
forall a. [a] -> [a] -> [a]
++ [ String
opt | String
opt <- InstalledPackageInfo -> [String]
Installed.ccOptions InstalledPackageInfo
pkg ] ]
forall a. [a] -> [a] -> [a]
++ [ String
"--lflag=" forall a. [a] -> [a] -> [a]
++ String
opt
| InstalledPackageInfo
pkg <- [InstalledPackageInfo]
pkgs
, String
opt <- [ String
"-L" forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- InstalledPackageInfo -> [String]
Installed.libraryDirs InstalledPackageInfo
pkg ]
forall a. [a] -> [a] -> [a]
++ [ String
"-Wl,-R," forall a. [a] -> [a] -> [a]
++ String
opt | Bool
isELF
, String
opt <- InstalledPackageInfo -> [String]
Installed.libraryDirs InstalledPackageInfo
pkg ]
forall a. [a] -> [a] -> [a]
++ [ String
"-l" forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- InstalledPackageInfo -> [String]
Installed.extraLibraries InstalledPackageInfo
pkg ]
forall a. [a] -> [a] -> [a]
++ [ String
opt | String
opt <- InstalledPackageInfo -> [String]
Installed.ldOptions InstalledPackageInfo
pkg ] ]
forall a. [a] -> [a] -> [a]
++ [String]
preccldFlags
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
hsc2hsOptions BuildInfo
bi
forall a. [a] -> [a] -> [a]
++ [String]
postccldFlags
forall a. [a] -> [a] -> [a]
++ [String
"-o", String
outFile, String
inFile]
where
ccldFlags :: [String]
ccldFlags =
[ String
"--cc=" forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> String
programPath ConfiguredProgram
gccProg
, String
"--ld=" forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> String
programPath ConfiguredProgram
gccProg
]
([String]
preccldFlags, [String]
postccldFlags)
| Version
hsc2hsVersion forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
0,Int
68,Int
8] = ([String]
ccldFlags, [])
| Bool
otherwise = ([], [String]
ccldFlags)
hacked_index :: InstalledPackageIndex
hacked_index = InstalledPackageIndex -> InstalledPackageIndex
packageHacks (LocalBuildInfo -> InstalledPackageIndex
installedPkgs LocalBuildInfo
lbi)
pkgs :: [InstalledPackageInfo]
pkgs = forall a. PackageInstalled a => PackageIndex a -> [a]
PackageIndex.topologicalOrder forall a b. (a -> b) -> a -> b
$
case InstalledPackageIndex
-> [UnitId]
-> Either InstalledPackageIndex [(InstalledPackageInfo, [UnitId])]
PackageIndex.dependencyClosure InstalledPackageIndex
hacked_index
(forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
componentPackageDeps ComponentLocalBuildInfo
clbi)) of
Left InstalledPackageIndex
index' -> InstalledPackageIndex
index'
Right [(InstalledPackageInfo, [UnitId])]
inf ->
forall a. HasCallStack => String -> a
error (String
"ppHsc2hs: broken closure: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [(InstalledPackageInfo, [UnitId])]
inf)
isOSX :: Bool
isOSX = case OS
buildOS of OS
OSX -> Bool
True; OS
_ -> Bool
False
isELF :: Bool
isELF = case OS
buildOS of OS
OSX -> Bool
False; OS
Windows -> Bool
False; OS
AIX -> Bool
False; OS
_ -> Bool
True;
packageHacks :: InstalledPackageIndex -> InstalledPackageIndex
packageHacks = case Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) of
CompilerFlavor
GHC -> InstalledPackageIndex -> InstalledPackageIndex
hackRtsPackage
CompilerFlavor
GHCJS -> InstalledPackageIndex -> InstalledPackageIndex
hackRtsPackage
CompilerFlavor
_ -> forall a. a -> a
id
hackRtsPackage :: InstalledPackageIndex -> InstalledPackageIndex
hackRtsPackage InstalledPackageIndex
index =
case forall a. PackageIndex a -> PackageName -> [(Version, [a])]
PackageIndex.lookupPackageName InstalledPackageIndex
index (String -> PackageName
mkPackageName String
"rts") of
[(Version
_, [InstalledPackageInfo
rts])]
-> InstalledPackageInfo
-> InstalledPackageIndex -> InstalledPackageIndex
PackageIndex.insert InstalledPackageInfo
rts { ldOptions :: [String]
Installed.ldOptions = [] } InstalledPackageIndex
index
[(Version, [InstalledPackageInfo])]
_ -> forall a. HasCallStack => String -> a
error String
"No (or multiple) ghc rts package is registered!!"
ppHsc2hsExtras :: PreProcessorExtras
String
buildBaseDir = forall a. (a -> Bool) -> [a] -> [a]
filter (String
"_hsc.c" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
PreProcessorExtras
getDirectoryContentsRecursive String
buildBaseDir
ppC2hs :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppC2hs :: BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppC2hs BuildInfo
bi LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi =
PreProcessor {
platformIndependent :: Bool
platformIndependent = Bool
False,
runPreProcessor :: (String, String) -> (String, String) -> Verbosity -> IO ()
runPreProcessor = \(String
inBaseDir, String
inRelativeFile)
(String
outBaseDir, String
outRelativeFile) Verbosity
verbosity -> do
(ConfiguredProgram
c2hsProg, Version
_, ProgramDb
_) <- Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)
requireProgramVersion Verbosity
verbosity
Program
c2hsProgram (Version -> VersionRange
orLaterVersion ([Int] -> Version
mkVersion [Int
0,Int
15]))
(LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
(ConfiguredProgram
gccProg, ProgramDb
_) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
gccProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
Verbosity -> ConfiguredProgram -> [String] -> IO ()
runProgram Verbosity
verbosity ConfiguredProgram
c2hsProg forall a b. (a -> b) -> a -> b
$
[ String
"--cpp=" forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> String
programPath ConfiguredProgram
gccProg, String
"--cppopts=-E" ]
forall a. [a] -> [a] -> [a]
++ [ String
"--cppopts=" forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- BuildInfo -> LocalBuildInfo -> [String]
getCppOptions BuildInfo
bi LocalBuildInfo
lbi ]
forall a. [a] -> [a] -> [a]
++ [ String
"--cppopts=-include" forall a. [a] -> [a] -> [a]
++ (LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi String -> String -> String
</> String
cppHeaderName) ]
forall a. [a] -> [a] -> [a]
++ [ String
"--include=" forall a. [a] -> [a] -> [a]
++ String
outBaseDir ]
forall a. [a] -> [a] -> [a]
++ [ String
"--cppopts=" forall a. [a] -> [a] -> [a]
++ String
opt
| InstalledPackageInfo
pkg <- [InstalledPackageInfo]
pkgs
, String
opt <- [ String
"-I" forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- InstalledPackageInfo -> [String]
Installed.includeDirs InstalledPackageInfo
pkg ]
forall a. [a] -> [a] -> [a]
++ [ String
opt | opt :: String
opt@(Char
'-':Char
c:String
_) <- InstalledPackageInfo -> [String]
Installed.ccOptions InstalledPackageInfo
pkg
, Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"DIU" ] ]
forall a. [a] -> [a] -> [a]
++ [ String
"--output-dir=" forall a. [a] -> [a] -> [a]
++ String
outBaseDir
, String
"--output=" forall a. [a] -> [a] -> [a]
++ String
outRelativeFile
, String
inBaseDir String -> String -> String
</> String
inRelativeFile ]
}
where
pkgs :: [InstalledPackageInfo]
pkgs = forall a. PackageInstalled a => PackageIndex a -> [a]
PackageIndex.topologicalOrder (LocalBuildInfo -> InstalledPackageIndex
installedPkgs LocalBuildInfo
lbi)
ppC2hsExtras :: PreProcessorExtras
String
d = forall a. (a -> Bool) -> [a] -> [a]
filter (\String
p -> String -> String
takeExtensions String
p forall a. Eq a => a -> a -> Bool
== String
".chs.c") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
PreProcessorExtras
getDirectoryContentsRecursive String
d
getCppOptions :: BuildInfo -> LocalBuildInfo -> [String]
getCppOptions :: BuildInfo -> LocalBuildInfo -> [String]
getCppOptions BuildInfo
bi LocalBuildInfo
lbi
= LocalBuildInfo -> [String]
platformDefines LocalBuildInfo
lbi
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
cppOptions BuildInfo
bi
forall a. [a] -> [a] -> [a]
++ [String
"-I" forall a. [a] -> [a] -> [a]
++ String
dir | String
dir <- BuildInfo -> [String]
PD.includeDirs BuildInfo
bi]
forall a. [a] -> [a] -> [a]
++ [String
opt | opt :: String
opt@(Char
'-':Char
c:String
_) <- BuildInfo -> [String]
PD.ccOptions BuildInfo
bi forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
PD.cxxOptions BuildInfo
bi, Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"DIU"]
platformDefines :: LocalBuildInfo -> [String]
platformDefines :: LocalBuildInfo -> [String]
platformDefines LocalBuildInfo
lbi =
case Compiler -> CompilerFlavor
compilerFlavor Compiler
comp of
CompilerFlavor
GHC ->
[String
"-D__GLASGOW_HASKELL__=" forall a. [a] -> [a] -> [a]
++ Version -> String
versionInt Version
version] forall a. [a] -> [a] -> [a]
++
[String
"-D" forall a. [a] -> [a] -> [a]
++ String
os forall a. [a] -> [a] -> [a]
++ String
"_BUILD_OS=1"] forall a. [a] -> [a] -> [a]
++
[String
"-D" forall a. [a] -> [a] -> [a]
++ String
arch forall a. [a] -> [a] -> [a]
++ String
"_BUILD_ARCH=1"] forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map (\String
os' -> String
"-D" forall a. [a] -> [a] -> [a]
++ String
os' forall a. [a] -> [a] -> [a]
++ String
"_HOST_OS=1") [String]
osStr forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map (\String
arch' -> String
"-D" forall a. [a] -> [a] -> [a]
++ String
arch' forall a. [a] -> [a] -> [a]
++ String
"_HOST_ARCH=1") [String]
archStr
CompilerFlavor
GHCJS ->
[String]
compatGlasgowHaskell forall a. [a] -> [a] -> [a]
++
[String
"-D__GHCJS__=" forall a. [a] -> [a] -> [a]
++ Version -> String
versionInt Version
version] forall a. [a] -> [a] -> [a]
++
[String
"-D" forall a. [a] -> [a] -> [a]
++ String
os forall a. [a] -> [a] -> [a]
++ String
"_BUILD_OS=1"] forall a. [a] -> [a] -> [a]
++
[String
"-D" forall a. [a] -> [a] -> [a]
++ String
arch forall a. [a] -> [a] -> [a]
++ String
"_BUILD_ARCH=1"] forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map (\String
os' -> String
"-D" forall a. [a] -> [a] -> [a]
++ String
os' forall a. [a] -> [a] -> [a]
++ String
"_HOST_OS=1") [String]
osStr forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map (\String
arch' -> String
"-D" forall a. [a] -> [a] -> [a]
++ String
arch' forall a. [a] -> [a] -> [a]
++ String
"_HOST_ARCH=1") [String]
archStr
HaskellSuite {} ->
[String
"-D__HASKELL_SUITE__"] forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map (\String
os' -> String
"-D" forall a. [a] -> [a] -> [a]
++ String
os' forall a. [a] -> [a] -> [a]
++ String
"_HOST_OS=1") [String]
osStr forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map (\String
arch' -> String
"-D" forall a. [a] -> [a] -> [a]
++ String
arch' forall a. [a] -> [a] -> [a]
++ String
"_HOST_ARCH=1") [String]
archStr
CompilerFlavor
_ -> []
where
comp :: Compiler
comp = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
Platform Arch
hostArch OS
hostOS = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
version :: Version
version = Compiler -> Version
compilerVersion Compiler
comp
compatGlasgowHaskell :: [String]
compatGlasgowHaskell =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Version
v -> [String
"-D__GLASGOW_HASKELL__=" forall a. [a] -> [a] -> [a]
++ Version -> String
versionInt Version
v])
(CompilerFlavor -> Compiler -> Maybe Version
compilerCompatVersion CompilerFlavor
GHC Compiler
comp)
versionInt :: Version -> String
versionInt :: Version -> String
versionInt Version
v = case Version -> [Int]
versionNumbers Version
v of
[] -> String
"1"
[Int
n] -> forall a. Show a => a -> String
show Int
n
Int
n1:Int
n2:[Int]
_ ->
let s1 :: String
s1 = forall a. Show a => a -> String
show Int
n1
s2 :: String
s2 = forall a. Show a => a -> String
show Int
n2
middle :: String
middle = case String
s2 of
Char
_ : Char
_ : String
_ -> String
""
String
_ -> String
"0"
in String
s1 forall a. [a] -> [a] -> [a]
++ String
middle forall a. [a] -> [a] -> [a]
++ String
s2
osStr :: [String]
osStr = case OS
hostOS of
OS
Linux -> [String
"linux"]
OS
Windows -> [String
"mingw32"]
OS
OSX -> [String
"darwin"]
OS
FreeBSD -> [String
"freebsd"]
OS
OpenBSD -> [String
"openbsd"]
OS
NetBSD -> [String
"netbsd"]
OS
DragonFly -> [String
"dragonfly"]
OS
Solaris -> [String
"solaris2"]
OS
AIX -> [String
"aix"]
OS
HPUX -> [String
"hpux"]
OS
IRIX -> [String
"irix"]
OS
HaLVM -> []
OS
IOS -> [String
"ios"]
OS
Android -> [String
"android"]
OS
Ghcjs -> [String
"ghcjs"]
OS
Hurd -> [String
"hurd"]
OtherOS String
_ -> []
archStr :: [String]
archStr = case Arch
hostArch of
Arch
I386 -> [String
"i386"]
Arch
X86_64 -> [String
"x86_64"]
Arch
PPC -> [String
"powerpc"]
Arch
PPC64 -> [String
"powerpc64"]
Arch
Sparc -> [String
"sparc"]
Arch
Arm -> [String
"arm"]
Arch
AArch64 -> [String
"aarch64"]
Arch
Mips -> [String
"mips"]
Arch
SH -> []
Arch
IA64 -> [String
"ia64"]
Arch
S390 -> [String
"s390"]
Arch
Alpha -> [String
"alpha"]
Arch
Hppa -> [String
"hppa"]
Arch
Rs6000 -> [String
"rs6000"]
Arch
M68k -> [String
"m68k"]
Arch
Vax -> [String
"vax"]
Arch
JavaScript -> [String
"javascript"]
OtherArch String
_ -> []
ppHappy :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppHappy :: BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppHappy BuildInfo
_ LocalBuildInfo
lbi ComponentLocalBuildInfo
_ = PreProcessor
pp { platformIndependent :: Bool
platformIndependent = Bool
True }
where pp :: PreProcessor
pp = LocalBuildInfo -> Program -> [String] -> PreProcessor
standardPP LocalBuildInfo
lbi Program
happyProgram (CompilerFlavor -> [String]
hcFlags CompilerFlavor
hc)
hc :: CompilerFlavor
hc = Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
hcFlags :: CompilerFlavor -> [String]
hcFlags CompilerFlavor
GHC = [String
"-agc"]
hcFlags CompilerFlavor
GHCJS = [String
"-agc"]
hcFlags CompilerFlavor
_ = []
ppAlex :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppAlex :: BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppAlex BuildInfo
_ LocalBuildInfo
lbi ComponentLocalBuildInfo
_ = PreProcessor
pp { platformIndependent :: Bool
platformIndependent = Bool
True }
where pp :: PreProcessor
pp = LocalBuildInfo -> Program -> [String] -> PreProcessor
standardPP LocalBuildInfo
lbi Program
alexProgram (CompilerFlavor -> [String]
hcFlags CompilerFlavor
hc)
hc :: CompilerFlavor
hc = Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
hcFlags :: CompilerFlavor -> [String]
hcFlags CompilerFlavor
GHC = [String
"-g"]
hcFlags CompilerFlavor
GHCJS = [String
"-g"]
hcFlags CompilerFlavor
_ = []
standardPP :: LocalBuildInfo -> Program -> [String] -> PreProcessor
standardPP :: LocalBuildInfo -> Program -> [String] -> PreProcessor
standardPP LocalBuildInfo
lbi Program
prog [String]
args =
PreProcessor {
platformIndependent :: Bool
platformIndependent = Bool
False,
runPreProcessor :: (String, String) -> (String, String) -> Verbosity -> IO ()
runPreProcessor = (String -> String -> Verbosity -> IO ())
-> (String, String) -> (String, String) -> Verbosity -> IO ()
mkSimplePreProcessor forall a b. (a -> b) -> a -> b
$ \String
inFile String
outFile Verbosity
verbosity ->
Verbosity -> Program -> ProgramDb -> [String] -> IO ()
runDbProgram Verbosity
verbosity Program
prog (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
([String]
args forall a. [a] -> [a] -> [a]
++ [String
"-o", String
outFile, String
inFile])
}
ppSuffixes :: [ PPSuffixHandler ] -> [String]
ppSuffixes :: [PPSuffixHandler] -> [String]
ppSuffixes = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst
knownSuffixHandlers :: [ PPSuffixHandler ]
knownSuffixHandlers :: [PPSuffixHandler]
knownSuffixHandlers =
[ (String
"gc", BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppGreenCard)
, (String
"chs", BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppC2hs)
, (String
"hsc", BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppHsc2hs)
, (String
"x", BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppAlex)
, (String
"y", BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppHappy)
, (String
"ly", BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppHappy)
, (String
"cpphs", BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppCpp)
]
knownExtrasHandlers :: [ PreProcessorExtras ]
knownExtrasHandlers :: [PreProcessorExtras]
knownExtrasHandlers = [ PreProcessorExtras
ppC2hsExtras, PreProcessorExtras
ppHsc2hsExtras ]
preprocessExtras :: Verbosity
-> Component
-> LocalBuildInfo
-> IO [FilePath]
Verbosity
verbosity Component
comp LocalBuildInfo
lbi = case Component
comp of
CLib Library
_ -> PreProcessorExtras
pp forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi
(CExe Executable { exeName :: Executable -> UnqualComponentName
exeName = UnqualComponentName
nm }) -> do
let nm' :: String
nm' = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
nm
PreProcessorExtras
pp forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
nm' String -> String -> String
</> String
nm' forall a. [a] -> [a] -> [a]
++ String
"-tmp"
(CFLib ForeignLib { foreignLibName :: ForeignLib -> UnqualComponentName
foreignLibName = UnqualComponentName
nm }) -> do
let nm' :: String
nm' = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
nm
PreProcessorExtras
pp forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
nm' String -> String -> String
</> String
nm' forall a. [a] -> [a] -> [a]
++ String
"-tmp"
CTest TestSuite
test -> do
let nm' :: String
nm' = UnqualComponentName -> String
unUnqualComponentName forall a b. (a -> b) -> a -> b
$ TestSuite -> UnqualComponentName
testName TestSuite
test
case TestSuite -> TestSuiteInterface
testInterface TestSuite
test of
TestSuiteExeV10 Version
_ String
_ ->
PreProcessorExtras
pp forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
nm' String -> String -> String
</> String
nm' forall a. [a] -> [a] -> [a]
++ String
"-tmp"
TestSuiteLibV09 Version
_ ModuleName
_ ->
PreProcessorExtras
pp forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> TestSuite -> String
stubName TestSuite
test String -> String -> String
</> TestSuite -> String
stubName TestSuite
test forall a. [a] -> [a] -> [a]
++ String
"-tmp"
TestSuiteUnsupported TestType
tt ->
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"No support for preprocessing test suite type " forall a. [a] -> [a] -> [a]
++
forall a. Pretty a => a -> String
prettyShow TestType
tt
CBench Benchmark
bm -> do
let nm' :: String
nm' = UnqualComponentName -> String
unUnqualComponentName forall a b. (a -> b) -> a -> b
$ Benchmark -> UnqualComponentName
benchmarkName Benchmark
bm
case Benchmark -> BenchmarkInterface
benchmarkInterface Benchmark
bm of
BenchmarkExeV10 Version
_ String
_ ->
PreProcessorExtras
pp forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
nm' String -> String -> String
</> String
nm' forall a. [a] -> [a] -> [a]
++ String
"-tmp"
BenchmarkUnsupported BenchmarkType
tt ->
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"No support for preprocessing benchmark "
forall a. [a] -> [a] -> [a]
++ String
"type " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow BenchmarkType
tt
where
pp :: FilePath -> IO [FilePath]
pp :: PreProcessorExtras
pp String
dir = (forall a b. (a -> b) -> [a] -> [b]
map (String
dir String -> String -> String
</>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
not_sub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [PreProcessorExtras]
knownExtrasHandlers
(forall a b.
(a -> WithCallStack (IO b)) -> WithCallStack (a -> IO b)
withLexicalCallStack (\PreProcessorExtras
f -> PreProcessorExtras
f String
dir))
not_sub :: String -> Bool
not_sub String
p = forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Bool -> Bool
not (String
pre forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
p) | String
pre <- [String]
component_dirs ]
component_dirs :: [String]
component_dirs = PackageDescription -> [String]
component_names (LocalBuildInfo -> PackageDescription
localPkgDescr LocalBuildInfo
lbi)
component_names :: PackageDescription -> [String]
component_names PackageDescription
pkg_descr = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnqualComponentName -> String
unUnqualComponentName forall a b. (a -> b) -> a -> b
$
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (LibraryName -> Maybe UnqualComponentName
libraryNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> LibraryName
libName) (PackageDescription -> [Library]
subLibraries PackageDescription
pkg_descr) forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map Executable -> UnqualComponentName
exeName (PackageDescription -> [Executable]
executables PackageDescription
pkg_descr) forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map TestSuite -> UnqualComponentName
testName (PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg_descr) forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map Benchmark -> UnqualComponentName
benchmarkName (PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg_descr)