SetupWrapper.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{- FOURMOLU_DISABLE -}

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

-- |
-- Module      :  Distribution.Client.SetupWrapper
-- Copyright   :  (c) The University of Glasgow 2006,
--                    Duncan Coutts 2008
--
-- Maintainer  :  cabal-devel@haskell.org
-- Stability   :  alpha
-- Portability :  portable
--
-- An interface to building and installing Cabal packages.
-- If the @Built-Type@ field is specified as something other than
-- 'Custom', and the current version of Cabal is acceptable, this performs
-- setup actions directly.  Otherwise it builds the setup script and
-- runs it with the given arguments.
module Distribution.Client.SetupWrapper
  ( getSetup
  , runSetup
  , runSetupCommand
  , setupWrapper
  , SetupScriptOptions (..)
  , defaultSetupScriptOptions
  ) where

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

import qualified Distribution.Backpack as Backpack
import Distribution.CabalSpecVersion (cabalSpecMinimumLibraryVersion)
import qualified Distribution.Make as Make
import Distribution.Package
  ( ComponentId
  , PackageId
  , PackageIdentifier (..)
  , mkPackageName
  , newSimpleUnitId
  , packageName
  , packageVersion
  , unsafeMkDefUnitId
  )
import Distribution.PackageDescription
  ( BuildType (..)
  , GenericPackageDescription (packageDescription)
  , PackageDescription (..)
  , buildType
  , specVersion
  )
import qualified Distribution.Simple as Simple
import Distribution.Simple.Build.Macros
  ( generatePackageVersionMacros
  )
import Distribution.Simple.BuildPaths
  ( defaultDistPref
  , exeExtension
  )
import Distribution.Simple.Compiler
import Distribution.Simple.Configure
  ( configCompilerEx
  )
import Distribution.Simple.PackageDescription
  ( readGenericPackageDescription
  )
import Distribution.Simple.PreProcess
  ( ppUnlit
  , runSimplePreProcessor
  )
import Distribution.Simple.Program
  ( ProgramDb
  , emptyProgramDb
  , getDbProgramOutputCwd
  , getProgramSearchPath
  , ghcProgram
  , ghcjsProgram
  , runDbProgramCwd
  )
import Distribution.Simple.Program.Db
  ( configureAllKnownPrograms
  , prependProgramSearchPath
  , progOverrideEnv
  )
import Distribution.Simple.Program.Find
  ( programSearchPathAsPATHVar
  )
import Distribution.Simple.Program.Run
  ( getEffectiveEnvironment
  )
import qualified Distribution.Simple.Program.Strip as Strip
import Distribution.Types.ModuleRenaming (defaultRenaming)
import Distribution.Version
  ( Version
  , VersionRange
  , anyVersion
  , intersectVersionRanges
  , mkVersion
  , orLaterVersion
  , versionNumbers
  , withinRange
  )

import Distribution.Client.Config
  ( defaultCacheDir
  )
import Distribution.Client.IndexUtils
  ( getInstalledPackages
  )
import Distribution.Client.JobControl
  ( Lock
  , criticalSection
  )
import Distribution.Client.Types
import Distribution.Client.Utils
  ( existsAndIsMoreRecentThan
  , makeRelativeToDirS
#ifdef mingw32_HOST_OS
  , canonicalizePathNoThrow
#endif
  , moreRecentFile
  , tryCanonicalizePath
  , withEnv
  , withEnvOverrides
  , withExtraPathEnv
  )
import Distribution.Utils.Path
  hiding ( (</>), (<.>) )
import qualified Distribution.Utils.Path as Cabal.Path
import qualified Distribution.InstalledPackageInfo as IPI
import Distribution.Simple.Command
  ( CommandUI (..)
  , commandShowOptions
  )
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.Program.GHC
  ( GhcMode (..)
  , GhcOptions (..)
  , renderGhcOptions
  )
import Distribution.Simple.Setup
  ( CommonSetupFlags (..)
  , Flag (..)
  , GlobalFlags (..)
  , globalCommand
  )
import Distribution.Simple.Utils
  ( cabalVersion
  , copyFileVerbose
  , createDirectoryIfMissingVerbose
  , debug
  , die'
  , dieWithException
  , info
  , infoNoWrap
  , installExecutableFile
  , maybeExit
  , rawSystemProc
  , rewriteFileEx
  , rewriteFileLBS
  , tryFindPackageDesc
  )
import Distribution.Utils.Generic
  ( safeHead
  )

import Distribution.Compat.Stack
import Distribution.ReadE
import Distribution.System (Platform (..), buildPlatform)
import Distribution.Utils.NubList
  ( toNubListR
  )
import Distribution.Verbosity

