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

-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Simple.GHC.Internal
-- Copyright   :  Isaac Jones 2003-2007
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This module contains functions shared by GHC (Distribution.Simple.GHC)
-- and GHC-derived compilers.

module Distribution.Simple.GHC.Internal (
        configureToolchain,
        getLanguages,
        getExtensions,
        targetPlatform,
        getGhcInfo,
        componentCcGhcOptions,
        componentCmmGhcOptions,
        componentCxxGhcOptions,
        componentAsmGhcOptions,
        componentGhcOptions,
        mkGHCiLibName,
        mkGHCiProfLibName,
        filterGhciFlags,
        ghcLookupProperty,
        getHaskellObjects,
        mkGhcOptPackages,
        substTopDir,
        checkPackageDbEnvVar,
        profDetailLevelFlag,
        -- * GHC platform and version strings
        ghcArchString,
        ghcOsString,
        ghcPlatformAndVersionString,
        -- * Constructing GHC environment files
        GhcEnvironmentFileEntry(..),
        writeGhcEnvironmentFile,
        simpleGhcEnvironmentFile,
        ghcEnvironmentFileName,
        renderGhcEnvironmentFile,
        renderGhcEnvironmentFileEntry,
 ) where

import Prelude ()
import Distribution.Compat.Prelude

import Distribution.Simple.GHC.ImplInfo
import Distribution.Types.ComponentLocalBuildInfo
import Distribution.Backpack
import qualified Distribution.InstalledPackageInfo as IPI
import Distribution.PackageDescription
import Distribution.Lex
import Distribution.Simple.Compiler
import Distribution.Simple.Program.GHC
import Distribution.Simple.Setup
import qualified Distribution.ModuleName as ModuleName
import Distribution.Simple.Program
import Distribution.Simple.LocalBuildInfo
import Distribution.Types.UnitId
import Distribution.Types.LocalBuildInfo
import Distribution.Types.TargetInfo
import Distribution.Simple.Utils
import Distribution.Simple.BuildPaths
import Distribution.System
import Distribution.Pretty ( prettyShow )
import Distribution.Parsec ( simpleParsec )
import Distribution.Utils.NubList ( toNubListR )
import Distribution.Verbosity
import Distribution.Compat.Stack
import Distribution.Version (Version)
import Distribution.Utils.Path
import Language.Haskell.Extension

import qualified Data.Map as Map
import qualified Data.ByteString.Lazy.Char8 as BS
import System.Directory         ( getDirectoryContents, getTemporaryDirectory )
import System.Environment       ( getEnv )
import System.FilePath          ( (</>), (<.>), takeExtension
                                , takeDirectory, takeFileName)
import System.IO                ( hClose, hPutStrLn )

targetPlatform :: [(String, String)] -> Maybe Platform
targetPlatform :: [(String, String)] -> Maybe Platform
targetPlatform [(String, String)]
ghcInfo = String -> Maybe Platform
platformFromTriple forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"Target platform" [(String, String)]
ghcInfo

-- | Adjust the way we find and configure gcc and ld
--
configureToolchain :: GhcImplInfo
                   -> ConfiguredProgram
                   -> Map String String
                   -> ProgramDb
                   -> ProgramDb
configureToolchain :: GhcImplInfo
-> ConfiguredProgram -> Map String String -> ProgramDb -> ProgramDb
configureToolchain GhcImplInfo
_implInfo ConfiguredProgram
ghcProg Map String String
ghcInfo =
    Program -> ProgramDb -> ProgramDb
addKnownProgram Program
gccProgram {
      programFindLocation :: Verbosity -> ProgramSearchPath -> IO (Maybe (String, [String]))
programFindLocation = String
-> [String]
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (String, [String]))
findProg String
gccProgramName [String]
extraGccPath,
      programPostConf :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
programPostConf     = Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
configureGcc
    }
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> ProgramDb -> ProgramDb
addKnownProgram Program
ldProgram {
      programFindLocation :: Verbosity -> ProgramSearchPath -> IO (Maybe (String, [String]))
programFindLocation = String
-> [String]
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (String, [String]))
findProg String
ldProgramName [String]
extraLdPath,
      programPostConf :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
programPostConf     = Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
configureLd
    }
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> ProgramDb -> ProgramDb
addKnownProgram Program
arProgram {
      programFindLocation :: Verbosity -> ProgramSearchPath -> IO (Maybe (String, [String]))
programFindLocation = String
-> [String]
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (String, [String]))
findProg String
arProgramName [String]
extraArPath
    }
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> ProgramDb -> ProgramDb
addKnownProgram Program
stripProgram {
      programFindLocation :: Verbosity -> ProgramSearchPath -> IO (Maybe (String, [String]))
programFindLocation = String
-> [String]
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (String, [String]))
findProg String
stripProgramName [String]
extraStripPath
    }
  where
    compilerDir :: String
compilerDir = String -> String
takeDirectory (ConfiguredProgram -> String
programPath ConfiguredProgram
ghcProg)
    base_dir :: String
base_dir     = String -> String
takeDirectory String
compilerDir
    mingwBinDir :: String
mingwBinDir = String
base_dir String -> String -> String
</> String
"mingw" String -> String -> String
</> String
"bin"
    isWindows :: Bool
isWindows   = case OS
buildOS of OS
Windows -> Bool
True; OS
_ -> Bool
False
    binPrefix :: String
binPrefix   = String
""

    maybeName :: Program -> Maybe FilePath -> String
    maybeName :: Program -> Maybe String -> String
maybeName Program
prog   = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Program -> String
programName Program
prog) (String -> String
dropExeExtension forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeFileName)

    gccProgramName :: String
gccProgramName   = Program -> Maybe String -> String
maybeName Program
gccProgram   Maybe String
mbGccLocation
    ldProgramName :: String
ldProgramName    = Program -> Maybe String -> String
maybeName Program
ldProgram    Maybe String
mbLdLocation
    arProgramName :: String
arProgramName    = Program -> Maybe String -> String
maybeName Program
arProgram    Maybe String
mbArLocation
    stripProgramName :: String
stripProgramName = Program -> Maybe String -> String
maybeName Program
stripProgram Maybe String
mbStripLocation

    mkExtraPath :: Maybe FilePath -> FilePath -> [FilePath]
    mkExtraPath :: Maybe String -> String -> [String]
mkExtraPath Maybe String
mbPath String
mingwPath | Bool
isWindows = [String]
mbDir forall a. [a] -> [a] -> [a]
++ [String
mingwPath]
                                 | Bool
otherwise = [String]
mbDir
      where
        mbDir :: [String]
mbDir = forall a. Maybe a -> [a]
maybeToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
takeDirectory forall a b. (a -> b) -> a -> b
$ Maybe String
mbPath

    extraGccPath :: [String]
extraGccPath   = Maybe String -> String -> [String]
mkExtraPath Maybe String
mbGccLocation   String
windowsExtraGccDir
    extraLdPath :: [String]
extraLdPath    = Maybe String -> String -> [String]
mkExtraPath Maybe String
mbLdLocation    String
windowsExtraLdDir
    extraArPath :: [String]
extraArPath    = Maybe String -> String -> [String]
mkExtraPath Maybe String
mbArLocation    String
windowsExtraArDir
    extraStripPath :: [String]
