{-# LANGUAGE ImplicitParams #-}{-# LANGUAGE RankNTypes #-}moduleDistribution.Compat.Stack(WithCallStack ,CallStack,annotateCallStackIO ,withFrozenCallStack,withLexicalCallStack ,callStack,prettyCallStack,parentSrcLocPrefix )whereimportGHC.StackimportSystem.IO.ErrortypeWithCallStack a =HasCallStack=>a -- | Give the *parent* of the person who invoked this;-- so it's most suitable for being called from a utility function.-- You probably want to call this using 'withFrozenCallStack'; otherwise-- it's not very useful. We didn't implement this for base-4.8.1-- because we cannot rely on freezing to have taken place.parentSrcLocPrefix ::WithCallStack StringparentSrcLocPrefix :: WithCallStack String
parentSrcLocPrefix =caseCallStack -> [(String, SrcLoc)]
getCallStackCallStack
HasCallStack => CallStack
callStackof((String, SrcLoc)
_:(String
_,SrcLoc
loc ):[(String, SrcLoc)]
_)->SrcLoc -> String
showLoc SrcLoc
loc [(String
_,SrcLoc
loc )]->SrcLoc -> String
showLoc SrcLoc
loc []->String -> String
forall a. HasCallStack => String -> a
errorString
"parentSrcLocPrefix: empty call stack"whereshowLoc :: SrcLoc -> String
showLoc SrcLoc
loc =SrcLoc -> String
srcLocFileSrcLoc
loc String -> String -> String
forall a. [a] -> [a] -> [a]
++String
":"String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show(SrcLoc -> Int
srcLocStartLineSrcLoc
loc )String -> String -> String
forall a. [a] -> [a] -> [a]
++String
": "-- Yeah, this uses skivvy implementation details.withLexicalCallStack ::(a ->WithCallStack (IOb ))->WithCallStack (a ->IOb )withLexicalCallStack :: forall a b.
(a -> WithCallStack (IO b)) -> WithCallStack (a -> IO b)
withLexicalCallStack a -> WithCallStack (IO b)
f =letstk :: CallStack
stk =HasCallStack
CallStack
?callStack in\a
x ->let?callStack=HasCallStack
CallStack
stk ina -> WithCallStack (IO b)
f a
x -- | This function is for when you *really* want to add a call-- stack to raised IO, but you don't have a-- 'Distribution.Verbosity.Verbosity' so you can't use-- 'Distribution.Simple.Utils.annotateIO'. If you have a 'Verbosity',-- please use that function instead.annotateCallStackIO ::WithCallStack (IOa ->IOa )annotateCallStackIO :: forall a. WithCallStack (IO a -> IO a)
annotateCallStackIO =(IOError -> IOError) -> IO a -> IO a
forall a. (IOError -> IOError) -> IO a -> IO a
modifyIOErrorIOError -> IOError
f wheref :: IOError -> IOError
f IOError
ioe =IOError -> String -> IOError
ioeSetErrorStringIOError
ioe (String -> IOError) -> (String -> String) -> String -> IOError
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String
wrapCallStack (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$IOError -> String
ioeGetErrorStringIOError
ioe wrapCallStack :: String -> String
wrapCallStack String
s =CallStack -> String
prettyCallStackCallStack
HasCallStack => CallStack
callStackString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
s