{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | This module exposes functions to build and register unpacked packages.
--
-- Mainly, unpacked packages are either:
--  * Built and registered in-place
--  * Built and installed
--
-- The two cases differ significantly for there to be a distinction.
-- For instance, we only care about file monitoring and re-building when dealing
-- with "inplace" registered packages, whereas for installed packages we don't.
module Distribution.Client.ProjectBuilding.UnpackedPackage
  ( buildInplaceUnpackedPackage
  , buildAndInstallUnpackedPackage

    -- ** Auxiliary definitions
  , buildAndRegisterUnpackedPackage
  , PackageBuildingPhase

    -- ** Utilities
  , annotateFailure
  , annotateFailureNoLog
  ) where

import Distribution.Client.Compat.Prelude
import Prelude ()

import Distribution.Client.PackageHash (renderPackageHashInputs)
import Distribution.Client.ProjectBuilding.Types
import Distribution.Client.ProjectConfig
import Distribution.Client.ProjectConfig.Types
import Distribution.Client.ProjectPlanning
import Distribution.Client.ProjectPlanning.Types
import Distribution.Client.RebuildMonad
import Distribution.Client.Store

import Distribution.Client.DistDirLayout
import Distribution.Client.FileMonitor
import Distribution.Client.JobControl
import Distribution.Client.Setup
  ( CommonSetupFlags
  , filterBenchmarkFlags
  , filterBuildFlags
  , filterConfigureFlags
  , filterCopyFlags
  , filterHaddockArgs
  , filterHaddockFlags
  , filterRegisterFlags
  , filterReplFlags
  , filterTestFlags
  )
import Distribution.Client.SetupWrapper
import Distribution.Client.SourceFiles
import Distribution.Client.SrcDist (allPackageSourceFiles)
import qualified Distribution.Client.Tar as Tar
import Distribution.Client.Types hiding
  ( BuildFailure (..)
  , BuildOutcome
  , BuildOutcomes
  , BuildResult (..)
  )
import Distribution.Client.Utils
  ( ProgressPhase (..)
  , progressMessage
  )

import Distribution.Compat.Lens
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import qualified Distribution.InstalledPackageInfo as Installed
import Distribution.Package
import qualified Distribution.PackageDescription as PD
import Distribution.Simple.BuildPaths (haddockDirName)
import Distribution.Simple.Command (CommandUI)
import Distribution.Simple.Compiler
  ( PackageDBStackCWD
  , coercePackageDBStack
  )
import qualified Distribution.Simple.Configure as Cabal
import qualified Distribution.Simple.InstallDirs as InstallDirs
import Distribution.Simple.LocalBuildInfo
  ( ComponentName (..)
  , LibraryName (..)
  )
import qualified Distribution.Simple.LocalBuildInfo as Cabal
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.Program
import qualified Distribution.Simple.Register as Cabal
import qualified Distribution.Simple.Setup as Cabal
import Distribution.Types.BuildType
import Distribution.Types.PackageDescription.Lens (componentModules)

import Distribution.Client.Errors
import Distribution.Simple.Utils
import Distribution.System (Platform (..))
import Distribution.Utils.Path hiding
  ( (<.>)
  , (</>)
  )
import Distribution.Verbosity (setVerbosityHandles)
import Distribution.Version

import Distribution.Client.ProjectBuilding.PackageFileMonitor

import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Lazy.Char8 as LBS.Char8
import qualified Data.List.NonEmpty as NE

import Control.Concurrent.STM (TVar, atomically, modifyTVar)
import Control.Exception (ErrorCall, Handler (..), SomeAsyncException, assert, catches, onException)
import Data.IORef (newIORef, readIORef, writeIORef)
import System.Directory (canonicalizePath, createDirectoryIfMissing, doesDirectoryExist, listDirectory)
import System.FilePath (dropDrive, normalise, takeDirectory, (<.>), (</>))
import System.IO (Handle, IOMode (AppendMode), withFile)
import System.Semaphore (SemaphoreIdentifier)

import GHC.Stack
import Web.Browser (openBrowser)

-- | Each unpacked package is processed in the following phases:
--
-- * Configure phase
-- * Build phase
-- * Haddock phase
-- * Install phase (copy + register)
-- * Register phase
-- * Test phase
-- * Bench phase
-- * Repl phase
--
-- Depending on whether we are installing the package or building it inplace,
-- the phases will be carried out differently. For example, when installing,
-- the test, benchmark, and repl phase are ignored.
data PackageBuildingPhase r where
  PBConfigurePhase :: {PackageBuildingPhase InLibraryLBI -> IO InLibraryLBI
runConfigure :: IO InLibraryLBI} -> PackageBuildingPhase InLibraryLBI
  PBBuildPhase :: {PackageBuildingPhase () -> IO [MonitorFilePath]
runBuild :: IO [MonitorFilePath]} -> PackageBuildingPhase ()
  PBHaddockPhase :: {PackageBuildingPhase () -> IO [MonitorFilePath]
runHaddock :: IO [MonitorFilePath]} -> PackageBuildingPhase ()
  PBReplPhase :: {PackageBuildingPhase () -> IO [MonitorFilePath]
runRepl :: IO [MonitorFilePath]} -> PackageBuildingPhase ()
  PBInstallPhase
    :: { PackageBuildingPhase () -> FilePath -> IO ()
runCopy :: FilePath -> IO ()
       , PackageBuildingPhase ()
-> PackageDBStackCWD -> RegisterOptions -> IO InstalledPackageInfo
runRegister
          :: PackageDBStackCWD
          -> Cabal.RegisterOptions
          -> IO InstalledPackageInfo
       , PackageBuildingPhase () -> IO InstalledPackageInfo
getInstalledPackageInfo :: IO InstalledPackageInfo
        -- ^ Compute the 'InstalledPackageInfo' from the build output,
        -- without registering with @ghc-pkg@. Deterministic.
       }
    -> PackageBuildingPhase ()
  PBTestPhase :: {PackageBuildingPhase () -> IO ()
runTest :: IO ()} -> PackageBuildingPhase ()
  PBBenchPhase :: {PackageBuildingPhase () -> IO ()
runBench :: IO ()} -> PackageBuildingPhase ()

-- | Structures the phases of building and registering a package amongst others
-- (see t'PackageBuildingPhase'). Delegates logic specific to a certain
-- building style (notably, inplace vs install) to the delegate function that
-- receives as an argument t'PackageBuildingPhase')
buildAndRegisterUnpackedPackage
  :: Verbosity
  -> DistDirLayout
  -> Maybe SemaphoreIdentifier
  -- ^ Whether to pass a semaphore to build process
  -- this is different to BuildTimeSettings because the
  -- name of the semaphore is created freshly each time.
  -> BuildTimeSettings
  -> Lock
  -> Lock
  -> ElaboratedSharedConfig
  -> ElaboratedInstallPlan
  -> ElaboratedReadyPackage
  -> TVar InstalledPackageIndex
  -- ^ Running 'InstalledPackageIndex', updated as @cabal-install@ registers
  -- packages
  -> SymbolicPath CWD (Dir Pkg)
  -> SymbolicPath Pkg (Dir Dist)
  -> Maybe FilePath
  -- ^ The path to an /initialized/ log file
  -> (forall r. PackageBuildingPhase r -> IO r)
  -> IO ()