extraStripPath = Maybe String -> String -> [String]
mkExtraPath Maybe String
mbStripLocation String
windowsExtraStripDir

    -- on Windows finding and configuring ghc's gcc & binutils is a bit special
    (String
windowsExtraGccDir, String
windowsExtraLdDir,
     String
windowsExtraArDir, String
windowsExtraStripDir) =
          let b :: String
b = String
mingwBinDir String -> String -> String
</> String
binPrefix
          in  (String
b, String
b, String
b, String
b)

    findProg :: String -> [FilePath]
             -> Verbosity -> ProgramSearchPath
             -> IO (Maybe (FilePath, [FilePath]))
    findProg :: String
-> [String]
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (String, [String]))
findProg String
progName [String]
extraPath Verbosity
v ProgramSearchPath
searchpath =
        Verbosity
-> ProgramSearchPath -> String -> IO (Maybe (String, [String]))
findProgramOnSearchPath Verbosity
v ProgramSearchPath
searchpath' String
progName
      where
        searchpath' :: ProgramSearchPath
searchpath' = (forall a b. (a -> b) -> [a] -> [b]
map String -> ProgramSearchPathEntry
ProgramSearchPathDir [String]
extraPath) forall a. [a] -> [a] -> [a]
++ ProgramSearchPath
searchpath

    -- Read tool locations from the 'ghc --info' output. Useful when
    -- cross-compiling.
    mbGccLocation :: Maybe String
mbGccLocation   = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"C compiler command" Map String String
ghcInfo
    mbLdLocation :: Maybe String
mbLdLocation    = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"ld command" Map String String
ghcInfo
    mbArLocation :: Maybe String
mbArLocation    = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"ar command" Map String String
ghcInfo
    mbStripLocation :: Maybe String
mbStripLocation = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"strip command" Map String String
ghcInfo

    ccFlags :: [String]
ccFlags        = String -> [String]
getFlags String
"C compiler flags"
    -- GHC 7.8 renamed "Gcc Linker flags" to "C compiler link flags"
    -- and "Ld Linker flags" to "ld flags" (GHC #4862).
    gccLinkerFlags :: [String]
gccLinkerFlags = String -> [String]
getFlags String
"Gcc Linker flags" forall a. [a] -> [a] -> [a]
++ String -> [String]
getFlags String
"C compiler link flags"
    ldLinkerFlags :: [String]
ldLinkerFlags  = String -> [String]
getFlags String
"Ld Linker flags" forall a. [a] -> [a] -> [a]
++ String -> [String]
getFlags String
"ld flags"

    -- It appears that GHC 7.6 and earlier encode the tokenized flags as a
    -- [String] in these settings whereas later versions just encode the flags as
    -- String.
    --
    -- We first try to parse as a [String] and if this fails then tokenize the
    -- flags ourself.
    getFlags :: String -> [String]
    getFlags :: String -> [String]
getFlags String
key =
        case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
key Map String String
ghcInfo of
          Maybe String
Nothing -> []
          Just String
flags
            | ([String]
flags', String
""):[([String], String)]
_ <- forall a. Read a => ReadS a
reads String
flags -> [String]
flags'
            | Bool
otherwise -> String -> [String]
tokenizeQuotedWords String
flags

    configureGcc :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
    configureGcc :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
configureGcc Verbosity
_v ConfiguredProgram
gccProg = do
      forall (m :: * -> *) a. Monad m => a -> m a
return ConfiguredProgram
gccProg {
        programDefaultArgs :: [String]
programDefaultArgs = ConfiguredProgram -> [String]
programDefaultArgs ConfiguredProgram
gccProg
                             forall a. [a] -> [a] -> [a]
++ [String]
ccFlags forall a. [a] -> [a] -> [a]
++ [String]
gccLinkerFlags
      }

    configureLd :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
    configureLd :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
configureLd Verbosity
v ConfiguredProgram
ldProg = do
      ConfiguredProgram
ldProg' <- Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
configureLd' Verbosity
v ConfiguredProgram
ldProg
      forall (m :: * -> *) a. Monad m => a -> m a
return ConfiguredProgram
ldProg' {
        programDefaultArgs :: [String]
programDefaultArgs = ConfiguredProgram -> [String]
programDefaultArgs ConfiguredProgram
ldProg' forall a. [a] -> [a] -> [a]
++ [String]
ldLinkerFlags
      }

    -- we need to find out if ld supports the -x flag
    configureLd' :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
    configureLd' :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
configureLd' Verbosity
verbosity ConfiguredProgram
ldProg = do
      String
tempDir <- IO String
getTemporaryDirectory
      Bool
ldx <- forall a. String -> String -> (String -> Handle -> IO a) -> IO a
withTempFile String
tempDir String
".c" forall a b. (a -> b) -> a -> b
$ \String
testcfile Handle
testchnd ->
             forall a. String -> String -> (String -> Handle -> IO a) -> IO a
withTempFile String
tempDir String
".o" forall a b. (a -> b) -> a -> b
$ \String
testofile Handle
testohnd -> do
               Handle -> String -> IO ()
hPutStrLn Handle
testchnd String
"int foo() { return 0; }"
               Handle -> IO ()
hClose Handle
testchnd; Handle -> IO ()
hClose Handle
testohnd
               Verbosity -> ConfiguredProgram -> [String] -> IO ()
runProgram Verbosity
verbosity ConfiguredProgram
ghcProg
                          [ String
"-hide-all-packages"
                          , String
"-c", String
testcfile
                          , String
"-o", String
testofile
                          ]
               forall a. String -> String -> (String -> Handle -> IO a) -> IO a
withTempFile String
tempDir String
".o" forall a b. (a -> b) -> a -> b
$ \String
testofile' Handle
testohnd' ->
                 do
                   Handle -> IO ()
hClose Handle
testohnd'
                   String
