----------------------------------------------------------------------------
-- |
-- Module      :  Emacs.Module.Errors
-- Copyright   :  (c) Sergey Vinokurov 2018
-- License     :  Apache-2.0 (see LICENSE)
-- Maintainer  :  serg.foo@gmail.com
--
-- This module defines various kinds of exception that this library
----------------------------------------------------------------------------

{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE OverloadedStrings #-}

module Emacs.Module.Errors
  ( EmacsThrow(..)
  , reportEmacsThrowToEmacs
  , EmacsSignal(..)
  , reportEmacsSignalToEmacs
  , EmacsError(..)
  , mkEmacsError
  , reportErrorToEmacs
  , EmacsInternalError(..)
  , mkEmacsInternalError
  , reportInternalErrorToEmacs
  , UserError(..)
  , mkUserError

  , formatSomeException
  , reportAnyErrorToEmacs
  , reportAllErrorsToEmacs
  ) where

import Control.Applicative
import Control.Exception as Exception

import Data.ByteString.Char8 qualified as C8
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE
import Data.Void
import Data.Void.Unsafe
import Foreign
import Foreign.C.String
import GHC.Stack (CallStack, callStack, prettyCallStack)
import Prettyprinter
import Prettyprinter.Combinators hiding (render, ppCallStack)
import Prettyprinter.Render.Text as PP

import Data.Emacs.Module.Env qualified as Raw
import Data.Emacs.Module.GetRawValue
import Data.Emacs.Module.NonNullPtr
import Data.Emacs.Module.Raw.Env.Internal (Env)
import Data.Emacs.Module.Raw.Value
import Data.Emacs.Module.SymbolName.Internal
import Data.Emacs.Module.SymbolName.Predefined qualified as Sym
import Emacs.Module.Assert

-- | A Haskell exception used to signal a @throw@ exit performed by an
-- Emacs function.
--
-- Unlikely to be needed when developing Emacs extensions.
data EmacsThrow = EmacsThrow
  { EmacsThrow -> RawValue 'Regular
emacsThrowTag    :: !(RawValue 'Regular)
  , EmacsThrow -> RawValue 'Regular
emacsThrowValue  :: !(RawValue 'Regular)
  , EmacsThrow -> CallStack
emacsThrowOrigin :: CallStack
  }

instance Show EmacsThrow where
  showsPrec :: Int -> EmacsThrow -> ShowS
showsPrec Int
_ EmacsThrow{CallStack
emacsThrowOrigin :: CallStack
emacsThrowOrigin :: EmacsThrow -> CallStack
emacsThrowOrigin}
    = String -> ShowS
showString String
"EmacsThrow\n"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (CallStack -> String
prettyCallStack CallStack
emacsThrowOrigin)

instance Exception EmacsThrow

reportEmacsThrowToEmacs :: Env -> EmacsThrow -> IO (RawValue 'Unknown)
reportEmacsThrowToEmacs :: Env -> EmacsThrow -> IO (RawValue 'Unknown)
reportEmacsThrowToEmacs Env
env EmacsThrow
et = do
  RawValue 'Unknown
nil <- WithCallStack => Env -> IO (RawValue 'Unknown)
mkNil Env
env
  Env -> EmacsThrow -> IO ()
reportEmacsThrowToEmacs' Env
env EmacsThrow
et
  forall (f :: * -> *) a. Applicative f => a -> f a
pure RawValue 'Unknown
nil

reportEmacsThrowToEmacs' :: Env -> EmacsThrow -> IO ()
reportEmacsThrowToEmacs' :: Env -> EmacsThrow -> IO ()
reportEmacsThrowToEmacs' Env
env EmacsThrow{RawValue 'Regular
emacsThrowTag :: RawValue 'Regular
emacsThrowTag :: EmacsThrow -> RawValue 'Regular
emacsThrowTag, RawValue 'Regular
emacsThrowValue :: RawValue 'Regular
emacsThrowValue :: EmacsThrow -> RawValue 'Regular
emacsThrowValue} =
  forall (m :: * -> *) (p1 :: Pinning) (p2 :: Pinning).
MonadIO m =>
Env -> RawValue p1 -> RawValue p2 -> m ()
Raw.nonLocalExitThrow Env
env RawValue 'Regular
emacsThrowTag RawValue 'Regular
emacsThrowValue

-- | A Haskell exception used to signal a @signal@ exit performed by an
-- Emacs function.
--
-- Unlikely to be needed when developing Emacs extensions.
data EmacsSignal = EmacsSignal
  { EmacsSignal -> RawValue 'Unknown
emacsSignalSym    :: !(RawValue 'Unknown)
  , EmacsSignal -> RawValue 'Regular
emacsSignalData   :: !(RawValue 'Regular)
  , EmacsSignal -> Text
emacsSignalInfo   :: !Text
  , EmacsSignal -> CallStack
emacsSignalOrigin :: CallStack
  }

instance Show EmacsSignal where
  showsPrec :: Int -> EmacsSignal -> ShowS
showsPrec Int
_ EmacsSignal{Text
emacsSignalInfo :: Text
emacsSignalInfo :: EmacsSignal -> Text
emacsSignalInfo, CallStack
emacsSignalOrigin :: CallStack
emacsSignalOrigin :: EmacsSignal -> CallStack
emacsSignalOrigin}
    = String -> ShowS
showString String
"EmacsSignal "
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (Text -> String
T.unpack Text
emacsSignalInfo)
    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 (CallStack -> String
prettyCallStack CallStack
emacsSignalOrigin)

instance Exception EmacsSignal

reportEmacsSignalToEmacs :: Env -> EmacsSignal -> IO (RawValue 'Unknown)
reportEmacsSignalToEmacs :: Env -> EmacsSignal -> IO (RawValue 'Unknown)
reportEmacsSignalToEmacs Env
env EmacsSignal
et = do
  RawValue 'Unknown
nil <- WithCallStack => Env -> IO (RawValue 'Unknown)
mkNil Env
env
  Env -> EmacsSignal -> IO ()
reportEmacsSignalToEmacs' Env
env EmacsSignal
et
  forall (f :: * -> *) a. Applicative f => a -> f a
pure RawValue 'Unknown
nil

reportEmacsSignalToEmacs' :: Env -> EmacsSignal -> IO ()
reportEmacsSignalToEmacs' :: Env -> EmacsSignal -> IO ()
reportEmacsSignalToEmacs' Env
env EmacsSignal{RawValue 'Unknown
emacsSignalSym :: RawValue 'Unknown
emacsSignalSym :: EmacsSignal -> RawValue 'Unknown
emacsSignalSym, RawValue 'Regular
emacsSignalData :: RawValue 'Regular
emacsSignalData :: EmacsSignal -> RawValue 'Regular
emacsSignalData} =
  forall (m :: * -> *) (p1 :: Pinning) (p2 :: Pinning).
MonadIO m =>
Env -> RawValue p1 -> RawValue p2 -> m ()
Raw.nonLocalExitSignal Env
env RawValue 'Unknown
emacsSignalSym RawValue 'Regular
emacsSignalData

-- | Error thrown to emacs by Haskell functions when anything goes awry.
data UserError = UserError
  { UserError -> Doc Void
userErrFunctionName :: Doc Void
  , UserError -> Doc Void
userErrMsg          :: Doc Void
  , UserError -> CallStack
userErrStack        :: CallStack
  } deriving (Int -> UserError -> ShowS
[UserError] -> ShowS
UserError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserError] -> ShowS
$cshowList :: [UserError] -> ShowS
show :: UserError -> String
$cshow :: UserError -> String
showsPrec :: Int -> UserError -> ShowS
$cshowsPrec :: Int -> UserError -> ShowS
Show)

instance Exception UserError

instance Pretty UserError where
  pretty :: forall ann. UserError -> Doc ann
pretty (UserError Doc Void
func Doc Void
msg CallStack
stack) =
    Doc ann
"Error in function" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall (f :: * -> *) a. Functor f => f Void -> f a
unsafeVacuous Doc Void
func forall a. Semigroup a => a -> a -> a
<> Doc ann
":" forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<>
    forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall (f :: * -> *) a. Functor f => f Void -> f a
unsafeVacuous Doc Void
msg) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<>
    Doc ann
"Location:" forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<>
    forall ann. Int -> Doc ann -> Doc ann
indent Int
2  (forall ann. CallStack -> Doc ann
ppCallStack CallStack
stack)

mkUserError
  :: WithCallStack
  => Doc Void -- ^ Function name
  -> Doc Void -- ^ Message body
  -> UserError
mkUserError :: WithCallStack => Doc Void -> Doc Void -> UserError
mkUserError Doc Void
funcName Doc Void
body = UserError
  { userErrFunctionName :: Doc Void
userErrFunctionName = Doc Void
funcName
  , userErrMsg :: Doc Void
userErrMsg          = Doc Void
body
  , userErrStack :: CallStack
userErrStack        = HasCallStack => CallStack
callStack
  }

-- | A high-level error thrown when an Emacs function fails.
data EmacsError = EmacsError
  { EmacsError -> Doc Void
emacsErrMsg    :: Doc Void
  , EmacsError -> Doc Void
emacsErrData   :: Doc Void
  , EmacsError -> CallStack
emacsErrStack  :: CallStack
  } deriving (Int -> EmacsError -> ShowS
[EmacsError] -> ShowS
EmacsError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmacsError] -> ShowS
$cshowList :: [EmacsError] -> ShowS
show :: EmacsError -> String
$cshow :: EmacsError -> String
showsPrec :: Int -> EmacsError -> ShowS
$cshowsPrec :: Int -> EmacsError -> ShowS
Show)

instance Exception EmacsError

mkEmacsError
  :: WithCallStack
  => Doc Void -- ^ Message
  -> Doc Void -- ^ Error data from Emacs
  -> EmacsError
mkEmacsError :: WithCallStack => Doc Void -> Doc Void -> EmacsError
mkEmacsError Doc Void
msg Doc Void
errData = EmacsError
  { emacsErrMsg :: Doc Void
emacsErrMsg   = Doc Void
msg
  , emacsErrData :: Doc Void
emacsErrData  = Doc Void
errData
  , emacsErrStack :: CallStack
emacsErrStack = HasCallStack => CallStack
callStack
  }

instance Pretty EmacsError where
  pretty :: forall ann. EmacsError -> Doc ann
pretty EmacsError{Doc Void
emacsErrMsg :: Doc Void
emacsErrMsg :: EmacsError -> Doc Void
emacsErrMsg, Doc Void
emacsErrData :: Doc Void
emacsErrData :: EmacsError -> Doc Void
emacsErrData, CallStack
emacsErrStack :: CallStack
emacsErrStack :: EmacsError -> CallStack
emacsErrStack} =
    Doc ann
"Error within Haskell<->Emacs bindings:" forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<>
    forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall (f :: * -> *) a. Functor f => f Void -> f a
unsafeVacuous Doc Void
emacsErrMsg) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<>
    Doc ann
"Emacs error:" forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<>
    forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall (f :: * -> *) a. Functor f => f Void -> f a
unsafeVacuous Doc Void
emacsErrData) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<>
    Doc ann
"Location:" forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<>
    forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall ann. CallStack -> Doc ann
ppCallStack CallStack
emacsErrStack)

reportErrorToEmacs :: Env -> EmacsError -> IO (RawValue 'Unknown)
reportErrorToEmacs :: Env -> EmacsError -> IO (RawValue 'Unknown)
reportErrorToEmacs Env
env EmacsError
e = do
  RawValue 'Unknown
nil <- WithCallStack => Env -> IO (RawValue 'Unknown)
mkNil Env
env
  forall e. (e -> Text) -> Env -> e -> IO ()
report forall a. Pretty a => a -> Text
render Env
env EmacsError
e
  forall (f :: * -> *) a. Applicative f => a -> f a
pure RawValue 'Unknown
nil

-- | A low-level error thrown when assumptions of this package are
-- violated and it's not safe to proceed further.
--
-- E.g. Emacs returned value not specified in a C enum - cannot
-- really process it in a meaningful way.
data EmacsInternalError = EmacsInternalError
  { EmacsInternalError -> Doc Void
emacsInternalErrMsg   :: Doc Void
  , EmacsInternalError -> CallStack
emacsInternalErrStack :: CallStack
  }

instance Exception EmacsInternalError

instance Show EmacsInternalError where
  showsPrec :: Int -> EmacsInternalError -> ShowS
showsPrec Int
_ (EmacsInternalError Doc Void
msg CallStack
stack)
    = String -> ShowS
showString (forall ann. Doc ann -> String
renderString (Doc Void
"EmacsInternalError" forall ann. Doc ann -> Doc ann -> Doc ann
## Doc Void
msg forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<> forall ann. CallStack -> Doc ann
ppCallStack CallStack
stack))

mkEmacsInternalError
  :: WithCallStack
  => Doc Void -- ^ Error message
  -> EmacsInternalError
mkEmacsInternalError :: WithCallStack => Doc Void -> EmacsInternalError
mkEmacsInternalError Doc Void
msg = EmacsInternalError
  { emacsInternalErrMsg :: Doc Void
emacsInternalErrMsg   = Doc Void
msg
  , emacsInternalErrStack :: CallStack
emacsInternalErrStack = HasCallStack => CallStack
callStack
  }

reportInternalErrorToEmacs :: Env -> EmacsInternalError -> IO (RawValue 'Unknown)
reportInternalErrorToEmacs :: Env -> EmacsInternalError -> IO (RawValue 'Unknown)
reportInternalErrorToEmacs Env
env EmacsInternalError
e = do
  RawValue 'Unknown
nil <- WithCallStack => Env -> IO (RawValue 'Unknown)
mkNil Env
env
  forall e. (e -> Text) -> Env -> e -> IO ()
report forall a. Pretty a => a -> Text
render Env
env EmacsInternalError
e
  forall (f :: * -> *) a. Applicative f => a -> f a
pure RawValue 'Unknown
nil

instance Pretty EmacsInternalError where
  pretty :: forall ann. EmacsInternalError -> Doc ann
pretty EmacsInternalError{Doc Void
emacsInternalErrMsg :: Doc Void
emacsInternalErrMsg :: EmacsInternalError -> Doc Void
emacsInternalErrMsg, CallStack
emacsInternalErrStack :: CallStack
emacsInternalErrStack :: EmacsInternalError -> CallStack
emacsInternalErrStack} =
    Doc ann
"Internal error within Haskell<->Emacs bindings:" forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<>
    forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall (f :: * -> *) a. Functor f => f Void -> f a
unsafeVacuous Doc Void
emacsInternalErrMsg) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<>
    Doc ann
"Location:" forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<>
    forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall ann. CallStack -> Doc ann
ppCallStack CallStack
emacsInternalErrStack)

formatSomeException :: SomeException -> Text
formatSomeException :: SomeException -> Text
formatSomeException SomeException
e =
  case forall a ann. Pretty a => a -> Doc ann
pretty @EmacsError         forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
       forall a ann. Pretty a => a -> Doc ann
pretty @EmacsInternalError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
    Just Doc Void
formatted -> Doc Void -> Text
render' Doc Void
formatted
    Maybe (Doc Void)
Nothing        ->
      forall ann. SimpleDocStream ann -> Text
PP.renderStrict forall a b. (a -> b) -> a -> b
$ forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions forall a b. (a -> b) -> a -> b
$
        Doc Any
"Error within Haskell<->Emacs bindings:" forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<>
        forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Show a => a -> String
show SomeException
e))

reportAnyErrorToEmacs :: Env -> SomeException -> IO (RawValue 'Unknown)
reportAnyErrorToEmacs :: Env -> SomeException -> IO (RawValue 'Unknown)
reportAnyErrorToEmacs Env
env !SomeException
e = do
  !RawValue 'Unknown
nil <- WithCallStack => Env -> IO (RawValue 'Unknown)
mkNil Env
env
  forall e. (e -> Text) -> Env -> e -> IO ()
report SomeException -> Text
formatSomeException Env
env SomeException
e
  forall (f :: * -> *) a. Applicative f => a -> f a
pure RawValue 'Unknown
nil

-- | Catch all errors this package might throw in an IO action
-- and make Emacs aware of them.
--
-- This is a convenience function intended to be used around exported
-- @initialise@ entry point into an Emacs module.
reportAllErrorsToEmacs
  :: Env
  -> IO a -- ^ Result to return on error.
  -> IO a
  -> IO a
reportAllErrorsToEmacs :: forall a. Env -> IO a -> IO a -> IO a
reportAllErrorsToEmacs Env
env IO a
resultOnErr IO a
x
  = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
Exception.handle (\SomeException
e -> forall e. (e -> Text) -> Env -> e -> IO ()
report SomeException -> Text
formatSomeException Env
env SomeException
e forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> IO a
resultOnErr)
  forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => (e -> IO a) -> IO a -> IO a
Exception.handle (\EmacsThrow
et -> Env -> EmacsThrow -> IO ()
reportEmacsThrowToEmacs' Env
env EmacsThrow
et forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> IO a
resultOnErr)
  forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => (e -> IO a) -> IO a -> IO a
Exception.handle (\EmacsSignal
et -> Env -> EmacsSignal -> IO ()
reportEmacsSignalToEmacs' Env
env EmacsSignal
et forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> IO a
resultOnErr) IO a
x

report :: (e -> Text) -> Env -> e -> IO ()
report :: forall e. (e -> Text) -> Env -> e -> IO ()
report e -> Text
format Env
env e
err = do
  RawValue 'Regular
errSym  <- Env -> SymbolName -> IO (RawValue 'Regular)
reifySymbolRaw Env
env SymbolName
Sym.error
  RawValue 'Regular
listSym <- Env -> SymbolName -> IO (RawValue 'Regular)
reifySymbolRaw Env
env SymbolName
Sym.list
  forall a. Text -> (CString -> Int -> IO a) -> IO a
withTextAsCString0AndLen (e -> Text
format e
err) forall a b. (a -> b) -> a -> b
$ \CString
str Int
len -> do
    RawValue 'Regular
str' <- forall (m :: * -> *).
MonadIO m =>
Env -> CString -> CPtrdiff -> m (RawValue 'Regular)
Raw.makeString Env
env CString
str (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (RawValue 'Regular)
argsPtr -> do
      forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (RawValue 'Regular)
argsPtr RawValue 'Regular
str'
      RawValue 'Regular
errData <- forall (m :: * -> *) (p1 :: Pinning) (p2 :: Pinning).
MonadIO m =>
Env
-> RawValue p1
-> CPtrdiff
-> NonNullPtr (RawValue p2)
-> m (RawValue 'Regular)
Raw.funcallPrimitive Env
env (forall a. GetRawValue a => a -> RawValue 'Regular
getRawValue RawValue 'Regular
listSym) CPtrdiff
1 (forall a. WithCallStack => Ptr a -> NonNullPtr a
mkNonNullPtr Ptr (RawValue 'Regular)
argsPtr)
      -- The 'nonLocalExitSignal' function does not overwrite pending
      -- signals, so it's ok to use it here without checking whether an
      -- error is already going on.
      forall (m :: * -> *) (p1 :: Pinning) (p2 :: Pinning).
MonadIO m =>
Env -> RawValue p1 -> RawValue p2 -> m ()
Raw.nonLocalExitSignal Env
env RawValue 'Regular
errSym RawValue 'Regular
errData

withTextAsCString0AndLen :: Text -> (CString -> Int -> IO a) -> IO a
withTextAsCString0AndLen :: forall a. Text -> (CString -> Int -> IO a) -> IO a
withTextAsCString0AndLen Text
str CString -> Int -> IO a
f =
  forall a. ByteString -> (CString -> IO a) -> IO a
C8.useAsCString ByteString
utf8 (\CString
ptr -> CString -> Int -> IO a
f CString
ptr (ByteString -> Int
C8.length ByteString
utf8))
  where
    utf8 :: ByteString
utf8 = Text -> ByteString
TE.encodeUtf8 Text
str

mkNil :: WithCallStack => Env -> IO (RawValue 'Unknown)
mkNil :: WithCallStack => Env -> IO (RawValue 'Unknown)
mkNil Env
env = Env -> SymbolName -> IO (RawValue 'Unknown)
reifySymbolUnknown Env
env SymbolName
Sym.nil

render :: Pretty a => a -> Text
render :: forall a. Pretty a => a -> Text
render = Doc Void -> Text
render' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty

render' :: Doc Void -> Text
render' :: Doc Void -> Text
render' = forall ann. SimpleDocStream ann -> Text
PP.renderStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions

ppCallStack :: CallStack -> Doc ann
ppCallStack :: forall ann. CallStack -> Doc ann
ppCallStack = forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallStack -> String
prettyCallStack