cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs

   1 {-# LANGUAGE CPP #-}
   2 {-# LANGUAGE LambdaCase #-}
   3 {-# LANGUAGE NamedFieldPuns #-}
   4 {-# LANGUAGE RecordWildCards #-}
   5
   6 -- | This module exposes functions to build and register unpacked packages.
   7 --
   8 -- Mainly, unpacked packages are either:
   9 --  * Built and registered in-place
  10 --  * Built and installed
  11 --
  12 -- The two cases differ significantly for there to be a distinction.
  13 -- For instance, we only care about file monitoring and re-building when dealing
  14 -- with "inplace" registered packages, whereas for installed packages we don't.
  15 module Distribution.Client.ProjectBuilding.UnpackedPackage
  16   ( buildInplaceUnpackedPackage
  17   , buildAndInstallUnpackedPackage
  18
  19     -- ** Auxiliary definitions
  20   , buildAndRegisterUnpackedPackage
  21   , PackageBuildingPhase
  22
  23     -- ** Utilities
  24   , annotateFailure
  25   , annotateFailureNoLog
  26   ) where
  27
  28 import Distribution.Client.Compat.Prelude
  29 import Prelude ()
  30
  31 import Distribution.Client.PackageHash (renderPackageHashInputs)
  32 import Distribution.Client.ProjectBuilding.Types
  33 import Distribution.Client.ProjectConfig
  34 import Distribution.Client.ProjectConfig.Types
  35 import Distribution.Client.ProjectPlanning
  36 import Distribution.Client.ProjectPlanning.Types
  37 import Distribution.Client.RebuildMonad
  38 import Distribution.Client.Store
  39
  40 import Distribution.Client.DistDirLayout
  41 import Distribution.Client.FileMonitor
  42 import Distribution.Client.JobControl
  43 import Distribution.Client.Setup
  44   ( filterConfigureFlags
  45   , filterHaddockArgs
  46   , filterHaddockFlags
  47   , filterTestFlags
  48   )
  49 import Distribution.Client.SetupWrapper
  50 import Distribution.Client.SourceFiles
  51 import Distribution.Client.SrcDist (allPackageSourceFiles)
  52 import qualified Distribution.Client.Tar as Tar
  53 import Distribution.Client.Types hiding
  54   ( BuildFailure (..)
  55   , BuildOutcome
  56   , BuildOutcomes
  57   , BuildResult (..)
  58   )
  59 import Distribution.Client.Utils
  60   ( ProgressPhase (..)
  61   , findOpenProgramLocation
  62   , progressMessage
  63   )
  64
  65 import Distribution.Compat.Lens
  66 import Distribution.InstalledPackageInfo (InstalledPackageInfo)
  67 import qualified Distribution.InstalledPackageInfo as Installed
  68 import Distribution.Package
  69 import qualified Distribution.PackageDescription as PD
  70 import Distribution.Simple.BuildPaths (haddockDirName)
  71 import Distribution.Simple.Command (CommandUI)
  72 import Distribution.Simple.Compiler
  73   ( PackageDBStack
  74   , compilerId
  75   )
  76 import qualified Distribution.Simple.InstallDirs as InstallDirs
  77 import Distribution.Simple.LocalBuildInfo
  78   ( ComponentName (..)
  79   , LibraryName (..)
  80   )
  81 import Distribution.Simple.Program
  82 import qualified Distribution.Simple.Register as Cabal
  83 import qualified Distribution.Simple.Setup as Cabal
  84 import Distribution.Types.BuildType
  85 import Distribution.Types.PackageDescription.Lens (componentModules)
  86
  87 import Distribution.Simple.Utils
  88 import Distribution.Version
  89
  90 import qualified Data.ByteString as BS
  91 import qualified Data.ByteString.Lazy as LBS
  92 import qualified Data.ByteString.Lazy.Char8 as LBS.Char8
  93 import qualified Data.List.NonEmpty as NE
  94
  95 import Control.Exception (Handler (..), SomeAsyncException, assert, catches)
  96 import System.Directory (canonicalizePath, createDirectoryIfMissing, doesDirectoryExist, doesFileExist, removeFile)
  97 import System.FilePath (dropDrive, normalise, takeDirectory, (<.>), (</>))
  98 import System.IO (Handle, IOMode (AppendMode), withFile)
  99 import System.Semaphore (SemaphoreName (..))
 100
 101 import Distribution.Client.Errors
 102 import Distribution.Compat.Directory (listDirectory)
 103
 104 import Distribution.Client.ProjectBuilding.PackageFileMonitor
 105
 106 -- | Each unpacked package is processed in the following phases:
 107 --
 108 -- * Configure phase
 109 -- * Build phase
 110 -- * Install phase (copy + register)
 111 -- * Register phase
 112 -- * Test phase
 113 -- * Bench phase
 114 -- * Repl phase
 115 -- * Haddock phase
 116 --
 117 -- Depending on whether we are installing the package or building it inplace,
 118 -- the phases will be carried out differently. For example, when installing,
 119 -- the test, benchmark, and repl phase are ignored.
 120 data PackageBuildingPhase
 121   = PBConfigurePhase {runConfigure :: IO ()}
 122   | PBBuildPhase {runBuild :: IO ()}
 123   | PBHaddockPhase {runHaddock :: IO ()}
 124   | PBInstallPhase
 125       { runCopy :: FilePath -> IO ()
 126       , runRegister
 127           :: PackageDBStack
 128           -> Cabal.RegisterOptions
 129           -> IO InstalledPackageInfo
 130       }
 131   | PBTestPhase {runTest :: IO ()}
 132   | PBBenchPhase {runBench :: IO ()}
 133   | PBReplPhase {runRepl :: IO ()}
 134
 135 -- | Structures the phases of building and registering a package amongst others
 136 -- (see t'PackageBuildingPhase'). Delegates logic specific to a certain
 137 -- building style (notably, inplace vs install) to the delegate function that
 138 -- receives as an argument t'PackageBuildingPhase')
 139 buildAndRegisterUnpackedPackage
 140   :: Verbosity
 141   -> DistDirLayout
 142   -> Maybe SemaphoreName
 143   -- ^ Whether to pass a semaphore to build process
 144   -- this is different to BuildTimeSettings because the
 145   -- name of the semaphore is created freshly each time.
 146   -> BuildTimeSettings
 147   -> Lock
 148   -> Lock
 149   -> ElaboratedSharedConfig
 150   -> ElaboratedInstallPlan
 151   -> ElaboratedReadyPackage
 152   -> FilePath
 153   -> FilePath
 154   -> Maybe (FilePath)
 155   -- ^ The path to an /initialized/ log file
 156   -> (PackageBuildingPhase -> IO ())
 157   -> IO ()
 158 buildAndRegisterUnpackedPackage
 159   verbosity
 160   distDirLayout@DistDirLayout{distTempDirectory}
 161   maybe_semaphore
 162   BuildTimeSettings{buildSettingNumJobs}
 163   registerLock
 164   cacheLock
 165   pkgshared@ElaboratedSharedConfig
 166     { pkgConfigCompiler = compiler
 167     , pkgConfigCompilerProgs = progdb
 168     }
 169   plan
 170   rpkg@(ReadyPackage pkg)
 171   srcdir
 172   builddir
 173   mlogFile
 174   delegate = do
 175     -- Configure phase
 176     delegate $
 177       PBConfigurePhase $
 178         annotateFailure mlogFile ConfigureFailed $
 179           setup configureCommand configureFlags configureArgs
 180
 181     -- Build phase
 182     delegate $
 183       PBBuildPhase $
 184         annotateFailure mlogFile BuildFailed $
 185           setup buildCommand buildFlags buildArgs
 186
 187     -- Haddock phase
 188     whenHaddock $
 189       delegate $
 190         PBHaddockPhase $
 191           annotateFailure mlogFile HaddocksFailed $ do
 192             setup haddockCommand haddockFlags haddockArgs
 193
 194     -- Install phase
 195     delegate $
 196       PBInstallPhase
 197         { runCopy = \destdir ->
 198             annotateFailure mlogFile InstallFailed $
 199               setup Cabal.copyCommand (copyFlags destdir) (const [])
 200         , runRegister = \pkgDBStack registerOpts ->
 201             annotateFailure mlogFile InstallFailed $ do
 202               -- We register ourselves rather than via Setup.hs. We need to
 203               -- grab and modify the InstalledPackageInfo. We decide what
 204               -- the installed package id is, not the build system.
 205               ipkg0 <- generateInstalledPackageInfo
 206               let ipkg = ipkg0{Installed.installedUnitId = uid}
 207               criticalSection registerLock $
 208                 Cabal.registerPackage
 209                   verbosity
 210                   compiler
 211                   progdb
 212                   pkgDBStack
 213                   ipkg
 214                   registerOpts
 215               return ipkg
 216         }
 217
 218     -- Test phase
 219     whenTest $
 220       delegate $
 221         PBTestPhase $
 222           annotateFailure mlogFile TestsFailed $
 223             setup testCommand testFlags testArgs
 224
 225     -- Bench phase
 226     whenBench $
 227       delegate $
 228         PBBenchPhase $
 229           annotateFailure mlogFile BenchFailed $
 230             setup benchCommand benchFlags benchArgs
 231
 232     -- Repl phase
 233     whenRepl $
 234       delegate $
 235         PBReplPhase $
 236           annotateFailure mlogFile ReplFailed $
 237             setupInteractive replCommand replFlags replArgs
 238
 239     return ()
 240     where
 241       uid = installedUnitId rpkg
 242
 243       comp_par_strat = case maybe_semaphore of
 244         Just sem_name -> Cabal.toFlag (getSemaphoreName sem_name)
 245         _ -> Cabal.NoFlag
 246
 247       whenTest action
 248         | null (elabTestTargets pkg) = return ()
 249         | otherwise = action
 250
 251       whenBench action
 252         | null (elabBenchTargets pkg) = return ()
 253         | otherwise = action
 254
 255       whenRepl action
 256         | null (elabReplTarget pkg) = return ()
 257         | otherwise = action
 258
 259       whenHaddock action
 260         | hasValidHaddockTargets pkg = action
 261         | otherwise = return ()
 262
 263       configureCommand = Cabal.configureCommand defaultProgramDb
 264       configureFlags v =
 265         flip filterConfigureFlags v $
 266           setupHsConfigureFlags
 267             plan
 268             rpkg
 269             pkgshared
 270             verbosity
 271             builddir
 272       configureArgs _ = setupHsConfigureArgs pkg
 273
 274       buildCommand = Cabal.buildCommand defaultProgramDb
 275       buildFlags _ = setupHsBuildFlags comp_par_strat pkg pkgshared verbosity builddir
 276       buildArgs _ = setupHsBuildArgs pkg
 277
 278       copyFlags destdir _ =
 279         setupHsCopyFlags
 280           pkg
 281           pkgshared
 282           verbosity
 283           builddir
 284           destdir
 285
 286       testCommand = Cabal.testCommand -- defaultProgramDb
 287       testFlags v =
 288         flip filterTestFlags v $
 289           setupHsTestFlags
 290             pkg
 291             verbosity
 292             builddir
 293       testArgs _ = setupHsTestArgs pkg
 294
 295       benchCommand = Cabal.benchmarkCommand
 296       benchFlags _ =
 297         setupHsBenchFlags
 298           pkg
 299           pkgshared
 300           verbosity
 301           builddir
 302       benchArgs _ = setupHsBenchArgs pkg
 303
 304       replCommand = Cabal.replCommand defaultProgramDb
 305       replFlags _ =
 306         setupHsReplFlags
 307           pkg
 308           pkgshared
 309           verbosity
 310           builddir
 311       replArgs _ = setupHsReplArgs pkg
 312
 313       haddockCommand = Cabal.haddockCommand
 314       haddockFlags v =
 315         flip filterHaddockFlags v $
 316           setupHsHaddockFlags
 317             pkg
 318             pkgshared
 319             verbosity
 320             builddir
 321       haddockArgs v =
 322         flip filterHaddockArgs v $
 323           setupHsHaddockArgs pkg
 324
 325       scriptOptions =
 326         setupHsScriptOptions
 327           rpkg
 328           plan
 329           pkgshared
 330           distDirLayout
 331           srcdir
 332           builddir
 333           (isParallelBuild buildSettingNumJobs)
 334           cacheLock
 335
 336       setup
 337         :: CommandUI flags
 338         -> (Version -> flags)
 339         -> (Version -> [String])
 340         -> IO ()
 341       setup cmd flags args =
 342         withLogging $ \mLogFileHandle ->
 343           setupWrapper
 344             verbosity
 345             scriptOptions
 346               { useLoggingHandle = mLogFileHandle
 347               , useExtraEnvOverrides =
 348                   dataDirsEnvironmentForPlan
 349                     distDirLayout
 350                     plan
 351               }
 352             (Just (elabPkgDescription pkg))
 353             cmd
 354             flags
 355             args
 356
 357       setupInteractive
 358         :: CommandUI flags
 359         -> (Version -> flags)
 360         -> (Version -> [String])
 361         -> IO ()
 362       setupInteractive cmd flags args =
 363         setupWrapper
 364           verbosity
 365           scriptOptions{isInteractive = True}
 366           (Just (elabPkgDescription pkg))
 367           cmd
 368           flags
 369           args
 370
 371       generateInstalledPackageInfo :: IO InstalledPackageInfo
 372       generateInstalledPackageInfo =
 373         withTempInstalledPackageInfoFile
 374           verbosity
 375           distTempDirectory
 376           $ \pkgConfDest -> do
 377             let registerFlags _ =
 378                   setupHsRegisterFlags
 379                     pkg
 380                     pkgshared
 381                     verbosity
 382                     builddir
 383                     pkgConfDest
 384             setup Cabal.registerCommand registerFlags (const [])
 385
 386       withLogging :: (Maybe Handle -> IO r) -> IO r
 387       withLogging action =
 388         case mlogFile of
 389           Nothing -> action Nothing
 390           Just logFile -> withFile logFile AppendMode (action . Just)
 391
 392 --------------------------------------------------------------------------------
 393
 394 -- * Build Inplace
 395
 396 --------------------------------------------------------------------------------
 397
 398 buildInplaceUnpackedPackage
 399   :: Verbosity
 400   -> DistDirLayout
 401   -> Maybe SemaphoreName
 402   -> BuildTimeSettings
 403   -> Lock
 404   -> Lock
 405   -> ElaboratedSharedConfig
 406   -> ElaboratedInstallPlan
 407   -> ElaboratedReadyPackage
 408   -> BuildStatusRebuild
 409   -> FilePath
 410   -> FilePath
 411   -> IO BuildResult
 412 buildInplaceUnpackedPackage
 413   verbosity
 414   distDirLayout@DistDirLayout
 415     { distPackageCacheDirectory
 416     , distDirectory
 417     , distHaddockOutputDir
 418     }
 419   maybe_semaphore
 420   buildSettings@BuildTimeSettings{buildSettingHaddockOpen}
 421   registerLock
 422   cacheLock
 423   pkgshared@ElaboratedSharedConfig{pkgConfigPlatform = platform}
 424   plan
 425   rpkg@(ReadyPackage pkg)
 426   buildStatus
 427   srcdir
 428   builddir = do
 429     -- TODO: [code cleanup] there is duplication between the
 430     --      distdirlayout and the builddir here builddir is not
 431     --      enough, we also need the per-package cachedir
 432     createDirectoryIfMissingVerbose verbosity True builddir
 433     createDirectoryIfMissingVerbose
 434       verbosity
 435       True
 436       (distPackageCacheDirectory dparams)
 437
 438     let docsResult = DocsNotTried
 439         testsResult = TestsNotTried
 440
 441         buildResult :: BuildResultMisc
 442         buildResult = (docsResult, testsResult)
 443
 444     buildAndRegisterUnpackedPackage
 445       verbosity
 446       distDirLayout
 447       maybe_semaphore
 448       buildSettings
 449       registerLock
 450       cacheLock
 451       pkgshared
 452       plan
 453       rpkg
 454       srcdir
 455       builddir
 456       Nothing -- no log file for inplace builds!
 457       $ \case
 458         PBConfigurePhase{runConfigure} -> do
 459           whenReConfigure $ do
 460             runConfigure
 461             invalidatePackageRegFileMonitor packageFileMonitor
 462             updatePackageConfigFileMonitor packageFileMonitor srcdir pkg
 463         PBBuildPhase{runBuild} -> do
 464           whenRebuild $ do
 465             timestamp <- beginUpdateFileMonitor
 466             runBuild
 467
 468             let listSimple =
 469                   execRebuild srcdir (needElaboratedConfiguredPackage pkg)
 470                 listSdist =
 471                   fmap (map monitorFileHashed) $
 472                     allPackageSourceFiles verbosity srcdir
 473                 ifNullThen m m' = do
 474                   xs <- m
 475                   if null xs then m' else return xs
 476             monitors <- case PD.buildType (elabPkgDescription pkg) of
 477               Simple -> listSimple
 478               -- If a Custom setup was used, AND the Cabal is recent
 479               -- enough to have sdist --list-sources, use that to
 480               -- determine the files that we need to track.  This can
 481               -- cause unnecessary rebuilding (for example, if README
 482               -- is edited, we will try to rebuild) but there isn't
 483               -- a more accurate Custom interface we can use to get
 484               -- this info.  We prefer not to use listSimple here
 485               -- as it can miss extra source files that are considered
 486               -- by the Custom setup.
 487               _
 488                 | elabSetupScriptCliVersion pkg >= mkVersion [1, 17] ->
 489                     -- However, sometimes sdist --list-sources will fail
 490                     -- and return an empty list.  In that case, fall
 491                     -- back on the (inaccurate) simple tracking.
 492                     listSdist `ifNullThen` listSimple
 493                 | otherwise ->
 494                     listSimple
 495
 496             let dep_monitors =
 497                   map monitorFileHashed $
 498                     elabInplaceDependencyBuildCacheFiles
 499                       distDirLayout
 500                       pkgshared
 501                       plan
 502                       pkg
 503             updatePackageBuildFileMonitor
 504               packageFileMonitor
 505               srcdir
 506               timestamp
 507               pkg
 508               buildStatus
 509               (monitors ++ dep_monitors)
 510               buildResult
 511         PBHaddockPhase{runHaddock} -> do
 512           runHaddock
 513           let haddockTarget = elabHaddockForHackage pkg
 514           when (haddockTarget == Cabal.ForHackage) $ do
 515             let dest = distDirectory </> name <.> "tar.gz"
 516                 name = haddockDirName haddockTarget (elabPkgDescription pkg)
 517                 docDir =
 518                   distBuildDirectory distDirLayout dparams
 519                     </> "doc"
 520                     </> "html"
 521             Tar.createTarGzFile dest docDir name
 522             notice verbosity $ "Documentation tarball created: " ++ dest
 523
 524           when (buildSettingHaddockOpen && haddockTarget /= Cabal.ForHackage) $ do
 525             let dest = docDir </> "index.html"
 526                 name = haddockDirName haddockTarget (elabPkgDescription pkg)
 527                 docDir = case distHaddockOutputDir of
 528                   Nothing -> distBuildDirectory distDirLayout dparams </> "doc" </> "html" </> name
 529                   Just dir -> dir
 530             exe <- findOpenProgramLocation platform
 531             case exe of
 532               Right open -> runProgramInvocation verbosity (simpleProgramInvocation open [dest])
 533               Left err -> dieWithException verbosity $ FindOpenProgramLocationErr err
 534         PBInstallPhase{runCopy = _runCopy, runRegister} -> do
 535           -- PURPOSELY omitted: no copy!
 536
 537           whenReRegister $ do
 538             -- Register locally
 539             mipkg <-
 540               if elabRequiresRegistration pkg
 541                 then do
 542                   ipkg <-
 543                     runRegister
 544                       (elabRegisterPackageDBStack pkg)
 545                       Cabal.defaultRegisterOptions
 546                   return (Just ipkg)
 547                 else return Nothing
 548
 549             updatePackageRegFileMonitor packageFileMonitor srcdir mipkg
 550         PBTestPhase{runTest} -> runTest
 551         PBBenchPhase{runBench} -> runBench
 552         PBReplPhase{runRepl} -> runRepl
 553
 554     return
 555       BuildResult
 556         { buildResultDocs = docsResult
 557         , buildResultTests = testsResult
 558         , buildResultLogFile = Nothing
 559         }
 560     where
 561       dparams = elabDistDirParams pkgshared pkg
 562
 563       packageFileMonitor = newPackageFileMonitor pkgshared distDirLayout dparams
 564
 565       whenReConfigure action = case buildStatus of
 566         BuildStatusConfigure _ -> action
 567         _ -> return ()
 568
 569       whenRebuild action
 570         | null (elabBuildTargets pkg)
 571         , -- NB: we have to build the test/bench suite!
 572           null (elabTestTargets pkg)
 573         , null (elabBenchTargets pkg) =
 574             return ()
 575         | otherwise = action
 576
 577       whenReRegister action =
 578         case buildStatus of
 579           -- We registered the package already
 580           BuildStatusBuild (Just _) _ ->
 581             info verbosity "whenReRegister: previously registered"
 582           -- There is nothing to register
 583           _
 584             | null (elabBuildTargets pkg) ->
 585                 info verbosity "whenReRegister: nothing to register"
 586             | otherwise -> action
 587
 588 --------------------------------------------------------------------------------
 589
 590 -- * Build and Install
 591
 592 --------------------------------------------------------------------------------
 593
 594 buildAndInstallUnpackedPackage
 595   :: Verbosity
 596   -> DistDirLayout
 597   -> StoreDirLayout
 598   -> Maybe SemaphoreName
 599   -- ^ Whether to pass a semaphore to build process
 600   -- this is different to BuildTimeSettings because the
 601   -- name of the semaphore is created freshly each time.
 602   -> BuildTimeSettings
 603   -> Lock
 604   -> Lock
 605   -> ElaboratedSharedConfig
 606   -> ElaboratedInstallPlan
 607   -> ElaboratedReadyPackage
 608   -> FilePath
 609   -> FilePath
 610   -> IO BuildResult
 611 buildAndInstallUnpackedPackage
 612   verbosity
 613   distDirLayout
 614   storeDirLayout@StoreDirLayout
 615     { storePackageDBStack
 616     }
 617   maybe_semaphore
 618   buildSettings@BuildTimeSettings{buildSettingNumJobs, buildSettingLogFile}
 619   registerLock
 620   cacheLock
 621   pkgshared@ElaboratedSharedConfig
 622     { pkgConfigCompiler = compiler
 623     , pkgConfigPlatform = platform
 624     }
 625   plan
 626   rpkg@(ReadyPackage pkg)
 627   srcdir
 628   builddir = do
 629     createDirectoryIfMissingVerbose verbosity True (srcdir </> builddir)
 630
 631     -- TODO: [code cleanup] deal consistently with talking to older
 632     --      Setup.hs versions, much like we do for ghc, with a proper
 633     --      options type and rendering step which will also let us
 634     --      call directly into the lib, rather than always going via
 635     --      the lib's command line interface, which would also allow
 636     --      passing data like installed packages, compiler, and
 637     --      program db for a quicker configure.
 638
 639     -- TODO: [required feature] docs and tests
 640     -- TODO: [required feature] sudo re-exec
 641
 642     initLogFile
 643
 644     buildAndRegisterUnpackedPackage
 645       verbosity
 646       distDirLayout
 647       maybe_semaphore
 648       buildSettings
 649       registerLock
 650       cacheLock
 651       pkgshared
 652       plan
 653       rpkg
 654       srcdir
 655       builddir
 656       mlogFile
 657       $ \case
 658         PBConfigurePhase{runConfigure} -> do
 659           noticeProgress ProgressStarting
 660           runConfigure
 661         PBBuildPhase{runBuild} -> do
 662           noticeProgress ProgressBuilding
 663           runBuild
 664         PBHaddockPhase{runHaddock} -> do
 665           noticeProgress ProgressHaddock
 666           runHaddock
 667         PBInstallPhase{runCopy, runRegister} -> do
 668           noticeProgress ProgressInstalling
 669
 670           let registerPkg
 671                 | not (elabRequiresRegistration pkg) =
 672                     debug verbosity $
 673                       "registerPkg: elab does NOT require registration for "
 674                         ++ prettyShow uid
 675                 | otherwise = do
 676                     assert
 677                       ( elabRegisterPackageDBStack pkg
 678                           == storePackageDBStack compid
 679                       )
 680                       (return ())
 681                     _ <-
 682                       runRegister
 683                         (storePackageDBStack compid)
 684                         Cabal.defaultRegisterOptions
 685                           { Cabal.registerMultiInstance = True
 686                           , Cabal.registerSuppressFilesCheck = True
 687                           }
 688                     return ()
 689
 690           -- Actual installation
 691           void $
 692             newStoreEntry
 693               verbosity
 694               storeDirLayout
 695               compid
 696               uid
 697               (copyPkgFiles verbosity pkgshared pkg runCopy)
 698               registerPkg
 699
 700         -- No tests on install
 701         PBTestPhase{} -> return ()
 702         -- No bench on install
 703         PBBenchPhase{} -> return ()
 704         -- No repl on install
 705         PBReplPhase{} -> return ()
 706
 707     -- TODO: [nice to have] we currently rely on Setup.hs copy to do the right
 708     -- thing. Although we do copy into an image dir and do the move into the
 709     -- final location ourselves, perhaps we ought to do some sanity checks on
 710     -- the image dir first.
 711
 712     -- TODO: [required eventually] note that for nix-style
 713     -- installations it is not necessary to do the
 714     -- 'withWin32SelfUpgrade' dance, but it would be necessary for a
 715     -- shared bin dir.
 716
 717     -- TODO: [required feature] docs and test phases
 718     let docsResult = DocsNotTried
 719         testsResult = TestsNotTried
 720
 721     noticeProgress ProgressCompleted
 722
 723     return
 724       BuildResult
 725         { buildResultDocs = docsResult
 726         , buildResultTests = testsResult
 727         , buildResultLogFile = mlogFile
 728         }
 729     where
 730       uid = installedUnitId rpkg
 731       pkgid = packageId rpkg
 732       compid = compilerId compiler
 733
 734       dispname :: String
 735       dispname = case elabPkgOrComp pkg of
 736         ElabPackage _ ->
 737           prettyShow pkgid
 738             ++ " (all, legacy fallback)"
 739         ElabComponent comp ->
 740           prettyShow pkgid
 741             ++ " ("
 742             ++ maybe "custom" prettyShow (compComponentName comp)
 743             ++ ")"
 744
 745       noticeProgress :: ProgressPhase -> IO ()
 746       noticeProgress phase =
 747         when (isParallelBuild buildSettingNumJobs) $
 748           progressMessage verbosity phase dispname
 749
 750       mlogFile :: Maybe FilePath
 751       mlogFile =
 752         case buildSettingLogFile of
 753           Nothing -> Nothing
 754           Just mkLogFile -> Just (mkLogFile compiler platform pkgid uid)
 755
 756       initLogFile :: IO ()
 757       initLogFile =
 758         case mlogFile of
 759           Nothing -> return ()
 760           Just logFile -> do
 761             createDirectoryIfMissing True (takeDirectory logFile)
 762             exists <- doesFileExist logFile
 763             when exists $ removeFile logFile
 764
 765 -- | The copy part of the installation phase when doing build-and-install
 766 copyPkgFiles
 767   :: Verbosity
 768   -> ElaboratedSharedConfig
 769   -> ElaboratedConfiguredPackage
 770   -> (FilePath -> IO ())
 771   -- ^ The 'runCopy' function which invokes ./Setup copy for the
 772   -- given filepath
 773   -> FilePath
 774   -- ^ The temporary dir file path
 775   -> IO (FilePath, [FilePath])
 776 copyPkgFiles verbosity pkgshared pkg runCopy tmpDir = do
 777   let tmpDirNormalised = normalise tmpDir
 778   runCopy tmpDirNormalised
 779   -- Note that the copy command has put the files into
 780   -- @$tmpDir/$prefix@ so we need to return this dir so
 781   -- the store knows which dir will be the final store entry.
 782   let prefix =
 783         normalise $
 784           dropDrive (InstallDirs.prefix (elabInstallDirs pkg))
 785       entryDir = tmpDirNormalised </> prefix
 786
 787   -- if there weren't anything to build, it might be that directory is not created
 788   -- the @setup Cabal.copyCommand@ above might do nothing.
 789   -- https://github.com/haskell/cabal/issues/4130
 790   createDirectoryIfMissingVerbose verbosity True entryDir
 791
 792   let hashFileName = entryDir </> "cabal-hash.txt"
 793       outPkgHashInputs = renderPackageHashInputs (packageHashInputs pkgshared pkg)
 794
 795   info verbosity $
 796     "creating file with the inputs used to compute the package hash: " ++ hashFileName
 797
 798   LBS.writeFile hashFileName outPkgHashInputs
 799
 800   debug verbosity "Package hash inputs:"
 801   traverse_
 802     (debug verbosity . ("> " ++))
 803     (lines $ LBS.Char8.unpack outPkgHashInputs)
 804
 805   -- Ensure that there are no files in `tmpDir`, that are
 806   -- not in `entryDir`. While this breaks the
 807   -- prefix-relocatable property of the libraries, it is
 808   -- necessary on macOS to stay under the load command limit
 809   -- of the macOS mach-o linker. See also
 810   -- @PackageHash.hashedInstalledPackageIdVeryShort@.
 811   --
 812   -- We also normalise paths to ensure that there are no
 813   -- different representations for the same path. Like / and
 814   -- \\ on windows under msys.
 815   otherFiles <-
 816     filter (not . isPrefixOf entryDir)
 817       <$> listFilesRecursive tmpDirNormalised
 818   -- Here's where we could keep track of the installed files
 819   -- ourselves if we wanted to by making a manifest of the
 820   -- files in the tmp dir.
 821   return (entryDir, otherFiles)
 822   where
 823     listFilesRecursive :: FilePath -> IO [FilePath]
 824     listFilesRecursive path = do
 825       files <- fmap (path </>) <$> (listDirectory path)
 826       allFiles <- for files $ \file -> do
 827         isDir <- doesDirectoryExist file
 828         if isDir
 829           then listFilesRecursive file
 830           else return [file]
 831       return (concat allFiles)
 832
 833 --------------------------------------------------------------------------------
 834
 835 -- * Exported Utils
 836
 837 --------------------------------------------------------------------------------
 838
 839 {- FOURMOLU_DISABLE -}
 840 annotateFailureNoLog :: (SomeException -> BuildFailureReason)
 841                      -> IO a -> IO a
 842 annotateFailureNoLog annotate action =
 843   annotateFailure Nothing annotate action
 844
 845 annotateFailure :: Maybe FilePath
 846                 -> (SomeException -> BuildFailureReason)
 847                 -> IO a -> IO a
 848 annotateFailure mlogFile annotate action =
 849   action `catches`
 850     -- It's not just IOException and ExitCode we have to deal with, there's
 851     -- lots, including exceptions from the hackage-security and tar packages.
 852     -- So we take the strategy of catching everything except async exceptions.
 853     [
 854 #if MIN_VERSION_base(4,7,0)
 855       Handler $ \async -> throwIO (async :: SomeAsyncException)
 856 #else
 857       Handler $ \async -> throwIO (async :: AsyncException)
 858 #endif
 859     , Handler $ \other -> handler (other :: SomeException)
 860     ]
 861   where
 862     handler :: Exception e => e -> IO a
 863     handler = throwIO . BuildFailure mlogFile . annotate . toException
 864
 865 --------------------------------------------------------------------------------
 866 -- * Other Utils
 867 --------------------------------------------------------------------------------
 868
 869 hasValidHaddockTargets :: ElaboratedConfiguredPackage -> Bool
 870 hasValidHaddockTargets ElaboratedConfiguredPackage{..}
 871   | not elabBuildHaddocks = False
 872   | otherwise = any componentHasHaddocks components
 873   where
 874     components :: [ComponentTarget]
 875     components =
 876       elabBuildTargets
 877         ++ elabTestTargets
 878         ++ elabBenchTargets
 879         ++ elabReplTarget
 880         ++ elabHaddockTargets
 881
 882     componentHasHaddocks :: ComponentTarget -> Bool
 883     componentHasHaddocks (ComponentTarget name _) =
 884       case name of
 885         CLibName LMainLibName -> hasHaddocks
 886         CLibName (LSubLibName _) -> elabHaddockInternal && hasHaddocks
 887         CFLibName _ -> elabHaddockForeignLibs && hasHaddocks
 888         CExeName _ -> elabHaddockExecutables && hasHaddocks
 889         CTestName _ -> elabHaddockTestSuites && hasHaddocks
 890         CBenchName _ -> elabHaddockBenchmarks && hasHaddocks
 891       where
 892         hasHaddocks = not (null (elabPkgDescription ^. componentModules name))
 893
 894 withTempInstalledPackageInfoFile
 895   :: Verbosity
 896   -> FilePath
 897   -> (FilePath -> IO ())
 898   -> IO InstalledPackageInfo
 899 withTempInstalledPackageInfoFile verbosity tempdir action =
 900   withTempDirectory verbosity tempdir "package-registration-" $ \dir -> do
 901     -- make absolute since @action@ will often change directory
 902     abs_dir <- canonicalizePath dir
 903
 904     let pkgConfDest = abs_dir </> "pkgConf"
 905     action pkgConfDest
 906
 907     readPkgConf "." pkgConfDest
 908   where
 909     pkgConfParseFailed :: String -> IO a
 910     pkgConfParseFailed perror =
 911       dieWithException verbosity $ PkgConfParseFailed perror
 912
 913     readPkgConf :: FilePath -> FilePath -> IO InstalledPackageInfo
 914     readPkgConf pkgConfDir pkgConfFile = do
 915       pkgConfStr <- BS.readFile (pkgConfDir </> pkgConfFile)
 916       (warns, ipkg) <- case Installed.parseInstalledPackageInfo pkgConfStr of
 917         Left perrors -> pkgConfParseFailed $ unlines $ NE.toList perrors
 918         Right (warns, ipkg) -> return (warns, ipkg)
 919
 920       unless (null warns) $
 921         warn verbosity $
 922           unlines warns
 923
 924       return ipkg
 925