{-# LANGUAGE CPP               #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- 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 Prelude ()
import Distribution.Client.Compat.Prelude

import Distribution.CabalSpecVersion (cabalSpecMinimumLibraryVersion)
import qualified Distribution.Make as Make
import qualified Distribution.Simple as Simple
import Distribution.Version
         ( Version, mkVersion, versionNumbers, VersionRange, anyVersion
         , intersectVersionRanges, orLaterVersion
         , withinRange )
import qualified Distribution.Backpack as Backpack
import Distribution.Package
         ( newSimpleUnitId, unsafeMkDefUnitId, ComponentId
         , PackageId, mkPackageName
         , PackageIdentifier(..), packageVersion, packageName )
import Distribution.PackageDescription
         ( GenericPackageDescription(packageDescription)
         , PackageDescription(..), specVersion, buildType
         , BuildType(..) )
import Distribution.Types.ModuleRenaming (defaultRenaming)
import Distribution.Simple.Configure
         ( configCompilerEx )
import Distribution.Compiler
         ( buildCompilerId, CompilerFlavor(GHC, GHCJS) )
import Distribution.Simple.Compiler
         ( Compiler(compilerId), compilerFlavor, PackageDB(..), PackageDBStack )
import Distribution.Simple.PackageDescription
         ( readGenericPackageDescription )
import Distribution.Simple.PreProcess
         ( runSimplePreProcessor, ppUnlit )
import Distribution.Simple.Build.Macros
         ( generatePackageVersionMacros )
import Distribution.Simple.Program
         ( ProgramDb, emptyProgramDb
         , getProgramSearchPath, getDbProgramOutput, runDbProgram, ghcProgram
         , ghcjsProgram )
import Distribution.Simple.Program.Find
         ( programSearchPathAsPATHVar
         , ProgramSearchPathEntry(ProgramSearchPathDir) )
import Distribution.Simple.Program.Run
         ( getEffectiveEnvironment )
import qualified Distribution.Simple.Program.Strip as Strip
import Distribution.Simple.BuildPaths
         ( defaultDistPref, exeExtension )

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

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

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

import qualified Data.ByteString.Lazy as BS

#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 { Setup -> SetupMethod
setupMethod        :: SetupMethod
                   , Setup -> SetupScriptOptions
setupScriptOptions :: SetupScriptOptions
                   , Setup -> Version
setupVersion       :: Version
                   , Setup -> BuildType
setupBuildType     :: BuildType
                   , Setup -> PackageDescription
setupPackage       :: PackageDescription
                   }

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

-- 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 {
    -- | 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'.
    --
    SetupScriptOptions -> VersionRange
useCabalVersion          :: VersionRange,

    -- | 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.
    --
    SetupScriptOptions -> Maybe Version
useCabalSpecVersion      :: Maybe Version,
    SetupScriptOptions -> Maybe Compiler
useCompiler              :: Maybe Compiler,
    SetupScriptOptions -> Maybe Platform
usePlatform              :: Maybe Platform,
    SetupScriptOptions -> PackageDBStack
usePackageDB             :: PackageDBStack,
    SetupScriptOptions -> Maybe InstalledPackageIndex
usePackageIndex          :: Maybe InstalledPackageIndex,
    SetupScriptOptions -> ProgramDb
useProgramDb             :: ProgramDb,
    SetupScriptOptions -> [Char]
useDistPref              :: FilePath,
    SetupScriptOptions -> Maybe Handle
useLoggingHandle         :: Maybe Handle,
    SetupScriptOptions -> Maybe [Char]
useWorkingDir            :: Maybe FilePath,
    -- | Extra things to add to PATH when invoking the setup script.
    SetupScriptOptions -> [[Char]]
useExtraPathEnv          :: [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\".
    SetupScriptOptions -> [([Char], Maybe [Char])]
useExtraEnvOverrides     :: [(String, Maybe FilePath)],
    SetupScriptOptions -> Bool
forceExternalSetupMethod :: Bool,

    -- | List of dependencies to use when building Setup.hs.
    SetupScriptOptions -> [(ComponentId, PackageId)]
useDependencies :: [(ComponentId, PackageId)],

    -- | 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.
    SetupScriptOptions -> Bool
useDependenciesExclusive :: 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.
    --
    SetupScriptOptions -> Bool
useVersionMacros         :: Bool,

    -- 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.
    SetupScriptOptions -> Bool
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.
    SetupScriptOptions -> Maybe Lock
setupCacheLock           :: Maybe Lock,

    -- | 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
    SetupScriptOptions -> Bool
isInteractive            :: Bool
  }

defaultSetupScriptOptions :: SetupScriptOptions
defaultSetupScriptOptions :: SetupScriptOptions
defaultSetupScriptOptions = SetupScriptOptions {
    useCabalVersion :: VersionRange
useCabalVersion          = VersionRange
anyVersion,
    useCabalSpecVersion :: Maybe Version
useCabalSpecVersion      = forall a. Maybe a
Nothing,
    useCompiler :: Maybe Compiler
useCompiler              = forall a. Maybe a
Nothing,
    usePlatform :: Maybe Platform
usePlatform              = forall a. Maybe a
Nothing,
    usePackageDB :: PackageDBStack
usePackageDB             = [PackageDB
GlobalPackageDB, PackageDB
UserPackageDB],
    usePackageIndex :: Maybe InstalledPackageIndex
usePackageIndex          = forall a. Maybe a
Nothing,
    useDependencies :: [(ComponentId, PackageId)]
useDependencies          = [],
    useDependenciesExclusive :: Bool
useDependenciesExclusive = Bool
False,
    useVersionMacros :: Bool
useVersionMacros         = Bool
False,
    useProgramDb :: ProgramDb
useProgramDb             = ProgramDb
emptyProgramDb,
    useDistPref :: [Char]
useDistPref              = [Char]
defaultDistPref,
    useLoggingHandle :: Maybe Handle
useLoggingHandle         = forall a. Maybe a
Nothing,
    useWorkingDir :: Maybe [Char]
useWorkingDir            = forall a. Maybe a
Nothing,
    useExtraPathEnv :: [[Char]]
useExtraPathEnv          = [],
    useExtraEnvOverrides :: [([Char], Maybe [Char])]
useExtraEnvOverrides     = [],
    useWin32CleanHack :: Bool
useWin32CleanHack        = Bool
False,
    forceExternalSetupMethod :: Bool
forceExternalSetupMethod = Bool
False,
    setupCacheLock :: Maybe Lock
setupCacheLock           = forall a. Maybe a
Nothing,
    isInteractive :: Bool
isInteractive            = Bool
False
  }

workingDir :: SetupScriptOptions -> FilePath
workingDir :: SetupScriptOptions -> [Char]
workingDir SetupScriptOptions
options =
  case forall a. a -> Maybe a -> a
fromMaybe [Char]
"" (SetupScriptOptions -> Maybe [Char]
useWorkingDir SetupScriptOptions
options) of
    []  -> [Char]
"."
    [Char]
dir -> [Char]
dir

-- | 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
-> SetupScriptOptions -> Maybe PackageDescription -> IO Setup
getSetup Verbosity
verbosity SetupScriptOptions
options Maybe PackageDescription
mpkg = do
  PackageDescription
pkg <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO PackageDescription
getPkg forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PackageDescription
mpkg
  let options' :: SetupScriptOptions
options'    = SetupScriptOptions
options {
                      useCabalVersion :: VersionRange
useCabalVersion = VersionRange -> VersionRange -> VersionRange
intersectVersionRanges
                                          (SetupScriptOptions -> VersionRange
useCabalVersion SetupScriptOptions
options)
                                          (Version -> VersionRange
orLaterVersion ([Int] -> Version
mkVersion (CabalSpecVersion -> [Int]
cabalSpecMinimumLibraryVersion (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg))))
                    }
      buildType' :: BuildType
buildType'  = PackageDescription -> BuildType
buildType PackageDescription
pkg
  (Version
version, SetupMethod
method, SetupScriptOptions
options'') <-
    Verbosity
-> SetupScriptOptions
-> PackageDescription
-> BuildType
-> IO (Version, SetupMethod, SetupScriptOptions)
getSetupMethod Verbosity
verbosity SetupScriptOptions
options' PackageDescription
pkg BuildType
buildType'
  forall (m :: * -> *) a. Monad m => a -> m a
return Setup { setupMethod :: SetupMethod
setupMethod = SetupMethod
method
               , setupScriptOptions :: SetupScriptOptions
setupScriptOptions = SetupScriptOptions
options''
               , setupVersion :: Version
setupVersion = Version
version
               , setupBuildType :: BuildType
setupBuildType = BuildType
buildType'
               , setupPackage :: PackageDescription
setupPackage = PackageDescription
pkg
               }
  where
    getPkg :: IO PackageDescription
getPkg = Verbosity -> [Char] -> IO [Char]
tryFindPackageDesc Verbosity
verbosity (forall a. a -> Maybe a -> a
fromMaybe [Char]
"." (SetupScriptOptions -> Maybe [Char]
useWorkingDir SetupScriptOptions
options))
         forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Verbosity -> [Char] -> IO GenericPackageDescription
readGenericPackageDescription Verbosity
verbosity
         forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription -> PackageDescription
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
-> SetupScriptOptions
-> PackageDescription
-> BuildType
-> IO (Version, SetupMethod, SetupScriptOptions)
getSetupMethod Verbosity
verbosity SetupScriptOptions
options PackageDescription
pkg BuildType
buildType'
  | BuildType
buildType' forall a. Eq a => a -> a -> Bool
== BuildType
Custom
    Bool -> Bool -> Bool
|| forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Version
cabalVersion forall a. Eq a => a -> a -> Bool
/=) (SetupScriptOptions -> Maybe Version
useCabalSpecVersion SetupScriptOptions
options)
    Bool -> Bool -> Bool
