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

-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Simple.GHC.Internal
  Copyright    :     2003 - 2007
--
-- Maintainer  :  
-- 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,
        componentJsGhcOptions,
        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.Flag ( Flag, maybeToFlag, toFlag )
import qualified Distribution.ModuleName as ModuleName
import Distribution.Simple.Program
import Distribution.Simple.LocalBuildInfo
import Distribution.Types.UnitId
import Distribution.Types.LocalBuildInfo
import Distribution.Types.TargetInfo
import Distribution.Simple.Utils
import Distribution.Simple.BuildPaths
import Distribution.System
import Distribution.Pretty ( prettyShow )
import Distribution.Parsec ( simpleParsec )
import Distribution.Utils.NubList ( toNubListR )
import Distribution.Verbosity
import Distribution.Compat.Stack
import Distribution.Version (Version)
import Distribution.Utils.Path
import Language.Haskell.Extension

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

targetPlatform :: [(String, String)] -> Maybe Platform
targetPlatform ghcInfo = platformFromTriple =<< lookup "Target platform" ghcInfo

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

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

    gccProgramName   = maybeName gccProgram   mbGccLocation
    ldProgramName    = maybeName ldProgram    mbLdLocation
    arProgramName    = maybeName arProgram    mbArLocation
    stripProgramName = maybeName stripProgram mbStripLocation

    mkExtraPath :: Maybe FilePath -> FilePath -> [FilePath]
    mkExtraPath mbPath mingwPath | isWindows = mbDir ++ [mingwPath]
                                 | otherwise = mbDir
      where
        mbDir = maybeToList . fmap takeDirectory $ mbPath

    extraGccPath   = mkExtraPath mbGccLocation   windowsExtraGccDir
    extraLdPath    = mkExtraPath mbLdLocation    windowsExtraLdDir
    extraArPath    = mkExtraPath mbArLocation    windowsExtraArDir
    extraStripPath = mkExtraPath mbStripLocation windowsExtraStripDir

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

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

    -- Read tool locations from the 'ghc --info' output. Useful when
    -- cross-compiling.
    mbGccLocation   = Map.lookup "C compiler command" ghcInfo
    mbLdLocation    = Map.lookup "ld command" ghcInfo
    mbArLocation    = Map.lookup "ar command" ghcInfo
    mbStripLocation = Map.lookup "strip command" ghcInfo

    ccFlags        = getFlags "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 = getFlags "Gcc Linker flags" ++ getFlags "C compiler link flags"
    ldLinkerFlags  = getFlags "Ld Linker flags" ++ getFlags "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 key =
        case Map.lookup key ghcInfo of
          Nothing -> []
          Just flags
            | (flags', ""):_ <- reads flags -> flags'
            | otherwise -> tokenizeQuotedWords flags

    configureGcc :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
    configureGcc _v gccProg = do
      return gccProg {
        programDefaultArgs = programDefaultArgs gccProg
                             ++ ccFlags ++ gccLinkerFlags
      }

    configureLd :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
    configureLd v ldProg = do
      ldProg' <- configureLd' v ldProg
      return ldProg' {
        programDefaultArgs = programDefaultArgs ldProg' ++ ldLinkerFlags
      }

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

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

getGhcInfo :: Verbosity -> GhcImplInfo -> ConfiguredProgram
           -> IO [(String, String)]
getGhcInfo verbosity _implInfo ghcProg = do
      xs <- getProgramOutput verbosity (suppressOverrideArgs ghcProg)
                 ["--info"]
      case reads xs of
        [(i, ss)]
          | all isSpace ss ->
              return i
        _ ->
          die' verbosity "Can't parse --info output of GHC"

getExtensions :: Verbosity -> GhcImplInfo -> ConfiguredProgram
              -> IO [(Extension, Maybe String)]
