{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
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 qualified Data.Text as T
import GHC.Types.SrcLoc
import Ormolu.Diff.Text (TextDiff, printTextDiff)
import Ormolu.Terminal
import System.Exit (ExitCode (..))
import System.IO
data OrmoluException
=
OrmoluParsingFailed SrcSpan String
|
OrmoluOutputParsingFailed SrcSpan String
|
OrmoluASTDiffers FilePath [SrcSpan]
|
OrmoluNonIdempotentOutput TextDiff
|
OrmoluUnrecognizedOpts (NonEmpty String)
|
OrmoluCabalFileParsingFailed FilePath
|
OrmoluMissingStdinInputFile
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
printOrmoluException ::
OrmoluException ->
Term ()
printOrmoluException :: OrmoluException -> Term ()
printOrmoluException = \case
OrmoluParsingFailed SrcSpan
s String
e -> do
Term () -> Term ()
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
Term () -> Term ()
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 String
path [SrcSpan]
ss -> do
String -> Term ()
putS String
path
Term ()
newline
Text -> Term ()
put Text
" AST of input and AST of formatted code differ."
Term ()
newline
[SrcSpan] -> (SrcSpan -> Term ()) -> Term ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [SrcSpan]
ss ((SrcSpan -> Term ()) -> Term ())
-> (SrcSpan -> Term ()) -> Term ()
forall a b. (a -> b) -> a -> b
$ \SrcSpan
s -> do
Text -> Term ()
put Text
" at "
SrcSpan -> Term ()
putSrcSpan SrcSpan
s
Term ()
newline
Text -> Term ()
put Text
" Please, consider reporting the bug."
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 (String -> Term ())
-> (NonEmpty String -> String) -> NonEmpty String -> Term ()
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
Term ()
newline
OrmoluCabalFileParsingFailed String
cabalFile -> do
Text -> Term ()
put Text
"Parsing this .cabal file failed:"
Term ()
newline
Text -> Term ()
put (Text -> Term ()) -> Text -> Term ()
forall a b. (a -> b) -> a -> b
$ Text
" " Text -> Text -> 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
withPrettyOrmoluExceptions ::
ColorMode ->
IO ExitCode ->
IO ExitCode
withPrettyOrmoluExceptions :: ColorMode -> IO ExitCode -> IO ExitCode
withPrettyOrmoluExceptions ColorMode
colorMode IO ExitCode
m = IO ExitCode
m IO ExitCode -> (OrmoluException -> IO ExitCode) -> IO ExitCode
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 ()
forall a. Term a -> ColorMode -> Handle -> IO a
runTerm (OrmoluException -> Term ()
printOrmoluException OrmoluException
e) ColorMode
colorMode Handle
stderr
ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> IO ExitCode)
-> (Int -> ExitCode) -> Int -> IO ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ExitCode
ExitFailure (Int -> IO ExitCode) -> Int -> IO ExitCode
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