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

Improve postRm message, fixes #384

Browse Source
This commit is contained in:
Julian Ospald 2022-12-20 21:28:49 +08:00
parent cb0d8b80c3
commit f7d2033e25
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
4 changed files with 22 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
app/ghcup/BrickMain.hs
View File

@ -13,6 +13,7 @@ import GHCup.Errors
import GHCup.Types.Optics ( getDirs ) import GHCup.Types.Optics ( getDirs )
import GHCup.Types hiding ( LeanAppState(..) ) import GHCup.Types hiding ( LeanAppState(..) )
import GHCup.Utils import GHCup.Utils
import GHCup.OptParse.Common (logGHCPostRm)
import GHCup.Prelude ( decUTF8Safe ) import GHCup.Prelude ( decUTF8Safe )
import GHCup.Prelude.File import GHCup.Prelude.File
import GHCup.Prelude.Logger import GHCup.Prelude.Logger
@ -554,6 +555,7 @@ del' _ (_, ListResult {..}) = do
) )
>>= \case >>= \case
VRight vi -> do VRight vi -> do
logGHCPostRm (mkTVer lVer)
forM_ (_viPostRemove =<< vi) $ \msg -> forM_ (_viPostRemove =<< vi) $ \msg ->
logInfo msg logInfo msg
pure $ Right () pure $ Right ()

11
app/ghcup/GHCup/OptParse/Common.hs
View File

@ -25,6 +25,7 @@ import Control.DeepSeq
import Control.Concurrent import Control.Concurrent
import Control.Concurrent.Async import Control.Concurrent.Async
import Control.Exception.Safe import Control.Exception.Safe
import Control.Monad.Identity (Identity(..))
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail ) import Control.Monad.Fail ( MonadFail )
#endif #endif
@ -64,6 +65,7 @@ import qualified Text.Megaparsec as MP
import qualified System.FilePath.Posix as FP import qualified System.FilePath.Posix as FP
import GHCup.Version import GHCup.Version
import Control.Exception (evaluate) import Control.Exception (evaluate)
import qualified Cabal.Config as CC
------------- -------------
@ -789,3 +791,12 @@ checkForUpdates = do
pure $ catMaybes (ghcup:otherTools) pure $ catMaybes (ghcup:otherTools)
where where
forMM a f = fmap join $ forM a f forMM a f = fmap join $ forM a f
logGHCPostRm :: (MonadReader env m, HasLog env, MonadIO m) => GHCTargetVersion -> m ()
logGHCPostRm ghcVer = do
cabalStore <- liftIO $ handleIO (\_ -> if isWindows then pure "C:\\cabal\\store" else pure "~/.cabal/store")
(runIdentity . CC.cfgStoreDir <$> CC.readConfig)
let storeGhcDir = cabalStore </> ("ghc-" <> T.unpack (prettyVer $ _tvVersion ghcVer))
logInfo $ T.pack $ "After removing GHC you might also want to clean up your cabal store at: " <> storeGhcDir

16
app/ghcup/GHCup/OptParse/Rm.hs
View File

@ -175,8 +175,8 @@ rm rmCommand runAppState runLogger = case rmCommand of
) )
>>= \case >>= \case
VRight vi -> do VRight vi -> do
forM_ (_viPostRemove =<< vi) $ \msg -> runLogger $ logGHCPostRm ghcVer
runLogger $ logInfo msg postRmLog vi
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e runLogger $ logError $ T.pack $ prettyShow e
@ -191,8 +191,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
) )
>>= \case >>= \case
VRight vi -> do VRight vi -> do
forM_ (_viPostRemove =<< vi) $ \msg -> postRmLog vi
runLogger $ logInfo msg
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e runLogger $ logError $ T.pack $ prettyShow e
@ -207,8 +206,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
) )
>>= \case >>= \case
VRight vi -> do VRight vi -> do
forM_ (_viPostRemove =<< vi) $ \msg -> postRmLog vi
runLogger $ logInfo msg
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e runLogger $ logError $ T.pack $ prettyShow e
@ -223,10 +221,12 @@ rm rmCommand runAppState runLogger = case rmCommand of
) )
>>= \case >>= \case
VRight vi -> do VRight vi -> do
forM_ (_viPostRemove =<< vi) $ \msg -> postRmLog vi
runLogger $ logInfo msg
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 15 pure $ ExitFailure 15
postRmLog vi =
forM_ (_viPostRemove =<< vi) $ \msg ->
runLogger $ logInfo msg

1
ghcup.cabal
View File

@ -247,6 +247,7 @@ executable ghcup
, base >=4.12 && <5 , base >=4.12 && <5
, bytestring >=0.10 && <0.12 , bytestring >=0.10 && <0.12
, cabal-plan ^>=0.7.2 , cabal-plan ^>=0.7.2
, cabal-install-parsers >=0.4.5
, containers ^>=0.6 , containers ^>=0.6
, deepseq ^>=1.4 , deepseq ^>=1.4
, directory ^>=1.3.6.0 , directory ^>=1.3.6.0