{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}

-- | 'OrmoluException' type and surrounding definitions.
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

-- | Ormolu exception representing all cases when Ormolu can fail.
data OrmoluException
  = -- | Parsing of original source code failed
    OrmoluParsingFailed SrcSpan String
  | -- | Parsing of formatted source code failed
    OrmoluOutputParsingFailed SrcSpan String
  | -- | Original and resulting ASTs differ
    OrmoluASTDiffers FilePath [SrcSpan]
  | -- | Formatted source code is not idempotent
    OrmoluNonIdempotentOutput TextDiff
  | -- | Some GHC options were not recognized
    OrmoluUnrecognizedOpts (NonEmpty String)
  | -- | Cabal file parsing failed
    OrmoluCabalFileParsingFailed FilePath
  | -- | Missing input file path when using stdin input and
    -- accounting for .cabal files
    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

-- | Print an '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

-- | Inside this wrapper 'OrmoluException' will be caught and displayed
-- nicely.
withPrettyOrmoluExceptions ::
  -- | Color mode
  ColorMode ->
  -- | Action that may throw an exception
  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
          -- Error code 1 is for 'error' or 'notImplemented'
          -- 2 used to be for erroring out on CPP
          OrmoluParsingFailed {} -> Int
3
          OrmoluOutputParsingFailed {} -> Int
4
          OrmoluASTDiffers {} -> Int
5
          OrmoluNonIdempotentOutput {} -> Int
6
          OrmoluUnrecognizedOpts {} -> Int
7
          OrmoluCabalFileParsingFailed {} -> Int
8
          OrmoluMissingStdinInputFile {} -> Int
9