module SysTools.Settings
( SettingsError (..)
, initSettings
) where
#include "HsVersions.h"
import GhcPrelude
import GHC.Settings
import Config
import CliOption
import FileSettings
import Fingerprint
import GHC.Platform
import GhcNameVersion
import Outputable
import Settings
import SysTools.BaseDir
import ToolSettings
import Control.Monad.Trans.Except
import Control.Monad.IO.Class
import qualified Data.Map as Map
import System.FilePath
import System.Directory
data SettingsError
= SettingsError_MissingData String
| SettingsError_BadData String
initSettings
:: forall m
. MonadIO m
=> String
-> ExceptT SettingsError m Settings
initSettings top_dir = do
mtool_dir <- liftIO $ findToolDir top_dir
let installed :: FilePath -> FilePath
installed file = top_dir </> file
libexec :: FilePath -> FilePath
libexec file = top_dir </> "bin" </> file
settingsFile = installed "settings"
platformConstantsFile = installed "platformConstants"
readFileSafe :: FilePath -> ExceptT SettingsError m String
readFileSafe path = liftIO (doesFileExist path) >>= \case
True -> liftIO $ readFile path
False -> throwE $ SettingsError_MissingData $ "Missing file: " ++ path
settingsStr <- readFileSafe settingsFile
platformConstantsStr <- readFileSafe platformConstantsFile
settingsList <- case maybeReadFuzzy settingsStr of
Just s -> pure s
Nothing -> throwE $ SettingsError_BadData $
"Can't parse " ++ show settingsFile
let mySettings = Map.fromList settingsList
platformConstants <- case maybeReadFuzzy platformConstantsStr of
Just s -> pure s
Nothing -> throwE $ SettingsError_BadData $
"Can't parse " ++ show platformConstantsFile
let getSetting key = either pgmError pure $
getFilePathSetting0 top_dir settingsFile mySettings key
getToolSetting :: String -> ExceptT SettingsError m String
getToolSetting key = expandToolDir mtool_dir <$> getSetting key
getBooleanSetting :: String -> ExceptT SettingsError m Bool
getBooleanSetting key = either pgmError pure $
getBooleanSetting0 settingsFile mySettings key
targetPlatformString <- getSetting "target platform string"
tablesNextToCode <- getBooleanSetting "Tables next to code"
myExtraGccViaCFlags <- getSetting "GCC extra via C opts"
cc_prog <- getToolSetting "C compiler command"
cc_args_str <- getSetting "C compiler flags"
cxx_args_str <- getSetting "C++ compiler flags"
gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie"
cpp_prog <- getToolSetting "Haskell CPP command"
cpp_args_str <- getSetting "Haskell CPP flags"
platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings
let unreg_cc_args = if platformUnregisterised platform
then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"]
else []
cpp_args = map Option (words cpp_args_str)
cc_args = words cc_args_str ++ unreg_cc_args
cxx_args = words cxx_args_str
ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind"
ldSupportsBuildId <- getBooleanSetting "ld supports build-id"
ldSupportsFilelist <- getBooleanSetting "ld supports filelist"
ldIsGnuLd <- getBooleanSetting "ld is GNU ld"
let pkgconfig_path = installed "package.conf.d"
ghc_usage_msg_path = installed "ghc-usage.txt"
ghci_usage_msg_path = installed "ghci-usage.txt"
unlit_path <- getToolSetting "unlit command"
windres_path <- getToolSetting "windres command"
libtool_path <- getToolSetting "libtool command"
ar_path <- getToolSetting "ar command"
otool_path <- getToolSetting "otool command"
install_name_tool_path <- getToolSetting "install_name_tool command"
ranlib_path <- getToolSetting "ranlib command"
tmpdir <- liftIO $ getTemporaryDirectory
touch_path <- getToolSetting "touch command"
mkdll_prog <- getToolSetting "dllwrap command"
let mkdll_args = []
cc_link_args_str <- getSetting "C compiler link flags"
let as_prog = cc_prog
as_args = map Option cc_args
ld_prog = cc_prog
ld_args = map Option (cc_args ++ words cc_link_args_str)
ld_r_prog <- getToolSetting "Merge objects command"
ld_r_args <- getSetting "Merge objects flags"
llvmTarget <- getSetting "LLVM target"
lc_prog <- getSetting "LLVM llc command"
lo_prog <- getSetting "LLVM opt command"
lcc_prog <- getSetting "LLVM clang command"
let iserv_prog = libexec "ghc-iserv"
integerLibrary <- getSetting "integer library"
integerLibraryType <- case integerLibrary of
"integer-gmp" -> pure IntegerGMP
"integer-simple" -> pure IntegerSimple
_ -> pgmError $ unwords
[ "Entry for"
, show "integer library"
, "must be one of"
, show "integer-gmp"
, "or"
, show "integer-simple"
]
ghcWithInterpreter <- getBooleanSetting "Use interpreter"
ghcWithNativeCodeGen <- getBooleanSetting "Use native code generator"
ghcWithSMP <- getBooleanSetting "Support SMP"
ghcRTSWays <- getSetting "RTS ways"
leadingUnderscore <- getBooleanSetting "Leading underscore"
useLibFFI <- getBooleanSetting "Use LibFFI"
ghcThreaded <- getBooleanSetting "Use Threads"
ghcDebugged <- getBooleanSetting "Use Debugging"
ghcRtsWithLibdw <- getBooleanSetting "RTS expects libdw"
return $ Settings
{ sGhcNameVersion = GhcNameVersion
{ ghcNameVersion_programName = "ghc"
, ghcNameVersion_projectVersion = cProjectVersion
}
, sFileSettings = FileSettings
{ fileSettings_tmpDir = normalise tmpdir
, fileSettings_ghcUsagePath = ghc_usage_msg_path
, fileSettings_ghciUsagePath = ghci_usage_msg_path
, fileSettings_toolDir = mtool_dir
, fileSettings_topDir = top_dir
, fileSettings_systemPackageConfig = pkgconfig_path
}
, sToolSettings = ToolSettings
{ toolSettings_ldSupportsCompactUnwind = ldSupportsCompactUnwind
, toolSettings_ldSupportsBuildId = ldSupportsBuildId
, toolSettings_ldSupportsFilelist = ldSupportsFilelist
, toolSettings_ldIsGnuLd = ldIsGnuLd
, toolSettings_ccSupportsNoPie = gccSupportsNoPie
, toolSettings_pgm_L = unlit_path
, toolSettings_pgm_P = (cpp_prog, cpp_args)
, toolSettings_pgm_F = ""
, toolSettings_pgm_c = cc_prog
, toolSettings_pgm_a = (as_prog, as_args)
, toolSettings_pgm_l = (ld_prog, ld_args)
, toolSettings_pgm_lm = (ld_r_prog, map Option $ words ld_r_args)
, toolSettings_pgm_dll = (mkdll_prog,mkdll_args)
, toolSettings_pgm_T = touch_path
, toolSettings_pgm_windres = windres_path
, toolSettings_pgm_libtool = libtool_path
, toolSettings_pgm_ar = ar_path
, toolSettings_pgm_otool = otool_path
, toolSettings_pgm_install_name_tool = install_name_tool_path
, toolSettings_pgm_ranlib = ranlib_path
, toolSettings_pgm_lo = (lo_prog,[])
, toolSettings_pgm_lc = (lc_prog,[])
, toolSettings_pgm_lcc = (lcc_prog,[])
, toolSettings_pgm_i = iserv_prog
, toolSettings_opt_L = []
, toolSettings_opt_P = []
, toolSettings_opt_P_fingerprint = fingerprint0
, toolSettings_opt_F = []
, toolSettings_opt_c = cc_args
, toolSettings_opt_cxx = cxx_args
, toolSettings_opt_a = []
, toolSettings_opt_l = []
, toolSettings_opt_lm = []
, toolSettings_opt_windres = []
, toolSettings_opt_lcc = []
, toolSettings_opt_lo = []
, toolSettings_opt_lc = []
, toolSettings_opt_i = []
, toolSettings_extraGccViaCFlags = words myExtraGccViaCFlags
}
, sTargetPlatform = platform
, sPlatformMisc = PlatformMisc
{ platformMisc_targetPlatformString = targetPlatformString
, platformMisc_integerLibrary = integerLibrary
, platformMisc_integerLibraryType = integerLibraryType
, platformMisc_ghcWithInterpreter = ghcWithInterpreter
, platformMisc_ghcWithNativeCodeGen = ghcWithNativeCodeGen
, platformMisc_ghcWithSMP = ghcWithSMP
, platformMisc_ghcRTSWays = ghcRTSWays
, platformMisc_tablesNextToCode = tablesNextToCode
, platformMisc_leadingUnderscore = leadingUnderscore
, platformMisc_libFFI = useLibFFI
, platformMisc_ghcThreaded = ghcThreaded
, platformMisc_ghcDebugged = ghcDebugged
, platformMisc_ghcRtsWithLibdw = ghcRtsWithLibdw
, platformMisc_llvmTarget = llvmTarget
}
, sPlatformConstants = platformConstants
, sRawSettings = settingsList
}