|| Bool -> Bool
not (Version
cabalVersion Version -> VersionRange -> Bool
`withinRange` SetupScriptOptions -> VersionRange
useCabalVersion SetupScriptOptions
options)    =
         Verbosity
-> SetupScriptOptions
-> PackageDescription
-> BuildType
-> IO (Version, SetupMethod, SetupScriptOptions)
getExternalSetupMethod Verbosity
verbosity SetupScriptOptions
options PackageDescription
pkg BuildType
buildType'
  | forall a. Maybe a -> Bool
isJust (SetupScriptOptions -> Maybe Handle
useLoggingHandle SetupScriptOptions
options)
    -- Forcing is done to use an external process e.g. due to parallel
    -- build concerns.
    Bool -> Bool -> Bool
|| SetupScriptOptions -> Bool
forceExternalSetupMethod SetupScriptOptions
options =
        forall (m :: * -> *) a. Monad m => a -> m a
return (Version
cabalVersion, SetupMethod
SelfExecMethod, SetupScriptOptions
options)
  | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return (Version
cabalVersion, SetupMethod
InternalMethod, SetupScriptOptions
options)

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

-- | Run a configured 'Setup' with specific arguments.
runSetup :: Verbosity -> Setup
         -> [String]  -- ^ command-line arguments
         -> IO ()
runSetup :: Verbosity -> Setup -> [[Char]] -> IO ()
runSetup Verbosity
verbosity Setup
setup [[Char]]
args0 = do
  let method :: SetupMethod
method = Setup -> SetupMethod
setupMethod Setup
setup
      options :: SetupScriptOptions
options = Setup -> SetupScriptOptions
setupScriptOptions Setup
setup
      bt :: BuildType
bt = Setup -> BuildType
setupBuildType Setup
setup
      args :: [[Char]]
args = Version -> [[Char]] -> [[Char]]
verbosityHack (Setup -> Version
setupVersion Setup
setup) [[Char]]
args0
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
verbosity forall a. Ord a => a -> a -> Bool
>= Verbosity
deafening {- avoid test if not debug -} Bool -> Bool -> Bool
&& [[Char]]
args forall a. Eq a => a -> a -> Bool
/= [[Char]]
args0) forall a b. (a -> b) -> a -> b
$
    Verbosity -> [Char] -> IO ()
infoNoWrap Verbosity
verbose forall a b. (a -> b) -> a -> b
$
        [Char]
"Applied verbosity hack:\n" forall a. [a] -> [a] -> [a]
++
        [Char]
"  Before: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [[Char]]
args0 forall a. [a] -> [a] -> [a]
++ [Char]
"\n" forall a. [a] -> [a] -> [a]
++
        [Char]
"  After:  " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [[Char]]
args forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
  WithCallStack (SetupMethod -> SetupRunner)
runSetupMethod SetupMethod
method Verbosity
verbosity SetupScriptOptions
options BuildType
bt [[Char]]
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 :: Version -> [[Char]] -> [[Char]]
verbosityHack Version
ver [[Char]]
args0
    | Version
ver forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
2,Int
1]  = [[Char]]
args0
    | Bool
otherwise = [[Char]] -> [[Char]]
go [[Char]]
args0
  where
    go :: [[Char]] -> [[Char]]
go ((Char
'-':Char
'v':[Char]
rest) : [[Char]]
args)
        | Just [Char]
rest' <- [Char] -> Maybe [Char]
munch [Char]
rest = ([Char]
"-v" forall a. [a] -> [a] -> [a]
++ [Char]
rest') forall a. a -> [a] -> [a]
: [[Char]] -> [[Char]]
go [[Char]]
args
    go ((Char
'-':Char
'-':Char
'v':Char
'e':Char
'r':Char
'b':Char
'o':Char
's':Char
'e':Char
'=':[Char]
rest) : [[Char]]
args)
        | Just [Char]
rest' <- [Char] -> Maybe [Char]
munch [Char]
rest = ([Char]
"--verbose=" forall a. [a] -> [a] -> [a]
++ [Char]
rest') forall a. a -> [a] -> [a]
: [[Char]] -> [[Char]]
go [[Char]]
args
    go ([Char]
"--verbose" : [Char]
rest : [[Char]]
args)
        | Just [Char]
rest' <- [Char] -> Maybe [Char]
munch [Char]
rest = [Char]
"--verbose" forall a. a -> [a] -> [a]
: [Char]
rest' forall a. a -> [a] -> [a]
: [[Char]] -> [[Char]]
go [[Char]]
args
    go rest :: [[Char]]
rest@([Char]
"--" : [[Char]]
_) = [[Char]]
rest
    go ([Char]
arg:[[Char]]
args) = [Char]
arg forall a. a -> [a] -> [a]
: [[Char]] -> [[Char]]
go [[Char]]
args
    go [] = []

    munch :: [Char] -> Maybe [Char]
munch [Char]
rest =
        case forall a. ReadE a -> [Char] -> Either [Char] a
runReadE ReadE Verbosity
flagToVerbosity [Char]
rest of
            Right Verbosity
v
              | Version
ver forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
2,Int
0], Verbosity -> Bool
verboseHasFlags Verbosity
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
              -> forall a. a -> Maybe a
Just (Verbosity -> [Char]
showForCabal (Verbosity -> Verbosity
verboseNoFlags Verbosity
v))
              | Version
ver forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
2,Int
1], Verbosity -> Bool
isVerboseTimestamp Verbosity
v
              -- +timestamp wasn't yet available in Cabal-2.0.0
              -> forall a. a -> Maybe a
