├── .github └── workflows │ └── haskell.yml ├── .gitignore ├── CHANGELOG.md ├── LICENSE ├── README.md ├── require-callstack.cabal ├── src └── RequireCallStack.hs ├── stack.yaml └── test └── Main.hs /.github/workflows/haskell.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | on: 3 | push: 4 | branches: 5 | - master 6 | pull_request: 7 | types: 8 | - opened 9 | - synchronize 10 | jobs: 11 | build: 12 | runs-on: ubuntu-latest 13 | strategy: 14 | matrix: 15 | cabal: ["3.10"] 16 | ghc: ["8.6.5", "8.8.4", "8.10.7", "9.0.2", "9.2.4", "9.4.1", "9.6", "9.8", "9.10"] 17 | env: 18 | CONFIG: "--enable-tests" 19 | steps: 20 | - uses: actions/checkout@v4 21 | - uses: haskell-actions/setup@v2 22 | id: setup-haskell-cabal 23 | with: 24 | ghc-version: ${{ matrix.ghc }} 25 | cabal-version: ${{ matrix.cabal }} 26 | - run: cabal v2-update 27 | - run: cabal v2-freeze $CONFIG 28 | - uses: actions/cache@v2 29 | with: 30 | path: | 31 | ${{ steps.setup-haskell-cabal.outputs.cabal-store }} 32 | dist-newstyle 33 | key: ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }} 34 | restore-keys: | 35 | ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }} 36 | ${{ runner.os }}-${{ matrix.ghc }}- 37 | - run: cabal v2-build --disable-optimization -j $CONFIG 38 | - run: cabal v2-test --disable-optimization -j $CONFIG 39 | - run: cabal v2-haddock -j $CONFIG 40 | - run: cabal v2-sdist 41 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | ## Haskell build 2 | dist 3 | *.hi 4 | *.o 5 | .stack-work/ 6 | 7 | ## Editor ignores 8 | TAGS 9 | *~ 10 | *.swp 11 | 12 | ## databases 13 | test.db3 14 | *.sqlite3 15 | 16 | # ? 17 | tarballs/ 18 | 19 | # install script error messages 20 | # maybe should use shellyNoDir ? 21 | .shelly/ 22 | 23 | ## Cabal sandboxing tools 24 | .virthualenv 25 | cabal-dev/ 26 | cabal.sandbox.config 27 | .cabal-sandbox/ 28 | dist-newstyle/ 29 | .ghc.environment.* 30 | 31 | ## Docker image ignores 32 | /.cabal/ 33 | /.stackage/ 34 | /.ghc/ 35 | /.bash_history 36 | /.bashrc 37 | .mongorc.js 38 | .dbshell 39 | crane.yml 40 | # can use this for Docker databases 41 | persistent-test/db/ 42 | 43 | # docker image with a mounted file system 44 | /x86_64-linux-ghc-7.8.3-packages.conf.d/ 45 | /packages/ 46 | 47 | # macOS 48 | .DS_Store 49 | 50 | # hspec nonsense 51 | .hspec-failures 52 | 53 | stack.yaml.lock 54 | *.yaml.lock 55 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for require-callstack 2 | 3 | ## 0.2.0.1 4 | 5 | * [#3](https://github.com/parsonsmatt/require-callstack/pull/3) 6 | * Finish the docs 7 | 8 | ## 0.2.0.0 9 | 10 | * [#2](https://github.com/parsonsmatt/require-callstack/pull/2) 11 | * A simpler and safer implementation 12 | 13 | ## 0.1.0.0 14 | 15 | * First version. Released on an unsuspecting world. 16 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2023 parsonsmatt 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining 4 | a copy of this software and associated documentation files (the 5 | "Software"), to deal in the Software without restriction, including 6 | without limitation the rights to use, copy, modify, merge, publish, 7 | distribute, sublicense, and/or sell copies of the Software, and to 8 | permit persons to whom the Software is furnished to do so, subject to 9 | the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be included 12 | in all copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 17 | IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 18 | CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 19 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 20 | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # `require-callstack` 2 | 3 | Haskell has opt-in call stacks through the use of the `HasCallStack` constraint. 4 | One unfortunate aspect of this design is that the resulting `CallStack` can be truncated if any function in the call list omits the constraint. 5 | 6 | ```haskell 7 | foo :: HasCallStack => Int -> String 8 | foo = error "oh no" 9 | 10 | bar :: HasCallStack => Int -> String 11 | bar = foo . negate 12 | 13 | baz :: Int -> String 14 | baz = bar . (* 2) 15 | 16 | main :: IO () 17 | main = do 18 | print $ baz 5 19 | ``` 20 | 21 | Running this code will fail with an `ErrorCall "oh no"` exception. 22 | The attached `CallStack` will only mention `foo` and `bar` - `baz` *will not* be present, nor will `main`. 23 | A truncated `CallStack` isn't nearly as useful as you might like. 24 | 25 | One solution is the [`annotated-exception`](https://www.stackage.org/lts-21.1/package/annotated-exception-0.2.0.4) library, which can attach `CallStack` to any thrown exception, and `catch` is guaranteed to add a stack frame at the catch-site for any exception that passes through. 26 | However, it's *still* nice to have `HasCallStack` entries on functions - then you get the name of the function, which makes diagnosing an error report easier. 27 | 28 | This library introduces a type `RequireCallStack`. 29 | Unlike `HasCallStack`, this isn't automagically solved - if you call a function that has `RequireCallStack` in the constraint, you must either call `provideCallStack` to discharge the constraint, or add `RequireCallStack` to the signature of the function you're defining. 30 | 31 | ```haskell 32 | panic :: RequireCallStack => String -> a 33 | panic = error 34 | 35 | foo :: RequireCallStack => Int -> String 36 | foo = panic "oh no" 37 | 38 | bar :: RequireCallStack => Int -> String 39 | bar = foo . negate 40 | 41 | baz :: Int -> String 42 | baz = bar . (* 2) 43 | 44 | main :: IO () 45 | main = do 46 | print $ baz 5 47 | ``` 48 | 49 | This code will fail with a compile-time error: 50 | 51 | > ``` 52 | > /home/matt/Projects/require-callstack/test/Main.hs:30:5: error: [GHC-39999] 53 | > • No instance for ‘RequireCallStack.Internal.Add_RequireCallStack_ToFunctionContext_OrUse_provideCallStack’ 54 | > arising from a use of ‘bar’ 55 | > .... 56 | > | 57 | > 30 | bar . (* 2) 58 | > | ^^^ 59 | > ``` 60 | 61 | The error message, read carefully, will tell you how to solve the issue. 62 | If we then write: 63 | 64 | ```haskell 65 | panic :: RequireCallStack => String -> a 66 | panic = error 67 | 68 | foo :: RequireCallStack => Int -> String 69 | foo = panic "oh no" 70 | 71 | bar :: RequireCallStack => Int -> String 72 | bar = foo . negate 73 | 74 | baz :: RequireCallStack => Int -> String 75 | baz = bar . (* 2) 76 | 77 | main :: IO () 78 | main = provideCallStack $ do 79 | print $ baz 5 80 | ``` 81 | 82 | Then the code compiles and works as expected. 83 | -------------------------------------------------------------------------------- /require-callstack.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: require-callstack 3 | version: 0.2.0.1 4 | synopsis: Propagate HasCallStack with constraints 5 | description: See the README for more information about this package. 6 | license: MIT 7 | license-file: LICENSE 8 | author: parsonsmatt 9 | maintainer: parsonsmatt@gmail.com 10 | category: Development 11 | build-type: Simple 12 | extra-doc-files: 13 | CHANGELOG.md 14 | README.md 15 | bug-reports: https://github.com/parsonsmatt/require-callstack/issues 16 | 17 | source-repository head 18 | type: git 19 | location: git://github.com/parsonsmatt/require-callstack.git 20 | 21 | 22 | common warnings 23 | ghc-options: -Wall 24 | 25 | library 26 | import: warnings 27 | exposed-modules: 28 | RequireCallStack 29 | build-depends: 30 | base >= 4.12 && < 5 31 | , ghc-prim 32 | hs-source-dirs: src 33 | default-language: Haskell2010 34 | 35 | test-suite require-callstack-test 36 | import: warnings 37 | default-language: Haskell2010 38 | type: exitcode-stdio-1.0 39 | hs-source-dirs: test 40 | main-is: Main.hs 41 | build-depends: 42 | base 43 | , require-callstack 44 | -------------------------------------------------------------------------------- /src/RequireCallStack.hs: -------------------------------------------------------------------------------- 1 | {-# language RankNTypes, MultiParamTypeClasses, DataKinds, ConstraintKinds, ImplicitParams, UndecidableInstances #-} 2 | 3 | {-# OPTIONS_GHC -Wno-orphans -Wno-missing-methods #-} 4 | 5 | -- | This module provides utilities to ensure that you propagate 6 | -- 'HasCallStack' constraints by introducing a class 'RequireCallStack' 7 | -- which can only be discharged using the 'provideCallStack' function. 8 | -- 9 | -- Let's say you have a custom prelude for your project, and you want 10 | -- better callstack support. You replace the 'Prelude.error' with a custom 11 | -- variant: 12 | -- 13 | -- @ 14 | -- error :: RequireCallStack => String -> a 15 | -- error = Prelude.error 16 | -- @ 17 | -- 18 | -- Now, you will receive a compile-time error at every use site of 'error' 19 | -- in your project. These errors will complain about a missing instance of 20 | -- some weird class that gently suggests to add a 'RequireCallStack' 21 | -- constraint, or use 'provideCallStack' to discharge it. You can add 22 | -- 'RequireCallStack' constraints up the stack, until eventually, you have 23 | -- complete provenance information. Or, if you want to make the work a bit 24 | -- easier, you can use 'provideCallStack' to dismiss the constraint. 25 | -- 26 | -- @ 27 | -- foo :: `RequireCallStack` => `Int` -> `String` 28 | -- foo = `error` "oh no" 29 | -- 30 | -- bar :: `Int` -> `String` 31 | -- bar i = `provideCallStack` `$` foo i 32 | -- @ 33 | -- 34 | -- Couple this with @annotated-exception@ library for excellent provenance 35 | -- information on all thrown exceptions. 36 | module RequireCallStack 37 | ( RequireCallStack 38 | , RequireCallStackImpl 39 | , ProvideCallStack 40 | , provideCallStack 41 | , errorRequireCallStack 42 | ) where 43 | 44 | import GHC.Stack (HasCallStack) 45 | import GHC.Classes (IP(..)) 46 | import GHC.TypeLits (TypeError, ErrorMessage(..)) 47 | 48 | -- | This constraint is similar to 'HasCallStack' in that it's presence 49 | -- will capture a stack frame for the call site of the function. Unlike 50 | -- 'HasCallStack', this is not a "magic" constraint that is automagically 51 | -- solved by GHC, which means that calling a function with this constraint 52 | -- will cause GHC to ask you to add this constraint to your own function. 53 | -- 54 | -- For example, let's say you have a function @unsafeHead :: 'RequireCallStack' => 55 | -- [a] -> a@. Then you go to call that function: 56 | -- 57 | -- @ 58 | -- myCoolFunction :: [Int] -> Int 59 | -- myCoolFunction = unsafeHead 60 | -- @ 61 | -- 62 | -- GHC will complain about the lack of the 'RequireCallStack' constraint. 63 | -- You will have two options: 64 | -- 65 | -- 1. Add the constraint to your functions. This is a good option because 66 | -- it means the callstack from @unsafeHead@ will include the 67 | -- @myCoolFunction@ callsite as well. 68 | -- 69 | -- @ 70 | -- myCoolFunction :: RequireCallStack => [Int] -> Int 71 | -- myCoolFunction = unsafeHead 72 | -- @ 73 | -- 74 | -- 2. Use 'provideCallStack' to silence the error. This will truncate the 75 | -- callstack unless you use 'HasCallStack' above. You should only do 76 | -- this if you're confident that you don't need any debugging 77 | -- information from a more complete callstack. 78 | -- 79 | -- @ 80 | -- myCoolFunction :: [Int] -> Int 81 | -- myCoolFunction = 'provideCallStack' unsafeHead 82 | -- @ 83 | -- 84 | -- @since 0.1.0.0 85 | type RequireCallStack = (HasCallStack, RequireCallStackImpl) 86 | 87 | -- | If you're running into this class, then you need to add 88 | -- 'RequireCallStack' to your function's signature, or discharge the 89 | -- constraint using 'provideCallStack'. 90 | -- 91 | -- See 'RequireCallStack' for more information. 92 | -- 93 | -- @since 0.1.0.0 94 | type RequireCallStackImpl = ?provideCallStack :: ProvideCallStack 95 | 96 | -- | The constructor for this type is intentionally not exported 97 | data ProvideCallStack = ProvideCallStack 98 | 99 | -- | Raise an 'Control.Exception.ErrorCall' and incur a 'RequireCallStack' 100 | -- constraint while you do so. This variant will ensure that callers of 101 | -- unsafe functions are required to provide a callstack until explicitly 102 | -- cut off with 'provideCallStack'. 103 | -- 104 | -- @since 0.1.0.0 105 | errorRequireCallStack :: RequireCallStack => String -> x 106 | errorRequireCallStack = error 107 | 108 | instance TypeError ('Text "Add RequireCallStack to your function context or use provideCallStack") => IP "provideCallStack" ProvideCallStack 109 | 110 | -- | Satisfy a 'RequireCallStack' constraint for the given block. Can be 111 | -- used instead of propagating a 'RequireCallStack' up the call graph. 112 | -- 113 | -- Usage: 114 | -- 115 | -- @ 116 | -- main :: `IO` () 117 | -- main = do 118 | -- `provideCallStack` `$` do 119 | -- `errorRequireCallStack` "hello" 120 | -- @ 121 | -- 122 | -- Note how @main@ does not have a 'HasCallStack' or 'RequireCallStack' 123 | -- constraint. This function eliminates them, so that 124 | -- 'errorRequireCallStack' can be called without compilation error. 125 | -- 126 | -- @since 0.1.0.0 127 | provideCallStack :: (RequireCallStackImpl => r) -> r 128 | provideCallStack r = r 129 | where 130 | ?provideCallStack = ProvideCallStack 131 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # https://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # 15 | # The location of a snapshot can be provided as a file or url. Stack assumes 16 | # a snapshot provided as a file might change, whereas a url resource does not. 17 | # 18 | # resolver: ./custom-snapshot.yaml 19 | # resolver: https://example.com/snapshots/2018-01-01.yaml 20 | resolver: 21 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2023/7/6.yaml 22 | 23 | # User packages to be built. 24 | # Various formats can be used as shown in the example below. 25 | # 26 | # packages: 27 | # - some-directory 28 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 29 | # subdirs: 30 | # - auto-update 31 | # - wai 32 | packages: 33 | - . 34 | # Dependency packages to be pulled from upstream that are not in the resolver. 35 | # These entries can reference officially published versions as well as 36 | # forks / in-progress versions pinned to a git hash. For example: 37 | # 38 | # extra-deps: 39 | # - acme-missiles-0.3 40 | # - git: https://github.com/commercialhaskell/stack.git 41 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 42 | # 43 | # extra-deps: [] 44 | 45 | # Override default flag values for local packages and extra-deps 46 | # flags: {} 47 | 48 | # Extra package databases containing global packages 49 | # extra-package-dbs: [] 50 | 51 | # Control whether we use the GHC we find on the path 52 | # system-ghc: true 53 | # 54 | # Require a specific version of stack, using version ranges 55 | # require-stack-version: -any # Default 56 | # require-stack-version: ">=2.9" 57 | # 58 | # Override the architecture used by stack, especially useful on Windows 59 | # arch: i386 60 | # arch: x86_64 61 | # 62 | # Extra directories used by stack for building 63 | # extra-include-dirs: [/path/to/dir] 64 | # extra-lib-dirs: [/path/to/dir] 65 | # 66 | # Allow a newer minor version of GHC than the snapshot specifies 67 | # compiler-check: newer-minor 68 | -------------------------------------------------------------------------------- /test/Main.hs: -------------------------------------------------------------------------------- 1 | {-# language FlexibleContexts #-} 2 | 3 | module Main (main) where 4 | 5 | import RequireCallStack (RequireCallStack, provideCallStack) 6 | import Control.Exception 7 | 8 | panic :: RequireCallStack => String -> IO a 9 | panic = error 10 | 11 | foo :: RequireCallStack => Int -> IO String 12 | foo _ = panic "foo" 13 | 14 | bar :: RequireCallStack => Int -> IO String 15 | bar = foo 16 | 17 | baz :: Int -> IO String 18 | baz = provideCallStack bar 19 | 20 | main :: IO () 21 | main = do 22 | -- won't work, no callstack 23 | -- panic "asdf" 24 | 25 | provideCallStack $ do 26 | -- panic "one level of provide callstack" 27 | pure () 28 | 29 | Left (ErrorCall "foo") <- try $ baz 3 30 | 31 | 32 | -- bar 3 33 | 34 | pure () 35 | --------------------------------------------------------------------------------