    {-# 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
      = -- | 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
        OrmoluParsingFailed s :: SrcSpan
    s e :: String
    e ->
          String -> SrcSpan -> [String] -> String
    forall a. Outputable a => String -> a -> [String] -> String
    showParsingErr "The GHC parser (in Haddock mode) 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'
              -- 2 used to be for erroring out on CPP
              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