Just (Verbosity -> [Char]
showForCabal (Verbosity -> Verbosity
verboseNoTimestamp Verbosity
v))
            Either [Char] Verbosity
_ -> forall a. Maybe a
Nothing

-- | Run a command through a configured 'Setup'.
runSetupCommand :: Verbosity -> Setup
                -> CommandUI flags  -- ^ command definition
                -> flags  -- ^ command flags
                -> [String] -- ^ extra command-line arguments
                -> IO ()
runSetupCommand :: forall flags.
Verbosity -> Setup -> CommandUI flags -> flags -> [[Char]] -> IO ()
runSetupCommand Verbosity
verbosity Setup
setup CommandUI flags
cmd flags
flags [[Char]]
extraArgs = do
  let args :: [[Char]]
args = forall flags. CommandUI flags -> [Char]
commandName CommandUI flags
cmd forall a. a -> [a] -> [a]
: forall flags. CommandUI flags -> flags -> [[Char]]
commandShowOptions CommandUI flags
cmd flags
flags forall a. [a] -> [a] -> [a]
++ [[Char]]
extraArgs
  Verbosity -> Setup -> [[Char]] -> IO ()
runSetup Verbosity
verbosity Setup
setup [[Char]]
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
             -> (Version -> flags)
                -- ^ produce command flags given the Cabal library version
             -> (Version -> [String])
             -> IO ()
setupWrapper :: forall flags.
Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
-> (Version -> flags)
-> (Version -> [[Char]])
-> IO ()
setupWrapper Verbosity
verbosity SetupScriptOptions
options Maybe PackageDescription
mpkg CommandUI flags
cmd Version -> flags
flags Version -> [[Char]]
extraArgs = do
  Setup
setup <- Verbosity
-> SetupScriptOptions -> Maybe PackageDescription -> IO Setup
getSetup Verbosity
verbosity SetupScriptOptions
options Maybe PackageDescription
mpkg
  forall flags.
Verbosity -> Setup -> CommandUI flags -> flags -> [[Char]] -> IO ()
runSetupCommand Verbosity
verbosity Setup
setup
                  CommandUI flags
cmd (Version -> flags
flags forall a b. (a -> b) -> a -> b
$ Setup -> Version
setupVersion Setup
setup)
                      (Version -> [[Char]]
extraArgs forall a b. (a -> b) -> a -> b
$ Setup -> Version
setupVersion Setup
setup)

-- ------------------------------------------------------------
-- * Internal SetupMethod
-- ------------------------------------------------------------

internalSetupMethod :: SetupRunner
internalSetupMethod :: SetupRunner
internalSetupMethod Verbosity
verbosity SetupScriptOptions
options BuildType
bt [[Char]]
args = do
  Verbosity -> [Char] -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [Char]
"Using internal setup method with build-type " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show BuildType
bt
                forall a. [a] -> [a] -> [a]
++ [Char]
" and args:\n  " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [[Char]]
args
  forall a. Maybe [Char] -> IO a -> IO a
inDir (SetupScriptOptions -> Maybe [Char]
useWorkingDir SetupScriptOptions
options) forall a b. (a -> b) -> a -> b
$ do
    forall a. [Char] -> [Char] -> IO a -> IO a
withEnv [Char]
"HASKELL_DIST_DIR" (SetupScriptOptions -> [Char]
useDistPref SetupScriptOptions
options) forall a b. (a -> b) -> a -> b
$
      forall a. [[Char]] -> IO a -> IO a
withExtraPathEnv (SetupScriptOptions -> [[Char]]
useExtraPathEnv SetupScriptOptions
options) forall a b. (a -> b) -> a -> b
$
        forall a. [([Char], Maybe [Char])] -> IO a -> IO a
withEnvOverrides (SetupScriptOptions -> [([Char], Maybe [Char])]
useExtraEnvOverrides SetupScriptOptions
options) forall a b. (a -> b) -> a -> b
$
          BuildType -> [[Char]] -> IO ()
buildTypeAction BuildType
bt [[Char]]
args

buildTypeAction :: BuildType -> ([String] -> IO ())
buildTypeAction :: BuildType -> [[Char]] -> IO ()
buildTypeAction BuildType
Simple    = [[Char]] -> IO ()
Simple.defaultMainArgs
buildTypeAction BuildType
Configure = UserHooks -> [[Char]] -> IO ()
Simple.defaultMainWithHooksArgs
                              UserHooks
Simple.autoconfUserHooks
buildTypeAction BuildType
Make      = [[Char]] -> IO ()
Make.defaultMainArgs
buildTypeAction BuildType
Custom               = forall a. HasCallStack => [Char] -> a
error [Char]
"buildTypeAction Custom"

invoke :: Verbosity -> FilePath -> [String] -> SetupScriptOptions -> IO ()
invoke :: Verbosity -> [Char] -> [[Char]] -> SetupScriptOptions -> IO ()
invoke Verbosity
verbosity [Char]
path [[Char]]
args SetupScriptOptions
options = do
  Verbosity -> [Char] -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords ([Char]
path forall a. a -> [a] -> [a]
: [[Char]]
args)
  case SetupScriptOptions -> Maybe Handle
useLoggingHandle SetupScriptOptions
options of
    Maybe Handle
Nothing        -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just Handle
logHandle -> Verbosity -> [Char] -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [Char]
"Redirecting build log to " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Handle
logHandle

  [Char]
searchpath <- ProgramSearchPath -> IO [Char]
programSearchPathAsPATHVar
                (forall a b. (a -> b) -> [a] -> [b]
map [Char] -> ProgramSearchPathEntry
ProgramSearchPathDir (SetupScriptOptions -> [[Char]]
useExtraPathEnv SetupScriptOptions
options) forall a. [a] -> [a] -> [a]
++
                 ProgramDb -> ProgramSearchPath
getProgramSearchPath (SetupScriptOptions -> ProgramDb
useProgramDb SetupScriptOptions
options))
  Maybe [([Char], [Char])]
env       <- [([Char], Maybe [Char])] -> IO (Maybe [([Char], [Char])])
getEffectiveEnvironment forall a b. (a -> b) -> a -> b
$
                 [ ([Char]
"PATH", forall a. a -> Maybe a
Just [Char]
searchpath)
                 , ([Char]
"HASKELL_DIST_DIR", forall a. a -> Maybe a
Just (SetupScriptOptions -> [Char]
useDistPref SetupScriptOptions
options))
                 ] forall a. [a] -> [a] -> [a]
++ SetupScriptOptions -> [([Char], Maybe [Char])]
useExtraEnvOverrides SetupScriptOptions
options

  let loggingHandle :: StdStream
