{-# 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
  , knownSuffixHandlers
  , ppSuffixes
  , PPSuffixHandler
  , Suffix (..)
  , builtinHaskellSuffixes
  , builtinHaskellBootSuffixes
  , PreProcessor (..)
  , mkSimplePreProcessor
  , runSimplePreProcessor
  , ppCpp
  , ppCpp'
  , ppGreenCard
  , 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 qualified Distribution.ModuleName as 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
  ( dropExtensions
  , 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
  -> [FilePath]
  -> [ModuleName]
  -> IO [ModuleName]
unsorted :: Verbosity -> [String] -> [ModuleName] -> IO [ModuleName]
unsorted Verbosity
_ [String]
_ [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 = FilePath -> IO [FilePath]

mkSimplePreProcessor
  :: (FilePath -> FilePath -> Verbosity -> IO ())
  -> (FilePath, FilePath)
  -> (FilePath, FilePath)
  -> Verbosity
  -> IO ()
mkSimplePreProcessor :: (String -> String -> Verbosity -> IO ())
-> (String, String) -> (String, String) -> Verbosity -> IO ()
mkSimplePreProcessor
  String -> String -> Verbosity -> IO ()
simplePP
  (String
inBaseDir, String
inRelativeFile)
  (String
outBaseDir, String
outRelativeFile)
  Verbosity
verbosity = String -> String -> Verbosity -> IO ()
simplePP String
inFile String
outFile Verbosity
verbosity
    where
      inFile :: String
inFile = String -> String
normalise (String
inBaseDir String -> String -> String
</> String
inRelativeFile)
      outFile :: String
outFile = String -> String
normalise (String
outBaseDir String -> String -> String
</> String
outRelativeFile)

runSimplePreProcessor
  :: PreProcessor
  -> FilePath
  -> FilePath
  -> Verbosity
  -> IO ()
runSimplePreProcessor :: PreProcessor -> String -> String -> Verbosity -> IO ()
runSimplePreProcessor PreProcessor
pp String
inFile String
outFile Verbosity
verbosity =
  PreProcessor
-> (String, String) -> (String, String) -> Verbosity -> IO ()
runPreProcessor PreProcessor
pp (String
".", String
inFile) (String
".", String
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
-> String
-> PackageIdentifier
-> ComponentName
-> Maybe [(ModuleName, Module)]
-> IO ()
forall a.
Pretty a =>
Verbosity
-> String
-> PackageIdentifier
-> ComponentName
-> Maybe [(ModuleName, a)]
-> IO ()
setupMessage'
      Verbosity
verbosity
      String
"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 :: [String]
dirs =
              (SymbolicPath PackageDir SourceDir -> String)
-> [SymbolicPath PackageDir SourceDir] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir SourceDir -> String
forall from to. SymbolicPath from to -> String
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi)
                [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi, LocalBuildInfo -> String
autogenPackageModulesDir LocalBuildInfo
lbi]
        let hndlrs :: [(Suffix, PreProcessor)]
hndlrs = BuildInfo -> [(Suffix, PreProcessor)]
localHandlers BuildInfo
bi
        [ModuleName]
mods <- Verbosity
-> [String]
-> [(Suffix, PreProcessor)]
-> [ModuleName]
-> IO [ModuleName]
forall {t :: * -> *} {a}.
Foldable t =>
Verbosity
-> [String]
-> t (a, PreProcessor)
-> [ModuleName]
-> IO [ModuleName]
orderingFromHandlers Verbosity
verbosity [String]
dirs [(Suffix, PreProcessor)]
hndlrs (Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi)
        [String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ((ModuleName -> String) -> [ModuleName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> String
ModuleName.toFilePath [ModuleName]
mods) ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
          [String] -> String -> [(Suffix, PreProcessor)] -> String -> IO ()
pre [String]
dirs (LocalBuildInfo -> ComponentLocalBuildInfo -> String
componentBuildDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi) [(Suffix, PreProcessor)]
hndlrs
      (CFLib flib :: ForeignLib
flib@ForeignLib{foreignLibBuildInfo :: ForeignLib -> BuildInfo
foreignLibBuildInfo = BuildInfo
bi, foreignLibName :: ForeignLib -> UnqualComponentName
foreignLibName = UnqualComponentName
nm}) -> do
        let nm' :: String
nm' = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
nm
        let flibDir :: String
flibDir = LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
nm' String -> String -> String
</> String
nm' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-tmp"
            dirs :: [String]
dirs =
              (SymbolicPath PackageDir SourceDir -> String)
-> [SymbolicPath PackageDir SourceDir] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir SourceDir -> String
forall from to. SymbolicPath from to -> String
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi)
                [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
                   , LocalBuildInfo -> String
autogenPackageModulesDir LocalBuildInfo
lbi
                   ]
        let hndlrs :: [(Suffix, PreProcessor)]
hndlrs = BuildInfo -> [(Suffix, PreProcessor)]
localHandlers BuildInfo
bi
        [ModuleName]
mods <- Verbosity
-> [String]
-> [(Suffix, PreProcessor)]
-> [ModuleName]
-> IO [ModuleName]
forall {t :: * -> *} {a}.
Foldable t =>
Verbosity
-> [String]
-> t (a, PreProcessor)
-> [ModuleName]
-> IO [ModuleName]
orderingFromHandlers Verbosity
verbosity [String]
dirs [(Suffix, PreProcessor)]
hndlrs (ForeignLib -> [ModuleName]
foreignLibModules ForeignLib
flib)
        [String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ((ModuleName -> String) -> [ModuleName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> String
ModuleName.toFilePath [ModuleName]
mods) ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
          [String] -> String -> [(Suffix, PreProcessor)] -> String -> IO ()
pre [String]
dirs String
flibDir [(Suffix, PreProcessor)]
hndlrs
      (CExe exe :: Executable
exe@Executable{buildInfo :: Executable -> BuildInfo
buildInfo = BuildInfo
bi, exeName :: Executable -> UnqualComponentName
exeName = UnqualComponentName
nm}) -> do
        let nm' :: String
nm' = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
nm
        let exeDir :: String
exeDir = LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
nm' String -> String -> String
</> String
nm' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-tmp"
            dirs :: [String]
dirs =
              (SymbolicPath PackageDir SourceDir -> String)
-> [SymbolicPath PackageDir SourceDir] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir SourceDir -> String
forall from to. SymbolicPath from to -> String
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi)
                [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
                   , LocalBuildInfo -> String
autogenPackageModulesDir LocalBuildInfo
lbi
                   ]
        let hndlrs :: [(Suffix, PreProcessor)]
hndlrs = BuildInfo -> [(Suffix, PreProcessor)]
localHandlers BuildInfo
bi
        [ModuleName]
mods <- Verbosity
-> [String]
-> [(Suffix, PreProcessor)]
-> [ModuleName]
-> IO [ModuleName]
forall {t :: * -> *} {a}.
Foldable t =>
Verbosity
-> [String]
-> t (a, PreProcessor)
-> [ModuleName]
-> IO [ModuleName]
orderingFromHandlers Verbosity
verbosity [String]
dirs [(Suffix, PreProcessor)]
hndlrs (BuildInfo -> [ModuleName]
otherModules BuildInfo
bi)
        [String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ((ModuleName -> String) -> [ModuleName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> String
ModuleName.toFilePath [ModuleName]
mods) ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
          [String] -> String -> [(Suffix, PreProcessor)] -> String -> IO ()
pre [String]
dirs String
exeDir [(Suffix, PreProcessor)]
hndlrs
        [String] -> String -> [(Suffix, PreProcessor)] -> String -> IO ()
pre ((SymbolicPath PackageDir SourceDir -> String)
-> [SymbolicPath PackageDir SourceDir] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir SourceDir -> String
forall from to. SymbolicPath from to -> String
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi)) String
exeDir (BuildInfo -> [(Suffix, PreProcessor)]
localHandlers BuildInfo
bi) (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
          String -> String
dropExtensions (Executable -> String
modulePath Executable
exe)
      CTest test :: TestSuite
test@TestSuite{testName :: TestSuite -> UnqualComponentName
testName = UnqualComponentName
nm} -> do
        let nm' :: String
nm' = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
nm
        case TestSuite -> TestSuiteInterface
testInterface TestSuite
test of
          TestSuiteExeV10 Version
_ String
f ->
            TestSuite -> String -> String -> IO ()
preProcessTest TestSuite
test String
f (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
nm' String -> String -> String
</> String
nm' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-tmp"
          TestSuiteLibV09 Version
_ ModuleName
_ -> do
            let testDir :: String
testDir =
                  LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi
                    String -> String -> String
</> TestSuite -> String
stubName TestSuite
test
                    String -> String -> String
</> TestSuite -> String
stubName TestSuite
test
                    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-tmp"
            TestSuite -> String -> IO ()
writeSimpleTestStub TestSuite
test String
testDir
            TestSuite -> String -> String -> IO ()
preProcessTest TestSuite
test (TestSuite -> String
stubFilePath TestSuite
test) String
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{benchmarkName :: Benchmark -> UnqualComponentName
benchmarkName = UnqualComponentName
nm} -> do
        let nm' :: String
nm' = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
nm
        case Benchmark -> BenchmarkInterface
benchmarkInterface Benchmark
bm of
          BenchmarkExeV10 Version
_ String
f ->
            Benchmark -> String -> String -> IO ()
preProcessBench Benchmark
bm String
f (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
nm' String -> String -> String
</> String
nm' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-tmp"
          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
-> [String]
-> t (a, PreProcessor)
-> [ModuleName]
-> IO [ModuleName]
orderingFromHandlers Verbosity
v [String]
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 -> [String] -> [ModuleName] -> IO [ModuleName]
ppOrdering PreProcessor
pp Verbosity
v [String]
d [ModuleName]
acc) [ModuleName]
mods t (a, PreProcessor)
hndlrs
    builtinCSuffixes :: [Suffix]
builtinCSuffixes = (String -> Suffix) -> [String] -> [Suffix]
forall a b. (a -> b) -> [a] -> [b]
map String -> Suffix
Suffix [String]
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]
    pre :: [String] -> String -> [(Suffix, PreProcessor)] -> String -> IO ()
pre [String]
dirs String
dir [(Suffix, PreProcessor)]
lhndlrs String
fp =
      [SymbolicPath PackageDir SourceDir]
-> String
-> Bool
-> String
-> Verbosity
-> [Suffix]
-> [(Suffix, PreProcessor)]
-> Bool
-> IO ()
preprocessFile ((String -> SymbolicPath PackageDir SourceDir)
-> [String] -> [SymbolicPath PackageDir SourceDir]
forall a b. (a -> b) -> [a] -> [b]
map String -> SymbolicPath PackageDir SourceDir
forall from to. String -> SymbolicPath from to
unsafeMakeSymbolicPath [String]
dirs) String
dir Bool
isSrcDist String
fp Verbosity
verbosity [Suffix]
builtinSuffixes [(Suffix, PreProcessor)]
lhndlrs Bool
True
    preProcessTest :: TestSuite -> String -> String -> IO ()
preProcessTest TestSuite
test =
      BuildInfo -> [ModuleName] -> String -> String -> IO ()
preProcessComponent
        (TestSuite -> BuildInfo
testBuildInfo TestSuite
test)
        (TestSuite -> [ModuleName]
testModules TestSuite
test)
    preProcessBench :: Benchmark -> String -> String -> IO ()
preProcessBench Benchmark
bm =
      BuildInfo -> [ModuleName] -> String -> String -> IO ()
preProcessComponent
        (Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
bm)
        (Benchmark -> [ModuleName]
benchmarkModules Benchmark
bm)

    preProcessComponent
      :: BuildInfo
      -> [ModuleName]
      -> FilePath
      -> FilePath
      -> IO ()
    preProcessComponent :: BuildInfo -> [ModuleName] -> String -> String -> IO ()
preProcessComponent BuildInfo
bi [ModuleName]
modules String
exePath String
dir = do
      let biHandlers :: [(Suffix, PreProcessor)]
biHandlers = BuildInfo -> [(Suffix, PreProcessor)]
localHandlers BuildInfo
bi
          sourceDirs :: [String]
sourceDirs =
            (SymbolicPath PackageDir SourceDir -> String)
-> [SymbolicPath PackageDir SourceDir] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir SourceDir -> String
forall from to. SymbolicPath from to -> String
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi)
              [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
                 , LocalBuildInfo -> String
autogenPackageModulesDir LocalBuildInfo
lbi
                 ]
      [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
        [ [SymbolicPath PackageDir SourceDir]
-> String
-> Bool
-> String
-> Verbosity
-> [Suffix]
-> [(Suffix, PreProcessor)]
-> Bool
-> IO ()
preprocessFile
          ((String -> SymbolicPath PackageDir SourceDir)
-> [String] -> [SymbolicPath PackageDir SourceDir]
forall a b. (a -> b) -> [a] -> [b]
map String -> SymbolicPath PackageDir SourceDir
forall from to. String -> SymbolicPath from to
unsafeMakeSymbolicPath [String]
sourceDirs)
          String
dir
          Bool
isSrcDist
          (ModuleName -> String
ModuleName.toFilePath ModuleName
modu)
          Verbosity
verbosity
          [Suffix]
builtinSuffixes
          [(Suffix, PreProcessor)]
biHandlers
          Bool
False
        | ModuleName
modu <- [ModuleName]
modules
        ]
      -- XXX: what we do here (re SymbolicPath dir)
      -- XXX: 2020-10-15 do we rely here on CWD being the PackageDir?
      -- 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)
      [SymbolicPath PackageDir SourceDir]
-> String
-> Bool
-> String
-> Verbosity
-> [Suffix]
-> [(Suffix, PreProcessor)]
-> Bool
-> IO ()
preprocessFile
        (String -> SymbolicPath PackageDir SourceDir
forall from to. String -> SymbolicPath from to
unsafeMakeSymbolicPath String
dir SymbolicPath PackageDir SourceDir
-> [SymbolicPath PackageDir SourceDir]
-> [SymbolicPath PackageDir SourceDir]
forall a. a -> [a] -> [a]
: BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi)
        String
dir
        Bool
isSrcDist
        (String -> String
dropExtensions (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
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
  :: [SymbolicPath PackageDir SourceDir]
  -- ^ source directories
  -> FilePath
  -- ^ build directory
  -> Bool
  -- ^ preprocess for sdist
  -> FilePath
  -- ^ module file name
  -> Verbosity
  -- ^ verbosity
  -> [Suffix]
  -- ^ builtin suffixes
  -> [(Suffix, PreProcessor)]
  -- ^ possible preprocessors
  -> Bool
  -- ^ fail on missing file
  -> IO ()
preprocessFile :: [SymbolicPath PackageDir SourceDir]
-> String
-> Bool
-> String
-> Verbosity
-> [Suffix]
-> [(Suffix, PreProcessor)]
-> Bool
-> IO ()
preprocessFile [SymbolicPath PackageDir SourceDir]
searchLoc String
buildLoc Bool
forSDist String
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
  Maybe (String, String)
psrcFiles <- [Suffix] -> [String] -> String -> IO (Maybe (String, String))
findFileWithExtension' (((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) ((SymbolicPath PackageDir SourceDir -> String)
-> [SymbolicPath PackageDir SourceDir] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir SourceDir -> String
forall from to. SymbolicPath from to -> String
getSymbolicPath [SymbolicPath PackageDir SourceDir]
searchLoc) String
baseFile
  case Maybe (String, String)
psrcFiles of
    -- no preprocessor file exists, look for an ordinary source file
    -- just to make sure one actually exists at all for this module.
    -- Note: by looking in the target/output build dir too, we allow
    -- source files to appear magically in the target build dir without
    -- any corresponding "real" source file. This lets custom Setup.hs
    -- files generate source modules directly into the build dir without
    -- the rest of the build system being aware of it (somewhat dodgy)
    Maybe (String, String)
Nothing -> do
      Maybe String
bsrcFiles <- [Suffix] -> [String] -> String -> IO (Maybe String)
findFileWithExtension [Suffix]
builtinSuffixes (String
buildLoc String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (SymbolicPath PackageDir SourceDir -> String)
-> [SymbolicPath PackageDir SourceDir] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir SourceDir -> String
forall from to. SymbolicPath from to -> String
getSymbolicPath [SymbolicPath PackageDir SourceDir]
searchLoc) String
baseFile
      case (Maybe String
bsrcFiles, Bool
failOnMissing) of
        (Maybe String
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
$
            String -> CabalException
CantFindSourceForPreProcessFile (String -> CabalException) -> String -> CabalException
forall a b. (a -> b) -> a -> b
$
              String
"can't find source for "
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
baseFile
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in "
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((SymbolicPath PackageDir SourceDir -> String)
-> [SymbolicPath PackageDir SourceDir] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir SourceDir -> String
forall from to. SymbolicPath from to -> String
getSymbolicPath [SymbolicPath PackageDir SourceDir]
searchLoc)
        (Maybe String, 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 (String
psrcLoc, String
psrcRelFile) -> do
      let (String
srcStem, String
ext) = String -> (String, String)
splitExtension String
psrcRelFile
          psrcFile :: String
psrcFile = String
psrcLoc String -> String -> String
</> String
psrcRelFile
          pp :: PreProcessor
pp =
            PreProcessor -> Maybe PreProcessor -> PreProcessor
forall a. a -> Maybe a -> a
fromMaybe
              (String -> PreProcessor
forall a. HasCallStack => String -> a
error String
"Distribution.Simple.PreProcess: Just expected")
              (Suffix -> [(Suffix, PreProcessor)] -> Maybe PreProcessor
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String -> Suffix
Suffix (String -> Suffix) -> String -> Suffix
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
safeTail String
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.
        Maybe String
ppsrcFiles <- [Suffix] -> [String] -> String -> IO (Maybe String)
findFileWithExtension [Suffix]
builtinSuffixes [String
buildLoc] String
baseFile
        Bool
recomp <- case Maybe String
ppsrcFiles of
          Maybe String
Nothing -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
          Just String
ppsrcFile ->
            String
psrcFile String -> String -> IO Bool
`moreRecentFile` String
ppsrcFile
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
recomp (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          let destDir :: String
destDir = String
buildLoc String -> String -> String
</> String -> String
dirName String
srcStem
          Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True String
destDir
          PreProcessor -> (String, String) -> (String, String) -> IO ()
runPreProcessorWithHsBootHack
            PreProcessor
pp
            (String
psrcLoc, String
psrcRelFile)
            (String
buildLoc, String
srcStem String -> String -> String
<.> String
"hs")
  where
    dirName :: String -> String
dirName = String -> String
takeDirectory

    -- 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 -> (String, String) -> (String, String) -> IO ()
runPreProcessorWithHsBootHack
      PreProcessor
pp
      (String
inBaseDir, String
inRelativeFile)
      (String
outBaseDir, String
outRelativeFile) = do
        PreProcessor
-> (String, String) -> (String, String) -> Verbosity -> IO ()
runPreProcessor
          PreProcessor
pp
          (String
inBaseDir, String
inRelativeFile)
          (String
outBaseDir, String
outRelativeFile)
          Verbosity
verbosity

        Bool
exists <- String -> IO Bool
doesFileExist String
inBoot
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> String -> String -> IO ()
copyFileVerbose Verbosity
verbosity String
inBoot String
outBoot
        where
          inBoot :: String
inBoot = String -> String -> String
replaceExtension String
inFile String
"hs-boot"
          outBoot :: String
outBoot = String -> String -> String
replaceExtension String
outFile String
"hs-boot"

          inFile :: String
inFile = String -> String
normalise (String
inBaseDir String -> String -> String
</> String
inRelativeFile)
          outFile :: String
outFile = String -> String
normalise (String
outBaseDir String -> String -> String
</> String
outRelativeFile)

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

-- * known preprocessors

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

ppGreenCard :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppGreenCard :: BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppGreenCard BuildInfo
_ LocalBuildInfo
lbi ComponentLocalBuildInfo
_ =
  PreProcessor
    { platformIndependent :: Bool
platformIndependent = Bool
False
    , ppOrdering :: Verbosity -> [String] -> [ModuleName] -> IO [ModuleName]
ppOrdering = Verbosity -> [String] -> [ModuleName] -> IO [ModuleName]
unsorted
    , runPreProcessor :: (String, String) -> (String, String) -> Verbosity -> IO ()
runPreProcessor = (String -> String -> Verbosity -> IO ())
-> (String, String) -> (String, String) -> Verbosity -> IO ()
mkSimplePreProcessor ((String -> String -> Verbosity -> IO ())
 -> (String, String) -> (String, String) -> Verbosity -> IO ())
-> (String -> String -> Verbosity -> IO ())
-> (String, String)
-> (String, String)
-> Verbosity
-> IO ()
forall a b. (a -> b) -> a -> b
$ \String
inFile String
outFile Verbosity
verbosity ->
        Verbosity -> Program -> ProgramDb -> [String] -> IO ()
runDbProgram
          Verbosity
verbosity
          Program
greencardProgram
          (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
          ([String
"-tffi", String
"-o" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
outFile, String
inFile])
    }

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

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

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

ppGhcCpp
  :: Program
  -> (Version -> Bool)
  -> [String]
  -> BuildInfo
  -> LocalBuildInfo
  -> ComponentLocalBuildInfo
  -> PreProcessor
ppGhcCpp :: Program
-> (Version -> Bool)
-> [String]
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> PreProcessor
ppGhcCpp Program
program Version -> Bool
xHs [String]
extraArgs BuildInfo
_bi LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi =
  PreProcessor
    { platformIndependent :: Bool
platformIndependent = Bool
False
    , ppOrdering :: Verbosity -> [String] -> [ModuleName] -> IO [ModuleName]
ppOrdering = Verbosity -> [String] -> [ModuleName] -> IO [ModuleName]
unsorted
    , runPreProcessor :: (String, String) -> (String, String) -> Verbosity -> IO ()
runPreProcessor = (String -> String -> Verbosity -> IO ())
-> (String, String) -> (String, String) -> Verbosity -> IO ()
mkSimplePreProcessor ((String -> String -> Verbosity -> IO ())
 -> (String, String) -> (String, String) -> Verbosity -> IO ())
-> (String -> String -> Verbosity -> IO ())
-> (String, String)
-> (String, String)
-> Verbosity
-> IO ()
forall a b. (a -> b) -> a -> b
$ \String
inFile String
outFile Verbosity
verbosity -> do
        (ConfiguredProgram
prog, Version
version, ProgramDb
_) <-
          Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)
requireProgramVersion
            Verbosity
verbosity
            Program
program
            VersionRange
anyVersion
            (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
        Verbosity -> ConfiguredProgram -> [String] -> IO ()
runProgram Verbosity
verbosity ConfiguredProgram
prog ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$
          [String
"-E", String
"-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.
            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (if Version -> Bool
xHs Version
version then [String
"-x", String
"hs"] else [])
            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"-optP-include", String
"-optP" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi String -> String -> String
</> String
cppHeaderName)]
            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"-o", String
outFile, String
inFile]
            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
extraArgs
    }

ppCpphs :: [String] -> BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppCpphs :: [String]
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> PreProcessor
ppCpphs [String]
extraArgs BuildInfo
_bi LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi =
  PreProcessor
    { platformIndependent :: Bool
platformIndependent = Bool
False
    , ppOrdering :: Verbosity -> [String] -> [ModuleName] -> IO [ModuleName]
ppOrdering = Verbosity -> [String] -> [ModuleName] -> IO [ModuleName]
unsorted
    , runPreProcessor :: (String, String) -> (String, String) -> Verbosity -> IO ()
runPreProcessor = (String -> String -> Verbosity -> IO ())
-> (String, String) -> (String, String) -> Verbosity -> IO ()
mkSimplePreProcessor ((String -> String -> Verbosity -> IO ())
 -> (String, String) -> (String, String) -> Verbosity -> IO ())
-> (String -> String -> Verbosity -> IO ())
-> (String, String)
-> (String, String)
-> Verbosity
-> IO ()
forall a b. (a -> b) -> a -> b
$ \String
inFile String
outFile Verbosity
verbosity -> do
        (ConfiguredProgram
cpphsProg, Version
cpphsVersion, ProgramDb
_) <-
          Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)
requireProgramVersion
            Verbosity
verbosity
            Program
cpphsProgram
            VersionRange
anyVersion
            (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
        Verbosity -> ConfiguredProgram -> [String] -> IO ()
runProgram Verbosity
verbosity ConfiguredProgram
cpphsProg ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$
          (String
"-O" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
outFile)
            String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
inFile
            String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"--noline"
            String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"--strip"
            String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ( if Version
cpphsVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
1, Int
6]
                  then [String
"--include=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi String -> String -> String
</> String
cppHeaderName)]
                  else []
              )
            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
extraArgs
    }

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 -> [String] -> [ModuleName] -> IO [ModuleName]
ppOrdering = Verbosity -> [String] -> [ModuleName] -> IO [ModuleName]
unsorted
    , runPreProcessor :: (String, String) -> (String, String) -> Verbosity -> IO ()
runPreProcessor = (String -> String -> Verbosity -> IO ())
-> (String, String) -> (String, String) -> Verbosity -> IO ()
mkSimplePreProcessor ((String -> String -> Verbosity -> IO ())
 -> (String, String) -> (String, String) -> Verbosity -> IO ())
-> (String -> String -> Verbosity -> IO ())
-> (String, String)
-> (String, String)
-> Verbosity
-> IO ()
forall a b. (a -> b) -> a -> b
$ \String
inFile String
outFile Verbosity
verbosity -> do
        (ConfiguredProgram
gccProg, ProgramDb
_) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
gccProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
        (ConfiguredProgram
hsc2hsProg, Version
hsc2hsVersion, ProgramDb
_) <-
          Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)
requireProgramVersion
            Verbosity
verbosity
            Program
hsc2hsProgram
            VersionRange
anyVersion
            (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
        -- See Trac #13896 and https://github.com/haskell/cabal/issues/3122.
        let isCross :: Bool
isCross = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi Platform -> Platform -> Bool
forall a. Eq a => a -> a -> Bool
/= Platform
buildPlatform
            prependCrossFlags :: [String] -> [String]
prependCrossFlags = if Bool
isCross then (String
"-x" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) else [String] -> [String]
forall a. a -> a
id
        let hsc2hsSupportsResponseFiles :: Bool
hsc2hsSupportsResponseFiles = Version
hsc2hsVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
0, Int
68, Int
4]
            pureArgs :: [String]
pureArgs = Version -> ConfiguredProgram -> String -> String -> [String]
genPureArgs Version
hsc2hsVersion ConfiguredProgram
gccProg String
inFile String
outFile
        if Bool
hsc2hsSupportsResponseFiles
          then
            Verbosity
-> TempFileOptions
-> String
-> String
-> Maybe TextEncoding
-> [String]
-> (String -> IO ())
-> IO ()
forall a.
Verbosity
-> TempFileOptions
-> String
-> String
-> Maybe TextEncoding
-> [String]
-> (String -> IO a)
-> IO a
withResponseFile
              Verbosity
verbosity
              TempFileOptions
defaultTempFileOptions
              (String -> String
takeDirectory String
outFile)
              String
"hsc2hs-response.txt"
              Maybe TextEncoding
forall a. Maybe a
Nothing
              [String]
pureArgs
              ( \String
responseFileName ->
                  Verbosity -> ConfiguredProgram -> [String] -> IO ()
runProgram Verbosity
verbosity ConfiguredProgram
hsc2hsProg ([String] -> [String]
prependCrossFlags [String
"@" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
responseFileName])
              )
          else Verbosity -> ConfiguredProgram -> [String] -> IO ()
runProgram Verbosity
verbosity ConfiguredProgram
hsc2hsProg ([String] -> [String]
prependCrossFlags [String]
pureArgs)
    }
  where
    -- 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 -> String -> String -> [String]
genPureArgs Version
hsc2hsVersion ConfiguredProgram
gccProg String
inFile String
outFile =
      -- Additional gcc options
      [ String
"--cflag=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt
      | String
opt <-
          ConfiguredProgram -> [String]
programDefaultArgs ConfiguredProgram
gccProg
            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> [String]
programOverrideArgs ConfiguredProgram
gccProg
      ]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--lflag=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt
           | String
opt <-
              ConfiguredProgram -> [String]
programDefaultArgs ConfiguredProgram
gccProg
                [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> [String]
programOverrideArgs ConfiguredProgram
gccProg
           ]
        -- OSX frameworks:
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
what String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"=-F" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt
           | Bool
isOSX
           , String
opt <- [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ((InstalledPackageInfo -> [String])
-> [InstalledPackageInfo] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap InstalledPackageInfo -> [String]
Installed.frameworkDirs [InstalledPackageInfo]
pkgs)
           , String
what <- [String
"--cflag", String
"--lflag"]
           ]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--lflag=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
arg
           | Bool
isOSX
           , String
opt <- BuildInfo -> [String]
PD.frameworks BuildInfo
bi [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (InstalledPackageInfo -> [String])
-> [InstalledPackageInfo] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap InstalledPackageInfo -> [String]
Installed.frameworks [InstalledPackageInfo]
pkgs
           , String
arg <- [String
"-framework", String
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.

        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"--cflag=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- LocalBuildInfo -> [String]
platformDefines LocalBuildInfo
lbi]
        -- Options from the current package:
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"--cflag=-I" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dir | String
dir <- BuildInfo -> [String]
PD.includeDirs BuildInfo
bi]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"--cflag=-I" String -> String -> String
forall a. [a] -> [a] -> [a]
++ LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
dir | String
dir <- BuildInfo -> [String]
PD.includeDirs BuildInfo
bi]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--cflag=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt
           | String
opt <-
              BuildInfo -> [String]
PD.ccOptions BuildInfo
bi
                [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
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!
           ]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--cflag=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt
           | String
opt <-
              [ String
"-I" String -> String -> String
forall a. [a] -> [a] -> [a]
++ LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
              , String
"-I" String -> String -> String
forall a. [a] -> [a] -> [a]
++ LocalBuildInfo -> String
autogenPackageModulesDir LocalBuildInfo
lbi
              , String
"-include"
              , LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi String -> String -> String
</> String
cppHeaderName
              ]
           ]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--lflag=-L" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt
           | String
opt <-
              if LocalBuildInfo -> Bool
withFullyStaticExe LocalBuildInfo
lbi
                then BuildInfo -> [String]
PD.extraLibDirsStatic BuildInfo
bi
                else BuildInfo -> [String]
PD.extraLibDirs BuildInfo
bi
           ]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--lflag=-Wl,-R," String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt
           | Bool
isELF
           , String
opt <-
              if LocalBuildInfo -> Bool
withFullyStaticExe LocalBuildInfo
lbi
                then BuildInfo -> [String]
PD.extraLibDirsStatic BuildInfo
bi
                else BuildInfo -> [String]
PD.extraLibDirs BuildInfo
bi
           ]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"--lflag=-l" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- BuildInfo -> [String]
PD.extraLibs BuildInfo
bi]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"--lflag=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- BuildInfo -> [String]
PD.ldOptions BuildInfo
bi]
        -- Options from dependent packages
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--cflag=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt
           | InstalledPackageInfo
