Pattern synonym call stacks

Main.hs

{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}

module Main where

import           GHC.Stack

-- | Some useless pattern synonym that groups a value with some call stack. In
-- the real code base where I'm using this this pattern synonym generates part
-- of an abstract syntax tree.
pattern Annotate :: HasCallStack => (CallStack, a) -> a
pattern Annotate x <- (addCallStack -> x)
  where
    Annotate (_, x) = x

-- | Used in 'SomeSynonym' to pair a value with the current call stack, since
-- you cannot add the 'HasCallStack' constraint to a lambda (in the real use
-- case I would be calling a function that uses the callstack from here).
addCallStack :: HasCallStack => a -> (CallStack, a)
addCallStack x = (callStack, x)

someAnnotatedValue :: HasCallStack => (CallStack, Int)
someAnnotatedValue = let Annotate annotated = 10 in annotated

main :: IO ()
main = do
    let (stack, _) = someAnnotatedValue
    putStrLn "No lines from within 'someAnnotatedValue' show up here:"
    putStrLn (prettyCallStack stack)