loggingHandle = case SetupScriptOptions -> Maybe Handle
useLoggingHandle SetupScriptOptions
options of
                        Maybe Handle
Nothing -> StdStream
Inherit
                        Just Handle
hdl -> Handle -> StdStream
UseHandle Handle
hdl
      cp :: CreateProcess
cp = ([Char] -> [[Char]] -> CreateProcess
proc [Char]
path [[Char]]
args) { cwd :: Maybe [Char]
Process.cwd = SetupScriptOptions -> Maybe [Char]
useWorkingDir SetupScriptOptions
options
                            , env :: Maybe [([Char], [Char])]
Process.env = Maybe [([Char], [Char])]
env
                            , std_out :: StdStream
Process.std_out = StdStream
loggingHandle
                            , std_err :: StdStream
Process.std_err = StdStream
loggingHandle
                            , delegate_ctlc :: Bool
Process.delegate_ctlc = SetupScriptOptions -> Bool
isInteractive SetupScriptOptions
options
                            }
  IO ExitCode -> IO ()
maybeExit forall a b. (a -> b) -> a -> b
$ Verbosity -> CreateProcess -> IO ExitCode
rawSystemProc Verbosity
verbosity CreateProcess
cp

-- ------------------------------------------------------------
-- * Self-Exec SetupMethod
-- ------------------------------------------------------------

selfExecSetupMethod :: SetupRunner
selfExecSetupMethod :: SetupRunner
selfExecSetupMethod Verbosity
verbosity SetupScriptOptions
options BuildType
bt [[Char]]
args0 = do
  let args :: [[Char]]
args = [[Char]
"act-as-setup",
              [Char]
"--build-type=" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
prettyShow BuildType
bt,
              [Char]
"--"] forall a. [a] -> [a] -> [a]
++ [[Char]]
args0
  Verbosity -> [Char] -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [Char]
"Using self-exec internal setup method with build-type "
                 forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show BuildType
bt forall a. [a] -> [a] -> [a]
++ [Char]
" and args:\n  " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [[Char]]
args
  [Char]
path <- IO [Char]
getExecutablePath
  Verbosity -> [Char] -> [[Char]] -> SetupScriptOptions -> IO ()
invoke Verbosity
verbosity [Char]
path [[Char]]
args SetupScriptOptions
options

-- ------------------------------------------------------------
-- * External SetupMethod
-- ------------------------------------------------------------

externalSetupMethod :: WithCallStack (FilePath -> SetupRunner)
externalSetupMethod :: WithCallStack ([Char] -> SetupRunner)
externalSetupMethod [Char]
path Verbosity
verbosity SetupScriptOptions
options BuildType
_ [[Char]]
args =
#ifndef mingw32_HOST_OS
  Verbosity -> [Char] -> [[Char]] -> SetupScriptOptions -> IO ()
invoke Verbosity
verbosity [Char]
path [[Char]]
args SetupScriptOptions
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
-> SetupScriptOptions
-> PackageDescription
-> BuildType
-> IO (Version, SetupMethod, SetupScriptOptions)
getExternalSetupMethod Verbosity
verbosity SetupScriptOptions
options PackageDescription
pkg BuildType
bt = do
  Verbosity -> [Char] -> IO ()
debug Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [Char]
"Using external setup method with build-type " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show BuildType
bt
  Verbosity -> [Char] -> IO ()
debug Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [Char]
"Using explicit dependencies: "
    forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (SetupScriptOptions -> Bool
useDependenciesExclusive SetupScriptOptions
options)
  Verbosity -> Bool -> [Char] -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True [Char]
