{-# 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
=
OrmoluCppEnabled FilePath
|
OrmoluParsingFailed GHC.SrcSpan String
|
OrmoluOutputParsingFailed GHC.SrcSpan String
|
OrmoluASTDiffers FilePath [GHC.SrcSpan]
|
OrmoluNonIdempotentOutput GHC.RealSrcLoc Text Text
|
OrmoluUnrecognizedOpts (NonEmpty String)
deriving (Eq, Show)
instance Exception OrmoluException where
displayException = \case
OrmoluCppEnabled path ->
unlines
[ "CPP is not supported:",
withIndent path
]
OrmoluParsingFailed s e ->
showParsingErr "Parsing of source code failed:" s [e]
OrmoluOutputParsingFailed s e ->
showParsingErr "Parsing of formatted code failed:" s [e]
++ "Please, consider reporting the bug.\n"
OrmoluASTDiffers path ss ->
unlines $
[ "AST of input and AST of formatted code differ."
]
++ fmap
withIndent
( case fmap (\s -> "at " ++ showOutputable s) ss of
[] -> ["in " ++ path]
xs -> xs
)
++ ["Please, consider reporting the bug."]
OrmoluNonIdempotentOutput loc left right ->
showParsingErr
"Formatting is not idempotent:"
loc
["before: " ++ show left, "after: " ++ show right]
++ "Please, consider reporting the bug.\n"
OrmoluUnrecognizedOpts opts ->
unlines
[ "The following GHC options were not recognized:",
(withIndent . unwords . NE.toList) opts
]
withPrettyOrmoluExceptions ::
IO a ->
IO a
withPrettyOrmoluExceptions m = m `catch` h
where
h :: OrmoluException -> IO a
h e = do
hPutStrLn stderr (displayException e)
exitWith . ExitFailure $
case e of
OrmoluCppEnabled {} -> 2
OrmoluParsingFailed {} -> 3
OrmoluOutputParsingFailed {} -> 4
OrmoluASTDiffers {} -> 5
OrmoluNonIdempotentOutput {} -> 6
OrmoluUnrecognizedOpts {} -> 7
showParsingErr :: GHC.Outputable a => String -> a -> [String] -> String
showParsingErr msg spn err =
unlines $
[ msg,
withIndent (showOutputable spn)
]
++ map withIndent err
withIndent :: String -> String
withIndent txt = " " ++ txt