_ <- Verbosity -> ConfiguredProgram -> [String] -> IO String
getProgramOutput Verbosity
verbosity ConfiguredProgram
ldProg
                     [String
"-x", String
"-r", String
testofile, String
"-o", String
testofile']
                   forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                 forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO`   (\IOException
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
                 forall a. IO a -> (ExitCode -> IO a) -> IO a
`catchExit` (\ExitCode
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
      if Bool
ldx
        then forall (m :: * -> *) a. Monad m => a -> m a
return ConfiguredProgram
ldProg { programDefaultArgs :: [String]
programDefaultArgs = [String
"-x"] }
        else forall (m :: * -> *) a. Monad m => a -> m a
return ConfiguredProgram
ldProg

getLanguages :: Verbosity -> GhcImplInfo -> ConfiguredProgram
             -> IO [(Language, String)]
getLanguages :: Verbosity
-> GhcImplInfo -> ConfiguredProgram -> IO [(Language, String)]
getLanguages Verbosity
_ GhcImplInfo
implInfo ConfiguredProgram
_
  -- TODO: should be using --supported-languages rather than hard coding
  | GhcImplInfo -> Bool
supportsGHC2021 GhcImplInfo
implInfo = forall (m :: * -> *) a. Monad m => a -> m a
return
    [ (Language
GHC2021, String
"-XGHC2021")
    , (Language
Haskell2010, String
"-XHaskell2010")
    , (Language
Haskell98, String
"-XHaskell98")
    ]
  | GhcImplInfo -> Bool
supportsHaskell2010 GhcImplInfo
implInfo = forall (m :: * -> *) a. Monad m => a -> m a
return [(Language
Haskell98,   String
"-XHaskell98")
                                          ,(Language
Haskell2010, String
"-XHaskell2010")]
  | Bool
otherwise                    = forall (m :: * -> *) a. Monad m => a -> m a
return [(Language
Haskell98,   String
"")]

getGhcInfo :: Verbosity -> GhcImplInfo -> ConfiguredProgram
           -> IO [(String, String)]
getGhcInfo :: Verbosity
-> GhcImplInfo -> ConfiguredProgram -> IO [(String, String)]
getGhcInfo Verbosity
verbosity GhcImplInfo
_implInfo ConfiguredProgram
ghcProg = do
      String
xs <- Verbosity -> ConfiguredProgram -> [String] -> IO String
getProgramOutput Verbosity
verbosity (ConfiguredProgram -> ConfiguredProgram
suppressOverrideArgs ConfiguredProgram
ghcProg)
                 [String
"--info"]
      case forall a. Read a => ReadS a
reads String
xs of
        [([(String, String)]
i, String
ss)]
          | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
ss ->
              forall (m :: * -> *) a. Monad m => a -> m a
return [(String, String)]
i
        [([(String, String)], String)]
_ ->
          forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity String
"Can't parse --info output of GHC"

getExtensions :: Verbosity -> GhcImplInfo -> ConfiguredProgram
              -> IO [(Extension, Maybe String)]
getExtensions :: Verbosity
-> GhcImplInfo
-> ConfiguredProgram
-> IO [(Extension, Maybe String)]
getExtensions Verbosity
verbosity GhcImplInfo
implInfo ConfiguredProgram
ghcProg = do
    String
str <- Verbosity -> ConfiguredProgram -> [String] -> IO String
getProgramOutput Verbosity
verbosity (ConfiguredProgram -> ConfiguredProgram
suppressOverrideArgs ConfiguredProgram
ghcProg)
              [String
"--supported-languages"]
    let extStrs :: [String]
extStrs = if GhcImplInfo -> Bool
reportsNoExt GhcImplInfo
implInfo
                  then String -> [String]
lines String
str
                  else -- Older GHCs only gave us either Foo or NoFoo,
                       -- so we have to work out the other one ourselves
                       [ String
extStr''
                       | String
extStr <- String -> [String]
lines String
str
                       , let extStr' :: String
extStr' = case String
extStr of
                                       Char
'N' : Char
'o' : String
xs -> String
xs
                                       String
_              -> String
"No" forall a. [a] -> [a] -> [a]
++ String
extStr
                       , String
extStr'' <- [String
extStr, String
extStr']
                       ]
    let extensions0 :: [(Extension, Maybe String)]
extensions0 = [ (Extension
ext, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String
"-X" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow Extension
ext)
                      | Just Extension
ext <- forall a b. (a -> b) -> [a] -> [b]
map forall a. Parsec a => String -> Maybe a
simpleParsec [String]
extStrs ]
        extensions1 :: [(Extension, Maybe String)]
extensions1 = if GhcImplInfo -> Bool
alwaysNondecIndent GhcImplInfo
implInfo
                      then -- ghc-7.2 split NondecreasingIndentation off
                           -- into a proper extension. Before that it
                           -- was always on.
                           -- Since it was not a proper extension, it could
                           -- not be turned off, hence we omit a
                           -- DisableExtension entry here.
                           (KnownExtension -> Extension
EnableExtension KnownExtension
NondecreasingIndentation, forall a. Maybe a
Nothing) forall a. a -> [a] -> [a]
:
                           [(Extension, Maybe String)]
extensions0
                      else [(Extension, Maybe String)]
extensions0
    forall (m :: * -> *) a. Monad m => a -> m a
return [(Extension, Maybe String)]
extensions1

componentCcGhcOptions :: Verbosity -> GhcImplInfo -> LocalBuildInfo
                      -> BuildInfo -> ComponentLocalBuildInfo
                      -> FilePath -> FilePath
                      -> GhcOptions
componentCcGhcOptions :: Verbosity
-> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> String
-> String
-> GhcOptions
componentCcGhcOptions Verbosity
verbosity GhcImplInfo
_implInfo LocalBuildInfo
lbi BuildInfo
bi ComponentLocalBuildInfo
clbi String
odir String
filename =
    forall a. Monoid a => a
mempty {
      -- Respect -v0, but don't crank up verbosity on GHC if
      -- Cabal verbosity is requested. For that, use --ghc-option=-v instead!
      ghcOptVerbosity :: Flag Verbosity
ghcOptVerbosity      = forall a. a -> Flag a
toFlag (forall a. Ord a => a -> a -> a
min Verbosity
verbosity Verbosity
normal),
      ghcOptMode :: Flag GhcMode
ghcOptMode           = forall a. a -> Flag a
toFlag GhcMode
GhcModeCompile,
      ghcOptInputFiles :: NubListR String
ghcOptInputFiles     = forall a. Ord a => [a] -> NubListR a
toNubListR [String
filename],

      ghcOptCppIncludePath :: NubListR String
ghcOptCppIncludePath = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$ [LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
                                          ,LocalBuildInfo -> String
autogenPackageModulesDir LocalBuildInfo
lbi
                                          ,String
odir]
                                          -- includes relative to the package
                                          forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
includeDirs BuildInfo
bi
                                          -- potential includes generated by `configure'
                                          -- in the build directory
                                          forall a. [a] -> [a] -> [a]
++ [LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
dir | String
dir <- BuildInfo -> [String]
includeDirs BuildInfo
bi],
      ghcOptHideAllPackages :: Flag Bool
ghcOptHideAllPackages= forall a. a -> Flag a
toFlag Bool
True,
      ghcOptPackageDBs :: PackageDBStack
ghcOptPackageDBs     = LocalBuildInfo -> PackageDBStack
withPackageDB LocalBuildInfo
lbi,
      ghcOptPackages :: NubListR (OpenUnitId, ModuleRenaming)
ghcOptPackages       = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$ ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)]
mkGhcOptPackages ComponentLocalBuildInfo
clbi,
      ghcOptCcOptions :: [String]
ghcOptCcOptions      = (case LocalBuildInfo -> OptimisationLevel
withOptimization LocalBuildInfo
lbi of
                                  OptimisationLevel
NoOptimisation -> []
                                  OptimisationLevel
_              -> [String
"-O2"]) forall a. [a] -> [a] -> [a]
++
                             (case LocalBuildInfo -> DebugInfoLevel
withDebugInfo LocalBuildInfo
lbi of
                                  DebugInfoLevel
NoDebugInfo   -> []
                                  DebugInfoLevel
MinimalDebugInfo -> [String
"-g1"]
                                  DebugInfoLevel
NormalDebugInfo  -> [String
"-g"]
                                  DebugInfoLevel
MaximalDebugInfo -> [String
"-g3"]) forall a. [a] -> [a] -> [a]
++
                                  BuildInfo -> [String]
ccOptions BuildInfo
bi,
      ghcOptObjDir :: Flag String
ghcOptObjDir         = forall a. a -> Flag a
toFlag String
odir
    }