import Data.List (foldl1')
import qualified Data.Map.Lazy as Map
import Distribution.Client.Compat.ExecutablePath (getExecutablePath)
import Distribution.Compat.Process (proc)
import System.Directory (doesFileExist)
import System.FilePath ((<.>), (</>))
import System.IO (Handle, hPutStr)
import System.Process (StdStream (..))
import qualified System.Process as Process

import qualified Data.ByteString.Lazy as BS
import Distribution.Client.Errors

#ifdef mingw32_HOST_OS
import Distribution.Simple.Utils
         ( withTempDirectory )

import Control.Exception   ( bracket )
import System.FilePath     ( equalFilePath, takeDirectory )
import System.Directory    ( doesDirectoryExist )
import qualified System.Win32 as Win32
#endif

-- | @Setup@ encapsulates the outcome of configuring a setup method to build a
-- particular package.
data Setup = Setup
  { setupMethod :: SetupMethod
  , setupScriptOptions :: SetupScriptOptions
  , setupVersion :: Version
  , setupBuildType :: BuildType
  , setupPackage :: PackageDescription
  }

-- | @SetupMethod@ represents one of the methods used to run Cabal commands.
data SetupMethod
  = -- | run Cabal commands through \"cabal\" in the
    -- current process
    InternalMethod
  | -- | run Cabal commands through \"cabal\" as a
    -- child process
    SelfExecMethod
  | -- | run Cabal commands through a custom \"Setup\" executable
    ExternalMethod FilePath

-- TODO: The 'setupWrapper' and 'SetupScriptOptions' should be split into two
-- parts: one that has no policy and just does as it's told with all the
-- explicit options, and an optional initial part that applies certain
-- policies (like if we should add the Cabal lib as a dep, and if so which
-- version). This could be structured as an action that returns a fully
-- elaborated 'SetupScriptOptions' containing no remaining policy choices.
--
-- See also the discussion at https://github.com/haskell/cabal/pull/3094

-- | @SetupScriptOptions@ are options used to configure and run 'Setup', as
-- opposed to options given to the Cabal command at runtime.
data SetupScriptOptions = SetupScriptOptions
  { useCabalVersion :: VersionRange
  -- ^ The version of the Cabal library to use (if 'useDependenciesExclusive'
  -- is not set). A suitable version of the Cabal library must be installed
  -- (or for some build-types be the one cabal-install was built with).
  --
  -- The version found also determines the version of the Cabal specification
  -- that we us for talking to the Setup.hs, unless overridden by
  -- 'useCabalSpecVersion'.
  , useCabalSpecVersion :: Maybe Version
  -- ^ This is the version of the Cabal specification that we believe that
  -- this package uses. This affects the semantics and in particular the
  -- Setup command line interface.
  --
  -- This is similar to 'useCabalVersion' but instead of probing the system
  -- for a version of the /Cabal library/ you just say exactly which version
  -- of the /spec/ we will use. Using this also avoid adding the Cabal
  -- library as an additional dependency, so add it to 'useDependencies'
  -- if needed.
  , useCompiler :: Maybe Compiler
  , usePlatform :: Maybe Platform
  , usePackageDB :: PackageDBStackCWD
  , usePackageIndex :: Maybe InstalledPackageIndex
  , useProgramDb :: ProgramDb
  , useDistPref :: SymbolicPath Pkg (Dir Dist)
  , useLoggingHandle :: Maybe Handle
  , useWorkingDir :: Maybe (SymbolicPath CWD (Dir Pkg))
  , useExtraPathEnv :: [FilePath]
  -- ^ Extra things to add to PATH when invoking the setup script.
  , useExtraEnvOverrides :: [(String, Maybe FilePath)]
  -- ^ Extra environment variables paired with overrides, where
  --
  -- * @'Just' v@ means \"set the environment variable's value to @v@\".
  -- * 'Nothing' means \"unset the environment variable\".
  , forceExternalSetupMethod :: Bool
  , useDependencies :: [(ComponentId, PackageId)]
  -- ^ List of dependencies to use when building Setup.hs.
  , useDependenciesExclusive :: Bool
  -- ^ Is the list of setup dependencies exclusive?
  --
  -- When this is @False@, if we compile the Setup.hs script we do so with the
  -- list in 'useDependencies' but all other packages in the environment are
  -- also visible. A suitable version of @Cabal@ library (see
  -- 'useCabalVersion') is also added to the list of dependencies, unless
  -- 'useDependencies' already contains a Cabal dependency.
  --
  -- When @True@, only the 'useDependencies' packages are used, with other
  -- packages in the environment hidden.
  --
  -- This feature is here to support the setup stanza in .cabal files that
  -- specifies explicit (and exclusive) dependencies, as well as the old
  -- style with no dependencies.
  , useVersionMacros :: Bool
  -- ^ Should we build the Setup.hs with CPP version macros available?
  -- We turn this on when we have a setup stanza in .cabal that declares
  -- explicit setup dependencies.
  , -- Used only by 'cabal clean' on Windows.
    --
    -- Note: win32 clean hack
    -------------------------
    -- On Windows, running './dist/setup/setup clean' doesn't work because the
    -- setup script will try to delete itself (which causes it to fail horribly,
    -- unlike on Linux). So we have to move the setup exe out of the way first
    -- and then delete it manually. This applies only to the external setup
    -- method.
    useWin32CleanHack :: Bool
  , -- Used only when calling setupWrapper from parallel code to serialise
    -- access to the setup cache; should be Nothing otherwise.
    --
    -- Note: setup exe cache
    ------------------------
    -- When we are installing in parallel, we always use the external setup
    -- method. Since compiling the setup script each time adds noticeable
    -- overhead, we use a shared setup script cache
    -- ('$XDG_CACHE_HOME/cabal/setup-exe-cache'). For each (compiler, platform, Cabal
    -- version) combination the cache holds a compiled setup script
    -- executable. This only affects the Simple build type; for the Custom,
    -- Configure and Make build types we always compile the setup script anew.
    setupCacheLock :: Maybe Lock
  , isInteractive :: Bool
  -- ^ Is the task we are going to run an interactive foreground task,
  -- or an non-interactive background task? Based on this flag we
  -- decide whether or not to delegate ctrl+c to the spawned task
  }

defaultSetupScriptOptions :: SetupScriptOptions
defaultSetupScriptOptions =
  SetupScriptOptions
    { useCabalVersion = anyVersion
    , useCabalSpecVersion = Nothing
    , useCompiler = Nothing
    , usePlatform = Nothing
    , usePackageDB = [GlobalPackageDB, UserPackageDB]
    , usePackageIndex = Nothing
    , useDependencies = []
    , useDependenciesExclusive = False
    , useVersionMacros = False
    , useProgramDb = emptyProgramDb
    , useDistPref = defaultDistPref
    , useLoggingHandle = Nothing
    , useWorkingDir = Nothing
    , useExtraPathEnv = []
    , useExtraEnvOverrides = []
    , useWin32CleanHack = False
    , forceExternalSetupMethod = False
    , setupCacheLock = Nothing
    , isInteractive = False
    }

workingDir :: SetupScriptOptions -> FilePath
workingDir options = case useWorkingDir options of
  Just dir
    | let fp = getSymbolicPath dir
    , not $ null fp
    -> fp
  _ -> "."

-- | A @SetupRunner@ implements a 'SetupMethod'.
type SetupRunner =
  Verbosity
  -> SetupScriptOptions
  -> BuildType
  -> [String]
  -> IO ()

-- | Prepare to build a package by configuring a 'SetupMethod'. The returned
-- 'Setup' object identifies the method. The 'SetupScriptOptions' may be changed
-- during the configuration process; the final values are given by
-- 'setupScriptOptions'.
getSetup
  :: Verbosity
  -> SetupScriptOptions
  -> Maybe PackageDescription
  -> IO Setup
getSetup verbosity options mpkg = do
  pkg <- maybe getPkg return mpkg
  let options' =
        options
          { useCabalVersion =
              intersectVersionRanges
                (useCabalVersion options)
                (orLaterVersion (mkVersion (cabalSpecMinimumLibraryVersion (specVersion pkg))))
          }
      buildType' = buildType pkg
  (version, method, options'') <-
    getSetupMethod verbosity options' pkg buildType'
  return
    Setup
      { setupMethod = method
      , setupScriptOptions = options''
      , setupVersion = version
      , setupBuildType = buildType'
      , setupPackage = pkg
      }
  where
    mbWorkDir = useWorkingDir options
    getPkg =
      (relativeSymbolicPath <$> tryFindPackageDesc verbosity mbWorkDir)
        >>= readGenericPackageDescription verbosity mbWorkDir
        >>= return . packageDescription

-- | Decide if we're going to be able to do a direct internal call to the
-- entry point in the Cabal library or if we're going to have to compile
-- and execute an external Setup.hs script.
getSetupMethod
  :: Verbosity
  -> SetupScriptOptions
  -> PackageDescription
  -> BuildType
  -> IO (Version, SetupMethod, SetupScriptOptions)
getSetupMethod verbosity options pkg buildType'
  | buildType' == Custom
      || buildType' == Hooks
      || maybe False (cabalVersion /=) (useCabalSpecVersion options)
      || not (cabalVersion `withinRange` useCabalVersion options) =
      getExternalSetupMethod verbosity options pkg buildType'
  | isJust (useLoggingHandle options)
      -- Forcing is done to use an external process e.g. due to parallel
      -- build concerns.
      || forceExternalSetupMethod options =
      return (cabalVersion, SelfExecMethod, options)
  | otherwise = return (cabalVersion, InternalMethod, options)

runSetupMethod :: WithCallStack (SetupMethod -> SetupRunner)
runSetupMethod InternalMethod = internalSetupMethod
runSetupMethod (ExternalMethod path) = externalSetupMethod path
runSetupMethod SelfExecMethod = selfExecSetupMethod

-- | Run a configured 'Setup' with specific arguments.
runSetup
  :: Verbosity
  -> Setup
  -> [String]
  -- ^ command-line arguments
  -> IO ()
runSetup verbosity setup args0 = do
  let method = setupMethod setup
      options = setupScriptOptions setup
      bt = setupBuildType setup
      args = verbosityHack (setupVersion setup) args0
  when (verbosity >= deafening {- avoid test if not debug -} && args /= args0) $
    infoNoWrap verbose $
      "Applied verbosity hack:\n"
        ++ "  Before: "
        ++ show args0
        ++ "\n"
        ++ "  After:  "
        ++ show args
        ++ "\n"
  runSetupMethod method verbosity options bt args

-- | This is a horrible hack to make sure passing fancy verbosity
-- flags (e.g., @-v'info +callstack'@) doesn't break horribly on
-- old Setup.  We can't do it in 'filterConfigureFlags' because
-- verbosity applies to ALL commands.
verbosityHack :: Version -> [String] -> [String]
verbosityHack ver args0
  | ver >= mkVersion [2, 1] = args0
  | otherwise = go args0
  where
    go (('-' : 'v' : rest) : args)
      | Just rest' <- munch rest = ("-v" ++ rest') : go args
    go (('-' : '-' : 'v' : 'e' : 'r' : 'b' : 'o' : 's' : 'e' : '=' : rest) : args)
      | Just rest' <- munch rest = ("--verbose=" ++ rest') : go args
    go ("--verbose" : rest : args)
      | Just rest' <- munch rest = "--verbose" : rest' : go args
    go rest@("--" : _) = rest
    go (arg : args) = arg : go args
    go [] = []

    munch rest =
      case runReadE flagToVerbosity rest of
        Right v
          | ver < mkVersion [2, 0]
          , verboseHasFlags v ->
              -- We could preserve the prefix, but since we're assuming
              -- it's Cabal's verbosity flag, we can assume that
              -- any format is OK
              Just (showForCabal (verboseNoFlags v))
          | ver < mkVersion [2, 1]
          , isVerboseTimestamp v ->
              -- +timestamp wasn't yet available in Cabal-2.0.0
              Just (showForCabal (verboseNoTimestamp v))
        _ -> Nothing

