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

Formatting

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

69
app/ghcup/Main.hs
View File

@ -527,10 +527,8 @@ describe_result = $( (LitE . StringL) <$>
main :: IO () main :: IO ()
main = do main = do
let let versionHelp = infoOption
versionHelp = infoOption ( ("The GHCup Haskell installer, version " <>)
(("The GHCup Haskell installer, version " <>
)
$ (head . lines $ describe_result) $ (head . lines $ describe_result)
) )
(long "version" <> help "Show version") (long "version" <> help "Show version")
@ -721,7 +719,9 @@ Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues
) )
>>= \case >>= \case
VRight v -> do 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|]
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger ($(logError) [i|#{e}|]) runLogger ($(logError) [i|#{e}|])
@ -744,16 +744,14 @@ Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues
liftE $ rmGHCVer ghcVer liftE $ rmGHCVer ghcVer
) )
>>= \case >>= \case
VRight _ -> VRight _ -> pure ExitSuccess
pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger ($(logError) [i|#{e}|]) runLogger ($(logError) [i|#{e}|])
pure $ ExitFailure 7 pure $ ExitFailure 7
DInfo -> do DInfo ->
(runDebugInfo $ do do
liftE $ getDebugInfo (runDebugInfo $ liftE $ getDebugInfo)
)
>>= \case >>= \case
VRight dinfo -> do VRight dinfo -> do
putStrLn $ prettyDebugInfo dinfo putStrLn $ prettyDebugInfo dinfo
@ -763,9 +761,12 @@ Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues
pure $ ExitFailure 8 pure $ ExitFailure 8
Compile (CompileGHC CompileOptions {..}) -> Compile (CompileGHC CompileOptions {..}) ->
(runCompileGHC $ do (runCompileGHC $ liftE $ compileGHC dls
liftE targetVer
$ compileGHC dls targetVer bootstrapGhc jobs buildConfig patchDir bootstrapGhc
jobs
buildConfig
patchDir
) )
>>= \case >>= \case
VRight _ -> do VRight _ -> do
@ -793,8 +794,10 @@ Make sure to clean up #{tmpdir} afterwards.|]
) )
>>= \case >>= \case
VRight _ -> do VRight _ -> do
runLogger ($(logInfo) runLogger
"Cabal successfully compiled and installed") ($(logInfo)
"Cabal successfully compiled and installed"
)
pure ExitSuccess pure ExitSuccess
VLeft (V (BuildFailed tmpdir e)) -> do VLeft (V (BuildFailed tmpdir e)) -> do
runLogger runLogger
@ -817,42 +820,46 @@ 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|]))
(runUpgrade $ (liftE $ upgradeGHCup dls target force)) (runUpgrade $ (liftE $ upgradeGHCup dls target force)) >>= \case
>>= \case
VRight v' -> do VRight v' -> do
let pretty_v = prettyVer v' let pretty_v = prettyVer v'
runLogger runLogger $ $(logInfo)
$ $(logInfo)
[i|Successfully upgraded GHCup to version #{pretty_v}|] [i|Successfully upgraded GHCup to version #{pretty_v}|]
pure ExitSuccess pure ExitSuccess
VLeft (V NoUpdate) -> do VLeft (V NoUpdate) -> do
runLogger $ $(logWarn) runLogger $ $(logWarn) [i|No GHCup update available|]
[i|No GHCup update available|]
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger ($(logError) [i|#{e}|]) runLogger ($(logError) [i|#{e}|])
pure $ ExitFailure 11 pure $ ExitFailure 11
ToolRequirements -> (runLogger $ runE ToolRequirements ->
@'[ NoCompatiblePlatform ( runLogger
, DistroNotFound $ runE
, NoToolRequirements @'[NoCompatiblePlatform , DistroNotFound , NoToolRequirements]
] $ do $ do
platform <- liftE $ getPlatform platform <- liftE $ getPlatform
req <- (getCommonRequirements platform $ treq) req <-
(getCommonRequirements platform $ treq)
?? NoToolRequirements ?? NoToolRequirements
liftIO $ T.hPutStr stdout (prettyRequirements req)) liftIO $ T.hPutStr stdout (prettyRequirements req)
)
>>= \case >>= \case
VRight _ -> pure ExitSuccess VRight _ -> pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger runLogger
($(logError) [i|Error getting tool requirements: #{e}|]) ($(logError)
[i|Error getting tool requirements: #{e}|]
)
pure $ ExitFailure 12 pure $ ExitFailure 12
case res of case res of
ExitSuccess -> pure () ExitSuccess -> pure ()
ef@(ExitFailure _) -> do ef@(ExitFailure _) -> do
runLogger ($(logError) [i|If you think this is a bug, report at: https://gitlab.haskell.org/haskell/ghcup-hs/issues|]) runLogger
($(logError)
[i|If you think this is a bug, report at: https://gitlab.haskell.org/haskell/ghcup-hs/issues|]
)
exitWith ef exitWith ef
pure () pure ()