componentCxxGhcOptions :: Verbosity -> GhcImplInfo -> LocalBuildInfo
                      -> BuildInfo -> ComponentLocalBuildInfo
                      -> FilePath -> FilePath
                      -> GhcOptions
componentCxxGhcOptions :: Verbosity
-> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> String
-> String
-> GhcOptions
componentCxxGhcOptions Verbosity
verbosity GhcImplInfo
_implInfo LocalBuildInfo
lbi BuildInfo
bi ComponentLocalBuildInfo
clbi String
odir String
filename =
    forall a. Monoid a => a
mempty {
      -- Respect -v0, but don't crank up verbosity on GHC if
      -- Cabal verbosity is requested. For that, use --ghc-option=-v instead!
      ghcOptVerbosity :: Flag Verbosity
ghcOptVerbosity      = forall a. a -> Flag a
toFlag (forall a. Ord a => a -> a -> a
min Verbosity
verbosity Verbosity
normal),
      ghcOptMode :: Flag GhcMode
ghcOptMode           = forall a. a -> Flag a
toFlag GhcMode
GhcModeCompile,
      ghcOptInputFiles :: NubListR String
ghcOptInputFiles     = forall a. Ord a => [a] -> NubListR a
toNubListR [String
filename],

      ghcOptCppIncludePath :: NubListR String
ghcOptCppIncludePath = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$ [LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
                                          ,LocalBuildInfo -> String
autogenPackageModulesDir LocalBuildInfo
lbi
                                          ,String
odir]
                                          -- includes relative to the package
                                          forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
includeDirs BuildInfo
bi
                                          -- potential includes generated by `configure'
                                          -- in the build directory
                                          forall a. [a] -> [a] -> [a]
++ [LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
dir | String
dir <- BuildInfo -> [String]
includeDirs BuildInfo
bi],
      ghcOptHideAllPackages :: Flag Bool
ghcOptHideAllPackages= forall a. a -> Flag a
toFlag Bool
True,
      ghcOptPackageDBs :: PackageDBStack
ghcOptPackageDBs     = LocalBuildInfo -> PackageDBStack
withPackageDB LocalBuildInfo
lbi,
      ghcOptPackages :: NubListR (OpenUnitId, ModuleRenaming)
ghcOptPackages       = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$ ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)]
mkGhcOptPackages ComponentLocalBuildInfo
clbi,
      ghcOptCxxOptions :: [String]
ghcOptCxxOptions     = (case LocalBuildInfo -> OptimisationLevel
withOptimization LocalBuildInfo
lbi of
                                  OptimisationLevel
NoOptimisation -> []
                                  OptimisationLevel
_              -> [String
"-O2"]) forall a. [a] -> [a] -> [a]
++
                             (case LocalBuildInfo -> DebugInfoLevel
withDebugInfo LocalBuildInfo
lbi of
                                  DebugInfoLevel
NoDebugInfo   -> []
                                  DebugInfoLevel
MinimalDebugInfo -> [String
"-g1"]
                                  DebugInfoLevel
NormalDebugInfo  -> [String
"-g"]
                                  DebugInfoLevel
MaximalDebugInfo -> [String
"-g3"]) forall a. [a] -> [a] -> [a]
++
                                  BuildInfo -> [String]
cxxOptions BuildInfo
bi,
      ghcOptObjDir :: Flag String
ghcOptObjDir         = forall a. a -> Flag a
toFlag String
odir
    }


componentAsmGhcOptions :: Verbosity -> GhcImplInfo -> LocalBuildInfo
                      -> BuildInfo -> ComponentLocalBuildInfo
                      -> FilePath -> FilePath
                      -> GhcOptions
componentAsmGhcOptions :: Verbosity
-> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> String
-> String
-> GhcOptions
componentAsmGhcOptions Verbosity
verbosity GhcImplInfo
_implInfo LocalBuildInfo
lbi BuildInfo
bi ComponentLocalBuildInfo
clbi String
odir String
filename =
    forall a. Monoid a => a
mempty {
      -- Respect -v0, but don't crank up verbosity on GHC if
      -- Cabal verbosity is requested. For that, use --ghc-option=-v instead!
      ghcOptVerbosity :: Flag Verbosity
ghcOptVerbosity      = forall a. a -> Flag a
toFlag (forall a. Ord a => a -> a -> a
min Verbosity
verbosity Verbosity
normal),
      ghcOptMode :: Flag GhcMode
ghcOptMode           = forall a. a -> Flag a
toFlag GhcMode
GhcModeCompile,
      ghcOptInputFiles :: NubListR String
ghcOptInputFiles     = forall a. Ord a => [a] -> NubListR a
toNubListR [String
filename],

      ghcOptCppIncludePath :: NubListR String
ghcOptCppIncludePath = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$ [LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
                                          ,LocalBuildInfo -> String
autogenPackageModulesDir LocalBuildInfo
lbi
                                          ,String
odir]
                                          -- includes relative to the package
                                          forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
includeDirs BuildInfo
bi
                                          -- potential includes generated by `configure'
                                          -- in the build directory
                                          forall a. [a] -> [a] -> [a]
++ [LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
dir | String
dir <- BuildInfo -> [String]
includeDirs BuildInfo
bi],
      ghcOptHideAllPackages :: Flag Bool
ghcOptHideAllPackages= forall a. a -> Flag a
toFlag Bool
True,
      ghcOptPackageDBs :: PackageDBStack
ghcOptPackageDBs     = LocalBuildInfo -> PackageDBStack
withPackageDB LocalBuildInfo
lbi,
      ghcOptPackages :: NubListR (OpenUnitId, ModuleRenaming)
ghcOptPackages       = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$ ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)]
mkGhcOptPackages ComponentLocalBuildInfo
clbi,
      ghcOptAsmOptions :: [String]
ghcOptAsmOptions     = (case LocalBuildInfo -> OptimisationLevel
withOptimization LocalBuildInfo
lbi of
                                  OptimisationLevel
NoOptimisation -> []
                                  OptimisationLevel
_              -> [String
"-O2"]) forall a. [a] -> [a] -> [a]
++
                             (case LocalBuildInfo -> DebugInfoLevel
withDebugInfo LocalBuildInfo
lbi of
                                  DebugInfoLevel
NoDebugInfo   -> []
                                  DebugInfoLevel
MinimalDebugInfo -> [String
"-g1"]
                                  DebugInfoLevel
NormalDebugInfo  -> [String
"-g"]
                                  DebugInfoLevel
MaximalDebugInfo -> [String
"-g3"]) forall a. [a] -> [a] -> [a]
++
                                  BuildInfo -> [String]
asmOptions BuildInfo
bi,
      ghcOptObjDir :: Flag String
ghcOptObjDir         = forall a. a -> Flag a
toFlag String
odir
    }


componentGhcOptions :: Verbosity -> GhcImplInfo -> LocalBuildInfo
                    -> BuildInfo -> ComponentLocalBuildInfo -> FilePath
                    -> GhcOptions
componentGhcOptions :: Verbosity
-> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> String
-> GhcOptions
componentGhcOptions Verbosity
verbosity GhcImplInfo
implInfo LocalBuildInfo
lbi BuildInfo
bi ComponentLocalBuildInfo
clbi String
odir =
    forall a. Monoid a => a
