{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Distribution.Client.SetupWrapper
( getSetup
, runSetup
, runSetupCommand
, setupWrapper
, SetupScriptOptions (..)
, defaultSetupScriptOptions
) where
import Distribution.Client.Compat.Prelude
import Prelude ()
import qualified Distribution.Backpack as Backpack
import Distribution.CabalSpecVersion (cabalSpecMinimumLibraryVersion)
import Distribution.Compiler
( CompilerFlavor (GHC, GHCJS)
, buildCompilerId
)
import qualified Distribution.Make as Make
import Distribution.Package
( ComponentId
, PackageId
, PackageIdentifier (..)
, mkPackageName
, newSimpleUnitId
, packageName
, packageVersion
, unsafeMkDefUnitId
)
import Distribution.PackageDescription
( BuildType (..)
, GenericPackageDescription (packageDescription)
, PackageDescription (..)
, buildType
, specVersion
)
import qualified Distribution.Simple as Simple
import Distribution.Simple.Build.Macros
( generatePackageVersionMacros
)
import Distribution.Simple.BuildPaths
( defaultDistPref
, exeExtension
)
import Distribution.Simple.Compiler
( Compiler (compilerId)
, PackageDB (..)
, PackageDBStack
, compilerFlavor
)
import Distribution.Simple.Configure
( configCompilerEx
)
import Distribution.Simple.PackageDescription
( readGenericPackageDescription
)
import Distribution.Simple.PreProcess
( ppUnlit
, runSimplePreProcessor
)
import Distribution.Simple.Program
( ProgramDb
, emptyProgramDb
, getDbProgramOutput
, getProgramSearchPath
, ghcProgram
, ghcjsProgram
, runDbProgram
)
import Distribution.Simple.Program.Db
( prependProgramSearchPath
)
import Distribution.Simple.Program.Find
( programSearchPathAsPATHVar
)
import Distribution.Simple.Program.Run
( getEffectiveEnvironment
)
import qualified Distribution.Simple.Program.Strip as Strip
import Distribution.Types.ModuleRenaming (defaultRenaming)
import Distribution.Version
( Version
, VersionRange
, anyVersion
, intersectVersionRanges
, mkVersion
, orLaterVersion
, versionNumbers
, withinRange
)
import Distribution.Client.Config
( defaultCacheDir
)
import Distribution.Client.IndexUtils
( getInstalledPackages
)
import Distribution.Client.JobControl
( Lock
, criticalSection
)
import Distribution.Client.Types
import Distribution.Client.Utils
( existsAndIsMoreRecentThan
, inDir
#ifdef mingw32_HOST_OS
, canonicalizePathNoThrow
#endif
, moreRecentFile
, tryCanonicalizePath
, withEnv
, withEnvOverrides
, withExtraPathEnv
)
import qualified Distribution.InstalledPackageInfo as IPI
import Distribution.Simple.Command
( CommandUI (..)
, commandShowOptions
)
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.Program.GHC
( GhcMode (..)
, GhcOptions (..)
, renderGhcOptions
)
import Distribution.Simple.Setup
( Flag (..)
)
import Distribution.Simple.Utils
( cabalVersion
, copyFileVerbose
, createDirectoryIfMissingVerbose
, debug
, dieWithException
, info
, infoNoWrap
, installExecutableFile
, maybeExit
, rawSystemProc
, rewriteFileEx
, rewriteFileLBS
, tryFindPackageDesc
)
import Distribution.Utils.Generic
( safeHead
)
import Distribution.Compat.Stack
import Distribution.ReadE
import Distribution.System (Platform (..), buildPlatform)
import Distribution.Utils.NubList
( toNubListR
)
import Distribution.Verbosity
import Data.List (foldl1')
import Distribution.Client.Compat.ExecutablePath (getExecutablePath)
import Distribution.Compat.Process (proc)
import System.Directory (doesFileExist)
import System.FilePath ((<.>), (</>))
import System.IO (Handle, hPutStr)
import System.Process (StdStream (..))
import qualified System.Process as Process
import qualified Data.ByteString.Lazy as BS
import Distribution.Client.Errors
#ifdef mingw32_HOST_OS
import Distribution.Simple.Utils
( withTempDirectory )
import Control.Exception ( bracket )
import System.FilePath ( equalFilePath, takeDirectory )
import System.Directory ( doesDirectoryExist )
import qualified System.Win32 as Win32
#endif
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 -> [Char]
useDistPref :: FilePath
, SetupScriptOptions -> Maybe Handle
useLoggingHandle :: Maybe Handle
, SetupScriptOptions -> Maybe [Char]
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
{ 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 :: [Char]
useDistPref = [Char]
defaultDistPref
, useLoggingHandle :: Maybe Handle
useLoggingHandle = Maybe Handle
forall a. Maybe a
Nothing
, useWorkingDir :: Maybe [Char]
useWorkingDir = Maybe [Char]
forall a. Maybe a
Nothing
, useExtraPathEnv :: [[Char]]
useExtraPathEnv = []
, useExtraEnvOverrides :: [([Char], Maybe [Char])]
useExtraEnvOverrides = []
, useWin32CleanHack :: Bool
useWin32CleanHack = Bool
False
, forceExternalSetupMethod :: Bool
forceExternalSetupMethod = Bool
False
, setupCacheLock :: Maybe Lock
setupCacheLock = Maybe Lock
forall a. Maybe a
Nothing
, isInteractive :: Bool
isInteractive = Bool
False
}
workingDir :: SetupScriptOptions -> FilePath
workingDir :: SetupScriptOptions -> [Char]
workingDir SetupScriptOptions
options =
case [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"" (SetupScriptOptions -> Maybe [Char]
useWorkingDir SetupScriptOptions
options) of
[] -> [Char]
"."
[Char]
dir -> [Char]
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
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PackageDescription
mpkg
let options' =
SetupScriptOptions
options
{ useCabalVersion =
intersectVersionRanges
(useCabalVersion options)
(orLaterVersion (mkVersion (cabalSpecMinimumLibraryVersion (specVersion pkg))))
}
buildType' = PackageDescription -> BuildType
buildType PackageDescription
pkg
(version, method, options'') <-
getSetupMethod verbosity options' pkg buildType'
return
Setup
{ setupMethod = method
, setupScriptOptions = options''
, setupVersion = version
, setupBuildType = buildType'
, setupPackage = pkg
}
where
getPkg :: IO PackageDescription
getPkg =
Verbosity -> [Char] -> IO [Char]
tryFindPackageDesc Verbosity
verbosity ([Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"." (SetupScriptOptions -> Maybe [Char]
useWorkingDir SetupScriptOptions
options))
IO [Char]
-> ([Char] -> IO GenericPackageDescription)
-> IO GenericPackageDescription
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Verbosity -> [Char] -> IO GenericPackageDescription
readGenericPackageDescription Verbosity
verbosity
IO GenericPackageDescription
-> (GenericPackageDescription -> IO PackageDescription)
-> IO PackageDescription
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PackageDescription -> IO PackageDescription
forall a. a -> IO a
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 a. a -> IO a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Version
cabalVersion, SetupMethod
InternalMethod, SetupScriptOptions
options)
runSetupMethod :: WithCallStack (SetupMethod -> SetupRunner)
runSetupMethod :: WithCallStack (SetupMethod -> SetupRunner)
runSetupMethod SetupMethod
InternalMethod = SetupRunner
internalSetupMethod
runSetupMethod (ExternalMethod [Char]
path) = WithCallStack ([Char] -> SetupRunner)
[Char] -> SetupRunner
externalSetupMethod [Char]
path
runSetupMethod SetupMethod
SelfExecMethod = SetupRunner
selfExecSetupMethod
runSetup
:: Verbosity
-> Setup
-> [String]
-> IO ()
runSetup :: Verbosity -> Setup -> [[Char]] -> IO ()
runSetup Verbosity
verbosity Setup
setup [[Char]]
args0 = do
let method :: SetupMethod
method = Setup -> SetupMethod
setupMethod Setup
setup
options :: SetupScriptOptions
options = Setup -> SetupScriptOptions
setupScriptOptions Setup
setup
bt :: BuildType
bt = Setup -> BuildType
setupBuildType Setup
setup
args :: [[Char]]
args = Version -> [[Char]] -> [[Char]]
verbosityHack (Setup -> Version
setupVersion Setup
setup) [[Char]]
args0
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
&& [[Char]]
args [[Char]] -> [[Char]] -> Bool
forall a. Eq a => a -> a -> Bool
/= [[Char]]
args0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> [Char] -> IO ()
infoNoWrap Verbosity
verbose ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char]
"Applied verbosity hack:\n"
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" Before: "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
args0
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" After: "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
args
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
WithCallStack (SetupMethod -> SetupRunner)
SetupMethod -> SetupRunner
runSetupMethod SetupMethod
method Verbosity
verbosity SetupScriptOptions
options BuildType
bt [[Char]]
args
verbosityHack :: Version -> [String] -> [String]
verbosityHack :: Version -> [[Char]] -> [[Char]]
verbosityHack Version
ver [[Char]]
args0
| Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
2, Int
1] = [[Char]]
args0
| Bool
otherwise = [[Char]] -> [[Char]]
go [[Char]]
args0
where
go :: [[Char]] -> [[Char]]
go ((Char
'-' : Char
'v' : [Char]
rest) : [[Char]]
args)
| Just [Char]
rest' <- [Char] -> Maybe [Char]
munch [Char]
rest = ([Char]
"-v" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
rest') [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]] -> [[Char]]
go [[Char]]
args
go ((Char
'-' : Char
'-' : Char
'v' : Char
'e' : Char
'r' : Char
'b' : Char
'o' : Char
's' : Char
'e' : Char
'=' : [Char]
rest) : [[Char]]
args)
| Just [Char]
rest' <- [Char] -> Maybe [Char]
munch [Char]
rest = ([Char]
"--verbose=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
rest') [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]] -> [[Char]]
go [[Char]]
args
go ([Char]
"--verbose" : [Char]
rest : [[Char]]
args)
| Just [Char]
rest' <- [Char] -> Maybe [Char]
munch [Char]
rest = [Char]
"--verbose" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char]
rest' [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]] -> [[Char]]
go [[Char]]
args
go rest :: [[Char]]
rest@([Char]
"--" : [[Char]]
_) = [[Char]]
rest
go ([Char]
arg : [[Char]]
args) = [Char]
arg [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]] -> [[Char]]
go [[Char]]
args
go [] = []
munch :: [Char] -> Maybe [Char]
munch [Char]
rest =
case ReadE Verbosity -> [Char] -> Either [Char] Verbosity
forall a. ReadE a -> [Char] -> Either [Char] a
runReadE ReadE Verbosity
flagToVerbosity [Char]
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 ->
[Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (Verbosity -> [Char]
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 ->
[Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (Verbosity -> [Char]
showForCabal (Verbosity -> Verbosity
verboseNoTimestamp Verbosity
v))
Either [Char] Verbosity
_ -> Maybe [Char]
forall a. Maybe a
Nothing
runSetupCommand
:: Verbosity
-> Setup
-> CommandUI flags
-> flags
-> [String]
-> IO ()
runSetupCommand :: forall flags.
Verbosity -> Setup -> CommandUI flags -> flags -> [[Char]] -> IO ()
runSetupCommand Verbosity
verbosity Setup
setup CommandUI flags
cmd flags
flags [[Char]]
extraArgs = do
let args :: [[Char]]
args = CommandUI flags -> [Char]
forall flags. CommandUI flags -> [Char]
commandName CommandUI flags
cmd [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: CommandUI flags -> flags -> [[Char]]
forall flags. CommandUI flags -> flags -> [[Char]]
commandShowOptions CommandUI flags
cmd flags
flags [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
extraArgs
Verbosity -> Setup -> [[Char]] -> IO ()
runSetup Verbosity
verbosity Setup
setup [[Char]]
args
setupWrapper
:: Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
-> (Version -> flags)
-> (Version -> [String])
-> IO ()
setupWrapper :: forall flags.
Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
-> (Version -> flags)
-> (Version -> [[Char]])
-> IO ()
setupWrapper Verbosity
verbosity SetupScriptOptions
options Maybe PackageDescription
mpkg CommandUI flags
cmd Version -> flags
flags Version -> [[Char]]
extraArgs = do
setup <- Verbosity
-> SetupScriptOptions -> Maybe PackageDescription -> IO Setup
getSetup Verbosity
verbosity SetupScriptOptions
options Maybe PackageDescription
mpkg
runSetupCommand
verbosity
setup
cmd
(flags $ setupVersion setup)
(extraArgs $ setupVersion setup)
internalSetupMethod :: SetupRunner
internalSetupMethod :: SetupRunner
internalSetupMethod Verbosity
verbosity SetupScriptOptions
options BuildType
bt [[Char]]
args = do
Verbosity -> [Char] -> IO ()
info Verbosity
verbosity ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char]
"Using internal setup method with build-type "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ BuildType -> [Char]
forall a. Show a => a -> [Char]
show BuildType
bt
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" and args:\n "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
args
Maybe [Char] -> IO () -> IO ()
forall a. Maybe [Char] -> IO a -> IO a
inDir (SetupScriptOptions -> Maybe [Char]
useWorkingDir SetupScriptOptions
options) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
[Char] -> [Char] -> IO () -> IO ()
forall a. [Char] -> [Char] -> IO a -> IO a
withEnv [Char]
"HASKELL_DIST_DIR" (SetupScriptOptions -> [Char]
useDistPref SetupScriptOptions
options) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
[[Char]] -> IO () -> IO ()
forall a. [[Char]] -> IO a -> IO a
withExtraPathEnv (SetupScriptOptions -> [[Char]]
useExtraPathEnv SetupScriptOptions
options) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
[([Char], Maybe [Char])] -> IO () -> IO ()
forall a. [([Char], Maybe [Char])] -> IO a -> IO a
withEnvOverrides (SetupScriptOptions -> [([Char], Maybe [Char])]
useExtraEnvOverrides SetupScriptOptions
options) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
BuildType -> [[Char]] -> IO ()
buildTypeAction BuildType
bt [[Char]]
args
buildTypeAction :: BuildType -> ([String] -> IO ())
buildTypeAction :: BuildType -> [[Char]] -> IO ()
buildTypeAction BuildType
Simple = [[Char]] -> IO ()
Simple.defaultMainArgs
buildTypeAction BuildType
Configure =
UserHooks -> [[Char]] -> IO ()
Simple.defaultMainWithHooksArgs
UserHooks
Simple.autoconfUserHooks
buildTypeAction BuildType
Make = [[Char]] -> IO ()
Make.defaultMainArgs
buildTypeAction BuildType
Custom = [Char] -> [[Char]] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"buildTypeAction Custom"
invoke :: Verbosity -> FilePath -> [String] -> SetupScriptOptions -> IO ()
invoke :: Verbosity -> [Char] -> [[Char]] -> SetupScriptOptions -> IO ()
invoke Verbosity
verbosity [Char]
path [[Char]]
args SetupScriptOptions
options = do
Verbosity -> [Char] -> IO ()
info Verbosity
verbosity ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords ([Char]
path [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
args)
case SetupScriptOptions -> Maybe Handle
useLoggingHandle SetupScriptOptions
options of
Maybe Handle
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Handle
logHandle -> Verbosity -> [Char] -> IO ()
info Verbosity
verbosity ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Redirecting build log to " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Handle -> [Char]
forall a. Show a => a -> [Char]
show Handle
logHandle
progDb <- Verbosity -> [[Char]] -> ProgramDb -> IO ProgramDb
prependProgramSearchPath Verbosity
verbosity (SetupScriptOptions -> [[Char]]
useExtraPathEnv SetupScriptOptions
options) (SetupScriptOptions -> ProgramDb
useProgramDb SetupScriptOptions
options)
searchpath <-
programSearchPathAsPATHVar $ getProgramSearchPath progDb
env <-
getEffectiveEnvironment $
[ ("PATH", Just searchpath)
, ("HASKELL_DIST_DIR", Just (useDistPref options))
]
++ useExtraEnvOverrides options
let loggingHandle = case SetupScriptOptions -> Maybe Handle
useLoggingHandle SetupScriptOptions
options of
Maybe Handle
Nothing -> StdStream
Inherit
Just Handle
hdl -> Handle -> StdStream
UseHandle Handle
hdl
cp =
([Char] -> [[Char]] -> CreateProcess
proc [Char]
path [[Char]]
args)
{ Process.cwd = useWorkingDir options
, Process.env = env
, Process.std_out = loggingHandle
, Process.std_err = loggingHandle
, Process.delegate_ctlc = isInteractive options
}
maybeExit $ rawSystemProc verbosity cp
selfExecSetupMethod :: SetupRunner
selfExecSetupMethod :: SetupRunner
selfExecSetupMethod Verbosity
verbosity SetupScriptOptions
options BuildType
bt [[Char]]
args0 = do
let args :: [[Char]]
args =
[ [Char]
"act-as-setup"
, [Char]
"--build-type=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ BuildType -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow BuildType
bt
, [Char]
"--"
]
[[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
args0
Verbosity -> [Char] -> IO ()
info Verbosity
verbosity ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char]
"Using self-exec internal setup method with build-type "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ BuildType -> [Char]
forall a. Show a => a -> [Char]
show BuildType
bt
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" and args:\n "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
args
path <- IO [Char]
getExecutablePath
invoke verbosity path args options
externalSetupMethod :: WithCallStack (FilePath -> SetupRunner)
externalSetupMethod :: WithCallStack ([Char] -> SetupRunner)
externalSetupMethod [Char]
path Verbosity
verbosity SetupScriptOptions
options BuildType
_ [[Char]]
args =
#ifndef mingw32_HOST_OS
Verbosity -> [Char] -> [[Char]] -> SetupScriptOptions -> IO ()
invoke
Verbosity
verbosity
[Char]
path
[[Char]]
args
SetupScriptOptions
options
#else
if useWin32CleanHack options
then invokeWithWin32CleanHack path
else invoke' path
where
invoke' p = invoke verbosity p args options
invokeWithWin32CleanHack origPath = do
info verbosity $ "Using the Win32 clean hack."
withTempDirectory verbosity (workingDir options) "cabal-tmp" $ \tmpDir ->
bracket
(moveOutOfTheWay tmpDir origPath)
(\tmpPath -> maybeRestore origPath tmpPath)
(\tmpPath -> invoke' tmpPath)
moveOutOfTheWay tmpDir origPath = do
let tmpPath = tmpDir </> "setup" <.> exeExtension buildPlatform
Win32.moveFile origPath tmpPath
return tmpPath
maybeRestore origPath tmpPath = do
let origPathDir = takeDirectory origPath
origPathDirExists <- doesDirectoryExist origPathDir
when origPathDirExists $
Win32.moveFile tmpPath origPath
#endif
getExternalSetupMethod
:: Verbosity
-> SetupScriptOptions
-> PackageDescription
-> BuildType
-> IO (Version, SetupMethod, SetupScriptOptions)
getExternalSetupMethod :: Verbosity
-> SetupScriptOptions
-> PackageDescription
-> BuildType
-> IO (Version, SetupMethod, SetupScriptOptions)
getExternalSetupMethod Verbosity
verbosity SetupScriptOptions
options PackageDescription
pkg BuildType
bt = do
Verbosity -> [Char] -> IO ()
debug Verbosity
verbosity ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Using external setup method with build-type " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ BuildType -> [Char]
forall a. Show a => a -> [Char]
show BuildType
bt
Verbosity -> [Char] -> IO ()
debug Verbosity
verbosity ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char]
"Using explicit dependencies: "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Bool -> [Char]
forall a. Show a => a -> [Char]
show (SetupScriptOptions -> Bool
useDependenciesExclusive SetupScriptOptions
options)
Verbosity -> Bool -> [Char] -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True [Char]
setupDir
(cabalLibVersion, mCabalLibInstalledPkgId, options') <- IO (Version, Maybe ComponentId, SetupScriptOptions)
cabalLibVersionToUse
debug verbosity $ "Using Cabal library version " ++ prettyShow cabalLibVersion
path <-
if useCachedSetupExecutable
then
getCachedSetupExecutable
options'
cabalLibVersion
mCabalLibInstalledPkgId
else
compileSetupExecutable
options'
cabalLibVersion
mCabalLibInstalledPkgId
False
path' <- tryCanonicalizePath path
#ifdef mingw32_HOST_OS
setupProgFile' <- canonicalizePathNoThrow setupProgFile
let win32CleanHackNeeded =
(useWin32CleanHack options)
&& setupProgFile' `equalFilePath` path'
#else
let win32CleanHackNeeded = Bool
False
#endif
let options'' = SetupScriptOptions
options'{useWin32CleanHack = win32CleanHackNeeded}
return (cabalLibVersion, ExternalMethod path', options'')
where
setupDir :: [Char]
setupDir = SetupScriptOptions -> [Char]
workingDir SetupScriptOptions
options [Char] -> [Char] -> [Char]
</> SetupScriptOptions -> [Char]
useDistPref SetupScriptOptions
options [Char] -> [Char] -> [Char]
</> [Char]
"setup"
setupVersionFile :: [Char]
setupVersionFile = [Char]
setupDir [Char] -> [Char] -> [Char]
</> [Char]
"setup" [Char] -> [Char] -> [Char]
<.> [Char]
"version"
setupHs :: [Char]
setupHs = [Char]
setupDir [Char] -> [Char] -> [Char]
</> [Char]
"setup" [Char] -> [Char] -> [Char]
<.> [Char]
"hs"
setupProgFile :: [Char]
setupProgFile = [Char]
setupDir [Char] -> [Char] -> [Char]
</> [Char]
"setup" [Char] -> [Char] -> [Char]
<.> Platform -> [Char]
exeExtension Platform
buildPlatform
platform :: Platform
platform = 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 a. a -> IO a
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 a. a -> IO a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Version
version, Maybe ComponentId
forall a. Maybe a
Nothing, SetupScriptOptions
options)
Maybe Version
Nothing -> do
savedVer <- IO (Maybe Version)
savedVersion
case 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
useExisting <- Version -> IO Bool
canUseExistingSetup Version
version
if useExisting
then return (version, Nothing, options)
else 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
(_, cachedSetupProgFile) <- SetupScriptOptions -> Version -> IO ([Char], [Char])
cachedSetupDirAndProg SetupScriptOptions
options Version
version
doesFileExist 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
<$> [Char]
setupProgFile [Char] -> [Char] -> IO Bool
`existsAndIsMoreRecentThan` [Char]
setupHs
IO (Bool -> Bool) -> IO Bool -> IO Bool
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char]
setupProgFile [Char] -> [Char] -> IO Bool
`existsAndIsMoreRecentThan` [Char]
setupVersionFile
writeSetupVersionFile :: Version -> IO ()
writeSetupVersionFile :: Version -> IO ()
writeSetupVersionFile Version
version =
[Char] -> [Char] -> IO ()
writeFile [Char]
setupVersionFile (Version -> [Char]
forall a. Show a => a -> [Char]
show Version
version [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n")
installedVersion
:: IO
( Version
, Maybe InstalledPackageId
, SetupScriptOptions
)
installedVersion :: IO (Version, Maybe ComponentId, SetupScriptOptions)
installedVersion = do
(comp, progdb, options') <- SetupScriptOptions -> IO (Compiler, ProgramDb, SetupScriptOptions)
configureCompiler SetupScriptOptions
options
(version, mipkgid, options'') <-
installedCabalVersion
options'
comp
progdb
updateSetupScript version bt
writeSetupVersionFile version
return (version, mipkgid, options'')
savedVersion :: IO (Maybe Version)
savedVersion :: IO (Maybe Version)
savedVersion = do
versionString <- [Char] -> IO [Char]
readFile [Char]
setupVersionFile IO [Char] -> (IOException -> IO [Char]) -> IO [Char]
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ -> [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
""
case reads versionString of
[(Version
version, [Char]
s)] | (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace [Char]
s -> Maybe Version -> IO (Maybe Version)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
version)
[(Version, [Char])]
_ -> Maybe Version -> IO (Maybe Version)
forall a. a -> IO a
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
useHs <- [Char] -> IO Bool
doesFileExist [Char]
customSetupHs
useLhs <- doesFileExist customSetupLhs
unless (useHs || useLhs) $
dieWithException verbosity UpdateSetupScript
let src = (if Bool
useHs then [Char]
customSetupHs else [Char]
customSetupLhs)
srcNewer <- src `moreRecentFile` setupHs
when srcNewer $
if useHs
then copyFileVerbose verbosity src setupHs
else runSimplePreProcessor ppUnlit src setupHs verbosity
where
customSetupHs :: [Char]
customSetupHs = SetupScriptOptions -> [Char]
workingDir SetupScriptOptions
options [Char] -> [Char] -> [Char]
</> [Char]
"Setup.hs"
customSetupLhs :: [Char]
customSetupLhs = SetupScriptOptions -> [Char]
workingDir SetupScriptOptions
options [Char] -> [Char] -> [Char]
</> [Char]
"Setup.lhs"
updateSetupScript Version
cabalLibVersion BuildType
_ =
Verbosity -> [Char] -> ByteString -> IO ()
rewriteFileLBS Verbosity
verbosity [Char]
setupHs (Version -> ByteString
buildTypeScript Version
cabalLibVersion)
buildTypeScript :: Version -> BS.ByteString
buildTypeScript :: Version -> ByteString
buildTypeScript Version
cabalLibVersion = case BuildType
bt of
BuildType
Simple -> ByteString
"import Distribution.Simple; main = defaultMain\n"
BuildType
Configure
| Version
cabalLibVersion 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 -> [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"buildTypeScript Custom"
installedCabalVersion
:: SetupScriptOptions
-> Compiler
-> ProgramDb
-> IO
( Version
, Maybe InstalledPackageId
, SetupScriptOptions
)
installedCabalVersion :: SetupScriptOptions
-> Compiler
-> ProgramDb
-> IO (Version, Maybe ComponentId, SetupScriptOptions)
installedCabalVersion SetupScriptOptions
options' Compiler
_ ProgramDb
_
| PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== [Char] -> PackageName
mkPackageName [Char]
"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 a. a -> IO a
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
index <- SetupScriptOptions
-> Compiler -> ProgramDb -> IO InstalledPackageIndex
maybeGetInstalledPackages SetupScriptOptions
options' Compiler
compiler ProgramDb
progdb
let cabalDepName = [Char] -> PackageName
mkPackageName [Char]
"Cabal"
cabalDepVersion = SetupScriptOptions -> VersionRange
useCabalVersion SetupScriptOptions
options'
options'' = SetupScriptOptions
options'{usePackageIndex = Just index}
case PackageIndex.lookupDependency index cabalDepName cabalDepVersion of
[] ->
Verbosity
-> CabalInstallException
-> IO (Version, Maybe ComponentId, SetupScriptOptions)
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException
-> IO (Version, Maybe ComponentId, SetupScriptOptions))
-> CabalInstallException
-> IO (Version, Maybe ComponentId, SetupScriptOptions)
forall a b. (a -> b) -> a -> b
$ PackageName -> VersionRange -> CabalInstallException
InstalledCabalVersion (PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg) (SetupScriptOptions -> VersionRange
useCabalVersion SetupScriptOptions
options)
[(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 = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Distribution.Client.installedCabalVersion: empty version list"
in (Version, Maybe ComponentId, SetupScriptOptions)
-> IO (Version, Maybe ComponentId, SetupScriptOptions)
forall a. a -> IO a
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 :: forall a. (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 :: forall a. (a -> a -> Ordering) -> [a] -> a
firstMaximumBy a -> a -> Ordering
_ [] =
[Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Distribution.Client.firstMaximumBy: empty list"
firstMaximumBy a -> a -> Ordering
cmp [a]
xs = (a -> a -> a) -> [a] -> a
forall a. HasCallStack => (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
(comp, progdb) <- case SetupScriptOptions -> Maybe Compiler
useCompiler SetupScriptOptions
options' of
Just Compiler
comp -> (Compiler, ProgramDb) -> IO (Compiler, ProgramDb)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Compiler
comp, SetupScriptOptions -> ProgramDb
useProgramDb SetupScriptOptions
options')
Maybe Compiler
Nothing -> do
(comp, _, progdb) <-
Maybe CompilerFlavor
-> Maybe [Char]
-> Maybe [Char]
-> ProgramDb
-> Verbosity
-> IO (Compiler, Platform, ProgramDb)
configCompilerEx
(CompilerFlavor -> Maybe CompilerFlavor
forall a. a -> Maybe a
Just CompilerFlavor
GHC)
Maybe [Char]
forall a. Maybe a
Nothing
Maybe [Char]
forall a. Maybe a
Nothing
(SetupScriptOptions -> ProgramDb
useProgramDb SetupScriptOptions
options')
Verbosity
verbosity
return (comp, progdb)
index <- maybeGetInstalledPackages options' comp progdb
return
( comp
, progdb
, options'
{ useCompiler = Just comp
, usePackageIndex = Just index
, useProgramDb = progdb
}
)
cachedSetupDirAndProg
:: SetupScriptOptions
-> Version
-> IO (FilePath, FilePath)
cachedSetupDirAndProg :: SetupScriptOptions -> Version -> IO ([Char], [Char])
cachedSetupDirAndProg SetupScriptOptions
options' Version
cabalLibVersion = do
cacheDir <- IO [Char]
defaultCacheDir
let setupCacheDir = [Char]
cacheDir [Char] -> [Char] -> [Char]
</> [Char]
"setup-exe-cache"
cachedSetupProgFile =
[Char]
setupCacheDir
[Char] -> [Char] -> [Char]
</> ( [Char]
"setup-"
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
buildTypeString
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-"
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cabalVersionString
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-"
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
platformString
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-"
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
compilerVersionString
)
[Char] -> [Char] -> [Char]
<.> Platform -> [Char]
exeExtension Platform
buildPlatform
return (setupCacheDir, cachedSetupProgFile)
where
buildTypeString :: [Char]
buildTypeString = BuildType -> [Char]
forall a. Show a => a -> [Char]
show BuildType
bt
cabalVersionString :: [Char]
cabalVersionString = [Char]
"Cabal-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Version -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow Version
cabalLibVersion
compilerVersionString :: [Char]
compilerVersionString =
CompilerId -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow (CompilerId -> [Char]) -> CompilerId -> [Char]
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 :: [Char]
platformString = Platform -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow Platform
platform
getCachedSetupExecutable
:: SetupScriptOptions
-> Version
-> Maybe InstalledPackageId
-> IO FilePath
getCachedSetupExecutable :: SetupScriptOptions -> Version -> Maybe ComponentId -> IO [Char]
getCachedSetupExecutable
SetupScriptOptions
options'
Version
cabalLibVersion
Maybe ComponentId
maybeCabalLibInstalledPkgId = do
(setupCacheDir, cachedSetupProgFile) <-
SetupScriptOptions -> Version -> IO ([Char], [Char])
cachedSetupDirAndProg SetupScriptOptions
options' Version
cabalLibVersion
cachedSetupExists <- doesFileExist cachedSetupProgFile
if cachedSetupExists
then
debug verbosity $
"Found cached setup executable: " ++ cachedSetupProgFile
else criticalSection' $ do
cachedSetupExists' <- doesFileExist cachedSetupProgFile
if cachedSetupExists'
then
debug verbosity $
"Found cached setup executable: " ++ cachedSetupProgFile
else do
debug verbosity $ "Setup executable not found in the cache."
src <-
compileSetupExecutable
options'
cabalLibVersion
maybeCabalLibInstalledPkgId
True
createDirectoryIfMissingVerbose verbosity True setupCacheDir
installExecutableFile verbosity src cachedSetupProgFile
when (maybe True ((/= GHCJS) . compilerFlavor) $ useCompiler options') $
Strip.stripExe
verbosity
platform
(useProgramDb options')
cachedSetupProgFile
return 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 [Char]
compileSetupExecutable
SetupScriptOptions
options'
Version
cabalLibVersion
Maybe ComponentId
maybeCabalLibInstalledPkgId
Bool
forceCompile = do
setupHsNewer <- [Char]
setupHs [Char] -> [Char] -> IO Bool
`moreRecentFile` [Char]
setupProgFile
cabalVersionNewer <- setupVersionFile `moreRecentFile` setupProgFile
let outOfDate = Bool
setupHsNewer Bool -> Bool -> Bool
|| Bool
cabalVersionNewer
when (outOfDate || forceCompile) $ do
debug verbosity "Setup executable needs to be updated, compiling..."
(compiler, progdb, options'') <- configureCompiler options'
let cabalPkgid = PackageName -> Version -> PackageId
PackageIdentifier ([Char] -> PackageName
mkPackageName [Char]
"Cabal") Version
cabalLibVersion
(program, extraOpts) =
case compilerFlavor compiler of
CompilerFlavor
GHCJS -> (Program
ghcjsProgram, [[Char]
"-build-runner"])
CompilerFlavor
_ -> (Program
ghcProgram, [[Char]
"-threaded"])
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
| 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
ipid, b
_) =
( DefUnitId -> OpenUnitId
Backpack.DefiniteUnitId (UnitId -> DefUnitId
unsafeMkDefUnitId (ComponentId -> UnitId
newSimpleUnitId ComponentId
ipid))
, ModuleRenaming
defaultRenaming
)
cppMacrosFile = [Char]
setupDir [Char] -> [Char] -> [Char]
</> [Char]
"setup_macros.h"
ghcOptions =
GhcOptions
forall a. Monoid a => a
mempty
{
ghcOptVerbosity = Flag (min verbosity normal)
, ghcOptMode = Flag GhcModeMake
, ghcOptInputFiles = toNubListR [setupHs]
, ghcOptOutputFile = Flag setupProgFile
, ghcOptObjDir = Flag setupDir
, ghcOptHiDir = Flag setupDir
, ghcOptSourcePathClear = Flag True
, ghcOptSourcePath = case bt of
BuildType
Custom -> [[Char]] -> NubListR [Char]
forall a. Ord a => [a] -> NubListR a
toNubListR [SetupScriptOptions -> [Char]
workingDir SetupScriptOptions
options']
BuildType
_ -> NubListR [Char]
forall a. Monoid a => a
mempty
, ghcOptPackageDBs = usePackageDB options''
, ghcOptHideAllPackages = Flag (useDependenciesExclusive options')
, ghcOptCabal = Flag (useDependenciesExclusive options')
, ghcOptPackages = toNubListR $ map addRenaming selectedDeps
, ghcOptCppIncludes =
toNubListR
[ cppMacrosFile
| useVersionMacros options'
]
, ghcOptExtra = extraOpts
}
let ghcCmdLine = Compiler -> Platform -> GhcOptions -> [[Char]]
renderGhcOptions Compiler
compiler Platform
platform GhcOptions
ghcOptions
when (useVersionMacros options') $
rewriteFileEx verbosity cppMacrosFile $
generatePackageVersionMacros (pkgVersion $ package pkg) (map snd selectedDeps)
case useLoggingHandle options of
Maybe Handle
Nothing -> Verbosity -> Program -> ProgramDb -> [[Char]] -> IO ()
runDbProgram Verbosity
verbosity Program
program ProgramDb
progdb [[Char]]
ghcCmdLine
(Just Handle
logHandle) -> do
output <-
Verbosity -> Program -> ProgramDb -> [[Char]] -> IO [Char]
getDbProgramOutput
Verbosity
verbosity
Program
program
ProgramDb
progdb
[[Char]]
ghcCmdLine
hPutStr logHandle output
return setupProgFile
isCabalPkgId :: PackageIdentifier -> Bool
isCabalPkgId :: PackageId -> Bool
isCabalPkgId (PackageIdentifier PackageName
pname Version
_) = PackageName
pname PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== [Char] -> PackageName
mkPackageName [Char]
"Cabal"