{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables, LambdaCase #-}
module GHC.Utils.Panic
(
GhcException(..)
, showGhcException
, showGhcExceptionUnsafe
, throwGhcException
, throwGhcExceptionIO
, handleGhcException
, pgmError
, panic
, pprPanic
, sorry
, panicDoc
, sorryDoc
, pgmErrorDoc
, cmdLineError
, cmdLineErrorIO
, assertPanic
, assertPprPanic
, assertPpr
, assertPprMaybe
, assertPprM
, massertPpr
, callStackDoc
, prettyCallStackDoc
, Exception.Exception(..)
, showException
, safeShowException
, try
, tryMost
, throwTo
, withSignalHandlers
)
where
import GHC.Prelude.Basic
import GHC.Stack
import GHC.Utils.Outputable
import GHC.Utils.Panic.Plain
import GHC.Utils.Constants
import GHC.Utils.Exception as Exception
import Control.Monad.IO.Class
import qualified Control.Monad.Catch as MC
import Control.Concurrent
import Data.Typeable ( cast )
import System.IO.Unsafe
#if !defined(mingw32_HOST_OS)
import System.Posix.Signals as S
#endif
#if defined(mingw32_HOST_OS)
import GHC.ConsoleHandler as S
#endif
import System.Mem.Weak ( deRefWeak )
data GhcException
= Signal Int
| UsageError String
| CmdLineError String
| Panic String
| PprPanic String SDoc
| Sorry String
| PprSorry String SDoc
| InstallationError String
| ProgramError String
| PprProgramError String SDoc
instance Exception GhcException where
fromException :: SomeException -> Maybe GhcException
fromException (SomeException e
e)
| Just GhcException
ge <- e -> Maybe GhcException
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e = GhcException -> Maybe GhcException
forall a. a -> Maybe a
Just GhcException
ge
| Just PlainGhcException
pge <- e -> Maybe PlainGhcException
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e = GhcException -> Maybe GhcException
forall a. a -> Maybe a
Just (GhcException -> Maybe GhcException)
-> GhcException -> Maybe GhcException
forall a b. (a -> b) -> a -> b
$
case PlainGhcException
pge of
PlainSignal Int
n -> Int -> GhcException
Signal Int
n
PlainUsageError String
str -> String -> GhcException
UsageError String
str
PlainCmdLineError String
str -> String -> GhcException
CmdLineError String
str
PlainPanic String
str -> String -> GhcException
Panic String
str
PlainSorry String
str -> String -> GhcException
Sorry String
str
PlainInstallationError String
str -> String -> GhcException
InstallationError String
str
PlainProgramError String
str -> String -> GhcException
ProgramError String
str
| Bool
otherwise = Maybe GhcException
forall a. Maybe a
Nothing
instance Show GhcException where
showsPrec :: Int -> GhcException -> ShowS
showsPrec Int
_ GhcException
e = GhcException -> ShowS
showGhcExceptionUnsafe GhcException
e
showException :: Exception e => e -> String
showException :: forall e. Exception e => e -> String
showException = e -> String
forall a. Show a => a -> String
show
safeShowException :: Exception e => e -> IO String
safeShowException :: forall e. Exception e => e -> IO String
safeShowException e
e = do
Either SomeException String
r <- IO String -> IO (Either SomeException String)
forall e a. Exception e => IO a -> IO (Either e a)
try (String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$! ShowS
forall {a}. [a] -> [a]
forceList (e -> String
forall e. Exception e => e -> String
showException e
e))
case Either SomeException String
r of
Right String
msg -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
msg
Left SomeException
e' -> SomeException -> IO String
forall e. Exception e => e -> IO String
safeShowException (SomeException
e' :: SomeException)
where
forceList :: [a] -> [a]
forceList [] = []
forceList xs :: [a]
xs@(a
x : [a]
xt) = a
x a -> [a] -> [a]
forall a b. a -> b -> b
`seq` [a] -> [a]
forceList [a]
xt [a] -> [a] -> [a]
forall a b. a -> b -> b
`seq` [a]
xs
showGhcExceptionUnsafe :: GhcException -> ShowS
showGhcExceptionUnsafe :: GhcException -> ShowS
showGhcExceptionUnsafe = SDocContext -> GhcException -> ShowS
showGhcException SDocContext
defaultSDocContext
showGhcException :: SDocContext -> GhcException -> ShowS
showGhcException :: SDocContext -> GhcException -> ShowS
showGhcException SDocContext
ctx = PlainGhcException -> ShowS
showPlainGhcException (PlainGhcException -> ShowS)
-> (GhcException -> PlainGhcException) -> GhcException -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
Signal Int
n -> Int -> PlainGhcException
PlainSignal Int
n
UsageError String
str -> String -> PlainGhcException
PlainUsageError String
str
CmdLineError String
str -> String -> PlainGhcException
PlainCmdLineError String
str
Panic String
str -> String -> PlainGhcException
PlainPanic String
str
Sorry String
str -> String -> PlainGhcException
PlainSorry String
str
InstallationError String
str -> String -> PlainGhcException
PlainInstallationError String
str
ProgramError String
str -> String -> PlainGhcException
PlainProgramError String
str
PprPanic String
str SDoc
sdoc -> String -> PlainGhcException
PlainPanic (String -> PlainGhcException) -> String -> PlainGhcException
forall a b. (a -> b) -> a -> b
$
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
str, String
"\n\n", SDocContext -> SDoc -> String
renderWithContext SDocContext
ctx SDoc
sdoc]
PprSorry String
str SDoc
sdoc -> String -> PlainGhcException
PlainProgramError (String -> PlainGhcException) -> String -> PlainGhcException
forall a b. (a -> b) -> a -> b
$
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
str, String
"\n\n", SDocContext -> SDoc -> String
renderWithContext SDocContext
ctx SDoc
sdoc]
PprProgramError String
str SDoc
sdoc -> String -> PlainGhcException
PlainProgramError (String -> PlainGhcException) -> String -> PlainGhcException
forall a b. (a -> b) -> a -> b
$
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
str, String
"\n\n", SDocContext -> SDoc -> String
renderWithContext SDocContext
ctx SDoc
sdoc]
throwGhcException :: GhcException -> a
throwGhcException :: forall a. GhcException -> a
throwGhcException = GhcException -> a
forall a e. Exception e => e -> a
Exception.throw
throwGhcExceptionIO :: GhcException -> IO a
throwGhcExceptionIO :: forall a. GhcException -> IO a
throwGhcExceptionIO = GhcException -> IO a
forall e a. Exception e => e -> IO a
Exception.throwIO
handleGhcException :: ExceptionMonad m => (GhcException -> m a) -> m a -> m a
handleGhcException :: forall (m :: * -> *) a.
ExceptionMonad m =>
(GhcException -> m a) -> m a -> m a
handleGhcException = (GhcException -> m a) -> m a -> m a
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
MC.handle
pprPanic :: HasCallStack => String -> SDoc -> a
pprPanic :: forall a. HasCallStack => String -> SDoc -> a
pprPanic String
s SDoc
doc = String -> SDoc -> a
forall a. String -> SDoc -> a
panicDoc String
s (SDoc
doc SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc
HasCallStack => SDoc
callStackDoc)
panicDoc :: String -> SDoc -> a
panicDoc :: forall a. String -> SDoc -> a
panicDoc String
x SDoc
doc = GhcException -> a
forall a. GhcException -> a
throwGhcException (String -> SDoc -> GhcException
PprPanic String
x SDoc
doc)
sorryDoc :: String -> SDoc -> a
sorryDoc :: forall a. String -> SDoc -> a
sorryDoc String
x SDoc
doc = GhcException -> a
forall a. GhcException -> a
throwGhcException (String -> SDoc -> GhcException
PprSorry String
x SDoc
doc)
pgmErrorDoc :: String -> SDoc -> a
pgmErrorDoc :: forall a. String -> SDoc -> a
pgmErrorDoc String
x SDoc
doc = GhcException -> a
forall a. GhcException -> a
throwGhcException (String -> SDoc -> GhcException
PprProgramError String
x SDoc
doc)
tryMost :: IO a -> IO (Either SomeException a)
tryMost :: forall a. IO a -> IO (Either SomeException a)
tryMost IO a
action = do Either SomeException a
r <- IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
try IO a
action
case Either SomeException a
r of
Left SomeException
se ->
case SomeException -> Maybe GhcException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se of
Just (Signal Int
_) -> SomeException -> IO (Either SomeException a)
forall e a. Exception e => e -> IO a
throwIO SomeException
se
Just (Panic String
_) -> SomeException -> IO (Either SomeException a)
forall e a. Exception e => e -> IO a
throwIO SomeException
se
Just GhcException
_ -> Either SomeException a -> IO (Either SomeException a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Either SomeException a
forall a b. a -> Either a b
Left SomeException
se)
Maybe GhcException
Nothing ->
case SomeException -> Maybe IOException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se of
Just (IOException
_ :: IOException) ->
Either SomeException a -> IO (Either SomeException a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Either SomeException a
forall a b. a -> Either a b
Left SomeException
se)
Maybe IOException
Nothing -> SomeException -> IO (Either SomeException a)
forall e a. Exception e => e -> IO a
throwIO SomeException
se
Right a
v -> Either SomeException a -> IO (Either SomeException a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either SomeException a
forall a b. b -> Either a b
Right a
v)
{-# NOINLINE signalHandlersRefCount #-}
#if !defined(mingw32_HOST_OS)
signalHandlersRefCount :: MVar (Word, Maybe (S.Handler,S.Handler
,S.Handler,S.Handler))
#else
signalHandlersRefCount :: MVar (Word, Maybe S.Handler)
#endif
signalHandlersRefCount :: MVar (Word, Maybe (Handler, Handler, Handler, Handler))
signalHandlersRefCount = IO (MVar (Word, Maybe (Handler, Handler, Handler, Handler)))
-> MVar (Word, Maybe (Handler, Handler, Handler, Handler))
forall a. IO a -> a
unsafePerformIO (IO (MVar (Word, Maybe (Handler, Handler, Handler, Handler)))
-> MVar (Word, Maybe (Handler, Handler, Handler, Handler)))
-> IO (MVar (Word, Maybe (Handler, Handler, Handler, Handler)))
-> MVar (Word, Maybe (Handler, Handler, Handler, Handler))
forall a b. (a -> b) -> a -> b
$ (Word, Maybe (Handler, Handler, Handler, Handler))
-> IO (MVar (Word, Maybe (Handler, Handler, Handler, Handler)))
forall a. a -> IO (MVar a)
newMVar (Word
0,Maybe (Handler, Handler, Handler, Handler)
forall a. Maybe a
Nothing)
withSignalHandlers :: ExceptionMonad m => m a -> m a
withSignalHandlers :: forall (m :: * -> *) a. ExceptionMonad m => m a -> m a
withSignalHandlers m a
act = do
ThreadId
main_thread <- IO ThreadId -> m ThreadId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ThreadId
myThreadId
Weak ThreadId
wtid <- IO (Weak ThreadId) -> m (Weak ThreadId)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ThreadId -> IO (Weak ThreadId)
mkWeakThreadId ThreadId
main_thread)
let
interrupt :: IO ()
interrupt = do
Maybe ThreadId
r <- Weak ThreadId -> IO (Maybe ThreadId)
forall v. Weak v -> IO (Maybe v)
deRefWeak Weak ThreadId
wtid
case Maybe ThreadId
r of
Maybe ThreadId
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ThreadId
t -> ThreadId -> AsyncException -> IO ()
forall e. Exception e => ThreadId -> e -> IO ()
throwTo ThreadId
t AsyncException
UserInterrupt
#if !defined(mingw32_HOST_OS)
let installHandlers :: IO (Handler, Handler, Handler, Handler)
installHandlers = do
let installHandler' :: CInt -> Handler -> IO Handler
installHandler' CInt
a Handler
b = CInt -> Handler -> Maybe SignalSet -> IO Handler
installHandler CInt
a Handler
b Maybe SignalSet
forall a. Maybe a
Nothing
Handler
hdlQUIT <- CInt -> Handler -> IO Handler
installHandler' CInt
sigQUIT (IO () -> Handler
Catch IO ()
interrupt)
Handler
hdlINT <- CInt -> Handler -> IO Handler
installHandler' CInt
sigINT (IO () -> Handler
Catch IO ()
interrupt)
let fatal_signal :: CInt -> IO ()
fatal_signal CInt
n = ThreadId -> GhcException -> IO ()
forall e. Exception e => ThreadId -> e -> IO ()
throwTo ThreadId
main_thread (Int -> GhcException
Signal (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n))
Handler
hdlHUP <- CInt -> Handler -> IO Handler
installHandler' CInt
sigHUP (IO () -> Handler
Catch (CInt -> IO ()
fatal_signal CInt
sigHUP))
Handler
hdlTERM <- CInt -> Handler -> IO Handler
installHandler' CInt
sigTERM (IO () -> Handler
Catch (CInt -> IO ()
fatal_signal CInt
sigTERM))
(Handler, Handler, Handler, Handler)
-> IO (Handler, Handler, Handler, Handler)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handler
hdlQUIT,Handler
hdlINT,Handler
hdlHUP,Handler
hdlTERM)
let uninstallHandlers :: (Handler, Handler, Handler, Handler) -> IO ()
uninstallHandlers (Handler
hdlQUIT,Handler
hdlINT,Handler
hdlHUP,Handler
hdlTERM) = do
Handler
_ <- CInt -> Handler -> Maybe SignalSet -> IO Handler
installHandler CInt
sigQUIT Handler
hdlQUIT Maybe SignalSet
forall a. Maybe a
Nothing
Handler
_ <- CInt -> Handler -> Maybe SignalSet -> IO Handler
installHandler CInt
sigINT Handler
hdlINT Maybe SignalSet
forall a. Maybe a
Nothing
Handler
_ <- CInt -> Handler -> Maybe SignalSet -> IO Handler
installHandler CInt
sigHUP Handler
hdlHUP Maybe SignalSet
forall a. Maybe a
Nothing
Handler
_ <- CInt -> Handler -> Maybe SignalSet -> IO Handler
installHandler CInt
sigTERM Handler
hdlTERM Maybe SignalSet
forall a. Maybe a
Nothing
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#else
let sig_handler ControlC = interrupt
sig_handler Break = interrupt
sig_handler _ = return ()
let installHandlers = installHandler (Catch sig_handler)
let uninstallHandlers = installHandler
#endif
let mayInstallHandlers :: m ()
mayInstallHandlers = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MVar (Word, Maybe (Handler, Handler, Handler, Handler))
-> ((Word, Maybe (Handler, Handler, Handler, Handler))
-> IO (Word, Maybe (Handler, Handler, Handler, Handler)))
-> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Word, Maybe (Handler, Handler, Handler, Handler))
signalHandlersRefCount (((Word, Maybe (Handler, Handler, Handler, Handler))
-> IO (Word, Maybe (Handler, Handler, Handler, Handler)))
-> IO ())
-> ((Word, Maybe (Handler, Handler, Handler, Handler))
-> IO (Word, Maybe (Handler, Handler, Handler, Handler)))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \case
(Word
0,Maybe (Handler, Handler, Handler, Handler)
Nothing) -> do
(Handler, Handler, Handler, Handler)
hdls <- IO (Handler, Handler, Handler, Handler)
installHandlers
(Word, Maybe (Handler, Handler, Handler, Handler))
-> IO (Word, Maybe (Handler, Handler, Handler, Handler))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word
1,(Handler, Handler, Handler, Handler)
-> Maybe (Handler, Handler, Handler, Handler)
forall a. a -> Maybe a
Just (Handler, Handler, Handler, Handler)
hdls)
(Word
c,Maybe (Handler, Handler, Handler, Handler)
oldHandlers) -> (Word, Maybe (Handler, Handler, Handler, Handler))
-> IO (Word, Maybe (Handler, Handler, Handler, Handler))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word
cWord -> Word -> Word
forall a. Num a => a -> a -> a
+Word
1,Maybe (Handler, Handler, Handler, Handler)
oldHandlers)
let mayUninstallHandlers :: m ()
mayUninstallHandlers = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MVar (Word, Maybe (Handler, Handler, Handler, Handler))
-> ((Word, Maybe (Handler, Handler, Handler, Handler))
-> IO (Word, Maybe (Handler, Handler, Handler, Handler)))
-> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Word, Maybe (Handler, Handler, Handler, Handler))
signalHandlersRefCount (((Word, Maybe (Handler, Handler, Handler, Handler))
-> IO (Word, Maybe (Handler, Handler, Handler, Handler)))
-> IO ())
-> ((Word, Maybe (Handler, Handler, Handler, Handler))
-> IO (Word, Maybe (Handler, Handler, Handler, Handler)))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \case
(Word
1,Just (Handler, Handler, Handler, Handler)
hdls) -> do
()
_ <- (Handler, Handler, Handler, Handler) -> IO ()
uninstallHandlers (Handler, Handler, Handler, Handler)
hdls
(Word, Maybe (Handler, Handler, Handler, Handler))
-> IO (Word, Maybe (Handler, Handler, Handler, Handler))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word
0,Maybe (Handler, Handler, Handler, Handler)
forall a. Maybe a
Nothing)
(Word
c,Maybe (Handler, Handler, Handler, Handler)
oldHandlers) -> (Word, Maybe (Handler, Handler, Handler, Handler))
-> IO (Word, Maybe (Handler, Handler, Handler, Handler))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word
cWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1,Maybe (Handler, Handler, Handler, Handler)
oldHandlers)
m ()
mayInstallHandlers
m a
act m a -> m () -> m a
forall (m :: * -> *) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
`MC.finally` m ()
mayUninstallHandlers
callStackDoc :: HasCallStack => SDoc
callStackDoc :: HasCallStack => SDoc
callStackDoc = CallStack -> SDoc
prettyCallStackDoc CallStack
HasCallStack => CallStack
callStack
prettyCallStackDoc :: CallStack -> SDoc
prettyCallStackDoc :: CallStack -> SDoc
prettyCallStackDoc CallStack
cs =
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Call stack:")
Int
4 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (String -> SDoc) -> [String] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map String -> SDoc
forall doc. IsLine doc => String -> doc
text ([String] -> [SDoc]) -> [String] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines (CallStack -> String
prettyCallStack CallStack
cs))
assertPprPanic :: HasCallStack => SDoc -> a
assertPprPanic :: forall a. HasCallStack => SDoc -> a
assertPprPanic SDoc
msg = (HasCallStack => a) -> a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (String -> SDoc -> a
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"ASSERT failed!" SDoc
msg)
assertPpr :: HasCallStack => Bool -> SDoc -> a -> a
{-# INLINE assertPpr #-}
assertPpr :: forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr Bool
cond SDoc
msg a
a =
if Bool
debugIsOn Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
cond
then (HasCallStack => a) -> a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (SDoc -> a
forall a. HasCallStack => SDoc -> a
assertPprPanic SDoc
msg)
else a
a
assertPprMaybe :: HasCallStack => Maybe SDoc -> a -> a
{-# INLINE assertPprMaybe #-}
assertPprMaybe :: forall a. HasCallStack => Maybe SDoc -> a -> a
assertPprMaybe Maybe SDoc
mb_msg a
a
| Bool
debugIsOn, Just SDoc
msg <- Maybe SDoc
mb_msg = (HasCallStack => a) -> a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (SDoc -> a
forall a. HasCallStack => SDoc -> a
assertPprPanic SDoc
msg)
| Bool
otherwise = a
a
massertPpr :: (HasCallStack, Applicative m) => Bool -> SDoc -> m ()
{-# INLINE massertPpr #-}
massertPpr :: forall (m :: * -> *).
(HasCallStack, Applicative m) =>
Bool -> SDoc -> m ()
massertPpr Bool
cond SDoc
msg = (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (Bool -> SDoc -> m () -> m ()
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr Bool
cond SDoc
msg (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()))
assertPprM :: (HasCallStack, Monad m) => m Bool -> SDoc -> m ()
{-# INLINE assertPprM #-}
assertPprM :: forall (m :: * -> *).
(HasCallStack, Monad m) =>
m Bool -> SDoc -> m ()
assertPprM m Bool
mcond SDoc
msg = (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (m Bool
mcond m Bool -> (Bool -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
cond -> Bool -> SDoc -> m ()
forall (m :: * -> *).
(HasCallStack, Applicative m) =>
Bool -> SDoc -> m ()
massertPpr Bool
cond SDoc
msg)