setupDir
  (Version
cabalLibVersion, Maybe ComponentId
mCabalLibInstalledPkgId, SetupScriptOptions
options') <- IO (Version, Maybe ComponentId, SetupScriptOptions)
cabalLibVersionToUse
  Verbosity -> [Char] -> IO ()
debug Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [Char]
"Using Cabal library version " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
prettyShow Version
cabalLibVersion
  [Char]
path <- if Bool
useCachedSetupExecutable
          then SetupScriptOptions -> Version -> Maybe ComponentId -> IO [Char]
getCachedSetupExecutable SetupScriptOptions
options'
               Version
cabalLibVersion Maybe ComponentId
mCabalLibInstalledPkgId
          else SetupScriptOptions
-> Version -> Maybe ComponentId -> Bool -> IO [Char]
compileSetupExecutable   SetupScriptOptions
options'
               Version
cabalLibVersion Maybe ComponentId
mCabalLibInstalledPkgId Bool
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.
  [Char]
path' <- [Char] -> IO [Char]
tryCanonicalizePath [Char]
path

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

  forall (m :: * -> *) a. Monad m => a -> m a
return (Version
cabalLibVersion, [Char] -> SetupMethod
ExternalMethod [Char]
path', SetupScriptOptions
options'')

  where
  setupDir :: [Char]
setupDir         = SetupScriptOptions -> [Char]
workingDir SetupScriptOptions
options [Char] -> [Char] -> [Char]
</> SetupScriptOptions -> [Char]
useDistPref SetupScriptOptions
options [Char] -> [Char] -> [Char]
</> [Char]
"setup"
  setupVersionFile :: [Char]
setupVersionFile = [Char]
setupDir   [Char] -> [Char] -> [Char]
</> [Char]
"setup" [Char] -> [Char] -> [Char]
<.> [Char]
"version"
  setupHs :: [Char]
setupHs          = [Char]
setupDir   [Char] -> [Char] -> [Char]
</> [Char]
"setup" [Char] -> [Char] -> [Char]
<.> [Char]
"hs"
  setupProgFile :: [Char]
setupProgFile    = [Char]
setupDir   [Char] -> [Char] -> [Char]
</> [Char]
"setup" [Char] -> [Char] -> [Char]
<.> Platform -> [Char]
exeExtension Platform
buildPlatform
  platform :: Platform
platform         = forall a. a -> Maybe a -> a
fromMaybe Platform
buildPlatform (SetupScriptOptions -> Maybe Platform
usePlatform SetupScriptOptions
options)

  useCachedSetupExecutable :: Bool
useCachedSetupExecutable = (BuildType
bt forall a. Eq a => a -> a -> Bool
== BuildType
Simple Bool -> Bool -> Bool
|| BuildType
bt forall a. Eq a => a -> a -> Bool
== BuildType
Configure Bool -> Bool -> Bool
|| BuildType
bt forall a. Eq a => a -> a -> Bool
== BuildType
Make)

  maybeGetInstalledPackages :: SetupScriptOptions -> Compiler
                            -> ProgramDb -> IO InstalledPackageIndex
  maybeGetInstalledPackages :: SetupScriptOptions
-> Compiler -> ProgramDb -> IO InstalledPackageIndex
maybeGetInstalledPackages SetupScriptOptions
options' Compiler
comp ProgramDb
progdb =
    case SetupScriptOptions -> Maybe InstalledPackageIndex
usePackageIndex SetupScriptOptions
options' of
      Just InstalledPackageIndex
index -> forall (m :: * -> *) a. Monad m => a -> m a
return InstalledPackageIndex
index
      Maybe InstalledPackageIndex
Nothing    -> Verbosity
-> Compiler
-> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages Verbosity
verbosity
                    Compiler
comp (SetupScriptOptions -> PackageDBStack
usePackageDB SetupScriptOptions
options') ProgramDb
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 :: IO (Version, Maybe ComponentId, SetupScriptOptions)
cabalLibVersionToUse =
    case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (PackageId -> Bool
isCabalPkgId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (SetupScriptOptions -> [(ComponentId, PackageId)]
useDependencies SetupScriptOptions
options) of
      Just (ComponentId
unitId, PackageId
pkgId) -> do
        let version :: Version
version = PackageId -> Version
pkgVersion PackageId
pkgId
        Version -> BuildType -> IO ()
updateSetupScript Version
version BuildType
bt
        Version -> IO ()
writeSetupVersionFile Version
version
        forall (m :: * -> *) a. Monad m => a -> m a
return (Version
version, forall a. a -> Maybe a
Just ComponentId
unitId, SetupScriptOptions
options)
      Maybe (ComponentId, PackageId)
Nothing ->
        case SetupScriptOptions -> Maybe Version
useCabalSpecVersion SetupScriptOptions
options of
          Just Version
version -> do
            Version -> BuildType -> IO ()
updateSetupScript Version
version BuildType
bt
            Version -> IO ()
writeSetupVersionFile Version
version
            forall (m :: * -> *) a. Monad m => a -> m a
return (Version
version, forall a. Maybe a
Nothing, SetupScriptOptions
options)
          Maybe Version
Nothing  -> do
            Maybe Version
savedVer <- IO (Maybe Version)
savedVersion
            case Maybe Version
savedVer of
              Just Version
version | Version
version Version -> VersionRange -> Bool
`withinRange` SetupScriptOptions -> VersionRange
useCabalVersion SetupScriptOptions
options
                -> do Version -> BuildType -> IO ()
updateSetupScript Version
version BuildType
bt
                      -- Does the previously compiled setup executable
                      -- still exist and is it up-to date?
                      Bool
useExisting <- Version -> IO Bool
canUseExistingSetup Version
version
                      if Bool
useExisting
                        then forall (m :: * -> *) a. Monad m => a -> m a
return (Version
version, forall a. Maybe a
Nothing, SetupScriptOptions
options)
                        else IO (Version, Maybe ComponentId, SetupScriptOptions)
installedVersion
              Maybe Version
_ -> IO (Version, Maybe ComponentId, SetupScriptOptions)
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 -> IO Bool
canUseExistingSetup Version
version =
        if Bool
useCachedSetupExecutable
        then do
          ([Char]
_, [Char]
cachedSetupProgFile) <- SetupScriptOptions -> Version -> IO ([Char], [Char])
cachedSetupDirAndProg SetupScriptOptions
options Version
version
          [Char] -> IO Bool
doesFileExist [Char]
cachedSetupProgFile
        else
          Bool -> Bool -> Bool
(&&) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
setupProgFile [Char] -> [Char] -> IO Bool
`existsAndIsMoreRecentThan` [Char]
setupHs
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char]
setupProgFile [Char] -> [Char] -> IO Bool
`existsAndIsMoreRecentThan` [Char]
setupVersionFile

      writeSetupVersionFile :: Version -> IO ()
      writeSetupVersionFile :: Version -> IO ()
writeSetupVersionFile Version
version =
          [Char] -> [Char] -> IO ()
writeFile [Char]
setupVersionFile (forall a. Show a => a -> [Char]
show Version
version forall a. [a] -> [a] -> [a]
++ [Char]
"\n")

      installedVersion :: IO (Version, Maybe InstalledPackageId
                             ,SetupScriptOptions)
      installedVersion :: IO (Version, Maybe ComponentId, SetupScriptOptions)
installedVersion = do
        (Compiler
comp,    ProgramDb
progdb,  SetupScriptOptions
options')  <- SetupScriptOptions -> IO (Compiler, ProgramDb, SetupScriptOptions)
configureCompiler SetupScriptOptions
options
        (Version
version, Maybe ComponentId
mipkgid, SetupScriptOptions
options'') <- SetupScriptOptions
-> Compiler
-> ProgramDb
-> IO (Version, Maybe ComponentId, SetupScriptOptions)
installedCabalVersion SetupScriptOptions
options'
                                         Compiler
comp ProgramDb
progdb
        Version -> BuildType -> IO ()
updateSetupScript Version
version BuildType
bt
        Version -> IO ()
writeSetupVersionFile Version
version
        forall (m :: * -> *) a. Monad m => a -> m a
return (Version
version, Maybe ComponentId
mipkgid, SetupScriptOptions
options'')

      savedVersion :: IO (Maybe Version)
      savedVersion :: IO (Maybe Version)
savedVersion = do
        [Char]
versionString <- [Char] -> IO [Char]
readFile [Char]
setupVersionFile forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
""
        case forall a. Read a => ReadS a
reads [Char]
versionString of
          [(Version
version,[Char]
s)] | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace [Char]
s -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Version
version)
          [(Version, [Char])]
_                             -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

  -- | Update a Setup.hs script, creating it if necessary.
  updateSetupScript :: Version -> BuildType -> IO ()
  updateSetupScript :: Version -> BuildType -> IO ()
updateSetupScript Version
_ BuildType
Custom = do
    Bool
useHs  <- [Char] -> IO Bool
doesFileExist [Char]
customSetupHs
    Bool
useLhs <- [Char] -> IO Bool
doesFileExist [Char]
customSetupLhs
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
useHs Bool -> Bool -> Bool
|| Bool
useLhs) forall a b. (a -> b) -> a -> b
$ forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity
      [Char]
"Using 'build-type: Custom' but there is no Setup.hs or Setup.lhs script."
    let src :: [Char]
src = (if Bool
useHs then [Char]
customSetupHs else [Char]
customSetupLhs)
    Bool
srcNewer <- [Char]
src [Char] -> [Char] -> IO Bool
`moreRecentFile` [Char]
setupHs
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
srcNewer forall a b. (a -> b) -> a -> b
$ if Bool
useHs
                    then Verbosity -> [Char] -> [Char] -> IO ()
copyFileVerbose Verbosity
verbosity [Char]
src [Char]
setupHs
                    else PreProcessor -> [Char] -> [Char] -> Verbosity -> IO ()
runSimplePreProcessor PreProcessor
ppUnlit [Char]
src [Char]
setupHs Verbosity
verbosity
    where
      customSetupHs :: [Char]
customSetupHs   = SetupScriptOptions -> [Char]
workingDir SetupScriptOptions
options [Char] -> [Char] -> [Char]
</> [Char]
"Setup.hs"
      customSetupLhs :: [Char]
customSetupLhs  = SetupScriptOptions -> [Char]
workingDir SetupScriptOptions
options [Char] -> [Char] -> [Char]
</> [Char]
"Setup.lhs"

  updateSetupScript Version
cabalLibVersion BuildType
_ =
    Verbosity -> [Char] -> ByteString -> IO ()
rewriteFileLBS Verbosity
verbosity [Char]
setupHs (Version -> ByteString
buildTypeScript Version
cabalLibVersion)

  buildTypeScript :: Version -> BS.ByteString
  buildTypeScript :: Version -> ByteString
buildTypeScript Version
cabalLibVersion = case BuildType
bt of
    BuildType
Simple                                            -> ByteString
"import Distribution.Simple; main = defaultMain\n"
    BuildType
Configure | Version
cabalLibVersion forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
1,Int
3,Int
10] -> ByteString
"import Distribution.Simple; main = defaultMainWithHooks autoconfUserHooks\n"
              | Bool