mempty {
      -- Respect -v0, but don't crank up verbosity on GHC if
      -- Cabal verbosity is requested. For that, use --ghc-option=-v instead!
      ghcOptVerbosity :: Flag Verbosity
ghcOptVerbosity       = forall a. a -> Flag a
toFlag (forall a. Ord a => a -> a -> a
min Verbosity
verbosity Verbosity
normal),
      ghcOptCabal :: Flag Bool
ghcOptCabal           = forall a. a -> Flag a
toFlag Bool
True,
      ghcOptThisUnitId :: Flag String
ghcOptThisUnitId      = case ComponentLocalBuildInfo
clbi of
        LibComponentLocalBuildInfo { componentCompatPackageKey :: ComponentLocalBuildInfo -> String
componentCompatPackageKey = String
pk }
          -> forall a. a -> Flag a
toFlag String
pk
        ComponentLocalBuildInfo
_ -> forall a. Monoid a => a
mempty,
      ghcOptThisComponentId :: Flag ComponentId
ghcOptThisComponentId = case ComponentLocalBuildInfo
clbi of
          LibComponentLocalBuildInfo { componentComponentId :: ComponentLocalBuildInfo -> ComponentId
componentComponentId = ComponentId
cid
                                     , componentInstantiatedWith :: ComponentLocalBuildInfo -> [(ModuleName, OpenModule)]
componentInstantiatedWith = [(ModuleName, OpenModule)]
insts } ->
              if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ModuleName, OpenModule)]
insts
                  then forall a. Monoid a => a
mempty
                  else forall a. a -> Flag a
toFlag ComponentId
cid
          ComponentLocalBuildInfo
_ -> forall a. Monoid a => a
mempty,
      ghcOptInstantiatedWith :: [(ModuleName, OpenModule)]
ghcOptInstantiatedWith = case ComponentLocalBuildInfo
clbi of
        LibComponentLocalBuildInfo { componentInstantiatedWith :: ComponentLocalBuildInfo -> [(ModuleName, OpenModule)]
componentInstantiatedWith = [(ModuleName, OpenModule)]
insts }
          -> [(ModuleName, OpenModule)]
insts
        ComponentLocalBuildInfo
_ -> [],
      ghcOptNoCode :: Flag Bool
ghcOptNoCode          = forall a. a -> Flag a
toFlag forall a b. (a -> b) -> a -> b
$ ComponentLocalBuildInfo -> Bool
componentIsIndefinite ComponentLocalBuildInfo
clbi,
      ghcOptHideAllPackages :: Flag Bool
ghcOptHideAllPackages = forall a. a -> Flag a
toFlag Bool
True,
      ghcOptWarnMissingHomeModules :: Flag Bool
ghcOptWarnMissingHomeModules = forall a. a -> Flag a
toFlag forall a b. (a -> b) -> a -> b
$ GhcImplInfo -> Bool
flagWarnMissingHomeModules GhcImplInfo
implInfo,
      ghcOptPackageDBs :: PackageDBStack
ghcOptPackageDBs      = LocalBuildInfo -> PackageDBStack
withPackageDB LocalBuildInfo
lbi,
      ghcOptPackages :: NubListR (OpenUnitId, ModuleRenaming)
ghcOptPackages        = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$ ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)]
mkGhcOptPackages ComponentLocalBuildInfo
clbi,
      ghcOptSplitSections :: Flag Bool
ghcOptSplitSections   = forall a. a -> Flag a
toFlag (LocalBuildInfo -> Bool
splitSections LocalBuildInfo
lbi),
      ghcOptSplitObjs :: Flag Bool
ghcOptSplitObjs       = forall a. a -> Flag a
toFlag (LocalBuildInfo -> Bool
splitObjs LocalBuildInfo
lbi),
      ghcOptSourcePathClear :: Flag Bool
ghcOptSourcePathClear = forall a. a -> Flag a
toFlag Bool
True,
      ghcOptSourcePath :: NubListR String
ghcOptSourcePath      = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$ [String
odir] forall a. [a] -> [a] -> [a]
++ (forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> String
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi))
                                           forall a. [a] -> [a] -> [a]
++ [LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi]
                                           forall a. [a] -> [a] -> [a]
++ [LocalBuildInfo -> String
autogenPackageModulesDir LocalBuildInfo
lbi],
      ghcOptCppIncludePath :: NubListR String
ghcOptCppIncludePath  = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$ [LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
                                           ,LocalBuildInfo -> String
autogenPackageModulesDir LocalBuildInfo
lbi
                                           ,String
odir]
                                           -- includes relative to the package
                                           forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
