{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}

-----------------------------------------------------------------------------

-- |
-- Module      :  Distribution.Simple.PreProcess
-- Copyright   :  (c) 2003-2005, Isaac Jones, Malcolm Wallace
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This module defines 'PPSuffixHandler', which is a combination of a file
-- extension and a function for configuring a 'PreProcessor'. It also 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
  , preprocessExtras
  , preprocessFile
  , knownSuffixHandlers
  , ppSuffixes
  , PPSuffixHandler
  , Suffix (..)
  , builtinHaskellSuffixes
  , builtinHaskellBootSuffixes
  , PreProcessor (..)
  , mkSimplePreProcessor
  , runSimplePreProcessor
  , ppCpp
  , ppCpp'
  , ppC2hs
  , ppHsc2hs
  , ppHappy
  , ppAlex
  , ppUnlit
  , platformDefines
  , unsorted
  )
where

import Distribution.Compat.Prelude
import Distribution.Compat.Stack
import Prelude ()

import Distribution.Backpack.DescribeUnitId
import qualified Distribution.InstalledPackageInfo as Installed
import Distribution.ModuleName (ModuleName)
import Distribution.Package
import Distribution.PackageDescription as PD
import Distribution.Simple.BuildPaths
import Distribution.Simple.CCompiler
import Distribution.Simple.Compiler
import Distribution.Simple.Errors
import Distribution.Simple.LocalBuildInfo
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.PreProcess.Types
import Distribution.Simple.PreProcess.Unlit
import Distribution.Simple.Program
import Distribution.Simple.Program.ResponseFile
import Distribution.Simple.Test.LibV09
import Distribution.Simple.Utils
import Distribution.System
import Distribution.Types.PackageName.Magic
import Distribution.Utils.Path
import Distribution.Verbosity
import Distribution.Version

import System.Directory (doesDirectoryExist, doesFileExist)
import System.FilePath
  ( normalise
  , replaceExtension
  , splitExtension
  , takeDirectory
  , takeExtensions
  )
import System.Info (arch, os)

-- | Just present the modules in the order given; this is the default and it is
-- appropriate for preprocessors which do not have any sort of dependencies
-- between modules.
unsorted
  :: Verbosity
  -> [path]
  -> [ModuleName]
  -> IO [ModuleName]
unsorted :: forall path. Verbosity -> [path] -> [ModuleName] -> IO [ModuleName]
unsorted Verbosity
_ [path]
_ [ModuleName]
ms = [ModuleName] -> IO [ModuleName]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ModuleName]
ms

-- | Function to determine paths to possible extra C sources for a
-- preprocessor: just takes the path to the build directory and uses
-- this to search for C sources with names that match the
-- preprocessor's output name format.
type PreProcessorExtras =
  Maybe (SymbolicPath CWD (Dir Pkg))
  -> SymbolicPath Pkg (Dir Source)
  -> IO [RelativePath Source File]

mkSimplePreProcessor
  :: (FilePath -> FilePath -> Verbosity -> IO ())
  -> (FilePath, FilePath)
  -> (FilePath, FilePath)
  -> Verbosity
  -> IO ()
