{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QualifiedDo #-}
module Ormolu.Exception
( OrmoluException (..),
printOrmoluException,
withPrettyOrmoluExceptions,
)
where
import Control.Exception
import Data.Foldable (for_)
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NE
import Data.Text (Text)
import Data.Text qualified as T
import Data.Void (Void)
import Distribution.Parsec.Error (PError, showPError)
import GHC.Types.SrcLoc
import Ormolu.Diff.Text (TextDiff, printTextDiff)
import Ormolu.Terminal
import Ormolu.Terminal.QualifiedDo qualified as Term
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 (NonEmpty PError)
|
OrmoluMissingStdinInputFile
|
OrmoluFixityOverridesParseError (ParseErrorBundle Text Void)
deriving (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 where
displayException :: OrmoluException -> String
displayException = Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Text
runTermPure forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrmoluException -> Term
printOrmoluException
printOrmoluException ::
OrmoluException ->
Term
printOrmoluException :: OrmoluException -> Term
printOrmoluException = \case
OrmoluParsingFailed SrcSpan
s String
e -> Term.do
Term -> Term
bold (forall a. Outputable a => a -> Term
putOutputable 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 -> Term.do
Term -> Term
bold (forall a. Outputable a => a -> Term
putOutputable SrcSpan
s)
Term
newline
Text -> Term
put Text
" Parsing of formatted code failed:"
Term
newline
Text -> Term
put Text
" "
Text -> Term
put (String -> Text
T.pack String
e)
Term
newline
OrmoluASTDiffers TextDiff
diff [RealSrcSpan]
ss -> Term.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 :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [RealSrcSpan]
ss forall a b. (a -> b) -> a -> b
$ \RealSrcSpan
s -> Term.do
Text -> Term
put Text
" at "
forall a. Outputable a => a -> Term
putOutputable 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 -> Term.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 -> Term.do
Text -> Term
put Text
"The following GHC options were not recognized:"
Term
newline
Text -> Term
put Text
" "
(Text -> Term
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack 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 NonEmpty PError
parseErrors -> Term.do
Text -> Term
put Text
"Parsing this .cabal file failed:"
Term
newline
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ NonEmpty PError
parseErrors forall a b. (a -> b) -> a -> b
$ \PError
e -> Term.do
Text -> Term
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
" " forall a. Semigroup a => a -> a -> a
<> String -> PError -> String
showPError String
cabalFile PError
e
Term
newline
OrmoluException
OrmoluMissingStdinInputFile -> Term.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 -> Term.do
Text -> Term
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty forall a b. (a -> b) -> a -> b
$ 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
Term -> ColorMode -> Handle -> IO ()
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