includeDirs BuildInfo
bi
                                           -- potential includes generated by `configure'
                                           -- in the build directory
                                           forall a. [a] -> [a] -> [a]
++ [LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
dir | String
dir <- BuildInfo -> [String]
includeDirs BuildInfo
bi],
      ghcOptCppOptions :: [String]
ghcOptCppOptions      = BuildInfo -> [String]
cppOptions BuildInfo
bi,
      ghcOptCppIncludes :: NubListR String
ghcOptCppIncludes     = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$
                              [LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi String -> String -> String
</> String
cppHeaderName],
      ghcOptFfiIncludes :: NubListR String
ghcOptFfiIncludes     = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$ BuildInfo -> [String]
includes BuildInfo
bi,
      ghcOptObjDir :: Flag String
ghcOptObjDir          = forall a. a -> Flag a
toFlag String
odir,
      ghcOptHiDir :: Flag String
ghcOptHiDir           = forall a. a -> Flag a
toFlag String
odir,
      ghcOptStubDir :: Flag String
ghcOptStubDir         = forall a. a -> Flag a
toFlag String
odir,
      ghcOptOutputDir :: Flag String
ghcOptOutputDir       = forall a. a -> Flag a
toFlag String
odir,
      ghcOptOptimisation :: Flag GhcOptimisation
ghcOptOptimisation    = OptimisationLevel -> Flag GhcOptimisation
toGhcOptimisation (LocalBuildInfo -> OptimisationLevel
withOptimization LocalBuildInfo
lbi),
      ghcOptDebugInfo :: Flag DebugInfoLevel
ghcOptDebugInfo       = forall a. a -> Flag a
toFlag (LocalBuildInfo -> DebugInfoLevel
withDebugInfo LocalBuildInfo
lbi),
      ghcOptExtra :: [String]
ghcOptExtra           = CompilerFlavor -> BuildInfo -> [String]
hcOptions CompilerFlavor
GHC BuildInfo
bi,
      ghcOptExtraPath :: NubListR String
ghcOptExtraPath       = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$ [String]
exe_paths,
      ghcOptLanguage :: Flag Language
ghcOptLanguage        = forall a. a -> Flag a
toFlag (forall a. a -> Maybe a -> a
fromMaybe Language
Haskell98 (BuildInfo -> Maybe Language
defaultLanguage BuildInfo
bi)),
      -- Unsupported extensions have already been checked by configure
      ghcOptExtensions :: NubListR Extension
ghcOptExtensions      = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$ BuildInfo -> [Extension]
usedExtensions BuildInfo
bi,
      ghcOptExtensionMap :: Map Extension (Maybe String)
ghcOptExtensionMap    = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compiler -> [(Extension, Maybe String)]
compilerExtensions forall a b. (a -> b) -> a -> b
$ (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
    }
  where
    exe_paths :: [String]
exe_paths = [ LocalBuildInfo -> ComponentLocalBuildInfo -> String
componentBuildDir LocalBuildInfo
lbi (TargetInfo -> ComponentLocalBuildInfo
targetCLBI TargetInfo
exe_tgt)
                | UnitId
uid <- ComponentLocalBuildInfo -> [UnitId]
componentExeDeps ComponentLocalBuildInfo
clbi
                -- TODO: Ugh, localPkgDescr
                , Just TargetInfo
exe_tgt <- [PackageDescription -> LocalBuildInfo -> UnitId -> Maybe TargetInfo
unitIdTarget' (LocalBuildInfo -> PackageDescription
localPkgDescr LocalBuildInfo
lbi) LocalBuildInfo
lbi UnitId
uid] ]

toGhcOptimisation :: OptimisationLevel -> Flag GhcOptimisation
toGhcOptimisation :: OptimisationLevel -> Flag GhcOptimisation
toGhcOptimisation OptimisationLevel
NoOptimisation      = forall a. Monoid a => a
mempty --TODO perhaps override?
toGhcOptimisation OptimisationLevel
NormalOptimisation  = forall a. a -> Flag a
toFlag GhcOptimisation
GhcNormalOptimisation
toGhcOptimisation OptimisationLevel
MaximumOptimisation = forall a. a -> Flag a
toFlag GhcOptimisation
GhcMaximumOptimisation


componentCmmGhcOptions :: Verbosity -> GhcImplInfo -> LocalBuildInfo
                      -> BuildInfo -> ComponentLocalBuildInfo
                      -> FilePath -> FilePath
                      -> GhcOptions
componentCmmGhcOptions :: Verbosity
-> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> String
-> String
-> GhcOptions
componentCmmGhcOptions Verbosity
verbosity GhcImplInfo
_implInfo LocalBuildInfo
lbi BuildInfo
bi ComponentLocalBuildInfo
clbi String
odir String
filename =
    forall a. Monoid a => a
mempty {
      -- Respect -v0, but don't crank up verbosity on GHC if
      -- Cabal verbosity is requested. For that, use --ghc-option=-v instead!
      ghcOptVerbosity :: Flag Verbosity
ghcOptVerbosity      = forall a. a -> Flag a
toFlag (forall a. Ord a => a -> a -> a
min Verbosity
verbosity Verbosity
normal),
      ghcOptMode :: Flag GhcMode
ghcOptMode           = forall a. a -> Flag a
toFlag GhcMode
GhcModeCompile,
      ghcOptInputFiles :: NubListR String
ghcOptInputFiles     = forall a. Ord a => [a] -> NubListR a
toNubListR [String
filename],

      ghcOptCppIncludePath :: NubListR String
ghcOptCppIncludePath = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$ [LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
                                          ,LocalBuildInfo -> String
autogenPackageModulesDir LocalBuildInfo
lbi
                                          ,String
odir]
                                          -- includes relative to the package
                                          forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
includeDirs BuildInfo
bi
                                          -- potential includes generated by `configure'
                                          -- in the build directory
                                          forall a. [a] -> [a] -> [a]
++ [LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
dir | String
dir <- BuildInfo -> [String]
includeDirs BuildInfo
bi],
      ghcOptCppOptions :: [String]
ghcOptCppOptions     = BuildInfo -> [String]
cppOptions BuildInfo
bi,
      ghcOptCppIncludes :: NubListR String
ghcOptCppIncludes    = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$
                             [LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi String -> String -> String
</> String
cppHeaderName],
      ghcOptHideAllPackages :: Flag Bool
ghcOptHideAllPackages= forall a. a -> Flag a
toFlag Bool
True,
      ghcOptPackageDBs :: PackageDBStack
ghcOptPackageDBs     = LocalBuildInfo -> PackageDBStack
withPackageDB LocalBuildInfo
lbi,
      ghcOptPackages :: NubListR (OpenUnitId, ModuleRenaming)
ghcOptPackages       = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$ ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)]
mkGhcOptPackages ComponentLocalBuildInfo
clbi,
      ghcOptOptimisation :: Flag GhcOptimisation
ghcOptOptimisation   = OptimisationLevel -> Flag GhcOptimisation
toGhcOptimisation (LocalBuildInfo -> OptimisationLevel
withOptimization LocalBuildInfo
lbi),
      ghcOptDebugInfo :: Flag DebugInfoLevel
ghcOptDebugInfo      = forall a. a -> Flag a
toFlag (LocalBuildInfo -> DebugInfoLevel
withDebugInfo LocalBuildInfo
lbi),
      ghcOptExtra :: [String]
ghcOptExtra          = BuildInfo -> [String]
cmmOptions BuildInfo
bi,
      ghcOptObjDir :: Flag String
ghcOptObjDir         = forall a. a -> Flag a
toFlag String
odir
    }


-- | Strip out flags that are not supported in ghci
filterGhciFlags :: [String] -> [String]
filterGhciFlags :: [String] -> [String]
filterGhciFlags = forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
supported
  where
    supported :: String -> Bool
supported (Char
'-':Char
'O':String
_) = Bool
False
    supported String
"-debug"    = Bool
False
    supported String
"-threaded" = Bool
False
    supported String
"-ticky"    = Bool
False
    supported String
"-eventlog" = Bool
False
    supported String
"-prof"     = Bool
False
    supported String
"-unreg"    = Bool
False
    supported String
_           = Bool
True

mkGHCiLibName :: UnitId -> String
mkGHCiLibName :: UnitId -> String
mkGHCiLibName UnitId
lib = UnitId -> String
getHSLibraryName UnitId
lib String -> String -> String
<.> String
"o"

mkGHCiProfLibName :: UnitId -> String
mkGHCiProfLibName :: UnitId -> String
mkGHCiProfLibName UnitId
lib = UnitId -> String
getHSLibraryName UnitId
lib String -> String -> String
<.> String
"p_o"

ghcLookupProperty :: String -> Compiler -> Bool
ghcLookupProperty :: String -> Compiler -> Bool
ghcLookupProperty String
prop Compiler
comp =
  case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
prop (Compiler -> Map String String
compilerProperties Compiler
comp) of
    Just String
"YES" -> Bool
True
    Maybe String
_          -> Bool
False

-- when using -split-objs, we need to search for object files in the
-- Module_split directory for each module.
getHaskellObjects :: GhcImplInfo -> Library -> LocalBuildInfo
                  -> ComponentLocalBuildInfo
                  -> FilePath -> String -> Bool -> IO [FilePath]
getHaskellObjects :: GhcImplInfo
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> String
-> String
-> Bool
-> IO [String]
getHaskellObjects GhcImplInfo
_implInfo Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi String
pref String
wanted_obj_ext Bool
allow_split_objs
  | LocalBuildInfo -> Bool
splitObjs LocalBuildInfo
lbi Bool -> Bool -> Bool
&& Bool
allow_split_objs = do
        let splitSuffix :: String
splitSuffix = String
"_" forall a. [a] -> [a] -> [a]
++ String
wanted_obj_ext forall a. [a] -> [a] -> [a]
++ String
"_split"
            dirs :: [String]
dirs = [ String
pref String -> String -> String
</> (ModuleName -> String
ModuleName.toFilePath ModuleName
x forall a. [a] -> [a] -> [a]
++ String
splitSuffix)
                   | ModuleName
x <- Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi ]
        [[String]]
