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.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 (Show)

instance Exception OrmoluException

-- | 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
  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
          OrmoluUnrecognizedOpts {} -> 7
          OrmoluCabalFileParsingFailed {} -> 8
          OrmoluMissingStdinInputFile {} -> 9
          OrmoluFixityOverridesParseError {} -> 10