{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | 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
  , filterCommonFlags
  , filterConfigureFlags
  , filterHaddockArgs
  , filterHaddockFlags
  , 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.InstallDirs as InstallDirs
import Distribution.Simple.LocalBuildInfo
  ( ComponentName (..)
  , LibraryName (..)
  )
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.Simple.Utils
import Distribution.System (Platform (..))
import Distribution.Utils.Path hiding
  ( (<.>)
  , (</>)
  )
import Distribution.Version

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.Exception (ErrorCall, Handler (..), SomeAsyncException, assert, catches, onException)
import System.Directory (canonicalizePath, createDirectoryIfMissing, doesDirectoryExist, doesFileExist, removeFile)
import System.FilePath (dropDrive, normalise, takeDirectory, (<.>), (</>))
import System.IO (Handle, IOMode (AppendMode), withFile)
import System.Semaphore (SemaphoreName (..))

import Web.Browser (openBrowser)

import Distribution.Client.Errors
import Distribution.Compat.Directory (listDirectory)

import Distribution.Client.ProjectBuilding.PackageFileMonitor

-- | 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
  = PBConfigurePhase {PackageBuildingPhase -> IO ()
runConfigure :: IO ()}
  | PBBuildPhase {PackageBuildingPhase -> IO ()
runBuild :: IO ()}
  | PBHaddockPhase {PackageBuildingPhase -> IO ()
runHaddock :: IO ()}
  | PBInstallPhase
      { PackageBuildingPhase -> String -> IO ()
runCopy :: FilePath -> IO ()
      , PackageBuildingPhase
-> PackageDBStackCWD -> RegisterOptions -> IO InstalledPackageInfo
runRegister
          :: PackageDBStackCWD
          -> Cabal.RegisterOptions
          -> IO InstalledPackageInfo
      }
  | PBTestPhase {PackageBuildingPhase -> IO ()
runTest :: IO ()}
  | PBBenchPhase {PackageBuildingPhase -> IO ()
runBench :: IO ()}
  | PBReplPhase {PackageBuildingPhase -> IO ()
runRepl :: IO ()}

-- | 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 SemaphoreName
  -- ^ 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
  -> SymbolicPath CWD (Dir Pkg)
  -> SymbolicPath Pkg (Dir Dist)
  -> Maybe FilePath
  -- ^ The path to an /initialized/ log file
  -> (PackageBuildingPhase -> IO ())
  -> IO ()
buildAndRegisterUnpackedPackage :: Verbosity
-> DistDirLayout
-> Maybe SemaphoreName
-> BuildTimeSettings
-> Lock
-> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> SymbolicPath CWD ('Dir Pkg)
-> SymbolicPath Pkg ('Dir Dist)
-> Maybe String
-> (PackageBuildingPhase -> IO ())
-> IO ()
buildAndRegisterUnpackedPackage
  Verbosity
verbosity
  distDirLayout :: DistDirLayout
distDirLayout@DistDirLayout{String
distTempDirectory :: String
distTempDirectory :: DistDirLayout -> String
distTempDirectory}
  Maybe SemaphoreName
maybe_semaphore
  buildTimeSettings :: BuildTimeSettings
buildTimeSettings@BuildTimeSettings{ParStratInstall
buildSettingNumJobs :: ParStratInstall
buildSettingNumJobs :: BuildTimeSettings -> ParStratInstall
buildSettingNumJobs}
  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)
  SymbolicPath CWD ('Dir Pkg)
srcdir
  SymbolicPath Pkg ('Dir Dist)
builddir
  Maybe String
mlogFile
  PackageBuildingPhase -> IO ()
delegate = do
    -- Configure phase
    PackageBuildingPhase -> IO ()
delegate (PackageBuildingPhase -> IO ()) -> PackageBuildingPhase -> IO ()
forall a b. (a -> b) -> a -> b
$
      IO () -> PackageBuildingPhase
PBConfigurePhase (IO () -> PackageBuildingPhase) -> IO () -> PackageBuildingPhase
forall a b. (a -> b) -> a -> b
$
        Maybe String
-> (SomeException -> BuildFailureReason) -> IO () -> IO ()
forall a.
Maybe String
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe String
mlogFile SomeException -> BuildFailureReason
ConfigureFailed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          CommandUI ConfigFlags
-> (ConfigFlags -> CommonSetupFlags)
-> (Version -> IO ConfigFlags)
-> (Version -> [String])
-> IO ()
forall flags.
CommandUI flags
-> (flags -> CommonSetupFlags)
-> (Version -> IO flags)
-> (Version -> [String])
-> IO ()
setup CommandUI ConfigFlags
configureCommand ConfigFlags -> CommonSetupFlags
Cabal.configCommonFlags Version -> IO ConfigFlags
configureFlags Version -> [String]
forall {p}. p -> [String]
configureArgs

    -- Build phase
    PackageBuildingPhase -> IO ()
delegate (PackageBuildingPhase -> IO ()) -> PackageBuildingPhase -> IO ()
forall a b. (a -> b) -> a -> b
$
      IO () -> PackageBuildingPhase
PBBuildPhase (IO () -> PackageBuildingPhase) -> IO () -> PackageBuildingPhase
forall a b. (a -> b) -> a -> b
$
        Maybe String
-> (SomeException -> BuildFailureReason) -> IO () -> IO ()
forall a.
Maybe String
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe String
mlogFile SomeException -> BuildFailureReason
BuildFailed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          CommandUI BuildFlags
-> (BuildFlags -> CommonSetupFlags)
-> (Version -> IO BuildFlags)
-> (Version -> [String])
-> IO ()
forall flags.
CommandUI flags
-> (flags -> CommonSetupFlags)
-> (Version -> IO flags)
-> (Version -> [String])
-> IO ()
setup CommandUI BuildFlags
buildCommand BuildFlags -> CommonSetupFlags
Cabal.buildCommonFlags (BuildFlags -> IO BuildFlags
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildFlags -> IO BuildFlags)
-> (Version -> BuildFlags) -> Version -> IO BuildFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> BuildFlags
buildFlags) Version -> [String]
forall {p}. p -> [String]
buildArgs

    -- Haddock phase
    IO () -> IO ()
forall {m :: * -> *}. Monad m => m () -> m ()
whenHaddock (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      PackageBuildingPhase -> IO ()
delegate (PackageBuildingPhase -> IO ()) -> PackageBuildingPhase -> IO ()
forall a b. (a -> b) -> a -> b
$
        IO () -> PackageBuildingPhase
PBHaddockPhase (IO () -> PackageBuildingPhase) -> IO () -> PackageBuildingPhase
forall a b. (a -> b) -> a -> b
$
          Maybe String
-> (SomeException -> BuildFailureReason) -> IO () -> IO ()
forall a.
Maybe String
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe String
mlogFile SomeException -> BuildFailureReason
HaddocksFailed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            CommandUI HaddockFlags
-> (HaddockFlags -> CommonSetupFlags)
-> (Version -> IO HaddockFlags)
-> (Version -> [String])
-> IO ()
forall flags.
CommandUI flags
-> (flags -> CommonSetupFlags)
-> (Version -> IO flags)
-> (Version -> [String])
-> IO ()
setup CommandUI HaddockFlags
haddockCommand HaddockFlags -> CommonSetupFlags
Cabal.haddockCommonFlags (HaddockFlags -> IO HaddockFlags
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HaddockFlags -> IO HaddockFlags)
-> (Version -> HaddockFlags) -> Version -> IO HaddockFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> HaddockFlags
haddockFlags) Version -> [String]
haddockArgs

    -- Install phase
    PackageBuildingPhase -> IO ()
delegate (PackageBuildingPhase -> IO ()) -> PackageBuildingPhase -> IO ()
forall a b. (a -> b) -> a -> b
$
      PBInstallPhase
        { runCopy :: String -> IO ()
runCopy = \String
destdir ->
            Maybe String
-> (SomeException -> BuildFailureReason) -> IO () -> IO ()
forall a.
Maybe String
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe String
mlogFile SomeException -> BuildFailureReason
InstallFailed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
              CommandUI CopyFlags
-> (CopyFlags -> CommonSetupFlags)
-> (Version -> IO CopyFlags)
-> (Version -> [String])
-> IO ()
forall flags.
CommandUI flags
-> (flags -> CommonSetupFlags)
-> (Version -> IO flags)
-> (Version -> [String])
-> IO ()
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
. String -> Version -> CopyFlags
copyFlags String
destdir) Version -> [String]
forall {p}. p -> [String]
copyArgs
        , runRegister :: PackageDBStackCWD -> RegisterOptions -> IO InstalledPackageInfo
runRegister = \PackageDBStackCWD
pkgDBStack RegisterOptions
registerOpts ->
            Maybe String
-> (SomeException -> BuildFailureReason)
-> IO InstalledPackageInfo
-> IO InstalledPackageInfo
forall a.
Maybe String
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe String
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. We need to
              -- grab and modify the InstalledPackageInfo. We decide what
              -- the installed package id is, not the build system.
              InstalledPackageInfo
ipkg0 <- IO InstalledPackageInfo
generateInstalledPackageInfo
              let ipkg :: InstalledPackageInfo
ipkg = InstalledPackageInfo
ipkg0{Installed.installedUnitId = uid}
              Lock -> IO () -> IO ()
forall a. Lock -> IO a -> IO a
criticalSection Lock
registerLock (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                Verbosity
-> Compiler
-> ProgramDb
-> Maybe (SymbolicPath CWD ('Dir CWD))
-> PackageDBStackS CWD
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
forall from.
Verbosity
-> Compiler
-> ProgramDb
-> Maybe (SymbolicPath CWD ('Dir from))
-> PackageDBStackS from
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
Cabal.registerPackage
                  Verbosity
verbosity
                  Compiler
compiler
                  ProgramDb
progdb
                  Maybe (SymbolicPath CWD ('Dir CWD))
forall a. Maybe a
Nothing
                  (PackageDBStackCWD -> PackageDBStackS CWD
coercePackageDBStack PackageDBStackCWD
pkgDBStack)
                  InstalledPackageInfo
ipkg
                  RegisterOptions
registerOpts
              InstalledPackageInfo -> IO InstalledPackageInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InstalledPackageInfo
ipkg
        }

    -- Test phase
    IO () -> IO ()
forall {m :: * -> *}. Monad m => m () -> m ()
whenTest (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      PackageBuildingPhase -> IO ()
delegate (PackageBuildingPhase -> IO ()) -> PackageBuildingPhase -> IO ()
forall a b. (a -> b) -> a -> b
$
        IO () -> PackageBuildingPhase
PBTestPhase (IO () -> PackageBuildingPhase) -> IO () -> PackageBuildingPhase
forall a b. (a -> b) -> a -> b
$
          Maybe String
-> (SomeException -> BuildFailureReason) -> IO () -> IO ()
forall a.
Maybe String
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe String
mlogFile SomeException -> BuildFailureReason
TestsFailed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            CommandUI TestFlags
-> (TestFlags -> CommonSetupFlags)
-> (Version -> IO TestFlags)
-> (Version -> [String])
-> IO ()
forall flags.
CommandUI flags
-> (flags -> CommonSetupFlags)
-> (Version -> IO flags)
-> (Version -> [String])
-> IO ()
setup CommandUI TestFlags
testCommand TestFlags -> CommonSetupFlags
Cabal.testCommonFlags (TestFlags -> IO TestFlags
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestFlags -> IO TestFlags)
-> (Version -> TestFlags) -> Version -> IO TestFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> TestFlags
testFlags) Version -> [String]
forall {p}. p -> [String]
testArgs

    -- Bench phase
    IO () -> IO ()
forall {m :: * -> *}. Monad m => m () -> m ()
whenBench (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      PackageBuildingPhase -> IO ()
delegate (PackageBuildingPhase -> IO ()) -> PackageBuildingPhase -> IO ()
forall a b. (a -> b) -> a -> b
$
        IO () -> PackageBuildingPhase
PBBenchPhase (IO () -> PackageBuildingPhase) -> IO () -> PackageBuildingPhase
forall a b. (a -> b) -> a -> b
$
          Maybe String
-> (SomeException -> BuildFailureReason) -> IO () -> IO ()
forall a.
Maybe String
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe String
mlogFile SomeException -> BuildFailureReason
BenchFailed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            CommandUI BenchmarkFlags
-> (BenchmarkFlags -> CommonSetupFlags)
-> (Version -> IO BenchmarkFlags)
-> (Version -> [String])
-> IO ()
forall flags.
CommandUI flags
-> (flags -> CommonSetupFlags)
-> (Version -> IO flags)
-> (Version -> [String])
-> IO ()
setup CommandUI BenchmarkFlags
benchCommand BenchmarkFlags -> CommonSetupFlags
Cabal.benchmarkCommonFlags (BenchmarkFlags -> IO BenchmarkFlags
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BenchmarkFlags -> IO BenchmarkFlags)
-> (Version -> BenchmarkFlags) -> Version -> IO BenchmarkFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> BenchmarkFlags
benchFlags) Version -> [String]
forall {p}. p -> [String]
benchArgs

    -- Repl phase
    IO () -> IO ()
forall {m :: * -> *}. Monad m => m () -> m ()
whenRepl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      PackageBuildingPhase -> IO ()
delegate (PackageBuildingPhase -> IO ()) -> PackageBuildingPhase -> IO ()
forall a b. (a -> b) -> a -> b
$
        IO () -> PackageBuildingPhase
PBReplPhase (IO () -> PackageBuildingPhase) -> IO () -> PackageBuildingPhase
forall a b. (a -> b) -> a -> b
$
          Maybe String
-> (SomeException -> BuildFailureReason) -> IO () -> IO ()
forall a.
Maybe String
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe String
mlogFile SomeException -> BuildFailureReason
ReplFailed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            CommandUI ReplFlags
-> (ReplFlags -> CommonSetupFlags)
-> (Version -> ReplFlags)
-> (Version -> [String])
-> IO ()
forall flags.
CommandUI flags
-> (flags -> CommonSetupFlags)
-> (Version -> flags)
-> (Version -> [String])
-> IO ()
setupInteractive CommandUI ReplFlags
replCommand ReplFlags -> CommonSetupFlags
Cabal.replCommonFlags Version -> ReplFlags
replFlags Version -> [String]
forall {p}. p -> [String]
replArgs

    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    where
      uid :: UnitId
uid = ElaboratedReadyPackage -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedReadyPackage
rpkg

      comp_par_strat :: Flag String
comp_par_strat = case Maybe SemaphoreName
maybe_semaphore of
        Just SemaphoreName
sem_name -> String -> Flag String
forall a. a -> Flag a
Cabal.toFlag (SemaphoreName -> String
getSemaphoreName SemaphoreName
sem_name)
        Maybe SemaphoreName
_ -> Flag String
forall a. Flag a
Cabal.NoFlag

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

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

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

      whenHaddock :: m () -> m ()
whenHaddock m ()
action
        | ElaboratedConfiguredPackage -> Bool
hasValidHaddockTargets ElaboratedConfiguredPackage
pkg = m ()
action
        | Bool
otherwise = () -> m ()
forall a. a -> m 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 :: Version -> CommonSetupFlags
commonFlags Version
v =
        (CommonSetupFlags -> Version -> CommonSetupFlags)
-> Version -> CommonSetupFlags -> CommonSetupFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip CommonSetupFlags -> Version -> CommonSetupFlags
filterCommonFlags Version
v (CommonSetupFlags -> CommonSetupFlags)
-> CommonSetupFlags -> CommonSetupFlags
forall a b. (a -> b) -> a -> b
$
          Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg ('Dir Dist)
-> CommonSetupFlags
setupHsCommonFlags Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPath Pkg ('Dir Dist)
builddir

      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
<$> (String -> IO (SymbolicPath Pkg ('Dir PkgDB)))
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> ElaboratedSharedConfig
-> CommonSetupFlags
-> IO ConfigFlags
forall (m :: * -> *).
Monad m =>
(String -> m (SymbolicPath Pkg ('Dir PkgDB)))
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> ElaboratedSharedConfig
-> CommonSetupFlags
-> m ConfigFlags
setupHsConfigureFlags
            (\String
p -> String -> SymbolicPath Pkg ('Dir PkgDB)
forall from (to :: FileOrDir). String -> SymbolicPath from to
makeSymbolicPath (String -> SymbolicPath Pkg ('Dir PkgDB))
-> IO String -> IO (SymbolicPath Pkg ('Dir PkgDB))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
canonicalizePath String
p)
            ElaboratedInstallPlan
plan
            ElaboratedReadyPackage
rpkg
            ElaboratedSharedConfig
pkgshared
            (Version -> CommonSetupFlags
commonFlags Version
v)
      configureArgs :: p -> [String]
configureArgs p
_ = ElaboratedConfiguredPackage -> [String]
setupHsConfigureArgs ElaboratedConfiguredPackage
pkg

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

      copyFlags :: String -> Version -> CopyFlags
copyFlags String
destdir Version
v =
        ElaboratedConfiguredPackage
-> ElaboratedSharedConfig
-> CommonSetupFlags
-> String
-> CopyFlags
setupHsCopyFlags
          ElaboratedConfiguredPackage
pkg
          ElaboratedSharedConfig
pkgshared
          (Version -> CommonSetupFlags
commonFlags Version
v)
          String
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 :: p -> [String]
copyArgs = p -> [String]
forall {p}. p -> [String]
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
            (Version -> CommonSetupFlags
commonFlags Version
v)
      testArgs :: p -> [String]
testArgs p
_ = ElaboratedConfiguredPackage -> [String]
setupHsTestArgs ElaboratedConfiguredPackage
pkg

      benchCommand :: CommandUI BenchmarkFlags
benchCommand = CommandUI BenchmarkFlags
Cabal.benchmarkCommand
      benchFlags :: Version -> BenchmarkFlags
benchFlags Version
v =
        ElaboratedConfiguredPackage
-> ElaboratedSharedConfig -> CommonSetupFlags -> BenchmarkFlags
setupHsBenchFlags
          ElaboratedConfiguredPackage
pkg
          ElaboratedSharedConfig
pkgshared
          (Version -> CommonSetupFlags
commonFlags Version
v)
      benchArgs :: p -> [String]
benchArgs p
_ = ElaboratedConfiguredPackage -> [String]
setupHsBenchArgs ElaboratedConfiguredPackage
pkg

      replCommand :: CommandUI ReplFlags
replCommand = ProgramDb -> CommandUI ReplFlags
Cabal.replCommand ProgramDb
defaultProgramDb
      replFlags :: Version -> ReplFlags
replFlags Version
v =
        ElaboratedConfiguredPackage
-> ElaboratedSharedConfig -> CommonSetupFlags -> ReplFlags
setupHsReplFlags
          ElaboratedConfiguredPackage
pkg
          ElaboratedSharedConfig
pkgshared
          (Version -> CommonSetupFlags
commonFlags Version
v)
      replArgs :: p -> [String]
replArgs p
_ = ElaboratedConfiguredPackage -> [String]
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
            (Version -> CommonSetupFlags
commonFlags Version
v)
      haddockArgs :: Version -> [String]
haddockArgs Version
v =
        ([String] -> Version -> [String])
-> Version -> [String] -> [String]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [String] -> Version -> [String]
filterHaddockArgs Version
v ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
          ElaboratedConfiguredPackage -> [String]
setupHsHaddockArgs ElaboratedConfiguredPackage
pkg

      scriptOptions :: SetupScriptOptions
scriptOptions =
        ElaboratedReadyPackage
-> ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> DistDirLayout
-> SymbolicPath CWD ('Dir Pkg)
-> SymbolicPath Pkg ('Dir Dist)
-> Bool
-> Lock
-> SetupScriptOptions
setupHsScriptOptions
          ElaboratedReadyPackage
rpkg
          ElaboratedInstallPlan
plan
          ElaboratedSharedConfig
pkgshared
          DistDirLayout
distDirLayout
          SymbolicPath CWD ('Dir Pkg)
srcdir
          SymbolicPath Pkg ('Dir Dist)
builddir
          (ParStratInstall -> Bool
forall n. ParStratX n -> Bool
isParallelBuild ParStratInstall
buildSettingNumJobs)
          Lock
cacheLock

      setup
        :: CommandUI flags
        -> (flags -> CommonSetupFlags)
        -> (Version -> IO flags)
        -> (Version -> [String])
        -> IO ()
      setup :: forall flags.
CommandUI flags
-> (flags -> CommonSetupFlags)
-> (Version -> IO flags)
-> (Version -> [String])
-> IO ()
setup CommandUI flags
cmd flags -> CommonSetupFlags
getCommonFlags Version -> IO flags
flags Version -> [String]
args =
        (Maybe Handle -> IO ()) -> IO ()
forall r. (Maybe Handle -> IO r) -> IO r
withLogging ((Maybe Handle -> IO ()) -> IO ())
-> (Maybe Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Maybe Handle
mLogFileHandle -> do
          Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
-> (flags -> CommonSetupFlags)
-> (Version -> IO flags)
-> (Version -> [String])
-> IO ()
forall flags.
Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
-> (flags -> CommonSetupFlags)
-> (Version -> IO flags)
-> (Version -> [String])
-> IO ()
setupWrapper
            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 -> [String]
args

      setupInteractive
        :: CommandUI flags
        -> (flags -> CommonSetupFlags)
        -> (Version -> flags)
        -> (Version -> [String])
        -> IO ()
      setupInteractive :: forall flags.
CommandUI flags
-> (flags -> CommonSetupFlags)
-> (Version -> flags)
-> (Version -> [String])
-> IO ()
setupInteractive CommandUI flags
cmd flags -> CommonSetupFlags
getCommonFlags Version -> flags
flags Version -> [String]
args =
        Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
-> (flags -> CommonSetupFlags)
-> (Version -> IO flags)
-> (Version -> [String])
-> IO ()
forall flags.
Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
-> (flags -> CommonSetupFlags)
-> (Version -> IO flags)
-> (Version -> [String])
-> IO ()
setupWrapper
          Verbosity
verbosity
          SetupScriptOptions
scriptOptions{isInteractive = True}
          (PackageDescription -> Maybe PackageDescription
forall a. a -> Maybe a
Just (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
pkg))
          CommandUI flags
cmd
          flags -> CommonSetupFlags
getCommonFlags
          (\Version
v -> flags -> IO flags
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Version -> flags
flags Version
v))
          Version -> [String]
args

      generateInstalledPackageInfo :: IO InstalledPackageInfo
      generateInstalledPackageInfo :: IO InstalledPackageInfo
generateInstalledPackageInfo =
        Verbosity -> String -> (String -> IO ()) -> IO InstalledPackageInfo
withTempInstalledPackageInfoFile
          Verbosity
verbosity
          String
distTempDirectory
          ((String -> IO ()) -> IO InstalledPackageInfo)
-> (String -> IO ()) -> IO InstalledPackageInfo
forall a b. (a -> b) -> a -> b
$ \String
pkgConfDest -> do
            let registerFlags :: Version -> RegisterFlags
registerFlags Version
v =
                  ElaboratedConfiguredPackage
-> ElaboratedSharedConfig
-> CommonSetupFlags
-> String
-> RegisterFlags
setupHsRegisterFlags
                    ElaboratedConfiguredPackage
pkg
                    ElaboratedSharedConfig
pkgshared
                    (Version -> CommonSetupFlags
commonFlags Version
v)
                    String
pkgConfDest
            CommandUI RegisterFlags
-> (RegisterFlags -> CommonSetupFlags)
-> (Version -> IO RegisterFlags)
-> (Version -> [String])
-> IO ()
forall flags.
CommandUI flags
-> (flags -> CommonSetupFlags)
-> (Version -> IO flags)
-> (Version -> [String])
-> IO ()
setup (CommandUI RegisterFlags
Cabal.registerCommand) RegisterFlags -> CommonSetupFlags
Cabal.registerCommonFlags (\Version
v -> RegisterFlags -> IO RegisterFlags
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Version -> RegisterFlags
registerFlags Version
v)) ([String] -> Version -> [String]
forall a b. a -> b -> a
const [])

      withLogging :: (Maybe Handle -> IO r) -> IO r
      withLogging :: forall r. (Maybe Handle -> IO r) -> IO r
withLogging Maybe Handle -> IO r
action =
        case Maybe String
mlogFile of
          Maybe String
Nothing -> Maybe Handle -> IO r
action Maybe Handle
forall a. Maybe a
Nothing
          Just String
logFile -> String -> IOMode -> (Handle -> IO r) -> IO r
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
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 SemaphoreName
  -> BuildTimeSettings
  -> Lock
  -> Lock
  -> ElaboratedSharedConfig
  -> ElaboratedInstallPlan
  -> ElaboratedReadyPackage
  -> BuildStatusRebuild
  -> SymbolicPath CWD (Dir Pkg)
  -> SymbolicPath Pkg (Dir Dist)
  -> IO BuildResult
buildInplaceUnpackedPackage :: Verbosity
-> DistDirLayout
-> Maybe SemaphoreName
-> BuildTimeSettings
-> Lock
-> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> BuildStatusRebuild
-> SymbolicPath CWD ('Dir Pkg)
-> SymbolicPath Pkg ('Dir Dist)
-> IO BuildResult
buildInplaceUnpackedPackage
  Verbosity
verbosity
  distDirLayout :: DistDirLayout
distDirLayout@DistDirLayout
    { DistDirParams -> String
distPackageCacheDirectory :: DistDirParams -> String
distPackageCacheDirectory :: DistDirLayout -> DistDirParams -> String
distPackageCacheDirectory
    , String
distDirectory :: String
distDirectory :: DistDirLayout -> String
distDirectory
    , Maybe String
distHaddockOutputDir :: Maybe String
distHaddockOutputDir :: DistDirLayout -> Maybe String
distHaddockOutputDir
    }
  Maybe SemaphoreName
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)
  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 -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg ('Dir Dist) -> String
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> String
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 -> String -> IO ()
createDirectoryIfMissingVerbose
      Verbosity
verbosity
      Bool
True
      (DistDirParams -> String
distPackageCacheDirectory DistDirParams
dparams)

    let docsResult :: DocsResult
docsResult = DocsResult
DocsNotTried
        testsResult :: TestsResult
testsResult = TestsResult
TestsNotTried

        buildResult :: BuildResultMisc
        buildResult :: BuildResultMisc
buildResult = (DocsResult
docsResult, TestsResult
testsResult)

    Verbosity
-> DistDirLayout
-> Maybe SemaphoreName
-> BuildTimeSettings
-> Lock
-> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> SymbolicPath CWD ('Dir Pkg)
-> SymbolicPath Pkg ('Dir Dist)
-> Maybe String
-> (PackageBuildingPhase -> IO ())
-> IO ()
buildAndRegisterUnpackedPackage
      Verbosity
verbosity
      DistDirLayout
distDirLayout
      Maybe SemaphoreName
maybe_semaphore
      BuildTimeSettings
buildSettings
      Lock
registerLock
      Lock
cacheLock
      ElaboratedSharedConfig
pkgshared
      ElaboratedInstallPlan
plan
      ElaboratedReadyPackage
rpkg
      SymbolicPath CWD ('Dir Pkg)
srcdir
      SymbolicPath Pkg ('Dir Dist)
builddir
      Maybe String
forall a. Maybe a
Nothing -- no log file for inplace builds!
      ((PackageBuildingPhase -> IO ()) -> IO ())
-> (PackageBuildingPhase -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \case
        PBConfigurePhase{IO ()
runConfigure :: PackageBuildingPhase -> IO ()
runConfigure :: IO ()
runConfigure} -> do
          IO () -> IO ()
forall {m :: * -> *}. Monad m => m () -> m ()
whenReConfigure (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            IO ()
runConfigure
            PackageFileMonitor -> IO ()
invalidatePackageRegFileMonitor PackageFileMonitor
packageFileMonitor
            PackageFileMonitor
-> String -> ElaboratedConfiguredPackage -> IO ()
updatePackageConfigFileMonitor PackageFileMonitor
packageFileMonitor (SymbolicPath CWD ('Dir Pkg) -> String
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> String
getSymbolicPath SymbolicPath CWD ('Dir Pkg)
srcdir) ElaboratedConfiguredPackage
pkg
        PBBuildPhase{IO ()
runBuild :: PackageBuildingPhase -> IO ()
runBuild :: IO ()
runBuild} -> do
          IO () -> IO ()
forall {m :: * -> *}. Monad m => m () -> m ()
whenRebuild (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            MonitorTimestamp
timestamp <- IO MonitorTimestamp
beginUpdateFileMonitor
            IO ()
runBuild
              -- 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.
              IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`onException` PackageFileMonitor -> IO ()
invalidatePackageRegFileMonitor PackageFileMonitor
packageFileMonitor

            let listSimple :: IO [MonitorFilePath]
listSimple =
                  String -> Rebuild () -> IO [MonitorFilePath]
forall a. String -> Rebuild a -> IO [MonitorFilePath]
execRebuild (SymbolicPath CWD ('Dir Pkg) -> String
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> String
getSymbolicPath SymbolicPath CWD ('Dir Pkg)
srcdir) (ElaboratedConfiguredPackage -> Rebuild ()
needElaboratedConfiguredPackage ElaboratedConfiguredPackage
pkg)
                listSdist :: IO [MonitorFilePath]
listSdist =
                  ([String] -> [MonitorFilePath])
-> IO [String] -> IO [MonitorFilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> MonitorFilePath) -> [String] -> [MonitorFilePath]
forall a b. (a -> b) -> [a] -> [b]
map String -> MonitorFilePath
monitorFileHashed) (IO [String] -> IO [MonitorFilePath])
-> IO [String] -> IO [MonitorFilePath]
forall a b. (a -> b) -> a -> b
$
                    Verbosity -> String -> IO [String]
allPackageSourceFiles Verbosity
verbosity (SymbolicPath CWD ('Dir Pkg) -> String
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> String
getSymbolicPath SymbolicPath CWD ('Dir Pkg)
srcdir)
                ifNullThen :: m (t a) -> m (t a) -> m (t a)
ifNullThen m (t a)
m m (t a)
m' = do
                  t a
xs <- m (t a)
m
                  if t a -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
xs then m (t a)
m' else t a -> m (t a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return t a
xs
            [MonitorFilePath]
monitors <- case PackageDescription -> BuildType
PD.buildType (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
pkg) of
              BuildType
Simple -> IO [MonitorFilePath]
listSimple
              -- If a Custom setup was used, AND the Cabal is recent
              -- enough to have sdist --list-sources, use that to
              -- determine the files that we need to track.  This can
              -- cause unnecessary rebuilding (for example, if README
              -- is edited, we will try to rebuild) but there isn't
              -- a more accurate Custom interface we can use to get
              -- this info.  We prefer not to use listSimple here
              -- as it can miss extra source files that are considered
              -- by the Custom setup.
              BuildType
_
                | ElaboratedConfiguredPackage -> Version
elabSetupScriptCliVersion ElaboratedConfiguredPackage
pkg Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
1, Int
17] ->
                    -- However, sometimes sdist --list-sources will fail
                    -- and return an empty list.  In that case, fall
                    -- back on the (inaccurate) simple tracking.
                    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 :: [MonitorFilePath]
dep_monitors =
                  (String -> MonitorFilePath) -> [String] -> [MonitorFilePath]
forall a b. (a -> b) -> [a] -> [b]
map String -> MonitorFilePath
monitorFileHashed ([String] -> [MonitorFilePath]) -> [String] -> [MonitorFilePath]
forall a b. (a -> b) -> a -> b
$
                    DistDirLayout
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedConfiguredPackage
-> [String]
elabInplaceDependencyBuildCacheFiles
                      DistDirLayout
distDirLayout
                      ElaboratedSharedConfig
pkgshared
                      ElaboratedInstallPlan
plan
                      ElaboratedConfiguredPackage
pkg
            PackageFileMonitor
-> String
-> MonitorTimestamp
-> ElaboratedConfiguredPackage
-> BuildStatusRebuild
-> [MonitorFilePath]
-> BuildResultMisc
-> IO ()
updatePackageBuildFileMonitor
              PackageFileMonitor
packageFileMonitor
              (SymbolicPath CWD ('Dir Pkg) -> String
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> String
getSymbolicPath SymbolicPath CWD ('Dir Pkg)
srcdir)
              MonitorTimestamp
timestamp
              ElaboratedConfiguredPackage
pkg
              BuildStatusRebuild
buildStatus
              ([MonitorFilePath]
monitors [MonitorFilePath] -> [MonitorFilePath] -> [MonitorFilePath]
forall a. [a] -> [a] -> [a]
++ [MonitorFilePath]
dep_monitors)
              BuildResultMisc
buildResult
        PBHaddockPhase{IO ()
runHaddock :: PackageBuildingPhase -> IO ()
runHaddock :: IO ()
runHaddock} -> do
          IO ()
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 :: String
dest = String
distDirectory String -> String -> String
</> String
name String -> String -> String
<.> String
"tar.gz"
                name :: String
name = HaddockTarget -> PackageDescription -> String
haddockDirName HaddockTarget
haddockTarget (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
pkg)
                docDir :: String
docDir =
                  DistDirLayout -> DistDirParams -> String
distBuildDirectory DistDirLayout
distDirLayout DistDirParams
dparams
                    String -> String -> String
</> String
"doc"
                    String -> String -> String
</> String
"html"
            String -> String -> String -> IO ()
Tar.createTarGzFile String
dest String
docDir String
name
            Verbosity -> String -> IO ()
notice Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Documentation tarball created: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
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 :: String
dest = String
docDir String -> String -> String
</> String
"index.html"
                name :: String
name = HaddockTarget -> PackageDescription -> String
haddockDirName HaddockTarget
haddockTarget (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
pkg)
                docDir :: String
docDir = case Maybe String
distHaddockOutputDir of
                  Maybe String
Nothing -> DistDirLayout -> DistDirParams -> String
distBuildDirectory DistDirLayout
distDirLayout DistDirParams
dparams String -> String -> String
</> String
"doc" String -> String -> String
</> String
"html" String -> String -> String
</> String
name
                  Just String
dir -> String
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
$ String -> IO Bool
openBrowser String
dest)
              ( \(ErrorCall
_ :: ErrorCall) ->
                  Verbosity -> CabalInstallException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO ()) -> CabalInstallException -> IO ()
forall a b. (a -> b) -> a -> b
$
                    String -> CabalInstallException
FindOpenProgramLocationErr (String -> CabalInstallException)
-> String -> CabalInstallException
forall a b. (a -> b) -> a -> b
$
                      String
"Unsupported OS: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> OS -> String
forall a. Show a => a -> String
show OS
os
              )
        PBInstallPhase{runCopy :: PackageBuildingPhase -> String -> IO ()
runCopy = String -> 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
            Maybe InstalledPackageInfo
mipkg <-
              if ElaboratedConfiguredPackage -> Bool
elabRequiresRegistration ElaboratedConfiguredPackage
pkg
                then do
                  InstalledPackageInfo
ipkg <-
                    PackageDBStackCWD -> RegisterOptions -> IO InstalledPackageInfo
runRegister
                      (ElaboratedConfiguredPackage -> PackageDBStackCWD
elabRegisterPackageDBStack ElaboratedConfiguredPackage
pkg)
                      RegisterOptions
Cabal.defaultRegisterOptions
                  Maybe InstalledPackageInfo -> IO (Maybe InstalledPackageInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (InstalledPackageInfo -> Maybe InstalledPackageInfo
forall a. a -> Maybe a
Just InstalledPackageInfo
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

            PackageFileMonitor -> String -> Maybe InstalledPackageInfo -> IO ()
updatePackageRegFileMonitor PackageFileMonitor
packageFileMonitor (SymbolicPath CWD ('Dir Pkg) -> String
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> String
getSymbolicPath SymbolicPath CWD ('Dir Pkg)
srcdir) Maybe InstalledPackageInfo
mipkg
        PBTestPhase{IO ()
runTest :: PackageBuildingPhase -> IO ()
runTest :: IO ()
runTest} -> IO ()
runTest
        PBBenchPhase{IO ()
runBench :: PackageBuildingPhase -> IO ()
runBench :: IO ()
runBench} -> IO ()
runBench
        PBReplPhase{IO ()
runRepl :: PackageBuildingPhase -> IO ()
runRepl :: IO ()
runRepl} -> IO ()
runRepl

    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 String
buildResultLogFile = Maybe String
forall a. Maybe a
Nothing
        }
    where
      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

      whenReConfigure :: m () -> m ()
whenReConfigure m ()
action = case BuildStatusRebuild
buildStatus of
        BuildStatusConfigure MonitorChangedReason ()
_ -> m ()
action
        BuildStatusRebuild
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

      whenRebuild :: m () -> m ()
whenRebuild m ()
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) =
            () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Bool
otherwise = m ()
action

      whenReRegister :: IO () -> IO ()
whenReRegister IO ()
action =
        case BuildStatusRebuild
buildStatus of
          -- We registered the package already
          BuildStatusBuild (Just Maybe InstalledPackageInfo
_) BuildReason
_ ->
            Verbosity -> String -> IO ()
info Verbosity
verbosity String
"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 -> String -> IO ()
info Verbosity
verbosity String
"whenReRegister: nothing to register"
            | Bool
otherwise -> IO ()
action

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

-- * Build and Install

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

buildAndInstallUnpackedPackage
  :: Verbosity
  -> DistDirLayout
  -> StoreDirLayout
  -> Maybe SemaphoreName
  -- ^ 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
  -> SymbolicPath CWD (Dir Pkg)
  -> SymbolicPath Pkg (Dir Dist)
  -> IO BuildResult
buildAndInstallUnpackedPackage :: Verbosity
-> DistDirLayout
-> StoreDirLayout
-> Maybe SemaphoreName
-> BuildTimeSettings
-> Lock
-> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> 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 SemaphoreName
maybe_semaphore
  buildSettings :: BuildTimeSettings
buildSettings@BuildTimeSettings{ParStratInstall
buildSettingNumJobs :: BuildTimeSettings -> ParStratInstall
buildSettingNumJobs :: ParStratInstall
buildSettingNumJobs, Maybe
  (Compiler -> Platform -> PackageIdentifier -> UnitId -> String)
buildSettingLogFile :: Maybe
  (Compiler -> Platform -> PackageIdentifier -> UnitId -> String)
buildSettingLogFile :: BuildTimeSettings
-> Maybe
     (Compiler -> Platform -> PackageIdentifier -> UnitId -> String)
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)
  SymbolicPath CWD ('Dir Pkg)
srcdir
  SymbolicPath Pkg ('Dir Dist)
builddir = do
    Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True (Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg ('Dir Dist) -> String
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> String
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 SemaphoreName
-> BuildTimeSettings
-> Lock
-> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> SymbolicPath CWD ('Dir Pkg)
-> SymbolicPath Pkg ('Dir Dist)
-> Maybe String
-> (PackageBuildingPhase -> IO ())
-> IO ()
buildAndRegisterUnpackedPackage
      Verbosity
verbosity
      DistDirLayout
distDirLayout
      Maybe SemaphoreName
maybe_semaphore
      BuildTimeSettings
buildSettings
      Lock
registerLock
      Lock
cacheLock
      ElaboratedSharedConfig
pkgshared
      ElaboratedInstallPlan
plan
      ElaboratedReadyPackage
rpkg
      SymbolicPath CWD ('Dir Pkg)
srcdir
      SymbolicPath Pkg ('Dir Dist)
builddir
      Maybe String
mlogFile
      ((PackageBuildingPhase -> IO ()) -> IO ())
-> (PackageBuildingPhase -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \case
        PBConfigurePhase{IO ()
runConfigure :: PackageBuildingPhase -> IO ()
runConfigure :: IO ()
runConfigure} -> do
          ProgressPhase -> IO ()
noticeProgress ProgressPhase
ProgressStarting
          IO ()
runConfigure
        PBBuildPhase{IO ()
runBuild :: PackageBuildingPhase -> IO ()
runBuild :: IO ()
runBuild} -> do
          ProgressPhase -> IO ()
noticeProgress ProgressPhase
ProgressBuilding
          IO ()
runBuild
        PBHaddockPhase{IO ()
runHaddock :: PackageBuildingPhase -> IO ()
runHaddock :: IO ()
runHaddock} -> do
          ProgressPhase -> IO ()
noticeProgress ProgressPhase
ProgressHaddock
          IO ()
runHaddock
        PBInstallPhase{String -> IO ()
runCopy :: PackageBuildingPhase -> String -> IO ()
runCopy :: String -> IO ()
runCopy, PackageDBStackCWD -> RegisterOptions -> IO InstalledPackageInfo
runRegister :: PackageBuildingPhase
-> PackageDBStackCWD -> RegisterOptions -> IO InstalledPackageInfo
runRegister :: PackageDBStackCWD -> RegisterOptions -> IO InstalledPackageInfo
runRegister} -> do
          ProgressPhase -> IO ()
noticeProgress ProgressPhase
ProgressInstalling

          let registerPkg :: IO ()
registerPkg
                | Bool -> Bool
not (ElaboratedConfiguredPackage -> Bool
elabRequiresRegistration ElaboratedConfiguredPackage
pkg) =
                    Verbosity -> String -> IO ()
debug Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
                      String
"registerPkg: elab does NOT require registration for "
                        String -> String -> String
forall a. [a] -> [a] -> [a]
++ UnitId -> String
forall a. Pretty a => a -> String
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 ())
                    InstalledPackageInfo
_ <-
                      PackageDBStackCWD -> RegisterOptions -> IO InstalledPackageInfo
runRegister
                        (ElaboratedConfiguredPackage -> PackageDBStackCWD
elabRegisterPackageDBStack ElaboratedConfiguredPackage
pkg)
                        RegisterOptions
Cabal.defaultRegisterOptions
                          { Cabal.registerMultiInstance = True
                          , Cabal.registerSuppressFilesCheck = True
                          }
                    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

          -- Actual installation
          IO NewStoreEntryOutcome -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO NewStoreEntryOutcome -> IO ())
-> IO NewStoreEntryOutcome -> IO ()
forall a b. (a -> b) -> a -> b
$
            Verbosity
-> StoreDirLayout
-> Compiler
-> UnitId
-> (String -> IO (String, [String]))
-> IO ()
-> IO NewStoreEntryOutcome
newStoreEntry
              Verbosity
verbosity
              StoreDirLayout
storeDirLayout
              Compiler
compiler
              UnitId
uid
              (Verbosity
-> ElaboratedSharedConfig
-> ElaboratedConfiguredPackage
-> (String -> IO ())
-> String
-> IO (String, [String])
copyPkgFiles Verbosity
verbosity ElaboratedSharedConfig
pkgshared ElaboratedConfiguredPackage
pkg String -> IO ()
runCopy)
              IO ()
registerPkg

        -- No tests on install
        PBTestPhase{} -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        -- No bench on install
        PBBenchPhase{} -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        -- No repl on install
        PBReplPhase{} -> () -> IO ()
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 String
buildResultLogFile = Maybe String
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 :: String
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 -> String
forall a. Pretty a => a -> String
prettyShow PackageIdentifier
pkgid
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (all, legacy fallback: "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords ((NotPerComponentReason -> String)
-> [NotPerComponentReason] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map NotPerComponentReason -> String
whyNotPerComponent ([NotPerComponentReason] -> [String])
-> [NotPerComponentReason] -> [String]
forall a b. (a -> b) -> a -> b
$ NonEmpty NotPerComponentReason -> [NotPerComponentReason]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty NotPerComponentReason
pkgWhyNotPerComponent)
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
        -- Packages built per component
        ElabComponent ElaboratedComponent
comp ->
          PackageIdentifier -> String
forall a. Pretty a => a -> String
prettyShow PackageIdentifier
pkgid
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ("
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
-> (ComponentName -> String) -> Maybe ComponentName -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"custom" ComponentName -> String
forall a. Pretty a => a -> String
prettyShow (ElaboratedComponent -> Maybe ComponentName
compComponentName ElaboratedComponent
comp)
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

      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 -> String -> IO ()
progressMessage Verbosity
verbosity ProgressPhase
phase String
dispname

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

      initLogFile :: IO ()
      initLogFile :: IO ()
initLogFile =
        case Maybe String
mlogFile of
          Maybe String
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just String
logFile -> do
            Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> String
takeDirectory String
logFile)
            Bool
exists <- String -> IO Bool
doesFileExist String
logFile
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeFile String
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
-> (String -> IO ())
-> String
-> IO (String, [String])
copyPkgFiles Verbosity
verbosity ElaboratedSharedConfig
pkgshared ElaboratedConfiguredPackage
pkg String -> IO ()
runCopy String
tmpDir = do
  let tmpDirNormalised :: String
tmpDirNormalised = String -> String
normalise String
tmpDir
  String -> IO ()
runCopy String
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 :: String
prefix =
        String -> String
normalise (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
          String -> String
dropDrive (InstallDirs String -> String
forall dir. InstallDirs dir -> dir
InstallDirs.prefix (ElaboratedConfiguredPackage -> InstallDirs String
elabInstallDirs ElaboratedConfiguredPackage
pkg))
      entryDir :: String
entryDir = String
tmpDirNormalised String -> String -> String
</> String
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 -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True String
entryDir

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

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

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

  Verbosity -> String -> IO ()
debug Verbosity
verbosity String
"Package hash inputs:"
  (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_
    (Verbosity -> String -> IO ()
debug Verbosity
verbosity (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"> " String -> String -> String
forall a. [a] -> [a] -> [a]
++))
    (String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ ByteString -> String
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.
  [String]
otherFiles <-
    (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
entryDir)
      ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
listFilesRecursive String
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.
  (String, [String]) -> IO (String, [String])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
entryDir, [String]
otherFiles)
  where
    listFilesRecursive :: FilePath -> IO [FilePath]
    listFilesRecursive :: String -> IO [String]
listFilesRecursive String
path = do
      [String]
files <- (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
path String -> String -> String
</>) ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO [String]
listDirectory String
path)
      [[String]]
allFiles <- [String] -> (String -> IO [String]) -> IO [[String]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [String]
files ((String -> IO [String]) -> IO [[String]])
-> (String -> IO [String]) -> IO [[String]]
forall a b. (a -> b) -> a -> b
$ \String
file -> do
        Bool
isDir <- String -> IO Bool
doesDirectoryExist String
file
        if Bool
isDir
          then String -> IO [String]
listFilesRecursive String
file
          else [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [String
file]
      [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
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 String
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
forall a.
Maybe String
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe String
forall a. Maybe a
Nothing SomeException -> BuildFailureReason
annotate IO a
action

annotateFailure :: Maybe FilePath
                -> (SomeException -> BuildFailureReason)
                -> IO a -> IO a
annotateFailure :: forall a.
Maybe String
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe String
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.
    [
#if MIN_VERSION_base(4,7,0)
      (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. Exception e => e -> IO a
throwIO (SomeAsyncException
async :: SomeAsyncException)
#else
      Handler $ \async -> throwIO (async :: AsyncException)
#endif
    , (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. 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 String -> BuildFailureReason -> BuildFailure
BuildFailure Maybe String
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
[String]
[Maybe PackageDBCWD]
[PathTemplate]
PackageDBStackCWD
[ComponentTarget]
Maybe String
Maybe PathTemplate
Maybe TestShowDetails
Maybe ByteString
Maybe PackageSourceHash
Version
ModuleShape
InstallDirs String
DumpBuildInfo
HaddockTarget
BuildOptions
Map String String
Map String [String]
Map ModuleName OpenModule
Map ModuleName Module
PackageDescription
ComponentId
UnitId
PackageIdentifier
FlagAssignment
ComponentRequestedSpec
OptionalStanzaMap (Maybe Bool)
OptionalStanzaSet
PackageLocation (Maybe String)
SetupScriptStyle
BuildStyle
ElaboratedPackageOrComponent
elabTestTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabPkgDescription :: ElaboratedConfiguredPackage -> PackageDescription
elabSetupScriptCliVersion :: ElaboratedConfiguredPackage -> Version
elabHaddockForHackage :: ElaboratedConfiguredPackage -> HaddockTarget
elabRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabPackageDbs :: ElaboratedConfiguredPackage -> [Maybe PackageDBCWD]
elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs String
elabUnitId :: UnitId
elabComponentId :: ComponentId
elabInstantiatedWith :: Map ModuleName Module
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabIsCanonical :: Bool
elabPkgSourceId :: PackageIdentifier
elabModuleShape :: ModuleShape
elabFlagAssignment :: FlagAssignment
elabFlagDefaults :: FlagAssignment
elabPkgDescription :: PackageDescription
elabPkgSourceLocation :: PackageLocation (Maybe String)
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 String String
elabProgramArgs :: Map String [String]
elabProgramPathExtra :: [String]
elabConfigureScriptArgs :: [String]
elabExtraLibDirs :: [String]
elabExtraLibDirsStatic :: [String]
elabExtraFrameworkDirs :: [String]
elabExtraIncludeDirs :: [String]
elabProgPrefix :: Maybe PathTemplate
elabProgSuffix :: Maybe PathTemplate
elabInstallDirs :: InstallDirs String
elabHaddockHoogle :: Bool
elabHaddockHtml :: Bool
elabHaddockHtmlLocation :: Maybe String
elabHaddockForeignLibs :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockExecutables :: Bool
elabHaddockTestSuites :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockInternal :: Bool
elabHaddockCss :: Maybe String
elabHaddockLinkedSource :: Bool
elabHaddockQuickJump :: Bool
elabHaddockHscolourCss :: Maybe String
elabHaddockContents :: Maybe PathTemplate
elabHaddockIndex :: Maybe PathTemplate
elabHaddockBaseUrl :: Maybe String
elabHaddockResourcesDir :: Maybe String
elabHaddockOutputDir :: Maybe String
elabHaddockUseUnicode :: Bool
elabTestMachineLog :: Maybe PathTemplate
elabTestHumanLog :: Maybe PathTemplate
elabTestShowDetails :: Maybe TestShowDetails
elabTestKeepTix :: Bool
elabTestWrapper :: Maybe String
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
elabUnitId :: ElaboratedConfiguredPackage -> UnitId
elabComponentId :: ElaboratedConfiguredPackage -> ComponentId
elabInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName Module
elabLinkedInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabIsCanonical :: ElaboratedConfiguredPackage -> Bool
elabPkgSourceId :: ElaboratedConfiguredPackage -> PackageIdentifier
elabModuleShape :: ElaboratedConfiguredPackage -> ModuleShape
elabFlagAssignment :: ElaboratedConfiguredPackage -> FlagAssignment
elabFlagDefaults :: ElaboratedConfiguredPackage -> FlagAssignment
elabPkgSourceLocation :: ElaboratedConfiguredPackage -> PackageLocation (Maybe String)
elabPkgSourceHash :: ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabBuildStyle :: ElaboratedConfiguredPackage -> BuildStyle
elabEnabledSpec :: ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabStanzasAvailable :: ElaboratedConfiguredPackage -> OptionalStanzaSet
elabStanzasRequested :: ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabPkgDescriptionOverride :: ElaboratedConfiguredPackage -> Maybe ByteString
elabBuildOptions :: ElaboratedConfiguredPackage -> BuildOptions
elabDumpBuildInfo :: ElaboratedConfiguredPackage -> DumpBuildInfo
elabProgramPaths :: ElaboratedConfiguredPackage -> Map String String
elabProgramArgs :: ElaboratedConfiguredPackage -> Map String [String]
elabProgramPathExtra :: ElaboratedConfiguredPackage -> [String]
elabConfigureScriptArgs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirsStatic :: ElaboratedConfiguredPackage -> [String]
elabExtraFrameworkDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraIncludeDirs :: ElaboratedConfiguredPackage -> [String]
elabProgPrefix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgSuffix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockHoogle :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtml :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtmlLocation :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockForeignLibs :: ElaboratedConfiguredPackage -> Bool
elabHaddockExecutables :: ElaboratedConfiguredPackage -> Bool
elabHaddockTestSuites :: ElaboratedConfiguredPackage -> Bool
elabHaddockBenchmarks :: ElaboratedConfiguredPackage -> Bool
elabHaddockInternal :: ElaboratedConfiguredPackage -> Bool
elabHaddockCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockLinkedSource :: ElaboratedConfiguredPackage -> Bool
elabHaddockQuickJump :: ElaboratedConfiguredPackage -> Bool
elabHaddockHscolourCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockContents :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockIndex :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockBaseUrl :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockResourcesDir :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockOutputDir :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockUseUnicode :: ElaboratedConfiguredPackage -> Bool
elabTestMachineLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestHumanLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestShowDetails :: ElaboratedConfiguredPackage -> Maybe TestShowDetails
elabTestKeepTix :: ElaboratedConfiguredPackage -> Bool
elabTestWrapper :: ElaboratedConfiguredPackage -> Maybe String
elabTestFailWhenNoTestSuites :: ElaboratedConfiguredPackage -> Bool
elabTestTestOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabBenchmarkOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabSetupScriptStyle :: ElaboratedConfiguredPackage -> SetupScriptStyle
elabConfigureTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabHaddockTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
..}
  | 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 -> String -> (String -> IO ()) -> IO InstalledPackageInfo
withTempInstalledPackageInfoFile Verbosity
verbosity String
tempdir String -> IO ()
action =
  Verbosity
-> String
-> String
-> (String -> IO InstalledPackageInfo)
-> IO InstalledPackageInfo
forall a. Verbosity -> String -> String -> (String -> IO a) -> IO a
withTempDirectory Verbosity
verbosity String
tempdir String
"package-registration-" ((String -> IO InstalledPackageInfo) -> IO InstalledPackageInfo)
-> (String -> IO InstalledPackageInfo) -> IO InstalledPackageInfo
forall a b. (a -> b) -> a -> b
$ \String
dir -> do
    -- make absolute since @action@ will often change directory
    String
abs_dir <- String -> IO String
canonicalizePath String
dir

    let pkgConfDest :: String
pkgConfDest = String
abs_dir String -> String -> String
</> String
"pkgConf"
    String -> IO ()
action String
pkgConfDest

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

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

      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
warns) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Verbosity -> String -> IO ()
warn Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
          [String] -> String
unlines [String]
warns

      InstalledPackageInfo -> IO InstalledPackageInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InstalledPackageInfo
ipkg