    {-# LANGUAGE CPP, ScopedTypeVariables, LambdaCase #-}

    -- | Defines a simple exception type and utilities to throw it. The
    -- 'PlainGhcException' type is a subset of the 'GHC.Utils.Panic.GhcException'
    -- type.  It omits the exception constructors that involve
    -- pretty-printing via 'GHC.Utils.Outputable.SDoc'.
    --
    -- There are two reasons for this:
    --
    -- 1. To avoid import cycles / use of boot files. "GHC.Utils.Outputable" has
    -- many transitive dependencies. To throw exceptions from these
    -- modules, the functions here can be used without introducing import
    -- cycles.
    --
    -- 2. To reduce the number of modules that need to be compiled to
    -- object code when loading GHC into GHCi. See #13101
    module GHC.Utils.Panic.Plain
      ( PlainGhcException(..)
      , showPlainGhcException

      , panic, sorry, pgmError
      , cmdLineError, cmdLineErrorIO
      , assertPanic

      , progName
      ) where

    #include "HsVersions.h"

    import GHC.Settings.Config
    import GHC.Utils.Exception as Exception
    import GHC.Stack
    import GHC.Prelude
    import System.Environment
    import System.IO.Unsafe

    -- | This type is very similar to 'GHC.Utils.Panic.GhcException', but it omits
    -- the constructors that involve pretty-printing via
    -- 'GHC.Utils.Outputable.SDoc'.  Due to the implementation of 'fromException'
    -- for 'GHC.Utils.Panic.GhcException', this type can be caught as a
    -- 'GHC.Utils.Panic.GhcException'.
    --
    -- Note that this should only be used for throwing exceptions, not for
    -- catching, as 'GHC.Utils.Panic.GhcException' will not be converted to this
    -- type when catching.
    data PlainGhcException
      -- | Some other fatal signal (SIGHUP,SIGTERM)
      = PlainSignal Int

      -- | Prints the short usage msg after the error
      | PlainUsageError        String

      -- | A problem with the command line arguments, but don't print usage.
      | PlainCmdLineError      String

      -- | The 'impossible' happened.
      | PlainPanic             String

      -- | The user tickled something that's known not to work yet,
      --   but we're not counting it as a bug.
      | PlainSorry             String

      -- | An installation problem.
      | PlainInstallationError String

      -- | An error in the user's code, probably.
      | PlainProgramError      String

    instance Exception PlainGhcException

    instance Show PlainGhcException where
      showsPrec :: Int -> PlainGhcException -> ShowS
    showsPrec Int
    _ e :: PlainGhcException
    e@(PlainProgramError String
    _) = PlainGhcException -> ShowS
    showPlainGhcException PlainGhcException
    e
      showsPrec Int
    _ e :: PlainGhcException
    e@(PlainCmdLineError String
    _) = String -> ShowS
    showString String
    "<command line>: " forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PlainGhcException -> ShowS
    showPlainGhcException PlainGhcException
    e
      showsPrec Int
    _ PlainGhcException
    e = String -> ShowS
    showString String
    progName forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    ": " forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PlainGhcException -> ShowS
    showPlainGhcException PlainGhcException
    e

    -- | The name of this GHC.
    progName :: String
    progName :: String
    progName = forall a. IO a -> a
    unsafePerformIO (IO String
    getProgName)
    {-# NOINLINE progName #-}

    -- | Short usage information to display when we are given the wrong cmd line arguments.
    short_usage :: String
    short_usage :: String
    short_usage = String
    "Usage: For basic information, try the `--help' option."

    -- | Append a description of the given exception to this string.
    showPlainGhcException :: PlainGhcException -> ShowS
    showPlainGhcException :: PlainGhcException -> ShowS
    showPlainGhcException =
      \case
        PlainSignal Int
    n -> String -> ShowS
    showString String
    "signal: " forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall a. Show a => a -> ShowS
    shows Int
    n
        PlainUsageError String
    str -> String -> ShowS
    showString String
    str forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    showChar Char
    '\n' forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    short_usage
        PlainCmdLineError String
    str -> String -> ShowS
    showString String
    str
        PlainPanic String
    s -> ShowS -> ShowS
    panicMsg (String -> ShowS
    showString String
    s)
        PlainSorry String
    s -> ShowS -> ShowS
    sorryMsg (String -> ShowS
    showString String
    s)
        PlainInstallationError String
    str -> String -> ShowS
    showString String
    str
        PlainProgramError String
    str -> String -> ShowS
    showString String
    str
      where
        sorryMsg :: ShowS -> ShowS
        sorryMsg :: ShowS -> ShowS
    sorryMsg ShowS
    s =
            String -> ShowS
    showString String
    "sorry! (unimplemented feature or known bug)\n"
          forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString (String
    "  (GHC version " forall a. [a] -> [a] -> [a]
    ++ String
    cProjectVersion forall a. [a] -> [a] -> [a]
    ++ String
    ":\n\t")
          forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    s forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "\n"

        panicMsg :: ShowS -> ShowS
        panicMsg :: ShowS -> ShowS
    panicMsg ShowS
    s =
            String -> ShowS
    showString String
    "panic! (the 'impossible' happened)\n"
          forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString (String
    "  (GHC version " forall a. [a] -> [a] -> [a]
    ++ String
    cProjectVersion forall a. [a] -> [a] -> [a]
    ++ String
    ":\n\t")
          forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    s forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "\n\n"
          forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "Please report this as a GHC bug:  https://www.haskell.org/ghc/reportabug\n"

    throwPlainGhcException :: PlainGhcException -> a
    throwPlainGhcException :: forall a. PlainGhcException -> a
    throwPlainGhcException = forall a e. Exception e => e -> a
    Exception.throw

    -- | Panics and asserts.
    panic, sorry, pgmError :: String -> a
    panic :: forall a. String -> a
    panic    String
    x = forall a. IO a -> a
    unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
    $ do
       [String]
    stack <- Ptr CostCentreStack -> IO [String]
    ccsToStrings forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< forall dummy. dummy -> IO (Ptr CostCentreStack)
    getCurrentCCS String
    x
       if forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    stack
          then forall a. PlainGhcException -> a
    throwPlainGhcException (String -> PlainGhcException
    PlainPanic String
    x)
          else forall a. PlainGhcException -> a
    throwPlainGhcException (String -> PlainGhcException
    PlainPanic (String
    x forall a. [a] -> [a] -> [a]
    ++ Char
    '\n' forall a. a -> [a] -> [a]
    : [String] -> String
    renderStack [String]
    stack))

    sorry :: forall a. String -> a
    sorry    String
    x = forall a. PlainGhcException -> a
    throwPlainGhcException (String -> PlainGhcException
    PlainSorry String
    x)
    pgmError :: forall a. String -> a
    pgmError String
    x = forall a. PlainGhcException -> a
    throwPlainGhcException (String -> PlainGhcException
    PlainProgramError String
    x)

    cmdLineError :: String -> a
    cmdLineError :: forall a. String -> a
    cmdLineError = forall a. IO a -> a
    unsafeDupablePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall a. String -> IO a
    cmdLineErrorIO

    cmdLineErrorIO :: String -> IO a
    cmdLineErrorIO :: forall a. String -> IO a
    cmdLineErrorIO String
    x = do
      [String]
    stack <- Ptr CostCentreStack -> IO [String]
    ccsToStrings forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< forall dummy. dummy -> IO (Ptr CostCentreStack)
    getCurrentCCS String
    x
      if forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    stack
        then forall a. PlainGhcException -> a
    throwPlainGhcException (String -> PlainGhcException
    PlainCmdLineError String
    x)
        else forall a. PlainGhcException -> a
    throwPlainGhcException (String -> PlainGhcException
    PlainCmdLineError (String
    x forall a. [a] -> [a] -> [a]
    ++ Char
    '\n' forall a. a -> [a] -> [a]
    : [String] -> String
    renderStack [String]
    stack))

    -- | Throw a failed assertion exception for a given filename and line number.
    assertPanic :: String -> Int -> a
    assertPanic :: forall a. String -> Int -> a
    assertPanic String
    file Int
    line =
      forall a e. Exception e => e -> a
    Exception.throw (String -> AssertionFailed
    Exception.AssertionFailed
               (String
    "ASSERT failed! file " forall a. [a] -> [a] -> [a]
    ++ String
    file forall a. [a] -> [a] -> [a]
    ++ String
    ", line " forall a. [a] -> [a] -> [a]
    ++ forall a. Show a => a -> String
    show Int
    line))