otherwise                             -> ByteString
"import Distribution.Simple; main = defaultMainWithHooks defaultUserHooks\n"
    BuildType
Make                                              -> ByteString
"import Distribution.Make; main = defaultMain\n"
    BuildType
Custom                                            -> forall a. HasCallStack => [Char] -> a
error [Char]
"buildTypeScript Custom"

  installedCabalVersion :: SetupScriptOptions -> Compiler -> ProgramDb
                        -> IO (Version, Maybe InstalledPackageId
                              ,SetupScriptOptions)
  installedCabalVersion :: SetupScriptOptions
-> Compiler
-> ProgramDb
-> IO (Version, Maybe ComponentId, SetupScriptOptions)
installedCabalVersion SetupScriptOptions
options' Compiler
_ ProgramDb
_ | forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg forall a. Eq a => a -> a -> Bool
== [Char] -> PackageName
mkPackageName [Char]
"Cabal"
                                       Bool -> Bool -> Bool
&& BuildType
bt forall a. Eq a => a -> a -> Bool
== BuildType
Custom =
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall pkg. Package pkg => pkg -> Version
packageVersion PackageDescription
pkg, forall a. Maybe a
Nothing, SetupScriptOptions
options')
  installedCabalVersion SetupScriptOptions
options' Compiler
compiler ProgramDb
progdb = do
    InstalledPackageIndex
index <- SetupScriptOptions
-> Compiler -> ProgramDb -> IO InstalledPackageIndex
maybeGetInstalledPackages SetupScriptOptions
options' Compiler
compiler ProgramDb
progdb
    let cabalDepName :: PackageName
cabalDepName    = [Char] -> PackageName
mkPackageName [Char]
"Cabal"
        cabalDepVersion :: VersionRange
cabalDepVersion = SetupScriptOptions -> VersionRange
useCabalVersion SetupScriptOptions
options'
        options'' :: SetupScriptOptions
options''       = SetupScriptOptions
options' { usePackageIndex :: Maybe InstalledPackageIndex
usePackageIndex = forall a. a -> Maybe a
Just InstalledPackageIndex
index }
    case InstalledPackageIndex
-> PackageName
-> VersionRange
-> [(Version, [InstalledPackageInfo])]
PackageIndex.lookupDependency InstalledPackageIndex
index PackageName
cabalDepName VersionRange
cabalDepVersion of
      []   -> forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [Char]
"The package '" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
prettyShow (forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg)
                 forall a. [a] -> [a] -> [a]
++ [Char]
"' requires Cabal library version "
                 forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
prettyShow (SetupScriptOptions -> VersionRange
useCabalVersion SetupScriptOptions
options)
                 forall a. [a] -> [a] -> [a]
++ [Char]
" but no suitable version is installed."
      [(Version, [InstalledPackageInfo])]
pkgs -> let ipkginfo :: InstalledPackageInfo
ipkginfo = forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
err forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
safeHead forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Version) -> [a] -> a
bestVersion forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ [(Version, [InstalledPackageInfo])]
pkgs
                  err :: a
err = forall a. HasCallStack => [Char] -> a
error [Char]
"Distribution.Client.installedCabalVersion: empty version list"
              in forall (m :: * -> *) a. Monad m => a -> m a
return (forall pkg. Package pkg => pkg -> Version
packageVersion InstalledPackageInfo
ipkginfo
                        ,forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledPackageInfo -> ComponentId
IPI.installedComponentId forall a b. (a -> b) -> a -> b
$ InstalledPackageInfo
ipkginfo, SetupScriptOptions
options'')

  bestVersion :: (a -> Version) -> [a] -> a
  bestVersion :: forall a. (a -> Version) -> [a] -> a
bestVersion a -> Version
f = forall a. (a -> a -> Ordering) -> [a] -> a
firstMaximumBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Version -> (Bool, Bool, Bool, Version)
preference forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Version
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 :: forall a. (a -> a -> Ordering) -> [a] -> a
firstMaximumBy a -> a -> Ordering
_ []   =
        forall a. HasCallStack => [Char] -> a
error [Char]
"Distribution.Client.firstMaximumBy: empty list"
      firstMaximumBy a -> a -> Ordering
cmp [a]
xs =  forall a. (a -> a -> a) -> [a] -> a
foldl1' a -> a -> a
maxBy [a]
xs
        where
          maxBy :: a -> a -> a
maxBy a
x a
y = case a -> a -> Ordering
cmp a
x a
y of { Ordering
GT -> a
x; Ordering
EQ -> a
x; Ordering
LT -> a
y; }

      preference :: Version -> (Bool, Bool, Bool, Version)
preference Version
version   = (Bool
sameVersion, Bool
sameMajorVersion
                             ,Bool
stableVersion, Version
latestVersion)
        where
          sameVersion :: Bool
sameVersion      = Version
version forall a. Eq a => a -> a -> Bool
== Version
cabalVersion
          sameMajorVersion :: Bool
sameMajorVersion = Version -> [Int]
majorVersion Version
version forall a. Eq a => a -> a -> Bool
== Version -> [Int]
majorVersion Version
cabalVersion
          majorVersion :: Version -> [Int]
majorVersion     = forall a. Int -> [a] -> [a]
take Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> [Int]
versionNumbers
          stableVersion :: Bool
stableVersion    = case Version -> [Int]
versionNumbers Version
version of
                               (Int
_:Int
x:[Int]
_) -> forall a. Integral a => a -> Bool
even Int
x
                               [Int]
_       -> Bool
False
          latestVersion :: Version
latestVersion    = Version
version

  configureCompiler :: SetupScriptOptions
                    -> IO (Compiler, ProgramDb, SetupScriptOptions)
  configureCompiler :: SetupScriptOptions -> IO (Compiler, ProgramDb, SetupScriptOptions)
configureCompiler SetupScriptOptions
options' = do
    (Compiler
comp, ProgramDb
progdb) <- case SetupScriptOptions -> Maybe Compiler
useCompiler SetupScriptOptions
options' of
      Just Compiler