pkg <- [InstalledPackageInfo]
pkgs
           , String
opt <-
              [String
"-I" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- InstalledPackageInfo -> [String]
Installed.includeDirs InstalledPackageInfo
pkg]
                [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ InstalledPackageInfo -> [String]
Installed.ccOptions InstalledPackageInfo
pkg
           ]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--lflag=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt
           | InstalledPackageInfo
pkg <- [InstalledPackageInfo]
pkgs
           , String
opt <-
              [String
"-L" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- InstalledPackageInfo -> [String]
Installed.libraryDirs InstalledPackageInfo
pkg]
                [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"-Wl,-R," String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | Bool
isELF, String
opt <- InstalledPackageInfo -> [String]
Installed.libraryDirs InstalledPackageInfo
pkg
                   ]
                [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"-l" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt
                   | String
opt <-
                      if LocalBuildInfo -> Bool
withFullyStaticExe LocalBuildInfo
lbi
                        then InstalledPackageInfo -> [String]
Installed.extraLibrariesStatic InstalledPackageInfo
pkg
                        else InstalledPackageInfo -> [String]
Installed.extraLibraries InstalledPackageInfo
pkg
                   ]
                [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ InstalledPackageInfo -> [String]
Installed.ldOptions InstalledPackageInfo
pkg
           ]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
