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