getExtensions verbosity implInfo ghcProg = do
    str <- getProgramOutput verbosity (suppressOverrideArgs ghcProg)
              ["--supported-languages"]
    let extStrs = if reportsNoExt implInfo
                  then lines str
  Older GHCs only gave us either  or NoFoo ,
  so we have to work out the other one ourselves
                       [ extStr''
                       | extStr <- lines str
                       , let extStr' = case extStr of
                                       'N' : 'o' : xs -> xs
                                       _              -> "No" ++ extStr
                       , extStr'' <- [extStr, extStr']
                       ]
    let extensions0 = [ (ext, Just $ "-X" ++ prettyShow ext)
                      | Just ext <- map simpleParsec extStrs ]
        extensions1 = if alwaysNondecIndent 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.
                           (EnableExtension NondecreasingIndentation, Nothing) :
                           extensions0
                      else extensions0
    return extensions1

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

      ghcOptCppIncludePath = toNubListR $ [autogenComponentModulesDir lbi clbi
                                          ,autogenPackageModulesDir lbi
                                          ,odir]
                                          -- includes relative to the package
                                          ++ includeDirs bi
                                          -- potential includes generated by `configure'
                                          -- in the build directory
                                          ++ [buildDir lbi </> dir | dir <- includeDirs bi],
      ghcOptHideAllPackages= toFlag True,
      ghcOptPackageDBs     = withPackageDB lbi,
      ghcOptPackages       = toNubListR $ mkGhcOptPackages clbi,
      ghcOptCcOptions      = (case withOptimization lbi of
                                  NoOptimisation -> []
                                  _              -> ["-O2"]) ++
                             (case withDebugInfo lbi of
                                  NoDebugInfo   -> []
                                  MinimalDebugInfo -> ["-g1"]
                                  NormalDebugInfo  -> ["-g"]
                                  MaximalDebugInfo -> ["-g3"]) ++
                                  ccOptions bi,
      ghcOptCcProgram      = maybeToFlag $ programPath <$>
                                 lookupProgram gccProgram (withPrograms lbi),
      ghcOptObjDir         = toFlag odir,
      ghcOptExtra          = hcOptions GHC bi
    }


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

      ghcOptCppIncludePath = toNubListR $ [autogenComponentModulesDir lbi clbi
                                          ,autogenPackageModulesDir lbi
                                          ,odir]
                                          -- includes relative to the package
                                          ++ includeDirs bi
                                          -- potential includes generated by `configure'
                                          -- in the build directory
                                          ++ [buildDir lbi </> dir | dir <- includeDirs bi],
      ghcOptHideAllPackages= toFlag True,
      ghcOptPackageDBs     = withPackageDB lbi,
      ghcOptPackages       = toNubListR $ mkGhcOptPackages clbi,
      ghcOptCxxOptions     = (case withOptimization lbi of
                                  NoOptimisation -> []
                                  _              -> ["-O2"]) ++
                             (case withDebugInfo lbi of
                                  NoDebugInfo   -> []
                                  MinimalDebugInfo -> ["-g1"]
                                  NormalDebugInfo  -> ["-g"]
                                  MaximalDebugInfo -> ["-g3"]) ++
                                  cxxOptions bi,
      ghcOptCcProgram      = maybeToFlag $ programPath <$>
                                 lookupProgram gccProgram (withPrograms lbi),
      ghcOptObjDir         = toFlag odir,
      ghcOptExtra          = hcOptions GHC bi
    }


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

      ghcOptCppIncludePath = toNubListR $ [autogenComponentModulesDir lbi clbi
                                          ,autogenPackageModulesDir lbi
                                          ,odir]
                                          -- includes relative to the package
                                          ++ includeDirs bi
                                          -- potential includes generated by `configure'
                                          -- in the build directory
                                          ++ [buildDir lbi </> dir | dir <- includeDirs bi],
      ghcOptHideAllPackages= toFlag True,
      ghcOptPackageDBs     = withPackageDB lbi,
      ghcOptPackages       = toNubListR $ mkGhcOptPackages clbi,
      ghcOptAsmOptions     = (case withOptimization lbi of
                                  NoOptimisation -> []
                                  _              -> ["-O2"]) ++
                             (case withDebugInfo lbi of
                                  NoDebugInfo   -> []
                                  MinimalDebugInfo -> ["-g1"]
                                  NormalDebugInfo  -> ["-g"]
                                  MaximalDebugInfo -> ["-g3"]) ++
                                  asmOptions bi,
      ghcOptObjDir         = toFlag odir
    }

componentJsGhcOptions :: Verbosity -> GhcImplInfo -> LocalBuildInfo
                      -> BuildInfo -> ComponentLocalBuildInfo
                      -> FilePath -> FilePath
                      -> GhcOptions
componentJsGhcOptions verbosity _implInfo lbi bi clbi odir filename =
    mempty {
  Respect -v0 , but do n't crank up verbosity on GHC if
  Cabal verbosity is requested . For that , use  - option=-v instead !
      ghcOptVerbosity      = toFlag (min verbosity normal),
      ghcOptMode           = toFlag GhcModeCompile,
      ghcOptInputFiles     = toNubListR [filename],

      ghcOptCppIncludePath = toNubListR $ [autogenComponentModulesDir lbi clbi
                                          ,autogenPackageModulesDir lbi
                                          ,odir]
                                          -- includes relative to the package
                                          ++ includeDirs bi
                                          -- potential includes generated by `configure'
                                          -- in the build directory
                                          ++ [buildDir lbi </> dir | dir <- includeDirs bi],
      ghcOptHideAllPackages= toFlag True,
      ghcOptPackageDBs     = withPackageDB lbi,
      ghcOptPackages       = toNubListR $ mkGhcOptPackages clbi,
      ghcOptObjDir         = toFlag odir
    }


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

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


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

      ghcOptCppIncludePath = toNubListR $ [autogenComponentModulesDir lbi clbi
                                          ,autogenPackageModulesDir lbi
                                          ,odir]
                                          -- includes relative to the package
                                          ++ includeDirs bi
                                          -- potential includes generated by `configure'
                                          -- in the build directory
                                          ++ [buildDir lbi </> dir | dir <- includeDirs bi],
      ghcOptCppOptions     = cppOptions bi,
      ghcOptCppIncludes    = toNubListR $
                             [autogenComponentModulesDir lbi clbi </> cppHeaderName],
      ghcOptHideAllPackages= toFlag True,
      ghcOptPackageDBs     = withPackageDB lbi,
      ghcOptPackages       = toNubListR $ mkGhcOptPackages clbi,
      ghcOptOptimisation   = toGhcOptimisation (withOptimization lbi),
      ghcOptDebugInfo      = toFlag (withDebugInfo lbi),
      ghcOptExtra          = cmmOptions bi,
      ghcOptObjDir         = toFlag odir
    }


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

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

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

ghcLookupProperty :: String -> Compiler -> Bool
ghcLookupProperty prop comp =
  case Map.lookup prop (compilerProperties comp) of
    Just "YES" -> True
    _          -> 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 _implInfo lib lbi clbi pref wanted_obj_ext allow_split_objs
  | splitObjs lbi && allow_split_objs = do
        let splitSuffix = "_" ++ wanted_obj_ext ++ "_split"
            dirs = [ pref </> (ModuleName.toFilePath x ++ splitSuffix)
                   | x <- allLibModules lib clbi ]
        objss <- traverse getDirectoryContents dirs
        let objs = [ dir </> obj
                   | (objs',dir) <- zip objss dirs, obj <- objs',
                     let obj_ext = takeExtension obj,
                     '.':wanted_obj_ext == obj_ext ]
        return objs
  | otherwise  =
        return [ pref </> ModuleName.toFilePath x <.> wanted_obj_ext
               | x <- allLibModules lib clbi ]

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

substTopDir :: FilePath -> IPI.InstalledPackageInfo -> IPI.InstalledPackageInfo
substTopDir topDir ipo
 = ipo {
       IPI.importDirs        = map f (IPI.importDirs ipo),
       IPI.libraryDirs       = map f (IPI.libraryDirs ipo),
       IPI.libraryDirsStatic = map f (IPI.libraryDirsStatic ipo),
       IPI.includeDirs       = map f (IPI.includeDirs ipo),
       IPI.frameworkDirs     = map f (IPI.frameworkDirs ipo),
       IPI.haddockInterfaces = map f (IPI.haddockInterfaces ipo),
       IPI.haddockHTMLs      = map f (IPI.haddockHTMLs ipo)
   }
    where f ('$':'t':'o':'p':'d':'i':'r':rest) = topDir ++ rest
          f x = 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 compilerName packagePathEnvVar = do
    mPP <- lookupEnv packagePathEnvVar
    when (isJust mPP) $ do
        mcsPP <- lookupEnv "CABAL_SANDBOX_PACKAGE_PATH"
        unless (mPP == mcsPP) abort
    where
        lookupEnv :: String -> IO (Maybe String)
        lookupEnv name = (Just `fmap` getEnv name)
                         `catchIO` const (return Nothing)
        abort =
            die' verbosity $ "Use of " ++ compilerName ++ "'s environment variable "
               ++ packagePathEnvVar ++ " is incompatible with Cabal. Use the "
               ++ "flag --package-db to specify a package database (it can be "
               ++ "used multiple times)."

        _ = callStack -- TODO: output stack when erroring

profDetailLevelFlag :: Bool -> ProfDetailLevel -> Flag GhcProfAuto
profDetailLevelFlag forLib mpl =
    case mpl of
      ProfDetailNone                -> mempty
      ProfDetailDefault | forLib    -> toFlag GhcProfAutoExported
                        | otherwise -> toFlag GhcProfAutoToplevel
      ProfDetailExportedFunctions   -> toFlag GhcProfAutoExported
      ProfDetailToplevelFunctions   -> toFlag GhcProfAutoToplevel
      ProfDetailAllFunctions        -> toFlag GhcProfAutoAll
      ProfDetailTopLate             -> toFlag GhcProfLate
      ProfDetailOther _             -> 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 PPC   = "powerpc"
ghcArchString PPC64 = "powerpc64"
ghcArchString other = prettyShow 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 Windows = "mingw32"
ghcOsString OSX     = "darwin"
ghcOsString Solaris = "solaris2"
ghcOsString other   = prettyShow 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 arch os) version =
    intercalate "-" [ ghcArchString arch, ghcOsString os, prettyShow 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@,
     - package - db@ or
                                      --   @package-db blah/package.conf.d/@
  ^ @clear - package - db@
     deriving (Eq, Ord, 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 packageDBs pkgids =
    GhcEnvFileClearPackageDbStack
  : map GhcEnvFilePackageDb packageDBs
 ++ map GhcEnvFilePackageId 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
  ^ the GHC target platform
  ^ the GHC version
                        -> [GhcEnvironmentFileEntry] -- ^ the content
                        -> IO FilePath
writeGhcEnvironmentFile directory platform ghcversion entries = do
    writeFileAtomic envfile . BS.pack . renderGhcEnvironmentFile $ entries
    return envfile
  where
    envfile = directory </> ghcEnvironmentFileName platform ghcversion

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

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

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

# LANGUAGE RankNTypes #
---------------------------------------------------------------------------
 |
 Module      :  Distribution.Simple.GHC.Internal

 Maintainer  :  
 Portability :  portable

 | Adjust the way we find and configure gcc and ld

 Read tool locations from the 'ghc --info' output. Useful when
 cross-compiling.
 [String] in these settings whereas later versions just encode the flags as
 String.

 flags ourself.
 we need to find out if ld supports the -x flag
 TODO: should be using --supported-languages rather than hard coding
 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.
 includes relative to the package
 potential includes generated by `configure'
 in the build directory
 includes relative to the package
 potential includes generated by `configure'
 in the build directory
 includes relative to the package
 potential includes generated by `configure'
 in the build directory
 includes relative to the package
 potential includes generated by `configure'
 in the build directory
 includes relative to the package
 potential includes generated by `configure'
 in the build directory
 Unsupported extensions have already been checked by configure
 TODO: Ugh, localPkgDescr
