diff --git a/app/ghcup/GHCup/OptParse/Common.hs b/app/ghcup/GHCup/OptParse/Common.hs
index 0bc9d4ad1b5a070ba783cfb197b0ef488f38349e..64e2d6a236472e76d21117f5759c93c8482d2316 100644
--- a/app/ghcup/GHCup/OptParse/Common.hs
+++ b/app/ghcup/GHCup/OptParse/Common.hs
@@ -472,42 +472,22 @@ checkForUpdates :: ( MonadReader env m
, MonadIO m
, MonadFail m
)
- => m ()
+ => m [(Tool, Version)]
checkForUpdates = do
GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
lInstalled <- listVersions Nothing (Just ListInstalled)
let latestInstalled tool = (fmap lVer . lastMay . filter (\lr -> lTool lr == tool)) lInstalled
- forM_ (getLatest dls GHCup) $ \(l, _) -> do
- (Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer
- when (l > ghc_ver)
- $ logWarn $
- "New GHCup version available: " <> prettyVer l <> ". To upgrade, run 'ghcup upgrade'"
-
- forM_ (getLatest dls GHC) $ \(l, _) -> do
- let mghc_ver = latestInstalled GHC
- forM mghc_ver $ \ghc_ver ->
- when (l > ghc_ver)
- $ logWarn $
- "New GHC version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install ghc " <> prettyVer l <> "'"
-
- forM_ (getLatest dls Cabal) $ \(l, _) -> do
- let mcabal_ver = latestInstalled Cabal
- forM mcabal_ver $ \cabal_ver ->
- when (l > cabal_ver)
- $ logWarn $
- "New Cabal version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install cabal " <> prettyVer l <> "'"
-
- forM_ (getLatest dls HLS) $ \(l, _) -> do
- let mhls_ver = latestInstalled HLS
- forM mhls_ver $ \hls_ver ->
- when (l > hls_ver)
- $ logWarn $
- "New HLS version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install hls " <> prettyVer l <> "'"
-
- forM_ (getLatest dls Stack) $ \(l, _) -> do
- let mstack_ver = latestInstalled Stack
- forM mstack_ver $ \stack_ver ->
- when (l > stack_ver)
- $ logWarn $
- "New Stack version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install stack " <> prettyVer l <> "'"
+ ghcup <- forMM (getLatest dls GHCup) $ \(l, _) -> do
+ (Right ghcup_ver) <- pure $ version $ prettyPVP ghcUpVer
+ if (l > ghcup_ver) then pure $ Just (GHCup, l) else pure Nothing
+
+ otherTools <- forM [GHC, Cabal, HLS, Stack] $ \t ->
+ forMM (getLatest dls t) $ \(l, _) -> do
+ let mver = latestInstalled t
+ forMM mver $ \ver ->
+ if (l > ver) then pure $ Just (t, l) else pure Nothing
+
+ pure $ catMaybes (ghcup:otherTools)
+ where
+ forMM a f = fmap join $ forM a f
diff --git a/app/ghcup/GHCup/OptParse/Compile.hs b/app/ghcup/GHCup/OptParse/Compile.hs
index 2d2f6aa6ccbec11350ade047c89d1cd4c96740f2..28e150629d75f7cb67d75415944ce1d86056cf9a 100644
--- a/app/ghcup/GHCup/OptParse/Compile.hs
+++ b/app/ghcup/GHCup/OptParse/Compile.hs
@@ -429,11 +429,11 @@ compile :: ( Monad m
)
=> CompileCommand
-> Settings
+ -> Dirs
-> (forall eff a . ReaderT AppState m (VEither eff a) -> m (VEither eff a))
-> (ReaderT LeanAppState m () -> m ())
-> m ExitCode
-compile compileCommand settings runAppState runLogger = do
- VRight Dirs{ .. } <- runAppState (VRight <$> getDirs)
+compile compileCommand settings Dirs{..} runAppState runLogger = do
case compileCommand of
(CompileHLS HLSCompileOptions { .. }) -> do
runCompileHLS runAppState (do
diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs
index d55031626fb6aa2db3107d01cf9d6d044d29f123..d8d05d68507828d097441b4ef5fc716ba4f4fc87 100644
--- a/app/ghcup/Main.hs
+++ b/app/ghcup/Main.hs
@@ -20,6 +20,7 @@ import GHCup.Download
import GHCup.Errors
import GHCup.Platform
import GHCup.Types
+import GHCup.Types.Optics hiding ( toolRequirements )
import GHCup.Utils
import GHCup.Utils.Logger
import GHCup.Utils.Prelude
@@ -39,6 +40,7 @@ import Data.Aeson.Encode.Pretty ( encodePretty )
import Data.Either
import Data.Functor
import Data.Maybe
+import Data.Versions
import GHC.IO.Encoding
import Haskus.Utils.Variant.Excepts
import Language.Haskell.TH
@@ -191,7 +193,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
-------------------------
- appState = do
+ let appState = do
pfreq <- (
runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest
) >>= \case
@@ -227,8 +229,28 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
#if defined(BRICK)
Interactive -> pure ()
#endif
+ -- check for new tools
_ -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
- Nothing -> runReaderT checkForUpdates s'
+ Nothing -> void . flip runReaderT s' . runE @'[TagNotFound, NextVerNotFound, NoToolVersionSet] $ do
+ newTools <- lift checkForUpdates
+ forM_ newTools $ \newTool@(t, l) -> do
+ -- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/283
+ alreadyInstalling' <- alreadyInstalling optCommand newTool
+ when (not alreadyInstalling') $
+ case t of
+ GHCup -> runLogger $
+ logWarn ("New GHCup version available: "
+ <> prettyVer l
+ <> ". To upgrade, run 'ghcup upgrade'")
+ _ -> runLogger $
+ logWarn ("New "
+ <> T.pack (prettyShow t)
+ <> " version available. "
+ <> "To upgrade, run 'ghcup install "
+ <> T.pack (prettyShow t)
+ <> " "
+ <> prettyVer l
+ <> "'")
Just _ -> pure ()
-- TODO: always run for windows
@@ -270,7 +292,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
List lo -> list lo no_color runAppState
Rm rmCommand -> rm rmCommand runAppState runLogger
DInfo -> dinfo runAppState runLogger
- Compile compileCommand -> compile compileCommand settings runAppState runLogger
+ Compile compileCommand -> compile compileCommand settings dirs runAppState runLogger
Config configCommand -> config configCommand settings keybindings runLogger
Whereis whereisOptions
whereisCommand -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger
@@ -287,4 +309,55 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
pure ()
-
+ where
+ alreadyInstalling :: ( HasLog env
+ , MonadFail m
+ , MonadReader env m
+ , HasGHCupInfo env
+ , HasDirs env
+ , MonadThrow m
+ , MonadIO m
+ , MonadCatch m
+ )
+ => Command
+ -> (Tool, Version)
+ -> Excepts
+ '[ TagNotFound
+ , NextVerNotFound
+ , NoToolVersionSet
+ ] m Bool
+ alreadyInstalling (Install (Right InstallOptions{..})) (GHC, ver) = cmp' GHC instVer ver
+ alreadyInstalling (Install (Left (InstallGHC InstallOptions{..}))) (GHC, ver) = cmp' GHC instVer ver
+ alreadyInstalling (Install (Left (InstallCabal InstallOptions{..}))) (Cabal, ver) = cmp' Cabal instVer ver
+ alreadyInstalling (Install (Left (InstallHLS InstallOptions{..}))) (HLS, ver) = cmp' HLS instVer ver
+ alreadyInstalling (Install (Left (InstallStack InstallOptions{..}))) (Stack, ver) = cmp' Stack instVer ver
+ alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ ovewrwiteVer = Just over }))
+ (GHC, ver) = cmp' GHC (Just $ ToolVersion (mkTVer over)) ver
+ alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = Left tver }))
+ (GHC, ver) = cmp' GHC (Just $ ToolVersion (mkTVer tver)) ver
+ alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ ovewrwiteVer = Just over }))
+ (HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer over)) ver
+ alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = Left tver }))
+ (HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
+ alreadyInstalling _ _ = pure False
+
+ cmp' :: ( HasLog env
+ , MonadFail m
+ , MonadReader env m
+ , HasGHCupInfo env
+ , HasDirs env
+ , MonadThrow m
+ , MonadIO m
+ , MonadCatch m
+ )
+ => Tool
+ -> Maybe ToolVersion
+ -> Version
+ -> Excepts
+ '[ TagNotFound
+ , NextVerNotFound
+ , NoToolVersionSet
+ ] m Bool
+ cmp' tool instVer ver = do
+ (v, _) <- liftE $ fromVersion instVer tool
+ pure (v == mkTVer ver)