objss <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> IO [String]
getDirectoryContents [String]
dirs
        let objs :: [String]
objs = [ String
dir String -> String -> String
</> String
obj
                   | ([String]
objs',String
dir) <- forall a b. [a] -> [b] -> [(a, b)]
zip [[String]]
objss [String]
dirs, String
obj <- [String]
objs',
                     let obj_ext :: String
obj_ext = String -> String
takeExtension String
obj,
                     Char
'.'forall a. a -> [a] -> [a]
:String
wanted_obj_ext forall a. Eq a => a -> a -> Bool
== String
obj_ext ]
        forall (m :: * -> *) a. Monad m => a -> m a
return [String]
objs
  | Bool
otherwise  =
        forall (m :: * -> *) a. Monad m => a -> m a
return [ String
pref String -> String -> String
</> ModuleName -> String
ModuleName.toFilePath ModuleName
x String -> String -> String
<.> String
wanted_obj_ext
               | ModuleName
x <- Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi ]

mkGhcOptPackages :: ComponentLocalBuildInfo
                 -> [(OpenUnitId, ModuleRenaming)]
mkGhcOptPackages :: ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)]
mkGhcOptPackages = ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)]
componentIncludes

substTopDir :: FilePath -> IPI.InstalledPackageInfo -> IPI.InstalledPackageInfo
substTopDir :: String -> InstalledPackageInfo -> InstalledPackageInfo
substTopDir String
topDir InstalledPackageInfo
ipo
 = InstalledPackageInfo
ipo {
       importDirs :: [String]
IPI.importDirs        = forall a b. (a -> b) -> [a] -> [b]
map String -> String
f (InstalledPackageInfo -> [String]
IPI.importDirs InstalledPackageInfo
ipo),
       libraryDirs :: [String]
IPI.libraryDirs       = forall a b. (a -> b) -> [a] -> [b]
map String -> String
f (InstalledPackageInfo -> [String]
IPI.libraryDirs InstalledPackageInfo
ipo),
       includeDirs :: [String]
IPI.includeDirs       = forall a b. (a -> b) -> [a] -> [b]
map String -> String
f (InstalledPackageInfo -> [String]
IPI.includeDirs InstalledPackageInfo
ipo),
       frameworkDirs :: [String]
IPI.frameworkDirs     = forall a b. (a -> b) -> [a] -> [b]
map String -> String
f (InstalledPackageInfo -> [String]
IPI.frameworkDirs InstalledPackageInfo
ipo),
       haddockInterfaces :: [String]
IPI.haddockInterfaces = forall a b. (a -> b) -> [a] -> [b]
map String -> String
f (InstalledPackageInfo -> [String]
IPI.haddockInterfaces InstalledPackageInfo
ipo),
       haddockHTMLs :: [String]
IPI.haddockHTMLs      = forall a b. (a -> b) -> [a] -> [b]
map String -> String
f (InstalledPackageInfo -> [String]
IPI.haddockHTMLs InstalledPackageInfo
ipo)
   }
    where f :: String -> String
f (Char
'$':Char
't':Char
'o':Char
'p':Char
'd':Char
'i':Char
'r':String
rest) = String
topDir forall a. [a] -> [a] -> [a]
++ String
rest
          f String
x = String
x

-- Cabal does not use the environment variable GHC{,JS}_PACKAGE_PATH; let
-- users know that this is the case. See ticket #335. Simply ignoring it is
-- not a good idea, since then ghc and cabal are looking at different sets
-- of package DBs and chaos is likely to ensue.
--
-- An exception to this is when running cabal from within a `cabal exec`
-- environment. In this case, `cabal exec` will set the
-- CABAL_SANDBOX_PACKAGE_PATH to the same value that it set
-- GHC{,JS}_PACKAGE_PATH to. If that is the case it is OK to allow
-- GHC{,JS}_PACKAGE_PATH.
checkPackageDbEnvVar :: Verbosity -> String -> String -> IO ()
checkPackageDbEnvVar :: Verbosity -> String -> String -> IO ()
checkPackageDbEnvVar Verbosity
verbosity String
compilerName String
packagePathEnvVar = do
    Maybe String
mPP <- String -> IO (Maybe String)
lookupEnv String
packagePathEnvVar
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe String
mPP) forall a b. (a -> b) -> a -> b
$ do
        Maybe String
mcsPP <- String -> IO (Maybe String)
lookupEnv String
"CABAL_SANDBOX_PACKAGE_PATH"
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe String
mPP forall a. Eq a => a -> a -> Bool
== Maybe String
mcsPP) forall {a}. IO a
abort
    where
        lookupEnv :: String -> IO (Maybe String)
        lookupEnv :: String -> IO (Maybe String)
lookupEnv String
name = (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO String
getEnv String
name)
                         forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
        abort :: IO a
abort =
            forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"Use of " forall a. [a] -> [a] -> [a]
++ String
compilerName forall a. [a] -> [a] -> [a]
++ String
"'s environment variable "
               forall a. [a] -> [a] -> [a]
++ String
packagePathEnvVar forall a. [a] -> [a] -> [a]
++ String
" is incompatible with Cabal. Use the "
               forall a. [a] -> [a] -> [a]
++ String
"flag --package-db to specify a package database (it can be "
               forall a. [a] -> [a] -> [a]
++ String
"used multiple times)."

        CallStack
_ = HasCallStack => CallStack
callStack -- TODO: output stack when erroring

profDetailLevelFlag :: Bool -> ProfDetailLevel -> Flag GhcProfAuto
profDetailLevelFlag :: Bool -> ProfDetailLevel -> Flag GhcProfAuto
profDetailLevelFlag Bool
forLib ProfDetailLevel
mpl =
    case ProfDetailLevel
mpl of
      ProfDetailLevel
ProfDetailNone                -> forall a. Monoid a => a
mempty
      ProfDetailLevel
ProfDetailDefault | Bool
forLib    -> forall a. a -> Flag a
toFlag GhcProfAuto
GhcProfAutoExported
                        | Bool
otherwise -> forall a. a -> Flag a
toFlag GhcProfAuto
GhcProfAutoToplevel
      ProfDetailLevel
ProfDetailExportedFunctions   -> forall a. a -> Flag a
toFlag GhcProfAuto
GhcProfAutoExported
      ProfDetailLevel
ProfDetailToplevelFunctions   -> forall a. a -> Flag a
toFlag GhcProfAuto
GhcProfAutoToplevel
      ProfDetailLevel
ProfDetailAllFunctions        -> forall a. a -> Flag a
toFlag GhcProfAuto
GhcProfAutoAll
      ProfDetailOther String
_             -> forall a. Monoid a => a
mempty


-- -----------------------------------------------------------------------------
-- GHC platform and version strings

-- | GHC's rendering of its host or target 'Arch' as used in its platform
-- strings and certain file locations (such as user package db location).
--
ghcArchString :: Arch -> String
ghcArchString :: Arch -> String
ghcArchString Arch
PPC   = String
"powerpc"
ghcArchString Arch
PPC64 = String
"powerpc64"
ghcArchString Arch
other = forall a. Pretty a => a -> String
prettyShow Arch
other

