{-# 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.Types.ModuleRenaming
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 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 (String -> Maybe Platform) -> Maybe String -> Maybe Platform
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> [(String, String)] -> Maybe String
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
    }
  (ProgramDb -> ProgramDb)
-> (ProgramDb -> ProgramDb) -> ProgramDb -> ProgramDb
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
    }
  (ProgramDb -> ProgramDb)
-> (ProgramDb -> ProgramDb) -> ProgramDb -> ProgramDb
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
    }
  (ProgramDb -> ProgramDb)
-> (ProgramDb -> ProgramDb) -> ProgramDb -> ProgramDb
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   = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Program -> String
programName Program
prog) (String -> String
dropExeExtension (String -> String) -> (String -> String) -> String -> String
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 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
mingwPath]
                                 | Bool
otherwise = [String]
mbDir
      where
        mbDir :: [String]
mbDir = Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList (Maybe String -> [String])
-> (Maybe String -> Maybe String) -> Maybe String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
takeDirectory (Maybe String -> [String]) -> Maybe String -> [String]
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' = ((String -> ProgramSearchPathEntry) -> [String] -> ProgramSearchPath
forall a b. (a -> b) -> [a] -> [b]
map String -> ProgramSearchPathEntry
ProgramSearchPathDir [String]
extraPath) ProgramSearchPath -> ProgramSearchPath -> ProgramSearchPath
forall a. [a] -> [a] -> [a]
++ ProgramSearchPath
searchpath

    -- Read tool locations from the 'ghc --info' output. Useful when
    -- cross-compiling.
    mbGccLocation :: Maybe String
mbGccLocation   = String -> Map String String -> Maybe String
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    = String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"ld command" Map String String
ghcInfo
    mbArLocation :: Maybe String
mbArLocation    = String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"ar command" Map String String
ghcInfo
    mbStripLocation :: Maybe String
mbStripLocation = String -> Map String String -> Maybe String
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" [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String]
getFlags String
"C compiler link flags"
    ldLinkerFlags :: [String]
