{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Distribution.Simple.GHC.Internal (
configureToolchain,
getLanguages,
getExtensions,
targetPlatform,
getGhcInfo,
componentCcGhcOptions,
componentCxxGhcOptions,
componentGhcOptions,
mkGHCiLibName,
mkGHCiProfLibName,
filterGhciFlags,
ghcLookupProperty,
getHaskellObjects,
mkGhcOptPackages,
substTopDir,
checkPackageDbEnvVar,
profDetailLevelFlag,
ghcArchString,
ghcOsString,
ghcPlatformAndVersionString,
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 Distribution.InstalledPackageInfo
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
import Distribution.PackageDescription as PD hiding (Flag)
import Distribution.Compat.Exception
import Distribution.Lex
import Distribution.Simple.Compiler hiding (Flag)
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 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 ghcInfo :: [(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 "Target platform" [(String, String)]
ghcInfo
configureToolchain :: GhcImplInfo
-> ConfiguredProgram
-> Map String String
-> ProgramDb
-> ProgramDb
configureToolchain :: GhcImplInfo
-> ConfiguredProgram -> Map String String -> ProgramDb -> ProgramDb
configureToolchain _implInfo :: GhcImplInfo
_implInfo ghcProg :: ConfiguredProgram
ghcProg ghcInfo :: 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 -> NoCallStackIO ConfiguredProgram
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
</> "mingw" String -> String -> String
</> "bin"
isWindows :: Bool
isWindows = case OS
buildOS of Windows -> Bool
True; _ -> Bool
False
binPrefix :: String
binPrefix = ""
maybeName :: Program -> Maybe FilePath -> String
maybeName :: Program -> Maybe String -> String
maybeName prog :: 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 mbPath :: Maybe String
mbPath mingwPath :: 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
(windowsExtraGccDir :: String
windowsExtraGccDir, windowsExtraLdDir :: String
windowsExtraLdDir,
windowsExtraArDir :: String
windowsExtraArDir, windowsExtraStripDir :: 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 progName :: String
progName extraPath :: [String]
extraPath v :: Verbosity
v searchpath :: 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
mbGccLocation :: Maybe String
mbGccLocation = String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup "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 "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 "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 "strip command" Map String String
ghcInfo
ccFlags :: [String]
ccFlags = String -> [String]
getFlags "C compiler flags"
gccLinkerFlags :: [String]
gccLinkerFlags = String -> [String]
getFlags "Gcc Linker flags" [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String]
getFlags "C compiler link flags"
ldLinkerFlags :: [String]
ldLinkerFlags = String -> [String]
getFlags "Ld Linker flags" [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String]
getFlags "ld flags"
getFlags :: String -> [String]
getFlags :: String -> [String]
getFlags key :: 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
Nothing -> []
Just flags :: String
flags
| (flags' :: [String]
flags', ""):_ <- ReadS [String]
forall a. Read a => ReadS a
reads String
flags -> [String]
flags'
| Bool
otherwise -> String -> [String]
tokenizeQuotedWords String
flags
configureGcc :: Verbosity -> ConfiguredProgram -> NoCallStackIO ConfiguredProgram
configureGcc :: Verbosity -> ConfiguredProgram -> NoCallStackIO ConfiguredProgram
configureGcc _v :: Verbosity
_v gccProg :: ConfiguredProgram
gccProg = do
ConfiguredProgram -> NoCallStackIO 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 v :: Verbosity
v ldProg :: ConfiguredProgram
ldProg = do
ConfiguredProgram
ldProg' <- Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
configureLd' Verbosity
v ConfiguredProgram
ldProg
ConfiguredProgram -> NoCallStackIO 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
}
configureLd' :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
configureLd' :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
configureLd' verbosity :: Verbosity
verbosity ldProg :: 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 ".c" ((String -> Handle -> IO Bool) -> IO Bool)
-> (String -> Handle -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \testcfile :: String
testcfile testchnd :: Handle
testchnd ->
String -> String -> (String -> Handle -> IO Bool) -> IO Bool
forall a. String -> String -> (String -> Handle -> IO a) -> IO a
withTempFile String
tempDir ".o" ((String -> Handle -> IO Bool) -> IO Bool)
-> (String -> Handle -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \testofile :: String
testofile testohnd :: Handle
testohnd -> do
Handle -> String -> IO ()
hPutStrLn Handle
testchnd "int foo() { return 0; }"
Handle -> IO ()
hClose Handle
testchnd; Handle -> IO ()
hClose Handle
testohnd
Verbosity -> ConfiguredProgram -> [String] -> IO ()
runProgram Verbosity
verbosity ConfiguredProgram
ghcProg
[ "-hide-all-packages"
, "-c", String
testcfile
, "-o", String
testofile
]
String -> String -> (String -> Handle -> IO Bool) -> IO Bool
forall a. String -> String -> (String -> Handle -> IO a) -> IO a
withTempFile String
tempDir ".o" ((String -> Handle -> IO Bool) -> IO Bool)
-> (String -> Handle -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \testofile' :: String
testofile' testohnd' :: Handle
testohnd' ->
do
Handle -> IO ()
hClose Handle
testohnd'
String
_ <- Verbosity -> ConfiguredProgram -> [String] -> IO String
getProgramOutput Verbosity
verbosity ConfiguredProgram
ldProg
["-x", "-r", String
testofile, "-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` (\_ -> 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` (\_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
if Bool
ldx
then ConfiguredProgram -> NoCallStackIO ConfiguredProgram
forall (m :: * -> *) a. Monad m => a -> m a
return ConfiguredProgram
ldProg { programDefaultArgs :: [String]
programDefaultArgs = ["-x"] }
else ConfiguredProgram -> NoCallStackIO ConfiguredProgram
forall (m :: * -> *) a. Monad m => a -> m a
return ConfiguredProgram
ldProg
getLanguages :: Verbosity -> GhcImplInfo -> ConfiguredProgram
-> NoCallStackIO [(Language, String)]
getLanguages :: Verbosity
-> GhcImplInfo
-> ConfiguredProgram
-> NoCallStackIO [(Language, String)]
getLanguages _ implInfo :: GhcImplInfo
implInfo _
| GhcImplInfo -> Bool
supportsHaskell2010 GhcImplInfo
implInfo = [(Language, String)] -> NoCallStackIO [(Language, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Language
Haskell98, "-XHaskell98")
,(Language
Haskell2010, "-XHaskell2010")]
| Bool
otherwise = [(Language, String)] -> NoCallStackIO [(Language, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Language
Haskell98, "")]
getGhcInfo :: Verbosity -> GhcImplInfo -> ConfiguredProgram
-> IO [(String, String)]
getGhcInfo :: Verbosity
-> GhcImplInfo -> ConfiguredProgram -> IO [(String, String)]
getGhcInfo verbosity :: Verbosity
verbosity _implInfo :: GhcImplInfo
_implInfo ghcProg :: ConfiguredProgram
ghcProg = do
String
xs <- Verbosity -> ConfiguredProgram -> [String] -> IO String
getProgramOutput Verbosity
verbosity (ConfiguredProgram -> ConfiguredProgram
suppressOverrideArgs ConfiguredProgram
ghcProg)
["--info"]
case ReadS [(String, String)]
forall a. Read a => ReadS a
reads String
xs of
[(i :: [(String, String)]
i, ss :: 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
_ ->
Verbosity -> String -> IO [(String, String)]
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity "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
verbosity implInfo :: GhcImplInfo
implInfo ghcProg :: ConfiguredProgram
ghcProg = do
String
str <- Verbosity -> ConfiguredProgram -> [String] -> IO String
getProgramOutput Verbosity
verbosity (ConfiguredProgram -> ConfiguredProgram
suppressOverrideArgs ConfiguredProgram
ghcProg)
["--supported-languages"]
let extStrs :: [String]
extStrs = if GhcImplInfo -> Bool
reportsNoExt GhcImplInfo
implInfo
then String -> [String]
lines String
str
else
[ String
extStr''
| String
extStr <- String -> [String]
lines String
str
, let extStr' :: String
extStr' = case String
extStr of
'N' : 'o' : xs :: String
xs -> String
xs
_ -> "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
$ "-X" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Extension -> String
forall a. Pretty a => a -> String
prettyShow Extension
ext)
| Just ext :: 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
(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
verbosity _implInfo :: GhcImplInfo
_implInfo lbi :: LocalBuildInfo
lbi bi :: BuildInfo
bi clbi :: ComponentLocalBuildInfo
clbi odir :: String
odir filename :: String
filename =
GhcOptions
forall a. Monoid a => a
mempty {
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]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
PD.includeDirs BuildInfo
bi
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
dir | String
dir <- BuildInfo -> [String]
PD.includeDirs BuildInfo
bi],
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
NoOptimisation -> []
_ -> ["-O2"]) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
(case LocalBuildInfo -> DebugInfoLevel
withDebugInfo LocalBuildInfo
lbi of
NoDebugInfo -> []
MinimalDebugInfo -> ["-g1"]
NormalDebugInfo -> ["-g"]
MaximalDebugInfo -> ["-g3"]) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
BuildInfo -> [String]
PD.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
verbosity _implInfo :: GhcImplInfo
_implInfo lbi :: LocalBuildInfo
lbi bi :: BuildInfo
bi clbi :: ComponentLocalBuildInfo
clbi odir :: String
odir filename :: String
filename =
GhcOptions
forall a. Monoid a => a
mempty {
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]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
PD.includeDirs BuildInfo
bi
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
dir | String
dir <- BuildInfo -> [String]
PD.includeDirs BuildInfo
bi],
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
NoOptimisation -> []
_ -> ["-O2"]) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
(case LocalBuildInfo -> DebugInfoLevel
withDebugInfo LocalBuildInfo
lbi of
NoDebugInfo -> []
MinimalDebugInfo -> ["-g1"]
NormalDebugInfo -> ["-g"]
MaximalDebugInfo -> ["-g3"]) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
BuildInfo -> [String]
PD.cxxOptions 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
verbosity implInfo :: GhcImplInfo
implInfo lbi :: LocalBuildInfo
lbi bi :: BuildInfo
bi clbi :: ComponentLocalBuildInfo
clbi odir :: String
odir =
GhcOptions
forall a. Monoid a => a
mempty {
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
_ -> 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
_ -> 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
_ -> [],
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]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
PD.includeDirs BuildInfo
bi
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
dir | String
dir <- BuildInfo -> [String]
PD.includeDirs BuildInfo
bi],
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]
PD.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)),
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
toGhcOptimisation :: OptimisationLevel -> Flag GhcOptimisation
toGhcOptimisation NoOptimisation = Flag GhcOptimisation
forall a. Monoid a => a
mempty
toGhcOptimisation NormalOptimisation = GhcOptimisation -> Flag GhcOptimisation
forall a. a -> Flag a
toFlag GhcOptimisation
GhcNormalOptimisation
toGhcOptimisation MaximumOptimisation = GhcOptimisation -> Flag GhcOptimisation
forall a. a -> Flag a
toFlag GhcOptimisation
GhcMaximumOptimisation
exe_paths :: [String]
exe_paths = [ LocalBuildInfo -> ComponentLocalBuildInfo -> String
componentBuildDir LocalBuildInfo
lbi (TargetInfo -> ComponentLocalBuildInfo
targetCLBI TargetInfo
exe_tgt)
| UnitId
uid <- ComponentLocalBuildInfo -> [UnitId]
componentExeDeps ComponentLocalBuildInfo
clbi
, Just exe_tgt :: TargetInfo
exe_tgt <- [PackageDescription -> LocalBuildInfo -> UnitId -> Maybe TargetInfo
unitIdTarget' (LocalBuildInfo -> PackageDescription
localPkgDescr LocalBuildInfo
lbi) LocalBuildInfo
lbi UnitId
uid] ]
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 ('-':'O':_) = Bool
False
supported "-debug" = Bool
False
supported "-threaded" = Bool
False
supported "-ticky" = Bool
False
supported "-eventlog" = Bool
False
supported "-prof" = Bool
False
supported "-unreg" = Bool
False
supported _ = Bool
True
mkGHCiLibName :: UnitId -> String
mkGHCiLibName :: UnitId -> String
mkGHCiLibName lib :: UnitId
lib = UnitId -> String
getHSLibraryName UnitId
lib String -> String -> String
<.> "o"
mkGHCiProfLibName :: UnitId -> String
mkGHCiProfLibName :: UnitId -> String
mkGHCiProfLibName lib :: UnitId
lib = UnitId -> String
getHSLibraryName UnitId
lib String -> String -> String
<.> "p_o"
ghcLookupProperty :: String -> Compiler -> Bool
ghcLookupProperty :: String -> Compiler -> Bool
ghcLookupProperty prop :: String
prop comp :: 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 "YES" -> Bool
True
_ -> Bool
False
getHaskellObjects :: GhcImplInfo -> Library -> LocalBuildInfo
-> ComponentLocalBuildInfo
-> FilePath -> String -> Bool -> NoCallStackIO [FilePath]
getHaskellObjects :: GhcImplInfo
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> String
-> String
-> Bool
-> NoCallStackIO [String]
getHaskellObjects _implInfo :: GhcImplInfo
_implInfo lib :: Library
lib lbi :: LocalBuildInfo
lbi clbi :: ComponentLocalBuildInfo
clbi pref :: String
pref wanted_obj_ext :: String
wanted_obj_ext allow_split_objs :: Bool
allow_split_objs
| LocalBuildInfo -> Bool
splitObjs LocalBuildInfo
lbi Bool -> Bool -> Bool
&& Bool
allow_split_objs = do
let splitSuffix :: String
splitSuffix = "_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
wanted_obj_ext String -> String -> String
forall a. [a] -> [a] -> [a]
++ "_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 -> NoCallStackIO [String]) -> [String] -> IO [[String]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> NoCallStackIO [String]
getDirectoryContents [String]
dirs
let objs :: [String]
objs = [ String
dir String -> String -> String
</> String
obj
| (objs' :: [String]
objs',dir :: 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 -> 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] -> NoCallStackIO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
objs
| Bool
otherwise =
[String] -> NoCallStackIO [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 -> InstalledPackageInfo -> InstalledPackageInfo
substTopDir :: String -> InstalledPackageInfo -> InstalledPackageInfo
substTopDir topDir :: String
topDir ipo :: InstalledPackageInfo
ipo
= InstalledPackageInfo
ipo {
importDirs :: [String]
InstalledPackageInfo.importDirs
= (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
f (InstalledPackageInfo -> [String]
InstalledPackageInfo.importDirs InstalledPackageInfo
ipo),
libraryDirs :: [String]
InstalledPackageInfo.libraryDirs
= (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
f (InstalledPackageInfo -> [String]
InstalledPackageInfo.libraryDirs InstalledPackageInfo
ipo),
includeDirs :: [String]
InstalledPackageInfo.includeDirs
= (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
f (InstalledPackageInfo -> [String]
InstalledPackageInfo.includeDirs InstalledPackageInfo
ipo),
frameworkDirs :: [String]
InstalledPackageInfo.frameworkDirs
= (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
f (InstalledPackageInfo -> [String]
InstalledPackageInfo.frameworkDirs InstalledPackageInfo
ipo),
haddockInterfaces :: [String]
InstalledPackageInfo.haddockInterfaces
= (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
f (InstalledPackageInfo -> [String]
InstalledPackageInfo.haddockInterfaces InstalledPackageInfo
ipo),
haddockHTMLs :: [String]
InstalledPackageInfo.haddockHTMLs
= (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
f (InstalledPackageInfo -> [String]
InstalledPackageInfo.haddockHTMLs InstalledPackageInfo
ipo)
}
where f :: String -> String
f ('$':'t':'o':'p':'d':'i':'r':rest :: String
rest) = String
topDir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
rest
f x :: String
x = String
x
checkPackageDbEnvVar :: Verbosity -> String -> String -> IO ()
checkPackageDbEnvVar :: Verbosity -> String -> String -> IO ()
checkPackageDbEnvVar verbosity :: Verbosity
verbosity compilerName :: String
compilerName packagePathEnvVar :: String
packagePathEnvVar = do
Maybe String
mPP <- String -> NoCallStackIO (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 -> NoCallStackIO (Maybe String)
lookupEnv "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 -> NoCallStackIO (Maybe String)
lookupEnv :: String -> NoCallStackIO (Maybe String)
lookupEnv name :: String
name = (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> IO String -> NoCallStackIO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO String
getEnv String
name)
NoCallStackIO (Maybe String)
-> (IOException -> NoCallStackIO (Maybe String))
-> NoCallStackIO (Maybe String)
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` NoCallStackIO (Maybe String)
-> IOException -> NoCallStackIO (Maybe String)
forall a b. a -> b -> a
const (Maybe String -> NoCallStackIO (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
$ "Use of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
compilerName String -> String -> String
forall a. [a] -> [a] -> [a]
++ "'s environment variable "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
packagePathEnvVar String -> String -> String
forall a. [a] -> [a] -> [a]
++ " is incompatible with Cabal. Use the "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ "flag --package-db to specify a package database (it can be "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ "used multiple times)."
CallStack
_ = CallStack
HasCallStack => CallStack
callStack
profDetailLevelFlag :: Bool -> ProfDetailLevel -> Flag GhcProfAuto
profDetailLevelFlag :: Bool -> ProfDetailLevel -> Flag GhcProfAuto
profDetailLevelFlag forLib :: Bool
forLib mpl :: ProfDetailLevel
mpl =
case ProfDetailLevel
mpl of
ProfDetailNone -> Flag GhcProfAuto
forall a. Monoid a => a
mempty
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
ProfDetailExportedFunctions -> GhcProfAuto -> Flag GhcProfAuto
forall a. a -> Flag a
toFlag GhcProfAuto
GhcProfAutoExported
ProfDetailToplevelFunctions -> GhcProfAuto -> Flag GhcProfAuto
forall a. a -> Flag a
toFlag GhcProfAuto
GhcProfAutoToplevel
ProfDetailAllFunctions -> GhcProfAuto -> Flag GhcProfAuto
forall a. a -> Flag a
toFlag GhcProfAuto
GhcProfAutoAll
ProfDetailOther _ -> Flag GhcProfAuto
forall a. Monoid a => a
mempty
ghcArchString :: Arch -> String
ghcArchString :: Arch -> String
ghcArchString PPC = "powerpc"
ghcArchString PPC64 = "powerpc64"
ghcArchString other :: Arch
other = Arch -> String
forall a. Pretty a => a -> String
prettyShow Arch
other
ghcOsString :: OS -> String
ghcOsString :: OS -> String
ghcOsString Windows = "mingw32"
ghcOsString OSX = "darwin"
ghcOsString Solaris = "solaris2"
ghcOsString other :: OS
other = OS -> String
forall a. Pretty a => a -> String
prettyShow OS
other
ghcPlatformAndVersionString :: Platform -> Version -> String
ghcPlatformAndVersionString :: Platform -> Version -> String
ghcPlatformAndVersionString (Platform arch :: Arch
arch os :: OS
os) version :: Version
version =
String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "-" [ Arch -> String
ghcArchString Arch
arch, OS -> String
ghcOsString OS
os, Version -> String
forall a. Pretty a => a -> String
prettyShow Version
version ]
data GhcEnvironmentFileEntry =
String
| GhcEnvFilePackageId UnitId
| GhcEnvFilePackageDb PackageDB
| GhcEnvFileClearPackageDbStack
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
$cp1Ord :: Eq GhcEnvironmentFileEntry
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)
simpleGhcEnvironmentFile :: PackageDBStack
-> [UnitId]
-> [GhcEnvironmentFileEntry]
simpleGhcEnvironmentFile :: PackageDBStack -> [UnitId] -> [GhcEnvironmentFileEntry]
simpleGhcEnvironmentFile packageDBs :: PackageDBStack
packageDBs pkgids :: [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
writeGhcEnvironmentFile :: FilePath
-> Platform
-> Version
-> [GhcEnvironmentFileEntry]
-> NoCallStackIO FilePath
writeGhcEnvironmentFile :: String
-> Platform -> Version -> [GhcEnvironmentFileEntry] -> IO String
writeGhcEnvironmentFile directory :: String
directory platform :: Platform
platform ghcversion :: Version
ghcversion entries :: [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
ghcEnvironmentFileName :: Platform -> Version -> FilePath
ghcEnvironmentFileName :: Platform -> Version -> String
ghcEnvironmentFileName platform :: Platform
platform ghcversion :: Version
ghcversion =
".ghc.environment." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Platform -> Version -> String
ghcPlatformAndVersionString Platform
platform Version
ghcversion
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
renderGhcEnvironmentFileEntry :: GhcEnvironmentFileEntry -> String
renderGhcEnvironmentFileEntry :: GhcEnvironmentFileEntry -> String
renderGhcEnvironmentFileEntry entry :: GhcEnvironmentFileEntry
entry = case GhcEnvironmentFileEntry
entry of
GhcEnvFileComment comment :: String
comment -> String -> String
format String
comment
where format :: String -> String
format = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\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
forall a. [a] -> [a] -> [a]
++) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
GhcEnvFilePackageId pkgid :: UnitId
pkgid -> "package-id " String -> String -> String
forall a. [a] -> [a] -> [a]
++ UnitId -> String
forall a. Pretty a => a -> String
prettyShow UnitId
pkgid
GhcEnvFilePackageDb pkgdb :: PackageDB
pkgdb ->
case PackageDB
pkgdb of
GlobalPackageDB -> "global-package-db"
UserPackageDB -> "user-package-db"
SpecificPackageDB dbfile :: String
dbfile -> "package-db " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dbfile
GhcEnvFileClearPackageDbStack -> "clear-package-db"