{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
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
( getCabalDir )
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
, cabalVersion, tryFindPackageDesc
, 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 (createProcess)
import System.Process ( StdStream(..), proc, waitForProcess
, ProcessHandle )
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
data Setup = Setup { Setup -> SetupMethod
setupMethod :: SetupMethod
, Setup -> SetupScriptOptions
setupScriptOptions :: SetupScriptOptions
, Setup -> Version
setupVersion :: Version
, Setup -> BuildType
setupBuildType :: BuildType
, Setup -> PackageDescription
setupPackage :: PackageDescription
}
data SetupMethod = InternalMethod
| SelfExecMethod
| ExternalMethod FilePath
data SetupScriptOptions = SetupScriptOptions {
SetupScriptOptions -> VersionRange
useCabalVersion :: VersionRange,
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 -> FilePath
useDistPref :: FilePath,
SetupScriptOptions -> Maybe Handle
useLoggingHandle :: Maybe Handle,
SetupScriptOptions -> Maybe FilePath
useWorkingDir :: Maybe FilePath,
:: [FilePath],
:: [(String, Maybe FilePath)],
SetupScriptOptions -> Bool
forceExternalSetupMethod :: Bool,
SetupScriptOptions -> [(ComponentId, PackageId)]
useDependencies :: [(ComponentId, PackageId)],
SetupScriptOptions -> Bool
useDependenciesExclusive :: Bool,
SetupScriptOptions -> Bool
useVersionMacros :: Bool,
SetupScriptOptions -> Bool
useWin32CleanHack :: Bool,
SetupScriptOptions -> Maybe Lock
setupCacheLock :: Maybe Lock,
SetupScriptOptions -> Bool
isInteractive :: Bool
}
defaultSetupScriptOptions :: SetupScriptOptions
defaultSetupScriptOptions :: SetupScriptOptions
defaultSetupScriptOptions = SetupScriptOptions :: VersionRange
-> Maybe Version
-> Maybe Compiler
-> Maybe Platform
-> PackageDBStack
-> Maybe InstalledPackageIndex
-> ProgramDb
-> FilePath
-> Maybe Handle
-> Maybe FilePath
-> [FilePath]
-> [(FilePath, Maybe FilePath)]
-> Bool
-> [(ComponentId, PackageId)]
-> Bool
-> Bool
-> Bool
-> Maybe Lock
-> Bool
-> SetupScriptOptions
SetupScriptOptions {
useCabalVersion :: VersionRange
useCabalVersion = VersionRange
anyVersion,
useCabalSpecVersion :: Maybe Version
useCabalSpecVersion = Maybe Version
forall a. Maybe a
Nothing,
useCompiler :: Maybe Compiler
useCompiler = Maybe Compiler
forall a. Maybe a
Nothing,
usePlatform :: Maybe Platform
usePlatform = Maybe Platform
forall a. Maybe a
Nothing,
usePackageDB :: PackageDBStack
usePackageDB = [PackageDB
GlobalPackageDB, PackageDB
UserPackageDB],
usePackageIndex :: Maybe InstalledPackageIndex
usePackageIndex = Maybe InstalledPackageIndex
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 :: FilePath
useDistPref = FilePath
defaultDistPref,
useLoggingHandle :: Maybe Handle
useLoggingHandle = Maybe Handle
forall a. Maybe a
Nothing,
useWorkingDir :: Maybe FilePath
useWorkingDir = Maybe FilePath
forall a. Maybe a
Nothing,
useExtraPathEnv :: [FilePath]
useExtraPathEnv = [],
useExtraEnvOverrides :: [(FilePath, Maybe FilePath)]
useExtraEnvOverrides = [],
useWin32CleanHack :: Bool
useWin32CleanHack = Bool
False,
forceExternalSetupMethod :: Bool
forceExternalSetupMethod = Bool
False,
setupCacheLock :: Maybe Lock
setupCacheLock = Maybe Lock
forall a. Maybe a
Nothing,
isInteractive :: Bool
isInteractive = Bool
False
}
workingDir :: SetupScriptOptions -> FilePath
workingDir :: SetupScriptOptions -> FilePath
workingDir SetupScriptOptions
options =
case FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"" (SetupScriptOptions -> Maybe FilePath
useWorkingDir SetupScriptOptions
options) of
[] -> FilePath
"."
FilePath
dir -> FilePath
dir
type SetupRunner = Verbosity
-> SetupScriptOptions
-> BuildType
-> [String]
-> IO ()
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 <- IO PackageDescription
-> (PackageDescription -> IO PackageDescription)
-> Maybe PackageDescription
-> IO PackageDescription
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO PackageDescription
getPkg PackageDescription -> IO PackageDescription
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'
Setup -> IO Setup
forall (m :: * -> *) a. Monad m => a -> m a
return Setup :: SetupMethod
-> SetupScriptOptions
-> Version
-> BuildType
-> PackageDescription
-> Setup
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 -> FilePath -> IO FilePath
tryFindPackageDesc Verbosity
verbosity (FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"." (SetupScriptOptions -> Maybe FilePath
useWorkingDir SetupScriptOptions
options))
IO FilePath
-> (FilePath -> IO GenericPackageDescription)
-> IO GenericPackageDescription
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Verbosity -> FilePath -> IO GenericPackageDescription
readGenericPackageDescription Verbosity
verbosity
IO GenericPackageDescription
-> (GenericPackageDescription -> IO PackageDescription)
-> IO PackageDescription
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PackageDescription -> IO PackageDescription
forall (m :: * -> *) a. Monad m => a -> m a
return (PackageDescription -> IO PackageDescription)
-> (GenericPackageDescription -> PackageDescription)
-> GenericPackageDescription
-> IO PackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription -> PackageDescription
packageDescription
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' BuildType -> BuildType -> Bool
forall a. Eq a => a -> a -> Bool
== BuildType
Custom
Bool -> Bool -> Bool
|| Bool -> (Version -> Bool) -> Maybe Version -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Version
cabalVersion Version -> Version -> Bool
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'
| Maybe Handle -> Bool
forall a. Maybe a -> Bool
isJust (SetupScriptOptions -> Maybe Handle
useLoggingHandle SetupScriptOptions
options)
Bool -> Bool -> Bool
|| SetupScriptOptions -> Bool
forceExternalSetupMethod SetupScriptOptions
options =
(Version, SetupMethod, SetupScriptOptions)
-> IO (Version, SetupMethod, SetupScriptOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return (Version
cabalVersion, SetupMethod
SelfExecMethod, SetupScriptOptions
options)
| Bool
otherwise = (Version, SetupMethod, SetupScriptOptions)
-> IO (Version, SetupMethod, SetupScriptOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return (Version
cabalVersion, SetupMethod
InternalMethod, SetupScriptOptions
options)
runSetupMethod :: WithCallStack (SetupMethod -> SetupRunner)
runSetupMethod :: SetupMethod -> SetupRunner
runSetupMethod SetupMethod
InternalMethod = SetupRunner
internalSetupMethod
runSetupMethod (ExternalMethod FilePath
path) = WithCallStack (FilePath -> SetupRunner)
FilePath -> SetupRunner
externalSetupMethod FilePath
path
runSetupMethod SetupMethod
SelfExecMethod = SetupRunner
selfExecSetupMethod
runSetup :: Verbosity -> Setup
-> [String]
-> IO ()
runSetup :: Verbosity -> Setup -> [FilePath] -> IO ()
runSetup Verbosity
verbosity Setup
setup [FilePath]
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 :: [FilePath]
args = Version -> [FilePath] -> [FilePath]
verbosityHack (Setup -> Version
setupVersion Setup
setup) [FilePath]
args0
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Verbosity
deafening Bool -> Bool -> Bool
&& [FilePath]
args [FilePath] -> [FilePath] -> Bool
forall a. Eq a => a -> a -> Bool
/= [FilePath]
args0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> FilePath -> IO ()
infoNoWrap Verbosity
verbose (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"Applied verbosity hack:\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
" Before: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
forall a. Show a => a -> FilePath
show [FilePath]
args0 FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
" After: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
forall a. Show a => a -> FilePath
show [FilePath]
args FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n"
WithCallStack (SetupMethod -> SetupRunner)
SetupMethod -> SetupRunner
runSetupMethod SetupMethod
method Verbosity
verbosity SetupScriptOptions
options BuildType
bt [FilePath]
args
verbosityHack :: Version -> [String] -> [String]
verbosityHack :: Version -> [FilePath] -> [FilePath]
verbosityHack Version
ver [FilePath]
args0
| Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
2,Int
1] = [FilePath]
args0
| Bool
otherwise = [FilePath] -> [FilePath]
go [FilePath]
args0
where
go :: [FilePath] -> [FilePath]
go ((Char
'-':Char
'v':FilePath
rest) : [FilePath]
args)
| Just FilePath
rest' <- FilePath -> Maybe FilePath
munch FilePath
rest = (FilePath
"-v" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
rest') FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath] -> [FilePath]
go [FilePath]
args
go ((Char
'-':Char
'-':Char
'v':Char
'e':Char
'r':Char
'b':Char
'o':Char
's':Char
'e':Char
'=':FilePath
rest) : [FilePath]
args)
| Just FilePath
rest' <- FilePath -> Maybe FilePath
munch FilePath
rest = (FilePath
"--verbose=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
rest') FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath] -> [FilePath]
go [FilePath]
args
go (FilePath
"--verbose" : FilePath
rest : [FilePath]
args)
| Just FilePath
rest' <- FilePath -> Maybe FilePath
munch FilePath
rest = FilePath
"--verbose" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath
rest' FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath] -> [FilePath]
go [FilePath]
args
go rest :: [FilePath]
rest@(FilePath
"--" : [FilePath]
_) = [FilePath]
rest
go (FilePath
arg:[FilePath]
args) = FilePath
arg FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath] -> [FilePath]
go [FilePath]
args
go [] = []
munch :: FilePath -> Maybe FilePath
munch FilePath
rest =
case ReadE Verbosity -> FilePath -> Either FilePath Verbosity
forall a. ReadE a -> FilePath -> Either FilePath a
runReadE ReadE Verbosity
flagToVerbosity FilePath
rest of
Right Verbosity
v
| Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
2,Int
0], Verbosity -> Bool
verboseHasFlags Verbosity
v
-> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (Verbosity -> FilePath
showForCabal (Verbosity -> Verbosity
verboseNoFlags Verbosity
v))
| Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
2,Int
1], Verbosity -> Bool
isVerboseTimestamp Verbosity
v
-> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (Verbosity -> FilePath
showForCabal (Verbosity -> Verbosity
verboseNoTimestamp Verbosity
v))
Either FilePath Verbosity
_ -> Maybe FilePath
forall a. Maybe a
Nothing
runSetupCommand :: Verbosity -> Setup
-> CommandUI flags
-> flags
-> [String]
-> IO ()
runSetupCommand :: Verbosity
-> Setup -> CommandUI flags -> flags -> [FilePath] -> IO ()
runSetupCommand Verbosity
verbosity Setup
setup CommandUI flags
cmd flags
flags [FilePath]
extraArgs = do
let args :: [FilePath]
args = CommandUI flags -> FilePath
forall flags. CommandUI flags -> FilePath
commandName CommandUI flags
cmd FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: CommandUI flags -> flags -> [FilePath]
forall flags. CommandUI flags -> flags -> [FilePath]
commandShowOptions CommandUI flags
cmd flags
flags [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
extraArgs
Verbosity -> Setup -> [FilePath] -> IO ()
runSetup Verbosity
verbosity Setup
setup [FilePath]
args
setupWrapper :: Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
-> (Version -> flags)
-> (Version -> [String])
-> IO ()
setupWrapper :: Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
-> (Version -> flags)
-> (Version -> [FilePath])
-> IO ()
setupWrapper Verbosity
verbosity SetupScriptOptions
options Maybe PackageDescription
mpkg CommandUI flags
cmd Version -> flags
flags Version -> [FilePath]
extraArgs = do
Setup
setup <- Verbosity
-> SetupScriptOptions -> Maybe PackageDescription -> IO Setup
getSetup Verbosity
verbosity SetupScriptOptions
options Maybe PackageDescription
mpkg
Verbosity
-> Setup -> CommandUI flags -> flags -> [FilePath] -> IO ()
forall flags.
Verbosity
-> Setup -> CommandUI flags -> flags -> [FilePath] -> IO ()
runSetupCommand Verbosity
verbosity Setup
setup
CommandUI flags
cmd (Version -> flags
flags (Version -> flags) -> Version -> flags
forall a b. (a -> b) -> a -> b
$ Setup -> Version
setupVersion Setup
setup)
(Version -> [FilePath]
extraArgs (Version -> [FilePath]) -> Version -> [FilePath]
forall a b. (a -> b) -> a -> b
$ Setup -> Version
setupVersion Setup
setup)
internalSetupMethod :: SetupRunner
internalSetupMethod :: SetupRunner
internalSetupMethod Verbosity
verbosity SetupScriptOptions
options BuildType
bt [FilePath]
args = do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Using internal setup method with build-type " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ BuildType -> FilePath
forall a. Show a => a -> FilePath
show BuildType
bt
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" and args:\n " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
forall a. Show a => a -> FilePath
show [FilePath]
args
Maybe FilePath -> IO () -> IO ()
forall a. Maybe FilePath -> IO a -> IO a
inDir (SetupScriptOptions -> Maybe FilePath
useWorkingDir SetupScriptOptions
options) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
FilePath -> FilePath -> IO () -> IO ()
forall a. FilePath -> FilePath -> IO a -> IO a
withEnv FilePath
"HASKELL_DIST_DIR" (SetupScriptOptions -> FilePath
useDistPref SetupScriptOptions
options) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
[FilePath] -> IO () -> IO ()
forall a. [FilePath] -> IO a -> IO a
withExtraPathEnv (SetupScriptOptions -> [FilePath]
useExtraPathEnv SetupScriptOptions
options) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
[(FilePath, Maybe FilePath)] -> IO () -> IO ()
forall a. [(FilePath, Maybe FilePath)] -> IO a -> IO a
withEnvOverrides (SetupScriptOptions -> [(FilePath, Maybe FilePath)]
useExtraEnvOverrides SetupScriptOptions
options) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
BuildType -> [FilePath] -> IO ()
buildTypeAction BuildType
bt [FilePath]
args
buildTypeAction :: BuildType -> ([String] -> IO ())
buildTypeAction :: BuildType -> [FilePath] -> IO ()
buildTypeAction BuildType
Simple = [FilePath] -> IO ()
Simple.defaultMainArgs
buildTypeAction BuildType
Configure = UserHooks -> [FilePath] -> IO ()
Simple.defaultMainWithHooksArgs
UserHooks
Simple.autoconfUserHooks
buildTypeAction BuildType
Make = [FilePath] -> IO ()
Make.defaultMainArgs
buildTypeAction BuildType
Custom = FilePath -> [FilePath] -> IO ()
forall a. HasCallStack => FilePath -> a
error FilePath
"buildTypeAction Custom"
runProcess' :: FilePath
-> [String]
-> Maybe FilePath
-> Maybe [(String, String)]
-> Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> Bool
-> IO ProcessHandle
runProcess' :: FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> Bool
-> IO ProcessHandle
runProcess' FilePath
cmd [FilePath]
args Maybe FilePath
mb_cwd Maybe [(FilePath, FilePath)]
mb_env Maybe Handle
mb_stdin Maybe Handle
mb_stdout Maybe Handle
mb_stderr Bool
_delegate = do
(Maybe Handle
_,Maybe Handle
_,Maybe Handle
_,ProcessHandle
ph) <-
CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess
(FilePath -> [FilePath] -> CreateProcess
proc FilePath
cmd [FilePath]
args){ cwd :: Maybe FilePath
Process.cwd = Maybe FilePath
mb_cwd
, env :: Maybe [(FilePath, FilePath)]
Process.env = Maybe [(FilePath, FilePath)]
mb_env
, std_in :: StdStream
Process.std_in = Maybe Handle -> StdStream
mbToStd Maybe Handle
mb_stdin
, std_out :: StdStream
Process.std_out = Maybe Handle -> StdStream
mbToStd Maybe Handle
mb_stdout
, std_err :: StdStream
Process.std_err = Maybe Handle -> StdStream
mbToStd Maybe Handle
mb_stderr
, delegate_ctlc :: Bool
Process.delegate_ctlc = Bool
_delegate
}
ProcessHandle -> IO ProcessHandle
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessHandle
ph
where
mbToStd :: Maybe Handle -> StdStream
mbToStd :: Maybe Handle -> StdStream
mbToStd Maybe Handle
Nothing = StdStream
Inherit
mbToStd (Just Handle
hdl) = Handle -> StdStream
UseHandle Handle
hdl
selfExecSetupMethod :: SetupRunner
selfExecSetupMethod :: SetupRunner
selfExecSetupMethod Verbosity
verbosity SetupScriptOptions
options BuildType
bt [FilePath]
args0 = do
let args :: [FilePath]
args = [FilePath
"act-as-setup",
FilePath
"--build-type=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ BuildType -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow BuildType
bt,
FilePath
"--"] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
args0
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Using self-exec internal setup method with build-type "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ BuildType -> FilePath
forall a. Show a => a -> FilePath
show BuildType
bt FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" and args:\n " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
forall a. Show a => a -> FilePath
show [FilePath]
args
FilePath
path <- IO FilePath
getExecutablePath
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords (FilePath
path FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
args)
case SetupScriptOptions -> Maybe Handle
useLoggingHandle SetupScriptOptions
options of
Maybe Handle
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Handle
logHandle -> Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Redirecting build log to "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Handle -> FilePath
forall a. Show a => a -> FilePath
show Handle
logHandle
FilePath
searchpath <- ProgramSearchPath -> IO FilePath
programSearchPathAsPATHVar
((FilePath -> ProgramSearchPathEntry)
-> [FilePath] -> ProgramSearchPath
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> ProgramSearchPathEntry
ProgramSearchPathDir (SetupScriptOptions -> [FilePath]
useExtraPathEnv SetupScriptOptions
options) ProgramSearchPath -> ProgramSearchPath -> ProgramSearchPath
forall a. [a] -> [a] -> [a]
++
ProgramDb -> ProgramSearchPath
getProgramSearchPath (SetupScriptOptions -> ProgramDb
useProgramDb SetupScriptOptions
options))
Maybe [(FilePath, FilePath)]
env <- [(FilePath, Maybe FilePath)] -> IO (Maybe [(FilePath, FilePath)])
getEffectiveEnvironment ([(FilePath, Maybe FilePath)] -> IO (Maybe [(FilePath, FilePath)]))
-> [(FilePath, Maybe FilePath)]
-> IO (Maybe [(FilePath, FilePath)])
forall a b. (a -> b) -> a -> b
$
[ (FilePath
"PATH", FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
searchpath)
, (FilePath
"HASKELL_DIST_DIR", FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (SetupScriptOptions -> FilePath
useDistPref SetupScriptOptions
options))
] [(FilePath, Maybe FilePath)]
-> [(FilePath, Maybe FilePath)] -> [(FilePath, Maybe FilePath)]
forall a. [a] -> [a] -> [a]
++ SetupScriptOptions -> [(FilePath, Maybe FilePath)]
useExtraEnvOverrides SetupScriptOptions
options
ProcessHandle
process <- FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> Bool
-> IO ProcessHandle
runProcess' FilePath
path [FilePath]
args
(SetupScriptOptions -> Maybe FilePath
useWorkingDir SetupScriptOptions
options) Maybe [(FilePath, FilePath)]
env Maybe Handle
forall a. Maybe a
Nothing
(SetupScriptOptions -> Maybe Handle
useLoggingHandle SetupScriptOptions
options) (SetupScriptOptions -> Maybe Handle
useLoggingHandle SetupScriptOptions
options)
(SetupScriptOptions -> Bool
isInteractive SetupScriptOptions
options)
ExitCode
exitCode <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
process
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ExitCode
exitCode ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith ExitCode
exitCode
externalSetupMethod :: WithCallStack (FilePath -> SetupRunner)
externalSetupMethod :: FilePath -> SetupRunner
externalSetupMethod FilePath
path Verbosity
verbosity SetupScriptOptions
options BuildType
_ [FilePath]
args = do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords (FilePath
path FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
args)
case SetupScriptOptions -> Maybe Handle
useLoggingHandle SetupScriptOptions
options of
Maybe Handle
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Handle
logHandle -> Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Redirecting build log to "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Handle -> FilePath
forall a. Show a => a -> FilePath
show Handle
logHandle
#ifdef mingw32_HOST_OS
if useWin32CleanHack options then doWin32CleanHack path else doInvoke path
#else
FilePath -> IO ()
doInvoke FilePath
path
#endif
where
doInvoke :: FilePath -> IO ()
doInvoke FilePath
path' = do
FilePath
searchpath <- ProgramSearchPath -> IO FilePath
programSearchPathAsPATHVar
((FilePath -> ProgramSearchPathEntry)
-> [FilePath] -> ProgramSearchPath
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> ProgramSearchPathEntry
ProgramSearchPathDir (SetupScriptOptions -> [FilePath]
useExtraPathEnv SetupScriptOptions
options) ProgramSearchPath -> ProgramSearchPath -> ProgramSearchPath
forall a. [a] -> [a] -> [a]
++
ProgramDb -> ProgramSearchPath
getProgramSearchPath (SetupScriptOptions -> ProgramDb
useProgramDb SetupScriptOptions
options))
Maybe [(FilePath, FilePath)]
env <- [(FilePath, Maybe FilePath)] -> IO (Maybe [(FilePath, FilePath)])
getEffectiveEnvironment ([(FilePath, Maybe FilePath)] -> IO (Maybe [(FilePath, FilePath)]))
-> [(FilePath, Maybe FilePath)]
-> IO (Maybe [(FilePath, FilePath)])
forall a b. (a -> b) -> a -> b
$
[ (FilePath
"PATH", FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
searchpath)
, (FilePath
"HASKELL_DIST_DIR", FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (SetupScriptOptions -> FilePath
useDistPref SetupScriptOptions
options))
] [(FilePath, Maybe FilePath)]
-> [(FilePath, Maybe FilePath)] -> [(FilePath, Maybe FilePath)]
forall a. [a] -> [a] -> [a]
++ SetupScriptOptions -> [(FilePath, Maybe FilePath)]
useExtraEnvOverrides SetupScriptOptions
options
Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Setup arguments: "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++[FilePath] -> FilePath
unwords [FilePath]
args
ProcessHandle
process <- FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> Bool
-> IO ProcessHandle
runProcess' FilePath
path' [FilePath]
args
(SetupScriptOptions -> Maybe FilePath
useWorkingDir SetupScriptOptions
options) Maybe [(FilePath, FilePath)]
env Maybe Handle
forall a. Maybe a
Nothing
(SetupScriptOptions -> Maybe Handle
useLoggingHandle SetupScriptOptions
options) (SetupScriptOptions -> Maybe Handle
useLoggingHandle SetupScriptOptions
options)
(SetupScriptOptions -> Bool
isInteractive SetupScriptOptions
options)
ExitCode
exitCode <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
process
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ExitCode
exitCode ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith ExitCode
exitCode
#ifdef mingw32_HOST_OS
doWin32CleanHack path' = do
info verbosity $ "Using the Win32 clean hack."
withTempDirectory verbosity (workingDir options) "cabal-tmp" $ \tmpDir ->
bracket (moveOutOfTheWay tmpDir path')
(maybeRestore path')
doInvoke
moveOutOfTheWay tmpDir path' = do
let newPath = tmpDir </> "setup" <.> exeExtension buildPlatform
Win32.moveFile path' newPath
return newPath
maybeRestore oldPath path' = do
let oldPathDir = takeDirectory oldPath
oldPathDirExists <- doesDirectoryExist oldPathDir
when oldPathDirExists $
Win32.moveFile path' oldPath
#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 -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Using external setup method with build-type " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ BuildType -> FilePath
forall a. Show a => a -> FilePath
show BuildType
bt
Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Using explicit dependencies: "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Bool -> FilePath
forall a. Show a => a -> FilePath
show (SetupScriptOptions -> Bool
useDependenciesExclusive SetupScriptOptions
options)
Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
setupDir
(Version
cabalLibVersion, Maybe ComponentId
mCabalLibInstalledPkgId, SetupScriptOptions
options') <- IO (Version, Maybe ComponentId, SetupScriptOptions)
cabalLibVersionToUse
Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Using Cabal library version " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
cabalLibVersion
FilePath
path <- if Bool
useCachedSetupExecutable
then SetupScriptOptions -> Version -> Maybe ComponentId -> IO FilePath
getCachedSetupExecutable SetupScriptOptions
options'
Version
cabalLibVersion Maybe ComponentId
mCabalLibInstalledPkgId
else SetupScriptOptions
-> Version -> Maybe ComponentId -> Bool -> IO FilePath
compileSetupExecutable SetupScriptOptions
options'
Version
cabalLibVersion Maybe ComponentId
mCabalLibInstalledPkgId Bool
False
FilePath
path' <- FilePath -> IO FilePath
tryCanonicalizePath FilePath
path
#ifdef mingw32_HOST_OS
setupProgFile' <- canonicalizePathNoThrow setupProgFile
let win32CleanHackNeeded = (useWin32CleanHack options)
&& setupProgFile' `equalFilePath` path'
#else
let win32CleanHackNeeded :: Bool
win32CleanHackNeeded = Bool
False
#endif
let options'' :: SetupScriptOptions
options'' = SetupScriptOptions
options' { useWin32CleanHack :: Bool
useWin32CleanHack = Bool
win32CleanHackNeeded }
(Version, SetupMethod, SetupScriptOptions)
-> IO (Version, SetupMethod, SetupScriptOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return (Version
cabalLibVersion, FilePath -> SetupMethod
ExternalMethod FilePath
path', SetupScriptOptions
options'')
where
setupDir :: FilePath
setupDir = SetupScriptOptions -> FilePath
workingDir SetupScriptOptions
options FilePath -> FilePath -> FilePath
</> SetupScriptOptions -> FilePath
useDistPref SetupScriptOptions
options FilePath -> FilePath -> FilePath
</> FilePath
"setup"
setupVersionFile :: FilePath
setupVersionFile = FilePath
setupDir FilePath -> FilePath -> FilePath
</> FilePath
"setup" FilePath -> FilePath -> FilePath
<.> FilePath
"version"
setupHs :: FilePath
setupHs = FilePath
setupDir FilePath -> FilePath -> FilePath
</> FilePath
"setup" FilePath -> FilePath -> FilePath
<.> FilePath
"hs"
setupProgFile :: FilePath
setupProgFile = FilePath
setupDir FilePath -> FilePath -> FilePath
</> FilePath
"setup" FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
exeExtension Platform
buildPlatform
platform :: Platform
platform = Platform -> Maybe Platform -> Platform
forall a. a -> Maybe a -> a
fromMaybe Platform
buildPlatform (SetupScriptOptions -> Maybe Platform
usePlatform SetupScriptOptions
options)
useCachedSetupExecutable :: Bool
useCachedSetupExecutable = (BuildType
bt BuildType -> BuildType -> Bool
forall a. Eq a => a -> a -> Bool
== BuildType
Simple Bool -> Bool -> Bool
|| BuildType
bt BuildType -> BuildType -> Bool
forall a. Eq a => a -> a -> Bool
== BuildType
Configure Bool -> Bool -> Bool
|| BuildType
bt BuildType -> BuildType -> Bool
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 -> InstalledPackageIndex -> IO InstalledPackageIndex
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
cabalLibVersionToUse :: IO (Version, Maybe ComponentId
,SetupScriptOptions)
cabalLibVersionToUse :: IO (Version, Maybe ComponentId, SetupScriptOptions)
cabalLibVersionToUse =
case ((ComponentId, PackageId) -> Bool)
-> [(ComponentId, PackageId)] -> Maybe (ComponentId, PackageId)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (PackageId -> Bool
isCabalPkgId (PackageId -> Bool)
-> ((ComponentId, PackageId) -> PackageId)
-> (ComponentId, PackageId)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ComponentId, PackageId) -> PackageId
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
(Version, Maybe ComponentId, SetupScriptOptions)
-> IO (Version, Maybe ComponentId, SetupScriptOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return (Version
version, ComponentId -> Maybe ComponentId
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
(Version, Maybe ComponentId, SetupScriptOptions)
-> IO (Version, Maybe ComponentId, SetupScriptOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return (Version
version, Maybe ComponentId
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
Bool
useExisting <- Version -> IO Bool
canUseExistingSetup Version
version
if Bool
useExisting
then (Version, Maybe ComponentId, SetupScriptOptions)
-> IO (Version, Maybe ComponentId, SetupScriptOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return (Version
version, Maybe ComponentId
forall a. Maybe a
Nothing, SetupScriptOptions
options)
else IO (Version, Maybe ComponentId, SetupScriptOptions)
installedVersion
Maybe Version
_ -> IO (Version, Maybe ComponentId, SetupScriptOptions)
installedVersion
where
canUseExistingSetup :: Version -> IO Bool
canUseExistingSetup :: Version -> IO Bool
canUseExistingSetup Version
version =
if Bool
useCachedSetupExecutable
then do
(FilePath
_, FilePath
cachedSetupProgFile) <- SetupScriptOptions -> Version -> IO (FilePath, FilePath)
cachedSetupDirAndProg SetupScriptOptions
options Version
version
FilePath -> IO Bool
doesFileExist FilePath
cachedSetupProgFile
else
Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> IO Bool -> IO (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath
setupProgFile FilePath -> FilePath -> IO Bool
`existsAndIsMoreRecentThan` FilePath
setupHs
IO (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath
setupProgFile FilePath -> FilePath -> IO Bool
`existsAndIsMoreRecentThan` FilePath
setupVersionFile
writeSetupVersionFile :: Version -> IO ()
writeSetupVersionFile :: Version -> IO ()
writeSetupVersionFile Version
version =
FilePath -> FilePath -> IO ()
writeFile FilePath
setupVersionFile (Version -> FilePath
forall a. Show a => a -> FilePath
show Version
version FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\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
(Version, Maybe ComponentId, SetupScriptOptions)
-> IO (Version, Maybe ComponentId, SetupScriptOptions)
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
FilePath
versionString <- FilePath -> IO FilePath
readFile FilePath
setupVersionFile IO FilePath -> (IOException -> IO FilePath) -> IO FilePath
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
""
case ReadS Version
forall a. Read a => ReadS a
reads FilePath
versionString of
[(Version
version,FilePath
s)] | (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace FilePath
s -> Maybe Version -> IO (Maybe Version)
forall (m :: * -> *) a. Monad m => a -> m a
return (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
version)
[(Version, FilePath)]
_ -> Maybe Version -> IO (Maybe Version)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Version
forall a. Maybe a
Nothing
updateSetupScript :: Version -> BuildType -> IO ()
updateSetupScript :: Version -> BuildType -> IO ()
updateSetupScript Version
_ BuildType
Custom = do
Bool
useHs <- FilePath -> IO Bool
doesFileExist FilePath
customSetupHs
Bool
useLhs <- FilePath -> IO Bool
doesFileExist FilePath
customSetupLhs
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
useHs Bool -> Bool -> Bool
|| Bool
useLhs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity
FilePath
"Using 'build-type: Custom' but there is no Setup.hs or Setup.lhs script."
let src :: FilePath
src = (if Bool
useHs then FilePath
customSetupHs else FilePath
customSetupLhs)
Bool
srcNewer <- FilePath
src FilePath -> FilePath -> IO Bool
`moreRecentFile` FilePath
setupHs
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
srcNewer (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ if Bool
useHs
then Verbosity -> FilePath -> FilePath -> IO ()
copyFileVerbose Verbosity
verbosity FilePath
src FilePath
setupHs
else PreProcessor -> FilePath -> FilePath -> Verbosity -> IO ()
runSimplePreProcessor PreProcessor
ppUnlit FilePath
src FilePath
setupHs Verbosity
verbosity
where
customSetupHs :: FilePath
customSetupHs = SetupScriptOptions -> FilePath
workingDir SetupScriptOptions
options FilePath -> FilePath -> FilePath
</> FilePath
"Setup.hs"
customSetupLhs :: FilePath
customSetupLhs = SetupScriptOptions -> FilePath
workingDir SetupScriptOptions
options FilePath -> FilePath -> FilePath
</> FilePath
"Setup.lhs"
updateSetupScript Version
cabalLibVersion BuildType
_ =
Verbosity -> FilePath -> ByteString -> IO ()
rewriteFileLBS Verbosity
verbosity FilePath
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 Version -> Version -> Bool
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 -> FilePath -> ByteString
forall a. HasCallStack => FilePath -> a
error FilePath
"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
_ | PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> PackageName
mkPackageName FilePath
"Cabal"
Bool -> Bool -> Bool
&& BuildType
bt BuildType -> BuildType -> Bool
forall a. Eq a => a -> a -> Bool
== BuildType
Custom =
(Version, Maybe ComponentId, SetupScriptOptions)
-> IO (Version, Maybe ComponentId, SetupScriptOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return (PackageDescription -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion PackageDescription
pkg, Maybe ComponentId
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 = FilePath -> PackageName
mkPackageName FilePath
"Cabal"
cabalDepVersion :: VersionRange
cabalDepVersion = SetupScriptOptions -> VersionRange
useCabalVersion SetupScriptOptions
options'
options'' :: SetupScriptOptions
options'' = SetupScriptOptions
options' { usePackageIndex :: Maybe InstalledPackageIndex
usePackageIndex = InstalledPackageIndex -> Maybe InstalledPackageIndex
forall a. a -> Maybe a
Just InstalledPackageIndex
index }
case InstalledPackageIndex
-> PackageName
-> VersionRange
-> [(Version, [InstalledPackageInfo])]
PackageIndex.lookupDependency InstalledPackageIndex
index PackageName
cabalDepName VersionRange
cabalDepVersion of
[] -> Verbosity
-> FilePath -> IO (Version, Maybe ComponentId, SetupScriptOptions)
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO (Version, Maybe ComponentId, SetupScriptOptions))
-> FilePath -> IO (Version, Maybe ComponentId, SetupScriptOptions)
forall a b. (a -> b) -> a -> b
$ FilePath
"The package '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PackageName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg)
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' requires Cabal library version "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ VersionRange -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (SetupScriptOptions -> VersionRange
useCabalVersion SetupScriptOptions
options)
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" but no suitable version is installed."
[(Version, [InstalledPackageInfo])]
pkgs -> let ipkginfo :: InstalledPackageInfo
ipkginfo = InstalledPackageInfo
-> Maybe InstalledPackageInfo -> InstalledPackageInfo
forall a. a -> Maybe a -> a
fromMaybe InstalledPackageInfo
forall a. a
err (Maybe InstalledPackageInfo -> InstalledPackageInfo)
-> Maybe InstalledPackageInfo -> InstalledPackageInfo
forall a b. (a -> b) -> a -> b
$ [InstalledPackageInfo] -> Maybe InstalledPackageInfo
forall a. [a] -> Maybe a
safeHead ([InstalledPackageInfo] -> Maybe InstalledPackageInfo)
-> ([(Version, [InstalledPackageInfo])] -> [InstalledPackageInfo])
-> [(Version, [InstalledPackageInfo])]
-> Maybe InstalledPackageInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version, [InstalledPackageInfo]) -> [InstalledPackageInfo]
forall a b. (a, b) -> b
snd ((Version, [InstalledPackageInfo]) -> [InstalledPackageInfo])
-> ([(Version, [InstalledPackageInfo])]
-> (Version, [InstalledPackageInfo]))
-> [(Version, [InstalledPackageInfo])]
-> [InstalledPackageInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Version, [InstalledPackageInfo]) -> Version)
-> [(Version, [InstalledPackageInfo])]
-> (Version, [InstalledPackageInfo])
forall a. (a -> Version) -> [a] -> a
bestVersion (Version, [InstalledPackageInfo]) -> Version
forall a b. (a, b) -> a
fst ([(Version, [InstalledPackageInfo])] -> Maybe InstalledPackageInfo)
-> [(Version, [InstalledPackageInfo])]
-> Maybe InstalledPackageInfo
forall a b. (a -> b) -> a -> b
$ [(Version, [InstalledPackageInfo])]
pkgs
err :: a
err = FilePath -> a
forall a. HasCallStack => FilePath -> a
error FilePath
"Distribution.Client.installedCabalVersion: empty version list"
in (Version, Maybe ComponentId, SetupScriptOptions)
-> IO (Version, Maybe ComponentId, SetupScriptOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return (InstalledPackageInfo -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion InstalledPackageInfo
ipkginfo
,ComponentId -> Maybe ComponentId
forall a. a -> Maybe a
Just (ComponentId -> Maybe ComponentId)
-> (InstalledPackageInfo -> ComponentId)
-> InstalledPackageInfo
-> Maybe ComponentId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledPackageInfo -> ComponentId
IPI.installedComponentId (InstalledPackageInfo -> Maybe ComponentId)
-> InstalledPackageInfo -> Maybe ComponentId
forall a b. (a -> b) -> a -> b
$ InstalledPackageInfo
ipkginfo, SetupScriptOptions
options'')
bestVersion :: (a -> Version) -> [a] -> a
bestVersion :: (a -> Version) -> [a] -> a
bestVersion a -> Version
f = (a -> a -> Ordering) -> [a] -> a
forall a. (a -> a -> Ordering) -> [a] -> a
firstMaximumBy ((a -> (Bool, Bool, Bool, Version)) -> a -> a -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Version -> (Bool, Bool, Bool, Version)
preference (Version -> (Bool, Bool, Bool, Version))
-> (a -> Version) -> a -> (Bool, Bool, Bool, Version)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Version
f))
where
firstMaximumBy :: (a -> a -> Ordering) -> [a] -> a
firstMaximumBy :: (a -> a -> Ordering) -> [a] -> a
firstMaximumBy a -> a -> Ordering
_ [] =
FilePath -> a
forall a. HasCallStack => FilePath -> a
error FilePath
"Distribution.Client.firstMaximumBy: empty list"
firstMaximumBy a -> a -> Ordering
cmp [a]
xs = (a -> a -> a) -> [a] -> a
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 Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
cabalVersion
sameMajorVersion :: Bool
sameMajorVersion = Version -> [Int]
majorVersion Version
version [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== Version -> [Int]
majorVersion Version
cabalVersion
majorVersion :: Version -> [Int]
majorVersion = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
2 ([Int] -> [Int]) -> (Version -> [Int]) -> Version -> [Int]
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]
_) -> Int -> Bool
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 -> (Compiler, ProgramDb) -> IO (Compiler, ProgramDb)
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 FilePath
-> Maybe FilePath
-> ProgramDb
-> Verbosity
-> IO (Compiler, Platform, ProgramDb)
configCompilerEx (CompilerFlavor -> Maybe CompilerFlavor
forall a. a -> Maybe a
Just CompilerFlavor
GHC) Maybe FilePath
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing
(SetupScriptOptions -> ProgramDb
useProgramDb SetupScriptOptions
options') Verbosity
verbosity
(Compiler, ProgramDb) -> IO (Compiler, ProgramDb)
forall (m :: * -> *) a. Monad m => a -> m a
return (Compiler
comp, ProgramDb
progdb)
InstalledPackageIndex
index <- SetupScriptOptions
-> Compiler -> ProgramDb -> IO InstalledPackageIndex
maybeGetInstalledPackages SetupScriptOptions
options' Compiler
comp ProgramDb
progdb
(Compiler, ProgramDb, SetupScriptOptions)
-> IO (Compiler, ProgramDb, SetupScriptOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return (Compiler
comp, ProgramDb
progdb, SetupScriptOptions
options' { useCompiler :: Maybe Compiler
useCompiler = Compiler -> Maybe Compiler
forall a. a -> Maybe a
Just Compiler
comp,
usePackageIndex :: Maybe InstalledPackageIndex
usePackageIndex = InstalledPackageIndex -> Maybe InstalledPackageIndex
forall a. a -> Maybe a
Just InstalledPackageIndex
index,
useProgramDb :: ProgramDb
useProgramDb = ProgramDb
progdb })
cachedSetupDirAndProg :: SetupScriptOptions -> Version
-> IO (FilePath, FilePath)
cachedSetupDirAndProg :: SetupScriptOptions -> Version -> IO (FilePath, FilePath)
cachedSetupDirAndProg SetupScriptOptions
options' Version
cabalLibVersion = do
FilePath
cabalDir <- IO FilePath
getCabalDir
let setupCacheDir :: FilePath
setupCacheDir = FilePath
cabalDir FilePath -> FilePath -> FilePath
</> FilePath
"setup-exe-cache"
cachedSetupProgFile :: FilePath
cachedSetupProgFile = FilePath
setupCacheDir
FilePath -> FilePath -> FilePath
</> (FilePath
"setup-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
buildTypeString FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cabalVersionString FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
platformString FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
compilerVersionString)
FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
exeExtension Platform
buildPlatform
(FilePath, FilePath) -> IO (FilePath, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
setupCacheDir, FilePath
cachedSetupProgFile)
where
buildTypeString :: FilePath
buildTypeString = BuildType -> FilePath
forall a. Show a => a -> FilePath
show BuildType
bt
cabalVersionString :: FilePath
cabalVersionString = FilePath
"Cabal-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
cabalLibVersion
compilerVersionString :: FilePath
compilerVersionString = CompilerId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (CompilerId -> FilePath) -> CompilerId -> FilePath
forall a b. (a -> b) -> a -> b
$
CompilerId
-> (Compiler -> CompilerId) -> Maybe Compiler -> CompilerId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CompilerId
buildCompilerId Compiler -> CompilerId
compilerId
(Maybe Compiler -> CompilerId) -> Maybe Compiler -> CompilerId
forall a b. (a -> b) -> a -> b
$ SetupScriptOptions -> Maybe Compiler
useCompiler SetupScriptOptions
options'
platformString :: FilePath
platformString = Platform -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Platform
platform
getCachedSetupExecutable :: SetupScriptOptions
-> Version -> Maybe InstalledPackageId
-> IO FilePath
getCachedSetupExecutable :: SetupScriptOptions -> Version -> Maybe ComponentId -> IO FilePath
getCachedSetupExecutable SetupScriptOptions
options' Version
cabalLibVersion
Maybe ComponentId
maybeCabalLibInstalledPkgId = do
(FilePath
setupCacheDir, FilePath
cachedSetupProgFile) <-
SetupScriptOptions -> Version -> IO (FilePath, FilePath)
cachedSetupDirAndProg SetupScriptOptions
options' Version
cabalLibVersion
Bool
cachedSetupExists <- FilePath -> IO Bool
doesFileExist FilePath
cachedSetupProgFile
if Bool
cachedSetupExists
then Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"Found cached setup executable: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cachedSetupProgFile
else IO () -> IO ()
forall a. IO a -> IO a
criticalSection' (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Bool
cachedSetupExists' <- FilePath -> IO Bool
doesFileExist FilePath
cachedSetupProgFile
if Bool
cachedSetupExists'
then Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"Found cached setup executable: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cachedSetupProgFile
else do
Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Setup executable not found in the cache."
FilePath
src <- SetupScriptOptions
-> Version -> Maybe ComponentId -> Bool -> IO FilePath
compileSetupExecutable SetupScriptOptions
options'
Version
cabalLibVersion Maybe ComponentId
maybeCabalLibInstalledPkgId Bool
True
Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
setupCacheDir
Verbosity -> FilePath -> FilePath -> IO ()
installExecutableFile Verbosity
verbosity FilePath
src FilePath
cachedSetupProgFile
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> (Compiler -> Bool) -> Maybe Compiler -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ((CompilerFlavor -> CompilerFlavor -> Bool
forall a. Eq a => a -> a -> Bool
/=CompilerFlavor
GHCJS)(CompilerFlavor -> Bool)
-> (Compiler -> CompilerFlavor) -> Compiler -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Compiler -> CompilerFlavor
compilerFlavor) (Maybe Compiler -> Bool) -> Maybe Compiler -> Bool
forall a b. (a -> b) -> a -> b
$ SetupScriptOptions -> Maybe Compiler
useCompiler SetupScriptOptions
options') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> Platform -> ProgramDb -> FilePath -> IO ()
Strip.stripExe Verbosity
verbosity Platform
platform (SetupScriptOptions -> ProgramDb
useProgramDb SetupScriptOptions
options')
FilePath
cachedSetupProgFile
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
cachedSetupProgFile
where
criticalSection' :: IO a -> IO a
criticalSection' = (IO a -> IO a)
-> (Lock -> IO a -> IO a) -> Maybe Lock -> IO a -> IO a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO a -> IO a
forall a. a -> a
id Lock -> IO a -> IO a
forall a. Lock -> IO a -> IO a
criticalSection (Maybe Lock -> IO a -> IO a) -> Maybe Lock -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ SetupScriptOptions -> Maybe Lock
setupCacheLock SetupScriptOptions
options'
compileSetupExecutable :: SetupScriptOptions
-> Version -> Maybe ComponentId -> Bool
-> IO FilePath
compileSetupExecutable :: SetupScriptOptions
-> Version -> Maybe ComponentId -> Bool -> IO FilePath
compileSetupExecutable SetupScriptOptions
options' Version
cabalLibVersion Maybe ComponentId
maybeCabalLibInstalledPkgId
Bool
forceCompile = do
Bool
setupHsNewer <- FilePath
setupHs FilePath -> FilePath -> IO Bool
`moreRecentFile` FilePath
setupProgFile
Bool
cabalVersionNewer <- FilePath
setupVersionFile FilePath -> FilePath -> IO Bool
`moreRecentFile` FilePath
setupProgFile
let outOfDate :: Bool
outOfDate = Bool
setupHsNewer Bool -> Bool -> Bool
|| Bool
cabalVersionNewer
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
outOfDate Bool -> Bool -> Bool
|| Bool
forceCompile) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity FilePath
"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 (FilePath -> PackageName
mkPackageName FilePath
"Cabal") Version
cabalLibVersion
(Program
program, [FilePath]
extraOpts)
= case Compiler -> CompilerFlavor
compilerFlavor Compiler
compiler of
CompilerFlavor
GHCJS -> (Program
ghcjsProgram, [FilePath
"-build-runner"])
CompilerFlavor
_ -> (Program
ghcProgram, [FilePath
"-threaded"])
cabalDep :: [(ComponentId, PackageId)]
cabalDep = [(ComponentId, PackageId)]
-> (ComponentId -> [(ComponentId, PackageId)])
-> Maybe ComponentId
-> [(ComponentId, PackageId)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ComponentId
ipkgid -> [(ComponentId
ipkgid, PackageId
cabalPkgid)])
Maybe ComponentId
maybeCabalLibInstalledPkgId
selectedDeps :: [(ComponentId, PackageId)]
selectedDeps | SetupScriptOptions -> Bool
useDependenciesExclusive SetupScriptOptions
options'
= SetupScriptOptions -> [(ComponentId, PackageId)]
useDependencies SetupScriptOptions
options'
| Bool
otherwise = SetupScriptOptions -> [(ComponentId, PackageId)]
useDependencies SetupScriptOptions
options' [(ComponentId, PackageId)]
-> [(ComponentId, PackageId)] -> [(ComponentId, PackageId)]
forall a. [a] -> [a] -> [a]
++
if ((ComponentId, PackageId) -> Bool)
-> [(ComponentId, PackageId)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (PackageId -> Bool
isCabalPkgId (PackageId -> Bool)
-> ((ComponentId, PackageId) -> PackageId)
-> (ComponentId, PackageId)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ComponentId, PackageId) -> PackageId
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
_) =
(DefUnitId -> OpenUnitId
Backpack.DefiniteUnitId (UnitId -> DefUnitId
unsafeMkDefUnitId (ComponentId -> UnitId
newSimpleUnitId ComponentId
ipid))
,ModuleRenaming
defaultRenaming)
cppMacrosFile :: FilePath
cppMacrosFile = FilePath
setupDir FilePath -> FilePath -> FilePath
</> FilePath
"setup_macros.h"
ghcOptions :: GhcOptions
ghcOptions = GhcOptions
forall a. Monoid a => a
mempty {
ghcOptVerbosity :: Flag Verbosity
ghcOptVerbosity = Verbosity -> Flag Verbosity
forall a. a -> Flag a
Flag (Verbosity -> Verbosity -> Verbosity
forall a. Ord a => a -> a -> a
min Verbosity
verbosity Verbosity
normal)
, ghcOptMode :: Flag GhcMode
ghcOptMode = GhcMode -> Flag GhcMode
forall a. a -> Flag a
Flag GhcMode
GhcModeMake
, ghcOptInputFiles :: NubListR FilePath
ghcOptInputFiles = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR [FilePath
setupHs]
, ghcOptOutputFile :: Flag FilePath
ghcOptOutputFile = FilePath -> Flag FilePath
forall a. a -> Flag a
Flag FilePath
setupProgFile
, ghcOptObjDir :: Flag FilePath
ghcOptObjDir = FilePath -> Flag FilePath
forall a. a -> Flag a
Flag FilePath
setupDir
, ghcOptHiDir :: Flag FilePath
ghcOptHiDir = FilePath -> Flag FilePath
forall a. a -> Flag a
Flag FilePath
setupDir
, ghcOptSourcePathClear :: Flag Bool
ghcOptSourcePathClear = Bool -> Flag Bool
forall a. a -> Flag a
Flag Bool
True
, ghcOptSourcePath :: NubListR FilePath
ghcOptSourcePath = case BuildType
bt of
BuildType
Custom -> [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR [SetupScriptOptions -> FilePath
workingDir SetupScriptOptions
options']
BuildType
_ -> NubListR FilePath
forall a. Monoid a => a
mempty
, ghcOptPackageDBs :: PackageDBStack
ghcOptPackageDBs = SetupScriptOptions -> PackageDBStack
usePackageDB SetupScriptOptions
options''
, ghcOptHideAllPackages :: Flag Bool
ghcOptHideAllPackages = Bool -> Flag Bool
forall a. a -> Flag a
Flag (SetupScriptOptions -> Bool
useDependenciesExclusive SetupScriptOptions
options')
, ghcOptCabal :: Flag Bool
ghcOptCabal = Bool -> Flag Bool
forall a. a -> Flag a
Flag (SetupScriptOptions -> Bool
useDependenciesExclusive SetupScriptOptions
options')
, ghcOptPackages :: NubListR (OpenUnitId, ModuleRenaming)
ghcOptPackages = [(OpenUnitId, ModuleRenaming)]
-> NubListR (OpenUnitId, ModuleRenaming)
forall a. Ord a => [a] -> NubListR a
toNubListR ([(OpenUnitId, ModuleRenaming)]
-> NubListR (OpenUnitId, ModuleRenaming))
-> [(OpenUnitId, ModuleRenaming)]
-> NubListR (OpenUnitId, ModuleRenaming)
forall a b. (a -> b) -> a -> b
$ ((ComponentId, PackageId) -> (OpenUnitId, ModuleRenaming))
-> [(ComponentId, PackageId)] -> [(OpenUnitId, ModuleRenaming)]
forall a b. (a -> b) -> [a] -> [b]
map (ComponentId, PackageId) -> (OpenUnitId, ModuleRenaming)
forall b. (ComponentId, b) -> (OpenUnitId, ModuleRenaming)
addRenaming [(ComponentId, PackageId)]
selectedDeps
, ghcOptCppIncludes :: NubListR FilePath
ghcOptCppIncludes = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR [ FilePath
cppMacrosFile
| SetupScriptOptions -> Bool
useVersionMacros SetupScriptOptions
options' ]
, ghcOptExtra :: [FilePath]
ghcOptExtra = [FilePath]
extraOpts
}
let ghcCmdLine :: [FilePath]
ghcCmdLine = Compiler -> Platform -> GhcOptions -> [FilePath]
renderGhcOptions Compiler
compiler Platform
platform GhcOptions
ghcOptions
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SetupScriptOptions -> Bool
useVersionMacros SetupScriptOptions
options') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> FilePath -> FilePath -> IO ()
rewriteFileEx Verbosity
verbosity FilePath
cppMacrosFile
(FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ Version -> [PackageId] -> FilePath
generatePackageVersionMacros (PackageId -> Version
pkgVersion (PackageId -> Version) -> PackageId -> Version
forall a b. (a -> b) -> a -> b
$ PackageDescription -> PackageId
package PackageDescription
pkg) (((ComponentId, PackageId) -> PackageId)
-> [(ComponentId, PackageId)] -> [PackageId]
forall a b. (a -> b) -> [a] -> [b]
map (ComponentId, PackageId) -> PackageId
forall a b. (a, b) -> b
snd [(ComponentId, PackageId)]
selectedDeps)
case SetupScriptOptions -> Maybe Handle
useLoggingHandle SetupScriptOptions
options of
Maybe Handle
Nothing -> Verbosity -> Program -> ProgramDb -> [FilePath] -> IO ()
runDbProgram Verbosity
verbosity Program
program ProgramDb
progdb [FilePath]
ghcCmdLine
(Just Handle
logHandle) -> do FilePath
output <- Verbosity -> Program -> ProgramDb -> [FilePath] -> IO FilePath
getDbProgramOutput Verbosity
verbosity Program
program
ProgramDb
progdb [FilePath]
ghcCmdLine
Handle -> FilePath -> IO ()
hPutStr Handle
logHandle FilePath
output
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
setupProgFile
isCabalPkgId :: PackageIdentifier -> Bool
isCabalPkgId :: PackageId -> Bool
isCabalPkgId (PackageIdentifier PackageName
pname Version
_) = PackageName
pname PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> PackageName
mkPackageName FilePath
"Cabal"