content: -----------------------------------------------------------------------------
  -- |
  -- Module      :  Distribution.Simple.PreProcess
  -- Copyright   :  (c) 2003-2005, Isaac Jones, Malcolm Wallace
  -- License     :  BSD3
  --
  -- Maintainer  :  cabal-devel@haskell.org
  -- Portability :  portable
  --
  -- This defines a 'PreProcessor' abstraction which represents a pre-processor
  -- that can transform one kind of file into another. There is also a
  -- 'PPSuffixHandler' which is a combination of a file extension and a function
  -- for configuring a 'PreProcessor'. It defines a bunch of known built-in
  -- preprocessors like @cpp@, @cpphs@, @c2hs@, @hsc2hs@, @happy@, @alex@ etc and
  -- lists them in 'knownSuffixHandlers'. On top of this it provides a function
  -- for actually preprocessing some sources given a bunch of known suffix
  -- handlers. This module is not as good as it could be, it could really do with
  -- a rewrite to address some of the problems we have with pre-processors.
  
  module Distribution.Simple.PreProcess (preprocessComponent, knownSuffixHandlers,
                                  ppSuffixes, PPSuffixHandler, PreProcessor(..),
                                  mkSimplePreProcessor, runSimplePreProcessor,
                                  ppCpp, ppCpp', ppGreenCard, ppC2hs, ppHsc2hs,
                                  ppHappy, ppAlex, ppUnlit, platformDefines
                                 )
      where
  
  
  import Control.Monad
  import Distribution.Simple.PreProcess.Unlit (unlit)
  import Distribution.Package
           ( Package(..), PackageName(..) )
  import qualified Distribution.ModuleName as ModuleName
  import Distribution.PackageDescription as PD
           ( PackageDescription(..), BuildInfo(..)
           , Executable(..)
           , Library(..), libModules
           , TestSuite(..), testModules
           , TestSuiteInterface(..)
           , Benchmark(..), benchmarkModules, BenchmarkInterface(..) )
  import qualified Distribution.InstalledPackageInfo as Installed
           ( InstalledPackageInfo_(..) )
  import qualified Distribution.Simple.PackageIndex as PackageIndex
  import Distribution.Simple.CCompiler
           ( cSourceExtensions )
  import Distribution.Simple.Compiler
           ( CompilerFlavor(..)
           , compilerFlavor, compilerCompatVersion, compilerVersion )
  import Distribution.Simple.LocalBuildInfo
           ( LocalBuildInfo(..), Component(..) )
  import Distribution.Simple.BuildPaths (autogenModulesDir,cppHeaderName)
  import Distribution.Simple.Utils
           ( createDirectoryIfMissingVerbose, withUTF8FileContents, writeUTF8File
           , die, setupMessage, intercalate, copyFileVerbose, moreRecentFile
           , findFileWithExtension, findFileWithExtension' )
  import Distribution.Simple.Program
           ( Program(..), ConfiguredProgram(..), programPath
           , requireProgram, requireProgramVersion
           , rawSystemProgramConf, rawSystemProgram
           , greencardProgram, cpphsProgram, hsc2hsProgram, c2hsProgram
           , happyProgram, alexProgram, ghcProgram, ghcjsProgram, gccProgram )
  import Distribution.Simple.Test.LibV09
           ( writeSimpleTestStub, stubFilePath, stubName )
  import Distribution.System
           ( OS(..), buildOS, Arch(..), Platform(..) )
  import Distribution.Text
  import Distribution.Version
           ( Version(..), anyVersion, orLaterVersion )
  import Distribution.Verbosity
  
  import Data.Maybe (fromMaybe)
  import Data.List (nub)
  import System.Directory (doesFileExist)
  import System.Info (os, arch)
  import System.FilePath (splitExtension, dropExtensions, (</>), (<.>),
                          takeDirectory, normalise, replaceExtension)
  
  -- |The interface to a preprocessor, which may be implemented using an
  -- external program, but need not be.  The arguments are the name of
  -- the input file, the name of the output file and a verbosity level.
  -- Here is a simple example that merely prepends a comment to the given
  -- source file:
  --
  -- > ppTestHandler :: PreProcessor
  -- > ppTestHandler =
  -- >   PreProcessor {
  -- >     platformIndependent = True,
  -- >     runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity ->
  -- >       do info verbosity (inFile++" has been preprocessed to "++outFile)
  -- >          stuff <- readFile inFile
  -- >          writeFile outFile ("-- preprocessed as a test\n\n" ++ stuff)
  -- >          return ExitSuccess
  --
  -- We split the input and output file names into a base directory and the
  -- rest of the file name. The input base dir is the path in the list of search
  -- dirs that this file was found in. The output base dir is the build dir where
  -- all the generated source files are put.
  --
  -- The reason for splitting it up this way is that some pre-processors don't
  -- simply generate one output .hs file from one input file but have
  -- dependencies on other generated files (notably c2hs, where building one
  -- .hs file may require reading other .chi files, and then compiling the .hs
  -- file may require reading a generated .h file). In these cases the generated
  -- files need to embed relative path names to each other (eg the generated .hs
  -- file mentions the .h file in the FFI imports). This path must be relative to
  -- the base directory where the generated files are located, it cannot be
  -- relative to the top level of the build tree because the compilers do not
  -- look for .h files relative to there, ie we do not use \"-I .\", instead we
  -- use \"-I dist\/build\" (or whatever dist dir has been set by the user)
  --
  -- Most pre-processors do not care of course, so mkSimplePreProcessor and
  -- runSimplePreProcessor functions handle the simple case.
  --
  data PreProcessor = PreProcessor {
  
    -- Is the output of the pre-processor platform independent? eg happy output
    -- is portable haskell but c2hs's output is platform dependent.
    -- This matters since only platform independent generated code can be
    -- inlcuded into a source tarball.
    platformIndependent :: Bool,
  
    -- TODO: deal with pre-processors that have implementaion dependent output
    --       eg alex and happy have --ghc flags. However we can't really inlcude
    --       ghc-specific code into supposedly portable source tarballs.
  
    runPreProcessor :: (FilePath, FilePath) -- Location of the source file relative to a base dir
                    -> (FilePath, FilePath) -- Output file name, relative to an output base dir
                    -> Verbosity -- verbosity
                    -> IO ()     -- Should exit if the preprocessor fails
    }
  
  mkSimplePreProcessor :: (FilePath -> FilePath -> Verbosity -> IO ())
                        -> (FilePath, FilePath)
                        -> (FilePath, FilePath) -> Verbosity -> IO ()
  mkSimplePreProcessor simplePP
    (inBaseDir, inRelativeFile)
    (outBaseDir, outRelativeFile) verbosity = simplePP inFile outFile verbosity
    where inFile  = normalise (inBaseDir  </> inRelativeFile)
          outFile = normalise (outBaseDir </> outRelativeFile)
  
  runSimplePreProcessor :: PreProcessor -> FilePath -> FilePath -> Verbosity
                        -> IO ()
  runSimplePreProcessor pp inFile outFile verbosity =
    runPreProcessor pp (".", inFile) (".", outFile) verbosity
  
  -- |A preprocessor for turning non-Haskell files with the given extension
  -- into plain Haskell source files.
  type PPSuffixHandler
      = (String, BuildInfo -> LocalBuildInfo -> PreProcessor)
  
  -- | Apply preprocessors to the sources from 'hsSourceDirs' for a given
  -- component (lib, exe, or test suite).
  preprocessComponent :: PackageDescription
                      -> Component
                      -> LocalBuildInfo
                      -> Bool
                      -> Verbosity
                      -> [PPSuffixHandler]
                      -> IO ()
  preprocessComponent pd comp lbi isSrcDist verbosity handlers = case comp of
    (CLib lib@Library{ libBuildInfo = bi }) -> do
      let dirs = hsSourceDirs bi ++ [autogenModulesDir lbi]
      setupMessage verbosity "Preprocessing library" (packageId pd)
      forM_ (map ModuleName.toFilePath $ libModules lib) $
        pre dirs (buildDir lbi) (localHandlers bi)
    (CExe exe@Executable { buildInfo = bi, exeName = nm }) -> do
      let exeDir = buildDir lbi </> nm </> nm ++ "-tmp"
          dirs   = hsSourceDirs bi ++ [autogenModulesDir lbi]
      setupMessage verbosity ("Preprocessing executable '" ++ nm ++ "' for") (packageId pd)
      forM_ (map ModuleName.toFilePath $ otherModules bi) $
        pre dirs exeDir (localHandlers bi)
      pre (hsSourceDirs bi) exeDir (localHandlers bi) $
        dropExtensions (modulePath exe)
    CTest test@TestSuite{ testName = nm } -> do
      setupMessage verbosity ("Preprocessing test suite '" ++ nm ++ "' for") (packageId pd)
      case testInterface test of
        TestSuiteExeV10 _ f ->
            preProcessTest test f $ buildDir lbi </> testName test
                </> testName test ++ "-tmp"
        TestSuiteLibV09 _ _ -> do
            let testDir = buildDir lbi </> stubName test
                    </> stubName test ++ "-tmp"
            writeSimpleTestStub test testDir
            preProcessTest test (stubFilePath test) testDir
        TestSuiteUnsupported tt -> die $ "No support for preprocessing test "
                                      ++ "suite type " ++ display tt
    CBench bm@Benchmark{ benchmarkName = nm } -> do
      setupMessage verbosity ("Preprocessing benchmark '" ++ nm ++ "' for") (packageId pd)
      case benchmarkInterface bm of
        BenchmarkExeV10 _ f ->
            preProcessBench bm f $ buildDir lbi </> benchmarkName bm
                </> benchmarkName bm ++ "-tmp"
        BenchmarkUnsupported tt -> die $ "No support for preprocessing benchmark "
                                   ++ "type " ++ display tt
    where
      builtinHaskellSuffixes = ["hs", "lhs", "hsig", "lhsig"]
      builtinCSuffixes       = cSourceExtensions
      builtinSuffixes        = builtinHaskellSuffixes ++ builtinCSuffixes
      localHandlers bi = [(ext, h bi lbi) | (ext, h) <- handlers]
      pre dirs dir lhndlrs fp =
        preprocessFile dirs dir isSrcDist fp verbosity builtinSuffixes lhndlrs
      preProcessTest test = preProcessComponent (testBuildInfo test)
                            (testModules test)
      preProcessBench bm = preProcessComponent (benchmarkBuildInfo bm)
                           (benchmarkModules bm)
      preProcessComponent bi modules exePath dir = do
          let biHandlers = localHandlers bi
              sourceDirs = hsSourceDirs bi ++ [ autogenModulesDir lbi ]
          sequence_ [ preprocessFile sourceDirs dir isSrcDist
                  (ModuleName.toFilePath modu) verbosity builtinSuffixes
                  biHandlers
                  | modu <- modules ]
          preprocessFile (dir : (hsSourceDirs bi)) dir isSrcDist
              (dropExtensions $ exePath) verbosity
              builtinSuffixes biHandlers
  
  --TODO: try to list all the modules that could not be found
  --      not just the first one. It's annoying and slow due to the need
  --      to reconfigure after editing the .cabal file each time.
  
  -- |Find the first extension of the file that exists, and preprocess it
  -- if required.
  preprocessFile
      :: [FilePath]               -- ^source directories
      -> FilePath                 -- ^build directory
      -> Bool                     -- ^preprocess for sdist
      -> FilePath                 -- ^module file name
      -> Verbosity                -- ^verbosity
      -> [String]                 -- ^builtin suffixes
      -> [(String, PreProcessor)] -- ^possible preprocessors
      -> IO ()
  preprocessFile searchLoc buildLoc forSDist baseFile verbosity builtinSuffixes handlers = do
      -- look for files in the various source dirs with this module name
      -- and a file extension of a known preprocessor
      psrcFiles <- findFileWithExtension' (map fst handlers) searchLoc baseFile
      case psrcFiles of
          -- no preprocessor file exists, look for an ordinary source file
          -- just to make sure one actually exists at all for this module.
          -- Note: by looking in the target/output build dir too, we allow
          -- source files to appear magically in the target build dir without
          -- any corresponding "real" source file. This lets custom Setup.hs
          -- files generate source modules directly into the build dir without
          -- the rest of the build system being aware of it (somewhat dodgy)
        Nothing -> do
                   bsrcFiles <- findFileWithExtension builtinSuffixes (buildLoc : searchLoc) baseFile
                   case bsrcFiles of
                    Nothing -> die $ "can't find source for " ++ baseFile
                                  ++ " in " ++ intercalate ", " searchLoc
                    _       -> return ()
          -- found a pre-processable file in one of the source dirs
        Just (psrcLoc, psrcRelFile) -> do
              let (srcStem, ext) = splitExtension psrcRelFile
                  psrcFile = psrcLoc </> psrcRelFile
                  pp = fromMaybe (error "Internal error in preProcess module: Just expected")
                                 (lookup (tailNotNull ext) handlers)
              -- Preprocessing files for 'sdist' is different from preprocessing
              -- for 'build'.  When preprocessing for sdist we preprocess to
              -- avoid that the user has to have the preprocessors available.
              -- ATM, we don't have a way to specify which files are to be
              -- preprocessed and which not, so for sdist we only process
              -- platform independent files and put them into the 'buildLoc'
              -- (which we assume is set to the temp. directory that will become
              -- the tarball).
              --TODO: eliminate sdist variant, just supply different handlers
              when (not forSDist || forSDist && platformIndependent pp) $ do
                -- look for existing pre-processed source file in the dest dir to
                -- see if we really have to re-run the preprocessor.
                ppsrcFiles <- findFileWithExtension builtinSuffixes [buildLoc] baseFile
                recomp <- case ppsrcFiles of
                            Nothing -> return True
                            Just ppsrcFile ->
                                psrcFile `moreRecentFile` ppsrcFile
                when recomp $ do
                  let destDir = buildLoc </> dirName srcStem
                  createDirectoryIfMissingVerbose verbosity True destDir
                  runPreProcessorWithHsBootHack pp
                     (psrcLoc, psrcRelFile)
                     (buildLoc, srcStem <.> "hs")
  
    where
      dirName = takeDirectory
      tailNotNull [] = []
      tailNotNull x  = tail x
  
      -- FIXME: This is a somewhat nasty hack. GHC requires that hs-boot files
      -- be in the same place as the hs files, so if we put the hs file in dist/
      -- then we need to copy the hs-boot file there too. This should probably be
      -- done another way. Possibly we should also be looking for .lhs-boot
      -- files, but I think that preprocessors only produce .hs files.
      runPreProcessorWithHsBootHack pp
        (inBaseDir,  inRelativeFile)
        (outBaseDir, outRelativeFile) = do
          runPreProcessor pp
            (inBaseDir, inRelativeFile)
            (outBaseDir, outRelativeFile) verbosity
  
          exists <- doesFileExist inBoot
          when exists $ copyFileVerbose verbosity inBoot outBoot
  
        where
          inBoot  = replaceExtension inFile  "hs-boot"
          outBoot = replaceExtension outFile "hs-boot"
  
          inFile  = normalise (inBaseDir  </> inRelativeFile)
          outFile = normalise (outBaseDir </> outRelativeFile)
  
  -- ------------------------------------------------------------
  -- * known preprocessors
  -- ------------------------------------------------------------
  
  ppGreenCard :: BuildInfo -> LocalBuildInfo -> PreProcessor
  ppGreenCard _ lbi
      = PreProcessor {
          platformIndependent = False,
          runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity ->
            rawSystemProgramConf verbosity greencardProgram (withPrograms lbi)
                (["-tffi", "-o" ++ outFile, inFile])
        }
  
  -- This one is useful for preprocessors that can't handle literate source.
  -- We also need a way to chain preprocessors.
  ppUnlit :: PreProcessor
  ppUnlit =
    PreProcessor {
      platformIndependent = True,
      runPreProcessor = mkSimplePreProcessor $ \inFile outFile _verbosity ->
        withUTF8FileContents inFile $ \contents ->
          either (writeUTF8File outFile) die (unlit inFile contents)
    }
  
  ppCpp :: BuildInfo -> LocalBuildInfo -> PreProcessor
  ppCpp = ppCpp' []
  
  ppCpp' :: [String] -> BuildInfo -> LocalBuildInfo -> PreProcessor
  ppCpp' extraArgs bi lbi =
    case compilerFlavor (compiler lbi) of
      GHC   -> ppGhcCpp ghcProgram   (>= Version [6,6] []) args bi lbi
      GHCJS -> ppGhcCpp ghcjsProgram (const True)          args bi lbi
      _     -> ppCpphs  args bi lbi
    where cppArgs = getCppOptions bi lbi
          args    = cppArgs ++ extraArgs
  
  ppGhcCpp :: Program -> (Version -> Bool)
           -> [String] -> BuildInfo -> LocalBuildInfo -> PreProcessor
  ppGhcCpp program xHs extraArgs _bi lbi =
    PreProcessor {
      platformIndependent = False,
      runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity -> do
        (prog, version, _) <- requireProgramVersion verbosity
                                program anyVersion (withPrograms lbi)
        rawSystemProgram verbosity prog $
            ["-E", "-cpp"]
            -- This is a bit of an ugly hack. We're going to
            -- unlit the file ourselves later on if appropriate,
            -- so we need GHC not to unlit it now or it'll get
            -- double-unlitted. In the future we might switch to
            -- using cpphs --unlit instead.
         ++ (if xHs version then ["-x", "hs"] else [])
         ++ [ "-optP-include", "-optP"++ (autogenModulesDir lbi </> cppHeaderName) ]
         ++ ["-o", outFile, inFile]
         ++ extraArgs
    }
  
  ppCpphs :: [String] -> BuildInfo -> LocalBuildInfo -> PreProcessor
  ppCpphs extraArgs _bi lbi =
    PreProcessor {
      platformIndependent = False,
      runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity -> do
        (cpphsProg, cpphsVersion, _) <- requireProgramVersion verbosity
                                          cpphsProgram anyVersion (withPrograms lbi)
        rawSystemProgram verbosity cpphsProg $
            ("-O" ++ outFile) : inFile
          : "--noline" : "--strip"
          : (if cpphsVersion >= Version [1,6] []
               then ["--include="++ (autogenModulesDir lbi </> cppHeaderName)]
               else [])
          ++ extraArgs
    }
  
  ppHsc2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor
  ppHsc2hs bi lbi =
    PreProcessor {
      platformIndependent = False,
      runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity -> do
        (gccProg, _) <- requireProgram verbosity gccProgram (withPrograms lbi)
        rawSystemProgramConf verbosity hsc2hsProgram (withPrograms lbi) $
            [ "--cc=" ++ programPath gccProg
            , "--ld=" ++ programPath gccProg ]
  
            -- Additional gcc options
         ++ [ "--cflag=" ++ opt | opt <- programDefaultArgs  gccProg
                                      ++ programOverrideArgs gccProg ]
         ++ [ "--lflag=" ++ opt | opt <- programDefaultArgs  gccProg
                                      ++ programOverrideArgs gccProg ]
  
            -- OSX frameworks:
         ++ [ what ++ "=-F" ++ opt
            | isOSX
            , opt <- nub (concatMap Installed.frameworkDirs pkgs)
            , what <- ["--cflag", "--lflag"] ]
         ++ [ "--lflag=" ++ arg
            | isOSX
            , opt <- PD.frameworks bi ++ concatMap Installed.frameworks pkgs
            , arg <- ["-framework", opt] ]
  
            -- Note that on ELF systems, wherever we use -L, we must also use -R
            -- because presumably that -L dir is not on the normal path for the
            -- system's dynamic linker. This is needed because hsc2hs works by
            -- compiling a C program and then running it.
  
         ++ [ "--cflag="   ++ opt | opt <- platformDefines lbi ]
  
            -- Options from the current package:
         ++ [ "--cflag=-I" ++ dir | dir <- PD.includeDirs  bi ]
         ++ [ "--cflag="   ++ opt | opt <- PD.ccOptions    bi
                                        ++ PD.cppOptions   bi ]
         ++ [ "--cflag="   ++ opt | opt <-
                 [ "-I" ++ autogenModulesDir lbi,
                   "-include", autogenModulesDir lbi </> cppHeaderName ] ]
         ++ [ "--lflag=-L" ++ opt | opt <- PD.extraLibDirs bi ]
         ++ [ "--lflag=-Wl,-R," ++ opt | isELF
                                  , opt <- PD.extraLibDirs bi ]
         ++ [ "--lflag=-l" ++ opt | opt <- PD.extraLibs    bi ]
         ++ [ "--lflag="   ++ opt | opt <- PD.ldOptions    bi ]
  
            -- Options from dependent packages
         ++ [ "--cflag=" ++ opt
            | pkg <- pkgs
            , opt <- [ "-I" ++ opt | opt <- Installed.includeDirs pkg ]
                  ++ [         opt | opt <- Installed.ccOptions   pkg ] ]
         ++ [ "--lflag=" ++ opt
            | pkg <- pkgs
            , opt <- [ "-L" ++ opt | opt <- Installed.libraryDirs    pkg ]
                  ++ [ "-Wl,-R," ++ opt | isELF
                                   , opt <- Installed.libraryDirs    pkg ]
                  ++ [ "-l" ++ opt | opt <- Installed.extraLibraries pkg ]
                  ++ [         opt | opt <- Installed.ldOptions      pkg ] ]
         ++ ["-o", outFile, inFile]
    }
    where
      pkgs = PackageIndex.topologicalOrder (packageHacks (installedPkgs lbi))
      isOSX = case buildOS of OSX -> True; _ -> False
      isELF = case buildOS of OSX -> False; Windows -> False; _ -> True;
      packageHacks = case compilerFlavor (compiler lbi) of
        GHC   -> hackRtsPackage
        GHCJS -> hackRtsPackage
        _     -> id
      -- We don't link in the actual Haskell libraries of our dependencies, so
      -- the -u flags in the ldOptions of the rts package mean linking fails on
      -- OS X (it's ld is a tad stricter than gnu ld). Thus we remove the
      -- ldOptions for GHC's rts package:
      hackRtsPackage index =
        case PackageIndex.lookupPackageName index (PackageName "rts") of
          [(_, [rts])]
             -> PackageIndex.insert rts { Installed.ldOptions = [] } index
          _  -> error "No (or multiple) ghc rts package is registered!!"
  
  
  ppC2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor
  ppC2hs bi lbi =
    PreProcessor {
      platformIndependent = False,
      runPreProcessor = \(inBaseDir, inRelativeFile)
                         (outBaseDir, outRelativeFile) verbosity -> do
        (c2hsProg, _, _) <- requireProgramVersion verbosity
                              c2hsProgram (orLaterVersion (Version [0,15] []))
                              (withPrograms lbi)
        (gccProg, _) <- requireProgram verbosity gccProgram (withPrograms lbi)
        rawSystemProgram verbosity c2hsProg $
  
            -- Options from the current package:
             [ "--cpp=" ++ programPath gccProg, "--cppopts=-E" ]
          ++ [ "--cppopts=" ++ opt | opt <- getCppOptions bi lbi ]
          ++ [ "--include=" ++ outBaseDir ]
  
            -- Options from dependent packages
         ++ [ "--cppopts=" ++ opt
            | pkg <- pkgs
            , opt <- [ "-I" ++ opt | opt <- Installed.includeDirs pkg ]
                  ++ [         opt | opt@('-':c:_) <- Installed.ccOptions pkg
                                   , c `elem` "DIU" ] ]
            --TODO: install .chi files for packages, so we can --include
            -- those dirs here, for the dependencies
  
             -- input and output files
          ++ [ "--output-dir=" ++ outBaseDir
             , "--output=" ++ outRelativeFile
             , inBaseDir </> inRelativeFile ]
    }
    where
      pkgs = PackageIndex.topologicalOrder (installedPkgs lbi)
  
  --TODO: perhaps use this with hsc2hs too
  --TODO: remove cc-options from cpphs for cabal-version: >= 1.10
  getCppOptions :: BuildInfo -> LocalBuildInfo -> [String]
  getCppOptions bi lbi
      = platformDefines lbi
     ++ cppOptions bi
     ++ ["-I" ++ dir | dir <- PD.includeDirs bi]
     ++ [opt | opt@('-':c:_) <- PD.ccOptions bi, c `elem` "DIU"]
  
  platformDefines :: LocalBuildInfo -> [String]
  platformDefines lbi =
    case compilerFlavor comp of
      GHC  ->
        ["-D__GLASGOW_HASKELL__=" ++ versionInt version] ++
        ["-D" ++ os   ++ "_BUILD_OS=1"] ++
        ["-D" ++ arch ++ "_BUILD_ARCH=1"] ++
        map (\os'   -> "-D" ++ os'   ++ "_HOST_OS=1")   osStr ++
        map (\arch' -> "-D" ++ arch' ++ "_HOST_ARCH=1") archStr
      GHCJS ->
        compatGlasgowHaskell ++
        ["-D__GHCJS__=" ++ versionInt version] ++
        ["-D" ++ os   ++ "_BUILD_OS=1"] ++
        ["-D" ++ arch ++ "_BUILD_ARCH=1"] ++
        map (\os'   -> "-D" ++ os'   ++ "_HOST_OS=1")   osStr ++
        map (\arch' -> "-D" ++ arch' ++ "_HOST_ARCH=1") archStr
      JHC  -> ["-D__JHC__=" ++ versionInt version]
      HaskellSuite {} ->
        ["-D__HASKELL_SUITE__"] ++
          map (\os'   -> "-D" ++ os'   ++ "_HOST_OS=1")   osStr ++
          map (\arch' -> "-D" ++ arch' ++ "_HOST_ARCH=1") archStr
      _    -> []
    where
      comp = compiler lbi
      Platform hostArch hostOS = hostPlatform lbi
      version = compilerVersion comp
      compatGlasgowHaskell =
        maybe [] (\v -> ["-D__GLASGOW_HASKELL__=" ++ versionInt v])
                 (compilerCompatVersion GHC comp)
      -- TODO: move this into the compiler abstraction
      -- FIXME: this forces GHC's crazy 4.8.2 -> 408 convention on all
      -- the other compilers. Check if that's really what they want.
      versionInt :: Version -> String
      versionInt (Version { versionBranch = [] }) = "1"
      versionInt (Version { versionBranch = [n] }) = show n
      versionInt (Version { versionBranch = n1:n2:_ })
        = -- 6.8.x -> 608
          -- 6.10.x -> 610
          let s1 = show n1
              s2 = show n2
              middle = case s2 of
                       _ : _ : _ -> ""
                       _         -> "0"
          in s1 ++ middle ++ s2
      osStr = case hostOS of
        Linux     -> ["linux"]
        Windows   -> ["mingw32"]
        OSX       -> ["darwin"]
        FreeBSD   -> ["freebsd"]
        OpenBSD   -> ["openbsd"]
        NetBSD    -> ["netbsd"]
        DragonFly -> ["dragonfly"]
        Solaris   -> ["solaris2"]
        AIX       -> ["aix"]
        HPUX      -> ["hpux"]
        IRIX      -> ["irix"]
        HaLVM     -> []
        IOS       -> ["ios"]
        Ghcjs     -> ["ghcjs"]
        OtherOS _ -> []
      archStr = case hostArch of
        I386        -> ["i386"]
        X86_64      -> ["x86_64"]
        PPC         -> ["powerpc"]
        PPC64       -> ["powerpc64"]
        Sparc       -> ["sparc"]
        Arm         -> ["arm"]
        Mips        -> ["mips"]
        SH          -> []
        IA64        -> ["ia64"]
        S390        -> ["s390"]
        Alpha       -> ["alpha"]
        Hppa        -> ["hppa"]
        Rs6000      -> ["rs6000"]
        M68k        -> ["m68k"]
        Vax         -> ["vax"]
        JavaScript  -> ["javascript"]
        OtherArch _ -> []
  
  ppHappy :: BuildInfo -> LocalBuildInfo -> PreProcessor
  ppHappy _ lbi = pp { platformIndependent = True }
    where pp = standardPP lbi happyProgram (hcFlags hc)
          hc = compilerFlavor (compiler lbi)
          hcFlags GHC = ["-agc"]
          hcFlags GHCJS = ["-agc"]
          hcFlags _ = []
  
  ppAlex :: BuildInfo -> LocalBuildInfo -> PreProcessor
  ppAlex _ lbi = pp { platformIndependent = True }
    where pp = standardPP lbi alexProgram (hcFlags hc)
          hc = compilerFlavor (compiler lbi)
          hcFlags GHC = ["-g"]
          hcFlags GHCJS = ["-g"]
          hcFlags _ = []
  
  standardPP :: LocalBuildInfo -> Program -> [String] -> PreProcessor
  standardPP lbi prog args =
    PreProcessor {
      platformIndependent = False,
      runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity ->
        rawSystemProgramConf verbosity prog (withPrograms lbi)
                             (args ++ ["-o", outFile, inFile])
    }
  
  -- |Convenience function; get the suffixes of these preprocessors.
  ppSuffixes :: [ PPSuffixHandler ] -> [String]
  ppSuffixes = map fst
  
  -- |Standard preprocessors: GreenCard, c2hs, hsc2hs, happy, alex and cpphs.
  knownSuffixHandlers :: [ PPSuffixHandler ]
  knownSuffixHandlers =
    [ ("gc",     ppGreenCard)
    , ("chs",    ppC2hs)
    , ("hsc",    ppHsc2hs)
    , ("x",      ppAlex)
    , ("y",      ppHappy)
    , ("ly",     ppHappy)
    , ("cpphs",  ppCpp)
    ]
  