preccldFlags
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
hsc2hsOptions BuildInfo
bi
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
postccldFlags
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"-o", String
outFile, String
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 :: [String]
ccldFlags =
          [ String
"--cc=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> String
programPath ConfiguredProgram
gccProg
          , String
"--ld=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> String
programPath ConfiguredProgram
gccProg
          ]

        ([String]
preccldFlags, [String]
postccldFlags)
          | Version
hsc2hsVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
0, Int
68, Int
8] = ([String]
ccldFlags, [])
          | Bool
otherwise = ([], [String]
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 ->
          String -> InstalledPackageIndex
forall a. HasCallStack => String -> a
error (String
"ppHsc2hs: broken closure: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(InstalledPackageInfo, [UnitId])] -> String
forall a. Show a => a -> String
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 (String -> PackageName
mkPackageName String
"rts") of
        [(Version
_, [InstalledPackageInfo
rts])] ->
          InstalledPackageInfo
-> InstalledPackageIndex -> InstalledPackageIndex
PackageIndex.insert InstalledPackageInfo
rts{Installed.ldOptions = []} InstalledPackageIndex
index
        [(Version, [InstalledPackageInfo])]
_ -> String -> InstalledPackageIndex
forall a. HasCallStack => String -> a
error String
"No (or multiple) ghc rts package is registered!!"

ppHsc2hsExtras :: PreProcessorExtras
ppHsc2hsExtras :: PreProcessorExtras
ppHsc2hsExtras String
buildBaseDir =
  (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
"_hsc.c" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`)
    ([String] -> [String]) -> IO [String] -> IO [String]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` PreProcessorExtras
getDirectoryContentsRecursive String
buildBaseDir

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 -> [String] -> [ModuleName] -> IO [ModuleName]
ppOrdering = Verbosity -> [String] -> [ModuleName] -> IO [ModuleName]
unsorted
    , runPreProcessor :: (String, String) -> (String, String) -> Verbosity -> IO ()
runPreProcessor =
        \(String
inBaseDir, String
inRelativeFile)
         (String
outBaseDir, String
outRelativeFile)
         Verbosity
verbosity -> do
            (ConfiguredProgram
c2hsProg, Version
_, ProgramDb
_) <-
              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)
            (ConfiguredProgram
gccProg, ProgramDb
_) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
gccProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
            Verbosity -> ConfiguredProgram -> [String] -> IO ()
runProgram Verbosity
verbosity ConfiguredProgram
c2hsProg ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$
              -- Options from the current package:
              [String
"--cpp=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> String
programPath ConfiguredProgram
gccProg, String
"--cppopts=-E"]
                [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"--cppopts=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- BuildInfo -> LocalBuildInfo -> [String]
getCppOptions BuildInfo
bi LocalBuildInfo
lbi]
                [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"--cppopts=-include" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi String -> String -> String
</> String
cppHeaderName)]
                [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"--include=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
outBaseDir]
                -- Options from dependent packages
                [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--cppopts=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt
                   | InstalledPackageInfo
pkg <- [InstalledPackageInfo]
pkgs
                   , String
opt <-
                      [String
"-I" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- InstalledPackageInfo -> [String]
Installed.includeDirs InstalledPackageInfo
pkg]
                        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
opt | opt :: String
opt@(Char
'-' : Char
c : String
_) <- InstalledPackageInfo -> [String]
Installed.ccOptions InstalledPackageInfo
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!
                           Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"DIU"
                           ]
                   ]
                -- TODO: install .chi files for packages, so we can --include
                -- those dirs here, for the dependencies

                -- input and output files
                [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"--output-dir=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
outBaseDir
                   , String
"--output=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
outRelativeFile
                   , String
inBaseDir String -> String -> String
</> String
inRelativeFile
                   ]
    }
  where
    pkgs :: [InstalledPackageInfo]
