@@ -487,7 +487,7 @@ install' _ (_, ListResult {..}) = do
|
||||
pure $ Right ()
|
||||
VLeft (V (AlreadyInstalled _ _)) -> pure $ Right ()
|
||||
VLeft (V NoUpdate) -> pure $ Right ()
|
||||
VLeft e -> pure $ Left $ prettyShow e <> "\n"
|
||||
VLeft e -> pure $ Left $ prettyHFError e <> "\n"
|
||||
<> "Also check the logs in ~/.ghcup/logs"
|
||||
|
||||
|
||||
@@ -524,7 +524,7 @@ set' bs input@(_, ListResult {..}) = do
|
||||
logInfo "Setting now..."
|
||||
set' bs input
|
||||
|
||||
PromptNo -> pure $ Left (prettyShow e)
|
||||
PromptNo -> pure $ Left (prettyHFError e)
|
||||
where
|
||||
userPrompt = L.toStrict . B.toLazyText . B.fromString $
|
||||
"This Version of "
|
||||
@@ -532,7 +532,7 @@ set' bs input@(_, ListResult {..}) = do
|
||||
<> " you are trying to set is not installed.\n"
|
||||
<> "Would you like to install it first? [Y/N]: "
|
||||
|
||||
_ -> pure $ Left (prettyShow e)
|
||||
_ -> pure $ Left (prettyHFError e)
|
||||
|
||||
|
||||
|
||||
@@ -560,7 +560,7 @@ del' _ (_, ListResult {..}) = do
|
||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
||||
logInfo msg
|
||||
pure $ Right ()
|
||||
VLeft e -> pure $ Left (prettyShow e)
|
||||
VLeft e -> pure $ Left (prettyHFError e)
|
||||
|
||||
|
||||
changelog' :: (MonadReader AppState m, MonadIO m)
|
||||
@@ -580,7 +580,7 @@ changelog' _ (_, ListResult {..}) = do
|
||||
Windows -> "start"
|
||||
exec cmd [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing >>= \case
|
||||
Right _ -> pure $ Right ()
|
||||
Left e -> pure $ Left $ prettyShow e
|
||||
Left e -> pure $ Left $ prettyHFError e
|
||||
|
||||
|
||||
settings' :: IORef AppState
|
||||
@@ -638,7 +638,7 @@ getGHCupInfo = do
|
||||
|
||||
case r of
|
||||
VRight a -> pure $ Right a
|
||||
VLeft e -> pure $ Left (prettyShow e)
|
||||
VLeft e -> pure $ Left (prettyHFError e)
|
||||
|
||||
|
||||
getAppData :: Maybe GHCupInfo
|
||||
|
||||
@@ -108,6 +108,7 @@ data Command
|
||||
| Prefetch PrefetchCommand
|
||||
| GC GCOptions
|
||||
| Run RunOptions
|
||||
| PrintAppErrors
|
||||
|
||||
|
||||
|
||||
@@ -341,3 +342,10 @@ com =
|
||||
<> commandGroup "Nuclear Commands:"
|
||||
<> hidden
|
||||
)
|
||||
<|> subparser
|
||||
(command
|
||||
"print-app-errors"
|
||||
(info (pure PrintAppErrors <**> helper)
|
||||
(progDesc ""))
|
||||
<> internal
|
||||
)
|
||||
|
||||
@@ -12,6 +12,7 @@ module GHCup.OptParse.ChangeLog where
|
||||
|
||||
|
||||
import GHCup.Types
|
||||
import GHCup.Errors
|
||||
import GHCup.OptParse.Common
|
||||
import GHCup.Prelude
|
||||
import GHCup.Prelude.Logger
|
||||
@@ -148,6 +149,6 @@ changelog ChangeLogOptions{..} runAppState runLogger = do
|
||||
Nothing
|
||||
>>= \case
|
||||
Right _ -> pure ExitSuccess
|
||||
Left e -> logError (T.pack $ prettyShow e)
|
||||
Left e -> logError (T.pack $ prettyHFError e)
|
||||
>> pure (ExitFailure 13)
|
||||
else liftIO $ putStrLn uri' >> pure ExitSuccess
|
||||
|
||||
@@ -40,7 +40,6 @@ import Options.Applicative hiding ( style )
|
||||
import Options.Applicative.Help.Pretty ( text )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import URI.ByteString hiding ( uriParser )
|
||||
import qualified Data.Text as T
|
||||
@@ -546,14 +545,14 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
||||
pure ExitSuccess
|
||||
VLeft err@(V (BuildFailed tmpdir _)) -> do
|
||||
case keepDirs settings of
|
||||
Never -> runLogger $ logError $ T.pack $ prettyShow err
|
||||
_ -> runLogger (logError $ T.pack (prettyShow err) <> "\n" <>
|
||||
Never -> runLogger $ logError $ T.pack $ prettyHFError err
|
||||
_ -> runLogger (logError $ T.pack (prettyHFError err) <> "\n" <>
|
||||
"Check the logs at " <> T.pack (fromGHCupPath logsDir) <> " and the build directory "
|
||||
<> T.pack tmpdir <> " for more clues." <> "\n" <>
|
||||
"Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
|
||||
pure $ ExitFailure 9
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyHFError e
|
||||
pure $ ExitFailure 9
|
||||
(CompileGHC GHCCompileOptions { hadrian = True, crossTarget = Just _ }) -> do
|
||||
runLogger $ logError "Hadrian cross compile support is not yet implemented!"
|
||||
@@ -608,12 +607,12 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
||||
pure $ ExitFailure 3
|
||||
VLeft err@(V (BuildFailed tmpdir _)) -> do
|
||||
case keepDirs settings of
|
||||
Never -> runLogger $ logError $ T.pack $ prettyShow err
|
||||
_ -> runLogger (logError $ T.pack (prettyShow err) <> "\n" <>
|
||||
Never -> runLogger $ logError $ T.pack $ prettyHFError err
|
||||
_ -> runLogger (logError $ T.pack (prettyHFError err) <> "\n" <>
|
||||
"Check the logs at " <> T.pack (fromGHCupPath logsDir) <> " and the build directory "
|
||||
<> T.pack tmpdir <> " for more clues." <> "\n" <>
|
||||
"Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
|
||||
pure $ ExitFailure 9
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyHFError e
|
||||
pure $ ExitFailure 9
|
||||
|
||||
@@ -115,5 +115,5 @@ dinfo runAppState runLogger = do
|
||||
liftIO $ putStrLn $ prettyDebugInfo di
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyHFError e
|
||||
pure $ ExitFailure 8
|
||||
|
||||
@@ -27,7 +27,6 @@ import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
@@ -139,5 +138,5 @@ gc GCOptions{..} runAppState runLogger = runGC runAppState (do
|
||||
VRight _ -> do
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyHFError e
|
||||
pure $ ExitFailure 27
|
||||
|
||||
@@ -38,7 +38,6 @@ import Options.Applicative hiding ( style )
|
||||
import Options.Applicative.Help.Pretty ( text )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
import URI.ByteString hiding ( uriParser )
|
||||
|
||||
import qualified Data.Text as T
|
||||
@@ -351,10 +350,10 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
pure ExitSuccess
|
||||
|
||||
VLeft e@(V (AlreadyInstalled _ _)) -> do
|
||||
runLogger $ logWarn $ T.pack $ prettyShow e
|
||||
runLogger $ logWarn $ T.pack $ prettyHFError e
|
||||
pure ExitSuccess
|
||||
VLeft e@(V (AlreadyInstalled _ _)) -> do
|
||||
runLogger $ logWarn $ T.pack $ prettyShow e
|
||||
runLogger $ logWarn $ T.pack $ prettyHFError e
|
||||
pure ExitSuccess
|
||||
|
||||
VLeft (V (DirNotEmpty fp)) -> do
|
||||
@@ -368,22 +367,22 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
|
||||
VLeft err@(V (BuildFailed tmpdir _)) -> do
|
||||
case keepDirs settings of
|
||||
Never -> runLogger (logError $ T.pack $ prettyShow err)
|
||||
_ -> runLogger (logError $ T.pack (prettyShow err) <> "\n" <>
|
||||
Never -> runLogger (logError $ T.pack $ prettyHFError err)
|
||||
_ -> runLogger (logError $ T.pack (prettyHFError err) <> "\n" <>
|
||||
"Check the logs at " <> T.pack (fromGHCupPath logsDir) <> " and the build directory " <> T.pack tmpdir <> " for more clues." <> "\n" <>
|
||||
"Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
|
||||
pure $ ExitFailure 3
|
||||
VLeft err@(V (BuildFailed tmpdir _)) -> do
|
||||
case keepDirs settings of
|
||||
Never -> runLogger (logError $ T.pack $ prettyShow err)
|
||||
_ -> runLogger (logError $ T.pack (prettyShow err) <> "\n" <>
|
||||
Never -> runLogger (logError $ T.pack $ prettyHFError err)
|
||||
_ -> runLogger (logError $ T.pack (prettyHFError err) <> "\n" <>
|
||||
"Check the logs at " <> T.pack (fromGHCupPath logsDir) <> " and the build directory " <> T.pack tmpdir <> " for more clues." <> "\n" <>
|
||||
"Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
|
||||
pure $ ExitFailure 3
|
||||
|
||||
VLeft e -> do
|
||||
runLogger $ do
|
||||
logError $ T.pack $ prettyShow e
|
||||
logError $ T.pack $ prettyHFError e
|
||||
logError $ "Also check the logs in " <> T.pack (fromGHCupPath logsDir)
|
||||
pure $ ExitFailure 3
|
||||
|
||||
@@ -418,14 +417,14 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft e@(V (AlreadyInstalled _ _)) -> do
|
||||
runLogger $ logWarn $ T.pack $ prettyShow e
|
||||
runLogger $ logWarn $ T.pack $ prettyHFError e
|
||||
pure ExitSuccess
|
||||
VLeft (V (FileAlreadyExistsError fp)) -> do
|
||||
runLogger $ logWarn $
|
||||
"File " <> T.pack fp <> " already exists. Use 'ghcup install cabal --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
|
||||
pure $ ExitFailure 3
|
||||
VLeft e@(V (AlreadyInstalled _ _)) -> do
|
||||
runLogger $ logWarn $ T.pack $ prettyShow e
|
||||
runLogger $ logWarn $ T.pack $ prettyHFError e
|
||||
pure ExitSuccess
|
||||
VLeft (V (FileAlreadyExistsError fp)) -> do
|
||||
runLogger $ logWarn $
|
||||
@@ -433,7 +432,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
pure $ ExitFailure 3
|
||||
VLeft e -> do
|
||||
runLogger $ do
|
||||
logError $ T.pack $ prettyShow e
|
||||
logError $ T.pack $ prettyHFError e
|
||||
logError $ "Also check the logs in " <> T.pack (fromGHCupPath logsDir)
|
||||
pure $ ExitFailure 4
|
||||
|
||||
@@ -468,14 +467,14 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft e@(V (AlreadyInstalled _ _)) -> do
|
||||
runLogger $ logWarn $ T.pack $ prettyShow e
|
||||
runLogger $ logWarn $ T.pack $ prettyHFError e
|
||||
pure ExitSuccess
|
||||
VLeft (V (FileAlreadyExistsError fp)) -> do
|
||||
runLogger $ logWarn $
|
||||
"File " <> T.pack fp <> " already exists. Use 'ghcup install hls --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
|
||||
pure $ ExitFailure 3
|
||||
VLeft e@(V (AlreadyInstalled _ _)) -> do
|
||||
runLogger $ logWarn $ T.pack $ prettyShow e
|
||||
runLogger $ logWarn $ T.pack $ prettyHFError e
|
||||
pure ExitSuccess
|
||||
VLeft (V (FileAlreadyExistsError fp)) -> do
|
||||
runLogger $ logWarn $
|
||||
@@ -483,7 +482,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
pure $ ExitFailure 3
|
||||
VLeft e -> do
|
||||
runLogger $ do
|
||||
logError $ T.pack $ prettyShow e
|
||||
logError $ T.pack $ prettyHFError e
|
||||
logError $ "Also check the logs in " <> T.pack (fromGHCupPath logsDir)
|
||||
pure $ ExitFailure 4
|
||||
|
||||
@@ -517,14 +516,14 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft e@(V (AlreadyInstalled _ _)) -> do
|
||||
runLogger $ logWarn $ T.pack $ prettyShow e
|
||||
runLogger $ logWarn $ T.pack $ prettyHFError e
|
||||
pure ExitSuccess
|
||||
VLeft (V (FileAlreadyExistsError fp)) -> do
|
||||
runLogger $ logWarn $
|
||||
"File " <> T.pack fp <> " already exists. Use 'ghcup install stack --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
|
||||
pure $ ExitFailure 3
|
||||
VLeft e@(V (AlreadyInstalled _ _)) -> do
|
||||
runLogger $ logWarn $ T.pack $ prettyShow e
|
||||
runLogger $ logWarn $ T.pack $ prettyHFError e
|
||||
pure ExitSuccess
|
||||
VLeft (V (FileAlreadyExistsError fp)) -> do
|
||||
runLogger $ logWarn $
|
||||
@@ -532,6 +531,6 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
pure $ ExitFailure 3
|
||||
VLeft e -> do
|
||||
runLogger $ do
|
||||
logError $ T.pack $ prettyShow e
|
||||
logError $ T.pack $ prettyHFError e
|
||||
logError $ "Also check the logs in " <> T.pack (fromGHCupPath logsDir)
|
||||
pure $ ExitFailure 4
|
||||
|
||||
@@ -26,7 +26,6 @@ import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
@@ -95,5 +94,5 @@ nuke appState runLogger = do
|
||||
pure ExitSuccess
|
||||
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyHFError e
|
||||
pure $ ExitFailure 15
|
||||
|
||||
@@ -30,7 +30,6 @@ import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
@@ -216,5 +215,5 @@ prefetch prefetchCommand runAppState runLogger =
|
||||
VRight _ -> do
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyHFError e
|
||||
pure $ ExitFailure 15
|
||||
|
||||
@@ -34,7 +34,6 @@ import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
@@ -179,7 +178,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
|
||||
postRmLog vi
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyHFError e
|
||||
pure $ ExitFailure 7
|
||||
|
||||
rmCabal' tv =
|
||||
@@ -194,7 +193,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
|
||||
postRmLog vi
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyHFError e
|
||||
pure $ ExitFailure 15
|
||||
|
||||
rmHLS' tv =
|
||||
@@ -209,7 +208,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
|
||||
postRmLog vi
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyHFError e
|
||||
pure $ ExitFailure 15
|
||||
|
||||
rmStack' tv =
|
||||
@@ -224,7 +223,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
|
||||
postRmLog vi
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyHFError e
|
||||
pure $ ExitFailure 15
|
||||
|
||||
postRmLog vi =
|
||||
|
||||
@@ -40,7 +40,6 @@ import Prelude hiding ( appendFile )
|
||||
import System.FilePath
|
||||
import System.Environment
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import qualified Data.Map.Strict as Map
|
||||
import qualified Data.Text as T
|
||||
@@ -266,11 +265,11 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
|
||||
case r' of
|
||||
VRight _ -> pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyHFError e
|
||||
pure $ ExitFailure 28
|
||||
#endif
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyHFError e
|
||||
pure $ ExitFailure 27
|
||||
|
||||
where
|
||||
|
||||
@@ -35,7 +35,6 @@ import Options.Applicative hiding ( style )
|
||||
import Options.Applicative.Help.Pretty ( text )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Data.Bifunctor (second)
|
||||
@@ -286,7 +285,7 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
||||
"GHC " <> prettyVer _tvVersion <> " successfully set as default version" <> maybe "" (" for cross target " <>) _tvTarget
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyHFError e
|
||||
pure $ ExitFailure 5
|
||||
|
||||
|
||||
@@ -307,7 +306,7 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
||||
"Cabal " <> prettyVer (_tvVersion v) <> " successfully set as default version"
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyHFError e
|
||||
pure $ ExitFailure 14
|
||||
|
||||
setHLS' :: SetOptions
|
||||
@@ -327,7 +326,7 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
||||
"HLS " <> prettyVer (_tvVersion v) <> " successfully set as default version"
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyHFError e
|
||||
pure $ ExitFailure 14
|
||||
|
||||
|
||||
@@ -348,5 +347,5 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
||||
"Stack " <> prettyVer (_tvVersion v) <> " successfully set as default version"
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyHFError e
|
||||
pure $ ExitFailure 14
|
||||
|
||||
@@ -23,7 +23,6 @@ import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
@@ -118,5 +117,5 @@ toolRequirements ToolReqOpts{..} runAppState runLogger = runToolRequirements run
|
||||
>>= \case
|
||||
VRight _ -> pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyHFError e
|
||||
pure $ ExitFailure 12
|
||||
|
||||
@@ -31,7 +31,6 @@ import Options.Applicative hiding ( style )
|
||||
import Options.Applicative.Help.Pretty ( text )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
@@ -189,7 +188,7 @@ unset unsetCommand runLeanAppState runLogger = case unsetCommand of
|
||||
runLogger $ logInfo "GHC successfully unset"
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyHFError e
|
||||
pure $ ExitFailure 14
|
||||
(UnsetCabal (UnsetOptions _)) -> do
|
||||
void $ runLeanAppState (VRight <$> unsetCabal)
|
||||
|
||||
@@ -28,7 +28,6 @@ import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
@@ -152,5 +151,5 @@ upgrade uOpts force' fatal Dirs{..} runAppState runLogger = do
|
||||
runLogger $ logWarn "No GHCup update available"
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyHFError e
|
||||
pure $ ExitFailure 11
|
||||
|
||||
@@ -34,7 +34,6 @@ import Options.Applicative.Help.Pretty ( text )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Environment
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
@@ -288,7 +287,7 @@ whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do
|
||||
liftIO $ putStr r
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyHFError e
|
||||
pure $ ExitFailure 30
|
||||
(WhereisTool tool (Just (ToolVersion v)), WhereisOptions{..}) ->
|
||||
runLeanWhereIs leanAppstate (do
|
||||
@@ -302,7 +301,7 @@ whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do
|
||||
liftIO $ putStr r
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyHFError e
|
||||
pure $ ExitFailure 30
|
||||
|
||||
(WhereisTool tool whereVer, WhereisOptions{..}) -> do
|
||||
@@ -318,7 +317,7 @@ whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do
|
||||
liftIO $ putStr r
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyHFError e
|
||||
pure $ ExitFailure 30
|
||||
|
||||
(WhereisBaseDir, _) -> do
|
||||
|
||||
@@ -206,7 +206,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
||||
VRight r -> pure r
|
||||
VLeft e -> do
|
||||
runLogger
|
||||
(logError $ T.pack $ prettyShow e)
|
||||
(logError $ T.pack $ prettyHFError e)
|
||||
exitWith (ExitFailure 2)
|
||||
|
||||
ghcupInfo <-
|
||||
@@ -218,7 +218,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
||||
VRight r -> pure r
|
||||
VLeft e -> do
|
||||
runLogger
|
||||
(logError $ T.pack $ prettyShow e)
|
||||
(logError $ T.pack $ prettyHFError e)
|
||||
exitWith (ExitFailure 2)
|
||||
let s' = AppState settings dirs keybindings ghcupInfo pfreq loggerConfig
|
||||
|
||||
@@ -266,7 +266,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
||||
VRight _ -> pure ()
|
||||
VLeft e -> do
|
||||
runLogger
|
||||
(logError $ T.pack $ prettyShow e)
|
||||
(logError $ T.pack $ prettyHFError e)
|
||||
exitWith (ExitFailure 30)
|
||||
pure s'
|
||||
|
||||
@@ -311,6 +311,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
||||
Prefetch pfCom -> prefetch pfCom runAppState runLogger
|
||||
GC gcOpts -> gc gcOpts runAppState runLogger
|
||||
Run runCommand -> run runCommand appState leanAppstate runLogger
|
||||
PrintAppErrors -> putStrLn allHFError >> pure ExitSuccess
|
||||
|
||||
case res of
|
||||
ExitSuccess -> pure ()
|
||||
|
||||
Reference in New Issue
Block a user