git.iko.soy/typeable/haskell-stack-trace-plugin
on d18c37a help sign in
6624a59
swap
0 ahead, 22 behind
.github/workflows/cabal.yml+28−16
since splitsnapshots
unifiedsplit
@@ -2,9 +2,13 @@ name: cabal
2
2
3on:
3on:
4 push:
4 push:
5− branches: [ master ]
5+ branches:
6+ - master
7+ tags-ignore:
8+ - '*'
6 pull_request:
9 pull_request:
7− branches: [ '*' ]
10+ branches:
11+ - '*'
8 schedule:
12 schedule:
9 - cron: "00 15 * * *"
13 - cron: "00 15 * * *"
10
14
@@ -13,32 +17,40 @@ jobs:
13 runs-on: ubuntu-18.04
17 runs-on: ubuntu-18.04
14 strategy:
18 strategy:
15 matrix:
19 matrix:
16− ghc: ["8.6", "8.8", "8.10", "9.0"]
20+ ghc: ["8.6.5", "8.8.1", "8.10.4"]
17− cabal: ["3.2"]
21+ cabal: ["3.0"]
18− cache-version: ["2021-05-21"]
19
22
20 steps:
23 steps:
21 - uses: actions/checkout@v2
24 - uses: actions/checkout@v2
22− - uses: haskell/actions/setup@v1
25+ - uses: actions/setup-haskell@v1
23 with:
26 with:
24 ghc-version: ${{ matrix.ghc }}
27 ghc-version: ${{ matrix.ghc }}
25 cabal-version: ${{ matrix.cabal }}
28 cabal-version: ${{ matrix.cabal }}
26
29
30+ - name: Display ghc & cabal version
31+ run: |
32+ ghc -V
33+ cabal -V
34+
27 - name: Cache ~/.cabal/store
35 - name: Cache ~/.cabal/store
28− uses: actions/cache@v2
36+ uses: actions/cache@v1.1.0
37+ with:
38+ path: ~/.cabal/store
39+ key: ${{ matrix.ghc }}-v0-cabal-store-${{ hashFiles('*.cabal') }}
40+
41+ - name: Cache dist-newstyle
42+ uses: actions/cache@v1.1.0
29 with:
43 with:
30− path: |
31− ~/.cabal/store
32− dist-newstyle
44+ path: dist-newstyle
33− key: ${{ runner.os }}-${{ matrix.ghc }}-${{ matrix.cache-version }}-cabal
45+ key: ${{ matrix.ghc }}-v0-cabal-dist-${{ hashFiles('*.cabal') }}
34
46
35 - name: Install dependencies
47 - name: Install dependencies
36 run: |
48 run: |
37− cabal update
49+ cabal v2-update
38− cabal configure --disable-optimization --enable-tests --write-ghc-environment-files=always -j2
50+ cabal v2-configure --disable-optimization --enable-tests --write-ghc-environment-files=always -j2
39− cabal build --only-dependencies
51+ cabal v2-build --only-dependencies
40
52
41 - name: Build & Test
53 - name: Build & Test
42 run: |
54 run: |
43− cabal build --flag dev
55+ cabal v2-build --flag dev
44− cabal test --flag dev
56+ cabal v2-test --flag dev
.gitignore+1−2
@@ -3,5 +3,4 @@ dist-*/
3.ghc.environment.*
3.ghc.environment.*
4cabal.project.local
4cabal.project.local
5
5
6−*~
6+*~
7−tasks.json
CHANGELOG.md−10
@@ -2,16 +2,6 @@
2
2
3## Unreleased changes
3## Unreleased changes
4
4
5−## 0.1.3.0
6−
7−- Added support `where` clause [#11](https://github.com/waddlaw/haskell-stack-trace-plugin/pull/11) (@waddlaw)
8−- Avoid redundant-constraints warnings [#12](https://github.com/waddlaw/haskell-stack-trace-plugin/pull/12) (@waddlaw)
9−
10−## 0.1.2.0 -- 2021-05-21
11−
12−- Added support for GHC 8.10 [#7](https://github.com/waddlaw/haskell-stack-trace-plugin/pull/7) (@etorreborre)
13−- Added support for GHC 9.0 @waddlaw
14−
15## 0.1.1.1 -- 2020-01-18
5## 0.1.1.1 -- 2020-01-18
16
6
17- Allow GHC-8.8.1
7- Allow GHC-8.8.1
LICENSE+1−1
@@ -1,4 +1,4 @@
1−Copyright (c) 2018-2021 Shinya Yamaguchi
1+Copyright (c) 2018-2020 Shinya Yamaguchi
2
2
3Permission is hereby granted, free of charge, to any person obtaining
3Permission is hereby granted, free of charge, to any person obtaining
4a copy of this software and associated documentation files (the
4a copy of this software and associated documentation files (the
Readme.md+22−30
@@ -5,10 +5,8 @@
5
5
6This plugin allow implicitly add `HasCallStack` class to every top-level function for all module. Hence, we can to get completely continuous call stack.
6This plugin allow implicitly add `HasCallStack` class to every top-level function for all module. Hence, we can to get completely continuous call stack.
7
7
8−1. (implicitly) Import [GHC.Stack](https://hackage.haskell.org/package/base/docs/GHC-Stack.html) for all modules.
8+1. (implicitly) Import [GHC.Stack](https://hackage.haskell.org/package/base-4.12.0.0/docs/GHC-Stack.html) for all modules.
9−2. Add [HasCallStack](https://hackage.haskell.org/package/base/docs/GHC-Stack.html#t:HasCallStack) constraint for all top-level functions.
9+2. Add [HasCallStack](https://hackage.haskell.org/package/base-4.12.0.0/docs/GHC-Stack.html#t:HasCallStack) constraint for all top-level functions.
10−3. Other supported syntaxes
11− - [x] `where` clause
12
10
13Requirement: (8.6 <= on GHC)
11Requirement: (8.6 <= on GHC)
14
12
@@ -34,10 +32,10 @@ f3 = f4 0
34
32
35-- HsQualTy
33-- HsQualTy
36f4 :: Show a => a -> Int
34f4 :: Show a => a -> Int
37−f4 n = f5 (show n) 0
35+f4 _ = f5 0 0
38
36
39-- HsFunTy
37-- HsFunTy
40−f5 :: String -> Int -> Int
38+f5 :: Int -> Int -> Int
41f5 _ _ = head f6
39f5 _ _ = head f6
42
40
43-- HsListTy
41-- HsListTy
@@ -50,13 +48,7 @@ f7 = (fromJust f8, fromJust f8)
50
48
51-- HsAppTy
49-- HsAppTy
52f8 :: Maybe Int
50f8 :: Maybe Int
53−f8 = Just f9
51+f8 = Just fError
54−
55−f9 :: Int
56−f9 = f10
57− where
58− f10 :: Int
59− f10 = fError
60
52
61-- HsTyVar
53-- HsTyVar
62fError :: Int
54fError :: Int
@@ -66,7 +58,7 @@ fError = error "fError"
66This example get error:
58This example get error:
67
59
68```shell
60```shell
69−$ cabal build
61+$ cabal new-build
70example/Main.hs:15:7: error:
62example/Main.hs:15:7: error:
71 Not in scope: type constructor or class ‘HasCallStack’
63 Not in scope: type constructor or class ‘HasCallStack’
72 |
64 |
@@ -79,10 +71,10 @@ Yes, add `import GHC.Stack` to above example.
79Fix and rebuild!
71Fix and rebuild!
80
72
81```shell
73```shell
82−$ cabal run example -v0
74+$ cabal new-run
83example: fError
75example: fError
84CallStack (from HasCallStack):
76CallStack (from HasCallStack):
85− error, called at example/Main.hs:47:10 in main:Main
77+ error, called at example/Main.hs:41:10 in main:Main
86```
78```
87
79
88Hmm, it is not useful. But, you will to be happy when enable this plugin.
80Hmm, it is not useful. But, you will to be happy when enable this plugin.
@@ -93,22 +85,22 @@ Hmm, it is not useful. But, you will to be happy when enable this plugin.
93```
85```
94
86
95```shell
87```shell
96−$ cabal run example -v0
88+$ cabal new-run
89+...
90+
97example: fError
91example: fError
98CallStack (from HasCallStack):
92CallStack (from HasCallStack):
99− error, called at example/Main.hs:47:10 in main:Main
93+ error, called at example/Main.hs:40:10 in main:Main
100− fError, called at example/Main.hs:43:11 in main:Main
101− f10, called at example/Main.hs:40:6 in main:Main
102− f9, called at example/Main.hs:37:11 in main:Main
94+ fError, called at example/Main.hs:36:11 in main:Main
103− f8, called at example/Main.hs:33:16 in main:Main
95+ f8, called at example/Main.hs:32:16 in main:Main
104− f7, called at example/Main.hs:29:11 in main:Main
96+ f7, called at example/Main.hs:28:11 in main:Main
105− f6, called at example/Main.hs:25:15 in main:Main
97+ f6, called at example/Main.hs:24:15 in main:Main
106− f5, called at example/Main.hs:21:8 in main:Main
98+ f5, called at example/Main.hs:20:8 in main:Main
107− f4, called at example/Main.hs:17:6 in main:Main
99+ f4, called at example/Main.hs:16:6 in main:Main
108− f3, called at example/Main.hs:13:6 in main:Main
100+ f3, called at example/Main.hs:12:6 in main:Main
109− f2, called at example/Main.hs:10:6 in main:Main
101+ f2, called at example/Main.hs:9:6 in main:Main
110− f1, called at example/Main.hs:7:14 in main:Main
102+ f1, called at example/Main.hs:6:14 in main:Main
111− main, called at example/Main.hs:7:1 in main:Main
103+ main, called at example/Main.hs:6:1 in main:Main
112```
104```
113
105
114Great!!!
106Great!!!
example/Main.hs+3−9
@@ -18,10 +18,10 @@ f3 = f4 0
18
18
19-- HsQualTy
19-- HsQualTy
20f4 :: Show a => a -> Int
20f4 :: Show a => a -> Int
21−f4 n = f5 (show n) 0
21+f4 _ = f5 0 0
22
22
23-- HsFunTy
23-- HsFunTy
24−f5 :: String -> Int -> Int
24+f5 :: Int -> Int -> Int
25f5 _ _ = head f6
25f5 _ _ = head f6
26
26
27-- HsListTy
27-- HsListTy
@@ -34,13 +34,7 @@ f7 = (fromJust f8, fromJust f8)
34
34
35-- HsAppTy
35-- HsAppTy
36f8 :: Maybe Int
36f8 :: Maybe Int
37−f8 = Just f9
37+f8 = Just fError
38−
39−f9 :: Int
40−f9 = f10
41− where
42− f10 :: Int
43− f10 = fError
44
38
45-- HsTyVar
39-- HsTyVar
46fError :: Int
40fError :: Int
haskell-stack-trace-plugin.cabal+14−12
@@ -1,6 +1,6 @@
1cabal-version: 2.4
1cabal-version: 2.4
2name: haskell-stack-trace-plugin
2name: haskell-stack-trace-plugin
3−version: 0.1.3.0
3+version: 0.1.2.0
4synopsis: haskell-stack-trace-plugin
4synopsis: haskell-stack-trace-plugin
5description:
5description:
6 This plugin allow implicitly add HasCallStack class to every top-level function for all module. Hence, we can to get completely continuous call stack.
6 This plugin allow implicitly add HasCallStack class to every top-level function for all module. Hence, we can to get completely continuous call stack.
@@ -12,15 +12,15 @@ bug-reports:
12license: MIT
12license: MIT
13license-file: LICENSE
13license-file: LICENSE
14author: Shinya Yamaguchi
14author: Shinya Yamaguchi
15−maintainer: a@wado.dev
15+maintainer: ingronze@gmail.com
16−copyright: 2018-2021 Shinya Yamaguchi
16+copyright: 2018-2020 Shinya Yamaguchi
17category: Compiler Plugin, Development, Debug
17category: Compiler Plugin, Development, Debug
18build-type: Simple
18build-type: Simple
19extra-source-files:
19extra-source-files:
20 CHANGELOG.md
20 CHANGELOG.md
21 Readme.md
21 Readme.md
22
22
23−tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
23+tested-with: GHC ==8.6.5 || ==8.8.1 || ==8.10.4
24
24
25source-repository head
25source-repository head
26 type: git
26 type: git
@@ -32,20 +32,22 @@ flag dev
32 default: False
32 default: False
33
33
34common common-opts
34common common-opts
35− build-depends: base >=4.12 && <4.18
35+ build-depends: base >=4.12 && <4.15
36 default-language: Haskell2010
36 default-language: Haskell2010
37
37
38library
38library
39 import: common-opts
39 import: common-opts
40 hs-source-dirs: src
40 hs-source-dirs: src
41− build-depends: ghc ^>=8.6 || ^>=8.8 || ^>=8.10 || ^>=9.0 || ^>=9.2 || ^>=9.4
41+ build-depends: ghc ^>=8.6 || ^>=8.8 || ^>=8.10
42 exposed-modules: StackTrace.Plugin
42 exposed-modules: StackTrace.Plugin
43
43
44 if flag(dev)
44 if flag(dev)
45 ghc-options:
45 ghc-options:
46 -Wall -Werror -Wcompat -Wincomplete-uni-patterns
46 -Wall -Werror -Wcompat -Wincomplete-uni-patterns
47− -Wnoncanonical-monad-instances -Wno-missing-home-modules
47+ -Wnoncanonical-monad-instances
48+ -Wno-missing-home-modules
48
49
50+ -- -Wincomplete-record-updates
49 else
51 else
50 ghc-options: -Wall
52 ghc-options: -Wall
51
53
@@ -55,11 +57,11 @@ test-suite test
55 hs-source-dirs: test
57 hs-source-dirs: test
56 type: exitcode-stdio-1.0
58 type: exitcode-stdio-1.0
57 build-depends:
59 build-depends:
58− , bytestring >=0.10 && <0.12
60+ , bytestring ^>=0.10
59− , hspec ^>=2.8
61+ , hspec ^>=2.7
60− , typed-process ^>=0.2
62+ , typed-process ^>=0.2.6
61
63
62− build-tool-depends: hspec-discover:hspec-discover ^>=2.8
64+ build-tool-depends: hspec-discover:hspec-discover ^>=2.7
63 other-modules: StackTrace.PluginSpec
65 other-modules: StackTrace.PluginSpec
64
66
65 if flag(dev)
67 if flag(dev)
@@ -72,5 +74,5 @@ executable example
72 import: common-opts
74 import: common-opts
73 main-is: Main.hs
75 main-is: Main.hs
74 hs-source-dirs: example
76 hs-source-dirs: example
75− ghc-options: -fplugin=StackTrace.Plugin -Wredundant-constraints
77+ ghc-options: -fplugin=StackTrace.Plugin
76 build-depends: haskell-stack-trace-plugin
78 build-depends: haskell-stack-trace-plugin
src/StackTrace/Plugin.hs+7−81
@@ -5,13 +5,7 @@ module StackTrace.Plugin (plugin) where
5
5
6import Control.Arrow (first)
6import Control.Arrow (first)
7import Data.Monoid (Any(Any, getAny))
7import Data.Monoid (Any(Any, getAny))
8−import GHC.Types.SrcLoc
9−#if __GLASGOW_HASKELL__ >= 900
10−import GHC.Plugins
11−#else
12−
13import GhcPlugins
8import GhcPlugins
14−#endif
15#if __GLASGOW_HASKELL__ >= 810
9#if __GLASGOW_HASKELL__ >= 810
16import GHC.Hs
10import GHC.Hs
17#endif
11#endif
@@ -50,20 +44,11 @@ importDeclQualified = QualifiedPre
50
44
51ghcStackImport :: Located (ImportDecl (GhcPass p))
45ghcStackImport :: Located (ImportDecl (GhcPass p))
52ghcStackImport =
46ghcStackImport =
53− L srcSpan $
47+ noLoc $
54 (simpleImportDecl $ mkModuleName "GHC.Stack")
48 (simpleImportDecl $ mkModuleName "GHC.Stack")
55− { ideclQualified = importDeclQualified, ideclAs = Just $ noLoc ghcStackModuleName }
49+ {ideclQualified = importDeclQualified, ideclAs = Just $ noLoc ghcStackModuleName}
56− where
57− -- This is for GHC-9 related problems. @noLoc@ causes GHC to throw warnings
58− -- about unused imports. Even if the import is used
59− -- See: https://github.com/waddlaw/haskell-stack-trace-plugin/issues/16
60− srcSpan = RealSrcSpan (realSrcLocSpan $ mkRealSrcLoc "haskell-stack-trace-plugin:very-unique-file-name-to-avoid-collision" 1 1) Nothing
61
50
62−#if __GLASGOW_HASKELL__ >= 900
63−updateHsModule :: HsModule -> HsModule
64−#else
65updateHsModule :: HsModule GhcPs -> HsModule GhcPs
51updateHsModule :: HsModule GhcPs -> HsModule GhcPs
66−#endif
67updateHsModule hsm =
52updateHsModule hsm =
68 hsm {hsmodImports = hsmodImports', hsmodDecls = hsmodDecls'}
53 hsm {hsmodImports = hsmodImports', hsmodDecls = hsmodDecls'}
69 where
54 where
@@ -85,6 +70,7 @@ updateHsModule hsm =
85 astTraversal :: Traversal' (LHsDecl GhcPs) (HsType GhcPs)
70 astTraversal :: Traversal' (LHsDecl GhcPs) (HsType GhcPs)
86 astTraversal = updateHsmodDecl
71 astTraversal = updateHsmodDecl
87 . updateHsDecl
72 . updateHsDecl
73+ . updateSig
88 . updateLHsSigWsType
74 . updateLHsSigWsType
89 . updateLHsSigType
75 . updateLHsSigType
90 . updateLHsType
76 . updateLHsType
@@ -93,56 +79,10 @@ updateHsModule hsm =
93updateHsmodDecl :: Traversal' (LHsDecl GhcPs) (HsDecl GhcPs)
79updateHsmodDecl :: Traversal' (LHsDecl GhcPs) (HsDecl GhcPs)
94updateHsmodDecl = traverse
80updateHsmodDecl = traverse
95
81
96−updateHsDecl :: Traversal' (HsDecl GhcPs) (LHsSigWcType GhcPs)
82+updateHsDecl :: Traversal' (HsDecl GhcPs) (Sig GhcPs)
97−updateHsDecl f (SigD xSig s) = SigD xSig <$> updateSig f s
83+updateHsDecl f (SigD xSig s) = SigD xSig <$> f s
98−updateHsDecl f (ValD xVal hsBind) = ValD xVal <$> updateHsBind f hsBind
99updateHsDecl _ sig = pure sig
84updateHsDecl _ sig = pure sig
100
85
101−updateHsBind :: Traversal' (HsBind GhcPs) (LHsSigWcType GhcPs)
102−updateHsBind f bind@FunBind {} = (\x -> bind {fun_matches = x}) <$> updateMatchGroup f (fun_matches bind)
103−updateHsBind _ bind = pure bind
104−
105−updateMatchGroup :: Traversal' (MatchGroup GhcPs (LHsExpr GhcPs)) (LHsSigWcType GhcPs)
106−updateMatchGroup f mg@MG {} = (\x -> mg {mg_alts = x}) <$> updateLLMatch f (mg_alts mg)
107−#if __GLASGOW_HASKELL__ < 900
108−updateMatchGroup _ mg = pure mg
109−#endif
110−
111−updateLocated :: Functor f => (a -> b -> f c) -> a -> Located b -> f (Located c)
112−updateLocated f g (L l e) = L l <$> f g e
113−
114−updateLLMatch :: Traversal' (Located [LMatch GhcPs (LHsExpr GhcPs)]) (LHsSigWcType GhcPs)
115−updateLLMatch = updateLocated updateLMatches
116−
117−updateLMatches :: Traversal' [LMatch GhcPs (LHsExpr GhcPs)] (LHsSigWcType GhcPs)
118−updateLMatches f = traverse (updateLocated updateMatch f)
119−
120−updateMatch :: Traversal' (Match GhcPs (LHsExpr GhcPs)) (LHsSigWcType GhcPs)
121−updateMatch f m@Match {} = (\x -> m {m_grhss = x}) <$> updateGrhss f (m_grhss m)
122−#if __GLASGOW_HASKELL__ < 900
123−updateMatch _ m = pure m
124−#endif
125−
126−updateGrhss :: Traversal' (GRHSs GhcPs (LHsExpr GhcPs)) (LHsSigWcType GhcPs)
127−updateGrhss f grhss@GRHSs {} = (\x -> grhss {grhssLocalBinds = x}) <$> updateLHsLocalBinds f (grhssLocalBinds grhss)
128−#if __GLASGOW_HASKELL__ < 900
129−updateGrhss _ grhss = pure grhss
130−#endif
131−
132−updateLHsLocalBinds :: Traversal' (LHsLocalBinds GhcPs) (LHsSigWcType GhcPs)
133−updateLHsLocalBinds = updateLocated updateLocalBinds
134−
135−updateLocalBinds :: Traversal' (HsLocalBinds GhcPs) (LHsSigWcType GhcPs)
136−updateLocalBinds f (HsValBinds xHsValBinds hsValBindsLR) = HsValBinds xHsValBinds <$> updateHsValBindsLR f hsValBindsLR
137−updateLocalBinds _ hsValBinds = pure hsValBinds
138−
139−updateHsValBindsLR :: Traversal' (HsValBindsLR GhcPs GhcPs) (LHsSigWcType GhcPs)
140−updateHsValBindsLR f (ValBinds xValBinds lHsBindsLR lSigs) = ValBinds xValBinds lHsBindsLR <$> updateLSigs f lSigs
141−updateHsValBindsLR _ valBinds = pure valBinds
142−
143−updateLSigs :: Traversal' [LSig GhcPs] (LHsSigWcType GhcPs)
144−updateLSigs f = traverse (updateLocated updateSig f)
145−
146updateSig :: Traversal' (Sig GhcPs) (LHsSigWcType GhcPs)
86updateSig :: Traversal' (Sig GhcPs) (LHsSigWcType GhcPs)
147updateSig f (TypeSig xSig ls t) = TypeSig xSig ls <$> f t
87updateSig f (TypeSig xSig ls t) = TypeSig xSig ls <$> f t
148updateSig _ sig = pure sig
88updateSig _ sig = pure sig
@@ -150,26 +90,20 @@ updateSig _ sig = pure sig
150updateLHsSigWsType :: Traversal' (LHsSigWcType GhcPs) (LHsSigType GhcPs)
90updateLHsSigWsType :: Traversal' (LHsSigWcType GhcPs) (LHsSigType GhcPs)
151updateLHsSigWsType f lhs@HsWC {} =
91updateLHsSigWsType f lhs@HsWC {} =
152 (\x -> lhs {hswc_body = x}) <$> f (hswc_body lhs)
92 (\x -> lhs {hswc_body = x}) <$> f (hswc_body lhs)
153−#if __GLASGOW_HASKELL__ < 900
154updateLHsSigWsType _ lhs = pure lhs
93updateLHsSigWsType _ lhs = pure lhs
155−#endif
156
94
157updateLHsSigType :: Traversal' (LHsSigType GhcPs) (LHsType GhcPs)
95updateLHsSigType :: Traversal' (LHsSigType GhcPs) (LHsType GhcPs)
158updateLHsSigType f lhs@HsIB {} =
96updateLHsSigType f lhs@HsIB {} =
159 (\x -> lhs {hsib_body = x}) <$> f (hsib_body lhs)
97 (\x -> lhs {hsib_body = x}) <$> f (hsib_body lhs)
160−#if __GLASGOW_HASKELL__ < 900
161updateLHsSigType _ lhs = pure lhs
98updateLHsSigType _ lhs = pure lhs
162−#endif
163
99
164updateLHsType :: Traversal' (LHsType GhcPs) (HsType GhcPs)
100updateLHsType :: Traversal' (LHsType GhcPs) (HsType GhcPs)
165updateLHsType = traverse
101updateLHsType = traverse
166
102
167-- Main process
103-- Main process
168updateHsType :: HsType GhcPs -> (Any, HsType GhcPs)
104updateHsType :: HsType GhcPs -> (Any, HsType GhcPs)
169−updateHsType ty@(HsQualTy xty ctxt body) =
105+updateHsType (HsQualTy xty ctxt body) =
170− if hasHasCallStack (unLoc ctxt)
171− then pure ty
172− else flagASTModified $ HsQualTy xty (fmap appendHSC ctxt) body
106+ flagASTModified $ HsQualTy xty (fmap appendHSC ctxt) body
173updateHsType ty@HsTyVar {} =
107updateHsType ty@HsTyVar {} =
174 flagASTModified $ HsQualTy xQualTy (noLoc $ appendHSC []) (noLoc ty)
108 flagASTModified $ HsQualTy xQualTy (noLoc $ appendHSC []) (noLoc ty)
175updateHsType ty@HsAppTy {} =
109updateHsType ty@HsAppTy {} =
@@ -183,7 +117,6 @@ updateHsType ty@HsTupleTy {} =
183updateHsType ty = pure ty
117updateHsType ty = pure ty
184
118
185#if __GLASGOW_HASKELL__ < 810
119#if __GLASGOW_HASKELL__ < 810
186−xQualTy :: NoExt
187xQualTy = noExt
120xQualTy = noExt
188#else
121#else
189xQualTy :: NoExtField
122xQualTy :: NoExtField
@@ -196,13 +129,6 @@ flagASTModified a = (Any True, a)
196appendHSC :: HsContext GhcPs -> HsContext GhcPs
129appendHSC :: HsContext GhcPs -> HsContext GhcPs
197appendHSC cs = mkHSC : cs
130appendHSC cs = mkHSC : cs
198
131
199−hasHasCallStack :: HsContext GhcPs -> Bool
200−hasHasCallStack = any (checkHsType . unLoc)
201− where
202− checkHsType :: HsType GhcPs -> Bool
203− checkHsType (HsTyVar _ _ lid) = unLoc lid == (mkRdrUnqual $ mkClsOcc "HasCallStack")
204− checkHsType _ = False
205−
206-- make HasCallStack => constraint
132-- make HasCallStack => constraint
207mkHSC :: LHsType GhcPs
133mkHSC :: LHsType GhcPs
208mkHSC = noLoc $ HsTyVar xQualTy NotPromoted lId
134mkHSC = noLoc $ HsTyVar xQualTy NotPromoted lId
test/resource/ghc.output+2−4
@@ -1,9 +1,7 @@
1example: fError
1example: fError
2CallStack (from HasCallStack):
2CallStack (from HasCallStack):
3− error, called at example/Main.hs:47:10 in main:Main
3+ error, called at example/Main.hs:41:10 in main:Main
4− fError, called at example/Main.hs:43:11 in main:Main
4+ fError, called at example/Main.hs:37:11 in main:Main
5− f10, called at example/Main.hs:40:6 in main:Main
6− f9, called at example/Main.hs:37:11 in main:Main
7 f8, called at example/Main.hs:33:16 in main:Main
5 f8, called at example/Main.hs:33:16 in main:Main
8 f7, called at example/Main.hs:29:11 in main:Main
6 f7, called at example/Main.hs:29:11 in main:Main
9 f6, called at example/Main.hs:25:15 in main:Main
7 f6, called at example/Main.hs:25:15 in main:Main