{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE CPP #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Simple.GHC
-- Copyright   :  Isaac Jones 2003-2007
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This is a fairly large module. It contains most of the GHC-specific code for
-- configuring, building and installing packages. It also exports a function
-- for finding out what packages are already installed. Configuring involves
-- finding the @ghc@ and @ghc-pkg@ programs, finding what language extensions
-- this version of ghc supports and returning a 'Compiler' value.
--
-- 'getInstalledPackages' involves calling the @ghc-pkg@ program to find out
-- what packages are installed.
--
-- Building is somewhat complex as there is quite a bit of information to take
-- into account. We have to build libs and programs, possibly for profiling and
-- shared libs. We have to support building libraries that will be usable by
-- GHCi and also ghc's @-split-objs@ feature. We have to compile any C files
-- using ghc. Linking, especially for @split-objs@ is remarkably complex,
-- partly because there tend to be 1,000's of @.o@ files and this can often be
-- more than we can pass to the @ld@ or @ar@ programs in one go.
--
-- Installing for libs and exes involves finding the right files and copying
-- them to the right places. One of the more tricky things about this module is
-- remembering the layout of files in the build directory (which is not
-- explicitly documented) and thus what search dirs are used for various kinds
-- of files.

module Distribution.Simple.GHC (
        getGhcInfo,
        configure,
        getInstalledPackages,
        getInstalledPackagesMonitorFiles,
        getPackageDBContents,
        buildLib, buildFLib, buildExe,
        replLib, replFLib, replExe,
        startInterpreter,
        installLib, installFLib, installExe,
        libAbiHash,
        hcPkgInfo,
        registerPackage,
        componentGhcOptions,
        componentCcGhcOptions,
        getGhcAppDir,
        getLibDir,
        isDynamic,
        getGlobalPackageDB,
        pkgRoot,
        -- * Constructing and deconstructing GHC environment files
        Internal.GhcEnvironmentFileEntry(..),
        Internal.simpleGhcEnvironmentFile,
        Internal.renderGhcEnvironmentFile,
        Internal.writeGhcEnvironmentFile,
        Internal.ghcPlatformAndVersionString,
        readGhcEnvironmentFile,
        parseGhcEnvironmentFile,
        ParseErrorExc(..),
        -- * Version-specific implementation quirks
        getImplInfo,
        GhcImplInfo(..)
 ) where

import Prelude ()
import Distribution.Compat.Prelude

import qualified Distribution.Simple.GHC.Internal as Internal
import Distribution.CabalSpecVersion
import Distribution.Simple.GHC.ImplInfo
import Distribution.Simple.GHC.EnvironmentParser
import Distribution.PackageDescription.Utils (cabalBug)
import Distribution.PackageDescription as PD
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.LocalBuildInfo
import Distribution.Types.ComponentLocalBuildInfo
import qualified Distribution.Simple.Hpc as Hpc
import Distribution.Simple.BuildPaths
import Distribution.Simple.Utils
import Distribution.Package
import qualified Distribution.ModuleName as ModuleName
import Distribution.ModuleName (ModuleName)
import Distribution.Simple.Program
import Distribution.Simple.Program.Builtin (runghcProgram)
import qualified Distribution.Simple.Program.HcPkg as HcPkg
import qualified Distribution.Simple.Program.Ar    as Ar
import qualified Distribution.Simple.Program.Ld    as Ld
import qualified Distribution.Simple.Program.Strip as Strip
import Distribution.Simple.Program.GHC
import Distribution.Simple.Setup
import qualified Distribution.Simple.Setup as Cabal
import Distribution.Simple.Compiler
import Distribution.Version
import Distribution.System
import Distribution.Types.PackageName.Magic
import Distribution.Verbosity
import Distribution.Pretty
import Distribution.Utils.NubList
import Distribution.Utils.Path
import Language.Haskell.Extension

import Control.Monad (msum, forM_)
import Data.Char (isLower)
import qualified Data.Map as Map
import System.Directory
         ( doesFileExist, getAppUserDataDirectory, createDirectoryIfMissing
         , canonicalizePath, removeFile, renameFile, getDirectoryContents
         , makeRelativeToCurrentDirectory )
import System.FilePath          ( (</>), (<.>), takeExtension
                                , takeDirectory, replaceExtension
                                ,isRelative )
import qualified System.Info
#ifndef mingw32_HOST_OS
import System.Posix (createSymbolicLink)
#endif /* mingw32_HOST_OS */

-- -----------------------------------------------------------------------------
-- Configuring

configure :: Verbosity -> Maybe FilePath -> Maybe FilePath
          -> ProgramDb
          -> IO (Compiler, Maybe Platform, ProgramDb)
configure :: Verbosity
-> Maybe FilePath
-> Maybe FilePath
-> ProgramDb
-> IO (Compiler, Maybe Platform, ProgramDb)
configure Verbosity
verbosity Maybe FilePath
hcPath Maybe FilePath
hcPkgPath ProgramDb
conf0 = do

  (ConfiguredProgram
ghcProg, Version
ghcVersion, ProgramDb
progdb1) <-
    Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)
requireProgramVersion Verbosity
verbosity Program
ghcProgram
      (Version -> VersionRange
orLaterVersion ([Int] -> Version
mkVersion [Int
7,Int
0,Int
1]))
      (FilePath -> Maybe FilePath -> ProgramDb -> ProgramDb
userMaybeSpecifyPath FilePath
"ghc" Maybe FilePath
hcPath ProgramDb
conf0)
  let implInfo :: GhcImplInfo
implInfo = Version -> GhcImplInfo
ghcVersionImplInfo Version
ghcVersion

  -- Cabal currently supports ghc >= 7.0.1 && < 9.6
  -- ... and the following odd development version
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Version
ghcVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
9,Int
6]) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
         FilePath
"Unknown/unsupported 'ghc' version detected "
      FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"(Cabal " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
cabalVersion FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" supports 'ghc' version < 9.6): "
      FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> FilePath
programPath ConfiguredProgram
ghcProg FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" is version " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
ghcVersion

  -- This is slightly tricky, we have to configure ghc first, then we use the
  -- location of ghc to help find ghc-pkg in the case that the user did not
  -- specify the location of ghc-pkg directly:
  (ConfiguredProgram
ghcPkgProg, Version
ghcPkgVersion, ProgramDb
progdb2) <-
    Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)
requireProgramVersion Verbosity
verbosity Program
ghcPkgProgram {
      programFindLocation :: Verbosity -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
programFindLocation = ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessGhcPkgFromGhcPath ConfiguredProgram
ghcProg
    }
    VersionRange
anyVersion (FilePath -> Maybe FilePath -> ProgramDb -> ProgramDb
userMaybeSpecifyPath FilePath
"ghc-pkg" Maybe FilePath
hcPkgPath ProgramDb
progdb1)

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version
ghcVersion Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
/= Version
ghcPkgVersion) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
       FilePath
"Version mismatch between ghc and ghc-pkg: "
    FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> FilePath
programPath ConfiguredProgram
ghcProg FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" is version " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
ghcVersion FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" "
    FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> FilePath
programPath ConfiguredProgram
ghcPkgProg FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" is version " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
ghcPkgVersion

  -- Likewise we try to find the matching hsc2hs and haddock programs.
  let hsc2hsProgram' :: Program
hsc2hsProgram' = Program
hsc2hsProgram {
                           programFindLocation :: Verbosity -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
programFindLocation = ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHsc2hsFromGhcPath ConfiguredProgram
ghcProg
                       }
      haddockProgram' :: Program
haddockProgram' = Program
haddockProgram {
                           programFindLocation :: Verbosity -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
programFindLocation = ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHaddockFromGhcPath ConfiguredProgram
ghcProg
                       }
      hpcProgram' :: Program
hpcProgram' = Program
hpcProgram {
                        programFindLocation :: Verbosity -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
programFindLocation = ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHpcFromGhcPath ConfiguredProgram
ghcProg
                    }
      runghcProgram' :: Program
runghcProgram' = Program
runghcProgram {
                        programFindLocation :: Verbosity -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
programFindLocation = ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessRunghcFromGhcPath ConfiguredProgram
ghcProg
                    }
      progdb3 :: ProgramDb
progdb3 = Program -> ProgramDb -> ProgramDb
addKnownProgram Program
haddockProgram' (ProgramDb -> ProgramDb) -> ProgramDb -> ProgramDb
forall a b. (a -> b) -> a -> b
$
              Program -> ProgramDb -> ProgramDb
addKnownProgram Program
hsc2hsProgram' (ProgramDb -> ProgramDb) -> ProgramDb -> ProgramDb
forall a b. (a -> b) -> a -> b
$
              Program -> ProgramDb -> ProgramDb
addKnownProgram Program
hpcProgram' (ProgramDb -> ProgramDb) -> ProgramDb -> ProgramDb
forall a b. (a -> b) -> a -> b
$
              Program -> ProgramDb -> ProgramDb
addKnownProgram Program
runghcProgram' ProgramDb
progdb2

  [(Language, FilePath)]
languages  <- Verbosity
-> GhcImplInfo -> ConfiguredProgram -> IO [(Language, FilePath)]
Internal.getLanguages Verbosity
verbosity GhcImplInfo
implInfo ConfiguredProgram
ghcProg
  [(Extension, Maybe FilePath)]
extensions0 <- Verbosity
-> GhcImplInfo
-> ConfiguredProgram
-> IO [(Extension, Maybe FilePath)]
Internal.getExtensions Verbosity
verbosity GhcImplInfo
implInfo ConfiguredProgram
ghcProg

  [(FilePath, FilePath)]
ghcInfo <- Verbosity
-> GhcImplInfo -> ConfiguredProgram -> IO [(FilePath, FilePath)]
Internal.getGhcInfo Verbosity
verbosity GhcImplInfo
implInfo ConfiguredProgram
ghcProg
  let ghcInfoMap :: Map FilePath FilePath
ghcInfoMap = [(FilePath, FilePath)] -> Map FilePath FilePath
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(FilePath, FilePath)]
ghcInfo
      extensions :: [(Extension, Maybe FilePath)]
extensions = -- workaround https://gitlab.haskell.org/ghc/ghc/-/issues/11214
                   KnownExtension
-> [(Extension, Maybe FilePath)] -> [(Extension, Maybe FilePath)]
forall b. KnownExtension -> [(Extension, b)] -> [(Extension, b)]
filterExt KnownExtension
JavaScriptFFI ([(Extension, Maybe FilePath)] -> [(Extension, Maybe FilePath)])
-> [(Extension, Maybe FilePath)] -> [(Extension, Maybe FilePath)]
forall a b. (a -> b) -> a -> b
$
                   -- see 'filterExtTH' comment below
                   [(Extension, Maybe FilePath)] -> [(Extension, Maybe FilePath)]
forall b. [(Extension, b)] -> [(Extension, b)]
filterExtTH ([(Extension, Maybe FilePath)] -> [(Extension, Maybe FilePath)])
-> [(Extension, Maybe FilePath)] -> [(Extension, Maybe FilePath)]
forall a b. (a -> b) -> a -> b
$ [(Extension, Maybe FilePath)]
extensions0

      -- starting with GHC 8.0, `TemplateHaskell` will be omitted from
      -- `--supported-extensions` when it's not available.
      -- for older GHCs we can use the "Have interpreter" property to
      -- filter out `TemplateHaskell`
      filterExtTH :: [(Extension, b)] -> [(Extension, b)]
filterExtTH | Version
ghcVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
8]
                   , Just FilePath
"NO" <- FilePath -> Map FilePath FilePath -> Maybe FilePath
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FilePath
"Have interpreter" Map FilePath FilePath
ghcInfoMap
                   = KnownExtension -> [(Extension, b)] -> [(Extension, b)]
forall b. KnownExtension -> [(Extension, b)] -> [(Extension, b)]
filterExt KnownExtension
TemplateHaskell
                  | Bool
otherwise = [(Extension, b)] -> [(Extension, b)]
forall a. a -> a
id

      filterExt :: KnownExtension -> [(Extension, b)] -> [(Extension, b)]
filterExt KnownExtension
ext = ((Extension, b) -> Bool) -> [(Extension, b)] -> [(Extension, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Extension -> Extension -> Bool
forall a. Eq a => a -> a -> Bool
/= KnownExtension -> Extension
EnableExtension KnownExtension
ext) (Extension -> Bool)
-> ((Extension, b) -> Extension) -> (Extension, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Extension, b) -> Extension
forall a b. (a, b) -> a
fst)

  let comp :: Compiler
comp = Compiler :: CompilerId
-> AbiTag
-> [CompilerId]
-> [(Language, FilePath)]
-> [(Extension, Maybe FilePath)]
-> Map FilePath FilePath
-> Compiler
Compiler {
        compilerId :: CompilerId
compilerId         = CompilerFlavor -> Version -> CompilerId
CompilerId CompilerFlavor
GHC Version
ghcVersion,
        compilerAbiTag :: AbiTag
compilerAbiTag     = AbiTag
NoAbiTag,
        compilerCompat :: [CompilerId]
compilerCompat     = [],
        compilerLanguages :: [(Language, FilePath)]
compilerLanguages  = [(Language, FilePath)]
languages,
        compilerExtensions :: [(Extension, Maybe FilePath)]
compilerExtensions = [(Extension, Maybe FilePath)]
extensions,
        compilerProperties :: Map FilePath FilePath
compilerProperties = Map FilePath FilePath
ghcInfoMap
      }
      compPlatform :: Maybe Platform
compPlatform = [(FilePath, FilePath)] -> Maybe Platform
Internal.targetPlatform [(FilePath, FilePath)]
ghcInfo
      -- configure gcc and ld
      progdb4 :: ProgramDb
progdb4 = GhcImplInfo
-> ConfiguredProgram
-> Map FilePath FilePath
-> ProgramDb
-> ProgramDb
Internal.configureToolchain GhcImplInfo
implInfo ConfiguredProgram
ghcProg Map FilePath FilePath
ghcInfoMap ProgramDb
progdb3
  (Compiler, Maybe Platform, ProgramDb)
-> IO (Compiler, Maybe Platform, ProgramDb)
forall (m :: * -> *) a. Monad m => a -> m a
return (Compiler
comp, Maybe Platform
compPlatform, ProgramDb
progdb4)

-- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find
-- the corresponding tool; e.g. if the tool is ghc-pkg, we try looking
-- for a versioned or unversioned ghc-pkg in the same dir, that is:
--
-- > /usr/local/bin/ghc-pkg-ghc-6.6.1(.exe)
-- > /usr/local/bin/ghc-pkg-6.6.1(.exe)
-- > /usr/local/bin/ghc-pkg(.exe)
--
guessToolFromGhcPath :: Program -> ConfiguredProgram
                     -> Verbosity -> ProgramSearchPath
                     -> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcPath :: Program
-> ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcPath Program
tool ConfiguredProgram
ghcProg Verbosity
verbosity ProgramSearchPath
searchpath
  = do let toolname :: FilePath
toolname          = Program -> FilePath
programName Program
tool
           given_path :: FilePath
given_path        = ConfiguredProgram -> FilePath
programPath ConfiguredProgram
ghcProg
           given_dir :: FilePath
given_dir         = FilePath -> FilePath
takeDirectory FilePath
given_path
       FilePath
real_path <- FilePath -> IO FilePath
canonicalizePath FilePath
given_path
       let real_dir :: FilePath
real_dir           = FilePath -> FilePath
takeDirectory FilePath
real_path
           versionSuffix :: FilePath -> FilePath
versionSuffix FilePath
path = FilePath -> FilePath
takeVersionSuffix (FilePath -> FilePath
dropExeExtension FilePath
path)
           given_suf :: FilePath
given_suf = FilePath -> FilePath
versionSuffix FilePath
given_path
           real_suf :: FilePath
real_suf  = FilePath -> FilePath
versionSuffix FilePath
real_path
           guessNormal :: FilePath -> FilePath
guessNormal       FilePath
dir = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
toolname FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
exeExtension Platform
buildPlatform
           guessGhcVersioned :: FilePath -> FilePath -> FilePath
guessGhcVersioned FilePath
dir FilePath
suf = FilePath
dir FilePath -> FilePath -> FilePath
</> (FilePath
toolname FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-ghc" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
suf)
                                           FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
exeExtension Platform
buildPlatform
           guessVersioned :: FilePath -> FilePath -> FilePath
guessVersioned    FilePath
dir FilePath
suf = FilePath
dir FilePath -> FilePath -> FilePath
</> (FilePath
toolname FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
suf)
                                           FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
exeExtension Platform
buildPlatform
           mkGuesses :: FilePath -> FilePath -> [FilePath]
mkGuesses FilePath
dir FilePath
suf | FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
suf  = [FilePath -> FilePath
guessNormal FilePath
dir]
                             | Bool
otherwise = [FilePath -> FilePath -> FilePath
guessGhcVersioned FilePath
dir FilePath
suf,
                                            FilePath -> FilePath -> FilePath
guessVersioned FilePath
dir FilePath
suf,
                                            FilePath -> FilePath
guessNormal FilePath
dir]
           -- order matters here, see https://github.com/haskell/cabal/issues/7390
           guesses :: [FilePath]