buildAndRegisterUnpackedPackage :: Verbosity
-> DistDirLayout
-> Maybe FilePath
-> BuildTimeSettings
-> Lock
-> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> TVar InstalledPackageIndex
-> SymbolicPath CWD ('Dir Pkg)
-> SymbolicPath Pkg ('Dir Dist)
-> Maybe FilePath
-> (forall r. PackageBuildingPhase r -> IO r)
-> IO ()
buildAndRegisterUnpackedPackage
  Verbosity
verbosity
  distDirLayout :: DistDirLayout
distDirLayout@DistDirLayout{FilePath
distTempDirectory :: FilePath
distTempDirectory :: DistDirLayout -> FilePath
distTempDirectory}
  Maybe FilePath
maybe_semaphore
  buildTimeSettings :: BuildTimeSettings
buildTimeSettings@BuildTimeSettings{Bool
buildSettingKeepTempFiles :: Bool
buildSettingKeepTempFiles :: BuildTimeSettings -> Bool
buildSettingKeepTempFiles}
  Lock
registerLock
  Lock
cacheLock
  pkgshared :: ElaboratedSharedConfig
pkgshared@ElaboratedSharedConfig
    { pkgConfigCompiler :: ElaboratedSharedConfig -> Compiler
pkgConfigCompiler = Compiler
compiler
    , pkgConfigCompilerProgs :: ElaboratedSharedConfig -> ProgramDb
pkgConfigCompilerProgs = ProgramDb
progdb
    }
  ElaboratedInstallPlan
plan
  rpkg :: ElaboratedReadyPackage
rpkg@(ReadyPackage ElaboratedConfiguredPackage
pkg)
  TVar InstalledPackageIndex
ipiTVar
  SymbolicPath CWD ('Dir Pkg)
srcdir
  SymbolicPath Pkg ('Dir Dist)
builddir
  Maybe FilePath
mlogFile
  forall r. PackageBuildingPhase r -> IO r
delegate = do
    -- Configure phase
    mbLBI <-
      PackageBuildingPhase InLibraryLBI -> IO InLibraryLBI
forall r. PackageBuildingPhase r -> IO r
delegate (PackageBuildingPhase InLibraryLBI -> IO InLibraryLBI)
-> PackageBuildingPhase InLibraryLBI -> IO InLibraryLBI
forall a b. (a -> b) -> a -> b
$
        IO InLibraryLBI -> PackageBuildingPhase InLibraryLBI
PBConfigurePhase (IO InLibraryLBI -> PackageBuildingPhase InLibraryLBI)
-> IO InLibraryLBI -> PackageBuildingPhase InLibraryLBI
forall a b. (a -> b) -> a -> b
$
          Maybe FilePath
-> (SomeException -> BuildFailureReason)
-> IO InLibraryLBI
-> IO InLibraryLBI
forall a.
Maybe FilePath
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe FilePath
mlogFile SomeException -> BuildFailureReason
ConfigureFailed (IO InLibraryLBI -> IO InLibraryLBI)
-> IO InLibraryLBI -> IO InLibraryLBI
forall a b. (a -> b) -> a -> b
$
            CommandUI ConfigFlags
-> (ConfigFlags -> CommonSetupFlags)
-> (Version -> IO ConfigFlags)
-> (Version -> [FilePath])
-> SetupRunnerArgs ('TryInLibrary ConfigFlags)
-> IO (SetupRunnerRes ('TryInLibrary ConfigFlags))
forall flags (setupSpec :: SetupWrapperSpec).
(HasCallStack, RightFlagsForPhase flags setupSpec) =>
CommandUI flags
-> (flags -> CommonSetupFlags)
-> (Version -> IO flags)
-> (Version -> [FilePath])
-> SetupRunnerArgs setupSpec
-> IO (SetupRunnerRes setupSpec)
setup
              CommandUI ConfigFlags
configureCommand
              ConfigFlags -> CommonSetupFlags
Cabal.configCommonFlags
              Version -> IO ConfigFlags
configureFlags
              Version -> [FilePath]
configureArgs
              (InLibraryArgs ConfigFlags
-> SetupRunnerArgs ('TryInLibrary ConfigFlags)
forall flags.
InLibraryArgs flags -> SetupRunnerArgs ('TryInLibrary flags)
InLibraryArgs (InLibraryArgs ConfigFlags
 -> SetupRunnerArgs ('TryInLibrary ConfigFlags))
-> InLibraryArgs ConfigFlags
-> SetupRunnerArgs ('TryInLibrary ConfigFlags)
forall a b. (a -> b) -> a -> b
$ ElaboratedSharedConfig
-> ElaboratedReadyPackage
-> TVar InstalledPackageIndex
-> InLibraryArgs ConfigFlags
InLibraryConfigureArgs ElaboratedSharedConfig
pkgshared ElaboratedReadyPackage
rpkg TVar InstalledPackageIndex
ipiTVar)

    -- Build phase
    delegate $
      PBBuildPhase $
        annotateFailure mlogFile BuildFailed $ do
          setup
            buildCommand
            Cabal.buildCommonFlags
            (return . buildFlags)
            buildArgs
            (InLibraryArgs $ InLibraryPostConfigureArgs SBuildPhase mbLBI)

    -- Haddock phase
    whenHaddock $
      delegate $
        PBHaddockPhase $
          annotateFailure mlogFile HaddocksFailed $ do
            setup
              haddockCommand
              Cabal.haddockCommonFlags
              (return . haddockFlags)
              haddockArgs
              (InLibraryArgs $ InLibraryPostConfigureArgs SHaddockPhase mbLBI)

    -- Install phase
    let getIpkg = do
          -- Grab and modify the InstalledPackageInfo. We decide what
          -- the installed package id is, not the build system.
          ipkg0 <- InLibraryLBI -> IO InstalledPackageInfo
generateInstalledPackageInfo InLibraryLBI
mbLBI
          return ipkg0{Installed.installedUnitId = uid}
    delegate $
      PBInstallPhase
        { runCopy = \FilePath
destdir ->
            Maybe FilePath
-> (SomeException -> BuildFailureReason) -> IO () -> IO ()
forall a.
Maybe FilePath
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe FilePath
mlogFile SomeException -> BuildFailureReason
InstallFailed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
              CommandUI CopyFlags
-> (CopyFlags -> CommonSetupFlags)
-> (Version -> IO CopyFlags)
-> (Version -> [FilePath])
-> SetupRunnerArgs ('TryInLibrary CopyFlags)
-> IO (SetupRunnerRes ('TryInLibrary CopyFlags))
forall flags (setupSpec :: SetupWrapperSpec).
(HasCallStack, RightFlagsForPhase flags setupSpec) =>
CommandUI flags
-> (flags -> CommonSetupFlags)
-> (Version -> IO flags)
-> (Version -> [FilePath])
-> SetupRunnerArgs setupSpec
-> IO (SetupRunnerRes setupSpec)
setup
                CommandUI CopyFlags
Cabal.copyCommand
                CopyFlags -> CommonSetupFlags
Cabal.copyCommonFlags
                (CopyFlags -> IO CopyFlags
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CopyFlags -> IO CopyFlags)
-> (Version -> CopyFlags) -> Version -> IO CopyFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Version -> CopyFlags
copyFlags FilePath
destdir)
                Version -> [FilePath]
copyArgs
                (InLibraryArgs CopyFlags
-> SetupRunnerArgs ('TryInLibrary CopyFlags)
forall flags.
InLibraryArgs flags -> SetupRunnerArgs ('TryInLibrary flags)
InLibraryArgs (InLibraryArgs CopyFlags
 -> SetupRunnerArgs ('TryInLibrary CopyFlags))
-> InLibraryArgs CopyFlags
-> SetupRunnerArgs ('TryInLibrary CopyFlags)
forall a b. (a -> b) -> a -> b
$ SPostConfigurePhase CopyFlags
-> InLibraryLBI -> InLibraryArgs CopyFlags
forall flags.
SPostConfigurePhase flags -> InLibraryLBI -> InLibraryArgs flags
InLibraryPostConfigureArgs SPostConfigurePhase CopyFlags
SCopyPhase InLibraryLBI
mbLBI)
        , runRegister = \PackageDBStackCWD
pkgDBStack RegisterOptions
registerOpts ->
            Maybe FilePath
-> (SomeException -> BuildFailureReason)
-> IO InstalledPackageInfo
-> IO InstalledPackageInfo
forall a.
Maybe FilePath
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe FilePath
mlogFile SomeException -> BuildFailureReason
InstallFailed (IO InstalledPackageInfo -> IO InstalledPackageInfo)
-> IO InstalledPackageInfo -> IO InstalledPackageInfo
forall a b. (a -> b) -> a -> b
$ do
              -- We register ourselves, rather than via Setup.hs.
              ipkg <- IO InstalledPackageInfo
getIpkg
              criticalSection registerLock $
                Cabal.registerPackage
                  verbosity
                  compiler
                  progdb
                  Nothing
                  (coercePackageDBStack pkgDBStack)
                  ipkg
                  registerOpts
              return ipkg
        , getInstalledPackageInfo = getIpkg
        }

    -- Test phase
    whenTest $
      delegate $
        PBTestPhase $
          annotateFailure mlogFile TestsFailed $
            setup
              testCommand
              Cabal.testCommonFlags
              (return . testFlags)
              testArgs
              (InLibraryArgs $ InLibraryPostConfigureArgs STestPhase mbLBI)

    -- Bench phase
    whenBench $
      delegate $
        PBBenchPhase $
          annotateFailure mlogFile BenchFailed $
            setup
              benchCommand
              Cabal.benchmarkCommonFlags
              (return . benchFlags)
              benchArgs
              (InLibraryArgs $ InLibraryPostConfigureArgs SBenchPhase mbLBI)

    -- Repl phase
    whenRepl $
      delegate $
        PBReplPhase $
          annotateFailure mlogFile ReplFailed $
            setupInteractive
              replCommand
              Cabal.replCommonFlags
              (return . replFlags)
              replArgs
              (InLibraryArgs $ InLibraryPostConfigureArgs SReplPhase mbLBI)

    return ()
    where
      uid :: UnitId
uid = ElaboratedReadyPackage -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedReadyPackage
rpkg

      comp_par_strat :: Flag FilePath
comp_par_strat = case Maybe FilePath
maybe_semaphore of
        Just FilePath
sem_ident -> FilePath -> Flag FilePath
forall a. a -> Flag a
Cabal.toFlag FilePath
sem_ident
        Maybe FilePath
_ -> Flag FilePath
forall a. Last a
Cabal.NoFlag

      whenTest :: IO () -> IO ()
whenTest IO ()
action
        | [ComponentTarget] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets ElaboratedConfiguredPackage
pkg) = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Bool
otherwise = IO ()
action

      whenBench :: IO () -> IO ()
whenBench IO ()
action
        | [ComponentTarget] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets ElaboratedConfiguredPackage
pkg) = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Bool
otherwise = IO ()
action

      whenRepl :: IO () -> IO ()
whenRepl IO ()
action
        | [ComponentTarget] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget ElaboratedConfiguredPackage
pkg) = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Bool
otherwise = IO ()
action

      whenHaddock :: IO () -> IO ()
whenHaddock IO ()
action
        | ElaboratedConfiguredPackage -> Bool
hasValidHaddockTargets ElaboratedConfiguredPackage
pkg = IO ()
action
        | Bool
otherwise = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

      mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = SetupScriptOptions -> Maybe (SymbolicPath CWD ('Dir Pkg))
useWorkingDir SetupScriptOptions
scriptOptions
      commonFlags :: [FilePath] -> CommonSetupFlags
commonFlags [FilePath]
targets =
        Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg ('Dir Dist)
-> [FilePath]
-> Bool
-> CommonSetupFlags
setupHsCommonFlags Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPath Pkg ('Dir Dist)
builddir [FilePath]
targets Bool
buildSettingKeepTempFiles

      configureCommand :: CommandUI ConfigFlags
configureCommand = ProgramDb -> CommandUI ConfigFlags
Cabal.configureCommand ProgramDb
defaultProgramDb
      configureFlags :: Version -> IO ConfigFlags
configureFlags Version
v =
        (ConfigFlags -> Version -> ConfigFlags)
-> Version -> ConfigFlags -> ConfigFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip ConfigFlags -> Version -> ConfigFlags
filterConfigureFlags Version
v
          (ConfigFlags -> ConfigFlags) -> IO ConfigFlags -> IO ConfigFlags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO (SymbolicPath Pkg ('Dir PkgDB)))
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> ElaboratedSharedConfig
-> CommonSetupFlags
-> IO ConfigFlags
forall (m :: * -> *).
Monad m =>
(FilePath -> m (SymbolicPath Pkg ('Dir PkgDB)))
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> ElaboratedSharedConfig
-> CommonSetupFlags
-> m ConfigFlags
setupHsConfigureFlags
            ((FilePath -> SymbolicPath Pkg ('Dir PkgDB))
-> IO FilePath -> IO (SymbolicPath Pkg ('Dir PkgDB))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> SymbolicPath Pkg ('Dir PkgDB)
forall from (to :: FileOrDir). FilePath -> SymbolicPath from to
makeSymbolicPath (IO FilePath -> IO (SymbolicPath Pkg ('Dir PkgDB)))
-> (FilePath -> IO FilePath)
-> FilePath
-> IO (SymbolicPath Pkg ('Dir PkgDB))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
canonicalizePath)
            ElaboratedInstallPlan
plan
            ElaboratedReadyPackage
rpkg
            ElaboratedSharedConfig
pkgshared
            ([FilePath] -> CommonSetupFlags
commonFlags ([FilePath] -> CommonSetupFlags) -> [FilePath] -> CommonSetupFlags
forall a b. (a -> b) -> a -> b
$ Version -> [FilePath]
configureArgs Version
v)
      configureArgs :: Version -> [FilePath]
configureArgs Version
_ = ElaboratedConfiguredPackage -> [FilePath]
setupHsConfigureArgs ElaboratedConfiguredPackage
pkg

      buildCommand :: CommandUI BuildFlags
buildCommand = ProgramDb -> CommandUI BuildFlags
Cabal.buildCommand ProgramDb
defaultProgramDb
      buildFlags :: Version -> BuildFlags
buildFlags Version
v =
        (BuildFlags -> Version -> BuildFlags)
-> Version -> BuildFlags -> BuildFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip BuildFlags -> Version -> BuildFlags
filterBuildFlags Version
v (BuildFlags -> BuildFlags) -> BuildFlags -> BuildFlags
forall a b. (a -> b) -> a -> b
$
          Flag FilePath
-> ElaboratedConfiguredPackage
-> ElaboratedSharedConfig
-> CommonSetupFlags
-> BuildFlags
setupHsBuildFlags
            Flag FilePath
comp_par_strat
            ElaboratedConfiguredPackage
pkg
            ElaboratedSharedConfig
pkgshared
            ([FilePath] -> CommonSetupFlags
commonFlags ([FilePath] -> CommonSetupFlags) -> [FilePath] -> CommonSetupFlags
forall a b. (a -> b) -> a -> b
$ Version -> [FilePath]
buildArgs Version
v)
      buildArgs :: Version -> [FilePath]
buildArgs Version
_ = ElaboratedConfiguredPackage -> [FilePath]
setupHsBuildArgs ElaboratedConfiguredPackage
pkg

      copyFlags :: FilePath -> Version -> CopyFlags
copyFlags FilePath
destdir Version
v =
        (CopyFlags -> Version -> CopyFlags)
-> Version -> CopyFlags -> CopyFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip CopyFlags -> Version -> CopyFlags
filterCopyFlags Version
v (CopyFlags -> CopyFlags) -> CopyFlags -> CopyFlags
forall a b. (a -> b) -> a -> b
$
          ElaboratedConfiguredPackage
-> ElaboratedSharedConfig
-> CommonSetupFlags
-> FilePath
-> CopyFlags
setupHsCopyFlags
            ElaboratedConfiguredPackage
pkg
            ElaboratedSharedConfig
pkgshared
            ([FilePath] -> CommonSetupFlags
commonFlags ([FilePath] -> CommonSetupFlags) -> [FilePath] -> CommonSetupFlags
forall a b. (a -> b) -> a -> b
$ Version -> [FilePath]
buildArgs Version
v)
            FilePath
destdir
      -- In theory, we could want to copy less things than those that were
      -- built, but instead, we simply copy the targets that were built.
      copyArgs :: Version -> [FilePath]
copyArgs = Version -> [FilePath]
buildArgs

      testCommand :: CommandUI TestFlags
testCommand = CommandUI TestFlags
Cabal.testCommand -- defaultProgramDb
      testFlags :: Version -> TestFlags
testFlags Version
v =
        (TestFlags -> Version -> TestFlags)
-> Version -> TestFlags -> TestFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip TestFlags -> Version -> TestFlags
filterTestFlags Version
v (TestFlags -> TestFlags) -> TestFlags -> TestFlags
forall a b. (a -> b) -> a -> b
$
          ElaboratedConfiguredPackage -> CommonSetupFlags -> TestFlags
setupHsTestFlags
            ElaboratedConfiguredPackage
pkg
            ([FilePath] -> CommonSetupFlags
commonFlags ([FilePath] -> CommonSetupFlags) -> [FilePath] -> CommonSetupFlags
forall a b. (a -> b) -> a -> b
$ Version -> [FilePath]
testArgs Version
v)
      testArgs :: Version -> [FilePath]
testArgs Version
_ = ElaboratedConfiguredPackage -> [FilePath]
setupHsTestArgs ElaboratedConfiguredPackage
pkg

      benchCommand :: CommandUI BenchmarkFlags
benchCommand = CommandUI BenchmarkFlags
Cabal.benchmarkCommand
      benchFlags :: Version -> BenchmarkFlags
benchFlags Version
v =
        (BenchmarkFlags -> Version -> BenchmarkFlags)
-> Version -> BenchmarkFlags -> BenchmarkFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip BenchmarkFlags -> Version -> BenchmarkFlags
filterBenchmarkFlags Version
v (BenchmarkFlags -> BenchmarkFlags)
-> BenchmarkFlags -> BenchmarkFlags
forall a b. (a -> b) -> a -> b
$
          ElaboratedConfiguredPackage
-> ElaboratedSharedConfig -> CommonSetupFlags -> BenchmarkFlags
setupHsBenchFlags
            ElaboratedConfiguredPackage
pkg
            ElaboratedSharedConfig
pkgshared
            ([FilePath] -> CommonSetupFlags
commonFlags ([FilePath] -> CommonSetupFlags) -> [FilePath] -> CommonSetupFlags
forall a b. (a -> b) -> a -> b
$ Version -> [FilePath]
benchArgs Version
v)
      benchArgs :: Version -> [FilePath]
benchArgs Version
_ = ElaboratedConfiguredPackage -> [FilePath]
setupHsBenchArgs ElaboratedConfiguredPackage
pkg

      replCommand :: CommandUI ReplFlags
replCommand = ProgramDb -> CommandUI ReplFlags
Cabal.replCommand ProgramDb
defaultProgramDb
      replFlags :: Version -> ReplFlags
replFlags Version
v =
        (ReplFlags -> Version -> ReplFlags)
-> Version -> ReplFlags -> ReplFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReplFlags -> Version -> ReplFlags
filterReplFlags Version
v (ReplFlags -> ReplFlags) -> ReplFlags -> ReplFlags
forall a b. (a -> b) -> a -> b
$
          ElaboratedConfiguredPackage
-> ElaboratedSharedConfig -> CommonSetupFlags -> ReplFlags
setupHsReplFlags
            ElaboratedConfiguredPackage
pkg
            ElaboratedSharedConfig
pkgshared
            ([FilePath] -> CommonSetupFlags
commonFlags ([FilePath] -> CommonSetupFlags) -> [FilePath] -> CommonSetupFlags
forall a b. (a -> b) -> a -> b
$ Version -> [FilePath]
replArgs Version
v)
      replArgs :: Version -> [FilePath]
replArgs Version
_ = ElaboratedConfiguredPackage -> [FilePath]
setupHsReplArgs ElaboratedConfiguredPackage
pkg

      haddockCommand :: CommandUI HaddockFlags
haddockCommand = CommandUI HaddockFlags
Cabal.haddockCommand
      haddockFlags :: Version -> HaddockFlags
haddockFlags Version
v =
        (HaddockFlags -> Version -> HaddockFlags)
-> Version -> HaddockFlags -> HaddockFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip HaddockFlags -> Version -> HaddockFlags
filterHaddockFlags Version
v (HaddockFlags -> HaddockFlags) -> HaddockFlags -> HaddockFlags
forall a b. (a -> b) -> a -> b
$
          ElaboratedConfiguredPackage
-> ElaboratedSharedConfig
-> BuildTimeSettings
-> CommonSetupFlags
-> HaddockFlags
setupHsHaddockFlags
            ElaboratedConfiguredPackage
pkg
            ElaboratedSharedConfig
pkgshared
            BuildTimeSettings
buildTimeSettings
            ([FilePath] -> CommonSetupFlags
commonFlags ([FilePath] -> CommonSetupFlags) -> [FilePath] -> CommonSetupFlags
forall a b. (a -> b) -> a -> b
$ Version -> [FilePath]
haddockArgs Version
v)
      haddockArgs :: Version -> [FilePath]
haddockArgs Version
v =
        ([FilePath] -> Version -> [FilePath])
-> Version -> [FilePath] -> [FilePath]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [FilePath] -> Version -> [FilePath]
filterHaddockArgs Version
v ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$
          ElaboratedConfiguredPackage -> [FilePath]
setupHsHaddockArgs ElaboratedConfiguredPackage
pkg

      scriptOptions :: SetupScriptOptions
scriptOptions =
        ElaboratedReadyPackage
-> ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> DistDirLayout
-> SymbolicPath CWD ('Dir Pkg)
-> SymbolicPath Pkg ('Dir Dist)
-> Lock
-> SetupScriptOptions
setupHsScriptOptions
          ElaboratedReadyPackage
rpkg
          ElaboratedInstallPlan
plan
          ElaboratedSharedConfig
pkgshared
          DistDirLayout
distDirLayout
          SymbolicPath CWD ('Dir Pkg)
srcdir
          SymbolicPath Pkg ('Dir Dist)
builddir
          Lock
cacheLock

      setup
        :: (HasCallStack, RightFlagsForPhase flags setupSpec)
        => CommandUI flags
        -> (flags -> CommonSetupFlags)
        -> (Version -> IO flags)
        -> (Version -> [String])
        -> SetupRunnerArgs setupSpec
        -> IO (SetupRunnerRes setupSpec)
      setup :: forall flags (setupSpec :: SetupWrapperSpec).
(HasCallStack, RightFlagsForPhase flags setupSpec) =>
CommandUI flags
-> (flags -> CommonSetupFlags)
-> (Version -> IO flags)
-> (Version -> [FilePath])
-> SetupRunnerArgs setupSpec
-> IO (SetupRunnerRes setupSpec)
setup CommandUI flags
cmd flags -> CommonSetupFlags
getCommonFlags Version -> IO flags
flags Version -> [FilePath]
args SetupRunnerArgs setupSpec
wrapperArgs =
        (Maybe Handle -> IO (SetupRunnerRes setupSpec))
-> IO (SetupRunnerRes setupSpec)
forall r. (Maybe Handle -> IO r) -> IO r
withLogging ((Maybe Handle -> IO (SetupRunnerRes setupSpec))
 -> IO (SetupRunnerRes setupSpec))
-> (Maybe Handle -> IO (SetupRunnerRes setupSpec))
-> IO (SetupRunnerRes setupSpec)
forall a b. (a -> b) -> a -> b
$ \Maybe Handle
mLogFileHandle ->
          Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
-> (flags -> CommonSetupFlags)
-> (Version -> IO flags)
-> (Version -> [FilePath])
-> SetupRunnerArgs setupSpec
-> IO (SetupRunnerRes setupSpec)
forall (setupSpec :: SetupWrapperSpec) flags.
RightFlagsForPhase flags setupSpec =>
Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
-> (flags -> CommonSetupFlags)
-> (Version -> IO flags)
-> (Version -> [FilePath])
-> SetupRunnerArgs setupSpec
-> IO (SetupRunnerRes setupSpec)
setupWrapper
            (Maybe Handle -> Verbosity -> Verbosity
setVerbosityHandles Maybe Handle
mLogFileHandle Verbosity
verbosity)
            SetupScriptOptions
scriptOptions
              { useLoggingHandle = mLogFileHandle
              , useExtraEnvOverrides =
                  dataDirsEnvironmentForPlan
                    distDirLayout
                    plan
              }
            (PackageDescription -> Maybe PackageDescription
forall a. a -> Maybe a
Just (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
pkg))
            CommandUI flags
cmd
            flags -> CommonSetupFlags
getCommonFlags
            Version -> IO flags
flags
            Version -> [FilePath]
args
            SetupRunnerArgs setupSpec
wrapperArgs

      setupInteractive
        :: RightFlagsForPhase flags setupSpec
        => CommandUI flags
        -> (flags -> CommonSetupFlags)
        -> (Version -> IO flags)
        -> (Version -> [String])
        -> SetupRunnerArgs setupSpec
        -> IO (SetupRunnerRes setupSpec)
      setupInteractive :: forall flags (setupSpec :: SetupWrapperSpec).
RightFlagsForPhase flags setupSpec =>
CommandUI flags
-> (flags -> CommonSetupFlags)
-> (Version -> IO flags)
-> (Version -> [FilePath])
-> SetupRunnerArgs setupSpec
-> IO (SetupRunnerRes setupSpec)
setupInteractive =
        Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
-> (flags -> CommonSetupFlags)
-> (Version -> IO flags)
-> (Version -> [FilePath])
-> SetupRunnerArgs setupSpec
-> IO (SetupRunnerRes setupSpec)
forall (setupSpec :: SetupWrapperSpec) flags.
RightFlagsForPhase flags setupSpec =>
Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
-> (flags -> CommonSetupFlags)
-> (Version -> IO flags)
-> (Version -> [FilePath])
-> SetupRunnerArgs setupSpec
-> IO (SetupRunnerRes setupSpec)
setupWrapper
          Verbosity
verbosity
          SetupScriptOptions
scriptOptions{isInteractive = True}
          (PackageDescription -> Maybe PackageDescription
forall a. a -> Maybe a
Just (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
pkg))

      generateInstalledPackageInfo :: InLibraryLBI -> IO InstalledPackageInfo
      generateInstalledPackageInfo :: InLibraryLBI -> IO InstalledPackageInfo
generateInstalledPackageInfo InLibraryLBI
mbLBI =
        Verbosity
-> FilePath -> (FilePath -> IO ()) -> IO InstalledPackageInfo
withTempInstalledPackageInfoFile
          Verbosity
verbosity
          FilePath
distTempDirectory
          ((FilePath -> IO ()) -> IO InstalledPackageInfo)
-> (FilePath -> IO ()) -> IO InstalledPackageInfo
forall a b. (a -> b) -> a -> b
$ \FilePath
pkgConfDest -> do
            let registerFlags :: Version -> RegisterFlags
registerFlags Version
v =
                  (RegisterFlags -> Version -> RegisterFlags)
-> Version -> RegisterFlags -> RegisterFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip RegisterFlags -> Version -> RegisterFlags
filterRegisterFlags Version
v (RegisterFlags -> RegisterFlags) -> RegisterFlags -> RegisterFlags
forall a b. (a -> b) -> a -> b
$
                    ElaboratedConfiguredPackage
-> ElaboratedSharedConfig
-> CommonSetupFlags
-> FilePath
-> RegisterFlags
setupHsRegisterFlags
                      ElaboratedConfiguredPackage
pkg
                      ElaboratedSharedConfig
pkgshared
                      ([FilePath] -> CommonSetupFlags
commonFlags [])
                      FilePath
pkgConfDest
            CommandUI RegisterFlags
-> (RegisterFlags -> CommonSetupFlags)
-> (Version -> IO RegisterFlags)
-> (Version -> [FilePath])
-> SetupRunnerArgs ('TryInLibrary RegisterFlags)
-> IO (SetupRunnerRes ('TryInLibrary RegisterFlags))
forall flags (setupSpec :: SetupWrapperSpec).
(HasCallStack, RightFlagsForPhase flags setupSpec) =>
CommandUI flags
-> (flags -> CommonSetupFlags)
-> (Version -> IO flags)
-> (Version -> [FilePath])
-> SetupRunnerArgs setupSpec
-> IO (SetupRunnerRes setupSpec)
setup
              CommandUI RegisterFlags
Cabal.registerCommand
              RegisterFlags -> CommonSetupFlags
Cabal.registerCommonFlags
              (RegisterFlags -> IO RegisterFlags
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RegisterFlags -> IO RegisterFlags)
-> (Version -> RegisterFlags) -> Version -> IO RegisterFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> RegisterFlags
registerFlags)
              ([FilePath] -> Version -> [FilePath]
forall a b. a -> b -> a
const [])
              (InLibraryArgs RegisterFlags
-> SetupRunnerArgs ('TryInLibrary RegisterFlags)
forall flags.
InLibraryArgs flags -> SetupRunnerArgs ('TryInLibrary flags)
InLibraryArgs (InLibraryArgs RegisterFlags
 -> SetupRunnerArgs ('TryInLibrary RegisterFlags))
-> InLibraryArgs RegisterFlags
-> SetupRunnerArgs ('TryInLibrary RegisterFlags)
forall a b. (a -> b) -> a -> b
$ SPostConfigurePhase RegisterFlags
-> InLibraryLBI -> InLibraryArgs RegisterFlags
forall flags.
SPostConfigurePhase flags -> InLibraryLBI -> InLibraryArgs flags
InLibraryPostConfigureArgs SPostConfigurePhase RegisterFlags
SRegisterPhase InLibraryLBI
mbLBI)

      withLogging :: (Maybe Handle -> IO r) -> IO r
      withLogging :: forall r. (Maybe Handle -> IO r) -> IO r
withLogging Maybe Handle -> IO r
action =
        case Maybe FilePath
mlogFile of
          Maybe FilePath
Nothing -> Maybe Handle -> IO r
action Maybe Handle
forall a. Maybe a
Nothing
          Just FilePath
logFile -> FilePath -> IOMode -> (Handle -> IO r) -> IO r
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
logFile IOMode
AppendMode (Maybe Handle -> IO r
action (Maybe Handle -> IO r)
-> (Handle -> Maybe Handle) -> Handle -> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Maybe Handle
forall a. a -> Maybe a
Just)

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

-- * Build Inplace

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

buildInplaceUnpackedPackage
  :: Verbosity
  -> DistDirLayout
  -> Maybe SemaphoreIdentifier
  -> BuildTimeSettings
  -> Lock
  -> Lock
  -> ElaboratedSharedConfig
  -> ElaboratedInstallPlan
  -> ElaboratedReadyPackage
  -> TVar InstalledPackageIndex
  -> BuildStatusRebuild
  -> SymbolicPath CWD (Dir Pkg)
  -> SymbolicPath Pkg (Dir Dist)
  -> IO BuildResult
buildInplaceUnpackedPackage :: Verbosity
-> DistDirLayout
-> Maybe FilePath
-> BuildTimeSettings
-> Lock
-> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> TVar InstalledPackageIndex
-> BuildStatusRebuild
-> SymbolicPath CWD ('Dir Pkg)
-> SymbolicPath Pkg ('Dir Dist)
-> IO BuildResult
buildInplaceUnpackedPackage
  Verbosity
verbosity
  distDirLayout :: DistDirLayout
distDirLayout@DistDirLayout
    { DistDirParams -> FilePath
distPackageCacheDirectory :: DistDirParams -> FilePath
distPackageCacheDirectory :: DistDirLayout -> DistDirParams -> FilePath
distPackageCacheDirectory
    , FilePath
distDirectory :: FilePath
distDirectory :: DistDirLayout -> FilePath
distDirectory
    , Maybe FilePath
distHaddockOutputDir :: Maybe FilePath
distHaddockOutputDir :: DistDirLayout -> Maybe FilePath
distHaddockOutputDir
    }
  Maybe FilePath
maybe_semaphore
  buildSettings :: BuildTimeSettings
buildSettings@BuildTimeSettings{Bool
buildSettingHaddockOpen :: Bool
buildSettingHaddockOpen :: BuildTimeSettings -> Bool
buildSettingHaddockOpen}
  Lock
registerLock
  Lock
cacheLock
  pkgshared :: ElaboratedSharedConfig
pkgshared@ElaboratedSharedConfig{pkgConfigPlatform :: ElaboratedSharedConfig -> Platform
pkgConfigPlatform = Platform Arch
_ OS
os}
  ElaboratedInstallPlan
plan
  rpkg :: ElaboratedReadyPackage
rpkg@(ReadyPackage ElaboratedConfiguredPackage
pkg)
  TVar InstalledPackageIndex
ipiTVar
  BuildStatusRebuild
buildStatus
  SymbolicPath CWD ('Dir Pkg)
srcdir
  SymbolicPath Pkg ('Dir Dist)
builddir = do
    -- TODO: [code cleanup] there is duplication between the
    --      distdirlayout and the builddir here builddir is not
    --      enough, we also need the per-package cachedir
    Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg ('Dir Dist) -> FilePath
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> FilePath
interpretSymbolicPath (SymbolicPath CWD ('Dir Pkg) -> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a. a -> Maybe a
Just SymbolicPath CWD ('Dir Pkg)
srcdir) SymbolicPath Pkg ('Dir Dist)
builddir
    Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose
      Verbosity
verbosity
      Bool
True
      (DistDirParams -> FilePath
distPackageCacheDirectory DistDirParams
dparams)

    Verbosity
-> DistDirLayout
-> Maybe FilePath
-> BuildTimeSettings
-> Lock
-> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> TVar InstalledPackageIndex
-> SymbolicPath CWD ('Dir Pkg)
-> SymbolicPath Pkg ('Dir Dist)
-> Maybe FilePath
-> (forall r. PackageBuildingPhase r -> IO r)
-> IO ()
buildAndRegisterUnpackedPackage
      Verbosity
verbosity
      DistDirLayout
distDirLayout
      Maybe FilePath
maybe_semaphore
      BuildTimeSettings
buildSettings
      Lock
registerLock
      Lock
cacheLock
      ElaboratedSharedConfig
pkgshared
      ElaboratedInstallPlan
plan
      ElaboratedReadyPackage
rpkg
      TVar InstalledPackageIndex
ipiTVar
      SymbolicPath CWD ('Dir Pkg)
srcdir
      SymbolicPath Pkg ('Dir Dist)
builddir
      Maybe FilePath
forall a. Maybe a
Nothing -- no log file for inplace builds!
      ((forall r. PackageBuildingPhase r -> IO r) -> IO ())
-> (forall r. PackageBuildingPhase r -> IO r) -> IO ()
forall a b. (a -> b) -> a -> b
$ \case
        PBConfigurePhase{IO InLibraryLBI
runConfigure :: PackageBuildingPhase InLibraryLBI -> IO InLibraryLBI
runConfigure :: IO InLibraryLBI
runConfigure} ->
          IO InLibraryLBI -> IO InLibraryLBI
whenReconfigure (IO InLibraryLBI -> IO InLibraryLBI)
-> IO InLibraryLBI -> IO InLibraryLBI
forall a b. (a -> b) -> a -> b
$ do
            mbLBI <- IO InLibraryLBI
runConfigure
            invalidatePackageRegFileMonitor packageFileMonitor
            updatePackageConfigFileMonitor packageFileMonitor (getSymbolicPath srcdir) pkg
            return mbLBI
        PBBuildPhase{IO [MonitorFilePath]
runBuild :: PackageBuildingPhase () -> IO [MonitorFilePath]
runBuild :: IO [MonitorFilePath]
runBuild} ->
          IO () -> IO ()
whenRebuild (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO [MonitorFilePath] -> IO ()
withFileMonitor IO [MonitorFilePath]
runBuild
        PBReplPhase{IO [MonitorFilePath]
runRepl :: PackageBuildingPhase () -> IO [MonitorFilePath]
runRepl :: IO [MonitorFilePath]
runRepl} ->
          IO [MonitorFilePath] -> IO ()
withFileMonitor IO [MonitorFilePath]
runRepl
        PBHaddockPhase{IO [MonitorFilePath]
runHaddock :: PackageBuildingPhase () -> IO [MonitorFilePath]
runHaddock :: IO [MonitorFilePath]
runHaddock} -> do
          IO [MonitorFilePath] -> IO ()
withFileMonitor IO [MonitorFilePath]
runHaddock
          let haddockTarget :: HaddockTarget
haddockTarget = ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockForHackage ElaboratedConfiguredPackage
pkg
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HaddockTarget
haddockTarget HaddockTarget -> HaddockTarget -> Bool
forall a. Eq a => a -> a -> Bool
== HaddockTarget
Cabal.ForHackage) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            let dest :: FilePath
dest = FilePath
distDirectory FilePath -> FilePath -> FilePath
</> FilePath
name FilePath -> FilePath -> FilePath
<.> FilePath
"tar.gz"
                name :: FilePath
name = HaddockTarget -> PackageDescription -> FilePath
haddockDirName HaddockTarget
haddockTarget (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
pkg)
                docDir :: FilePath
docDir =
                  DistDirLayout -> DistDirParams -> FilePath
distBuildDirectory DistDirLayout
distDirLayout DistDirParams
dparams
                    FilePath -> FilePath -> FilePath
</> FilePath
"doc"
                    FilePath -> FilePath -> FilePath
</> FilePath
"html"
            FilePath -> FilePath -> FilePath -> IO ()
Tar.createTarGzFile FilePath
dest FilePath
docDir FilePath
name
            Verbosity -> FilePath -> IO ()
notice Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Documentation tarball created: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
dest

          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
buildSettingHaddockOpen Bool -> Bool -> Bool
&& HaddockTarget
haddockTarget HaddockTarget -> HaddockTarget -> Bool
forall a. Eq a => a -> a -> Bool
/= HaddockTarget
Cabal.ForHackage) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            let dest :: FilePath
dest = FilePath
docDir FilePath -> FilePath -> FilePath
</> FilePath
"index.html"
                name :: FilePath
name = HaddockTarget -> PackageDescription -> FilePath
haddockDirName HaddockTarget
haddockTarget (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
pkg)
                docDir :: FilePath
docDir = case Maybe FilePath
distHaddockOutputDir of
                  Maybe FilePath
Nothing -> DistDirLayout -> DistDirParams -> FilePath
distBuildDirectory DistDirLayout
distDirLayout DistDirParams
dparams FilePath -> FilePath -> FilePath
</> FilePath
"doc" FilePath -> FilePath -> FilePath
</> FilePath
"html" FilePath -> FilePath -> FilePath
</> FilePath
name
                  Just FilePath
dir -> FilePath
dir
            IO () -> (ErrorCall -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch
              (IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
openBrowser FilePath
dest)
              ( \(ErrorCall
_ :: ErrorCall) ->
                  Verbosity -> CabalInstallException -> IO ()
forall a1 a.
(HasCallStack, Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO ()) -> CabalInstallException -> IO ()
forall a b. (a -> b) -> a -> b
$
                    FilePath -> CabalInstallException
FindOpenProgramLocationErr (FilePath -> CabalInstallException)
-> FilePath -> CabalInstallException
forall a b. (a -> b) -> a -> b
$
                      FilePath
"Unsupported OS: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> OS -> FilePath
forall a. Show a => a -> FilePath
show OS
os
              )
        PBInstallPhase{runCopy :: PackageBuildingPhase () -> FilePath -> IO ()
runCopy = FilePath -> IO ()
_runCopy, PackageDBStackCWD -> RegisterOptions -> IO InstalledPackageInfo
runRegister :: PackageBuildingPhase ()
-> PackageDBStackCWD -> RegisterOptions -> IO InstalledPackageInfo
runRegister :: PackageDBStackCWD -> RegisterOptions -> IO InstalledPackageInfo
runRegister} -> do
          -- PURPOSELY omitted: no copy!

          IO () -> IO ()
whenReRegister (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            -- Register locally
            mipkg <-
              if ElaboratedConfiguredPackage -> Bool
elabRequiresRegistration ElaboratedConfiguredPackage
pkg
                then do
                  ipkg <-
                    PackageDBStackCWD -> RegisterOptions -> IO InstalledPackageInfo
runRegister
                      (ElaboratedConfiguredPackage -> PackageDBStackCWD
elabRegisterPackageDBStack ElaboratedConfiguredPackage
pkg)
                      RegisterOptions
Cabal.defaultRegisterOptions
                  -- Keep the per-project running InstalledPackageIndex up to date.
                  -- See (ProjIPI2) from Note [Per-project InstalledPackageIndex]
                  -- in Distribution.Client.ProjectBuilding.
                  atomically $ modifyTVar ipiTVar (PackageIndex.insert ipkg)
                  return (Just ipkg)
                else Maybe InstalledPackageInfo -> IO (Maybe InstalledPackageInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InstalledPackageInfo
forall a. Maybe a
Nothing

            updatePackageRegFileMonitor packageFileMonitor (getSymbolicPath srcdir) mipkg
        PBTestPhase{IO ()
runTest :: PackageBuildingPhase () -> IO ()
runTest :: IO ()
runTest} -> IO r
IO ()
runTest
        PBBenchPhase{IO ()
runBench :: PackageBuildingPhase () -> IO ()
runBench :: IO ()
runBench} -> IO r
IO ()
runBench

    BuildResult -> IO BuildResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
      BuildResult
        { buildResultDocs :: DocsResult
buildResultDocs = DocsResult
docsResult
        , buildResultTests :: TestsResult
buildResultTests = TestsResult
testsResult
        , buildResultLogFile :: Maybe FilePath
buildResultLogFile = Maybe FilePath
forall a. Maybe a
Nothing
        }
    where
      docsResult :: DocsResult
docsResult = DocsResult
DocsNotTried
      testsResult :: TestsResult
testsResult = TestsResult
TestsNotTried
      buildResult :: BuildResultMisc
      buildResult :: BuildResultMisc
buildResult = (DocsResult
docsResult, TestsResult
testsResult)

      dparams :: DistDirParams
dparams = ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> DistDirParams
elabDistDirParams ElaboratedSharedConfig
pkgshared ElaboratedConfiguredPackage
pkg

      packageFileMonitor :: PackageFileMonitor
packageFileMonitor = ElaboratedSharedConfig
-> DistDirLayout -> DistDirParams -> PackageFileMonitor
newPackageFileMonitor ElaboratedSharedConfig
pkgshared DistDirLayout
distDirLayout DistDirParams
dparams

      withFileMonitor :: IO [MonitorFilePath] -> IO ()
      withFileMonitor :: IO [MonitorFilePath] -> IO ()
withFileMonitor IO [MonitorFilePath]
runAction = do
        timestamp <- IO MonitorTimestamp
beginUpdateFileMonitor
        monitors' <-
          runAction
            -- Be sure to invalidate the cache if building throws an exception!
            -- If not, we'll abort execution with a stale recompilation cache.
            -- See ghc#24926 for an example of how this can go wrong.
            `onException` invalidatePackageRegFileMonitor packageFileMonitor
        let listSimple =
              FilePath -> Rebuild () -> IO [MonitorFilePath]
forall a. FilePath -> Rebuild a -> IO [MonitorFilePath]
execRebuild (SymbolicPath CWD ('Dir Pkg) -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath SymbolicPath CWD ('Dir Pkg)
srcdir) (ElaboratedConfiguredPackage -> Rebuild ()
needElaboratedConfiguredPackage ElaboratedConfiguredPackage
pkg)
            listSdist =
              ([FilePath] -> [MonitorFilePath])
-> IO [FilePath] -> IO [MonitorFilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath -> MonitorFilePath) -> [FilePath] -> [MonitorFilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> MonitorFilePath
monitorFileHashed) (IO [FilePath] -> IO [MonitorFilePath])
-> IO [FilePath] -> IO [MonitorFilePath]
forall a b. (a -> b) -> a -> b
$
                Verbosity -> FilePath -> IO [FilePath]
allPackageSourceFiles Verbosity
verbosity (SymbolicPath CWD ('Dir Pkg) -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath SymbolicPath CWD ('Dir Pkg)
srcdir)
            ifNullThen m (t a)
m m (t a)
m' = do
              xs <- m (t a)
m
              if null xs then m' else return xs
        monitors <- case PD.buildType (elabPkgDescription pkg) of
          BuildType
Simple -> IO [MonitorFilePath]
listSimple
          BuildType
Hooks -> IO [MonitorFilePath]
listSdist IO [MonitorFilePath]
-> IO [MonitorFilePath] -> IO [MonitorFilePath]
forall {m :: * -> *} {t :: * -> *} {a}.
(Monad m, Foldable t) =>
m (t a) -> m (t a) -> m (t a)
`ifNullThen` IO [MonitorFilePath]
listSimple
          BuildType
_
            | ElaboratedConfiguredPackage -> Version
elabSetupScriptCliVersion ElaboratedConfiguredPackage
pkg Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
1, Int
17] ->
                IO [MonitorFilePath]
listSdist IO [MonitorFilePath]
-> IO [MonitorFilePath] -> IO [MonitorFilePath]
forall {m :: * -> *} {t :: * -> *} {a}.
(Monad m, Foldable t) =>
m (t a) -> m (t a) -> m (t a)
`ifNullThen` IO [MonitorFilePath]
listSimple
            | Bool
otherwise ->
                IO [MonitorFilePath]
listSimple

        let dep_monitors =
              (FilePath -> MonitorFilePath) -> [FilePath] -> [MonitorFilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> MonitorFilePath
monitorFileHashed ([FilePath] -> [MonitorFilePath])
-> [FilePath] -> [MonitorFilePath]
forall a b. (a -> b) -> a -> b
$
                DistDirLayout
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedConfiguredPackage
-> [FilePath]
elabInplaceDependencyBuildCacheFiles
                  DistDirLayout
distDirLayout
                  ElaboratedSharedConfig
pkgshared
                  ElaboratedInstallPlan
plan
                  ElaboratedConfiguredPackage
pkg
        updatePackageBuildFileMonitor
          packageFileMonitor
          (getSymbolicPath srcdir)
          timestamp
          pkg
          buildStatus
          (monitors ++ monitors' ++ dep_monitors)
          buildResult

      whenReconfigure :: IO InLibraryLBI -> IO InLibraryLBI
      whenReconfigure :: IO InLibraryLBI -> IO InLibraryLBI
whenReconfigure IO InLibraryLBI
action =
        case BuildStatusRebuild
buildStatus of
          BuildStatusConfigure MonitorChangedReason ()
_ -> IO InLibraryLBI
action
          BuildStatusRebuild
_ -> do
            -- We are skipping reconfiguration, so we recover the
            -- 'LocalBuildInfo' persisted by the previous 'configure'.
            mbOldLBI <- Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg ('Dir Dist)
-> IO (Either ConfigStateFileError LocalBuildInfo)
Cabal.tryGetPersistBuildConfig (SymbolicPath CWD ('Dir Pkg) -> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a. a -> Maybe a
Just SymbolicPath CWD ('Dir Pkg)
srcdir) SymbolicPath Pkg ('Dir Dist)
builddir
            case mbOldLBI of
              -- #11942: if the previous LocalBuildInfo was written by an
              -- external Setup.hs with an incompatible Cabal library version,
              -- then we must continue to use the external setup method.
              Left Cabal.ConfigStateFileBadVersion{} -> InLibraryLBI -> IO InLibraryLBI
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InLibraryLBI
NotInLibraryNoLBI
              -- Other errors reflect genuine problems: re-throw them.
              Left ConfigStateFileError
err -> ConfigStateFileError -> IO InLibraryLBI
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO ConfigStateFileError
err
              Right LocalBuildInfo
lbi_wo_programs -> do
                -- Restore info about unconfigured programs, since it is not serialized
                -- TODO: copied from Distribution.Simple.getBuildConfig.
                let lbi :: LocalBuildInfo
lbi =
                      LocalBuildInfo
lbi_wo_programs
                        { Cabal.withPrograms =
                            restoreProgramDb
                              builtinPrograms
                              (Cabal.withPrograms lbi_wo_programs)
                        }
                InLibraryLBI -> IO InLibraryLBI
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (InLibraryLBI -> IO InLibraryLBI)
-> InLibraryLBI -> IO InLibraryLBI
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> InLibraryLBI
InLibraryLBI LocalBuildInfo
lbi

      whenRebuild, whenReRegister :: IO () -> IO ()
      whenRebuild :: IO () -> IO ()
whenRebuild IO ()
action
        | [ComponentTarget] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets ElaboratedConfiguredPackage
pkg)
        , -- NB: we have to build the test/bench suite!
          [ComponentTarget] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets ElaboratedConfiguredPackage
pkg)
        , [ComponentTarget] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets ElaboratedConfiguredPackage
pkg) =
            () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Bool
otherwise = IO ()
action

      whenReRegister :: IO () -> IO ()
whenReRegister IO ()
action =
        case BuildStatusRebuild
buildStatus of
          -- We registered the package already.
          -- No need to update ipiTVar: the InstalledPackageInfo for this package
          -- was picked up at startup.
          -- See Note [Per-project InstalledPackageIndex] in Distribution.Client.ProjectBuilding.
          BuildStatusBuild (Just Maybe InstalledPackageInfo
_) BuildReason
_ ->
            Verbosity -> FilePath -> IO ()
info Verbosity
verbosity FilePath
"whenReRegister: previously registered"
          -- There is nothing to register
          BuildStatusRebuild
_
            | [ComponentTarget] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets ElaboratedConfiguredPackage
pkg) ->
                Verbosity -> FilePath -> IO ()
info Verbosity
verbosity FilePath
"whenReRegister: nothing to register"
            | Bool
otherwise -> IO ()
action

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

-- * Build and Install

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

buildAndInstallUnpackedPackage
  :: Verbosity
  -> DistDirLayout
  -> StoreDirLayout
  -> Maybe SemaphoreIdentifier
  -- ^ Whether to pass a semaphore to build process
  -- this is different to BuildTimeSettings because the
  -- name of the semaphore is created freshly each time.
  -> BuildTimeSettings
  -> Lock
  -> Lock
  -> ElaboratedSharedConfig
  -> ElaboratedInstallPlan
  -> ElaboratedReadyPackage
  -> TVar InstalledPackageIndex
  -> SymbolicPath CWD (Dir Pkg)
  -> SymbolicPath Pkg (Dir Dist)
  -> IO BuildResult
buildAndInstallUnpackedPackage :: Verbosity
-> DistDirLayout
-> StoreDirLayout
-> Maybe FilePath
-> BuildTimeSettings
-> Lock
-> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> TVar InstalledPackageIndex
-> SymbolicPath CWD ('Dir Pkg)
-> SymbolicPath Pkg ('Dir Dist)
-> IO BuildResult
buildAndInstallUnpackedPackage
  Verbosity
verbosity
  DistDirLayout
distDirLayout
  storeDirLayout :: StoreDirLayout
storeDirLayout@StoreDirLayout
    { Compiler -> [Maybe PackageDBCWD] -> PackageDBStackCWD
storePackageDBStack :: Compiler -> [Maybe PackageDBCWD] -> PackageDBStackCWD
storePackageDBStack :: StoreDirLayout
-> Compiler -> [Maybe PackageDBCWD] -> PackageDBStackCWD
storePackageDBStack
    }
  Maybe FilePath
maybe_semaphore
  buildSettings :: BuildTimeSettings
buildSettings@BuildTimeSettings{ParStratInstall
buildSettingNumJobs :: ParStratInstall
buildSettingNumJobs :: BuildTimeSettings -> ParStratInstall
buildSettingNumJobs, Maybe
  (Compiler -> Platform -> PackageIdentifier -> UnitId -> FilePath)
buildSettingLogFile :: Maybe
  (Compiler -> Platform -> PackageIdentifier -> UnitId -> FilePath)
buildSettingLogFile :: BuildTimeSettings
-> Maybe
     (Compiler -> Platform -> PackageIdentifier -> UnitId -> FilePath)
buildSettingLogFile}
  Lock
registerLock
  Lock
cacheLock
  pkgshared :: ElaboratedSharedConfig
pkgshared@ElaboratedSharedConfig
    { pkgConfigCompiler :: ElaboratedSharedConfig -> Compiler
pkgConfigCompiler = Compiler
compiler
    , pkgConfigPlatform :: ElaboratedSharedConfig -> Platform
pkgConfigPlatform = Platform
platform
    }
  ElaboratedInstallPlan
plan
  rpkg :: ElaboratedReadyPackage
rpkg@(ReadyPackage ElaboratedConfiguredPackage
pkg)
  TVar InstalledPackageIndex
ipiTVar
  SymbolicPath CWD ('Dir Pkg)
srcdir
  SymbolicPath Pkg ('Dir Dist)
builddir = do
    Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True (Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg ('Dir Dist) -> FilePath
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> FilePath
interpretSymbolicPath (SymbolicPath CWD ('Dir Pkg) -> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a. a -> Maybe a
Just SymbolicPath CWD ('Dir Pkg)
srcdir) SymbolicPath Pkg ('Dir Dist)
builddir)

    -- TODO: [code cleanup] deal consistently with talking to older
    --      Setup.hs versions, much like we do for ghc, with a proper
    --      options type and rendering step which will also let us
    --      call directly into the lib, rather than always going via
    --      the lib's command line interface, which would also allow
    --      passing data like installed packages, compiler, and
    --      program db for a quicker configure.

    -- TODO: [required feature] docs and tests
    -- TODO: [required feature] sudo re-exec

    IO ()
initLogFile

    Verbosity
-> DistDirLayout
-> Maybe FilePath
-> BuildTimeSettings
-> Lock
-> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> TVar InstalledPackageIndex
-> SymbolicPath CWD ('Dir Pkg)
-> SymbolicPath Pkg ('Dir Dist)
-> Maybe FilePath
-> (forall r. PackageBuildingPhase r -> IO r)
-> IO ()
buildAndRegisterUnpackedPackage
      Verbosity
verbosity
      DistDirLayout
distDirLayout
      Maybe FilePath
maybe_semaphore
      BuildTimeSettings
buildSettings
      Lock
registerLock
      Lock
cacheLock
      ElaboratedSharedConfig
pkgshared
      ElaboratedInstallPlan
plan
      ElaboratedReadyPackage
rpkg
      TVar InstalledPackageIndex
ipiTVar
      SymbolicPath CWD ('Dir Pkg)
srcdir
      SymbolicPath Pkg ('Dir Dist)
builddir
      Maybe FilePath
mlogFile
      ((forall r. PackageBuildingPhase r -> IO r) -> IO ())
-> (forall r. PackageBuildingPhase r -> IO r) -> IO ()
forall a b. (a -> b) -> a -> b
$ \case
        PBConfigurePhase{IO InLibraryLBI
runConfigure :: PackageBuildingPhase InLibraryLBI -> IO InLibraryLBI
runConfigure :: IO InLibraryLBI
runConfigure} -> do
          ProgressPhase -> IO ()
noticeProgress ProgressPhase
ProgressStarting
          IO r
IO InLibraryLBI
runConfigure
        PBBuildPhase{IO [MonitorFilePath]
runBuild :: PackageBuildingPhase () -> IO [MonitorFilePath]
runBuild :: IO [MonitorFilePath]
runBuild} -> do
          ProgressPhase -> IO ()
noticeProgress ProgressPhase
ProgressBuilding
          _monitors <- IO [MonitorFilePath]
runBuild
          return ()
        PBHaddockPhase{IO [MonitorFilePath]
runHaddock :: PackageBuildingPhase () -> IO [MonitorFilePath]
runHaddock :: IO [MonitorFilePath]
runHaddock} -> do
          ProgressPhase -> IO ()
noticeProgress ProgressPhase
ProgressHaddock
          _monitors <- IO [MonitorFilePath]
runHaddock
          return ()
        PBInstallPhase{FilePath -> IO ()
runCopy :: PackageBuildingPhase () -> FilePath -> IO ()
runCopy :: FilePath -> IO ()
runCopy, PackageDBStackCWD -> RegisterOptions -> IO InstalledPackageInfo
runRegister :: PackageBuildingPhase ()
-> PackageDBStackCWD -> RegisterOptions -> IO InstalledPackageInfo
runRegister :: PackageDBStackCWD -> RegisterOptions -> IO InstalledPackageInfo
runRegister, IO InstalledPackageInfo
getInstalledPackageInfo :: PackageBuildingPhase () -> IO InstalledPackageInfo
getInstalledPackageInfo :: IO InstalledPackageInfo
getInstalledPackageInfo} -> do
          ProgressPhase -> IO ()
noticeProgress ProgressPhase
ProgressInstalling

          -- Create an IORef used to retrieve the InstalledPackageInfo computed
          -- by running "register".
          ipkgRef <- Maybe InstalledPackageInfo
-> IO (IORef (Maybe InstalledPackageInfo))
forall a. a -> IO (IORef a)
newIORef Maybe InstalledPackageInfo
forall a. Maybe a
Nothing

          let registerPkg
                | Bool -> Bool
not (ElaboratedConfiguredPackage -> Bool
elabRequiresRegistration ElaboratedConfiguredPackage
pkg) =
                    Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
                      FilePath
"registerPkg: elab does NOT require registration for "
                        FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ UnitId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow UnitId
uid
                | Bool
otherwise = do
                    Bool -> IO () -> IO ()
forall a. HasCallStack => Bool -> a -> a
assert
                      ( ElaboratedConfiguredPackage -> PackageDBStackCWD
elabRegisterPackageDBStack ElaboratedConfiguredPackage
pkg
                          PackageDBStackCWD -> PackageDBStackCWD -> Bool
forall a. Eq a => a -> a -> Bool
== Compiler -> [Maybe PackageDBCWD] -> PackageDBStackCWD
storePackageDBStack Compiler
compiler (ElaboratedConfiguredPackage -> [Maybe PackageDBCWD]
elabPackageDbs ElaboratedConfiguredPackage
pkg)
                      )
                      (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                    ipkg <-
                      PackageDBStackCWD -> RegisterOptions -> IO InstalledPackageInfo
runRegister
                        (ElaboratedConfiguredPackage -> PackageDBStackCWD
elabRegisterPackageDBStack ElaboratedConfiguredPackage
pkg)
                        RegisterOptions
Cabal.defaultRegisterOptions
                          { Cabal.registerMultiInstance = True
                          , Cabal.registerSuppressFilesCheck = True
                          }
                    -- Write the InstalledPackageInfo to the IORef
                    writeIORef ipkgRef (Just ipkg)

          -- Actual installation
          void $
            newStoreEntry
              verbosity
              storeDirLayout
              compiler
              uid
              (copyPkgFiles verbosity pkgshared pkg runCopy)
              registerPkg

          -- Keep the per-project running InstalledPackageIndex TVar up to date.
          -- This must run regardless of whether newStoreEntry won or lost the
          -- race (UseNewStoreEntry/UseExistingStoreEntry).
          --
          -- See (ProjIPI2) in Note [Per-project InstalledPackageIndex].
          when (elabRequiresRegistration pkg) $ do
            -- If we won the race, we use the InstalledPackageInfo that was
            -- computed by 'runRegister'. If we lost, then we fall back to
            -- 'getInstalledPackageInfo' which re-runs 'Cabal register'
            -- (takes ~100ms).
            mipkg <- readIORef ipkgRef
            ipkg <- maybe getInstalledPackageInfo return mipkg
            atomically $ modifyTVar ipiTVar (PackageIndex.insert ipkg)

        -- No tests on install
        PBTestPhase{} -> r -> IO r
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        -- No bench on install
        PBBenchPhase{} -> r -> IO r
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        -- No repl on install
        PBReplPhase{} -> r -> IO r
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    -- TODO: [nice to have] we currently rely on Setup.hs copy to do the right
    -- thing. Although we do copy into an image dir and do the move into the
    -- final location ourselves, perhaps we ought to do some sanity checks on
    -- the image dir first.

    -- TODO: [required eventually] note that for nix-style
    -- installations it is not necessary to do the
    -- 'withWin32SelfUpgrade' dance, but it would be necessary for a
    -- shared bin dir.

    -- TODO: [required feature] docs and test phases
    let docsResult :: DocsResult
docsResult = DocsResult
DocsNotTried
        testsResult :: TestsResult
testsResult = TestsResult
TestsNotTried

    ProgressPhase -> IO ()
noticeProgress ProgressPhase
ProgressCompleted

    BuildResult -> IO BuildResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
      BuildResult
        { buildResultDocs :: DocsResult
buildResultDocs = DocsResult
docsResult
        , buildResultTests :: TestsResult
buildResultTests = TestsResult
testsResult
        , buildResultLogFile :: Maybe FilePath
buildResultLogFile = Maybe FilePath
mlogFile
        }
    where
      uid :: UnitId
uid = ElaboratedReadyPackage -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedReadyPackage
rpkg
      pkgid :: PackageIdentifier
pkgid = ElaboratedReadyPackage -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ElaboratedReadyPackage
rpkg

      dispname :: String
      dispname :: FilePath
dispname = case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
pkg of
        -- Packages built altogether, instead of per component
        ElabPackage ElaboratedPackage{NonEmpty NotPerComponentReason
pkgWhyNotPerComponent :: NonEmpty NotPerComponentReason
pkgWhyNotPerComponent :: ElaboratedPackage -> NonEmpty NotPerComponentReason
pkgWhyNotPerComponent} ->
          PackageIdentifier -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow PackageIdentifier
pkgid
            FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" (all, legacy fallback: "
            FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords ((NotPerComponentReason -> FilePath)
-> [NotPerComponentReason] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map NotPerComponentReason -> FilePath
whyNotPerComponent ([NotPerComponentReason] -> [FilePath])
-> [NotPerComponentReason] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ NonEmpty NotPerComponentReason -> [NotPerComponentReason]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty NotPerComponentReason
pkgWhyNotPerComponent)
            FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")"
        -- Packages built per component
        ElabComponent ElaboratedComponent
comp ->
          PackageIdentifier -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow PackageIdentifier
pkgid
            FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" ("
            FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
-> (ComponentName -> FilePath) -> Maybe ComponentName -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"custom" ComponentName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (ElaboratedComponent -> Maybe ComponentName
compComponentName ElaboratedComponent
comp)
            FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")"

      noticeProgress :: ProgressPhase -> IO ()
      noticeProgress :: ProgressPhase -> IO ()
noticeProgress ProgressPhase
phase =
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ParStratInstall -> Bool
forall n. ParStratX n -> Bool
isParallelBuild ParStratInstall
buildSettingNumJobs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          Verbosity -> ProgressPhase -> FilePath -> IO ()
progressMessage Verbosity
verbosity ProgressPhase
phase FilePath
dispname

      mlogFile :: Maybe FilePath
      mlogFile :: Maybe FilePath
mlogFile =
        case Maybe
  (Compiler -> Platform -> PackageIdentifier -> UnitId -> FilePath)
buildSettingLogFile of
          Maybe
  (Compiler -> Platform -> PackageIdentifier -> UnitId -> FilePath)
Nothing -> Maybe FilePath
forall a. Maybe a
Nothing
          Just Compiler -> Platform -> PackageIdentifier -> UnitId -> FilePath
mkLogFile -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (Compiler -> Platform -> PackageIdentifier -> UnitId -> FilePath
mkLogFile Compiler
compiler Platform
platform PackageIdentifier
pkgid UnitId
uid)

      initLogFile :: IO ()
      initLogFile :: IO ()
initLogFile =
        case Maybe FilePath
mlogFile of
          Maybe FilePath
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just FilePath
logFile -> do
            Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> FilePath
takeDirectory FilePath
logFile)
            FilePath -> IO ()
removeFileForcibly FilePath
logFile

-- | The copy part of the installation phase when doing build-and-install
copyPkgFiles
  :: Verbosity
  -> ElaboratedSharedConfig
  -> ElaboratedConfiguredPackage
  -> (FilePath -> IO ())
  -- ^ The 'runCopy' function which invokes ./Setup copy for the
  -- given filepath
  -> FilePath
  -- ^ The temporary dir file path
  -> IO (FilePath, [FilePath])
copyPkgFiles :: Verbosity
-> ElaboratedSharedConfig
-> ElaboratedConfiguredPackage
-> (FilePath -> IO ())
-> FilePath
-> IO (FilePath, [FilePath])
copyPkgFiles Verbosity
verbosity ElaboratedSharedConfig
pkgshared ElaboratedConfiguredPackage
pkg FilePath -> IO ()
runCopy FilePath
tmpDir = do
  let tmpDirNormalised :: FilePath
tmpDirNormalised = FilePath -> FilePath
normalise FilePath
tmpDir
  FilePath -> IO ()
runCopy FilePath
tmpDirNormalised
  -- Note that the copy command has put the files into
  -- @$tmpDir/$prefix@ so we need to return this dir so
  -- the store knows which dir will be the final store entry.
  let prefix :: FilePath
prefix =
        FilePath -> FilePath
normalise (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$
          FilePath -> FilePath
dropDrive (InstallDirs FilePath -> FilePath
forall dir. InstallDirs dir -> dir
InstallDirs.prefix (ElaboratedConfiguredPackage -> InstallDirs FilePath
elabInstallDirs ElaboratedConfiguredPackage
pkg))
      entryDir :: FilePath
entryDir = FilePath
tmpDirNormalised FilePath -> FilePath -> FilePath
</> FilePath
prefix

  -- if there weren't anything to build, it might be that directory is not created
  -- the @setup Cabal.copyCommand@ above might do nothing.
  -- https://github.com/haskell/cabal/issues/4130
  Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
entryDir

  let hashFileName :: FilePath
hashFileName = FilePath
entryDir FilePath -> FilePath -> FilePath
</> FilePath
"cabal-hash.txt"
      outPkgHashInputs :: ByteString
outPkgHashInputs = PackageHashInputs -> ByteString
renderPackageHashInputs (ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> PackageHashInputs
packageHashInputs ElaboratedSharedConfig
pkgshared ElaboratedConfiguredPackage
pkg)

  Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
    FilePath
"creating file with the inputs used to compute the package hash: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
hashFileName

  FilePath -> ByteString -> IO ()
LBS.writeFile FilePath
hashFileName ByteString
outPkgHashInputs

  Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity FilePath
"Package hash inputs:"
  (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_
    (Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath -> IO ()) -> (FilePath -> FilePath) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
"> " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++))
    (FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
LBS.Char8.unpack ByteString
outPkgHashInputs)

  -- Ensure that there are no files in `tmpDir`, that are
  -- not in `entryDir`. While this breaks the
  -- prefix-relocatable property of the libraries, it is
  -- necessary on macOS to stay under the load command limit
  -- of the macOS mach-o linker. See also
  -- @PackageHash.hashedInstalledPackageIdVeryShort@.
  --
  -- We also normalise paths to ensure that there are no
  -- different representations for the same path. Like / and
  -- \\ on windows under msys.
  otherFiles <-
    (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
entryDir)
      ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
listFilesRecursive FilePath
tmpDirNormalised
  -- Here's where we could keep track of the installed files
  -- ourselves if we wanted to by making a manifest of the
  -- files in the tmp dir.
  return (entryDir, otherFiles)
  where
    listFilesRecursive :: FilePath -> IO [FilePath]
    listFilesRecursive :: FilePath -> IO [FilePath]
listFilesRecursive FilePath
path = do
      files <- (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath
path FilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
listDirectory FilePath
path
      allFiles <- for files $ \FilePath
file -> do
        isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
file
        if isDir
          then listFilesRecursive file
          else return [file]
      return (concat allFiles)

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

-- * Exported Utils

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

{- FOURMOLU_DISABLE -}
annotateFailureNoLog :: (SomeException -> BuildFailureReason)
                     -> IO a -> IO a
annotateFailureNoLog :: forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
annotate IO a
action =
  Maybe FilePath
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
forall a.
Maybe FilePath
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe FilePath
forall a. Maybe a
Nothing SomeException -> BuildFailureReason
annotate IO a
action

annotateFailure :: Maybe FilePath
                -> (SomeException -> BuildFailureReason)
                -> IO a -> IO a
annotateFailure :: forall a.
Maybe FilePath
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe FilePath
mlogFile SomeException -> BuildFailureReason
annotate IO a
action =
  IO a
action IO a -> [Handler a] -> IO a
forall a. IO a -> [Handler a] -> IO a
`catches`
    -- It's not just IOException and ExitCode we have to deal with, there's
    -- lots, including exceptions from the hackage-security and tar packages.
    -- So we take the strategy of catching everything except async exceptions.
    [
      (SomeAsyncException -> IO a) -> Handler a
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((SomeAsyncException -> IO a) -> Handler a)
-> (SomeAsyncException -> IO a) -> Handler a
forall a b. (a -> b) -> a -> b
$ \SomeAsyncException
async -> SomeAsyncException -> IO a
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (SomeAsyncException
async :: SomeAsyncException)
    , (SomeException -> IO a) -> Handler a
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((SomeException -> IO a) -> Handler a)
-> (SomeException -> IO a) -> Handler a
forall a b. (a -> b) -> a -> b
$ \SomeException
other -> SomeException -> IO a
forall e a. Exception e => e -> IO a
handler (SomeException
other :: SomeException)
    ]
  where
    handler :: Exception e => e -> IO a
    handler :: forall e a. Exception e => e -> IO a
handler = BuildFailure -> IO a
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (BuildFailure -> IO a) -> (e -> BuildFailure) -> e -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe FilePath -> BuildFailureReason -> BuildFailure
BuildFailure Maybe FilePath
mlogFile (BuildFailureReason -> BuildFailure)
-> (e -> BuildFailureReason) -> e -> BuildFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> BuildFailureReason
annotate (SomeException -> BuildFailureReason)
-> (e -> SomeException) -> e -> BuildFailureReason
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SomeException
forall e. Exception e => e -> SomeException
toException

--------------------------------------------------------------------------------
-- * Other Utils
--------------------------------------------------------------------------------

hasValidHaddockTargets :: ElaboratedConfiguredPackage -> Bool
hasValidHaddockTargets :: ElaboratedConfiguredPackage -> Bool
hasValidHaddockTargets ElaboratedConfiguredPackage{Bool
[FilePath]
[Maybe PackageDBCWD]
[PathTemplate]
[ConfiguredProgram]
PackageDBStackCWD
[ComponentTarget]
Maybe FilePath
Maybe PathTemplate
Maybe TestShowDetails
Maybe ByteString
Maybe PackageSourceHash
ModuleShape
InstallDirs FilePath
DumpBuildInfo
HaddockTarget
BuildOptions
Map FilePath FilePath
Map FilePath [FilePath]
Map ModuleName OpenModule
Map ModuleName Module
PackageDescription
ComponentId
UnitId
Version
PackageIdentifier
GenericPackageDescription
FlagAssignment
ComponentRequestedSpec
OptionalStanzaMap (Maybe Bool)
OptionalStanzaSet
PackageLocation (Maybe FilePath)
BuildStyle
ElaboratedPackageOrComponent
SetupScriptStyle
elabTestTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabPkgDescription :: ElaboratedConfiguredPackage -> PackageDescription
elabHaddockForHackage :: ElaboratedConfiguredPackage -> HaddockTarget
elabRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabSetupScriptCliVersion :: ElaboratedConfiguredPackage -> Version
elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabPackageDbs :: ElaboratedConfiguredPackage -> [Maybe PackageDBCWD]
elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs FilePath
elabUnitId :: UnitId
elabComponentId :: ComponentId
elabInstantiatedWith :: Map ModuleName Module
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabIsCanonical :: Bool
elabPkgSourceId :: PackageIdentifier
elabModuleShape :: ModuleShape
elabFlagAssignment :: FlagAssignment
elabFlagDefaults :: FlagAssignment
elabPkgDescription :: PackageDescription
elabGPkgDescription :: GenericPackageDescription
elabPkgSourceLocation :: PackageLocation (Maybe FilePath)
elabPkgSourceHash :: Maybe PackageSourceHash
elabLocalToProject :: Bool
elabBuildStyle :: BuildStyle
elabEnabledSpec :: ComponentRequestedSpec
elabStanzasAvailable :: OptionalStanzaSet
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabPackageDbs :: [Maybe PackageDBCWD]
elabSetupPackageDBStack :: PackageDBStackCWD
elabBuildPackageDBStack :: PackageDBStackCWD
elabRegisterPackageDBStack :: PackageDBStackCWD
elabInplaceSetupPackageDBStack :: PackageDBStackCWD
elabInplaceBuildPackageDBStack :: PackageDBStackCWD
elabInplaceRegisterPackageDBStack :: PackageDBStackCWD
elabPkgDescriptionOverride :: Maybe ByteString
elabBuildOptions :: BuildOptions
elabDumpBuildInfo :: DumpBuildInfo
elabProgramPaths :: Map FilePath FilePath
elabProgramArgs :: Map FilePath [FilePath]
elabProgramPathExtra :: [FilePath]
elabConfiguredPrograms :: [ConfiguredProgram]
elabConfigureScriptArgs :: [FilePath]
elabExtraLibDirs :: [FilePath]
elabExtraLibDirsStatic :: [FilePath]
elabExtraFrameworkDirs :: [FilePath]
elabExtraIncludeDirs :: [FilePath]
elabProgPrefix :: Maybe PathTemplate
elabProgSuffix :: Maybe PathTemplate
elabInstallDirs :: InstallDirs FilePath
elabHaddockHoogle :: Bool
elabHaddockHtml :: Bool
elabHaddockHtmlLocation :: Maybe FilePath
elabHaddockForeignLibs :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockExecutables :: Bool
elabHaddockTestSuites :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockInternal :: Bool
elabHaddockCss :: Maybe FilePath
elabHaddockLinkedSource :: Bool
elabHaddockQuickJump :: Bool
elabHaddockHscolourCss :: Maybe FilePath
elabHaddockContents :: Maybe PathTemplate
elabHaddockIndex :: Maybe PathTemplate
elabHaddockBaseUrl :: Maybe FilePath
elabHaddockResourcesDir :: Maybe FilePath
elabHaddockOutputDir :: Maybe FilePath
elabHaddockUseUnicode :: Bool
elabTestMachineLog :: Maybe PathTemplate
elabTestHumanLog :: Maybe PathTemplate
elabTestShowDetails :: Maybe TestShowDetails
elabTestKeepTix :: Bool
elabTestWrapper :: Maybe FilePath
elabTestFailWhenNoTestSuites :: Bool
elabTestTestOptions :: [PathTemplate]
elabBenchmarkOptions :: [PathTemplate]
elabSetupScriptStyle :: SetupScriptStyle
elabSetupScriptCliVersion :: Version
elabConfigureTargets :: [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
elabTestTargets :: [ComponentTarget]
elabBenchTargets :: [ComponentTarget]
elabReplTarget :: [ComponentTarget]
elabHaddockTargets :: [ComponentTarget]
elabBuildHaddocks :: Bool
elabPkgOrComp :: ElaboratedPackageOrComponent
elabBenchmarkOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
elabBuildOptions :: ElaboratedConfiguredPackage -> BuildOptions
elabBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabBuildStyle :: ElaboratedConfiguredPackage -> BuildStyle
elabComponentId :: ElaboratedConfiguredPackage -> ComponentId
elabConfigureScriptArgs :: ElaboratedConfiguredPackage -> [FilePath]
elabConfigureTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabConfiguredPrograms :: ElaboratedConfiguredPackage -> [ConfiguredProgram]
elabDumpBuildInfo :: ElaboratedConfiguredPackage -> DumpBuildInfo
elabEnabledSpec :: ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabExtraFrameworkDirs :: ElaboratedConfiguredPackage -> [FilePath]
elabExtraIncludeDirs :: ElaboratedConfiguredPackage -> [FilePath]
elabExtraLibDirs :: ElaboratedConfiguredPackage -> [FilePath]
elabExtraLibDirsStatic :: ElaboratedConfiguredPackage -> [FilePath]
elabFlagAssignment :: ElaboratedConfiguredPackage -> FlagAssignment
elabFlagDefaults :: ElaboratedConfiguredPackage -> FlagAssignment
elabGPkgDescription :: ElaboratedConfiguredPackage -> GenericPackageDescription
elabHaddockBaseUrl :: ElaboratedConfiguredPackage -> Maybe FilePath
elabHaddockBenchmarks :: ElaboratedConfiguredPackage -> Bool
elabHaddockContents :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockCss :: ElaboratedConfiguredPackage -> Maybe FilePath
elabHaddockExecutables :: ElaboratedConfiguredPackage -> Bool
elabHaddockForeignLibs :: ElaboratedConfiguredPackage -> Bool
elabHaddockHoogle :: ElaboratedConfiguredPackage -> Bool
elabHaddockHscolourCss :: ElaboratedConfiguredPackage -> Maybe FilePath
elabHaddockHtml :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtmlLocation :: ElaboratedConfiguredPackage -> Maybe FilePath
elabHaddockIndex :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockInternal :: ElaboratedConfiguredPackage -> Bool
elabHaddockLinkedSource :: ElaboratedConfiguredPackage -> Bool
elabHaddockOutputDir :: ElaboratedConfiguredPackage -> Maybe FilePath
elabHaddockQuickJump :: ElaboratedConfiguredPackage -> Bool
elabHaddockResourcesDir :: ElaboratedConfiguredPackage -> Maybe FilePath
elabHaddockTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabHaddockTestSuites :: ElaboratedConfiguredPackage -> Bool
elabHaddockUseUnicode :: ElaboratedConfiguredPackage -> Bool
elabInplaceBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName Module
elabIsCanonical :: ElaboratedConfiguredPackage -> Bool
elabLinkedInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabModuleShape :: ElaboratedConfiguredPackage -> ModuleShape
elabPkgDescriptionOverride :: ElaboratedConfiguredPackage -> Maybe ByteString
elabPkgSourceHash :: ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabPkgSourceId :: ElaboratedConfiguredPackage -> PackageIdentifier
elabPkgSourceLocation :: ElaboratedConfiguredPackage -> PackageLocation (Maybe FilePath)
elabProgPrefix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgSuffix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgramArgs :: ElaboratedConfiguredPackage -> Map FilePath [FilePath]
elabProgramPathExtra :: ElaboratedConfiguredPackage -> [FilePath]
elabProgramPaths :: ElaboratedConfiguredPackage -> Map FilePath FilePath
elabSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabSetupScriptStyle :: ElaboratedConfiguredPackage -> SetupScriptStyle
elabStanzasAvailable :: ElaboratedConfiguredPackage -> OptionalStanzaSet
elabStanzasRequested :: ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabTestFailWhenNoTestSuites :: ElaboratedConfiguredPackage -> Bool
elabTestHumanLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestKeepTix :: ElaboratedConfiguredPackage -> Bool
elabTestMachineLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestShowDetails :: ElaboratedConfiguredPackage -> Maybe TestShowDetails
elabTestTestOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabTestWrapper :: ElaboratedConfiguredPackage -> Maybe FilePath
elabUnitId :: ElaboratedConfiguredPackage -> UnitId
..}
  | Bool -> Bool
not Bool
elabBuildHaddocks = Bool
False
  | Bool
otherwise = (ComponentTarget -> Bool) -> [ComponentTarget] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ComponentTarget -> Bool
componentHasHaddocks [ComponentTarget]
components
  where
    components :: [ComponentTarget]
    components :: [ComponentTarget]
components =
      [ComponentTarget]
elabBuildTargets
        [ComponentTarget] -> [ComponentTarget] -> [ComponentTarget]
forall a. [a] -> [a] -> [a]
++ [ComponentTarget]
elabTestTargets
        [ComponentTarget] -> [ComponentTarget] -> [ComponentTarget]
forall a. [a] -> [a] -> [a]
++ [ComponentTarget]
elabBenchTargets
        [ComponentTarget] -> [ComponentTarget] -> [ComponentTarget]
forall a. [a] -> [a] -> [a]
++ [ComponentTarget]
elabReplTarget
        [ComponentTarget] -> [ComponentTarget] -> [ComponentTarget]
forall a. [a] -> [a] -> [a]
++ [ComponentTarget]
elabHaddockTargets

    componentHasHaddocks :: ComponentTarget -> Bool
    componentHasHaddocks :: ComponentTarget -> Bool
componentHasHaddocks (ComponentTarget ComponentName
name SubComponentTarget
_) =
      case ComponentName
name of
        CLibName LibraryName
LMainLibName -> Bool
hasHaddocks
        CLibName (LSubLibName UnqualComponentName
_) -> Bool
elabHaddockInternal Bool -> Bool -> Bool
&& Bool
hasHaddocks
        CFLibName UnqualComponentName
_ -> Bool
elabHaddockForeignLibs Bool -> Bool -> Bool
&& Bool
hasHaddocks
        CExeName UnqualComponentName
_ -> Bool
elabHaddockExecutables Bool -> Bool -> Bool
&& Bool
hasHaddocks
        CTestName UnqualComponentName
_ -> Bool
elabHaddockTestSuites Bool -> Bool -> Bool
&& Bool
hasHaddocks
        CBenchName UnqualComponentName
_ -> Bool
elabHaddockBenchmarks Bool -> Bool -> Bool
&& Bool
hasHaddocks
      where
        hasHaddocks :: Bool
hasHaddocks = Bool -> Bool
not ([ModuleName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PackageDescription
elabPkgDescription PackageDescription
-> Getting [ModuleName] PackageDescription [ModuleName]
-> [ModuleName]
forall s a. s -> Getting a s a -> a
^. ComponentName
-> Getting [ModuleName] PackageDescription [ModuleName]
forall r.
Monoid r =>
ComponentName -> Getting r PackageDescription [ModuleName]
componentModules ComponentName
name))

withTempInstalledPackageInfoFile
  :: Verbosity
  -> FilePath
  -> (FilePath -> IO ())
  -> IO InstalledPackageInfo
withTempInstalledPackageInfoFile :: Verbosity
-> FilePath -> (FilePath -> IO ()) -> IO InstalledPackageInfo
withTempInstalledPackageInfoFile Verbosity
verbosity FilePath
tempdir FilePath -> IO ()
action =
  FilePath
-> FilePath
-> (FilePath -> IO InstalledPackageInfo)
-> IO InstalledPackageInfo
forall a. FilePath -> FilePath -> (FilePath -> IO a) -> IO a
withTempDirectory FilePath
tempdir FilePath
"package-registration-" ((FilePath -> IO InstalledPackageInfo) -> IO InstalledPackageInfo)
-> (FilePath -> IO InstalledPackageInfo) -> IO InstalledPackageInfo
forall a b. (a -> b) -> a -> b
$ \FilePath
dir -> do
    -- make absolute since @action@ will often change directory
    abs_dir <- FilePath -> IO FilePath
canonicalizePath FilePath
dir

    let pkgConfDest = FilePath
abs_dir FilePath -> FilePath -> FilePath
</> FilePath
"pkgConf"
    action pkgConfDest

    readPkgConf "." pkgConfDest
  where
    pkgConfParseFailed :: String -> IO a
    pkgConfParseFailed :: forall a. FilePath -> IO a
pkgConfParseFailed FilePath
perror =
      Verbosity -> CabalInstallException -> IO a
forall a1 a.
(HasCallStack, Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO a) -> CabalInstallException -> IO a
forall a b. (a -> b) -> a -> b
$ FilePath -> CabalInstallException
PkgConfParseFailed FilePath
perror

    readPkgConf :: FilePath -> FilePath -> IO InstalledPackageInfo
    readPkgConf :: FilePath -> FilePath -> IO InstalledPackageInfo
readPkgConf FilePath
pkgConfDir FilePath
pkgConfFile = do
      pkgConfStr <- FilePath -> IO ByteString
BS.readFile (FilePath
pkgConfDir FilePath -> FilePath -> FilePath
</> FilePath
pkgConfFile)
      (warns, ipkg) <- case Installed.parseInstalledPackageInfo pkgConfStr of
        Left NonEmpty FilePath
perrors -> FilePath -> IO ([FilePath], InstalledPackageInfo)
forall a. FilePath -> IO a
pkgConfParseFailed (FilePath -> IO ([FilePath], InstalledPackageInfo))
-> FilePath -> IO ([FilePath], InstalledPackageInfo)
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ NonEmpty FilePath -> [FilePath]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty FilePath
perrors
        Right ([FilePath]
warns, InstalledPackageInfo
ipkg) -> ([FilePath], InstalledPackageInfo)
-> IO ([FilePath], InstalledPackageInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath]
warns, InstalledPackageInfo
ipkg)

      unless (null warns) $
        warn verbosity $
          unlines warns

      return ipkg