Cabal/src/Distribution/Simple/PreProcess.hs

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