Cabal/Distribution/Simple/PreProcess.hs

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