{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Distribution.Simple.PreProcess (preprocessComponent, preprocessExtras,
                                knownSuffixHandlers, ppSuffixes,
                                PPSuffixHandler, PreProcessor(..),
                                mkSimplePreProcessor, runSimplePreProcessor,
                                ppCpp, ppCpp', ppGreenCard, ppC2hs, ppHsc2hs,
                                ppHappy, ppAlex, ppUnlit, platformDefines,
                                unsorted
                               )
    where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Compat.Stack
import Distribution.Simple.PreProcess.Unlit
import Distribution.Backpack.DescribeUnitId
import Distribution.Package
import qualified Distribution.ModuleName as ModuleName
import Distribution.ModuleName (ModuleName)
import Distribution.PackageDescription as PD
import qualified Distribution.InstalledPackageInfo as Installed
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.CCompiler
import Distribution.Simple.Compiler
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.BuildPaths
import Distribution.Simple.Utils
import Distribution.Simple.Program
import Distribution.Simple.Program.ResponseFile
import Distribution.Simple.Test.LibV09
import Distribution.System
import Distribution.Types.PackageName.Magic
import Distribution.Pretty
import Distribution.Version
import Distribution.Verbosity
import Distribution.Utils.Path
import System.Directory (doesFileExist, doesDirectoryExist)
import System.Info (os, arch)
import System.FilePath (splitExtension, dropExtensions, (</>), (<.>),
                        takeDirectory, normalise, replaceExtension,
                        takeExtensions)
data PreProcessor = PreProcessor {
  
  
  
  
  PreProcessor -> Bool
platformIndependent :: Bool,
  
  
  
  
  
  
  PreProcessor
-> Verbosity -> [String] -> [ModuleName] -> IO [ModuleName]
ppOrdering :: Verbosity
             -> [FilePath] 
             -> [ModuleName] 
             -> IO [ModuleName], 
  PreProcessor
-> (String, String) -> (String, String) -> Verbosity -> IO ()
runPreProcessor :: (FilePath, FilePath) 
                  -> (FilePath, FilePath) 
                  -> Verbosity 
                  -> IO ()     
  }
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
type  = 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
type PPSuffixHandler
    = (String, BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor)
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 =
  
  
  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
   
   
   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 :: [(String, PreProcessor)]
hndlrs = BuildInfo -> [(String, PreProcessor)]
localHandlers BuildInfo
bi
      [ModuleName]
mods <- Verbosity
-> [String]
-> [(String, PreProcessor)]
-> [ModuleName]
-> IO [ModuleName]
forall {t :: * -> *} {a}.
Foldable t =>
Verbosity
-> [String]
-> t (a, PreProcessor)
-> [ModuleName]
-> IO [ModuleName]
orderingFromHandlers Verbosity
verbosity [String]
dirs [(String, 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 -> [(String, PreProcessor)] -> String -> IO ()
pre [String]
dirs (LocalBuildInfo -> ComponentLocalBuildInfo -> String
componentBuildDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi) [(String, 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 :: [(String, PreProcessor)]
hndlrs = BuildInfo -> [(String, PreProcessor)]
localHandlers BuildInfo
bi
      [ModuleName]
mods <- Verbosity
-> [String]
-> [(String, PreProcessor)]
-> [ModuleName]
-> IO [ModuleName]
forall {t :: * -> *} {a}.
Foldable t =>
Verbosity
-> [String]
-> t (a, PreProcessor)
-> [ModuleName]
-> IO [ModuleName]
orderingFromHandlers Verbosity
verbosity [String]
dirs [(String, 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 -> [(String, PreProcessor)] -> String -> IO ()
pre [String]
dirs String
flibDir [(String, 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 :: [(String, PreProcessor)]
hndlrs = BuildInfo -> [(String, PreProcessor)]
localHandlers BuildInfo
bi
      [ModuleName]
mods <- Verbosity
-> [String]
-> [(String, PreProcessor)]
-> [ModuleName]
-> IO [ModuleName]
forall {t :: * -> *} {a}.
Foldable t =>
Verbosity
-> [String]
-> t (a, PreProcessor)
-> [ModuleName]
-> IO [ModuleName]
orderingFromHandlers Verbosity
verbosity [String]
dirs [(String, 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 -> [(String, PreProcessor)] -> String -> IO ()
pre [String]
dirs String
exeDir [(String, PreProcessor)]
hndlrs
      [String] -> String -> [(String, 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 -> [(String, 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 -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"No support for preprocessing test "
                          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"suite type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TestType -> String
forall a. Pretty a => a -> String
prettyShow 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 -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"No support for preprocessing benchmark "
                          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ BenchmarkType -> String
forall a. Pretty a => a -> String
prettyShow 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
    builtinHaskellSuffixes :: [String]
builtinHaskellSuffixes = [String
"hs", String
"lhs", String
"hsig", String
"lhsig"]
    builtinCSuffixes :: [String]
builtinCSuffixes       = [String]
cSourceExtensions
    builtinSuffixes :: [String]
builtinSuffixes        = [String]
builtinHaskellSuffixes [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
builtinCSuffixes
    localHandlers :: BuildInfo -> [(String, PreProcessor)]
localHandlers BuildInfo
bi = [(String
ext, BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
h BuildInfo
bi LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi) | (String
ext, BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
h) <- [PPSuffixHandler]
handlers]
    pre :: [String] -> String -> [(String, PreProcessor)] -> String -> IO ()
pre [String]
dirs String
dir [(String, PreProcessor)]
lhndlrs String
fp =
      [SymbolicPath PackageDir SourceDir]
-> String
-> Bool
-> String
-> Verbosity
-> [String]
-> [(String, 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 [String]
builtinSuffixes [(String, 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 :: [(String, PreProcessor)]
biHandlers = BuildInfo -> [(String, 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
-> [String]
-> [(String, 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 [String]
builtinSuffixes
                [(String, PreProcessor)]
biHandlers Bool
False
                | ModuleName
modu <- [ModuleName]
modules ]
        
        
        
        [SymbolicPath PackageDir SourceDir]
-> String
-> Bool
-> String
-> Verbosity
-> [String]
-> [(String, 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
            [String]
builtinSuffixes [(String, PreProcessor)]
biHandlers Bool
False
preprocessFile
    :: [SymbolicPath PackageDir SourceDir] 
    -> FilePath                 
    -> Bool                     
    -> FilePath                 
    -> Verbosity                
    -> [String]                 
    -> [(String, PreProcessor)] 
    -> Bool                     
    -> IO ()
preprocessFile :: [SymbolicPath PackageDir SourceDir]
-> String
-> Bool
-> String
-> Verbosity
-> [String]
-> [(String, PreProcessor)]
-> Bool
-> IO ()
preprocessFile [SymbolicPath PackageDir SourceDir]
searchLoc String
buildLoc Bool
forSDist String
baseFile Verbosity
verbosity [String]
builtinSuffixes [(String, PreProcessor)]
handlers Bool
failOnMissing = do
    
    
    Maybe (String, String)
psrcFiles <- [String] -> [String] -> String -> IO (Maybe (String, String))
findFileWithExtension' (((String, PreProcessor) -> String)
-> [(String, PreProcessor)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, PreProcessor) -> String
forall a b. (a, b) -> a
fst [(String, 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
        
        
        
        
        
        
        
      Maybe (String, String)
Nothing -> do
                 Maybe String
bsrcFiles <- [String] -> [String] -> String -> IO (Maybe String)
findFileWithExtension [String]
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 -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
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 ()
        
      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")
                               (String -> [(String, PreProcessor)] -> Maybe PreProcessor
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String -> String
forall a. [a] -> [a]
safeTail String
ext) [(String, PreProcessor)]
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
              
              
              Maybe String
ppsrcFiles <- [String] -> [String] -> String -> IO (Maybe String)
findFileWithExtension [String]
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
    
    
    
    
    
    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)
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])
      }
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 ())
-> (String -> IO ()) -> Either String String -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> String -> IO ()
writeUTF8File String
outFile) (Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity) (String -> String -> Either String String
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"]
          
          
          
          
          
       [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)
      
      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
    
    
    genPureArgs :: Version -> ConfiguredProgram -> String -> String -> [String]
    genPureArgs :: Version -> ConfiguredProgram -> String -> String -> [String]
genPureArgs Version
hsc2hsVersion ConfiguredProgram
gccProg String
inFile String
outFile =
          
          [ 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 ]
          
       [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] ]
          
          
          
          
       [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 ]
          
       [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
                                      
                                      
                                      
                                      
                                      
                                      
                                      
                                      
                                      ]
       [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 ]
          
       [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]
++ [         String
opt | String
opt <- 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]
++ [         String
opt | String
opt <- 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
        
        
        
        
        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)
    
    
    
    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
    
    
    
    
    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 { ldOptions :: [String]
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
 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
$
          
           [ 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 ]
          
       [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
                                                 
                                                 
                                                 
                                                 
                                                 
                                                 
                                                 
                                                 
                                                 
                                 , 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" ] ]
          
          
           
        [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
 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
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)
    
    
    
    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]
_ ->
        
        
        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"]
      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
Sparc       -> [String
"sparc"]
      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
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 :: Bool
platformIndependent = Bool
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 :: Bool
platformIndependent = Bool
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])
  }
ppSuffixes :: [ PPSuffixHandler ] -> [String]
ppSuffixes :: [PPSuffixHandler] -> [String]
ppSuffixes = (PPSuffixHandler -> String) -> [PPSuffixHandler] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map PPSuffixHandler -> String
forall a b. (a, b) -> a
fst
knownSuffixHandlers :: [ PPSuffixHandler ]
knownSuffixHandlers :: [PPSuffixHandler]
knownSuffixHandlers =
  [ (String
"gc",     BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppGreenCard)
  , (String
"chs",    BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppC2hs)
  , (String
"hsc",    BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppHsc2hs)
  , (String
"x",      BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppAlex)
  , (String
"y",      BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppHappy)
  , (String
"ly",     BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppHappy)
  , (String
"cpphs",  BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppCpp)
  ]
knownExtrasHandlers :: [ PreProcessorExtras ]
knownExtrasHandlers :: [PreProcessorExtras]
knownExtrasHandlers = [ PreProcessorExtras
ppC2hsExtras, PreProcessorExtras
ppHsc2hsExtras ]
preprocessExtras :: Verbosity
                 -> Component
                 -> LocalBuildInfo
                 -> IO [FilePath]
 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 -> PreProcessorExtras
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity PreProcessorExtras -> PreProcessorExtras
forall a b. (a -> b) -> a -> b
$ String
"No support for preprocessing test suite type " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                         TestType -> String
forall a. Pretty a => a -> String
prettyShow 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 -> PreProcessorExtras
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity PreProcessorExtras -> PreProcessorExtras
forall a b. (a -> b) -> a -> b
$ String
"No support for preprocessing benchmark "
                        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ BenchmarkType -> String
forall a. Pretty a => a -> String
prettyShow 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 []
    
    
    
    
    
    
    
    
    
    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)
    
    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)