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

Redo file handling wrt #165 and #187

Browse Source
This commit is contained in:
Julian Ospald
2021-07-22 15:45:08 +02:00
parent 1c2cf98850
commit 3bdc82c99b
8 changed files with 221 additions and 158 deletions
Download Patch File Download Diff File Expand all files Collapse all files

20
app/ghcup/Main.hs
View File

@@ -1387,8 +1387,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
exitWith (ExitFailure 2)
let s' = AppState settings dirs keybindings ghcupInfo pfreq
race_ (liftIO $ runLogger $ flip runReaderT dirs $ cleanupGHCupTmp)
(threadDelay 5000000 >> runLogger ($(logWarn) [i|Killing cleanup thread (exceeded 5s timeout)... please remove leftover files in #{tmpDir} manually|]))
race_ (liftIO $ runLogger $ flip runReaderT dirs $ cleanupTrash)
(threadDelay 5000000 >> runLogger ($(logWarn) [i|Killing cleanup thread (exceeded 5s timeout)... please remove leftover files in #{recycleDir} manually|]))
lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
Nothing -> runLogger $ flip runReaderT s' $ checkForUpdates
@@ -1422,6 +1422,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
-- Effect interpreters --
-------------------------
let runInstTool' appstate' mInstPlatform =
runLogger
. flip runReaderT (maybe appstate' (\x -> appstate'{ pfreq = x } :: AppState) mInstPlatform)
@@ -1519,6 +1520,9 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
let runRm =
runLogger . runAppState . runE @'[NotInstalled]
let runNuke s' =
runLogger . flip runReaderT s' . runE @'[NotInstalled]
let runDebugInfo =
runLogger
. runAppState
@@ -2067,7 +2071,8 @@ Make sure to clean up #{tmpdir} afterwards.|])
)
pure ExitSuccess
Just uri -> do
pfreq <- runAppState getPlatformReq
s' <- appState
pfreq <- flip runReaderT s' getPlatformReq
let uri' = T.unpack . decUTF8Safe . serializeURIRef' $ uri
cmd = case _rPlatform pfreq of
Darwin -> "open"
@@ -2077,7 +2082,6 @@ Make sure to clean up #{tmpdir} afterwards.|])
if clOpen
then do
s' <- appState
flip runReaderT s' $
exec cmd
[T.unpack $ decUTF8Safe $ serializeURIRef' uri]
@@ -2089,10 +2093,10 @@ Make sure to clean up #{tmpdir} afterwards.|])
>> pure (ExitFailure 13)
else putStrLn uri' >> pure ExitSuccess
Nuke ->
runRm (do
s' <- liftIO appState
void $ liftIO $ evaluate $ force s'
Nuke -> do
s' <- liftIO appState
void $ liftIO $ evaluate $ force s'
runNuke s' (do
lift $ $logWarn "WARNING: This will remove GHCup and all installed components from your system."
lift $ $logWarn "Waiting 10 seconds before commencing, if you want to cancel it, now would be the time."
liftIO $ threadDelay 10000000 -- wait 10s