[GHC] #14911: Offer a way to augment call stacks

[GHC]

#14911: Offer a way to augment call stacks
-------------------------------------+-------------------------------------
        Reporter:  dfeuer            |                Owner:  (none)
            Type:  feature request   |               Status:  new
        Priority:  normal            |            Milestone:  8.6.1
       Component:  Core Libraries    |              Version:  8.4.1
      Resolution:                    |             Keywords:  CallStacks
Operating System:  Unknown/Multiple  |         Architecture:
                                     |  Unknown/Multiple
 Type of failure:  None/Unknown      |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:                    |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------

Comment (by dfeuer):

 My implementation of `extraCS` leads to pretty bad output, but I've
 finally managed to fix that. However, the only fix I managed to find
 involved doing some seriously shady things! Let me explain a little. If
 you look at `extraCS` above, you'll see a variable called `a`. That
 variable is very boring, and there's no point in having it show up in the
 stack trace. But because the passed function (bound to `a`) has a
 `HasCallStack` constraint, the name `a` is captured as a stack frame.
 Maybe there's some clever way to avoid that without shadiness, but I
 couldn't find one! I ended up having to do this:

 {{{#!hs
 {-# language RankNTypes #-}
 import GHC.Stack
 import GHC.Stack.Types
 import Unsafe.Coerce

 newtype Magic a = Magic (CallStack -> String -> (CallStack -> a) -> a)
 newtype Magic2 a = Magic2 (HasCallStack => String -> (HasCallStack => a)
 -> a)
 extraCS :: forall a. HasCallStack
         => String
         -> (HasCallStack => a)
         -> a
 extraCS = case unsafeCoerce (Magic boom) of
             Magic2 x -> x

 boom :: CallStack -> String -> (CallStack -> a) -> a
 boom cs s z =
     let cs' = case popCallStack cs of
            EmptyCallStack -> EmptyCallStack
            PushCallStack x y z -> PushCallStack (x ++ " (" ++ s ++ ")") y
 z
            r@(FreezeCallStack _) -> r
     in z cs'
 }}}

 What a mess! Unless someone comes up with a cleverer workaround (please
 do!), that leaves two options:

 1. Add some sort of compiler magic to help. This would be beyond me, but
 potentially valuable to provide finer-grained control of call stacks in
 general.

 2. Add logic to the call stack printer to make it skip those particular
 stack frames.

-- 
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/14911#comment:8>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler