ghc-stack-annotations (empty) → 0.1.0.0

raw patch · 5 files changed

+351/−0 lines, 5 filesdep +basedep +ghc-experimentaldep +ghc-internal

Dependencies added: base, ghc-experimental, ghc-internal

Files

• CHANGELOG.md +6/−0
• LICENSE +28/−0
• README.md +28/−0
• ghc-stack-annotations.cabal +51/−0
• src/GHC/Stack/Annotation.hs +238/−0

@@ -0,0 +1,6 @@+# Revision history for ghc-stack-annotations++## 0.1.0.0 -- YYYY-mm-dd++* Introduce `GHC.Stack.Annotation`, which is a backwards compatibility module, allowing+    users to use `annotateStack*` without having to resort to `CPP` for older GHC versions.

@@ -0,0 +1,28 @@+BSD 3-Clause License++Copyright (c) 2025, Hannes Siebenhandl++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+  list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.++* Neither the name of the copyright holder nor the names of its+  contributors may be used to endorse or promote products derived from+  this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,28 @@+# `ghc-stack-annotations`++A compatibility library for the RTS callstack annotations introduced in GHC 9.14.++```haskell+handleGetRequest :: Int -> IO Int+handleGetRequest number = annotateStackStringIO "My User Annotation" $ do+    bigOperationThatCouldFail number+```++The annotation primop called by `handleGetRequest` pushes a stack frame which contains a user-annotation.+The stack decoding logic can interpret these frames and display the user-annotated+information during exceptions and sample profiling.++* [Better Haskell stack traces via user annotations](https://www.well-typed.com/blog/2025/09/better-haskell-stack-traces/)++Since the annotation primop has only been introduced in GHC-9.14, the annotation+functions do not do anything if used on earlier GHC versions.++IPE backtraces which include annotation stack frames offers a number of advantages over the existing backtrace collection mechanisms:++* It is not necessary to modify the function API (unlike `HasCallStack`)+* A "continuous chain" of modifications is not necessary (unlike `HasCallStack`)+* The annotations work in all ways of compilation (unlike cost centre stacks)+* The backtrace is expressed in terms of predictable source locations (unlike some IPE backtraces)++Further, tools such as [`ghc-stack-profiler`](https://github.com/well-typed/ghc-stack-profiler) can also use the annotation stack frame+to provide improved profiles.

@@ -0,0 +1,51 @@+cabal-version: 3.8+name: ghc-stack-annotations+version: 0.1.0.0+synopsis: RTS Callstack annotation library+description: A compatibility library for the RTS Callstack annotations introduced in GHC 9.14.+             .+             Allows you to use the stack annotations without having to worry about older GHC versions.+             As stack annotations rely on the newly introduced 'AnnFrame' stack frame type, this library+             is operationally a NO-OP for GHC versions below 9.14.+             .+             For GHC <9.14, this library exposes an API identical to 'GHC.Stack.Annotation.Experimental' including+             data types and type classes for writing 'StackAnnotation' instances, without worrying about backwards+             compatibility.+             For GHC >=9.14, this library re-exports the API of 'GHC.Stack.Annotation.Experimental'.+category: development, BSD+license: BSD-3-Clause+license-file: LICENSE+author: Hannes Siebenhandl, Matthew Pickering+maintainer: hannes@well-typed.com+build-type: Simple+extra-doc-files:+  CHANGELOG.md+  README.md++tested-with: GHC ==9.14 || ==9.12 || ==9.10 || ==9.8++common warnings+  ghc-options: -Wall++common exts+  default-extensions:+    GADTs+    ImplicitParams+    RankNTypes++library+  import: warnings, exts+  exposed-modules: GHC.Stack.Annotation+  build-depends:+    base >=4.19.1 && <5,++  if impl(ghc >=9.14)+    build-depends:+      ghc-internal >= 9.1400 && <10,+      ghc-experimental >= 9.1400.0 && <10,+  hs-source-dirs: src+  default-language: Haskell2010++source-repository head+  location: https://github.com/well-typed/ghc-stack-annotations+  type: git

