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

169
app/ghcup/Main.hs
View File

@ -527,13 +527,11 @@ 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")
let numericVersionHelp = infoOption let numericVersionHelp = infoOption
numericVer numericVer
( long "numeric-version" ( long "numeric-version"
@ -664,18 +662,18 @@ main = do
) )
>>= \case >>= \case
VRight r -> pure r VRight r -> pure r
VLeft e -> do VLeft e -> do
runLogger runLogger
($(logError) [i|Error fetching download info: #{e}|]) ($(logError) [i|Error fetching download info: #{e}|])
exitWith (ExitFailure 2) exitWith (ExitFailure 2)
runLogger $ checkForUpdates dls runLogger $ checkForUpdates dls
res <- case optCommand of res <- case optCommand of
Install (InstallOptions {..}) -> Install (InstallOptions {..}) ->
(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 _ -> do VRight _ -> do
runLogger $ $(logInfo) ("GHC installation successful") runLogger $ $(logInfo) ("GHC installation successful")
@ -686,9 +684,9 @@ main = do
pure ExitSuccess pure ExitSuccess
VLeft (V (BuildFailed tmpdir e)) -> do 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.|]
) )
pure $ ExitFailure 3 pure $ ExitFailure 3
VLeft e -> do VLeft e -> do
runLogger $ do runLogger $ do
@ -696,10 +694,10 @@ Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues
$(logError) [i|Also check the logs in ~/.ghcup/logs|] $(logError) [i|Also check the logs in ~/.ghcup/logs|]
pure $ ExitFailure 3 pure $ ExitFailure 3
InstallCabal (InstallOptions {..}) -> InstallCabal (InstallOptions {..}) ->
(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 _ -> do VRight _ -> do
runLogger $ $(logInfo) ("Cabal installation successful") runLogger $ $(logInfo) ("Cabal installation successful")
@ -715,22 +713,24 @@ Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues
pure $ ExitFailure 4 pure $ ExitFailure 4
SetGHC (SetGHCOptions {..}) -> SetGHC (SetGHCOptions {..}) ->
(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 -> 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}|])
pure $ ExitFailure 5 pure $ ExitFailure 5
List (ListOptions {..}) -> List (ListOptions {..}) ->
(runListGHC $ do (runListGHC $ do
liftIO $ listVersions dls lTool lCriteria liftIO $ listVersions dls lTool lCriteria
) )
>>= \case >>= \case
VRight r -> do VRight r -> do
liftIO $ printListResult r liftIO $ printListResult r
@ -740,20 +740,18 @@ Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues
pure $ ExitFailure 6 pure $ ExitFailure 6
Rm (RmOptions {..}) -> Rm (RmOptions {..}) ->
(runRmGHC $ do (runRmGHC $ do
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,10 +761,13 @@ 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
runLogger $ $(logInfo) runLogger $ $(logInfo)
@ -778,29 +779,31 @@ Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues
pure ExitSuccess pure ExitSuccess
VLeft (V (BuildFailed tmpdir e)) -> do 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.|]
) )
pure $ ExitFailure 9 pure $ ExitFailure 9
VLeft e -> do VLeft e -> do
runLogger ($(logError) [i|#{e}|]) runLogger ($(logError) [i|#{e}|])
pure $ ExitFailure 9 pure $ ExitFailure 9
Compile (CompileCabal CompileOptions {..}) -> Compile (CompileCabal CompileOptions {..}) ->
(runCompileCabal $ do (runCompileCabal $ do
liftE $ compileCabal dls targetVer bootstrapGhc jobs patchDir liftE $ compileCabal dls targetVer bootstrapGhc jobs patchDir
) )
>>= \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
($(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.|]
) )
pure $ ExitFailure 10 pure $ ExitFailure 10
VLeft e -> do VLeft e -> do
runLogger ($(logError) [i|#{e}|]) runLogger ($(logError) [i|#{e}|])
@ -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 $ $(logInfo)
runLogger [i|Successfully upgraded GHCup to version #{pretty_v}|]
$ $(logInfo) pure ExitSuccess
[i|Successfully upgraded GHCup to version #{pretty_v}|] VLeft (V NoUpdate) -> do
pure ExitSuccess runLogger $ $(logWarn) [i|No GHCup update available|]
VLeft (V NoUpdate) -> do pure ExitSuccess
runLogger $ $(logWarn) VLeft e -> do
[i|No GHCup update available|] runLogger ($(logError) [i|#{e}|])
pure ExitSuccess pure $ ExitFailure 11
VLeft e -> do
runLogger ($(logError) [i|#{e}|])
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 <-
?? NoToolRequirements (getCommonRequirements platform $ treq)
liftIO $ T.hPutStr stdout (prettyRequirements req)) ?? NoToolRequirements
>>= \case liftIO $ T.hPutStr stdout (prettyRequirements req)
VRight _ -> pure ExitSuccess )
VLeft e -> do >>= \case
runLogger VRight _ -> pure ExitSuccess
($(logError) [i|Error getting tool requirements: #{e}|]) VLeft e -> do
pure $ ExitFailure 12 runLogger
($(logError)
[i|Error getting tool requirements: #{e}|]
)
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 ()