-- | Run a command through a configured 'Setup'.
runSetupCommand
  :: Verbosity
  -> Setup
  -> CommandUI flags
  -- ^ command definition
  -> (flags -> CommonSetupFlags)
  -> flags
  -- ^ command flags
  -> [String]
  -- ^ extra command-line arguments
  -> IO ()
runSetupCommand verbosity setup cmd getCommonFlags flags extraArgs =
  -- The 'setupWorkingDir' flag corresponds to a global argument which needs to
  -- be passed before the individual command (e.g. 'configure' or 'build').
  let common = getCommonFlags flags
      globalFlags = mempty { globalWorkingDir = setupWorkingDir common }
      args = commandShowOptions (globalCommand []) globalFlags
          ++ (commandName cmd : commandShowOptions cmd flags ++ extraArgs)
  in runSetup verbosity setup args

-- | Configure a 'Setup' and run a command in one step. The command flags
-- may depend on the Cabal library version in use.
setupWrapper
  :: Verbosity
  -> SetupScriptOptions
  -> Maybe PackageDescription
  -> CommandUI flags
  -> (flags -> CommonSetupFlags)
  -> (Version -> IO flags)
  -- ^ produce command flags given the Cabal library version
  -> (Version -> [String])
  -> IO ()
setupWrapper verbosity options mpkg cmd getCommonFlags getFlags getExtraArgs = do
  setup <- getSetup verbosity options mpkg
  let version = setupVersion setup
      extraArgs = getExtraArgs version
  flags <- getFlags version
  runSetupCommand
    verbosity
    setup
    cmd
    getCommonFlags
    flags
    extraArgs

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

