diff --git a/app/ghcup-gen/Validate.hs b/app/ghcup-gen/Validate.hs index 34a61b1..82e376f 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 a527255..4083923 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 57a8bf8..ed3535f 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 5bd5b8c..e74a7b5 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 882416b..b6c2e91 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