ldLinkerFlags  = String -> [String]
getFlags String
"Ld Linker flags" [String] -> [String] -> [String]
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 String -> Map String String -> Maybe String
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)]
_ <- ReadS [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
      ConfiguredProgram -> IO ConfiguredProgram
forall (m :: * -> *) a. Monad m => a -> m a
return ConfiguredProgram
gccProg {
        programDefaultArgs :: [String]
programDefaultArgs = ConfiguredProgram -> [String]
programDefaultArgs ConfiguredProgram
gccProg
                             [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ccFlags [String] -> [String] -> [String]
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
      ConfiguredProgram -> IO ConfiguredProgram
forall (m :: * -> *) a. Monad m => a -> m a
return ConfiguredProgram
ldProg' {
        programDefaultArgs :: [String]
programDefaultArgs = ConfiguredProgram -> [String]
programDefaultArgs ConfiguredProgram
ldProg' [String] -> [String] -> [String]
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 <- String -> String -> (String -> Handle -> IO Bool) -> IO Bool
forall a. String -> String -> (String -> Handle -> IO a) -> IO a
withTempFile String
tempDir String
".c" ((String -> Handle -> IO Bool) -> IO Bool)
-> (String -> Handle -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \String
testcfile Handle
testchnd ->
             String -> String -> (String -> Handle -> IO Bool) -> IO Bool
forall a. String -> String -> (String -> Handle -> IO a) -> IO a
withTempFile String
tempDir String
".o" ((String -> Handle -> IO Bool) -> IO Bool)
-> (String -> Handle -> IO Bool) -> IO Bool
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
                          ]
               String -> String -> (String -> Handle -> IO Bool) -> IO Bool
forall a. String -> String -> (String -> Handle -> IO a) -> IO a
withTempFile String
tempDir String
".o" ((String -> Handle -> IO Bool) -> IO Bool)
-> (String -> Handle -> IO Bool) -> IO Bool
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']
                   Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                 IO Bool -> (IOException -> IO Bool) -> IO Bool
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO`   (\IOException
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
                 IO Bool -> (ExitCode -> IO Bool) -> IO Bool
forall a. IO a -> (ExitCode -> IO a) -> IO a
`catchExit` (\ExitCode
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
      if Bool
ldx
        then ConfiguredProgram -> IO ConfiguredProgram
forall (m :: * -> *) a. Monad m => a -> m a
return ConfiguredProgram
ldProg { programDefaultArgs :: [String]
programDefaultArgs = [String
"-x"] }
        else ConfiguredProgram -> IO ConfiguredProgram
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
supportsHaskell2010 GhcImplInfo
implInfo = [(Language, String)] -> IO [(Language, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Language
Haskell98,   String
"-XHaskell98")
                                          ,(Language
Haskell2010, String
"-XHaskell2010")]
  | Bool
otherwise                    = [(Language, String)] -> IO [(Language, String)]
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 ReadS [(String, String)]
forall a. Read a => ReadS a
reads String
xs of
        [([(String, String)]
i, String
ss)]
          | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
ss ->
              [(String, String)] -> IO [(String, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(String, String)]
i
        [([(String, String)], String)]
_ ->
          Verbosity -> String -> IO [(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" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
extStr
                       , String
extStr'' <- [String
extStr, String
extStr']
                       ]
    let extensions0 :: [(Extension, Maybe String)]
extensions0 = [ (Extension
ext, String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"-X" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Extension -> String
forall a. Pretty a => a -> String
prettyShow Extension
ext)
                      | Just Extension
ext <- (String -> Maybe Extension) -> [String] -> [Maybe Extension]
forall a b. (a -> b) -> [a] -> [b]
map String -> Maybe Extension
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, Maybe String
forall a. Maybe a
Nothing) (Extension, Maybe String)
-> [(Extension, Maybe String)] -> [(Extension, Maybe String)]
forall a. a -> [a] -> [a]
:
                           [(Extension, Maybe String)]
extensions0
                      else [(Extension, Maybe String)]
extensions0
    [(Extension, Maybe String)] -> IO [(Extension, Maybe String)]
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 =
    GhcOptions
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      = Verbosity -> Flag Verbosity
forall a. a -> Flag a
toFlag (Verbosity -> Verbosity -> Verbosity
forall a. Ord a => a -> a -> a
min Verbosity
verbosity Verbosity
normal),
      ghcOptMode :: Flag GhcMode
ghcOptMode           = GhcMode -> Flag GhcMode
forall a. a -> Flag a
toFlag GhcMode
GhcModeCompile,
      ghcOptInputFiles :: NubListR String
ghcOptInputFiles     = [String] -> NubListR String
forall a. Ord a => [a] -> NubListR a
toNubListR [String
filename],

      ghcOptCppIncludePath :: NubListR String
ghcOptCppIncludePath = [String] -> NubListR String
forall a. Ord a => [a] -> NubListR a
toNubListR ([String] -> NubListR String) -> [String] -> NubListR String
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
                                          [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
includeDirs BuildInfo
bi
                                          -- potential includes generated by `configure'
                                          -- in the build directory
                                          [String] -> [String] -> [String]
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= Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
      ghcOptPackageDBs :: PackageDBStack
ghcOptPackageDBs     = LocalBuildInfo -> PackageDBStack
withPackageDB LocalBuildInfo
lbi,
      ghcOptPackages :: NubListR (OpenUnitId, ModuleRenaming)
ghcOptPackages       = [(OpenUnitId, ModuleRenaming)]
-> NubListR (OpenUnitId, ModuleRenaming)
forall a. Ord a => [a] -> NubListR a
toNubListR ([(OpenUnitId, ModuleRenaming)]
 -> NubListR (OpenUnitId, ModuleRenaming))
-> [(OpenUnitId, ModuleRenaming)]
-> NubListR (OpenUnitId, ModuleRenaming)
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"]) [String] -> [String] -> [String]
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"]) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                                  BuildInfo -> [String]
ccOptions BuildInfo
bi,
      ghcOptObjDir :: Flag String
ghcOptObjDir         = String -> Flag String
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 =
    GhcOptions
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      = Verbosity -> Flag Verbosity
forall a. a -> Flag a
toFlag (Verbosity -> Verbosity -> Verbosity
forall a. Ord a => a -> a -> a
min Verbosity
verbosity Verbosity
normal),
      ghcOptMode :: Flag GhcMode
ghcOptMode           = GhcMode -> Flag GhcMode
forall a. a -> Flag a
toFlag GhcMode
GhcModeCompile,
      ghcOptInputFiles :: NubListR String
ghcOptInputFiles     = [String] -> NubListR String
forall a. Ord a => [a] -> NubListR a
toNubListR [String
filename],

      ghcOptCppIncludePath :: NubListR String
ghcOptCppIncludePath = [String] -> NubListR String
forall a. Ord a => [a] -> NubListR a
toNubListR ([String] -> NubListR String) -> [String] -> NubListR String
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
                                          [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
includeDirs BuildInfo
bi
                                          -- potential includes generated by `configure'
                                          -- in the build directory
                                          [String] -> [String] -> [String]
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= Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
      ghcOptPackageDBs :: PackageDBStack
ghcOptPackageDBs     = LocalBuildInfo -> PackageDBStack
withPackageDB LocalBuildInfo
lbi,
      ghcOptPackages :: NubListR (OpenUnitId, ModuleRenaming)
ghcOptPackages       = [(OpenUnitId, ModuleRenaming)]
-> NubListR (OpenUnitId, ModuleRenaming)
forall a. Ord a => [a] -> NubListR a
toNubListR ([(OpenUnitId, ModuleRenaming)]
 -> NubListR (OpenUnitId, ModuleRenaming))
-> [(OpenUnitId, ModuleRenaming)]
-> NubListR (OpenUnitId, ModuleRenaming)
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"]) [String] -> [String] -> [String]
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"]) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                                  BuildInfo -> [String]
cxxOptions BuildInfo
bi,
      ghcOptObjDir :: Flag String
ghcOptObjDir         = String -> Flag String
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 =
    GhcOptions
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      = Verbosity -> Flag Verbosity
forall a. a -> Flag a
toFlag (Verbosity -> Verbosity -> Verbosity
forall a. Ord a => a -> a -> a
min Verbosity
verbosity Verbosity
normal),
      ghcOptMode :: Flag GhcMode
ghcOptMode           = GhcMode -> Flag GhcMode
forall a. a -> Flag a
toFlag GhcMode
GhcModeCompile,
      ghcOptInputFiles :: NubListR String
ghcOptInputFiles     = [String] -> NubListR String
forall a. Ord a => [a] -> NubListR a
toNubListR [String
filename],

      ghcOptCppIncludePath :: NubListR String
ghcOptCppIncludePath = [String] -> NubListR String
forall a. Ord a => [a] -> NubListR a
toNubListR ([String] -> NubListR String) -> [String] -> NubListR String
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
                                          [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
includeDirs BuildInfo
bi
                                          -- potential includes generated by `configure'
                                          -- in the build directory
                                          [String] -> [String] -> [String]
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= Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
      ghcOptPackageDBs :: PackageDBStack
ghcOptPackageDBs     = LocalBuildInfo -> PackageDBStack
withPackageDB LocalBuildInfo
lbi,
      ghcOptPackages :: NubListR (OpenUnitId, ModuleRenaming)
ghcOptPackages       = [(OpenUnitId, ModuleRenaming)]
-> NubListR (OpenUnitId, ModuleRenaming)
forall a. Ord a => [a] -> NubListR a
toNubListR ([(OpenUnitId, ModuleRenaming)]
 -> NubListR (OpenUnitId, ModuleRenaming))
-> [(OpenUnitId, ModuleRenaming)]
-> NubListR (OpenUnitId, ModuleRenaming)
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"]) [String] -> [String] -> [String]
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"]) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                                  BuildInfo -> [String]
asmOptions BuildInfo
bi,
      ghcOptObjDir :: Flag String
ghcOptObjDir         = String -> Flag String
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 =
    GhcOptions
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       = Verbosity -> Flag Verbosity
forall a. a -> Flag a
toFlag (Verbosity -> Verbosity -> Verbosity
forall a. Ord a => a -> a -> a
min Verbosity
verbosity Verbosity
normal),
      ghcOptCabal :: Flag Bool
ghcOptCabal           = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
      ghcOptThisUnitId :: Flag String
ghcOptThisUnitId      = case ComponentLocalBuildInfo
clbi of
        LibComponentLocalBuildInfo { componentCompatPackageKey :: ComponentLocalBuildInfo -> String
componentCompatPackageKey = String
pk }
          -> String -> Flag String
forall a. a -> Flag a
toFlag String
pk
        ComponentLocalBuildInfo
_ -> Flag String
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 [(ModuleName, OpenModule)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ModuleName, OpenModule)]
insts
                  then Flag ComponentId
forall a. Monoid a => a
mempty
                  else ComponentId -> Flag ComponentId
forall a. a -> Flag a
toFlag ComponentId
cid
          ComponentLocalBuildInfo
_ -> Flag ComponentId
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          = Bool -> Flag Bool
forall a. a -> Flag a
toFlag (Bool -> Flag Bool) -> Bool -> Flag Bool
forall a b. (a -> b) -> a -> b
$ ComponentLocalBuildInfo -> Bool
componentIsIndefinite ComponentLocalBuildInfo
clbi,
      ghcOptHideAllPackages :: Flag Bool
ghcOptHideAllPackages = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
      ghcOptWarnMissingHomeModules :: Flag Bool
ghcOptWarnMissingHomeModules = Bool -> Flag Bool
forall a. a -> Flag a
toFlag (Bool -> Flag Bool) -> Bool -> Flag Bool
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        = [(OpenUnitId, ModuleRenaming)]
-> NubListR (OpenUnitId, ModuleRenaming)
forall a. Ord a => [a] -> NubListR a
toNubListR ([(OpenUnitId, ModuleRenaming)]
 -> NubListR (OpenUnitId, ModuleRenaming))
-> [(OpenUnitId, ModuleRenaming)]
-> NubListR (OpenUnitId, ModuleRenaming)
forall a b. (a -> b) -> a -> b
$ ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)]
mkGhcOptPackages ComponentLocalBuildInfo
clbi,
      ghcOptSplitSections :: Flag Bool
ghcOptSplitSections   = Bool -> Flag Bool
forall a. a -> Flag a
toFlag (LocalBuildInfo -> Bool
splitSections LocalBuildInfo
lbi),
      ghcOptSplitObjs :: Flag Bool
ghcOptSplitObjs       = Bool -> Flag Bool
forall a. a -> Flag a
toFlag (LocalBuildInfo -> Bool
splitObjs LocalBuildInfo
lbi),
      ghcOptSourcePathClear :: Flag Bool
ghcOptSourcePathClear = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
      ghcOptSourcePath :: NubListR String
ghcOptSourcePath      = [String] -> NubListR String
forall a. Ord a => [a] -> NubListR a
toNubListR ([String] -> NubListR String) -> [String] -> NubListR String
forall a b. (a -> b) -> a -> b
$ [String
odir] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (BuildInfo -> [String]
hsSourceDirs BuildInfo
bi)
                                           [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi]
                                           [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [LocalBuildInfo -> String
autogenPackageModulesDir LocalBuildInfo
lbi],
      ghcOptCppIncludePath :: NubListR String
ghcOptCppIncludePath  = [String] -> NubListR String
forall a. Ord a => [a] -> NubListR a
toNubListR ([String] -> NubListR String) -> [String] -> NubListR String
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
                                           [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
includeDirs BuildInfo
bi
                                           -- potential includes generated by `configure'
                                           -- in the build directory
                                           [String] -> [String] -> [String]
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     = [String] -> NubListR String
forall a. Ord a => [a] -> NubListR a
toNubListR ([String] -> NubListR String) -> [String] -> NubListR String
forall a b. (a -> b) -> a -> b
$
                              [LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi String -> String -> String
</> String
cppHeaderName],
      ghcOptFfiIncludes :: NubListR String
ghcOptFfiIncludes     = [String] -> NubListR String
forall a. Ord a => [a] -> NubListR a
toNubListR ([String] -> NubListR String) -> [String] -> NubListR String
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [String]
includes BuildInfo
bi,
      ghcOptObjDir :: Flag String
ghcOptObjDir          = String -> Flag String
forall a. a -> Flag a
toFlag String
odir,
      ghcOptHiDir :: Flag String
ghcOptHiDir           = String -> Flag String
forall a. a -> Flag a
toFlag String
odir,
      ghcOptStubDir :: Flag String
ghcOptStubDir         = String -> Flag String
forall a. a -> Flag a
toFlag String
odir,
      ghcOptOutputDir :: Flag String
ghcOptOutputDir       = String -> Flag String
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       = DebugInfoLevel -> Flag DebugInfoLevel
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       = [String] -> NubListR String
forall a. Ord a => [a] -> NubListR a
toNubListR ([String] -> NubListR String) -> [String] -> NubListR String
forall a b. (a -> b) -> a -> b
$ [String]
exe_paths,
      ghcOptLanguage :: Flag Language
ghcOptLanguage        = Language -> Flag Language
forall a. a -> Flag a
toFlag (Language -> Maybe Language -> Language
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      = [Extension] -> NubListR Extension
forall a. Ord a => [a] -> NubListR a
toNubListR ([Extension] -> NubListR Extension)
-> [Extension] -> NubListR Extension
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [Extension]
usedExtensions BuildInfo
bi,
      ghcOptExtensionMap :: Map Extension (Maybe String)
ghcOptExtensionMap    = [(Extension, Maybe String)] -> Map Extension (Maybe String)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Extension, Maybe String)] -> Map Extension (Maybe String))
-> (Compiler -> [(Extension, Maybe String)])
-> Compiler
-> Map Extension (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compiler -> [(Extension, Maybe String)]
compilerExtensions (Compiler -> Map Extension (Maybe String))
-> Compiler -> Map Extension (Maybe String)
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      = Flag GhcOptimisation
forall a. Monoid a => a
mempty --TODO perhaps override?
toGhcOptimisation OptimisationLevel
NormalOptimisation  = GhcOptimisation -> Flag GhcOptimisation
forall a. a -> Flag a
toFlag GhcOptimisation
GhcNormalOptimisation
toGhcOptimisation OptimisationLevel
MaximumOptimisation = GhcOptimisation -> Flag GhcOptimisation
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 =
    GhcOptions
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      = Verbosity -> Flag Verbosity
forall a. a -> Flag a
toFlag (Verbosity -> Verbosity -> Verbosity
forall a. Ord a => a -> a -> a
min Verbosity
verbosity Verbosity
normal),
      ghcOptMode :: Flag GhcMode
ghcOptMode           = GhcMode -> Flag GhcMode
forall a. a -> Flag a
toFlag GhcMode
GhcModeCompile,
      ghcOptInputFiles :: NubListR String
ghcOptInputFiles     = [String] -> NubListR String
forall a. Ord a => [a] -> NubListR a
toNubListR [String
filename],

      ghcOptCppIncludePath :: NubListR String
ghcOptCppIncludePath = [String] -> NubListR String
forall a. Ord a => [a] -> NubListR a
toNubListR ([String] -> NubListR String) -> [String] -> NubListR String
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
                                          [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
includeDirs BuildInfo
bi
                                          -- potential includes generated by `configure'
                                          -- in the build directory
                                          [String] -> [String] -> [String]
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    = [String] -> NubListR String
forall a. Ord a => [a] -> NubListR a
toNubListR ([String] -> NubListR String) -> [String] -> NubListR String
forall a b. (a -> b) -> a -> b
$
                             [LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi String -> String -> String
</> String
cppHeaderName],
      ghcOptHideAllPackages :: Flag Bool
ghcOptHideAllPackages= Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
      ghcOptPackageDBs :: PackageDBStack
ghcOptPackageDBs     = LocalBuildInfo -> PackageDBStack
withPackageDB LocalBuildInfo
lbi,
      ghcOptPackages :: NubListR (OpenUnitId, ModuleRenaming)
ghcOptPackages       = [(OpenUnitId, ModuleRenaming)]
-> NubListR (OpenUnitId, ModuleRenaming)
forall a. Ord a => [a] -> NubListR a
toNubListR ([(OpenUnitId, ModuleRenaming)]
 -> NubListR (OpenUnitId, ModuleRenaming))
-> [(OpenUnitId, ModuleRenaming)]
-> NubListR (OpenUnitId, ModuleRenaming)
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      = DebugInfoLevel -> Flag DebugInfoLevel
forall a. a -> Flag a
toFlag (LocalBuildInfo -> DebugInfoLevel
withDebugInfo LocalBuildInfo
lbi),
      ghcOptExtra :: [String]
ghcOptExtra          = BuildInfo -> [String]
cmmOptions BuildInfo
bi,
      ghcOptObjDir :: Flag String
ghcOptObjDir         = String -> Flag String
forall a. a -> Flag a
toFlag String
odir
    }


-- | Strip out flags that are not supported in ghci
filterGhciFlags :: [String] -> [String]
filterGhciFlags :: [String] -> [String]
filterGhciFlags = (String -> Bool) -> [String] -> [String]
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 String -> Map String String -> Maybe String
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
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
wanted_obj_ext String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_split"
            dirs :: [String]
dirs = [ String
pref String -> String -> String
</> (ModuleName -> String
ModuleName.toFilePath ModuleName
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
splitSuffix)
                   | ModuleName
x <- Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi ]
        [[String]]
objss <- (String -> IO [String]) -> [String] -> IO [[String]]
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) <- [[String]] -> [String] -> [([String], String)]
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
'.'Char -> String -> String
forall a. a -> [a] -> [a]
:String
wanted_obj_ext String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
obj_ext ]
        [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
objs
  | Bool
otherwise  =
        [String] -> IO [String]
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        = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
f (InstalledPackageInfo -> [String]
IPI.importDirs InstalledPackageInfo
ipo),
       libraryDirs :: [String]
IPI.libraryDirs       = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
f (InstalledPackageInfo -> [String]
IPI.libraryDirs InstalledPackageInfo
ipo),
       includeDirs :: [String]
IPI.includeDirs       = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
f (InstalledPackageInfo -> [String]
IPI.includeDirs InstalledPackageInfo
ipo),
       frameworkDirs :: [String]
IPI.frameworkDirs     = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
f (InstalledPackageInfo -> [String]
IPI.frameworkDirs InstalledPackageInfo
ipo),
       haddockInterfaces :: [String]
IPI.haddockInterfaces = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
f (InstalledPackageInfo -> [String]
IPI.haddockInterfaces InstalledPackageInfo
ipo),
       haddockHTMLs :: [String]
IPI.haddockHTMLs      = (String -> String) -> [String] -> [String]
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 String -> String -> String
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
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Maybe String
mPP) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Maybe String
mcsPP <- String -> IO (Maybe String)
lookupEnv String
"CABAL_SANDBOX_PACKAGE_PATH"
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe String
mPP Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
mcsPP) IO ()
forall {a}. IO a
abort
    where
        lookupEnv :: String -> IO (Maybe String)
        lookupEnv :: String -> IO (Maybe String)