-- * Internal SetupMethod

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

-- | Run a Setup script by directly invoking the @Cabal@ library.
internalSetupMethod :: SetupRunner
internalSetupMethod verbosity options bt args = do
  info verbosity $
    "Using internal setup method with build-type "
      ++ show bt
      ++ " and args:\n  "
      ++ show args
  -- NB: we do not set the working directory of the process here, because
  -- we will instead pass the -working-dir flag when invoking the Setup script.
  -- Note that the Setup script is guaranteed to support this flag, because
  -- the logic in 'getSetupMethod' guarantees we have an up-to-date Cabal version.
  --
  -- In the future, it would be desirable to also stop relying on the following
  -- pieces of process-global state, as this would allow us to use this internal
  -- setup method in concurrent contexts.
  withEnv "HASKELL_DIST_DIR" (getSymbolicPath $ useDistPref options) $
    withExtraPathEnv (useExtraPathEnv options) $
      withEnvOverrides (useExtraEnvOverrides options) $
        buildTypeAction bt args

buildTypeAction :: BuildType -> ([String] -> IO ())
buildTypeAction Simple = Simple.defaultMainArgs
buildTypeAction Configure =
  Simple.defaultMainWithSetupHooksArgs
    Simple.autoconfSetupHooks
buildTypeAction Make = Make.defaultMainArgs
buildTypeAction Hooks  = error "buildTypeAction Hooks"
buildTypeAction Custom = error "buildTypeAction Custom"

invoke :: Verbosity -> FilePath -> [String] -> SetupScriptOptions -> IO ()
invoke verbosity path args options = do
  info verbosity $ unwords (path : args)
  case useLoggingHandle options of
    Nothing -> return ()
    Just logHandle -> info verbosity $ "Redirecting build log to " ++ show logHandle

  progDb <- prependProgramSearchPath verbosity (useExtraPathEnv options) (useExtraEnvOverrides options) (useProgramDb options)

  searchpath <-
    programSearchPathAsPATHVar $ getProgramSearchPath progDb

  env <-
    getEffectiveEnvironment $
      [ ("PATH", Just searchpath)
      , ("HASKELL_DIST_DIR", Just (getSymbolicPath $ useDistPref options))
      ]
        ++ progOverrideEnv progDb

  let loggingHandle = case useLoggingHandle options of
        Nothing -> Inherit
        Just hdl -> UseHandle hdl
      cp =
        (proc path args)
          { Process.cwd = fmap getSymbolicPath $ useWorkingDir options
          , Process.env = env
          , Process.std_out = loggingHandle
          , Process.std_err = loggingHandle
          , Process.delegate_ctlc = isInteractive options
          }
  maybeExit $ rawSystemProc verbosity cp

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

-- * Self-Exec SetupMethod

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

selfExecSetupMethod :: SetupRunner
selfExecSetupMethod verbosity options bt args0 = do
  let args =
        [ "act-as-setup"
        , "--build-type=" ++ prettyShow bt
        , "--"
        ]
          ++ args0
  info verbosity $
    "Using self-exec internal setup method with build-type "
      ++ show bt
      ++ " and args:\n  "
      ++ show args
  path <- getExecutablePath
  invoke verbosity path args options

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

