{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Ormolu.Exception
( OrmoluException (..),
withPrettyOrmoluExceptions,
)
where
import Control.Exception
import Control.Monad (forM_)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Text (Text)
import qualified Data.Text as T
import Data.Void (Void)
import GHC.Types.SrcLoc
import Ormolu.Diff.Text (TextDiff, printTextDiff)
import Ormolu.Terminal
import System.Exit (ExitCode (..))
import System.IO
import Text.Megaparsec (ParseErrorBundle, errorBundlePretty)
data OrmoluException
=
OrmoluParsingFailed SrcSpan String
|
OrmoluOutputParsingFailed SrcSpan String
|
OrmoluASTDiffers TextDiff [RealSrcSpan]
|
OrmoluNonIdempotentOutput TextDiff
|
OrmoluUnrecognizedOpts (NonEmpty String)
|
OrmoluCabalFileParsingFailed FilePath
|
OrmoluMissingStdinInputFile
|
OrmoluFixityOverridesParseError (ParseErrorBundle Text Void)
deriving (OrmoluException -> OrmoluException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrmoluException -> OrmoluException -> Bool
$c/= :: OrmoluException -> OrmoluException -> Bool
== :: OrmoluException -> OrmoluException -> Bool
$c== :: OrmoluException -> OrmoluException -> Bool
Eq, Int -> OrmoluException -> ShowS
[OrmoluException] -> ShowS
OrmoluException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrmoluException] -> ShowS
$cshowList :: [OrmoluException] -> ShowS
show :: OrmoluException -> String
$cshow :: OrmoluException -> String
showsPrec :: Int -> OrmoluException -> ShowS
$cshowsPrec :: Int -> OrmoluException -> ShowS
Show)
instance Exception OrmoluException
printOrmoluException ::
OrmoluException ->
Term ()
printOrmoluException :: OrmoluException -> Term ()
printOrmoluException = \case
OrmoluParsingFailed SrcSpan
s String
e -> do
forall a. Term a -> Term a
bold (SrcSpan -> Term ()
putSrcSpan SrcSpan
s)
Term ()
newline
Text -> Term ()
put Text
" The GHC parser (in Haddock mode) failed:"
Term ()
newline
Text -> Term ()
put Text
" "
Text -> Term ()
put (String -> Text
T.pack String
e)
Term ()
newline
OrmoluOutputParsingFailed SrcSpan
s String
e -> do
forall a. Term a -> Term a
bold (SrcSpan -> Term ()
putSrcSpan SrcSpan
s)
Term ()
newline
Text -> Term ()
put Text
" Parsing of formatted code failed:"
Text -> Term ()
put Text
" "
Text -> Term ()
put (String -> Text
T.pack String
e)
Term ()
newline
OrmoluASTDiffers TextDiff
diff [RealSrcSpan]
ss -> do
TextDiff -> Term ()
printTextDiff TextDiff
diff
Term ()
newline
Text -> Term ()
put Text
" AST of input and AST of formatted code differ."
Term ()
newline
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [RealSrcSpan]
ss forall a b. (a -> b) -> a -> b
$ \RealSrcSpan
s -> do
Text -> Term ()
put Text
" at "
RealSrcSpan -> Term ()
putRealSrcSpan RealSrcSpan
s
Term ()
newline
Text -> Term ()
put Text
" Please, consider reporting the bug."
Term ()
newline
Text -> Term ()
put Text
" To format anyway, use --unsafe."
Term ()
newline
OrmoluNonIdempotentOutput TextDiff
diff -> do
TextDiff -> Term ()
printTextDiff TextDiff
diff
Term ()
newline
Text -> Term ()
put Text
" Formatting is not idempotent."
Term ()
newline
Text -> Term ()
put Text
" Please, consider reporting the bug."
Term ()
newline
OrmoluUnrecognizedOpts NonEmpty String
opts -> do
Text -> Term ()
put Text
"The following GHC options were not recognized:"
Term ()
newline
Text -> Term ()
put Text
" "
(String -> Term ()
putS forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList) NonEmpty String
opts
Term ()
newline
OrmoluCabalFileParsingFailed String
cabalFile -> do
Text -> Term ()
put Text
"Parsing this .cabal file failed:"
Term ()
newline
Text -> Term ()
put forall a b. (a -> b) -> a -> b
$ Text
" " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
cabalFile
Term ()
newline
OrmoluException
OrmoluMissingStdinInputFile -> do
Text -> Term ()
put Text
"The --stdin-input-file option is necessary when using input"
Term ()
newline
Text -> Term ()
put Text
"from stdin and accounting for .cabal files"
Term ()
newline
OrmoluFixityOverridesParseError ParseErrorBundle Text Void
errorBundle -> do
String -> Term ()
putS (forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle Text Void
errorBundle)
Term ()
newline
withPrettyOrmoluExceptions ::
ColorMode ->
IO ExitCode ->
IO ExitCode
withPrettyOrmoluExceptions :: ColorMode -> IO ExitCode -> IO ExitCode
withPrettyOrmoluExceptions ColorMode
colorMode IO ExitCode
m = IO ExitCode
m forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` OrmoluException -> IO ExitCode
h
where
h :: OrmoluException -> IO ExitCode
h OrmoluException
e = do
forall a. Term a -> ColorMode -> Handle -> IO a
runTerm (OrmoluException -> Term ()
printOrmoluException OrmoluException
e) ColorMode
colorMode Handle
stderr
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ExitCode
ExitFailure forall a b. (a -> b) -> a -> b
$
case OrmoluException
e of
OrmoluParsingFailed {} -> Int
3
OrmoluOutputParsingFailed {} -> Int
4
OrmoluASTDiffers {} -> Int
5
OrmoluNonIdempotentOutput {} -> Int
6
OrmoluUnrecognizedOpts {} -> Int
7
OrmoluCabalFileParsingFailed {} -> Int
8
OrmoluMissingStdinInputFile {} -> Int
9
OrmoluFixityOverridesParseError {} -> Int
10