TODO perhaps override?
 includes relative to the package
 potential includes generated by `configure'
 in the build directory
 | Strip out flags that are not supported in ghci
 when using -split-objs, we need to search for object files in the
 Module_split directory for each module.

 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.
 TODO: output stack when erroring
 -----------------------------------------------------------------------------
 strings and certain file locations (such as user package db location).

 strings and certain file locations (such as user package db location).

 certain file locations (such as user package db location).
 For example @x86_64-linux-7.10.4@

 -----------------------------------------------------------------------------

 ^ @-- a comment@
 ^ @package-id foo-1.0-4fe301a...@
 ^ @global-package-db@,
   @package-db blah/package.conf.d/@
 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.

 | Write a @.ghc.environment-$arch-$os-$ver@ file in the given directory.


 Returns the name of the file written.
 ^ directory in which to put it
 ^ the content
 | The @.ghc.environment-$arch-$os-$ver@ file name



# LANGUAGE FlexibleContexts #

  Copyright    :     2003 - 2007
  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,
        componentJsGhcOptions,
        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.Flag ( Flag, maybeToFlag, toFlag )
import qualified Distribution.ModuleName as ModuleName
import Distribution.Simple.Program
import Distribution.Simple.LocalBuildInfo
import Distribution.Types.UnitId
import Distribution.Types.LocalBuildInfo
import Distribution.Types.TargetInfo
import Distribution.Simple.Utils
import Distribution.Simple.BuildPaths
import Distribution.System
import Distribution.Pretty ( prettyShow )
import Distribution.Parsec ( simpleParsec )
import Distribution.Utils.NubList ( toNubListR )
import Distribution.Verbosity
import Distribution.Compat.Stack
import Distribution.Version (Version)
import Distribution.Utils.Path
import Language.Haskell.Extension

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

targetPlatform :: [(String, String)] -> Maybe Platform
targetPlatform ghcInfo = platformFromTriple =<< lookup "Target platform" ghcInfo

configureToolchain :: GhcImplInfo
                   -> ConfiguredProgram
                   -> Map String String
                   -> ProgramDb
                   -> ProgramDb
configureToolchain _implInfo ghcProg ghcInfo =
    addKnownProgram gccProgram {
      programFindLocation = findProg gccProgramName extraGccPath,
      programPostConf     = configureGcc
    }
  . addKnownProgram ldProgram {
      programFindLocation = findProg ldProgramName extraLdPath,
      programPostConf     = configureLd
    }
  . addKnownProgram arProgram {
      programFindLocation = findProg arProgramName extraArPath
    }
  . addKnownProgram stripProgram {
      programFindLocation = findProg stripProgramName extraStripPath
    }
  where
    compilerDir = takeDirectory (programPath ghcProg)
    base_dir     = takeDirectory compilerDir
    mingwBinDir = base_dir </> "mingw" </> "bin"
    isWindows   = case buildOS of Windows -> True; _ -> False
    binPrefix   = ""

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

    gccProgramName   = maybeName gccProgram   mbGccLocation
    ldProgramName    = maybeName ldProgram    mbLdLocation
    arProgramName    = maybeName arProgram    mbArLocation
    stripProgramName = maybeName stripProgram mbStripLocation

    mkExtraPath :: Maybe FilePath -> FilePath -> [FilePath]
    mkExtraPath mbPath mingwPath | isWindows = mbDir ++ [mingwPath]
                                 | otherwise = mbDir
      where
        mbDir = maybeToList . fmap takeDirectory $ mbPath

    extraGccPath   = mkExtraPath mbGccLocation   windowsExtraGccDir
    extraLdPath    = mkExtraPath mbLdLocation    windowsExtraLdDir
    extraArPath    = mkExtraPath mbArLocation    windowsExtraArDir
    extraStripPath = mkExtraPath mbStripLocation windowsExtraStripDir

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

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

    mbGccLocation   = Map.lookup "C compiler command" ghcInfo
    mbLdLocation    = Map.lookup "ld command" ghcInfo
    mbArLocation    = Map.lookup "ar command" ghcInfo
    mbStripLocation = Map.lookup "strip command" ghcInfo

    ccFlags        = getFlags "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 = getFlags "Gcc Linker flags" ++ getFlags "C compiler link flags"
    ldLinkerFlags  = getFlags "Ld Linker flags" ++ getFlags "ld flags"

  It appears that GHC 7.6 and earlier encode the tokenized flags as a
  We first try to parse as a [ String ] and if this fails then tokenize the
    getFlags :: String -> [String]
    getFlags key =
        case Map.lookup key ghcInfo of
          Nothing -> []
          Just flags
            | (flags', ""):_ <- reads flags -> flags'
            | otherwise -> tokenizeQuotedWords flags

    configureGcc :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
    configureGcc _v gccProg = do
      return gccProg {
        programDefaultArgs = programDefaultArgs gccProg
                             ++ ccFlags ++ gccLinkerFlags
      }

    configureLd :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
    configureLd v ldProg = do
      ldProg' <- configureLd' v ldProg
      return ldProg' {
        programDefaultArgs = programDefaultArgs ldProg' ++ ldLinkerFlags
      }

    configureLd' :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
    configureLd' verbosity ldProg = do
      tempDir <- getTemporaryDirectory
      ldx <- withTempFile tempDir ".c" $ \testcfile testchnd ->
             withTempFile tempDir ".o" $ \testofile testohnd -> do
               hPutStrLn testchnd "int foo() { return 0; }"
               hClose testchnd; hClose testohnd
               runProgram verbosity ghcProg
                          [ "-hide-all-packages"
                          , "-c", testcfile
                          , "-o", testofile
                          ]
               withTempFile tempDir ".o" $ \testofile' testohnd' ->
                 do
                   hClose testohnd'
                   _ <- getProgramOutput verbosity ldProg
                     ["-x", "-r", testofile, "-o", testofile']
                   return True
                 `catchIO`   (\_ -> return False)
                 `catchExit` (\_ -> return False)
      if ldx
        then return ldProg { programDefaultArgs = ["-x"] }
        else return ldProg

getLanguages :: Verbosity -> GhcImplInfo -> ConfiguredProgram
             -> IO [(Language, String)]
getLanguages _ implInfo _
  | supportsGHC2021 implInfo = return
    [ (GHC2021, "-XGHC2021")
    , (Haskell2010, "-XHaskell2010")
    , (Haskell98, "-XHaskell98")
    ]
  | supportsHaskell2010 implInfo = return [(Haskell98,   "-XHaskell98")
                                          ,(Haskell2010, "-XHaskell2010")]
  | otherwise                    = return [(Haskell98,   "")]

getGhcInfo :: Verbosity -> GhcImplInfo -> ConfiguredProgram
           -> IO [(String, String)]
getGhcInfo verbosity _implInfo ghcProg = do
      xs <- getProgramOutput verbosity (suppressOverrideArgs ghcProg)
                 ["--info"]
      case reads xs of
        [(i, ss)]
          | all isSpace ss ->
              return i
        _ ->
          die' verbosity "Can't parse --info output of GHC"

getExtensions :: Verbosity -> GhcImplInfo -> ConfiguredProgram
              -> IO [(Extension, Maybe String)]
getExtensions verbosity implInfo ghcProg = do
    str <- getProgramOutput verbosity (suppressOverrideArgs ghcProg)
              ["--supported-languages"]
    let extStrs = if reportsNoExt implInfo
                  then lines str
  Older GHCs only gave us either  or NoFoo ,
  so we have to work out the other one ourselves
                       [ extStr''
                       | extStr <- lines str
                       , let extStr' = case extStr of
                                       'N' : 'o' : xs -> xs
                                       _              -> "No" ++ extStr
                       , extStr'' <- [extStr, extStr']
                       ]
    let extensions0 = [ (ext, Just $ "-X" ++ prettyShow ext)
                      | Just ext <- map simpleParsec extStrs ]
        extensions1 = if alwaysNondecIndent implInfo
                           (EnableExtension NondecreasingIndentation, Nothing) :
                           extensions0
                      else extensions0
    return extensions1

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

      ghcOptCppIncludePath = toNubListR $ [autogenComponentModulesDir lbi clbi
                                          ,autogenPackageModulesDir lbi
                                          ,odir]
                                          ++ includeDirs bi
                                          ++ [buildDir lbi </> dir | dir <- includeDirs bi],
      ghcOptHideAllPackages= toFlag True,
      ghcOptPackageDBs     = withPackageDB lbi,
      ghcOptPackages       = toNubListR $ mkGhcOptPackages clbi,
      ghcOptCcOptions      = (case withOptimization lbi of
                                  NoOptimisation -> []
                                  _              -> ["-O2"]) ++
                             (case withDebugInfo lbi of
                                  NoDebugInfo   -> []
                                  MinimalDebugInfo -> ["-g1"]
                                  NormalDebugInfo  -> ["-g"]
                                  MaximalDebugInfo -> ["-g3"]) ++
                                  ccOptions bi,
      ghcOptCcProgram      = maybeToFlag $ programPath <$>
                                 lookupProgram gccProgram (withPrograms lbi),
      ghcOptObjDir         = toFlag odir,
      ghcOptExtra          = hcOptions GHC bi
    }


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

      ghcOptCppIncludePath = toNubListR $ [autogenComponentModulesDir lbi clbi
                                          ,autogenPackageModulesDir lbi
                                          ,odir]
                                          ++ includeDirs bi
                                          ++ [buildDir lbi </> dir | dir <- includeDirs bi],
      ghcOptHideAllPackages= toFlag True,
      ghcOptPackageDBs     = withPackageDB lbi,
      ghcOptPackages       = toNubListR $ mkGhcOptPackages clbi,
      ghcOptCxxOptions     = (case withOptimization lbi of
                                  NoOptimisation -> []
                                  _              -> ["-O2"]) ++
                             (case withDebugInfo lbi of
                                  NoDebugInfo   -> []
                                  MinimalDebugInfo -> ["-g1"]
                                  NormalDebugInfo  -> ["-g"]
                                  MaximalDebugInfo -> ["-g3"]) ++
                                  cxxOptions bi,
      ghcOptCcProgram      = maybeToFlag $ programPath <$>
                                 lookupProgram gccProgram (withPrograms lbi),
      ghcOptObjDir         = toFlag odir,
      ghcOptExtra          = hcOptions GHC bi
    }


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

      ghcOptCppIncludePath = toNubListR $ [autogenComponentModulesDir lbi clbi
                                          ,autogenPackageModulesDir lbi
                                          ,odir]
                                          ++ includeDirs bi
                                          ++ [buildDir lbi </> dir | dir <- includeDirs bi],
      ghcOptHideAllPackages= toFlag True,
      ghcOptPackageDBs     = withPackageDB lbi,
      ghcOptPackages       = toNubListR $ mkGhcOptPackages clbi,
      ghcOptAsmOptions     = (case withOptimization lbi of
                                  NoOptimisation -> []
                                  _              -> ["-O2"]) ++
                             (case withDebugInfo lbi of
                                  NoDebugInfo   -> []
                                  MinimalDebugInfo -> ["-g1"]
                                  NormalDebugInfo  -> ["-g"]
                                  MaximalDebugInfo -> ["-g3"]) ++
                                  asmOptions bi,
      ghcOptObjDir         = toFlag odir
    }

componentJsGhcOptions :: Verbosity -> GhcImplInfo -> LocalBuildInfo
                      -> BuildInfo -> ComponentLocalBuildInfo
                      -> FilePath -> FilePath
                      -> GhcOptions
componentJsGhcOptions verbosity _implInfo lbi bi clbi odir filename =
    mempty {
  Respect -v0 , but do n't crank up verbosity on GHC if
  Cabal verbosity is requested . For that , use  - option=-v instead !
      ghcOptVerbosity      = toFlag (min verbosity normal),
      ghcOptMode           = toFlag GhcModeCompile,
      ghcOptInputFiles     = toNubListR [filename],

      ghcOptCppIncludePath = toNubListR $ [autogenComponentModulesDir lbi clbi
                                          ,autogenPackageModulesDir lbi
                                          ,odir]
                                          ++ includeDirs bi
                                          ++ [buildDir lbi </> dir | dir <- includeDirs bi],
      ghcOptHideAllPackages= toFlag True,
      ghcOptPackageDBs     = withPackageDB lbi,
      ghcOptPackages       = toNubListR $ mkGhcOptPackages clbi,
      ghcOptObjDir         = toFlag odir
    }


componentGhcOptions :: Verbosity -> GhcImplInfo -> LocalBuildInfo
                    -> BuildInfo -> ComponentLocalBuildInfo -> FilePath
                    -> GhcOptions
componentGhcOptions verbosity implInfo lbi bi clbi odir =
    mempty {
  Respect -v0 , but do n't crank up verbosity on GHC if
  Cabal verbosity is requested . For that , use  - option=-v instead !
      ghcOptVerbosity       = toFlag (min verbosity normal),
      ghcOptCabal           = toFlag True,
      ghcOptThisUnitId      = case clbi of
        LibComponentLocalBuildInfo { componentCompatPackageKey = pk }
          -> toFlag pk
        _ -> mempty,
      ghcOptThisComponentId = case clbi of
          LibComponentLocalBuildInfo { componentComponentId = cid
                                     , componentInstantiatedWith = insts } ->
              if null insts
                  then mempty
                  else toFlag cid
          _ -> mempty,
      ghcOptInstantiatedWith = case clbi of
        LibComponentLocalBuildInfo { componentInstantiatedWith = insts }
          -> insts
        _ -> [],
      ghcOptNoCode          = toFlag $ componentIsIndefinite clbi,
      ghcOptHideAllPackages = toFlag True,
      ghcOptWarnMissingHomeModules = toFlag $ flagWarnMissingHomeModules implInfo,
      ghcOptPackageDBs      = withPackageDB lbi,
      ghcOptPackages        = toNubListR $ mkGhcOptPackages clbi,
      ghcOptSplitSections   = toFlag (splitSections lbi),
      ghcOptSplitObjs       = toFlag (splitObjs lbi),
      ghcOptSourcePathClear = toFlag True,
      ghcOptSourcePath      = toNubListR $ map getSymbolicPath (hsSourceDirs bi)
                                           ++ [odir]
                                           ++ [autogenComponentModulesDir lbi clbi]
                                           ++ [autogenPackageModulesDir lbi],
      ghcOptCppIncludePath  = toNubListR $ [autogenComponentModulesDir lbi clbi
                                           ,autogenPackageModulesDir lbi
                                           ,odir]
                                           ++ includeDirs bi
                                           ++ [buildDir lbi </> dir | dir <- includeDirs bi],
      ghcOptCppOptions      = cppOptions bi,
      ghcOptCppIncludes     = toNubListR $
                              [autogenComponentModulesDir lbi clbi </> cppHeaderName],
      ghcOptFfiIncludes     = toNubListR $ includes bi,
      ghcOptObjDir          = toFlag odir,
      ghcOptHiDir           = toFlag odir,
      ghcOptStubDir         = toFlag odir,
      ghcOptOutputDir       = toFlag odir,
      ghcOptOptimisation    = toGhcOptimisation (withOptimization lbi),
      ghcOptDebugInfo       = toFlag (withDebugInfo lbi),
      ghcOptExtra           = hcOptions GHC bi,
      ghcOptExtraPath       = toNubListR $ exe_paths,
      ghcOptLanguage        = toFlag (fromMaybe Haskell98 (defaultLanguage bi)),
      ghcOptExtensions      = toNubListR $ usedExtensions bi,
      ghcOptExtensionMap    = Map.fromList . compilerExtensions $ (compiler lbi)
    }
  where
    exe_paths = [ componentBuildDir lbi (targetCLBI exe_tgt)
                | uid <- componentExeDeps clbi
                , Just exe_tgt <- [unitIdTarget' (localPkgDescr lbi) lbi uid] ]

toGhcOptimisation :: OptimisationLevel -> Flag GhcOptimisation
toGhcOptimisation NormalOptimisation  = toFlag GhcNormalOptimisation
toGhcOptimisation MaximumOptimisation = toFlag GhcMaximumOptimisation


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

      ghcOptCppIncludePath = toNubListR $ [autogenComponentModulesDir lbi clbi
                                          ,autogenPackageModulesDir lbi
                                          ,odir]
                                          ++ includeDirs bi
                                          ++ [buildDir lbi </> dir | dir <- includeDirs bi],
      ghcOptCppOptions     = cppOptions bi,
      ghcOptCppIncludes    = toNubListR $
                             [autogenComponentModulesDir lbi clbi </> cppHeaderName],
      ghcOptHideAllPackages= toFlag True,
      ghcOptPackageDBs     = withPackageDB lbi,
      ghcOptPackages       = toNubListR $ mkGhcOptPackages clbi,
      ghcOptOptimisation   = toGhcOptimisation (withOptimization lbi),
      ghcOptDebugInfo      = toFlag (withDebugInfo lbi),
      ghcOptExtra          = cmmOptions bi,
      ghcOptObjDir         = toFlag odir
    }


filterGhciFlags :: [String] -> [String]
filterGhciFlags = filter supported
  where
    supported ('-':'O':_) = False
    supported "-debug"    = False
    supported "-threaded" = False
    supported "-ticky"    = False
    supported "-eventlog" = False
    supported "-prof"     = False
    supported "-unreg"    = False
    supported _           = True

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

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

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

getHaskellObjects :: GhcImplInfo -> Library -> LocalBuildInfo
                  -> ComponentLocalBuildInfo
                  -> FilePath -> String -> Bool -> IO [FilePath]
getHaskellObjects _implInfo lib lbi clbi pref wanted_obj_ext allow_split_objs
  | splitObjs lbi && allow_split_objs = do
        let splitSuffix = "_" ++ wanted_obj_ext ++ "_split"
            dirs = [ pref </> (ModuleName.toFilePath x ++ splitSuffix)
                   | x <- allLibModules lib clbi ]
        objss <- traverse getDirectoryContents dirs
        let objs = [ dir </> obj
                   | (objs',dir) <- zip objss dirs, obj <- objs',
                     let obj_ext = takeExtension obj,
                     '.':wanted_obj_ext == obj_ext ]
        return objs
  | otherwise  =
        return [ pref </> ModuleName.toFilePath x <.> wanted_obj_ext
               | x <- allLibModules lib clbi ]

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

substTopDir :: FilePath -> IPI.InstalledPackageInfo -> IPI.InstalledPackageInfo
substTopDir topDir ipo
 = ipo {
       IPI.importDirs        = map f (IPI.importDirs ipo),
       IPI.libraryDirs       = map f (IPI.libraryDirs ipo),
       IPI.libraryDirsStatic = map f (IPI.libraryDirsStatic ipo),
       IPI.includeDirs       = map f (IPI.includeDirs ipo),
       IPI.frameworkDirs     = map f (IPI.frameworkDirs ipo),
       IPI.haddockInterfaces = map f (IPI.haddockInterfaces ipo),
       IPI.haddockHTMLs      = map f (IPI.haddockHTMLs ipo)
   }
    where f ('$':'t':'o':'p':'d':'i':'r':rest) = topDir ++ rest
          f x = 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 .
checkPackageDbEnvVar :: Verbosity -> String -> String -> IO ()
checkPackageDbEnvVar verbosity compilerName packagePathEnvVar = do
    mPP <- lookupEnv packagePathEnvVar
    when (isJust mPP) $ do
        mcsPP <- lookupEnv "CABAL_SANDBOX_PACKAGE_PATH"
        unless (mPP == mcsPP) abort
    where
        lookupEnv :: String -> IO (Maybe String)
        lookupEnv name = (Just `fmap` getEnv name)
                         `catchIO` const (return Nothing)
        abort =
            die' verbosity $ "Use of " ++ compilerName ++ "'s environment variable "
               ++ packagePathEnvVar ++ " is incompatible with Cabal. Use the "
               ++ "flag --package-db to specify a package database (it can be "
               ++ "used multiple times)."


profDetailLevelFlag :: Bool -> ProfDetailLevel -> Flag GhcProfAuto
profDetailLevelFlag forLib mpl =
    case mpl of
      ProfDetailNone                -> mempty
      ProfDetailDefault | forLib    -> toFlag GhcProfAutoExported
                        | otherwise -> toFlag GhcProfAutoToplevel
      ProfDetailExportedFunctions   -> toFlag GhcProfAutoExported
      ProfDetailToplevelFunctions   -> toFlag GhcProfAutoToplevel
      ProfDetailAllFunctions        -> toFlag GhcProfAutoAll
      ProfDetailTopLate             -> toFlag GhcProfLate
      ProfDetailOther _             -> mempty


  GHC platform and version strings

  | GHC 's rendering of its host or target ' Arch ' as used in its platform
ghcArchString :: Arch -> String
ghcArchString PPC   = "powerpc"
ghcArchString PPC64 = "powerpc64"
ghcArchString other = prettyShow other

  | GHC 's rendering of its host or target ' OS ' as used in its platform
ghcOsString :: OS -> String
ghcOsString Windows = "mingw32"
ghcOsString OSX     = "darwin"
ghcOsString Solaris = "solaris2"
ghcOsString other   = prettyShow other

  | GHC 's rendering of its platform and compiler version string as used in
ghcPlatformAndVersionString :: Platform -> Version -> String
ghcPlatformAndVersionString (Platform arch os) version =
    intercalate "-" [ ghcArchString arch, ghcOsString os, prettyShow version ]


  Constructing GHC environment files

  | The kinds of entries we can stick in a @.ghc.environment@ file .
data GhcEnvironmentFileEntry =
     - package - db@ or
  ^ @clear - package - db@
     deriving (Eq, Ord, Show)

  | Make entries for a GHC environment file based on a ' PackageDBStack ' and
simpleGhcEnvironmentFile :: PackageDBStack
                         -> [UnitId]
                         -> [GhcEnvironmentFileEntry]
simpleGhcEnvironmentFile packageDBs pkgids =
    GhcEnvFileClearPackageDbStack
  : map GhcEnvFilePackageDb packageDBs
 ++ map GhcEnvFilePackageId pkgids

  The ' Platform ' and GHC ' Version ' are needed as part of the file name .
  ^ the GHC target platform
  ^ the GHC version
                        -> IO FilePath
writeGhcEnvironmentFile directory platform ghcversion entries = do
    writeFileAtomic envfile . BS.pack . renderGhcEnvironmentFile $ entries
    return envfile
  where
    envfile = directory </> ghcEnvironmentFileName platform ghcversion

ghcEnvironmentFileName :: Platform -> Version -> FilePath
ghcEnvironmentFileName platform ghcversion =
    ".ghc.environment." ++ ghcPlatformAndVersionString platform ghcversion

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

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