-- * External SetupMethod

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

externalSetupMethod :: WithCallStack (FilePath -> SetupRunner)
externalSetupMethod path verbosity options _ args =
#ifndef mingw32_HOST_OS
  invoke
    verbosity
    path
    args
    options
#else
    -- See 'Note: win32 clean hack' above.
    if useWin32CleanHack options
      then invokeWithWin32CleanHack path
      else invoke' path
  where
    invoke' p = invoke verbosity p args options

    invokeWithWin32CleanHack origPath = do
      info verbosity $ "Using the Win32 clean hack."
      -- Recursively removes the temp dir on exit.
      withTempDirectory verbosity (workingDir options) "cabal-tmp" $ \tmpDir ->
        bracket
          (moveOutOfTheWay tmpDir origPath)
          (\tmpPath -> maybeRestore origPath tmpPath)
          (\tmpPath -> invoke' tmpPath)

    moveOutOfTheWay tmpDir origPath = do
      let tmpPath = tmpDir </> "setup" <.> exeExtension buildPlatform
      Win32.moveFile origPath tmpPath
      return tmpPath

    maybeRestore origPath tmpPath = do
      let origPathDir = takeDirectory origPath
      origPathDirExists <- doesDirectoryExist origPathDir
      -- 'setup clean' didn't complete, 'dist/setup' still exists.
      when origPathDirExists $
        Win32.moveFile tmpPath origPath

#endif

getExternalSetupMethod
  :: Verbosity
  -> SetupScriptOptions
  -> PackageDescription
  -> BuildType
  -> IO (Version, SetupMethod, SetupScriptOptions)
getExternalSetupMethod verbosity options pkg bt = do
  debug verbosity $ "Using external setup method with build-type " ++ show bt
  debug verbosity $
    "Using explicit dependencies: "
      ++ show (useDependenciesExclusive options)
  createDirectoryIfMissingVerbose verbosity True $ i setupDir
  (cabalLibVersion, mCabalLibInstalledPkgId, options') <- cabalLibVersionToUse
  debug verbosity $ "Using Cabal library version " ++ prettyShow cabalLibVersion
  path <-
    if useCachedSetupExecutable
      then
        getCachedSetupExecutable
          options'
          cabalLibVersion
          mCabalLibInstalledPkgId
      else
        compileSetupExecutable
          options'
          cabalLibVersion
          mCabalLibInstalledPkgId
          False

  -- Since useWorkingDir can change the relative path, the path argument must
  -- be turned into an absolute path. On some systems, runProcess' will take
  -- path as relative to the new working directory instead of the current
  -- working directory.
  path' <- tryCanonicalizePath path

  -- See 'Note: win32 clean hack' above.
#ifdef mingw32_HOST_OS
  -- setupProgFile may not exist if we're using a cached program
  setupProgFile' <- canonicalizePathNoThrow $ i setupProgFile
  let win32CleanHackNeeded =
        (useWin32CleanHack options)
          -- Skip when a cached setup script is used.
          && setupProgFile' `equalFilePath` path'
#else
  let win32CleanHackNeeded = False
#endif
  let options'' = options'{useWin32CleanHack = win32CleanHackNeeded}

  return (cabalLibVersion, ExternalMethod path', options'')
  where
    mbWorkDir = useWorkingDir options
    -- See Note [Symbolic paths] in Distribution.Utils.Path
    i = interpretSymbolicPath mbWorkDir
    setupDir = useDistPref options Cabal.Path.</> makeRelativePathEx "setup"
    setupVersionFile = setupDir Cabal.Path.</> makeRelativePathEx ("setup" <.> "version")
    setupHs = setupDir Cabal.Path.</> makeRelativePathEx ("setup" <.> "hs")
    setupHooks = setupDir Cabal.Path.</> makeRelativePathEx ("SetupHooks" <.> "hs")
    setupProgFile = setupDir Cabal.Path.</> makeRelativePathEx ("setup" <.> exeExtension buildPlatform)

    platform = fromMaybe buildPlatform (usePlatform options)

    useCachedSetupExecutable =
      bt == Simple || bt == Configure || bt == Make

    maybeGetInstalledPackages
      :: SetupScriptOptions
      -> Compiler
      -> ProgramDb
      -> IO InstalledPackageIndex
    maybeGetInstalledPackages options' comp progdb =
      case usePackageIndex options' of
        Just index -> return index
        Nothing ->
          getInstalledPackages
            verbosity
            comp
            (usePackageDB options')
            progdb

    -- Choose the version of Cabal to use if the setup script has a dependency on
    -- Cabal, and possibly update the setup script options. The version also
    -- determines how to filter the flags to Setup.
    --
    -- We first check whether the dependency solver has specified a Cabal version.
    -- If it has, we use the solver's version without looking at the installed
    -- package index (See issue #3436). Otherwise, we pick the Cabal version by
    -- checking 'useCabalSpecVersion', then the saved version, and finally the
    -- versions available in the index.
    --
    -- The version chosen here must match the one used in 'compileSetupExecutable'
    -- (See issue #3433).
    cabalLibVersionToUse
      :: IO
          ( Version
          , Maybe ComponentId
          , SetupScriptOptions
          )
    cabalLibVersionToUse =
      case find (isCabalPkgId . snd) (useDependencies options) of
        Just (unitId, pkgId) -> do
          let version = pkgVersion pkgId
          updateSetupScript version bt
          writeSetupVersionFile version
          return (version, Just unitId, options)
        Nothing ->
          case useCabalSpecVersion options of
            Just version -> do
              updateSetupScript version bt
              writeSetupVersionFile version
              return (version, Nothing, options)
            Nothing -> do
              savedVer <- savedVersion
              case savedVer of
                Just version | version `withinRange` useCabalVersion options ->
                  do
                    updateSetupScript version bt
                    -- Does the previously compiled setup executable
                    -- still exist and is it up-to date?
                    useExisting <- canUseExistingSetup version
                    if useExisting
                      then return (version, Nothing, options)
                      else installedVersion
                _ -> installedVersion
      where
        -- This check duplicates the checks in 'getCachedSetupExecutable' /
        -- 'compileSetupExecutable'. Unfortunately, we have to perform it twice
        -- because the selected Cabal version may change as a result of this
        -- check.
        canUseExistingSetup :: Version -> IO Bool
        canUseExistingSetup version =
          if useCachedSetupExecutable
            then do
              (_, cachedSetupProgFile) <- cachedSetupDirAndProg options version
              doesFileExist cachedSetupProgFile
            else
              (&&)
                <$> i setupProgFile `existsAndIsMoreRecentThan` i setupHs
                <*> i setupProgFile `existsAndIsMoreRecentThan` i setupVersionFile

        writeSetupVersionFile :: Version -> IO ()
        writeSetupVersionFile version =
          writeFile (i setupVersionFile) (show version ++ "\n")

        installedVersion
          :: IO
              ( Version
              , Maybe InstalledPackageId
              , SetupScriptOptions
              )
        installedVersion = do
          (comp, progdb, options') <- configureCompiler options
          (version, mipkgid, options'') <-
            installedCabalVersion
              options'
              comp
              progdb
          updateSetupScript version bt
          writeSetupVersionFile version
          return (version, mipkgid, options'')

        savedVersion :: IO (Maybe Version)
        savedVersion = do
          versionString <- readFile (i setupVersionFile) `catchIO` \_ -> return ""
          case reads versionString of
            [(version, s)] | all isSpace s -> return (Just version)
            _ -> return Nothing

    -- \| Update a Setup.hs script, creating it if necessary.
    updateSetupScript :: Version -> BuildType -> IO ()
    updateSetupScript _ Custom = do
      useHs <- doesFileExist customSetupHs
      useLhs <- doesFileExist customSetupLhs
      unless (useHs || useLhs) $
        dieWithException verbosity UpdateSetupScript
      let src = (if useHs then customSetupHs else customSetupLhs)
      srcNewer <- src `moreRecentFile` i setupHs
      when srcNewer $
        if useHs
          then copyFileVerbose verbosity src (i setupHs)
          else runSimplePreProcessor ppUnlit src (i setupHs) verbosity
      where
        customSetupHs = workingDir options </> "Setup.hs"
        customSetupLhs = workingDir options </> "Setup.lhs"
    updateSetupScript cabalLibVersion Hooks = do

      let customSetupHooks = workingDir options </> "SetupHooks.hs"
      useHs <- doesFileExist customSetupHooks
      unless (useHs) $
        die'
          verbosity
          "Using 'build-type: Hooks' but there is no SetupHooks.hs file."
      copyFileVerbose verbosity customSetupHooks (i setupHooks)
      rewriteFileLBS verbosity (i setupHs) (buildTypeScript cabalLibVersion)
--      rewriteFileLBS verbosity hooksHs hooksScript
    updateSetupScript cabalLibVersion _ =
      rewriteFileLBS verbosity (i setupHs) (buildTypeScript cabalLibVersion)

    buildTypeScript :: Version -> BS.ByteString
    buildTypeScript cabalLibVersion = "{-# LANGUAGE NoImplicitPrelude #-}\n" <> case bt of
      Simple -> "import Distribution.Simple; main = defaultMain\n"
      Configure
        | cabalLibVersion >= mkVersion [3, 13, 0]
        -> "import Distribution.Simple; main = defaultMainWithSetupHooks autoconfSetupHooks\n"
        | cabalLibVersion >= mkVersion [1, 3, 10]
        -> "import Distribution.Simple; main = defaultMainWithHooks autoconfUserHooks\n"
        | otherwise
        -> "import Distribution.Simple; main = defaultMainWithHooks defaultUserHooks\n"
      Make -> "import Distribution.Make; main = defaultMain\n"
      Hooks
        | cabalLibVersion >= mkVersion [3, 13, 0]
        -> "import Distribution.Simple; import SetupHooks; main = defaultMainWithSetupHooks setupHooks\n"
        | otherwise
        -> error "buildTypeScript Hooks with Cabal < 3.13"
      Custom -> error "buildTypeScript Custom"

    installedCabalVersion
      :: SetupScriptOptions
      -> Compiler
      -> ProgramDb
      -> IO
          ( Version
          , Maybe InstalledPackageId
          , SetupScriptOptions
          )
    installedCabalVersion options' _ _
      | packageName pkg == mkPackageName "Cabal"
          && bt == Custom =
          return (packageVersion pkg, Nothing, options')
    installedCabalVersion options' compiler progdb = do
      index <- maybeGetInstalledPackages options' compiler progdb
      let cabalDepName = mkPackageName "Cabal"
          cabalDepVersion = useCabalVersion options'
          options'' = options'{usePackageIndex = Just index}
      case PackageIndex.lookupDependency index cabalDepName cabalDepVersion of
        [] ->
          dieWithException verbosity $ InstalledCabalVersion (packageName pkg) (useCabalVersion options)
        pkgs ->
          let ipkginfo = fromMaybe err $ safeHead . snd . bestVersion fst $ pkgs
              err = error "Distribution.Client.installedCabalVersion: empty version list"
           in return
                ( packageVersion ipkginfo
                , Just . IPI.installedComponentId $ ipkginfo
                , options''
                )

    bestVersion :: (a -> Version) -> [a] -> a
    bestVersion f = firstMaximumBy (comparing (preference . f))
      where
        -- Like maximumBy, but picks the first maximum element instead of the
        -- last. In general, we expect the preferred version to go first in the
        -- list. For the default case, this has the effect of choosing the version
        -- installed in the user package DB instead of the global one. See #1463.
        --
        -- Note: firstMaximumBy could be written as just
        -- `maximumBy cmp . reverse`, but the problem is that the behaviour of
        -- maximumBy is not fully specified in the case when there is not a single
        -- greatest element.
        firstMaximumBy :: (a -> a -> Ordering) -> [a] -> a
        firstMaximumBy _ [] =
          error "Distribution.Client.firstMaximumBy: empty list"
        firstMaximumBy cmp xs = foldl1' maxBy xs
          where
            maxBy x y = case cmp x y of GT -> x; EQ -> x; LT -> y

        preference version =
          ( sameVersion
          , sameMajorVersion
          , stableVersion
          , latestVersion
          )
          where
            sameVersion = version == cabalVersion
            sameMajorVersion = majorVersion version == majorVersion cabalVersion
            majorVersion = take 2 . versionNumbers
            stableVersion = case versionNumbers version of
              (_ : x : _) -> even x
              _ -> False
            latestVersion = version

    configureCompiler
      :: SetupScriptOptions
      -> IO (Compiler, ProgramDb, SetupScriptOptions)
    configureCompiler options' = do
      (comp, progdb) <- case useCompiler options' of
        Just comp -> return (comp, useProgramDb options')
        Nothing -> do
          (comp, _, progdb) <-
            configCompilerEx
              (Just GHC)
              Nothing
              Nothing
              (useProgramDb options')
              verbosity
          return (comp, progdb)
      -- Whenever we need to call configureCompiler, we also need to access the
      -- package index, so let's cache it in SetupScriptOptions.
      index <- maybeGetInstalledPackages options' comp progdb
      return
        ( comp
        , progdb
        , options'
            { useCompiler = Just comp
            , usePackageIndex = Just index
            , useProgramDb = progdb
            }
        )

    -- \| Path to the setup exe cache directory and path to the cached setup
    -- executable.
    cachedSetupDirAndProg
      :: SetupScriptOptions
      -> Version
      -> IO (FilePath, FilePath)
    cachedSetupDirAndProg options' cabalLibVersion = do
      cacheDir <- defaultCacheDir
      let setupCacheDir = cacheDir </> "setup-exe-cache"
          cachedSetupProgFile =
            setupCacheDir
              </> ( "setup-"
                      ++ buildTypeString
                      ++ "-"
                      ++ cabalVersionString
                      ++ "-"
                      ++ platformString
                      ++ "-"
                      ++ compilerVersionString
                  )
              <.> exeExtension buildPlatform
      return (setupCacheDir, cachedSetupProgFile)
      where
        buildTypeString = show bt
        cabalVersionString = "Cabal-" ++ prettyShow cabalLibVersion
        compilerVersionString =
          prettyShow $
            maybe buildCompilerId compilerId $
              useCompiler options'
        platformString = prettyShow platform

    -- \| Look up the setup executable in the cache; update the cache if the setup
    -- executable is not found.
    getCachedSetupExecutable
      :: SetupScriptOptions
      -> Version
      -> Maybe InstalledPackageId
      -> IO FilePath
    getCachedSetupExecutable
      options'
      cabalLibVersion
      maybeCabalLibInstalledPkgId = do
        (setupCacheDir, cachedSetupProgFile) <-
          cachedSetupDirAndProg options' cabalLibVersion
        cachedSetupExists <- doesFileExist cachedSetupProgFile
        if cachedSetupExists
          then
            debug verbosity $
              "Found cached setup executable: " ++ cachedSetupProgFile
          else criticalSection' $ do
            -- The cache may have been populated while we were waiting.
            cachedSetupExists' <- doesFileExist cachedSetupProgFile
            if cachedSetupExists'
              then
                debug verbosity $
                  "Found cached setup executable: " ++ cachedSetupProgFile
              else do
                debug verbosity $ "Setup executable not found in the cache."
                src <-
                  compileSetupExecutable
                    options'
                    cabalLibVersion
                    maybeCabalLibInstalledPkgId
                    True
                createDirectoryIfMissingVerbose verbosity True setupCacheDir
                installExecutableFile verbosity src cachedSetupProgFile
                -- Do not strip if we're using GHCJS, since the result may be a script
                when (maybe True ((/= GHCJS) . compilerFlavor) $ useCompiler options') $ do
                  -- Add the relevant PATH overrides for the package to the
                  -- program database.
                  setupProgDb
                    <- prependProgramSearchPath verbosity
                          (useExtraPathEnv options)
                          (useExtraEnvOverrides options)
                          (useProgramDb options')
                         >>= configureAllKnownPrograms verbosity
                  Strip.stripExe
                    verbosity
                    platform
                    setupProgDb
                    cachedSetupProgFile
        return cachedSetupProgFile
        where
          criticalSection' = maybe id criticalSection $ setupCacheLock options'

    -- \| If the Setup.hs is out of date wrt the executable then recompile it.
    -- Currently this is GHC/GHCJS only. It should really be generalised.
    compileSetupExecutable
      :: SetupScriptOptions
      -> Version
      -> Maybe ComponentId
      -> Bool
      -> IO FilePath
    compileSetupExecutable
      options'
      cabalLibVersion
      maybeCabalLibInstalledPkgId
      forceCompile = do
        setupHsNewer <- i setupHs `moreRecentFile` i setupProgFile
        cabalVersionNewer <- i setupVersionFile `moreRecentFile` i setupProgFile
        let outOfDate = setupHsNewer || cabalVersionNewer
        when (outOfDate || forceCompile) $ do
          debug verbosity "Setup executable needs to be updated, compiling..."
          (compiler, progdb, options'') <- configureCompiler options'
          pkgDbs <- traverse (traverse (makeRelativeToDirS mbWorkDir)) (coercePackageDBStack (usePackageDB options''))
          let cabalPkgid = PackageIdentifier (mkPackageName "Cabal") cabalLibVersion
              (program, extraOpts) =
                case compilerFlavor compiler of
                  GHCJS -> (ghcjsProgram, ["-build-runner"])
                  _ -> (ghcProgram, ["-threaded"])
              cabalDep =
                maybe
                  []
                  (\ipkgid -> [(ipkgid, cabalPkgid)])
                  maybeCabalLibInstalledPkgId

              -- With 'useDependenciesExclusive' and Custom build type,
              -- we enforce the deps specified, so only the given ones can be used.
              -- Otherwise we add on a dep on the Cabal library
              -- (unless 'useDependencies' already contains one).
              selectedDeps
                |  (useDependenciesExclusive options' && (bt /= Hooks))
                -- NB: to compile build-type: Hooks packages, we need Cabal
                -- in order to compile @main = defaultMainWithSetupHooks setupHooks@.
                || any (isCabalPkgId . snd) (useDependencies options')
                = useDependencies options'
                | otherwise =
                    useDependencies options' ++ cabalDep
              addRenaming (ipid, _) =
                -- Assert 'DefUnitId' invariant
                ( Backpack.DefiniteUnitId (unsafeMkDefUnitId (newSimpleUnitId ipid))
                , defaultRenaming
                )
              cppMacrosFile = setupDir Cabal.Path.</> makeRelativePathEx "setup_macros.h"
              ghcOptions =
                mempty
                  { -- Respect -v0, but don't crank up verbosity on GHC if
                    -- Cabal verbosity is requested. For that, use
                    -- --ghc-option=-v instead!
                    ghcOptVerbosity = Flag (min verbosity normal)
                  , ghcOptMode = Flag GhcModeMake
                  , ghcOptInputFiles = toNubListR [setupHs]
                  , ghcOptOutputFile = Flag $ setupProgFile
                  , ghcOptObjDir = Flag $ setupDir
                  , ghcOptHiDir = Flag $ setupDir
                  , ghcOptSourcePathClear = Flag True
                  , ghcOptSourcePath = case bt of
                      Custom -> toNubListR [sameDirectory]
                      Hooks -> toNubListR [sameDirectory]
                      _ -> mempty
                  , ghcOptPackageDBs = pkgDbs
                  , ghcOptHideAllPackages = Flag (useDependenciesExclusive options')
                  , ghcOptCabal = Flag (useDependenciesExclusive options')
                  , ghcOptPackages = toNubListR $ map addRenaming selectedDeps
                  -- With 'useVersionMacros', use a version CPP macros .h file.
                  , ghcOptCppIncludes =
                      toNubListR
                        [ cppMacrosFile
                        | useVersionMacros options'
                        ]
                  , ghcOptExtra = extraOpts
                  , ghcOptExtensions = toNubListR $
                      if bt == Custom || any (isBasePkgId . snd) selectedDeps
                      then []
                      else [ Simple.DisableExtension Simple.ImplicitPrelude ]
                        -- Pass -WNoImplicitPrelude to avoid depending on base
                        -- when compiling a Simple Setup.hs file.
                  , ghcOptExtensionMap = Map.fromList . Simple.compilerExtensions $ compiler
                  }
          let ghcCmdLine = renderGhcOptions compiler platform ghcOptions
          when (useVersionMacros options') $
            rewriteFileEx verbosity (i cppMacrosFile) $
              generatePackageVersionMacros (pkgVersion $ package pkg) (map snd selectedDeps)
          case useLoggingHandle options of
            Nothing -> runDbProgramCwd verbosity mbWorkDir program progdb ghcCmdLine
            -- If build logging is enabled, redirect compiler output to
            -- the log file.
            Just logHandle -> do
              output <-
                getDbProgramOutputCwd
                  verbosity
                  mbWorkDir
                  program
                  progdb
                  ghcCmdLine
              hPutStr logHandle output
        return $ i setupProgFile

isCabalPkgId, isBasePkgId :: PackageIdentifier -> Bool
isCabalPkgId (PackageIdentifier pname _) = pname == mkPackageName "Cabal"
isBasePkgId (PackageIdentifier pname _) = pname == mkPackageName "base"