cabal-install/src/Distribution/Client/SetupWrapper.hs

   1 {-# LANGUAGE CPP #-}
   2 {-# LANGUAGE DataKinds #-}
   3 {-# LANGUAGE FlexibleContexts #-}
   4 {-# LANGUAGE OverloadedStrings #-}
   5 {- FOURMOLU_DISABLE -}
   6
   7 -----------------------------------------------------------------------------
   8
   9 -- |
  10 -- Module      :  Distribution.Client.SetupWrapper
  11 -- Copyright   :  (c) The University of Glasgow 2006,
  12 --                    Duncan Coutts 2008
  13 --
  14 -- Maintainer  :  cabal-devel@haskell.org
  15 -- Stability   :  alpha
  16 -- Portability :  portable
  17 --
  18 -- An interface to building and installing Cabal packages.
  19 -- If the @Built-Type@ field is specified as something other than
  20 -- 'Custom', and the current version of Cabal is acceptable, this performs
  21 -- setup actions directly.  Otherwise it builds the setup script and
  22 -- runs it with the given arguments.
  23 module Distribution.Client.SetupWrapper
  24   ( getSetup
  25   , runSetup
  26   , runSetupCommand
  27   , setupWrapper
  28   , SetupScriptOptions (..)
  29   , defaultSetupScriptOptions
  30   ) where
  31
  32 import Distribution.Client.Compat.Prelude
  33 import Prelude ()
  34
  35 import qualified Distribution.Backpack as Backpack
  36 import Distribution.CabalSpecVersion (cabalSpecMinimumLibraryVersion)
  37 import Distribution.Compiler
  38   ( CompilerFlavor (GHC, GHCJS)
  39   , buildCompilerId
  40   )
  41 import qualified Distribution.Make as Make
  42 import Distribution.Package
  43   ( ComponentId
  44   , PackageId
  45   , PackageIdentifier (..)
  46   , mkPackageName
  47   , newSimpleUnitId
  48   , packageName
  49   , packageVersion
  50   , unsafeMkDefUnitId
  51   )
  52 import Distribution.PackageDescription
  53   ( BuildType (..)
  54   , GenericPackageDescription (packageDescription)
  55   , PackageDescription (..)
  56   , buildType
  57   , specVersion
  58   )
  59 import qualified Distribution.Simple as Simple
  60 import Distribution.Simple.Build.Macros
  61   ( generatePackageVersionMacros
  62   )
  63 import Distribution.Simple.BuildPaths
  64   ( defaultDistPref
  65   , exeExtension
  66   )
  67 import Distribution.Simple.Compiler
  68   ( Compiler (compilerId)
  69   , PackageDB (..)
  70   , PackageDBStack
  71   , compilerFlavor
  72   )
  73 import Distribution.Simple.Configure
  74   ( configCompilerEx
  75   )
  76 import Distribution.Simple.PackageDescription
  77   ( readGenericPackageDescription
  78   )
  79 import Distribution.Simple.PreProcess
  80   ( ppUnlit
  81   , runSimplePreProcessor
  82   )
  83 import Distribution.Simple.Program
  84   ( ProgramDb
  85   , emptyProgramDb
  86   , getDbProgramOutputCwd
  87   , getProgramSearchPath
  88   , ghcProgram
  89   , ghcjsProgram
  90   , runDbProgramCwd
  91   )
  92 import Distribution.Simple.Program.Db
  93   ( prependProgramSearchPath
  94   , progOverrideEnv
  95   )
  96 import Distribution.Simple.Program.Find
  97   ( programSearchPathAsPATHVar
  98   )
  99 import Distribution.Simple.Program.Run
 100   ( getEffectiveEnvironment
 101   )
 102 import qualified Distribution.Simple.Program.Strip as Strip
 103 import Distribution.Types.ModuleRenaming (defaultRenaming)
 104 import Distribution.Version
 105   ( Version
 106   , VersionRange
 107   , anyVersion
 108   , intersectVersionRanges
 109   , mkVersion
 110   , orLaterVersion
 111   , versionNumbers
 112   , withinRange
 113   )
 114
 115 import Distribution.Client.Config
 116   ( defaultCacheDir
 117   )
 118 import Distribution.Client.IndexUtils
 119   ( getInstalledPackages
 120   )
 121 import Distribution.Client.JobControl
 122   ( Lock
 123   , criticalSection
 124   )
 125 import Distribution.Client.Types
 126 import Distribution.Client.Utils
 127   ( existsAndIsMoreRecentThan
 128 #ifdef mingw32_HOST_OS
 129   , canonicalizePathNoThrow
 130 #endif
 131   , moreRecentFile
 132   , tryCanonicalizePath
 133   , withEnv
 134   , withEnvOverrides
 135   , withExtraPathEnv
 136   )
 137 import Distribution.Utils.Path
 138   hiding ( (</>), (<.>) )
 139 import qualified Distribution.Utils.Path as Cabal.Path
 140 import qualified Distribution.InstalledPackageInfo as IPI
 141 import Distribution.Simple.Command
 142   ( CommandUI (..)
 143   , commandShowOptions
 144   )
 145 import Distribution.Simple.PackageIndex (InstalledPackageIndex)
 146 import qualified Distribution.Simple.PackageIndex as PackageIndex
 147 import Distribution.Simple.Program.GHC
 148   ( GhcMode (..)
 149   , GhcOptions (..)
 150   , renderGhcOptions
 151   )
 152 import Distribution.Simple.Setup
 153   ( Flag (..), CommonSetupFlags (..), GlobalFlags (..)
 154   )
 155 import Distribution.Simple.Utils
 156   ( cabalVersion
 157   , copyFileVerbose
 158   , createDirectoryIfMissingVerbose
 159   , debug
 160   , die'
 161   , dieWithException
 162   , info
 163   , infoNoWrap
 164   , installExecutableFile
 165   , maybeExit
 166   , rawSystemProc
 167   , rewriteFileEx
 168   , rewriteFileLBS
 169   , tryFindPackageDesc
 170   )
 171 import Distribution.Utils.Generic
 172   ( safeHead
 173   )
 174
 175 import Distribution.Compat.Stack
 176 import Distribution.ReadE
 177 import Distribution.System (Platform (..), buildPlatform)
 178 import Distribution.Utils.NubList
 179   ( toNubListR
 180   )
 181 import Distribution.Verbosity
 182
 183 import Data.List (foldl1')
 184 import qualified Data.Map.Lazy as Map
 185 import Distribution.Simple.Setup (globalCommand)
 186 import Distribution.Client.Compat.ExecutablePath (getExecutablePath)
 187 import Distribution.Compat.Process (proc)
 188 import System.Directory (doesFileExist)
 189 import System.FilePath ((<.>), (</>))
 190 import System.IO (Handle, hPutStr)
 191 import System.Process (StdStream (..))
 192 import qualified System.Process as Process
 193
 194 import qualified Data.ByteString.Lazy as BS
 195 import Distribution.Client.Errors
 196
 197 #ifdef mingw32_HOST_OS
 198 import Distribution.Simple.Utils
 199          ( withTempDirectory )
 200
 201 import Control.Exception   ( bracket )
 202 import System.FilePath     ( equalFilePath, takeDirectory )
 203 import System.Directory    ( doesDirectoryExist )
 204 import qualified System.Win32 as Win32
 205 #endif
 206
 207 -- | @Setup@ encapsulates the outcome of configuring a setup method to build a
 208 -- particular package.
 209 data Setup = Setup
 210   { setupMethod :: SetupMethod
 211   , setupScriptOptions :: SetupScriptOptions
 212   , setupVersion :: Version
 213   , setupBuildType :: BuildType
 214   , setupPackage :: PackageDescription
 215   }
 216
 217 -- | @SetupMethod@ represents one of the methods used to run Cabal commands.
 218 data SetupMethod
 219   = -- | run Cabal commands through \"cabal\" in the
 220     -- current process
 221     InternalMethod
 222   | -- | run Cabal commands through \"cabal\" as a
 223     -- child process
 224     SelfExecMethod
 225   | -- | run Cabal commands through a custom \"Setup\" executable
 226     ExternalMethod FilePath
 227
 228 -- TODO: The 'setupWrapper' and 'SetupScriptOptions' should be split into two
 229 -- parts: one that has no policy and just does as it's told with all the
 230 -- explicit options, and an optional initial part that applies certain
 231 -- policies (like if we should add the Cabal lib as a dep, and if so which
 232 -- version). This could be structured as an action that returns a fully
 233 -- elaborated 'SetupScriptOptions' containing no remaining policy choices.
 234 --
 235 -- See also the discussion at https://github.com/haskell/cabal/pull/3094
 236
 237 -- | @SetupScriptOptions@ are options used to configure and run 'Setup', as
 238 -- opposed to options given to the Cabal command at runtime.
 239 data SetupScriptOptions = SetupScriptOptions
 240   { useCabalVersion :: VersionRange
 241   -- ^ The version of the Cabal library to use (if 'useDependenciesExclusive'
 242   -- is not set). A suitable version of the Cabal library must be installed
 243   -- (or for some build-types be the one cabal-install was built with).
 244   --
 245   -- The version found also determines the version of the Cabal specification
 246   -- that we us for talking to the Setup.hs, unless overridden by
 247   -- 'useCabalSpecVersion'.
 248   , useCabalSpecVersion :: Maybe Version
 249   -- ^ This is the version of the Cabal specification that we believe that
 250   -- this package uses. This affects the semantics and in particular the
 251   -- Setup command line interface.
 252   --
 253   -- This is similar to 'useCabalVersion' but instead of probing the system
 254   -- for a version of the /Cabal library/ you just say exactly which version
 255   -- of the /spec/ we will use. Using this also avoid adding the Cabal
 256   -- library as an additional dependency, so add it to 'useDependencies'
 257   -- if needed.
 258   , useCompiler :: Maybe Compiler
 259   , usePlatform :: Maybe Platform
 260   , usePackageDB :: PackageDBStack
 261   , usePackageIndex :: Maybe InstalledPackageIndex
 262   , useProgramDb :: ProgramDb
 263   , useDistPref :: SymbolicPath Pkg (Dir Dist)
 264   , useLoggingHandle :: Maybe Handle
 265   , useWorkingDir :: Maybe (SymbolicPath CWD (Dir Pkg))
 266   , useExtraPathEnv :: [FilePath]
 267   -- ^ Extra things to add to PATH when invoking the setup script.
 268   , useExtraEnvOverrides :: [(String, Maybe FilePath)]
 269   -- ^ Extra environment variables paired with overrides, where
 270   --
 271   -- * @'Just' v@ means \"set the environment variable's value to @v@\".
 272   -- * 'Nothing' means \"unset the environment variable\".
 273   , forceExternalSetupMethod :: Bool
 274   , useDependencies :: [(ComponentId, PackageId)]
 275   -- ^ List of dependencies to use when building Setup.hs.
 276   , useDependenciesExclusive :: Bool
 277   -- ^ Is the list of setup dependencies exclusive?
 278   --
 279   -- When this is @False@, if we compile the Setup.hs script we do so with the
 280   -- list in 'useDependencies' but all other packages in the environment are
 281   -- also visible. A suitable version of @Cabal@ library (see
 282   -- 'useCabalVersion') is also added to the list of dependencies, unless
 283   -- 'useDependencies' already contains a Cabal dependency.
 284   --
 285   -- When @True@, only the 'useDependencies' packages are used, with other
 286   -- packages in the environment hidden.
 287   --
 288   -- This feature is here to support the setup stanza in .cabal files that
 289   -- specifies explicit (and exclusive) dependencies, as well as the old
 290   -- style with no dependencies.
 291   , useVersionMacros :: Bool
 292   -- ^ Should we build the Setup.hs with CPP version macros available?
 293   -- We turn this on when we have a setup stanza in .cabal that declares
 294   -- explicit setup dependencies.
 295   , -- Used only by 'cabal clean' on Windows.
 296     --
 297     -- Note: win32 clean hack
 298     -------------------------
 299     -- On Windows, running './dist/setup/setup clean' doesn't work because the
 300     -- setup script will try to delete itself (which causes it to fail horribly,
 301     -- unlike on Linux). So we have to move the setup exe out of the way first
 302     -- and then delete it manually. This applies only to the external setup
 303     -- method.
 304     useWin32CleanHack :: Bool
 305   , -- Used only when calling setupWrapper from parallel code to serialise
 306     -- access to the setup cache; should be Nothing otherwise.
 307     --
 308     -- Note: setup exe cache
 309     ------------------------
 310     -- When we are installing in parallel, we always use the external setup
 311     -- method. Since compiling the setup script each time adds noticeable
 312     -- overhead, we use a shared setup script cache
 313     -- ('$XDG_CACHE_HOME/cabal/setup-exe-cache'). For each (compiler, platform, Cabal
 314     -- version) combination the cache holds a compiled setup script
 315     -- executable. This only affects the Simple build type; for the Custom,
 316     -- Configure and Make build types we always compile the setup script anew.
 317     setupCacheLock :: Maybe Lock
 318   , isInteractive :: Bool
 319   -- ^ Is the task we are going to run an interactive foreground task,
 320   -- or an non-interactive background task? Based on this flag we
 321   -- decide whether or not to delegate ctrl+c to the spawned task
 322   }
 323
 324 defaultSetupScriptOptions :: SetupScriptOptions
 325 defaultSetupScriptOptions =
 326   SetupScriptOptions
 327     { useCabalVersion = anyVersion
 328     , useCabalSpecVersion = Nothing
 329     , useCompiler = Nothing
 330     , usePlatform = Nothing
 331     , usePackageDB = [GlobalPackageDB, UserPackageDB]
 332     , usePackageIndex = Nothing
 333     , useDependencies = []
 334     , useDependenciesExclusive = False
 335     , useVersionMacros = False
 336     , useProgramDb = emptyProgramDb
 337     , useDistPref = defaultDistPref
 338     , useLoggingHandle = Nothing
 339     , useWorkingDir = Nothing
 340     , useExtraPathEnv = []
 341     , useExtraEnvOverrides = []
 342     , useWin32CleanHack = False
 343     , forceExternalSetupMethod = False
 344     , setupCacheLock = Nothing
 345     , isInteractive = False
 346     }
 347
 348 workingDir :: SetupScriptOptions -> FilePath
 349 workingDir options = case useWorkingDir options of
 350   Just dir
 351     | let fp = getSymbolicPath dir
 352     , not $ null fp
 353     -> fp
 354   _ -> "."
 355
 356 -- | A @SetupRunner@ implements a 'SetupMethod'.
 357 type SetupRunner =
 358   Verbosity
 359   -> SetupScriptOptions
 360   -> BuildType
 361   -> [String]
 362   -> IO ()
 363
 364 -- | Prepare to build a package by configuring a 'SetupMethod'. The returned
 365 -- 'Setup' object identifies the method. The 'SetupScriptOptions' may be changed
 366 -- during the configuration process; the final values are given by
 367 -- 'setupScriptOptions'.
 368 getSetup
 369   :: Verbosity
 370   -> SetupScriptOptions
 371   -> Maybe PackageDescription
 372   -> IO Setup
 373 getSetup verbosity options mpkg = do
 374   pkg <- maybe getPkg return mpkg
 375   let options' =
 376         options
 377           { useCabalVersion =
 378               intersectVersionRanges
 379                 (useCabalVersion options)
 380                 (orLaterVersion (mkVersion (cabalSpecMinimumLibraryVersion (specVersion pkg))))
 381           }
 382       buildType' = buildType pkg
 383   (version, method, options'') <-
 384     getSetupMethod verbosity options' pkg buildType'
 385   return
 386     Setup
 387       { setupMethod = method
 388       , setupScriptOptions = options''
 389       , setupVersion = version
 390       , setupBuildType = buildType'
 391       , setupPackage = pkg
 392       }
 393   where
 394     mbWorkDir = useWorkingDir options
 395     getPkg =
 396       (relativeSymbolicPath <$> tryFindPackageDesc verbosity mbWorkDir)
 397         >>= readGenericPackageDescription verbosity mbWorkDir
 398         >>= return . packageDescription
 399
 400 -- | Decide if we're going to be able to do a direct internal call to the
 401 -- entry point in the Cabal library or if we're going to have to compile
 402 -- and execute an external Setup.hs script.
 403 getSetupMethod
 404   :: Verbosity
 405   -> SetupScriptOptions
 406   -> PackageDescription
 407   -> BuildType
 408   -> IO (Version, SetupMethod, SetupScriptOptions)
 409 getSetupMethod verbosity options pkg buildType'
 410   | buildType' == Custom
 411       || buildType' == Hooks
 412       || maybe False (cabalVersion /=) (useCabalSpecVersion options)
 413       || not (cabalVersion `withinRange` useCabalVersion options) =
 414       getExternalSetupMethod verbosity options pkg buildType'
 415   | isJust (useLoggingHandle options)
 416       -- Forcing is done to use an external process e.g. due to parallel
 417       -- build concerns.
 418       || forceExternalSetupMethod options =
 419       return (cabalVersion, SelfExecMethod, options)
 420   | otherwise = return (cabalVersion, InternalMethod, options)
 421
 422 runSetupMethod :: WithCallStack (SetupMethod -> SetupRunner)
 423 runSetupMethod InternalMethod = internalSetupMethod
 424 runSetupMethod (ExternalMethod path) = externalSetupMethod path
 425 runSetupMethod SelfExecMethod = selfExecSetupMethod
 426
 427 -- | Run a configured 'Setup' with specific arguments.
 428 runSetup
 429   :: Verbosity
 430   -> Setup
 431   -> [String]
 432   -- ^ command-line arguments
 433   -> IO ()
 434 runSetup verbosity setup args0 = do
 435   let method = setupMethod setup
 436       options = setupScriptOptions setup
 437       bt = setupBuildType setup
 438       args = verbosityHack (setupVersion setup) args0
 439   when (verbosity >= deafening {- avoid test if not debug -} && args /= args0) $
 440     infoNoWrap verbose $
 441       "Applied verbosity hack:\n"
 442         ++ "  Before: "
 443         ++ show args0
 444         ++ "\n"
 445         ++ "  After:  "
 446         ++ show args
 447         ++ "\n"
 448   runSetupMethod method verbosity options bt args
 449
 450 -- | This is a horrible hack to make sure passing fancy verbosity
 451 -- flags (e.g., @-v'info +callstack'@) doesn't break horribly on
 452 -- old Setup.  We can't do it in 'filterConfigureFlags' because
 453 -- verbosity applies to ALL commands.
 454 verbosityHack :: Version -> [String] -> [String]
 455 verbosityHack ver args0
 456   | ver >= mkVersion [2, 1] = args0
 457   | otherwise = go args0
 458   where
 459     go (('-' : 'v' : rest) : args)
 460       | Just rest' <- munch rest = ("-v" ++ rest') : go args
 461     go (('-' : '-' : 'v' : 'e' : 'r' : 'b' : 'o' : 's' : 'e' : '=' : rest) : args)
 462       | Just rest' <- munch rest = ("--verbose=" ++ rest') : go args
 463     go ("--verbose" : rest : args)
 464       | Just rest' <- munch rest = "--verbose" : rest' : go args
 465     go rest@("--" : _) = rest
 466     go (arg : args) = arg : go args
 467     go [] = []
 468
 469     munch rest =
 470       case runReadE flagToVerbosity rest of
 471         Right v
 472           | ver < mkVersion [2, 0]
 473           , verboseHasFlags v ->
 474               -- We could preserve the prefix, but since we're assuming
 475               -- it's Cabal's verbosity flag, we can assume that
 476               -- any format is OK
 477               Just (showForCabal (verboseNoFlags v))
 478           | ver < mkVersion [2, 1]
 479           , isVerboseTimestamp v ->
 480               -- +timestamp wasn't yet available in Cabal-2.0.0
 481               Just (showForCabal (verboseNoTimestamp v))
 482         _ -> Nothing
 483
 484 -- | Run a command through a configured 'Setup'.
 485 runSetupCommand
 486   :: Verbosity
 487   -> Setup
 488   -> CommandUI flags
 489   -- ^ command definition
 490   -> (flags -> CommonSetupFlags)
 491   -> flags
 492   -- ^ command flags
 493   -> [String]
 494   -- ^ extra command-line arguments
 495   -> IO ()
 496 runSetupCommand verbosity setup cmd getCommonFlags flags extraArgs =
 497   -- The 'setupWorkingDir' flag corresponds to a global argument which needs to
 498   -- be passed before the individual command (e.g. 'configure' or 'build').
 499   let common = getCommonFlags flags
 500       globalFlags = mempty { globalWorkingDir = setupWorkingDir common }
 501       args = commandShowOptions (globalCommand []) globalFlags
 502           ++ (commandName cmd : commandShowOptions cmd flags ++ extraArgs)
 503   in runSetup verbosity setup args
 504
 505 -- | Configure a 'Setup' and run a command in one step. The command flags
 506 -- may depend on the Cabal library version in use.
 507 setupWrapper
 508   :: Verbosity
 509   -> SetupScriptOptions
 510   -> Maybe PackageDescription
 511   -> CommandUI flags
 512   -> (flags -> CommonSetupFlags)
 513   -> (Version -> flags)
 514   -- ^ produce command flags given the Cabal library version
 515   -> (Version -> [String])
 516   -> IO ()
 517 setupWrapper verbosity options mpkg cmd getCommonFlags getFlags getExtraArgs = do
 518   setup <- getSetup verbosity options mpkg
 519   let version = setupVersion setup
 520       flags = getFlags version
 521       extraArgs = getExtraArgs version
 522   runSetupCommand
 523     verbosity
 524     setup
 525     cmd
 526     getCommonFlags
 527     flags
 528     extraArgs
 529
 530 -- ------------------------------------------------------------
 531
 532 -- * Internal SetupMethod
 533
 534 -- ------------------------------------------------------------
 535
 536 -- | Run a Setup script by directly invoking the @Cabal@ library.
 537 internalSetupMethod :: SetupRunner
 538 internalSetupMethod verbosity options bt args = do
 539   info verbosity $
 540     "Using internal setup method with build-type "
 541       ++ show bt
 542       ++ " and args:\n  "
 543       ++ show args
 544   -- NB: we do not set the working directory of the process here, because
 545   -- we will instead pass the -working-dir flag when invoking the Setup script.
 546   -- Note that the Setup script is guaranteed to support this flag, because
 547   -- the logic in 'getSetupMethod' guarantees we have an up-to-date Cabal version.
 548   --
 549   -- In the future, it would be desirable to also stop relying on the following
 550   -- pieces of process-global state, as this would allow us to use this internal
 551   -- setup method in concurrent contexts.
 552   withEnv "HASKELL_DIST_DIR" (getSymbolicPath $ useDistPref options) $
 553     withExtraPathEnv (useExtraPathEnv options) $
 554       withEnvOverrides (useExtraEnvOverrides options) $
 555         buildTypeAction bt args
 556
 557 buildTypeAction :: BuildType -> ([String] -> IO ())
 558 buildTypeAction Simple = Simple.defaultMainArgs
 559 buildTypeAction Configure =
 560   Simple.defaultMainWithHooksArgs
 561     Simple.autoconfUserHooks
 562 buildTypeAction Make = Make.defaultMainArgs
 563 buildTypeAction Hooks  = error "buildTypeAction Hooks"
 564 buildTypeAction Custom = error "buildTypeAction Custom"
 565
 566 invoke :: Verbosity -> FilePath -> [String] -> SetupScriptOptions -> IO ()
 567 invoke verbosity path args options = do
 568   info verbosity $ unwords (path : args)
 569   case useLoggingHandle options of
 570     Nothing -> return ()
 571     Just logHandle -> info verbosity $ "Redirecting build log to " ++ show logHandle
 572
 573   progDb <- prependProgramSearchPath verbosity (useExtraPathEnv options) (useExtraEnvOverrides options) (useProgramDb options)
 574
 575   searchpath <-
 576     programSearchPathAsPATHVar $ getProgramSearchPath progDb
 577
 578   env <-
 579     getEffectiveEnvironment $
 580       [ ("PATH", Just searchpath)
 581       , ("HASKELL_DIST_DIR", Just (getSymbolicPath $ useDistPref options))
 582       ]
 583         ++ progOverrideEnv progDb
 584
 585   let loggingHandle = case useLoggingHandle options of
 586         Nothing -> Inherit
 587         Just hdl -> UseHandle hdl
 588       cp =
 589         (proc path args)
 590           { Process.cwd = fmap getSymbolicPath $ useWorkingDir options
 591           , Process.env = env
 592           , Process.std_out = loggingHandle
 593           , Process.std_err = loggingHandle
 594           , Process.delegate_ctlc = isInteractive options
 595           }
 596   maybeExit $ rawSystemProc verbosity cp
 597
 598 -- ------------------------------------------------------------
 599
 600 -- * Self-Exec SetupMethod
 601
 602 -- ------------------------------------------------------------
 603
 604 selfExecSetupMethod :: SetupRunner
 605 selfExecSetupMethod verbosity options bt args0 = do
 606   let args =
 607         [ "act-as-setup"
 608         , "--build-type=" ++ prettyShow bt
 609         , "--"
 610         ]
 611           ++ args0
 612   info verbosity $
 613     "Using self-exec internal setup method with build-type "
 614       ++ show bt
 615       ++ " and args:\n  "
 616       ++ show args
 617   path <- getExecutablePath
 618   invoke verbosity path args options
 619
 620 -- ------------------------------------------------------------
 621
 622 -- * External SetupMethod
 623
 624 -- ------------------------------------------------------------
 625
 626 externalSetupMethod :: WithCallStack (FilePath -> SetupRunner)
 627 externalSetupMethod path verbosity options _ args =
 628 #ifndef mingw32_HOST_OS
 629   invoke
 630     verbosity
 631     path
 632     args
 633     options
 634 #else
 635     -- See 'Note: win32 clean hack' above.
 636     if useWin32CleanHack options
 637       then invokeWithWin32CleanHack path
 638       else invoke' path
 639   where
 640     invoke' p = invoke verbosity p args options
 641
 642     invokeWithWin32CleanHack origPath = do
 643       info verbosity $ "Using the Win32 clean hack."
 644       -- Recursively removes the temp dir on exit.
 645       withTempDirectory verbosity (workingDir options) "cabal-tmp" $ \tmpDir ->
 646         bracket
 647           (moveOutOfTheWay tmpDir origPath)
 648           (\tmpPath -> maybeRestore origPath tmpPath)
 649           (\tmpPath -> invoke' tmpPath)
 650
 651     moveOutOfTheWay tmpDir origPath = do
 652       let tmpPath = tmpDir </> "setup" <.> exeExtension buildPlatform
 653       Win32.moveFile origPath tmpPath
 654       return tmpPath
 655
 656     maybeRestore origPath tmpPath = do
 657       let origPathDir = takeDirectory origPath
 658       origPathDirExists <- doesDirectoryExist origPathDir
 659       -- 'setup clean' didn't complete, 'dist/setup' still exists.
 660       when origPathDirExists $
 661         Win32.moveFile tmpPath origPath
 662
 663 #endif
 664
 665 getExternalSetupMethod
 666   :: Verbosity
 667   -> SetupScriptOptions
 668   -> PackageDescription
 669   -> BuildType
 670   -> IO (Version, SetupMethod, SetupScriptOptions)
 671 getExternalSetupMethod verbosity options pkg bt = do
 672   debug verbosity $ "Using external setup method with build-type " ++ show bt
 673   debug verbosity $
 674     "Using explicit dependencies: "
 675       ++ show (useDependenciesExclusive options)
 676   createDirectoryIfMissingVerbose verbosity True $ i setupDir
 677   (cabalLibVersion, mCabalLibInstalledPkgId, options') <- cabalLibVersionToUse
 678   debug verbosity $ "Using Cabal library version " ++ prettyShow cabalLibVersion
 679   path <-
 680     if useCachedSetupExecutable
 681       then
 682         getCachedSetupExecutable
 683           options'
 684           cabalLibVersion
 685           mCabalLibInstalledPkgId
 686       else
 687         compileSetupExecutable
 688           options'
 689           cabalLibVersion
 690           mCabalLibInstalledPkgId
 691           False
 692
 693   -- Since useWorkingDir can change the relative path, the path argument must
 694   -- be turned into an absolute path. On some systems, runProcess' will take
 695   -- path as relative to the new working directory instead of the current
 696   -- working directory.
 697   path' <- tryCanonicalizePath path
 698
 699   -- See 'Note: win32 clean hack' above.
 700 #ifdef mingw32_HOST_OS
 701   -- setupProgFile may not exist if we're using a cached program
 702   setupProgFile' <- canonicalizePathNoThrow $ i setupProgFile
 703   let win32CleanHackNeeded =
 704         (useWin32CleanHack options)
 705           -- Skip when a cached setup script is used.
 706           && setupProgFile' `equalFilePath` path'
 707 #else
 708   let win32CleanHackNeeded = False
 709 #endif
 710   let options'' = options'{useWin32CleanHack = win32CleanHackNeeded}
 711
 712   return (cabalLibVersion, ExternalMethod path', options'')
 713   where
 714     mbWorkDir = useWorkingDir options
 715     -- See Note [Symbolic paths] in Distribution.Utils.Path
 716     i = interpretSymbolicPath mbWorkDir
 717     setupDir = useDistPref options Cabal.Path.</> makeRelativePathEx "setup"
 718     setupVersionFile = setupDir Cabal.Path.</> makeRelativePathEx ("setup" <.> "version")
 719     setupHs = setupDir Cabal.Path.</> makeRelativePathEx ("setup" <.> "hs")
 720     setupHooks = setupDir Cabal.Path.</> makeRelativePathEx ("SetupHooks" <.> "hs")
 721     setupProgFile = setupDir Cabal.Path.</> makeRelativePathEx ("setup" <.> exeExtension buildPlatform)
 722
 723     platform = fromMaybe buildPlatform (usePlatform options)
 724
 725     useCachedSetupExecutable =
 726       bt == Simple || bt == Configure || bt == Make
 727
 728     maybeGetInstalledPackages
 729       :: SetupScriptOptions
 730       -> Compiler
 731       -> ProgramDb
 732       -> IO InstalledPackageIndex
 733     maybeGetInstalledPackages options' comp progdb =
 734       case usePackageIndex options' of
 735         Just index -> return index
 736         Nothing ->
 737           getInstalledPackages
 738             verbosity
 739             comp
 740             (usePackageDB options')
 741             progdb
 742
 743     -- Choose the version of Cabal to use if the setup script has a dependency on
 744     -- Cabal, and possibly update the setup script options. The version also
 745     -- determines how to filter the flags to Setup.
 746     --
 747     -- We first check whether the dependency solver has specified a Cabal version.
 748     -- If it has, we use the solver's version without looking at the installed
 749     -- package index (See issue #3436). Otherwise, we pick the Cabal version by
 750     -- checking 'useCabalSpecVersion', then the saved version, and finally the
 751     -- versions available in the index.
 752     --
 753     -- The version chosen here must match the one used in 'compileSetupExecutable'
 754     -- (See issue #3433).
 755     cabalLibVersionToUse
 756       :: IO
 757           ( Version
 758           , Maybe ComponentId
 759           , SetupScriptOptions
 760           )
 761     cabalLibVersionToUse =
 762       case find (isCabalPkgId . snd) (useDependencies options) of
 763         Just (unitId, pkgId) -> do
 764           let version = pkgVersion pkgId
 765           updateSetupScript version bt
 766           writeSetupVersionFile version
 767           return (version, Just unitId, options)
 768         Nothing ->
 769           case useCabalSpecVersion options of
 770             Just version -> do
 771               updateSetupScript version bt
 772               writeSetupVersionFile version
 773               return (version, Nothing, options)
 774             Nothing -> do
 775               savedVer <- savedVersion
 776               case savedVer of
 777                 Just version | version `withinRange` useCabalVersion options ->
 778                   do
 779                     updateSetupScript version bt
 780                     -- Does the previously compiled setup executable
 781                     -- still exist and is it up-to date?
 782                     useExisting <- canUseExistingSetup version
 783                     if useExisting
 784                       then return (version, Nothing, options)
 785                       else installedVersion
 786                 _ -> installedVersion
 787       where
 788         -- This check duplicates the checks in 'getCachedSetupExecutable' /
 789         -- 'compileSetupExecutable'. Unfortunately, we have to perform it twice
 790         -- because the selected Cabal version may change as a result of this
 791         -- check.
 792         canUseExistingSetup :: Version -> IO Bool
 793         canUseExistingSetup version =
 794           if useCachedSetupExecutable
 795             then do
 796               (_, cachedSetupProgFile) <- cachedSetupDirAndProg options version
 797               doesFileExist cachedSetupProgFile
 798             else
 799               (&&)
 800                 <$> i setupProgFile `existsAndIsMoreRecentThan` i setupHs
 801                 <*> i setupProgFile `existsAndIsMoreRecentThan` i setupVersionFile
 802
 803         writeSetupVersionFile :: Version -> IO ()
 804         writeSetupVersionFile version =
 805           writeFile (i setupVersionFile) (show version ++ "\n")
 806
 807         installedVersion
 808           :: IO
 809               ( Version
 810               , Maybe InstalledPackageId
 811               , SetupScriptOptions
 812               )
 813         installedVersion = do
 814           (comp, progdb, options') <- configureCompiler options
 815           (version, mipkgid, options'') <-
 816             installedCabalVersion
 817               options'
 818               comp
 819               progdb
 820           updateSetupScript version bt
 821           writeSetupVersionFile version
 822           return (version, mipkgid, options'')
 823
 824         savedVersion :: IO (Maybe Version)
 825         savedVersion = do
 826           versionString <- readFile (i setupVersionFile) `catchIO` \_ -> return ""
 827           case reads versionString of
 828             [(version, s)] | all isSpace s -> return (Just version)
 829             _ -> return Nothing
 830
 831     -- \| Update a Setup.hs script, creating it if necessary.
 832     updateSetupScript :: Version -> BuildType -> IO ()
 833     updateSetupScript _ Custom = do
 834       useHs <- doesFileExist customSetupHs
 835       useLhs <- doesFileExist customSetupLhs
 836       unless (useHs || useLhs) $
 837         dieWithException verbosity UpdateSetupScript
 838       let src = (if useHs then customSetupHs else customSetupLhs)
 839       srcNewer <- src `moreRecentFile` i setupHs
 840       when srcNewer $
 841         if useHs
 842           then copyFileVerbose verbosity src (i setupHs)
 843           else runSimplePreProcessor ppUnlit src (i setupHs) verbosity
 844       where
 845         customSetupHs = workingDir options </> "Setup.hs"
 846         customSetupLhs = workingDir options </> "Setup.lhs"
 847     updateSetupScript cabalLibVersion Hooks = do
 848
 849       let customSetupHooks = workingDir options </> "SetupHooks.hs"
 850       useHs <- doesFileExist customSetupHooks
 851       unless (useHs) $
 852         die'
 853           verbosity
 854           "Using 'build-type: Hooks' but there is no SetupHooks.hs file."
 855       copyFileVerbose verbosity customSetupHooks (i setupHooks)
 856       rewriteFileLBS verbosity (i setupHs) (buildTypeScript cabalLibVersion)
 857 --      rewriteFileLBS verbosity hooksHs hooksScript
 858     updateSetupScript cabalLibVersion _ =
 859       rewriteFileLBS verbosity (i setupHs) (buildTypeScript cabalLibVersion)
 860
 861     buildTypeScript :: Version -> BS.ByteString
 862     buildTypeScript cabalLibVersion = "{-# LANGUAGE NoImplicitPrelude #-}\n" <> case bt of
 863       Simple -> "import Distribution.Simple; main = defaultMain\n"
 864       Configure
 865         | cabalLibVersion >= mkVersion [1, 3, 10] -> "import Distribution.Simple; main = defaultMainWithHooks autoconfUserHooks\n"
 866         | otherwise -> "import Distribution.Simple; main = defaultMainWithHooks defaultUserHooks\n"
 867       Make -> "import Distribution.Make; main = defaultMain\n"
 868       Hooks -> "import Distribution.Simple; import SetupHooks; main = defaultMainWithSetupHooks setupHooks\n"
 869       Custom -> error "buildTypeScript Custom"
 870
 871     installedCabalVersion
 872       :: SetupScriptOptions
 873       -> Compiler
 874       -> ProgramDb
 875       -> IO
 876           ( Version
 877           , Maybe InstalledPackageId
 878           , SetupScriptOptions
 879           )
 880     installedCabalVersion options' _ _
 881       | packageName pkg == mkPackageName "Cabal"
 882           && bt == Custom =
 883           return (packageVersion pkg, Nothing, options')
 884     installedCabalVersion options' compiler progdb = do
 885       index <- maybeGetInstalledPackages options' compiler progdb
 886       let cabalDepName = mkPackageName "Cabal"
 887           cabalDepVersion = useCabalVersion options'
 888           options'' = options'{usePackageIndex = Just index}
 889       case PackageIndex.lookupDependency index cabalDepName cabalDepVersion of
 890         [] ->
 891           dieWithException verbosity $ InstalledCabalVersion (packageName pkg) (useCabalVersion options)
 892         pkgs ->
 893           let ipkginfo = fromMaybe err $ safeHead . snd . bestVersion fst $ pkgs
 894               err = error "Distribution.Client.installedCabalVersion: empty version list"
 895            in return
 896                 ( packageVersion ipkginfo
 897                 , Just . IPI.installedComponentId $ ipkginfo
 898                 , options''
 899                 )
 900
 901     bestVersion :: (a -> Version) -> [a] -> a
 902     bestVersion f = firstMaximumBy (comparing (preference . f))
 903       where
 904         -- Like maximumBy, but picks the first maximum element instead of the
 905         -- last. In general, we expect the preferred version to go first in the
 906         -- list. For the default case, this has the effect of choosing the version
 907         -- installed in the user package DB instead of the global one. See #1463.
 908         --
 909         -- Note: firstMaximumBy could be written as just
 910         -- `maximumBy cmp . reverse`, but the problem is that the behaviour of
 911         -- maximumBy is not fully specified in the case when there is not a single
 912         -- greatest element.
 913         firstMaximumBy :: (a -> a -> Ordering) -> [a] -> a
 914         firstMaximumBy _ [] =
 915           error "Distribution.Client.firstMaximumBy: empty list"
 916         firstMaximumBy cmp xs = foldl1' maxBy xs
 917           where
 918             maxBy x y = case cmp x y of GT -> x; EQ -> x; LT -> y
 919
 920         preference version =
 921           ( sameVersion
 922           , sameMajorVersion
 923           , stableVersion
 924           , latestVersion
 925           )
 926           where
 927             sameVersion = version == cabalVersion
 928             sameMajorVersion = majorVersion version == majorVersion cabalVersion
 929             majorVersion = take 2 . versionNumbers
 930             stableVersion = case versionNumbers version of
 931               (_ : x : _) -> even x
 932               _ -> False
 933             latestVersion = version
 934
 935     configureCompiler
 936       :: SetupScriptOptions
 937       -> IO (Compiler, ProgramDb, SetupScriptOptions)
 938     configureCompiler options' = do
 939       (comp, progdb) <- case useCompiler options' of
 940         Just comp -> return (comp, useProgramDb options')
 941         Nothing -> do
 942           (comp, _, progdb) <-
 943             configCompilerEx
 944               (Just GHC)
 945               Nothing
 946               Nothing
 947               (useProgramDb options')
 948               verbosity
 949           return (comp, progdb)
 950       -- Whenever we need to call configureCompiler, we also need to access the
 951       -- package index, so let's cache it in SetupScriptOptions.
 952       index <- maybeGetInstalledPackages options' comp progdb
 953       return
 954         ( comp
 955         , progdb
 956         , options'
 957             { useCompiler = Just comp
 958             , usePackageIndex = Just index
 959             , useProgramDb = progdb
 960             }
 961         )
 962
 963     -- \| Path to the setup exe cache directory and path to the cached setup
 964     -- executable.
 965     cachedSetupDirAndProg
 966       :: SetupScriptOptions
 967       -> Version
 968       -> IO (FilePath, FilePath)
 969     cachedSetupDirAndProg options' cabalLibVersion = do
 970       cacheDir <- defaultCacheDir
 971       let setupCacheDir = cacheDir </> "setup-exe-cache"
 972           cachedSetupProgFile =
 973             setupCacheDir
 974               </> ( "setup-"
 975                       ++ buildTypeString
 976                       ++ "-"
 977                       ++ cabalVersionString
 978                       ++ "-"
 979                       ++ platformString
 980                       ++ "-"
 981                       ++ compilerVersionString
 982                   )
 983               <.> exeExtension buildPlatform
 984       return (setupCacheDir, cachedSetupProgFile)
 985       where
 986         buildTypeString = show bt
 987         cabalVersionString = "Cabal-" ++ prettyShow cabalLibVersion
 988         compilerVersionString =
 989           prettyShow $
 990             maybe buildCompilerId compilerId $
 991               useCompiler options'
 992         platformString = prettyShow platform
 993
 994     -- \| Look up the setup executable in the cache; update the cache if the setup
 995     -- executable is not found.
 996     getCachedSetupExecutable
 997       :: SetupScriptOptions
 998       -> Version
 999       -> Maybe InstalledPackageId
1000       -> IO FilePath
1001     getCachedSetupExecutable
1002       options'
1003       cabalLibVersion
1004       maybeCabalLibInstalledPkgId = do
1005         (setupCacheDir, cachedSetupProgFile) <-
1006           cachedSetupDirAndProg options' cabalLibVersion
1007         cachedSetupExists <- doesFileExist cachedSetupProgFile
1008         if cachedSetupExists
1009           then
1010             debug verbosity $
1011               "Found cached setup executable: " ++ cachedSetupProgFile
1012           else criticalSection' $ do
1013             -- The cache may have been populated while we were waiting.
1014             cachedSetupExists' <- doesFileExist cachedSetupProgFile
1015             if cachedSetupExists'
1016               then
1017                 debug verbosity $
1018                   "Found cached setup executable: " ++ cachedSetupProgFile
1019               else do
1020                 debug verbosity $ "Setup executable not found in the cache."
1021                 src <-
1022                   compileSetupExecutable
1023                     options'
1024                     cabalLibVersion
1025                     maybeCabalLibInstalledPkgId
1026                     True
1027                 createDirectoryIfMissingVerbose verbosity True setupCacheDir
1028                 installExecutableFile verbosity src cachedSetupProgFile
1029                 -- Do not strip if we're using GHCJS, since the result may be a script
1030                 when (maybe True ((/= GHCJS) . compilerFlavor) $ useCompiler options') $
1031                   Strip.stripExe
1032                     verbosity
1033                     platform
1034                     (useProgramDb options')
1035                     cachedSetupProgFile
1036         return cachedSetupProgFile
1037         where
1038           criticalSection' = maybe id criticalSection $ setupCacheLock options'
1039
1040     -- \| If the Setup.hs is out of date wrt the executable then recompile it.
1041     -- Currently this is GHC/GHCJS only. It should really be generalised.
1042     compileSetupExecutable
1043       :: SetupScriptOptions
1044       -> Version
1045       -> Maybe ComponentId
1046       -> Bool
1047       -> IO FilePath
1048     compileSetupExecutable
1049       options'
1050       cabalLibVersion
1051       maybeCabalLibInstalledPkgId
1052       forceCompile = do
1053         setupHsNewer <- i setupHs `moreRecentFile` i setupProgFile
1054         cabalVersionNewer <- i setupVersionFile `moreRecentFile` i setupProgFile
1055         let outOfDate = setupHsNewer || cabalVersionNewer
1056         when (outOfDate || forceCompile) $ do
1057           debug verbosity "Setup executable needs to be updated, compiling..."
1058           (compiler, progdb, options'') <- configureCompiler options'
1059           let cabalPkgid = PackageIdentifier (mkPackageName "Cabal") cabalLibVersion
1060               (program, extraOpts) =
1061                 case compilerFlavor compiler of
1062                   GHCJS -> (ghcjsProgram, ["-build-runner"])
1063                   _ -> (ghcProgram, ["-threaded"])
1064               cabalDep =
1065                 maybe
1066                   []
1067                   (\ipkgid -> [(ipkgid, cabalPkgid)])
1068                   maybeCabalLibInstalledPkgId
1069
1070               -- With 'useDependenciesExclusive' and Custom build type,
1071               -- we enforce the deps specified, so only the given ones can be used.
1072               -- Otherwise we add on a dep on the Cabal library
1073               -- (unless 'useDependencies' already contains one).
1074               selectedDeps
1075                 |  (useDependenciesExclusive options' && (bt /= Hooks))
1076                 -- NB: to compile build-type: Hooks packages, we need Cabal
1077                 -- in order to compile @main = defaultMainWithSetupHooks setupHooks@.
1078                 || any (isCabalPkgId . snd) (useDependencies options')
1079                 = useDependencies options'
1080                 | otherwise =
1081                     useDependencies options' ++ cabalDep
1082               addRenaming (ipid, _) =
1083                 -- Assert 'DefUnitId' invariant
1084                 ( Backpack.DefiniteUnitId (unsafeMkDefUnitId (newSimpleUnitId ipid))
1085                 , defaultRenaming
1086                 )
1087               cppMacrosFile = setupDir Cabal.Path.</> makeRelativePathEx "setup_macros.h"
1088               ghcOptions =
1089                 mempty
1090                   { -- Respect -v0, but don't crank up verbosity on GHC if
1091                     -- Cabal verbosity is requested. For that, use
1092                     -- --ghc-option=-v instead!
1093                     ghcOptVerbosity = Flag (min verbosity normal)
1094                   , ghcOptMode = Flag GhcModeMake
1095                   , ghcOptInputFiles = toNubListR [setupHs]
1096                   , ghcOptOutputFile = Flag $ setupProgFile
1097                   , ghcOptObjDir = Flag $ setupDir
1098                   , ghcOptHiDir = Flag $ setupDir
1099                   , ghcOptSourcePathClear = Flag True
1100                   , ghcOptSourcePath = case bt of
1101                       Custom -> toNubListR [sameDirectory]
1102                       Hooks -> toNubListR [sameDirectory]
1103                       _ -> mempty
1104                   , ghcOptPackageDBs = usePackageDB options''
1105                   , ghcOptHideAllPackages = Flag (useDependenciesExclusive options')
1106                   , ghcOptCabal = Flag (useDependenciesExclusive options')
1107                   , ghcOptPackages = toNubListR $ map addRenaming selectedDeps
1108                   -- With 'useVersionMacros', use a version CPP macros .h file.
1109                   , ghcOptCppIncludes =
1110                       toNubListR
1111                         [ cppMacrosFile
1112                         | useVersionMacros options'
1113                         ]
1114                   , ghcOptExtra = extraOpts
1115                   , ghcOptExtensions = toNubListR $
1116                       if bt == Custom || any (isBasePkgId . snd) selectedDeps
1117                       then []
1118                       else [ Simple.DisableExtension Simple.ImplicitPrelude ]
1119                         -- Pass -WNoImplicitPrelude to avoid depending on base
1120                         -- when compiling a Simple Setup.hs file.
1121                   , ghcOptExtensionMap = Map.fromList . Simple.compilerExtensions $ compiler
1122                   }
1123           let ghcCmdLine = renderGhcOptions compiler platform ghcOptions
1124           when (useVersionMacros options') $
1125             rewriteFileEx verbosity (i cppMacrosFile) $
1126               generatePackageVersionMacros (pkgVersion $ package pkg) (map snd selectedDeps)
1127           case useLoggingHandle options of
1128             Nothing -> runDbProgramCwd verbosity mbWorkDir program progdb ghcCmdLine
1129             -- If build logging is enabled, redirect compiler output to
1130             -- the log file.
1131             Just logHandle -> do
1132               output <-
1133                 getDbProgramOutputCwd
1134                   verbosity
1135                   mbWorkDir
1136                   program
1137                   progdb
1138                   ghcCmdLine
1139               hPutStr logHandle output
1140         return $ i setupProgFile
1141
1142 isCabalPkgId, isBasePkgId :: PackageIdentifier -> Bool
1143 isCabalPkgId (PackageIdentifier pname _) = pname == mkPackageName "Cabal"
1144 isBasePkgId (PackageIdentifier pname _) = pname == mkPackageName "base"