guesses = (if FilePath
real_path FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
given_path
                        then []
                        else FilePath -> FilePath -> [FilePath]
mkGuesses FilePath
real_dir FilePath
real_suf)
                     [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath -> [FilePath]
mkGuesses FilePath
given_dir FilePath
given_suf
       Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"looking for tool " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
toolname
         FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" near compiler in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
given_dir
       Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"candidate locations: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
forall a. Show a => a -> FilePath
show [FilePath]
guesses
       [Bool]
exists <- (FilePath -> IO Bool) -> [FilePath] -> IO [Bool]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> IO Bool
doesFileExist [FilePath]
guesses
       case [ FilePath
file | (FilePath
file, Bool
True) <- [FilePath] -> [Bool] -> [(FilePath, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
guesses [Bool]
exists ] of
                   -- If we can't find it near ghc, fall back to the usual
                   -- method.
         []     -> Program
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
programFindLocation Program
tool Verbosity
verbosity ProgramSearchPath
searchpath
         (FilePath
fp:[FilePath]
_) -> do Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"found " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
toolname FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
fp
                      let lookedAt :: [FilePath]
lookedAt = ((FilePath, Bool) -> FilePath) -> [(FilePath, Bool)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, Bool) -> FilePath
forall a b. (a, b) -> a
fst
                                   ([(FilePath, Bool)] -> [FilePath])
-> ([(FilePath, Bool)] -> [(FilePath, Bool)])
-> [(FilePath, Bool)]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath, Bool) -> Bool)
-> [(FilePath, Bool)] -> [(FilePath, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(FilePath
_file, Bool
exist) -> Bool -> Bool
not Bool
exist)
                                   ([(FilePath, Bool)] -> [FilePath])
-> [(FilePath, Bool)] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [Bool] -> [(FilePath, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
guesses [Bool]
exists
                      Maybe (FilePath, [FilePath]) -> IO (Maybe (FilePath, [FilePath]))
forall (m :: * -> *) a. Monad m => a -> m a
return ((FilePath, [FilePath]) -> Maybe (FilePath, [FilePath])
forall a. a -> Maybe a
Just (FilePath
fp, [FilePath]
lookedAt))

  where takeVersionSuffix :: FilePath -> String
        takeVersionSuffix :: FilePath -> FilePath
takeVersionSuffix = (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhileEndLE Char -> Bool
isSuffixChar

        isSuffixChar :: Char -> Bool
        isSuffixChar :: Char -> Bool
isSuffixChar Char
c = Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'

-- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
-- corresponding ghc-pkg, we try looking for both a versioned and unversioned
-- ghc-pkg in the same dir, that is:
--
-- > /usr/local/bin/ghc-pkg-ghc-6.6.1(.exe)
-- > /usr/local/bin/ghc-pkg-6.6.1(.exe)
-- > /usr/local/bin/ghc-pkg(.exe)
--
guessGhcPkgFromGhcPath :: ConfiguredProgram
                       -> Verbosity -> ProgramSearchPath
                       -> IO (Maybe (FilePath, [FilePath]))
guessGhcPkgFromGhcPath :: ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessGhcPkgFromGhcPath = Program
-> ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcPath Program
ghcPkgProgram

-- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
-- corresponding hsc2hs, we try looking for both a versioned and unversioned
-- hsc2hs in the same dir, that is:
--
-- > /usr/local/bin/hsc2hs-ghc-6.6.1(.exe)
-- > /usr/local/bin/hsc2hs-6.6.1(.exe)
-- > /usr/local/bin/hsc2hs(.exe)
--
guessHsc2hsFromGhcPath :: ConfiguredProgram
                       -> Verbosity -> ProgramSearchPath
                       -> IO (Maybe (FilePath, [FilePath]))
guessHsc2hsFromGhcPath :: ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHsc2hsFromGhcPath = Program
-> ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcPath Program
hsc2hsProgram

-- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
-- corresponding haddock, we try looking for both a versioned and unversioned
-- haddock in the same dir, that is:
--
-- > /usr/local/bin/haddock-ghc-6.6.1(.exe)
-- > /usr/local/bin/haddock-6.6.1(.exe)
-- > /usr/local/bin/haddock(.exe)
--
guessHaddockFromGhcPath :: ConfiguredProgram
                       -> Verbosity -> ProgramSearchPath
                       -> IO (Maybe (FilePath, [FilePath]))
guessHaddockFromGhcPath :: ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHaddockFromGhcPath = Program
-> ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcPath Program
haddockProgram

guessHpcFromGhcPath :: ConfiguredProgram
                       -> Verbosity -> ProgramSearchPath
                       -> IO (Maybe (FilePath, [FilePath]))
guessHpcFromGhcPath :: ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHpcFromGhcPath = Program
-> ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcPath Program
hpcProgram

guessRunghcFromGhcPath :: ConfiguredProgram
                       -> Verbosity -> ProgramSearchPath
                       -> IO (Maybe (FilePath, [FilePath]))
guessRunghcFromGhcPath :: ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessRunghcFromGhcPath = Program
-> ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcPath Program
runghcProgram


getGhcInfo :: Verbosity -> ConfiguredProgram -> IO [(String, String)]
getGhcInfo :: Verbosity -> ConfiguredProgram -> IO [(FilePath, FilePath)]
getGhcInfo Verbosity
verbosity ConfiguredProgram
ghcProg = Verbosity
-> GhcImplInfo -> ConfiguredProgram -> IO [(FilePath, FilePath)]
Internal.getGhcInfo Verbosity
verbosity GhcImplInfo
implInfo ConfiguredProgram
ghcProg
  where
    version :: Version
version = Version -> Maybe Version -> Version
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> Version
forall a. HasCallStack => FilePath -> a
error FilePath
"GHC.getGhcInfo: no ghc version") (Maybe Version -> Version) -> Maybe Version -> Version
forall a b. (a -> b) -> a -> b
$ ConfiguredProgram -> Maybe Version
programVersion ConfiguredProgram
ghcProg
    implInfo :: GhcImplInfo
implInfo = Version -> GhcImplInfo
ghcVersionImplInfo Version
version

-- | Given a single package DB, return all installed packages.
getPackageDBContents :: Verbosity -> PackageDB -> ProgramDb
                        -> IO InstalledPackageIndex
getPackageDBContents :: Verbosity -> PackageDB -> ProgramDb -> IO InstalledPackageIndex
getPackageDBContents Verbosity
verbosity PackageDB
packagedb ProgramDb
progdb = do
  [(PackageDB, [InstalledPackageInfo])]
pkgss <- Verbosity
-> [PackageDB]
-> ProgramDb
-> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' Verbosity
verbosity [PackageDB
packagedb] ProgramDb
progdb
  Verbosity
-> [(PackageDB, [InstalledPackageInfo])]
-> ProgramDb
-> IO InstalledPackageIndex
toPackageIndex Verbosity
verbosity [(PackageDB, [InstalledPackageInfo])]
pkgss ProgramDb
progdb

-- | Given a package DB stack, return all installed packages.
getInstalledPackages :: Verbosity -> Compiler -> PackageDBStack
                     -> ProgramDb
                     -> IO InstalledPackageIndex
getInstalledPackages :: Verbosity
-> Compiler -> [PackageDB] -> ProgramDb -> IO InstalledPackageIndex
getInstalledPackages Verbosity
verbosity Compiler
comp [PackageDB]
packagedbs ProgramDb
progdb = do
  Verbosity -> IO ()
checkPackageDbEnvVar Verbosity
verbosity
  Verbosity -> Compiler -> [PackageDB] -> IO ()
checkPackageDbStack Verbosity
verbosity Compiler
comp [PackageDB]
packagedbs
  [(PackageDB, [InstalledPackageInfo])]
pkgss <- Verbosity
-> [PackageDB]
-> ProgramDb
-> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' Verbosity
verbosity [PackageDB]
packagedbs ProgramDb
progdb
  InstalledPackageIndex
index <- Verbosity
-> [(PackageDB, [InstalledPackageInfo])]
-> ProgramDb
-> IO InstalledPackageIndex
toPackageIndex Verbosity
verbosity [(PackageDB, [InstalledPackageInfo])]
pkgss ProgramDb
progdb
  InstalledPackageIndex -> IO InstalledPackageIndex
forall (m :: * -> *) a. Monad m => a -> m a
return (InstalledPackageIndex -> IO InstalledPackageIndex)
-> InstalledPackageIndex -> IO InstalledPackageIndex
forall a b. (a -> b) -> a -> b
$! InstalledPackageIndex -> InstalledPackageIndex
hackRtsPackage InstalledPackageIndex
index

  where
    hackRtsPackage :: InstalledPackageIndex -> InstalledPackageIndex
hackRtsPackage InstalledPackageIndex
index =
      case InstalledPackageIndex
-> PackageName -> [(Version, [InstalledPackageInfo])]
forall a. PackageIndex a -> PackageName -> [(Version, [a])]
PackageIndex.lookupPackageName InstalledPackageIndex
index (FilePath -> PackageName
mkPackageName FilePath
"rts") of
        [(Version
_,[InstalledPackageInfo
rts])]
           -> InstalledPackageInfo
-> InstalledPackageIndex -> InstalledPackageIndex
PackageIndex.insert (InstalledPackageInfo -> InstalledPackageInfo
removeMingwIncludeDir InstalledPackageInfo
rts) InstalledPackageIndex
index
        [(Version, [InstalledPackageInfo])]
_  -> InstalledPackageIndex
index -- No (or multiple) ghc rts package is registered!!
                    -- Feh, whatever, the ghc test suite does some crazy stuff.

-- | Given a list of @(PackageDB, InstalledPackageInfo)@ pairs, produce a
-- @PackageIndex@. Helper function used by 'getPackageDBContents' and
-- 'getInstalledPackages'.
toPackageIndex :: Verbosity
               -> [(PackageDB, [InstalledPackageInfo])]
               -> ProgramDb
               -> IO InstalledPackageIndex
toPackageIndex :: Verbosity
-> [(PackageDB, [InstalledPackageInfo])]
-> ProgramDb
-> IO InstalledPackageIndex
toPackageIndex Verbosity
verbosity [(PackageDB, [InstalledPackageInfo])]
pkgss ProgramDb
progdb = do
  -- On Windows, various fields have $topdir/foo rather than full
  -- paths. We need to substitute the right value in so that when
  -- we, for example, call gcc, we have proper paths to give it.
  FilePath
topDir <- Verbosity -> ConfiguredProgram -> IO FilePath
getLibDir' Verbosity
verbosity ConfiguredProgram
ghcProg
  let indices :: [InstalledPackageIndex]
indices = [ [InstalledPackageInfo] -> InstalledPackageIndex
PackageIndex.fromList ((InstalledPackageInfo -> InstalledPackageInfo)
-> [InstalledPackageInfo] -> [InstalledPackageInfo]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> InstalledPackageInfo -> InstalledPackageInfo
Internal.substTopDir FilePath
topDir) [InstalledPackageInfo]
pkgs)
                | (PackageDB
_, [InstalledPackageInfo]
pkgs) <- [(PackageDB, [InstalledPackageInfo])]
pkgss ]
  InstalledPackageIndex -> IO InstalledPackageIndex
forall (m :: * -> *) a. Monad m => a -> m a
return (InstalledPackageIndex -> IO InstalledPackageIndex)
-> InstalledPackageIndex -> IO InstalledPackageIndex
forall a b. (a -> b) -> a -> b
$! [InstalledPackageIndex] -> InstalledPackageIndex
forall a. Monoid a => [a] -> a
mconcat [InstalledPackageIndex]
indices

  where
    ghcProg :: ConfiguredProgram
ghcProg = ConfiguredProgram -> Maybe ConfiguredProgram -> ConfiguredProgram
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> ConfiguredProgram
forall a. HasCallStack => FilePath -> a
error FilePath
"GHC.toPackageIndex: no ghc program") (Maybe ConfiguredProgram -> ConfiguredProgram)
-> Maybe ConfiguredProgram -> ConfiguredProgram
forall a b. (a -> b) -> a -> b
$ Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
ghcProgram ProgramDb
progdb

-- | Return the 'FilePath' to the GHC application data directory.
--
-- @since 3.4.0.0
getGhcAppDir :: IO FilePath
getGhcAppDir :: IO FilePath
getGhcAppDir = FilePath -> IO FilePath
getAppUserDataDirectory FilePath
"ghc"

getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath
getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath
getLibDir Verbosity
verbosity LocalBuildInfo
lbi =
    (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEndLE Char -> Bool
isSpace (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
     Verbosity -> Program -> ProgramDb -> [FilePath] -> IO FilePath
getDbProgramOutput Verbosity
verbosity Program
ghcProgram
     (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi) [FilePath
"--print-libdir"]

getLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath
getLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath
getLibDir' Verbosity
verbosity ConfiguredProgram
ghcProg =
    (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEndLE Char -> Bool
isSpace (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
     Verbosity -> ConfiguredProgram -> [FilePath] -> IO FilePath
getProgramOutput Verbosity
verbosity ConfiguredProgram
ghcProg [FilePath
"--print-libdir"]


-- | Return the 'FilePath' to the global GHC package database.
getGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath
getGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath
getGlobalPackageDB Verbosity
verbosity ConfiguredProgram
ghcProg =
    (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEndLE Char -> Bool
isSpace (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
     Verbosity -> ConfiguredProgram -> [FilePath] -> IO FilePath
getProgramOutput Verbosity
verbosity ConfiguredProgram
ghcProg [FilePath
"--print-global-package-db"]

-- | Return the 'FilePath' to the per-user GHC package database.
getUserPackageDB
  :: Verbosity -> ConfiguredProgram -> Platform -> IO FilePath
getUserPackageDB :: Verbosity -> ConfiguredProgram -> Platform -> IO FilePath
getUserPackageDB Verbosity
_verbosity ConfiguredProgram
ghcProg Platform
platform = do
    -- It's rather annoying that we have to reconstruct this, because ghc
    -- hides this information from us otherwise. But for certain use cases
    -- like change monitoring it really can't remain hidden.
    FilePath
appdir <- IO FilePath
getGhcAppDir
    FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
appdir FilePath -> FilePath -> FilePath
</> FilePath
platformAndVersion FilePath -> FilePath -> FilePath
</> FilePath
packageConfFileName)
  where
    platformAndVersion :: FilePath
platformAndVersion = Platform -> Version -> FilePath
Internal.ghcPlatformAndVersionString
                           Platform
platform Version
ghcVersion
    packageConfFileName :: FilePath
packageConfFileName = FilePath
"package.conf.d"
    ghcVersion :: Version
ghcVersion = Version -> Maybe Version -> Version
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> Version
forall a. HasCallStack => FilePath -> a
error FilePath
"GHC.getUserPackageDB: no ghc version") (Maybe Version -> Version) -> Maybe Version -> Version
forall a b. (a -> b) -> a -> b
$ ConfiguredProgram -> Maybe Version
programVersion ConfiguredProgram
ghcProg

checkPackageDbEnvVar :: Verbosity -> IO ()
checkPackageDbEnvVar :: Verbosity -> IO ()
checkPackageDbEnvVar Verbosity
verbosity =
    Verbosity -> FilePath -> FilePath -> IO ()
Internal.checkPackageDbEnvVar Verbosity
verbosity FilePath
"GHC" FilePath
"GHC_PACKAGE_PATH"

checkPackageDbStack :: Verbosity -> Compiler -> PackageDBStack -> IO ()
checkPackageDbStack :: Verbosity -> Compiler -> [PackageDB] -> IO ()
checkPackageDbStack Verbosity
verbosity Compiler
comp =
    if GhcImplInfo -> Bool
flagPackageConf GhcImplInfo
implInfo
      then Verbosity -> [PackageDB] -> IO ()
checkPackageDbStackPre76 Verbosity
verbosity
      else Verbosity -> [PackageDB] -> IO ()
checkPackageDbStackPost76 Verbosity
verbosity
  where implInfo :: GhcImplInfo
implInfo = Version -> GhcImplInfo
ghcVersionImplInfo (Compiler -> Version
compilerVersion Compiler
comp)

checkPackageDbStackPost76 :: Verbosity -> PackageDBStack -> IO ()
checkPackageDbStackPost76 :: Verbosity -> [PackageDB] -> IO ()
checkPackageDbStackPost76 Verbosity
_ (PackageDB
GlobalPackageDB:[PackageDB]
rest)
  | PackageDB
GlobalPackageDB PackageDB -> [PackageDB] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [PackageDB]
rest = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkPackageDbStackPost76 Verbosity
verbosity [PackageDB]
rest
  | PackageDB
GlobalPackageDB PackageDB -> [PackageDB] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PackageDB]
rest =
  Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"If the global package db is specified, it must be "
     FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"specified first and cannot be specified multiple times"
checkPackageDbStackPost76 Verbosity
_ [PackageDB]
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

checkPackageDbStackPre76 :: Verbosity -> PackageDBStack -> IO ()
checkPackageDbStackPre76 :: Verbosity -> [PackageDB] -> IO ()
checkPackageDbStackPre76 Verbosity
_ (PackageDB
GlobalPackageDB:[PackageDB]
rest)
  | PackageDB
GlobalPackageDB PackageDB -> [PackageDB] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [PackageDB]
rest = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkPackageDbStackPre76 Verbosity
verbosity [PackageDB]
rest
  | PackageDB
GlobalPackageDB PackageDB -> [PackageDB] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [PackageDB]
rest =
  Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
        FilePath
"With current ghc versions the global package db is always used "
     FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"and must be listed first. This ghc limitation is lifted in GHC 7.6,"
     FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"see https://gitlab.haskell.org/ghc/ghc/-/issues/5977"
checkPackageDbStackPre76 Verbosity
verbosity [PackageDB]
_ =
  Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"If the global package db is specified, it must be "
     FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"specified first and cannot be specified multiple times"

-- GHC < 6.10 put "$topdir/include/mingw" in rts's installDirs. This
-- breaks when you want to use a different gcc, so we need to filter
-- it out.
removeMingwIncludeDir :: InstalledPackageInfo -> InstalledPackageInfo
removeMingwIncludeDir :: InstalledPackageInfo -> InstalledPackageInfo
removeMingwIncludeDir InstalledPackageInfo
pkg =
    let ids :: [FilePath]
ids = InstalledPackageInfo -> [FilePath]
InstalledPackageInfo.includeDirs InstalledPackageInfo
pkg
        ids' :: [FilePath]
ids' = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
"mingw" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`)) [FilePath]
ids
    in InstalledPackageInfo
pkg { includeDirs :: [FilePath]
InstalledPackageInfo.includeDirs = [FilePath]
ids' }

-- | Get the packages from specific PackageDBs, not cumulative.
--
getInstalledPackages' :: Verbosity -> [PackageDB] -> ProgramDb
                     -> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' :: Verbosity
-> [PackageDB]
-> ProgramDb
-> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' Verbosity
verbosity [PackageDB]
packagedbs ProgramDb
progdb =
  [IO (PackageDB, [InstalledPackageInfo])]
-> IO [(PackageDB, [InstalledPackageInfo])]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
    [ do [InstalledPackageInfo]
pkgs <- HcPkgInfo -> Verbosity -> PackageDB -> IO [InstalledPackageInfo]
HcPkg.dump (ProgramDb -> HcPkgInfo
hcPkgInfo ProgramDb
progdb) Verbosity
verbosity PackageDB
packagedb
         (PackageDB, [InstalledPackageInfo])
-> IO (PackageDB, [InstalledPackageInfo])
forall (m :: * -> *) a. Monad m => a -> m a
return (PackageDB
packagedb, [InstalledPackageInfo]
pkgs)
    | PackageDB
packagedb <- [PackageDB]
packagedbs ]

getInstalledPackagesMonitorFiles :: Verbosity -> Platform
                                 -> ProgramDb
                                 -> [PackageDB]
                                 -> IO [FilePath]
getInstalledPackagesMonitorFiles :: Verbosity -> Platform -> ProgramDb -> [PackageDB] -> IO [FilePath]
getInstalledPackagesMonitorFiles Verbosity
verbosity Platform
platform ProgramDb
progdb =
    (PackageDB -> IO FilePath) -> [PackageDB] -> IO [FilePath]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse PackageDB -> IO FilePath
getPackageDBPath
  where
    getPackageDBPath :: PackageDB -> IO FilePath
    getPackageDBPath :: PackageDB -> IO FilePath
getPackageDBPath PackageDB
GlobalPackageDB =
      FilePath -> IO FilePath
selectMonitorFile (FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Verbosity -> ConfiguredProgram -> IO FilePath
getGlobalPackageDB Verbosity
verbosity ConfiguredProgram
ghcProg

    getPackageDBPath PackageDB
UserPackageDB =
      FilePath -> IO FilePath
selectMonitorFile (FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Verbosity -> ConfiguredProgram -> Platform -> IO FilePath
getUserPackageDB Verbosity
verbosity ConfiguredProgram
ghcProg Platform
platform

    getPackageDBPath (SpecificPackageDB FilePath
path) = FilePath -> IO FilePath
selectMonitorFile FilePath
path

    -- GHC has old style file dbs, and new style directory dbs.
    -- Note that for dir style dbs, we only need to monitor the cache file, not
    -- the whole directory. The ghc program itself only reads the cache file
    -- so it's safe to only monitor this one file.
    selectMonitorFile :: FilePath -> IO FilePath
selectMonitorFile FilePath
path = do
      Bool
isFileStyle <- FilePath -> IO Bool
doesFileExist FilePath
path
      if Bool
isFileStyle then FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path
                     else FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
"package.cache")

    ghcProg :: ConfiguredProgram
ghcProg = ConfiguredProgram -> Maybe ConfiguredProgram -> ConfiguredProgram
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> ConfiguredProgram
forall a. HasCallStack => FilePath -> a
error FilePath
"GHC.toPackageIndex: no ghc program") (Maybe ConfiguredProgram -> ConfiguredProgram)
-> Maybe ConfiguredProgram -> ConfiguredProgram
forall a b. (a -> b) -> a -> b
$ Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
ghcProgram ProgramDb
progdb


-- -----------------------------------------------------------------------------
-- Building a library

buildLib :: Verbosity          -> Cabal.Flag (Maybe Int)
         -> PackageDescription -> LocalBuildInfo
         -> Library            -> ComponentLocalBuildInfo -> IO ()
buildLib :: Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildLib = Maybe ReplOptions
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildOrReplLib Maybe ReplOptions
forall a. Maybe a
Nothing

replLib :: ReplOptions             -> Verbosity
        -> Cabal.Flag (Maybe Int)  -> PackageDescription
        -> LocalBuildInfo          -> Library
        -> ComponentLocalBuildInfo -> IO ()
replLib :: ReplOptions
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
replLib = Maybe ReplOptions
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildOrReplLib (Maybe ReplOptions
 -> Verbosity
 -> Flag (Maybe Int)
 -> PackageDescription
 -> LocalBuildInfo
 -> Library
 -> ComponentLocalBuildInfo
 -> IO ())
-> (ReplOptions -> Maybe ReplOptions)
-> ReplOptions
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReplOptions -> Maybe ReplOptions
forall a. a -> Maybe a
Just

buildOrReplLib :: Maybe ReplOptions -> Verbosity
               -> Cabal.Flag (Maybe Int) -> PackageDescription
               -> LocalBuildInfo -> Library
               -> ComponentLocalBuildInfo -> IO ()
buildOrReplLib :: Maybe ReplOptions
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildOrReplLib Maybe ReplOptions
mReplFlags Verbosity
verbosity Flag (Maybe Int)
numJobs PackageDescription
pkg_descr LocalBuildInfo
lbi Library
lib ComponentLocalBuildInfo
clbi = do
  let uid :: UnitId
uid = ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi
      libTargetDir :: FilePath
libTargetDir = LocalBuildInfo -> ComponentLocalBuildInfo -> FilePath
componentBuildDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
      whenVanillaLib :: Bool -> f () -> f ()
whenVanillaLib Bool
forceVanilla =
        Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
forceVanilla Bool -> Bool -> Bool
|| LocalBuildInfo -> Bool
withVanillaLib LocalBuildInfo
lbi)
      whenProfLib :: IO () -> IO ()
whenProfLib = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LocalBuildInfo -> Bool
withProfLib LocalBuildInfo
lbi)
      whenSharedLib :: Bool -> f () -> f ()
whenSharedLib Bool
forceShared =
        Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
forceShared Bool -> Bool -> Bool
|| LocalBuildInfo -> Bool
withSharedLib LocalBuildInfo
lbi)
      whenStaticLib :: Bool -> f () -> f ()
whenStaticLib Bool
forceStatic =
        Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
forceStatic Bool -> Bool -> Bool
|| LocalBuildInfo -> Bool
withStaticLib LocalBuildInfo
lbi)
      whenGHCiLib :: IO () -> IO ()
whenGHCiLib = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LocalBuildInfo -> Bool
withGHCiLib LocalBuildInfo
lbi)
      forRepl :: Bool
forRepl = Bool -> (ReplOptions -> Bool) -> Maybe ReplOptions -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Bool -> ReplOptions -> Bool
forall a b. a -> b -> a
const Bool
True) Maybe ReplOptions
mReplFlags
      whenReplLib :: IO () -> IO ()
whenReplLib = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
forRepl
      replFlags :: ReplOptions
replFlags = ReplOptions -> Maybe ReplOptions -> ReplOptions
forall a. a -> Maybe a -> a
fromMaybe ReplOptions
forall a. Monoid a => a
mempty Maybe ReplOptions
mReplFlags
      comp :: Compiler
comp = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
      ghcVersion :: Version
ghcVersion = Compiler -> Version
compilerVersion Compiler
comp
      implInfo :: GhcImplInfo
implInfo  = Compiler -> GhcImplInfo
getImplInfo Compiler
comp
      platform :: Platform
platform@(Platform Arch
_hostArch OS
hostOS) = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
      has_code :: Bool
has_code = Bool -> Bool
not (ComponentLocalBuildInfo -> Bool
componentIsIndefinite ComponentLocalBuildInfo
clbi)

  FilePath
relLibTargetDir <- FilePath -> IO FilePath
makeRelativeToCurrentDirectory FilePath
libTargetDir

  (ConfiguredProgram
ghcProg, ProgramDb
_) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
ghcProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
  let runGhcProg :: GhcOptions -> IO ()
runGhcProg = Verbosity
-> ConfiguredProgram -> Compiler -> Platform -> GhcOptions -> IO ()
runGHC Verbosity
verbosity ConfiguredProgram
ghcProg Compiler
comp Platform
platform

  let libBi :: BuildInfo
libBi = Library -> BuildInfo
libBuildInfo Library
lib

  let isGhcDynamic :: Bool
isGhcDynamic        = Compiler -> Bool
isDynamic Compiler
comp
      dynamicTooSupported :: Bool
dynamicTooSupported = Compiler -> Bool
supportsDynamicToo Compiler
comp
      doingTH :: Bool
doingTH = BuildInfo -> Bool
usesTemplateHaskellOrQQ BuildInfo
libBi
      forceVanillaLib :: Bool
forceVanillaLib = Bool
doingTH Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isGhcDynamic
      forceSharedLib :: Bool
forceSharedLib  = Bool
doingTH Bool -> Bool -> Bool
&&     Bool
isGhcDynamic
      -- TH always needs default libs, even when building for profiling

  -- Determine if program coverage should be enabled and if so, what
  -- '-hpcdir' should be.
  let isCoverageEnabled :: Bool
isCoverageEnabled = LocalBuildInfo -> Bool
libCoverage LocalBuildInfo
lbi
      -- TODO: Historically HPC files have been put into a directory which
      -- has the package name.  I'm going to avoid changing this for
      -- now, but it would probably be better for this to be the
      -- component ID instead...
      pkg_name :: FilePath
pkg_name = PackageIdentifier -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (PackageDescription -> PackageIdentifier
PD.package PackageDescription
pkg_descr)
      distPref :: FilePath
distPref = Flag FilePath -> FilePath
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag FilePath -> FilePath) -> Flag FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag FilePath
configDistPref (ConfigFlags -> Flag FilePath) -> ConfigFlags -> Flag FilePath
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> ConfigFlags
configFlags LocalBuildInfo
lbi
      hpcdir :: Way -> Flag FilePath
hpcdir Way
way
        | Bool
forRepl = Flag FilePath
forall a. Monoid a => a
mempty  -- HPC is not supported in ghci
        | Bool
isCoverageEnabled = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag (FilePath -> Flag FilePath) -> FilePath -> Flag FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Way -> FilePath -> FilePath
Hpc.mixDir FilePath
distPref Way
way FilePath
pkg_name
        | Bool
otherwise = Flag FilePath
forall a. Monoid a => a
mempty

  Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
libTargetDir
  -- TODO: do we need to put hs-boot files into place for mutually recursive
  -- modules?
  let cLikeSources :: [FilePath]
cLikeSources  = NubListR FilePath -> [FilePath]
forall a. NubListR a -> [a]
fromNubListR (NubListR FilePath -> [FilePath])
-> NubListR FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [NubListR FilePath] -> NubListR FilePath
forall a. Monoid a => [a] -> a
mconcat
                      [ [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR (BuildInfo -> [FilePath]
cSources   BuildInfo
libBi)
                      , [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR (BuildInfo -> [FilePath]
cxxSources BuildInfo
libBi)
                      , [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR (BuildInfo -> [FilePath]
cmmSources BuildInfo
libBi)
                      , [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR (BuildInfo -> [FilePath]
asmSources BuildInfo
libBi)
                      ]
      cLikeObjs :: [FilePath]
cLikeObjs   = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
`replaceExtension` FilePath
objExtension) [FilePath]
cLikeSources
      baseOpts :: GhcOptions
baseOpts    = Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> GhcOptions
componentGhcOptions Verbosity
verbosity LocalBuildInfo
lbi BuildInfo
libBi ComponentLocalBuildInfo
clbi FilePath
libTargetDir
      vanillaOpts :: GhcOptions
vanillaOpts = GhcOptions
baseOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                      ghcOptMode :: Flag GhcMode
ghcOptMode         = GhcMode -> Flag GhcMode
forall a. a -> Flag a
toFlag GhcMode
GhcModeMake,
                      ghcOptNumJobs :: Flag (Maybe Int)
ghcOptNumJobs      = Flag (Maybe Int)
numJobs,
                      ghcOptInputModules :: NubListR ModuleName
ghcOptInputModules = [ModuleName] -> NubListR ModuleName
forall a. Ord a => [a] -> NubListR a
toNubListR ([ModuleName] -> NubListR ModuleName)
-> [ModuleName] -> NubListR ModuleName
forall a b. (a -> b) -> a -> b
$ Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi,
                      ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir       = Way -> Flag FilePath
hpcdir Way
Hpc.Vanilla
                    }

      profOpts :: GhcOptions
profOpts    = GhcOptions
vanillaOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                      ghcOptProfilingMode :: Flag Bool
ghcOptProfilingMode = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                      ghcOptProfilingAuto :: Flag GhcProfAuto
ghcOptProfilingAuto = Bool -> ProfDetailLevel -> Flag GhcProfAuto
Internal.profDetailLevelFlag Bool
True
                                              (LocalBuildInfo -> ProfDetailLevel
withProfLibDetail LocalBuildInfo
lbi),
                      ghcOptHiSuffix :: Flag FilePath
ghcOptHiSuffix      = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"p_hi",
                      ghcOptObjSuffix :: Flag FilePath
ghcOptObjSuffix     = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"p_o",
                      ghcOptExtra :: [FilePath]
ghcOptExtra         = CompilerFlavor -> BuildInfo -> [FilePath]
hcProfOptions CompilerFlavor
GHC BuildInfo
libBi,
                      ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir        = Way -> Flag FilePath
hpcdir Way
Hpc.Prof
                    }

      sharedOpts :: GhcOptions
sharedOpts  = GhcOptions
vanillaOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                      ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcDynamicOnly,
                      ghcOptFPic :: Flag Bool
ghcOptFPic        = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                      ghcOptHiSuffix :: Flag FilePath
ghcOptHiSuffix    = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"dyn_hi",
                      ghcOptObjSuffix :: Flag FilePath
ghcOptObjSuffix   = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"dyn_o",
                      ghcOptExtra :: [FilePath]
ghcOptExtra       = CompilerFlavor -> BuildInfo -> [FilePath]
hcSharedOptions CompilerFlavor
GHC BuildInfo
libBi,
                      ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir      = Way -> Flag FilePath
hpcdir Way
Hpc.Dyn
                    }
      linkerOpts :: GhcOptions
linkerOpts = GhcOptions
forall a. Monoid a => a
mempty {
                      ghcOptLinkOptions :: [FilePath]
ghcOptLinkOptions       = BuildInfo -> [FilePath]
PD.ldOptions BuildInfo
libBi
                                                [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [ FilePath
"-static"
                                                   | LocalBuildInfo -> Bool
withFullyStaticExe LocalBuildInfo
lbi ]
                                                -- Pass extra `ld-options` given
                                                -- through to GHC's linker.
                                                [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
-> (ConfiguredProgram -> [FilePath])
-> Maybe ConfiguredProgram
-> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ConfiguredProgram -> [FilePath]
programOverrideArgs
                                                     (Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
ldProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)),
                      ghcOptLinkLibs :: [FilePath]
ghcOptLinkLibs          = if LocalBuildInfo -> Bool
withFullyStaticExe LocalBuildInfo
lbi
                                                  then BuildInfo -> [FilePath]
extraLibsStatic BuildInfo
libBi
                                                  else BuildInfo -> [FilePath]
extraLibs BuildInfo
libBi,
                      ghcOptLinkLibPath :: NubListR FilePath
ghcOptLinkLibPath       = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$
                                                  if LocalBuildInfo -> Bool
withFullyStaticExe LocalBuildInfo
lbi
                                                    then BuildInfo -> [FilePath]
extraLibDirsStatic BuildInfo
libBi
                                                    else BuildInfo -> [FilePath]
extraLibDirs BuildInfo
libBi,
                      ghcOptLinkFrameworks :: NubListR FilePath
ghcOptLinkFrameworks    = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [FilePath]
PD.frameworks BuildInfo
libBi,
                      ghcOptLinkFrameworkDirs :: NubListR FilePath
ghcOptLinkFrameworkDirs = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$
                                                BuildInfo -> [FilePath]
PD.extraFrameworkDirs BuildInfo
libBi,
                      ghcOptInputFiles :: NubListR FilePath
ghcOptInputFiles     = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR
                                             [FilePath
relLibTargetDir FilePath -> FilePath -> FilePath
</> FilePath
x | FilePath
x <- [FilePath]
cLikeObjs]
                   }
      replOpts :: GhcOptions
replOpts    = GhcOptions
vanillaOpts {
                      ghcOptExtra :: [FilePath]
ghcOptExtra        = [FilePath] -> [FilePath]
Internal.filterGhciFlags
                                           (GhcOptions -> [FilePath]
ghcOptExtra GhcOptions
vanillaOpts)
                                           [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> ReplOptions -> [FilePath]
replOptionsFlags ReplOptions
replFlags,
                      ghcOptNumJobs :: Flag (Maybe Int)
ghcOptNumJobs      = Flag (Maybe Int)
forall a. Monoid a => a
mempty,
                      ghcOptInputModules :: NubListR ModuleName
ghcOptInputModules = ReplOptions -> NubListR ModuleName -> NubListR ModuleName
forall a. Ord a => ReplOptions -> NubListR a -> NubListR a
replNoLoad ReplOptions
replFlags (GhcOptions -> NubListR ModuleName
ghcOptInputModules GhcOptions
vanillaOpts)
                    }
                    GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
linkerOpts
                    GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                      ghcOptMode :: Flag GhcMode
ghcOptMode         = GhcMode -> Flag GhcMode
forall a. a -> Flag a
toFlag GhcMode
GhcModeInteractive,
                      ghcOptOptimisation :: Flag GhcOptimisation
ghcOptOptimisation = GhcOptimisation -> Flag GhcOptimisation
forall a. a -> Flag a
toFlag GhcOptimisation
GhcNoOptimisation
                    }

      vanillaSharedOpts :: GhcOptions
vanillaSharedOpts = GhcOptions
vanillaOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                      ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode  = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcStaticAndDynamic,
                      ghcOptDynHiSuffix :: Flag FilePath
ghcOptDynHiSuffix  = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"dyn_hi",
                      ghcOptDynObjSuffix :: Flag FilePath
ghcOptDynObjSuffix = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"dyn_o",
                      ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir       = Way -> Flag FilePath
hpcdir Way
Hpc.Dyn
                    }

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
forRepl Bool -> Bool -> Bool
|| [ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    do let vanilla :: IO ()
vanilla = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenVanillaLib Bool
forceVanillaLib (GhcOptions -> IO ()
runGhcProg GhcOptions
vanillaOpts)
           shared :: IO ()
shared  = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenSharedLib  Bool
forceSharedLib  (GhcOptions -> IO ()
runGhcProg GhcOptions
sharedOpts)
           useDynToo :: Bool
useDynToo = Bool
dynamicTooSupported Bool -> Bool -> Bool
&&
                       (Bool
forceVanillaLib Bool -> Bool -> Bool
|| LocalBuildInfo -> Bool
withVanillaLib LocalBuildInfo
lbi) Bool -> Bool -> Bool
&&
                       (Bool
forceSharedLib  Bool -> Bool -> Bool
|| LocalBuildInfo -> Bool
withSharedLib  LocalBuildInfo
lbi) Bool -> Bool -> Bool
&&
                       [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CompilerFlavor -> BuildInfo -> [FilePath]
hcSharedOptions CompilerFlavor
GHC BuildInfo
libBi)
       if Bool -> Bool
not Bool
has_code
        then IO ()
vanilla
        else
         if Bool
useDynToo
          then do
              GhcOptions -> IO ()
runGhcProg GhcOptions
vanillaSharedOpts
              case (Way -> Flag FilePath
hpcdir Way
Hpc.Dyn, Way -> Flag FilePath
hpcdir Way
Hpc.Vanilla) of
                (Cabal.Flag FilePath
dynDir, Cabal.Flag FilePath
vanillaDir) ->
                    -- When the vanilla and shared library builds are done
                    -- in one pass, only one set of HPC module interfaces
                    -- are generated. This set should suffice for both
                    -- static and dynamically linked executables. We copy
                    -- the modules interfaces so they are available under
                    -- both ways.
                    Verbosity -> FilePath -> FilePath -> IO ()
copyDirectoryRecursive Verbosity
verbosity FilePath
dynDir FilePath
vanillaDir
                (Flag FilePath, Flag FilePath)
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else if Bool
isGhcDynamic
            then do IO ()
shared;  IO ()
vanilla
            else do IO ()
vanilla; IO ()
shared
       IO () -> IO ()
whenProfLib (GhcOptions -> IO ()
runGhcProg GhcOptions
profOpts)

  -- Build any C++ sources separately.
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool -> Bool
not Bool
has_code Bool -> Bool -> Bool
|| [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [FilePath]
cxxSources BuildInfo
libBi)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Verbosity -> FilePath -> IO ()
info Verbosity
verbosity FilePath
"Building C++ Sources..."
    [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
      [ do let baseCxxOpts :: GhcOptions
baseCxxOpts    = Verbosity
-> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> GhcOptions
Internal.componentCxxGhcOptions Verbosity
verbosity GhcImplInfo
implInfo
                                LocalBuildInfo
lbi BuildInfo
libBi ComponentLocalBuildInfo
clbi FilePath
relLibTargetDir FilePath
filename
               vanillaCxxOpts :: GhcOptions
vanillaCxxOpts = if Bool
isGhcDynamic
                                then GhcOptions
baseCxxOpts { ghcOptFPic :: Flag Bool
ghcOptFPic = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True }
                                else GhcOptions
baseCxxOpts
               profCxxOpts :: GhcOptions
profCxxOpts    = GhcOptions
vanillaCxxOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                                  ghcOptProfilingMode :: Flag Bool
ghcOptProfilingMode = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                                  ghcOptObjSuffix :: Flag FilePath
ghcOptObjSuffix     = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"p_o"
                                }
               sharedCxxOpts :: GhcOptions
sharedCxxOpts  = GhcOptions
vanillaCxxOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                                 ghcOptFPic :: Flag Bool
ghcOptFPic        = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                                 ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcDynamicOnly,
                                 ghcOptObjSuffix :: Flag FilePath
ghcOptObjSuffix   = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"dyn_o"
                               }
               odir :: FilePath
odir           = Flag FilePath -> FilePath
forall a. WithCallStack (Flag a -> a)
fromFlag (GhcOptions -> Flag FilePath
ghcOptObjDir GhcOptions
vanillaCxxOpts)
           Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
odir
           let runGhcProgIfNeeded :: GhcOptions -> IO ()
runGhcProgIfNeeded GhcOptions
cxxOpts = do
                 Bool
needsRecomp <- FilePath -> GhcOptions -> IO Bool
checkNeedsRecompilation FilePath
filename GhcOptions
cxxOpts
                 Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needsRecomp (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ GhcOptions -> IO ()
runGhcProg GhcOptions
cxxOpts
           GhcOptions -> IO ()
runGhcProgIfNeeded GhcOptions
vanillaCxxOpts
           Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forRepl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
             Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenSharedLib Bool
forceSharedLib (GhcOptions -> IO ()
runGhcProgIfNeeded GhcOptions
sharedCxxOpts)
           Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forRepl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
whenProfLib   (GhcOptions -> IO ()
runGhcProgIfNeeded   GhcOptions
profCxxOpts)
      | FilePath
filename <- BuildInfo -> [FilePath]
cxxSources BuildInfo
libBi]

  -- build any C sources
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool -> Bool
not Bool
has_code Bool -> Bool -> Bool
|| [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [FilePath]
cSources BuildInfo
libBi)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Verbosity -> FilePath -> IO ()
info Verbosity
verbosity FilePath
"Building C Sources..."
    [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
      [ do let baseCcOpts :: GhcOptions
baseCcOpts    = Verbosity
-> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> GhcOptions
Internal.componentCcGhcOptions Verbosity
verbosity GhcImplInfo
implInfo
                               LocalBuildInfo
lbi BuildInfo
libBi ComponentLocalBuildInfo
clbi FilePath
relLibTargetDir FilePath
filename
               vanillaCcOpts :: GhcOptions
vanillaCcOpts = if Bool
isGhcDynamic
                               -- Dynamic GHC requires C sources to be built
                               -- with -fPIC for REPL to work. See #2207.
                               then GhcOptions
baseCcOpts { ghcOptFPic :: Flag Bool
ghcOptFPic = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True }
                               else GhcOptions
baseCcOpts
               profCcOpts :: GhcOptions
profCcOpts    = GhcOptions
vanillaCcOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                                 ghcOptProfilingMode :: Flag Bool
ghcOptProfilingMode = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                                 ghcOptObjSuffix :: Flag FilePath
ghcOptObjSuffix     = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"p_o"
                               }
               sharedCcOpts :: GhcOptions
sharedCcOpts  = GhcOptions
vanillaCcOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                                 ghcOptFPic :: Flag Bool
ghcOptFPic        = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                                 ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcDynamicOnly,
                                 ghcOptObjSuffix :: Flag FilePath
ghcOptObjSuffix   = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"dyn_o"
                               }
               odir :: FilePath
odir          = Flag FilePath -> FilePath
forall a. WithCallStack (Flag a -> a)
fromFlag (GhcOptions -> Flag FilePath
ghcOptObjDir GhcOptions
vanillaCcOpts)
           Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
odir
           let runGhcProgIfNeeded :: GhcOptions -> IO ()
runGhcProgIfNeeded GhcOptions
ccOpts = do
                 Bool
needsRecomp <- FilePath -> GhcOptions -> IO Bool
checkNeedsRecompilation FilePath
filename GhcOptions
ccOpts
                 Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needsRecomp (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ GhcOptions -> IO ()
runGhcProg GhcOptions
ccOpts
           GhcOptions -> IO ()
runGhcProgIfNeeded GhcOptions
vanillaCcOpts
           Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forRepl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
             Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenSharedLib Bool
forceSharedLib (GhcOptions -> IO ()
runGhcProgIfNeeded GhcOptions
sharedCcOpts)
           Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forRepl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
whenProfLib (GhcOptions -> IO ()
runGhcProgIfNeeded GhcOptions
profCcOpts)
      | FilePath
filename <- BuildInfo -> [FilePath]
cSources BuildInfo
libBi]

  -- build any ASM sources
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool -> Bool
not Bool
has_code Bool -> Bool -> Bool
|| [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [FilePath]
asmSources BuildInfo
libBi)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Verbosity -> FilePath -> IO ()
info Verbosity
verbosity FilePath
"Building Assembler Sources..."
    [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
      [ do let baseAsmOpts :: GhcOptions
baseAsmOpts    = Verbosity
-> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> GhcOptions
Internal.componentAsmGhcOptions Verbosity
verbosity GhcImplInfo
implInfo
                                LocalBuildInfo
lbi BuildInfo
libBi ComponentLocalBuildInfo
clbi FilePath
relLibTargetDir FilePath
filename
               vanillaAsmOpts :: GhcOptions
vanillaAsmOpts = if Bool
isGhcDynamic
                                -- Dynamic GHC requires objects to be built
                                -- with -fPIC for REPL to work. See #2207.
                                then GhcOptions
baseAsmOpts { ghcOptFPic :: Flag Bool
ghcOptFPic = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True }
                                else GhcOptions
baseAsmOpts
               profAsmOpts :: GhcOptions
profAsmOpts    = GhcOptions
vanillaAsmOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                                 ghcOptProfilingMode :: Flag Bool
ghcOptProfilingMode = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                                 ghcOptObjSuffix :: Flag FilePath
ghcOptObjSuffix     = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"p_o"
                               }
               sharedAsmOpts :: GhcOptions
sharedAsmOpts  = GhcOptions
vanillaAsmOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                                 ghcOptFPic :: Flag Bool
ghcOptFPic        = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                                 ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcDynamicOnly,
                                 ghcOptObjSuffix :: Flag FilePath
ghcOptObjSuffix   = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"dyn_o"
                               }
               odir :: FilePath
odir           = Flag FilePath -> FilePath
forall a. WithCallStack (Flag a -> a)
fromFlag (GhcOptions -> Flag FilePath
ghcOptObjDir GhcOptions
vanillaAsmOpts)
           Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
odir
           let runGhcProgIfNeeded :: GhcOptions -> IO ()
runGhcProgIfNeeded GhcOptions
asmOpts = do
                 Bool
needsRecomp <- FilePath -> GhcOptions -> IO Bool
checkNeedsRecompilation FilePath
filename GhcOptions
asmOpts
                 Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needsRecomp (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ GhcOptions -> IO ()
runGhcProg GhcOptions
asmOpts
           GhcOptions -> IO ()
runGhcProgIfNeeded GhcOptions
vanillaAsmOpts
           Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forRepl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
             Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenSharedLib Bool
forceSharedLib (GhcOptions -> IO ()
runGhcProgIfNeeded GhcOptions
sharedAsmOpts)
           Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forRepl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
whenProfLib (GhcOptions -> IO ()
runGhcProgIfNeeded GhcOptions
profAsmOpts)
      | FilePath
filename <- BuildInfo -> [FilePath]
asmSources BuildInfo
libBi]

  -- build any Cmm sources
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool -> Bool
not Bool
has_code Bool -> Bool -> Bool
|| [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [FilePath]
cmmSources BuildInfo
libBi)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Verbosity -> FilePath -> IO ()
info Verbosity
verbosity FilePath
"Building C-- Sources..."
    [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
      [ do let baseCmmOpts :: GhcOptions
baseCmmOpts    = Verbosity
-> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> GhcOptions
Internal.componentCmmGhcOptions Verbosity
verbosity GhcImplInfo
implInfo
                                LocalBuildInfo
lbi BuildInfo
libBi ComponentLocalBuildInfo
clbi FilePath
relLibTargetDir FilePath
filename
               vanillaCmmOpts :: GhcOptions
vanillaCmmOpts = if Bool
isGhcDynamic
                                -- Dynamic GHC requires C sources to be built
                                -- with -fPIC for REPL to work. See #2207.
                                then GhcOptions
baseCmmOpts { ghcOptFPic :: Flag Bool
ghcOptFPic = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True }
                                else GhcOptions
baseCmmOpts
               profCmmOpts :: GhcOptions
profCmmOpts    = GhcOptions
vanillaCmmOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                                 ghcOptProfilingMode :: Flag Bool
ghcOptProfilingMode = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                                 ghcOptObjSuffix :: Flag FilePath
ghcOptObjSuffix     = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"p_o"
                               }
               sharedCmmOpts :: GhcOptions
sharedCmmOpts  = GhcOptions
vanillaCmmOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                                 ghcOptFPic :: Flag Bool
ghcOptFPic        = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                                 ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcDynamicOnly,
                                 ghcOptObjSuffix :: Flag FilePath
ghcOptObjSuffix   = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"dyn_o"
                               }
               odir :: FilePath
odir          = Flag FilePath -> FilePath
forall a. WithCallStack (Flag a -> a)
fromFlag (GhcOptions -> Flag FilePath
ghcOptObjDir GhcOptions
vanillaCmmOpts)
           Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
odir
           let runGhcProgIfNeeded :: GhcOptions -> IO ()
runGhcProgIfNeeded GhcOptions
cmmOpts = do
                 Bool
needsRecomp <- FilePath -> GhcOptions -> IO Bool
checkNeedsRecompilation FilePath
filename GhcOptions
cmmOpts
                 Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needsRecomp (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ GhcOptions -> IO ()
runGhcProg GhcOptions
cmmOpts
           GhcOptions -> IO ()
runGhcProgIfNeeded GhcOptions
vanillaCmmOpts
           Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forRepl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
             Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenSharedLib Bool
forceSharedLib (GhcOptions -> IO ()
runGhcProgIfNeeded GhcOptions
sharedCmmOpts)
           Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forRepl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
whenProfLib (GhcOptions -> IO ()
runGhcProgIfNeeded GhcOptions
profCmmOpts)
      | FilePath
filename <- BuildInfo -> [FilePath]
cmmSources BuildInfo
libBi]

  -- TODO: problem here is we need the .c files built first, so we can load them
  -- with ghci, but .c files can depend on .h files generated by ghc by ffi
  -- exports.
  IO () -> IO ()
whenReplLib (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity FilePath
"No exposed modules"
    GhcOptions -> IO ()
runGhcProg GhcOptions
replOpts

  -- link:
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
has_code (IO () -> IO ()) -> (IO () -> IO ()) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forRepl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Verbosity -> FilePath -> IO ()
info Verbosity
verbosity FilePath
"Linking..."
    let cLikeProfObjs :: [FilePath]
cLikeProfObjs        = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
`replaceExtension` (FilePath
"p_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
objExtension))
                               [FilePath]
cLikeSources
        cLikeSharedObjs :: [FilePath]
cLikeSharedObjs      = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
`replaceExtension` (FilePath
"dyn_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
objExtension))
                               [FilePath]
cLikeSources
        compiler_id :: CompilerId
compiler_id          = Compiler -> CompilerId
compilerId (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
        vanillaLibFilePath :: FilePath
vanillaLibFilePath   = FilePath
relLibTargetDir FilePath -> FilePath -> FilePath
</> UnitId -> FilePath
mkLibName UnitId
uid
        profileLibFilePath :: FilePath
profileLibFilePath   = FilePath
relLibTargetDir FilePath -> FilePath -> FilePath
</> UnitId -> FilePath
mkProfLibName UnitId
uid
        sharedLibFilePath :: FilePath
sharedLibFilePath    = FilePath
relLibTargetDir FilePath -> FilePath -> FilePath
</>
                               Platform -> CompilerId -> UnitId -> FilePath
mkSharedLibName (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) CompilerId
compiler_id UnitId
uid
        staticLibFilePath :: FilePath
staticLibFilePath    = FilePath
relLibTargetDir FilePath -> FilePath -> FilePath
</>
                               Platform -> CompilerId -> UnitId -> FilePath
mkStaticLibName (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) CompilerId
compiler_id UnitId
uid
        ghciLibFilePath :: FilePath
ghciLibFilePath      = FilePath
relLibTargetDir FilePath -> FilePath -> FilePath
</> UnitId -> FilePath
Internal.mkGHCiLibName UnitId
uid
        ghciProfLibFilePath :: FilePath
ghciProfLibFilePath  = FilePath
relLibTargetDir FilePath -> FilePath -> FilePath
</> UnitId -> FilePath
Internal.mkGHCiProfLibName UnitId
uid
        libInstallPath :: FilePath
libInstallPath       = InstallDirs FilePath -> FilePath
forall dir. InstallDirs dir -> dir
libdir (InstallDirs FilePath -> FilePath)
-> InstallDirs FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$
                               PackageDescription
-> LocalBuildInfo -> UnitId -> CopyDest -> InstallDirs FilePath
absoluteComponentInstallDirs
                               PackageDescription
pkg_descr LocalBuildInfo
lbi UnitId
uid CopyDest
NoCopyDest
        sharedLibInstallPath :: FilePath
sharedLibInstallPath = FilePath
libInstallPath FilePath -> FilePath -> FilePath
</>
                               Platform -> CompilerId -> UnitId -> FilePath
mkSharedLibName (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) CompilerId
compiler_id UnitId
uid

    [FilePath]
stubObjs <- [Maybe FilePath] -> [FilePath]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe FilePath] -> [FilePath])
-> IO [Maybe FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IO (Maybe FilePath)] -> IO [Maybe FilePath]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
      [ [FilePath] -> [FilePath] -> FilePath -> IO (Maybe FilePath)
findFileWithExtension [FilePath
objExtension] [FilePath
libTargetDir]
          (ModuleName -> FilePath
ModuleName.toFilePath ModuleName
x FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"_stub")
      | Version
ghcVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
7,Int
2] -- ghc-7.2+ does not make _stub.o files
      , ModuleName
x <- Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi ]
    [FilePath]
stubProfObjs <- [Maybe FilePath] -> [FilePath]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe FilePath] -> [FilePath])
-> IO [Maybe FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IO (Maybe FilePath)] -> IO [Maybe FilePath]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
      [ [FilePath] -> [FilePath] -> FilePath -> IO (Maybe FilePath)
findFileWithExtension [FilePath
"p_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
objExtension] [FilePath
libTargetDir]
          (ModuleName -> FilePath
ModuleName.toFilePath ModuleName
x FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"_stub")
      | Version
ghcVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
7,Int
2] -- ghc-7.2+ does not make _stub.o files
      , ModuleName
x <- Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi ]
    [FilePath]
stubSharedObjs <- [Maybe FilePath] -> [FilePath]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe FilePath] -> [FilePath])
-> IO [Maybe FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IO (Maybe FilePath)] -> IO [Maybe FilePath]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
      [ [FilePath] -> [FilePath] -> FilePath -> IO (Maybe FilePath)
findFileWithExtension [FilePath
"dyn_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
objExtension] [FilePath
libTargetDir]
          (ModuleName -> FilePath
ModuleName.toFilePath ModuleName
x FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"_stub")
      | Version
ghcVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
7,Int
2] -- ghc-7.2+ does not make _stub.o files
      , ModuleName
x <- Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi ]

    [FilePath]
hObjs     <- GhcImplInfo
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> Bool
-> IO [FilePath]
Internal.getHaskellObjects GhcImplInfo
implInfo Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
                      FilePath
relLibTargetDir FilePath
objExtension Bool
True
    [FilePath]
hProfObjs <-
      if LocalBuildInfo -> Bool
withProfLib LocalBuildInfo
lbi
              then GhcImplInfo
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> Bool
-> IO [FilePath]
Internal.getHaskellObjects GhcImplInfo
implInfo Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
                      FilePath
relLibTargetDir (FilePath
"p_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
objExtension) Bool
True
              else [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    [FilePath]
hSharedObjs <-
      if LocalBuildInfo -> Bool
withSharedLib LocalBuildInfo
lbi
              then GhcImplInfo
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> Bool
-> IO [FilePath]
Internal.getHaskellObjects GhcImplInfo
implInfo Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
                      FilePath
relLibTargetDir (FilePath
"dyn_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
objExtension) Bool
False
              else [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
hObjs Bool -> Bool -> Bool
&& [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
cLikeObjs Bool -> Bool -> Bool
&& [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
stubObjs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      NubListR FilePath
rpaths <- LocalBuildInfo -> ComponentLocalBuildInfo -> IO (NubListR FilePath)
getRPaths LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi

      let staticObjectFiles :: [FilePath]
staticObjectFiles =
                 [FilePath]
hObjs
              [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
relLibTargetDir FilePath -> FilePath -> FilePath
</>) [FilePath]
cLikeObjs
              [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
stubObjs
          profObjectFiles :: [FilePath]
profObjectFiles =
                 [FilePath]
hProfObjs
              [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
relLibTargetDir FilePath -> FilePath -> FilePath
</>) [FilePath]
cLikeProfObjs
              [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
stubProfObjs
          dynamicObjectFiles :: [FilePath]
dynamicObjectFiles =
                 [FilePath]
hSharedObjs
              [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
relLibTargetDir FilePath -> FilePath -> FilePath
</>) [FilePath]
cLikeSharedObjs
              [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
stubSharedObjs
          -- After the relocation lib is created we invoke ghc -shared
          -- with the dependencies spelled out as -package arguments
          -- and ghc invokes the linker with the proper library paths
          ghcSharedLinkArgs :: GhcOptions
ghcSharedLinkArgs =
              GhcOptions
forall a. Monoid a => a
mempty {
                ghcOptShared :: Flag Bool
ghcOptShared             = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode        = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcDynamicOnly,
                ghcOptInputFiles :: NubListR FilePath
ghcOptInputFiles         = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR [FilePath]
dynamicObjectFiles,
                ghcOptOutputFile :: Flag FilePath
ghcOptOutputFile         = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
sharedLibFilePath,
                ghcOptExtra :: [FilePath]
ghcOptExtra              = CompilerFlavor -> BuildInfo -> [FilePath]
hcSharedOptions CompilerFlavor
GHC BuildInfo
libBi,
                -- For dynamic libs, Mac OS/X needs to know the install location
                -- at build time. This only applies to GHC < 7.8 - see the
                -- discussion in #1660.
                ghcOptDylibName :: Flag FilePath
ghcOptDylibName          = if OS
hostOS OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSX
                                              Bool -> Bool -> Bool
&& Version
ghcVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
7,Int
8]
                                            then FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
sharedLibInstallPath
                                            else Flag FilePath
forall a. Monoid a => a
mempty,
                ghcOptHideAllPackages :: Flag Bool
ghcOptHideAllPackages    = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                ghcOptNoAutoLinkPackages :: Flag Bool
ghcOptNoAutoLinkPackages = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                ghcOptPackageDBs :: [PackageDB]
ghcOptPackageDBs         = LocalBuildInfo -> [PackageDB]
withPackageDB LocalBuildInfo
lbi,
                ghcOptThisUnitId :: Flag FilePath
ghcOptThisUnitId = case ComponentLocalBuildInfo
clbi of
                    LibComponentLocalBuildInfo { componentCompatPackageKey :: ComponentLocalBuildInfo -> FilePath
componentCompatPackageKey = FilePath
pk }
                      -> FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
pk
                    ComponentLocalBuildInfo
_ -> Flag FilePath
forall a. Monoid a => a
mempty,
                ghcOptThisComponentId :: Flag ComponentId
ghcOptThisComponentId = case ComponentLocalBuildInfo
clbi of
                    LibComponentLocalBuildInfo
                      { 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 (ComponentLocalBuildInfo -> ComponentId
componentComponentId ComponentLocalBuildInfo
clbi)
                    ComponentLocalBuildInfo
_ -> Flag ComponentId
forall a. Monoid a => a
mempty,
                ghcOptInstantiatedWith :: [(ModuleName, OpenModule)]
ghcOptInstantiatedWith = case ComponentLocalBuildInfo
clbi of
                    LibComponentLocalBuildInfo
                      { componentInstantiatedWith :: ComponentLocalBuildInfo -> [(ModuleName, OpenModule)]
componentInstantiatedWith = [(ModuleName, OpenModule)]
insts }
                      -> [(ModuleName, OpenModule)]
insts
                    ComponentLocalBuildInfo
_ -> [],
                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)]
Internal.mkGhcOptPackages ComponentLocalBuildInfo
clbi ,
                ghcOptLinkLibs :: [FilePath]
ghcOptLinkLibs           = BuildInfo -> [FilePath]
extraLibs BuildInfo
libBi,
                ghcOptLinkLibPath :: NubListR FilePath
ghcOptLinkLibPath        = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [FilePath]
extraLibDirs BuildInfo
libBi,
                ghcOptLinkFrameworks :: NubListR FilePath
ghcOptLinkFrameworks     = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [FilePath]
PD.frameworks BuildInfo
libBi,
                ghcOptLinkFrameworkDirs :: NubListR FilePath
ghcOptLinkFrameworkDirs  =
                  [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [FilePath]
PD.extraFrameworkDirs BuildInfo
libBi,
                ghcOptRPaths :: NubListR FilePath
ghcOptRPaths             = NubListR FilePath
rpaths
              }
          ghcStaticLinkArgs :: GhcOptions
ghcStaticLinkArgs =
              GhcOptions
forall a. Monoid a => a
mempty {
                ghcOptStaticLib :: Flag Bool
ghcOptStaticLib          = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                ghcOptInputFiles :: NubListR FilePath
ghcOptInputFiles         = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR [FilePath]
staticObjectFiles,
                ghcOptOutputFile :: Flag FilePath
ghcOptOutputFile         = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
staticLibFilePath,
                ghcOptExtra :: [FilePath]
ghcOptExtra              = CompilerFlavor -> BuildInfo -> [FilePath]
hcStaticOptions CompilerFlavor
GHC BuildInfo
libBi,
                ghcOptHideAllPackages :: Flag Bool
ghcOptHideAllPackages    = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                ghcOptNoAutoLinkPackages :: Flag Bool
ghcOptNoAutoLinkPackages = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                ghcOptPackageDBs :: [PackageDB]
ghcOptPackageDBs         = LocalBuildInfo -> [PackageDB]
withPackageDB LocalBuildInfo
lbi,
                ghcOptThisUnitId :: Flag FilePath
ghcOptThisUnitId = case ComponentLocalBuildInfo
clbi of
                    LibComponentLocalBuildInfo { componentCompatPackageKey :: ComponentLocalBuildInfo -> FilePath
componentCompatPackageKey = FilePath
pk }
                      -> FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
pk
                    ComponentLocalBuildInfo
_ -> Flag FilePath
forall a. Monoid a => a
mempty,
                ghcOptThisComponentId :: Flag ComponentId
ghcOptThisComponentId = case ComponentLocalBuildInfo
clbi of
                    LibComponentLocalBuildInfo
                      { 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 (ComponentLocalBuildInfo -> ComponentId
componentComponentId ComponentLocalBuildInfo
clbi)
                    ComponentLocalBuildInfo
_ -> Flag ComponentId
forall a. Monoid a => a
mempty,
                ghcOptInstantiatedWith :: [(ModuleName, OpenModule)]
ghcOptInstantiatedWith = case ComponentLocalBuildInfo
clbi of
                    LibComponentLocalBuildInfo
                      { componentInstantiatedWith :: ComponentLocalBuildInfo -> [(ModuleName, OpenModule)]
componentInstantiatedWith = [(ModuleName, OpenModule)]
insts }
                      -> [(ModuleName, OpenModule)]
insts
                    ComponentLocalBuildInfo
_ -> [],
                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)]
Internal.mkGhcOptPackages ComponentLocalBuildInfo
clbi ,
                ghcOptLinkLibs :: [FilePath]
ghcOptLinkLibs           = BuildInfo -> [FilePath]
extraLibs BuildInfo
libBi,
                ghcOptLinkLibPath :: NubListR FilePath
ghcOptLinkLibPath        = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [FilePath]
extraLibDirs BuildInfo
libBi
              }

      Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (NubListR (OpenUnitId, ModuleRenaming) -> FilePath
forall a. Show a => a -> FilePath
show (GhcOptions -> NubListR (OpenUnitId, ModuleRenaming)
ghcOptPackages GhcOptions
ghcSharedLinkArgs))

      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenVanillaLib Bool
False (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Verbosity -> LocalBuildInfo -> FilePath -> [FilePath] -> IO ()
Ar.createArLibArchive Verbosity
verbosity LocalBuildInfo
lbi FilePath
vanillaLibFilePath [FilePath]
staticObjectFiles
        IO () -> IO ()
whenGHCiLib (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          (ConfiguredProgram
ldProg, ProgramDb
_) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
ldProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
          Verbosity
-> LocalBuildInfo
-> ConfiguredProgram
-> FilePath
-> [FilePath]
-> IO ()
Ld.combineObjectFiles Verbosity
verbosity LocalBuildInfo
lbi ConfiguredProgram
ldProg
            FilePath
ghciLibFilePath [FilePath]
staticObjectFiles

      IO () -> IO ()
whenProfLib (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Verbosity -> LocalBuildInfo -> FilePath -> [FilePath] -> IO ()
Ar.createArLibArchive Verbosity
verbosity LocalBuildInfo
lbi FilePath
profileLibFilePath [FilePath]
profObjectFiles
        IO () -> IO ()
whenGHCiLib (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          (ConfiguredProgram
ldProg, ProgramDb
_) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
ldProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
          Verbosity
-> LocalBuildInfo
-> ConfiguredProgram
-> FilePath
-> [FilePath]
-> IO ()
Ld.combineObjectFiles Verbosity
verbosity LocalBuildInfo
lbi ConfiguredProgram
ldProg
            FilePath
ghciProfLibFilePath [FilePath]
profObjectFiles

      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenSharedLib Bool
False (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        GhcOptions -> IO ()
runGhcProg GhcOptions
ghcSharedLinkArgs

      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenStaticLib Bool
False (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        GhcOptions -> IO ()
runGhcProg GhcOptions
ghcStaticLinkArgs

-- | Start a REPL without loading any source files.
startInterpreter :: Verbosity -> ProgramDb -> Compiler -> Platform
                 -> PackageDBStack -> IO ()
startInterpreter :: Verbosity
-> ProgramDb -> Compiler -> Platform -> [PackageDB] -> IO ()
startInterpreter Verbosity
verbosity ProgramDb
progdb Compiler
comp Platform
platform [PackageDB]
packageDBs = do
  let replOpts :: GhcOptions
replOpts = GhcOptions
forall a. Monoid a => a
mempty {
        ghcOptMode :: Flag GhcMode
ghcOptMode       = GhcMode -> Flag GhcMode
forall a. a -> Flag a
toFlag GhcMode
GhcModeInteractive,
        ghcOptPackageDBs :: [PackageDB]
ghcOptPackageDBs = [PackageDB]
packageDBs
        }
  Verbosity -> Compiler -> [PackageDB] -> IO ()
checkPackageDbStack Verbosity
verbosity Compiler
comp [PackageDB]
packageDBs
  (ConfiguredProgram
ghcProg, ProgramDb
_) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
ghcProgram ProgramDb
progdb
  Verbosity
-> ConfiguredProgram -> Compiler -> Platform -> GhcOptions -> IO ()
runGHC Verbosity
verbosity ConfiguredProgram
ghcProg Compiler
comp Platform
platform GhcOptions
replOpts

-- -----------------------------------------------------------------------------
-- Building an executable or foreign library

-- | Build a foreign library
buildFLib
  :: Verbosity          -> Cabal.Flag (Maybe Int)
  -> PackageDescription -> LocalBuildInfo
  -> ForeignLib         -> ComponentLocalBuildInfo -> IO ()
buildFLib :: Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO ()
buildFLib Verbosity
v Flag (Maybe Int)
njobs PackageDescription
pkg LocalBuildInfo
lbi = Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> GBuildMode
-> ComponentLocalBuildInfo
-> IO ()
gbuild Verbosity
v Flag (Maybe Int)
njobs PackageDescription
pkg LocalBuildInfo
lbi (GBuildMode -> ComponentLocalBuildInfo -> IO ())
-> (ForeignLib -> GBuildMode)
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignLib -> GBuildMode
GBuildFLib

replFLib
  :: ReplOptions             -> Verbosity
  -> Cabal.Flag (Maybe Int)  -> PackageDescription
  -> LocalBuildInfo          -> ForeignLib
  -> ComponentLocalBuildInfo -> IO ()
replFLib :: ReplOptions
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO ()
replFLib ReplOptions
replFlags  Verbosity
v Flag (Maybe Int)
njobs PackageDescription
pkg LocalBuildInfo
lbi =
  Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> GBuildMode
-> ComponentLocalBuildInfo
-> IO ()
gbuild Verbosity
v Flag (Maybe Int)
njobs PackageDescription
pkg LocalBuildInfo
lbi (GBuildMode -> ComponentLocalBuildInfo -> IO ())
-> (ForeignLib -> GBuildMode)
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReplOptions -> ForeignLib -> GBuildMode
GReplFLib ReplOptions
replFlags

-- | Build an executable with GHC.
--
buildExe
  :: Verbosity          -> Cabal.Flag (Maybe Int)
  -> PackageDescription -> LocalBuildInfo
  -> Executable         -> ComponentLocalBuildInfo -> IO ()
buildExe :: Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
buildExe Verbosity
v Flag (Maybe Int)
njobs PackageDescription
pkg LocalBuildInfo
lbi = Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> GBuildMode
-> ComponentLocalBuildInfo
-> IO ()
gbuild Verbosity
v Flag (Maybe Int)
njobs PackageDescription
pkg LocalBuildInfo
lbi (GBuildMode -> ComponentLocalBuildInfo -> IO ())
-> (Executable -> GBuildMode)
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> GBuildMode
GBuildExe

replExe
  :: ReplOptions             -> Verbosity
  -> Cabal.Flag (Maybe Int)  -> PackageDescription
  -> LocalBuildInfo          -> Executable
  -> ComponentLocalBuildInfo -> IO ()
replExe :: ReplOptions
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
replExe ReplOptions
replFlags Verbosity
v Flag (Maybe Int)
njobs PackageDescription
pkg LocalBuildInfo
lbi =
  Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> GBuildMode
-> ComponentLocalBuildInfo
-> IO ()
gbuild Verbosity
v Flag (Maybe Int)
njobs PackageDescription
pkg LocalBuildInfo
lbi (GBuildMode -> ComponentLocalBuildInfo -> IO ())
-> (Executable -> GBuildMode)
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReplOptions -> Executable -> GBuildMode
GReplExe ReplOptions
replFlags

-- | Building an executable, starting the REPL, and building foreign
-- libraries are all very similar and implemented in 'gbuild'. The
-- 'GBuildMode' distinguishes between the various kinds of operation.
data GBuildMode =
    GBuildExe  Executable
  | GReplExe   ReplOptions Executable
  | GBuildFLib ForeignLib
  | GReplFLib  ReplOptions ForeignLib

gbuildInfo :: GBuildMode -> BuildInfo
gbuildInfo :: GBuildMode -> BuildInfo
gbuildInfo (GBuildExe  Executable
exe)  = Executable -> BuildInfo
buildInfo Executable
exe
gbuildInfo (GReplExe   ReplOptions
_ Executable
exe)  = Executable -> BuildInfo
buildInfo Executable
exe
gbuildInfo (GBuildFLib ForeignLib
flib) = ForeignLib -> BuildInfo
foreignLibBuildInfo ForeignLib
flib
gbuildInfo (GReplFLib  ReplOptions
_ ForeignLib
flib) = ForeignLib -> BuildInfo
foreignLibBuildInfo ForeignLib
flib

gbuildName :: GBuildMode -> String
gbuildName :: GBuildMode -> FilePath
gbuildName (GBuildExe  Executable
exe)  = UnqualComponentName -> FilePath
unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
forall a b. (a -> b) -> a -> b
$ Executable -> UnqualComponentName
exeName Executable
exe
gbuildName (GReplExe   ReplOptions
_ Executable
exe)  = UnqualComponentName -> FilePath
unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
forall a b. (a -> b) -> a -> b
$ Executable -> UnqualComponentName
exeName Executable
exe
gbuildName (GBuildFLib ForeignLib
flib) = UnqualComponentName -> FilePath
unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
forall a b. (a -> b) -> a -> b
$ ForeignLib -> UnqualComponentName
foreignLibName ForeignLib
flib
gbuildName (GReplFLib  ReplOptions
_ ForeignLib
flib) = UnqualComponentName -> FilePath
unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
forall a b. (a -> b) -> a -> b
$ ForeignLib -> UnqualComponentName
foreignLibName ForeignLib
flib

gbuildTargetName :: LocalBuildInfo -> GBuildMode -> String
gbuildTargetName :: LocalBuildInfo -> GBuildMode -> FilePath
gbuildTargetName LocalBuildInfo
lbi (GBuildExe  Executable
exe)  = Platform -> Executable -> FilePath
exeTargetName (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) Executable
exe
gbuildTargetName LocalBuildInfo
lbi (GReplExe   ReplOptions
_ Executable
exe)  = Platform -> Executable -> FilePath
exeTargetName (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) Executable
exe
gbuildTargetName LocalBuildInfo
lbi (GBuildFLib ForeignLib
flib) = LocalBuildInfo -> ForeignLib -> FilePath
flibTargetName LocalBuildInfo
lbi ForeignLib
flib
gbuildTargetName LocalBuildInfo
lbi (GReplFLib  ReplOptions
_ ForeignLib
flib) = LocalBuildInfo -> ForeignLib -> FilePath
flibTargetName LocalBuildInfo
lbi ForeignLib
flib

exeTargetName :: Platform -> Executable -> String
exeTargetName :: Platform -> Executable -> FilePath
exeTargetName Platform
platform Executable
exe = UnqualComponentName -> FilePath
unUnqualComponentName (Executable -> UnqualComponentName
exeName Executable
exe) FilePath -> FilePath -> FilePath
`withExt` Platform -> FilePath
exeExtension Platform
platform

-- | Target name for a foreign library (the actual file name)
--
-- We do not use mkLibName and co here because the naming for foreign libraries
-- is slightly different (we don't use "_p" or compiler version suffices, and we
-- don't want the "lib" prefix on Windows).
--
-- TODO: We do use `dllExtension` and co here, but really that's wrong: they
-- use the OS used to build cabal to determine which extension to use, rather
-- than the target OS (but this is wrong elsewhere in Cabal as well).
flibTargetName :: LocalBuildInfo -> ForeignLib -> String
flibTargetName :: LocalBuildInfo -> ForeignLib -> FilePath
flibTargetName LocalBuildInfo
lbi ForeignLib
flib =
    case (OS
os, ForeignLib -> ForeignLibType
foreignLibType ForeignLib
flib) of
      (OS
Windows, ForeignLibType
ForeignLibNativeShared) -> FilePath
nm FilePath -> FilePath -> FilePath
<.> FilePath
"dll"
      (OS
Windows, ForeignLibType
ForeignLibNativeStatic) -> FilePath
nm FilePath -> FilePath -> FilePath
<.> FilePath
"lib"
      (OS
Linux,   ForeignLibType
ForeignLibNativeShared) -> FilePath
"lib" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
nm FilePath -> FilePath -> FilePath
<.> FilePath
versionedExt
      (OS
_other,  ForeignLibType
ForeignLibNativeShared) ->
        FilePath
"lib" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
nm FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
dllExtension (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi)
      (OS
_other,  ForeignLibType
ForeignLibNativeStatic) ->
        FilePath
"lib" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
nm FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
staticLibExtension (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi)
      (OS
_any,    ForeignLibType
ForeignLibTypeUnknown)  -> FilePath -> FilePath
forall a. FilePath -> a
cabalBug FilePath
"unknown foreign lib type"
  where
    nm :: String
    nm :: FilePath
nm = UnqualComponentName -> FilePath
unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
forall a b. (a -> b) -> a -> b
$ ForeignLib -> UnqualComponentName
foreignLibName ForeignLib
flib

    os :: OS
    os :: OS
os = let (Platform Arch
_ OS
os') = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
         in OS
os'

    -- If a foreign lib foo has lib-version-info 5:1:2 or
    -- lib-version-linux 3.2.1, it should be built as libfoo.so.3.2.1
    -- Libtool's version-info data is translated into library versions in a
    -- nontrivial way: so refer to libtool documentation.
    versionedExt :: String
    versionedExt :: FilePath
versionedExt =
      let nums :: [Int]
nums = ForeignLib -> OS -> [Int]
foreignLibVersion ForeignLib
flib OS
os
      in (FilePath -> FilePath -> FilePath)
-> FilePath -> [FilePath] -> FilePath
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl FilePath -> FilePath -> FilePath
(<.>) FilePath
"so" ((Int -> FilePath) -> [Int] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Int -> FilePath
forall a. Show a => a -> FilePath
show [Int]
nums)

-- | Name for the library when building.
--
-- If the `lib-version-info` field or the `lib-version-linux` field of
-- a foreign library target is set, we need to incorporate that
-- version into the SONAME field.
--
-- If a foreign library foo has lib-version-info 5:1:2, it should be
-- built as libfoo.so.3.2.1.  We want it to get soname libfoo.so.3.
-- However, GHC does not allow overriding soname by setting linker
-- options, as it sets a soname of its own (namely the output
-- filename), after the user-supplied linker options.  Hence, we have
-- to compile the library with the soname as its filename.  We rename
-- the compiled binary afterwards.
--
-- This method allows to adjust the name of the library at build time
-- such that the correct soname can be set.
flibBuildName :: LocalBuildInfo -> ForeignLib -> String
flibBuildName :: LocalBuildInfo -> ForeignLib -> FilePath
flibBuildName LocalBuildInfo
lbi ForeignLib
flib
  -- On linux, if a foreign-library has version data, the first digit is used
  -- to produce the SONAME.
  | (OS
os, ForeignLib -> ForeignLibType
foreignLibType ForeignLib
flib) (OS, ForeignLibType) -> (OS, ForeignLibType) -> Bool
forall a. Eq a => a -> a -> Bool
==
    (OS
Linux, ForeignLibType
ForeignLibNativeShared)
  = let nums :: [Int]
nums = ForeignLib -> OS -> [Int]
foreignLibVersion ForeignLib
flib OS
os
    in FilePath
"lib" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
nm FilePath -> FilePath -> FilePath
<.> (FilePath -> FilePath -> FilePath)
-> FilePath -> [FilePath] -> FilePath
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl FilePath -> FilePath -> FilePath
(<.>) FilePath
"so" ((Int -> FilePath) -> [Int] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
1 [Int]
nums))
  | Bool
otherwise = LocalBuildInfo -> ForeignLib -> FilePath
flibTargetName LocalBuildInfo
lbi ForeignLib
flib
  where
    os :: OS
    os :: OS
os = let (Platform Arch
_ OS
os') = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
         in OS
os'

    nm :: String
    nm :: FilePath
nm = UnqualComponentName -> FilePath
unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
forall a b. (a -> b) -> a -> b
$ ForeignLib -> UnqualComponentName
foreignLibName ForeignLib
flib

gbuildIsRepl :: GBuildMode -> Bool
gbuildIsRepl :: GBuildMode -> Bool
gbuildIsRepl (GBuildExe  Executable
_) = Bool
False
gbuildIsRepl (GReplExe ReplOptions
_ Executable
_) = Bool
True
gbuildIsRepl (GBuildFLib ForeignLib
_) = Bool
False
gbuildIsRepl (GReplFLib ReplOptions
_ ForeignLib
_) = Bool
True

gbuildNeedDynamic :: LocalBuildInfo -> GBuildMode -> Bool
gbuildNeedDynamic :: LocalBuildInfo -> GBuildMode -> Bool
gbuildNeedDynamic LocalBuildInfo
lbi GBuildMode
bm =
    case GBuildMode
bm of
      GBuildExe  Executable
_    -> LocalBuildInfo -> Bool
withDynExe LocalBuildInfo
lbi
      GReplExe   ReplOptions
_ Executable
_  -> LocalBuildInfo -> Bool
withDynExe LocalBuildInfo
lbi
      GBuildFLib ForeignLib
flib -> ForeignLib -> Bool
withDynFLib ForeignLib
flib
      GReplFLib  ReplOptions
_ ForeignLib
flib -> ForeignLib -> Bool
withDynFLib ForeignLib
flib
  where
    withDynFLib :: ForeignLib -> Bool
withDynFLib ForeignLib
flib =
      case ForeignLib -> ForeignLibType
foreignLibType ForeignLib
flib of
        ForeignLibType
ForeignLibNativeShared ->
          ForeignLibOption
ForeignLibStandalone ForeignLibOption -> [ForeignLibOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ForeignLib -> [ForeignLibOption]
foreignLibOptions ForeignLib
flib
        ForeignLibType
ForeignLibNativeStatic ->
          Bool
False
        ForeignLibType
ForeignLibTypeUnknown  ->
          FilePath -> Bool
forall a. FilePath -> a
cabalBug FilePath
"unknown foreign lib type"

gbuildModDefFiles :: GBuildMode -> [FilePath]
gbuildModDefFiles :: GBuildMode -> [FilePath]
gbuildModDefFiles (GBuildExe Executable
_)     = []
gbuildModDefFiles (GReplExe  ReplOptions
_ Executable
_)     = []
gbuildModDefFiles (GBuildFLib ForeignLib
flib) = ForeignLib -> [FilePath]
foreignLibModDefFile ForeignLib
flib
gbuildModDefFiles (GReplFLib ReplOptions
_ ForeignLib
flib) = ForeignLib -> [FilePath]
foreignLibModDefFile ForeignLib
flib

-- | "Main" module name when overridden by @ghc-options: -main-is ...@
-- or 'Nothing' if no @-main-is@ flag could be found.
--
-- In case of 'Nothing', 'Distribution.ModuleName.main' can be assumed.
exeMainModuleName :: Executable -> Maybe ModuleName
exeMainModuleName :: Executable -> Maybe ModuleName
exeMainModuleName Executable{buildInfo :: Executable -> BuildInfo
buildInfo = BuildInfo
bnfo} =
    -- GHC honors the last occurrence of a module name updated via -main-is
    --
    -- Moreover, -main-is when parsed left-to-right can update either
    -- the "Main" module name, or the "main" function name, or both,
    -- see also 'decodeMainIsArg'.
    [Maybe ModuleName] -> Maybe ModuleName
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe ModuleName] -> Maybe ModuleName)
-> [Maybe ModuleName] -> Maybe ModuleName
forall a b. (a -> b) -> a -> b
$ [Maybe ModuleName] -> [Maybe ModuleName]
forall a. [a] -> [a]
reverse ([Maybe ModuleName] -> [Maybe ModuleName])
-> [Maybe ModuleName] -> [Maybe ModuleName]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Maybe ModuleName) -> [FilePath] -> [Maybe ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Maybe ModuleName
decodeMainIsArg ([FilePath] -> [Maybe ModuleName])
-> [FilePath] -> [Maybe ModuleName]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath]
findIsMainArgs [FilePath]
ghcopts
  where
    ghcopts :: [FilePath]
ghcopts = CompilerFlavor -> BuildInfo -> [FilePath]
hcOptions CompilerFlavor
GHC BuildInfo
bnfo

    findIsMainArgs :: [FilePath] -> [FilePath]
findIsMainArgs [] = []
    findIsMainArgs (FilePath
"-main-is":FilePath
arg:[FilePath]
rest) = FilePath
arg FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath] -> [FilePath]
findIsMainArgs [FilePath]
rest
    findIsMainArgs (FilePath
_:[FilePath]
rest) = [FilePath] -> [FilePath]
findIsMainArgs [FilePath]
rest

-- | Decode argument to '-main-is'
--
-- Returns 'Nothing' if argument set only the function name.
--
-- This code has been stolen/refactored from GHC's DynFlags.setMainIs
-- function. The logic here is deliberately imperfect as it is
-- intended to be bug-compatible with GHC's parser. See discussion in
-- https://github.com/haskell/cabal/pull/4539#discussion_r118981753.
decodeMainIsArg :: String -> Maybe ModuleName
decodeMainIsArg :: FilePath -> Maybe ModuleName
decodeMainIsArg FilePath
arg
  | FilePath -> (Char -> Bool) -> Bool
headOf FilePath
main_fn Char -> Bool
isLower
                        -- The arg looked like "Foo.Bar.baz"
  = ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just (FilePath -> ModuleName
forall a. IsString a => FilePath -> a
ModuleName.fromString FilePath
main_mod)
  | FilePath -> (Char -> Bool) -> Bool
headOf FilePath
arg Char -> Bool
isUpper  -- The arg looked like "Foo" or "Foo.Bar"
  = ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just (FilePath -> ModuleName
forall a. IsString a => FilePath -> a
ModuleName.fromString FilePath
arg)
  | Bool
otherwise           -- The arg looked like "baz"
  = Maybe ModuleName
forall a. Maybe a
Nothing
  where
    headOf :: String -> (Char -> Bool) -> Bool
    headOf :: FilePath -> (Char -> Bool) -> Bool
headOf FilePath
str Char -> Bool
pred' = (Char -> Bool) -> Maybe Char -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
pred' (FilePath -> Maybe Char
forall a. [a] -> Maybe a
safeHead FilePath
str)

    (FilePath
main_mod, FilePath
main_fn) = FilePath -> (Char -> Bool) -> (FilePath, FilePath)
splitLongestPrefix FilePath
arg (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')

    splitLongestPrefix :: String -> (Char -> Bool) -> (String,String)
    splitLongestPrefix :: FilePath -> (Char -> Bool) -> (FilePath, FilePath)
splitLongestPrefix FilePath
str Char -> Bool
pred'
      | FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
r_pre = (FilePath
str,           [])
      | Bool
otherwise  = (FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath
forall a. [a] -> [a]
safeTail FilePath
r_pre), FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
r_suf)
                           -- 'safeTail' drops the char satisfying 'pred'
      where (FilePath
r_suf, FilePath
r_pre) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
pred' (FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
str)

-- | A collection of:
--    * C input files
--    * C++ input files
--    * GHC input files
--    * GHC input modules
--
-- Used to correctly build and link sources.
data BuildSources = BuildSources {
        BuildSources -> [FilePath]
cSourcesFiles      :: [FilePath],
        BuildSources -> [FilePath]
cxxSourceFiles     :: [FilePath],
        BuildSources -> [FilePath]
inputSourceFiles   :: [FilePath],
        BuildSources -> [ModuleName]
inputSourceModules :: [ModuleName]
    }

-- | Locate and return the 'BuildSources' required to build and link.
gbuildSources :: Verbosity
              -> PackageId
              -> CabalSpecVersion
              -> FilePath
              -> GBuildMode
              -> IO BuildSources
gbuildSources :: Verbosity
-> PackageIdentifier
-> CabalSpecVersion
-> FilePath
-> GBuildMode
-> IO BuildSources
gbuildSources Verbosity
verbosity PackageIdentifier
pkgId CabalSpecVersion
specVer FilePath
tmpDir GBuildMode
bm =
    case GBuildMode
bm of
      GBuildExe  Executable
exe  -> Executable -> IO BuildSources
exeSources Executable
exe
      GReplExe   ReplOptions
_ Executable
exe  -> Executable -> IO BuildSources
exeSources Executable
exe
      GBuildFLib ForeignLib
flib -> BuildSources -> IO BuildSources
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildSources -> IO BuildSources)
-> BuildSources -> IO BuildSources
forall a b. (a -> b) -> a -> b
$ ForeignLib -> BuildSources
flibSources ForeignLib
flib
      GReplFLib  ReplOptions
_ ForeignLib
flib -> BuildSources -> IO BuildSources
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildSources -> IO BuildSources)
-> BuildSources -> IO BuildSources
forall a b. (a -> b) -> a -> b
$ ForeignLib -> BuildSources
flibSources ForeignLib
flib
  where
    exeSources :: Executable -> IO BuildSources
    exeSources :: Executable -> IO BuildSources
exeSources exe :: Executable
exe@Executable{buildInfo :: Executable -> BuildInfo
buildInfo = BuildInfo
bnfo, modulePath :: Executable -> FilePath
modulePath = FilePath
modPath} = do
      FilePath
main <- Verbosity -> [FilePath] -> FilePath -> IO FilePath
findFileEx Verbosity
verbosity (FilePath
tmpDir FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (SymbolicPath PackageDir SourceDir -> FilePath)
-> [SymbolicPath PackageDir SourceDir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir SourceDir -> FilePath
forall from to. SymbolicPath from to -> FilePath
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bnfo)) FilePath
modPath
      let mainModName :: ModuleName
mainModName = ModuleName -> Maybe ModuleName -> ModuleName
forall a. a -> Maybe a -> a
fromMaybe ModuleName
ModuleName.main (Maybe ModuleName -> ModuleName) -> Maybe ModuleName -> ModuleName
forall a b. (a -> b) -> a -> b
$ Executable -> Maybe ModuleName
exeMainModuleName Executable
exe
          otherModNames :: [ModuleName]
otherModNames = Executable -> [ModuleName]
exeModules Executable
exe

      -- Scripts have fakePackageId and are always Haskell but can have any extension.
      if FilePath -> Bool
isHaskell FilePath
main Bool -> Bool -> Bool
|| PackageIdentifier
pkgId PackageIdentifier -> PackageIdentifier -> Bool
forall a. Eq a => a -> a -> Bool
== PackageIdentifier
fakePackageId
        then
          if CabalSpecVersion
specVer CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV2_0 Bool -> Bool -> Bool
&& (ModuleName
mainModName ModuleName -> [ModuleName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ModuleName]
otherModNames)
          then do
             -- The cabal manual clearly states that `other-modules` is
             -- intended for non-main modules.  However, there's at least one
             -- important package on Hackage (happy-1.19.5) which
             -- violates this. We workaround this here so that we don't
             -- invoke GHC with e.g.  'ghc --make Main src/Main.hs' which
             -- would result in GHC complaining about duplicate Main
             -- modules.
             --
             -- Finally, we only enable this workaround for
             -- specVersion < 2, as 'cabal-version:>=2.0' cabal files
             -- have no excuse anymore to keep doing it wrong... ;-)
             Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Enabling workaround for Main module '"
                            FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow ModuleName
mainModName
                            FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' listed in 'other-modules' illegally!"

             BuildSources -> IO BuildSources
forall (m :: * -> *) a. Monad m => a -> m a
return BuildSources :: [FilePath]
-> [FilePath] -> [FilePath] -> [ModuleName] -> BuildSources
BuildSources {
                        cSourcesFiles :: [FilePath]
cSourcesFiles      = BuildInfo -> [FilePath]
cSources BuildInfo
bnfo,
                        cxxSourceFiles :: [FilePath]
cxxSourceFiles     = BuildInfo -> [FilePath]
cxxSources BuildInfo
bnfo,
                        inputSourceFiles :: [FilePath]
inputSourceFiles   = [FilePath
main],
                        inputSourceModules :: [ModuleName]
inputSourceModules = (ModuleName -> Bool) -> [ModuleName] -> [ModuleName]
forall a. (a -> Bool) -> [a] -> [a]
filter (ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
/= ModuleName
mainModName) ([ModuleName] -> [ModuleName]) -> [ModuleName] -> [ModuleName]
forall a b. (a -> b) -> a -> b
$
                                             Executable -> [ModuleName]
exeModules Executable
exe
                    }

          else BuildSources -> IO BuildSources
forall (m :: * -> *) a. Monad m => a -> m a
return BuildSources :: [FilePath]
-> [FilePath] -> [FilePath] -> [ModuleName] -> BuildSources
BuildSources {
                          cSourcesFiles :: [FilePath]
cSourcesFiles      = BuildInfo -> [FilePath]
cSources BuildInfo
bnfo,
                          cxxSourceFiles :: [FilePath]
cxxSourceFiles     = BuildInfo -> [FilePath]
cxxSources BuildInfo
bnfo,
                          inputSourceFiles :: [FilePath]
inputSourceFiles   = [FilePath
main],
                          inputSourceModules :: [ModuleName]
inputSourceModules = Executable -> [ModuleName]
exeModules Executable
exe
                      }
        else let ([FilePath]
csf, [FilePath]
cxxsf)
                   | FilePath -> Bool
isCxx FilePath
main = (       BuildInfo -> [FilePath]
cSources BuildInfo
bnfo, FilePath
main FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: BuildInfo -> [FilePath]
cxxSources BuildInfo
bnfo)
                   -- if main is not a Haskell source
                   -- and main is not a C++ source
                   -- then we assume that it is a C source
                   | Bool
otherwise  = (FilePath
main FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: BuildInfo -> [FilePath]
cSources BuildInfo
bnfo,        BuildInfo -> [FilePath]
cxxSources BuildInfo
bnfo)

             in  BuildSources -> IO BuildSources
forall (m :: * -> *) a. Monad m => a -> m a
return BuildSources :: [FilePath]
-> [FilePath] -> [FilePath] -> [ModuleName] -> BuildSources
BuildSources {
                            cSourcesFiles :: [FilePath]
cSourcesFiles      = [FilePath]
csf,
                            cxxSourceFiles :: [FilePath]
cxxSourceFiles     = [FilePath]
cxxsf,
                            inputSourceFiles :: [FilePath]
inputSourceFiles   = [],
                            inputSourceModules :: [ModuleName]
inputSourceModules = Executable -> [ModuleName]
exeModules Executable
exe
                        }

    flibSources :: ForeignLib -> BuildSources
    flibSources :: ForeignLib -> BuildSources
flibSources flib :: ForeignLib
flib@ForeignLib{foreignLibBuildInfo :: ForeignLib -> BuildInfo
foreignLibBuildInfo = BuildInfo
bnfo} =
        BuildSources :: [FilePath]
-> [FilePath] -> [FilePath] -> [ModuleName] -> BuildSources
BuildSources {
            cSourcesFiles :: [FilePath]
cSourcesFiles      = BuildInfo -> [FilePath]
cSources BuildInfo
bnfo,
            cxxSourceFiles :: [FilePath]
cxxSourceFiles     = BuildInfo -> [FilePath]
cxxSources BuildInfo
bnfo,
            inputSourceFiles :: [FilePath]
inputSourceFiles   = [],
            inputSourceModules :: [ModuleName]
inputSourceModules = ForeignLib -> [ModuleName]
foreignLibModules ForeignLib
flib
        }

    isCxx :: FilePath -> Bool
    isCxx :: FilePath -> Bool
isCxx FilePath
fp = FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (FilePath -> FilePath
takeExtension FilePath
fp) [FilePath
".cpp", FilePath
".cxx", FilePath
".c++"]

-- | FilePath has a Haskell extension: .hs or .lhs
isHaskell :: FilePath -> Bool
isHaskell :: FilePath -> Bool
isHaskell FilePath
fp = FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (FilePath -> FilePath
takeExtension FilePath
fp) [FilePath
".hs", FilePath
".lhs"]

replNoLoad :: Ord a => ReplOptions -> NubListR a -> NubListR a
replNoLoad :: ReplOptions -> NubListR a -> NubListR a
replNoLoad ReplOptions
replFlags NubListR a
l
    | ReplOptions -> Flag Bool
replOptionsNoLoad ReplOptions
replFlags Flag Bool -> Flag Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Flag Bool
forall a. a -> Flag a
Flag Bool
True = NubListR a
forall a. Monoid a => a
mempty
    | Bool
otherwise                                = NubListR a
l

-- | Generic build function. See comment for 'GBuildMode'.
gbuild :: Verbosity          -> Cabal.Flag (Maybe Int)
       -> PackageDescription -> LocalBuildInfo
       -> GBuildMode         -> ComponentLocalBuildInfo -> IO ()
gbuild :: Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> GBuildMode
-> ComponentLocalBuildInfo
-> IO ()
gbuild Verbosity
verbosity Flag (Maybe Int)
numJobs PackageDescription
pkg_descr LocalBuildInfo
lbi GBuildMode
bm ComponentLocalBuildInfo
clbi = do
  (ConfiguredProgram
ghcProg, ProgramDb
_) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
ghcProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
  let replFlags :: ReplOptions
replFlags = case GBuildMode
bm of
          GReplExe ReplOptions
flags Executable
_  -> ReplOptions
flags
          GReplFLib ReplOptions
flags ForeignLib
_ -> ReplOptions
flags
          GBuildExe{}       -> ReplOptions
forall a. Monoid a => a
mempty
          GBuildFLib{}      -> ReplOptions
forall a. Monoid a => a
mempty
      comp :: Compiler
comp       = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
      platform :: Platform
platform   = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
      implInfo :: GhcImplInfo
implInfo   = Compiler -> GhcImplInfo
getImplInfo Compiler
comp
      runGhcProg :: GhcOptions -> IO ()
runGhcProg = Verbosity
-> ConfiguredProgram -> Compiler -> Platform -> GhcOptions -> IO ()
runGHC Verbosity
verbosity ConfiguredProgram
ghcProg Compiler
comp Platform
platform

  let bnfo :: BuildInfo
bnfo = GBuildMode -> BuildInfo
gbuildInfo GBuildMode
bm

  -- the name that GHC really uses (e.g., with .exe on Windows for executables)
  let targetName :: FilePath
targetName = LocalBuildInfo -> GBuildMode -> FilePath
gbuildTargetName LocalBuildInfo
lbi GBuildMode
bm
  let targetDir :: FilePath
targetDir  = LocalBuildInfo -> FilePath
buildDir LocalBuildInfo
lbi FilePath -> FilePath -> FilePath
</> (GBuildMode -> FilePath
gbuildName GBuildMode
bm)
  let tmpDir :: FilePath
tmpDir     = FilePath
targetDir    FilePath -> FilePath -> FilePath
</> (GBuildMode -> FilePath
gbuildName GBuildMode
bm FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-tmp")
  Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
targetDir
  Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
tmpDir

  -- TODO: do we need to put hs-boot files into place for mutually recursive
  -- modules?  FIX: what about exeName.hi-boot?

  -- Determine if program coverage should be enabled and if so, what
  -- '-hpcdir' should be.
  let isCoverageEnabled :: Bool
isCoverageEnabled = LocalBuildInfo -> Bool
exeCoverage LocalBuildInfo
lbi
      distPref :: FilePath
distPref = Flag FilePath -> FilePath
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag FilePath -> FilePath) -> Flag FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag FilePath
configDistPref (ConfigFlags -> Flag FilePath) -> ConfigFlags -> Flag FilePath
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> ConfigFlags
configFlags LocalBuildInfo
lbi
      hpcdir :: Way -> Flag FilePath
hpcdir Way
way
        | GBuildMode -> Bool
gbuildIsRepl GBuildMode
bm   = Flag FilePath
forall a. Monoid a => a
mempty  -- HPC is not supported in ghci
        | Bool
isCoverageEnabled = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag (FilePath -> Flag FilePath) -> FilePath -> Flag FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Way -> FilePath -> FilePath
Hpc.mixDir FilePath
distPref Way
way (GBuildMode -> FilePath
gbuildName GBuildMode
bm)
        | Bool
otherwise         = Flag FilePath
forall a. Monoid a => a
mempty

  NubListR FilePath
rpaths <- LocalBuildInfo -> ComponentLocalBuildInfo -> IO (NubListR FilePath)
getRPaths LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
  BuildSources
buildSources <- Verbosity
-> PackageIdentifier
-> CabalSpecVersion
-> FilePath
-> GBuildMode
-> IO BuildSources
gbuildSources Verbosity
verbosity (PackageDescription -> PackageIdentifier
package PackageDescription
pkg_descr) (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg_descr) FilePath
tmpDir GBuildMode
bm

  let cSrcs :: [FilePath]
cSrcs               = BuildSources -> [FilePath]
cSourcesFiles BuildSources
buildSources
      cxxSrcs :: [FilePath]
cxxSrcs             = BuildSources -> [FilePath]
cxxSourceFiles BuildSources
buildSources
      inputFiles :: [FilePath]
inputFiles          = BuildSources -> [FilePath]
inputSourceFiles BuildSources
buildSources
      inputModules :: [ModuleName]
inputModules        = BuildSources -> [ModuleName]
inputSourceModules BuildSources
buildSources
      isGhcDynamic :: Bool
isGhcDynamic        = Compiler -> Bool
isDynamic Compiler
comp
      dynamicTooSupported :: Bool
dynamicTooSupported = Compiler -> Bool
supportsDynamicToo Compiler
comp
      cLikeObjs :: [FilePath]
cLikeObjs           = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
`replaceExtension` FilePath
objExtension) [FilePath]
cSrcs
      cxxObjs :: [FilePath]
cxxObjs             = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
`replaceExtension` FilePath
objExtension) [FilePath]
cxxSrcs
      needDynamic :: Bool
needDynamic         = LocalBuildInfo -> GBuildMode -> Bool
gbuildNeedDynamic LocalBuildInfo
lbi GBuildMode
bm
      needProfiling :: Bool
needProfiling       = LocalBuildInfo -> Bool
withProfExe LocalBuildInfo
lbi

  -- build executables
      baseOpts :: GhcOptions
baseOpts   = (Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> GhcOptions
componentGhcOptions Verbosity
verbosity LocalBuildInfo
lbi BuildInfo
bnfo ComponentLocalBuildInfo
clbi FilePath
tmpDir)
                    GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                      ghcOptMode :: Flag GhcMode
ghcOptMode         = GhcMode -> Flag GhcMode
forall a. a -> Flag a
toFlag GhcMode
GhcModeMake,
                      ghcOptInputFiles :: NubListR FilePath
ghcOptInputFiles   = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$ if PackageDescription -> PackageIdentifier
package PackageDescription
pkg_descr PackageIdentifier -> PackageIdentifier -> Bool
forall a. Eq a => a -> a -> Bool
== PackageIdentifier
fakePackageId
                                                        then (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
isHaskell [FilePath]
inputFiles
                                                        else [FilePath]
inputFiles,
                      ghcOptInputScripts :: NubListR FilePath
ghcOptInputScripts = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$ if PackageDescription -> PackageIdentifier
package PackageDescription
pkg_descr PackageIdentifier -> PackageIdentifier -> Bool
forall a. Eq a => a -> a -> Bool
== PackageIdentifier
fakePackageId
                                                        then (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
isHaskell) [FilePath]
inputFiles
                                                        else [],
                      ghcOptInputModules :: NubListR ModuleName
ghcOptInputModules = [ModuleName] -> NubListR ModuleName
forall a. Ord a => [a] -> NubListR a
toNubListR [ModuleName]
inputModules
                    }
      staticOpts :: GhcOptions
staticOpts = GhcOptions
baseOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                      ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode    = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcStaticOnly,
                      ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir         = Way -> Flag FilePath
hpcdir Way
Hpc.Vanilla
                   }
      profOpts :: GhcOptions
profOpts   = GhcOptions
baseOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                      ghcOptProfilingMode :: Flag Bool
ghcOptProfilingMode  = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                      ghcOptProfilingAuto :: Flag GhcProfAuto
ghcOptProfilingAuto  = Bool -> ProfDetailLevel -> Flag GhcProfAuto
Internal.profDetailLevelFlag Bool
False
                                             (LocalBuildInfo -> ProfDetailLevel
withProfExeDetail LocalBuildInfo
lbi),
                      ghcOptHiSuffix :: Flag FilePath
ghcOptHiSuffix       = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"p_hi",
                      ghcOptObjSuffix :: Flag FilePath
ghcOptObjSuffix      = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"p_o",
                      ghcOptExtra :: [FilePath]
ghcOptExtra          = CompilerFlavor -> BuildInfo -> [FilePath]
hcProfOptions CompilerFlavor
GHC BuildInfo
bnfo,
                      ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir         = Way -> Flag FilePath
hpcdir Way
Hpc.Prof
                    }
      dynOpts :: GhcOptions
dynOpts    = GhcOptions
baseOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                      ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode    = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcDynamicOnly,
                      -- TODO: Does it hurt to set -fPIC for executables?
                      ghcOptFPic :: Flag Bool
ghcOptFPic           = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                      ghcOptHiSuffix :: Flag FilePath
ghcOptHiSuffix       = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"dyn_hi",
                      ghcOptObjSuffix :: Flag FilePath
ghcOptObjSuffix      = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"dyn_o",
                      ghcOptExtra :: [FilePath]
ghcOptExtra          = CompilerFlavor -> BuildInfo -> [FilePath]
hcSharedOptions CompilerFlavor
GHC BuildInfo
bnfo,
                      ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir         = Way -> Flag FilePath
hpcdir Way
Hpc.Dyn
                    }
      dynTooOpts :: GhcOptions
dynTooOpts = GhcOptions
staticOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                      ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode    = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcStaticAndDynamic,
                      ghcOptDynHiSuffix :: Flag FilePath
ghcOptDynHiSuffix    = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"dyn_hi",
                      ghcOptDynObjSuffix :: Flag FilePath
ghcOptDynObjSuffix   = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"dyn_o",
                      ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir         = Way -> Flag FilePath
hpcdir Way
Hpc.Dyn
                    }
      linkerOpts :: GhcOptions
linkerOpts = GhcOptions
forall a. Monoid a => a
mempty {
                      ghcOptLinkOptions :: [FilePath]
ghcOptLinkOptions       = BuildInfo -> [FilePath]
PD.ldOptions BuildInfo
bnfo
                                                [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [ FilePath
"-static"
                                                   | LocalBuildInfo -> Bool
withFullyStaticExe LocalBuildInfo
lbi ]
                                                -- Pass extra `ld-options` given
                                                -- through to GHC's linker.
                                                [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
-> (ConfiguredProgram -> [FilePath])
-> Maybe ConfiguredProgram
-> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ConfiguredProgram -> [FilePath]
programOverrideArgs
                                                     (Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
ldProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)),
                      ghcOptLinkLibs :: [FilePath]
ghcOptLinkLibs          = if LocalBuildInfo -> Bool
withFullyStaticExe LocalBuildInfo
lbi
                                                  then BuildInfo -> [FilePath]
extraLibsStatic BuildInfo
bnfo
                                                  else BuildInfo -> [FilePath]
extraLibs BuildInfo
bnfo,
                      ghcOptLinkLibPath :: NubListR FilePath
ghcOptLinkLibPath       = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$
                                                  if LocalBuildInfo -> Bool
withFullyStaticExe LocalBuildInfo
lbi
                                                    then BuildInfo -> [FilePath]
extraLibDirsStatic BuildInfo
bnfo
                                                    else BuildInfo -> [FilePath]
extraLibDirs BuildInfo
bnfo,
                      ghcOptLinkFrameworks :: NubListR FilePath
ghcOptLinkFrameworks    = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$
                                                BuildInfo -> [FilePath]
PD.frameworks BuildInfo
bnfo,
                      ghcOptLinkFrameworkDirs :: NubListR FilePath
ghcOptLinkFrameworkDirs = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$
                                                BuildInfo -> [FilePath]
PD.extraFrameworkDirs BuildInfo
bnfo,
                      ghcOptInputFiles :: NubListR FilePath
ghcOptInputFiles     = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR
                                             [FilePath
tmpDir FilePath -> FilePath -> FilePath
</> FilePath
x | FilePath
x <- [FilePath]
cLikeObjs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
cxxObjs]
                    }
      dynLinkerOpts :: GhcOptions
dynLinkerOpts = GhcOptions
forall a. Monoid a => a
mempty {
                      ghcOptRPaths :: NubListR FilePath
ghcOptRPaths         = NubListR FilePath
rpaths,
                      ghcOptInputFiles :: NubListR FilePath
ghcOptInputFiles     = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR
                                             [FilePath
tmpDir FilePath -> FilePath -> FilePath
</> FilePath
x | FilePath
x <- [FilePath]
cLikeObjs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
cxxObjs]
                   }
      replOpts :: GhcOptions
replOpts   = GhcOptions
baseOpts {
                    ghcOptExtra :: [FilePath]
ghcOptExtra            = [FilePath] -> [FilePath]
Internal.filterGhciFlags
                                             (GhcOptions -> [FilePath]
ghcOptExtra GhcOptions
baseOpts)
                                             [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> ReplOptions -> [FilePath]
replOptionsFlags ReplOptions
replFlags,
                    ghcOptInputModules :: NubListR ModuleName
ghcOptInputModules     = ReplOptions -> NubListR ModuleName -> NubListR ModuleName
forall a. Ord a => ReplOptions -> NubListR a -> NubListR a
replNoLoad ReplOptions
replFlags (GhcOptions -> NubListR ModuleName
ghcOptInputModules GhcOptions
baseOpts),
                    ghcOptInputFiles :: NubListR FilePath
ghcOptInputFiles       = ReplOptions -> NubListR FilePath -> NubListR FilePath
forall a. Ord a => ReplOptions -> NubListR a -> NubListR a
replNoLoad ReplOptions
replFlags (GhcOptions -> NubListR FilePath
ghcOptInputFiles GhcOptions
baseOpts)
                   }
                   -- For a normal compile we do separate invocations of ghc for
                   -- compiling as for linking. But for repl we have to do just
                   -- the one invocation, so that one has to include all the
                   -- linker stuff too, like -l flags and any .o files from C
                   -- files etc.
                   GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
linkerOpts
                   GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                      ghcOptMode :: Flag GhcMode
ghcOptMode         = GhcMode -> Flag GhcMode
forall a. a -> Flag a
toFlag GhcMode
GhcModeInteractive,
                      ghcOptOptimisation :: Flag GhcOptimisation
ghcOptOptimisation = GhcOptimisation -> Flag GhcOptimisation
forall a. a -> Flag a
toFlag GhcOptimisation
GhcNoOptimisation
                     }
      commonOpts :: GhcOptions
commonOpts  | Bool
needProfiling = GhcOptions
profOpts
                  | Bool
needDynamic   = GhcOptions
dynOpts
                  | Bool
otherwise     = GhcOptions
staticOpts
      compileOpts :: GhcOptions
compileOpts | Bool
useDynToo = GhcOptions
dynTooOpts
                  | Bool
otherwise = GhcOptions
commonOpts
      withStaticExe :: Bool
withStaticExe = Bool -> Bool
not Bool
needProfiling Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
needDynamic

      -- For building exe's that use TH with -prof or -dynamic we actually have
      -- to build twice, once without -prof/-dynamic and then again with
      -- -prof/-dynamic. This is because the code that TH needs to run at
      -- compile time needs to be the vanilla ABI so it can be loaded up and run
      -- by the compiler.
      -- With dynamic-by-default GHC the TH object files loaded at compile-time
      -- need to be .dyn_o instead of .o.
      doingTH :: Bool
doingTH = BuildInfo -> Bool
usesTemplateHaskellOrQQ BuildInfo
bnfo
      -- Should we use -dynamic-too instead of compiling twice?
      useDynToo :: Bool
useDynToo = Bool
dynamicTooSupported Bool -> Bool -> Bool
&& Bool
isGhcDynamic
                  Bool -> Bool -> Bool
&& Bool
doingTH Bool -> Bool -> Bool
&& Bool
withStaticExe
                  Bool -> Bool -> Bool
&& [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CompilerFlavor -> BuildInfo -> [FilePath]
hcSharedOptions CompilerFlavor
GHC BuildInfo
bnfo)
      compileTHOpts :: GhcOptions
compileTHOpts | Bool
isGhcDynamic = GhcOptions
dynOpts
                    | Bool
otherwise    = GhcOptions
staticOpts
      compileForTH :: Bool
compileForTH
        | GBuildMode -> Bool
gbuildIsRepl GBuildMode
bm = Bool
False
        | Bool
useDynToo       = Bool
False
        | Bool
isGhcDynamic    = Bool
doingTH Bool -> Bool -> Bool
&& (Bool
needProfiling Bool -> Bool -> Bool
|| Bool
withStaticExe)
        | Bool
otherwise       = Bool
doingTH Bool -> Bool -> Bool
&& (Bool
needProfiling Bool -> Bool -> Bool
|| Bool
needDynamic)

   -- Build static/dynamic object files for TH, if needed.
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
compileForTH (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    GhcOptions -> IO ()
runGhcProg GhcOptions
compileTHOpts { ghcOptNoLink :: Flag Bool
ghcOptNoLink  = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True
                             , ghcOptNumJobs :: Flag (Maybe Int)
ghcOptNumJobs = Flag (Maybe Int)
numJobs }

  -- Do not try to build anything if there are no input files.
  -- This can happen if the cabal file ends up with only cSrcs
  -- but no Haskell modules.
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
inputFiles Bool -> Bool -> Bool
&& [ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleName]
inputModules)
          Bool -> Bool -> Bool
|| GBuildMode -> Bool
gbuildIsRepl GBuildMode
bm) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    GhcOptions -> IO ()
runGhcProg GhcOptions
compileOpts { ghcOptNoLink :: Flag Bool
ghcOptNoLink  = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True
                           , ghcOptNumJobs :: Flag (Maybe Int)
ghcOptNumJobs = Flag (Maybe Int)
numJobs }

  -- build any C++ sources
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
cxxSrcs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
   Verbosity -> FilePath -> IO ()
info Verbosity
verbosity FilePath
"Building C++ Sources..."
   [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
     [ do let baseCxxOpts :: GhcOptions
baseCxxOpts    = Verbosity
-> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> GhcOptions
Internal.componentCxxGhcOptions Verbosity
verbosity GhcImplInfo
implInfo
                               LocalBuildInfo
lbi BuildInfo
bnfo ComponentLocalBuildInfo
clbi FilePath
tmpDir FilePath
filename
              vanillaCxxOpts :: GhcOptions
vanillaCxxOpts = if Bool
isGhcDynamic
                                -- Dynamic GHC requires C++ sources to be built
                                -- with -fPIC for REPL to work. See #2207.
                               then GhcOptions
baseCxxOpts { ghcOptFPic :: Flag Bool
ghcOptFPic = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True }
                               else GhcOptions
baseCxxOpts
              profCxxOpts :: GhcOptions
profCxxOpts    = GhcOptions
vanillaCxxOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                                 ghcOptProfilingMode :: Flag Bool
ghcOptProfilingMode = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True
                               }
              sharedCxxOpts :: GhcOptions
sharedCxxOpts  = GhcOptions
vanillaCxxOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                                 ghcOptFPic :: Flag Bool
ghcOptFPic        = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                                 ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcDynamicOnly
                               }
              opts :: GhcOptions
opts | Bool
needProfiling = GhcOptions
profCxxOpts
                   | Bool
needDynamic   = GhcOptions
sharedCxxOpts
                   | Bool
otherwise     = GhcOptions
vanillaCxxOpts
              -- TODO: Placing all Haskell, C, & C++ objects in a single directory
              --       Has the potential for file collisions. In general we would
              --       consider this a user error. However, we should strive to
              --       add a warning if this occurs.
              odir :: FilePath
odir = Flag FilePath -> FilePath
forall a. WithCallStack (Flag a -> a)
fromFlag (GhcOptions -> Flag FilePath
ghcOptObjDir GhcOptions
opts)
          Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
odir
          Bool
needsRecomp <- FilePath -> GhcOptions -> IO Bool
checkNeedsRecompilation FilePath
filename GhcOptions
opts
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needsRecomp (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            GhcOptions -> IO ()
runGhcProg GhcOptions
opts
     | FilePath
filename <- [FilePath]
cxxSrcs ]

  -- build any C sources
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
cSrcs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
   Verbosity -> FilePath -> IO ()
info Verbosity
verbosity FilePath
"Building C Sources..."
   [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
     [ do let baseCcOpts :: GhcOptions
baseCcOpts    = Verbosity
-> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> GhcOptions
Internal.componentCcGhcOptions Verbosity
verbosity GhcImplInfo
implInfo
                              LocalBuildInfo
lbi BuildInfo
bnfo ComponentLocalBuildInfo
clbi FilePath
tmpDir FilePath
filename
              vanillaCcOpts :: GhcOptions
vanillaCcOpts = if Bool
isGhcDynamic
                              -- Dynamic GHC requires C sources to be built
                              -- with -fPIC for REPL to work. See #2207.
                              then GhcOptions
baseCcOpts { ghcOptFPic :: Flag Bool
ghcOptFPic = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True }
                              else GhcOptions
baseCcOpts
              profCcOpts :: GhcOptions
profCcOpts    = GhcOptions
vanillaCcOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                                ghcOptProfilingMode :: Flag Bool
ghcOptProfilingMode = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True
                              }
              sharedCcOpts :: GhcOptions
sharedCcOpts  = GhcOptions
vanillaCcOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                                ghcOptFPic :: Flag Bool
ghcOptFPic        = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                                ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcDynamicOnly
                              }
              opts :: GhcOptions
opts | Bool
needProfiling = GhcOptions
profCcOpts
                   | Bool
needDynamic   = GhcOptions
sharedCcOpts
                   | Bool
otherwise     = GhcOptions
vanillaCcOpts
              odir :: FilePath
odir = Flag FilePath -> FilePath
forall a. WithCallStack (Flag a -> a)
fromFlag (GhcOptions -> Flag FilePath
ghcOptObjDir GhcOptions
opts)
          Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
odir
          Bool
needsRecomp <- FilePath -> GhcOptions -> IO Bool
checkNeedsRecompilation FilePath
filename GhcOptions
opts
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needsRecomp (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            GhcOptions -> IO ()
runGhcProg GhcOptions
opts
     | FilePath
filename <- [FilePath]
cSrcs ]

  -- TODO: problem here is we need the .c files built first, so we can load them
  -- with ghci, but .c files can depend on .h files generated by ghc by ffi
  -- exports.
  case GBuildMode
bm of
    GReplExe  ReplOptions
_ Executable
_ -> GhcOptions -> IO ()
runGhcProg GhcOptions
replOpts
    GReplFLib ReplOptions
_ ForeignLib
_ -> GhcOptions -> IO ()
runGhcProg GhcOptions
replOpts
    GBuildExe Executable
_ -> do
      let linkOpts :: GhcOptions
linkOpts = GhcOptions
commonOpts
                   GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
linkerOpts
                   GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                      ghcOptLinkNoHsMain :: Flag Bool
ghcOptLinkNoHsMain = Bool -> Flag Bool
forall a. a -> Flag a
toFlag ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
inputFiles)
                     }
                   GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` (if LocalBuildInfo -> Bool
withDynExe LocalBuildInfo
lbi then GhcOptions
dynLinkerOpts else GhcOptions
forall a. Monoid a => a
mempty)

      Verbosity -> FilePath -> IO ()
info Verbosity
verbosity FilePath
"Linking..."
      -- Work around old GHCs not relinking in this
      -- situation, see #3294
      let target :: FilePath
target = FilePath
targetDir FilePath -> FilePath -> FilePath
</> FilePath
targetName
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Compiler -> Version
compilerVersion Compiler
comp Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
7,Int
7]) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Bool
e <- FilePath -> IO Bool
doesFileExist FilePath
target
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
e (FilePath -> IO ()
removeFile FilePath
target)
      GhcOptions -> IO ()
runGhcProg GhcOptions
linkOpts { ghcOptOutputFile :: Flag FilePath
ghcOptOutputFile = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
target }
    GBuildFLib ForeignLib
flib -> do
      let -- Instruct GHC to link against libHSrts.
          rtsLinkOpts :: GhcOptions
          rtsLinkOpts :: GhcOptions
rtsLinkOpts
            | Bool
supportsFLinkRts =
              GhcOptions
forall a. Monoid a => a
mempty {
                 ghcOptLinkRts :: Flag Bool
ghcOptLinkRts         = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True
              }
            | Bool
otherwise =
              GhcOptions
forall a. Monoid a => a
mempty {
                 ghcOptLinkLibs :: [FilePath]
ghcOptLinkLibs        = [FilePath]
rtsOptLinkLibs,
                 ghcOptLinkLibPath :: NubListR FilePath
ghcOptLinkLibPath     = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$ RtsInfo -> [FilePath]
rtsLibPaths RtsInfo
rtsInfo
              }
            where
              threaded :: Bool
threaded = BuildInfo -> Bool
hasThreaded (GBuildMode -> BuildInfo
gbuildInfo GBuildMode
bm)
              supportsFLinkRts :: Bool
supportsFLinkRts = Compiler -> Version
compilerVersion Compiler
comp Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
9,Int
0]
              rtsInfo :: RtsInfo
rtsInfo  = LocalBuildInfo -> RtsInfo
extractRtsInfo LocalBuildInfo
lbi
              rtsOptLinkLibs :: [FilePath]
rtsOptLinkLibs = [
                  if Bool
needDynamic
                      then if Bool
threaded
                                then DynamicRtsInfo -> FilePath
dynRtsThreadedLib (RtsInfo -> DynamicRtsInfo
rtsDynamicInfo RtsInfo
rtsInfo)
                                else DynamicRtsInfo -> FilePath
dynRtsVanillaLib (RtsInfo -> DynamicRtsInfo
rtsDynamicInfo RtsInfo
rtsInfo)
                      else if Bool
threaded
                               then StaticRtsInfo -> FilePath
statRtsThreadedLib (RtsInfo -> StaticRtsInfo
rtsStaticInfo RtsInfo
rtsInfo)
                               else StaticRtsInfo -> FilePath
statRtsVanillaLib (RtsInfo -> StaticRtsInfo
rtsStaticInfo RtsInfo
rtsInfo)
                  ]


          linkOpts :: GhcOptions
          linkOpts :: GhcOptions
linkOpts = case ForeignLib -> ForeignLibType
foreignLibType ForeignLib
flib of
            ForeignLibType
ForeignLibNativeShared ->
                        GhcOptions
commonOpts
              GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
linkerOpts
              GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
dynLinkerOpts
              GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
rtsLinkOpts
              GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                 ghcOptLinkNoHsMain :: Flag Bool
ghcOptLinkNoHsMain    = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                 ghcOptShared :: Flag Bool
ghcOptShared          = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                 ghcOptFPic :: Flag Bool
ghcOptFPic            = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                 ghcOptLinkModDefFiles :: NubListR FilePath
ghcOptLinkModDefFiles = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$ GBuildMode -> [FilePath]
gbuildModDefFiles GBuildMode
bm
                }
              -- See Note [RPATH]
              GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` LocalBuildInfo -> GhcOptions -> GhcOptions
forall a. Monoid a => LocalBuildInfo -> a -> a
ifNeedsRPathWorkaround LocalBuildInfo
lbi GhcOptions
forall a. Monoid a => a
mempty {
                  ghcOptLinkOptions :: [FilePath]
ghcOptLinkOptions = [FilePath
"-Wl,--no-as-needed"]
                , ghcOptLinkLibs :: [FilePath]
ghcOptLinkLibs    = [FilePath
"ffi"]
                }
            ForeignLibType
ForeignLibNativeStatic ->
              -- this should be caught by buildFLib
              -- (and if we do implement this, we probably don't even want to call
              -- ghc here, but rather Ar.createArLibArchive or something)
              FilePath -> GhcOptions
forall a. FilePath -> a
cabalBug FilePath
"static libraries not yet implemented"
            ForeignLibType
ForeignLibTypeUnknown ->
              FilePath -> GhcOptions
forall a. FilePath -> a
cabalBug FilePath
"unknown foreign lib type"
      -- We build under a (potentially) different filename to set a
      -- soname on supported platforms.  See also the note for
      -- @flibBuildName@.
      Verbosity -> FilePath -> IO ()
info Verbosity
verbosity FilePath
"Linking..."
      let buildName :: FilePath
buildName = LocalBuildInfo -> ForeignLib -> FilePath
flibBuildName LocalBuildInfo
lbi ForeignLib
flib
      GhcOptions -> IO ()
runGhcProg GhcOptions
linkOpts { ghcOptOutputFile :: Flag FilePath
ghcOptOutputFile = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag (FilePath
targetDir FilePath -> FilePath -> FilePath
</> FilePath
buildName) }
      FilePath -> FilePath -> IO ()
renameFile (FilePath
targetDir FilePath -> FilePath -> FilePath
</> FilePath
buildName) (FilePath
targetDir FilePath -> FilePath -> FilePath
</> FilePath
targetName)

{-
Note [RPATH]
~~~~~~~~~~~~

Suppose that the dynamic library depends on `base`, but not (directly) on
`integer-gmp` (which, however, is a dependency of `base`). We will link the
library as

    gcc ... -lHSbase-4.7.0.2-ghc7.8.4 -lHSinteger-gmp-0.5.1.0-ghc7.8.4 ...

However, on systems (like Ubuntu) where the linker gets called with `-as-needed`
by default, the linker will notice that `integer-gmp` isn't actually a direct
dependency and hence omit the link.

Then when we attempt to link a C program against this dynamic library, the
_static_ linker will attempt to verify that all symbols can be resolved.  The
dynamic library itself does not require any symbols from `integer-gmp`, but
`base` does. In order to verify that the symbols used by `base` can be
resolved, the static linker needs to be able to _find_ integer-gmp.

Finding the `base` dependency is simple, because the dynamic elf header
(`readelf -d`) for the library that we have created looks something like

    (NEEDED) Shared library: [libHSbase-4.7.0.2-ghc7.8.4.so]
    (RPATH)  Library rpath: [/path/to/base-4.7.0.2:...]

However, when it comes to resolving the dependency on `integer-gmp`, it needs
to look at the dynamic header for `base`. On modern ghc (7.8 and higher) this
looks something like

    (NEEDED) Shared library: [libHSinteger-gmp-0.5.1.0-ghc7.8.4.so]
    (RPATH)  Library rpath: [$ORIGIN/../integer-gmp-0.5.1.0:...]

This specifies the location of `integer-gmp` _in terms of_ the location of base
(using the `$ORIGIN`) variable. But here's the crux: when the static linker
attempts to verify that all symbols can be resolved, [**IT DOES NOT RESOLVE
`$ORIGIN`**](http://stackoverflow.com/questions/6323603/ld-using-rpath-origin-inside-a-shared-library-recursive).
As a consequence, it will not be able to resolve the symbols and report the
missing symbols as errors, _even though the dynamic linker **would** be able to
resolve these symbols_. We can tell the static linker not to report these
errors by using `--unresolved-symbols=ignore-all` and all will be fine when we
run the program ([(indeed, this is what the gold linker
does)](https://sourceware.org/ml/binutils/2013-05/msg00038.html), but it makes
the resulting library more difficult to use.

Instead what we can do is make sure that the generated dynamic library has
explicit top-level dependencies on these libraries. This means that the static
linker knows where to find them, and when we have transitive dependencies on
the same libraries the linker will only load them once, so we avoid needing to
look at the `RPATH` of our dependencies. We can do this by passing
`--no-as-needed` to the linker, so that it doesn't omit any libraries.

Note that on older ghc (7.6 and before) the Haskell libraries don't have an
RPATH set at all, which makes it even more important that we make these
top-level dependencies.

Finally, we have to explicitly link against `libffi` for the same reason. For
newer ghc this _happens_ to be unnecessary on many systems because `libffi` is
a library which is not specific to GHC, and when the static linker verifies
that all symbols can be resolved it will find the `libffi` that is globally
installed (completely independent from ghc). Of course, this may well be the
_wrong_ version of `libffi`, but it's quite possible that symbol resolution
happens to work. This is of course the wrong approach, which is why we link
explicitly against `libffi` so that we will find the _right_ version of
`libffi`.
-}

-- | Do we need the RPATH workaround?
--
-- See Note [RPATH].
ifNeedsRPathWorkaround :: Monoid a => LocalBuildInfo -> a -> a
ifNeedsRPathWorkaround :: LocalBuildInfo -> a -> a
ifNeedsRPathWorkaround LocalBuildInfo
lbi a
a =
  case LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi of
    Platform Arch
_ OS
Linux -> a
a
    Platform
_otherwise       -> a
forall a. Monoid a => a
mempty

data DynamicRtsInfo = DynamicRtsInfo {
    DynamicRtsInfo -> FilePath
dynRtsVanillaLib          :: FilePath
  , DynamicRtsInfo -> FilePath
dynRtsThreadedLib         :: FilePath
  , DynamicRtsInfo -> FilePath
dynRtsDebugLib            :: FilePath
  , DynamicRtsInfo -> FilePath
dynRtsEventlogLib         :: FilePath
  , DynamicRtsInfo -> FilePath
dynRtsThreadedDebugLib    :: FilePath
  , DynamicRtsInfo -> FilePath
dynRtsThreadedEventlogLib :: FilePath
  }

data StaticRtsInfo = StaticRtsInfo {
    StaticRtsInfo -> FilePath
statRtsVanillaLib           :: FilePath
  , StaticRtsInfo -> FilePath
statRtsThreadedLib          :: FilePath
  , StaticRtsInfo -> FilePath
statRtsDebugLib             :: FilePath
  , StaticRtsInfo -> FilePath
statRtsEventlogLib          :: FilePath
  , StaticRtsInfo -> FilePath
statRtsThreadedDebugLib     :: FilePath
  , StaticRtsInfo -> FilePath
statRtsThreadedEventlogLib  :: FilePath
  , StaticRtsInfo -> FilePath
statRtsProfilingLib         :: FilePath
  , StaticRtsInfo -> FilePath
statRtsThreadedProfilingLib :: FilePath
  }

data RtsInfo = RtsInfo {
    RtsInfo -> DynamicRtsInfo
rtsDynamicInfo :: DynamicRtsInfo
  , RtsInfo -> StaticRtsInfo
rtsStaticInfo  :: StaticRtsInfo
  , RtsInfo -> [FilePath]
rtsLibPaths    :: [FilePath]
  }

-- | Extract (and compute) information about the RTS library
--
-- TODO: This hardcodes the name as @HSrts-ghc<version>@. I don't know if we can
-- find this information somewhere. We can lookup the 'hsLibraries' field of
-- 'InstalledPackageInfo' but it will tell us @["HSrts", "Cffi"]@, which
-- doesn't really help.
extractRtsInfo :: LocalBuildInfo -> RtsInfo
extractRtsInfo :: LocalBuildInfo -> RtsInfo
extractRtsInfo LocalBuildInfo
lbi =
    case InstalledPackageIndex
-> PackageName -> [(Version, [InstalledPackageInfo])]
forall a. PackageIndex a -> PackageName -> [(Version, [a])]
PackageIndex.lookupPackageName
         (LocalBuildInfo -> InstalledPackageIndex
installedPkgs LocalBuildInfo
lbi) (FilePath -> PackageName
mkPackageName FilePath
"rts") of
      [(Version
_, [InstalledPackageInfo
rts])] -> InstalledPackageInfo -> RtsInfo
aux InstalledPackageInfo
rts
      [(Version, [InstalledPackageInfo])]
_otherwise   -> FilePath -> RtsInfo
forall a. HasCallStack => FilePath -> a
error FilePath
"No (or multiple) ghc rts package is registered"
  where
    aux :: InstalledPackageInfo -> RtsInfo
    aux :: InstalledPackageInfo -> RtsInfo
aux InstalledPackageInfo
rts = RtsInfo :: DynamicRtsInfo -> StaticRtsInfo -> [FilePath] -> RtsInfo
RtsInfo {
        rtsDynamicInfo :: DynamicRtsInfo
rtsDynamicInfo = DynamicRtsInfo :: FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> DynamicRtsInfo
DynamicRtsInfo {
            dynRtsVanillaLib :: FilePath
dynRtsVanillaLib          = FilePath -> FilePath
withGhcVersion FilePath
"HSrts"
          , dynRtsThreadedLib :: FilePath
dynRtsThreadedLib         = FilePath -> FilePath
withGhcVersion FilePath
"HSrts_thr"
          , dynRtsDebugLib :: FilePath
dynRtsDebugLib            = FilePath -> FilePath
withGhcVersion FilePath
"HSrts_debug"
          , dynRtsEventlogLib :: FilePath
dynRtsEventlogLib         = FilePath -> FilePath
withGhcVersion FilePath
"HSrts_l"
          , dynRtsThreadedDebugLib :: FilePath
dynRtsThreadedDebugLib    = FilePath -> FilePath
withGhcVersion FilePath
"HSrts_thr_debug"
          , dynRtsThreadedEventlogLib :: FilePath
dynRtsThreadedEventlogLib = FilePath -> FilePath
withGhcVersion FilePath
"HSrts_thr_l"
          }
      , rtsStaticInfo :: StaticRtsInfo
rtsStaticInfo = StaticRtsInfo :: FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> StaticRtsInfo
StaticRtsInfo {
            statRtsVanillaLib :: FilePath
statRtsVanillaLib           = FilePath
"HSrts"
          , statRtsThreadedLib :: FilePath
statRtsThreadedLib          = FilePath
"HSrts_thr"
          , statRtsDebugLib :: FilePath
statRtsDebugLib             = FilePath
"HSrts_debug"
          , statRtsEventlogLib :: FilePath
statRtsEventlogLib          = FilePath
"HSrts_l"
          , statRtsThreadedDebugLib :: FilePath
statRtsThreadedDebugLib     = FilePath
"HSrts_thr_debug"
          , statRtsThreadedEventlogLib :: FilePath
statRtsThreadedEventlogLib  = FilePath
"HSrts_thr_l"
          , statRtsProfilingLib :: FilePath
statRtsProfilingLib         = FilePath
"HSrts_p"
          , statRtsThreadedProfilingLib :: FilePath
statRtsThreadedProfilingLib = FilePath
"HSrts_thr_p"
          }
      , rtsLibPaths :: [FilePath]
rtsLibPaths   = InstalledPackageInfo -> [FilePath]
InstalledPackageInfo.libraryDirs InstalledPackageInfo
rts
      }
    withGhcVersion :: FilePath -> FilePath
withGhcVersion = (FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (FilePath
"-ghc" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (Compiler -> Version
compilerVersion (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi))))

-- | Returns True if the modification date of the given source file is newer than
-- the object file we last compiled for it, or if no object file exists yet.
checkNeedsRecompilation :: FilePath -> GhcOptions -> IO Bool
checkNeedsRecompilation :: FilePath -> GhcOptions -> IO Bool
checkNeedsRecompilation FilePath
filename GhcOptions
opts = FilePath
filename FilePath -> FilePath -> IO Bool
`moreRecentFile` FilePath
oname
    where oname :: FilePath
oname = FilePath -> GhcOptions -> FilePath
getObjectFileName FilePath
filename GhcOptions
opts

-- | Finds the object file name of the given source file
getObjectFileName :: FilePath -> GhcOptions -> FilePath
getObjectFileName :: FilePath -> GhcOptions -> FilePath
getObjectFileName FilePath
filename GhcOptions
opts = FilePath
oname
    where odir :: FilePath
odir  = Flag FilePath -> FilePath
forall a. WithCallStack (Flag a -> a)
fromFlag (GhcOptions -> Flag FilePath
ghcOptObjDir GhcOptions
opts)
          oext :: FilePath
oext  = FilePath -> Flag FilePath -> FilePath
forall a. a -> Flag a -> a
fromFlagOrDefault FilePath
"o" (GhcOptions -> Flag FilePath
ghcOptObjSuffix GhcOptions
opts)
          oname :: FilePath
oname = FilePath
odir FilePath -> FilePath -> FilePath
</> FilePath -> FilePath -> FilePath
replaceExtension FilePath
filename FilePath
oext

-- | Calculate the RPATHs for the component we are building.
--
-- Calculates relative RPATHs when 'relocatable' is set.
getRPaths :: LocalBuildInfo
          -> ComponentLocalBuildInfo -- ^ Component we are building
          -> IO (NubListR FilePath)
getRPaths :: LocalBuildInfo -> ComponentLocalBuildInfo -> IO (NubListR FilePath)
getRPaths LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi | OS -> Bool
supportRPaths OS
hostOS = do
    [FilePath]
libraryPaths <- Bool
-> Bool
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> IO [FilePath]
depLibraryPaths Bool
False (LocalBuildInfo -> Bool
relocatable LocalBuildInfo
lbi) LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
    let hostPref :: FilePath
hostPref = case OS
hostOS of
                     OS
OSX -> FilePath
"@loader_path"
                     OS
_   -> FilePath
"$ORIGIN"
        relPath :: FilePath -> FilePath
relPath FilePath
p = if FilePath -> Bool
isRelative FilePath
p then FilePath
hostPref FilePath -> FilePath -> FilePath
</> FilePath
p else FilePath
p
        rpaths :: NubListR FilePath
rpaths    = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
relPath [FilePath]
libraryPaths)
    NubListR FilePath -> IO (NubListR FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return NubListR FilePath
rpaths
  where
    (Platform Arch
_ OS
hostOS) = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
    compid :: CompilerId
compid              = Compiler -> CompilerId
compilerId (Compiler -> CompilerId)
-> (LocalBuildInfo -> Compiler) -> LocalBuildInfo -> CompilerId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalBuildInfo -> Compiler
compiler (LocalBuildInfo -> CompilerId) -> LocalBuildInfo -> CompilerId
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo
lbi

    -- The list of RPath-supported operating systems below reflects the
    -- platforms on which Cabal's RPATH handling is tested. It does _NOT_
    -- reflect whether the OS supports RPATH.

    -- E.g. when this comment was written, the *BSD operating systems were
    -- untested with regards to Cabal RPATH handling, and were hence set to
    -- 'False', while those operating systems themselves do support RPATH.
    supportRPaths :: OS -> Bool
supportRPaths OS
Linux       = Bool
True
    supportRPaths OS
Windows     = Bool
False
    supportRPaths OS
OSX         = Bool
True
    supportRPaths OS
FreeBSD     =
      case CompilerId
compid of
        CompilerId CompilerFlavor
GHC Version
ver | Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
7,Int
10,Int
2] -> Bool
True
        CompilerId
_                                              -> Bool
False
    supportRPaths OS
OpenBSD     = Bool
False
    supportRPaths OS
NetBSD      = Bool
False
    supportRPaths OS
DragonFly   = Bool
False
    supportRPaths OS
Solaris     = Bool
False
    supportRPaths OS
AIX         = Bool
False
    supportRPaths OS
HPUX        = Bool
False
    supportRPaths OS
IRIX        = Bool
False
    supportRPaths OS
HaLVM       = Bool
False
    supportRPaths OS
IOS         = Bool
False
    supportRPaths OS
Android     = Bool
False
    supportRPaths OS
Ghcjs       = Bool
False
    supportRPaths OS
Wasi        = Bool
False
    supportRPaths OS
Hurd        = Bool
False
    supportRPaths (OtherOS FilePath
_) = Bool
False
    -- Do _not_ add a default case so that we get a warning here when a new OS
    -- is added.

getRPaths LocalBuildInfo
_ ComponentLocalBuildInfo
_ = NubListR FilePath -> IO (NubListR FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return NubListR FilePath
forall a. Monoid a => a
mempty

-- | Determine whether the given 'BuildInfo' is intended to link against the
-- threaded RTS. This is used to determine which RTS to link against when
-- building a foreign library with a GHC without support for @-flink-rts@.
hasThreaded :: BuildInfo -> Bool
hasThreaded :: BuildInfo -> Bool
hasThreaded BuildInfo
bi = FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem FilePath
"-threaded" [FilePath]
ghc
  where
    PerCompilerFlavor [FilePath]
ghc [FilePath]
_ = BuildInfo -> PerCompilerFlavor [FilePath]
options BuildInfo
bi

-- | Extracts a String representing a hash of the ABI of a built
-- library.  It can fail if the library has not yet been built.
--
libAbiHash :: Verbosity -> PackageDescription -> LocalBuildInfo
           -> Library -> ComponentLocalBuildInfo -> IO String
libAbiHash :: Verbosity
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO FilePath
libAbiHash Verbosity
verbosity PackageDescription
_pkg_descr LocalBuildInfo
lbi Library
lib ComponentLocalBuildInfo
clbi = do
  let
      libBi :: BuildInfo
libBi = Library -> BuildInfo
libBuildInfo Library
lib
      comp :: Compiler
comp        = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
      platform :: Platform
platform    = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
      vanillaArgs0 :: GhcOptions
vanillaArgs0 =
        (Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> GhcOptions
componentGhcOptions Verbosity
verbosity LocalBuildInfo
lbi BuildInfo
libBi ComponentLocalBuildInfo
clbi (LocalBuildInfo -> ComponentLocalBuildInfo -> FilePath
componentBuildDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi))
        GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
          ghcOptMode :: Flag GhcMode
ghcOptMode         = GhcMode -> Flag GhcMode
forall a. a -> Flag a
toFlag GhcMode
GhcModeAbiHash,
          ghcOptInputModules :: NubListR ModuleName
ghcOptInputModules = [ModuleName] -> NubListR ModuleName
forall a. Ord a => [a] -> NubListR a
toNubListR ([ModuleName] -> NubListR ModuleName)
-> [ModuleName] -> NubListR ModuleName
forall a b. (a -> b) -> a -> b
$ Library -> [ModuleName]
exposedModules Library
lib
        }
      vanillaArgs :: GhcOptions
vanillaArgs =
          -- Package DBs unnecessary, and break ghc-cabal. See #3633
          -- BUT, put at least the global database so that 7.4 doesn't
          -- break.
          GhcOptions
vanillaArgs0 { ghcOptPackageDBs :: [PackageDB]
ghcOptPackageDBs = [PackageDB
GlobalPackageDB]
                       , ghcOptPackages :: NubListR (OpenUnitId, ModuleRenaming)
ghcOptPackages = NubListR (OpenUnitId, ModuleRenaming)
forall a. Monoid a => a
mempty }
      sharedArgs :: GhcOptions
sharedArgs = GhcOptions
vanillaArgs GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                       ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcDynamicOnly,
                       ghcOptFPic :: Flag Bool
ghcOptFPic        = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                       ghcOptHiSuffix :: Flag FilePath
ghcOptHiSuffix    = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"dyn_hi",
                       ghcOptObjSuffix :: Flag FilePath
ghcOptObjSuffix   = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"dyn_o",
                       ghcOptExtra :: [FilePath]
ghcOptExtra       = CompilerFlavor -> BuildInfo -> [FilePath]
hcSharedOptions CompilerFlavor
GHC BuildInfo
libBi
                   }
      profArgs :: GhcOptions
profArgs   = GhcOptions
vanillaArgs GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                     ghcOptProfilingMode :: Flag Bool
ghcOptProfilingMode = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                     ghcOptProfilingAuto :: Flag GhcProfAuto
ghcOptProfilingAuto = Bool -> ProfDetailLevel -> Flag GhcProfAuto
Internal.profDetailLevelFlag Bool
True
                                             (LocalBuildInfo -> ProfDetailLevel
withProfLibDetail LocalBuildInfo
lbi),
                     ghcOptHiSuffix :: Flag FilePath
ghcOptHiSuffix      = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"p_hi",
                     ghcOptObjSuffix :: Flag FilePath
ghcOptObjSuffix     = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"p_o",
                     ghcOptExtra :: [FilePath]
ghcOptExtra         = CompilerFlavor -> BuildInfo -> [FilePath]
hcProfOptions CompilerFlavor
GHC BuildInfo
libBi
                   }
      ghcArgs :: GhcOptions
ghcArgs
        | LocalBuildInfo -> Bool
withVanillaLib LocalBuildInfo
lbi = GhcOptions
vanillaArgs
        | LocalBuildInfo -> Bool
withSharedLib LocalBuildInfo
lbi = GhcOptions
sharedArgs
        | LocalBuildInfo -> Bool
withProfLib LocalBuildInfo
lbi = GhcOptions
profArgs
        | Bool
otherwise = FilePath -> GhcOptions
forall a. HasCallStack => FilePath -> a
error FilePath
"libAbiHash: Can't find an enabled library way"

  (ConfiguredProgram
ghcProg, ProgramDb
_) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
ghcProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
  FilePath
hash <- Verbosity -> ProgramInvocation -> IO FilePath
getProgramInvocationOutput Verbosity
verbosity
          (ConfiguredProgram
-> Compiler -> Platform -> GhcOptions -> ProgramInvocation
ghcInvocation ConfiguredProgram
ghcProg Compiler
comp Platform
platform GhcOptions
ghcArgs)
  FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) FilePath
hash)

componentGhcOptions :: Verbosity -> LocalBuildInfo
                    -> BuildInfo -> ComponentLocalBuildInfo -> FilePath
                    -> GhcOptions
componentGhcOptions :: Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> GhcOptions
componentGhcOptions Verbosity
verbosity LocalBuildInfo
lbi =
  Verbosity
-> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> GhcOptions
Internal.componentGhcOptions Verbosity
verbosity GhcImplInfo
implInfo LocalBuildInfo
lbi
  where
    comp :: Compiler
comp     = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
    implInfo :: GhcImplInfo
implInfo = Compiler -> GhcImplInfo
getImplInfo Compiler
comp

componentCcGhcOptions :: Verbosity -> LocalBuildInfo
                      -> BuildInfo -> ComponentLocalBuildInfo
                      -> FilePath -> FilePath
                      -> GhcOptions
componentCcGhcOptions :: Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> GhcOptions
componentCcGhcOptions Verbosity
verbosity LocalBuildInfo
lbi =
    Verbosity
-> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> GhcOptions
Internal.componentCcGhcOptions Verbosity
verbosity GhcImplInfo
implInfo LocalBuildInfo
lbi
  where
    comp :: Compiler
comp     = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
    implInfo :: GhcImplInfo
implInfo = Compiler -> GhcImplInfo
getImplInfo Compiler
comp

-- -----------------------------------------------------------------------------
-- Installing

-- |Install executables for GHC.
installExe :: Verbosity
           -> LocalBuildInfo
           -> FilePath -- ^Where to copy the files to
           -> FilePath  -- ^Build location
           -> (FilePath, FilePath)  -- ^Executable (prefix,suffix)
           -> PackageDescription
           -> Executable
           -> IO ()
installExe :: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> (FilePath, FilePath)
-> PackageDescription
-> Executable
-> IO ()
installExe Verbosity
verbosity LocalBuildInfo
lbi FilePath
binDir FilePath
buildPref
  (FilePath
progprefix, FilePath
progsuffix) PackageDescription
_pkg Executable
exe = do
  Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
binDir
  let exeName' :: FilePath
exeName' = UnqualComponentName -> FilePath
unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
forall a b. (a -> b) -> a -> b
$ Executable -> UnqualComponentName
exeName Executable
exe
      exeFileName :: FilePath
exeFileName = Platform -> Executable -> FilePath
exeTargetName (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) Executable
exe
      fixedExeBaseName :: FilePath
fixedExeBaseName = FilePath
progprefix FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
exeName' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
progsuffix
      installBinary :: FilePath -> IO ()
installBinary FilePath
dest = do
          Verbosity -> FilePath -> FilePath -> IO ()
installExecutableFile Verbosity
verbosity
            (FilePath
buildPref FilePath -> FilePath -> FilePath
</> FilePath
exeName' FilePath -> FilePath -> FilePath
</> FilePath
exeFileName)
            (FilePath
dest FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
exeExtension (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi))
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LocalBuildInfo -> Bool
stripExes LocalBuildInfo
lbi) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            Verbosity -> Platform -> ProgramDb -> FilePath -> IO ()
Strip.stripExe Verbosity
verbosity (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
                           (FilePath
dest FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
exeExtension (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi))
  FilePath -> IO ()
installBinary (FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
fixedExeBaseName)

-- |Install foreign library for GHC.
installFLib :: Verbosity
            -> LocalBuildInfo
            -> FilePath  -- ^install location
            -> FilePath  -- ^Build location
            -> PackageDescription
            -> ForeignLib
            -> IO ()
installFLib :: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> PackageDescription
-> ForeignLib
-> IO ()
installFLib Verbosity
verbosity LocalBuildInfo
lbi FilePath
targetDir FilePath
builtDir PackageDescription
_pkg ForeignLib
flib =
    Bool -> FilePath -> FilePath -> FilePath -> IO ()
install (ForeignLib -> Bool
foreignLibIsShared ForeignLib
flib)
            FilePath
builtDir
            FilePath
targetDir
            (LocalBuildInfo -> ForeignLib -> FilePath
flibTargetName LocalBuildInfo
lbi ForeignLib
flib)
  where
    install :: Bool -> FilePath -> FilePath -> FilePath -> IO ()
install Bool
isShared FilePath
srcDir FilePath
dstDir FilePath
name = do
      let src :: FilePath
src = FilePath
srcDir FilePath -> FilePath -> FilePath
</> FilePath
name
          dst :: FilePath
dst = FilePath
dstDir FilePath -> FilePath -> FilePath
</> FilePath
name
      Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
targetDir
      -- TODO: Should we strip? (stripLibs lbi)
      if Bool
isShared
        then Verbosity -> FilePath -> FilePath -> IO ()
installExecutableFile Verbosity
verbosity FilePath
src FilePath
dst
        else Verbosity -> FilePath -> FilePath -> IO ()
installOrdinaryFile   Verbosity
verbosity FilePath
src FilePath
dst
      -- Now install appropriate symlinks if library is versioned
      let (Platform Arch
_ OS
os) = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ForeignLib -> OS -> [Int]
foreignLibVersion ForeignLib
flib OS
os))) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (OS
os OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
/= OS
Linux) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity
            -- It should be impossible to get here.
            FilePath
"Can't install foreign-library symlink on non-Linux OS"
#ifndef mingw32_HOST_OS
          -- 'createSymbolicLink file1 file2' creates a symbolic link
          -- named 'file2' which points to the file 'file1'.
          -- Note that we do want a symlink to 'name' rather than
          -- 'dst', because the symlink will be relative to the
          -- directory it's created in.
          -- Finally, we first create the symlinks in a temporary
          -- directory and then rename to simulate 'ln --force'.
          Verbosity -> FilePath -> FilePath -> (FilePath -> IO ()) -> IO ()
forall a.
Verbosity -> FilePath -> FilePath -> (FilePath -> IO a) -> IO a
withTempDirectory Verbosity
verbosity FilePath
dstDir FilePath
nm ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
tmpDir -> do
              let link1 :: FilePath
link1 = LocalBuildInfo -> ForeignLib -> FilePath
flibBuildName LocalBuildInfo
lbi ForeignLib
flib
                  link2 :: FilePath
link2 = FilePath
"lib" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
nm FilePath -> FilePath -> FilePath
<.> FilePath
"so"
              FilePath -> FilePath -> IO ()
createSymbolicLink FilePath
name (FilePath
tmpDir FilePath -> FilePath -> FilePath
</> FilePath
link1)
              FilePath -> FilePath -> IO ()
renameFile (FilePath
tmpDir FilePath -> FilePath -> FilePath
</> FilePath
link1) (FilePath
dstDir FilePath -> FilePath -> FilePath
</> FilePath
link1)
              FilePath -> FilePath -> IO ()
createSymbolicLink FilePath
name (FilePath
tmpDir FilePath -> FilePath -> FilePath
</> FilePath
link2)
              FilePath -> FilePath -> IO ()
renameFile (FilePath
tmpDir FilePath -> FilePath -> FilePath
</> FilePath
link2) (FilePath
dstDir FilePath -> FilePath -> FilePath
</> FilePath
link2)
        where
          nm :: String
          nm :: FilePath
nm = UnqualComponentName -> FilePath
unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
forall a b. (a -> b) -> a -> b
$ ForeignLib -> UnqualComponentName
foreignLibName ForeignLib
flib
#endif /* mingw32_HOST_OS */


-- |Install for ghc, .hi, .a and, if --with-ghci given, .o
installLib    :: Verbosity
              -> LocalBuildInfo
              -> FilePath  -- ^install location
              -> FilePath  -- ^install location for dynamic libraries
              -> FilePath  -- ^Build location
              -> PackageDescription
              -> Library
              -> ComponentLocalBuildInfo
              -> IO ()
installLib :: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> FilePath
-> PackageDescription
-> Library
-> ComponentLocalBuildInfo
-> IO ()
installLib Verbosity
verbosity LocalBuildInfo
lbi FilePath
targetDir FilePath
dynlibTargetDir FilePath
_builtDir PackageDescription
pkg Library
lib ComponentLocalBuildInfo
clbi = do
  -- copy .hi files over:
  IO () -> IO ()
whenVanilla (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
copyModuleFiles FilePath
"hi"
  IO () -> IO ()
whenProf    (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
copyModuleFiles FilePath
"p_hi"
  IO () -> IO ()
whenShared  (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
copyModuleFiles FilePath
"dyn_hi"

  -- copy the built library files over:
  IO () -> IO ()
whenHasCode (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    IO () -> IO ()
whenVanilla (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ FilePath -> FilePath -> FilePath -> IO ()
installOrdinary
                    FilePath
builtDir
                    FilePath
targetDir
                    (FilePath -> FilePath
mkGenericStaticLibName (FilePath
l FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f))
                | FilePath
l <- UnitId -> FilePath
getHSLibraryName
                       (ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi)FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:(BuildInfo -> [FilePath]
extraBundledLibs (Library -> BuildInfo
libBuildInfo Library
lib))
                , FilePath
f <- FilePath
""FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:BuildInfo -> [FilePath]
extraLibFlavours (Library -> BuildInfo
libBuildInfo Library
lib)
                ]
      IO () -> IO ()
whenGHCi (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> IO ()
installOrdinary FilePath
builtDir FilePath
targetDir FilePath
ghciLibName
    IO () -> IO ()
whenProf (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      FilePath -> FilePath -> FilePath -> IO ()
installOrdinary FilePath
builtDir FilePath
targetDir FilePath
profileLibName
      IO () -> IO ()
whenGHCi (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> IO ()
installOrdinary FilePath
builtDir FilePath
targetDir FilePath
ghciProfLibName
    IO () -> IO ()
whenShared (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ if
      -- The behavior for "extra-bundled-libraries" changed in version 2.5.0.
      -- See ghc issue #15837 and Cabal PR #5855.
      | PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV3_0 -> do
        [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ FilePath -> FilePath -> FilePath -> IO ()
installShared FilePath
builtDir FilePath
dynlibTargetDir
              (Platform -> CompilerId -> FilePath -> FilePath
mkGenericSharedLibName Platform
platform CompilerId
compiler_id (FilePath
l FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f))
          | FilePath
l <- UnitId -> FilePath
getHSLibraryName UnitId
uid FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: BuildInfo -> [FilePath]
extraBundledLibs (Library -> BuildInfo
libBuildInfo Library
lib)
          , FilePath
f <- FilePath
""FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:BuildInfo -> [FilePath]
extraDynLibFlavours (Library -> BuildInfo
libBuildInfo Library
lib)
          ]
      | Bool
otherwise -> do
        [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ FilePath -> FilePath -> FilePath -> IO ()
installShared
                        FilePath
builtDir
                        FilePath
dynlibTargetDir
                        (Platform -> CompilerId -> FilePath -> FilePath
mkGenericSharedLibName
                          Platform
platform
                          CompilerId
compiler_id
                          (UnitId -> FilePath
getHSLibraryName UnitId
uid FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f))
                  | FilePath
f <- FilePath
""FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:BuildInfo -> [FilePath]
extraDynLibFlavours (Library -> BuildInfo
libBuildInfo Library
lib)
                  ]
        [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ do
                    [FilePath]
files <- FilePath -> IO [FilePath]
getDirectoryContents FilePath
builtDir
                    let l' :: FilePath
l' = Platform -> CompilerId -> FilePath -> FilePath
mkGenericSharedBundledLibName
                              Platform
platform
                              CompilerId
compiler_id
                              FilePath
l
                    [FilePath] -> (FilePath -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
files ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ FilePath
file ->
                      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FilePath
l' FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
file) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                        Bool
isFile <- FilePath -> IO Bool
doesFileExist (FilePath
builtDir FilePath -> FilePath -> FilePath
</> FilePath
file)
                        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isFile (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                          FilePath -> FilePath -> FilePath -> IO ()
installShared
                            FilePath
builtDir
                            FilePath
dynlibTargetDir
                            FilePath
file
                  | FilePath
l <- BuildInfo -> [FilePath]
extraBundledLibs (Library -> BuildInfo
libBuildInfo Library
lib)
                  ]

  where
    builtDir :: FilePath
builtDir = LocalBuildInfo -> ComponentLocalBuildInfo -> FilePath
componentBuildDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi

    install :: Bool -> FilePath -> FilePath -> FilePath -> IO ()
install Bool
isShared FilePath
srcDir FilePath
dstDir FilePath
name = do
      let src :: FilePath
src = FilePath
srcDir FilePath -> FilePath -> FilePath
</> FilePath
name
          dst :: FilePath
dst = FilePath
dstDir FilePath -> FilePath -> FilePath
</> FilePath
name

      Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
dstDir

      if Bool
isShared
        then Verbosity -> FilePath -> FilePath -> IO ()
installExecutableFile Verbosity
verbosity FilePath
src FilePath
dst
        else Verbosity -> FilePath -> FilePath -> IO ()
installOrdinaryFile   Verbosity
verbosity FilePath
src FilePath
dst

      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LocalBuildInfo -> Bool
stripLibs LocalBuildInfo
lbi) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> Platform -> ProgramDb -> FilePath -> IO ()
Strip.stripLib Verbosity
verbosity
                             Platform
platform (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi) FilePath
dst

    installOrdinary :: FilePath -> FilePath -> FilePath -> IO ()
installOrdinary = Bool -> FilePath -> FilePath -> FilePath -> IO ()
install Bool
False
    installShared :: FilePath -> FilePath -> FilePath -> IO ()
installShared   = Bool -> FilePath -> FilePath -> FilePath -> IO ()
install Bool
True

    copyModuleFiles :: FilePath -> IO ()
copyModuleFiles FilePath
ext =
      Verbosity
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> IO [(FilePath, FilePath)]
findModuleFilesEx Verbosity
verbosity [FilePath
builtDir] [FilePath
ext] (Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi)
      IO [(FilePath, FilePath)]
-> ([(FilePath, FilePath)] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
installOrdinaryFiles Verbosity
verbosity FilePath
targetDir

    compiler_id :: CompilerId
compiler_id = Compiler -> CompilerId
compilerId (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
    platform :: Platform
platform = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
    uid :: UnitId
uid = ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi
    profileLibName :: FilePath
profileLibName = UnitId -> FilePath
mkProfLibName          UnitId
uid
    ghciLibName :: FilePath
ghciLibName    = UnitId -> FilePath
Internal.mkGHCiLibName UnitId
uid
    ghciProfLibName :: FilePath
ghciProfLibName = UnitId -> FilePath
Internal.mkGHCiProfLibName UnitId
uid

    hasLib :: Bool
hasLib    = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi)
                   Bool -> Bool -> Bool
&& [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [FilePath]
cSources (Library -> BuildInfo
libBuildInfo Library
lib))
                   Bool -> Bool -> Bool
&& [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [FilePath]
cxxSources (Library -> BuildInfo
libBuildInfo Library
lib))
                   Bool -> Bool -> Bool
&& [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [FilePath]
cmmSources (Library -> BuildInfo
libBuildInfo Library
lib))
                   Bool -> Bool -> Bool
&& [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [FilePath]
asmSources (Library -> BuildInfo
libBuildInfo Library
lib))
    has_code :: Bool
has_code = Bool -> Bool
not (ComponentLocalBuildInfo -> Bool
componentIsIndefinite ComponentLocalBuildInfo
clbi)
    whenHasCode :: IO () -> IO ()
whenHasCode = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
has_code
    whenVanilla :: IO () -> IO ()
whenVanilla = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
hasLib Bool -> Bool -> Bool
&& LocalBuildInfo -> Bool
withVanillaLib LocalBuildInfo
lbi)
    whenProf :: IO () -> IO ()
whenProf    = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
hasLib Bool -> Bool -> Bool
&& LocalBuildInfo -> Bool
withProfLib    LocalBuildInfo
lbi Bool -> Bool -> Bool
&& Bool
has_code)
    whenGHCi :: IO () -> IO ()
whenGHCi    = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
hasLib Bool -> Bool -> Bool
&& LocalBuildInfo -> Bool
withGHCiLib    LocalBuildInfo
lbi Bool -> Bool -> Bool
&& Bool
has_code)
    whenShared :: IO () -> IO ()
whenShared  = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
hasLib Bool -> Bool -> Bool
&& LocalBuildInfo -> Bool
withSharedLib  LocalBuildInfo
lbi Bool -> Bool -> Bool
&& Bool
has_code)

-- -----------------------------------------------------------------------------
-- Registering

hcPkgInfo :: ProgramDb -> HcPkg.HcPkgInfo
hcPkgInfo :: ProgramDb -> HcPkgInfo
hcPkgInfo ProgramDb
progdb = HcPkgInfo :: ConfiguredProgram
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> HcPkgInfo
HcPkg.HcPkgInfo
  { hcPkgProgram :: ConfiguredProgram
HcPkg.hcPkgProgram         = ConfiguredProgram
ghcPkgProg
  , noPkgDbStack :: Bool
HcPkg.noPkgDbStack         = [Int]
v [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
< [Int
6,Int
9]
  , noVerboseFlag :: Bool
HcPkg.noVerboseFlag        = [Int]
v [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
< [Int
6,Int
11]
  , flagPackageConf :: Bool
HcPkg.flagPackageConf      = [Int]
v [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
< [Int
7,Int
5]
  , supportsDirDbs :: Bool
HcPkg.supportsDirDbs       = [Int]
v [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
6,Int
8]
  , requiresDirDbs :: Bool
HcPkg.requiresDirDbs       = [Int]
v [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
7,Int
10]
  , nativeMultiInstance :: Bool
HcPkg.nativeMultiInstance  = [Int]
v [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
7,Int
10]
  , recacheMultiInstance :: Bool
HcPkg.recacheMultiInstance = [Int]
v [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
6,Int
12]
  , suppressFilesCheck :: Bool
HcPkg.suppressFilesCheck   = [Int]
v [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
6,Int
6]
  }
  where
    v :: [Int]
v          = Version -> [Int]
versionNumbers Version
ver
    ghcPkgProg :: ConfiguredProgram
ghcPkgProg = ConfiguredProgram -> Maybe ConfiguredProgram -> ConfiguredProgram
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> ConfiguredProgram
forall a. HasCallStack => FilePath -> a
error FilePath
"GHC.hcPkgInfo: no ghc program") (Maybe ConfiguredProgram -> ConfiguredProgram)
-> Maybe ConfiguredProgram -> ConfiguredProgram
forall a b. (a -> b) -> a -> b
$ Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
ghcPkgProgram ProgramDb
progdb
    ver :: Version
ver        = Version -> Maybe Version -> Version
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> Version
forall a. HasCallStack => FilePath -> a
error FilePath
"GHC.hcPkgInfo: no ghc version") (Maybe Version -> Version) -> Maybe Version -> Version
forall a b. (a -> b) -> a -> b
$ ConfiguredProgram -> Maybe Version
programVersion ConfiguredProgram
ghcPkgProg

registerPackage
  :: Verbosity
  -> ProgramDb
  -> PackageDBStack
  -> InstalledPackageInfo
  -> HcPkg.RegisterOptions
  -> IO ()
registerPackage :: Verbosity
-> ProgramDb
-> [PackageDB]
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
registerPackage Verbosity
verbosity ProgramDb
progdb [PackageDB]
packageDbs InstalledPackageInfo
installedPkgInfo RegisterOptions
registerOptions =
    HcPkgInfo
-> Verbosity
-> [PackageDB]
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
HcPkg.register (ProgramDb -> HcPkgInfo
hcPkgInfo ProgramDb
progdb) Verbosity
verbosity [PackageDB]
packageDbs
                   InstalledPackageInfo
installedPkgInfo RegisterOptions
registerOptions

pkgRoot :: Verbosity -> LocalBuildInfo -> PackageDB -> IO FilePath
pkgRoot :: Verbosity -> LocalBuildInfo -> PackageDB -> IO FilePath
pkgRoot Verbosity
verbosity LocalBuildInfo
lbi = PackageDB -> IO FilePath
pkgRoot'
   where
    pkgRoot' :: PackageDB -> IO FilePath
pkgRoot' PackageDB
GlobalPackageDB =
      let ghcProg :: ConfiguredProgram
ghcProg = ConfiguredProgram -> Maybe ConfiguredProgram -> ConfiguredProgram
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> ConfiguredProgram
forall a. HasCallStack => FilePath -> a
error FilePath
"GHC.pkgRoot: no ghc program") (Maybe ConfiguredProgram -> ConfiguredProgram)
-> Maybe ConfiguredProgram -> ConfiguredProgram
forall a b. (a -> b) -> a -> b
$ Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
ghcProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
      in  (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FilePath
takeDirectory (Verbosity -> ConfiguredProgram -> IO FilePath
getGlobalPackageDB Verbosity
verbosity ConfiguredProgram
ghcProg)
    pkgRoot' PackageDB
UserPackageDB = do
      FilePath
appDir <- IO FilePath
getGhcAppDir
      let ver :: Version
ver      = Compiler -> Version
compilerVersion (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
          subdir :: FilePath
subdir   = FilePath
System.Info.arch FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Char
'-'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
System.Info.os
                     FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Char
'-'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
ver
          rootDir :: FilePath
rootDir  = FilePath
appDir FilePath -> FilePath -> FilePath
</> FilePath
subdir
      -- We must create the root directory for the user package database if it
      -- does not yet exists. Otherwise '${pkgroot}' will resolve to a
      -- directory at the time of 'ghc-pkg register', and registration will
      -- fail.
      Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
rootDir
      FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
rootDir
    pkgRoot' (SpecificPackageDB FilePath
fp) = FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> FilePath
takeDirectory FilePath
fp)

-- -----------------------------------------------------------------------------
-- Utils

isDynamic :: Compiler -> Bool
isDynamic :: Compiler -> Bool
isDynamic = FilePath -> Compiler -> Bool
Internal.ghcLookupProperty FilePath
"GHC Dynamic"

supportsDynamicToo :: Compiler -> Bool
supportsDynamicToo :: Compiler -> Bool
supportsDynamicToo = FilePath -> Compiler -> Bool
Internal.ghcLookupProperty FilePath
"Support dynamic-too"

withExt :: FilePath -> String -> FilePath
withExt :: FilePath -> FilePath -> FilePath
withExt FilePath
fp FilePath
ext = FilePath
fp FilePath -> FilePath -> FilePath
<.> if FilePath -> FilePath
takeExtension FilePath
fp FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= (Char
'.'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
ext) then FilePath
ext else FilePath
""