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

Improve error reporting

Browse Source
This commit is contained in:
Julian Ospald 2020-04-17 18:26:55 +02:00
parent 62005f83a4
commit 0623c7b1b1
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
1 changed files with 88 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

158
app/ghcup/Main.hs
View File

@ -664,136 +664,147 @@ main = do
) )
>>= \case >>= \case
VRight r -> pure r VRight r -> pure r
VLeft e -> VLeft e -> do
runLogger runLogger
($(logError) [i|Error fetching download info: #{e}|]) ($(logError) [i|Error fetching download info: #{e}|])
>> exitFailure exitWith (ExitFailure 2)
runLogger $ checkForUpdates dls runLogger $ checkForUpdates dls
case optCommand of res <- case optCommand of
Install (InstallOptions {..}) -> Install (InstallOptions {..}) ->
void (runInstTool $ do
$ (runInstTool $ do
v <- liftE $ fromVersion dls instVer GHC v <- liftE $ fromVersion dls instVer GHC
liftE $ installGHCBin dls v instPlatform liftE $ installGHCBin dls v instPlatform
) )
>>= \case >>= \case
VRight _ -> VRight _ -> do
runLogger $ $(logInfo) ("GHC installation successful") runLogger $ $(logInfo) ("GHC installation successful")
VLeft (V (AlreadyInstalled _ v)) -> pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ $(logWarn) runLogger $ $(logWarn)
[i|GHC ver #{prettyVer v} already installed|] [i|GHC ver #{prettyVer v} already installed|]
VLeft (V (BuildFailed tmpdir e)) -> pure ExitSuccess
VLeft (V (BuildFailed tmpdir e)) -> do
runLogger runLogger
($(logError) [i|Build failed with #{e} ($(logError) [i|Build failed with #{e}
Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues.|] Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues.|]
) )
>> exitFailure pure $ ExitFailure 3
VLeft e -> do VLeft e -> do
runLogger $ do runLogger $ do
$(logError) [i|#{e}|] $(logError) [i|#{e}|]
$(logError) [i|Also check the logs in ~/.ghcup/logs|] $(logError) [i|Also check the logs in ~/.ghcup/logs|]
exitFailure pure $ ExitFailure 3
InstallCabal (InstallOptions {..}) -> InstallCabal (InstallOptions {..}) ->
void (runInstTool $ do
$ (runInstTool $ do
v <- liftE $ fromVersion dls instVer Cabal v <- liftE $ fromVersion dls instVer Cabal
liftE $ installCabalBin dls v instPlatform liftE $ installCabalBin dls v instPlatform
) )
>>= \case >>= \case
VRight _ -> VRight _ -> do
runLogger $ $(logInfo) ("Cabal installation successful") runLogger $ $(logInfo) ("Cabal installation successful")
VLeft (V (AlreadyInstalled _ v)) -> pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ $(logWarn) runLogger $ $(logWarn)
[i|Cabal ver #{prettyVer v} already installed|] [i|Cabal ver #{prettyVer v} already installed|]
pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ do runLogger $ do
$(logError) [i|#{e}|] $(logError) [i|#{e}|]
$(logError) [i|Also check the logs in ~/.ghcup/logs|] $(logError) [i|Also check the logs in ~/.ghcup/logs|]
exitFailure pure $ ExitFailure 4
SetGHC (SetGHCOptions {..}) -> SetGHC (SetGHCOptions {..}) ->
void (runSetGHC $ do
$ (runSetGHC $ do
v <- liftE $ fromVersion dls ghcVer GHC v <- liftE $ fromVersion dls ghcVer GHC
liftE $ setGHC v SetGHCOnly liftE $ setGHC v SetGHCOnly
) )
>>= \case >>= \case
VRight v -> VRight v -> do
runLogger $ $(logInfo) [i|GHC #{prettyVer v} successfully set as default version|] runLogger $ $(logInfo) [i|GHC #{prettyVer v} successfully set as default version|]
VLeft e -> pure ExitSuccess
runLogger ($(logError) [i|#{e}|]) >> exitFailure VLeft e -> do
runLogger ($(logError) [i|#{e}|])
pure $ ExitFailure 5
List (ListOptions {..}) -> List (ListOptions {..}) ->
void (runListGHC $ do
$ (runListGHC $ do
liftIO $ listVersions dls lTool lCriteria liftIO $ listVersions dls lTool lCriteria
) )
>>= \case >>= \case
VRight r -> liftIO $ printListResult r VRight r -> do
VLeft e -> liftIO $ printListResult r
runLogger ($(logError) [i|#{e}|]) >> exitFailure pure ExitSuccess
VLeft e -> do
runLogger ($(logError) [i|#{e}|])
pure $ ExitFailure 6
Rm (RmOptions {..}) -> Rm (RmOptions {..}) ->
void (runRmGHC $ do
$ (runRmGHC $ do
liftE $ rmGHCVer ghcVer liftE $ rmGHCVer ghcVer
) )
>>= \case >>= \case
VRight _ -> pure () VRight _ ->
VLeft e -> pure ExitSuccess
runLogger ($(logError) [i|#{e}|]) >> exitFailure VLeft e -> do
runLogger ($(logError) [i|#{e}|])
pure $ ExitFailure 7
DInfo -> do DInfo -> do
void (runDebugInfo $ do
$ (runDebugInfo $ do
liftE $ getDebugInfo liftE $ getDebugInfo
) )
>>= \case >>= \case
VRight dinfo -> putStrLn $ prettyDebugInfo dinfo VRight dinfo -> do
VLeft e -> putStrLn $ prettyDebugInfo dinfo
runLogger ($(logError) [i|#{e}|]) >> exitFailure pure ExitSuccess
VLeft e -> do
runLogger ($(logError) [i|#{e}|])
pure $ ExitFailure 8
Compile (CompileGHC CompileOptions {..}) -> Compile (CompileGHC CompileOptions {..}) ->
void (runCompileGHC $ do
$ (runCompileGHC $ do
liftE liftE
$ compileGHC dls targetVer bootstrapGhc jobs buildConfig patchDir $ compileGHC dls targetVer bootstrapGhc jobs buildConfig patchDir
) )
>>= \case >>= \case
VRight _ -> VRight _ -> do
runLogger $ $(logInfo) runLogger $ $(logInfo)
("GHC successfully compiled and installed") ("GHC successfully compiled and installed")
VLeft (V (AlreadyInstalled _ v)) -> pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ $(logWarn) runLogger $ $(logWarn)
[i|GHC ver #{prettyVer v} already installed|] [i|GHC ver #{prettyVer v} already installed|]
VLeft (V (BuildFailed tmpdir e)) -> pure ExitSuccess
VLeft (V (BuildFailed tmpdir e)) -> do
runLogger runLogger
($(logError) [i|Build failed with #{e} ($(logError) [i|Build failed with #{e}
Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues. Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues.
Make sure to clean up #{tmpdir} afterwards.|] Make sure to clean up #{tmpdir} afterwards.|]
) )
>> exitFailure pure $ ExitFailure 9
VLeft e -> VLeft e -> do
runLogger ($(logError) [i|#{e}|]) >> exitFailure runLogger ($(logError) [i|#{e}|])
pure $ ExitFailure 9
Compile (CompileCabal CompileOptions {..}) -> Compile (CompileCabal CompileOptions {..}) ->
void (runCompileCabal $ do
$ (runCompileCabal $ do
liftE $ compileCabal dls targetVer bootstrapGhc jobs patchDir liftE $ compileCabal dls targetVer bootstrapGhc jobs patchDir
) )
>>= \case >>= \case
VRight _ -> VRight _ -> do
runLogger $ $(logInfo) runLogger ($(logInfo)
("Cabal successfully compiled and installed") "Cabal successfully compiled and installed")
VLeft (V (BuildFailed tmpdir e)) -> pure ExitSuccess
VLeft (V (BuildFailed tmpdir e)) -> do
runLogger runLogger
($(logError) [i|Build failed with #{e} ($(logError) [i|Build failed with #{e}
Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues.|] Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues.|]
) )
>> exitFailure pure $ ExitFailure 10
VLeft e -> VLeft e -> do
runLogger ($(logError) [i|#{e}|]) >> exitFailure runLogger ($(logError) [i|#{e}|])
pure $ ExitFailure 10
Upgrade (uOpts) force -> do Upgrade (uOpts) force -> do
target <- case uOpts of target <- case uOpts of
@ -806,21 +817,21 @@ Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues
bdir <- liftIO $ ghcupBinDir bdir <- liftIO $ ghcupBinDir
pure (Just (bdir </> [rel|ghcup|])) pure (Just (bdir </> [rel|ghcup|]))
void (runUpgrade $ (liftE $ upgradeGHCup dls target force))
$ (runUpgrade $ do >>= \case
liftE $ upgradeGHCup dls target force VRight v' -> do
) let pretty_v = prettyVer v'
>>= \case runLogger
VRight v' -> do $ $(logInfo)
let pretty_v = prettyVer v' [i|Successfully upgraded GHCup to version #{pretty_v}|]
runLogger pure ExitSuccess
$ $(logInfo) VLeft (V NoUpdate) -> do
[i|Successfully upgraded GHCup to version #{pretty_v}|] runLogger $ $(logWarn)
VLeft (V NoUpdate) -> [i|No GHCup update available|]
runLogger $ $(logWarn) pure ExitSuccess
[i|No GHCup update available|] VLeft e -> do
VLeft e -> runLogger ($(logError) [i|#{e}|])
runLogger ($(logError) [i|#{e}|]) >> exitFailure pure $ ExitFailure 11
ToolRequirements -> (runLogger $ runE ToolRequirements -> (runLogger $ runE
@'[ NoCompatiblePlatform @'[ NoCompatiblePlatform
@ -832,11 +843,17 @@ Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues
?? NoToolRequirements ?? NoToolRequirements
liftIO $ T.hPutStr stdout (prettyRequirements req)) liftIO $ T.hPutStr stdout (prettyRequirements req))
>>= \case >>= \case
VRight r -> pure r VRight _ -> pure ExitSuccess
VLeft e -> VLeft e -> do
runLogger runLogger
($(logError) [i|Error getting tool requirements: #{e}|]) ($(logError) [i|Error getting tool requirements: #{e}|])
>> exitFailure pure $ ExitFailure 12
case res of
ExitSuccess -> pure ()
ef@(ExitFailure _) -> do
runLogger ($(logError) [i|If you think this is a bug, report at: https://gitlab.haskell.org/haskell/ghcup-hs/issues|])
exitWith ef
pure () pure ()
@ -912,3 +929,4 @@ Version: #{describe_result}|]
= show plat <> ", " <> show v' = show plat <> ", " <> show v'
prettyPlatform PlatformResult { _platform = plat, _distroVersion = Nothing } prettyPlatform PlatformResult { _platform = plat, _distroVersion = Nothing }
= show plat = show plat