Cabal/src/Distribution/Simple/GHC.hs

   1 {-# LANGUAGE CPP #-}
   2 {-# LANGUAGE FlexibleContexts #-}
   3 {-# LANGUAGE MultiWayIf #-}
   4 {-# LANGUAGE NamedFieldPuns #-}
   5 {-# LANGUAGE RankNTypes #-}
   6 {-# LANGUAGE TupleSections #-}
   7
   8 -----------------------------------------------------------------------------
   9
  10 -- |
  11 -- Module      :  Distribution.Simple.GHC
  12 -- Copyright   :  Isaac Jones 2003-2007
  13 -- License     :  BSD3
  14 --
  15 -- Maintainer  :  cabal-devel@haskell.org
  16 -- Portability :  portable
  17 --
  18 -- This is a fairly large module. It contains most of the GHC-specific code for
  19 -- configuring, building and installing packages. It also exports a function
  20 -- for finding out what packages are already installed. Configuring involves
  21 -- finding the @ghc@ and @ghc-pkg@ programs, finding what language extensions
  22 -- this version of ghc supports and returning a 'Compiler' value.
  23 --
  24 -- 'getInstalledPackages' involves calling the @ghc-pkg@ program to find out
  25 -- what packages are installed.
  26 --
  27 -- Building is somewhat complex as there is quite a bit of information to take
  28 -- into account. We have to build libs and programs, possibly for profiling and
  29 -- shared libs. We have to support building libraries that will be usable by
  30 -- GHCi and also ghc's @-split-objs@ feature. We have to compile any C files
  31 -- using ghc. Linking, especially for @split-objs@ is remarkably complex,
  32 -- partly because there tend to be 1,000's of @.o@ files and this can often be
  33 -- more than we can pass to the @ld@ or @ar@ programs in one go.
  34 --
  35 -- Installing for libs and exes involves finding the right files and copying
  36 -- them to the right places. One of the more tricky things about this module is
  37 -- remembering the layout of files in the build directory (which is not
  38 -- explicitly documented) and thus what search dirs are used for various kinds
  39 -- of files.
  40 module Distribution.Simple.GHC
  41   ( getGhcInfo
  42   , configure
  43   , getInstalledPackages
  44   , getInstalledPackagesMonitorFiles
  45   , getPackageDBContents
  46   , buildLib
  47   , buildFLib
  48   , buildExe
  49   , replLib
  50   , replFLib
  51   , replExe
  52   , startInterpreter
  53   , installLib
  54   , installFLib
  55   , installExe
  56   , libAbiHash
  57   , hcPkgInfo
  58   , registerPackage
  59   , Internal.componentGhcOptions
  60   , Internal.componentCcGhcOptions
  61   , getGhcAppDir
  62   , getLibDir
  63   , isDynamic
  64   , getGlobalPackageDB
  65   , pkgRoot
  66
  67     -- * Constructing and deconstructing GHC environment files
  68   , Internal.GhcEnvironmentFileEntry (..)
  69   , Internal.simpleGhcEnvironmentFile
  70   , Internal.renderGhcEnvironmentFile
  71   , Internal.writeGhcEnvironmentFile
  72   , Internal.ghcPlatformAndVersionString
  73   , readGhcEnvironmentFile
  74   , parseGhcEnvironmentFile
  75   , ParseErrorExc (..)
  76
  77     -- * Version-specific implementation quirks
  78   , getImplInfo
  79   , GhcImplInfo (..)
  80   ) where
  81
  82 import Distribution.Compat.Prelude
  83 import Prelude ()
  84
  85 import Control.Monad (forM_)
  86 import Data.List (stripPrefix)
  87 import qualified Data.Map as Map
  88 import Distribution.CabalSpecVersion
  89 import Distribution.InstalledPackageInfo (InstalledPackageInfo)
  90 import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
  91 import Distribution.Package
  92 import Distribution.PackageDescription as PD
  93 import Distribution.Pretty
  94 import Distribution.Simple.Build.Inputs (PreBuildComponentInputs (..))
  95 import Distribution.Simple.BuildPaths
  96 import Distribution.Simple.Compiler
  97 import Distribution.Simple.Errors
  98 import Distribution.Simple.Flag (Flag (..), toFlag)
  99 import qualified Distribution.Simple.GHC.Build as GHC
 100 import Distribution.Simple.GHC.Build.Utils
 101 import Distribution.Simple.GHC.EnvironmentParser
 102 import Distribution.Simple.GHC.ImplInfo
 103 import qualified Distribution.Simple.GHC.Internal as Internal
 104 import Distribution.Simple.LocalBuildInfo
 105 import Distribution.Simple.PackageIndex (InstalledPackageIndex)
 106 import qualified Distribution.Simple.PackageIndex as PackageIndex
 107 import Distribution.Simple.PreProcess.Types
 108 import Distribution.Simple.Program
 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.Strip as Strip
 113 import Distribution.Simple.Setup.Common (extraCompilationArtifacts)
 114 import Distribution.Simple.Setup.Repl
 115 import Distribution.Simple.Utils
 116 import Distribution.System
 117 import Distribution.Types.ComponentLocalBuildInfo
 118 import Distribution.Types.ParStrat
 119 import Distribution.Types.TargetInfo
 120 import Distribution.Utils.NubList
 121 import Distribution.Verbosity
 122 import Distribution.Version
 123 import Language.Haskell.Extension
 124 import System.Directory
 125   ( canonicalizePath
 126   , createDirectoryIfMissing
 127   , doesDirectoryExist
 128   , doesFileExist
 129   , getAppUserDataDirectory
 130   , getDirectoryContents
 131   )
 132 import System.FilePath
 133   ( takeDirectory
 134   , (<.>)
 135   , (</>)
 136   )
 137 import qualified System.Info
 138 #ifndef mingw32_HOST_OS
 139 import System.Directory (renameFile)
 140 import System.Posix (createSymbolicLink)
 141 #endif /* mingw32_HOST_OS */
 142
 143 import Distribution.Simple.Setup (BuildingWhat (..))
 144 import Distribution.Simple.Setup.Build
 145
 146 -- -----------------------------------------------------------------------------
 147 -- Configuring
 148
 149 configure
 150   :: Verbosity
 151   -> Maybe FilePath
 152   -> Maybe FilePath
 153   -> ProgramDb
 154   -> IO (Compiler, Maybe Platform, ProgramDb)
 155 configure verbosity hcPath hcPkgPath conf0 = do
 156   (ghcProg, ghcVersion, progdb1) <-
 157     requireProgramVersion
 158       verbosity
 159       ghcProgram
 160       (orLaterVersion (mkVersion [7, 0, 1]))
 161       (userMaybeSpecifyPath "ghc" hcPath conf0)
 162   let implInfo = ghcVersionImplInfo ghcVersion
 163
 164   -- Cabal currently supports ghc >= 7.0.1 && < 9.12
 165   -- ... and the following odd development version
 166   unless (ghcVersion < mkVersion [9, 12]) $
 167     warn verbosity $
 168       "Unknown/unsupported 'ghc' version detected "
 169         ++ "(Cabal "
 170         ++ prettyShow cabalVersion
 171         ++ " supports 'ghc' version < 9.12): "
 172         ++ programPath ghcProg
 173         ++ " is version "
 174         ++ prettyShow ghcVersion
 175
 176   -- This is slightly tricky, we have to configure ghc first, then we use the
 177   -- location of ghc to help find ghc-pkg in the case that the user did not
 178   -- specify the location of ghc-pkg directly:
 179   (ghcPkgProg, ghcPkgVersion, progdb2) <-
 180     requireProgramVersion
 181       verbosity
 182       ghcPkgProgram
 183         { programFindLocation = guessGhcPkgFromGhcPath ghcProg
 184         }
 185       anyVersion
 186       (userMaybeSpecifyPath "ghc-pkg" hcPkgPath progdb1)
 187
 188   when (ghcVersion /= ghcPkgVersion) $
 189     dieWithException verbosity $
 190       VersionMismatchGHC (programPath ghcProg) ghcVersion (programPath ghcPkgProg) ghcPkgVersion
 191   -- Likewise we try to find the matching hsc2hs and haddock programs.
 192   let hsc2hsProgram' =
 193         hsc2hsProgram
 194           { programFindLocation = guessHsc2hsFromGhcPath ghcProg
 195           }
 196       haddockProgram' =
 197         haddockProgram
 198           { programFindLocation = guessHaddockFromGhcPath ghcProg
 199           }
 200       hpcProgram' =
 201         hpcProgram
 202           { programFindLocation = guessHpcFromGhcPath ghcProg
 203           }
 204       runghcProgram' =
 205         runghcProgram
 206           { programFindLocation = guessRunghcFromGhcPath ghcProg
 207           }
 208       progdb3 =
 209         addKnownProgram haddockProgram' $
 210           addKnownProgram hsc2hsProgram' $
 211             addKnownProgram hpcProgram' $
 212               addKnownProgram runghcProgram' progdb2
 213
 214   languages <- Internal.getLanguages verbosity implInfo ghcProg
 215   extensions0 <- Internal.getExtensions verbosity implInfo ghcProg
 216
 217   ghcInfo <- Internal.getGhcInfo verbosity implInfo ghcProg
 218   let ghcInfoMap = Map.fromList ghcInfo
 219       filterJS = if ghcVersion < mkVersion [9, 8] then filterExt JavaScriptFFI else id
 220       extensions =
 221         -- workaround https://gitlab.haskell.org/ghc/ghc/-/issues/11214
 222         filterJS $
 223           -- see 'filterExtTH' comment below
 224           filterExtTH $
 225             extensions0
 226
 227       -- starting with GHC 8.0, `TemplateHaskell` will be omitted from
 228       -- `--supported-extensions` when it's not available.
 229       -- for older GHCs we can use the "Have interpreter" property to
 230       -- filter out `TemplateHaskell`
 231       filterExtTH
 232         | ghcVersion < mkVersion [8]
 233         , Just "NO" <- Map.lookup "Have interpreter" ghcInfoMap =
 234             filterExt TemplateHaskell
 235         | otherwise = id
 236
 237       filterExt ext = filter ((/= EnableExtension ext) . fst)
 238
 239       compilerId :: CompilerId
 240       compilerId = CompilerId GHC ghcVersion
 241
 242       compilerAbiTag :: AbiTag
 243       compilerAbiTag = maybe NoAbiTag AbiTag (Map.lookup "Project Unit Id" ghcInfoMap >>= stripPrefix (prettyShow compilerId <> "-"))
 244
 245   let comp =
 246         Compiler
 247           { compilerId
 248           , compilerAbiTag
 249           , compilerCompat = []
 250           , compilerLanguages = languages
 251           , compilerExtensions = extensions
 252           , compilerProperties = ghcInfoMap
 253           }
 254       compPlatform = Internal.targetPlatform ghcInfo
 255       -- configure gcc and ld
 256       progdb4 = Internal.configureToolchain implInfo ghcProg ghcInfoMap progdb3
 257   return (comp, compPlatform, progdb4)
 258
 259 -- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find
 260 -- the corresponding tool; e.g. if the tool is ghc-pkg, we try looking
 261 -- for a versioned or unversioned ghc-pkg in the same dir, that is:
 262 --
 263 -- > /usr/local/bin/ghc-pkg-ghc-6.6.1(.exe)
 264 -- > /usr/local/bin/ghc-pkg-6.6.1(.exe)
 265 -- > /usr/local/bin/ghc-pkg(.exe)
 266 guessToolFromGhcPath
 267   :: Program
 268   -> ConfiguredProgram
 269   -> Verbosity
 270   -> ProgramSearchPath
 271   -> IO (Maybe (FilePath, [FilePath]))
 272 guessToolFromGhcPath tool ghcProg verbosity searchpath =
 273   do
 274     let toolname = programName tool
 275         given_path = programPath ghcProg
 276         given_dir = takeDirectory given_path
 277     real_path <- canonicalizePath given_path
 278     let real_dir = takeDirectory real_path
 279         versionSuffix path = takeVersionSuffix (dropExeExtension path)
 280         given_suf = versionSuffix given_path
 281         real_suf = versionSuffix real_path
 282         guessNormal dir = dir </> toolname <.> exeExtension buildPlatform
 283         guessGhcVersioned dir suf =
 284           dir
 285             </> (toolname ++ "-ghc" ++ suf)
 286               <.> exeExtension buildPlatform
 287         guessVersioned dir suf =
 288           dir
 289             </> (toolname ++ suf)
 290               <.> exeExtension buildPlatform
 291         mkGuesses dir suf
 292           | null suf = [guessNormal dir]
 293           | otherwise =
 294               [ guessGhcVersioned dir suf
 295               , guessVersioned dir suf
 296               , guessNormal dir
 297               ]
 298         -- order matters here, see https://github.com/haskell/cabal/issues/7390
 299         guesses =
 300           ( if real_path == given_path
 301               then []
 302               else mkGuesses real_dir real_suf
 303           )
 304             ++ mkGuesses given_dir given_suf
 305     info verbosity $
 306       "looking for tool "
 307         ++ toolname
 308         ++ " near compiler in "
 309         ++ given_dir
 310     debug verbosity $ "candidate locations: " ++ show guesses
 311     exists <- traverse doesFileExist guesses
 312     case [file | (file, True) <- zip guesses exists] of
 313       -- If we can't find it near ghc, fall back to the usual
 314       -- method.
 315       [] -> programFindLocation tool verbosity searchpath
 316       (fp : _) -> do
 317         info verbosity $ "found " ++ toolname ++ " in " ++ fp
 318         let lookedAt =
 319               map fst
 320                 . takeWhile (\(_file, exist) -> not exist)
 321                 $ zip guesses exists
 322         return (Just (fp, lookedAt))
 323   where
 324     takeVersionSuffix :: FilePath -> String
 325     takeVersionSuffix = takeWhileEndLE isSuffixChar
 326
 327     isSuffixChar :: Char -> Bool
 328     isSuffixChar c = isDigit c || c == '.' || c == '-'
 329
 330 -- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
 331 -- corresponding ghc-pkg, we try looking for both a versioned and unversioned
 332 -- ghc-pkg in the same dir, that is:
 333 --
 334 -- > /usr/local/bin/ghc-pkg-ghc-6.6.1(.exe)
 335 -- > /usr/local/bin/ghc-pkg-6.6.1(.exe)
 336 -- > /usr/local/bin/ghc-pkg(.exe)
 337 guessGhcPkgFromGhcPath
 338   :: ConfiguredProgram
 339   -> Verbosity
 340   -> ProgramSearchPath
 341   -> IO (Maybe (FilePath, [FilePath]))
 342 guessGhcPkgFromGhcPath = guessToolFromGhcPath ghcPkgProgram
 343
 344 -- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
 345 -- corresponding hsc2hs, we try looking for both a versioned and unversioned
 346 -- hsc2hs in the same dir, that is:
 347 --
 348 -- > /usr/local/bin/hsc2hs-ghc-6.6.1(.exe)
 349 -- > /usr/local/bin/hsc2hs-6.6.1(.exe)
 350 -- > /usr/local/bin/hsc2hs(.exe)
 351 guessHsc2hsFromGhcPath
 352   :: ConfiguredProgram
 353   -> Verbosity
 354   -> ProgramSearchPath
 355   -> IO (Maybe (FilePath, [FilePath]))
 356 guessHsc2hsFromGhcPath = guessToolFromGhcPath hsc2hsProgram
 357
 358 -- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
 359 -- corresponding haddock, we try looking for both a versioned and unversioned
 360 -- haddock in the same dir, that is:
 361 --
 362 -- > /usr/local/bin/haddock-ghc-6.6.1(.exe)
 363 -- > /usr/local/bin/haddock-6.6.1(.exe)
 364 -- > /usr/local/bin/haddock(.exe)
 365 guessHaddockFromGhcPath
 366   :: ConfiguredProgram
 367   -> Verbosity
 368   -> ProgramSearchPath
 369   -> IO (Maybe (FilePath, [FilePath]))
 370 guessHaddockFromGhcPath = guessToolFromGhcPath haddockProgram
 371
 372 guessHpcFromGhcPath
 373   :: ConfiguredProgram
 374   -> Verbosity
 375   -> ProgramSearchPath
 376   -> IO (Maybe (FilePath, [FilePath]))
 377 guessHpcFromGhcPath = guessToolFromGhcPath hpcProgram
 378
 379 guessRunghcFromGhcPath
 380   :: ConfiguredProgram
 381   -> Verbosity
 382   -> ProgramSearchPath
 383   -> IO (Maybe (FilePath, [FilePath]))
 384 guessRunghcFromGhcPath = guessToolFromGhcPath runghcProgram
 385
 386 getGhcInfo :: Verbosity -> ConfiguredProgram -> IO [(String, String)]
 387 getGhcInfo verbosity ghcProg = Internal.getGhcInfo verbosity implInfo ghcProg
 388   where
 389     version = fromMaybe (error "GHC.getGhcInfo: no ghc version") $ programVersion ghcProg
 390     implInfo = ghcVersionImplInfo version
 391
 392 -- | Given a single package DB, return all installed packages.
 393 getPackageDBContents
 394   :: Verbosity
 395   -> PackageDB
 396   -> ProgramDb
 397   -> IO InstalledPackageIndex
 398 getPackageDBContents verbosity packagedb progdb = do
 399   pkgss <- getInstalledPackages' verbosity [packagedb] progdb
 400   toPackageIndex verbosity pkgss progdb
 401
 402 -- | Given a package DB stack, return all installed packages.
 403 getInstalledPackages
 404   :: Verbosity
 405   -> Compiler
 406   -> PackageDBStack
 407   -> ProgramDb
 408   -> IO InstalledPackageIndex
 409 getInstalledPackages verbosity comp packagedbs progdb = do
 410   checkPackageDbEnvVar verbosity
 411   checkPackageDbStack verbosity comp packagedbs
 412   pkgss <- getInstalledPackages' verbosity packagedbs progdb
 413   index <- toPackageIndex verbosity pkgss progdb
 414   return $! hackRtsPackage index
 415   where
 416     hackRtsPackage index =
 417       case PackageIndex.lookupPackageName index (mkPackageName "rts") of
 418         [(_, [rts])] ->
 419           PackageIndex.insert (removeMingwIncludeDir rts) index
 420         _ -> index -- No (or multiple) ghc rts package is registered!!
 421         -- Feh, whatever, the ghc test suite does some crazy stuff.
 422
 423 -- | Given a list of @(PackageDB, InstalledPackageInfo)@ pairs, produce a
 424 -- @PackageIndex@. Helper function used by 'getPackageDBContents' and
 425 -- 'getInstalledPackages'.
 426 toPackageIndex
 427   :: Verbosity
 428   -> [(PackageDB, [InstalledPackageInfo])]
 429   -> ProgramDb
 430   -> IO InstalledPackageIndex
 431 toPackageIndex verbosity pkgss progdb = do
 432   -- On Windows, various fields have $topdir/foo rather than full
 433   -- paths. We need to substitute the right value in so that when
 434   -- we, for example, call gcc, we have proper paths to give it.
 435   topDir <- getLibDir' verbosity ghcProg
 436   let indices =
 437         [ PackageIndex.fromList (map (Internal.substTopDir topDir) pkgs)
 438         | (_, pkgs) <- pkgss
 439         ]
 440   return $! mconcat indices
 441   where
 442     ghcProg = fromMaybe (error "GHC.toPackageIndex: no ghc program") $ lookupProgram ghcProgram progdb
 443
 444 -- | Return the 'FilePath' to the GHC application data directory.
 445 --
 446 -- @since 3.4.0.0
 447 getGhcAppDir :: IO FilePath
 448 getGhcAppDir = getAppUserDataDirectory "ghc"
 449
 450 getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath
 451 getLibDir verbosity lbi =
 452   dropWhileEndLE isSpace
 453     `fmap` getDbProgramOutput
 454       verbosity
 455       ghcProgram
 456       (withPrograms lbi)
 457       ["--print-libdir"]
 458
 459 getLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath
 460 getLibDir' verbosity ghcProg =
 461   dropWhileEndLE isSpace
 462     `fmap` getProgramOutput verbosity ghcProg ["--print-libdir"]
 463
 464 -- | Return the 'FilePath' to the global GHC package database.
 465 getGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath
 466 getGlobalPackageDB verbosity ghcProg =
 467   dropWhileEndLE isSpace
 468     `fmap` getProgramOutput verbosity ghcProg ["--print-global-package-db"]
 469
 470 -- | Return the 'FilePath' to the per-user GHC package database.
 471 getUserPackageDB
 472   :: Verbosity -> ConfiguredProgram -> Platform -> IO FilePath
 473 getUserPackageDB _verbosity ghcProg platform = do
 474   -- It's rather annoying that we have to reconstruct this, because ghc
 475   -- hides this information from us otherwise. But for certain use cases
 476   -- like change monitoring it really can't remain hidden.
 477   appdir <- getGhcAppDir
 478   return (appdir </> platformAndVersion </> packageConfFileName)
 479   where
 480     platformAndVersion =
 481       Internal.ghcPlatformAndVersionString
 482         platform
 483         ghcVersion
 484     packageConfFileName = "package.conf.d"
 485     ghcVersion = fromMaybe (error "GHC.getUserPackageDB: no ghc version") $ programVersion ghcProg
 486
 487 checkPackageDbEnvVar :: Verbosity -> IO ()
 488 checkPackageDbEnvVar verbosity =
 489   Internal.checkPackageDbEnvVar verbosity "GHC" "GHC_PACKAGE_PATH"
 490
 491 checkPackageDbStack :: Verbosity -> Compiler -> PackageDBStack -> IO ()
 492 checkPackageDbStack verbosity comp =
 493   if flagPackageConf implInfo
 494     then checkPackageDbStackPre76 verbosity
 495     else checkPackageDbStackPost76 verbosity
 496   where
 497     implInfo = ghcVersionImplInfo (compilerVersion comp)
 498
 499 checkPackageDbStackPost76 :: Verbosity -> PackageDBStack -> IO ()
 500 checkPackageDbStackPost76 _ (GlobalPackageDB : rest)
 501   | GlobalPackageDB `notElem` rest = return ()
 502 checkPackageDbStackPost76 verbosity rest
 503   | GlobalPackageDB `elem` rest =
 504       dieWithException verbosity CheckPackageDbStackPost76
 505 checkPackageDbStackPost76 _ _ = return ()
 506
 507 checkPackageDbStackPre76 :: Verbosity -> PackageDBStack -> IO ()
 508 checkPackageDbStackPre76 _ (GlobalPackageDB : rest)
 509   | GlobalPackageDB `notElem` rest = return ()
 510 checkPackageDbStackPre76 verbosity rest
 511   | GlobalPackageDB `notElem` rest =
 512       dieWithException verbosity CheckPackageDbStackPre76
 513 checkPackageDbStackPre76 verbosity _ =
 514   dieWithException verbosity GlobalPackageDbSpecifiedFirst
 515
 516 -- GHC < 6.10 put "$topdir/include/mingw" in rts's installDirs. This
 517 -- breaks when you want to use a different gcc, so we need to filter
 518 -- it out.
 519 removeMingwIncludeDir :: InstalledPackageInfo -> InstalledPackageInfo
 520 removeMingwIncludeDir pkg =
 521   let ids = InstalledPackageInfo.includeDirs pkg
 522       ids' = filter (not . ("mingw" `isSuffixOf`)) ids
 523    in pkg{InstalledPackageInfo.includeDirs = ids'}
 524
 525 -- | Get the packages from specific PackageDBs, not cumulative.
 526 getInstalledPackages'
 527   :: Verbosity
 528   -> [PackageDB]
 529   -> ProgramDb
 530   -> IO [(PackageDB, [InstalledPackageInfo])]
 531 getInstalledPackages' verbosity packagedbs progdb =
 532   sequenceA
 533     [ do
 534       pkgs <- HcPkg.dump (hcPkgInfo progdb) verbosity packagedb
 535       return (packagedb, pkgs)
 536     | packagedb <- packagedbs
 537     ]
 538
 539 getInstalledPackagesMonitorFiles
 540   :: Verbosity
 541   -> Platform
 542   -> ProgramDb
 543   -> [PackageDB]
 544   -> IO [FilePath]
 545 getInstalledPackagesMonitorFiles verbosity platform progdb =
 546   traverse getPackageDBPath
 547   where
 548     getPackageDBPath :: PackageDB -> IO FilePath
 549     getPackageDBPath GlobalPackageDB =
 550       selectMonitorFile =<< getGlobalPackageDB verbosity ghcProg
 551     getPackageDBPath UserPackageDB =
 552       selectMonitorFile =<< getUserPackageDB verbosity ghcProg platform
 553     getPackageDBPath (SpecificPackageDB path) = selectMonitorFile path
 554
 555     -- GHC has old style file dbs, and new style directory dbs.
 556     -- Note that for dir style dbs, we only need to monitor the cache file, not
 557     -- the whole directory. The ghc program itself only reads the cache file
 558     -- so it's safe to only monitor this one file.
 559     selectMonitorFile path = do
 560       isFileStyle <- doesFileExist path
 561       if isFileStyle
 562         then return path
 563         else return (path </> "package.cache")
 564
 565     ghcProg = fromMaybe (error "GHC.toPackageIndex: no ghc program") $ lookupProgram ghcProgram progdb
 566
 567 -- -----------------------------------------------------------------------------
 568 -- Building a library
 569
 570 buildLib
 571   :: BuildFlags
 572   -> Flag ParStrat
 573   -> PackageDescription
 574   -> LocalBuildInfo
 575   -> Library
 576   -> ComponentLocalBuildInfo
 577   -> IO ()
 578 buildLib flags numJobs pkg lbi lib clbi =
 579   GHC.build numJobs pkg $
 580     PreBuildComponentInputs (BuildNormal flags) lbi (TargetInfo clbi (CLib lib))
 581
 582 replLib
 583   :: ReplFlags
 584   -> Flag ParStrat
 585   -> PackageDescription
 586   -> LocalBuildInfo
 587   -> Library
 588   -> ComponentLocalBuildInfo
 589   -> IO ()
 590 replLib flags numJobs pkg lbi lib clbi =
 591   GHC.build numJobs pkg $
 592     PreBuildComponentInputs (BuildRepl flags) lbi (TargetInfo clbi (CLib lib))
 593
 594 -- | Start a REPL without loading any source files.
 595 startInterpreter
 596   :: Verbosity
 597   -> ProgramDb
 598   -> Compiler
 599   -> Platform
 600   -> PackageDBStack
 601   -> IO ()
 602 startInterpreter verbosity progdb comp platform packageDBs = do
 603   let replOpts =
 604         mempty
 605           { ghcOptMode = toFlag GhcModeInteractive
 606           , ghcOptPackageDBs = packageDBs
 607           }
 608   checkPackageDbStack verbosity comp packageDBs
 609   (ghcProg, _) <- requireProgram verbosity ghcProgram progdb
 610   runGHC verbosity ghcProg comp platform replOpts
 611
 612 -- -----------------------------------------------------------------------------
 613 -- Building an executable or foreign library
 614
 615 -- | Build a foreign library
 616 buildFLib
 617   :: Verbosity
 618   -> Flag ParStrat
 619   -> PackageDescription
 620   -> LocalBuildInfo
 621   -> ForeignLib
 622   -> ComponentLocalBuildInfo
 623   -> IO ()
 624 buildFLib v numJobs pkg lbi flib clbi =
 625   GHC.build numJobs pkg $
 626     PreBuildComponentInputs (BuildNormal mempty{buildVerbosity = toFlag v}) lbi (TargetInfo clbi (CFLib flib))
 627
 628 replFLib
 629   :: ReplFlags
 630   -> Flag ParStrat
 631   -> PackageDescription
 632   -> LocalBuildInfo
 633   -> ForeignLib
 634   -> ComponentLocalBuildInfo
 635   -> IO ()
 636 replFLib replFlags njobs pkg lbi flib clbi =
 637   GHC.build njobs pkg $
 638     PreBuildComponentInputs (BuildRepl replFlags) lbi (TargetInfo clbi (CFLib flib))
 639
 640 -- | Build an executable with GHC.
 641 buildExe
 642   :: Verbosity
 643   -> Flag ParStrat
 644   -> PackageDescription
 645   -> LocalBuildInfo
 646   -> Executable
 647   -> ComponentLocalBuildInfo
 648   -> IO ()
 649 buildExe v njobs pkg lbi exe clbi =
 650   GHC.build njobs pkg $
 651     PreBuildComponentInputs (BuildNormal mempty{buildVerbosity = toFlag v}) lbi (TargetInfo clbi (CExe exe))
 652
 653 replExe
 654   :: ReplFlags
 655   -> Flag ParStrat
 656   -> PackageDescription
 657   -> LocalBuildInfo
 658   -> Executable
 659   -> ComponentLocalBuildInfo
 660   -> IO ()
 661 replExe replFlags njobs pkg lbi exe clbi =
 662   GHC.build njobs pkg $
 663     PreBuildComponentInputs (BuildRepl replFlags) lbi (TargetInfo clbi (CExe exe))
 664
 665 -- | Extracts a String representing a hash of the ABI of a built
 666 -- library.  It can fail if the library has not yet been built.
 667 libAbiHash
 668   :: Verbosity
 669   -> PackageDescription
 670   -> LocalBuildInfo
 671   -> Library
 672   -> ComponentLocalBuildInfo
 673   -> IO String
 674 libAbiHash verbosity _pkg_descr lbi lib clbi = do
 675   let
 676     libBi = libBuildInfo lib
 677     comp = compiler lbi
 678     platform = hostPlatform lbi
 679     vanillaArgs =
 680       (Internal.componentGhcOptions verbosity lbi libBi clbi (componentBuildDir lbi clbi))
 681         `mappend` mempty
 682           { ghcOptMode = toFlag GhcModeAbiHash
 683           , ghcOptInputModules = toNubListR $ exposedModules lib
 684           }
 685     sharedArgs =
 686       vanillaArgs
 687         `mappend` mempty
 688           { ghcOptDynLinkMode = toFlag GhcDynamicOnly
 689           , ghcOptFPic = toFlag True
 690           , ghcOptHiSuffix = toFlag "dyn_hi"
 691           , ghcOptObjSuffix = toFlag "dyn_o"
 692           , ghcOptExtra = hcSharedOptions GHC libBi
 693           }
 694     profArgs =
 695       vanillaArgs
 696         `mappend` mempty
 697           { ghcOptProfilingMode = toFlag True
 698           , ghcOptProfilingAuto =
 699               Internal.profDetailLevelFlag
 700                 True
 701                 (withProfLibDetail lbi)
 702           , ghcOptHiSuffix = toFlag "p_hi"
 703           , ghcOptObjSuffix = toFlag "p_o"
 704           , ghcOptExtra = hcProfOptions GHC libBi
 705           }
 706     ghcArgs
 707       | withVanillaLib lbi = vanillaArgs
 708       | withSharedLib lbi = sharedArgs
 709       | withProfLib lbi = profArgs
 710       | otherwise = error "libAbiHash: Can't find an enabled library way"
 711
 712   (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
 713
 714   hash <-
 715     getProgramInvocationOutput
 716       verbosity
 717       =<< ghcInvocation verbosity ghcProg comp platform ghcArgs
 718
 719   return (takeWhile (not . isSpace) hash)
 720
 721 -- -----------------------------------------------------------------------------
 722 -- Installing
 723
 724 -- | Install executables for GHC.
 725 installExe
 726   :: Verbosity
 727   -> LocalBuildInfo
 728   -> FilePath
 729   -- ^ Where to copy the files to
 730   -> FilePath
 731   -- ^ Build location
 732   -> (FilePath, FilePath)
 733   -- ^ Executable (prefix,suffix)
 734   -> PackageDescription
 735   -> Executable
 736   -> IO ()
 737 installExe
 738   verbosity
 739   lbi
 740   binDir
 741   buildPref
 742   (progprefix, progsuffix)
 743   _pkg
 744   exe = do
 745     createDirectoryIfMissingVerbose verbosity True binDir
 746     let exeName' = unUnqualComponentName $ exeName exe
 747         exeFileName = exeTargetName (hostPlatform lbi) (exeName exe)
 748         fixedExeBaseName = progprefix ++ exeName' ++ progsuffix
 749         installBinary dest = do
 750           installExecutableFile
 751             verbosity
 752             (buildPref </> exeName' </> exeFileName)
 753             (dest <.> exeExtension (hostPlatform lbi))
 754           when (stripExes lbi) $
 755             Strip.stripExe
 756               verbosity
 757               (hostPlatform lbi)
 758               (withPrograms lbi)
 759               (dest <.> exeExtension (hostPlatform lbi))
 760     installBinary (binDir </> fixedExeBaseName)
 761
 762 -- | Install foreign library for GHC.
 763 installFLib
 764   :: Verbosity
 765   -> LocalBuildInfo
 766   -> FilePath
 767   -- ^ install location
 768   -> FilePath
 769   -- ^ Build location
 770   -> PackageDescription
 771   -> ForeignLib
 772   -> IO ()
 773 installFLib verbosity lbi targetDir builtDir _pkg flib =
 774   install
 775     (foreignLibIsShared flib)
 776     builtDir
 777     targetDir
 778     (flibTargetName lbi flib)
 779   where
 780     install isShared srcDir dstDir name = do
 781       let src = srcDir </> name
 782           dst = dstDir </> name
 783       createDirectoryIfMissingVerbose verbosity True targetDir
 784       -- TODO: Should we strip? (stripLibs lbi)
 785       if isShared
 786         then installExecutableFile verbosity src dst
 787         else installOrdinaryFile verbosity src dst
 788       -- Now install appropriate symlinks if library is versioned
 789       let (Platform _ os) = hostPlatform lbi
 790       when (not (null (foreignLibVersion flib os))) $ do
 791         when (os /= Linux) $
 792           dieWithException verbosity $
 793             CantInstallForeignLib
 794 #ifndef mingw32_HOST_OS
 795         -- 'createSymbolicLink file1 file2' creates a symbolic link
 796         -- named 'file2' which points to the file 'file1'.
 797         -- Note that we do want a symlink to 'name' rather than
 798         -- 'dst', because the symlink will be relative to the
 799         -- directory it's created in.
 800         -- Finally, we first create the symlinks in a temporary
 801         -- directory and then rename to simulate 'ln --force'.
 802         withTempDirectory verbosity dstDir nm $ \tmpDir -> do
 803             let link1 = flibBuildName lbi flib
 804                 link2 = "lib" ++ nm <.> "so"
 805             createSymbolicLink name (tmpDir </> link1)
 806             renameFile (tmpDir </> link1) (dstDir </> link1)
 807             createSymbolicLink name (tmpDir </> link2)
 808             renameFile (tmpDir </> link2) (dstDir </> link2)
 809       where
 810         nm :: String
 811         nm = unUnqualComponentName $ foreignLibName flib
 812 #endif /* mingw32_HOST_OS */
 813
 814 -- | Install for ghc, .hi, .a and, if --with-ghci given, .o
 815 installLib
 816   :: Verbosity
 817   -> LocalBuildInfo
 818   -> FilePath
 819   -- ^ install location
 820   -> FilePath
 821   -- ^ install location for dynamic libraries
 822   -> FilePath
 823   -- ^ Build location
 824   -> PackageDescription
 825   -> Library
 826   -> ComponentLocalBuildInfo
 827   -> IO ()
 828 installLib verbosity lbi targetDir dynlibTargetDir _builtDir pkg lib clbi = do
 829   -- copy .hi files over:
 830   whenVanilla $ copyModuleFiles $ Suffix "hi"
 831   whenProf $ copyModuleFiles $ Suffix "p_hi"
 832   whenShared $ copyModuleFiles $ Suffix "dyn_hi"
 833
 834   -- copy extra compilation artifacts that ghc plugins may produce
 835   copyDirectoryIfExists extraCompilationArtifacts
 836
 837   -- copy the built library files over:
 838   whenHasCode $ do
 839     whenVanilla $ do
 840       sequence_
 841         [ installOrdinary
 842           builtDir
 843           targetDir
 844           (mkGenericStaticLibName (l ++ f))
 845         | l <-
 846             getHSLibraryName
 847               (componentUnitId clbi)
 848               : (extraBundledLibs (libBuildInfo lib))
 849         , f <- "" : extraLibFlavours (libBuildInfo lib)
 850         ]
 851       whenGHCi $ installOrdinary builtDir targetDir ghciLibName
 852     whenProf $ do
 853       installOrdinary builtDir targetDir profileLibName
 854       whenGHCi $ installOrdinary builtDir targetDir ghciProfLibName
 855     whenShared $
 856       if
 857           -- The behavior for "extra-bundled-libraries" changed in version 2.5.0.
 858           -- See ghc issue #15837 and Cabal PR #5855.
 859           | specVersion pkg < CabalSpecV3_0 -> do
 860               sequence_
 861                 [ installShared
 862                   builtDir
 863                   dynlibTargetDir
 864                   (mkGenericSharedLibName platform compiler_id (l ++ f))
 865                 | l <- getHSLibraryName uid : extraBundledLibs (libBuildInfo lib)
 866                 , f <- "" : extraDynLibFlavours (libBuildInfo lib)
 867                 ]
 868           | otherwise -> do
 869               sequence_
 870                 [ installShared
 871                   builtDir
 872                   dynlibTargetDir
 873                   ( mkGenericSharedLibName
 874                       platform
 875                       compiler_id
 876                       (getHSLibraryName uid ++ f)
 877                   )
 878                 | f <- "" : extraDynLibFlavours (libBuildInfo lib)
 879                 ]
 880               sequence_
 881                 [ do
 882                   files <- getDirectoryContents builtDir
 883                   let l' =
 884                         mkGenericSharedBundledLibName
 885                           platform
 886                           compiler_id
 887                           l
 888                   forM_ files $ \file ->
 889                     when (l' `isPrefixOf` file) $ do
 890                       isFile <- doesFileExist (builtDir </> file)
 891                       when isFile $ do
 892                         installShared
 893                           builtDir
 894                           dynlibTargetDir
 895                           file
 896                 | l <- extraBundledLibs (libBuildInfo lib)
 897                 ]
 898   where
 899     builtDir = componentBuildDir lbi clbi
 900
 901     install isShared srcDir dstDir name = do
 902       let src = srcDir </> name
 903           dst = dstDir </> name
 904
 905       createDirectoryIfMissingVerbose verbosity True dstDir
 906
 907       if isShared
 908         then installExecutableFile verbosity src dst
 909         else installOrdinaryFile verbosity src dst
 910
 911       when (stripLibs lbi) $
 912         Strip.stripLib
 913           verbosity
 914           platform
 915           (withPrograms lbi)
 916           dst
 917
 918     installOrdinary = install False
 919     installShared = install True
 920
 921     copyModuleFiles ext =
 922       findModuleFilesEx verbosity [builtDir] [ext] (allLibModules lib clbi)
 923         >>= installOrdinaryFiles verbosity targetDir
 924
 925     copyDirectoryIfExists dirName = do
 926       let src = builtDir </> dirName
 927           dst = targetDir </> dirName
 928       dirExists <- doesDirectoryExist src
 929       when dirExists $ copyDirectoryRecursive verbosity src dst
 930
 931     compiler_id = compilerId (compiler lbi)
 932     platform = hostPlatform lbi
 933     uid = componentUnitId clbi
 934     profileLibName = mkProfLibName uid
 935     ghciLibName = Internal.mkGHCiLibName uid
 936     ghciProfLibName = Internal.mkGHCiProfLibName uid
 937
 938     hasLib =
 939       not $
 940         null (allLibModules lib clbi)
 941           && null (cSources (libBuildInfo lib))
 942           && null (cxxSources (libBuildInfo lib))
 943           && null (cmmSources (libBuildInfo lib))
 944           && null (asmSources (libBuildInfo lib))
 945           && (null (jsSources (libBuildInfo lib)) || not hasJsSupport)
 946     hasJsSupport = case hostPlatform lbi of
 947       Platform JavaScript _ -> True
 948       _ -> False
 949     has_code = not (componentIsIndefinite clbi)
 950     whenHasCode = when has_code
 951     whenVanilla = when (hasLib && withVanillaLib lbi)
 952     whenProf = when (hasLib && withProfLib lbi && has_code)
 953     whenGHCi = when (hasLib && withGHCiLib lbi && has_code)
 954     whenShared = when (hasLib && withSharedLib lbi && has_code)
 955
 956 -- -----------------------------------------------------------------------------
 957 -- Registering
 958
 959 hcPkgInfo :: ProgramDb -> HcPkg.HcPkgInfo
 960 hcPkgInfo progdb =
 961   HcPkg.HcPkgInfo
 962     { HcPkg.hcPkgProgram = ghcPkgProg
 963     , HcPkg.noPkgDbStack = v < [6, 9]
 964     , HcPkg.noVerboseFlag = v < [6, 11]
 965     , HcPkg.flagPackageConf = v < [7, 5]
 966     , HcPkg.supportsDirDbs = v >= [6, 8]
 967     , HcPkg.requiresDirDbs = v >= [7, 10]
 968     , HcPkg.nativeMultiInstance = v >= [7, 10]
 969     , HcPkg.recacheMultiInstance = v >= [6, 12]
 970     , HcPkg.suppressFilesCheck = v >= [6, 6]
 971     }
 972   where
 973     v = versionNumbers ver
 974     ghcPkgProg = fromMaybe (error "GHC.hcPkgInfo: no ghc program") $ lookupProgram ghcPkgProgram progdb
 975     ver = fromMaybe (error "GHC.hcPkgInfo: no ghc version") $ programVersion ghcPkgProg
 976
 977 registerPackage
 978   :: Verbosity
 979   -> ProgramDb
 980   -> PackageDBStack
 981   -> InstalledPackageInfo
 982   -> HcPkg.RegisterOptions
 983   -> IO ()
 984 registerPackage verbosity progdb packageDbs installedPkgInfo registerOptions =
 985   HcPkg.register
 986     (hcPkgInfo progdb)
 987     verbosity
 988     packageDbs
 989     installedPkgInfo
 990     registerOptions
 991
 992 pkgRoot :: Verbosity -> LocalBuildInfo -> PackageDB -> IO FilePath
 993 pkgRoot verbosity lbi = pkgRoot'
 994   where
 995     pkgRoot' GlobalPackageDB =
 996       let ghcProg = fromMaybe (error "GHC.pkgRoot: no ghc program") $ lookupProgram ghcProgram (withPrograms lbi)
 997        in fmap takeDirectory (getGlobalPackageDB verbosity ghcProg)
 998     pkgRoot' UserPackageDB = do
 999       appDir <- getGhcAppDir
1000       let ver = compilerVersion (compiler lbi)
1001           subdir =
1002             System.Info.arch
1003               ++ '-'
1004               : System.Info.os
1005               ++ '-'
1006               : prettyShow ver
1007           rootDir = appDir </> subdir
1008       -- We must create the root directory for the user package database if it
1009       -- does not yet exists. Otherwise '${pkgroot}' will resolve to a
1010       -- directory at the time of 'ghc-pkg register', and registration will
1011       -- fail.
1012       createDirectoryIfMissing True rootDir
1013       return rootDir
1014     pkgRoot' (SpecificPackageDB fp) = return (takeDirectory fp)