Cabal/src/Distribution/Simple/GHC.hs

   1 {-# LANGUAGE CPP #-}
   2 {-# LANGUAGE FlexibleContexts #-}
   3 {-# LANGUAGE MultiWayIf #-}
   4 {-# LANGUAGE RankNTypes #-}
   5 {-# LANGUAGE TupleSections #-}
   6
   7 -----------------------------------------------------------------------------
   8
   9 -- |
  10 -- Module      :  Distribution.Simple.GHC
  11 -- Copyright   :  Isaac Jones 2003-2007
  12 -- License     :  BSD3
  13 --
  14 -- Maintainer  :  cabal-devel@haskell.org
  15 -- Portability :  portable
  16 --
  17 -- This is a fairly large module. It contains most of the GHC-specific code for
  18 -- configuring, building and installing packages. It also exports a function
  19 -- for finding out what packages are already installed. Configuring involves
  20 -- finding the @ghc@ and @ghc-pkg@ programs, finding what language extensions
  21 -- this version of ghc supports and returning a 'Compiler' value.
  22 --
  23 -- 'getInstalledPackages' involves calling the @ghc-pkg@ program to find out
  24 -- what packages are installed.
  25 --
  26 -- Building is somewhat complex as there is quite a bit of information to take
  27 -- into account. We have to build libs and programs, possibly for profiling and
  28 -- shared libs. We have to support building libraries that will be usable by
  29 -- GHCi and also ghc's @-split-objs@ feature. We have to compile any C files
  30 -- using ghc. Linking, especially for @split-objs@ is remarkably complex,
  31 -- partly because there tend to be 1,000's of @.o@ files and this can often be
  32 -- more than we can pass to the @ld@ or @ar@ programs in one go.
  33 --
  34 -- Installing for libs and exes involves finding the right files and copying
  35 -- them to the right places. One of the more tricky things about this module is
  36 -- remembering the layout of files in the build directory (which is not
  37 -- explicitly documented) and thus what search dirs are used for various kinds
  38 -- of files.
  39 module Distribution.Simple.GHC
  40   ( getGhcInfo
  41   , configure
  42   , getInstalledPackages
  43   , getInstalledPackagesMonitorFiles
  44   , getPackageDBContents
  45   , buildLib
  46   , buildFLib
  47   , buildExe
  48   , replLib
  49   , replFLib
  50   , replExe
  51   , startInterpreter
  52   , installLib
  53   , installFLib
  54   , installExe
  55   , libAbiHash
  56   , hcPkgInfo
  57   , registerPackage
  58   , componentGhcOptions
  59   , componentCcGhcOptions
  60   , getGhcAppDir
  61   , getLibDir
  62   , isDynamic
  63   , getGlobalPackageDB
  64   , pkgRoot
  65
  66     -- * Constructing and deconstructing GHC environment files
  67   , Internal.GhcEnvironmentFileEntry (..)
  68   , Internal.simpleGhcEnvironmentFile
  69   , Internal.renderGhcEnvironmentFile
  70   , Internal.writeGhcEnvironmentFile
  71   , Internal.ghcPlatformAndVersionString
  72   , readGhcEnvironmentFile
  73   , parseGhcEnvironmentFile
  74   , ParseErrorExc (..)
  75
  76     -- * Version-specific implementation quirks
  77   , getImplInfo
  78   , GhcImplInfo (..)
  79   ) where
  80
  81 import Distribution.Compat.Prelude
  82 import Prelude ()
  83
  84 import Control.Monad (forM_, msum)
  85 import Data.Char (isLower)
  86 import qualified Data.Map as Map
  87 import Distribution.CabalSpecVersion
  88 import Distribution.InstalledPackageInfo (InstalledPackageInfo)
  89 import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
  90 import Distribution.ModuleName (ModuleName)
  91 import qualified Distribution.ModuleName as ModuleName
  92 import Distribution.Package
  93 import Distribution.PackageDescription as PD
  94 import Distribution.PackageDescription.Utils (cabalBug)
  95 import Distribution.Pretty
  96 import Distribution.Simple.BuildPaths
  97 import Distribution.Simple.Compiler
  98 import Distribution.Simple.Errors
  99 import Distribution.Simple.Flag (Flag (..), fromFlag, fromFlagOrDefault, toFlag)
 100 import Distribution.Simple.GHC.EnvironmentParser
 101 import Distribution.Simple.GHC.ImplInfo
 102 import qualified Distribution.Simple.GHC.Internal as Internal
 103 import qualified Distribution.Simple.Hpc as Hpc
 104 import Distribution.Simple.LocalBuildInfo
 105 import Distribution.Simple.PackageIndex (InstalledPackageIndex)
 106 import qualified Distribution.Simple.PackageIndex as PackageIndex
 107 import Distribution.Simple.Program
 108 import qualified Distribution.Simple.Program.Ar as Ar
 109 import Distribution.Simple.Program.Builtin (runghcProgram)
 110 import Distribution.Simple.Program.GHC
 111 import qualified Distribution.Simple.Program.HcPkg as HcPkg
 112 import qualified Distribution.Simple.Program.Ld as Ld
 113 import qualified Distribution.Simple.Program.Strip as Strip
 114 import Distribution.Simple.Setup.Common (extraCompilationArtifacts)
 115 import Distribution.Simple.Setup.Config
 116 import Distribution.Simple.Setup.Repl
 117 import Distribution.Simple.Utils
 118 import Distribution.System
 119 import Distribution.Types.ComponentLocalBuildInfo
 120 import Distribution.Types.PackageName.Magic
 121 import Distribution.Types.ParStrat
 122 import Distribution.Utils.NubList
 123 import Distribution.Utils.Path
 124 import Distribution.Verbosity
 125 import Distribution.Version
 126 import Language.Haskell.Extension
 127 import System.Directory
 128   ( canonicalizePath
 129   , createDirectoryIfMissing
 130   , doesDirectoryExist
 131   , doesFileExist
 132   , getAppUserDataDirectory
 133   , getCurrentDirectory
 134   , getDirectoryContents
 135   , makeRelativeToCurrentDirectory
 136   , removeFile
 137   , renameFile
 138   )
 139 import System.FilePath
 140   ( isRelative
 141   , replaceExtension
 142   , takeDirectory
 143   , takeExtension
 144   , (<.>)
 145   , (</>)
 146   )
 147 import qualified System.Info
 148 #ifndef mingw32_HOST_OS
 149 import System.Posix (createSymbolicLink)
 150 #endif /* mingw32_HOST_OS */
 151 import qualified Data.ByteString.Lazy.Char8 as BS
 152 import Distribution.Compat.Binary (encode)
 153 import Distribution.Compat.ResponseFile (escapeArgs)
 154 import qualified Distribution.InstalledPackageInfo as IPI
 155
 156 -- -----------------------------------------------------------------------------
 157 -- Configuring
 158
 159 configure
 160   :: Verbosity
 161   -> Maybe FilePath
 162   -> Maybe FilePath
 163   -> ProgramDb
 164   -> IO (Compiler, Maybe Platform, ProgramDb)
 165 configure verbosity hcPath hcPkgPath conf0 = do
 166   (ghcProg, ghcVersion, progdb1) <-
 167     requireProgramVersion
 168       verbosity
 169       ghcProgram
 170       (orLaterVersion (mkVersion [7, 0, 1]))
 171       (userMaybeSpecifyPath "ghc" hcPath conf0)
 172   let implInfo = ghcVersionImplInfo ghcVersion
 173
 174   -- Cabal currently supports ghc >= 7.0.1 && < 9.8
 175   -- ... and the following odd development version
 176   unless (ghcVersion < mkVersion [9, 8]) $
 177     warn verbosity $
 178       "Unknown/unsupported 'ghc' version detected "
 179         ++ "(Cabal "
 180         ++ prettyShow cabalVersion
 181         ++ " supports 'ghc' version < 9.8): "
 182         ++ programPath ghcProg
 183         ++ " is version "
 184         ++ prettyShow ghcVersion
 185
 186   -- This is slightly tricky, we have to configure ghc first, then we use the
 187   -- location of ghc to help find ghc-pkg in the case that the user did not
 188   -- specify the location of ghc-pkg directly:
 189   (ghcPkgProg, ghcPkgVersion, progdb2) <-
 190     requireProgramVersion
 191       verbosity
 192       ghcPkgProgram
 193         { programFindLocation = guessGhcPkgFromGhcPath ghcProg
 194         }
 195       anyVersion
 196       (userMaybeSpecifyPath "ghc-pkg" hcPkgPath progdb1)
 197
 198   when (ghcVersion /= ghcPkgVersion) $
 199     dieWithException verbosity $
 200       VersionMismatchGHC (programPath ghcProg) ghcVersion (programPath ghcPkgProg) ghcPkgVersion
 201   -- Likewise we try to find the matching hsc2hs and haddock programs.
 202   let hsc2hsProgram' =
 203         hsc2hsProgram
 204           { programFindLocation = guessHsc2hsFromGhcPath ghcProg
 205           }
 206       haddockProgram' =
 207         haddockProgram
 208           { programFindLocation = guessHaddockFromGhcPath ghcProg
 209           }
 210       hpcProgram' =
 211         hpcProgram
 212           { programFindLocation = guessHpcFromGhcPath ghcProg
 213           }
 214       runghcProgram' =
 215         runghcProgram
 216           { programFindLocation = guessRunghcFromGhcPath ghcProg
 217           }
 218       progdb3 =
 219         addKnownProgram haddockProgram' $
 220           addKnownProgram hsc2hsProgram' $
 221             addKnownProgram hpcProgram' $
 222               addKnownProgram runghcProgram' progdb2
 223
 224   languages <- Internal.getLanguages verbosity implInfo ghcProg
 225   extensions0 <- Internal.getExtensions verbosity implInfo ghcProg
 226
 227   ghcInfo <- Internal.getGhcInfo verbosity implInfo ghcProg
 228   let ghcInfoMap = Map.fromList ghcInfo
 229       filterJS = if ghcVersion < mkVersion [9, 8] then filterExt JavaScriptFFI else id
 230       extensions =
 231         -- workaround https://gitlab.haskell.org/ghc/ghc/-/issues/11214
 232         filterJS $
 233           -- see 'filterExtTH' comment below
 234           filterExtTH $
 235             extensions0
 236
 237       -- starting with GHC 8.0, `TemplateHaskell` will be omitted from
 238       -- `--supported-extensions` when it's not available.
 239       -- for older GHCs we can use the "Have interpreter" property to
 240       -- filter out `TemplateHaskell`
 241       filterExtTH
 242         | ghcVersion < mkVersion [8]
 243         , Just "NO" <- Map.lookup "Have interpreter" ghcInfoMap =
 244             filterExt TemplateHaskell
 245         | otherwise = id
 246
 247       filterExt ext = filter ((/= EnableExtension ext) . fst)
 248
 249   let comp =
 250         Compiler
 251           { compilerId = CompilerId GHC ghcVersion
 252           , compilerAbiTag = NoAbiTag
 253           , compilerCompat = []
 254           , compilerLanguages = languages
 255           , compilerExtensions = extensions
 256           , compilerProperties = ghcInfoMap
 257           }
 258       compPlatform = Internal.targetPlatform ghcInfo
 259       -- configure gcc and ld
 260       progdb4 = Internal.configureToolchain implInfo ghcProg ghcInfoMap progdb3
 261   return (comp, compPlatform, progdb4)
 262
 263 -- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find
 264 -- the corresponding tool; e.g. if the tool is ghc-pkg, we try looking
 265 -- for a versioned or unversioned ghc-pkg in the same dir, that is:
 266 --
 267 -- > /usr/local/bin/ghc-pkg-ghc-6.6.1(.exe)
 268 -- > /usr/local/bin/ghc-pkg-6.6.1(.exe)
 269 -- > /usr/local/bin/ghc-pkg(.exe)
 270 guessToolFromGhcPath
 271   :: Program
 272   -> ConfiguredProgram
 273   -> Verbosity
 274   -> ProgramSearchPath
 275   -> IO (Maybe (FilePath, [FilePath]))
 276 guessToolFromGhcPath tool ghcProg verbosity searchpath =
 277   do
 278     let toolname = programName tool
 279         given_path = programPath ghcProg
 280         given_dir = takeDirectory given_path
 281     real_path <- canonicalizePath given_path
 282     let real_dir = takeDirectory real_path
 283         versionSuffix path = takeVersionSuffix (dropExeExtension path)
 284         given_suf = versionSuffix given_path
 285         real_suf = versionSuffix real_path
 286         guessNormal dir = dir </> toolname <.> exeExtension buildPlatform
 287         guessGhcVersioned dir suf =
 288           dir
 289             </> (toolname ++ "-ghc" ++ suf)
 290               <.> exeExtension buildPlatform
 291         guessVersioned dir suf =
 292           dir
 293             </> (toolname ++ suf)
 294               <.> exeExtension buildPlatform
 295         mkGuesses dir suf
 296           | null suf = [guessNormal dir]
 297           | otherwise =
 298               [ guessGhcVersioned dir suf
 299               , guessVersioned dir suf
 300               , guessNormal dir
 301               ]
 302         -- order matters here, see https://github.com/haskell/cabal/issues/7390
 303         guesses =
 304           ( if real_path == given_path
 305               then []
 306               else mkGuesses real_dir real_suf
 307           )
 308             ++ mkGuesses given_dir given_suf
 309     info verbosity $
 310       "looking for tool "
 311         ++ toolname
 312         ++ " near compiler in "
 313         ++ given_dir
 314     debug verbosity $ "candidate locations: " ++ show guesses
 315     exists <- traverse doesFileExist guesses
 316     case [file | (file, True) <- zip guesses exists] of
 317       -- If we can't find it near ghc, fall back to the usual
 318       -- method.
 319       [] -> programFindLocation tool verbosity searchpath
 320       (fp : _) -> do
 321         info verbosity $ "found " ++ toolname ++ " in " ++ fp
 322         let lookedAt =
 323               map fst
 324                 . takeWhile (\(_file, exist) -> not exist)
 325                 $ zip guesses exists
 326         return (Just (fp, lookedAt))
 327   where
 328     takeVersionSuffix :: FilePath -> String
 329     takeVersionSuffix = takeWhileEndLE isSuffixChar
 330
 331     isSuffixChar :: Char -> Bool
 332     isSuffixChar c = isDigit c || c == '.' || c == '-'
 333
 334 -- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
 335 -- corresponding ghc-pkg, we try looking for both a versioned and unversioned
 336 -- ghc-pkg in the same dir, that is:
 337 --
 338 -- > /usr/local/bin/ghc-pkg-ghc-6.6.1(.exe)
 339 -- > /usr/local/bin/ghc-pkg-6.6.1(.exe)
 340 -- > /usr/local/bin/ghc-pkg(.exe)
 341 guessGhcPkgFromGhcPath
 342   :: ConfiguredProgram
 343   -> Verbosity
 344   -> ProgramSearchPath
 345   -> IO (Maybe (FilePath, [FilePath]))
 346 guessGhcPkgFromGhcPath = guessToolFromGhcPath ghcPkgProgram
 347
 348 -- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
 349 -- corresponding hsc2hs, we try looking for both a versioned and unversioned
 350 -- hsc2hs in the same dir, that is:
 351 --
 352 -- > /usr/local/bin/hsc2hs-ghc-6.6.1(.exe)
 353 -- > /usr/local/bin/hsc2hs-6.6.1(.exe)
 354 -- > /usr/local/bin/hsc2hs(.exe)
 355 guessHsc2hsFromGhcPath
 356   :: ConfiguredProgram
 357   -> Verbosity
 358   -> ProgramSearchPath
 359   -> IO (Maybe (FilePath, [FilePath]))
 360 guessHsc2hsFromGhcPath = guessToolFromGhcPath hsc2hsProgram
 361
 362 -- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
 363 -- corresponding haddock, we try looking for both a versioned and unversioned
 364 -- haddock in the same dir, that is:
 365 --
 366 -- > /usr/local/bin/haddock-ghc-6.6.1(.exe)
 367 -- > /usr/local/bin/haddock-6.6.1(.exe)
 368 -- > /usr/local/bin/haddock(.exe)
 369 guessHaddockFromGhcPath
 370   :: ConfiguredProgram
 371   -> Verbosity
 372   -> ProgramSearchPath
 373   -> IO (Maybe (FilePath, [FilePath]))
 374 guessHaddockFromGhcPath = guessToolFromGhcPath haddockProgram
 375
 376 guessHpcFromGhcPath
 377   :: ConfiguredProgram
 378   -> Verbosity
 379   -> ProgramSearchPath
 380   -> IO (Maybe (FilePath, [FilePath]))
 381 guessHpcFromGhcPath = guessToolFromGhcPath hpcProgram
 382
 383 guessRunghcFromGhcPath
 384   :: ConfiguredProgram
 385   -> Verbosity
 386   -> ProgramSearchPath
 387   -> IO (Maybe (FilePath, [FilePath]))
 388 guessRunghcFromGhcPath = guessToolFromGhcPath runghcProgram
 389
 390 getGhcInfo :: Verbosity -> ConfiguredProgram -> IO [(String, String)]
 391 getGhcInfo verbosity ghcProg = Internal.getGhcInfo verbosity implInfo ghcProg
 392   where
 393     version = fromMaybe (error "GHC.getGhcInfo: no ghc version") $ programVersion ghcProg
 394     implInfo = ghcVersionImplInfo version
 395
 396 -- | Given a single package DB, return all installed packages.
 397 getPackageDBContents
 398   :: Verbosity
 399   -> PackageDB
 400   -> ProgramDb
 401   -> IO InstalledPackageIndex
 402 getPackageDBContents verbosity packagedb progdb = do
 403   pkgss <- getInstalledPackages' verbosity [packagedb] progdb
 404   toPackageIndex verbosity pkgss progdb
 405
 406 -- | Given a package DB stack, return all installed packages.
 407 getInstalledPackages
 408   :: Verbosity
 409   -> Compiler
 410   -> PackageDBStack
 411   -> ProgramDb
 412   -> IO InstalledPackageIndex
 413 getInstalledPackages verbosity comp packagedbs progdb = do
 414   checkPackageDbEnvVar verbosity
 415   checkPackageDbStack verbosity comp packagedbs
 416   pkgss <- getInstalledPackages' verbosity packagedbs progdb
 417   index <- toPackageIndex verbosity pkgss progdb
 418   return $! hackRtsPackage index
 419   where
 420     hackRtsPackage index =
 421       case PackageIndex.lookupPackageName index (mkPackageName "rts") of
 422         [(_, [rts])] ->
 423           PackageIndex.insert (removeMingwIncludeDir rts) index
 424         _ -> index -- No (or multiple) ghc rts package is registered!!
 425         -- Feh, whatever, the ghc test suite does some crazy stuff.
 426
 427 -- | Given a list of @(PackageDB, InstalledPackageInfo)@ pairs, produce a
 428 -- @PackageIndex@. Helper function used by 'getPackageDBContents' and
 429 -- 'getInstalledPackages'.
 430 toPackageIndex
 431   :: Verbosity
 432   -> [(PackageDB, [InstalledPackageInfo])]
 433   -> ProgramDb
 434   -> IO InstalledPackageIndex
 435 toPackageIndex verbosity pkgss progdb = do
 436   -- On Windows, various fields have $topdir/foo rather than full
 437   -- paths. We need to substitute the right value in so that when
 438   -- we, for example, call gcc, we have proper paths to give it.
 439   topDir <- getLibDir' verbosity ghcProg
 440   let indices =
 441         [ PackageIndex.fromList (map (Internal.substTopDir topDir) pkgs)
 442         | (_, pkgs) <- pkgss
 443         ]
 444   return $! mconcat indices
 445   where
 446     ghcProg = fromMaybe (error "GHC.toPackageIndex: no ghc program") $ lookupProgram ghcProgram progdb
 447
 448 -- | Return the 'FilePath' to the GHC application data directory.
 449 --
 450 -- @since 3.4.0.0
 451 getGhcAppDir :: IO FilePath
 452 getGhcAppDir = getAppUserDataDirectory "ghc"
 453
 454 getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath
 455 getLibDir verbosity lbi =
 456   dropWhileEndLE isSpace
 457     `fmap` getDbProgramOutput
 458       verbosity
 459       ghcProgram
 460       (withPrograms lbi)
 461       ["--print-libdir"]
 462
 463 getLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath
 464 getLibDir' verbosity ghcProg =
 465   dropWhileEndLE isSpace
 466     `fmap` getProgramOutput verbosity ghcProg ["--print-libdir"]
 467
 468 -- | Return the 'FilePath' to the global GHC package database.
 469 getGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath
 470 getGlobalPackageDB verbosity ghcProg =
 471   dropWhileEndLE isSpace
 472     `fmap` getProgramOutput verbosity ghcProg ["--print-global-package-db"]
 473
 474 -- | Return the 'FilePath' to the per-user GHC package database.
 475 getUserPackageDB
 476   :: Verbosity -> ConfiguredProgram -> Platform -> IO FilePath
 477 getUserPackageDB _verbosity ghcProg platform = do
 478   -- It's rather annoying that we have to reconstruct this, because ghc
 479   -- hides this information from us otherwise. But for certain use cases
 480   -- like change monitoring it really can't remain hidden.
 481   appdir <- getGhcAppDir
 482   return (appdir </> platformAndVersion </> packageConfFileName)
 483   where
 484     platformAndVersion =
 485       Internal.ghcPlatformAndVersionString
 486         platform
 487         ghcVersion
 488     packageConfFileName = "package.conf.d"
 489     ghcVersion = fromMaybe (error "GHC.getUserPackageDB: no ghc version") $ programVersion ghcProg
 490
 491 checkPackageDbEnvVar :: Verbosity -> IO ()
 492 checkPackageDbEnvVar verbosity =
 493   Internal.checkPackageDbEnvVar verbosity "GHC" "GHC_PACKAGE_PATH"
 494
 495 checkPackageDbStack :: Verbosity -> Compiler -> PackageDBStack -> IO ()
 496 checkPackageDbStack verbosity comp =
 497   if flagPackageConf implInfo
 498     then checkPackageDbStackPre76 verbosity
 499     else checkPackageDbStackPost76 verbosity
 500   where
 501     implInfo = ghcVersionImplInfo (compilerVersion comp)
 502
 503 checkPackageDbStackPost76 :: Verbosity -> PackageDBStack -> IO ()
 504 checkPackageDbStackPost76 _ (GlobalPackageDB : rest)
 505   | GlobalPackageDB `notElem` rest = return ()
 506 checkPackageDbStackPost76 verbosity rest
 507   | GlobalPackageDB `elem` rest =
 508       dieWithException verbosity CheckPackageDbStackPost76
 509 checkPackageDbStackPost76 _ _ = return ()
 510
 511 checkPackageDbStackPre76 :: Verbosity -> PackageDBStack -> IO ()
 512 checkPackageDbStackPre76 _ (GlobalPackageDB : rest)
 513   | GlobalPackageDB `notElem` rest = return ()
 514 checkPackageDbStackPre76 verbosity rest
 515   | GlobalPackageDB `notElem` rest =
 516       dieWithException verbosity CheckPackageDbStackPre76
 517 checkPackageDbStackPre76 verbosity _ =
 518   dieWithException verbosity GlobalPackageDbSpecifiedFirst
 519
 520 -- GHC < 6.10 put "$topdir/include/mingw" in rts's installDirs. This
 521 -- breaks when you want to use a different gcc, so we need to filter
 522 -- it out.
 523 removeMingwIncludeDir :: InstalledPackageInfo -> InstalledPackageInfo
 524 removeMingwIncludeDir pkg =
 525   let ids = InstalledPackageInfo.includeDirs pkg
 526       ids' = filter (not . ("mingw" `isSuffixOf`)) ids
 527    in pkg{InstalledPackageInfo.includeDirs = ids'}
 528
 529 -- | Get the packages from specific PackageDBs, not cumulative.
 530 getInstalledPackages'
 531   :: Verbosity
 532   -> [PackageDB]
 533   -> ProgramDb
 534   -> IO [(PackageDB, [InstalledPackageInfo])]
 535 getInstalledPackages' verbosity packagedbs progdb =
 536   sequenceA
 537     [ do
 538       pkgs <- HcPkg.dump (hcPkgInfo progdb) verbosity packagedb
 539       return (packagedb, pkgs)
 540     | packagedb <- packagedbs
 541     ]
 542
 543 getInstalledPackagesMonitorFiles
 544   :: Verbosity
 545   -> Platform
 546   -> ProgramDb
 547   -> [PackageDB]
 548   -> IO [FilePath]
 549 getInstalledPackagesMonitorFiles verbosity platform progdb =
 550   traverse getPackageDBPath
 551   where
 552     getPackageDBPath :: PackageDB -> IO FilePath
 553     getPackageDBPath GlobalPackageDB =
 554       selectMonitorFile =<< getGlobalPackageDB verbosity ghcProg
 555     getPackageDBPath UserPackageDB =
 556       selectMonitorFile =<< getUserPackageDB verbosity ghcProg platform
 557     getPackageDBPath (SpecificPackageDB path) = selectMonitorFile path
 558
 559     -- GHC has old style file dbs, and new style directory dbs.
 560     -- Note that for dir style dbs, we only need to monitor the cache file, not
 561     -- the whole directory. The ghc program itself only reads the cache file
 562     -- so it's safe to only monitor this one file.
 563     selectMonitorFile path = do
 564       isFileStyle <- doesFileExist path
 565       if isFileStyle
 566         then return path
 567         else return (path </> "package.cache")
 568
 569     ghcProg = fromMaybe (error "GHC.toPackageIndex: no ghc program") $ lookupProgram ghcProgram progdb
 570
 571 -- -----------------------------------------------------------------------------
 572 -- Building a library
 573
 574 buildLib
 575   :: Verbosity
 576   -> Flag ParStrat
 577   -> PackageDescription
 578   -> LocalBuildInfo
 579   -> Library
 580   -> ComponentLocalBuildInfo
 581   -> IO ()
 582 buildLib = buildOrReplLib Nothing
 583
 584 replLib
 585   :: ReplOptions
 586   -> Verbosity
 587   -> Flag ParStrat
 588   -> PackageDescription
 589   -> LocalBuildInfo
 590   -> Library
 591   -> ComponentLocalBuildInfo
 592   -> IO ()
 593 replLib = buildOrReplLib . Just
 594
 595 buildOrReplLib
 596   :: Maybe ReplOptions
 597   -> Verbosity
 598   -> Flag ParStrat
 599   -> PackageDescription
 600   -> LocalBuildInfo
 601   -> Library
 602   -> ComponentLocalBuildInfo
 603   -> IO ()
 604 buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do
 605   let uid = componentUnitId clbi
 606       libTargetDir = componentBuildDir lbi clbi
 607       whenVanillaLib forceVanilla =
 608         when (forceVanilla || withVanillaLib lbi)
 609       whenProfLib = when (withProfLib lbi)
 610       whenSharedLib forceShared =
 611         when (forceShared || withSharedLib lbi)
 612       whenStaticLib forceStatic =
 613         when (forceStatic || withStaticLib lbi)
 614       whenGHCiLib = when (withGHCiLib lbi)
 615       forRepl = maybe False (const True) mReplFlags
 616       whenReplLib = forM_ mReplFlags
 617       replFlags = fromMaybe mempty mReplFlags
 618       comp = compiler lbi
 619       ghcVersion = compilerVersion comp
 620       implInfo = getImplInfo comp
 621       platform@(Platform hostArch hostOS) = hostPlatform lbi
 622       hasJsSupport = hostArch == JavaScript
 623       has_code = not (componentIsIndefinite clbi)
 624
 625   relLibTargetDir <- makeRelativeToCurrentDirectory libTargetDir
 626
 627   (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
 628   let runGhcProg = runGHC verbosity ghcProg comp platform
 629
 630   let libBi = libBuildInfo lib
 631
 632   -- ensure extra lib dirs exist before passing to ghc
 633   cleanedExtraLibDirs <- filterM doesDirectoryExist (extraLibDirs libBi)
 634   cleanedExtraLibDirsStatic <- filterM doesDirectoryExist (extraLibDirsStatic libBi)
 635
 636   let isGhcDynamic = isDynamic comp
 637       dynamicTooSupported = supportsDynamicToo comp
 638       doingTH = usesTemplateHaskellOrQQ libBi
 639       forceVanillaLib = doingTH && not isGhcDynamic
 640       forceSharedLib = doingTH && isGhcDynamic
 641   -- TH always needs default libs, even when building for profiling
 642
 643   -- Determine if program coverage should be enabled and if so, what
 644   -- '-hpcdir' should be.
 645   let isCoverageEnabled = libCoverage lbi
 646       -- TODO: Historically HPC files have been put into a directory which
 647       -- has the package name.  I'm going to avoid changing this for
 648       -- now, but it would probably be better for this to be the
 649       -- component ID instead...
 650       pkg_name = prettyShow (PD.package pkg_descr)
 651       distPref = fromFlag $ configDistPref $ configFlags lbi
 652       hpcdir way
 653         | forRepl = mempty -- HPC is not supported in ghci
 654         | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way pkg_name
 655         | otherwise = mempty
 656
 657   createDirectoryIfMissingVerbose verbosity True libTargetDir
 658   -- TODO: do we need to put hs-boot files into place for mutually recursive
 659   -- modules?
 660   let cLikeSources =
 661         fromNubListR $
 662           mconcat
 663             [ toNubListR (cSources libBi)
 664             , toNubListR (cxxSources libBi)
 665             , toNubListR (cmmSources libBi)
 666             , toNubListR (asmSources libBi)
 667             , if hasJsSupport
 668                 then -- JS files are C-like with GHC's JS backend: they are
 669                 -- "compiled" into `.o` files (renamed with a header).
 670                 -- This is a difference from GHCJS, for which we only
 671                 -- pass the JS files at link time.
 672                   toNubListR (jsSources libBi)
 673                 else mempty
 674             ]
 675       cLikeObjs = map (`replaceExtension` objExtension) cLikeSources
 676       baseOpts = componentGhcOptions verbosity lbi libBi clbi libTargetDir
 677       vanillaOpts =
 678         baseOpts
 679           `mappend` mempty
 680             { ghcOptMode = toFlag GhcModeMake
 681             , ghcOptNumJobs = numJobs
 682             , ghcOptInputModules = toNubListR $ allLibModules lib clbi
 683             , ghcOptHPCDir = hpcdir Hpc.Vanilla
 684             }
 685
 686       profOpts =
 687         vanillaOpts
 688           `mappend` mempty
 689             { ghcOptProfilingMode = toFlag True
 690             , ghcOptProfilingAuto =
 691                 Internal.profDetailLevelFlag
 692                   True
 693                   (withProfLibDetail lbi)
 694             , ghcOptHiSuffix = toFlag "p_hi"
 695             , ghcOptObjSuffix = toFlag "p_o"
 696             , ghcOptExtra = hcProfOptions GHC libBi
 697             , ghcOptHPCDir = hpcdir Hpc.Prof
 698             }
 699
 700       sharedOpts =
 701         vanillaOpts
 702           `mappend` mempty
 703             { ghcOptDynLinkMode = toFlag GhcDynamicOnly
 704             , ghcOptFPic = toFlag True
 705             , ghcOptHiSuffix = toFlag "dyn_hi"
 706             , ghcOptObjSuffix = toFlag "dyn_o"
 707             , ghcOptExtra = hcSharedOptions GHC libBi
 708             , ghcOptHPCDir = hpcdir Hpc.Dyn
 709             }
 710       linkerOpts =
 711         mempty
 712           { ghcOptLinkOptions =
 713               PD.ldOptions libBi
 714                 ++ [ "-static"
 715                    | withFullyStaticExe lbi
 716                    ]
 717                 -- Pass extra `ld-options` given
 718                 -- through to GHC's linker.
 719                 ++ maybe
 720                   []
 721                   programOverrideArgs
 722                   (lookupProgram ldProgram (withPrograms lbi))
 723           , ghcOptLinkLibs =
 724               if withFullyStaticExe lbi
 725                 then extraLibsStatic libBi
 726                 else extraLibs libBi
 727           , ghcOptLinkLibPath =
 728               toNubListR $
 729                 if withFullyStaticExe lbi
 730                   then cleanedExtraLibDirsStatic
 731                   else cleanedExtraLibDirs
 732           , ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi
 733           , ghcOptLinkFrameworkDirs =
 734               toNubListR $
 735                 PD.extraFrameworkDirs libBi
 736           , ghcOptInputFiles =
 737               toNubListR
 738                 [relLibTargetDir </> x | x <- cLikeObjs]
 739           }
 740       replOpts =
 741         vanillaOpts
 742           { ghcOptExtra =
 743               Internal.filterGhciFlags
 744                 (ghcOptExtra vanillaOpts)
 745                 <> replOptionsFlags replFlags
 746           , ghcOptNumJobs = mempty
 747           , ghcOptInputModules = replNoLoad replFlags (ghcOptInputModules vanillaOpts)
 748           }
 749           `mappend` linkerOpts
 750           `mappend` mempty
 751             { ghcOptMode = isInteractive
 752             , ghcOptOptimisation = toFlag GhcNoOptimisation
 753             }
 754
 755       isInteractive = toFlag GhcModeInteractive
 756
 757       vanillaSharedOpts =
 758         vanillaOpts
 759           `mappend` mempty
 760             { ghcOptDynLinkMode = toFlag GhcStaticAndDynamic
 761             , ghcOptDynHiSuffix = toFlag "dyn_hi"
 762             , ghcOptDynObjSuffix = toFlag "dyn_o"
 763             , ghcOptHPCDir = hpcdir Hpc.Dyn
 764             }
 765
 766   unless (forRepl || null (allLibModules lib clbi)) $
 767     do
 768       let vanilla = whenVanillaLib forceVanillaLib (runGhcProg vanillaOpts)
 769           shared = whenSharedLib forceSharedLib (runGhcProg sharedOpts)
 770           useDynToo =
 771             dynamicTooSupported
 772               && (forceVanillaLib || withVanillaLib lbi)
 773               && (forceSharedLib || withSharedLib lbi)
 774               && null (hcSharedOptions GHC libBi)
 775       if not has_code
 776         then vanilla
 777         else
 778           if useDynToo
 779             then do
 780               runGhcProg vanillaSharedOpts
 781               case (hpcdir Hpc.Dyn, hpcdir Hpc.Vanilla) of
 782                 (Flag dynDir, Flag vanillaDir) ->
 783                   -- When the vanilla and shared library builds are done
 784                   -- in one pass, only one set of HPC module interfaces
 785                   -- are generated. This set should suffice for both
 786                   -- static and dynamically linked executables. We copy
 787                   -- the modules interfaces so they are available under
 788                   -- both ways.
 789                   copyDirectoryRecursive verbosity dynDir vanillaDir
 790                 _ -> return ()
 791             else
 792               if isGhcDynamic
 793                 then do shared; vanilla
 794                 else do vanilla; shared
 795       whenProfLib (runGhcProg profOpts)
 796
 797   let
 798     buildExtraSources mkSrcOpts wantDyn = traverse_ $ buildExtraSource mkSrcOpts wantDyn
 799     buildExtraSource mkSrcOpts wantDyn filename = do
 800       let baseSrcOpts =
 801             mkSrcOpts
 802               verbosity
 803               implInfo
 804               lbi
 805               libBi
 806               clbi
 807               relLibTargetDir
 808               filename
 809           vanillaSrcOpts
 810             -- Dynamic GHC requires C sources to be built
 811             -- with -fPIC for REPL to work. See #2207.
 812             | isGhcDynamic && wantDyn = baseSrcOpts{ghcOptFPic = toFlag True}
 813             | otherwise = baseSrcOpts
 814           runGhcProgIfNeeded opts = do
 815             needsRecomp <- checkNeedsRecompilation filename opts
 816             when needsRecomp $ runGhcProg opts
 817           profSrcOpts =
 818             vanillaSrcOpts
 819               `mappend` mempty
 820                 { ghcOptProfilingMode = toFlag True
 821                 , ghcOptObjSuffix = toFlag "p_o"
 822                 }
 823           sharedSrcOpts =
 824             vanillaSrcOpts
 825               `mappend` mempty
 826                 { ghcOptFPic = toFlag True
 827                 , ghcOptDynLinkMode = toFlag GhcDynamicOnly
 828                 , ghcOptObjSuffix = toFlag "dyn_o"
 829                 }
 830           odir = fromFlag (ghcOptObjDir vanillaSrcOpts)
 831
 832       createDirectoryIfMissingVerbose verbosity True odir
 833       runGhcProgIfNeeded vanillaSrcOpts
 834       unless (forRepl || not wantDyn) $
 835         whenSharedLib forceSharedLib (runGhcProgIfNeeded sharedSrcOpts)
 836       unless forRepl $
 837         whenProfLib (runGhcProgIfNeeded profSrcOpts)
 838
 839   -- Build any C++ sources separately.
 840   unless (not has_code || null (cxxSources libBi)) $ do
 841     info verbosity "Building C++ Sources..."
 842     buildExtraSources Internal.componentCxxGhcOptions True (cxxSources libBi)
 843
 844   -- build any C sources
 845   unless (not has_code || null (cSources libBi)) $ do
 846     info verbosity "Building C Sources..."
 847     buildExtraSources Internal.componentCcGhcOptions True (cSources libBi)
 848
 849   -- build any JS sources
 850   unless (not has_code || not hasJsSupport || null (jsSources libBi)) $ do
 851     info verbosity "Building JS Sources..."
 852     buildExtraSources Internal.componentJsGhcOptions False (jsSources libBi)
 853
 854   -- build any ASM sources
 855   unless (not has_code || null (asmSources libBi)) $ do
 856     info verbosity "Building Assembler Sources..."
 857     buildExtraSources Internal.componentAsmGhcOptions True (asmSources libBi)
 858
 859   -- build any Cmm sources
 860   unless (not has_code || null (cmmSources libBi)) $ do
 861     info verbosity "Building C-- Sources..."
 862     buildExtraSources Internal.componentCmmGhcOptions True (cmmSources libBi)
 863
 864   -- TODO: problem here is we need the .c files built first, so we can load them
 865   -- with ghci, but .c files can depend on .h files generated by ghc by ffi
 866   -- exports.
 867   whenReplLib $ \rflags -> do
 868     when (null (allLibModules lib clbi)) $ warn verbosity "No exposed modules"
 869     runReplOrWriteFlags verbosity ghcProg comp platform rflags replOpts libBi clbi (pkgName (PD.package pkg_descr))
 870
 871   -- link:
 872   when has_code . unless forRepl $ do
 873     info verbosity "Linking..."
 874     let cLikeProfObjs =
 875           map
 876             (`replaceExtension` ("p_" ++ objExtension))
 877             cLikeSources
 878         cLikeSharedObjs =
 879           map
 880             (`replaceExtension` ("dyn_" ++ objExtension))
 881             cLikeSources
 882         compiler_id = compilerId (compiler lbi)
 883         vanillaLibFilePath = relLibTargetDir </> mkLibName uid
 884         profileLibFilePath = relLibTargetDir </> mkProfLibName uid
 885         sharedLibFilePath =
 886           relLibTargetDir
 887             </> mkSharedLibName (hostPlatform lbi) compiler_id uid
 888         staticLibFilePath =
 889           relLibTargetDir
 890             </> mkStaticLibName (hostPlatform lbi) compiler_id uid
 891         ghciLibFilePath = relLibTargetDir </> Internal.mkGHCiLibName uid
 892         ghciProfLibFilePath = relLibTargetDir </> Internal.mkGHCiProfLibName uid
 893         libInstallPath =
 894           libdir $
 895             absoluteComponentInstallDirs
 896               pkg_descr
 897               lbi
 898               uid
 899               NoCopyDest
 900         sharedLibInstallPath =
 901           libInstallPath
 902             </> mkSharedLibName (hostPlatform lbi) compiler_id uid
 903
 904     stubObjs <-
 905       catMaybes
 906         <$> sequenceA
 907           [ findFileWithExtension
 908             [objExtension]
 909             [libTargetDir]
 910             (ModuleName.toFilePath x ++ "_stub")
 911           | ghcVersion < mkVersion [7, 2] -- ghc-7.2+ does not make _stub.o files
 912           , x <- allLibModules lib clbi
 913           ]
 914     stubProfObjs <-
 915       catMaybes
 916         <$> sequenceA
 917           [ findFileWithExtension
 918             ["p_" ++ objExtension]
 919             [libTargetDir]
 920             (ModuleName.toFilePath x ++ "_stub")
 921           | ghcVersion < mkVersion [7, 2] -- ghc-7.2+ does not make _stub.o files
 922           , x <- allLibModules lib clbi
 923           ]
 924     stubSharedObjs <-
 925       catMaybes
 926         <$> sequenceA
 927           [ findFileWithExtension
 928             ["dyn_" ++ objExtension]
 929             [libTargetDir]
 930             (ModuleName.toFilePath x ++ "_stub")
 931           | ghcVersion < mkVersion [7, 2] -- ghc-7.2+ does not make _stub.o files
 932           , x <- allLibModules lib clbi
 933           ]
 934
 935     hObjs <-
 936       Internal.getHaskellObjects
 937         implInfo
 938         lib
 939         lbi
 940         clbi
 941         relLibTargetDir
 942         objExtension
 943         True
 944     hProfObjs <-
 945       if withProfLib lbi
 946         then
 947           Internal.getHaskellObjects
 948             implInfo
 949             lib
 950             lbi
 951             clbi
 952             relLibTargetDir
 953             ("p_" ++ objExtension)
 954             True
 955         else return []
 956     hSharedObjs <-
 957       if withSharedLib lbi
 958         then
 959           Internal.getHaskellObjects
 960             implInfo
 961             lib
 962             lbi
 963             clbi
 964             relLibTargetDir
 965             ("dyn_" ++ objExtension)
 966             False
 967         else return []
 968
 969     unless (null hObjs && null cLikeObjs && null stubObjs) $ do
 970       rpaths <- getRPaths lbi clbi
 971
 972       let staticObjectFiles =
 973             hObjs
 974               ++ map (relLibTargetDir </>) cLikeObjs
 975               ++ stubObjs
 976           profObjectFiles =
 977             hProfObjs
 978               ++ map (relLibTargetDir </>) cLikeProfObjs
 979               ++ stubProfObjs
 980           dynamicObjectFiles =
 981             hSharedObjs
 982               ++ map (relLibTargetDir </>) cLikeSharedObjs
 983               ++ stubSharedObjs
 984           -- After the relocation lib is created we invoke ghc -shared
 985           -- with the dependencies spelled out as -package arguments
 986           -- and ghc invokes the linker with the proper library paths
 987           ghcSharedLinkArgs =
 988             mempty
 989               { ghcOptShared = toFlag True
 990               , ghcOptDynLinkMode = toFlag GhcDynamicOnly
 991               , ghcOptInputFiles = toNubListR dynamicObjectFiles
 992               , ghcOptOutputFile = toFlag sharedLibFilePath
 993               , ghcOptExtra = hcSharedOptions GHC libBi
 994               , -- For dynamic libs, Mac OS/X needs to know the install location
 995                 -- at build time. This only applies to GHC < 7.8 - see the
 996                 -- discussion in #1660.
 997                 ghcOptDylibName =
 998                   if hostOS == OSX
 999                     && ghcVersion < mkVersion [7, 8]
1000                     then toFlag sharedLibInstallPath
1001                     else mempty
1002               , ghcOptHideAllPackages = toFlag True
1003               , ghcOptNoAutoLinkPackages = toFlag True
1004               , ghcOptPackageDBs = withPackageDB lbi
1005               , ghcOptThisUnitId = case clbi of
1006                   LibComponentLocalBuildInfo{componentCompatPackageKey = pk} ->
1007                     toFlag pk
1008                   _ -> mempty
1009               , ghcOptThisComponentId = case clbi of
1010                   LibComponentLocalBuildInfo
1011                     { componentInstantiatedWith = insts
1012                     } ->
1013                       if null insts
1014                         then mempty
1015                         else toFlag (componentComponentId clbi)
1016                   _ -> mempty
1017               , ghcOptInstantiatedWith = case clbi of
1018                   LibComponentLocalBuildInfo
1019                     { componentInstantiatedWith = insts
1020                     } ->
1021                       insts
1022                   _ -> []
1023               , ghcOptPackages =
1024                   toNubListR $
1025                     Internal.mkGhcOptPackages mempty clbi
1026               , ghcOptLinkLibs = extraLibs libBi
1027               , ghcOptLinkLibPath = toNubListR $ cleanedExtraLibDirs
1028               , ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi
1029               , ghcOptLinkFrameworkDirs =
1030                   toNubListR $ PD.extraFrameworkDirs libBi
1031               , ghcOptRPaths = rpaths
1032               }
1033           ghcStaticLinkArgs =
1034             mempty
1035               { ghcOptStaticLib = toFlag True
1036               , ghcOptInputFiles = toNubListR staticObjectFiles
1037               , ghcOptOutputFile = toFlag staticLibFilePath
1038               , ghcOptExtra = hcStaticOptions GHC libBi
1039               , ghcOptHideAllPackages = toFlag True
1040               , ghcOptNoAutoLinkPackages = toFlag True
1041               , ghcOptPackageDBs = withPackageDB lbi
1042               , ghcOptThisUnitId = case clbi of
1043                   LibComponentLocalBuildInfo{componentCompatPackageKey = pk} ->
1044                     toFlag pk
1045                   _ -> mempty
1046               , ghcOptThisComponentId = case clbi of
1047                   LibComponentLocalBuildInfo
1048                     { componentInstantiatedWith = insts
1049                     } ->
1050                       if null insts
1051                         then mempty
1052                         else toFlag (componentComponentId clbi)
1053                   _ -> mempty
1054               , ghcOptInstantiatedWith = case clbi of
1055                   LibComponentLocalBuildInfo
1056                     { componentInstantiatedWith = insts
1057                     } ->
1058                       insts
1059                   _ -> []
1060               , ghcOptPackages =
1061                   toNubListR $
1062                     Internal.mkGhcOptPackages mempty clbi
1063               , ghcOptLinkLibs = extraLibs libBi
1064               , ghcOptLinkLibPath = toNubListR $ cleanedExtraLibDirs
1065               }
1066
1067       info verbosity (show (ghcOptPackages ghcSharedLinkArgs))
1068
1069       whenVanillaLib False $ do
1070         Ar.createArLibArchive verbosity lbi vanillaLibFilePath staticObjectFiles
1071         whenGHCiLib $ do
1072           (ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi)
1073           Ld.combineObjectFiles
1074             verbosity
1075             lbi
1076             ldProg
1077             ghciLibFilePath
1078             staticObjectFiles
1079
1080       whenProfLib $ do
1081         Ar.createArLibArchive verbosity lbi profileLibFilePath profObjectFiles
1082         whenGHCiLib $ do
1083           (ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi)
1084           Ld.combineObjectFiles
1085             verbosity
1086             lbi
1087             ldProg
1088             ghciProfLibFilePath
1089             profObjectFiles
1090
1091       whenSharedLib False $
1092         runGhcProg ghcSharedLinkArgs
1093
1094       whenStaticLib False $
1095         runGhcProg ghcStaticLinkArgs
1096
1097 -- | Start a REPL without loading any source files.
1098 startInterpreter
1099   :: Verbosity
1100   -> ProgramDb
1101   -> Compiler
1102   -> Platform
1103   -> PackageDBStack
1104   -> IO ()
1105 startInterpreter verbosity progdb comp platform packageDBs = do
1106   let replOpts =
1107         mempty
1108           { ghcOptMode = toFlag GhcModeInteractive
1109           , ghcOptPackageDBs = packageDBs
1110           }
1111   checkPackageDbStack verbosity comp packageDBs
1112   (ghcProg, _) <- requireProgram verbosity ghcProgram progdb
1113   runGHC verbosity ghcProg comp platform replOpts
1114
1115 runReplOrWriteFlags
1116   :: Verbosity
1117   -> ConfiguredProgram
1118   -> Compiler
1119   -> Platform
1120   -> ReplOptions
1121   -> GhcOptions
1122   -> BuildInfo
1123   -> ComponentLocalBuildInfo
1124   -> PackageName
1125   -> IO ()
1126 runReplOrWriteFlags verbosity ghcProg comp platform rflags replOpts bi clbi pkg_name =
1127   case replOptionsFlagOutput rflags of
1128     NoFlag -> runGHC verbosity ghcProg comp platform replOpts
1129     Flag out_dir -> do
1130       src_dir <- getCurrentDirectory
1131       let uid = componentUnitId clbi
1132           this_unit = prettyShow uid
1133           reexported_modules = [mn | LibComponentLocalBuildInfo{} <- [clbi], IPI.ExposedModule mn (Just{}) <- componentExposedModules clbi]
1134           hidden_modules = otherModules bi
1135           extra_opts =
1136             concat $
1137               [ ["-this-package-name", prettyShow pkg_name]
1138               , ["-working-dir", src_dir]
1139               ]
1140                 ++ [ ["-reexported-module", prettyShow m] | m <- reexported_modules
1141                    ]
1142                 ++ [ ["-hidden-module", prettyShow m] | m <- hidden_modules
1143                    ]
1144       -- Create "paths" subdirectory if it doesn't exist. This is where we write
1145       -- information about how the PATH was augmented.
1146       createDirectoryIfMissing False (out_dir </> "paths")
1147       -- Write out the PATH information into `paths` subdirectory.
1148       writeFileAtomic (out_dir </> "paths" </> this_unit) (encode ghcProg)
1149       -- Write out options for this component into a file ready for loading into
1150       -- the multi-repl
1151       writeFileAtomic (out_dir </> this_unit) $
1152         BS.pack $
1153           escapeArgs $
1154             extra_opts ++ renderGhcOptions comp platform (replOpts{ghcOptMode = NoFlag})
1155
1156 -- -----------------------------------------------------------------------------
1157 -- Building an executable or foreign library
1158
1159 -- | Build a foreign library
1160 buildFLib
1161   :: Verbosity
1162   -> Flag ParStrat
1163   -> PackageDescription
1164   -> LocalBuildInfo
1165   -> ForeignLib
1166   -> ComponentLocalBuildInfo
1167   -> IO ()
1168 buildFLib v njobs pkg lbi = gbuild v njobs pkg lbi . GBuildFLib
1169
1170 replFLib
1171   :: ReplOptions
1172   -> Verbosity
1173   -> Flag ParStrat
1174   -> PackageDescription
1175   -> LocalBuildInfo
1176   -> ForeignLib
1177   -> ComponentLocalBuildInfo
1178   -> IO ()
1179 replFLib replFlags v njobs pkg lbi =
1180   gbuild v njobs pkg lbi . GReplFLib replFlags
1181
1182 -- | Build an executable with GHC.
1183 buildExe
1184   :: Verbosity
1185   -> Flag ParStrat
1186   -> PackageDescription
1187   -> LocalBuildInfo
1188   -> Executable
1189   -> ComponentLocalBuildInfo
1190   -> IO ()
1191 buildExe v njobs pkg lbi = gbuild v njobs pkg lbi . GBuildExe
1192
1193 replExe
1194   :: ReplOptions
1195   -> Verbosity
1196   -> Flag ParStrat
1197   -> PackageDescription
1198   -> LocalBuildInfo
1199   -> Executable
1200   -> ComponentLocalBuildInfo
1201   -> IO ()
1202 replExe replFlags v njobs pkg lbi =
1203   gbuild v njobs pkg lbi . GReplExe replFlags
1204
1205 -- | Building an executable, starting the REPL, and building foreign
1206 -- libraries are all very similar and implemented in 'gbuild'. The
1207 -- 'GBuildMode' distinguishes between the various kinds of operation.
1208 data GBuildMode
1209   = GBuildExe Executable
1210   | GReplExe ReplOptions Executable
1211   | GBuildFLib ForeignLib
1212   | GReplFLib ReplOptions ForeignLib
1213
1214 gbuildInfo :: GBuildMode -> BuildInfo
1215 gbuildInfo (GBuildExe exe) = buildInfo exe
1216 gbuildInfo (GReplExe _ exe) = buildInfo exe
1217 gbuildInfo (GBuildFLib flib) = foreignLibBuildInfo flib
1218 gbuildInfo (GReplFLib _ flib) = foreignLibBuildInfo flib
1219
1220 gbuildName :: GBuildMode -> String
1221 gbuildName (GBuildExe exe) = unUnqualComponentName $ exeName exe
1222 gbuildName (GReplExe _ exe) = unUnqualComponentName $ exeName exe
1223 gbuildName (GBuildFLib flib) = unUnqualComponentName $ foreignLibName flib
1224 gbuildName (GReplFLib _ flib) = unUnqualComponentName $ foreignLibName flib
1225
1226 gbuildTargetName :: LocalBuildInfo -> GBuildMode -> String
1227 gbuildTargetName lbi (GBuildExe exe) = exeTargetName (hostPlatform lbi) exe
1228 gbuildTargetName lbi (GReplExe _ exe) = exeTargetName (hostPlatform lbi) exe
1229 gbuildTargetName lbi (GBuildFLib flib) = flibTargetName lbi flib
1230 gbuildTargetName lbi (GReplFLib _ flib) = flibTargetName lbi flib
1231
1232 exeTargetName :: Platform -> Executable -> String
1233 exeTargetName platform exe = unUnqualComponentName (exeName exe) `withExt` exeExtension platform
1234
1235 -- | Target name for a foreign library (the actual file name)
1236 --
1237 -- We do not use mkLibName and co here because the naming for foreign libraries
1238 -- is slightly different (we don't use "_p" or compiler version suffices, and we
1239 -- don't want the "lib" prefix on Windows).
1240 --
1241 -- TODO: We do use `dllExtension` and co here, but really that's wrong: they
1242 -- use the OS used to build cabal to determine which extension to use, rather
1243 -- than the target OS (but this is wrong elsewhere in Cabal as well).
1244 flibTargetName :: LocalBuildInfo -> ForeignLib -> String
1245 flibTargetName lbi flib =
1246   case (os, foreignLibType flib) of
1247     (Windows, ForeignLibNativeShared) -> nm <.> "dll"
1248     (Windows, ForeignLibNativeStatic) -> nm <.> "lib"
1249     (Linux, ForeignLibNativeShared) -> "lib" ++ nm <.> versionedExt
1250     (_other, ForeignLibNativeShared) ->
1251       "lib" ++ nm <.> dllExtension (hostPlatform lbi)
1252     (_other, ForeignLibNativeStatic) ->
1253       "lib" ++ nm <.> staticLibExtension (hostPlatform lbi)
1254     (_any, ForeignLibTypeUnknown) -> cabalBug "unknown foreign lib type"
1255   where
1256     nm :: String
1257     nm = unUnqualComponentName $ foreignLibName flib
1258
1259     os :: OS
1260     os =
1261       let (Platform _ os') = hostPlatform lbi
1262        in os'
1263
1264     -- If a foreign lib foo has lib-version-info 5:1:2 or
1265     -- lib-version-linux 3.2.1, it should be built as libfoo.so.3.2.1
1266     -- Libtool's version-info data is translated into library versions in a
1267     -- nontrivial way: so refer to libtool documentation.
1268     versionedExt :: String
1269     versionedExt =
1270       let nums = foreignLibVersion flib os
1271        in foldl (<.>) "so" (map show nums)
1272
1273 -- | Name for the library when building.
1274 --
1275 -- If the `lib-version-info` field or the `lib-version-linux` field of
1276 -- a foreign library target is set, we need to incorporate that
1277 -- version into the SONAME field.
1278 --
1279 -- If a foreign library foo has lib-version-info 5:1:2, it should be
1280 -- built as libfoo.so.3.2.1.  We want it to get soname libfoo.so.3.
1281 -- However, GHC does not allow overriding soname by setting linker
1282 -- options, as it sets a soname of its own (namely the output
1283 -- filename), after the user-supplied linker options.  Hence, we have
1284 -- to compile the library with the soname as its filename.  We rename
1285 -- the compiled binary afterwards.
1286 --
1287 -- This method allows to adjust the name of the library at build time
1288 -- such that the correct soname can be set.
1289 flibBuildName :: LocalBuildInfo -> ForeignLib -> String
1290 flibBuildName lbi flib
1291   -- On linux, if a foreign-library has version data, the first digit is used
1292   -- to produce the SONAME.
1293   | (os, foreignLibType flib)
1294       == (Linux, ForeignLibNativeShared) =
1295       let nums = foreignLibVersion flib os
1296        in "lib" ++ nm <.> foldl (<.>) "so" (map show (take 1 nums))
1297   | otherwise = flibTargetName lbi flib
1298   where
1299     os :: OS
1300     os =
1301       let (Platform _ os') = hostPlatform lbi
1302        in os'
1303
1304     nm :: String
1305     nm = unUnqualComponentName $ foreignLibName flib
1306
1307 gbuildIsRepl :: GBuildMode -> Bool
1308 gbuildIsRepl (GBuildExe _) = False
1309 gbuildIsRepl (GReplExe _ _) = True
1310 gbuildIsRepl (GBuildFLib _) = False
1311 gbuildIsRepl (GReplFLib _ _) = True
1312
1313 gbuildNeedDynamic :: LocalBuildInfo -> GBuildMode -> Bool
1314 gbuildNeedDynamic lbi bm =
1315   case bm of
1316     GBuildExe _ -> withDynExe lbi
1317     GReplExe _ _ -> withDynExe lbi
1318     GBuildFLib flib -> withDynFLib flib
1319     GReplFLib _ flib -> withDynFLib flib
1320   where
1321     withDynFLib flib =
1322       case foreignLibType flib of
1323         ForeignLibNativeShared ->
1324           ForeignLibStandalone `notElem` foreignLibOptions flib
1325         ForeignLibNativeStatic ->
1326           False
1327         ForeignLibTypeUnknown ->
1328           cabalBug "unknown foreign lib type"
1329
1330 gbuildModDefFiles :: GBuildMode -> [FilePath]
1331 gbuildModDefFiles (GBuildExe _) = []
1332 gbuildModDefFiles (GReplExe _ _) = []
1333 gbuildModDefFiles (GBuildFLib flib) = foreignLibModDefFile flib
1334 gbuildModDefFiles (GReplFLib _ flib) = foreignLibModDefFile flib
1335
1336 -- | "Main" module name when overridden by @ghc-options: -main-is ...@
1337 -- or 'Nothing' if no @-main-is@ flag could be found.
1338 --
1339 -- In case of 'Nothing', 'Distribution.ModuleName.main' can be assumed.
1340 exeMainModuleName :: Executable -> Maybe ModuleName
1341 exeMainModuleName Executable{buildInfo = bnfo} =
1342   -- GHC honors the last occurrence of a module name updated via -main-is
1343   --
1344   -- Moreover, -main-is when parsed left-to-right can update either
1345   -- the "Main" module name, or the "main" function name, or both,
1346   -- see also 'decodeMainIsArg'.
1347   msum $ reverse $ map decodeMainIsArg $ findIsMainArgs ghcopts
1348   where
1349     ghcopts = hcOptions GHC bnfo
1350
1351     findIsMainArgs [] = []
1352     findIsMainArgs ("-main-is" : arg : rest) = arg : findIsMainArgs rest
1353     findIsMainArgs (_ : rest) = findIsMainArgs rest
1354
1355 -- | Decode argument to '-main-is'
1356 --
1357 -- Returns 'Nothing' if argument set only the function name.
1358 --
1359 -- This code has been stolen/refactored from GHC's DynFlags.setMainIs
1360 -- function. The logic here is deliberately imperfect as it is
1361 -- intended to be bug-compatible with GHC's parser. See discussion in
1362 -- https://github.com/haskell/cabal/pull/4539#discussion_r118981753.
1363 decodeMainIsArg :: String -> Maybe ModuleName
1364 decodeMainIsArg arg
1365   | headOf main_fn isLower =
1366       -- The arg looked like "Foo.Bar.baz"
1367       Just (ModuleName.fromString main_mod)
1368   | headOf arg isUpper -- The arg looked like "Foo" or "Foo.Bar"
1369     =
1370       Just (ModuleName.fromString arg)
1371   | otherwise -- The arg looked like "baz"
1372     =
1373       Nothing
1374   where
1375     headOf :: String -> (Char -> Bool) -> Bool
1376     headOf str pred' = any pred' (safeHead str)
1377
1378     (main_mod, main_fn) = splitLongestPrefix arg (== '.')
1379
1380     splitLongestPrefix :: String -> (Char -> Bool) -> (String, String)
1381     splitLongestPrefix str pred'
1382       | null r_pre = (str, [])
1383       | otherwise = (reverse (safeTail r_pre), reverse r_suf)
1384       where
1385         -- 'safeTail' drops the char satisfying 'pred'
1386         (r_suf, r_pre) = break pred' (reverse str)
1387
1388 -- | A collection of:
1389 --    * C input files
1390 --    * C++ input files
1391 --    * GHC input files
1392 --    * GHC input modules
1393 --
1394 -- Used to correctly build and link sources.
1395 data BuildSources = BuildSources
1396   { cSourcesFiles :: [FilePath]
1397   , cxxSourceFiles :: [FilePath]
1398   , jsSourceFiles :: [FilePath]
1399   , asmSourceFiles :: [FilePath]
1400   , cmmSourceFiles :: [FilePath]
1401   , inputSourceFiles :: [FilePath]
1402   , inputSourceModules :: [ModuleName]
1403   }
1404
1405 -- | Locate and return the 'BuildSources' required to build and link.
1406 gbuildSources
1407   :: Verbosity
1408   -> PackageId
1409   -> CabalSpecVersion
1410   -> FilePath
1411   -> GBuildMode
1412   -> IO BuildSources
1413 gbuildSources verbosity pkgId specVer tmpDir bm =
1414   case bm of
1415     GBuildExe exe -> exeSources exe
1416     GReplExe _ exe -> exeSources exe
1417     GBuildFLib flib -> return $ flibSources flib
1418     GReplFLib _ flib -> return $ flibSources flib
1419   where
1420     exeSources :: Executable -> IO BuildSources
1421     exeSources exe@Executable{buildInfo = bnfo, modulePath = modPath} = do
1422       main <- findFileEx verbosity (tmpDir : map getSymbolicPath (hsSourceDirs bnfo)) modPath
1423       let mainModName = fromMaybe ModuleName.main $ exeMainModuleName exe
1424           otherModNames = exeModules exe
1425
1426       -- Scripts have fakePackageId and are always Haskell but can have any extension.
1427       if isHaskell main || pkgId == fakePackageId
1428         then
1429           if specVer < CabalSpecV2_0 && (mainModName `elem` otherModNames)
1430             then do
1431               -- The cabal manual clearly states that `other-modules` is
1432               -- intended for non-main modules.  However, there's at least one
1433               -- important package on Hackage (happy-1.19.5) which
1434               -- violates this. We workaround this here so that we don't
1435               -- invoke GHC with e.g.  'ghc --make Main src/Main.hs' which
1436               -- would result in GHC complaining about duplicate Main
1437               -- modules.
1438               --
1439               -- Finally, we only enable this workaround for
1440               -- specVersion < 2, as 'cabal-version:>=2.0' cabal files
1441               -- have no excuse anymore to keep doing it wrong... ;-)
1442               warn verbosity $
1443                 "Enabling workaround for Main module '"
1444                   ++ prettyShow mainModName
1445                   ++ "' listed in 'other-modules' illegally!"
1446
1447               return
1448                 BuildSources
1449                   { cSourcesFiles = cSources bnfo
1450                   , cxxSourceFiles = cxxSources bnfo
1451                   , jsSourceFiles = jsSources bnfo
1452                   , asmSourceFiles = asmSources bnfo
1453                   , cmmSourceFiles = cmmSources bnfo
1454                   , inputSourceFiles = [main]
1455                   , inputSourceModules =
1456                       filter (/= mainModName) $
1457                         exeModules exe
1458                   }
1459             else
1460               return
1461                 BuildSources
1462                   { cSourcesFiles = cSources bnfo
1463                   , cxxSourceFiles = cxxSources bnfo
1464                   , jsSourceFiles = jsSources bnfo
1465                   , asmSourceFiles = asmSources bnfo
1466                   , cmmSourceFiles = cmmSources bnfo
1467                   , inputSourceFiles = [main]
1468                   , inputSourceModules = exeModules exe
1469                   }
1470         else
1471           let (csf, cxxsf)
1472                 | isCxx main = (cSources bnfo, main : cxxSources bnfo)
1473                 -- if main is not a Haskell source
1474                 -- and main is not a C++ source
1475                 -- then we assume that it is a C source
1476                 | otherwise = (main : cSources bnfo, cxxSources bnfo)
1477            in return
1478                 BuildSources
1479                   { cSourcesFiles = csf
1480                   , cxxSourceFiles = cxxsf
1481                   , jsSourceFiles = jsSources bnfo
1482                   , asmSourceFiles = asmSources bnfo
1483                   , cmmSourceFiles = cmmSources bnfo
1484                   , inputSourceFiles = []
1485                   , inputSourceModules = exeModules exe
1486                   }
1487
1488     flibSources :: ForeignLib -> BuildSources
1489     flibSources flib@ForeignLib{foreignLibBuildInfo = bnfo} =
1490       BuildSources
1491         { cSourcesFiles = cSources bnfo
1492         , cxxSourceFiles = cxxSources bnfo
1493         , jsSourceFiles = jsSources bnfo
1494         , asmSourceFiles = asmSources bnfo
1495         , cmmSourceFiles = cmmSources bnfo
1496         , inputSourceFiles = []
1497         , inputSourceModules = foreignLibModules flib
1498         }
1499
1500     isCxx :: FilePath -> Bool
1501     isCxx fp = elem (takeExtension fp) [".cpp", ".cxx", ".c++"]
1502
1503 -- | FilePath has a Haskell extension: .hs or .lhs
1504 isHaskell :: FilePath -> Bool
1505 isHaskell fp = elem (takeExtension fp) [".hs", ".lhs"]
1506
1507 replNoLoad :: Ord a => ReplOptions -> NubListR a -> NubListR a
1508 replNoLoad replFlags l
1509   | replOptionsNoLoad replFlags == Flag True = mempty
1510   | otherwise = l
1511
1512 -- | Generic build function. See comment for 'GBuildMode'.
1513 gbuild
1514   :: Verbosity
1515   -> Flag ParStrat
1516   -> PackageDescription
1517   -> LocalBuildInfo
1518   -> GBuildMode
1519   -> ComponentLocalBuildInfo
1520   -> IO ()
1521 gbuild verbosity numJobs pkg_descr lbi bm clbi = do
1522   (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
1523   let replFlags = case bm of
1524         GReplExe flags _ -> flags
1525         GReplFLib flags _ -> flags
1526         GBuildExe{} -> mempty
1527         GBuildFLib{} -> mempty
1528       comp = compiler lbi
1529       platform = hostPlatform lbi
1530       implInfo = getImplInfo comp
1531       runGhcProg = runGHC verbosity ghcProg comp platform
1532
1533   let bnfo = gbuildInfo bm
1534
1535   -- the name that GHC really uses (e.g., with .exe on Windows for executables)
1536   let targetName = gbuildTargetName lbi bm
1537   let targetDir = buildDir lbi </> (gbuildName bm)
1538   let tmpDir = targetDir </> (gbuildName bm ++ "-tmp")
1539   createDirectoryIfMissingVerbose verbosity True targetDir
1540   createDirectoryIfMissingVerbose verbosity True tmpDir
1541
1542   -- TODO: do we need to put hs-boot files into place for mutually recursive
1543   -- modules?  FIX: what about exeName.hi-boot?
1544
1545   -- Determine if program coverage should be enabled and if so, what
1546   -- '-hpcdir' should be.
1547   let isCoverageEnabled = exeCoverage lbi
1548       distPref = fromFlag $ configDistPref $ configFlags lbi
1549       hpcdir way
1550         | gbuildIsRepl bm = mempty -- HPC is not supported in ghci
1551         | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way (gbuildName bm)
1552         | otherwise = mempty
1553
1554   rpaths <- getRPaths lbi clbi
1555   buildSources <- gbuildSources verbosity (package pkg_descr) (specVersion pkg_descr) tmpDir bm
1556
1557   -- ensure extra lib dirs exist before passing to ghc
1558   cleanedExtraLibDirs <- filterM doesDirectoryExist (extraLibDirs bnfo)
1559   cleanedExtraLibDirsStatic <- filterM doesDirectoryExist (extraLibDirsStatic bnfo)
1560
1561   let cSrcs = cSourcesFiles buildSources
1562       cxxSrcs = cxxSourceFiles buildSources
1563       jsSrcs = jsSourceFiles buildSources
1564       asmSrcs = asmSourceFiles buildSources
1565       cmmSrcs = cmmSourceFiles buildSources
1566       inputFiles = inputSourceFiles buildSources
1567       inputModules = inputSourceModules buildSources
1568       isGhcDynamic = isDynamic comp
1569       dynamicTooSupported = supportsDynamicToo comp
1570       cLikeObjs = map (`replaceExtension` objExtension) cSrcs
1571       cxxObjs = map (`replaceExtension` objExtension) cxxSrcs
1572       jsObjs = if hasJsSupport then map (`replaceExtension` objExtension) jsSrcs else []
1573       asmObjs = map (`replaceExtension` objExtension) asmSrcs
1574       cmmObjs = map (`replaceExtension` objExtension) cmmSrcs
1575       needDynamic = gbuildNeedDynamic lbi bm
1576       needProfiling = withProfExe lbi
1577       Platform hostArch _ = hostPlatform lbi
1578       hasJsSupport = hostArch == JavaScript
1579
1580       -- build executables
1581       baseOpts =
1582         (componentGhcOptions verbosity lbi bnfo clbi tmpDir)
1583           `mappend` mempty
1584             { ghcOptMode = toFlag GhcModeMake
1585             , ghcOptInputFiles =
1586                 toNubListR $
1587                   if package pkg_descr == fakePackageId
1588                     then filter isHaskell inputFiles
1589                     else inputFiles
1590             , ghcOptInputScripts =
1591                 toNubListR $
1592                   if package pkg_descr == fakePackageId
1593                     then filter (not . isHaskell) inputFiles
1594                     else []
1595             , ghcOptInputModules = toNubListR inputModules
1596             }
1597       staticOpts =
1598         baseOpts
1599           `mappend` mempty
1600             { ghcOptDynLinkMode = toFlag GhcStaticOnly
1601             , ghcOptHPCDir = hpcdir Hpc.Vanilla
1602             }
1603       profOpts =
1604         baseOpts
1605           `mappend` mempty
1606             { ghcOptProfilingMode = toFlag True
1607             , ghcOptProfilingAuto =
1608                 Internal.profDetailLevelFlag
1609                   False
1610                   (withProfExeDetail lbi)
1611             , ghcOptHiSuffix = toFlag "p_hi"
1612             , ghcOptObjSuffix = toFlag "p_o"
1613             , ghcOptExtra = hcProfOptions GHC bnfo
1614             , ghcOptHPCDir = hpcdir Hpc.Prof
1615             }
1616       dynOpts =
1617         baseOpts
1618           `mappend` mempty
1619             { ghcOptDynLinkMode = toFlag GhcDynamicOnly
1620             , -- TODO: Does it hurt to set -fPIC for executables?
1621               ghcOptFPic = toFlag True
1622             , ghcOptHiSuffix = toFlag "dyn_hi"
1623             , ghcOptObjSuffix = toFlag "dyn_o"
1624             , ghcOptExtra = hcSharedOptions GHC bnfo
1625             , ghcOptHPCDir = hpcdir Hpc.Dyn
1626             }
1627       dynTooOpts =
1628         staticOpts
1629           `mappend` mempty
1630             { ghcOptDynLinkMode = toFlag GhcStaticAndDynamic
1631             , ghcOptDynHiSuffix = toFlag "dyn_hi"
1632             , ghcOptDynObjSuffix = toFlag "dyn_o"
1633             , ghcOptHPCDir = hpcdir Hpc.Dyn
1634             }
1635       linkerOpts =
1636         mempty
1637           { ghcOptLinkOptions =
1638               PD.ldOptions bnfo
1639                 ++ [ "-static"
1640                    | withFullyStaticExe lbi
1641                    ]
1642                 -- Pass extra `ld-options` given
1643                 -- through to GHC's linker.
1644                 ++ maybe
1645                   []
1646                   programOverrideArgs
1647                   (lookupProgram ldProgram (withPrograms lbi))
1648           , ghcOptLinkLibs =
1649               if withFullyStaticExe lbi
1650                 then extraLibsStatic bnfo
1651                 else extraLibs bnfo
1652           , ghcOptLinkLibPath =
1653               toNubListR $
1654                 if withFullyStaticExe lbi
1655                   then cleanedExtraLibDirsStatic
1656                   else cleanedExtraLibDirs
1657           , ghcOptLinkFrameworks =
1658               toNubListR $
1659                 PD.frameworks bnfo
1660           , ghcOptLinkFrameworkDirs =
1661               toNubListR $
1662                 PD.extraFrameworkDirs bnfo
1663           , ghcOptInputFiles =
1664               toNubListR
1665                 [tmpDir </> x | x <- cLikeObjs ++ cxxObjs ++ jsObjs ++ cmmObjs ++ asmObjs]
1666           }
1667       dynLinkerOpts =
1668         mempty
1669           { ghcOptRPaths = rpaths
1670           , ghcOptInputFiles =
1671               toNubListR
1672                 [tmpDir </> x | x <- cLikeObjs ++ cxxObjs ++ cmmObjs ++ asmObjs]
1673           }
1674       replOpts =
1675         baseOpts
1676           { ghcOptExtra =
1677               Internal.filterGhciFlags
1678                 (ghcOptExtra baseOpts)
1679                 <> replOptionsFlags replFlags
1680           , ghcOptInputModules = replNoLoad replFlags (ghcOptInputModules baseOpts)
1681           , ghcOptInputFiles = replNoLoad replFlags (ghcOptInputFiles baseOpts)
1682           }
1683           -- For a normal compile we do separate invocations of ghc for
1684           -- compiling as for linking. But for repl we have to do just
1685           -- the one invocation, so that one has to include all the
1686           -- linker stuff too, like -l flags and any .o files from C
1687           -- files etc.
1688           `mappend` linkerOpts
1689           `mappend` mempty
1690             { ghcOptMode = toFlag GhcModeInteractive
1691             , ghcOptOptimisation = toFlag GhcNoOptimisation
1692             }
1693       commonOpts
1694         | needProfiling = profOpts
1695         | needDynamic = dynOpts
1696         | otherwise = staticOpts
1697       compileOpts
1698         | useDynToo = dynTooOpts
1699         | otherwise = commonOpts
1700       withStaticExe = not needProfiling && not needDynamic
1701
1702       -- For building exe's that use TH with -prof or -dynamic we actually have
1703       -- to build twice, once without -prof/-dynamic and then again with
1704       -- -prof/-dynamic. This is because the code that TH needs to run at
1705       -- compile time needs to be the vanilla ABI so it can be loaded up and run
1706       -- by the compiler.
1707       -- With dynamic-by-default GHC the TH object files loaded at compile-time
1708       -- need to be .dyn_o instead of .o.
1709       doingTH = usesTemplateHaskellOrQQ bnfo
1710       -- Should we use -dynamic-too instead of compiling twice?
1711       useDynToo =
1712         dynamicTooSupported
1713           && isGhcDynamic
1714           && doingTH
1715           && withStaticExe
1716           && null (hcSharedOptions GHC bnfo)
1717       compileTHOpts
1718         | isGhcDynamic = dynOpts
1719         | otherwise = staticOpts
1720       compileForTH
1721         | gbuildIsRepl bm = False
1722         | useDynToo = False
1723         | isGhcDynamic = doingTH && (needProfiling || withStaticExe)
1724         | otherwise = doingTH && (needProfiling || needDynamic)
1725
1726   -- Build static/dynamic object files for TH, if needed.
1727   when compileForTH $
1728     runGhcProg
1729       compileTHOpts
1730         { ghcOptNoLink = toFlag True
1731         , ghcOptNumJobs = numJobs
1732         }
1733
1734   -- Do not try to build anything if there are no input files.
1735   -- This can happen if the cabal file ends up with only cSrcs
1736   -- but no Haskell modules.
1737   unless
1738     ( (null inputFiles && null inputModules)
1739         || gbuildIsRepl bm
1740     )
1741     $ runGhcProg
1742       compileOpts
1743         { ghcOptNoLink = toFlag True
1744         , ghcOptNumJobs = numJobs
1745         }
1746
1747   let
1748     buildExtraSources mkSrcOpts wantDyn = traverse_ $ buildExtraSource mkSrcOpts wantDyn
1749     buildExtraSource mkSrcOpts wantDyn filename = do
1750       let baseSrcOpts =
1751             mkSrcOpts
1752               verbosity
1753               implInfo
1754               lbi
1755               bnfo
1756               clbi
1757               tmpDir
1758               filename
1759           vanillaSrcOpts =
1760             if isGhcDynamic && wantDyn
1761               then -- Dynamic GHC requires C/C++ sources to be built
1762               -- with -fPIC for REPL to work. See #2207.
1763                 baseSrcOpts{ghcOptFPic = toFlag True}
1764               else baseSrcOpts
1765           profSrcOpts =
1766             vanillaSrcOpts
1767               `mappend` mempty
1768                 { ghcOptProfilingMode = toFlag True
1769                 }
1770           sharedSrcOpts =
1771             vanillaSrcOpts
1772               `mappend` mempty
1773                 { ghcOptFPic = toFlag True
1774                 , ghcOptDynLinkMode = toFlag GhcDynamicOnly
1775                 }
1776           opts
1777             | needProfiling = profSrcOpts
1778             | needDynamic && wantDyn = sharedSrcOpts
1779             | otherwise = vanillaSrcOpts
1780           -- TODO: Placing all Haskell, C, & C++ objects in a single directory
1781           --       Has the potential for file collisions. In general we would
1782           --       consider this a user error. However, we should strive to
1783           --       add a warning if this occurs.
1784           odir = fromFlag (ghcOptObjDir opts)
1785
1786       createDirectoryIfMissingVerbose verbosity True odir
1787       needsRecomp <- checkNeedsRecompilation filename opts
1788       when needsRecomp $
1789         runGhcProg opts
1790
1791   -- build any C++ sources
1792   unless (null cxxSrcs) $ do
1793     info verbosity "Building C++ Sources..."
1794     buildExtraSources Internal.componentCxxGhcOptions True cxxSrcs
1795
1796   -- build any C sources
1797   unless (null cSrcs) $ do
1798     info verbosity "Building C Sources..."
1799     buildExtraSources Internal.componentCcGhcOptions True cSrcs
1800
1801   -- build any JS sources
1802   unless (not hasJsSupport || null jsSrcs) $ do
1803     info verbosity "Building JS Sources..."
1804     buildExtraSources Internal.componentJsGhcOptions False jsSrcs
1805
1806   -- build any ASM sources
1807   unless (null asmSrcs) $ do
1808     info verbosity "Building Assembler Sources..."
1809     buildExtraSources Internal.componentAsmGhcOptions True asmSrcs
1810
1811   -- build any Cmm sources
1812   unless (null cmmSrcs) $ do
1813     info verbosity "Building C-- Sources..."
1814     buildExtraSources Internal.componentCmmGhcOptions True cmmSrcs
1815
1816   -- TODO: problem here is we need the .c files built first, so we can load them
1817   -- with ghci, but .c files can depend on .h files generated by ghc by ffi
1818   -- exports.
1819   case bm of
1820     GReplExe _ _ -> runReplOrWriteFlags verbosity ghcProg comp platform replFlags replOpts bnfo clbi (pkgName (PD.package pkg_descr))
1821     GReplFLib _ _ -> runReplOrWriteFlags verbosity ghcProg comp platform replFlags replOpts bnfo clbi (pkgName (PD.package pkg_descr))
1822     GBuildExe _ -> do
1823       let linkOpts =
1824             commonOpts
1825               `mappend` linkerOpts
1826               `mappend` mempty
1827                 { ghcOptLinkNoHsMain = toFlag (null inputFiles)
1828                 }
1829               `mappend` (if withDynExe lbi then dynLinkerOpts else mempty)
1830
1831       info verbosity "Linking..."
1832       -- Work around old GHCs not relinking in this
1833       -- situation, see #3294
1834       let target = targetDir </> targetName
1835       when (compilerVersion comp < mkVersion [7, 7]) $ do
1836         e <- doesFileExist target
1837         when e (removeFile target)
1838       runGhcProg linkOpts{ghcOptOutputFile = toFlag target}
1839     GBuildFLib flib -> do
1840       let
1841         -- Instruct GHC to link against libHSrts.
1842         rtsLinkOpts :: GhcOptions
1843         rtsLinkOpts
1844           | supportsFLinkRts =
1845               mempty
1846                 { ghcOptLinkRts = toFlag True
1847                 }
1848           | otherwise =
1849               mempty
1850                 { ghcOptLinkLibs = rtsOptLinkLibs
1851                 , ghcOptLinkLibPath = toNubListR $ rtsLibPaths rtsInfo
1852                 }
1853           where
1854             threaded = hasThreaded (gbuildInfo bm)
1855             supportsFLinkRts = compilerVersion comp >= mkVersion [9, 0]
1856             rtsInfo = extractRtsInfo lbi
1857             rtsOptLinkLibs =
1858               [ if needDynamic
1859                   then
1860                     if threaded
1861                       then dynRtsThreadedLib (rtsDynamicInfo rtsInfo)
1862                       else dynRtsVanillaLib (rtsDynamicInfo rtsInfo)
1863                   else
1864                     if threaded
1865                       then statRtsThreadedLib (rtsStaticInfo rtsInfo)
1866                       else statRtsVanillaLib (rtsStaticInfo rtsInfo)
1867               ]
1868
1869         linkOpts :: GhcOptions
1870         linkOpts = case foreignLibType flib of
1871           ForeignLibNativeShared ->
1872             commonOpts
1873               `mappend` linkerOpts
1874               `mappend` dynLinkerOpts
1875               `mappend` rtsLinkOpts
1876               `mappend` mempty
1877                 { ghcOptLinkNoHsMain = toFlag True
1878                 , ghcOptShared = toFlag True
1879                 , ghcOptFPic = toFlag True
1880                 , ghcOptLinkModDefFiles = toNubListR $ gbuildModDefFiles bm
1881                 }
1882           ForeignLibNativeStatic ->
1883             -- this should be caught by buildFLib
1884             -- (and if we do implement this, we probably don't even want to call
1885             -- ghc here, but rather Ar.createArLibArchive or something)
1886             cabalBug "static libraries not yet implemented"
1887           ForeignLibTypeUnknown ->
1888             cabalBug "unknown foreign lib type"
1889       -- We build under a (potentially) different filename to set a
1890       -- soname on supported platforms.  See also the note for
1891       -- @flibBuildName@.
1892       info verbosity "Linking..."
1893       let buildName = flibBuildName lbi flib
1894       runGhcProg linkOpts{ghcOptOutputFile = toFlag (targetDir </> buildName)}
1895       renameFile (targetDir </> buildName) (targetDir </> targetName)
1896
1897 data DynamicRtsInfo = DynamicRtsInfo
1898   { dynRtsVanillaLib :: FilePath
1899   , dynRtsThreadedLib :: FilePath
1900   , dynRtsDebugLib :: FilePath
1901   , dynRtsEventlogLib :: FilePath
1902   , dynRtsThreadedDebugLib :: FilePath
1903   , dynRtsThreadedEventlogLib :: FilePath
1904   }
1905
1906 data StaticRtsInfo = StaticRtsInfo
1907   { statRtsVanillaLib :: FilePath
1908   , statRtsThreadedLib :: FilePath
1909   , statRtsDebugLib :: FilePath
1910   , statRtsEventlogLib :: FilePath
1911   , statRtsThreadedDebugLib :: FilePath
1912   , statRtsThreadedEventlogLib :: FilePath
1913   , statRtsProfilingLib :: FilePath
1914   , statRtsThreadedProfilingLib :: FilePath
1915   }
1916
1917 data RtsInfo = RtsInfo
1918   { rtsDynamicInfo :: DynamicRtsInfo
1919   , rtsStaticInfo :: StaticRtsInfo
1920   , rtsLibPaths :: [FilePath]
1921   }
1922
1923 -- | Extract (and compute) information about the RTS library
1924 --
1925 -- TODO: This hardcodes the name as @HSrts-ghc<version>@. I don't know if we can
1926 -- find this information somewhere. We can lookup the 'hsLibraries' field of
1927 -- 'InstalledPackageInfo' but it will tell us @["HSrts", "Cffi"]@, which
1928 -- doesn't really help.
1929 extractRtsInfo :: LocalBuildInfo -> RtsInfo
1930 extractRtsInfo lbi =
1931   case PackageIndex.lookupPackageName
1932     (installedPkgs lbi)
1933     (mkPackageName "rts") of
1934     [(_, [rts])] -> aux rts
1935     _otherwise -> error "No (or multiple) ghc rts package is registered"
1936   where
1937     aux :: InstalledPackageInfo -> RtsInfo
1938     aux rts =
1939       RtsInfo
1940         { rtsDynamicInfo =
1941             DynamicRtsInfo
1942               { dynRtsVanillaLib = withGhcVersion "HSrts"
1943               , dynRtsThreadedLib = withGhcVersion "HSrts_thr"
1944               , dynRtsDebugLib = withGhcVersion "HSrts_debug"
1945               , dynRtsEventlogLib = withGhcVersion "HSrts_l"
1946               , dynRtsThreadedDebugLib = withGhcVersion "HSrts_thr_debug"
1947               , dynRtsThreadedEventlogLib = withGhcVersion "HSrts_thr_l"
1948               }
1949         , rtsStaticInfo =
1950             StaticRtsInfo
1951               { statRtsVanillaLib = "HSrts"
1952               , statRtsThreadedLib = "HSrts_thr"
1953               , statRtsDebugLib = "HSrts_debug"
1954               , statRtsEventlogLib = "HSrts_l"
1955               , statRtsThreadedDebugLib = "HSrts_thr_debug"
1956               , statRtsThreadedEventlogLib = "HSrts_thr_l"
1957               , statRtsProfilingLib = "HSrts_p"
1958               , statRtsThreadedProfilingLib = "HSrts_thr_p"
1959               }
1960         , rtsLibPaths = InstalledPackageInfo.libraryDirs rts
1961         }
1962     withGhcVersion = (++ ("-ghc" ++ prettyShow (compilerVersion (compiler lbi))))
1963
1964 -- | Returns True if the modification date of the given source file is newer than
1965 -- the object file we last compiled for it, or if no object file exists yet.
1966 checkNeedsRecompilation :: FilePath -> GhcOptions -> IO Bool
1967 checkNeedsRecompilation filename opts = filename `moreRecentFile` oname
1968   where
1969     oname = getObjectFileName filename opts
1970
1971 -- | Finds the object file name of the given source file
1972 getObjectFileName :: FilePath -> GhcOptions -> FilePath
1973 getObjectFileName filename opts = oname
1974   where
1975     odir = fromFlag (ghcOptObjDir opts)
1976     oext = fromFlagOrDefault "o" (ghcOptObjSuffix opts)
1977     oname = odir </> replaceExtension filename oext
1978
1979 -- | Calculate the RPATHs for the component we are building.
1980 --
1981 -- Calculates relative RPATHs when 'relocatable' is set.
1982 getRPaths
1983   :: LocalBuildInfo
1984   -> ComponentLocalBuildInfo
1985   -- ^ Component we are building
1986   -> IO (NubListR FilePath)
1987 getRPaths lbi clbi | supportRPaths hostOS = do
1988   libraryPaths <- depLibraryPaths False (relocatable lbi) lbi clbi
1989   let hostPref = case hostOS of
1990         OSX -> "@loader_path"
1991         _ -> "$ORIGIN"
1992       relPath p = if isRelative p then hostPref </> p else p
1993       rpaths = toNubListR (map relPath libraryPaths)
1994   return rpaths
1995   where
1996     (Platform _ hostOS) = hostPlatform lbi
1997     compid = compilerId . compiler $ lbi
1998
1999     -- The list of RPath-supported operating systems below reflects the
2000     -- platforms on which Cabal's RPATH handling is tested. It does _NOT_
2001     -- reflect whether the OS supports RPATH.
2002
2003     -- E.g. when this comment was written, the *BSD operating systems were
2004     -- untested with regards to Cabal RPATH handling, and were hence set to
2005     -- 'False', while those operating systems themselves do support RPATH.
2006     supportRPaths Linux = True
2007     supportRPaths Windows = False
2008     supportRPaths OSX = True
2009     supportRPaths FreeBSD =
2010       case compid of
2011         CompilerId GHC ver | ver >= mkVersion [7, 10, 2] -> True
2012         _ -> False
2013     supportRPaths OpenBSD = False
2014     supportRPaths NetBSD = False
2015     supportRPaths DragonFly = False
2016     supportRPaths Solaris = False
2017     supportRPaths AIX = False
2018     supportRPaths HPUX = False
2019     supportRPaths IRIX = False
2020     supportRPaths HaLVM = False
2021     supportRPaths IOS = False
2022     supportRPaths Android = False
2023     supportRPaths Ghcjs = False
2024     supportRPaths Wasi = False
2025     supportRPaths Hurd = False
2026     supportRPaths Haiku = False
2027     supportRPaths (OtherOS _) = False
2028 -- Do _not_ add a default case so that we get a warning here when a new OS
2029 -- is added.
2030
2031 getRPaths _ _ = return mempty
2032
2033 -- | Determine whether the given 'BuildInfo' is intended to link against the
2034 -- threaded RTS. This is used to determine which RTS to link against when
2035 -- building a foreign library with a GHC without support for @-flink-rts@.
2036 hasThreaded :: BuildInfo -> Bool
2037 hasThreaded bi = elem "-threaded" ghc
2038   where
2039     PerCompilerFlavor ghc _ = options bi
2040
2041 -- | Extracts a String representing a hash of the ABI of a built
2042 -- library.  It can fail if the library has not yet been built.
2043 libAbiHash
2044   :: Verbosity
2045   -> PackageDescription
2046   -> LocalBuildInfo
2047   -> Library
2048   -> ComponentLocalBuildInfo
2049   -> IO String
2050 libAbiHash verbosity _pkg_descr lbi lib clbi = do
2051   let
2052     libBi = libBuildInfo lib
2053     comp = compiler lbi
2054     platform = hostPlatform lbi
2055     vanillaArgs0 =
2056       (componentGhcOptions verbosity lbi libBi clbi (componentBuildDir lbi clbi))
2057         `mappend` mempty
2058           { ghcOptMode = toFlag GhcModeAbiHash
2059           , ghcOptInputModules = toNubListR $ exposedModules lib
2060           }
2061     vanillaArgs =
2062       -- Package DBs unnecessary, and break ghc-cabal. See #3633
2063       -- BUT, put at least the global database so that 7.4 doesn't
2064       -- break.
2065       vanillaArgs0
2066         { ghcOptPackageDBs = [GlobalPackageDB]
2067         , ghcOptPackages = mempty
2068         }
2069     sharedArgs =
2070       vanillaArgs
2071         `mappend` mempty
2072           { ghcOptDynLinkMode = toFlag GhcDynamicOnly
2073           , ghcOptFPic = toFlag True
2074           , ghcOptHiSuffix = toFlag "dyn_hi"
2075           , ghcOptObjSuffix = toFlag "dyn_o"
2076           , ghcOptExtra = hcSharedOptions GHC libBi
2077           }
2078     profArgs =
2079       vanillaArgs
2080         `mappend` mempty
2081           { ghcOptProfilingMode = toFlag True
2082           , ghcOptProfilingAuto =
2083               Internal.profDetailLevelFlag
2084                 True
2085                 (withProfLibDetail lbi)
2086           , ghcOptHiSuffix = toFlag "p_hi"
2087           , ghcOptObjSuffix = toFlag "p_o"
2088           , ghcOptExtra = hcProfOptions GHC libBi
2089           }
2090     ghcArgs
2091       | withVanillaLib lbi = vanillaArgs
2092       | withSharedLib lbi = sharedArgs
2093       | withProfLib lbi = profArgs
2094       | otherwise = error "libAbiHash: Can't find an enabled library way"
2095
2096   (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
2097   hash <-
2098     getProgramInvocationOutput
2099       verbosity
2100       (ghcInvocation ghcProg comp platform ghcArgs)
2101   return (takeWhile (not . isSpace) hash)
2102
2103 componentGhcOptions
2104   :: Verbosity
2105   -> LocalBuildInfo
2106   -> BuildInfo
2107   -> ComponentLocalBuildInfo
2108   -> FilePath
2109   -> GhcOptions
2110 componentGhcOptions verbosity lbi =
2111   Internal.componentGhcOptions verbosity implInfo lbi
2112   where
2113     comp = compiler lbi
2114     implInfo = getImplInfo comp
2115
2116 componentCcGhcOptions
2117   :: Verbosity
2118   -> LocalBuildInfo
2119   -> BuildInfo
2120   -> ComponentLocalBuildInfo
2121   -> FilePath
2122   -> FilePath
2123   -> GhcOptions
2124 componentCcGhcOptions verbosity lbi =
2125   Internal.componentCcGhcOptions verbosity implInfo lbi
2126   where
2127     comp = compiler lbi
2128     implInfo = getImplInfo comp
2129
2130 -- -----------------------------------------------------------------------------
2131 -- Installing
2132
2133 -- | Install executables for GHC.
2134 installExe
2135   :: Verbosity
2136   -> LocalBuildInfo
2137   -> FilePath
2138   -- ^ Where to copy the files to
2139   -> FilePath
2140   -- ^ Build location
2141   -> (FilePath, FilePath)
2142   -- ^ Executable (prefix,suffix)
2143   -> PackageDescription
2144   -> Executable
2145   -> IO ()
2146 installExe
2147   verbosity
2148   lbi
2149   binDir
2150   buildPref
2151   (progprefix, progsuffix)
2152   _pkg
2153   exe = do
2154     createDirectoryIfMissingVerbose verbosity True binDir
2155     let exeName' = unUnqualComponentName $ exeName exe
2156         exeFileName = exeTargetName (hostPlatform lbi) exe
2157         fixedExeBaseName = progprefix ++ exeName' ++ progsuffix
2158         installBinary dest = do
2159           installExecutableFile
2160             verbosity
2161             (buildPref </> exeName' </> exeFileName)
2162             (dest <.> exeExtension (hostPlatform lbi))
2163           when (stripExes lbi) $
2164             Strip.stripExe
2165               verbosity
2166               (hostPlatform lbi)
2167               (withPrograms lbi)
2168               (dest <.> exeExtension (hostPlatform lbi))
2169     installBinary (binDir </> fixedExeBaseName)
2170
2171 -- | Install foreign library for GHC.
2172 installFLib
2173   :: Verbosity
2174   -> LocalBuildInfo
2175   -> FilePath
2176   -- ^ install location
2177   -> FilePath
2178   -- ^ Build location
2179   -> PackageDescription
2180   -> ForeignLib
2181   -> IO ()
2182 installFLib verbosity lbi targetDir builtDir _pkg flib =
2183   install
2184     (foreignLibIsShared flib)
2185     builtDir
2186     targetDir
2187     (flibTargetName lbi flib)
2188   where
2189     install isShared srcDir dstDir name = do
2190       let src = srcDir </> name
2191           dst = dstDir </> name
2192       createDirectoryIfMissingVerbose verbosity True targetDir
2193       -- TODO: Should we strip? (stripLibs lbi)
2194       if isShared
2195         then installExecutableFile verbosity src dst
2196         else installOrdinaryFile verbosity src dst
2197       -- Now install appropriate symlinks if library is versioned
2198       let (Platform _ os) = hostPlatform lbi
2199       when (not (null (foreignLibVersion flib os))) $ do
2200         when (os /= Linux) $
2201           dieWithException verbosity $
2202             CantInstallForeignLib
2203 #ifndef mingw32_HOST_OS
2204         -- 'createSymbolicLink file1 file2' creates a symbolic link
2205         -- named 'file2' which points to the file 'file1'.
2206         -- Note that we do want a symlink to 'name' rather than
2207         -- 'dst', because the symlink will be relative to the
2208         -- directory it's created in.
2209         -- Finally, we first create the symlinks in a temporary
2210         -- directory and then rename to simulate 'ln --force'.
2211         withTempDirectory verbosity dstDir nm $ \tmpDir -> do
2212             let link1 = flibBuildName lbi flib
2213                 link2 = "lib" ++ nm <.> "so"
2214             createSymbolicLink name (tmpDir </> link1)
2215             renameFile (tmpDir </> link1) (dstDir </> link1)
2216             createSymbolicLink name (tmpDir </> link2)
2217             renameFile (tmpDir </> link2) (dstDir </> link2)
2218       where
2219         nm :: String
2220         nm = unUnqualComponentName $ foreignLibName flib
2221 #endif /* mingw32_HOST_OS */
2222
2223 -- | Install for ghc, .hi, .a and, if --with-ghci given, .o
2224 installLib
2225   :: Verbosity
2226   -> LocalBuildInfo
2227   -> FilePath
2228   -- ^ install location
2229   -> FilePath
2230   -- ^ install location for dynamic libraries
2231   -> FilePath
2232   -- ^ Build location
2233   -> PackageDescription
2234   -> Library
2235   -> ComponentLocalBuildInfo
2236   -> IO ()
2237 installLib verbosity lbi targetDir dynlibTargetDir _builtDir pkg lib clbi = do
2238   -- copy .hi files over:
2239   whenVanilla $ copyModuleFiles "hi"
2240   whenProf $ copyModuleFiles "p_hi"
2241   whenShared $ copyModuleFiles "dyn_hi"
2242
2243   -- copy extra compilation artifacts that ghc plugins may produce
2244   copyDirectoryIfExists extraCompilationArtifacts
2245
2246   -- copy the built library files over:
2247   whenHasCode $ do
2248     whenVanilla $ do
2249       sequence_
2250         [ installOrdinary
2251           builtDir
2252           targetDir
2253           (mkGenericStaticLibName (l ++ f))
2254         | l <-
2255             getHSLibraryName
2256               (componentUnitId clbi)
2257               : (extraBundledLibs (libBuildInfo lib))
2258         , f <- "" : extraLibFlavours (libBuildInfo lib)
2259         ]
2260       whenGHCi $ installOrdinary builtDir targetDir ghciLibName
2261     whenProf $ do
2262       installOrdinary builtDir targetDir profileLibName
2263       whenGHCi $ installOrdinary builtDir targetDir ghciProfLibName
2264     whenShared $
2265       if
2266           -- The behavior for "extra-bundled-libraries" changed in version 2.5.0.
2267           -- See ghc issue #15837 and Cabal PR #5855.
2268           | specVersion pkg < CabalSpecV3_0 -> do
2269               sequence_
2270                 [ installShared
2271                   builtDir
2272                   dynlibTargetDir
2273                   (mkGenericSharedLibName platform compiler_id (l ++ f))
2274                 | l <- getHSLibraryName uid : extraBundledLibs (libBuildInfo lib)
2275                 , f <- "" : extraDynLibFlavours (libBuildInfo lib)
2276                 ]
2277           | otherwise -> do
2278               sequence_
2279                 [ installShared
2280                   builtDir
2281                   dynlibTargetDir
2282                   ( mkGenericSharedLibName
2283                       platform
2284                       compiler_id
2285                       (getHSLibraryName uid ++ f)
2286                   )
2287                 | f <- "" : extraDynLibFlavours (libBuildInfo lib)
2288                 ]
2289               sequence_
2290                 [ do
2291                   files <- getDirectoryContents builtDir
2292                   let l' =
2293                         mkGenericSharedBundledLibName
2294                           platform
2295                           compiler_id
2296                           l
2297                   forM_ files $ \file ->
2298                     when (l' `isPrefixOf` file) $ do
2299                       isFile <- doesFileExist (builtDir </> file)
2300                       when isFile $ do
2301                         installShared
2302                           builtDir
2303                           dynlibTargetDir
2304                           file
2305                 | l <- extraBundledLibs (libBuildInfo lib)
2306                 ]
2307   where
2308     builtDir = componentBuildDir lbi clbi
2309
2310     install isShared srcDir dstDir name = do
2311       let src = srcDir </> name
2312           dst = dstDir </> name
2313
2314       createDirectoryIfMissingVerbose verbosity True dstDir
2315
2316       if isShared
2317         then installExecutableFile verbosity src dst
2318         else installOrdinaryFile verbosity src dst
2319
2320       when (stripLibs lbi) $
2321         Strip.stripLib
2322           verbosity
2323           platform
2324           (withPrograms lbi)
2325           dst
2326
2327     installOrdinary = install False
2328     installShared = install True
2329
2330     copyModuleFiles ext =
2331       findModuleFilesEx verbosity [builtDir] [ext] (allLibModules lib clbi)
2332         >>= installOrdinaryFiles verbosity targetDir
2333
2334     copyDirectoryIfExists dirName = do
2335       let src = builtDir </> dirName
2336           dst = targetDir </> dirName
2337       dirExists <- doesDirectoryExist src
2338       when dirExists $ copyDirectoryRecursive verbosity src dst
2339
2340     compiler_id = compilerId (compiler lbi)
2341     platform = hostPlatform lbi
2342     uid = componentUnitId clbi
2343     profileLibName = mkProfLibName uid
2344     ghciLibName = Internal.mkGHCiLibName uid
2345     ghciProfLibName = Internal.mkGHCiProfLibName uid
2346
2347     hasLib =
2348       not $
2349         null (allLibModules lib clbi)
2350           && null (cSources (libBuildInfo lib))
2351           && null (cxxSources (libBuildInfo lib))
2352           && null (cmmSources (libBuildInfo lib))
2353           && null (asmSources (libBuildInfo lib))
2354           && (null (jsSources (libBuildInfo lib)) || not hasJsSupport)
2355     hasJsSupport = case hostPlatform lbi of
2356       Platform JavaScript _ -> True
2357       _ -> False
2358     has_code = not (componentIsIndefinite clbi)
2359     whenHasCode = when has_code
2360     whenVanilla = when (hasLib && withVanillaLib lbi)
2361     whenProf = when (hasLib && withProfLib lbi && has_code)
2362     whenGHCi = when (hasLib && withGHCiLib lbi && has_code)
2363     whenShared = when (hasLib && withSharedLib lbi && has_code)
2364
2365 -- -----------------------------------------------------------------------------
2366 -- Registering
2367
2368 hcPkgInfo :: ProgramDb -> HcPkg.HcPkgInfo
2369 hcPkgInfo progdb =
2370   HcPkg.HcPkgInfo
2371     { HcPkg.hcPkgProgram = ghcPkgProg
2372     , HcPkg.noPkgDbStack = v < [6, 9]
2373     , HcPkg.noVerboseFlag = v < [6, 11]
2374     , HcPkg.flagPackageConf = v < [7, 5]
2375     , HcPkg.supportsDirDbs = v >= [6, 8]
2376     , HcPkg.requiresDirDbs = v >= [7, 10]
2377     , HcPkg.nativeMultiInstance = v >= [7, 10]
2378     , HcPkg.recacheMultiInstance = v >= [6, 12]
2379     , HcPkg.suppressFilesCheck = v >= [6, 6]
2380     }
2381   where
2382     v = versionNumbers ver
2383     ghcPkgProg = fromMaybe (error "GHC.hcPkgInfo: no ghc program") $ lookupProgram ghcPkgProgram progdb
2384     ver = fromMaybe (error "GHC.hcPkgInfo: no ghc version") $ programVersion ghcPkgProg
2385
2386 registerPackage
2387   :: Verbosity
2388   -> ProgramDb
2389   -> PackageDBStack
2390   -> InstalledPackageInfo
2391   -> HcPkg.RegisterOptions
2392   -> IO ()
2393 registerPackage verbosity progdb packageDbs installedPkgInfo registerOptions =
2394   HcPkg.register
2395     (hcPkgInfo progdb)
2396     verbosity
2397     packageDbs
2398     installedPkgInfo
2399     registerOptions
2400
2401 pkgRoot :: Verbosity -> LocalBuildInfo -> PackageDB -> IO FilePath
2402 pkgRoot verbosity lbi = pkgRoot'
2403   where
2404     pkgRoot' GlobalPackageDB =
2405       let ghcProg = fromMaybe (error "GHC.pkgRoot: no ghc program") $ lookupProgram ghcProgram (withPrograms lbi)
2406        in fmap takeDirectory (getGlobalPackageDB verbosity ghcProg)
2407     pkgRoot' UserPackageDB = do
2408       appDir <- getGhcAppDir
2409       let ver = compilerVersion (compiler lbi)
2410           subdir =
2411             System.Info.arch
2412               ++ '-'
2413               : System.Info.os
2414               ++ '-'
2415               : prettyShow ver
2416           rootDir = appDir </> subdir
2417       -- We must create the root directory for the user package database if it
2418       -- does not yet exists. Otherwise '${pkgroot}' will resolve to a
2419       -- directory at the time of 'ghc-pkg register', and registration will
2420       -- fail.
2421       createDirectoryIfMissing True rootDir
2422       return rootDir
2423     pkgRoot' (SpecificPackageDB fp) = return (takeDirectory fp)
2424
2425 -- -----------------------------------------------------------------------------
2426 -- Utils
2427
2428 isDynamic :: Compiler -> Bool
2429 isDynamic = Internal.ghcLookupProperty "GHC Dynamic"
2430
2431 supportsDynamicToo :: Compiler -> Bool
2432 supportsDynamicToo = Internal.ghcLookupProperty "Support dynamic-too"
2433
2434 withExt :: FilePath -> String -> FilePath
2435 withExt fp ext = fp <.> if takeExtension fp /= ('.' : ext) then ext else ""