{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Stack.Setup
( setupEnv
, ensureCompilerAndMsys
, ensureDockerStackExe
, SetupOpts (..)
, defaultSetupInfoYaml
, withNewLocalBuildTargets
, StackReleaseInfo
, getDownloadVersion
, stackVersion
, preferredPlatforms
, downloadStackReleaseInfo
, downloadStackExe
) where
import qualified Codec.Archive.Tar as Tar
import Conduit
import Control.Applicative (empty)
import "cryptonite" Crypto.Hash (SHA1(..), SHA256(..))
import Pantry.Internal.AesonExtended
import qualified Data.Aeson.KeyMap as KeyMap
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Conduit.Binary as CB
import Data.Conduit.Lazy (lazyConsume)
import qualified Data.Conduit.List as CL
import Data.Conduit.Process.Typed (createSource)
import Data.Conduit.Zlib (ungzip)
import Data.List hiding (concat, elem, maximumBy, any)
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy.Encoding as TL
import qualified Data.Text.Encoding.Error as T
import qualified Data.Yaml as Yaml
import Distribution.System (OS, Arch (..), Platform (..))
import qualified Distribution.System as Cabal
import Distribution.Text (simpleParse)
import Distribution.Types.PackageName (mkPackageName)
import Distribution.Version (mkVersion)
import Network.HTTP.Client (redirectCount)
import Network.HTTP.StackClient (CheckHexDigest (..), HashCheck (..),
getResponseBody, getResponseStatusCode, httpLbs, httpJSON,
mkDownloadRequest, parseRequest, parseUrlThrow, setGitHubHeaders,
setHashChecks, setLengthCheck, verifiedDownloadWithProgress, withResponse,
setRequestMethod)
import Network.HTTP.Simple (getResponseHeader)
import Path hiding (fileExtension)
import Path.CheckInstall (warnInstallSearchPathIssues)
import Path.Extended (fileExtension)
import Path.Extra (toFilePathNoTrailingSep)
import Path.IO hiding (findExecutable, withSystemTempDir)
import qualified Pantry
import qualified RIO
import RIO.List
import RIO.PrettyPrint
import RIO.Process
import Stack.Build.Haddock (shouldHaddockDeps)
import Stack.Build.Source (loadSourceMap, hashSourceMapData)
import Stack.Build.Target (NeedTargets(..), parseTargets)
import Stack.Constants
import Stack.Constants.Config (distRelativeDir)
import Stack.GhcPkg (createDatabase, getGlobalDB, mkGhcPackagePath, ghcPkgPathEnvVar)
import Stack.Prelude hiding (Display (..))
import Stack.SourceMap
import Stack.Setup.Installed (Tool (..), extraDirs, filterTools,
installDir, getCompilerVersion,
listInstalled, markInstalled, tempInstallDir,
toolString, unmarkInstalled)
import Stack.Storage.User (loadCompilerPaths, saveCompilerPaths)
import Stack.Types.Build
import Stack.Types.Compiler
import Stack.Types.CompilerBuild
import Stack.Types.Config
import Stack.Types.Docker
import Stack.Types.SourceMap
import Stack.Types.Version
import qualified System.Directory as D
import System.Environment (getExecutablePath, lookupEnv)
import System.IO.Error (isPermissionError)
import System.FilePath (searchPathSeparator)
import qualified System.FilePath as FP
import System.Permissions (setFileExecutable)
import System.Uname (getRelease)
import Data.List.Split (splitOn)
defaultSetupInfoYaml :: String
defaultSetupInfoYaml :: [Char]
defaultSetupInfoYaml =
[Char]
"https://raw.githubusercontent.com/commercialhaskell/stackage-content/master/stack/stack-setup-2.yaml"
data SetupOpts = SetupOpts
{ SetupOpts -> Bool
soptsInstallIfMissing :: !Bool
, SetupOpts -> Bool
soptsUseSystem :: !Bool
, SetupOpts -> WantedCompiler
soptsWantedCompiler :: !WantedCompiler
, SetupOpts -> VersionCheck
soptsCompilerCheck :: !VersionCheck
, SetupOpts -> Maybe (Path Abs File)
soptsStackYaml :: !(Maybe (Path Abs File))
, SetupOpts -> Bool
soptsForceReinstall :: !Bool
, SetupOpts -> Bool
soptsSanityCheck :: !Bool
, SetupOpts -> Bool
soptsSkipGhcCheck :: !Bool
, SetupOpts -> Bool
soptsSkipMsys :: !Bool
, SetupOpts -> Maybe Text
soptsResolveMissingGHC :: !(Maybe Text)
, SetupOpts -> Maybe [Char]
soptsGHCBindistURL :: !(Maybe String)
}
deriving Int -> SetupOpts -> ShowS
[SetupOpts] -> ShowS
SetupOpts -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SetupOpts] -> ShowS
$cshowList :: [SetupOpts] -> ShowS
show :: SetupOpts -> [Char]
$cshow :: SetupOpts -> [Char]
showsPrec :: Int -> SetupOpts -> ShowS
$cshowsPrec :: Int -> SetupOpts -> ShowS
Show
data SetupException = UnsupportedSetupCombo OS Arch
| MissingDependencies [String]
| UnknownCompilerVersion (Set.Set Text) WantedCompiler (Set.Set ActualCompiler)
| UnknownOSKey Text
| GHCSanityCheckCompileFailed SomeException (Path Abs File)
| WantedMustBeGHC
| RequireCustomGHCVariant
| ProblemWhileDecompressing (Path Abs File)
| SetupInfoMissingSevenz
| DockerStackExeNotFound Version Text
| UnsupportedSetupConfiguration
| InvalidGhcAt (Path Abs File) SomeException
deriving Typeable
instance Exception SetupException
instance Show SetupException where
show :: SetupException -> [Char]
show (UnsupportedSetupCombo OS
os Arch
arch) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Char]
"I don't know how to install GHC for "
, forall a. Show a => a -> [Char]
show (OS
os, Arch
arch)
, [Char]
", please install manually"
]
show (MissingDependencies [[Char]]
tools) =
[Char]
"The following executables are missing and must be installed: " forall a. [a] -> [a] -> [a]
++
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " [[Char]]
tools
show (UnknownCompilerVersion Set Text
oskeys WantedCompiler
wanted Set ActualCompiler
known) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Char]
"No setup information found for "
, Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ Utf8Builder -> Text
utf8BuilderToText forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Utf8Builder
RIO.display WantedCompiler
wanted
, [Char]
" on your platform.\nThis probably means a GHC bindist has not yet been added for OS key '"
, Text -> [Char]
T.unpack (Text -> [Text] -> Text
T.intercalate Text
"', '" (forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set Text
oskeys))
, [Char]
"'.\nSupported versions: "
, Text -> [Char]
T.unpack (Text -> [Text] -> Text
T.intercalate Text
", " (forall a b. (a -> b) -> [a] -> [b]
map ActualCompiler -> Text
compilerVersionText (forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set ActualCompiler
known)))
]
show (UnknownOSKey Text
oskey) =
[Char]
"Unable to find installation URLs for OS key: " forall a. [a] -> [a] -> [a]
++
Text -> [Char]
T.unpack Text
oskey
show (GHCSanityCheckCompileFailed SomeException
e Path Abs File
ghc) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Char]
"The GHC located at "
, forall b t. Path b t -> [Char]
toFilePath Path Abs File
ghc
, [Char]
" failed to compile a sanity check. Please see:\n\n"
, [Char]
" http://docs.haskellstack.org/en/stable/install_and_upgrade/\n\n"
, [Char]
"for more information. Exception was:\n"
, forall a. Show a => a -> [Char]
show SomeException
e
]
show SetupException
WantedMustBeGHC =
[Char]
"The wanted compiler must be GHC"
show SetupException
RequireCustomGHCVariant =
[Char]
"A custom --ghc-variant must be specified to use --ghc-bindist"
show (ProblemWhileDecompressing Path Abs File
archive) =
[Char]
"Problem while decompressing " forall a. [a] -> [a] -> [a]
++ forall b t. Path b t -> [Char]
toFilePath Path Abs File
archive
show SetupException
SetupInfoMissingSevenz =
[Char]
"SetupInfo missing Sevenz EXE/DLL"
show (DockerStackExeNotFound Version
stackVersion' Text
osKey) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Char]
stackProgName
, [Char]
"-"
, Version -> [Char]
versionString Version
stackVersion'
, [Char]
" executable not found for "
, Text -> [Char]
T.unpack Text
osKey
, [Char]
"\nUse the '"
, Text -> [Char]
T.unpack Text
dockerStackExeArgName
, [Char]
"' option to specify a location"]
show SetupException
UnsupportedSetupConfiguration =
[Char]
"I don't know how to install GHC on your system configuration, please install manually"
show (InvalidGhcAt Path Abs File
compiler SomeException
e) =
[Char]
"Found an invalid compiler at " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall b t. Path b t -> [Char]
toFilePath Path Abs File
compiler) forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ forall e. Exception e => e -> [Char]
displayException SomeException
e
setupEnv :: NeedTargets
-> BuildOptsCLI
-> Maybe Text
-> RIO BuildConfig EnvConfig
setupEnv :: NeedTargets
-> BuildOptsCLI -> Maybe Text -> RIO BuildConfig EnvConfig
setupEnv NeedTargets
needTargets BuildOptsCLI
boptsCLI Maybe Text
mResolveMissingGHC = do
Config
config <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env Config
configL
BuildConfig
bc <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasBuildConfig env => Lens' env BuildConfig
buildConfigL
let stackYaml :: Path Abs File
stackYaml = BuildConfig -> Path Abs File
bcStackYaml BuildConfig
bc
Platform
platform <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasPlatform env => Lens' env Platform
platformL
WantedCompiler
wcVersion <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s r. HasBuildConfig s => Getting r s WantedCompiler
wantedCompilerVersionL
WantedCompiler
wanted <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s r. HasBuildConfig s => Getting r s WantedCompiler
wantedCompilerVersionL
ActualCompiler
actual <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ WantedCompiler -> Either CompilerException ActualCompiler
wantedToActual WantedCompiler
wanted
let wc :: WhichCompiler
wc = ActualCompiler
actualforall s a. s -> Getting a s a -> a
^.forall r. Getting r ActualCompiler WhichCompiler
whichCompilerL
let sopts :: SetupOpts
sopts = SetupOpts
{ soptsInstallIfMissing :: Bool
soptsInstallIfMissing = Config -> Bool
configInstallGHC Config
config
, soptsUseSystem :: Bool
soptsUseSystem = Config -> Bool
configSystemGHC Config
config
, soptsWantedCompiler :: WantedCompiler
soptsWantedCompiler = WantedCompiler
wcVersion
, soptsCompilerCheck :: VersionCheck
soptsCompilerCheck = Config -> VersionCheck
configCompilerCheck Config
config
, soptsStackYaml :: Maybe (Path Abs File)
soptsStackYaml = forall a. a -> Maybe a
Just Path Abs File
stackYaml
, soptsForceReinstall :: Bool
soptsForceReinstall = Bool
False
, soptsSanityCheck :: Bool
soptsSanityCheck = Bool
False
, soptsSkipGhcCheck :: Bool
soptsSkipGhcCheck = Config -> Bool
configSkipGHCCheck Config
config
, soptsSkipMsys :: Bool
soptsSkipMsys = Config -> Bool
configSkipMsys Config
config
, soptsResolveMissingGHC :: Maybe Text
soptsResolveMissingGHC = Maybe Text
mResolveMissingGHC
, soptsGHCBindistURL :: Maybe [Char]
soptsGHCBindistURL = forall a. Maybe a
Nothing
}
(CompilerPaths
compilerPaths, ExtraDirs
ghcBin) <- forall env.
(HasBuildConfig env, HasGHCVariant env) =>
SetupOpts -> RIO env (CompilerPaths, ExtraDirs)
ensureCompilerAndMsys SetupOpts
sopts
let compilerVer :: ActualCompiler
compilerVer = CompilerPaths -> ActualCompiler
cpCompilerVersion CompilerPaths
compilerPaths
ProcessContext
menv0 <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasProcessContext env => Lens' env ProcessContext
processContextL
Map Text Text
env <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Text -> Map Text Text
removeHaskellEnvVars)
forall a b. (a -> b) -> a -> b
$ [[Char]]
-> Map Text Text -> Either ProcessException (Map Text Text)
augmentPathMap
(forall a b. (a -> b) -> [a] -> [b]
map forall b t. Path b t -> [Char]
toFilePath forall a b. (a -> b) -> a -> b
$ ExtraDirs -> [Path Abs Dir]
edBins ExtraDirs
ghcBin)
(forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env.
HasProcessContext env =>
SimpleGetter env (Map Text Text)
envVarsL ProcessContext
menv0)
ProcessContext
menv <- forall (m :: * -> *).
MonadIO m =>
Map Text Text -> m ProcessContext
mkProcessContext Map Text Text
env
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Resolving package entries"
(SourceMap
sourceMap, SourceMapHash
sourceMapHash) <- forall env a.
HasConfig env =>
ProcessContext -> CompilerPaths -> RIO (WithGHC env) a -> RIO env a
runWithGHC ProcessContext
menv CompilerPaths
compilerPaths forall a b. (a -> b) -> a -> b
$ do
SMActual DumpedGlobalPackage
smActual <- forall env.
(HasConfig env, HasCompiler env) =>
SMWanted
-> ActualCompiler -> RIO env (SMActual DumpedGlobalPackage)
actualFromGhc (BuildConfig -> SMWanted
bcSMWanted BuildConfig
bc) ActualCompiler
compilerVer
let actualPkgs :: Set PackageName
actualPkgs = forall k a. Map k a -> Set k
Map.keysSet (forall global. SMActual global -> Map PackageName DepPackage
smaDeps SMActual DumpedGlobalPackage
smActual) forall a. Semigroup a => a -> a -> a
<>
forall k a. Map k a -> Set k
Map.keysSet (forall global. SMActual global -> Map PackageName ProjectPackage
smaProject SMActual DumpedGlobalPackage
smActual)
prunedActual :: SMActual GlobalPackage
prunedActual = SMActual DumpedGlobalPackage
smActual { smaGlobal :: Map PackageName GlobalPackage
smaGlobal = Map PackageName DumpedGlobalPackage
-> Set PackageName -> Map PackageName GlobalPackage
pruneGlobals (forall global. SMActual global -> Map PackageName global
smaGlobal SMActual DumpedGlobalPackage
smActual) Set PackageName
actualPkgs }
haddockDeps :: Bool
haddockDeps = BuildOpts -> Bool
shouldHaddockDeps (Config -> BuildOpts
configBuild Config
config)
SMTargets
targets <- forall env.
HasBuildConfig env =>
NeedTargets
-> Bool
-> BuildOptsCLI
-> SMActual GlobalPackage
-> RIO env SMTargets
parseTargets NeedTargets
needTargets Bool
haddockDeps BuildOptsCLI
boptsCLI SMActual GlobalPackage
prunedActual
SourceMap
sourceMap <- forall env.
HasBuildConfig env =>
SMTargets
-> BuildOptsCLI
-> SMActual DumpedGlobalPackage
-> RIO env SourceMap
loadSourceMap SMTargets
targets BuildOptsCLI
boptsCLI SMActual DumpedGlobalPackage
smActual
SourceMapHash
sourceMapHash <- forall env.
(HasBuildConfig env, HasCompiler env) =>
BuildOptsCLI -> SourceMap -> RIO env SourceMapHash
hashSourceMapData BuildOptsCLI
boptsCLI SourceMap
sourceMap
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourceMap
sourceMap, SourceMapHash
sourceMapHash)
let envConfig0 :: EnvConfig
envConfig0 = EnvConfig
{ envConfigBuildConfig :: BuildConfig
envConfigBuildConfig = BuildConfig
bc
, envConfigBuildOptsCLI :: BuildOptsCLI
envConfigBuildOptsCLI = BuildOptsCLI
boptsCLI
, envConfigSourceMap :: SourceMap
envConfigSourceMap = SourceMap
sourceMap
, envConfigSourceMapHash :: SourceMapHash
envConfigSourceMapHash = SourceMapHash
sourceMapHash
, envConfigCompilerPaths :: CompilerPaths
envConfigCompilerPaths = CompilerPaths
compilerPaths
}
Bool -> [Path Abs Dir]
mkDirs <- forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO EnvConfig
envConfig0 forall env. HasEnvConfig env => RIO env (Bool -> [Path Abs Dir])
extraBinDirs
let mpath :: Maybe Text
mpath = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"PATH" Map Text Text
env
Text
depsPath <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [[Char]] -> Maybe Text -> Either ProcessException Text
augmentPath (forall b t. Path b t -> [Char]
toFilePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> [Path Abs Dir]
mkDirs Bool
False) Maybe Text
mpath
Text
localsPath <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [[Char]] -> Maybe Text -> Either ProcessException Text
augmentPath (forall b t. Path b t -> [Char]
toFilePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> [Path Abs Dir]
mkDirs Bool
True) Maybe Text
mpath
Path Abs Dir
deps <- forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO EnvConfig
envConfig0 forall env. HasEnvConfig env => RIO env (Path Abs Dir)
packageDatabaseDeps
forall env a.
HasConfig env =>
ProcessContext -> CompilerPaths -> RIO (WithGHC env) a -> RIO env a
runWithGHC ProcessContext
menv CompilerPaths
compilerPaths forall a b. (a -> b) -> a -> b
$ forall env.
(HasProcessContext env, HasLogFunc env) =>
GhcPkgExe -> Path Abs Dir -> RIO env ()
createDatabase (CompilerPaths -> GhcPkgExe
cpPkg CompilerPaths
compilerPaths) Path Abs Dir
deps
Path Abs Dir
localdb <- forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO EnvConfig
envConfig0 forall env. HasEnvConfig env => RIO env (Path Abs Dir)
packageDatabaseLocal
forall env a.
HasConfig env =>
ProcessContext -> CompilerPaths -> RIO (WithGHC env) a -> RIO env a
runWithGHC ProcessContext
menv CompilerPaths
compilerPaths forall a b. (a -> b) -> a -> b
$ forall env.
(HasProcessContext env, HasLogFunc env) =>
GhcPkgExe -> Path Abs Dir -> RIO env ()
createDatabase (CompilerPaths -> GhcPkgExe
cpPkg CompilerPaths
compilerPaths) Path Abs Dir
localdb
[Path Abs Dir]
extras <- forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT forall env (m :: * -> *).
(MonadReader env m, HasEnvConfig env) =>
m [Path Abs Dir]
packageDatabaseExtra EnvConfig
envConfig0
let mkGPP :: Bool -> Text
mkGPP Bool
locals = Bool
-> Path Abs Dir
-> Path Abs Dir
-> [Path Abs Dir]
-> Path Abs Dir
-> Text
mkGhcPackagePath Bool
locals Path Abs Dir
localdb Path Abs Dir
deps [Path Abs Dir]
extras forall a b. (a -> b) -> a -> b
$ CompilerPaths -> Path Abs Dir
cpGlobalDB CompilerPaths
compilerPaths
Path Abs Dir
distDir <- forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT forall (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
m (Path Rel Dir)
distRelativeDir EnvConfig
envConfig0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall path (m :: * -> *).
(AnyPath path, MonadIO m) =>
path -> m (AbsPath path)
canonicalizePath
[Char]
executablePath <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Char]
getExecutablePath
Map Text Text
utf8EnvVars <- forall env a.
HasProcessContext env =>
ProcessContext -> RIO env a -> RIO env a
withProcessContext ProcessContext
menv forall a b. (a -> b) -> a -> b
$ forall env.
(HasProcessContext env, HasPlatform env, HasLogFunc env) =>
ActualCompiler -> RIO env (Map Text Text)
getUtf8EnvVars ActualCompiler
compilerVer
Maybe [Char]
mGhcRtsEnvVar <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"GHCRTS"
IORef (Map EnvSettings ProcessContext)
envRef <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef forall k a. Map k a
Map.empty
let getProcessContext' :: EnvSettings -> IO ProcessContext
getProcessContext' EnvSettings
es = do
Map EnvSettings ProcessContext
m <- forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef (Map EnvSettings ProcessContext)
envRef
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup EnvSettings
es Map EnvSettings ProcessContext
m of
Just ProcessContext
eo -> forall (m :: * -> *) a. Monad m => a -> m a
return ProcessContext
eo
Maybe ProcessContext
Nothing -> do
ProcessContext
eo <- forall (m :: * -> *).
MonadIO m =>
Map Text Text -> m ProcessContext
mkProcessContext
forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"PATH" (if EnvSettings -> Bool
esIncludeLocals EnvSettings
es then Text
localsPath else Text
depsPath)
forall a b. (a -> b) -> a -> b
$ (if EnvSettings -> Bool
esIncludeGhcPackagePath EnvSettings
es
then forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (WhichCompiler -> Text
ghcPkgPathEnvVar WhichCompiler
wc) (Bool -> Text
mkGPP (EnvSettings -> Bool
esIncludeLocals EnvSettings
es))
else forall a. a -> a
id)
forall a b. (a -> b) -> a -> b
$ (if EnvSettings -> Bool
esStackExe EnvSettings
es
then forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"STACK_EXE" ([Char] -> Text
T.pack [Char]
executablePath)
else forall a. a -> a
id)
forall a b. (a -> b) -> a -> b
$ (if EnvSettings -> Bool
esLocaleUtf8 EnvSettings
es
then forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Text Text
utf8EnvVars
else forall a. a -> a
id)
forall a b. (a -> b) -> a -> b
$ case (SetupOpts -> Bool
soptsSkipMsys SetupOpts
sopts, Platform
platform) of
(Bool
False, Platform Arch
Cabal.I386 OS
Cabal.Windows)
-> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"MSYSTEM" Text
"MINGW32"
(Bool
False, Platform Arch
Cabal.X86_64 OS
Cabal.Windows)
-> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"MSYSTEM" Text
"MINGW64"
(Bool, Platform)
_ -> forall a. a -> a
id
forall a b. (a -> b) -> a -> b
$ case (EnvSettings -> Bool
esKeepGhcRts EnvSettings
es, Maybe [Char]
mGhcRtsEnvVar) of
(Bool
True, Just [Char]
ghcRts) -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"GHCRTS" ([Char] -> Text
T.pack [Char]
ghcRts)
(Bool, Maybe [Char])
_ -> forall a. a -> a
id
forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"HASKELL_PACKAGE_SANDBOX" ([Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall loc. Path loc Dir -> [Char]
toFilePathNoTrailingSep Path Abs Dir
deps)
forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"HASKELL_PACKAGE_SANDBOXES"
([Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ if EnvSettings -> Bool
esIncludeLocals EnvSettings
es
then forall a. [a] -> [[a]] -> [a]
intercalate [Char
searchPathSeparator]
[ forall loc. Path loc Dir -> [Char]
toFilePathNoTrailingSep Path Abs Dir
localdb
, forall loc. Path loc Dir -> [Char]
toFilePathNoTrailingSep Path Abs Dir
deps
, [Char]
""
]
else forall a. [a] -> [[a]] -> [a]
intercalate [Char
searchPathSeparator]
[ forall loc. Path loc Dir -> [Char]
toFilePathNoTrailingSep Path Abs Dir
deps
, [Char]
""
])
forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"HASKELL_DIST_DIR" ([Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall loc. Path loc Dir -> [Char]
toFilePathNoTrailingSep Path Abs Dir
distDir)
forall a b. (a -> b) -> a -> b
$ (case CompilerPaths -> ActualCompiler
cpCompilerVersion CompilerPaths
compilerPaths of
ACGhc Version
version | Version
version forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
8, Int
4, Int
4] ->
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"GHC_ENVIRONMENT" Text
"-"
ActualCompiler
_ -> forall a. a -> a
id)
Map Text Text
env
() <- forall (m :: * -> *) a b.
MonadIO m =>
IORef a -> (a -> (a, b)) -> m b
atomicModifyIORef IORef (Map EnvSettings ProcessContext)
envRef forall a b. (a -> b) -> a -> b
$ \Map EnvSettings ProcessContext
m' ->
(forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert EnvSettings
es ProcessContext
eo Map EnvSettings ProcessContext
m', ())
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessContext
eo
ProcessContext
envOverride <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ EnvSettings -> IO ProcessContext
getProcessContext' EnvSettings
minimalEnvSettings
forall (m :: * -> *) a. Monad m => a -> m a
return EnvConfig
{ envConfigBuildConfig :: BuildConfig
envConfigBuildConfig = BuildConfig
bc
{ bcConfig :: Config
bcConfig = ExtraDirs -> Config -> Config
addIncludeLib ExtraDirs
ghcBin
forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set forall env. HasProcessContext env => Lens' env ProcessContext
processContextL ProcessContext
envOverride
(forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env Config
configL BuildConfig
bc)
{ configProcessContextSettings :: EnvSettings -> IO ProcessContext
configProcessContextSettings = EnvSettings -> IO ProcessContext
getProcessContext'
}
}
, envConfigBuildOptsCLI :: BuildOptsCLI
envConfigBuildOptsCLI = BuildOptsCLI
boptsCLI
, envConfigSourceMap :: SourceMap
envConfigSourceMap = SourceMap
sourceMap
, envConfigSourceMapHash :: SourceMapHash
envConfigSourceMapHash = SourceMapHash
sourceMapHash
, envConfigCompilerPaths :: CompilerPaths
envConfigCompilerPaths = CompilerPaths
compilerPaths
}
data WithGHC env = WithGHC !CompilerPaths !env
insideL :: Lens' (WithGHC env) env
insideL :: forall env. Lens' (WithGHC env) env
insideL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(WithGHC CompilerPaths
_ env
x) -> env
x) (\(WithGHC CompilerPaths
cp env
_) -> forall env. CompilerPaths -> env -> WithGHC env
WithGHC CompilerPaths
cp)
instance HasLogFunc env => HasLogFunc (WithGHC env) where
logFuncL :: Lens' (WithGHC env) LogFunc
logFuncL = forall env. Lens' (WithGHC env) env
insideLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasLogFunc env => Lens' env LogFunc
logFuncL
instance HasRunner env => HasRunner (WithGHC env) where
runnerL :: Lens' (WithGHC env) Runner
runnerL = forall env. Lens' (WithGHC env) env
insideLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasRunner env => Lens' env Runner
runnerL
instance HasProcessContext env => HasProcessContext (WithGHC env) where
processContextL :: Lens' (WithGHC env) ProcessContext
processContextL = forall env. Lens' (WithGHC env) env
insideLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasProcessContext env => Lens' env ProcessContext
processContextL
instance HasStylesUpdate env => HasStylesUpdate (WithGHC env) where
stylesUpdateL :: Lens' (WithGHC env) StylesUpdate
stylesUpdateL = forall env. Lens' (WithGHC env) env
insideLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasStylesUpdate env => Lens' env StylesUpdate
stylesUpdateL
instance HasTerm env => HasTerm (WithGHC env) where
useColorL :: Lens' (WithGHC env) Bool
useColorL = forall env. Lens' (WithGHC env) env
insideLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasTerm env => Lens' env Bool
useColorL
termWidthL :: Lens' (WithGHC env) Int
termWidthL = forall env. Lens' (WithGHC env) env
insideLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasTerm env => Lens' env Int
termWidthL
instance HasPantryConfig env => HasPantryConfig (WithGHC env) where
pantryConfigL :: Lens' (WithGHC env) PantryConfig
pantryConfigL = forall env. Lens' (WithGHC env) env
insideLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasPantryConfig env => Lens' env PantryConfig
pantryConfigL
instance HasConfig env => HasPlatform (WithGHC env)
instance HasConfig env => HasGHCVariant (WithGHC env)
instance HasConfig env => HasConfig (WithGHC env) where
configL :: Lens' (WithGHC env) Config
configL = forall env. Lens' (WithGHC env) env
insideLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasConfig env => Lens' env Config
configL
instance HasBuildConfig env => HasBuildConfig (WithGHC env) where
buildConfigL :: Lens' (WithGHC env) BuildConfig
buildConfigL = forall env. Lens' (WithGHC env) env
insideLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasBuildConfig env => Lens' env BuildConfig
buildConfigL
instance HasCompiler (WithGHC env) where
compilerPathsL :: SimpleGetter (WithGHC env) CompilerPaths
compilerPathsL = forall s a. (s -> a) -> SimpleGetter s a
to (\(WithGHC CompilerPaths
cp env
_) -> CompilerPaths
cp)
runWithGHC :: HasConfig env => ProcessContext -> CompilerPaths -> RIO (WithGHC env) a -> RIO env a
runWithGHC :: forall env a.
HasConfig env =>
ProcessContext -> CompilerPaths -> RIO (WithGHC env) a -> RIO env a
runWithGHC ProcessContext
pc CompilerPaths
cp RIO (WithGHC env) a
inner = do
env
env <- forall r (m :: * -> *). MonadReader r m => m r
ask
let envg :: WithGHC env
envg
= forall env. CompilerPaths -> env -> WithGHC env
WithGHC CompilerPaths
cp forall a b. (a -> b) -> a -> b
$
forall s t a b. ASetter s t a b -> b -> s -> t
set forall env.
HasConfig env =>
Lens' env (EnvSettings -> IO ProcessContext)
envOverrideSettingsL (\EnvSettings
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ProcessContext
pc) forall a b. (a -> b) -> a -> b
$
forall s t a b. ASetter s t a b -> b -> s -> t
set forall env. HasProcessContext env => Lens' env ProcessContext
processContextL ProcessContext
pc env
env
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO WithGHC env
envg RIO (WithGHC env) a
inner
rebuildEnv :: EnvConfig
-> NeedTargets
-> Bool
-> BuildOptsCLI
-> RIO env EnvConfig
rebuildEnv :: forall env.
EnvConfig
-> NeedTargets -> Bool -> BuildOptsCLI -> RIO env EnvConfig
rebuildEnv EnvConfig
envConfig NeedTargets
needTargets Bool
haddockDeps BuildOptsCLI
boptsCLI = do
let bc :: BuildConfig
bc = EnvConfig -> BuildConfig
envConfigBuildConfig EnvConfig
envConfig
cp :: CompilerPaths
cp = EnvConfig -> CompilerPaths
envConfigCompilerPaths EnvConfig
envConfig
compilerVer :: ActualCompiler
compilerVer = SourceMap -> ActualCompiler
smCompiler forall a b. (a -> b) -> a -> b
$ EnvConfig -> SourceMap
envConfigSourceMap EnvConfig
envConfig
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO (forall env. CompilerPaths -> env -> WithGHC env
WithGHC CompilerPaths
cp BuildConfig
bc) forall a b. (a -> b) -> a -> b
$ do
SMActual DumpedGlobalPackage
smActual <- forall env.
(HasConfig env, HasCompiler env) =>
SMWanted
-> ActualCompiler -> RIO env (SMActual DumpedGlobalPackage)
actualFromGhc (BuildConfig -> SMWanted
bcSMWanted BuildConfig
bc) ActualCompiler
compilerVer
let actualPkgs :: Set PackageName
actualPkgs = forall k a. Map k a -> Set k
Map.keysSet (forall global. SMActual global -> Map PackageName DepPackage
smaDeps SMActual DumpedGlobalPackage
smActual) forall a. Semigroup a => a -> a -> a
<> forall k a. Map k a -> Set k
Map.keysSet (forall global. SMActual global -> Map PackageName ProjectPackage
smaProject SMActual DumpedGlobalPackage
smActual)
prunedActual :: SMActual GlobalPackage
prunedActual = SMActual DumpedGlobalPackage
smActual {
smaGlobal :: Map PackageName GlobalPackage
smaGlobal = Map PackageName DumpedGlobalPackage
-> Set PackageName -> Map PackageName GlobalPackage
pruneGlobals (forall global. SMActual global -> Map PackageName global
smaGlobal SMActual DumpedGlobalPackage
smActual) Set PackageName
actualPkgs
}
SMTargets
targets <- forall env.
HasBuildConfig env =>
NeedTargets
-> Bool
-> BuildOptsCLI
-> SMActual GlobalPackage
-> RIO env SMTargets
parseTargets NeedTargets
needTargets Bool
haddockDeps BuildOptsCLI
boptsCLI SMActual GlobalPackage
prunedActual
SourceMap
sourceMap <- forall env.
HasBuildConfig env =>
SMTargets
-> BuildOptsCLI
-> SMActual DumpedGlobalPackage
-> RIO env SourceMap
loadSourceMap SMTargets
targets BuildOptsCLI
boptsCLI SMActual DumpedGlobalPackage
smActual
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
EnvConfig
envConfig
{envConfigSourceMap :: SourceMap
envConfigSourceMap = SourceMap
sourceMap, envConfigBuildOptsCLI :: BuildOptsCLI
envConfigBuildOptsCLI = BuildOptsCLI
boptsCLI}
withNewLocalBuildTargets :: HasEnvConfig env => [Text] -> RIO env a -> RIO env a
withNewLocalBuildTargets :: forall env a. HasEnvConfig env => [Text] -> RIO env a -> RIO env a
withNewLocalBuildTargets [Text]
targets RIO env a
f = do
EnvConfig
envConfig <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasEnvConfig env => Lens' env EnvConfig
envConfigL
Bool
haddockDeps <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasConfig env => Lens' env Config
configLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Config -> BuildOpts
configBuildforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to BuildOpts -> Bool
shouldHaddockDeps
let boptsCLI :: BuildOptsCLI
boptsCLI = EnvConfig -> BuildOptsCLI
envConfigBuildOptsCLI EnvConfig
envConfig
EnvConfig
envConfig' <- forall env.
EnvConfig
-> NeedTargets -> Bool -> BuildOptsCLI -> RIO env EnvConfig
rebuildEnv EnvConfig
envConfig NeedTargets
NeedTargets Bool
haddockDeps forall a b. (a -> b) -> a -> b
$
BuildOptsCLI
boptsCLI {boptsCLITargets :: [Text]
boptsCLITargets = [Text]
targets}
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (forall s t a b. ASetter s t a b -> b -> s -> t
set forall env. HasEnvConfig env => Lens' env EnvConfig
envConfigL EnvConfig
envConfig') RIO env a
f
addIncludeLib :: ExtraDirs -> Config -> Config
addIncludeLib :: ExtraDirs -> Config -> Config
addIncludeLib (ExtraDirs [Path Abs Dir]
_bins [Path Abs Dir]
includes [Path Abs Dir]
libs) Config
config = Config
config
{ configExtraIncludeDirs :: [[Char]]
configExtraIncludeDirs =
Config -> [[Char]]
configExtraIncludeDirs Config
config forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map forall loc. Path loc Dir -> [Char]
toFilePathNoTrailingSep [Path Abs Dir]
includes
, configExtraLibDirs :: [[Char]]
configExtraLibDirs =
Config -> [[Char]]
configExtraLibDirs Config
config forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map forall loc. Path loc Dir -> [Char]
toFilePathNoTrailingSep [Path Abs Dir]
libs
}
ensureCompilerAndMsys
:: (HasBuildConfig env, HasGHCVariant env)
=> SetupOpts
-> RIO env (CompilerPaths, ExtraDirs)
ensureCompilerAndMsys :: forall env.
(HasBuildConfig env, HasGHCVariant env) =>
SetupOpts -> RIO env (CompilerPaths, ExtraDirs)
ensureCompilerAndMsys SetupOpts
sopts = do
Memoized SetupInfo
getSetupInfo' <- forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Memoized a)
memoizeRef forall env. HasConfig env => RIO env SetupInfo
getSetupInfo
Maybe Tool
mmsys2Tool <- forall env.
HasBuildConfig env =>
SetupOpts -> Memoized SetupInfo -> RIO env (Maybe Tool)
ensureMsys SetupOpts
sopts Memoized SetupInfo
getSetupInfo'
Maybe ExtraDirs
msysPaths <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall env. HasConfig env => Tool -> RIO env ExtraDirs
extraDirs) Maybe Tool
mmsys2Tool
ActualCompiler
actual <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ WantedCompiler -> Either CompilerException ActualCompiler
wantedToActual forall a b. (a -> b) -> a -> b
$ SetupOpts -> WantedCompiler
soptsWantedCompiler SetupOpts
sopts
Bool
didWarn <- forall env. HasLogFunc env => Version -> RIO env Bool
warnUnsupportedCompiler forall a b. (a -> b) -> a -> b
$ ActualCompiler -> Version
getGhcVersion ActualCompiler
actual
(CompilerPaths
cp, ExtraDirs
ghcPaths) <- forall env.
(HasConfig env, HasBuildConfig env, HasGHCVariant env) =>
SetupOpts
-> Memoized SetupInfo -> RIO env (CompilerPaths, ExtraDirs)
ensureCompiler SetupOpts
sopts Memoized SetupInfo
getSetupInfo'
forall env. HasLogFunc env => CompilerPaths -> Bool -> RIO env ()
warnUnsupportedCompilerCabal CompilerPaths
cp Bool
didWarn
let paths :: ExtraDirs
paths = forall b a. b -> (a -> b) -> Maybe a -> b
maybe ExtraDirs
ghcPaths (ExtraDirs
ghcPaths forall a. Semigroup a => a -> a -> a
<>) Maybe ExtraDirs
msysPaths
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompilerPaths
cp, ExtraDirs
paths)
warnUnsupportedCompiler :: HasLogFunc env => Version -> RIO env Bool
warnUnsupportedCompiler :: forall env. HasLogFunc env => Version -> RIO env Bool
warnUnsupportedCompiler Version
ghcVersion = do
if
| Version
ghcVersion forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
7, Int
8] -> do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$
Utf8Builder
"Stack will almost certainly fail with GHC below version 7.8, requested " forall a. Semigroup a => a -> a -> a
<>
forall a. IsString a => [Char] -> a
fromString (Version -> [Char]
versionString Version
ghcVersion)
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"Valiantly attempting to run anyway, but I know this is doomed"
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"For more information, see: https://github.com/commercialhaskell/stack/issues/648"
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
""
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
| Version
ghcVersion forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
9, Int
5] -> do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$
Utf8Builder
"Stack has not been tested with GHC versions above 9.4, and using " forall a. Semigroup a => a -> a -> a
<>
forall a. IsString a => [Char] -> a
fromString (Version -> [Char]
versionString Version
ghcVersion) forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
", this may fail"
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
| Bool
otherwise -> do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Asking for a supported GHC version"
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
warnUnsupportedCompilerCabal
:: HasLogFunc env
=> CompilerPaths
-> Bool
-> RIO env ()
warnUnsupportedCompilerCabal :: forall env. HasLogFunc env => CompilerPaths -> Bool -> RIO env ()
warnUnsupportedCompilerCabal CompilerPaths
cp Bool
didWarn = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
didWarn forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall env. HasLogFunc env => Version -> RIO env Bool
warnUnsupportedCompiler forall a b. (a -> b) -> a -> b
$ ActualCompiler -> Version
getGhcVersion forall a b. (a -> b) -> a -> b
$ CompilerPaths -> ActualCompiler
cpCompilerVersion CompilerPaths
cp
let cabalVersion :: Version
cabalVersion = CompilerPaths -> Version
cpCabalVersion CompilerPaths
cp
if
| Version
cabalVersion forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
1, Int
19, Int
2] -> do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Stack no longer supports Cabal versions below 1.19.2,"
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ Utf8Builder
"but version " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (Version -> [Char]
versionString Version
cabalVersion) forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" was found."
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"This invocation will most likely fail."
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"To fix this, either use an older version of Stack or a newer resolver"
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"Acceptable resolvers: lts-3.0/nightly-2015-05-05 or later"
| Version
cabalVersion forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
3, Int
9] ->
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$
Utf8Builder
"Stack has not been tested with Cabal versions above 3.8, but version " forall a. Semigroup a => a -> a -> a
<>
forall a. IsString a => [Char] -> a
fromString (Version -> [Char]
versionString Version
cabalVersion) forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
" was found, this may fail"
| Bool
otherwise -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ensureMsys
:: HasBuildConfig env
=> SetupOpts
-> Memoized SetupInfo
-> RIO env (Maybe Tool)
ensureMsys :: forall env.
HasBuildConfig env =>
SetupOpts -> Memoized SetupInfo -> RIO env (Maybe Tool)
ensureMsys SetupOpts
sopts Memoized SetupInfo
getSetupInfo' = do
Platform
platform <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasPlatform env => Lens' env Platform
platformL
Path Abs Dir
localPrograms <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasConfig env => Lens' env Config
configLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Config -> Path Abs Dir
configLocalPrograms
[Tool]
installed <- forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Path Abs Dir -> m [Tool]
listInstalled Path Abs Dir
localPrograms
case Platform
platform of
Platform Arch
_ OS
Cabal.Windows | Bool -> Bool
not (SetupOpts -> Bool
soptsSkipMsys SetupOpts
sopts) ->
case [Tool] -> PackageName -> (Version -> Bool) -> Maybe Tool
getInstalledTool [Tool]
installed ([Char] -> PackageName
mkPackageName [Char]
"msys2") (forall a b. a -> b -> a
const Bool
True) of
Just Tool
tool -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Tool
tool)
Maybe Tool
Nothing
| SetupOpts -> Bool
soptsInstallIfMissing SetupOpts
sopts -> do
SetupInfo
si <- forall (m :: * -> *) a. MonadIO m => Memoized a -> m a
runMemoized Memoized SetupInfo
getSetupInfo'
Text
osKey <- forall (m :: * -> *). MonadThrow m => Platform -> m Text
getOSKey Platform
platform
Config
config <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env Config
configL
VersionedDownloadInfo Version
version DownloadInfo
info <-
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
osKey forall a b. (a -> b) -> a -> b
$ SetupInfo -> Map Text VersionedDownloadInfo
siMsys2 SetupInfo
si of
Just VersionedDownloadInfo
x -> forall (m :: * -> *) a. Monad m => a -> m a
return VersionedDownloadInfo
x
Maybe VersionedDownloadInfo
Nothing -> forall (m :: * -> *) a. (MonadIO m, HasCallStack) => [Char] -> m a
throwString forall a b. (a -> b) -> a -> b
$ [Char]
"MSYS2 not found for " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
osKey
let tool :: Tool
tool = PackageIdentifier -> Tool
Tool (PackageName -> Version -> PackageIdentifier
PackageIdentifier ([Char] -> PackageName
mkPackageName [Char]
"msys2") Version
version)
forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall env.
(HasTerm env, HasBuildConfig env) =>
Path Abs Dir
-> DownloadInfo
-> Tool
-> (Path Abs File
-> ArchiveType -> Path Abs Dir -> Path Abs Dir -> RIO env ())
-> RIO env Tool
downloadAndInstallTool (Config -> Path Abs Dir
configLocalPrograms Config
config) DownloadInfo
info Tool
tool (forall env.
HasBuildConfig env =>
SetupInfo
-> Path Abs File
-> ArchiveType
-> Path Abs Dir
-> Path Abs Dir
-> RIO env ()
installMsys2Windows SetupInfo
si)
| Bool
otherwise -> do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"Continuing despite missing tool: msys2"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Platform
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
installGhcBindist
:: HasBuildConfig env
=> SetupOpts
-> Memoized SetupInfo
-> [Tool]
-> RIO env (Tool, CompilerBuild)
installGhcBindist :: forall env.
HasBuildConfig env =>
SetupOpts
-> Memoized SetupInfo -> [Tool] -> RIO env (Tool, CompilerBuild)
installGhcBindist SetupOpts
sopts Memoized SetupInfo
getSetupInfo' [Tool]
installed = do
Platform Arch
expectedArch OS
_ <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasPlatform env => Lens' env Platform
platformL
let wanted :: WantedCompiler
wanted = SetupOpts -> WantedCompiler
soptsWantedCompiler SetupOpts
sopts
isWanted :: ActualCompiler -> Bool
isWanted = VersionCheck -> WantedCompiler -> ActualCompiler -> Bool
isWantedCompiler (SetupOpts -> VersionCheck
soptsCompilerCheck SetupOpts
sopts) (SetupOpts -> WantedCompiler
soptsWantedCompiler SetupOpts
sopts)
Config
config <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env Config
configL
GHCVariant
ghcVariant <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasGHCVariant env => SimpleGetter env GHCVariant
ghcVariantL
WhichCompiler
wc <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActualCompiler -> WhichCompiler
whichCompiler) forall a b. (a -> b) -> a -> b
$ WantedCompiler -> Either CompilerException ActualCompiler
wantedToActual WantedCompiler
wanted
[(Maybe Tool, CompilerBuild)]
possibleCompilers <-
case WhichCompiler
wc of
WhichCompiler
Ghc -> do
[CompilerBuild]
ghcBuilds <- forall env. HasConfig env => RIO env [CompilerBuild]
getGhcBuilds
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [CompilerBuild]
ghcBuilds forall a b. (a -> b) -> a -> b
$ \CompilerBuild
ghcBuild -> do
PackageName
ghcPkgName <- forall (m :: * -> *). MonadThrow m => [Char] -> m PackageName
parsePackageNameThrowing ([Char]
"ghc" forall a. [a] -> [a] -> [a]
++ GHCVariant -> [Char]
ghcVariantSuffix GHCVariant
ghcVariant forall a. [a] -> [a] -> [a]
++ CompilerBuild -> [Char]
compilerBuildSuffix CompilerBuild
ghcBuild)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tool] -> PackageName -> (Version -> Bool) -> Maybe Tool
getInstalledTool [Tool]
installed PackageName
ghcPkgName (ActualCompiler -> Bool
isWanted forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> ActualCompiler
ACGhc), CompilerBuild
ghcBuild)
let existingCompilers :: [(Tool, CompilerBuild)]
existingCompilers = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(\(Maybe Tool
installedCompiler, CompilerBuild
compilerBuild) ->
case (Maybe Tool
installedCompiler, SetupOpts -> Bool
soptsForceReinstall SetupOpts
sopts) of
(Just Tool
tool, Bool
False) -> [(Tool
tool, CompilerBuild
compilerBuild)]
(Maybe Tool, Bool)
_ -> [])
[(Maybe Tool, CompilerBuild)]
possibleCompilers
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug forall a b. (a -> b) -> a -> b
$
Utf8Builder
"Found already installed GHC builds: " forall a. Semigroup a => a -> a -> a
<>
forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse Utf8Builder
", " (forall a b. (a -> b) -> [a] -> [b]
map (forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompilerBuild -> [Char]
compilerBuildName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Tool, CompilerBuild)]
existingCompilers))
case [(Tool, CompilerBuild)]
existingCompilers of
(Tool
tool, CompilerBuild
build_):[(Tool, CompilerBuild)]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (Tool
tool, CompilerBuild
build_)
[]
| SetupOpts -> Bool
soptsInstallIfMissing SetupOpts
sopts -> do
SetupInfo
si <- forall (m :: * -> *) a. MonadIO m => Memoized a -> m a
runMemoized Memoized SetupInfo
getSetupInfo'
forall env.
(HasGHCVariant env, HasBuildConfig env) =>
[CompilerBuild]
-> SetupInfo
-> WantedCompiler
-> VersionCheck
-> Maybe [Char]
-> RIO env (Tool, CompilerBuild)
downloadAndInstallPossibleCompilers
(forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Maybe Tool, CompilerBuild)]
possibleCompilers)
SetupInfo
si
(SetupOpts -> WantedCompiler
soptsWantedCompiler SetupOpts
sopts)
(SetupOpts -> VersionCheck
soptsCompilerCheck SetupOpts
sopts)
(SetupOpts -> Maybe [Char]
soptsGHCBindistURL SetupOpts
sopts)
| Bool
otherwise -> do
let suggestion :: Text
suggestion = forall a. a -> Maybe a -> a
fromMaybe
(forall a. Monoid a => [a] -> a
mconcat
[ Text
"To install the correct GHC into "
, [Char] -> Text
T.pack (forall b t. Path b t -> [Char]
toFilePath (Config -> Path Abs Dir
configLocalPrograms Config
config))
, Text
", try running \"stack setup\" or use the \"--install-ghc\" flag."
, Text
" To use your system GHC installation, run \"stack config set system-ghc --global true\", or use the \"--system-ghc\" flag."
])
(SetupOpts -> Maybe Text
soptsResolveMissingGHC SetupOpts
sopts)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Maybe (ActualCompiler, Arch)
-> (WantedCompiler, Arch)
-> GHCVariant
-> CompilerBuild
-> VersionCheck
-> Maybe (Path Abs File)
-> Text
-> StackBuildException
CompilerVersionMismatch
forall a. Maybe a
Nothing
(SetupOpts -> WantedCompiler
soptsWantedCompiler SetupOpts
sopts, Arch
expectedArch)
GHCVariant
ghcVariant
(case [(Maybe Tool, CompilerBuild)]
possibleCompilers of
[] -> CompilerBuild
CompilerBuildStandard
(Maybe Tool
_, CompilerBuild
compilerBuild):[(Maybe Tool, CompilerBuild)]
_ -> CompilerBuild
compilerBuild)
(SetupOpts -> VersionCheck
soptsCompilerCheck SetupOpts
sopts)
(SetupOpts -> Maybe (Path Abs File)
soptsStackYaml SetupOpts
sopts)
Text
suggestion
ensureCompiler
:: forall env. (HasConfig env, HasBuildConfig env, HasGHCVariant env)
=> SetupOpts
-> Memoized SetupInfo
-> RIO env (CompilerPaths, ExtraDirs)
ensureCompiler :: forall env.
(HasConfig env, HasBuildConfig env, HasGHCVariant env) =>
SetupOpts
-> Memoized SetupInfo -> RIO env (CompilerPaths, ExtraDirs)
ensureCompiler SetupOpts
sopts Memoized SetupInfo
getSetupInfo' = do
let wanted :: WantedCompiler
wanted = SetupOpts -> WantedCompiler
soptsWantedCompiler SetupOpts
sopts
WhichCompiler
wc <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActualCompiler -> WhichCompiler
whichCompiler) forall a b. (a -> b) -> a -> b
$ WantedCompiler -> Either CompilerException ActualCompiler
wantedToActual WantedCompiler
wanted
Path Abs File
hook <- forall env. HasConfig env => RIO env (Path Abs File)
ghcInstallHook
Bool
hookIsExecutable <- forall (m :: * -> *) a.
MonadUnliftIO m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) forall a b. (a -> b) -> a -> b
$ if Bool
osIsWindows
then forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
hook
else Permissions -> Bool
executable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) b t. MonadIO m => Path b t -> m Permissions
getPermissions Path Abs File
hook
Platform Arch
expectedArch OS
_ <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasPlatform env => Lens' env Platform
platformL
let canUseCompiler :: CompilerPaths -> RIO env CompilerPaths
canUseCompiler CompilerPaths
cp
| SetupOpts -> Bool
soptsSkipGhcCheck SetupOpts
sopts = forall (f :: * -> *) a. Applicative f => a -> f a
pure CompilerPaths
cp
| Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ ActualCompiler -> Bool
isWanted forall a b. (a -> b) -> a -> b
$ CompilerPaths -> ActualCompiler
cpCompilerVersion CompilerPaths
cp = forall (m :: * -> *) a. (MonadIO m, HasCallStack) => [Char] -> m a
throwString [Char]
"Not the compiler version we want"
| CompilerPaths -> Arch
cpArch CompilerPaths
cp forall a. Eq a => a -> a -> Bool
/= Arch
expectedArch = forall (m :: * -> *) a. (MonadIO m, HasCallStack) => [Char] -> m a
throwString [Char]
"Not the architecture we want"
| Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure CompilerPaths
cp
isWanted :: ActualCompiler -> Bool
isWanted = VersionCheck -> WantedCompiler -> ActualCompiler -> Bool
isWantedCompiler (SetupOpts -> VersionCheck
soptsCompilerCheck SetupOpts
sopts) (SetupOpts -> WantedCompiler
soptsWantedCompiler SetupOpts
sopts)
let checkCompiler :: Path Abs File -> RIO env (Maybe CompilerPaths)
checkCompiler :: Path Abs File -> RIO env (Maybe CompilerPaths)
checkCompiler Path Abs File
compiler = do
Either SomeException CompilerPaths
eres <- forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny forall a b. (a -> b) -> a -> b
$ forall env.
HasConfig env =>
WhichCompiler
-> CompilerBuild -> Bool -> Path Abs File -> RIO env CompilerPaths
pathsFromCompiler WhichCompiler
wc CompilerBuild
CompilerBuildStandard Bool
False Path Abs File
compiler forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CompilerPaths -> RIO env CompilerPaths
canUseCompiler
case Either SomeException CompilerPaths
eres of
Left SomeException
e -> do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Not using compiler at " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow (forall b t. Path b t -> [Char]
toFilePath Path Abs File
compiler) forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow SomeException
e
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Right CompilerPaths
cp -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just CompilerPaths
cp
Maybe CompilerPaths
mcp <-
if | SetupOpts -> Bool
soptsUseSystem SetupOpts
sopts -> do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Getting system compiler version"
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit forall a b. (a -> b) -> a -> b
$
forall env i.
(HasProcessContext env, HasLogFunc env) =>
WantedCompiler -> ConduitT i (Path Abs File) (RIO env) ()
sourceSystemCompilers WantedCompiler
wanted forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.|
forall (m :: * -> *) mono a.
(Monad m, MonoFoldable mono) =>
(a -> m mono) -> ConduitT a (Element mono) m ()
concatMapMC Path Abs File -> RIO env (Maybe CompilerPaths)
checkCompiler forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.|
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
| Bool
hookIsExecutable -> do
Maybe (Path Abs File)
hookGHC <- forall env.
HasBuildConfig env =>
SetupOpts -> Path Abs File -> RIO env (Maybe (Path Abs File))
runGHCInstallHook SetupOpts
sopts Path Abs File
hook
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) Path Abs File -> RIO env (Maybe CompilerPaths)
checkCompiler Maybe (Path Abs File)
hookGHC
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
case Maybe CompilerPaths
mcp of
Maybe CompilerPaths
Nothing -> forall env.
HasBuildConfig env =>
SetupOpts
-> Memoized SetupInfo -> RIO env (CompilerPaths, ExtraDirs)
ensureSandboxedCompiler SetupOpts
sopts Memoized SetupInfo
getSetupInfo'
Just CompilerPaths
cp -> do
let paths :: ExtraDirs
paths = ExtraDirs { edBins :: [Path Abs Dir]
edBins = [forall b t. Path b t -> Path b Dir
parent forall a b. (a -> b) -> a -> b
$ CompilerPaths -> Path Abs File
cpCompiler CompilerPaths
cp], edInclude :: [Path Abs Dir]
edInclude = [], edLib :: [Path Abs Dir]
edLib = [] }
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompilerPaths
cp, ExtraDirs
paths)
runGHCInstallHook
:: HasBuildConfig env
=> SetupOpts
-> Path Abs File
-> RIO env (Maybe (Path Abs File))
runGHCInstallHook :: forall env.
HasBuildConfig env =>
SetupOpts -> Path Abs File -> RIO env (Maybe (Path Abs File))
runGHCInstallHook SetupOpts
sopts Path Abs File
hook = do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Getting hook installed compiler version"
let wanted :: WantedCompiler
wanted = SetupOpts -> WantedCompiler
soptsWantedCompiler SetupOpts
sopts
ProcessContext
menv0 <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasProcessContext env => Lens' env ProcessContext
processContextL
ProcessContext
menv <- forall (m :: * -> *).
MonadIO m =>
Map Text Text -> m ProcessContext
mkProcessContext (forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (WantedCompiler -> Map Text Text
wantedCompilerToEnv WantedCompiler
wanted) forall a b. (a -> b) -> a -> b
$
Map Text Text -> Map Text Text
removeHaskellEnvVars (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env.
HasProcessContext env =>
SimpleGetter env (Map Text Text)
envVarsL ProcessContext
menv0))
(ExitCode
exit, ByteString
out) <- forall env a.
HasProcessContext env =>
ProcessContext -> RIO env a -> RIO env a
withProcessContext ProcessContext
menv forall a b. (a -> b) -> a -> b
$ forall env (m :: * -> *) a.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
MonadIO m, HasCallStack) =>
[Char] -> [[Char]] -> (ProcessConfig () () () -> m a) -> m a
proc [Char]
"sh" [forall b t. Path b t -> [Char]
toFilePath Path Abs File
hook] forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr
-> m (ExitCode, ByteString)
readProcessStdout
case ExitCode
exit of
ExitCode
ExitSuccess -> do
let ghcPath :: [Char]
ghcPath = ShowS
stripNewline forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
TL.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
TL.decodeUtf8With OnDecodeError
T.lenientDecode forall a b. (a -> b) -> a -> b
$ ByteString
out
case forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Abs File)
parseAbsFile [Char]
ghcPath of
Just Path Abs File
compiler -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SetupOpts -> Bool
soptsSanityCheck SetupOpts
sopts) forall a b. (a -> b) -> a -> b
$ forall env.
(HasProcessContext env, HasLogFunc env) =>
Path Abs File -> RIO env ()
sanityCheck Path Abs File
compiler
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder
"Using GHC compiler at: " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (forall b t. Path b t -> [Char]
toFilePath Path Abs File
compiler))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just Path Abs File
compiler)
Maybe (Path Abs File)
Nothing -> do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn (Utf8Builder
"Path to GHC binary is not a valid path: " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString [Char]
ghcPath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
ExitFailure Int
i -> do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn (Utf8Builder
"GHC install hook exited with code: " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (forall a. Show a => a -> [Char]
show Int
i))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
where
wantedCompilerToEnv :: WantedCompiler -> EnvVars
wantedCompilerToEnv :: WantedCompiler -> Map Text Text
wantedCompilerToEnv (WCGhc Version
ver) =
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text
"HOOK_GHC_TYPE", Text
"bindist")
,(Text
"HOOK_GHC_VERSION", [Char] -> Text
T.pack (Version -> [Char]
versionString Version
ver))
]
wantedCompilerToEnv (WCGhcGit Text
commit Text
flavor) =
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text
"HOOK_GHC_TYPE", Text
"git")
,(Text
"HOOK_GHC_COMMIT", Text
commit)
,(Text
"HOOK_GHC_FLAVOR", Text
flavor)
,(Text
"HOOK_GHC_FLAVOUR", Text
flavor)
]
wantedCompilerToEnv (WCGhcjs Version
ghcjs_ver Version
ghc_ver) =
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text
"HOOK_GHC_TYPE", Text
"ghcjs")
,(Text
"HOOK_GHC_VERSION", [Char] -> Text
T.pack (Version -> [Char]
versionString Version
ghc_ver))
,(Text
"HOOK_GHCJS_VERSION", [Char] -> Text
T.pack (Version -> [Char]
versionString Version
ghcjs_ver))
]
newlines :: [Char]
newlines :: [Char]
newlines = [Char
'\n', Char
'\r']
stripNewline :: String -> String
stripNewline :: ShowS
stripNewline [Char]
str = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem [Char]
newlines) [Char]
str
ensureSandboxedCompiler
:: HasBuildConfig env
=> SetupOpts
-> Memoized SetupInfo
-> RIO env (CompilerPaths, ExtraDirs)
ensureSandboxedCompiler :: forall env.
HasBuildConfig env =>
SetupOpts
-> Memoized SetupInfo -> RIO env (CompilerPaths, ExtraDirs)
ensureSandboxedCompiler SetupOpts
sopts Memoized SetupInfo
getSetupInfo' = do
let wanted :: WantedCompiler
wanted = SetupOpts -> WantedCompiler
soptsWantedCompiler SetupOpts
sopts
Config
config <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env Config
configL
let localPrograms :: Path Abs Dir
localPrograms = Config -> Path Abs Dir
configLocalPrograms Config
config
[Tool]
installed <- forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Path Abs Dir -> m [Tool]
listInstalled Path Abs Dir
localPrograms
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Installed tools: \n - " forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse Utf8Builder
"\n - " (forall a b. (a -> b) -> [a] -> [b]
map (forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tool -> [Char]
toolString) [Tool]
installed))
(Tool
compilerTool, CompilerBuild
compilerBuild) <-
case SetupOpts -> WantedCompiler
soptsWantedCompiler SetupOpts
sopts of
WCGhcGit Text
commitId Text
flavour -> forall env.
(HasTerm env, HasProcessContext env, HasBuildConfig env) =>
Memoized SetupInfo
-> [Tool]
-> CompilerRepository
-> Text
-> Text
-> RIO env (Tool, CompilerBuild)
buildGhcFromSource Memoized SetupInfo
getSetupInfo' [Tool]
installed (Config -> CompilerRepository
configCompilerRepository Config
config) Text
commitId Text
flavour
WantedCompiler
_ -> forall env.
HasBuildConfig env =>
SetupOpts
-> Memoized SetupInfo -> [Tool] -> RIO env (Tool, CompilerBuild)
installGhcBindist SetupOpts
sopts Memoized SetupInfo
getSetupInfo' [Tool]
installed
ExtraDirs
paths <- forall env. HasConfig env => Tool -> RIO env ExtraDirs
extraDirs Tool
compilerTool
WhichCompiler
wc <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActualCompiler -> WhichCompiler
whichCompiler) forall a b. (a -> b) -> a -> b
$ WantedCompiler -> Either CompilerException ActualCompiler
wantedToActual WantedCompiler
wanted
ProcessContext
menv0 <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasProcessContext env => Lens' env ProcessContext
processContextL
Map Text Text
m <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall (m :: * -> *) a. Monad m => a -> m a
return
forall a b. (a -> b) -> a -> b
$ [[Char]]
-> Map Text Text -> Either ProcessException (Map Text Text)
augmentPathMap (forall b t. Path b t -> [Char]
toFilePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExtraDirs -> [Path Abs Dir]
edBins ExtraDirs
paths) (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env.
HasProcessContext env =>
SimpleGetter env (Map Text Text)
envVarsL ProcessContext
menv0)
ProcessContext
menv <- forall (m :: * -> *).
MonadIO m =>
Map Text Text -> m ProcessContext
mkProcessContext (Map Text Text -> Map Text Text
removeHaskellEnvVars Map Text Text
m)
[[Char]]
names <-
case WantedCompiler
wanted of
WCGhc Version
version -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Char]
"ghc-" forall a. [a] -> [a] -> [a]
++ Version -> [Char]
versionString Version
version, [Char]
"ghc"]
WCGhcGit{} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Char]
"ghc"]
WCGhcjs{} -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO CompilerException
GhcjsNotSupported
let loop :: [[Char]] -> RIO env (Path Abs File)
loop [] = do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logError forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Looked for sandboxed compiler named one of: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow [[Char]]
names
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logError forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Could not find it on the paths " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow (ExtraDirs -> [Path Abs Dir]
edBins ExtraDirs
paths)
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => [Char] -> m a
throwString [Char]
"Could not find sandboxed compiler"
loop ([Char]
x:[[Char]]
xs) = do
[[Char]]
res <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char] -> IO [[Char]]
D.findExecutablesInDirectories (forall a b. (a -> b) -> [a] -> [b]
map forall b t. Path b t -> [Char]
toFilePath (ExtraDirs -> [Path Abs Dir]
edBins ExtraDirs
paths)) [Char]
x
case [[Char]]
res of
[] -> [[Char]] -> RIO env (Path Abs File)
loop [[Char]]
xs
[Char]
compiler:[[Char]]
rest -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
rest) forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"Found multiple candidate compilers:"
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [[Char]]
res forall a b. (a -> b) -> a -> b
$ \[Char]
y -> forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ Utf8Builder
"- " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString [Char]
y
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ Utf8Builder
"This usually indicates a failed installation. Trying anyway with " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString [Char]
compiler
forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Abs File)
parseAbsFile [Char]
compiler
Path Abs File
compiler <- forall env a.
HasProcessContext env =>
ProcessContext -> RIO env a -> RIO env a
withProcessContext ProcessContext
menv forall a b. (a -> b) -> a -> b
$ do
Path Abs File
compiler <- [[Char]] -> RIO env (Path Abs File)
loop [[Char]]
names
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SetupOpts -> Bool
soptsSanityCheck SetupOpts
sopts) forall a b. (a -> b) -> a -> b
$ forall env.
(HasProcessContext env, HasLogFunc env) =>
Path Abs File -> RIO env ()
sanityCheck Path Abs File
compiler
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs File
compiler
CompilerPaths
cp <- forall env.
HasConfig env =>
WhichCompiler
-> CompilerBuild -> Bool -> Path Abs File -> RIO env CompilerPaths
pathsFromCompiler WhichCompiler
wc CompilerBuild
compilerBuild Bool
True Path Abs File
compiler
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompilerPaths
cp, ExtraDirs
paths)
pathsFromCompiler
:: forall env. HasConfig env
=> WhichCompiler
-> CompilerBuild
-> Bool
-> Path Abs File
-> RIO env CompilerPaths
pathsFromCompiler :: forall env.
HasConfig env =>
WhichCompiler
-> CompilerBuild -> Bool -> Path Abs File -> RIO env CompilerPaths
pathsFromCompiler WhichCompiler
wc CompilerBuild
compilerBuild Bool
isSandboxed Path Abs File
compiler = RIO env CompilerPaths -> RIO env CompilerPaths
withCache forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadUnliftIO m =>
(SomeException -> m a) -> m a -> m a
handleAny SomeException -> RIO env CompilerPaths
onErr forall a b. (a -> b) -> a -> b
$ do
let dir :: [Char]
dir = forall b t. Path b t -> [Char]
toFilePath forall a b. (a -> b) -> a -> b
$ forall b t. Path b t -> Path b Dir
parent Path Abs File
compiler
suffixNoVersion :: [Char]
suffixNoVersion
| Bool
osIsWindows = [Char]
".exe"
| Bool
otherwise = [Char]
""
msuffixWithVersion :: Maybe [Char]
msuffixWithVersion = do
let prefix :: [Char]
prefix =
case WhichCompiler
wc of
WhichCompiler
Ghc -> [Char]
"ghc-"
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char]
"-" forall a. [a] -> [a] -> [a]
++) forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
prefix forall a b. (a -> b) -> a -> b
$ forall b t. Path b t -> [Char]
toFilePath forall a b. (a -> b) -> a -> b
$ forall b. Path b File -> Path Rel File
filename Path Abs File
compiler
suffixes :: [[Char]]
suffixes = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (:) Maybe [Char]
msuffixWithVersion [[Char]
suffixNoVersion]
findHelper :: (WhichCompiler -> [String]) -> RIO env (Path Abs File)
findHelper :: (WhichCompiler -> [[Char]]) -> RIO env (Path Abs File)
findHelper WhichCompiler -> [[Char]]
getNames = do
let toTry :: [[Char]]
toTry = [[Char]
dir forall a. [a] -> [a] -> [a]
++ [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
suffix | [Char]
suffix <- [[Char]]
suffixes, [Char]
name <- WhichCompiler -> [[Char]]
getNames WhichCompiler
wc]
loop :: [[Char]] -> RIO env (Path Abs File)
loop [] = forall (m :: * -> *) a. (MonadIO m, HasCallStack) => [Char] -> m a
throwString forall a b. (a -> b) -> a -> b
$ [Char]
"Could not find any of: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show [[Char]]
toTry
loop ([Char]
guessedPath':[[Char]]
rest) = do
Path Abs File
guessedPath <- forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Abs File)
parseAbsFile [Char]
guessedPath'
Bool
exists <- forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
guessedPath
if Bool
exists
then forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs File
guessedPath
else [[Char]] -> RIO env (Path Abs File)
loop [[Char]]
rest
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Looking for executable(s): " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow [[Char]]
toTry
[[Char]] -> RIO env (Path Abs File)
loop [[Char]]
toTry
GhcPkgExe
pkg <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Path Abs File -> GhcPkgExe
GhcPkgExe forall a b. (a -> b) -> a -> b
$ (WhichCompiler -> [[Char]]) -> RIO env (Path Abs File)
findHelper forall a b. (a -> b) -> a -> b
$ \case
WhichCompiler
Ghc -> [[Char]
"ghc-pkg"]
ProcessContext
menv0 <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasProcessContext env => Lens' env ProcessContext
processContextL
ProcessContext
menv <- forall (m :: * -> *).
MonadIO m =>
Map Text Text -> m ProcessContext
mkProcessContext (Map Text Text -> Map Text Text
removeHaskellEnvVars (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env.
HasProcessContext env =>
SimpleGetter env (Map Text Text)
envVarsL ProcessContext
menv0))
Path Abs File
interpreter <- (WhichCompiler -> [[Char]]) -> RIO env (Path Abs File)
findHelper forall a b. (a -> b) -> a -> b
$
\case
WhichCompiler
Ghc -> [[Char]
"runghc"]
Path Abs File
haddock <- (WhichCompiler -> [[Char]]) -> RIO env (Path Abs File)
findHelper forall a b. (a -> b) -> a -> b
$
\case
WhichCompiler
Ghc -> [[Char]
"haddock", [Char]
"haddock-ghc"]
ByteString
infobs <- forall env (m :: * -> *) a.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
MonadIO m, HasCallStack) =>
[Char] -> [[Char]] -> (ProcessConfig () () () -> m a) -> m a
proc (forall b t. Path b t -> [Char]
toFilePath Path Abs File
compiler) [[Char]
"--info"]
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> ByteString
toStrictBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ByteString, ByteString)
readProcess_
Text
infotext <-
case ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
infobs of
Left UnicodeException
e -> forall (m :: * -> *) a. (MonadIO m, HasCallStack) => [Char] -> m a
throwString forall a b. (a -> b) -> a -> b
$ [Char]
"GHC info is not valid UTF-8: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show UnicodeException
e
Right Text
info -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
info
[([Char], [Char])]
infoPairs :: [(String, String)] <-
case forall a. Read a => [Char] -> Maybe a
readMaybe forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
infotext of
Maybe [([Char], [Char])]
Nothing -> forall (m :: * -> *) a. (MonadIO m, HasCallStack) => [Char] -> m a
throwString [Char]
"GHC info does not parse as a list of pairs"
Just [([Char], [Char])]
infoPairs -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [([Char], [Char])]
infoPairs
let infoMap :: Map [Char] [Char]
infoMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [([Char], [Char])]
infoPairs
Either SomeException (Path Abs Dir)
eglobaldb <- forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny forall a b. (a -> b) -> a -> b
$
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
"Global Package DB" Map [Char] [Char]
infoMap of
Maybe [Char]
Nothing -> forall (m :: * -> *) a. (MonadIO m, HasCallStack) => [Char] -> m a
throwString [Char]
"Key 'Global Package DB' not found in GHC info"
Just [Char]
db -> forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Abs Dir)
parseAbsDir [Char]
db
Arch
arch <-
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
"Target platform" Map [Char] [Char]
infoMap of
Maybe [Char]
Nothing -> forall (m :: * -> *) a. (MonadIO m, HasCallStack) => [Char] -> m a
throwString [Char]
"Key 'Target platform' not found in GHC info"
Just [Char]
targetPlatform ->
case forall a. Parsec a => [Char] -> Maybe a
simpleParse forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'-') [Char]
targetPlatform of
Maybe Arch
Nothing -> forall (m :: * -> *) a. (MonadIO m, HasCallStack) => [Char] -> m a
throwString forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid target platform in GHC info: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
targetPlatform
Just Arch
arch -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Arch
arch
ActualCompiler
compilerVer <-
case WhichCompiler
wc of
WhichCompiler
Ghc ->
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
"Project version" Map [Char] [Char]
infoMap of
Maybe [Char]
Nothing -> do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"Key 'Project version' not found in GHC info"
forall env.
(HasProcessContext env, HasLogFunc env) =>
WhichCompiler -> Path Abs File -> RIO env ActualCompiler
getCompilerVersion WhichCompiler
wc Path Abs File
compiler
Just [Char]
versionString' -> Version -> ActualCompiler
ACGhc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadThrow m => [Char] -> m Version
parseVersionThrowing [Char]
versionString'
Path Abs Dir
globaldb <-
case Either SomeException (Path Abs Dir)
eglobaldb of
Left SomeException
e -> do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"Parsing global DB from GHC info failed"
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Utf8Builder
displayShow SomeException
e
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"Asking ghc-pkg directly"
forall env a.
HasProcessContext env =>
ProcessContext -> RIO env a -> RIO env a
withProcessContext ProcessContext
menv forall a b. (a -> b) -> a -> b
$ forall env.
(HasProcessContext env, HasLogFunc env) =>
GhcPkgExe -> RIO env (Path Abs Dir)
getGlobalDB GhcPkgExe
pkg
Right Path Abs Dir
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs Dir
x
Map PackageName DumpedGlobalPackage
globalDump <- forall env a.
HasProcessContext env =>
ProcessContext -> RIO env a -> RIO env a
withProcessContext ProcessContext
menv forall a b. (a -> b) -> a -> b
$ forall env.
(HasLogFunc env, HasProcessContext env) =>
GhcPkgExe -> RIO env (Map PackageName DumpedGlobalPackage)
globalsFromDump GhcPkgExe
pkg
Version
cabalPkgVer <-
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
cabalPackageName Map PackageName DumpedGlobalPackage
globalDump of
Maybe DumpedGlobalPackage
Nothing -> forall (m :: * -> *) a. (MonadIO m, HasCallStack) => [Char] -> m a
throwString forall a b. (a -> b) -> a -> b
$ [Char]
"Cabal library not found in global package database for " forall a. [a] -> [a] -> [a]
++ forall b t. Path b t -> [Char]
toFilePath Path Abs File
compiler
Just DumpedGlobalPackage
dp -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> Version
pkgVersion forall a b. (a -> b) -> a -> b
$ DumpedGlobalPackage -> PackageIdentifier
dpPackageIdent DumpedGlobalPackage
dp
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerPaths
{ cpBuild :: CompilerBuild
cpBuild = CompilerBuild
compilerBuild
, cpArch :: Arch
cpArch = Arch
arch
, cpSandboxed :: Bool
cpSandboxed = Bool
isSandboxed
, cpCompilerVersion :: ActualCompiler
cpCompilerVersion = ActualCompiler
compilerVer
, cpCompiler :: Path Abs File
cpCompiler = Path Abs File
compiler
, cpPkg :: GhcPkgExe
cpPkg = GhcPkgExe
pkg
, cpInterpreter :: Path Abs File
cpInterpreter = Path Abs File
interpreter
, cpHaddock :: Path Abs File
cpHaddock = Path Abs File
haddock
, cpCabalVersion :: Version
cpCabalVersion = Version
cabalPkgVer
, cpGlobalDB :: Path Abs Dir
cpGlobalDB = Path Abs Dir
globaldb
, cpGhcInfo :: ByteString
cpGhcInfo = ByteString
infobs
, cpGlobalDump :: Map PackageName DumpedGlobalPackage
cpGlobalDump = Map PackageName DumpedGlobalPackage
globalDump
}
where
onErr :: SomeException -> RIO env CompilerPaths
onErr = forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> SomeException -> SetupException
InvalidGhcAt Path Abs File
compiler
withCache :: RIO env CompilerPaths -> RIO env CompilerPaths
withCache RIO env CompilerPaths
inner = do
Either SomeException (Maybe CompilerPaths)
eres <- forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny forall a b. (a -> b) -> a -> b
$ forall env.
HasConfig env =>
Path Abs File
-> CompilerBuild -> Bool -> RIO env (Maybe CompilerPaths)
loadCompilerPaths Path Abs File
compiler CompilerBuild
compilerBuild Bool
isSandboxed
Maybe CompilerPaths
mres <-
case Either SomeException (Maybe CompilerPaths)
eres of
Left SomeException
e -> do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Trouble loading CompilerPaths cache: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow SomeException
e
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Right Maybe CompilerPaths
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CompilerPaths
x
case Maybe CompilerPaths
mres of
Just CompilerPaths
cp -> CompilerPaths
cp forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Loaded compiler information from cache"
Maybe CompilerPaths
Nothing -> do
CompilerPaths
cp <- RIO env CompilerPaths
inner
forall env. HasConfig env => CompilerPaths -> RIO env ()
saveCompilerPaths CompilerPaths
cp forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (SomeException -> m a) -> m a
`catchAny` \SomeException
e ->
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn (Utf8Builder
"Unable to save CompilerPaths cache: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow SomeException
e)
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompilerPaths
cp
buildGhcFromSource :: forall env.
( HasTerm env
, HasProcessContext env
, HasBuildConfig env
) => Memoized SetupInfo -> [Tool] -> CompilerRepository -> Text -> Text
-> RIO env (Tool, CompilerBuild)
buildGhcFromSource :: forall env.
(HasTerm env, HasProcessContext env, HasBuildConfig env) =>
Memoized SetupInfo
-> [Tool]
-> CompilerRepository
-> Text
-> Text
-> RIO env (Tool, CompilerBuild)
buildGhcFromSource Memoized SetupInfo
getSetupInfo' [Tool]
installed (CompilerRepository Text
url) Text
commitId Text
flavour = do
Config
config <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env Config
configL
let compilerTool :: Tool
compilerTool = Text -> Text -> Tool
ToolGhcGit Text
commitId Text
flavour
if Tool
compilerTool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Tool]
installed
then forall (m :: * -> *) a. Monad m => a -> m a
return (Tool
compilerTool,CompilerBuild
CompilerBuildStandard)
else do
forall env a.
(HasLogFunc env, HasProcessContext env) =>
SimpleRepo -> RIO env a -> RIO env a
Pantry.withRepo (Text -> Text -> RepoType -> SimpleRepo
Pantry.SimpleRepo Text
url Text
commitId RepoType
RepoGit) forall a b. (a -> b) -> a -> b
$ do
Maybe (Path Abs Dir)
mcwd <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Abs Dir)
parseAbsDir forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasProcessContext env => Lens' env (Maybe [Char])
workingDirL
let cwd :: Path Abs Dir
cwd = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid working directory") Maybe (Path Abs Dir)
mcwd
Int
threads <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasConfig env => Lens' env Config
configLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Config -> Int
configJobs
let
hadrianArgs :: [[Char]]
hadrianArgs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> [Char]
T.unpack
[ Text
"-c"
, Text
"-j" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
threads
, Text
"--flavour=" forall a. Semigroup a => a -> a -> a
<> Text
flavour
, Text
"binary-dist"
]
hadrianScripts :: [Path Rel File]
hadrianScripts
| Bool
osIsWindows = [Path Rel File]
hadrianScriptsWindows
| Bool
otherwise = [Path Rel File]
hadrianScriptsPosix
[Path Abs File]
foundHadrianPaths <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist forall a b. (a -> b) -> a -> b
$ (Path Abs Dir
cwd forall b t. Path b Dir -> Path Rel t -> Path b t
</>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Path Rel File]
hadrianScripts
Path Abs File
hadrianPath <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. (MonadIO m, HasCallStack) => [Char] -> m a
throwString [Char]
"No Hadrian build script found") forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
listToMaybe [Path Abs File]
foundHadrianPaths
forall (m :: * -> *) env.
(MonadIO m, HasCallStack, MonadReader env m, HasLogFunc env) =>
Utf8Builder -> m ()
logSticky forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Building GHC from source with `"
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
RIO.display Text
flavour
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"` flavour. It can take a long time (more than one hour)..."
forall env (m :: * -> *) a.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
MonadIO m, HasCallStack) =>
[Char] -> [[Char]] -> (ProcessConfig () () () -> m a) -> m a
proc (forall b t. Path b t -> [Char]
toFilePath Path Abs File
hadrianPath) [[Char]]
hadrianArgs forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ()
runProcess_
Path Rel Dir
bindistPath <- forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel Dir)
parseRelDir [Char]
"_build/bindist"
([Path Abs Dir]
_,[Path Abs File]
files) <- forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Abs Dir], [Path Abs File])
listDir (Path Abs Dir
cwd forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
bindistPath)
let
isBindist :: Path b File -> m Bool
isBindist Path b File
p = do
[Char]
extension <- forall (m :: * -> *) b. MonadThrow m => Path b File -> m [Char]
fileExtension (forall b. Path b File -> Path Rel File
filename Path b File
p)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char]
"ghc-" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` (forall b t. Path b t -> [Char]
toFilePath (forall b. Path b File -> Path Rel File
filename Path b File
p))
Bool -> Bool -> Bool
&& [Char]
extension forall a. Eq a => a -> a -> Bool
== [Char]
".xz"
[Path Abs File]
mbindist <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM forall {m :: * -> *} {b}. MonadThrow m => Path b File -> m Bool
isBindist [Path Abs File]
files
case [Path Abs File]
mbindist of
[Path Abs File
bindist] -> do
let bindist' :: Text
bindist' = [Char] -> Text
T.pack (forall b t. Path b t -> [Char]
toFilePath Path Abs File
bindist)
dlinfo :: DownloadInfo
dlinfo = DownloadInfo
{ downloadInfoUrl :: Text
downloadInfoUrl = Text
bindist'
, downloadInfoContentLength :: Maybe Int
downloadInfoContentLength = forall a. Maybe a
Nothing
, downloadInfoSha1 :: Maybe ByteString
downloadInfoSha1 = forall a. Maybe a
Nothing
, downloadInfoSha256 :: Maybe ByteString
downloadInfoSha256 = forall a. Maybe a
Nothing
}
ghcdlinfo :: GHCDownloadInfo
ghcdlinfo = [Text] -> Map Text Text -> DownloadInfo -> GHCDownloadInfo
GHCDownloadInfo forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty DownloadInfo
dlinfo
installer :: SetupInfo
-> Path Abs File
-> ArchiveType
-> Path Abs Dir
-> Path Abs Dir
-> RIO env ()
installer
| Bool
osIsWindows = forall env.
HasBuildConfig env =>
SetupInfo
-> Path Abs File
-> ArchiveType
-> Path Abs Dir
-> Path Abs Dir
-> RIO env ()
installGHCWindows
| Bool
otherwise = forall env.
HasConfig env =>
GHCDownloadInfo
-> SetupInfo
-> Path Abs File
-> ArchiveType
-> Path Abs Dir
-> Path Abs Dir
-> RIO env ()
installGHCPosix GHCDownloadInfo
ghcdlinfo
SetupInfo
si <- forall (m :: * -> *) a. MonadIO m => Memoized a -> m a
runMemoized Memoized SetupInfo
getSetupInfo'
Tool
_ <- forall env.
(HasTerm env, HasBuildConfig env) =>
Path Abs Dir
-> DownloadInfo
-> Tool
-> (Path Abs File
-> ArchiveType -> Path Abs Dir -> Path Abs Dir -> RIO env ())
-> RIO env Tool
downloadAndInstallTool
(Config -> Path Abs Dir
configLocalPrograms Config
config)
DownloadInfo
dlinfo
Tool
compilerTool
(SetupInfo
-> Path Abs File
-> ArchiveType
-> Path Abs Dir
-> Path Abs Dir
-> RIO env ()
installer SetupInfo
si)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tool
compilerTool, CompilerBuild
CompilerBuildStandard)
[Path Abs File]
_ -> do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Path Abs File]
files (forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
" - " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> [Char]
toFilePath)
forall a. HasCallStack => [Char] -> a
error [Char]
"Can't find hadrian generated bindist"
getGhcBuilds :: HasConfig env => RIO env [CompilerBuild]
getGhcBuilds :: forall env. HasConfig env => RIO env [CompilerBuild]
getGhcBuilds = do
Config
config <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env Config
configL
case Config -> Maybe CompilerBuild
configGHCBuild Config
config of
Just CompilerBuild
ghcBuild -> forall (m :: * -> *) a. Monad m => a -> m a
return [CompilerBuild
ghcBuild]
Maybe CompilerBuild
Nothing -> RIO env [CompilerBuild]
determineGhcBuild
where
determineGhcBuild :: RIO env [CompilerBuild]
determineGhcBuild = do
Platform
platform <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasPlatform env => Lens' env Platform
platformL
case Platform
platform of
Platform Arch
_ OS
Cabal.Linux -> do
let sbinEnv :: Map k a -> Map k a
sbinEnv Map k a
m = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
k
"PATH"
(a
"/sbin:/usr/sbin" forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
"" (a
":" forall a. Semigroup a => a -> a -> a
<>) (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
"PATH" Map k a
m))
Map k a
m
Either SomeException ByteString
eldconfigOut
<- forall env (m :: * -> *) a.
(HasProcessContext env, MonadReader env m, MonadIO m) =>
(Map Text Text -> Map Text Text) -> m a -> m a
withModifyEnvVars forall {k} {a}.
(Ord k, Semigroup a, IsString k, IsString a) =>
Map k a -> Map k a
sbinEnv
forall a b. (a -> b) -> a -> b
$ forall env (m :: * -> *) a.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
MonadIO m, HasCallStack) =>
[Char] -> [[Char]] -> (ProcessConfig () () () -> m a) -> m a
proc [Char]
"ldconfig" [[Char]
"-p"]
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ByteString, ByteString)
readProcess_
let firstWords :: [Text]
firstWords = case Either SomeException ByteString
eldconfigOut of
Right ByteString
ldconfigOut -> forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words) forall a b. (a -> b) -> a -> b
$
Text -> [Text]
T.lines forall a b. (a -> b) -> a -> b
$ OnDecodeError -> ByteString -> Text
T.decodeUtf8With OnDecodeError
T.lenientDecode
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.toStrict ByteString
ldconfigOut
Left SomeException
_ -> []
checkLib :: Path Rel File -> RIO env Bool
checkLib Path Rel File
lib
| Text
libT forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
firstWords = do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder
"Found shared library " forall a. Semigroup a => a -> a -> a
<> Utf8Builder
libD forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" in 'ldconfig -p' output")
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
| Bool
osIsWindows =
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
| Bool
otherwise = do
[Path Abs Dir]
matches <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist forall b c a. (b -> c) -> (a -> b) -> a -> c
.(forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
lib)) [Path Abs Dir]
usrLibDirs
case [Path Abs Dir]
matches of
[] -> forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder
"Did not find shared library " forall a. Semigroup a => a -> a -> a
<> Utf8Builder
libD)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
(Path Abs Dir
path:[Path Abs Dir]
_) -> forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder
"Found shared library " forall a. Semigroup a => a -> a -> a
<> Utf8Builder
libD
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" in " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (forall b t. Path b t -> [Char]
Path.toFilePath Path Abs Dir
path))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
where
libT :: Text
libT = [Char] -> Text
T.pack (forall b t. Path b t -> [Char]
toFilePath Path Rel File
lib)
libD :: Utf8Builder
libD = forall a. IsString a => [Char] -> a
fromString (forall b t. Path b t -> [Char]
toFilePath Path Rel File
lib)
Bool
hastinfo5 <- Path Rel File -> RIO env Bool
checkLib Path Rel File
relFileLibtinfoSo5
Bool
hastinfo6 <- Path Rel File -> RIO env Bool
checkLib Path Rel File
relFileLibtinfoSo6
Bool
hasncurses6 <- Path Rel File -> RIO env Bool
checkLib Path Rel File
relFileLibncurseswSo6
Bool
hasgmp5 <- Path Rel File -> RIO env Bool
checkLib Path Rel File
relFileLibgmpSo10
Bool
hasgmp4 <- Path Rel File -> RIO env Bool
checkLib Path Rel File
relFileLibgmpSo3
let libComponents :: [[[Char]]]
libComponents = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [[[Char]
"tinfo6"] | Bool
hastinfo6 Bool -> Bool -> Bool
&& Bool
hasgmp5]
, [[] | Bool
hastinfo5 Bool -> Bool -> Bool
&& Bool
hasgmp5]
, [[[Char]
"ncurses6"] | Bool
hasncurses6 Bool -> Bool -> Bool
&& Bool
hasgmp5 ]
, [[[Char]
"gmp4"] | Bool
hasgmp4 ]
]
forall {m :: * -> *} {env}.
(MonadIO m, MonadReader env m, HasLogFunc env) =>
[CompilerBuild] -> m [CompilerBuild]
useBuilds forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map
(\[[Char]]
c -> case [[Char]]
c of
[] -> CompilerBuild
CompilerBuildStandard
[[Char]]
_ -> [Char] -> CompilerBuild
CompilerBuildSpecialized (forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"-" [[Char]]
c))
[[[Char]]]
libComponents
Platform Arch
_ OS
Cabal.FreeBSD -> do
let getMajorVer :: [Char] -> Maybe Int
getMajorVer = forall a. Read a => [Char] -> Maybe a
readMaybe forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. [a] -> Maybe a
headMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [Char]
".")
Maybe Int
majorVer <- [Char] -> Maybe Int
getMajorVer forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall env. HasLogFunc env => RIO env [Char]
sysRelease
if Maybe Int
majorVer forall a. Ord a => a -> a -> Bool
>= forall a. a -> Maybe a
Just (Int
12 :: Int) then
forall {m :: * -> *} {env}.
(MonadIO m, MonadReader env m, HasLogFunc env) =>
[CompilerBuild] -> m [CompilerBuild]
useBuilds [[Char] -> CompilerBuild
CompilerBuildSpecialized [Char]
"ino64"]
else
forall {m :: * -> *} {env}.
(MonadIO m, MonadReader env m, HasLogFunc env) =>
[CompilerBuild] -> m [CompilerBuild]
useBuilds [CompilerBuild
CompilerBuildStandard]
Platform Arch
_ OS
Cabal.OpenBSD -> do
[Char]
releaseStr <- ShowS
mungeRelease forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall env. HasLogFunc env => RIO env [Char]
sysRelease
forall {m :: * -> *} {env}.
(MonadIO m, MonadReader env m, HasLogFunc env) =>
[CompilerBuild] -> m [CompilerBuild]
useBuilds [[Char] -> CompilerBuild
CompilerBuildSpecialized [Char]
releaseStr]
Platform
_ -> forall {m :: * -> *} {env}.
(MonadIO m, MonadReader env m, HasLogFunc env) =>
[CompilerBuild] -> m [CompilerBuild]
useBuilds [CompilerBuild
CompilerBuildStandard]
useBuilds :: [CompilerBuild] -> m [CompilerBuild]
useBuilds [CompilerBuild]
builds = do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug forall a b. (a -> b) -> a -> b
$
Utf8Builder
"Potential GHC builds: " forall a. Semigroup a => a -> a -> a
<>
forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse Utf8Builder
", " (forall a b. (a -> b) -> [a] -> [b]
map (forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompilerBuild -> [Char]
compilerBuildName) [CompilerBuild]
builds))
forall (m :: * -> *) a. Monad m => a -> m a
return [CompilerBuild]
builds
mungeRelease :: String -> String
mungeRelease :: ShowS
mungeRelease = forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"-" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
prefixMaj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [Char]
"."
where
prefixFst :: [a] -> ([[a]] -> [[a]]) -> [[a]] -> [[a]]
prefixFst [a]
pfx [[a]] -> [[a]]
k ([a]
rev : [[a]]
revs) = ([a]
pfx forall a. [a] -> [a] -> [a]
++ [a]
rev) forall a. a -> [a] -> [a]
: [[a]] -> [[a]]
k [[a]]
revs
prefixFst [a]
_ [[a]] -> [[a]]
_ [] = []
prefixMaj :: [[Char]] -> [[Char]]
prefixMaj = forall {a}. [a] -> ([[a]] -> [[a]]) -> [[a]] -> [[a]]
prefixFst [Char]
"maj" [[Char]] -> [[Char]]
prefixMin
prefixMin :: [[Char]] -> [[Char]]
prefixMin = forall {a}. [a] -> ([[a]] -> [[a]]) -> [[a]] -> [[a]]
prefixFst [Char]
"min" (forall a b. (a -> b) -> [a] -> [b]
map (Char
'r'forall a. a -> [a] -> [a]
:))
sysRelease :: HasLogFunc env => RIO env String
sysRelease :: forall env. HasLogFunc env => RIO env [Char]
sysRelease =
forall (m :: * -> *) a.
MonadUnliftIO m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
e -> do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Could not query OS version: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow IOException
e
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"")
(forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Char]
getRelease)
ensureDockerStackExe :: HasConfig env => Platform -> RIO env (Path Abs File)
ensureDockerStackExe :: forall env. HasConfig env => Platform -> RIO env (Path Abs File)
ensureDockerStackExe Platform
containerPlatform = do
Config
config <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env Config
configL
Path Rel Dir
containerPlatformDir <- forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT forall env (m :: * -> *).
(MonadReader env m, HasPlatform env, MonadThrow m) =>
m (Path Rel Dir)
platformOnlyRelDir (Platform
containerPlatform,PlatformVariant
PlatformVariantNone)
let programsPath :: Path Abs Dir
programsPath = Config -> Path Abs Dir
configLocalProgramsBase Config
config forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
containerPlatformDir
tool :: Tool
tool = PackageIdentifier -> Tool
Tool (PackageName -> Version -> PackageIdentifier
PackageIdentifier ([Char] -> PackageName
mkPackageName [Char]
"stack") Version
stackVersion)
Path Abs Dir
stackExeDir <- forall env (m :: * -> *).
(MonadReader env m, MonadThrow m) =>
Path Abs Dir -> Tool -> m (Path Abs Dir)
installDir Path Abs Dir
programsPath Tool
tool
let stackExePath :: Path Abs File
stackExePath = Path Abs Dir
stackExeDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFileStack
Bool
stackExeExists <- forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
stackExePath
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
stackExeExists forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo forall a b. (a -> b) -> a -> b
$
Utf8Builder
"Downloading Docker-compatible " forall a. Semigroup a => a -> a -> a
<>
forall a. IsString a => [Char] -> a
fromString [Char]
stackProgName forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
" executable"
StackReleaseInfo
sri <- forall env.
(HasPlatform env, HasLogFunc env) =>
Maybe [Char]
-> Maybe [Char] -> Maybe [Char] -> RIO env StackReleaseInfo
downloadStackReleaseInfo forall a. Maybe a
Nothing forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just (Version -> [Char]
versionString Version
stackMinorVersion))
[(Bool, [Char])]
platforms <- forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT forall env (m :: * -> *).
(MonadReader env m, HasPlatform env, MonadThrow m) =>
m [(Bool, [Char])]
preferredPlatforms (Platform
containerPlatform, PlatformVariant
PlatformVariantNone)
forall env.
HasConfig env =>
[(Bool, [Char])]
-> StackReleaseInfo
-> Path Abs Dir
-> Bool
-> (Path Abs File -> IO ())
-> RIO env ()
downloadStackExe [(Bool, [Char])]
platforms StackReleaseInfo
sri Path Abs Dir
stackExeDir Bool
False (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ())
forall (m :: * -> *) a. Monad m => a -> m a
return Path Abs File
stackExePath
sourceSystemCompilers
:: (HasProcessContext env, HasLogFunc env)
=> WantedCompiler
-> ConduitT i (Path Abs File) (RIO env) ()
sourceSystemCompilers :: forall env i.
(HasProcessContext env, HasLogFunc env) =>
WantedCompiler -> ConduitT i (Path Abs File) (RIO env) ()
sourceSystemCompilers WantedCompiler
wanted = do
[[Char]]
searchPath <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasProcessContext env => SimpleGetter env [[Char]]
exeSearchPathL
[[Char]]
names <-
case WantedCompiler
wanted of
WCGhc Version
version -> forall (f :: * -> *) a. Applicative f => a -> f a
pure
[ [Char]
"ghc-" forall a. [a] -> [a] -> [a]
++ Version -> [Char]
versionString Version
version
, [Char]
"ghc"
]
WCGhcjs{} -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO CompilerException
GhcjsNotSupported
WCGhcGit{} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [[Char]]
names forall a b. (a -> b) -> a -> b
$ \[Char]
name -> forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [[Char]]
searchPath forall a b. (a -> b) -> a -> b
$ \[Char]
dir -> do
Path Abs File
fp <- forall (m :: * -> *). MonadIO m => [Char] -> m (Path Abs File)
resolveFile' forall a b. (a -> b) -> a -> b
$ ShowS
addExe forall a b. (a -> b) -> a -> b
$ [Char]
dir [Char] -> ShowS
FP.</> [Char]
name
Bool
exists <- forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
fp
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Path Abs File
fp
where
addExe :: ShowS
addExe
| Bool
osIsWindows = (forall a. [a] -> [a] -> [a]
++ [Char]
".exe")
| Bool
otherwise = forall a. a -> a
id
getSetupInfo :: HasConfig env => RIO env SetupInfo
getSetupInfo :: forall env. HasConfig env => RIO env SetupInfo
getSetupInfo = do
Config
config <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env Config
configL
let inlineSetupInfo :: SetupInfo
inlineSetupInfo = Config -> SetupInfo
configSetupInfoInline Config
config
locations' :: [[Char]]
locations' = Config -> [[Char]]
configSetupInfoLocations Config
config
locations :: [[Char]]
locations = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
locations' then [[Char]
defaultSetupInfoYaml] else [[Char]]
locations'
[SetupInfo]
resolvedSetupInfos <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {m :: * -> *} {b} {env}.
(MonadIO m, MonadThrow m, FromJSON (WithJSONWarnings b),
MonadReader env m, HasLogFunc env) =>
[Char] -> m b
loadSetupInfo [[Char]]
locations
forall (m :: * -> *) a. Monad m => a -> m a
return (SetupInfo
inlineSetupInfo forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat [SetupInfo]
resolvedSetupInfos)
where
loadSetupInfo :: [Char] -> m b
loadSetupInfo [Char]
urlOrFile = do
ByteString
bs <-
case forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseUrlThrow [Char]
urlOrFile of
Just Request
req -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (ByteString -> ByteString
LBS.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Response a -> a
getResponseBody) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
httpLbs Request
req
Maybe Request
Nothing -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO ByteString
S.readFile [Char]
urlOrFile
WithJSONWarnings b
si [JSONWarning]
warnings <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. FromJSON a => ByteString -> Either ParseException a
Yaml.decodeEither' ByteString
bs)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
urlOrFile forall a. Eq a => a -> a -> Bool
/= [Char]
defaultSetupInfoYaml) forall a b. (a -> b) -> a -> b
$
forall env (m :: * -> *).
(MonadReader env m, HasLogFunc env, HasCallStack, MonadIO m) =>
[Char] -> [JSONWarning] -> m ()
logJSONWarnings [Char]
urlOrFile [JSONWarning]
warnings
forall (m :: * -> *) a. Monad m => a -> m a
return b
si
getInstalledTool :: [Tool]
-> PackageName
-> (Version -> Bool)
-> Maybe Tool
getInstalledTool :: [Tool] -> PackageName -> (Version -> Bool) -> Maybe Tool
getInstalledTool [Tool]
installed PackageName
name Version -> Bool
goodVersion = PackageIdentifier -> Tool
Tool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> Maybe a
maximumByMaybe (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing PackageIdentifier -> Version
pkgVersion) (PackageName -> (Version -> Bool) -> [Tool] -> [PackageIdentifier]
filterTools PackageName
name Version -> Bool
goodVersion [Tool]
installed)
downloadAndInstallTool :: (HasTerm env, HasBuildConfig env)
=> Path Abs Dir
-> DownloadInfo
-> Tool
-> (Path Abs File -> ArchiveType -> Path Abs Dir -> Path Abs Dir -> RIO env ())
-> RIO env Tool
downloadAndInstallTool :: forall env.
(HasTerm env, HasBuildConfig env) =>
Path Abs Dir
-> DownloadInfo
-> Tool
-> (Path Abs File
-> ArchiveType -> Path Abs Dir -> Path Abs Dir -> RIO env ())
-> RIO env Tool
downloadAndInstallTool Path Abs Dir
programsDir DownloadInfo
downloadInfo Tool
tool Path Abs File
-> ArchiveType -> Path Abs Dir -> Path Abs Dir -> RIO env ()
installer = do
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
ensureDir Path Abs Dir
programsDir
(Path Abs File
file, ArchiveType
at) <- forall env.
(HasTerm env, HasBuildConfig env) =>
Path Abs Dir
-> DownloadInfo -> Tool -> RIO env (Path Abs File, ArchiveType)
downloadFromInfo Path Abs Dir
programsDir DownloadInfo
downloadInfo Tool
tool
Path Abs Dir
dir <- forall env (m :: * -> *).
(MonadReader env m, MonadThrow m) =>
Path Abs Dir -> Tool -> m (Path Abs Dir)
installDir Path Abs Dir
programsDir Tool
tool
Path Abs Dir
tempDir <- forall env (m :: * -> *).
(MonadReader env m, MonadThrow m) =>
Path Abs Dir -> Tool -> m (Path Abs Dir)
tempInstallDir Path Abs Dir
programsDir Tool
tool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. (MonadIO m, MonadCatch m) => m a -> m ()
ignoringAbsence (forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
removeDirRecur Path Abs Dir
tempDir)
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
ensureDir Path Abs Dir
tempDir
forall (m :: * -> *). MonadIO m => Path Abs Dir -> Tool -> m ()
unmarkInstalled Path Abs Dir
programsDir Tool
tool
Path Abs File
-> ArchiveType -> Path Abs Dir -> Path Abs Dir -> RIO env ()
installer Path Abs File
file ArchiveType
at Path Abs Dir
tempDir Path Abs Dir
dir
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Path Abs Dir -> Tool -> m ()
markInstalled Path Abs Dir
programsDir Tool
tool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. (MonadIO m, MonadCatch m) => m a -> m ()
ignoringAbsence (forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
removeDirRecur Path Abs Dir
tempDir)
forall (m :: * -> *) a. Monad m => a -> m a
return Tool
tool
downloadAndInstallCompiler :: (HasBuildConfig env, HasGHCVariant env)
=> CompilerBuild
-> SetupInfo
-> WantedCompiler
-> VersionCheck
-> Maybe String
-> RIO env Tool
downloadAndInstallCompiler :: forall env.
(HasBuildConfig env, HasGHCVariant env) =>
CompilerBuild
-> SetupInfo
-> WantedCompiler
-> VersionCheck
-> Maybe [Char]
-> RIO env Tool
downloadAndInstallCompiler CompilerBuild
ghcBuild SetupInfo
si wanted :: WantedCompiler
wanted@(WCGhc Version
version) VersionCheck
versionCheck Maybe [Char]
mbindistURL = do
GHCVariant
ghcVariant <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasGHCVariant env => SimpleGetter env GHCVariant
ghcVariantL
(Version
selectedVersion, GHCDownloadInfo
downloadInfo) <- case Maybe [Char]
mbindistURL of
Just [Char]
bindistURL -> do
case GHCVariant
ghcVariant of
GHCCustom [Char]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
GHCVariant
_ -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SetupException
RequireCustomGHCVariant
forall (m :: * -> *) a. Monad m => a -> m a
return (Version
version, [Text] -> Map Text Text -> DownloadInfo -> GHCDownloadInfo
GHCDownloadInfo forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty DownloadInfo
{ downloadInfoUrl :: Text
downloadInfoUrl = [Char] -> Text
T.pack [Char]
bindistURL
, downloadInfoContentLength :: Maybe Int
downloadInfoContentLength = forall a. Maybe a
Nothing
, downloadInfoSha1 :: Maybe ByteString
downloadInfoSha1 = forall a. Maybe a
Nothing
, downloadInfoSha256 :: Maybe ByteString
downloadInfoSha256 = forall a. Maybe a
Nothing
})
Maybe [Char]
_ -> do
Text
ghcKey <- forall env (m :: * -> *).
(MonadReader env m, HasPlatform env, HasGHCVariant env,
MonadThrow m) =>
CompilerBuild -> m Text
getGhcKey CompilerBuild
ghcBuild
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
ghcKey forall a b. (a -> b) -> a -> b
$ SetupInfo -> Map Text (Map Version GHCDownloadInfo)
siGHCs SetupInfo
si of
Maybe (Map Version GHCDownloadInfo)
Nothing -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Text -> SetupException
UnknownOSKey Text
ghcKey
Just Map Version GHCDownloadInfo
pairs_ -> forall k (m :: * -> *) a.
(Ord k, MonadThrow m) =>
Text
-> VersionCheck
-> WantedCompiler
-> (k -> ActualCompiler)
-> Map k a
-> m (k, a)
getWantedCompilerInfo Text
ghcKey VersionCheck
versionCheck WantedCompiler
wanted Version -> ActualCompiler
ACGhc Map Version GHCDownloadInfo
pairs_
Config
config <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env Config
configL
let installer :: SetupInfo
-> Path Abs File
-> ArchiveType
-> Path Abs Dir
-> Path Abs Dir
-> RIO env ()
installer =
case Config -> Platform
configPlatform Config
config of
Platform Arch
_ OS
Cabal.Windows -> forall env.
HasBuildConfig env =>
SetupInfo
-> Path Abs File
-> ArchiveType
-> Path Abs Dir
-> Path Abs Dir
-> RIO env ()
installGHCWindows
Platform
_ -> forall env.
HasConfig env =>
GHCDownloadInfo
-> SetupInfo
-> Path Abs File
-> ArchiveType
-> Path Abs Dir
-> Path Abs Dir
-> RIO env ()
installGHCPosix GHCDownloadInfo
downloadInfo
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo forall a b. (a -> b) -> a -> b
$
Utf8Builder
"Preparing to install GHC" forall a. Semigroup a => a -> a -> a
<>
(case GHCVariant
ghcVariant of
GHCVariant
GHCStandard -> Utf8Builder
""
GHCVariant
v -> Utf8Builder
" (" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (GHCVariant -> [Char]
ghcVariantName GHCVariant
v) forall a. Semigroup a => a -> a -> a
<> Utf8Builder
")") forall a. Semigroup a => a -> a -> a
<>
(case CompilerBuild
ghcBuild of
CompilerBuild
CompilerBuildStandard -> Utf8Builder
""
CompilerBuild
b -> Utf8Builder
" (" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (CompilerBuild -> [Char]
compilerBuildName CompilerBuild
b) forall a. Semigroup a => a -> a -> a
<> Utf8Builder
")") forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
" to an isolated location."
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo Utf8Builder
"This will not interfere with any system-level installation."
PackageName
ghcPkgName <- forall (m :: * -> *). MonadThrow m => [Char] -> m PackageName
parsePackageNameThrowing ([Char]
"ghc" forall a. [a] -> [a] -> [a]
++ GHCVariant -> [Char]
ghcVariantSuffix GHCVariant
ghcVariant forall a. [a] -> [a] -> [a]
++ CompilerBuild -> [Char]
compilerBuildSuffix CompilerBuild
ghcBuild)
let tool :: Tool
tool = PackageIdentifier -> Tool
Tool forall a b. (a -> b) -> a -> b
$ PackageName -> Version -> PackageIdentifier
PackageIdentifier PackageName
ghcPkgName Version
selectedVersion
forall env.
(HasTerm env, HasBuildConfig env) =>
Path Abs Dir
-> DownloadInfo
-> Tool
-> (Path Abs File
-> ArchiveType -> Path Abs Dir -> Path Abs Dir -> RIO env ())
-> RIO env Tool
downloadAndInstallTool (Config -> Path Abs Dir
configLocalPrograms Config
config) (GHCDownloadInfo -> DownloadInfo
gdiDownloadInfo GHCDownloadInfo
downloadInfo) Tool
tool (SetupInfo
-> Path Abs File
-> ArchiveType
-> Path Abs Dir
-> Path Abs Dir
-> RIO env ()
installer SetupInfo
si)
downloadAndInstallCompiler CompilerBuild
_ SetupInfo
_ WCGhcjs{} VersionCheck
_ Maybe [Char]
_ = forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO CompilerException
GhcjsNotSupported
downloadAndInstallCompiler CompilerBuild
_ SetupInfo
_ WCGhcGit{} VersionCheck
_ Maybe [Char]
_ =
forall a. HasCallStack => [Char] -> a
error [Char]
"downloadAndInstallCompiler: shouldn't be reached with ghc-git"
getWantedCompilerInfo :: (Ord k, MonadThrow m)
=> Text
-> VersionCheck
-> WantedCompiler
-> (k -> ActualCompiler)
-> Map k a
-> m (k, a)
getWantedCompilerInfo :: forall k (m :: * -> *) a.
(Ord k, MonadThrow m) =>
Text
-> VersionCheck
-> WantedCompiler
-> (k -> ActualCompiler)
-> Map k a
-> m (k, a)
getWantedCompilerInfo Text
key VersionCheck
versionCheck WantedCompiler
wanted k -> ActualCompiler
toCV Map k a
pairs_ =
case Maybe (k, a)
mpair of
Just (k, a)
pair -> forall (m :: * -> *) a. Monad m => a -> m a
return (k, a)
pair
Maybe (k, a)
Nothing -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Set Text -> WantedCompiler -> Set ActualCompiler -> SetupException
UnknownCompilerVersion (forall a. a -> Set a
Set.singleton Text
key) WantedCompiler
wanted (forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map k -> ActualCompiler
toCV (forall k a. Map k a -> [k]
Map.keys Map k a
pairs_))
where
mpair :: Maybe (k, a)
mpair =
forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> a
fst)) forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
filter (VersionCheck -> WantedCompiler -> ActualCompiler -> Bool
isWantedCompiler VersionCheck
versionCheck WantedCompiler
wanted forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> ActualCompiler
toCV forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall k a. Map k a -> [(k, a)]
Map.toList Map k a
pairs_)
downloadAndInstallPossibleCompilers
:: (HasGHCVariant env, HasBuildConfig env)
=> [CompilerBuild]
-> SetupInfo
-> WantedCompiler
-> VersionCheck
-> Maybe String
-> RIO env (Tool, CompilerBuild)
downloadAndInstallPossibleCompilers :: forall env.
(HasGHCVariant env, HasBuildConfig env) =>
[CompilerBuild]
-> SetupInfo
-> WantedCompiler
-> VersionCheck
-> Maybe [Char]
-> RIO env (Tool, CompilerBuild)
downloadAndInstallPossibleCompilers [CompilerBuild]
possibleCompilers SetupInfo
si WantedCompiler
wanted VersionCheck
versionCheck Maybe [Char]
mbindistURL =
[CompilerBuild]
-> Maybe SetupException -> RIO env (Tool, CompilerBuild)
go [CompilerBuild]
possibleCompilers forall a. Maybe a
Nothing
where
go :: [CompilerBuild]
-> Maybe SetupException -> RIO env (Tool, CompilerBuild)
go [] Maybe SetupException
Nothing = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SetupException
UnsupportedSetupConfiguration
go [] (Just SetupException
e) = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SetupException
e
go (CompilerBuild
b:[CompilerBuild]
bs) Maybe SetupException
e = do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Trying to setup GHC build: " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (CompilerBuild -> [Char]
compilerBuildName CompilerBuild
b)
Either SetupException Tool
er <- forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try forall a b. (a -> b) -> a -> b
$ forall env.
(HasBuildConfig env, HasGHCVariant env) =>
CompilerBuild
-> SetupInfo
-> WantedCompiler
-> VersionCheck
-> Maybe [Char]
-> RIO env Tool
downloadAndInstallCompiler CompilerBuild
b SetupInfo
si WantedCompiler
wanted VersionCheck
versionCheck Maybe [Char]
mbindistURL
case Either SetupException Tool
er of
Left e' :: SetupException
e'@(UnknownCompilerVersion Set Text
ks' WantedCompiler
w' Set ActualCompiler
vs') ->
case Maybe SetupException
e of
Maybe SetupException
Nothing -> [CompilerBuild]
-> Maybe SetupException -> RIO env (Tool, CompilerBuild)
go [CompilerBuild]
bs (forall a. a -> Maybe a
Just SetupException
e')
Just (UnknownOSKey Text
k) ->
[CompilerBuild]
-> Maybe SetupException -> RIO env (Tool, CompilerBuild)
go [CompilerBuild]
bs forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Set Text -> WantedCompiler -> Set ActualCompiler -> SetupException
UnknownCompilerVersion (forall a. Ord a => a -> Set a -> Set a
Set.insert Text
k Set Text
ks') WantedCompiler
w' Set ActualCompiler
vs'
Just (UnknownCompilerVersion Set Text
ks WantedCompiler
_ Set ActualCompiler
vs) ->
[CompilerBuild]
-> Maybe SetupException -> RIO env (Tool, CompilerBuild)
go [CompilerBuild]
bs forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Set Text -> WantedCompiler -> Set ActualCompiler -> SetupException
UnknownCompilerVersion (forall a. Ord a => Set a -> Set a -> Set a
Set.union Set Text
ks' Set Text
ks) WantedCompiler
w' (forall a. Ord a => Set a -> Set a -> Set a
Set.union Set ActualCompiler
vs' Set ActualCompiler
vs)
Just SetupException
x -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SetupException
x
Left e' :: SetupException
e'@(UnknownOSKey Text
k') ->
case Maybe SetupException
e of
Maybe SetupException
Nothing -> [CompilerBuild]
-> Maybe SetupException -> RIO env (Tool, CompilerBuild)
go [CompilerBuild]
bs (forall a. a -> Maybe a
Just SetupException
e')
Just (UnknownOSKey Text
_) -> [CompilerBuild]
-> Maybe SetupException -> RIO env (Tool, CompilerBuild)
go [CompilerBuild]
bs Maybe SetupException
e
Just (UnknownCompilerVersion Set Text
ks WantedCompiler
w Set ActualCompiler
vs) ->
[CompilerBuild]
-> Maybe SetupException -> RIO env (Tool, CompilerBuild)
go [CompilerBuild]
bs forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Set Text -> WantedCompiler -> Set ActualCompiler -> SetupException
UnknownCompilerVersion (forall a. Ord a => a -> Set a -> Set a
Set.insert Text
k' Set Text
ks) WantedCompiler
w Set ActualCompiler
vs
Just SetupException
x -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SetupException
x
Left SetupException
e' -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SetupException
e'
Right Tool
r -> forall (m :: * -> *) a. Monad m => a -> m a
return (Tool
r, CompilerBuild
b)
getGhcKey :: (MonadReader env m, HasPlatform env, HasGHCVariant env, MonadThrow m)
=> CompilerBuild -> m Text
getGhcKey :: forall env (m :: * -> *).
(MonadReader env m, HasPlatform env, HasGHCVariant env,
MonadThrow m) =>
CompilerBuild -> m Text
getGhcKey CompilerBuild
ghcBuild = do
GHCVariant
ghcVariant <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasGHCVariant env => SimpleGetter env GHCVariant
ghcVariantL
Platform
platform <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasPlatform env => Lens' env Platform
platformL
Text
osKey <- forall (m :: * -> *). MonadThrow m => Platform -> m Text
getOSKey Platform
platform
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
osKey forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (GHCVariant -> [Char]
ghcVariantSuffix GHCVariant
ghcVariant) forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (CompilerBuild -> [Char]
compilerBuildSuffix CompilerBuild
ghcBuild)
getOSKey :: (MonadThrow m)
=> Platform -> m Text
getOSKey :: forall (m :: * -> *). MonadThrow m => Platform -> m Text
getOSKey Platform
platform =
case Platform
platform of
Platform Arch
I386 OS
Cabal.Linux -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
"linux32"
Platform Arch
X86_64 OS
Cabal.Linux -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
"linux64"
Platform Arch
I386 OS
Cabal.OSX -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
"macosx"
Platform Arch
X86_64 OS
Cabal.OSX -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
"macosx"
Platform Arch
I386 OS
Cabal.FreeBSD -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
"freebsd32"
Platform Arch
X86_64 OS
Cabal.FreeBSD -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
"freebsd64"
Platform Arch
I386 OS
Cabal.OpenBSD -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
"openbsd32"
Platform Arch
X86_64 OS
Cabal.OpenBSD -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
"openbsd64"
Platform Arch
I386 OS
Cabal.Windows -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
"windows32"
Platform Arch
X86_64 OS
Cabal.Windows -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
"windows64"
Platform Arch
Arm OS
Cabal.Linux -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
"linux-armv7"
Platform Arch
AArch64 OS
Cabal.Linux -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
"linux-aarch64"
Platform Arch
Sparc OS
Cabal.Linux -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
"linux-sparc"
Platform Arch
AArch64 OS
Cabal.OSX -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
"macosx-aarch64"
Platform Arch
AArch64 OS
Cabal.FreeBSD -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
"freebsd-aarch64"
Platform Arch
arch OS
os -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ OS -> Arch -> SetupException
UnsupportedSetupCombo OS
os Arch
arch
downloadOrUseLocal
:: (HasTerm env, HasBuildConfig env)
=> Text -> DownloadInfo -> Path Abs File -> RIO env (Path Abs File)
downloadOrUseLocal :: forall env.
(HasTerm env, HasBuildConfig env) =>
Text -> DownloadInfo -> Path Abs File -> RIO env (Path Abs File)
downloadOrUseLocal Text
downloadLabel DownloadInfo
downloadInfo Path Abs File
destination =
case [Char]
url of
(forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseUrlThrow -> Just Request
_) -> do
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
ensureDir (forall b t. Path b t -> Path b Dir
parent Path Abs File
destination)
forall env.
HasTerm env =>
Text -> DownloadInfo -> Path Abs File -> RIO env ()
chattyDownload Text
downloadLabel DownloadInfo
downloadInfo Path Abs File
destination
forall (m :: * -> *) a. Monad m => a -> m a
return Path Abs File
destination
(forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Abs File)
parseAbsFile -> Just Path Abs File
path) -> do
RIO env ()
warnOnIgnoredChecks
forall (m :: * -> *) a. Monad m => a -> m a
return Path Abs File
path
(forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel File)
parseRelFile -> Just Path Rel File
path) -> do
RIO env ()
warnOnIgnoredChecks
Path Abs Dir
root <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env r. HasBuildConfig env => Getting r env (Path Abs Dir)
projectRootL
forall (m :: * -> *) a. Monad m => a -> m a
return (Path Abs Dir
root forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
path)
[Char]
_ ->
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => [Char] -> m a
throwString forall a b. (a -> b) -> a -> b
$ [Char]
"Error: `url` must be either an HTTP URL or a file path: " forall a. [a] -> [a] -> [a]
++ [Char]
url
where
url :: [Char]
url = Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ DownloadInfo -> Text
downloadInfoUrl DownloadInfo
downloadInfo
warnOnIgnoredChecks :: RIO env ()
warnOnIgnoredChecks = do
let DownloadInfo{downloadInfoContentLength :: DownloadInfo -> Maybe Int
downloadInfoContentLength=Maybe Int
contentLength, downloadInfoSha1 :: DownloadInfo -> Maybe ByteString
downloadInfoSha1=Maybe ByteString
sha1,
downloadInfoSha256 :: DownloadInfo -> Maybe ByteString
downloadInfoSha256=Maybe ByteString
sha256} = DownloadInfo
downloadInfo
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe Int
contentLength) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"`content-length` is not checked and should not be specified when `url` is a file path"
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe ByteString
sha1) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"`sha1` is not checked and should not be specified when `url` is a file path"
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe ByteString
sha256) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"`sha256` is not checked and should not be specified when `url` is a file path"
downloadFromInfo
:: (HasTerm env, HasBuildConfig env)
=> Path Abs Dir -> DownloadInfo -> Tool -> RIO env (Path Abs File, ArchiveType)
downloadFromInfo :: forall env.
(HasTerm env, HasBuildConfig env) =>
Path Abs Dir
-> DownloadInfo -> Tool -> RIO env (Path Abs File, ArchiveType)
downloadFromInfo Path Abs Dir
programsDir DownloadInfo
downloadInfo Tool
tool = do
ArchiveType
archiveType <-
case [Char]
extension of
[Char]
".tar.xz" -> forall (m :: * -> *) a. Monad m => a -> m a
return ArchiveType
TarXz
[Char]
".tar.bz2" -> forall (m :: * -> *) a. Monad m => a -> m a
return ArchiveType
TarBz2
[Char]
".tar.gz" -> forall (m :: * -> *) a. Monad m => a -> m a
return ArchiveType
TarGz
[Char]
".7z.exe" -> forall (m :: * -> *) a. Monad m => a -> m a
return ArchiveType
SevenZ
[Char]
_ -> forall (m :: * -> *) a. (MonadIO m, HasCallStack) => [Char] -> m a
throwString forall a b. (a -> b) -> a -> b
$ [Char]
"Error: Unknown extension for url: " forall a. [a] -> [a] -> [a]
++ [Char]
url
Path Rel File
relativeFile <- forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel File)
parseRelFile forall a b. (a -> b) -> a -> b
$ Tool -> [Char]
toolString Tool
tool forall a. [a] -> [a] -> [a]
++ [Char]
extension
let destinationPath :: Path Abs File
destinationPath = Path Abs Dir
programsDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relativeFile
Path Abs File
localPath <- forall env.
(HasTerm env, HasBuildConfig env) =>
Text -> DownloadInfo -> Path Abs File -> RIO env (Path Abs File)
downloadOrUseLocal ([Char] -> Text
T.pack (Tool -> [Char]
toolString Tool
tool)) DownloadInfo
downloadInfo Path Abs File
destinationPath
forall (m :: * -> *) a. Monad m => a -> m a
return (Path Abs File
localPath, ArchiveType
archiveType)
where
url :: [Char]
url = Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ DownloadInfo -> Text
downloadInfoUrl DownloadInfo
downloadInfo
extension :: [Char]
extension = ShowS
loop [Char]
url
where
loop :: ShowS
loop [Char]
fp
| [Char]
ext forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
".tar", [Char]
".bz2", [Char]
".xz", [Char]
".exe", [Char]
".7z", [Char]
".gz"] = ShowS
loop [Char]
fp' forall a. [a] -> [a] -> [a]
++ [Char]
ext
| Bool
otherwise = [Char]
""
where
([Char]
fp', [Char]
ext) = [Char] -> ([Char], [Char])
FP.splitExtension [Char]
fp
data ArchiveType
= TarBz2
| TarXz
| TarGz
| SevenZ
installGHCPosix :: HasConfig env
=> GHCDownloadInfo
-> SetupInfo
-> Path Abs File
-> ArchiveType
-> Path Abs Dir
-> Path Abs Dir
-> RIO env ()
installGHCPosix :: forall env.
HasConfig env =>
GHCDownloadInfo
-> SetupInfo
-> Path Abs File
-> ArchiveType
-> Path Abs Dir
-> Path Abs Dir
-> RIO env ()
installGHCPosix GHCDownloadInfo
downloadInfo SetupInfo
_ Path Abs File
archiveFile ArchiveType
archiveType Path Abs Dir
tempDir Path Abs Dir
destDir = do
Platform
platform <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasPlatform env => Lens' env Platform
platformL
ProcessContext
menv0 <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasProcessContext env => Lens' env ProcessContext
processContextL
ProcessContext
menv <- forall (m :: * -> *).
MonadIO m =>
Map Text Text -> m ProcessContext
mkProcessContext (Map Text Text -> Map Text Text
removeHaskellEnvVars (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env.
HasProcessContext env =>
SimpleGetter env (Map Text Text)
envVarsL ProcessContext
menv0))
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Utf8Builder
"menv = " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env.
HasProcessContext env =>
SimpleGetter env (Map Text Text)
envVarsL ProcessContext
menv)
([Char]
zipTool', Char
compOpt) <-
case ArchiveType
archiveType of
ArchiveType
TarXz -> forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
"xz", Char
'J')
ArchiveType
TarBz2 -> forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
"bzip2", Char
'j')
ArchiveType
TarGz -> forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
"gzip", Char
'z')
ArchiveType
SevenZ -> forall (m :: * -> *) a. (MonadIO m, HasCallStack) => [Char] -> m a
throwString [Char]
"Don't know how to deal with .7z files on non-Windows"
let tarDep :: CheckDependency env [Char]
tarDep =
case (Platform
platform, ArchiveType
archiveType) of
(Platform Arch
_ OS
Cabal.OpenBSD, ArchiveType
TarXz) -> forall env.
HasProcessContext env =>
[Char] -> CheckDependency env [Char]
checkDependency [Char]
"gtar"
(Platform, ArchiveType)
_ -> forall env.
HasProcessContext env =>
[Char] -> CheckDependency env [Char]
checkDependency [Char]
"tar"
([Char]
zipTool, [Char]
makeTool, [Char]
tarTool) <- forall env a. CheckDependency env a -> RIO env a
checkDependencies forall a b. (a -> b) -> a -> b
$ (,,)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall env.
HasProcessContext env =>
[Char] -> CheckDependency env [Char]
checkDependency [Char]
zipTool'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall env.
HasProcessContext env =>
[Char] -> CheckDependency env [Char]
checkDependency [Char]
"gmake" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall env.
HasProcessContext env =>
[Char] -> CheckDependency env [Char]
checkDependency [Char]
"make")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CheckDependency env [Char]
tarDep
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Utf8Builder
"ziptool: " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString [Char]
zipTool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Utf8Builder
"make: " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString [Char]
makeTool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Utf8Builder
"tar: " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString [Char]
tarTool
let runStep :: StyleDoc
-> Path Abs Dir
-> Map Text Text
-> [Char]
-> [[Char]]
-> RIO env ()
runStep StyleDoc
step Path Abs Dir
wd Map Text Text
env [Char]
cmd [[Char]]
args = do
ProcessContext
menv' <- forall (m :: * -> *).
MonadIO m =>
ProcessContext
-> (Map Text Text -> Map Text Text) -> m ProcessContext
modifyEnvVars ProcessContext
menv (forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Text Text
env)
let logLines :: (Utf8Builder -> m ()) -> ConduitT ByteString c m ()
logLines Utf8Builder -> m ()
lvl = forall (m :: * -> *).
Monad m =>
ConduitT ByteString ByteString m ()
CB.lines forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a o.
Monad m =>
(a -> m ()) -> ConduitT a o m ()
CL.mapM_ (Utf8Builder -> m ()
lvl forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Utf8Builder
displayBytesUtf8)
logStdout :: ConduitT ByteString c (RIO env) ()
logStdout = forall {m :: * -> *} {c}.
Monad m =>
(Utf8Builder -> m ()) -> ConduitT ByteString c m ()
logLines forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug
logStderr :: ConduitT ByteString c (RIO env) ()
logStderr = forall {m :: * -> *} {c}.
Monad m =>
(Utf8Builder -> m ()) -> ConduitT ByteString c m ()
logLines forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logError
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall env (m :: * -> *) a.
(HasProcessContext env, MonadReader env m, MonadIO m) =>
[Char] -> m a -> m a
withWorkingDir (forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
wd) forall a b. (a -> b) -> a -> b
$
forall env a.
HasProcessContext env =>
ProcessContext -> RIO env a -> RIO env a
withProcessContext ProcessContext
menv' forall a b. (a -> b) -> a -> b
$
forall e o env.
(HasProcessContext env, HasLogFunc env, HasCallStack) =>
[Char]
-> [[Char]]
-> ConduitM ByteString Void (RIO env) e
-> ConduitM ByteString Void (RIO env) o
-> RIO env (e, o)
sinkProcessStderrStdout [Char]
cmd [[Char]]
args forall {c}. ConduitT ByteString c (RIO env) ()
logStderr forall {c}. ConduitT ByteString c (RIO env) ()
logStdout
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (SomeException -> m a) -> m a
`catchAny` \SomeException
ex -> do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logError forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Utf8Builder
displayShow SomeException
ex
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
StyleDoc -> m ()
prettyError forall a b. (a -> b) -> a -> b
$ Int -> StyleDoc -> StyleDoc
hang Int
2 (
StyleDoc
"Error encountered while" StyleDoc -> StyleDoc -> StyleDoc
<+> StyleDoc
step StyleDoc -> StyleDoc -> StyleDoc
<+> StyleDoc
"GHC with"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line forall a. Semigroup a => a -> a -> a
<>
Style -> StyleDoc -> StyleDoc
style Style
Shell (forall a. IsString a => [Char] -> a
fromString ([[Char]] -> [Char]
unwords ([Char]
cmd forall a. a -> [a] -> [a]
: [[Char]]
args)))
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line forall a. Semigroup a => a -> a -> a
<>
StyleDoc
"run in " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> StyleDoc
pretty Path Abs Dir
wd
)
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line forall a. Semigroup a => a -> a -> a
<> StyleDoc
line forall a. Semigroup a => a -> a -> a
<>
StyleDoc
"The following directories may now contain files, but won't be used by stack:"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line forall a. Semigroup a => a -> a -> a
<>
StyleDoc
" -" StyleDoc -> StyleDoc -> StyleDoc
<+> forall a. Pretty a => a -> StyleDoc
pretty Path Abs Dir
tempDir
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line forall a. Semigroup a => a -> a -> a
<>
StyleDoc
" -" StyleDoc -> StyleDoc -> StyleDoc
<+> forall a. Pretty a => a -> StyleDoc
pretty Path Abs Dir
destDir
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line forall a. Semigroup a => a -> a -> a
<> StyleDoc
line forall a. Semigroup a => a -> a -> a
<>
StyleDoc
"For more information consider rerunning with --verbose flag"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall (m :: * -> *) a. MonadIO m => m a
exitFailure
forall (m :: * -> *) env.
(MonadIO m, HasCallStack, MonadReader env m, HasLogFunc env) =>
Utf8Builder -> m ()
logSticky forall a b. (a -> b) -> a -> b
$
Utf8Builder
"Unpacking GHC into " forall a. Semigroup a => a -> a -> a
<>
forall a. IsString a => [Char] -> a
fromString (forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
tempDir) forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
" ..."
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Unpacking " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (forall b t. Path b t -> [Char]
toFilePath Path Abs File
archiveFile)
StyleDoc
-> Path Abs Dir
-> Map Text Text
-> [Char]
-> [[Char]]
-> RIO env ()
runStep StyleDoc
"unpacking" Path Abs Dir
tempDir forall a. Monoid a => a
mempty [Char]
tarTool [Char
compOpt forall a. a -> [a] -> [a]
: [Char]
"xf", forall b t. Path b t -> [Char]
toFilePath Path Abs File
archiveFile]
Path Abs Dir
dir <- forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Path Abs File -> Path Abs Dir -> m (Path Abs Dir)
expectSingleUnpackedDir Path Abs File
archiveFile Path Abs Dir
tempDir
Maybe (Path Abs File)
mOverrideGccPath <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasConfig env => Lens' env Config
configLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Config -> Maybe (Path Abs File)
configOverrideGccPath
let mGccEnv :: Maybe (Map Text Text)
mGccEnv = let gccEnvFromPath :: Path b t -> Map k Text
gccEnvFromPath Path b t
p =
forall k a. k -> a -> Map k a
Map.singleton k
"CC" forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack (forall b t. Path b t -> [Char]
toFilePath Path b t
p)
in forall {k} {b} {t}. IsString k => Path b t -> Map k Text
gccEnvFromPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Path Abs File)
mOverrideGccPath
let ghcConfigureEnv :: Map Text Text
ghcConfigureEnv =
forall a. a -> Maybe a -> a
fromMaybe forall k a. Map k a
Map.empty Maybe (Map Text Text)
mGccEnv forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` GHCDownloadInfo -> Map Text Text
gdiConfigureEnv GHCDownloadInfo
downloadInfo
forall (m :: * -> *) env.
(MonadIO m, HasCallStack, MonadReader env m, HasLogFunc env) =>
Utf8Builder -> m ()
logSticky Utf8Builder
"Configuring GHC ..."
StyleDoc
-> Path Abs Dir
-> Map Text Text
-> [Char]
-> [[Char]]
-> RIO env ()
runStep StyleDoc
"configuring" Path Abs Dir
dir
Map Text Text
ghcConfigureEnv
(forall b t. Path b t -> [Char]
toFilePath forall a b. (a -> b) -> a -> b
$ Path Abs Dir
dir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFileConfigure)
(([Char]
"--prefix=" forall a. [a] -> [a] -> [a]
++ forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
destDir) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map Text -> [Char]
T.unpack (GHCDownloadInfo -> [Text]
gdiConfigureOpts GHCDownloadInfo
downloadInfo))
forall (m :: * -> *) env.
(MonadIO m, HasCallStack, MonadReader env m, HasLogFunc env) =>
Utf8Builder -> m ()
logSticky Utf8Builder
"Installing GHC ..."
StyleDoc
-> Path Abs Dir
-> Map Text Text
-> [Char]
-> [[Char]]
-> RIO env ()
runStep StyleDoc
"installing" Path Abs Dir
dir forall a. Monoid a => a
mempty [Char]
makeTool [[Char]
"install"]
forall (m :: * -> *) env.
(MonadIO m, HasCallStack, MonadReader env m, HasLogFunc env) =>
Utf8Builder -> m ()
logStickyDone forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Installed GHC."
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Utf8Builder
"GHC installed to " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
destDir)
checkDependencies :: CheckDependency env a -> RIO env a
checkDependencies :: forall env a. CheckDependency env a -> RIO env a
checkDependencies (CheckDependency RIO env (Either [[Char]] a)
f) = RIO env (Either [[Char]] a)
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> SetupException
MissingDependencies) forall (m :: * -> *) a. Monad m => a -> m a
return
checkDependency :: HasProcessContext env => String -> CheckDependency env String
checkDependency :: forall env.
HasProcessContext env =>
[Char] -> CheckDependency env [Char]
checkDependency [Char]
tool = forall env a. RIO env (Either [[Char]] a) -> CheckDependency env a
CheckDependency forall a b. (a -> b) -> a -> b
$ do
Bool
exists <- forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasProcessContext env) =>
[Char] -> m Bool
doesExecutableExist [Char]
tool
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
exists then forall a b. b -> Either a b
Right [Char]
tool else forall a b. a -> Either a b
Left [[Char]
tool]
newtype CheckDependency env a = CheckDependency (RIO env (Either [String] a))
deriving forall a b. a -> CheckDependency env b -> CheckDependency env a
forall a b.
(a -> b) -> CheckDependency env a -> CheckDependency env b
forall env a b. a -> CheckDependency env b -> CheckDependency env a
forall env a b.
(a -> b) -> CheckDependency env a -> CheckDependency env b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> CheckDependency env b -> CheckDependency env a
$c<$ :: forall env a b. a -> CheckDependency env b -> CheckDependency env a
fmap :: forall a b.
(a -> b) -> CheckDependency env a -> CheckDependency env b
$cfmap :: forall env a b.
(a -> b) -> CheckDependency env a -> CheckDependency env b
Functor
instance Applicative (CheckDependency env) where
pure :: forall a. a -> CheckDependency env a
pure a
x = forall env a. RIO env (Either [[Char]] a) -> CheckDependency env a
CheckDependency forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right a
x)
CheckDependency RIO env (Either [[Char]] (a -> b))
f <*> :: forall a b.
CheckDependency env (a -> b)
-> CheckDependency env a -> CheckDependency env b
<*> CheckDependency RIO env (Either [[Char]] a)
x = forall env a. RIO env (Either [[Char]] a) -> CheckDependency env a
CheckDependency forall a b. (a -> b) -> a -> b
$ do
Either [[Char]] (a -> b)
f' <- RIO env (Either [[Char]] (a -> b))
f
Either [[Char]] a
x' <- RIO env (Either [[Char]] a)
x
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
case (Either [[Char]] (a -> b)
f', Either [[Char]] a
x') of
(Left [[Char]]
e1, Left [[Char]]
e2) -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [[Char]]
e1 forall a. [a] -> [a] -> [a]
++ [[Char]]
e2
(Left [[Char]]
e, Right a
_) -> forall a b. a -> Either a b
Left [[Char]]
e
(Right a -> b
_, Left [[Char]]
e) -> forall a b. a -> Either a b
Left [[Char]]
e
(Right a -> b
f'', Right a
x'') -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ a -> b
f'' a
x''
instance Alternative (CheckDependency env) where
empty :: forall a. CheckDependency env a
empty = forall env a. RIO env (Either [[Char]] a) -> CheckDependency env a
CheckDependency forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left []
CheckDependency RIO env (Either [[Char]] a)
x <|> :: forall a.
CheckDependency env a
-> CheckDependency env a -> CheckDependency env a
<|> CheckDependency RIO env (Either [[Char]] a)
y = forall env a. RIO env (Either [[Char]] a) -> CheckDependency env a
CheckDependency forall a b. (a -> b) -> a -> b
$ do
Either [[Char]] a
res1 <- RIO env (Either [[Char]] a)
x
case Either [[Char]] a
res1 of
Left [[Char]]
_ -> RIO env (Either [[Char]] a)
y
Right a
x' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right a
x'
installGHCWindows :: HasBuildConfig env
=> SetupInfo
-> Path Abs File
-> ArchiveType
-> Path Abs Dir
-> Path Abs Dir
-> RIO env ()
installGHCWindows :: forall env.
HasBuildConfig env =>
SetupInfo
-> Path Abs File
-> ArchiveType
-> Path Abs Dir
-> Path Abs Dir
-> RIO env ()
installGHCWindows SetupInfo
si Path Abs File
archiveFile ArchiveType
archiveType Path Abs Dir
_tempDir Path Abs Dir
destDir = do
forall env.
HasBuildConfig env =>
[Char]
-> SetupInfo
-> Path Abs File
-> ArchiveType
-> Path Abs Dir
-> RIO env ()
withUnpackedTarball7z [Char]
"GHC" SetupInfo
si Path Abs File
archiveFile ArchiveType
archiveType Path Abs Dir
destDir
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ Utf8Builder
"GHC installed to " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
destDir)
installMsys2Windows :: HasBuildConfig env
=> SetupInfo
-> Path Abs File
-> ArchiveType
-> Path Abs Dir
-> Path Abs Dir
-> RIO env ()
installMsys2Windows :: forall env.
HasBuildConfig env =>
SetupInfo
-> Path Abs File
-> ArchiveType
-> Path Abs Dir
-> Path Abs Dir
-> RIO env ()
installMsys2Windows SetupInfo
si Path Abs File
archiveFile ArchiveType
archiveType Path Abs Dir
_tempDir Path Abs Dir
destDir = do
Bool
exists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
D.doesDirectoryExist forall a b. (a -> b) -> a -> b
$ forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
destDir
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([Char] -> IO ()
D.removeDirectoryRecursive forall a b. (a -> b) -> a -> b
$ forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
destDir) forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (IOException -> m a) -> m a
`catchIO` \IOException
e -> do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logError forall a b. (a -> b) -> a -> b
$
Utf8Builder
"Could not delete existing msys directory: " forall a. Semigroup a => a -> a -> a
<>
forall a. IsString a => [Char] -> a
fromString (forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
destDir)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM IOException
e
forall env.
HasBuildConfig env =>
[Char]
-> SetupInfo
-> Path Abs File
-> ArchiveType
-> Path Abs Dir
-> RIO env ()
withUnpackedTarball7z [Char]
"MSYS2" SetupInfo
si Path Abs File
archiveFile ArchiveType
archiveType Path Abs Dir
destDir
ProcessContext
menv0 <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasProcessContext env => Lens' env ProcessContext
processContextL
ProcessContext
newEnv0 <- forall (m :: * -> *).
MonadIO m =>
ProcessContext
-> (Map Text Text -> Map Text Text) -> m ProcessContext
modifyEnvVars ProcessContext
menv0 forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"MSYSTEM" Text
"MSYS"
Map Text Text
newEnv <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [[Char]]
-> Map Text Text -> Either ProcessException (Map Text Text)
augmentPathMap
[forall b t. Path b t -> [Char]
toFilePath forall a b. (a -> b) -> a -> b
$ Path Abs Dir
destDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirUsr forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirBin]
(forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env.
HasProcessContext env =>
SimpleGetter env (Map Text Text)
envVarsL ProcessContext
newEnv0)
ProcessContext
menv <- forall (m :: * -> *).
MonadIO m =>
Map Text Text -> m ProcessContext
mkProcessContext Map Text Text
newEnv
forall env (m :: * -> *) a.
(HasProcessContext env, MonadReader env m, MonadIO m) =>
[Char] -> m a -> m a
withWorkingDir (forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
destDir) forall a b. (a -> b) -> a -> b
$ forall env a.
HasProcessContext env =>
ProcessContext -> RIO env a -> RIO env a
withProcessContext ProcessContext
menv
forall a b. (a -> b) -> a -> b
$ forall env (m :: * -> *) a.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
MonadIO m, HasCallStack) =>
[Char] -> [[Char]] -> (ProcessConfig () () () -> m a) -> m a
proc [Char]
"sh" [[Char]
"--login", [Char]
"-c", [Char]
"true"] forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ()
runProcess_
withUnpackedTarball7z :: HasBuildConfig env
=> String
-> SetupInfo
-> Path Abs File
-> ArchiveType
-> Path Abs Dir
-> RIO env ()
withUnpackedTarball7z :: forall env.
HasBuildConfig env =>
[Char]
-> SetupInfo
-> Path Abs File
-> ArchiveType
-> Path Abs Dir
-> RIO env ()
withUnpackedTarball7z [Char]
name SetupInfo
si Path Abs File
archiveFile ArchiveType
archiveType Path Abs Dir
destDir = do
Text
suffix <-
case ArchiveType
archiveType of
ArchiveType
TarXz -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
".xz"
ArchiveType
TarBz2 -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
".bz2"
ArchiveType
TarGz -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
".gz"
ArchiveType
_ -> forall (m :: * -> *) a. (MonadIO m, HasCallStack) => [Char] -> m a
throwString forall a b. (a -> b) -> a -> b
$ [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
" must be a tarball file"
Path Rel File
tarFile <-
case Text -> Text -> Maybe Text
T.stripSuffix Text
suffix forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall b t. Path b t -> [Char]
toFilePath (forall b. Path b File -> Path Rel File
filename Path Abs File
archiveFile) of
Maybe Text
Nothing -> forall (m :: * -> *) a. (MonadIO m, HasCallStack) => [Char] -> m a
throwString forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid " forall a. [a] -> [a] -> [a]
++ [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
" filename: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Path Abs File
archiveFile
Just Text
x -> forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel File)
parseRelFile forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
x
Path Abs Dir -> Path Abs File -> RIO env ()
run7z <- forall env (m :: * -> *).
(HasBuildConfig env, MonadIO m) =>
SetupInfo -> RIO env (Path Abs Dir -> Path Abs File -> m ())
setup7z SetupInfo
si
let tmpName :: [Char]
tmpName = forall loc. Path loc Dir -> [Char]
toFilePathNoTrailingSep (forall b. Path b Dir -> Path Rel Dir
dirname Path Abs Dir
destDir) forall a. [a] -> [a] -> [a]
++ [Char]
"-tmp"
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
ensureDir (forall b t. Path b t -> Path b Dir
parent Path Abs Dir
destDir)
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. RIO env a -> IO a
run -> forall (m :: * -> *) b a.
(MonadIO m, MonadMask m) =>
Path b Dir -> [Char] -> (Path Abs Dir -> m a) -> m a
withTempDir (forall b t. Path b t -> Path b Dir
parent Path Abs Dir
destDir) [Char]
tmpName forall a b. (a -> b) -> a -> b
$ \Path Abs Dir
tmpDir -> forall a. RIO env a -> IO a
run forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. (MonadIO m, MonadCatch m) => m a -> m ()
ignoringAbsence (forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
removeDirRecur Path Abs Dir
destDir)
Path Abs Dir -> Path Abs File -> RIO env ()
run7z Path Abs Dir
tmpDir Path Abs File
archiveFile
Path Abs Dir -> Path Abs File -> RIO env ()
run7z Path Abs Dir
tmpDir (Path Abs Dir
tmpDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
tarFile)
Path Abs Dir
absSrcDir <- forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Path Abs File -> Path Abs Dir -> m (Path Abs Dir)
expectSingleUnpackedDir Path Abs File
archiveFile Path Abs Dir
tmpDir
forall (m :: * -> *) b0 b1.
MonadIO m =>
Path b0 Dir -> Path b1 Dir -> m ()
renameDir Path Abs Dir
absSrcDir Path Abs Dir
destDir
expectSingleUnpackedDir :: (MonadIO m, MonadThrow m) => Path Abs File -> Path Abs Dir -> m (Path Abs Dir)
expectSingleUnpackedDir :: forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Path Abs File -> Path Abs Dir -> m (Path Abs Dir)
expectSingleUnpackedDir Path Abs File
archiveFile Path Abs Dir
destDir = do
([Path Abs Dir], [Path Abs File])
contents <- forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Abs Dir], [Path Abs File])
listDir Path Abs Dir
destDir
case ([Path Abs Dir], [Path Abs File])
contents of
([Path Abs Dir
dir], [Path Abs File]
_ ) -> forall (m :: * -> *) a. Monad m => a -> m a
return Path Abs Dir
dir
([Path Abs Dir], [Path Abs File])
_ -> forall (m :: * -> *) a. (MonadIO m, HasCallStack) => [Char] -> m a
throwString forall a b. (a -> b) -> a -> b
$ [Char]
"Expected a single directory within unpacked " forall a. [a] -> [a] -> [a]
++ forall b t. Path b t -> [Char]
toFilePath Path Abs File
archiveFile
setup7z :: (HasBuildConfig env, MonadIO m)
=> SetupInfo
-> RIO env (Path Abs Dir -> Path Abs File -> m ())
setup7z :: forall env (m :: * -> *).
(HasBuildConfig env, MonadIO m) =>
SetupInfo -> RIO env (Path Abs Dir -> Path Abs File -> m ())
setup7z SetupInfo
si = do
Path Abs Dir
dir <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasConfig env => Lens' env Config
configLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Config -> Path Abs Dir
configLocalPrograms
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
ensureDir Path Abs Dir
dir
let exeDestination :: Path Abs File
exeDestination = Path Abs Dir
dir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFile7zexe
dllDestination :: Path Abs File
dllDestination = Path Abs Dir
dir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFile7zdll
case (SetupInfo -> Maybe DownloadInfo
siSevenzDll SetupInfo
si, SetupInfo -> Maybe DownloadInfo
siSevenzExe SetupInfo
si) of
(Just DownloadInfo
sevenzDll, Just DownloadInfo
sevenzExe) -> do
Path Abs File
_ <- forall env.
(HasTerm env, HasBuildConfig env) =>
Text -> DownloadInfo -> Path Abs File -> RIO env (Path Abs File)
downloadOrUseLocal Text
"7z.dll" DownloadInfo
sevenzDll Path Abs File
dllDestination
Path Abs File
exePath <- forall env.
(HasTerm env, HasBuildConfig env) =>
Text -> DownloadInfo -> Path Abs File -> RIO env (Path Abs File)
downloadOrUseLocal Text
"7z.exe" DownloadInfo
sevenzExe Path Abs File
exeDestination
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. RIO env a -> IO a
run -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \Path Abs Dir
outdir Path Abs File
archive -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. RIO env a -> IO a
run forall a b. (a -> b) -> a -> b
$ do
let cmd :: [Char]
cmd = forall b t. Path b t -> [Char]
toFilePath Path Abs File
exePath
args :: [[Char]]
args =
[ [Char]
"x"
, [Char]
"-o" forall a. [a] -> [a] -> [a]
++ forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
outdir
, [Char]
"-y"
, forall b t. Path b t -> [Char]
toFilePath Path Abs File
archive
]
let archiveDisplay :: Utf8Builder
archiveDisplay = forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ ShowS
FP.takeFileName forall a b. (a -> b) -> a -> b
$ forall b t. Path b t -> [Char]
toFilePath Path Abs File
archive
isExtract :: Bool
isExtract = ShowS
FP.takeExtension (forall b t. Path b t -> [Char]
toFilePath Path Abs File
archive) forall a. Eq a => a -> a -> Bool
== [Char]
".tar"
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo forall a b. (a -> b) -> a -> b
$
(if Bool
isExtract then Utf8Builder
"Extracting " else Utf8Builder
"Decompressing ") forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
archiveDisplay forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"..."
ExitCode
ec <-
forall env (m :: * -> *) a.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
MonadIO m, HasCallStack) =>
[Char] -> [[Char]] -> (ProcessConfig () () () -> m a) -> m a
proc [Char]
cmd [[Char]]
args forall a b. (a -> b) -> a -> b
$ \ProcessConfig () () ()
pc ->
if Bool
isExtract
then forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcessWait (forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout forall (m :: * -> *) i.
MonadIO m =>
StreamSpec 'STOutput (ConduitM i ByteString m ())
createSource ProcessConfig () () ()
pc) forall a b. (a -> b) -> a -> b
$ \Process () (ConduitM () ByteString (RIO env) ()) ()
p -> do
Int
total <- forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit
forall a b. (a -> b) -> a -> b
$ forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout Process () (ConduitM () ByteString (RIO env) ()) ()
p
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall seq (m :: * -> *).
(IsSequence seq, Monad m) =>
(Element seq -> Bool) -> ConduitT seq seq m ()
filterCE (forall a. Eq a => a -> a -> Bool
== Word8
10)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a b o.
Monad m =>
(a -> b -> m a) -> a -> ConduitT b o m a
foldMC
(\Int
count ByteString
bs -> do
let count' :: Int
count' = Int
count forall a. Num a => a -> a -> a
+ ByteString -> Int
S.length ByteString
bs
forall (m :: * -> *) env.
(MonadIO m, HasCallStack, MonadReader env m, HasLogFunc env) =>
Utf8Builder -> m ()
logSticky forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Extracted " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
RIO.display Int
count' forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" files"
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
count'
)
Int
0
forall (m :: * -> *) env.
(MonadIO m, HasCallStack, MonadReader env m, HasLogFunc env) =>
Utf8Builder -> m ()
logStickyDone forall a b. (a -> b) -> a -> b
$
Utf8Builder
"Extracted total of " forall a. Semigroup a => a -> a -> a
<>
forall a. Display a => a -> Utf8Builder
RIO.display Int
total forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
" files from " forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
archiveDisplay
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ExitCode
waitExitCode Process () (ConduitM () ByteString (RIO env) ()) ()
p
else forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
runProcess ProcessConfig () () ()
pc
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
ec forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess)
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Path Abs File -> SetupException
ProblemWhileDecompressing Path Abs File
archive)
(Maybe DownloadInfo, Maybe DownloadInfo)
_ -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SetupException
SetupInfoMissingSevenz
chattyDownload :: HasTerm env
=> Text
-> DownloadInfo
-> Path Abs File
-> RIO env ()
chattyDownload :: forall env.
HasTerm env =>
Text -> DownloadInfo -> Path Abs File -> RIO env ()
chattyDownload Text
label DownloadInfo
downloadInfo Path Abs File
path = do
let url :: Text
url = DownloadInfo -> Text
downloadInfoUrl DownloadInfo
downloadInfo
Request
req <- forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseUrlThrow forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
url
forall (m :: * -> *) env.
(MonadIO m, HasCallStack, MonadReader env m, HasLogFunc env) =>
Utf8Builder -> m ()
logSticky forall a b. (a -> b) -> a -> b
$
Utf8Builder
"Preparing to download " forall a. Semigroup a => a -> a -> a
<>
forall a. Display a => a -> Utf8Builder
RIO.display Text
label forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
" ..."
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug forall a b. (a -> b) -> a -> b
$
Utf8Builder
"Downloading from " forall a. Semigroup a => a -> a -> a
<>
forall a. Display a => a -> Utf8Builder
RIO.display Text
url forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
" to " forall a. Semigroup a => a -> a -> a
<>
forall a. IsString a => [Char] -> a
fromString (forall b t. Path b t -> [Char]
toFilePath Path Abs File
path) forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
" ..."
[HashCheck]
hashChecks <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM
[ (Utf8Builder
"sha1", forall a.
(Show a, HashAlgorithm a) =>
a -> CheckHexDigest -> HashCheck
HashCheck SHA1
SHA1, DownloadInfo -> Maybe ByteString
downloadInfoSha1)
, (Utf8Builder
"sha256", forall a.
(Show a, HashAlgorithm a) =>
a -> CheckHexDigest -> HashCheck
HashCheck SHA256
SHA256, DownloadInfo -> Maybe ByteString
downloadInfoSha256)
]
forall a b. (a -> b) -> a -> b
$ \(Utf8Builder
name, CheckHexDigest -> HashCheck
constr, DownloadInfo -> Maybe ByteString
getter) ->
case DownloadInfo -> Maybe ByteString
getter DownloadInfo
downloadInfo of
Just ByteString
bs -> do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug forall a b. (a -> b) -> a -> b
$
Utf8Builder
"Will check against " forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
name forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
" hash: " forall a. Semigroup a => a -> a -> a
<>
ByteString -> Utf8Builder
displayBytesUtf8 ByteString
bs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ CheckHexDigest -> HashCheck
constr forall a b. (a -> b) -> a -> b
$ ByteString -> CheckHexDigest
CheckHexDigestByteString ByteString
bs
Maybe ByteString
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HashCheck]
hashChecks) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$
Utf8Builder
"No sha1 or sha256 found in metadata," forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
" download hash won't be checked."
let dReq :: DownloadRequest
dReq = [HashCheck] -> DownloadRequest -> DownloadRequest
setHashChecks [HashCheck]
hashChecks forall a b. (a -> b) -> a -> b
$
Maybe Int -> DownloadRequest -> DownloadRequest
setLengthCheck Maybe Int
mtotalSize forall a b. (a -> b) -> a -> b
$
Request -> DownloadRequest
mkDownloadRequest Request
req
Bool
x <- forall env.
HasTerm env =>
DownloadRequest
-> Path Abs File -> Text -> Maybe Int -> RIO env Bool
verifiedDownloadWithProgress DownloadRequest
dReq Path Abs File
path Text
label Maybe Int
mtotalSize
if Bool
x
then forall (m :: * -> *) env.
(MonadIO m, HasCallStack, MonadReader env m, HasLogFunc env) =>
Utf8Builder -> m ()
logStickyDone (Utf8Builder
"Downloaded " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
RIO.display Text
label forall a. Semigroup a => a -> a -> a
<> Utf8Builder
".")
else forall (m :: * -> *) env.
(MonadIO m, HasCallStack, MonadReader env m, HasLogFunc env) =>
Utf8Builder -> m ()
logStickyDone Utf8Builder
"Already downloaded."
where
mtotalSize :: Maybe Int
mtotalSize = DownloadInfo -> Maybe Int
downloadInfoContentLength DownloadInfo
downloadInfo
sanityCheck :: (HasProcessContext env, HasLogFunc env)
=> Path Abs File -> RIO env ()
sanityCheck :: forall env.
(HasProcessContext env, HasLogFunc env) =>
Path Abs File -> RIO env ()
sanityCheck Path Abs File
ghc = forall (m :: * -> *) a.
MonadUnliftIO m =>
[Char] -> (Path Abs Dir -> m a) -> m a
withSystemTempDir [Char]
"stack-sanity-check" forall a b. (a -> b) -> a -> b
$ \Path Abs Dir
dir -> do
let fp :: [Char]
fp = forall b t. Path b t -> [Char]
toFilePath forall a b. (a -> b) -> a -> b
$ Path Abs Dir
dir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFileMainHs
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString -> IO ()
S.writeFile [Char]
fp forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines
[ [Char]
"import Distribution.Simple"
, [Char]
"main = putStrLn \"Hello World\""
]
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Performing a sanity check on: " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (forall b t. Path b t -> [Char]
toFilePath Path Abs File
ghc)
Either SomeException (ByteString, ByteString)
eres <- forall env (m :: * -> *) a.
(HasProcessContext env, MonadReader env m, MonadIO m) =>
[Char] -> m a -> m a
withWorkingDir (forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
dir) forall a b. (a -> b) -> a -> b
$ forall env (m :: * -> *) a.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
MonadIO m, HasCallStack) =>
[Char] -> [[Char]] -> (ProcessConfig () () () -> m a) -> m a
proc (forall b t. Path b t -> [Char]
toFilePath Path Abs File
ghc)
[ [Char]
fp
, [Char]
"-no-user-package-db"
] forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ByteString, ByteString)
readProcess_
case Either SomeException (ByteString, ByteString)
eres of
Left SomeException
e -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ SomeException -> Path Abs File -> SetupException
GHCSanityCheckCompileFailed SomeException
e Path Abs File
ghc
Right (ByteString, ByteString)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
removeHaskellEnvVars :: Map Text Text -> Map Text Text
removeHaskellEnvVars :: Map Text Text -> Map Text Text
removeHaskellEnvVars =
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Text
"GHC_PACKAGE_PATH" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Text
"GHC_ENVIRONMENT" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Text
"HASKELL_PACKAGE_SANDBOX" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Text
"HASKELL_PACKAGE_SANDBOXES" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Text
"HASKELL_DIST_DIR" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Text
"DESTDIR" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Text
"GHCRTS"
getUtf8EnvVars
:: (HasProcessContext env, HasPlatform env, HasLogFunc env)
=> ActualCompiler
-> RIO env (Map Text Text)
getUtf8EnvVars :: forall env.
(HasProcessContext env, HasPlatform env, HasLogFunc env) =>
ActualCompiler -> RIO env (Map Text Text)
getUtf8EnvVars ActualCompiler
compilerVer =
if ActualCompiler -> Version
getGhcVersion ActualCompiler
compilerVer forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
7, Int
10, Int
3]
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton Text
"GHC_CHARENC" Text
"UTF-8"
else RIO env (Map Text Text)
legacyLocale
where
legacyLocale :: RIO env (Map Text Text)
legacyLocale = do
ProcessContext
menv <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasProcessContext env => Lens' env ProcessContext
processContextL
Platform Arch
_ OS
os <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasPlatform env => Lens' env Platform
platformL
if OS
os forall a. Eq a => a -> a -> Bool
== OS
Cabal.Windows
then
forall (m :: * -> *) a. Monad m => a -> m a
return
forall k a. Map k a
Map.empty
else do
let checkedVars :: [([Text], Set Text)]
checkedVars = forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> ([Text], Set Text)
checkVar (forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env.
HasProcessContext env =>
SimpleGetter env (Map Text Text)
envVarsL ProcessContext
menv)
needChangeVars :: [Text]
needChangeVars = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> a
fst [([Text], Set Text)]
checkedVars
existingVarNames :: Set Text
existingVarNames = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [([Text], Set Text)]
checkedVars)
hasAnyExisting :: Bool
hasAnyExisting =
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
existingVarNames) [Text
"LANG", Text
"LANGUAGE", Text
"LC_ALL"]
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
needChangeVars Bool -> Bool -> Bool
&& Bool
hasAnyExisting
then
forall (m :: * -> *) a. Monad m => a -> m a
return
forall k a. Map k a
Map.empty
else do
Either SomeException ByteString
elocales <- forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall env (m :: * -> *) a.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
MonadIO m, HasCallStack) =>
[Char] -> [[Char]] -> (ProcessConfig () () () -> m a) -> m a
proc [Char]
"locale" [[Char]
"-a"] forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ByteString, ByteString)
readProcess_
let
utf8Locales :: [Text]
utf8Locales =
case Either SomeException ByteString
elocales of
Left SomeException
_ -> []
Right ByteString
locales ->
forall a. (a -> Bool) -> [a] -> [a]
filter
Text -> Bool
isUtf8Locale
(Text -> [Text]
T.lines forall a b. (a -> b) -> a -> b
$
OnDecodeError -> ByteString -> Text
T.decodeUtf8With
OnDecodeError
T.lenientDecode forall a b. (a -> b) -> a -> b
$
ByteString -> ByteString
LBS.toStrict ByteString
locales)
mfallback :: Maybe Text
mfallback = [Text] -> Maybe Text
getFallbackLocale [Text]
utf8Locales
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
(forall a. Maybe a -> Bool
isNothing Maybe Text
mfallback)
(forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn
Utf8Builder
"Warning: unable to set locale to UTF-8 encoding; GHC may fail with 'invalid character'")
let
changes :: Map Text Text
changes =
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map
(ProcessContext -> [Text] -> Maybe Text -> Text -> Map Text Text
adjustedVarValue ProcessContext
menv [Text]
utf8Locales Maybe Text
mfallback)
[Text]
needChangeVars
adds :: Map Text Text
adds
| Bool
hasAnyExisting =
forall k a. Map k a
Map.empty
| Bool
otherwise =
case Maybe Text
mfallback of
Maybe Text
Nothing -> forall k a. Map k a
Map.empty
Just Text
fallback ->
forall k a. k -> a -> Map k a
Map.singleton Text
"LANG" Text
fallback
forall (m :: * -> *) a. Monad m => a -> m a
return (forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Text Text
changes Map Text Text
adds)
checkVar
:: (Text, Text) -> ([Text], Set Text)
checkVar :: (Text, Text) -> ([Text], Set Text)
checkVar (Text
k,Text
v) =
if Text
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"LANG", Text
"LANGUAGE"] Bool -> Bool -> Bool
|| Text
"LC_" Text -> Text -> Bool
`T.isPrefixOf` Text
k
then if Text -> Bool
isUtf8Locale Text
v
then ([], forall a. a -> Set a
Set.singleton Text
k)
else ([Text
k], forall a. a -> Set a
Set.singleton Text
k)
else ([], forall a. Set a
Set.empty)
adjustedVarValue
:: ProcessContext -> [Text] -> Maybe Text -> Text -> Map Text Text
adjustedVarValue :: ProcessContext -> [Text] -> Maybe Text -> Text -> Map Text Text
adjustedVarValue ProcessContext
menv [Text]
utf8Locales Maybe Text
mfallback Text
k =
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
k (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env.
HasProcessContext env =>
SimpleGetter env (Map Text Text)
envVarsL ProcessContext
menv) of
Maybe Text
Nothing -> forall k a. Map k a
Map.empty
Just Text
v ->
case forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
([Text] -> Text -> [Text]
matchingLocales [Text]
utf8Locales)
[ (Char -> Bool) -> Text -> Text
T.takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'.') Text
v forall a. Semigroup a => a -> a -> a
<> Text
"."
, (Char -> Bool) -> Text -> Text
T.takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'_') Text
v forall a. Semigroup a => a -> a -> a
<> Text
"_"] of
(Text
v':[Text]
_) -> forall k a. k -> a -> Map k a
Map.singleton Text
k Text
v'
[] ->
case Maybe Text
mfallback of
Just Text
fallback -> forall k a. k -> a -> Map k a
Map.singleton Text
k Text
fallback
Maybe Text
Nothing -> forall k a. Map k a
Map.empty
getFallbackLocale
:: [Text] -> Maybe Text
getFallbackLocale :: [Text] -> Maybe Text
getFallbackLocale [Text]
utf8Locales =
case forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Text] -> Text -> [Text]
matchingLocales [Text]
utf8Locales) [Text]
fallbackPrefixes of
(Text
v:[Text]
_) -> forall a. a -> Maybe a
Just Text
v
[] ->
case [Text]
utf8Locales of
[] -> forall a. Maybe a
Nothing
(Text
v:[Text]
_) -> forall a. a -> Maybe a
Just Text
v
matchingLocales
:: [Text] -> Text -> [Text]
matchingLocales :: [Text] -> Text -> [Text]
matchingLocales [Text]
utf8Locales Text
prefix =
forall a. (a -> Bool) -> [a] -> [a]
filter (\Text
v -> Text -> Text
T.toLower Text
prefix Text -> Text -> Bool
`T.isPrefixOf` Text -> Text
T.toLower Text
v) [Text]
utf8Locales
isUtf8Locale :: Text -> Bool
isUtf8Locale Text
locale =
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\ Text
v -> Text -> Text
T.toLower Text
v Text -> Text -> Bool
`T.isSuffixOf` Text -> Text
T.toLower Text
locale) [Text]
utf8Suffixes
fallbackPrefixes :: [Text]
fallbackPrefixes = [Text
"C.", Text
"en_US.", Text
"en_"]
utf8Suffixes :: [Text]
utf8Suffixes = [Text
".UTF-8", Text
".utf8"]
data StackReleaseInfo
= SRIGitHub !Value
| SRIHaskellStackOrg !HaskellStackOrg
data HaskellStackOrg = HaskellStackOrg
{ HaskellStackOrg -> Text
hsoUrl :: !Text
, HaskellStackOrg -> Version
hsoVersion :: !Version
}
deriving Int -> HaskellStackOrg -> ShowS
[HaskellStackOrg] -> ShowS
HaskellStackOrg -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HaskellStackOrg] -> ShowS
$cshowList :: [HaskellStackOrg] -> ShowS
show :: HaskellStackOrg -> [Char]
$cshow :: HaskellStackOrg -> [Char]
showsPrec :: Int -> HaskellStackOrg -> ShowS
$cshowsPrec :: Int -> HaskellStackOrg -> ShowS
Show
downloadStackReleaseInfo
:: (HasPlatform env, HasLogFunc env)
=> Maybe String
-> Maybe String
-> Maybe String
-> RIO env StackReleaseInfo
downloadStackReleaseInfo :: forall env.
(HasPlatform env, HasLogFunc env) =>
Maybe [Char]
-> Maybe [Char] -> Maybe [Char] -> RIO env StackReleaseInfo
downloadStackReleaseInfo Maybe [Char]
Nothing Maybe [Char]
Nothing Maybe [Char]
Nothing = do
Platform
platform <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasPlatform env => Lens' env Platform
platformL
let urls0 :: [Text]
urls0 =
case Platform
platform of
Platform Arch
X86_64 OS
Cabal.Linux ->
[ Text
"https://get.haskellstack.org/upgrade/linux-x86_64-static.tar.gz"
, Text
"https://get.haskellstack.org/upgrade/linux-x86_64.tar.gz"
]
Platform Arch
X86_64 OS
Cabal.OSX ->
[ Text
"https://get.haskellstack.org/upgrade/osx-x86_64.tar.gz"
]
Platform Arch
X86_64 OS
Cabal.Windows ->
[ Text
"https://get.haskellstack.org/upgrade/windows-x86_64.tar.gz"
]
Platform
_ -> []
let extractVersion :: Text -> Either [Char] Version
extractVersion Text
loc = do
[Char]
version0 <-
case forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [Char]
"/" forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
loc of
[Char]
_final:[Char]
version0:[[Char]]
_ -> forall a b. b -> Either a b
Right [Char]
version0
[[Char]]
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"Insufficient pieces in location: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
loc
[Char]
version1 <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left [Char]
"no leading v on version") forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
"v" [Char]
version0
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid version: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
version1) forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe Version
parseVersion [Char]
version1
loop :: [Text] -> m StackReleaseInfo
loop [] = do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Could not get binary from haskellstack.org, trying GitHub"
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Maybe [Char] -> Maybe [Char] -> Maybe [Char] -> m StackReleaseInfo
downloadStackReleaseInfoGitHub forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing
loop (Text
url:[Text]
urls) = do
Request
req <- ByteString -> Request -> Request
setRequestMethod ByteString
"HEAD" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseRequest (Text -> [Char]
T.unpack Text
url)
Response ByteString
res <- forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
httpLbs Request
req { redirectCount :: Int
redirectCount = Int
0 }
case forall a. HeaderName -> Response a -> [ByteString]
getResponseHeader HeaderName
"location" Response ByteString
res of
[] -> forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"No location header found, continuing" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Text] -> m StackReleaseInfo
loop [Text]
urls
[ByteString
locBS] ->
case ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
locBS of
Left UnicodeException
e -> forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder
"Invalid UTF8: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow (ByteString
locBS, UnicodeException
e)) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Text] -> m StackReleaseInfo
loop [Text]
urls
Right Text
loc ->
case Text -> Either [Char] Version
extractVersion Text
loc of
Left [Char]
s -> forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder
"No version found: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow (Text
url, Text
loc, [Char]
s)) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Text] -> m StackReleaseInfo
loop (Text
locforall a. a -> [a] -> [a]
:[Text]
urls)
Right Version
version -> do
let hso :: HaskellStackOrg
hso = HaskellStackOrg
{ hsoUrl :: Text
hsoUrl = Text
loc
, hsoVersion :: Version
hsoVersion = Version
version
}
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Downloading from haskellstack.org: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow HaskellStackOrg
hso
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ HaskellStackOrg -> StackReleaseInfo
SRIHaskellStackOrg HaskellStackOrg
hso
[ByteString]
locs -> forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder
"Multiple location headers found: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow [ByteString]
locs) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Text] -> m StackReleaseInfo
loop [Text]
urls
forall {env} {m :: * -> *}.
(MonadReader env m, MonadThrow m, MonadIO m, HasLogFunc env) =>
[Text] -> m StackReleaseInfo
loop [Text]
urls0
downloadStackReleaseInfo Maybe [Char]
morg Maybe [Char]
mrepo Maybe [Char]
mver = forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Maybe [Char] -> Maybe [Char] -> Maybe [Char] -> m StackReleaseInfo
downloadStackReleaseInfoGitHub Maybe [Char]
morg Maybe [Char]
mrepo Maybe [Char]
mver
downloadStackReleaseInfoGitHub
:: (MonadIO m, MonadThrow m)
=> Maybe String
-> Maybe String
-> Maybe String
-> m StackReleaseInfo
downloadStackReleaseInfoGitHub :: forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Maybe [Char] -> Maybe [Char] -> Maybe [Char] -> m StackReleaseInfo
downloadStackReleaseInfoGitHub Maybe [Char]
morg Maybe [Char]
mrepo Maybe [Char]
mver = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
let org :: [Char]
org = forall a. a -> Maybe a -> a
fromMaybe [Char]
"commercialhaskell" Maybe [Char]
morg
repo :: [Char]
repo = forall a. a -> Maybe a -> a
fromMaybe [Char]
"stack" Maybe [Char]
mrepo
let url :: [Char]
url = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Char]
"https://api.github.com/repos/"
, [Char]
org
, [Char]
"/"
, [Char]
repo
, [Char]
"/releases/"
, case Maybe [Char]
mver of
Maybe [Char]
Nothing -> [Char]
"latest"
Just [Char]
ver -> [Char]
"tags/v" forall a. [a] -> [a] -> [a]
++ [Char]
ver
]
Request
req <- forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseRequest [Char]
url
Response Value
res <- forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Request -> m (Response a)
httpJSON forall a b. (a -> b) -> a -> b
$ Request -> Request
setGitHubHeaders Request
req
let code :: Int
code = forall a. Response a -> Int
getResponseStatusCode Response Value
res
if Int
code forall a. Ord a => a -> a -> Bool
>= Int
200 Bool -> Bool -> Bool
&& Int
code forall a. Ord a => a -> a -> Bool
< Int
300
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> StackReleaseInfo
SRIGitHub forall a b. (a -> b) -> a -> b
$ forall a. Response a -> a
getResponseBody Response Value
res
else forall (m :: * -> *) a. (MonadIO m, HasCallStack) => [Char] -> m a
throwString forall a b. (a -> b) -> a -> b
$ [Char]
"Could not get release information for Stack from: " forall a. [a] -> [a] -> [a]
++ [Char]
url
preferredPlatforms :: (MonadReader env m, HasPlatform env, MonadThrow m)
=> m [(Bool, String)]
preferredPlatforms :: forall env (m :: * -> *).
(MonadReader env m, HasPlatform env, MonadThrow m) =>
m [(Bool, [Char])]
preferredPlatforms = do
Platform Arch
arch' OS
os' <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasPlatform env => Lens' env Platform
platformL
(Bool
isWindows, [Char]
os) <-
case OS
os' of
OS
Cabal.Linux -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, [Char]
"linux")
OS
Cabal.Windows -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, [Char]
"windows")
OS
Cabal.OSX -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, [Char]
"osx")
OS
Cabal.FreeBSD -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, [Char]
"freebsd")
OS
_ -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ HasCallStack => [Char] -> StringException
stringException forall a b. (a -> b) -> a -> b
$ [Char]
"Binary upgrade not yet supported on OS: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show OS
os'
[Char]
arch <-
case Arch
arch' of
Arch
I386 -> forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"i386"
Arch
X86_64 -> forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"x86_64"
Arch
Arm -> forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"arm"
Arch
_ -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ HasCallStack => [Char] -> StringException
stringException forall a b. (a -> b) -> a -> b
$ [Char]
"Binary upgrade not yet supported on arch: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Arch
arch'
Bool
hasgmp4 <- forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
let suffixes :: [[Char]]
suffixes
| Bool
hasgmp4 = [[Char]
"-static", [Char]
"-gmp4", [Char]
""]
| Bool
otherwise = [[Char]
"-static", [Char]
""]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
suffix -> (Bool
isWindows, forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
os, [Char]
"-", [Char]
arch, [Char]
suffix])) [[Char]]
suffixes
downloadStackExe
:: HasConfig env
=> [(Bool, String)]
-> StackReleaseInfo
-> Path Abs Dir
-> Bool
-> (Path Abs File -> IO ())
-> RIO env ()
downloadStackExe :: forall env.
HasConfig env =>
[(Bool, [Char])]
-> StackReleaseInfo
-> Path Abs Dir
-> Bool
-> (Path Abs File -> IO ())
-> RIO env ()
downloadStackExe [(Bool, [Char])]
platforms0 StackReleaseInfo
archiveInfo Path Abs Dir
destDir Bool
checkPath Path Abs File -> IO ()
testExe = do
(Bool
isWindows, Text
archiveURL) <-
let loop :: [(Bool, [Char])] -> RIO env (Bool, Text)
loop [] = forall (m :: * -> *) a. (MonadIO m, HasCallStack) => [Char] -> m a
throwString forall a b. (a -> b) -> a -> b
$ [Char]
"Unable to find binary Stack archive for platforms: "
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Bool, [Char])]
platforms0)
loop ((Bool
isWindows, [Char]
p'):[(Bool, [Char])]
ps) = do
let p :: Text
p = [Char] -> Text
T.pack [Char]
p'
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Querying for archive location for platform: " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString [Char]
p'
case StackReleaseInfo -> Text -> Maybe Text
findArchive StackReleaseInfo
archiveInfo Text
p of
Just Text
x -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
isWindows, Text
x)
Maybe Text
Nothing -> [(Bool, [Char])] -> RIO env (Bool, Text)
loop [(Bool, [Char])]
ps
in [(Bool, [Char])] -> RIO env (Bool, Text)
loop [(Bool, [Char])]
platforms0
let (Path Abs File
destFile, Path Abs File
tmpFile)
| Bool
isWindows =
( Path Abs Dir
destDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFileStackDotExe
, Path Abs Dir
destDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFileStackDotTmpDotExe
)
| Bool
otherwise =
( Path Abs Dir
destDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFileStack
, Path Abs Dir
destDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFileStackDotTmp
)
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Downloading from: " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
RIO.display Text
archiveURL
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
case () of
()
| Text
".tar.gz" Text -> Text -> Bool
`T.isSuffixOf` Text
archiveURL -> Path Abs File -> Bool -> Text -> IO ()
handleTarball Path Abs File
tmpFile Bool
isWindows Text
archiveURL
| Text
".zip" Text -> Text -> Bool
`T.isSuffixOf` Text
archiveURL -> forall a. HasCallStack => [Char] -> a
error [Char]
"FIXME: Handle zip files"
| Bool
otherwise -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown archive format for Stack archive: " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
archiveURL
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo Utf8Builder
"Download complete, testing executable"
Platform
platform <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasPlatform env => Lens' env Platform
platformL
[Char]
currExe <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Char]
getExecutablePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *). MonadIO m => [Char] -> m ()
setFileExecutable (forall b t. Path b t -> [Char]
toFilePath Path Abs File
tmpFile)
Path Abs File -> IO ()
testExe Path Abs File
tmpFile
case Platform
platform of
Platform Arch
_ OS
Cabal.Windows | [Char] -> [Char] -> Bool
FP.equalFilePath (forall b t. Path b t -> [Char]
toFilePath Path Abs File
destFile) [Char]
currExe -> do
Path Abs File
old <- forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Abs File)
parseAbsFile (forall b t. Path b t -> [Char]
toFilePath Path Abs File
destFile forall a. [a] -> [a] -> [a]
++ [Char]
".old")
forall (m :: * -> *) b0 b1.
MonadIO m =>
Path b0 File -> Path b1 File -> m ()
renameFile Path Abs File
destFile Path Abs File
old
forall (m :: * -> *) b0 b1.
MonadIO m =>
Path b0 File -> Path b1 File -> m ()
renameFile Path Abs File
tmpFile Path Abs File
destFile
Platform
_ -> forall (m :: * -> *) b0 b1.
MonadIO m =>
Path b0 File -> Path b1 File -> m ()
renameFile Path Abs File
tmpFile Path Abs File
destFile
[Char]
destDir' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO [Char]
D.canonicalizePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> [Char]
toFilePath forall a b. (a -> b) -> a -> b
$ Path Abs Dir
destDir
forall env. HasConfig env => [Char] -> [Text] -> RIO env ()
warnInstallSearchPathIssues [Char]
destDir' [Text
"stack"]
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ Utf8Builder
"New stack executable available at " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (forall b t. Path b t -> [Char]
toFilePath Path Abs File
destFile)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
checkPath forall a b. (a -> b) -> a -> b
$ forall env. HasConfig env => Path Abs File -> [Char] -> RIO env ()
performPathChecking Path Abs File
destFile [Char]
currExe
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (SomeException -> m a) -> m a
`catchAny` (forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Utf8Builder
displayShow)
where
findArchive :: StackReleaseInfo -> Text -> Maybe Text
findArchive (SRIGitHub Value
val) Text
pattern = do
Object Object
top <- forall (m :: * -> *) a. Monad m => a -> m a
return Value
val
Array Array
assets <- forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
"assets" Object
top
forall a. First a -> Maybe a
getFirst forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Maybe a -> First a
First forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value -> Maybe Text
findMatch Text
pattern') Array
assets
where
pattern' :: Text
pattern' = forall a. Monoid a => [a] -> a
mconcat [Text
"-", Text
pattern, Text
"."]
findMatch :: Text -> Value -> Maybe Text
findMatch Text
pattern'' (Object Object
o) = do
String Text
name <- forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
"name" Object
o
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text
".asc" Text -> Text -> Bool
`T.isSuffixOf` Text
name
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Text
pattern'' Text -> Text -> Bool
`T.isInfixOf` Text
name
String Text
url <- forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
"browser_download_url" Object
o
forall a. a -> Maybe a
Just Text
url
findMatch Text
_ Value
_ = forall a. Maybe a
Nothing
findArchive (SRIHaskellStackOrg HaskellStackOrg
hso) Text
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ HaskellStackOrg -> Text
hsoUrl HaskellStackOrg
hso
handleTarball :: Path Abs File -> Bool -> T.Text -> IO ()
handleTarball :: Path Abs File -> Bool -> Text -> IO ()
handleTarball Path Abs File
tmpFile Bool
isWindows Text
url = do
Request
req <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Request -> Request
setGitHubHeaders forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseUrlThrow forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
url
forall (m :: * -> *) (n :: * -> *) i a.
(MonadUnliftIO m, MonadIO n) =>
Request -> (Response (ConduitM i ByteString n ()) -> m a) -> m a
withResponse Request
req forall a b. (a -> b) -> a -> b
$ \Response (ConduitM () ByteString IO ())
res -> do
Entries FormatError
entries <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Entries FormatError
Tar.read forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
LBS.fromChunks)
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadUnliftIO m, MonadActive m) =>
Source m a -> m [a]
lazyConsume
forall a b. (a -> b) -> a -> b
$ forall a. Response a -> a
getResponseBody Response (ConduitM () ByteString IO ())
res forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *).
(PrimMonad m, MonadThrow m) =>
ConduitT ByteString ByteString m ()
ungzip
let loop :: Entries FormatError -> IO ()
loop Entries FormatError
Tar.Done = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Char]
"Stack executable "
, forall a. Show a => a -> [Char]
show [Char]
exeName
, [Char]
" not found in archive from "
, Text -> [Char]
T.unpack Text
url
]
loop (Tar.Fail FormatError
e) = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM FormatError
e
loop (Tar.Next Entry
e Entries FormatError
es) =
case [Char] -> [[Char]]
FP.splitPath (Entry -> [Char]
Tar.entryPath Entry
e) of
[[Char]
_ignored, [Char]
name] | [Char]
name forall a. Eq a => a -> a -> Bool
== [Char]
exeName -> do
case Entry -> EntryContent
Tar.entryContent Entry
e of
Tar.NormalFile ByteString
lbs FileSize
_ -> do
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
ensureDir Path Abs Dir
destDir
[Char] -> ByteString -> IO ()
LBS.writeFile (forall b t. Path b t -> [Char]
toFilePath Path Abs File
tmpFile) ByteString
lbs
EntryContent
_ -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Char]
"Invalid file type for tar entry named "
, Entry -> [Char]
Tar.entryPath Entry
e
, [Char]
" downloaded from "
, Text -> [Char]
T.unpack Text
url
]
[[Char]]
_ -> Entries FormatError -> IO ()
loop Entries FormatError
es
Entries FormatError -> IO ()
loop Entries FormatError
entries
where
exeName :: [Char]
exeName
| Bool
isWindows = [Char]
"stack.exe"
| Bool
otherwise = [Char]
"stack"
performPathChecking
:: HasConfig env
=> Path Abs File
-> String
-> RIO env ()
performPathChecking :: forall env. HasConfig env => Path Abs File -> [Char] -> RIO env ()
performPathChecking Path Abs File
newFile [Char]
executablePath = do
Path Abs File
executablePath' <- forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Abs File)
parseAbsFile [Char]
executablePath
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall b t. Path b t -> [Char]
toFilePath Path Abs File
newFile forall a. Eq a => a -> a -> Bool
== [Char]
executablePath) forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Also copying stack executable to " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString [Char]
executablePath
Path Abs File
tmpFile <- forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Abs File)
parseAbsFile forall a b. (a -> b) -> a -> b
$ [Char]
executablePath forall a. [a] -> [a] -> [a]
++ [Char]
".tmp"
Either IOException ()
eres <- forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either IOException a)
tryIO forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b0 b1.
MonadIO m =>
Path b0 File -> Path b1 File -> m ()
copyFile Path Abs File
newFile Path Abs File
tmpFile
forall (m :: * -> *). MonadIO m => [Char] -> m ()
setFileExecutable (forall b t. Path b t -> [Char]
toFilePath Path Abs File
tmpFile)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b0 b1.
MonadIO m =>
Path b0 File -> Path b1 File -> m ()
renameFile Path Abs File
tmpFile Path Abs File
executablePath'
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo Utf8Builder
"Stack executable copied successfully!"
case Either IOException ()
eres of
Right () -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Left IOException
e
| IOException -> Bool
isPermissionError IOException
e -> do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Permission error when trying to copy: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow IOException
e
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"Should I try to perform the file copy using sudo? This may fail"
Bool
toSudo <- forall (m :: * -> *). MonadIO m => Text -> m Bool
promptBool Text
"Try using sudo? (y/n) "
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
toSudo forall a b. (a -> b) -> a -> b
$ do
let run :: [Char] -> [[Char]] -> m ()
run [Char]
cmd [[Char]]
args = do
ExitCode
ec <- forall env (m :: * -> *) a.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
MonadIO m, HasCallStack) =>
[Char] -> [[Char]] -> (ProcessConfig () () () -> m a) -> m a
proc [Char]
cmd [[Char]]
args forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
runProcess
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
ec forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Char]
"Process exited with "
, forall a. Show a => a -> [Char]
show ExitCode
ec
, [Char]
": "
, [[Char]] -> [Char]
unwords ([Char]
cmdforall a. a -> [a] -> [a]
:[[Char]]
args)
]
commands :: [([Char], [[Char]])]
commands =
[ ([Char]
"sudo",
[ [Char]
"cp"
, forall b t. Path b t -> [Char]
toFilePath Path Abs File
newFile
, forall b t. Path b t -> [Char]
toFilePath Path Abs File
tmpFile
])
, ([Char]
"sudo",
[ [Char]
"mv"
, forall b t. Path b t -> [Char]
toFilePath Path Abs File
tmpFile
, [Char]
executablePath
])
]
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo Utf8Builder
"Going to run the following commands:"
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo Utf8Builder
""
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [([Char], [[Char]])]
commands forall a b. (a -> b) -> a -> b
$ \([Char]
cmd, [[Char]]
args) ->
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ Utf8Builder
"- " forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse Utf8Builder
" " (forall a. IsString a => [Char] -> a
fromString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char]
cmdforall a. a -> [a] -> [a]
:[[Char]]
args)))
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall {m :: * -> *} {env}.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
MonadIO m) =>
[Char] -> [[Char]] -> m ()
run) [([Char], [[Char]])]
commands
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo Utf8Builder
""
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo Utf8Builder
"sudo file copy worked!"
| Bool
otherwise -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM IOException
e
getDownloadVersion :: StackReleaseInfo -> Maybe Version
getDownloadVersion :: StackReleaseInfo -> Maybe Version
getDownloadVersion (SRIGitHub Value
val) = do
Object Object
o <- forall a. a -> Maybe a
Just Value
val
String Text
rawName <- forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
"name" Object
o
[Char] -> Maybe Version
parseVersion forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Int -> Text -> Text
T.drop Int
1 Text
rawName)
getDownloadVersion (SRIHaskellStackOrg HaskellStackOrg
hso) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ HaskellStackOrg -> Version
hsoVersion HaskellStackOrg
hso