{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | CallStack with a nicer 'Show' instance
--
-- Use of this module is intended to /replace/ import of @GHC.Stack@
module Ouroboros.Consensus.Util.CallStack (
    prettyCallStack
    -- * opaque
  , PrettyCallStack
    -- * Re-exports
  , HasCallStack
  ) where

import           GHC.Stack (CallStack, HasCallStack)
import qualified GHC.Stack as GHC
import           NoThunks.Class (NoThunks)

{-------------------------------------------------------------------------------
  Auxiliary: CallStack with different Show instance
-------------------------------------------------------------------------------}

-- | CallStack with 'Show' instance using 'prettyCallStack'
newtype PrettyCallStack = PrettyCallStack CallStack
  deriving (Context -> PrettyCallStack -> IO (Maybe ThunkInfo)
Proxy PrettyCallStack -> String
(Context -> PrettyCallStack -> IO (Maybe ThunkInfo))
-> (Context -> PrettyCallStack -> IO (Maybe ThunkInfo))
-> (Proxy PrettyCallStack -> String)
-> NoThunks PrettyCallStack
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> PrettyCallStack -> IO (Maybe ThunkInfo)
noThunks :: Context -> PrettyCallStack -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> PrettyCallStack -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> PrettyCallStack -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy PrettyCallStack -> String
showTypeOf :: Proxy PrettyCallStack -> String
NoThunks)

instance Show PrettyCallStack where
  show :: PrettyCallStack -> String
show (PrettyCallStack CallStack
cs) = CallStack -> String
GHC.prettyCallStack CallStack
cs

prettyCallStack :: HasCallStack => PrettyCallStack
prettyCallStack :: HasCallStack => PrettyCallStack
prettyCallStack = CallStack -> PrettyCallStack
PrettyCallStack CallStack
HasCallStack => CallStack
GHC.callStack