{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
module Stack.Upgrade
( upgrade
, UpgradeOpts
, upgradeOpts
) where
import Stack.Prelude hiding (force, Display (..))
import qualified Data.Text as T
import Distribution.Version (mkVersion')
import Options.Applicative
import Path
import qualified Paths_stack as Paths
import Stack.Build
import Stack.Build.Target (NeedTargets(..))
import Stack.Constants
import Stack.Runners
import Stack.Setup
import Stack.Types.Config
import System.Console.ANSI (hSupportsANSIWithoutEmulation)
import System.Process (rawSystem, readProcess)
import RIO.PrettyPrint
import RIO.Process
upgradeOpts :: Parser UpgradeOpts
upgradeOpts :: Parser UpgradeOpts
upgradeOpts = Maybe BinaryOpts -> Maybe SourceOpts -> UpgradeOpts
UpgradeOpts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall {a}. Parser (Maybe a)
sourceOnly forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser BinaryOpts
binaryOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall {a}. Parser (Maybe a)
binaryOnly forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser SourceOpts
sourceOpts)
where
binaryOnly :: Parser (Maybe a)
binaryOnly = forall a. a -> Mod FlagFields a -> Parser a
flag' forall a. Maybe a
Nothing (forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"binary-only" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Do not use a source upgrade path")
sourceOnly :: Parser (Maybe a)
sourceOnly = forall a. a -> Mod FlagFields a -> Parser a
flag' forall a. Maybe a
Nothing (forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"source-only" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Do not use a binary upgrade path")
binaryOpts :: Parser BinaryOpts
binaryOpts = Maybe [Char]
-> Bool
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> BinaryOpts
BinaryOpts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall s. IsString s => Mod OptionFields s -> Parser s
strOption
( forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"binary-platform"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Platform type for archive to download"
forall a. Semigroup a => a -> a -> a
<> forall a (f :: * -> *). Show a => Mod f a
showDefault))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
(forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"force-download" forall a. Semigroup a => a -> a -> a
<>
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Download the latest available stack executable")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall s. IsString s => Mod OptionFields s -> Parser s
strOption
(forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"binary-version" forall a. Semigroup a => a -> a -> a
<>
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Download a specific stack version"))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall s. IsString s => Mod OptionFields s -> Parser s
strOption
(forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"github-org" forall a. Semigroup a => a -> a -> a
<>
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"GitHub organization name"))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall s. IsString s => Mod OptionFields s -> Parser s
strOption
(forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"github-repo" forall a. Semigroup a => a -> a -> a
<>
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"GitHub repository name"))
sourceOpts :: Parser SourceOpts
sourceOpts = Maybe ([Char], [Char]) -> SourceOpts
SourceOpts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((\Bool
fromGit [Char]
repo [Char]
branch -> if Bool
fromGit then forall a. a -> Maybe a
Just ([Char]
repo, [Char]
branch) else forall a. Maybe a
Nothing)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
switch
( forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"git"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Clone from Git instead of downloading from Hackage (more dangerous)" )
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s. IsString s => Mod OptionFields s -> Parser s
strOption
( forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"git-repo"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Clone from specified git repository"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value [Char]
"https://github.com/commercialhaskell/stack"
forall a. Semigroup a => a -> a -> a
<> forall a (f :: * -> *). Show a => Mod f a
showDefault )
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s. IsString s => Mod OptionFields s -> Parser s
strOption
( forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"git-branch"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Clone from this git branch"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value [Char]
"master"
forall a. Semigroup a => a -> a -> a
<> forall a (f :: * -> *). Show a => Mod f a
showDefault ))
data BinaryOpts = BinaryOpts
{ BinaryOpts -> Maybe [Char]
_boPlatform :: !(Maybe String)
, BinaryOpts -> Bool
_boForce :: !Bool
, BinaryOpts -> Maybe [Char]
_boVersion :: !(Maybe String)
, BinaryOpts -> Maybe [Char]
_boGitHubOrg :: !(Maybe String)
, BinaryOpts -> Maybe [Char]
_boGitHubRepo :: !(Maybe String)
}
deriving Int -> BinaryOpts -> ShowS
[BinaryOpts] -> ShowS
BinaryOpts -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [BinaryOpts] -> ShowS
$cshowList :: [BinaryOpts] -> ShowS
show :: BinaryOpts -> [Char]
$cshow :: BinaryOpts -> [Char]
showsPrec :: Int -> BinaryOpts -> ShowS
$cshowsPrec :: Int -> BinaryOpts -> ShowS
Show
newtype SourceOpts = SourceOpts (Maybe (String, String))
deriving Int -> SourceOpts -> ShowS
[SourceOpts] -> ShowS
SourceOpts -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SourceOpts] -> ShowS
$cshowList :: [SourceOpts] -> ShowS
show :: SourceOpts -> [Char]
$cshow :: SourceOpts -> [Char]
showsPrec :: Int -> SourceOpts -> ShowS
$cshowsPrec :: Int -> SourceOpts -> ShowS
Show
data UpgradeOpts = UpgradeOpts
{ UpgradeOpts -> Maybe BinaryOpts
_uoBinary :: !(Maybe BinaryOpts)
, UpgradeOpts -> Maybe SourceOpts
_uoSource :: !(Maybe SourceOpts)
}
deriving Int -> UpgradeOpts -> ShowS
[UpgradeOpts] -> ShowS
UpgradeOpts -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [UpgradeOpts] -> ShowS
$cshowList :: [UpgradeOpts] -> ShowS
show :: UpgradeOpts -> [Char]
$cshow :: UpgradeOpts -> [Char]
showsPrec :: Int -> UpgradeOpts -> ShowS
$cshowsPrec :: Int -> UpgradeOpts -> ShowS
Show
upgrade :: Maybe String
-> UpgradeOpts
-> RIO Runner ()
upgrade :: Maybe [Char] -> UpgradeOpts -> RIO Runner ()
upgrade Maybe [Char]
builtHash (UpgradeOpts Maybe BinaryOpts
mbo Maybe SourceOpts
mso) =
case (Maybe BinaryOpts
mbo, Maybe SourceOpts
mso) of
(Maybe BinaryOpts
Nothing, Maybe SourceOpts
Nothing) -> forall (m :: * -> *) a. (MonadIO m, HasCallStack) => [Char] -> m a
throwString [Char]
"You must allow either binary or source upgrade paths"
(Just BinaryOpts
bo, Maybe SourceOpts
Nothing) -> BinaryOpts -> RIO Runner ()
binary BinaryOpts
bo
(Maybe BinaryOpts
Nothing, Just SourceOpts
so) -> SourceOpts -> RIO Runner ()
source SourceOpts
so
(Maybe BinaryOpts
_, Just so :: SourceOpts
so@(SourceOpts (Just ([Char], [Char])
_))) -> SourceOpts -> RIO Runner ()
source SourceOpts
so
(Just BinaryOpts
bo, Just SourceOpts
so) -> BinaryOpts -> RIO Runner ()
binary BinaryOpts
bo forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (SomeException -> m a) -> m a
`catchAny` \SomeException
e -> do
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
[ [Char] -> StyleDoc
flow [Char]
"Exception occurred when trying to perform binary upgrade:"
, forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ SomeException
e
, StyleDoc
line forall a. Semigroup a => a -> a -> a
<> [Char] -> StyleDoc
flow [Char]
"Falling back to source upgrade"
]
SourceOpts -> RIO Runner ()
source SourceOpts
so
where
binary :: BinaryOpts -> RIO Runner ()
binary BinaryOpts
bo = BinaryOpts -> RIO Runner ()
binaryUpgrade BinaryOpts
bo
source :: SourceOpts -> RIO Runner ()
source SourceOpts
so = Maybe [Char] -> SourceOpts -> RIO Runner ()
sourceUpgrade Maybe [Char]
builtHash SourceOpts
so
binaryUpgrade :: BinaryOpts -> RIO Runner ()
binaryUpgrade :: BinaryOpts -> RIO Runner ()
binaryUpgrade (BinaryOpts Maybe [Char]
mplatform Bool
force' Maybe [Char]
mver Maybe [Char]
morg Maybe [Char]
mrepo) = forall a. ShouldReexec -> RIO Config a -> RIO Runner a
withConfig ShouldReexec
NoReexec forall a b. (a -> b) -> a -> b
$ do
[(Bool, [Char])]
platforms0 <-
case Maybe [Char]
mplatform of
Maybe [Char]
Nothing -> forall env (m :: * -> *).
(MonadReader env m, HasPlatform env, MonadThrow m) =>
m [(Bool, [Char])]
preferredPlatforms
Just [Char]
p -> forall (m :: * -> *) a. Monad m => a -> m a
return [(Text
"windows" Text -> Text -> Bool
`T.isInfixOf` [Char] -> Text
T.pack [Char]
p, [Char]
p)]
StackReleaseInfo
archiveInfo <- forall env.
(HasPlatform env, HasLogFunc env) =>
Maybe [Char]
-> Maybe [Char] -> Maybe [Char] -> RIO env StackReleaseInfo
downloadStackReleaseInfo Maybe [Char]
morg Maybe [Char]
mrepo Maybe [Char]
mver
let mdownloadVersion :: Maybe Version
mdownloadVersion = StackReleaseInfo -> Maybe Version
getDownloadVersion StackReleaseInfo
archiveInfo
force :: Bool
force =
case Maybe [Char]
mver of
Maybe [Char]
Nothing -> Bool
force'
Just [Char]
_ -> Bool
True
Bool
isNewer <-
case Maybe Version
mdownloadVersion of
Maybe Version
Nothing -> do
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyErrorL forall a b. (a -> b) -> a -> b
$
[Char] -> StyleDoc
flow [Char]
"Unable to determine upstream version from GitHub metadata"
forall a. a -> [a] -> [a]
:
[ StyleDoc
line forall a. Semigroup a => a -> a -> a
<> [Char] -> StyleDoc
flow [Char]
"Rerun with --force-download to force an upgrade"
| Bool -> Bool
not Bool
force]
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just Version
downloadVersion -> do
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyInfoL
[ [Char] -> StyleDoc
flow [Char]
"Current Stack version:"
, forall a. IsString a => [Char] -> a
fromString (Version -> [Char]
versionString Version
stackVersion) forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
, [Char] -> StyleDoc
flow [Char]
"available download version:"
, forall a. IsString a => [Char] -> a
fromString (Version -> [Char]
versionString Version
downloadVersion)
]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Version
downloadVersion forall a. Ord a => a -> a -> Bool
> Version
stackVersion
Bool
toUpgrade <- case (Bool
force, Bool
isNewer) of
(Bool
False, Bool
False) -> do
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[Char] -> m ()
prettyInfoS [Char]
"Skipping binary upgrade, you are already running the most recent version"
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
(Bool
True, Bool
False) -> do
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[Char] -> m ()
prettyInfoS [Char]
"Forcing binary upgrade"
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
(Bool
_, Bool
True) -> do
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[Char] -> m ()
prettyInfoS [Char]
"Newer version detected, downloading"
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
toUpgrade forall a b. (a -> b) -> a -> b
$ 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
forall env.
HasConfig env =>
[(Bool, [Char])]
-> StackReleaseInfo
-> Path Abs Dir
-> Bool
-> (Path Abs File -> IO ())
-> RIO env ()
downloadStackExe [(Bool, [Char])]
platforms0 StackReleaseInfo
archiveInfo (Config -> Path Abs Dir
configLocalBin Config
config) Bool
True forall a b. (a -> b) -> a -> b
$ \Path Abs File
tmpFile -> do
ExitCode
ec <- [Char] -> [[Char]] -> IO ExitCode
rawSystem (forall b t. Path b t -> [Char]
toFilePath Path Abs File
tmpFile) [[Char]
"--version"]
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ExitCode
ec forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess)
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. (MonadIO m, HasCallStack) => [Char] -> m a
throwString [Char]
"Non-success exit code from running newly downloaded executable"
sourceUpgrade
:: Maybe String
-> SourceOpts
-> RIO Runner ()
sourceUpgrade :: Maybe [Char] -> SourceOpts -> RIO Runner ()
sourceUpgrade Maybe [Char]
builtHash (SourceOpts Maybe ([Char], [Char])
gitRepo) =
forall (m :: * -> *) a.
MonadUnliftIO m =>
[Char] -> (Path Abs Dir -> m a) -> m a
withSystemTempDir [Char]
"stack-upgrade" forall a b. (a -> b) -> a -> b
$ \Path Abs Dir
tmp -> do
Maybe (Path Abs Dir)
mdir <- case Maybe ([Char], [Char])
gitRepo of
Just ([Char]
repo, [Char]
branch) -> do
[Char]
remote <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [Char] -> IO [Char]
System.Process.readProcess [Char]
"git" [[Char]
"ls-remote", [Char]
repo, [Char]
branch] []
[Char]
latestCommit <-
case [Char] -> [[Char]]
words [Char]
remote of
[] -> forall (m :: * -> *) a. (MonadIO m, HasCallStack) => [Char] -> m a
throwString forall a b. (a -> b) -> a -> b
$ [Char]
"No commits found for branch " forall a. [a] -> [a] -> [a]
++ [Char]
branch forall a. [a] -> [a] -> [a]
++ [Char]
" on repo " forall a. [a] -> [a] -> [a]
++ [Char]
repo
[Char]
x:[[Char]]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
x
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing Maybe [Char]
builtHash) forall a b. (a -> b) -> a -> b
$
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[Char] -> m ()
prettyWarnS forall a b. (a -> b) -> a -> b
$
[Char]
"Information about the commit this version of stack was "
forall a. Semigroup a => a -> a -> a
<> [Char]
"built from is not available due to how it was built. "
forall a. Semigroup a => a -> a -> a
<> [Char]
"Will continue by assuming an upgrade is needed "
forall a. Semigroup a => a -> a -> a
<> [Char]
"because we have no information to the contrary."
if Maybe [Char]
builtHash forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just [Char]
latestCommit
then do
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[Char] -> m ()
prettyInfoS [Char]
"Already up-to-date, no upgrade required"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else do
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[Char] -> m ()
prettyInfoS [Char]
"Cloning stack"
let args :: [[Char]]
args = [ [Char]
"clone", [Char]
repo , [Char]
"stack", [Char]
"--depth", [Char]
"1", [Char]
"--recursive", [Char]
"--branch", [Char]
branch]
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
tmp) 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]
"git" [[Char]]
args forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ()
runProcess_
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
osIsWindows forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> IO (Maybe Bool)
hSupportsANSIWithoutEmulation Handle
stdout
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
$ Path Abs Dir
tmp forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirStackProgName
Maybe ([Char], [Char])
Nothing -> forall a. ShouldReexec -> RIO Config a -> RIO Runner a
withConfig ShouldReexec
NoReexec forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall env.
(HasPantryConfig env, HasLogFunc env) =>
Maybe Utf8Builder -> RIO env DidUpdateOccur
updateHackageIndex
forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Utf8Builder
"Updating index to make sure we find the latest Stack version"
Maybe PackageIdentifierRevision
mversion <- forall env.
(HasPantryConfig env, HasLogFunc env) =>
RequireHackageIndex
-> PackageName
-> UsePreferredVersions
-> RIO env (Maybe PackageIdentifierRevision)
getLatestHackageVersion RequireHackageIndex
YesRequireHackageIndex PackageName
"stack" UsePreferredVersions
UsePreferredVersions
(PackageIdentifierRevision PackageName
_ Version
version CabalFileInfo
_) <-
case Maybe PackageIdentifierRevision
mversion of
Maybe PackageIdentifierRevision
Nothing -> forall (m :: * -> *) a. (MonadIO m, HasCallStack) => [Char] -> m a
throwString [Char]
"No stack found in package indices"
Just PackageIdentifierRevision
version -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageIdentifierRevision
version
if Version
version forall a. Ord a => a -> a -> Bool
<= Version -> Version
mkVersion' Version
Paths.version
then do
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[Char] -> m ()
prettyInfoS [Char]
"Already at latest version, no upgrade required"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else do
Path Rel Dir
suffix <- forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel Dir)
parseRelDir forall a b. (a -> b) -> a -> b
$ [Char]
"stack-" forall a. [a] -> [a] -> [a]
++ Version -> [Char]
versionString Version
version
let dir :: Path Abs Dir
dir = Path Abs Dir
tmp forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
suffix
Maybe (Revision, BlobKey, TreeKey)
mrev <- forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
RequireHackageIndex
-> PackageName
-> Version
-> RIO env (Maybe (Revision, BlobKey, TreeKey))
getLatestHackageRevision RequireHackageIndex
YesRequireHackageIndex PackageName
"stack" Version
version
case Maybe (Revision, BlobKey, TreeKey)
mrev of
Maybe (Revision, BlobKey, TreeKey)
Nothing -> forall (m :: * -> *) a. (MonadIO m, HasCallStack) => [Char] -> m a
throwString [Char]
"Latest version with no revision"
Just (Revision
_rev, BlobKey
cfKey, TreeKey
treeKey) -> do
let ident :: PackageIdentifier
ident = PackageName -> Version -> PackageIdentifier
PackageIdentifier PackageName
"stack" Version
version
forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
Path Abs Dir -> PackageLocationImmutable -> RIO env ()
unpackPackageLocation Path Abs Dir
dir forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> BlobKey -> TreeKey -> PackageLocationImmutable
PLIHackage PackageIdentifier
ident BlobKey
cfKey TreeKey
treeKey
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Path Abs Dir
dir
let modifyGO :: Path Abs Dir -> GlobalOpts -> GlobalOpts
modifyGO Path Abs Dir
dir GlobalOpts
go = GlobalOpts
go
{ globalResolver :: Maybe AbstractResolver
globalResolver = forall a. Maybe a
Nothing
, globalStackYaml :: StackYamlLoc
globalStackYaml = Path Abs File -> StackYamlLoc
SYLOverride 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
stackDotYaml
}
boptsCLI :: BuildOptsCLI
boptsCLI = BuildOptsCLI
defaultBuildOptsCLI
{ boptsCLITargets :: [Text]
boptsCLITargets = [Text
"stack"]
}
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Path Abs Dir)
mdir forall a b. (a -> b) -> a -> b
$ \Path Abs Dir
dir ->
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall env. HasRunner env => Lens' env GlobalOpts
globalOptsL (Path Abs Dir -> GlobalOpts -> GlobalOpts
modifyGO Path Abs Dir
dir)) forall a b. (a -> b) -> a -> b
$
forall a. ShouldReexec -> RIO Config a -> RIO Runner a
withConfig ShouldReexec
NoReexec forall a b. (a -> b) -> a -> b
$ forall a.
NeedTargets -> BuildOptsCLI -> RIO EnvConfig a -> RIO Config a
withEnvConfig NeedTargets
AllowNoTargets BuildOptsCLI
boptsCLI forall a b. (a -> b) -> a -> b
$
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 s. HasConfig s => Lens' s BuildOpts
buildOptsLforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' BuildOpts Bool
buildOptsInstallExesL) Bool
True) forall a b. (a -> b) -> a -> b
$
forall env.
HasEnvConfig env =>
Maybe (Set (Path Abs File) -> IO ()) -> RIO env ()
build forall a. Maybe a
Nothing