hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add viPreInstall wrt #1016

Browse Source
This commit is contained in:
Julian Ospald
2024-03-02 16:23:28 +08:00
parent 190d308ddf
commit aef10a699e
8 changed files with 21940 additions and 23428 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
lib-opt/GHCup/OptParse/Compile.hs
View File

@@ -529,9 +529,14 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
HLS.SourceDist targetVer -> do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo (mkTVer targetVer) HLS dls
forM_ (_viPreInstall =<< vi) $ \msg -> do
lift $ logWarn msg
lift $ logWarn
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
forM_ (_viPreCompile =<< vi) $ \msg -> do
lift $ logInfo msg
lift $ logInfo
lift $ logWarn msg
lift $ logWarn
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
_ -> pure ()
@@ -578,9 +583,14 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
GHC.SourceDist targetVer -> do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo (mkTVer targetVer) GHC dls
forM_ (_viPreInstall =<< vi) $ \msg -> do
lift $ logWarn msg
lift $ logWarn
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
forM_ (_viPreCompile =<< vi) $ \msg -> do
lift $ logInfo msg
lift $ logInfo
lift $ logWarn msg
lift $ logWarn
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
_ -> pure ()

41
lib-opt/GHCup/OptParse/Install.hs
View File

@@ -24,6 +24,7 @@ import GHCup.Prelude
import GHCup.Prelude.Logger
import GHCup.Prelude.String.QQ
import Control.Concurrent (threadDelay)
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
@@ -327,6 +328,11 @@ install installCommand settings getAppState' runLogger = case installCommand of
(case instBindist of
Nothing -> runInstGHC s' $ do
(v, vi) <- liftE $ fromVersion instVer GHC
forM_ (_viPreInstall =<< vi) $ \msg -> do
lift $ logWarn msg
lift $ logWarn
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
liftE $ runBothE' (installGHCBin
v
(maybe GHCupInternal IsolateDir isolateDir)
@@ -338,6 +344,11 @@ install installCommand settings getAppState' runLogger = case installCommand of
Just uri -> do
runInstGHC s'{ settings = settings {noVerify = True}} $ do
(v, vi) <- liftE $ fromVersion instVer GHC
forM_ (_viPreInstall =<< vi) $ \msg -> do
lift $ logWarn msg
lift $ logWarn
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
liftE $ runBothE' (installGHCBindist
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing Nothing)
v
@@ -399,6 +410,11 @@ install installCommand settings getAppState' runLogger = case installCommand of
(case instBindist of
Nothing -> runInstTool s' $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
forM_ (_viPreInstall =<< vi) $ \msg -> do
lift $ logWarn msg
lift $ logWarn
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
liftE $ runBothE' (installCabalBin
v
(maybe GHCupInternal IsolateDir isolateDir)
@@ -408,6 +424,11 @@ install installCommand settings getAppState' runLogger = case installCommand of
Just uri -> do
runInstTool s'{ settings = settings { noVerify = True}} $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
forM_ (_viPreInstall =<< vi) $ \msg -> do
lift $ logWarn msg
lift $ logWarn
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
liftE $ runBothE' (installCabalBindist
(DownloadInfo uri Nothing "" Nothing Nothing)
v
@@ -448,6 +469,11 @@ install installCommand settings getAppState' runLogger = case installCommand of
(case instBindist of
Nothing -> runInstTool s' $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
forM_ (_viPreInstall =<< vi) $ \msg -> do
lift $ logWarn msg
lift $ logWarn
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
liftE $ runBothE' (installHLSBin
v
(maybe GHCupInternal IsolateDir isolateDir)
@@ -457,6 +483,11 @@ install installCommand settings getAppState' runLogger = case installCommand of
Just uri -> do
runInstTool s'{ settings = settings { noVerify = True}} $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
forM_ (_viPreInstall =<< vi) $ \msg -> do
lift $ logWarn msg
lift $ logWarn
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
-- TODO: support legacy
liftE $ runBothE' (installHLSBindist
(DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing Nothing)
@@ -498,6 +529,11 @@ install installCommand settings getAppState' runLogger = case installCommand of
(case instBindist of
Nothing -> runInstTool s' $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
forM_ (_viPreInstall =<< vi) $ \msg -> do
lift $ logWarn msg
lift $ logWarn
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
liftE $ runBothE' (installStackBin
v
(maybe GHCupInternal IsolateDir isolateDir)
@@ -507,6 +543,11 @@ install installCommand settings getAppState' runLogger = case installCommand of
Just uri -> do
runInstTool s'{ settings = settings { noVerify = True}} $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
forM_ (_viPreInstall =<< vi) $ \msg -> do
lift $ logWarn msg
lift $ logWarn
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
liftE $ runBothE' (installStackBindist
(DownloadInfo uri Nothing "" Nothing Nothing)
v

10
lib-opt/GHCup/OptParse/Upgrade.hs
View File

@@ -17,6 +17,7 @@ import GHCup.Types
import GHCup.Prelude.File
import GHCup.Prelude.Logger
import Control.Concurrent (threadDelay)
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
@@ -135,8 +136,15 @@ upgrade uOpts force' fatal Dirs{..} runAppState runLogger = do
UpgradeGHCupDir -> pure (Just (binDir </> "ghcup" <> exeExt))
runUpgrade runAppState (do
v' <- liftE $ upgradeGHCup target force' fatal
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
Just (tver, vi) <- pure $ getLatest dls GHCup
let latestVer = _tvVersion tver
forM_ (_viPreInstall vi) $ \msg -> do
lift $ logWarn msg
lift $ logWarn
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
v' <- liftE $ upgradeGHCup' target force' fatal latestVer
pure (v', dls)
) >>= \case
VRight (v', dls) -> do