{-# 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 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
Verbosity
-> String
-> PackageIdentifier
-> ComponentName
-> Maybe [(ModuleName, Module)]
-> IO ()
forall a.
Pretty a =>
Verbosity
-> String
-> PackageIdentifier
-> ComponentName
-> Maybe [(ModuleName, a)]
-> IO ()
setupMessage' Verbosity
verbosity String
"Preprocessing" (PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pd)
(ComponentLocalBuildInfo -> ComponentName
componentLocalName ComponentLocalBuildInfo
clbi) (Maybe [(ModuleName, Module)]
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 = BuildInfo -> [String]
hsSourceDirs BuildInfo
bi [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
,LocalBuildInfo -> String
autogenPackageModulesDir LocalBuildInfo
lbi]
[String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ((ModuleName -> String) -> [ModuleName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> String
ModuleName.toFilePath ([ModuleName] -> [String]) -> [ModuleName] -> [String]
forall a b. (a -> b) -> a -> b
$ Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi) ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
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' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-tmp"
dirs :: [String]
dirs = BuildInfo -> [String]
hsSourceDirs BuildInfo
bi [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
,LocalBuildInfo -> String
autogenPackageModulesDir LocalBuildInfo
lbi]
[String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ((ModuleName -> String) -> [ModuleName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> String
ModuleName.toFilePath ([ModuleName] -> [String]) -> [ModuleName] -> [String]
forall a b. (a -> b) -> a -> b
$ ForeignLib -> [ModuleName]
foreignLibModules ForeignLib
flib) ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
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' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-tmp"
dirs :: [String]
dirs = BuildInfo -> [String]
hsSourceDirs BuildInfo
bi [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
,LocalBuildInfo -> String
autogenPackageModulesDir LocalBuildInfo
lbi]
[String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ((ModuleName -> String) -> [ModuleName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> String
ModuleName.toFilePath ([ModuleName] -> [String]) -> [ModuleName] -> [String]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [ModuleName]
otherModules BuildInfo
bi) ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
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 (BuildInfo -> [String]
hsSourceDirs BuildInfo
bi) String
exeDir (BuildInfo -> [(String, PreProcessor)]
localHandlers BuildInfo
bi) (String -> IO ()) -> String -> IO ()
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 (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
nm' String -> String -> String
</> String
nm' String -> String -> String
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 String -> String -> String
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 ->
Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"No support for preprocessing test "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"suite type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TestType -> String
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 (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
nm' String -> String -> String
</> String
nm' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-tmp"
BenchmarkUnsupported BenchmarkType
tt ->
Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"No support for preprocessing benchmark "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ BenchmarkType -> String
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 [String] -> [String] -> [String]
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 =
[String]
-> String
-> Bool
-> String
-> Verbosity
-> [String]
-> [(String, PreProcessor)]
-> IO ()
preprocessFile [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] -> 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 = BuildInfo -> [String]
hsSourceDirs BuildInfo
bi [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
, LocalBuildInfo -> String
autogenPackageModulesDir LocalBuildInfo
lbi ]
[IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ [String]
-> String
-> Bool
-> String
-> Verbosity
-> [String]
-> [(String, PreProcessor)]
-> IO ()
preprocessFile [String]
sourceDirs String
dir Bool
isSrcDist
(ModuleName -> String
ModuleName.toFilePath ModuleName
modu) Verbosity
verbosity [String]
builtinSuffixes
[(String, PreProcessor)]
biHandlers
| ModuleName
modu <- [ModuleName]
modules ]
[String]
-> String
-> Bool
-> String
-> Verbosity
-> [String]
-> [(String, PreProcessor)]
-> IO ()
preprocessFile (String
dir String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (BuildInfo -> [String]
hsSourceDirs BuildInfo
bi)) String
dir Bool
isSrcDist
(String -> String
dropExtensions (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
exePath) Verbosity
verbosity
[String]
builtinSuffixes [(String, PreProcessor)]
biHandlers
preprocessFile
:: [FilePath]
-> FilePath
-> Bool
-> FilePath
-> Verbosity
-> [String]
-> [(String, PreProcessor)]
-> IO ()
preprocessFile :: [String]
-> String
-> Bool
-> String
-> Verbosity
-> [String]
-> [(String, PreProcessor)]
-> IO ()
preprocessFile [String]
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' (((String, PreProcessor) -> String)
-> [(String, PreProcessor)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, PreProcessor) -> String
forall a b. (a, b) -> a
fst [(String, PreProcessor)]
handlers) [String]
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 String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
searchLoc) String
baseFile
case Maybe String
bsrcFiles of
Maybe String
Nothing ->
Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"can't find source for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
baseFile
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
searchLoc
Maybe String
_ -> () -> IO ()
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 = PreProcessor -> Maybe PreProcessor -> PreProcessor
forall a. a -> Maybe a -> a
fromMaybe (String -> PreProcessor
forall a. HasCallStack => String -> a
error String
"Distribution.Simple.PreProcess: Just expected")
(String -> [(String, PreProcessor)] -> Maybe PreProcessor
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String -> String
forall a. [a] -> [a]
safeTail String
ext) [(String, PreProcessor)]
handlers)
Bool -> IO () -> IO ()
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) (IO () -> IO ()) -> IO () -> IO ()
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 -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Just String
ppsrcFile ->
String
psrcFile String -> String -> IO Bool
`moreRecentFile` String
ppsrcFile
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
recomp (IO () -> IO ()) -> IO () -> IO ()
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
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (IO () -> IO ()) -> IO () -> IO ()
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 :: Bool
-> ((String, String) -> (String, String) -> Verbosity -> IO ())
-> PreProcessor
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 ((String -> String -> Verbosity -> IO ())
-> (String, String) -> (String, String) -> Verbosity -> IO ())
-> (String -> String -> Verbosity -> IO ())
-> (String, String)
-> (String, String)
-> Verbosity
-> IO ()
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" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
outFile, String
inFile])
}
ppUnlit :: PreProcessor
ppUnlit :: PreProcessor
ppUnlit =
PreProcessor :: Bool
-> ((String, String) -> (String, String) -> Verbosity -> IO ())
-> PreProcessor
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 ((String -> String -> Verbosity -> IO ())
-> (String, String) -> (String, String) -> Verbosity -> IO ())
-> (String -> String -> Verbosity -> IO ())
-> (String, String)
-> (String, String)
-> Verbosity
-> IO ()
forall a b. (a -> b) -> a -> b
$ \String
inFile String
outFile Verbosity
verbosity ->
String -> (String -> IO ()) -> IO ()
forall a. String -> (String -> IO a) -> IO a
withUTF8FileContents String
inFile ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
contents ->
(String -> IO ())
-> (String -> IO ()) -> Either String String -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> String -> IO ()
writeUTF8File String
outFile) (Verbosity -> String -> IO ()
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 (Bool -> Version -> Bool
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 (Bool -> Version -> Bool
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 [String] -> [String] -> [String]
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 :: Bool
-> ((String, String) -> (String, String) -> Verbosity -> IO ())
-> PreProcessor
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 ((String -> String -> Verbosity -> IO ())
-> (String, String) -> (String, String) -> Verbosity -> IO ())
-> (String -> String -> Verbosity -> IO ())
-> (String, String)
-> (String, String)
-> Verbosity
-> IO ()
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 ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$
[String
"-E", String
"-cpp"]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (if Version -> Bool
xHs Version
version then [String
"-x", String
"hs"] else [])
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"-optP-include", String
"-optP"String -> String -> String
forall a. [a] -> [a] -> [a]
++ (LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi String -> String -> String
</> String
cppHeaderName) ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"-o", String
outFile, String
inFile]
[String] -> [String] -> [String]
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 :: Bool
-> ((String, String) -> (String, String) -> Verbosity -> IO ())
-> PreProcessor
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 ((String -> String -> Verbosity -> IO ())
-> (String, String) -> (String, String) -> Verbosity -> IO ())
-> (String -> String -> Verbosity -> IO ())
-> (String, String)
-> (String, String)
-> Verbosity
-> IO ()
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 ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$
(String
"-O" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
outFile) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
inFile
String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"--noline" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"--strip"
String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (if Version
cpphsVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
1,Int
6]
then [String
"--include="String -> String -> String
forall a. [a] -> [a] -> [a]
++ (LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi String -> String -> String
</> String
cppHeaderName)]
else [])
[String] -> [String] -> [String]
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 :: Bool
-> ((String, String) -> (String, String) -> Verbosity -> IO ())
-> PreProcessor
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 ((String -> String -> Verbosity -> IO ())
-> (String, String) -> (String, String) -> Verbosity -> IO ())
-> (String -> String -> Verbosity -> IO ())
-> (String, String)
-> (String, String)
-> Verbosity
-> IO ()
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 Platform -> Platform -> Bool
forall a. Eq a => a -> a -> Bool
/= Platform
buildPlatform
prependCrossFlags :: [String] -> [String]
prependCrossFlags = if Bool
isCross then (String
"-x"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) else [String] -> [String]
forall a. a -> a
id
let hsc2hsSupportsResponseFiles :: Bool
hsc2hsSupportsResponseFiles = Version
hsc2hsVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
0,Int
68,Int
4]
pureArgs :: [String]
pureArgs = ConfiguredProgram -> String -> String -> [String]
genPureArgs ConfiguredProgram
gccProg String
inFile String
outFile
if Bool
hsc2hsSupportsResponseFiles
then Verbosity
-> TempFileOptions
-> String
-> String
-> Maybe TextEncoding
-> [String]
-> (String -> IO ())
-> IO ()
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"
Maybe TextEncoding
forall a. Maybe a
Nothing
[String]
pureArgs
(\String
responseFileName ->
Verbosity -> ConfiguredProgram -> [String] -> IO ()
runProgram Verbosity
verbosity ConfiguredProgram
hsc2hsProg ([String] -> [String]
prependCrossFlags [String
"@"String -> String -> 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 :: ConfiguredProgram -> String -> String -> [String]
genPureArgs :: ConfiguredProgram -> String -> String -> [String]
genPureArgs ConfiguredProgram
gccProg String
inFile String
outFile =
[ String
"--cc=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> String
programPath ConfiguredProgram
gccProg
, String
"--ld=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> String
programPath ConfiguredProgram
gccProg ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--cflag=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- ConfiguredProgram -> [String]
programDefaultArgs ConfiguredProgram
gccProg
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> [String]
programOverrideArgs ConfiguredProgram
gccProg ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--lflag=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- ConfiguredProgram -> [String]
programDefaultArgs ConfiguredProgram
gccProg
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> [String]
programOverrideArgs ConfiguredProgram
gccProg ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
what String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"=-F" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt
| Bool
isOSX
, String
opt <- [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ((InstalledPackageInfo -> [String])
-> [InstalledPackageInfo] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap InstalledPackageInfo -> [String]
Installed.frameworkDirs [InstalledPackageInfo]
pkgs)
, String
what <- [String
"--cflag", String
"--lflag"] ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--lflag=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
arg
| Bool
isOSX
, String
opt <- BuildInfo -> [String]
PD.frameworks BuildInfo
bi [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (InstalledPackageInfo -> [String])
-> [InstalledPackageInfo] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap InstalledPackageInfo -> [String]
Installed.frameworks [InstalledPackageInfo]
pkgs
, String
arg <- [String
"-framework", String
opt] ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--cflag=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- LocalBuildInfo -> [String]
platformDefines LocalBuildInfo
lbi ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--cflag=-I" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dir | String
dir <- BuildInfo -> [String]
PD.includeDirs BuildInfo
bi ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--cflag=-I" String -> String -> String
forall a. [a] -> [a] -> [a]
++ LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
dir | String
dir <- BuildInfo -> [String]
PD.includeDirs BuildInfo
bi ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--cflag=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- BuildInfo -> [String]
PD.ccOptions BuildInfo
bi
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
PD.cppOptions BuildInfo
bi
]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--cflag=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <-
[ String
"-I" String -> String -> String
forall a. [a] -> [a] -> [a]
++ LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi,
String
"-I" String -> String -> String
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 ] ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--lflag=-L" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- BuildInfo -> [String]
PD.extraLibDirs BuildInfo
bi ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--lflag=-Wl,-R," String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | Bool
isELF
, String
opt <- BuildInfo -> [String]
PD.extraLibDirs BuildInfo
bi ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--lflag=-l" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- BuildInfo -> [String]
PD.extraLibs BuildInfo
bi ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--lflag=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- BuildInfo -> [String]
PD.ldOptions BuildInfo
bi ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--cflag=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt
| InstalledPackageInfo
pkg <- [InstalledPackageInfo]
pkgs
, String
opt <- [ String
"-I" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- InstalledPackageInfo -> [String]
Installed.includeDirs InstalledPackageInfo
pkg ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
opt | String
opt <- InstalledPackageInfo -> [String]
Installed.ccOptions InstalledPackageInfo
pkg ] ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--lflag=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt
| InstalledPackageInfo
pkg <- [InstalledPackageInfo]
pkgs
, String
opt <- [ String
"-L" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- InstalledPackageInfo -> [String]
Installed.libraryDirs InstalledPackageInfo
pkg ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"-Wl,-R," String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | Bool
isELF
, String
opt <- InstalledPackageInfo -> [String]
Installed.libraryDirs InstalledPackageInfo
pkg ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"-l" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- InstalledPackageInfo -> [String]
Installed.extraLibraries InstalledPackageInfo
pkg ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
opt | String
opt <- InstalledPackageInfo -> [String]
Installed.ldOptions InstalledPackageInfo
pkg ] ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"-o", String
outFile, String
inFile]
hacked_index :: InstalledPackageIndex
hacked_index = InstalledPackageIndex -> InstalledPackageIndex
packageHacks (LocalBuildInfo -> InstalledPackageIndex
installedPkgs LocalBuildInfo
lbi)
pkgs :: [InstalledPackageInfo]
pkgs = InstalledPackageIndex -> [InstalledPackageInfo]
forall a. PackageInstalled a => PackageIndex a -> [a]
PackageIndex.topologicalOrder (InstalledPackageIndex -> [InstalledPackageInfo])
-> InstalledPackageIndex -> [InstalledPackageInfo]
forall a b. (a -> b) -> a -> b
$
case InstalledPackageIndex
-> [UnitId]
-> Either InstalledPackageIndex [(InstalledPackageInfo, [UnitId])]
PackageIndex.dependencyClosure InstalledPackageIndex
hacked_index
(((UnitId, MungedPackageId) -> UnitId)
-> [(UnitId, MungedPackageId)] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map (UnitId, MungedPackageId) -> UnitId
forall a b. (a, b) -> a
fst (ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
componentPackageDeps ComponentLocalBuildInfo
clbi)) of
Left InstalledPackageIndex
index' -> InstalledPackageIndex
index'
Right [(InstalledPackageInfo, [UnitId])]
inf ->
String -> InstalledPackageIndex
forall a. HasCallStack => String -> a
error (String
"ppHsc2hs: broken closure: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(InstalledPackageInfo, [UnitId])] -> String
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
_ -> InstalledPackageIndex -> InstalledPackageIndex
forall a. a -> a
id
hackRtsPackage :: InstalledPackageIndex -> InstalledPackageIndex
hackRtsPackage InstalledPackageIndex
index =
case InstalledPackageIndex
-> PackageName -> [(Version, [InstalledPackageInfo])]
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])]
_ -> String -> InstalledPackageIndex
forall a. HasCallStack => String -> a
error String
"No (or multiple) ghc rts package is registered!!"
ppHsc2hsExtras :: PreProcessorExtras
String
buildBaseDir = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
"_hsc.c" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`) ([String] -> [String]) -> IO [String] -> IO [String]
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 :: Bool
-> ((String, String) -> (String, String) -> Verbosity -> IO ())
-> PreProcessor
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 ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$
[ String
"--cpp=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> String
programPath ConfiguredProgram
gccProg, String
"--cppopts=-E" ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--cppopts=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- BuildInfo -> LocalBuildInfo -> [String]
getCppOptions BuildInfo
bi LocalBuildInfo
lbi ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--cppopts=-include" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi String -> String -> String
</> String
cppHeaderName) ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--include=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
outBaseDir ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--cppopts=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt
| InstalledPackageInfo
pkg <- [InstalledPackageInfo]
pkgs
, String
opt <- [ String
"-I" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- InstalledPackageInfo -> [String]
Installed.includeDirs InstalledPackageInfo
pkg ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
opt | opt :: String
opt@(Char
'-':Char
c:String
_) <- InstalledPackageInfo -> [String]
Installed.ccOptions InstalledPackageInfo
pkg
, Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"DIU" ] ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--output-dir=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
outBaseDir
, String
"--output=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
outRelativeFile
, String
inBaseDir String -> String -> String
</> String
inRelativeFile ]
}
where
pkgs :: [InstalledPackageInfo]
pkgs = InstalledPackageIndex -> [InstalledPackageInfo]
forall a. PackageInstalled a => PackageIndex a -> [a]
PackageIndex.topologicalOrder (LocalBuildInfo -> InstalledPackageIndex
installedPkgs LocalBuildInfo
lbi)
ppC2hsExtras :: PreProcessorExtras
String
d = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
p -> String -> String
takeExtensions String
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".chs.c") ([String] -> [String]) -> IO [String] -> IO [String]
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
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
cppOptions BuildInfo
bi
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"-I" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dir | String
dir <- BuildInfo -> [String]
PD.includeDirs BuildInfo
bi]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
opt | opt :: String
opt@(Char
'-':Char
c:String
_) <- BuildInfo -> [String]
PD.ccOptions BuildInfo
bi [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
PD.cxxOptions BuildInfo
bi, Char
c Char -> String -> Bool
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__=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
versionInt Version
version] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
[String
"-D" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
os String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_BUILD_OS=1"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
[String
"-D" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
arch String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_BUILD_ARCH=1"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
(String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
os' -> String
"-D" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
os' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_HOST_OS=1") [String]
osStr [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
(String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
arch' -> String
"-D" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
arch' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_HOST_ARCH=1") [String]
archStr
CompilerFlavor
GHCJS ->
[String]
compatGlasgowHaskell [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
[String
"-D__GHCJS__=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
versionInt Version
version] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
[String
"-D" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
os String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_BUILD_OS=1"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
[String
"-D" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
arch String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_BUILD_ARCH=1"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
(String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
os' -> String
"-D" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
os' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_HOST_OS=1") [String]
osStr [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
(String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
arch' -> String
"-D" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
arch' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_HOST_ARCH=1") [String]
archStr
HaskellSuite {} ->
[String
"-D__HASKELL_SUITE__"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
(String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
os' -> String
"-D" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
os' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_HOST_OS=1") [String]
osStr [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
(String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
arch' -> String
"-D" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
arch' String -> String -> String
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 =
[String] -> (Version -> [String]) -> Maybe Version -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Version
v -> [String
"-D__GLASGOW_HASKELL__=" String -> String -> String
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] -> Int -> String
forall a. Show a => a -> String
show Int
n
Int
n1:Int
n2:[Int]
_ ->
let s1 :: String
s1 = Int -> String
forall a. Show a => a -> String
show Int
n1
s2 :: String
s2 = Int -> String
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 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
middle String -> String -> String
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 :: Bool
-> ((String, String) -> (String, String) -> Verbosity -> IO ())
-> PreProcessor
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 ((String -> String -> Verbosity -> IO ())
-> (String, String) -> (String, String) -> Verbosity -> IO ())
-> (String -> String -> Verbosity -> IO ())
-> (String, String)
-> (String, String)
-> Verbosity
-> IO ()
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 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"-o", String
outFile, String
inFile])
}
ppSuffixes :: [ PPSuffixHandler ] -> [String]
ppSuffixes :: [PPSuffixHandler] -> [String]
ppSuffixes = (PPSuffixHandler -> String) -> [PPSuffixHandler] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map PPSuffixHandler -> String
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 PreProcessorExtras -> PreProcessorExtras
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 PreProcessorExtras -> PreProcessorExtras
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
nm' String -> String -> String
</> String
nm' String -> String -> String
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 PreProcessorExtras -> PreProcessorExtras
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
nm' String -> String -> String
</> String
nm' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-tmp"
CTest TestSuite
test -> do
let nm' :: String
nm' = UnqualComponentName -> String
unUnqualComponentName (UnqualComponentName -> String) -> UnqualComponentName -> String
forall a b. (a -> b) -> a -> b
$ TestSuite -> UnqualComponentName
testName TestSuite
test
case TestSuite -> TestSuiteInterface
testInterface TestSuite
test of
TestSuiteExeV10 Version
_ String
_ ->
PreProcessorExtras
pp PreProcessorExtras -> PreProcessorExtras
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
nm' String -> String -> String
</> String
nm' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-tmp"
TestSuiteLibV09 Version
_ ModuleName
_ ->
PreProcessorExtras
pp PreProcessorExtras -> PreProcessorExtras
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 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-tmp"
TestSuiteUnsupported TestType
tt ->
Verbosity -> PreProcessorExtras
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity PreProcessorExtras -> PreProcessorExtras
forall a b. (a -> b) -> a -> b
$ String
"No support for preprocessing test suite type " String -> String -> String
forall a. [a] -> [a] -> [a]
++
TestType -> String
forall a. Pretty a => a -> String
prettyShow TestType
tt
CBench Benchmark
bm -> do
let nm' :: String
nm' = UnqualComponentName -> String
unUnqualComponentName (UnqualComponentName -> String) -> UnqualComponentName -> String
forall a b. (a -> b) -> a -> b
$ Benchmark -> UnqualComponentName
benchmarkName Benchmark
bm
case Benchmark -> BenchmarkInterface
benchmarkInterface Benchmark
bm of
BenchmarkExeV10 Version
_ String
_ ->
PreProcessorExtras
pp PreProcessorExtras -> PreProcessorExtras
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
nm' String -> String -> String
</> String
nm' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-tmp"
BenchmarkUnsupported BenchmarkType
tt ->
Verbosity -> PreProcessorExtras
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity PreProcessorExtras -> PreProcessorExtras
forall a b. (a -> b) -> a -> b
$ String
"No support for preprocessing benchmark "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ BenchmarkType -> String
forall a. Pretty a => a -> String
prettyShow BenchmarkType
tt
where
pp :: FilePath -> IO [FilePath]
pp :: PreProcessorExtras
pp String
dir = ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
dir String -> String -> String
</>) ([String] -> [String])
-> ([[String]] -> [String]) -> [[String]] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
not_sub ([String] -> [String])
-> ([[String]] -> [String]) -> [[String]] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat)
([[String]] -> [String]) -> IO [[String]] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PreProcessorExtras]
-> (PreProcessorExtras -> IO [String]) -> IO [[String]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [PreProcessorExtras]
knownExtrasHandlers
((PreProcessorExtras -> WithCallStack (IO [String]))
-> WithCallStack (PreProcessorExtras -> IO [String])
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 = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Bool -> Bool
not (String
pre String -> String -> Bool
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 = (UnqualComponentName -> String)
-> [UnqualComponentName] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnqualComponentName -> String
unUnqualComponentName ([UnqualComponentName] -> [String])
-> [UnqualComponentName] -> [String]
forall a b. (a -> b) -> a -> b
$
(Library -> Maybe UnqualComponentName)
-> [Library] -> [UnqualComponentName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (LibraryName -> Maybe UnqualComponentName
libraryNameString (LibraryName -> Maybe UnqualComponentName)
-> (Library -> LibraryName) -> Library -> Maybe UnqualComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> LibraryName
libName) (PackageDescription -> [Library]
subLibraries PackageDescription
pkg_descr) [UnqualComponentName]
-> [UnqualComponentName] -> [UnqualComponentName]
forall a. [a] -> [a] -> [a]
++
(Executable -> UnqualComponentName)
-> [Executable] -> [UnqualComponentName]
forall a b. (a -> b) -> [a] -> [b]
map Executable -> UnqualComponentName
exeName (PackageDescription -> [Executable]
executables PackageDescription
pkg_descr) [UnqualComponentName]
-> [UnqualComponentName] -> [UnqualComponentName]
forall a. [a] -> [a] -> [a]
++
(TestSuite -> UnqualComponentName)
-> [TestSuite] -> [UnqualComponentName]
forall a b. (a -> b) -> [a] -> [b]
map TestSuite -> UnqualComponentName
testName (PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg_descr) [UnqualComponentName]
-> [UnqualComponentName] -> [UnqualComponentName]
forall a. [a] -> [a] -> [a]
++
(Benchmark -> UnqualComponentName)
-> [Benchmark] -> [UnqualComponentName]
forall a b. (a -> b) -> [a] -> [b]
map Benchmark -> UnqualComponentName
benchmarkName (PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg_descr)