{-# LANGUAGE LambdaCase #-}

-- | '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 Data.Text (Text)
import qualified GHC
import Ormolu.Utils (showOutputable)
import qualified Outputable as GHC
import System.Exit (ExitCode (..), exitWith)
import System.IO

-- | Ormolu exception representing all cases when Ormolu can fail.
data OrmoluException
  = -- | Ormolu does not work with source files that use CPP
    OrmoluCppEnabled FilePath
  | -- | 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 GHC.RealSrcLoc Text Text
  | -- | 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 where
  displayException :: OrmoluException -> String
displayException = \case
    OrmoluCppEnabled path :: String
path ->
      [String] -> String
unlines
        [ "CPP is not supported:",
          ShowS
withIndent String
path
        ]
    OrmoluParsingFailed s :: SrcSpan
s e :: String
e ->
      String -> SrcSpan -> [String] -> String
forall a. Outputable a => String -> a -> [String] -> String
showParsingErr "Parsing of source code failed:" SrcSpan
s [String
e]
    OrmoluOutputParsingFailed s :: SrcSpan
s e :: String
e ->
      String -> SrcSpan -> [String] -> String
forall a. Outputable a => String -> a -> [String] -> String
showParsingErr "Parsing of formatted code failed:" SrcSpan
s [String
e]
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ "Please, consider reporting the bug.\n"
    OrmoluASTDiffers path :: String
path ss :: [SrcSpan]
ss ->
      [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
        [ "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 (\s :: SrcSpan
s -> "at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SrcSpan -> String
forall o. Outputable o => o -> String
showOutputable SrcSpan
s) [SrcSpan]
ss of
                [] -> ["in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path]
                xs :: [String]
xs -> [String]
xs
            )
          [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ["Please, consider reporting the bug."]
    OrmoluNonIdempotentOutput loc :: RealSrcLoc
loc left :: Text
left right :: Text
right ->
      String -> RealSrcLoc -> [String] -> String
forall a. Outputable a => String -> a -> [String] -> String
showParsingErr
        "Formatting is not idempotent:"
        RealSrcLoc
loc
        ["before: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
left, "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]
++ "Please, consider reporting the bug.\n"
    OrmoluUnrecognizedOpts opts :: NonEmpty String
opts ->
      [String] -> String
unlines
        [ "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 using 'displayException'.
withPrettyOrmoluExceptions ::
  -- | Action that may throw the exception
  IO a ->
  IO a
withPrettyOrmoluExceptions :: IO a -> IO a
withPrettyOrmoluExceptions m :: 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 e :: 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
          -- Error code 1 is for `error` or `notImplemented`
          OrmoluCppEnabled {} -> 2
          OrmoluParsingFailed {} -> 3
          OrmoluOutputParsingFailed {} -> 4
          OrmoluASTDiffers {} -> 5
          OrmoluNonIdempotentOutput {} -> 6
          OrmoluUnrecognizedOpts {} -> 7

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

-- | Show a parse error.
showParsingErr :: GHC.Outputable a => String -> a -> [String] -> String
showParsingErr :: String -> a -> [String] -> String
showParsingErr msg :: String
msg spn :: a
spn err :: [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 txt :: String
txt = "  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
txt