@@ -0,0 +1,238 @@+{-# LANGUAGE CPP #-}++module GHC.Stack.Annotation (+  -- * The root of Stack Annotation Types+  SomeStackAnnotation(..),+  -- * Displaying Stack Annotations+  StackAnnotation(..),+  -- * Annotation helpers+  ShowAnnotation(..),+  StringAnnotation(..),+  -- * 'CallStack' annotations+  CallStackAnnotation(..),+  -- * Push stack frame annotations in 'IO' code.+  --+  --+  annotateStackIO,+  annotateStackStringIO,+  annotateStackShowIO,+  annotateCallStackIO,+  -- * Push stack frame annotations in non-'IO' code.+  --+  -- | These variants all evaluate the code to be annotated to WHNF.+  -- Otherwise, the stack annotations will not be shown in stack traces,+  -- as the computation is immediately "evaluated" to a thunk, popping the+  -- annotation frames from the stack.+  -- If the pure computation throws an exception later, the annotation frame+  -- will not be present, thus missing in the stack trace.+  --+  -- Note, you will encounter similar issues if the exception is thrown+  -- during evaluation of a nested value, for example @Just (error "Oh, no!")@.+  annotateStack,+  annotateStackString,+  annotateStackShow,+  annotateCallStack,+) where+++#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 914+import GHC.Stack.Annotation.Experimental (+  SomeStackAnnotation(..),+  StackAnnotation(..),+  ShowAnnotation(..),+  StringAnnotation(..),+  CallStackAnnotation(..),+  annotateStackIO,+  annotateStackStringIO,+  annotateStackShowIO,+  annotateCallStackIO,+  annotateStack,+  annotateStackString,+  annotateStackShow,+  annotateCallStack,+  )+#else++-- The following source code is a copy of ghc-experimental:+--  GHC.Stack.Annotation.Experimental.hs+-- The only difference is that no 'annotateStackIO' is simply the 'id' function.+--+-- As such, we reproduce the copyright notice here.++-- Copyright (c) 2023, ghc-devs@haskell.org+--+-- All rights reserved.+--+-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions are met:+--+--     * Redistributions of source code must retain the above copyright+--       notice, this list of conditions and the following disclaimer.+--+--     * Redistributions in binary form must reproduce the above+--       copyright notice, this list of conditions and the following+--       disclaimer in the documentation and/or other materials provided+--       with the distribution.+--+--     * Neither the name of ghc-devs@haskell.org nor the names of other+--       contributors may be used to endorse or promote products derived+--       from this software without specific prior written permission.+--+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+-- OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+-- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+-- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++import Control.Exception+import Data.Typeable+import GHC.Exception+import GHC.Stack (withFrozenCallStack)+import GHC.Stack.Types+import System.IO.Unsafe (unsafePerformIO)++-- ----------------------------------------------------------------------------+-- StackAnnotation+-- ----------------------------------------------------------------------------++-- | 'StackAnnotation's are types which can be pushed onto the call stack+-- as the payload of 'AnnFrame' stack frames.+--+class StackAnnotation a where+  displayStackAnnotation :: a -> String++-- ----------------------------------------------------------------------------+-- Annotations+-- ----------------------------------------------------------------------------++-- |+-- The @SomeStackAnnotation@ type is the root of the stack annotation type hierarchy.+-- When the call stack is annotated with a value of type @a@, behind the scenes it is+-- encapsulated in a @SomeStackAnnotation@.+--+data SomeStackAnnotation where+  SomeStackAnnotation :: forall a. (Typeable a, StackAnnotation a) => a -> SomeStackAnnotation++instance StackAnnotation SomeStackAnnotation where+  displayStackAnnotation (SomeStackAnnotation a) = displayStackAnnotation a++data StringAnnotation where+  StringAnnotation :: String -> StringAnnotation++instance StackAnnotation StringAnnotation where+  displayStackAnnotation (StringAnnotation str) = str++-- | Use the 'Show' instance of a type to display as the 'StackAnnotation'.+data ShowAnnotation where+  ShowAnnotation :: forall a . Show a => a -> ShowAnnotation++instance StackAnnotation ShowAnnotation where+  displayStackAnnotation (ShowAnnotation showAnno) = show showAnno++-- | A 'CallStack' stack annotation.+newtype CallStackAnnotation = CallStackAnnotation CallStack++instance Show CallStackAnnotation where+  show (CallStackAnnotation cs) = prettyCallStack cs++-- | Displays the first entry of the 'CallStack'+instance StackAnnotation CallStackAnnotation where+  displayStackAnnotation (CallStackAnnotation cs) = case getCallStack cs of+    [] -> "<unknown source location>"+    ((fnName,srcLoc):_) -> fnName ++ ", called at " ++ prettySrcLoc srcLoc++-- ----------------------------------------------------------------------------+-- Annotate the CallStack with custom data+-- ----------------------------------------------------------------------------++-- See Note [User-defined stack annotations for better stack traces]++-- | @'annotateStack' anno b@ annotates the evaluation stack of @b@+-- with the value of @anno@.+--+-- When decoding the call stack, the annotation frames can be used to add more+-- information to stack traces.+--+-- WARNING: forces the evaluation of @b@ to WHNF.+{-# NOINLINE annotateStack #-}+annotateStack :: forall a b. (Typeable a, StackAnnotation a) => a -> b -> b+annotateStack ann b = unsafePerformIO $+  annotateStackIO ann (evaluate b)++-- | @'annotateCallStack' b@ annotates the evaluation stack of @b@+-- with the current 'callstack'.+--+-- When decoding the call stack, the annotation frames can be used to add more+-- information to stack traces.+--+-- WARNING: forces the evaluation of @b@ to WHNF.+{-# NOINLINE annotateCallStack #-}+annotateCallStack :: HasCallStack => b -> b+annotateCallStack b = unsafePerformIO $ withFrozenCallStack $+  annotateCallStackIO (evaluate b)+++-- | @'annotateStackString' msg b@ annotates the evaluation stack of @b@+-- with the value @msg@.+--+-- When decoding the call stack, the annotation frames can be used to add more+-- information to stack traces.+--+-- WARNING: forces the evaluation of @b@ to WHNF.+annotateStackString :: forall b . String -> b -> b+annotateStackString ann =+  annotateStack (StringAnnotation ann)++-- | @'annotateStackShow' showable b@ annotates the evaluation stack of @b@+-- with the value @showable@.+--+-- When decoding the call stack, the annotation frames can be used to add more+-- information to stack traces.+--+-- WARNING: forces the evaluation of @b@ to WHNF.+annotateStackShow :: forall a b . (Typeable a, Show a) => a -> b -> b+annotateStackShow ann =+  annotateStack (ShowAnnotation ann)++-- | @'annotateStackIO' showable b@ annotates the evaluation stack of @b@+-- with the value @showable@.+--+-- When decoding the call stack, the annotation frames can be used to add more+-- information to stack traces.+annotateStackIO :: forall a b . (Typeable a, StackAnnotation a) => a -> IO b -> IO b+annotateStackIO _ann = id++-- | @'annotateStackStringIO' msg b@ annotates the evaluation stack of @b@+-- with the value @msg@.+--+-- When decoding the call stack, the annotation frames can be used to add more+-- information to stack traces.+annotateStackStringIO :: forall b . String -> IO b -> IO b+annotateStackStringIO ann =+  annotateStackIO (StringAnnotation ann)++-- | @'annotateStackShowIO' msg b@ annotates the evaluation stack of @b@+-- with the value @msg@.+--+-- When decoding the call stack, the annotation frames can be used to add more+-- information to stack traces.+annotateStackShowIO :: forall a b . (Show a) => a -> IO b -> IO b+annotateStackShowIO ann =+  annotateStackIO (ShowAnnotation ann)++-- | @'annotateCallStackIO' b@ annotates the evaluation stack of @b@ with the+-- current 'callstack'.+--+-- When decoding the call stack, the annotation frames can be used to add more+-- information to stack traces.+annotateCallStackIO :: HasCallStack => IO a -> IO a+annotateCallStackIO =+  annotateStackIO (CallStackAnnotation ?callStack)++#endif