{-# LANGUAGE LambdaCase #-}
module Ormolu.Exception
( OrmoluException (..),
withPrettyOrmoluExceptions,
)
where
import Control.Exception
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Text (Text)
import qualified GHC
import Ormolu.Utils (showOutputable)
import qualified Outputable as GHC
import System.Exit (ExitCode (..), exitWith)
import System.IO
data OrmoluException
=
OrmoluParsingFailed GHC.SrcSpan String
|
OrmoluOutputParsingFailed GHC.SrcSpan String
|
OrmoluASTDiffers FilePath [GHC.SrcSpan]
|
OrmoluNonIdempotentOutput GHC.RealSrcLoc Text Text
|
OrmoluUnrecognizedOpts (NonEmpty String)
deriving (OrmoluException -> OrmoluException -> Bool
(OrmoluException -> OrmoluException -> Bool)
-> (OrmoluException -> OrmoluException -> Bool)
-> Eq OrmoluException
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
(Int -> OrmoluException -> ShowS)
-> (OrmoluException -> String)
-> ([OrmoluException] -> ShowS)
-> Show OrmoluException
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 = \case
OrmoluParsingFailed SrcSpan
s String
e ->
String -> SrcSpan -> [String] -> String
forall a. Outputable a => String -> a -> [String] -> String
showParsingErr String
"The GHC parser (in Haddock mode) failed:" SrcSpan
s [String
e]
OrmoluOutputParsingFailed SrcSpan
s String
e ->
String -> SrcSpan -> [String] -> String
forall a. Outputable a => String -> a -> [String] -> String
showParsingErr String
"Parsing of formatted code failed:" SrcSpan
s [String
e]
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Please, consider reporting the bug.\n"
OrmoluASTDiffers String
path [SrcSpan]
ss ->
[String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
[ String
"AST of input and AST of formatted code differ."
]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ShowS -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
ShowS
withIndent
( case (SrcSpan -> String) -> [SrcSpan] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SrcSpan
s -> String
"at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SrcSpan -> String
forall o. Outputable o => o -> String
showOutputable SrcSpan
s) [SrcSpan]
ss of
[] -> [String
"in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path]
[String]
xs -> [String]
xs
)
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"Please, consider reporting the bug."]
OrmoluNonIdempotentOutput RealSrcLoc
loc Text
left Text
right ->
String -> RealSrcLoc -> [String] -> String
forall a. Outputable a => String -> a -> [String] -> String
showParsingErr
String
"Formatting is not idempotent:"
RealSrcLoc
loc
[String
"before: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
left, String
"after: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
right]
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Please, consider reporting the bug.\n"
OrmoluUnrecognizedOpts NonEmpty String
opts ->
[String] -> String
unlines
[ String
"The following GHC options were not recognized:",
(ShowS
withIndent ShowS -> (NonEmpty String -> String) -> NonEmpty String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> String)
-> (NonEmpty String -> [String]) -> NonEmpty String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NE.toList) NonEmpty String
opts
]
withPrettyOrmoluExceptions ::
IO a ->
IO a
withPrettyOrmoluExceptions :: IO a -> IO a
withPrettyOrmoluExceptions IO a
m = IO a
m IO a -> (OrmoluException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` OrmoluException -> IO a
forall a. OrmoluException -> IO a
h
where
h :: OrmoluException -> IO a
h :: OrmoluException -> IO a
h OrmoluException
e = do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (OrmoluException -> String
forall e. Exception e => e -> String
displayException OrmoluException
e)
ExitCode -> IO a
forall a. ExitCode -> IO a
exitWith (ExitCode -> IO a) -> (Int -> ExitCode) -> Int -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ExitCode
ExitFailure (Int -> IO a) -> Int -> IO a
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
showParsingErr :: GHC.Outputable a => String -> a -> [String] -> String
showParsingErr :: String -> a -> [String] -> String
showParsingErr String
msg a
spn [String]
err =
[String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
[ String
msg,
ShowS
withIndent (a -> String
forall o. Outputable o => o -> String
showOutputable a
spn)
]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
withIndent [String]
err
withIndent :: String -> String
withIndent :: ShowS
withIndent String
txt = String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
txt