1{-# LANGUAGE FlexibleContexts #-} 2{-# LANGUAGE RankNTypes #-} 3 4----------------------------------------------------------------------------- 5-- | 6-- Module : Distribution.Simple.PreProcess 7-- Copyright : (c) 2003-2005, Isaac Jones, Malcolm Wallace 8-- License : BSD3 9-- 10-- Maintainer : cabal-devel@haskell.org 11-- Portability : portable 12-- 13-- This defines a 'PreProcessor' abstraction which represents a pre-processor 14-- that can transform one kind of file into another. There is also a 15-- 'PPSuffixHandler' which is a combination of a file extension and a function 16-- for configuring a 'PreProcessor'. It defines a bunch of known built-in 17-- preprocessors like @cpp@, @cpphs@, @c2hs@, @hsc2hs@, @happy@, @alex@ etc and 18-- lists them in 'knownSuffixHandlers'. On top of this it provides a function 19-- for actually preprocessing some sources given a bunch of known suffix 20-- handlers. This module is not as good as it could be, it could really do with 21-- a rewrite to address some of the problems we have with pre-processors. 22 23module Distribution.Simple.PreProcess (preprocessComponent, preprocessExtras, 24 knownSuffixHandlers, ppSuffixes, 25 PPSuffixHandler, PreProcessor(..), 26 mkSimplePreProcessor, runSimplePreProcessor, 27 ppCpp, ppCpp', ppGreenCard, ppC2hs, ppHsc2hs, 28 ppHappy, ppAlex, ppUnlit, platformDefines 29 ) 30 where 31 32import Prelude () 33import Distribution.Compat.Prelude 34import Distribution.Compat.Stack 35 36import Distribution.Simple.PreProcess.Unlit 37import Distribution.Backpack.DescribeUnitId 38import Distribution.Package 39import qualified Distribution.ModuleName as ModuleName 40import Distribution.ModuleName (ModuleName) 41import Distribution.PackageDescription as PD 42import qualified Distribution.InstalledPackageInfo as Installed 43import qualified Distribution.Simple.PackageIndex as PackageIndex 44import Distribution.Simple.CCompiler 45import Distribution.Simple.Compiler 46import Distribution.Simple.LocalBuildInfo 47import Distribution.Simple.BuildPaths 48import Distribution.Simple.Utils 49import Distribution.Simple.Program 50import Distribution.Simple.Program.ResponseFile 51import Distribution.Simple.Test.LibV09 52import Distribution.System 53import Distribution.Pretty 54import Distribution.Version 55import Distribution.Verbosity 56import Distribution.Types.ForeignLib 57import Distribution.Types.LibraryName 58import Distribution.Types.UnqualComponentName 59 60import System.Directory (doesFileExist) 61import System.Info (os, arch) 62import System.FilePath (splitExtension, dropExtensions, (</>), (<.>), 63 takeDirectory, normalise, replaceExtension, 64 takeExtensions) 65 66-- |The interface to a preprocessor, which may be implemented using an 67-- external program, but need not be. The arguments are the name of 68-- the input file, the name of the output file and a verbosity level. 69-- Here is a simple example that merely prepends a comment to the given 70-- source file: 71-- 72-- > ppTestHandler :: PreProcessor 73-- > ppTestHandler = 74-- > PreProcessor { 75-- > platformIndependent = True, 76-- > runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity -> 77-- > do info verbosity (inFile++" has been preprocessed to "++outFile) 78-- > stuff <- readFile inFile 79-- > writeFile outFile ("-- preprocessed as a test\n\n" ++ stuff) 80-- > return ExitSuccess 81-- 82-- We split the input and output file names into a base directory and the 83-- rest of the file name. The input base dir is the path in the list of search 84-- dirs that this file was found in. The output base dir is the build dir where 85-- all the generated source files are put. 86-- 87-- The reason for splitting it up this way is that some pre-processors don't 88-- simply generate one output .hs file from one input file but have 89-- dependencies on other generated files (notably c2hs, where building one 90-- .hs file may require reading other .chi files, and then compiling the .hs 91-- file may require reading a generated .h file). In these cases the generated 92-- files need to embed relative path names to each other (eg the generated .hs 93-- file mentions the .h file in the FFI imports). This path must be relative to 94-- the base directory where the generated files are located, it cannot be 95-- relative to the top level of the build tree because the compilers do not 96-- look for .h files relative to there, ie we do not use \"-I .\", instead we 97-- use \"-I dist\/build\" (or whatever dist dir has been set by the user) 98-- 99-- Most pre-processors do not care of course, so mkSimplePreProcessor and 100-- runSimplePreProcessor functions handle the simple case. 101-- 102data PreProcessor = PreProcessor { 103 104 -- Is the output of the pre-processor platform independent? eg happy output 105 -- is portable haskell but c2hs's output is platform dependent. 106 -- This matters since only platform independent generated code can be 107 -- included into a source tarball. 108 platformIndependent :: Bool, 109 110 -- TODO: deal with pre-processors that have implementation dependent output 111 -- eg alex and happy have --ghc flags. However we can't really include 112 -- ghc-specific code into supposedly portable source tarballs. 113 114 runPreProcessor :: (FilePath, FilePath) -- Location of the source file relative to a base dir 115 -> (FilePath, FilePath) -- Output file name, relative to an output base dir 116 -> Verbosity -- verbosity 117 -> IO () -- Should exit if the preprocessor fails 118 } 119 120-- | Function to determine paths to possible extra C sources for a 121-- preprocessor: just takes the path to the build directory and uses 122-- this to search for C sources with names that match the 123-- preprocessor's output name format. 124type PreProcessorExtras = FilePath -> IO [FilePath] 125 126-- | A newtype around 'PreProcessorExtras', useful for storing 127-- 'PreProcessorExtras' inside of another type constructor (e.g., a list) 128-- without impredicativity (recall that the 'IO' type, which is contained in 129-- 'PreProcessorExtras', is a synonym for @'HasCallStack' => Prelude.IO@, which 130-- is a polymorphic type). 131newtype WrappedPreProcessorExtras = WrapPPE { unWrapPPE :: PreProcessorExtras } 132 133mkSimplePreProcessor :: (FilePath -> FilePath -> Verbosity -> IO ()) 134 -> (FilePath, FilePath) 135 -> (FilePath, FilePath) -> Verbosity -> IO () 136mkSimplePreProcessor simplePP 137 (inBaseDir, inRelativeFile) 138 (outBaseDir, outRelativeFile) verbosity = simplePP inFile outFile verbosity 139 where inFile = normalise (inBaseDir </> inRelativeFile) 140 outFile = normalise (outBaseDir </> outRelativeFile) 141 142runSimplePreProcessor :: PreProcessor -> FilePath -> FilePath -> Verbosity 143 -> IO () 144runSimplePreProcessor pp inFile outFile verbosity = 145 runPreProcessor pp (".", inFile) (".", outFile) verbosity 146 147-- |A preprocessor for turning non-Haskell files with the given extension 148-- into plain Haskell source files. 149type PPSuffixHandler 150 = (String, BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor) 151 152-- | Apply preprocessors to the sources from 'hsSourceDirs' for a given 153-- component (lib, exe, or test suite). 154preprocessComponent :: PackageDescription 155 -> Component 156 -> LocalBuildInfo 157 -> ComponentLocalBuildInfo 158 -> Bool 159 -> Verbosity 160 -> [PPSuffixHandler] 161 -> IO () 162preprocessComponent pd comp lbi clbi isSrcDist verbosity handlers = do 163 -- NB: never report instantiation here; we'll report it properly when 164 -- building. 165 setupMessage' verbosity "Preprocessing" (packageId pd) 166 (componentLocalName clbi) (Nothing :: Maybe [(ModuleName, Module)]) 167 case comp of 168 (CLib lib@Library{ libBuildInfo = bi }) -> do 169 let dirs = hsSourceDirs bi ++ [autogenComponentModulesDir lbi clbi 170 ,autogenPackageModulesDir lbi] 171 for_ (map ModuleName.toFilePath $ allLibModules lib clbi) $ 172 pre dirs (componentBuildDir lbi clbi) (localHandlers bi) 173 (CFLib flib@ForeignLib { foreignLibBuildInfo = bi, foreignLibName = nm }) -> do 174 let nm' = unUnqualComponentName nm 175 let flibDir = buildDir lbi </> nm' </> nm' ++ "-tmp" 176 dirs = hsSourceDirs bi ++ [autogenComponentModulesDir lbi clbi 177 ,autogenPackageModulesDir lbi] 178 for_ (map ModuleName.toFilePath $ foreignLibModules flib) $ 179 pre dirs flibDir (localHandlers bi) 180 (CExe exe@Executable { buildInfo = bi, exeName = nm }) -> do 181 let nm' = unUnqualComponentName nm 182 let exeDir = buildDir lbi </> nm' </> nm' ++ "-tmp" 183 dirs = hsSourceDirs bi ++ [autogenComponentModulesDir lbi clbi 184 ,autogenPackageModulesDir lbi] 185 for_ (map ModuleName.toFilePath $ otherModules bi) $ 186 pre dirs exeDir (localHandlers bi) 187 pre (hsSourceDirs bi) exeDir (localHandlers bi) $ 188 dropExtensions (modulePath exe) 189 CTest test@TestSuite{ testName = nm } -> do 190 let nm' = unUnqualComponentName nm 191 case testInterface test of 192 TestSuiteExeV10 _ f -> 193 preProcessTest test f $ buildDir lbi </> nm' </> nm' ++ "-tmp" 194 TestSuiteLibV09 _ _ -> do 195 let testDir = buildDir lbi </> stubName test 196 </> stubName test ++ "-tmp" 197 writeSimpleTestStub test testDir 198 preProcessTest test (stubFilePath test) testDir 199 TestSuiteUnsupported tt -> 200 die' verbosity $ "No support for preprocessing test " 201 ++ "suite type " ++ prettyShow tt 202 CBench bm@Benchmark{ benchmarkName = nm } -> do 203 let nm' = unUnqualComponentName nm 204 case benchmarkInterface bm of 205 BenchmarkExeV10 _ f -> 206 preProcessBench bm f $ buildDir lbi </> nm' </> nm' ++ "-tmp" 207 BenchmarkUnsupported tt -> 208 die' verbosity $ "No support for preprocessing benchmark " 209 ++ "type " ++ prettyShow tt 210 where 211 builtinHaskellSuffixes = ["hs", "lhs", "hsig", "lhsig"] 212 builtinCSuffixes = cSourceExtensions 213 builtinSuffixes = builtinHaskellSuffixes ++ builtinCSuffixes 214 localHandlers bi = [(ext, h bi lbi clbi) | (ext, h) <- handlers] 215 pre dirs dir lhndlrs fp = 216 preprocessFile dirs dir isSrcDist fp verbosity builtinSuffixes lhndlrs 217 preProcessTest test = preProcessComponent (testBuildInfo test) 218 (testModules test) 219 preProcessBench bm = preProcessComponent (benchmarkBuildInfo bm) 220 (benchmarkModules bm) 221 preProcessComponent bi modules exePath dir = do 222 let biHandlers = localHandlers bi 223 sourceDirs = hsSourceDirs bi ++ [ autogenComponentModulesDir lbi clbi 224 , autogenPackageModulesDir lbi ] 225 sequence_ [ preprocessFile sourceDirs dir isSrcDist 226 (ModuleName.toFilePath modu) verbosity builtinSuffixes 227 biHandlers 228 | modu <- modules ] 229 preprocessFile (dir : (hsSourceDirs bi)) dir isSrcDist 230 (dropExtensions $ exePath) verbosity 231 builtinSuffixes biHandlers 232 233--TODO: try to list all the modules that could not be found 234-- not just the first one. It's annoying and slow due to the need 235-- to reconfigure after editing the .cabal file each time. 236 237-- |Find the first extension of the file that exists, and preprocess it 238-- if required. 239preprocessFile 240 :: [FilePath] -- ^source directories 241 -> FilePath -- ^build directory 242 -> Bool -- ^preprocess for sdist 243 -> FilePath -- ^module file name 244 -> Verbosity -- ^verbosity 245 -> [String] -- ^builtin suffixes 246 -> [(String, PreProcessor)] -- ^possible preprocessors 247 -> IO () 248preprocessFile searchLoc buildLoc forSDist baseFile verbosity builtinSuffixes handlers = do 249 -- look for files in the various source dirs with this module name 250 -- and a file extension of a known preprocessor 251 psrcFiles <- findFileWithExtension' (map fst handlers) searchLoc baseFile 252 case psrcFiles of 253 -- no preprocessor file exists, look for an ordinary source file 254 -- just to make sure one actually exists at all for this module. 255 -- Note: by looking in the target/output build dir too, we allow 256 -- source files to appear magically in the target build dir without 257 -- any corresponding "real" source file. This lets custom Setup.hs 258 -- files generate source modules directly into the build dir without 259 -- the rest of the build system being aware of it (somewhat dodgy) 260 Nothing -> do 261 bsrcFiles <- findFileWithExtension builtinSuffixes (buildLoc : searchLoc) baseFile 262 case bsrcFiles of 263 Nothing -> 264 die' verbosity $ "can't find source for " ++ baseFile 265 ++ " in " ++ intercalate ", " searchLoc 266 _ -> return () 267 -- found a pre-processable file in one of the source dirs 268 Just (psrcLoc, psrcRelFile) -> do 269 let (srcStem, ext) = splitExtension psrcRelFile 270 psrcFile = psrcLoc </> psrcRelFile 271 pp = fromMaybe (error "Distribution.Simple.PreProcess: Just expected") 272 (lookup (safeTail ext) handlers) 273 -- Preprocessing files for 'sdist' is different from preprocessing 274 -- for 'build'. When preprocessing for sdist we preprocess to 275 -- avoid that the user has to have the preprocessors available. 276 -- ATM, we don't have a way to specify which files are to be 277 -- preprocessed and which not, so for sdist we only process 278 -- platform independent files and put them into the 'buildLoc' 279 -- (which we assume is set to the temp. directory that will become 280 -- the tarball). 281 --TODO: eliminate sdist variant, just supply different handlers 282 when (not forSDist || forSDist && platformIndependent pp) $ do 283 -- look for existing pre-processed source file in the dest dir to 284 -- see if we really have to re-run the preprocessor. 285 ppsrcFiles <- findFileWithExtension builtinSuffixes [buildLoc] baseFile 286 recomp <- case ppsrcFiles of 287 Nothing -> return True 288 Just ppsrcFile -> 289 psrcFile `moreRecentFile` ppsrcFile 290 when recomp $ do 291 let destDir = buildLoc </> dirName srcStem 292 createDirectoryIfMissingVerbose verbosity True destDir 293 runPreProcessorWithHsBootHack pp 294 (psrcLoc, psrcRelFile) 295 (buildLoc, srcStem <.> "hs") 296 297 where 298 dirName = takeDirectory 299 300 -- FIXME: This is a somewhat nasty hack. GHC requires that hs-boot files 301 -- be in the same place as the hs files, so if we put the hs file in dist/ 302 -- then we need to copy the hs-boot file there too. This should probably be 303 -- done another way. Possibly we should also be looking for .lhs-boot 304 -- files, but I think that preprocessors only produce .hs files. 305 runPreProcessorWithHsBootHack pp 306 (inBaseDir, inRelativeFile) 307 (outBaseDir, outRelativeFile) = do 308 runPreProcessor pp 309 (inBaseDir, inRelativeFile) 310 (outBaseDir, outRelativeFile) verbosity 311 312 exists <- doesFileExist inBoot 313 when exists $ copyFileVerbose verbosity inBoot outBoot 314 315 where 316 inBoot = replaceExtension inFile "hs-boot" 317 outBoot = replaceExtension outFile "hs-boot" 318 319 inFile = normalise (inBaseDir </> inRelativeFile) 320 outFile = normalise (outBaseDir </> outRelativeFile) 321 322-- ------------------------------------------------------------ 323-- * known preprocessors 324-- ------------------------------------------------------------ 325 326ppGreenCard :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor 327ppGreenCard _ lbi _ 328 = PreProcessor { 329 platformIndependent = False, 330 runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity -> 331 runDbProgram verbosity greencardProgram (withPrograms lbi) 332 (["-tffi", "-o" ++ outFile, inFile]) 333 } 334 335-- This one is useful for preprocessors that can't handle literate source. 336-- We also need a way to chain preprocessors. 337ppUnlit :: PreProcessor 338ppUnlit = 339 PreProcessor { 340 platformIndependent = True, 341 runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity -> 342 withUTF8FileContents inFile $ \contents -> 343 either (writeUTF8File outFile) (die' verbosity) (unlit inFile contents) 344 } 345 346ppCpp :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor 347ppCpp = ppCpp' [] 348 349ppCpp' :: [String] -> BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor 350ppCpp' extraArgs bi lbi clbi = 351 case compilerFlavor (compiler lbi) of 352 GHC -> ppGhcCpp ghcProgram (const True) args bi lbi clbi 353 GHCJS -> ppGhcCpp ghcjsProgram (const True) args bi lbi clbi 354 _ -> ppCpphs args bi lbi clbi 355 where cppArgs = getCppOptions bi lbi 356 args = cppArgs ++ extraArgs 357 358ppGhcCpp :: Program -> (Version -> Bool) 359 -> [String] -> BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor 360ppGhcCpp program xHs extraArgs _bi lbi clbi = 361 PreProcessor { 362 platformIndependent = False, 363 runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity -> do 364 (prog, version, _) <- requireProgramVersion verbosity 365 program anyVersion (withPrograms lbi) 366 runProgram verbosity prog $ 367 ["-E", "-cpp"] 368 -- This is a bit of an ugly hack. We're going to 369 -- unlit the file ourselves later on if appropriate, 370 -- so we need GHC not to unlit it now or it'll get 371 -- double-unlitted. In the future we might switch to 372 -- using cpphs --unlit instead. 373 ++ (if xHs version then ["-x", "hs"] else []) 374 ++ [ "-optP-include", "-optP"++ (autogenComponentModulesDir lbi clbi </> cppHeaderName) ] 375 ++ ["-o", outFile, inFile] 376 ++ extraArgs 377 } 378 379ppCpphs :: [String] -> BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor 380ppCpphs extraArgs _bi lbi clbi = 381 PreProcessor { 382 platformIndependent = False, 383 runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity -> do 384 (cpphsProg, cpphsVersion, _) <- requireProgramVersion verbosity 385 cpphsProgram anyVersion (withPrograms lbi) 386 runProgram verbosity cpphsProg $ 387 ("-O" ++ outFile) : inFile 388 : "--noline" : "--strip" 389 : (if cpphsVersion >= mkVersion [1,6] 390 then ["--include="++ (autogenComponentModulesDir lbi clbi </> cppHeaderName)] 391 else []) 392 ++ extraArgs 393 } 394 395ppHsc2hs :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor 396ppHsc2hs bi lbi clbi = 397 PreProcessor { 398 platformIndependent = False, 399 runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity -> do 400 (gccProg, _) <- requireProgram verbosity gccProgram (withPrograms lbi) 401 (hsc2hsProg, hsc2hsVersion, _) <- requireProgramVersion verbosity 402 hsc2hsProgram anyVersion (withPrograms lbi) 403 -- See Trac #13896 and https://github.com/haskell/cabal/issues/3122. 404 let isCross = hostPlatform lbi /= buildPlatform 405 prependCrossFlags = if isCross then ("-x":) else id 406 let hsc2hsSupportsResponseFiles = hsc2hsVersion >= mkVersion [0,68,4] 407 pureArgs = genPureArgs gccProg inFile outFile 408 if hsc2hsSupportsResponseFiles 409 then withResponseFile 410 verbosity 411 defaultTempFileOptions 412 (takeDirectory outFile) 413 "hsc2hs-response.txt" 414 Nothing 415 pureArgs 416 (\responseFileName -> 417 runProgram verbosity hsc2hsProg (prependCrossFlags ["@"++ responseFileName])) 418 else runProgram verbosity hsc2hsProg (prependCrossFlags pureArgs) 419 } 420 where 421 -- Returns a list of command line arguments that can either be passed 422 -- directly, or via a response file. 423 genPureArgs :: ConfiguredProgram -> String -> String -> [String] 424 genPureArgs gccProg inFile outFile = 425 [ "--cc=" ++ programPath gccProg 426 , "--ld=" ++ programPath gccProg ] 427 428 -- Additional gcc options 429 ++ [ "--cflag=" ++ opt | opt <- programDefaultArgs gccProg 430 ++ programOverrideArgs gccProg ] 431 ++ [ "--lflag=" ++ opt | opt <- programDefaultArgs gccProg 432 ++ programOverrideArgs gccProg ] 433 434 -- OSX frameworks: 435 ++ [ what ++ "=-F" ++ opt 436 | isOSX 437 , opt <- nub (concatMap Installed.frameworkDirs pkgs) 438 , what <- ["--cflag", "--lflag"] ] 439 ++ [ "--lflag=" ++ arg 440 | isOSX 441 , opt <- PD.frameworks bi ++ concatMap Installed.frameworks pkgs 442 , arg <- ["-framework", opt] ] 443 444 -- Note that on ELF systems, wherever we use -L, we must also use -R 445 -- because presumably that -L dir is not on the normal path for the 446 -- system's dynamic linker. This is needed because hsc2hs works by 447 -- compiling a C program and then running it. 448 449 ++ [ "--cflag=" ++ opt | opt <- platformDefines lbi ] 450 451 -- Options from the current package: 452 ++ [ "--cflag=-I" ++ dir | dir <- PD.includeDirs bi ] 453 ++ [ "--cflag=-I" ++ buildDir lbi </> dir | dir <- PD.includeDirs bi ] 454 ++ [ "--cflag=" ++ opt | opt <- PD.ccOptions bi 455 ++ PD.cppOptions bi 456 -- hsc2hs uses the C ABI 457 -- We assume that there are only C sources 458 -- and C++ functions are exported via a C 459 -- interface and wrapped in a C source file. 460 -- Therefore we do not supply C++ flags 461 -- because there will not be C++ sources. 462 -- 463 -- DO NOT add PD.cxxOptions unless this changes! 464 ] 465 ++ [ "--cflag=" ++ opt | opt <- 466 [ "-I" ++ autogenComponentModulesDir lbi clbi, 467 "-I" ++ autogenPackageModulesDir lbi, 468 "-include", autogenComponentModulesDir lbi clbi </> cppHeaderName ] ] 469 ++ [ "--lflag=-L" ++ opt | opt <- PD.extraLibDirs bi ] 470 ++ [ "--lflag=-Wl,-R," ++ opt | isELF 471 , opt <- PD.extraLibDirs bi ] 472 ++ [ "--lflag=-l" ++ opt | opt <- PD.extraLibs bi ] 473 ++ [ "--lflag=" ++ opt | opt <- PD.ldOptions bi ] 474 475 -- Options from dependent packages 476 ++ [ "--cflag=" ++ opt 477 | pkg <- pkgs 478 , opt <- [ "-I" ++ opt | opt <- Installed.includeDirs pkg ] 479 ++ [ opt | opt <- Installed.ccOptions pkg ] ] 480 ++ [ "--lflag=" ++ opt 481 | pkg <- pkgs 482 , opt <- [ "-L" ++ opt | opt <- Installed.libraryDirs pkg ] 483 ++ [ "-Wl,-R," ++ opt | isELF 484 , opt <- Installed.libraryDirs pkg ] 485 ++ [ "-l" ++ opt | opt <- Installed.extraLibraries pkg ] 486 ++ [ opt | opt <- Installed.ldOptions pkg ] ] 487 ++ ["-o", outFile, inFile] 488 489 hacked_index = packageHacks (installedPkgs lbi) 490 -- Look only at the dependencies of the current component 491 -- being built! This relies on 'installedPkgs' maintaining 492 -- 'InstalledPackageInfo' for internal deps too; see #2971. 493 pkgs = PackageIndex.topologicalOrder $ 494 case PackageIndex.dependencyClosure hacked_index 495 (map fst (componentPackageDeps clbi)) of 496 Left index' -> index' 497 Right inf -> 498 error ("ppHsc2hs: broken closure: " ++ show inf) 499 isOSX = case buildOS of OSX -> True; _ -> False 500 isELF = case buildOS of OSX -> False; Windows -> False; AIX -> False; _ -> True; 501 packageHacks = case compilerFlavor (compiler lbi) of 502 GHC -> hackRtsPackage 503 GHCJS -> hackRtsPackage 504 _ -> id 505 -- We don't link in the actual Haskell libraries of our dependencies, so 506 -- the -u flags in the ldOptions of the rts package mean linking fails on 507 -- OS X (its ld is a tad stricter than gnu ld). Thus we remove the 508 -- ldOptions for GHC's rts package: 509 hackRtsPackage index = 510 case PackageIndex.lookupPackageName index (mkPackageName "rts") of 511 [(_, [rts])] 512 -> PackageIndex.insert rts { Installed.ldOptions = [] } index 513 _ -> error "No (or multiple) ghc rts package is registered!!" 514 515ppHsc2hsExtras :: PreProcessorExtras 516ppHsc2hsExtras buildBaseDir = filter ("_hsc.c" `isSuffixOf`) `fmap` 517 getDirectoryContentsRecursive buildBaseDir 518 519ppC2hs :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor 520ppC2hs bi lbi clbi = 521 PreProcessor { 522 platformIndependent = False, 523 runPreProcessor = \(inBaseDir, inRelativeFile) 524 (outBaseDir, outRelativeFile) verbosity -> do 525 (c2hsProg, _, _) <- requireProgramVersion verbosity 526 c2hsProgram (orLaterVersion (mkVersion [0,15])) 527 (withPrograms lbi) 528 (gccProg, _) <- requireProgram verbosity gccProgram (withPrograms lbi) 529 runProgram verbosity c2hsProg $ 530 531 -- Options from the current package: 532 [ "--cpp=" ++ programPath gccProg, "--cppopts=-E" ] 533 ++ [ "--cppopts=" ++ opt | opt <- getCppOptions bi lbi ] 534 ++ [ "--cppopts=-include" ++ (autogenComponentModulesDir lbi clbi </> cppHeaderName) ] 535 ++ [ "--include=" ++ outBaseDir ] 536 537 -- Options from dependent packages 538 ++ [ "--cppopts=" ++ opt 539 | pkg <- pkgs 540 , opt <- [ "-I" ++ opt | opt <- Installed.includeDirs pkg ] 541 ++ [ opt | opt@('-':c:_) <- Installed.ccOptions pkg 542 -- c2hs uses the C ABI 543 -- We assume that there are only C sources 544 -- and C++ functions are exported via a C 545 -- interface and wrapped in a C source file. 546 -- Therefore we do not supply C++ flags 547 -- because there will not be C++ sources. 548 -- 549 -- 550 -- DO NOT add Installed.cxxOptions unless this changes! 551 , c `elem` "DIU" ] ] 552 --TODO: install .chi files for packages, so we can --include 553 -- those dirs here, for the dependencies 554 555 -- input and output files 556 ++ [ "--output-dir=" ++ outBaseDir 557 , "--output=" ++ outRelativeFile 558 , inBaseDir </> inRelativeFile ] 559 } 560 where 561 pkgs = PackageIndex.topologicalOrder (installedPkgs lbi) 562 563ppC2hsExtras :: PreProcessorExtras 564ppC2hsExtras d = filter (\p -> takeExtensions p == ".chs.c") `fmap` 565 getDirectoryContentsRecursive d 566 567--TODO: perhaps use this with hsc2hs too 568--TODO: remove cc-options from cpphs for cabal-version: >= 1.10 569--TODO: Refactor and add separate getCppOptionsForHs, getCppOptionsForCxx, & getCppOptionsForC 570-- instead of combining all these cases in a single function. This blind combination can 571-- potentially lead to compilation inconsistencies. 572getCppOptions :: BuildInfo -> LocalBuildInfo -> [String] 573getCppOptions bi lbi 574 = platformDefines lbi 575 ++ cppOptions bi 576 ++ ["-I" ++ dir | dir <- PD.includeDirs bi] 577 ++ [opt | opt@('-':c:_) <- PD.ccOptions bi ++ PD.cxxOptions bi, c `elem` "DIU"] 578 579platformDefines :: LocalBuildInfo -> [String] 580platformDefines lbi = 581 case compilerFlavor comp of 582 GHC -> 583 ["-D__GLASGOW_HASKELL__=" ++ versionInt version] ++ 584 ["-D" ++ os ++ "_BUILD_OS=1"] ++ 585 ["-D" ++ arch ++ "_BUILD_ARCH=1"] ++ 586 map (\os' -> "-D" ++ os' ++ "_HOST_OS=1") osStr ++ 587 map (\arch' -> "-D" ++ arch' ++ "_HOST_ARCH=1") archStr 588 GHCJS -> 589 compatGlasgowHaskell ++ 590 ["-D__GHCJS__=" ++ versionInt version] ++ 591 ["-D" ++ os ++ "_BUILD_OS=1"] ++ 592 ["-D" ++ arch ++ "_BUILD_ARCH=1"] ++ 593 map (\os' -> "-D" ++ os' ++ "_HOST_OS=1") osStr ++ 594 map (\arch' -> "-D" ++ arch' ++ "_HOST_ARCH=1") archStr 595 HaskellSuite {} -> 596 ["-D__HASKELL_SUITE__"] ++ 597 map (\os' -> "-D" ++ os' ++ "_HOST_OS=1") osStr ++ 598 map (\arch' -> "-D" ++ arch' ++ "_HOST_ARCH=1") archStr 599 _ -> [] 600 where 601 comp = compiler lbi 602 Platform hostArch hostOS = hostPlatform lbi 603 version = compilerVersion comp 604 compatGlasgowHaskell = 605 maybe [] (\v -> ["-D__GLASGOW_HASKELL__=" ++ versionInt v]) 606 (compilerCompatVersion GHC comp) 607 -- TODO: move this into the compiler abstraction 608 -- FIXME: this forces GHC's crazy 4.8.2 -> 408 convention on all 609 -- the other compilers. Check if that's really what they want. 610 versionInt :: Version -> String 611 versionInt v = case versionNumbers v of 612 [] -> "1" 613 [n] -> show n 614 n1:n2:_ -> 615 -- 6.8.x -> 608 616 -- 6.10.x -> 610 617 let s1 = show n1 618 s2 = show n2 619 middle = case s2 of 620 _ : _ : _ -> "" 621 _ -> "0" 622 in s1 ++ middle ++ s2 623 624 osStr = case hostOS of 625 Linux -> ["linux"] 626 Windows -> ["mingw32"] 627 OSX -> ["darwin"] 628 FreeBSD -> ["freebsd"] 629 OpenBSD -> ["openbsd"] 630 NetBSD -> ["netbsd"] 631 DragonFly -> ["dragonfly"] 632 Solaris -> ["solaris2"] 633 AIX -> ["aix"] 634 HPUX -> ["hpux"] 635 IRIX -> ["irix"] 636 HaLVM -> [] 637 IOS -> ["ios"] 638 Android -> ["android"] 639 Ghcjs -> ["ghcjs"] 640 Hurd -> ["hurd"] 641 OtherOS _ -> [] 642 archStr = case hostArch of 643 I386 -> ["i386"] 644 X86_64 -> ["x86_64"] 645 PPC -> ["powerpc"] 646 PPC64 -> ["powerpc64"] 647 Sparc -> ["sparc"] 648 Arm -> ["arm"] 649 AArch64 -> ["aarch64"] 650 Mips -> ["mips"] 651 SH -> [] 652 IA64 -> ["ia64"] 653 S390 -> ["s390"] 654 Alpha -> ["alpha"] 655 Hppa -> ["hppa"] 656 Rs6000 -> ["rs6000"] 657 M68k -> ["m68k"] 658 Vax -> ["vax"] 659 JavaScript -> ["javascript"] 660 OtherArch _ -> [] 661 662ppHappy :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor 663ppHappy _ lbi _ = pp { platformIndependent = True } 664 where pp = standardPP lbi happyProgram (hcFlags hc) 665 hc = compilerFlavor (compiler lbi) 666 hcFlags GHC = ["-agc"] 667 hcFlags GHCJS = ["-agc"] 668 hcFlags _ = [] 669 670ppAlex :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor 671ppAlex _ lbi _ = pp { platformIndependent = True } 672 where pp = standardPP lbi alexProgram (hcFlags hc) 673 hc = compilerFlavor (compiler lbi) 674 hcFlags GHC = ["-g"] 675 hcFlags GHCJS = ["-g"] 676 hcFlags _ = [] 677 678standardPP :: LocalBuildInfo -> Program -> [String] -> PreProcessor 679standardPP lbi prog args = 680 PreProcessor { 681 platformIndependent = False, 682 runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity -> 683 runDbProgram verbosity prog (withPrograms lbi) 684 (args ++ ["-o", outFile, inFile]) 685 } 686 687-- |Convenience function; get the suffixes of these preprocessors. 688ppSuffixes :: [ PPSuffixHandler ] -> [String] 689ppSuffixes = map fst 690 691-- |Standard preprocessors: GreenCard, c2hs, hsc2hs, happy, alex and cpphs. 692knownSuffixHandlers :: [ PPSuffixHandler ] 693knownSuffixHandlers = 694 [ ("gc", ppGreenCard) 695 , ("chs", ppC2hs) 696 , ("hsc", ppHsc2hs) 697 , ("x", ppAlex) 698 , ("y", ppHappy) 699 , ("ly", ppHappy) 700 , ("cpphs", ppCpp) 701 ] 702 703-- |Standard preprocessors with possible extra C sources: c2hs, hsc2hs. 704knownExtrasHandlers :: [ WrappedPreProcessorExtras ] 705knownExtrasHandlers = [ WrapPPE ppC2hsExtras, WrapPPE ppHsc2hsExtras ] 706 707-- | Find any extra C sources generated by preprocessing that need to 708-- be added to the component (addresses issue #238). 709preprocessExtras :: Verbosity 710 -> Component 711 -> LocalBuildInfo 712 -> IO [FilePath] 713preprocessExtras verbosity comp lbi = case comp of 714 CLib _ -> pp $ buildDir lbi 715 (CExe Executable { exeName = nm }) -> do 716 let nm' = unUnqualComponentName nm 717 pp $ buildDir lbi </> nm' </> nm' ++ "-tmp" 718 (CFLib ForeignLib { foreignLibName = nm }) -> do 719 let nm' = unUnqualComponentName nm 720 pp $ buildDir lbi </> nm' </> nm' ++ "-tmp" 721 CTest test -> do 722 let nm' = unUnqualComponentName $ testName test 723 case testInterface test of 724 TestSuiteExeV10 _ _ -> 725 pp $ buildDir lbi </> nm' </> nm' ++ "-tmp" 726 TestSuiteLibV09 _ _ -> 727 pp $ buildDir lbi </> stubName test </> stubName test ++ "-tmp" 728 TestSuiteUnsupported tt -> 729 die' verbosity $ "No support for preprocessing test suite type " ++ 730 prettyShow tt 731 CBench bm -> do 732 let nm' = unUnqualComponentName $ benchmarkName bm 733 case benchmarkInterface bm of 734 BenchmarkExeV10 _ _ -> 735 pp $ buildDir lbi </> nm' </> nm' ++ "-tmp" 736 BenchmarkUnsupported tt -> 737 die' verbosity $ "No support for preprocessing benchmark " 738 ++ "type " ++ prettyShow tt 739 where 740 pp :: FilePath -> IO [FilePath] 741 pp dir = (map (dir </>) . filter not_sub . concat) 742 <$> for knownExtrasHandlers 743 (withLexicalCallStack (\f -> f dir) . unWrapPPE) 744 -- TODO: This is a terrible hack to work around #3545 while we don't 745 -- reorganize the directory layout. Basically, for the main 746 -- library, we might accidentally pick up autogenerated sources for 747 -- our subcomponents, because they are all stored as subdirectories 748 -- in dist/build. This is a cheap and cheerful check to prevent 749 -- this from happening. It is not particularly correct; for example 750 -- if a user has a test suite named foobar and puts their C file in 751 -- foobar/foo.c, this test will incorrectly exclude it. But I 752 -- didn't want to break BC... 753 not_sub p = and [ not (pre `isPrefixOf` p) | pre <- component_dirs ] 754 component_dirs = component_names (localPkgDescr lbi) 755 -- TODO: libify me 756 component_names pkg_descr = fmap unUnqualComponentName $ 757 mapMaybe (libraryNameString . libName) (subLibraries pkg_descr) ++ 758 map exeName (executables pkg_descr) ++ 759 map testName (testSuites pkg_descr) ++ 760 map benchmarkName (benchmarks pkg_descr) 761