Exception.hs

{-# 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.Comments.Invariants (InvariantViolation, renderInvariantViolation)
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
  | -- | The comments that came out do not correspond to the comments that
    -- went in
    OrmoluCommentInvariantsViolated FilePath [InvariantViolation]
  | -- | 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 (Show)

instance Exception OrmoluException where
  displayException = T.unpack . runTermPure . printOrmoluException

-- | Print an 'OrmoluException'.
printOrmoluException ::
  OrmoluException ->
  Term
printOrmoluException = \case
  OrmoluParsingFailed s e -> Term.do
    bold (putOutputable s)
    newline
    put "  The GHC parser (in Haddock mode) failed:"
    newline
    put "  "
    put (T.pack e)
    newline
  OrmoluOutputParsingFailed s e -> Term.do
    bold (putOutputable s)
    newline
    put "  Parsing of formatted code failed:"
    newline
    put "  "
    put (T.pack e)
    newline
  OrmoluASTDiffers diff ss -> Term.do
    printTextDiff diff
    newline
    put "  AST of input and AST of formatted code differ."
    newline
    for_ ss $ \s -> Term.do
      put "    at "
      putOutputable s
      newline
    put "  Please, consider reporting the bug."
    newline
    put "  To format anyway, use --unsafe."
    newline
  OrmoluNonIdempotentOutput diff -> Term.do
    printTextDiff diff
    newline
    put "  Formatting is not idempotent."
    newline
    put "  Please, consider reporting the bug."
    newline
  OrmoluCommentInvariantsViolated path violations -> Term.do
    put (T.pack path)
    newline
    for_ violations $ \violation -> Term.do
      put "  "
      put (renderInvariantViolation violation)
      newline
    newline
    put "  The comments of the output do not correspond to the comments of"
    newline
    put "  the input."
    newline
    put "  Please, consider reporting the bug."
    newline
    put "  To format anyway, use --unsafe."
    newline
  OrmoluUnrecognizedOpts opts -> Term.do
    put "The following GHC options were not recognized:"
    newline
    put "  "
    (put . T.unwords . map T.pack . NE.toList) opts
    newline
  OrmoluCabalFileParsingFailed cabalFile parseErrors -> Term.do
    put "Parsing this .cabal file failed:"
    newline
    for_ parseErrors $ \e -> Term.do
      put . T.pack $ "  " <> showPError cabalFile e
      newline
  OrmoluMissingStdinInputFile -> Term.do
    put "The --stdin-input-file option is necessary when using input"
    newline
    put "from stdin and accounting for .cabal files."
    newline
  OrmoluFixityOverridesParseError errorBundle -> Term.do
    put . T.pack . errorBundlePretty $ errorBundle
    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 m = m `catch` h
  where
    h e = do
      runTerm (printOrmoluException e) colorMode stderr
      return . ExitFailure $
        case 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
          OrmoluCommentInvariantsViolated {} -> 11
          OrmoluUnrecognizedOpts {} -> 7
          OrmoluCabalFileParsingFailed {} -> 8
          OrmoluMissingStdinInputFile {} -> 9
          OrmoluFixityOverridesParseError {} -> 10