comp -> forall (m :: * -> *) a. Monad m => a -> m a
return (Compiler
comp, SetupScriptOptions -> ProgramDb
useProgramDb SetupScriptOptions
options')
      Maybe Compiler
Nothing   -> do (Compiler
comp, Platform
_, ProgramDb
progdb) <-
                        Maybe CompilerFlavor
-> Maybe [Char]
-> Maybe [Char]
-> ProgramDb
-> Verbosity
-> IO (Compiler, Platform, ProgramDb)
configCompilerEx (forall a. a -> Maybe a
Just CompilerFlavor
GHC) forall a. Maybe a
Nothing forall a. Maybe a
Nothing
                        (SetupScriptOptions -> ProgramDb
useProgramDb SetupScriptOptions
options') Verbosity
verbosity
                      forall (m :: * -> *) a. Monad m => a -> m a
return (Compiler
comp, ProgramDb
progdb)
    -- Whenever we need to call configureCompiler, we also need to access the
    -- package index, so let's cache it in SetupScriptOptions.
    InstalledPackageIndex
index <- SetupScriptOptions
-> Compiler -> ProgramDb -> IO InstalledPackageIndex
maybeGetInstalledPackages SetupScriptOptions
options' Compiler
comp ProgramDb
progdb
    forall (m :: * -> *) a. Monad m => a -> m a
return (Compiler
comp, ProgramDb
progdb, SetupScriptOptions
options' { useCompiler :: Maybe Compiler
useCompiler      = forall a. a -> Maybe a
Just Compiler
comp,
                                     usePackageIndex :: Maybe InstalledPackageIndex
usePackageIndex  = forall a. a -> Maybe a
Just InstalledPackageIndex
index,
                                     useProgramDb :: ProgramDb
useProgramDb = ProgramDb
progdb })

  -- | Path to the setup exe cache directory and path to the cached setup
  -- executable.
  cachedSetupDirAndProg :: SetupScriptOptions -> Version
                        -> IO (FilePath, FilePath)
  cachedSetupDirAndProg :: SetupScriptOptions -> Version -> IO ([Char], [Char])
cachedSetupDirAndProg SetupScriptOptions
options' Version
cabalLibVersion = do
    [Char]
cacheDir <- IO [Char]
defaultCacheDir
    let setupCacheDir :: [Char]
setupCacheDir       = [Char]
cacheDir [Char] -> [Char] -> [Char]
</> [Char]
"setup-exe-cache"
        cachedSetupProgFile :: [Char]
cachedSetupProgFile = [Char]
setupCacheDir
                              [Char] -> [Char] -> [Char]
</> ([Char]
"setup-" forall a. [a] -> [a] -> [a]
++ [Char]
buildTypeString forall a. [a] -> [a] -> [a]
++ [Char]
"-"
                                   forall a. [a] -> [a] -> [a]
++ [Char]
cabalVersionString forall a. [a] -> [a] -> [a]
++ [Char]
"-"
                                   forall a. [a] -> [a] -> [a]
++ [Char]
platformString forall a. [a] -> [a] -> [a]
++ [Char]
"-"
                                   forall a. [a] -> [a] -> [a]
++ [Char]
compilerVersionString)
                              [Char] -> [Char] -> [Char]
<.> Platform -> [Char]
exeExtension Platform
buildPlatform
    forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
setupCacheDir, [Char]
cachedSetupProgFile)
      where
        buildTypeString :: [Char]
buildTypeString       = forall a. Show a => a -> [Char]
show BuildType
bt
        cabalVersionString :: [Char]
cabalVersionString    = [Char]
"Cabal-" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
prettyShow Version
cabalLibVersion
        compilerVersionString :: [Char]
compilerVersionString = forall a. Pretty a => a -> [Char]
prettyShow forall a b. (a -> b) -> a -> b
$
                                forall b a. b -> (a -> b) -> Maybe a -> b
maybe CompilerId
buildCompilerId Compiler -> CompilerId
compilerId
                                  forall a b. (a -> b) -> a -> b
$ SetupScriptOptions -> Maybe Compiler
useCompiler SetupScriptOptions
options'
        platformString :: [Char]
platformString        = forall a. Pretty a => a -> [Char]
prettyShow Platform
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 :: SetupScriptOptions -> Version -> Maybe ComponentId -> IO [Char]
getCachedSetupExecutable SetupScriptOptions
options' Version
cabalLibVersion
                           Maybe ComponentId
maybeCabalLibInstalledPkgId = do
    ([Char]
setupCacheDir, [Char]
cachedSetupProgFile) <-
      SetupScriptOptions -> Version -> IO ([Char], [Char])
cachedSetupDirAndProg SetupScriptOptions
options' Version
cabalLibVersion
    Bool
cachedSetupExists <- [Char] -> IO Bool
doesFileExist [Char]
cachedSetupProgFile
    if Bool
cachedSetupExists
      then Verbosity -> [Char] -> IO ()
debug Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
           [Char]
"Found cached setup executable: " forall a. [a] -> [a] -> [a]
++ [Char]
cachedSetupProgFile
      else forall {a}. IO a -> IO a
criticalSection' forall a b. (a -> b) -> a -> b
$ do
        -- The cache may have been populated while we were waiting.
        Bool
cachedSetupExists' <- [Char] -> IO Bool
doesFileExist [Char]
cachedSetupProgFile
        if Bool
cachedSetupExists'
          then Verbosity -> [Char] -> IO ()
debug Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
               [Char]
"Found cached setup executable: " forall a. [a] -> [a] -> [a]
++ [Char]
cachedSetupProgFile
          else do
          Verbosity -> [Char] -> IO ()
debug Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [Char]
"Setup executable not found in the cache."
          [Char]
src <- SetupScriptOptions
-> Version -> Maybe ComponentId -> Bool -> IO [Char]
compileSetupExecutable SetupScriptOptions
options'
                 Version
cabalLibVersion Maybe ComponentId
maybeCabalLibInstalledPkgId Bool
True
          Verbosity -> Bool -> [Char] -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True [Char]
setupCacheDir
          Verbosity -> [Char] -> [Char] -> IO ()
installExecutableFile Verbosity
verbosity [Char]
src [Char]
cachedSetupProgFile
          -- Do not strip if we're using GHCJS, since the result may be a script
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ((forall a. Eq a => a -> a -> Bool
/=CompilerFlavor
GHCJS)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Compiler -> CompilerFlavor
compilerFlavor) forall a b. (a -> b) -> a -> b
$ SetupScriptOptions -> Maybe Compiler
useCompiler SetupScriptOptions
options') forall a b. (a -> b) -> a -> b
$
            Verbosity -> Platform -> ProgramDb -> [Char] -> IO ()
Strip.stripExe Verbosity
verbosity Platform
platform (SetupScriptOptions -> ProgramDb
useProgramDb SetupScriptOptions
options')
              [Char]
cachedSetupProgFile
    forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
cachedSetupProgFile
      where
        criticalSection' :: IO a -> IO a
criticalSection' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall a. Lock -> IO a -> IO a
criticalSection forall a b. (a -> b) -> a -> b
$ SetupScriptOptions -> Maybe Lock
setupCacheLock SetupScriptOptions
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 :: SetupScriptOptions
-> Version -> Maybe ComponentId -> Bool -> IO [Char]
compileSetupExecutable SetupScriptOptions
options' Version
cabalLibVersion Maybe ComponentId
maybeCabalLibInstalledPkgId
                         Bool
forceCompile = do
    Bool
setupHsNewer      <- [Char]
setupHs          [Char] -> [Char] -> IO Bool
`moreRecentFile` [Char]
setupProgFile
    Bool
cabalVersionNewer <- [Char]
setupVersionFile [Char] -> [Char] -> IO Bool
`moreRecentFile` [Char]
setupProgFile
    let outOfDate :: Bool
outOfDate = Bool
setupHsNewer Bool -> Bool -> Bool
|| Bool
cabalVersionNewer
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
outOfDate Bool -> Bool -> Bool
|| Bool
forceCompile) forall a b. (a -> b) -> a -> b
$ do
      Verbosity -> [Char] -> IO ()
debug Verbosity
verbosity [Char]
"Setup executable needs to be updated, compiling..."
      (Compiler
compiler, ProgramDb
progdb, SetupScriptOptions
options'') <- SetupScriptOptions -> IO (Compiler, ProgramDb, SetupScriptOptions)
configureCompiler SetupScriptOptions
options'
      let cabalPkgid :: PackageId