lookupEnv String
name = (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> IO String -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO String
getEnv String
name)
                         IO (Maybe String)
-> (IOException -> IO (Maybe String)) -> IO (Maybe String)
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` IO (Maybe String) -> IOException -> IO (Maybe String)
forall a b. a -> b -> a
const (Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing)
        abort :: IO a
abort =
            Verbosity -> String -> IO a
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ String
"Use of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
compilerName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'s environment variable "
               String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
packagePathEnvVar String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is incompatible with Cabal. Use the "
               String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"flag --package-db to specify a package database (it can be "
               String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"used multiple times)."

        CallStack
_ = 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                -> Flag GhcProfAuto
forall a. Monoid a => a
mempty
      ProfDetailLevel
ProfDetailDefault | Bool
forLib    -> GhcProfAuto -> Flag GhcProfAuto
forall a. a -> Flag a
toFlag GhcProfAuto
GhcProfAutoExported
                        | Bool
otherwise -> GhcProfAuto -> Flag GhcProfAuto
forall a. a -> Flag a
toFlag GhcProfAuto
GhcProfAutoToplevel
      ProfDetailLevel
ProfDetailExportedFunctions   -> GhcProfAuto -> Flag GhcProfAuto
forall a. a -> Flag a
toFlag GhcProfAuto
GhcProfAutoExported
      ProfDetailLevel
ProfDetailToplevelFunctions   -> GhcProfAuto -> Flag GhcProfAuto
forall a. a -> Flag a
toFlag GhcProfAuto
GhcProfAutoToplevel
      ProfDetailLevel
ProfDetailAllFunctions        -> GhcProfAuto -> Flag GhcProfAuto
forall a. a -> Flag a
toFlag GhcProfAuto
GhcProfAutoAll
      ProfDetailOther String
_             -> Flag GhcProfAuto
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 = Arch -> String
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   = OS -> String
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 =
    String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"-" [ Arch -> String
ghcArchString Arch
arch, OS -> String
ghcOsString OS
os, Version -> String
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
(GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry -> Bool)
-> (GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry -> Bool)
-> Eq GhcEnvironmentFileEntry
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
Eq GhcEnvironmentFileEntry
-> (GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry -> Ordering)
-> (GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry -> Bool)
-> (GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry -> Bool)
-> (GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry -> Bool)
-> (GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry -> Bool)
-> (GhcEnvironmentFileEntry
    -> GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry)
-> (GhcEnvironmentFileEntry
    -> GhcEnvironmentFileEntry -> GhcEnvironmentFileEntry)
-> Ord 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
(Int -> GhcEnvironmentFileEntry -> String -> String)
-> (GhcEnvironmentFileEntry -> String)
-> ([GhcEnvironmentFileEntry] -> String -> String)
-> Show GhcEnvironmentFileEntry
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
  GhcEnvironmentFileEntry
-> [GhcEnvironmentFileEntry] -> [GhcEnvironmentFileEntry]
forall a. a -> [a] -> [a]
: (PackageDB -> GhcEnvironmentFileEntry)
-> PackageDBStack -> [GhcEnvironmentFileEntry]
forall a b. (a -> b) -> [a] -> [b]
map PackageDB -> GhcEnvironmentFileEntry
GhcEnvFilePackageDb PackageDBStack
packageDBs
 [GhcEnvironmentFileEntry]
-> [GhcEnvironmentFileEntry] -> [GhcEnvironmentFileEntry]
forall a. [a] -> [a] -> [a]
++ (UnitId -> GhcEnvironmentFileEntry)
-> [UnitId] -> [GhcEnvironmentFileEntry]
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 (ByteString -> IO ())
-> ([GhcEnvironmentFileEntry] -> ByteString)
-> [GhcEnvironmentFileEntry]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack (String -> ByteString)
-> ([GhcEnvironmentFileEntry] -> String)
-> [GhcEnvironmentFileEntry]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GhcEnvironmentFileEntry] -> String
renderGhcEnvironmentFile ([GhcEnvironmentFileEntry] -> IO ())
-> [GhcEnvironmentFileEntry] -> IO ()
forall a b. (a -> b) -> a -> b
$ [GhcEnvironmentFileEntry]
entries
    String -> IO String
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." String -> String -> String
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 ([String] -> String)
-> ([GhcEnvironmentFileEntry] -> [String])
-> [GhcEnvironmentFileEntry]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GhcEnvironmentFileEntry -> String)
-> [GhcEnvironmentFileEntry] -> [String]
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 = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"--" String -> String -> String
<++>) ([String] -> [String])
-> (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 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str
    GhcEnvFilePackageId UnitId
pkgid     -> String
"package-id " String -> String -> String
forall a. [a] -> [a] -> [a]
++ UnitId -> String
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 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dbfile
    GhcEnvironmentFileEntry
GhcEnvFileClearPackageDbStack -> String
"clear-package-db"