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

-- | 'OrmoluException' type and surrounding definitions.
module Ormolu.Exception
  ( OrmoluException (..),
    withPrettyOrmoluExceptions,
  )
where

import Control.Exception
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import qualified GHC
import Ormolu.Diff.Text (TextDiff, printTextDiff)
import Ormolu.Utils (showOutputable)
import qualified Outputable as GHC
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 GHC.SrcSpan String
  | -- | Parsing of formatted source code failed
    OrmoluOutputParsingFailed GHC.SrcSpan String
  | -- | Original and resulting ASTs differ
    OrmoluASTDiffers FilePath [GHC.SrcSpan]
  | -- | Formatted source code is not idempotent
    OrmoluNonIdempotentOutput TextDiff
  | -- | Some GHC options were not recognized
    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

-- |
printOrmoluException :: Handle -> OrmoluException -> IO ()
printOrmoluException :: Handle -> OrmoluException -> IO ()
printOrmoluException Handle
h = \case
  OrmoluParsingFailed SrcSpan
s String
e ->
    Handle -> String -> IO ()
hPutStrLn Handle
h (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
      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 ->
    Handle -> String -> IO ()
hPutStrLn Handle
h (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
      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 ->
    Handle -> String -> IO ()
hPutStrLn Handle
h (String -> IO ()) -> ([String] -> String) -> [String] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> IO ()) -> [String] -> IO ()
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 TextDiff
diff -> do
    Handle -> String -> IO ()
hPutStrLn Handle
h String
"Formatting is not idempotent:\n"
    Handle -> TextDiff -> IO ()
printTextDiff Handle
h TextDiff
diff
    Handle -> String -> IO ()
hPutStrLn Handle
h String
"\nPlease, consider reporting the bug.\n"
  OrmoluUnrecognizedOpts NonEmpty String
opts ->
    Handle -> String -> IO ()
hPutStrLn Handle
h (String -> IO ()) -> ([String] -> String) -> [String] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$
      [ 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
      ]

-- | Inside this wrapper 'OrmoluException' will be caught and displayed
-- nicely.
withPrettyOrmoluExceptions ::
  -- | Action that may throw an exception
  IO ExitCode ->
  IO ExitCode
withPrettyOrmoluExceptions :: IO ExitCode -> IO ExitCode
withPrettyOrmoluExceptions 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
      Handle -> OrmoluException -> IO ()
printOrmoluException Handle
stderr OrmoluException
e
      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

----------------------------------------------------------------------------
-- Helpers

-- | Show a parse error.
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

-- | Indent with 2 spaces for readability.
withIndent :: String -> String
withIndent :: ShowS
withIndent String
txt = String
"  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
txt