cabalPkgid = PackageName -> Version -> PackageId
PackageIdentifier ([Char] -> PackageName
mkPackageName [Char]
"Cabal") Version
cabalLibVersion
          (Program
program, [[Char]]
extraOpts)
            = case Compiler -> CompilerFlavor
compilerFlavor Compiler
compiler of
                      CompilerFlavor
GHCJS -> (Program
ghcjsProgram, [[Char]
"-build-runner"])
                      CompilerFlavor
_     -> (Program
ghcProgram,   [[Char]
"-threaded"])
          cabalDep :: [(ComponentId, PackageId)]
cabalDep = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ComponentId
ipkgid -> [(ComponentId
ipkgid, PackageId
cabalPkgid)])
                              Maybe ComponentId
maybeCabalLibInstalledPkgId

          -- With 'useDependenciesExclusive' we enforce the deps specified,
          -- so only the given ones can be used. Otherwise we allow the use
          -- of packages in the ambient environment, and add on a dep on the
          -- Cabal library (unless 'useDependencies' already contains one).
          --
          -- With 'useVersionMacros' we use a version CPP macros .h file.
          --
          -- Both of these options should be enabled for packages that have
          -- opted-in and declared a custom-settup stanza.
          --
          selectedDeps :: [(ComponentId, PackageId)]
selectedDeps | SetupScriptOptions -> Bool
useDependenciesExclusive SetupScriptOptions
options'
                                   = SetupScriptOptions -> [(ComponentId, PackageId)]
useDependencies SetupScriptOptions
options'
                       | Bool
otherwise = SetupScriptOptions -> [(ComponentId, PackageId)]
useDependencies SetupScriptOptions
options' forall a. [a] -> [a] -> [a]
++
                                     if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (PackageId -> Bool
isCabalPkgId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
                                        (SetupScriptOptions -> [(ComponentId, PackageId)]
useDependencies SetupScriptOptions
options')
                                     then []
                                     else [(ComponentId, PackageId)]
cabalDep
          addRenaming :: (ComponentId, b) -> (OpenUnitId, ModuleRenaming)
addRenaming (ComponentId
ipid, b
_) =
            -- Assert 'DefUnitId' invariant
            (DefUnitId -> OpenUnitId
Backpack.DefiniteUnitId (UnitId -> DefUnitId
unsafeMkDefUnitId (ComponentId -> UnitId
newSimpleUnitId ComponentId
ipid))
            ,ModuleRenaming
defaultRenaming)
          cppMacrosFile :: [Char]
cppMacrosFile = [Char]
setupDir [Char] -> [Char] -> [Char]
</> [Char]
"setup_macros.h"
          ghcOptions :: GhcOptions
ghcOptions = forall a. Monoid a => a
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 Verbosity
ghcOptVerbosity       = forall a. a -> Flag a
Flag (forall a. Ord a => a -> a -> a
min Verbosity
verbosity Verbosity
normal)
            , ghcOptMode :: Flag GhcMode
ghcOptMode            = forall a. a -> Flag a
Flag GhcMode
GhcModeMake
            , ghcOptInputFiles :: NubListR [Char]
ghcOptInputFiles      = forall a. Ord a => [a] -> NubListR a
toNubListR [[Char]
setupHs]
            , ghcOptOutputFile :: Flag [Char]
ghcOptOutputFile      = forall a. a -> Flag a
Flag [Char]
setupProgFile
            , ghcOptObjDir :: Flag [Char]
ghcOptObjDir          = forall a. a -> Flag a
Flag [Char]
setupDir
            , ghcOptHiDir :: Flag [Char]
ghcOptHiDir           = forall a. a -> Flag a
Flag [Char]
setupDir
            , ghcOptSourcePathClear :: Flag Bool
ghcOptSourcePathClear = forall a. a -> Flag a
Flag Bool
True
            , ghcOptSourcePath :: NubListR [Char]
ghcOptSourcePath      = case BuildType
bt of
                                      BuildType
Custom -> forall a. Ord a => [a] -> NubListR a
toNubListR [SetupScriptOptions -> [Char]
workingDir SetupScriptOptions
options']
                                      BuildType
_      -> forall a. Monoid a => a
mempty
            , ghcOptPackageDBs :: PackageDBStack
ghcOptPackageDBs      = SetupScriptOptions -> PackageDBStack
usePackageDB SetupScriptOptions
options''
            , ghcOptHideAllPackages :: Flag Bool
ghcOptHideAllPackages = forall a. a -> Flag a
Flag (SetupScriptOptions -> Bool
useDependenciesExclusive SetupScriptOptions
options')
            , ghcOptCabal :: Flag Bool
ghcOptCabal           = forall a. a -> Flag a
Flag (SetupScriptOptions -> Bool
useDependenciesExclusive SetupScriptOptions
options')
            , ghcOptPackages :: NubListR (OpenUnitId, ModuleRenaming)
ghcOptPackages        = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {b}. (ComponentId, b) -> (OpenUnitId, ModuleRenaming)
addRenaming [(ComponentId, PackageId)]
selectedDeps
            , ghcOptCppIncludes :: NubListR [Char]
ghcOptCppIncludes     = forall a. Ord a => [a] -> NubListR a
toNubListR [ [Char]
cppMacrosFile
                                                 | SetupScriptOptions -> Bool
useVersionMacros SetupScriptOptions
options' ]
            , ghcOptExtra :: [[Char]]
ghcOptExtra           = [[Char]]
extraOpts
            }
      let ghcCmdLine :: [[Char]]
ghcCmdLine = Compiler -> Platform -> GhcOptions -> [[Char]]
renderGhcOptions Compiler
compiler Platform
platform GhcOptions
ghcOptions
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SetupScriptOptions -> Bool
useVersionMacros SetupScriptOptions
options') forall a b. (a -> b) -> a -> b
$
        Verbosity -> [Char] -> [Char] -> IO ()
rewriteFileEx Verbosity
verbosity [Char]
cppMacrosFile
          forall a b. (a -> b) -> a -> b
$ Version -> [PackageId] -> [Char]
generatePackageVersionMacros (PackageId -> Version
pkgVersion forall a b. (a -> b) -> a -> b
$ PackageDescription -> PackageId
package PackageDescription
pkg) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(ComponentId, PackageId)]
selectedDeps)
      case SetupScriptOptions -> Maybe Handle
useLoggingHandle SetupScriptOptions
options of
        Maybe Handle
Nothing          -> Verbosity -> Program -> ProgramDb -> [[Char]] -> IO ()
runDbProgram Verbosity
verbosity Program
program ProgramDb
progdb [[Char]]
ghcCmdLine

        -- If build logging is enabled, redirect compiler output to
        -- the log file.
        (Just Handle
logHandle) -> do [Char]
output <- Verbosity -> Program -> ProgramDb -> [[Char]] -> IO [Char]
getDbProgramOutput Verbosity
verbosity Program
program
                                         ProgramDb
progdb [[Char]]
ghcCmdLine
                               Handle -> [Char] -> IO ()
hPutStr Handle
logHandle [Char]
output
    forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
setupProgFile


isCabalPkgId :: PackageIdentifier -> Bool
isCabalPkgId :: PackageId -> Bool
isCabalPkgId (PackageIdentifier PackageName
pname Version
_) = PackageName
pname forall a. Eq a => a -> a -> Bool
== [Char] -> PackageName
mkPackageName [Char]
"Cabal"