Skip to content

Commit 90ae9ec

Browse files
decentral1sedecentral1se
committed
Add --install-cabal option for stack setup.
1 parent 2f64d64 commit 90ae9ec

6 files changed

Lines changed: 92 additions & 66 deletions

File tree

‎ChangeLog.md‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -64,6 +64,9 @@ Major changes:
6464
that all packages be present in a snapshot, however.
6565
[#2805](https://github.com/commercialhaskell/stack/issues/2805)
6666

67+
* `stack setup` now accepts a `--install-cabal VERSION` option which
68+
will install a specific version of the Cabal library globally.
69+
6770
Behavior changes:
6871

6972
* The default package metadata backend has been changed from Git to

‎src/Stack/Setup.hs‎

Lines changed: 64 additions & 57 deletions
Original file line numberDiff line numberDiff line change
@@ -138,7 +138,7 @@ data SetupOpts = SetupOpts
138138
-- ^ Don't check for a compatible GHC version/architecture
139139
, soptsSkipMsys :: !Bool
140140
-- ^ Do not use a custom msys installation on Windows
141-
, soptsUpgradeCabal :: !Bool
141+
, soptsUpgradeCabal :: !(Maybe UpgradeTo)
142142
-- ^ Upgrade the global Cabal library in the database to the newest
143143
-- version. Only works reliably with a stack-managed installation.
144144
, soptsResolveMissingGHC :: !(Maybe Text)
@@ -234,7 +234,7 @@ setupEnv mResolveMissingGHC = do
234234
, soptsSanityCheck = False
235235
, soptsSkipGhcCheck = configSkipGHCCheck config
236236
, soptsSkipMsys = configSkipMsys config
237-
, soptsUpgradeCabal = False
237+
, soptsUpgradeCabal = Nothing
238238
, soptsResolveMissingGHC = mResolveMissingGHC
239239
, soptsSetupInfoYaml = defaultSetupInfoYaml
240240
, soptsGHCBindistURL = Nothing
@@ -493,11 +493,11 @@ ensureCompiler sopts = do
493493
m <- augmentPathMap (edBins ed) (unEnvOverride menv0)
494494
mkEnvOverride (configPlatform config) (removeHaskellEnvVars m)
495495

496-
when (soptsUpgradeCabal sopts) $ do
496+
forM_ (soptsUpgradeCabal sopts) $ \version -> do
497497
unless needLocal $ do
498-
$logWarn "Trying to upgrade Cabal library on a GHC not installed by stack."
498+
$logWarn "Trying to change a Cabal library on a GHC not installed by stack."
499499
$logWarn "This may fail, caveat emptor!"
500-
upgradeCabal menv wc
500+
upgradeCabal menv wc version
501501

502502
case mtools of
503503
Just (Just (ToolGhcjs cv), _) -> ensureGhcjsBooted menv cv (soptsInstallIfMissing sopts) (soptsGHCJSBootOpts sopts)
@@ -626,68 +626,75 @@ ensureDockerStackExe containerPlatform = do
626626
downloadStackExe platforms sri stackExeDir (const $ return ())
627627
return stackExePath
628628

629-
-- | Install the newest version of Cabal globally
629+
-- | Install the newest version or a specific version of Cabal globally
630630
upgradeCabal :: (StackM env m, HasConfig env, HasGHCVariant env)
631631
=> EnvOverride
632632
-> WhichCompiler
633+
-> UpgradeTo
633634
-> m ()
634-
upgradeCabal menv wc = do
635+
upgradeCabal menv wc cabalVersion = do
636+
$logInfo "Manipulating the global Cabal is only for debugging purposes"
635637
let name = $(mkPackageName "Cabal")
636638
rmap <- resolvePackages menv Nothing Map.empty (Set.singleton name)
637-
newest <-
638-
case map rpIdent rmap of
639+
installed <- getCabalPkgVer menv wc
640+
case cabalVersion of
641+
Specific version -> do
642+
if installed /= version then
643+
doCabalInstall menv wc installed version
644+
else
645+
$logInfo $ T.concat ["No install necessary. Cabal "
646+
, T.pack $ versionString installed
647+
, " is already installed"]
648+
Latest -> case map rpIdent rmap of
639649
[] -> error "No Cabal library found in index, cannot upgrade"
640-
[PackageIdentifier name' version]
641-
| name == name' -> return version
650+
[PackageIdentifier name' version] | name == name' -> do
651+
if installed > version then
652+
doCabalInstall menv wc installed version
653+
else
654+
$logInfo $ "No upgrade necessary. Latest Cabal already installed"
642655
x -> error $ "Unexpected results for resolvePackages: " ++ show x
643-
installed <- getCabalPkgVer menv wc
644-
if installed >= newest
645-
then $logInfo $ T.concat
646-
[ "Currently installed Cabal is "
656+
657+
-- Configure and run the necessary commands for a cabal install
658+
doCabalInstall :: (StackM env m, HasConfig env, HasGHCVariant env)
659+
=> EnvOverride
660+
-> WhichCompiler
661+
-> Version
662+
-> Version
663+
-> m ()
664+
doCabalInstall menv wc installed version = do
665+
withSystemTempDir "stack-cabal-upgrade" $ \tmpdir -> do
666+
$logInfo $ T.concat
667+
[ "Installing Cabal-"
668+
, T.pack $ versionString version
669+
, " to replace "
647670
, T.pack $ versionString installed
648-
, ", newest is "
649-
, T.pack $ versionString newest
650-
, ". I'm not upgrading Cabal."
651671
]
652-
else withSystemTempDir "stack-cabal-upgrade" $ \tmpdir -> do
653-
$logInfo $ T.concat
654-
[ "Installing Cabal-"
655-
, T.pack $ versionString newest
656-
, " to replace "
657-
, T.pack $ versionString installed
658-
]
659-
let ident = PackageIdentifier name newest
660-
-- Nothing below: use the newest .cabal file revision
661-
m <- unpackPackageIdents menv tmpdir Nothing (Map.singleton ident Nothing)
662-
663-
compilerPath <- join $ findExecutable menv (compilerExeName wc)
664-
newestDir <- parseRelDir $ versionString newest
665-
let installRoot = toFilePath $ parent (parent compilerPath)
666-
</> $(mkRelDir "new-cabal")
667-
</> newestDir
668-
669-
dir <-
670-
case Map.lookup ident m of
671-
Nothing -> error "upgradeCabal: Invariant violated, dir missing"
672-
Just dir -> return dir
673-
674-
runCmd (Cmd (Just dir) (compilerExeName wc) menv ["Setup.hs"]) Nothing
675-
platform <- view platformL
676-
let setupExe = toFilePath $ dir </>
677-
(case platform of
678-
Platform _ Cabal.Windows -> $(mkRelFile "Setup.exe")
679-
_ -> $(mkRelFile "Setup"))
680-
dirArgument name' = concat
681-
[ "--"
682-
, name'
683-
, "dir="
684-
, installRoot FP.</> name'
685-
]
686-
args = "configure" : map dirArgument (words "lib bin data doc")
687-
runCmd (Cmd (Just dir) setupExe menv args) Nothing
688-
runCmd (Cmd (Just dir) setupExe menv ["build"]) Nothing
689-
runCmd (Cmd (Just dir) setupExe menv ["install"]) Nothing
690-
$logInfo "New Cabal library installed"
672+
let name = $(mkPackageName "Cabal")
673+
ident = PackageIdentifier name version
674+
m <- unpackPackageIdents menv tmpdir Nothing (Map.singleton ident Nothing)
675+
compilerPath <- join $ findExecutable menv (compilerExeName wc)
676+
versionDir <- parseRelDir $ versionString version
677+
let installRoot = toFilePath $ parent (parent compilerPath)
678+
</> $(mkRelDir "new-cabal")
679+
</> versionDir
680+
dir <- case Map.lookup ident m of
681+
Nothing -> error "upgradeCabal: Invariant violated, dir missing"
682+
Just dir -> return dir
683+
runCmd (Cmd (Just dir) (compilerExeName wc) menv ["Setup.hs"]) Nothing
684+
platform <- view platformL
685+
let setupExe = toFilePath $ dir </> case platform of
686+
Platform _ Cabal.Windows -> $(mkRelFile "Setup.exe")
687+
_ -> $(mkRelFile "Setup")
688+
dirArgument name' = concat [ "--"
689+
, name'
690+
, "dir="
691+
, installRoot FP.</> name'
692+
]
693+
args = "configure" : map dirArgument (words "lib bin data doc")
694+
runCmd (Cmd (Just dir) setupExe menv args) Nothing
695+
runCmd (Cmd (Just dir) setupExe menv ["build"]) Nothing
696+
runCmd (Cmd (Just dir) setupExe menv ["install"]) Nothing
697+
$logInfo "New Cabal library installed"
691698

692699
-- | Get the version of the system compiler, if available
693700
getSystemCompiler :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => EnvOverride -> WhichCompiler -> m (Maybe (CompilerVersion, Arch))

‎src/Stack/SetupCmd.hs‎

Lines changed: 18 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -30,7 +30,7 @@ import Stack.Types.Version
3030
data SetupCmdOpts = SetupCmdOpts
3131
{ scoCompilerVersion :: !(Maybe CompilerVersion)
3232
, scoForceReinstall :: !Bool
33-
, scoUpgradeCabal :: !Bool
33+
, scoUpgradeCabal :: !(Maybe UpgradeTo)
3434
, scoSetupInfoYaml :: !String
3535
, scoGHCBindistURL :: !(Maybe String)
3636
, scoGHCJSBootOpts :: ![String]
@@ -50,6 +50,22 @@ setupYamlCompatParser = stackSetupYaml <|> setupInfoYaml
5050
<> OA.metavar "URL"
5151
<> OA.value defaultSetupInfoYaml )
5252

53+
cabalUpgradeParser :: OA.Parser UpgradeTo
54+
cabalUpgradeParser = Specific <$> version' <|> latestParser
55+
where
56+
versionReader = do
57+
s <- OA.readerAsk
58+
case parseVersion (T.pack s) of
59+
Nothing -> OA.readerError $ "Invalid version: " ++ s
60+
Just v -> return v
61+
version' = OA.option versionReader (
62+
OA.long "install-cabal"
63+
<> OA.metavar "VERSION"
64+
<> OA.help "Install a specific version of Cabal" )
65+
latestParser = OA.flag' Latest (
66+
OA.long "upgrade-cabal"
67+
<> OA.help "Install latest version of Cabal globally" )
68+
5369
setupParser :: OA.Parser SetupCmdOpts
5470
setupParser = SetupCmdOpts
5571
<$> OA.optional (OA.argument readVersion
@@ -60,10 +76,7 @@ setupParser = SetupCmdOpts
6076
"reinstall"
6177
"reinstalling GHC, even if available (incompatible with --system-ghc)"
6278
OA.idm
63-
<*> OA.boolFlags False
64-
"upgrade-cabal"
65-
"installing the newest version of the Cabal library globally"
66-
OA.idm
79+
<*> OA.optional cabalUpgradeParser
6780
<*> setupYamlCompatParser
6881
<*> OA.optional (OA.strOption
6982
(OA.long "ghc-bindist"

‎src/Stack/Solver.hs‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -293,13 +293,12 @@ setupCompiler compiler = do
293293
, soptsUseSystem = configSystemGHC config
294294
, soptsWantedCompiler = compiler
295295
, soptsCompilerCheck = configCompilerCheck config
296-
297296
, soptsStackYaml = Nothing
298297
, soptsForceReinstall = False
299298
, soptsSanityCheck = False
300299
, soptsSkipGhcCheck = False
301300
, soptsSkipMsys = configSkipMsys config
302-
, soptsUpgradeCabal = False
301+
, soptsUpgradeCabal = Nothing
303302
, soptsResolveMissingGHC = msg
304303
, soptsSetupInfoYaml = defaultSetupInfoYaml
305304
, soptsGHCBindistURL = Nothing

‎src/Stack/Types/Version.hs‎

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -27,7 +27,8 @@ module Stack.Types.Version
2727
,toMajorVersion
2828
,latestApplicableVersion
2929
,checkVersion
30-
,nextMajorVersion)
30+
,nextMajorVersion
31+
,UpgradeTo(..))
3132
where
3233

3334
import Control.Applicative
@@ -64,6 +65,9 @@ instance Exception VersionParseFail
6465
instance Show VersionParseFail where
6566
show (VersionParseFail bs) = "Invalid version: " ++ show bs
6667

68+
-- | A Package upgrade; Latest or a specific version.
69+
data UpgradeTo = Specific Version | Latest deriving (Show)
70+
6771
-- | A package version.
6872
newtype Version =
6973
Version {unVersion :: Vector Word}

‎src/main/Main.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -578,7 +578,7 @@ pathCmd keys go = withBuildConfig go (Stack.Path.path keys)
578578
setupCmd :: SetupCmdOpts -> GlobalOpts -> IO ()
579579
setupCmd sco@SetupCmdOpts{..} go@GlobalOpts{..} = do
580580
lc <- loadConfigWithOpts go
581-
when (scoUpgradeCabal && nixEnable (configNix (lcConfig lc))) $ do
581+
when (isJust scoUpgradeCabal && nixEnable (configNix (lcConfig lc))) $ do
582582
throwIO UpgradeCabalUnusable
583583
withUserFileLock go (configStackRoot $ lcConfig lc) $ \lk -> do
584584
let getCompilerVersion = loadCompilerVersion go lc

0 commit comments

Comments
 (0)