-- | GHC's rendering of its host or target 'OS' as used in its platform
-- strings and certain file locations (such as user package db location).
--
ghcOsString :: OS -> String
ghcOsString :: OS -> String
ghcOsString OS
Windows = String
"mingw32"
ghcOsString OS
OSX     = String
"darwin"
ghcOsString OS
Solaris = String
"solaris2"
ghcOsString OS
other   = forall a. Pretty a => a -> String
prettyShow OS
other

-- | GHC's rendering of its platform and compiler version string as used in
-- certain file locations (such as user package db location).
-- For example @x86_64-linux-7.10.4@
--
ghcPlatformAndVersionString :: Platform -> Version -> String
ghcPlatformAndVersionString :: Platform -> Version -> String
ghcPlatformAndVersionString (Platform Arch
arch OS
os) Version
version =
    forall a. [a] -> [[a]] -> [a]
intercalate String
"-" [ Arch -> String
ghcArchString Arch
arch, OS -> String
ghcOsString OS
os, forall a. Pretty a => a -> String
prettyShow Version
version ]


-- -----------------------------------------------------------------------------
-- Constructing GHC environment files

-- | The kinds of entries we can stick in a @.ghc.environment@ file.
--
data GhcEnvironmentFileEntry =
       GhcEnvFileComment   String     -- ^ @-- a comment@
     | GhcEnvFilePackageId UnitId     -- ^ @package-id foo-1.0-4fe301a...@
     | GhcEnvFilePackageDb PackageDB  -- ^ @global-package-db@,
                                      --   @user-package-db@ or
                                      --   @package-db blah/package.conf.d/@
     | GhcEnvFileClearPackageDbStack  -- ^ @clear-package-db@
     deriving (GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry -> Bool
$c/= :: GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry -> Bool
== :: GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry -> Bool
$c== :: GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry -> Bool
Eq, Eq GhcEnvironmentFileEntry
GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry -> Bool
GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry -> Ordering
GhcEnvironmentFileEntry
-> GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GhcEnvironmentFileEntry
-> GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry
$cmin :: GhcEnvironmentFileEntry
-> GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry
max :: GhcEnvironmentFileEntry
-> GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry
$cmax :: GhcEnvironmentFileEntry
-> GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry
>= :: GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry -> Bool
$c>= :: GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry -> Bool
> :: GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry -> Bool
$c> :: GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry -> Bool
<= :: GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry -> Bool
$c<= :: GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry -> Bool
< :: GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry -> Bool
$c< :: GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry -> Bool
compare :: GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry -> Ordering
$ccompare :: GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry -> Ordering
Ord, Int -> GhcEnvironmentFileEntry -> String -> String
[GhcEnvironmentFileEntry] -> String -> String
GhcEnvironmentFileEntry -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GhcEnvironmentFileEntry] -> String -> String
$cshowList :: [GhcEnvironmentFileEntry] -> String -> String
show :: GhcEnvironmentFileEntry -> String
$cshow :: GhcEnvironmentFileEntry -> String
showsPrec :: Int -> GhcEnvironmentFileEntry -> String -> String
$cshowsPrec :: Int -> GhcEnvironmentFileEntry -> String -> String
Show)

-- | Make entries for a GHC environment file based on a 'PackageDBStack' and
-- a bunch of package (unit) ids.
--
-- If you need to do anything more complicated then either use this as a basis
-- and add more entries, or just make all the entries directly.
--
simpleGhcEnvironmentFile :: PackageDBStack
                         -> [UnitId]
                         -> [GhcEnvironmentFileEntry]
simpleGhcEnvironmentFile :: PackageDBStack -> [UnitId] -> [GhcEnvironmentFileEntry]
simpleGhcEnvironmentFile PackageDBStack
packageDBs [UnitId]
pkgids =
    GhcEnvironmentFileEntry
GhcEnvFileClearPackageDbStack
  forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map PackageDB -> GhcEnvironmentFileEntry
GhcEnvFilePackageDb PackageDBStack
packageDBs
 forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map UnitId -> GhcEnvironmentFileEntry
GhcEnvFilePackageId [UnitId]
pkgids

-- | Write a @.ghc.environment-$arch-$os-$ver@ file in the given directory.
--
-- The 'Platform' and GHC 'Version' are needed as part of the file name.
--
-- Returns the name of the file written.
writeGhcEnvironmentFile :: FilePath  -- ^ directory in which to put it
                        -> Platform  -- ^ the GHC target platform
                        -> Version   -- ^ the GHC version
                        -> [GhcEnvironmentFileEntry] -- ^ the content
                        -> IO FilePath
writeGhcEnvironmentFile :: String
-> Platform -> Version -> [GhcEnvironmentFileEntry] -> IO String
writeGhcEnvironmentFile String
directory Platform
platform Version
ghcversion [GhcEnvironmentFileEntry]
entries = do
    String -> ByteString -> IO ()
writeFileAtomic String
envfile forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GhcEnvironmentFileEntry] -> String
renderGhcEnvironmentFile forall a b. (a -> b) -> a -> b
$ [GhcEnvironmentFileEntry]
entries
    forall (m :: * -> *) a. Monad m => a -> m a
return String
envfile
  where
    envfile :: String
envfile = String
directory String -> String -> String
</> Platform -> Version -> String
ghcEnvironmentFileName Platform
platform Version
ghcversion

-- | The @.ghc.environment-$arch-$os-$ver@ file name
--
ghcEnvironmentFileName :: Platform -> Version -> FilePath
ghcEnvironmentFileName :: Platform -> Version -> String
ghcEnvironmentFileName Platform
platform Version
ghcversion =
    String
".ghc.environment." forall a. [a] -> [a] -> [a]
++ Platform -> Version -> String
ghcPlatformAndVersionString Platform
platform Version
ghcversion

-- | Render a bunch of GHC environment file entries
--
renderGhcEnvironmentFile :: [GhcEnvironmentFileEntry] -> String
renderGhcEnvironmentFile :: [GhcEnvironmentFileEntry] -> String
renderGhcEnvironmentFile =
    [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map GhcEnvironmentFileEntry -> String
renderGhcEnvironmentFileEntry

-- | Render an individual GHC environment file entry
--
renderGhcEnvironmentFileEntry :: GhcEnvironmentFileEntry -> String
renderGhcEnvironmentFileEntry :: GhcEnvironmentFileEntry -> String
renderGhcEnvironmentFileEntry GhcEnvironmentFileEntry
entry = case GhcEnvironmentFileEntry
entry of
    GhcEnvFileComment   String
comment   -> String -> String
format String
comment
      where format :: String -> String
format = forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (String
"--" String -> String -> String
<++>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
            String
pref <++> :: String -> String -> String
<++> String
""  = String
pref
            String
pref <++> String
str = String
pref forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
str
    GhcEnvFilePackageId UnitId
pkgid     -> String
"package-id " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow UnitId
pkgid
    GhcEnvFilePackageDb PackageDB
pkgdb     ->
      case PackageDB
pkgdb of
        PackageDB
GlobalPackageDB           -> String
"global-package-db"
        PackageDB
UserPackageDB             -> String
"user-package-db"
        SpecificPackageDB String
dbfile  -> String
"package-db " forall a. [a] -> [a] -> [a]
++ String
dbfile
    GhcEnvironmentFileEntry
GhcEnvFileClearPackageDbStack -> String
"clear-package-db"