mkSimplePreProcessor :: ([Char] -> [Char] -> Verbosity -> IO ())
-> ([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ()
mkSimplePreProcessor
  [Char] -> [Char] -> Verbosity -> IO ()
simplePP
  ([Char]
inBaseDir, [Char]
inRelativeFile)
  ([Char]
outBaseDir, [Char]
outRelativeFile)
  Verbosity
verbosity = [Char] -> [Char] -> Verbosity -> IO ()
simplePP [Char]
inFile [Char]
outFile Verbosity
verbosity
    where
      inFile :: [Char]
inFile = [Char] -> [Char]
normalise ([Char]
inBaseDir [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
inRelativeFile)
      outFile :: [Char]
outFile = [Char] -> [Char]
normalise ([Char]
outBaseDir [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
outRelativeFile)

runSimplePreProcessor
  :: PreProcessor
  -> FilePath
  -> FilePath
  -> Verbosity
  -> IO ()
runSimplePreProcessor :: PreProcessor -> [Char] -> [Char] -> Verbosity -> IO ()
runSimplePreProcessor PreProcessor
pp [Char]
inFile [Char]
outFile Verbosity
verbosity =
  PreProcessor
-> ([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ()
runPreProcessor PreProcessor
pp ([Char]
".", [Char]
inFile) ([Char]
".", [Char]
outFile) Verbosity
verbosity

-- | A preprocessor for turning non-Haskell files with the given 'Suffix'
-- (i.e. file extension) into plain Haskell source files.
type PPSuffixHandler =
  (Suffix, BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor)

-- | Apply preprocessors to the sources from 'hsSourceDirs' for a given
-- component (lib, exe, or test suite).
--
-- XXX: This is terrible
preprocessComponent
  :: PackageDescription
  -> Component
  -> LocalBuildInfo
  -> ComponentLocalBuildInfo
  -> Bool
  -> Verbosity
  -> [PPSuffixHandler]
  -> IO ()
preprocessComponent :: PackageDescription
-> Component
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Bool
-> Verbosity
-> [PPSuffixHandler]
-> IO ()
preprocessComponent PackageDescription
pd Component
comp LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi Bool
isSrcDist Verbosity
verbosity [PPSuffixHandler]
handlers =
  -- Skip preprocessing for scripts since they should be regular Haskell files,
  -- but may have no or unknown extensions.
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PackageDescription -> PackageIdentifier
package PackageDescription
pd PackageIdentifier -> PackageIdentifier -> Bool
forall a. Eq a => a -> a -> Bool
/= PackageIdentifier
fakePackageId) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    -- NB: never report instantiation here; we'll report it properly when
    -- building.
    Verbosity
-> [Char]
-> PackageIdentifier
-> ComponentName
-> Maybe [(ModuleName, Module)]
-> IO ()
forall a.
Pretty a =>
Verbosity
-> [Char]
-> PackageIdentifier
-> ComponentName
-> Maybe [(ModuleName, a)]
-> IO ()
setupMessage'
      Verbosity
verbosity
      [Char]
"Preprocessing"
      (PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pd)
      (ComponentLocalBuildInfo -> ComponentName
componentLocalName ComponentLocalBuildInfo
clbi)
      (Maybe [(ModuleName, Module)]
forall a. Maybe a
Nothing :: Maybe [(ModuleName, Module)])
    case Component
comp of
      (CLib lib :: Library
lib@Library{libBuildInfo :: Library -> BuildInfo
libBuildInfo = BuildInfo
bi}) -> do
        let dirs :: [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
dirs =
              BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
hsSourceDirs BuildInfo
bi
                [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
forall a. [a] -> [a] -> [a]
++ [LocalBuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi, LocalBuildInfo -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
autogenPackageModulesDir LocalBuildInfo
lbi]
        let hndlrs :: [(Suffix, PreProcessor)]
hndlrs = BuildInfo -> [(Suffix, PreProcessor)]
localHandlers BuildInfo
bi
        mods <- Verbosity
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [(Suffix, PreProcessor)]
-> [ModuleName]
-> IO [ModuleName]
forall {t :: * -> *} {a}.
Foldable t =>
Verbosity
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> t (a, PreProcessor)
-> [ModuleName]
-> IO [ModuleName]
orderingFromHandlers Verbosity
verbosity [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
dirs [(Suffix, PreProcessor)]
hndlrs (Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi)
        for_ (map moduleNameSymbolicPath mods) $
          pre dirs (componentBuildDir lbi clbi) hndlrs
      (CFLib flib :: ForeignLib
flib@ForeignLib{foreignLibBuildInfo :: ForeignLib -> BuildInfo
foreignLibBuildInfo = BuildInfo
bi}) -> do
        let flibDir :: SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
flibDir = LocalBuildInfo
-> ForeignLib -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
flibBuildDir LocalBuildInfo
lbi ForeignLib
flib
            dirs :: [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
dirs =
              BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
hsSourceDirs BuildInfo
bi
                [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
forall a. [a] -> [a] -> [a]
++ [ LocalBuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
                   , LocalBuildInfo -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
autogenPackageModulesDir LocalBuildInfo
lbi
                   ]
        let hndlrs :: [(Suffix, PreProcessor)]
hndlrs = BuildInfo -> [(Suffix, PreProcessor)]
localHandlers BuildInfo
bi
        mods <- Verbosity
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [(Suffix, PreProcessor)]
-> [ModuleName]
-> IO [ModuleName]
forall {t :: * -> *} {a}.
Foldable t =>
Verbosity
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> t (a, PreProcessor)
-> [ModuleName]
-> IO [ModuleName]
orderingFromHandlers Verbosity
verbosity [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
dirs [(Suffix, PreProcessor)]
hndlrs (ForeignLib -> [ModuleName]
foreignLibModules ForeignLib
flib)
        for_ (map moduleNameSymbolicPath mods) $
          pre dirs flibDir hndlrs
      (CExe exe :: Executable
exe@Executable{buildInfo :: Executable -> BuildInfo
buildInfo = BuildInfo
bi}) -> do
        let exeDir :: SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
exeDir = LocalBuildInfo
-> Executable -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
exeBuildDir LocalBuildInfo
lbi Executable
exe
            dirs :: [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
dirs =
              BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
hsSourceDirs BuildInfo
bi
                [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
forall a. [a] -> [a] -> [a]
++ [ LocalBuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
                   , LocalBuildInfo -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
autogenPackageModulesDir LocalBuildInfo
lbi
                   ]
        let hndlrs :: [(Suffix, PreProcessor)]
hndlrs = BuildInfo -> [(Suffix, PreProcessor)]
localHandlers BuildInfo
bi
        mods <- Verbosity
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [(Suffix, PreProcessor)]
-> [ModuleName]
-> IO [ModuleName]
forall {t :: * -> *} {a}.
Foldable t =>
Verbosity
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> t (a, PreProcessor)
-> [ModuleName]
-> IO [ModuleName]
orderingFromHandlers Verbosity
verbosity [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
dirs [(Suffix, PreProcessor)]
hndlrs (BuildInfo -> [ModuleName]
otherModules BuildInfo
bi)
        for_ (map moduleNameSymbolicPath mods) $
          pre dirs exeDir hndlrs
        pre (hsSourceDirs bi) exeDir (localHandlers bi) $
          dropExtensionsSymbolicPath (modulePath exe)
      CTest test :: TestSuite
test@TestSuite{} -> do
        let testDir :: SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
testDir = LocalBuildInfo
-> TestSuite -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
testBuildDir LocalBuildInfo
lbi TestSuite
test
        case TestSuite -> TestSuiteInterface
testInterface TestSuite
test of
          TestSuiteExeV10 Version
_ SymbolicPathX 'OnlyRelative Source 'File
f ->
            TestSuite
-> SymbolicPathX 'OnlyRelative Source 'File
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> IO ()
preProcessTest TestSuite
test SymbolicPathX 'OnlyRelative Source 'File
f SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
testDir
          TestSuiteLibV09 Version
_ ModuleName
_ -> do
            TestSuite -> [Char] -> IO ()
writeSimpleTestStub TestSuite
test (SymbolicPathX 'AllowAbsolute Pkg ('Dir Build) -> [Char]
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> [Char]
i SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
testDir)
            TestSuite
-> SymbolicPathX 'OnlyRelative Source 'File
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> IO ()
preProcessTest TestSuite
test ([Char] -> SymbolicPathX 'OnlyRelative Source 'File
forall from (to :: FileOrDir).
HasCallStack =>
[Char] -> RelativePath from to
makeRelativePathEx ([Char] -> SymbolicPathX 'OnlyRelative Source 'File)
-> [Char] -> SymbolicPathX 'OnlyRelative Source 'File
forall a b. (a -> b) -> a -> b
$ TestSuite -> [Char]
stubFilePath TestSuite
test) SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
testDir
          TestSuiteUnsupported TestType
tt ->
            Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO ()) -> CabalException -> IO ()
forall a b. (a -> b) -> a -> b
$ TestType -> CabalException
NoSupportForPreProcessingTest TestType
tt
      CBench bm :: Benchmark
bm@Benchmark{} -> do
        let benchDir :: SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
benchDir = LocalBuildInfo
-> Benchmark -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
benchmarkBuildDir LocalBuildInfo
lbi Benchmark
bm
        case Benchmark -> BenchmarkInterface
benchmarkInterface Benchmark
bm of
          BenchmarkExeV10 Version
_ SymbolicPathX 'OnlyRelative Source 'File
f ->
            Benchmark
-> SymbolicPathX 'OnlyRelative Source 'File
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> IO ()
preProcessBench Benchmark
bm SymbolicPathX 'OnlyRelative Source 'File
f SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
benchDir
          BenchmarkUnsupported BenchmarkType
tt ->
            Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO ()) -> CabalException -> IO ()
forall a b. (a -> b) -> a -> b
$ BenchmarkType -> CabalException
NoSupportForPreProcessingBenchmark BenchmarkType
tt
  where
    orderingFromHandlers :: Verbosity
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> t (a, PreProcessor)
-> [ModuleName]
-> IO [ModuleName]
orderingFromHandlers Verbosity
v [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
d t (a, PreProcessor)
hndlrs [ModuleName]
mods =
      ([ModuleName] -> (a, PreProcessor) -> IO [ModuleName])
-> [ModuleName] -> t (a, PreProcessor) -> IO [ModuleName]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\[ModuleName]
acc (a
_, PreProcessor
pp) -> PreProcessor
-> Verbosity
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [ModuleName]
-> IO [ModuleName]
ppOrdering PreProcessor
pp Verbosity
v [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
d [ModuleName]
acc) [ModuleName]
mods t (a, PreProcessor)
hndlrs
    builtinCSuffixes :: [Suffix]
builtinCSuffixes = ([Char] -> Suffix) -> [[Char]] -> [Suffix]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Suffix
Suffix [[Char]]
cSourceExtensions
    builtinSuffixes :: [Suffix]
builtinSuffixes = [Suffix]
builtinHaskellSuffixes [Suffix] -> [Suffix] -> [Suffix]
forall a. [a] -> [a] -> [a]
++ [Suffix]
builtinCSuffixes
    localHandlers :: BuildInfo -> [(Suffix, PreProcessor)]
localHandlers BuildInfo
bi = [(Suffix
ext, BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
h BuildInfo
bi LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi) | (Suffix
ext, BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
h) <- [PPSuffixHandler]
handlers]
    mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = LocalBuildInfo -> Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDirLBI LocalBuildInfo
lbi
    i :: SymbolicPathX allowAbsolute Pkg to -> [Char]
i = LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> [Char]
forall (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> [Char]
interpretSymbolicPathLBI LocalBuildInfo
lbi -- See Note [Symbolic paths] in Distribution.Utils.Path
    pre :: [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> [(Suffix, PreProcessor)]
-> SymbolicPathX 'OnlyRelative Source 'File
-> IO ()
pre [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
dirs SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
dir [(Suffix, PreProcessor)]
lhndlrs SymbolicPathX 'OnlyRelative Source 'File
fp =
      Maybe (SymbolicPath CWD ('Dir Pkg))
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> Bool
-> SymbolicPathX 'OnlyRelative Source 'File
-> Verbosity
-> [Suffix]
-> [(Suffix, PreProcessor)]
-> Bool
-> IO ()
preprocessFile Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
dirs SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
dir Bool
isSrcDist SymbolicPathX 'OnlyRelative Source 'File
fp Verbosity
verbosity [Suffix]
builtinSuffixes [(Suffix, PreProcessor)]
lhndlrs Bool
True
    preProcessTest :: TestSuite
-> SymbolicPathX 'OnlyRelative Source 'File
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> IO ()
preProcessTest TestSuite
test =
      BuildInfo
-> [ModuleName]
-> SymbolicPathX 'OnlyRelative Source 'File
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> IO ()
preProcessComponent
        (TestSuite -> BuildInfo
testBuildInfo TestSuite
test)
        (TestSuite -> [ModuleName]
testModules TestSuite
test)
    preProcessBench :: Benchmark
-> SymbolicPathX 'OnlyRelative Source 'File
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> IO ()
preProcessBench Benchmark
bm =
      BuildInfo
-> [ModuleName]
-> SymbolicPathX 'OnlyRelative Source 'File
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> IO ()
preProcessComponent
        (Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
bm)
        (Benchmark -> [ModuleName]
benchmarkModules Benchmark
bm)

    preProcessComponent
      :: BuildInfo
      -> [ModuleName]
      -> RelativePath Source File
      -> SymbolicPath Pkg (Dir Build)
      -> IO ()
    preProcessComponent :: BuildInfo
-> [ModuleName]
-> SymbolicPathX 'OnlyRelative Source 'File
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> IO ()
preProcessComponent BuildInfo
bi [ModuleName]
modules SymbolicPathX 'OnlyRelative Source 'File
exePath SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
outputDir = do
      let biHandlers :: [(Suffix, PreProcessor)]
biHandlers = BuildInfo -> [(Suffix, PreProcessor)]
localHandlers BuildInfo
bi
          sourceDirs :: [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
sourceDirs =
            BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
hsSourceDirs BuildInfo
bi
              [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
forall a. [a] -> [a] -> [a]
++ [ LocalBuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
                 , LocalBuildInfo -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
autogenPackageModulesDir LocalBuildInfo
lbi
                 ]
      [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
        [ Maybe (SymbolicPath CWD ('Dir Pkg))
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> Bool
-> SymbolicPathX 'OnlyRelative Source 'File
-> Verbosity
-> [Suffix]
-> [(Suffix, PreProcessor)]
-> Bool
-> IO ()
preprocessFile
          Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir
          [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
sourceDirs
          SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
outputDir
          Bool
isSrcDist
          (ModuleName -> SymbolicPathX 'OnlyRelative Source 'File
forall (allowAbsolute :: AllowAbsolute).
ModuleName -> SymbolicPathX allowAbsolute Source 'File
moduleNameSymbolicPath ModuleName
modu)
          Verbosity
verbosity
          [Suffix]
builtinSuffixes
          [(Suffix, PreProcessor)]
biHandlers
          Bool
False
        | ModuleName
modu <- [ModuleName]
modules
        ]
      -- 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)
      Maybe (SymbolicPath CWD ('Dir Pkg))
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> Bool
-> SymbolicPathX 'OnlyRelative Source 'File
-> Verbosity
-> [Suffix]
-> [(Suffix, PreProcessor)]
-> Bool
-> IO ()
preprocessFile
        Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir
        (SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
forall (allowAbsolute :: AllowAbsolute) from (to1 :: FileOrDir)
       (to2 :: FileOrDir).
SymbolicPathX allowAbsolute from to1
-> SymbolicPathX allowAbsolute from to2
coerceSymbolicPath SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
outputDir SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
forall a. a -> [a] -> [a]
: BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
hsSourceDirs BuildInfo
bi)
        SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
outputDir
        Bool
isSrcDist
        (SymbolicPathX 'OnlyRelative Source 'File
-> SymbolicPathX 'OnlyRelative Source 'File
forall (allowAbsolute :: AllowAbsolute) from.
SymbolicPathX allowAbsolute from 'File
-> SymbolicPathX allowAbsolute from 'File
dropExtensionsSymbolicPath (SymbolicPathX 'OnlyRelative Source 'File
 -> SymbolicPathX 'OnlyRelative Source 'File)
-> SymbolicPathX 'OnlyRelative Source 'File
-> SymbolicPathX 'OnlyRelative Source 'File
forall a b. (a -> b) -> a -> b
$ SymbolicPathX 'OnlyRelative Source 'File
exePath)
        Verbosity
verbosity
        [Suffix]
builtinSuffixes
        [(Suffix, PreProcessor)]
biHandlers
        Bool
False

-- 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
  :: Maybe (SymbolicPath CWD (Dir Pkg))
  -- ^ package directory location
  -> [SymbolicPath Pkg (Dir Source)]
  -- ^ source directories
  -> SymbolicPath Pkg (Dir Build)
  -- ^ build directory
  -> Bool
  -- ^ preprocess for sdist
  -> RelativePath Source File
  -- ^ module file name
  -> Verbosity
  -- ^ verbosity
  -> [Suffix]
  -- ^ builtin suffixes
  -> [(Suffix, PreProcessor)]
  -- ^ possible preprocessors
  -> Bool
  -- ^ fail on missing file
  -> IO ()
preprocessFile :: Maybe (SymbolicPath CWD ('Dir Pkg))
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> Bool
-> SymbolicPathX 'OnlyRelative Source 'File
-> Verbosity
-> [Suffix]
-> [(Suffix, PreProcessor)]
-> Bool
-> IO ()
preprocessFile Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
searchLoc SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
buildLoc Bool
forSDist SymbolicPathX 'OnlyRelative Source 'File
baseFile Verbosity
verbosity [Suffix]
builtinSuffixes [(Suffix, PreProcessor)]
handlers Bool
failOnMissing = do
  -- look for files in the various source dirs with this module name
  -- and a file extension of a known preprocessor
  psrcFiles <- Maybe (SymbolicPath CWD ('Dir Pkg))
-> [Suffix]
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> SymbolicPathX 'OnlyRelative Source 'File
-> IO
     (Maybe
        (SymbolicPathX 'AllowAbsolute Pkg ('Dir Source),
         SymbolicPathX 'OnlyRelative Source 'File))
forall searchDir (allowAbsolute :: AllowAbsolute).
Maybe (SymbolicPath CWD ('Dir Pkg))
-> [Suffix]
-> [SymbolicPathX allowAbsolute Pkg ('Dir searchDir)]
-> RelativePath searchDir 'File
-> IO
     (Maybe
        (SymbolicPathX allowAbsolute Pkg ('Dir searchDir),
         RelativePath searchDir 'File))
findFileCwdWithExtension' Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir (((Suffix, PreProcessor) -> Suffix)
-> [(Suffix, PreProcessor)] -> [Suffix]
forall a b. (a -> b) -> [a] -> [b]
map (Suffix, PreProcessor) -> Suffix
forall a b. (a, b) -> a
fst [(Suffix, PreProcessor)]
handlers) [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
searchLoc SymbolicPathX 'OnlyRelative Source 'File
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 [Dodgy build dirs for preprocessors]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- 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)
    Maybe
  (SymbolicPathX 'AllowAbsolute Pkg ('Dir Source),
   SymbolicPathX 'OnlyRelative Source 'File)
Nothing -> do
      bsrcFiles <- Maybe (SymbolicPath CWD ('Dir Pkg))
-> [Suffix]
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> SymbolicPathX 'OnlyRelative Source 'File
-> IO (Maybe (SymbolicPathX 'AllowAbsolute Pkg 'File))
forall searchDir (allowAbsolute :: AllowAbsolute).
Maybe (SymbolicPath CWD ('Dir Pkg))
-> [Suffix]
-> [SymbolicPathX allowAbsolute Pkg ('Dir searchDir)]
-> RelativePath searchDir 'File
-> IO (Maybe (SymbolicPathX allowAbsolute Pkg 'File))
findFileCwdWithExtension Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir [Suffix]
builtinSuffixes (SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
buildAsSrcLoc SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
forall a. a -> [a] -> [a]
: [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
searchLoc) SymbolicPathX 'OnlyRelative Source 'File
baseFile
      case (bsrcFiles, failOnMissing) of
        (Maybe (SymbolicPathX 'AllowAbsolute Pkg 'File)
Nothing, Bool
True) ->
          Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO ()) -> CabalException -> IO ()
forall a b. (a -> b) -> a -> b
$
            [Char] -> CabalException
CantFindSourceForPreProcessFile ([Char] -> CabalException) -> [Char] -> CabalException
forall a b. (a -> b) -> a -> b
$
              [Char]
"can't find source for "
                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SymbolicPathX 'OnlyRelative Source 'File -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
getSymbolicPath SymbolicPathX 'OnlyRelative Source 'File
baseFile
                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" in "
                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " ((SymbolicPathX 'AllowAbsolute Pkg ('Dir Source) -> [Char])
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPathX 'AllowAbsolute Pkg ('Dir Source) -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
getSymbolicPath [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
searchLoc)
        (Maybe (SymbolicPathX 'AllowAbsolute Pkg 'File), Bool)
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    -- found a pre-processable file in one of the source dirs
    Just (SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
psrcLoc, SymbolicPathX 'OnlyRelative Source 'File
psrcRelFile) -> do
      let ([Char]
srcStem, [Char]
ext) = [Char] -> ([Char], [Char])
splitExtension ([Char] -> ([Char], [Char])) -> [Char] -> ([Char], [Char])
forall a b. (a -> b) -> a -> b
$ SymbolicPathX 'OnlyRelative Source 'File -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
getSymbolicPath SymbolicPathX 'OnlyRelative Source 'File
psrcRelFile
          psrcFile :: SymbolicPathX 'AllowAbsolute Pkg 'File
psrcFile = SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
psrcLoc SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
-> SymbolicPathX 'OnlyRelative Source 'File
-> SymbolicPathX 'AllowAbsolute Pkg 'File
forall p q r. PathLike p q r => p -> q -> r
</> SymbolicPathX 'OnlyRelative Source 'File
psrcRelFile
          pp :: PreProcessor
pp =
            PreProcessor -> Maybe PreProcessor -> PreProcessor
forall a. a -> Maybe a -> a
fromMaybe
              ([Char] -> PreProcessor
forall a. HasCallStack => [Char] -> a
error [Char]
"Distribution.Simple.PreProcess: Just expected")
              (Suffix -> [(Suffix, PreProcessor)] -> Maybe PreProcessor
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ([Char] -> Suffix
Suffix ([Char] -> Suffix) -> [Char] -> Suffix
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. [a] -> [a]
safeTail [Char]
ext) [(Suffix, PreProcessor)]
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
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
forSDist Bool -> Bool -> Bool
|| Bool
forSDist Bool -> Bool -> Bool
&& PreProcessor -> Bool
platformIndependent PreProcessor
pp) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        -- look for existing pre-processed source file in the dest dir to
        -- see if we really have to re-run the preprocessor.
        ppsrcFiles <- Maybe (SymbolicPath CWD ('Dir Pkg))
-> [Suffix]
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> SymbolicPathX 'OnlyRelative Source 'File
-> IO (Maybe (SymbolicPathX 'AllowAbsolute Pkg 'File))
forall searchDir (allowAbsolute :: AllowAbsolute).
Maybe (SymbolicPath CWD ('Dir Pkg))
-> [Suffix]
-> [SymbolicPathX allowAbsolute Pkg ('Dir searchDir)]
-> RelativePath searchDir 'File
-> IO (Maybe (SymbolicPathX allowAbsolute Pkg 'File))
findFileCwdWithExtension Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir [Suffix]
builtinSuffixes [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
buildAsSrcLoc] SymbolicPathX 'OnlyRelative Source 'File
baseFile
        recomp <- case ppsrcFiles of
          Maybe (SymbolicPathX 'AllowAbsolute Pkg 'File)
Nothing -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
          Just SymbolicPathX 'AllowAbsolute Pkg 'File
ppsrcFile ->
            SymbolicPathX 'AllowAbsolute Pkg 'File -> [Char]
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> [Char]
i SymbolicPathX 'AllowAbsolute Pkg 'File
psrcFile [Char] -> [Char] -> IO Bool
`moreRecentFile` SymbolicPathX 'AllowAbsolute Pkg 'File -> [Char]
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> [Char]
i SymbolicPathX 'AllowAbsolute Pkg 'File
ppsrcFile
        when recomp $ do
          let destDir = SymbolicPathX 'AllowAbsolute Pkg ('Dir Build) -> [Char]
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> [Char]
i SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
buildLoc [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char] -> [Char]
takeDirectory [Char]
srcStem
          createDirectoryIfMissingVerbose verbosity True destDir
          runPreProcessorWithHsBootHack
            pp
            (psrcLoc, getSymbolicPath $ psrcRelFile)
            (buildLoc, srcStem <.> "hs")
  where
    i :: SymbolicPathX allowAbsolute Pkg to -> [Char]
i = Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPathX allowAbsolute Pkg to -> [Char]
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> [Char]
interpretSymbolicPath Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path
    buildAsSrcLoc :: SymbolicPath Pkg (Dir Source)
    buildAsSrcLoc :: SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
buildAsSrcLoc = SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
forall (allowAbsolute :: AllowAbsolute) from (to1 :: FileOrDir)
       (to2 :: FileOrDir).
SymbolicPathX allowAbsolute from to1
-> SymbolicPathX allowAbsolute from to2
coerceSymbolicPath SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
buildLoc

    -- 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 :: PreProcessor
-> (SymbolicPathX allowAbsolute Pkg to, [Char])
-> (SymbolicPathX allowAbsolute Pkg to, [Char])
-> IO ()
runPreProcessorWithHsBootHack
      PreProcessor
pp
      (SymbolicPathX allowAbsolute Pkg to
inBaseDir, [Char]
inRelativeFile)
      (SymbolicPathX allowAbsolute Pkg to
outBaseDir, [Char]
outRelativeFile) = do
        -- Preprocessors are expected to take into account the working
        -- directory, e.g. using runProgramCwd with a working directory
        -- computed with mbWorkDirLBI.
        -- Hence the use of 'getSymbolicPath' here.
        PreProcessor
-> ([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ()
runPreProcessor
          PreProcessor
pp
          (SymbolicPathX allowAbsolute Pkg to -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
getSymbolicPath (SymbolicPathX allowAbsolute Pkg to -> [Char])
-> SymbolicPathX allowAbsolute Pkg to -> [Char]
forall a b. (a -> b) -> a -> b
$ SymbolicPathX allowAbsolute Pkg to
inBaseDir, [Char]
inRelativeFile)
          (SymbolicPathX allowAbsolute Pkg to -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
getSymbolicPath (SymbolicPathX allowAbsolute Pkg to -> [Char])
-> SymbolicPathX allowAbsolute Pkg to -> [Char]
forall a b. (a -> b) -> a -> b
$ SymbolicPathX allowAbsolute Pkg to
outBaseDir, [Char]
outRelativeFile)
          Verbosity
verbosity

        -- Here we interact directly with the file system, so we must
        -- interpret symbolic paths with respect to the working directory.
        let
          inFile :: [Char]
inFile = [Char] -> [Char]
normalise (SymbolicPathX allowAbsolute Pkg to -> [Char]
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> [Char]
i SymbolicPathX allowAbsolute Pkg to
inBaseDir [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
inRelativeFile)
          outFile :: [Char]
outFile = [Char] -> [Char]
normalise (SymbolicPathX allowAbsolute Pkg to -> [Char]
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> [Char]
i SymbolicPathX allowAbsolute Pkg to
outBaseDir [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
outRelativeFile)
          inBoot :: [Char]
inBoot = [Char] -> [Char] -> [Char]
replaceExtension [Char]
inFile [Char]
"hs-boot"
          outBoot :: [Char]
outBoot = [Char] -> [Char] -> [Char]
replaceExtension [Char]
outFile [Char]
"hs-boot"
        exists <- [Char] -> IO Bool
doesFileExist [Char]
inBoot
        when exists $ copyFileVerbose verbosity inBoot outBoot

-- ------------------------------------------------------------

-- * known preprocessors

-- ------------------------------------------------------------

-- This one is useful for preprocessors that can't handle literate source.
-- We also need a way to chain preprocessors.
ppUnlit :: PreProcessor
ppUnlit :: PreProcessor
ppUnlit =
  PreProcessor
    { platformIndependent :: Bool
platformIndependent = Bool
True
    , ppOrdering :: Verbosity
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [ModuleName]
-> IO [ModuleName]
ppOrdering = Verbosity
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [ModuleName]
-> IO [ModuleName]
forall path. Verbosity -> [path] -> [ModuleName] -> IO [ModuleName]
unsorted
    , runPreProcessor :: ([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ()
runPreProcessor = ([Char] -> [Char] -> Verbosity -> IO ())
-> ([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ()
mkSimplePreProcessor (([Char] -> [Char] -> Verbosity -> IO ())
 -> ([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ())
-> ([Char] -> [Char] -> Verbosity -> IO ())
-> ([Char], [Char])
-> ([Char], [Char])
-> Verbosity
-> IO ()
forall a b. (a -> b) -> a -> b
$ \[Char]
inFile [Char]
outFile Verbosity
verbosity ->
        [Char] -> ([Char] -> IO ()) -> IO ()
forall a. [Char] -> ([Char] -> IO a) -> IO a
withUTF8FileContents [Char]
inFile (([Char] -> IO ()) -> IO ()) -> ([Char] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[Char]
contents ->
          ([Char] -> IO ())
-> (CabalException -> IO ())
-> Either [Char] CabalException
-> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> [Char] -> IO ()
writeUTF8File [Char]
outFile) (Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity) ([Char] -> [Char] -> Either [Char] CabalException
unlit [Char]
inFile [Char]
contents)
    }

ppCpp :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppCpp :: BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppCpp = [[Char]]
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> PreProcessor
ppCpp' []

ppCpp' :: [String] -> BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppCpp' :: [[Char]]
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> PreProcessor
ppCpp' [[Char]]
extraArgs BuildInfo
bi LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi =
  case Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) of
    CompilerFlavor
GHC -> Program
-> (Version -> Bool)
-> [[Char]]
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> PreProcessor
ppGhcCpp Program
ghcProgram (Bool -> Version -> Bool
forall a b. a -> b -> a
const Bool
True) [[Char]]
args BuildInfo
bi LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
    CompilerFlavor
GHCJS -> Program
-> (Version -> Bool)
-> [[Char]]
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> PreProcessor
ppGhcCpp Program
ghcjsProgram (Bool -> Version -> Bool
forall a b. a -> b -> a
const Bool
True) [[Char]]
args BuildInfo
bi LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
    CompilerFlavor
_ -> [[Char]]
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> PreProcessor
ppCpphs [[Char]]
args BuildInfo
bi LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
  where
    cppArgs :: [[Char]]
cppArgs = BuildInfo -> LocalBuildInfo -> [[Char]]
getCppOptions BuildInfo
bi LocalBuildInfo
lbi
    args :: [[Char]]
args = [[Char]]
cppArgs [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
extraArgs

ppGhcCpp
  :: Program
  -> (Version -> Bool)
  -> [String]
  -> BuildInfo
  -> LocalBuildInfo
  -> ComponentLocalBuildInfo
  -> PreProcessor
ppGhcCpp :: Program
-> (Version -> Bool)
-> [[Char]]
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> PreProcessor
ppGhcCpp Program
program Version -> Bool
xHs [[Char]]
extraArgs BuildInfo
_bi LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi =
  PreProcessor
    { platformIndependent :: Bool
platformIndependent = Bool
False
    , ppOrdering :: Verbosity
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [ModuleName]
-> IO [ModuleName]
ppOrdering = Verbosity
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [ModuleName]
-> IO [ModuleName]
forall path. Verbosity -> [path] -> [ModuleName] -> IO [ModuleName]
unsorted
    , runPreProcessor :: ([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ()
runPreProcessor = ([Char] -> [Char] -> Verbosity -> IO ())
-> ([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ()
mkSimplePreProcessor (([Char] -> [Char] -> Verbosity -> IO ())
 -> ([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ())
-> ([Char] -> [Char] -> Verbosity -> IO ())
-> ([Char], [Char])
-> ([Char], [Char])
-> Verbosity
-> IO ()
forall a b. (a -> b) -> a -> b
$ \[Char]
inFile [Char]
outFile Verbosity
verbosity -> do
        (prog, version, _) <-
          Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)
requireProgramVersion
            Verbosity
verbosity
            Program
program
            VersionRange
anyVersion
            (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
        runProgramCwd verbosity (mbWorkDirLBI lbi) 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" ++ u (autogenComponentModulesDir lbi clbi </> makeRelativePathEx cppHeaderName)]
            ++ ["-o", outFile, inFile]
            ++ extraArgs
    }
  where
    -- See Note [Symbolic paths] in Distribution.Utils.Path
    u :: SymbolicPath Pkg to -> FilePath
    u :: forall (to :: FileOrDir). SymbolicPath Pkg to -> [Char]
u = SymbolicPathX 'AllowAbsolute Pkg to -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
interpretSymbolicPathCWD

ppCpphs :: [String] -> BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppCpphs :: [[Char]]
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> PreProcessor
ppCpphs [[Char]]
extraArgs BuildInfo
_bi LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi =
  PreProcessor
    { platformIndependent :: Bool
platformIndependent = Bool
False
    , ppOrdering :: Verbosity
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [ModuleName]
-> IO [ModuleName]
ppOrdering = Verbosity
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [ModuleName]
-> IO [ModuleName]
forall path. Verbosity -> [path] -> [ModuleName] -> IO [ModuleName]
unsorted
    , runPreProcessor :: ([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ()
runPreProcessor = ([Char] -> [Char] -> Verbosity -> IO ())
-> ([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ()
mkSimplePreProcessor (([Char] -> [Char] -> Verbosity -> IO ())
 -> ([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ())
-> ([Char] -> [Char] -> Verbosity -> IO ())
-> ([Char], [Char])
-> ([Char], [Char])
-> Verbosity
-> IO ()
forall a b. (a -> b) -> a -> b
$ \[Char]
inFile [Char]
outFile Verbosity
verbosity -> do
        (cpphsProg, cpphsVersion, _) <-
          Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)
requireProgramVersion
            Verbosity
verbosity
            Program
cpphsProgram
            VersionRange
anyVersion
            (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
        runProgramCwd verbosity (mbWorkDirLBI lbi) cpphsProg $
          ("-O" ++ outFile)
            : inFile
            : "--noline"
            : "--strip"
            : ( if cpphsVersion >= mkVersion [1, 6]
                  then ["--include=" ++ u (autogenComponentModulesDir lbi clbi </> makeRelativePathEx cppHeaderName)]
                  else []
              )
            ++ extraArgs
    }
  where
    -- See Note [Symbolic paths] in Distribution.Utils.Path
    u :: SymbolicPath Pkg to -> FilePath
    u :: forall (to :: FileOrDir). SymbolicPath Pkg to -> [Char]
u = SymbolicPathX 'AllowAbsolute Pkg to -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
interpretSymbolicPathCWD

ppHsc2hs :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppHsc2hs :: BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppHsc2hs BuildInfo
bi LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi =
  PreProcessor
    { platformIndependent :: Bool
platformIndependent = Bool
False
    , ppOrdering :: Verbosity
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [ModuleName]
-> IO [ModuleName]
ppOrdering = Verbosity
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [ModuleName]
-> IO [ModuleName]
forall path. Verbosity -> [path] -> [ModuleName] -> IO [ModuleName]
unsorted
    , runPreProcessor :: ([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ()
runPreProcessor = ([Char] -> [Char] -> Verbosity -> IO ())
-> ([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ()
mkSimplePreProcessor (([Char] -> [Char] -> Verbosity -> IO ())
 -> ([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ())
-> ([Char] -> [Char] -> Verbosity -> IO ())
-> ([Char], [Char])
-> ([Char], [Char])
-> Verbosity
-> IO ()
forall a b. (a -> b) -> a -> b
$ \[Char]
inFile [Char]
outFile Verbosity
verbosity -> do
        (gccProg, _) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
gccProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
        (hsc2hsProg, hsc2hsVersion, _) <-
          requireProgramVersion
            verbosity
            hsc2hsProgram
            anyVersion
            (withPrograms lbi)
        let runHsc2hs = Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> ConfiguredProgram
-> [[Char]]
-> IO ()
forall to.
Verbosity
-> Maybe (SymbolicPath CWD ('Dir to))
-> ConfiguredProgram
-> [[Char]]
-> IO ()
runProgramCwd Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir ConfiguredProgram
hsc2hsProg
        -- See Trac #13896 and https://github.com/haskell/cabal/issues/3122.
        let isCross = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi Platform -> Platform -> Bool
forall a. Eq a => a -> a -> Bool
/= Platform
buildPlatform
            prependCrossFlags = if Bool
isCross then ([Char]
"-x" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:) else [[Char]] -> [[Char]]
forall a. a -> a
id
        let hsc2hsSupportsResponseFiles = Version
hsc2hsVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
0, Int
68, Int
4]
            pureArgs = Version -> ConfiguredProgram -> [Char] -> [Char] -> [[Char]]
genPureArgs Version
hsc2hsVersion ConfiguredProgram
gccProg [Char]
inFile [Char]
outFile
        if hsc2hsSupportsResponseFiles
          then
            withResponseFile
              verbosity
              defaultTempFileOptions
              "hsc2hs-response.txt"
              Nothing
              pureArgs
              ( \[Char]
responseFileName ->
                  [[Char]] -> IO ()
runHsc2hs ([[Char]] -> [[Char]]
prependCrossFlags [[Char]
"@" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
responseFileName])
              )
          else runHsc2hs (prependCrossFlags pureArgs)
    }
  where
    -- See Note [Symbolic paths] in Distribution.Utils.Path
    u :: SymbolicPathX allowAbs Pkg to -> FilePath
    u :: forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> [Char]
u = SymbolicPathX allowAbs Pkg to -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
interpretSymbolicPathCWD
    mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = LocalBuildInfo -> Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDirLBI LocalBuildInfo
lbi

    -- Returns a list of command line arguments that can either be passed
    -- directly, or via a response file.
    genPureArgs :: Version -> ConfiguredProgram -> String -> String -> [String]
    genPureArgs :: Version -> ConfiguredProgram -> [Char] -> [Char] -> [[Char]]
genPureArgs Version
hsc2hsVersion ConfiguredProgram
gccProg [Char]
inFile [Char]
outFile =
      -- Additional gcc options
      [ [Char]
"--cflag=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
opt
      | [Char]
opt <-
          ConfiguredProgram -> [[Char]]
programDefaultArgs ConfiguredProgram
gccProg
            [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> [[Char]]
programOverrideArgs ConfiguredProgram
gccProg
      ]
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [ [Char]
"--lflag=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
opt
           | [Char]
opt <-
              ConfiguredProgram -> [[Char]]
programDefaultArgs ConfiguredProgram
gccProg
                [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> [[Char]]
programOverrideArgs ConfiguredProgram
gccProg
           ]
        -- OSX frameworks:
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [ [Char]
what [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"=-F" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
opt
           | Bool
isOSX
           , [Char]
opt <- [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
nub ((InstalledPackageInfo -> [[Char]])
-> [InstalledPackageInfo] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap InstalledPackageInfo -> [[Char]]
Installed.frameworkDirs [InstalledPackageInfo]
pkgs)
           , [Char]
what <- [[Char]
"--cflag", [Char]
"--lflag"]
           ]
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [ [Char]
"--lflag=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
arg
           | Bool
isOSX
           , [Char]
opt <- (SymbolicPathX 'OnlyRelative Framework 'File -> [Char])
-> [SymbolicPathX 'OnlyRelative Framework 'File] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPathX 'OnlyRelative Framework 'File -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
getSymbolicPath (BuildInfo -> [SymbolicPathX 'OnlyRelative Framework 'File]
PD.frameworks BuildInfo
bi) [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ (InstalledPackageInfo -> [[Char]])
-> [InstalledPackageInfo] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap InstalledPackageInfo -> [[Char]]
Installed.frameworks [InstalledPackageInfo]
pkgs
           , [Char]
arg <- [[Char]
"-framework", [Char]
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.

        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"--cflag=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
opt | [Char]
opt <- LocalBuildInfo -> [[Char]]
platformDefines LocalBuildInfo
lbi]
        -- Options from the current package:
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"--cflag=-I" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SymbolicPathX 'AllowAbsolute Pkg ('Dir Include) -> [Char]
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> [Char]
u SymbolicPathX 'AllowAbsolute Pkg ('Dir Include)
dir | SymbolicPathX 'AllowAbsolute Pkg ('Dir Include)
dir <- BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Include)]
PD.includeDirs BuildInfo
bi]
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [ [Char]
"--cflag=-I" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 2) -> [Char]
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> [Char]
u (LocalBuildInfo -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
buildDir LocalBuildInfo
lbi SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> SymbolicPathX 'OnlyRelative Build (ZonkAny 2)
-> SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 2)
forall p q r. PathLike p q r => p -> q -> r
</> SymbolicPathX 'OnlyRelative Pkg ('Dir Include)
-> SymbolicPathX 'OnlyRelative Build (ZonkAny 2)
forall (allowAbsolute :: AllowAbsolute) from1 (to1 :: FileOrDir)
       from2 (to2 :: FileOrDir).
SymbolicPathX allowAbsolute from1 to1
-> SymbolicPathX allowAbsolute from2 to2
unsafeCoerceSymbolicPath SymbolicPathX 'OnlyRelative Pkg ('Dir Include)
relDir)
           | SymbolicPathX 'OnlyRelative Pkg ('Dir Include)
relDir <- (SymbolicPathX 'AllowAbsolute Pkg ('Dir Include)
 -> Maybe (SymbolicPathX 'OnlyRelative Pkg ('Dir Include)))
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Include)]
-> [SymbolicPathX 'OnlyRelative Pkg ('Dir Include)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe SymbolicPathX 'AllowAbsolute Pkg ('Dir Include)
-> Maybe (SymbolicPathX 'OnlyRelative Pkg ('Dir Include))
forall from (to :: FileOrDir).
SymbolicPath from to -> Maybe (RelativePath from to)
symbolicPathRelative_maybe ([SymbolicPathX 'AllowAbsolute Pkg ('Dir Include)]
 -> [SymbolicPathX 'OnlyRelative Pkg ('Dir Include)])
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Include)]
-> [SymbolicPathX 'OnlyRelative Pkg ('Dir Include)]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Include)]
PD.includeDirs BuildInfo
bi
           ]
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [ [Char]
"--cflag=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
opt
           | [Char]
opt <-
              BuildInfo -> [[Char]]
PD.ccOptions BuildInfo
bi
                [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [[Char]]
PD.cppOptions BuildInfo
bi
                -- hsc2hs uses the C ABI
                -- We assume that there are only C sources
                -- and C++ functions are exported via a C
                -- interface and wrapped in a C source file.
                -- Therefore we do not supply C++ flags
                -- because there will not be C++ sources.
                --
                -- DO NOT add PD.cxxOptions unless this changes!
           ]
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [ [Char]
"--cflag=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
opt
           | [Char]
opt <-
              [ [Char]
"-I" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SymbolicPathX 'AllowAbsolute Pkg ('Dir Source) -> [Char]
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> [Char]
u (LocalBuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi)
              , [Char]
"-I" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SymbolicPathX 'AllowAbsolute Pkg ('Dir Source) -> [Char]
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> [Char]
u (LocalBuildInfo -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
autogenPackageModulesDir LocalBuildInfo
lbi)
              , [Char]
"-include"
              , SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 3) -> [Char]
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> [Char]
u (SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 3) -> [Char])
-> SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 3) -> [Char]
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
-> SymbolicPathX 'OnlyRelative Source (ZonkAny 3)
-> SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 3)
forall p q r. PathLike p q r => p -> q -> r
</> [Char] -> SymbolicPathX 'OnlyRelative Source (ZonkAny 3)
forall from (to :: FileOrDir).
HasCallStack =>
[Char] -> RelativePath from to
makeRelativePathEx [Char]
cppHeaderName
              ]
           ]
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [ [Char]
"--lflag=-L" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SymbolicPathX 'AllowAbsolute Pkg ('Dir Lib) -> [Char]
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> [Char]
u SymbolicPathX 'AllowAbsolute Pkg ('Dir Lib)
opt
           | SymbolicPathX 'AllowAbsolute Pkg ('Dir Lib)
opt <-
              if LocalBuildInfo -> Bool
withFullyStaticExe LocalBuildInfo
lbi
                then BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Lib)]
PD.extraLibDirsStatic BuildInfo
bi
                else BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Lib)]
PD.extraLibDirs BuildInfo
bi
           ]
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [ [Char]
"--lflag=-Wl,-R," [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SymbolicPathX 'AllowAbsolute Pkg ('Dir Lib) -> [Char]
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> [Char]
u SymbolicPathX 'AllowAbsolute Pkg ('Dir Lib)
opt
           | Bool
isELF
           , SymbolicPathX 'AllowAbsolute Pkg ('Dir Lib)
opt <-
              if LocalBuildInfo -> Bool
withFullyStaticExe LocalBuildInfo
lbi
                then BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Lib)]
PD.extraLibDirsStatic BuildInfo
bi
                else BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Lib)]
PD.extraLibDirs BuildInfo
bi
           ]
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"--lflag=-l" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
opt | [Char]
opt <- BuildInfo -> [[Char]]
PD.extraLibs BuildInfo
bi]
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"--lflag=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
opt | [Char]
opt <- BuildInfo -> [[Char]]
PD.ldOptions BuildInfo
bi]
        -- Options from dependent packages
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [ [Char]
"--cflag=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
opt
           | InstalledPackageInfo
pkg <- [InstalledPackageInfo]
pkgs
           , [Char]
opt <-
              [[Char]
"-I" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
opt | [Char]
opt <- InstalledPackageInfo -> [[Char]]
Installed.includeDirs InstalledPackageInfo
pkg]
                [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ InstalledPackageInfo -> [[Char]]
Installed.ccOptions InstalledPackageInfo
pkg
           ]
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [ [Char]
"--lflag=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
opt
           | InstalledPackageInfo
pkg <- [InstalledPackageInfo]
pkgs
           , [Char]
opt <-
              [[Char]
"-L" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
opt | [Char]
opt <- InstalledPackageInfo -> [[Char]]
Installed.libraryDirs InstalledPackageInfo
pkg]
                [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [ [Char]
"-Wl,-R," [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
opt | Bool
isELF, [Char]
opt <- InstalledPackageInfo -> [[Char]]
Installed.libraryDirs InstalledPackageInfo
pkg
                   ]
                [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [ [Char]
"-l" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
opt
                   | [Char]
opt <-
                      if LocalBuildInfo -> Bool
withFullyStaticExe LocalBuildInfo
lbi
                        then InstalledPackageInfo -> [[Char]]
Installed.extraLibrariesStatic InstalledPackageInfo
pkg
                        else InstalledPackageInfo -> [[Char]]
Installed.extraLibraries InstalledPackageInfo
pkg
                   ]
                [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ InstalledPackageInfo -> [[Char]]
Installed.ldOptions InstalledPackageInfo
pkg
           ]
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
preccldFlags
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [[Char]]
hsc2hsOptions BuildInfo
bi
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
postccldFlags
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"-o", [Char]
outFile, [Char]
inFile]
      where
        -- hsc2hs flag parsing was wrong
        -- (see -- https://github.com/haskell/hsc2hs/issues/35)
        -- so we need to put -- --cc/--ld *after* hsc2hsOptions,
        -- for older hsc2hs (pre 0.68.8) so that they can be overridden.
        ccldFlags :: [[Char]]
ccldFlags =
          [ [Char]
"--cc=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> [Char]
programPath ConfiguredProgram
gccProg
          , [Char]
"--ld=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> [Char]
programPath ConfiguredProgram
gccProg
          ]

        ([[Char]]
preccldFlags, [[Char]]
postccldFlags)
          | Version
hsc2hsVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
0, Int
68, Int
8] = ([[Char]]
ccldFlags, [])
          | Bool
otherwise = ([], [[Char]]
ccldFlags)

    hacked_index :: InstalledPackageIndex
hacked_index = InstalledPackageIndex -> InstalledPackageIndex
packageHacks (LocalBuildInfo -> InstalledPackageIndex
installedPkgs LocalBuildInfo
lbi)
    -- Look only at the dependencies of the current component
    -- being built!  This relies on 'installedPkgs' maintaining
    -- 'InstalledPackageInfo' for internal deps too; see #2971.
    pkgs :: [InstalledPackageInfo]
pkgs = InstalledPackageIndex -> [InstalledPackageInfo]
forall a. PackageInstalled a => PackageIndex a -> [a]
PackageIndex.topologicalOrder (InstalledPackageIndex -> [InstalledPackageInfo])
-> InstalledPackageIndex -> [InstalledPackageInfo]
forall a b. (a -> b) -> a -> b
$
      case InstalledPackageIndex
-> [UnitId]
-> Either InstalledPackageIndex [(InstalledPackageInfo, [UnitId])]
PackageIndex.dependencyClosure
        InstalledPackageIndex
hacked_index
        (((UnitId, MungedPackageId) -> UnitId)
-> [(UnitId, MungedPackageId)] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map (UnitId, MungedPackageId) -> UnitId
forall a b. (a, b) -> a
fst (ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
componentPackageDeps ComponentLocalBuildInfo
clbi)) of
        Left InstalledPackageIndex
index' -> InstalledPackageIndex
index'
        Right [(InstalledPackageInfo, [UnitId])]
inf ->
          [Char] -> InstalledPackageIndex
forall a. HasCallStack => [Char] -> a
error ([Char]
"ppHsc2hs: broken closure: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [(InstalledPackageInfo, [UnitId])] -> [Char]
forall a. Show a => a -> [Char]
show [(InstalledPackageInfo, [UnitId])]
inf)
    isOSX :: Bool
isOSX = case OS
buildOS of OS
OSX -> Bool
True; OS
_ -> Bool
False
    isELF :: Bool
isELF = case OS
buildOS of OS
OSX -> Bool
False; OS
Windows -> Bool
False; OS
AIX -> Bool
False; OS
_ -> Bool
True
    packageHacks :: InstalledPackageIndex -> InstalledPackageIndex
packageHacks = case Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) of
      CompilerFlavor
GHC -> InstalledPackageIndex -> InstalledPackageIndex
hackRtsPackage
      CompilerFlavor
GHCJS -> InstalledPackageIndex -> InstalledPackageIndex
hackRtsPackage
      CompilerFlavor
_ -> InstalledPackageIndex -> InstalledPackageIndex
forall a. a -> a
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 (its ld is a tad stricter than gnu ld). Thus we remove the
    -- ldOptions for GHC's rts package:
    hackRtsPackage :: InstalledPackageIndex -> InstalledPackageIndex
hackRtsPackage InstalledPackageIndex
index =
      case InstalledPackageIndex
-> PackageName -> [(Version, [InstalledPackageInfo])]
forall a. PackageIndex a -> PackageName -> [(Version, [a])]
PackageIndex.lookupPackageName InstalledPackageIndex
index ([Char] -> PackageName
mkPackageName [Char]
"rts") of
        [(Version
_, [InstalledPackageInfo
rts])] ->
          InstalledPackageInfo
-> InstalledPackageIndex -> InstalledPackageIndex
PackageIndex.insert InstalledPackageInfo
rts{Installed.ldOptions = []} InstalledPackageIndex
index
        [(Version, [InstalledPackageInfo])]
_ -> [Char] -> InstalledPackageIndex
forall a. HasCallStack => [Char] -> a
error [Char]
"No (or multiple) ghc rts package is registered!!"

ppHsc2hsExtras :: PreProcessorExtras
ppHsc2hsExtras :: PreProcessorExtras
ppHsc2hsExtras Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
buildBaseDir = do
  fs <- [Char] -> IO [[Char]]
getDirectoryContentsRecursive ([Char] -> IO [[Char]]) -> [Char] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Source) -> [Char]
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> [Char]
interpretSymbolicPath Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
buildBaseDir
  let hscCFiles = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char]
"_hsc.c" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`) [[Char]]
fs
  return $ map makeRelativePathEx hscCFiles

ppC2hs :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppC2hs :: BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppC2hs BuildInfo
bi LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi =
  PreProcessor
    { platformIndependent :: Bool
platformIndependent = Bool
False
    , ppOrdering :: Verbosity
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [ModuleName]
-> IO [ModuleName]
ppOrdering = Verbosity
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [ModuleName]
-> IO [ModuleName]
forall path. Verbosity -> [path] -> [ModuleName] -> IO [ModuleName]
unsorted
    , runPreProcessor :: ([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ()
runPreProcessor =
        \([Char]
inBaseDir, [Char]
inRelativeFile)
         ([Char]
outBaseDir, [Char]
outRelativeFile)
         Verbosity
verbosity -> do
            (c2hsProg, _, _) <-
              Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)
requireProgramVersion
                Verbosity
verbosity
                Program
c2hsProgram
                (Version -> VersionRange
orLaterVersion ([Int] -> Version
mkVersion [Int
0, Int
15]))
                (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
            (gccProg, _) <- requireProgram verbosity gccProgram (withPrograms lbi)
            runProgramCwd verbosity mbWorkDir c2hsProg $
              -- Options from the current package:
              ["--cpp=" ++ programPath gccProg, "--cppopts=-E"]
                ++ ["--cppopts=" ++ opt | opt <- getCppOptions bi lbi]
                ++ ["--cppopts=-include" ++ u (autogenComponentModulesDir lbi clbi </> makeRelativePathEx cppHeaderName)]
                ++ ["--include=" ++ outBaseDir]
                -- Options from dependent packages
                ++ [ "--cppopts=" ++ opt
                   | pkg <- pkgs
                   , opt <-
                      ["-I" ++ opt | opt <- Installed.includeDirs pkg]
                        ++ [ opt | opt@('-' : c : _) <- Installed.ccOptions pkg,
                           -- c2hs uses the C ABI
                           -- We assume that there are only C sources
                           -- and C++ functions are exported via a C
                           -- interface and wrapped in a C source file.
                           -- Therefore we do not supply C++ flags
                           -- because there will not be C++ sources.
                           --
                           --
                           -- DO NOT add Installed.cxxOptions unless this changes!
                           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 :: [InstalledPackageInfo]
pkgs = InstalledPackageIndex -> [InstalledPackageInfo]
forall a. PackageInstalled a => PackageIndex a -> [a]
PackageIndex.topologicalOrder (LocalBuildInfo -> InstalledPackageIndex
installedPkgs LocalBuildInfo
lbi)
    mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = LocalBuildInfo -> Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDirLBI LocalBuildInfo
lbi
    -- See Note [Symbolic paths] in Distribution.Utils.Path
    u :: SymbolicPath Pkg to -> FilePath
    u :: forall (to :: FileOrDir). SymbolicPath Pkg to -> [Char]
u = SymbolicPathX 'AllowAbsolute Pkg to -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
interpretSymbolicPathCWD

ppC2hsExtras :: PreProcessorExtras
ppC2hsExtras :: PreProcessorExtras
ppC2hsExtras Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
buildBaseDir = do
  fs <- [Char] -> IO [[Char]]
getDirectoryContentsRecursive ([Char] -> IO [[Char]]) -> [Char] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Source) -> [Char]
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> [Char]
interpretSymbolicPath Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
buildBaseDir
  return $
    map makeRelativePathEx $
      filter (\[Char]
p -> [Char] -> [Char]
takeExtensions [Char]
p [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
".chs.c") fs

-- TODO: perhaps use this with hsc2hs too
-- TODO: remove cc-options from cpphs for cabal-version: >= 1.10
-- TODO: Refactor and add separate getCppOptionsForHs, getCppOptionsForCxx, & getCppOptionsForC
--      instead of combining all these cases in a single function. This blind combination can
--      potentially lead to compilation inconsistencies.
getCppOptions :: BuildInfo -> LocalBuildInfo -> [String]
getCppOptions :: BuildInfo -> LocalBuildInfo -> [[Char]]
getCppOptions BuildInfo
bi LocalBuildInfo
lbi =
  LocalBuildInfo -> [[Char]]
platformDefines LocalBuildInfo
lbi
    [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [[Char]]
cppOptions BuildInfo
bi
    [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"-I" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SymbolicPathX 'AllowAbsolute Pkg ('Dir Include) -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
getSymbolicPath SymbolicPathX 'AllowAbsolute Pkg ('Dir Include)
dir | SymbolicPathX 'AllowAbsolute Pkg ('Dir Include)
dir <- BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Include)]
PD.includeDirs BuildInfo
bi]
    [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
opt | opt :: [Char]
opt@(Char
'-' : Char
c : [Char]
_) <- BuildInfo -> [[Char]]
PD.ccOptions BuildInfo
bi [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [[Char]]
PD.cxxOptions BuildInfo
bi, Char
c Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"DIU"]

platformDefines :: LocalBuildInfo -> [String]
platformDefines :: LocalBuildInfo -> [[Char]]
platformDefines LocalBuildInfo
lbi =
  case Compiler -> CompilerFlavor
compilerFlavor Compiler
comp of
    CompilerFlavor
GHC ->
      [[Char]
"-D__GLASGOW_HASKELL__=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Version -> [Char]
versionInt Version
version]
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"-D" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
os [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"_BUILD_OS=1"]
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"-D" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
arch [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"_BUILD_ARCH=1"]
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
os' -> [Char]
"-D" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
os' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"_HOST_OS=1") [[Char]]
osStr
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
arch' -> [Char]
"-D" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
arch' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"_HOST_ARCH=1") [[Char]]
archStr
    CompilerFlavor
GHCJS ->
      [[Char]]
compatGlasgowHaskell
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"-D__GHCJS__=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Version -> [Char]
versionInt Version
version]
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"-D" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
os [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"_BUILD_OS=1"]
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"-D" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
arch [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"_BUILD_ARCH=1"]
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
os' -> [Char]
"-D" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
os' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"_HOST_OS=1") [[Char]]
osStr
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
arch' -> [Char]
"-D" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
arch' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"_HOST_ARCH=1") [[Char]]
archStr
    CompilerFlavor
_ -> []
  where
    comp :: Compiler
comp = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
    Platform Arch
hostArch OS
hostOS = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
    version :: Version
version = Compiler -> Version
compilerVersion Compiler
comp
    compatGlasgowHaskell :: [[Char]]
compatGlasgowHaskell =
      [[Char]] -> (Version -> [[Char]]) -> Maybe Version -> [[Char]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        []
        (\Version
v -> [[Char]
"-D__GLASGOW_HASKELL__=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Version -> [Char]
versionInt Version
v])
        (CompilerFlavor -> Compiler -> Maybe Version
compilerCompatVersion CompilerFlavor
GHC Compiler
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 -> [Char]
versionInt Version
v = case Version -> [Int]
versionNumbers Version
v of
      [] -> [Char]
"1"
      [Int
n] -> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n
      Int
n1 : Int
n2 : [Int]
_ ->
        -- 6.8.x -> 608
        -- 6.10.x -> 610
        let s1 :: [Char]
s1 = Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n1
            s2 :: [Char]
s2 = Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n2
            middle :: [Char]
middle = case [Char]
s2 of
              Char
_ : Char
_ : [Char]
_ -> [Char]
""
              [Char]
_ -> [Char]
"0"
         in [Char]
s1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
middle [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s2

    osStr :: [[Char]]
osStr = case OS
hostOS of
      OS
Linux -> [[Char]
"linux"]
      OS
Windows -> [[Char]
"mingw32"]
      OS
OSX -> [[Char]
"darwin"]
      OS
FreeBSD -> [[Char]
"freebsd"]
      OS
OpenBSD -> [[Char]
"openbsd"]
      OS
NetBSD -> [[Char]
"netbsd"]
      OS
DragonFly -> [[Char]
"dragonfly"]
      OS
Solaris -> [[Char]
"solaris2"]
      OS
AIX -> [[Char]
"aix"]
      OS
HPUX -> [[Char]
"hpux"]
      OS
IRIX -> [[Char]
"irix"]
      OS
HaLVM -> []
      OS
IOS -> [[Char]
"ios"]
      OS
Android -> [[Char]
"android"]
      OS
Ghcjs -> [[Char]
"ghcjs"]
      OS
Wasi -> [[Char]
"wasi"]
      OS
Hurd -> [[Char]
"hurd"]
      OS
Haiku -> [[Char]
"haiku"]
      OtherOS [Char]
_ -> []
    archStr :: [[Char]]
archStr = case Arch
hostArch of
      Arch
I386 -> [[Char]
"i386"]
      Arch
X86_64 -> [[Char]
"x86_64"]
      Arch
PPC -> [[Char]
"powerpc"]
      Arch
PPC64 -> [[Char]
"powerpc64"]
      Arch
PPC64LE -> [[Char]
"powerpc64le"]
      Arch
Sparc -> [[Char]
"sparc"]
      Arch
Sparc64 -> [[Char]
"sparc64"]
      Arch
Arm -> [[Char]
"arm"]
      Arch
AArch64 -> [[Char]
"aarch64"]
      Arch
Mips -> [[Char]
"mips"]
      Arch
SH -> []
      Arch
IA64 -> [[Char]
"ia64"]
      Arch
S390 -> [[Char]
"s390"]
      Arch
S390X -> [[Char]
"s390x"]
      Arch
Alpha -> [[Char]
"alpha"]
      Arch
Hppa -> [[Char]
"hppa"]
      Arch
Rs6000 -> [[Char]
"rs6000"]
      Arch
M68k -> [[Char]
"m68k"]
      Arch
Vax -> [[Char]
"vax"]
      Arch
RISCV64 -> [[Char]
"riscv64"]
      Arch
LoongArch64 -> [[Char]
"loongarch64"]
      Arch
JavaScript -> [[Char]
"javascript"]
      Arch
Wasm32 -> [[Char]
"wasm32"]
      OtherArch [Char]
_ -> []

ppHappy :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppHappy :: BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppHappy BuildInfo
_ LocalBuildInfo
lbi ComponentLocalBuildInfo
_ = PreProcessor
pp{platformIndependent = True}
  where
    pp :: PreProcessor
pp = LocalBuildInfo -> Program -> [[Char]] -> PreProcessor
standardPP LocalBuildInfo
lbi Program
happyProgram (CompilerFlavor -> [[Char]]
hcFlags CompilerFlavor
hc)
    hc :: CompilerFlavor
hc = Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
    hcFlags :: CompilerFlavor -> [[Char]]
hcFlags CompilerFlavor
GHC = [[Char]
"-agc"]
    hcFlags CompilerFlavor
GHCJS = [[Char]
"-agc"]
    hcFlags CompilerFlavor
_ = []

ppAlex :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppAlex :: BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppAlex BuildInfo
_ LocalBuildInfo
lbi ComponentLocalBuildInfo
_ = PreProcessor
pp{platformIndependent = True}
  where
    pp :: PreProcessor
pp = LocalBuildInfo -> Program -> [[Char]] -> PreProcessor
standardPP LocalBuildInfo
lbi Program
alexProgram (CompilerFlavor -> [[Char]]
hcFlags CompilerFlavor
hc)
    hc :: CompilerFlavor
hc = Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
    hcFlags :: CompilerFlavor -> [[Char]]
hcFlags CompilerFlavor
GHC = [[Char]
"-g"]
    hcFlags CompilerFlavor
GHCJS = [[Char]
"-g"]
    hcFlags CompilerFlavor
_ = []

standardPP :: LocalBuildInfo -> Program -> [String] -> PreProcessor
standardPP :: LocalBuildInfo -> Program -> [[Char]] -> PreProcessor
standardPP LocalBuildInfo
lbi Program
prog [[Char]]
args =
  PreProcessor
    { platformIndependent :: Bool
platformIndependent = Bool
False
    , ppOrdering :: Verbosity
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [ModuleName]
-> IO [ModuleName]
ppOrdering = Verbosity
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [ModuleName]
-> IO [ModuleName]
forall path. Verbosity -> [path] -> [ModuleName] -> IO [ModuleName]
unsorted
    , runPreProcessor :: ([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ()
runPreProcessor = ([Char] -> [Char] -> Verbosity -> IO ())
-> ([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ()
mkSimplePreProcessor (([Char] -> [Char] -> Verbosity -> IO ())
 -> ([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ())
-> ([Char] -> [Char] -> Verbosity -> IO ())
-> ([Char], [Char])
-> ([Char], [Char])
-> Verbosity
-> IO ()
forall a b. (a -> b) -> a -> b
$ \[Char]
inFile [Char]
outFile Verbosity
verbosity ->
        Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> Program
-> ProgramDb
-> [[Char]]
-> IO ()
forall to.
Verbosity
-> Maybe (SymbolicPath CWD ('Dir to))
-> Program
-> ProgramDb
-> [[Char]]
-> IO ()
runDbProgramCwd
          Verbosity
verbosity
          (LocalBuildInfo -> Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDirLBI LocalBuildInfo
lbi)
          Program
prog
          (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
          ([[Char]]
args [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"-o", [Char]
outFile, [Char]
inFile])
    }

-- | Convenience function; get the suffixes of these preprocessors.
ppSuffixes :: [PPSuffixHandler] -> [Suffix]
ppSuffixes :: [PPSuffixHandler] -> [Suffix]
ppSuffixes = (PPSuffixHandler -> Suffix) -> [PPSuffixHandler] -> [Suffix]
forall a b. (a -> b) -> [a] -> [b]
map PPSuffixHandler -> Suffix
forall a b. (a, b) -> a
fst

-- | Standard preprocessors: c2hs, hsc2hs, happy, alex and cpphs.
knownSuffixHandlers :: [PPSuffixHandler]
knownSuffixHandlers :: [PPSuffixHandler]
knownSuffixHandlers =
  [ ([Char] -> Suffix
Suffix [Char]
"chs", BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppC2hs)
  , ([Char] -> Suffix
Suffix [Char]
"hsc", BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppHsc2hs)
  , ([Char] -> Suffix
Suffix [Char]
"x", BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppAlex)
  , ([Char] -> Suffix
Suffix [Char]
"y", BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppHappy)
  , ([Char] -> Suffix
Suffix [Char]
"ly", BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppHappy)
  , ([Char] -> Suffix
Suffix [Char]
"cpphs", BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppCpp)
  ]

-- | Standard preprocessors with possible extra C sources: c2hs, hsc2hs.
knownExtrasHandlers :: [PreProcessorExtras]
knownExtrasHandlers :: [PreProcessorExtras]
knownExtrasHandlers = [PreProcessorExtras
ppC2hsExtras, PreProcessorExtras
ppHsc2hsExtras]

-- | Find any extra C sources generated by preprocessing that need to
-- be added to the component (addresses issue #238).
preprocessExtras
  :: Verbosity
  -> Component
  -> LocalBuildInfo
  -> IO [SymbolicPath Pkg File]
preprocessExtras :: Verbosity
-> Component
-> LocalBuildInfo
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
preprocessExtras Verbosity
verbosity Component
comp LocalBuildInfo
lbi = case Component
comp of
  CLib Library
_ -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
pp (SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
buildDir LocalBuildInfo
lbi
  (CExe exe :: Executable
exe@Executable{}) -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
pp (SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo
-> Executable -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
exeBuildDir LocalBuildInfo
lbi Executable
exe
  (CFLib flib :: ForeignLib
flib@ForeignLib{}) -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
pp (SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo
-> ForeignLib -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
flibBuildDir LocalBuildInfo
lbi ForeignLib
flib
  CTest TestSuite
test ->
    case TestSuite -> TestSuiteInterface
testInterface TestSuite
test of
      TestSuiteUnsupported TestType
tt ->
        Verbosity
-> CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> a -> b
$ TestType -> CabalException
NoSupportPreProcessingTestExtras TestType
tt
      TestSuiteInterface
_ -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
pp (SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo
-> TestSuite -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
testBuildDir LocalBuildInfo
lbi TestSuite
test
  CBench Benchmark
bm ->
    case Benchmark -> BenchmarkInterface
benchmarkInterface Benchmark
bm of
      BenchmarkUnsupported BenchmarkType
tt ->
        Verbosity
-> CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> a -> b
$ BenchmarkType -> CabalException
NoSupportPreProcessingBenchmarkExtras BenchmarkType
tt
      BenchmarkInterface
_ -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
pp (SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo
-> Benchmark -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
benchmarkBuildDir LocalBuildInfo
lbi Benchmark
bm
  where
    pp :: SymbolicPath Pkg (Dir Build) -> IO [SymbolicPath Pkg File]
    pp :: SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
pp SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
builddir = do
      -- Use the build dir as a source dir.
      let dir :: SymbolicPath Pkg (Dir Source)
          dir :: SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
dir = SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
forall (allowAbsolute :: AllowAbsolute) from (to1 :: FileOrDir)
       (to2 :: FileOrDir).
SymbolicPathX allowAbsolute from to1
-> SymbolicPathX allowAbsolute from to2
coerceSymbolicPath SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
builddir
          mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = LocalBuildInfo -> Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDirLBI LocalBuildInfo
lbi
      b <- [Char] -> IO Bool
doesDirectoryExist (LocalBuildInfo
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Source) -> [Char]
forall (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> [Char]
interpretSymbolicPathLBI LocalBuildInfo
lbi SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
dir)
      if b
        then do
          xs <- for knownExtrasHandlers $ withLexicalCallStack $ \PreProcessorExtras
f -> PreProcessorExtras
f Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
dir
          let not_subs =
                (SymbolicPathX 'OnlyRelative Source 'File
 -> SymbolicPathX 'AllowAbsolute Pkg 'File)
-> [SymbolicPathX 'OnlyRelative Source 'File]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> [a] -> [b]
map (SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
dir SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
-> SymbolicPathX 'OnlyRelative Source 'File
-> SymbolicPathX 'AllowAbsolute Pkg 'File
forall p q r. PathLike p q r => p -> q -> r
</>) ([SymbolicPathX 'OnlyRelative Source 'File]
 -> [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> [SymbolicPathX 'OnlyRelative Source 'File]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> a -> b
$
                  (SymbolicPathX 'OnlyRelative Source 'File -> Bool)
-> [SymbolicPathX 'OnlyRelative Source 'File]
-> [SymbolicPathX 'OnlyRelative Source 'File]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> Bool
not_sub ([Char] -> Bool)
-> (SymbolicPathX 'OnlyRelative Source 'File -> [Char])
-> SymbolicPathX 'OnlyRelative Source 'File
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPathX 'OnlyRelative Source 'File -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
getSymbolicPath) ([SymbolicPathX 'OnlyRelative Source 'File]
 -> [SymbolicPathX 'OnlyRelative Source 'File])
-> [SymbolicPathX 'OnlyRelative Source 'File]
-> [SymbolicPathX 'OnlyRelative Source 'File]
forall a b. (a -> b) -> a -> b
$
                    [[SymbolicPathX 'OnlyRelative Source 'File]]
-> [SymbolicPathX 'OnlyRelative Source 'File]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[SymbolicPathX 'OnlyRelative Source 'File]]
xs
          return not_subs
        else pure []
    -- TODO: This is a terrible hack to work around #3545 while we don't
    -- reorganize the directory layout.  Basically, for the main
    -- library, we might accidentally pick up autogenerated sources for
    -- our subcomponents, because they are all stored as subdirectories
    -- in dist/build.  This is a cheap and cheerful check to prevent
    -- this from happening.  It is not particularly correct; for example
    -- if a user has a test suite named foobar and puts their C file in
    -- foobar/foo.c, this test will incorrectly exclude it.  But I
    -- didn't want to break BC...
    not_sub :: [Char] -> Bool
not_sub [Char]
p = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool -> Bool
not ([Char]
pre [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
p) | [Char]
pre <- [[Char]]
component_dirs]
    component_dirs :: [[Char]]
component_dirs = PackageDescription -> [[Char]]
component_names (LocalBuildInfo -> PackageDescription
localPkgDescr LocalBuildInfo
lbi)
    -- TODO: libify me
    component_names :: PackageDescription -> [[Char]]
component_names PackageDescription
pkg_descr =
      (UnqualComponentName -> [Char])
-> [UnqualComponentName] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnqualComponentName -> [Char]
unUnqualComponentName ([UnqualComponentName] -> [[Char]])
-> [UnqualComponentName] -> [[Char]]
forall a b. (a -> b) -> a -> b
$
        (Library -> Maybe UnqualComponentName)
-> [Library] -> [UnqualComponentName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (LibraryName -> Maybe UnqualComponentName
libraryNameString (LibraryName -> Maybe UnqualComponentName)
-> (Library -> LibraryName) -> Library -> Maybe UnqualComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> LibraryName
libName) (PackageDescription -> [Library]
subLibraries PackageDescription
pkg_descr)
          [UnqualComponentName]
-> [UnqualComponentName] -> [UnqualComponentName]
forall a. [a] -> [a] -> [a]
++ (Executable -> UnqualComponentName)
-> [Executable] -> [UnqualComponentName]
forall a b. (a -> b) -> [a] -> [b]
map Executable -> UnqualComponentName
exeName (PackageDescription -> [Executable]
executables PackageDescription
pkg_descr)
          [UnqualComponentName]
-> [UnqualComponentName] -> [UnqualComponentName]
forall a. [a] -> [a] -> [a]
++ (TestSuite -> UnqualComponentName)
-> [TestSuite] -> [UnqualComponentName]
forall a b. (a -> b) -> [a] -> [b]
map TestSuite -> UnqualComponentName
testName (PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg_descr)
          [UnqualComponentName]
-> [UnqualComponentName] -> [UnqualComponentName]
forall a. [a] -> [a] -> [a]
++ (Benchmark -> UnqualComponentName)
-> [Benchmark] -> [UnqualComponentName]
forall a b. (a -> b) -> [a] -> [b]
map Benchmark -> UnqualComponentName
benchmarkName (PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg_descr)