pkgs = InstalledPackageIndex -> [InstalledPackageInfo]
forall a. PackageInstalled a => PackageIndex a -> [a]
PackageIndex.topologicalOrder (LocalBuildInfo -> InstalledPackageIndex
installedPkgs LocalBuildInfo
lbi)

ppC2hsExtras :: PreProcessorExtras
ppC2hsExtras :: PreProcessorExtras
ppC2hsExtras String
d =
  (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
p -> String -> String
takeExtensions String
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".chs.c")
    ([String] -> [String]) -> IO [String] -> IO [String]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` PreProcessorExtras
getDirectoryContentsRecursive String
d

-- 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 -> [String]
getCppOptions BuildInfo
bi LocalBuildInfo
lbi =
  LocalBuildInfo -> [String]
platformDefines LocalBuildInfo
lbi
    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
cppOptions BuildInfo
bi
    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"-I" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dir | String
dir <- BuildInfo -> [String]
PD.includeDirs BuildInfo
bi]
    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
opt | opt :: String
opt@(Char
'-' : Char
c : String
_) <- BuildInfo -> [String]
PD.ccOptions BuildInfo
bi [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
PD.cxxOptions BuildInfo
bi, Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"DIU"]

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

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

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 -> [String] -> PreProcessor
standardPP LocalBuildInfo
lbi Program
happyProgram (CompilerFlavor -> [String]
hcFlags CompilerFlavor
hc)
    hc :: CompilerFlavor
hc = Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
    hcFlags :: CompilerFlavor -> [String]
hcFlags CompilerFlavor
GHC = [String
"-agc"]
    hcFlags CompilerFlavor
GHCJS = [String
"-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 -> [String] -> PreProcessor
standardPP LocalBuildInfo
lbi Program
alexProgram (CompilerFlavor -> [String]
hcFlags CompilerFlavor
hc)
    hc :: CompilerFlavor
hc = Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
    hcFlags :: CompilerFlavor -> [String]
hcFlags CompilerFlavor
GHC = [String
"-g"]
    hcFlags CompilerFlavor
GHCJS = [String
"-g"]
    hcFlags CompilerFlavor
_ = []

standardPP :: LocalBuildInfo -> Program -> [String] -> PreProcessor
standardPP :: LocalBuildInfo -> Program -> [String] -> PreProcessor
standardPP LocalBuildInfo
lbi Program
prog [String]
args =
  PreProcessor
    { platformIndependent :: Bool
platformIndependent = Bool
False
    , ppOrdering :: Verbosity -> [String] -> [ModuleName] -> IO [ModuleName]
ppOrdering = Verbosity -> [String] -> [ModuleName] -> IO [ModuleName]
unsorted
    , runPreProcessor :: (String, String) -> (String, String) -> Verbosity -> IO ()
runPreProcessor = (String -> String -> Verbosity -> IO ())
-> (String, String) -> (String, String) -> Verbosity -> IO ()
mkSimplePreProcessor ((String -> String -> Verbosity -> IO ())
 -> (String, String) -> (String, String) -> Verbosity -> IO ())
-> (String -> String -> Verbosity -> IO ())
-> (String, String)
-> (String, String)
-> Verbosity
-> IO ()
forall a b. (a -> b) -> a -> b
$ \String
inFile String
outFile Verbosity
verbosity ->
        Verbosity -> Program -> ProgramDb -> [String] -> IO ()
runDbProgram
          Verbosity
verbosity
          Program
prog
          (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
          ([String]
args [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"-o", String
outFile, String
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: GreenCard, c2hs, hsc2hs, happy, alex and cpphs.
knownSuffixHandlers :: [PPSuffixHandler]
knownSuffixHandlers :: [PPSuffixHandler]
knownSuffixHandlers =
  [ (String -> Suffix
Suffix String
"gc", BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppGreenCard)
  , (String -> Suffix
Suffix String
"chs", BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppC2hs)
  , (String -> Suffix
Suffix String
"hsc", BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppHsc2hs)
  , (String -> Suffix
Suffix String
"x", BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppAlex)
  , (String -> Suffix
Suffix String
"y", BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppHappy)
  , (String -> Suffix
Suffix String
"ly", BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppHappy)
  , (String -> Suffix
Suffix String
"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 [FilePath]
preprocessExtras :: Verbosity -> Component -> LocalBuildInfo -> IO [String]
preprocessExtras Verbosity
verbosity Component
comp LocalBuildInfo
lbi = case Component
comp of
  CLib Library
_ -> PreProcessorExtras
pp PreProcessorExtras -> PreProcessorExtras
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi
  (CExe Executable{exeName :: Executable -> UnqualComponentName
exeName = UnqualComponentName
nm}) -> do
    let nm' :: String
nm' = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
nm
    PreProcessorExtras
pp PreProcessorExtras -> PreProcessorExtras
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
nm' String -> String -> String
</> String
nm' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-tmp"
  (CFLib ForeignLib{foreignLibName :: ForeignLib -> UnqualComponentName
foreignLibName = UnqualComponentName
nm}) -> do
    let nm' :: String
nm' = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
nm
    PreProcessorExtras
pp PreProcessorExtras -> PreProcessorExtras
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
nm' String -> String -> String
</> String
nm' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-tmp"
  CTest TestSuite
test -> do
    let nm' :: String
nm' = UnqualComponentName -> String
unUnqualComponentName (UnqualComponentName -> String) -> UnqualComponentName -> String
forall a b. (a -> b) -> a -> b
$ TestSuite -> UnqualComponentName
testName TestSuite
test
    case TestSuite -> TestSuiteInterface
testInterface TestSuite
test of
      TestSuiteExeV10 Version
_ String
_ ->
        PreProcessorExtras
pp PreProcessorExtras -> PreProcessorExtras
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
nm' String -> String -> String
</> String
nm' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-tmp"
      TestSuiteLibV09 Version
_ ModuleName
_ ->
        PreProcessorExtras
pp PreProcessorExtras -> PreProcessorExtras
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> TestSuite -> String
stubName TestSuite
test String -> String -> String
</> TestSuite -> String
stubName TestSuite
test String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-tmp"
      TestSuiteUnsupported TestType
tt ->
        Verbosity -> CabalException -> IO [String]
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO [String]) -> CabalException -> IO [String]
forall a b. (a -> b) -> a -> b
$ TestType -> CabalException
NoSupportPreProcessingTestExtras TestType
tt
  CBench Benchmark
bm -> do
    let nm' :: String
nm' = UnqualComponentName -> String
unUnqualComponentName (UnqualComponentName -> String) -> UnqualComponentName -> String
forall a b. (a -> b) -> a -> b
$ Benchmark -> UnqualComponentName
benchmarkName Benchmark
bm
    case Benchmark -> BenchmarkInterface
benchmarkInterface Benchmark
bm of
      BenchmarkExeV10 Version
_ String
_ ->
        PreProcessorExtras
pp PreProcessorExtras -> PreProcessorExtras
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
nm' String -> String -> String
</> String
nm' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-tmp"
      BenchmarkUnsupported BenchmarkType
tt ->
        Verbosity -> CabalException -> IO [String]
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO [String]) -> CabalException -> IO [String]
forall a b. (a -> b) -> a -> b
$ BenchmarkType -> CabalException
NoSupportPreProcessingBenchmarkExtras BenchmarkType
tt
  where
    pp :: FilePath -> IO [FilePath]
    pp :: PreProcessorExtras
pp String
dir = do
      Bool
b <- String -> IO Bool
doesDirectoryExist String
dir
      if Bool
b
        then
          ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
dir String -> String -> String
</>) ([String] -> [String])
-> ([[String]] -> [String]) -> [[String]] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
not_sub ([String] -> [String])
-> ([[String]] -> [String]) -> [[String]] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat)
            ([[String]] -> [String]) -> IO [[String]] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PreProcessorExtras]
-> (PreProcessorExtras -> IO [String]) -> IO [[String]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for
              [PreProcessorExtras]
knownExtrasHandlers
              ((PreProcessorExtras -> WithCallStack (IO [String]))
-> WithCallStack (PreProcessorExtras -> IO [String])
forall a b.
(a -> WithCallStack (IO b)) -> WithCallStack (a -> IO b)
withLexicalCallStack (\PreProcessorExtras
f -> PreProcessorExtras
f String
dir))
        else [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
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 :: String -> Bool
not_sub String
p = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool -> Bool
not (String
pre String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
p) | String
pre <- [String]
component_dirs]
    component_dirs :: [String]
component_dirs = PackageDescription -> [String]
component_names (LocalBuildInfo -> PackageDescription
localPkgDescr LocalBuildInfo
lbi)
    -- TODO: libify me
    component_names :: PackageDescription -> [String]
component_names PackageDescription
pkg_descr =
      (UnqualComponentName -> String)
-> [UnqualComponentName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnqualComponentName -> String
unUnqualComponentName ([UnqualComponentName] -> [String])
-> [UnqualComponentName] -> [String]
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)