    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE QualifiedDo #-}

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

    import Control.Exception
    import Data.Foldable (for_)
    import Data.List.NonEmpty (NonEmpty (..))
    import Data.List.NonEmpty qualified as NE
    import Data.Text (Text)
    import Data.Text qualified as T
    import Data.Void (Void)
    import Distribution.Parsec.Error (PError, showPError)
    import GHC.Types.SrcLoc
    import Ormolu.Diff.Text (TextDiff, printTextDiff)
    import Ormolu.Terminal
    import Ormolu.Terminal.QualifiedDo qualified as Term
    import System.Exit (ExitCode (..))
    import System.IO
    import Text.Megaparsec (ParseErrorBundle, errorBundlePretty)

    -- | 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 TextDiff [RealSrcSpan]
      | -- | Formatted source code is not idempotent
        OrmoluNonIdempotentOutput TextDiff
      | -- | Some GHC options were not recognized
        OrmoluUnrecognizedOpts (NonEmpty String)
      | -- | Cabal file parsing failed
        OrmoluCabalFileParsingFailed FilePath (NonEmpty PError)
      | -- | Missing input file path when using stdin input and
        -- accounting for .cabal files
        OrmoluMissingStdinInputFile
      | -- | A parse error in a fixity overrides file
        OrmoluFixityOverridesParseError (ParseErrorBundle Text Void)
      deriving (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
    $cshowsPrec :: Int -> OrmoluException -> ShowS
    showsPrec :: Int -> OrmoluException -> ShowS
    $cshow :: OrmoluException -> String
    show :: OrmoluException -> String
    $cshowList :: [OrmoluException] -> ShowS
    showList :: [OrmoluException] -> ShowS
    Show)

    instance Exception OrmoluException where
      displayException :: OrmoluException -> String
    displayException = Text -> String
    T.unpack (Text -> String)
    -> (OrmoluException -> Text) -> OrmoluException -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Term -> Text
    runTermPure (Term -> Text)
    -> (OrmoluException -> Term) -> OrmoluException -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . OrmoluException -> Term
    printOrmoluException

    -- | Print an 'OrmoluException'.
    printOrmoluException ::
      OrmoluException ->
      Term
    printOrmoluException :: OrmoluException -> Term
    printOrmoluException = \case
      OrmoluParsingFailed SrcSpan
    s String
    e -> Term.do
        Term -> Term
    bold (SrcSpan -> Term
    forall a. Outputable a => a -> Term
    putOutputable 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 -> Term.do
        Term -> Term
    bold (SrcSpan -> Term
    forall a. Outputable a => a -> Term
    putOutputable SrcSpan
    s)
        Term
    newline
        Text -> Term
    put Text
    "  Parsing of formatted code failed:"
        Term
    newline
        Text -> Term
    put Text
    "  "
        Text -> Term
    put (String -> Text
    T.pack String
    e)
        Term
    newline
      OrmoluASTDiffers TextDiff
    diff [RealSrcSpan]
    ss -> Term.do
        TextDiff -> Term
    printTextDiff TextDiff
    diff
        Term
    newline
        Text -> Term
    put Text
    "  AST of input and AST of formatted code differ."
        Term
    newline
        [RealSrcSpan] -> (RealSrcSpan -> Term) -> Term
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    t a -> (a -> f b) -> f ()
    for_ [RealSrcSpan]
    ss ((RealSrcSpan -> Term) -> Term) -> (RealSrcSpan -> Term) -> Term
    forall a b. (a -> b) -> a -> b
    $ \RealSrcSpan
    s -> Term.do
          Text -> Term
    put Text
    "    at "
          RealSrcSpan -> Term
    forall a. Outputable a => a -> Term
    putOutputable RealSrcSpan
    s
          Term
    newline
        Text -> Term
    put Text
    "  Please, consider reporting the bug."
        Term
    newline
        Text -> Term
    put Text
    "  To format anyway, use --unsafe."
        Term
    newline
      OrmoluNonIdempotentOutput TextDiff
    diff -> Term.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 -> Term.do
        Text -> Term
    put Text
    "The following GHC options were not recognized:"
        Term
    newline
        Text -> Term
    put Text
    "  "
        (Text -> Term
    put (Text -> Term)
    -> (NonEmpty String -> Text) -> NonEmpty String -> Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Text] -> Text
    T.unwords ([Text] -> Text)
    -> (NonEmpty String -> [Text]) -> NonEmpty String -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Text) -> [String] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Text
    T.pack ([String] -> [Text])
    -> (NonEmpty String -> [String]) -> NonEmpty String -> [Text]
    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 NonEmpty PError
    parseErrors -> Term.do
        Text -> Term
    put Text
    "Parsing this .cabal file failed:"
        Term
    newline
        NonEmpty PError -> (PError -> Term) -> Term
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    t a -> (a -> f b) -> f ()
    for_ NonEmpty PError
    parseErrors ((PError -> Term) -> Term) -> (PError -> Term) -> Term
    forall a b. (a -> b) -> a -> b
    $ \PError
    e -> Term.do
          Text -> Term
    put (Text -> Term) -> (String -> Text) -> String -> Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    T.pack (String -> Term) -> String -> Term
    forall a b. (a -> b) -> a -> b
    $ String
    "  " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String -> PError -> String
    showPError String
    cabalFile PError
    e
          Term
    newline
      OrmoluException
    OrmoluMissingStdinInputFile -> Term.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
      OrmoluFixityOverridesParseError ParseErrorBundle Text Void
    errorBundle -> Term.do
        Text -> Term
    put (Text -> Term)
    -> (ParseErrorBundle Text Void -> Text)
    -> ParseErrorBundle Text Void
    -> Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    T.pack (String -> Text)
    -> (ParseErrorBundle Text Void -> String)
    -> ParseErrorBundle Text Void
    -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParseErrorBundle Text Void -> String
    forall s e.
    (VisualStream s, TraversableStream s, ShowErrorComponent e) =>
    ParseErrorBundle s e -> String
    errorBundlePretty (ParseErrorBundle Text Void -> Term)
    -> ParseErrorBundle Text Void -> Term
    forall a b. (a -> b) -> a -> b
    $ ParseErrorBundle Text Void
    errorBundle
        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 ()
    runTerm (OrmoluException -> Term
    printOrmoluException OrmoluException
    e) ColorMode
    colorMode Handle
    stderr
          ExitCode -> IO ExitCode
    forall a. a -> IO a
    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
              OrmoluFixityOverridesParseError {} -> Int
    10