diff --git a/app/ghcup-gen/Validate.hs b/app/ghcup-gen/Validate.hs
index 34a61b142d7538bc453ae1249c5ede843f34a9c6..82e376fcefa04d3484dabc7f15c4a225d4a50566 100644
--- a/app/ghcup-gen/Validate.hs
+++ b/app/ghcup-gen/Validate.hs
@@ -126,7 +126,7 @@ validate dls _ = do
_ -> lift $ $(logWarn) [i|Linux Alpine missing for #{t} #{v'} #{arch'}|]
checkUniqueTags tool = do
- let allTags = join $ M.elems $ availableToolVersions dls tool
+ let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool
let nonUnique =
fmap fst
. filter (\(_, b) -> not b)
@@ -164,7 +164,7 @@ validate dls _ = do
-- a tool must have at least one of each mandatory tags
checkMandatoryTags tool = do
- let allTags = join $ M.elems $ availableToolVersions dls tool
+ let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool
forM_ [Latest, Recommended] $ \t -> case elem t allTags of
False -> do
lift $ $(logError) [i|Tag #{t} missing from #{tool}|]
@@ -174,7 +174,7 @@ validate dls _ = do
-- all GHC versions must have a base tag
checkGHCHasBaseVersion = do
let allTags = M.toList $ availableToolVersions dls GHC
- forM allTags $ \(ver, tags) -> case any isBase tags of
+ forM allTags $ \(ver, _viTags -> tags) -> case any isBase tags of
False -> do
lift $ $(logError) [i|Base tag missing from GHC ver #{ver}|]
addError
diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs
index a527255295fbecdc308743521828a4c179ede428..408392388f263b26da659ef5feb64ce44fa5c953 100644
--- a/app/ghcup/Main.hs
+++ b/app/ghcup/Main.hs
@@ -1061,6 +1061,7 @@ tagCompleter tool add = listIOCompleter $ do
VRight ghcupInfo -> do
let allTags = filter (\t -> t /= Old)
$ join
+ $ fmap _viTags
$ M.elems
$ availableToolVersions (_ghcupDownloads ghcupInfo) tool
pure $ nub $ (add ++) $ fmap tagToString allTags
@@ -2026,22 +2027,25 @@ Make sure to clean up #{tmpdir} afterwards.|])
(UpgradeAt p) -> pure $ Just p
UpgradeGHCupDir -> pure (Just (binDir </> "ghcup" <> exeExt))
- runUpgrade (liftE $ upgradeGHCup target force') >>= \case
- VRight v' -> do
- GHCupInfo { _ghcupDownloads = dls } <- runAppState getGHCupInfo
- let pretty_v = prettyVer v'
- let vi = fromJust $ snd <$> getLatest dls GHCup
- runLogger $ $(logInfo)
- [i|Successfully upgraded GHCup to version #{pretty_v}|]
- forM_ (_viPostInstall vi) $ \msg ->
- runLogger $ $(logInfo) msg
- pure ExitSuccess
- VLeft (V NoUpdate) -> do
- runLogger $ $(logWarn) [i|No GHCup update available|]
- pure ExitSuccess
- VLeft e -> do
- runLogger $ $(logError) $ T.pack $ prettyShow e
- pure $ ExitFailure 11
+ runUpgrade (do
+ v' <- liftE $ upgradeGHCup target force'
+ GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
+ pure (v', dls)
+ ) >>= \case
+ VRight (v', dls) -> do
+ let pretty_v = prettyVer v'
+ let vi = fromJust $ snd <$> getLatest dls GHCup
+ runLogger $ $(logInfo)
+ [i|Successfully upgraded GHCup to version #{pretty_v}|]
+ forM_ (_viPostInstall vi) $ \msg ->
+ runLogger $ $(logInfo) msg
+ pure ExitSuccess
+ VLeft (V NoUpdate) -> do
+ runLogger $ $(logWarn) [i|No GHCup update available|]
+ pure ExitSuccess
+ VLeft e -> do
+ runLogger $ $(logError) $ T.pack $ prettyShow e
+ pure $ ExitFailure 11
ToolRequirements -> do
s' <- appState
diff --git a/ghcup-0.0.5.yaml b/ghcup-0.0.5.yaml
index 57a8bf84648f9911af5e996ccffa1fee45351bd6..ed3535f40ebac2a0b3fa4c055bc7e5f7d7521637 100644
--- a/ghcup-0.0.5.yaml
+++ b/ghcup-0.0.5.yaml
@@ -2076,7 +2076,10 @@ ghcupDownloads:
1.1.0:
viTags: []
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#110
- viPostInstall: "This is just the server part of your LSP configuration. Consult the README on how to configure HLS, your project and your LSP client in your editor: https://github.com/haskell/haskell-language-server/blob/master/README.md"
+ viPostInstall: &hls-post-install |
+ This is just the server part of your LSP configuration. Consult the README on how to
+ configure HLS, your project and your LSP client in your editor:
+ https://github.com/haskell/haskell-language-server/blob/master/README.md
viArch:
A_64:
Linux_UnknownLinux:
@@ -2098,7 +2101,7 @@ ghcupDownloads:
- Recommended
- Latest
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#120
- viPostInstall: "This is just the server part of your LSP configuration. Consult the README on how to configure HLS, your project and your LSP client in your editor: https://github.com/haskell/haskell-language-server/blob/master/README.md"
+ viPostInstall: *hls-post-install
viArch:
A_64:
Linux_UnknownLinux:
diff --git a/ghcup.cabal b/ghcup.cabal
index 5bd5b8c134c8881cfb2b002a8583ba582f7784d7..e74a7b5569bf58950a9c4df9997a97b6df234b70 100644
--- a/ghcup.cabal
+++ b/ghcup.cabal
@@ -1,6 +1,6 @@
cabal-version: 3.0
name: ghcup
-version: 0.1.15.2
+version: 0.1.16
license: LGPL-3.0-only
license-file: LICENSE
copyright: Julian Ospald 2020
diff --git a/lib/GHCup.hs b/lib/GHCup.hs
index 882416b2d0d07052d5ea73fb83f899a043375fd0..b6c2e91735ba7802e7000347f3496fcbf04f1e84 100644
--- a/lib/GHCup.hs
+++ b/lib/GHCup.hs
@@ -965,9 +965,9 @@ data ListResult = ListResult
-- | Extract all available tool versions and their tags.
-availableToolVersions :: GHCupDownloads -> Tool -> Map.Map Version [Tag]
+availableToolVersions :: GHCupDownloads -> Tool -> Map.Map Version VersionInfo
availableToolVersions av tool = view
- (at tool % non Map.empty % to (fmap _viTags))
+ (at tool % non Map.empty)
av
@@ -1018,7 +1018,9 @@ listVersions lt' criteria = do
Stack -> do
slr <- strayStacks avTools sSet stacks
pure (sort (slr ++ lr))
- GHCup -> pure lr
+ GHCup -> do
+ let cg = currentGHCup avTools
+ pure (sort (cg : lr))
Nothing -> do
ghcvers <- go (Just GHC) cSet cabals hlsSet' hlses sSet stacks
cabalvers <- go (Just Cabal) cSet cabals hlsSet' hlses sSet stacks
@@ -1033,7 +1035,7 @@ listVersions lt' criteria = do
, MonadLogger m
, MonadIO m
)
- => Map.Map Version [Tag]
+ => Map.Map Version VersionInfo
-> m [ListResult]
strayGHCs avTools = do
ghcs <- getInstalledGHCs
@@ -1081,7 +1083,7 @@ listVersions lt' criteria = do
, MonadLogger m
, MonadIO m
)
- => Map.Map Version [Tag]
+ => Map.Map Version VersionInfo
-> Maybe Version
-> [Either FilePath Version]
-> m [ListResult]
@@ -1115,7 +1117,7 @@ listVersions lt' criteria = do
, MonadThrow m
, MonadLogger m
, MonadIO m)
- => Map.Map Version [Tag]
+ => Map.Map Version VersionInfo
-> Maybe Version
-> [Either FilePath Version]
-> m [ListResult]
@@ -1150,7 +1152,7 @@ listVersions lt' criteria = do
, MonadLogger m
, MonadIO m
)
- => Map.Map Version [Tag]
+ => Map.Map Version VersionInfo
-> Maybe Version
-> [Either FilePath Version]
-> m [ListResult]
@@ -1178,6 +1180,25 @@ listVersions lt' criteria = do
[i|Could not parse version of stray directory #{e}|]
pure Nothing
+ currentGHCup :: Map.Map Version VersionInfo -> ListResult
+ currentGHCup av =
+ let currentVer = pvpToVersion ghcUpVer
+ listVer = Map.lookup currentVer av
+ latestVer = fst <$> headOf (getTagged Latest) av
+ recommendedVer = fst <$> headOf (getTagged Latest) av
+ isOld = maybe True (> currentVer) latestVer && maybe True (> currentVer) recommendedVer
+ in ListResult { lVer = currentVer
+ , lTag = maybe (if isOld then [Old] else []) _viTags listVer
+ , lCross = Nothing
+ , lTool = GHCup
+ , fromSrc = False
+ , lStray = isNothing listVer
+ , lSet = True
+ , lInstalled = True
+ , lNoBindist = False
+ , hlsPowered = False
+ }
+
-- NOTE: this are not cross ones, because no bindists
toListResult :: ( MonadLogger m
, MonadReader env m
@@ -1194,9 +1215,9 @@ listVersions lt' criteria = do
-> [Either FilePath Version]
-> Maybe Version
-> [Either FilePath Version]
- -> (Version, [Tag])
+ -> (Version, VersionInfo)
-> m ListResult
- toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, tags) = do
+ toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, _viTags -> tags) = do
case t of
GHC -> do
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo GHC v