git.iko.soy/typeable/haskell-stack-trace-plugin
on f5e9de9 help sign in
6624a59
swap
0 ahead, 15 behind
5 files changed+14−32
since splitsnapshots
unifiedsplit
CHANGELOG.md−1 Readme.md+4−6 example/Main.hs+2−2 haskell-stack-trace-plugin.cabal+3−3 src/StackTrace/Plugin.hs+5−20
CHANGELOG.md−1
@@ -5,7 +5,6 @@
55## 0.1.3.0
66
77- 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)
98
109## 0.1.2.0 -- 2021-05-21
1110
Readme.md+4−6
@@ -5,10 +5,8 @@
55
66This plugin allow implicitly add `HasCallStack` class to every top-level function for all module. Hence, we can to get completely continuous call stack.
77
8−1. (implicitly) Import [GHC.Stack](https://hackage.haskell.org/package/base/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.
10−3. Other supported syntaxes
11− - [x] `where` clause
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-4.12.0.0/docs/GHC-Stack.html#t:HasCallStack) constraint for all top-level functions.
1210
1311Requirement: (8.6 <= on GHC)
1412
@@ -34,10 +32,10 @@ f3 = f4 0
3432
3533-- HsQualTy
3634f4 :: Show a => a -> Int
37−f4 n = f5 (show n) 0
35+f4 _ = f5 0 0
3836
3937-- HsFunTy
40−f5 :: String -> Int -> Int
38+f5 :: Int -> Int -> Int
4139f5 _ _ = head f6
4240
4341-- HsListTy
example/Main.hs+2−2
@@ -18,10 +18,10 @@ f3 = f4 0
1818
1919-- HsQualTy
2020f4 :: Show a => a -> Int
21−f4 n = f5 (show n) 0
21+f4 _ = f5 0 0
2222
2323-- HsFunTy
24−f5 :: String -> Int -> Int
24+f5 :: Int -> Int -> Int
2525f5 _ _ = head f6
2626
2727-- HsListTy
haskell-stack-trace-plugin.cabal+3−3
@@ -32,13 +32,13 @@ flag dev
3232 default: False
3333
3434common common-opts
35− build-depends: base >=4.12 && <4.18
35+ build-depends: base >=4.12 && <4.16
3636 default-language: Haskell2010
3737
3838library
3939 import: common-opts
4040 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 || ^>=9.0
4242 exposed-modules: StackTrace.Plugin
4343
4444 if flag(dev)
@@ -72,5 +72,5 @@ executable example
7272 import: common-opts
7373 main-is: Main.hs
7474 hs-source-dirs: example
75− ghc-options: -fplugin=StackTrace.Plugin -Wredundant-constraints
75+ ghc-options: -fplugin=StackTrace.Plugin
7676 build-depends: haskell-stack-trace-plugin
src/StackTrace/Plugin.hs+5−20
@@ -5,7 +5,6 @@ module StackTrace.Plugin (plugin) where
55
66import Control.Arrow (first)
77import Data.Monoid (Any(Any, getAny))
8−import GHC.Types.SrcLoc
98#if __GLASGOW_HASKELL__ >= 900
109import GHC.Plugins
1110#else
@@ -50,14 +49,9 @@ importDeclQualified = QualifiedPre
5049
5150ghcStackImport :: Located (ImportDecl (GhcPass p))
5251ghcStackImport =
53− L srcSpan $
52+ noLoc $
5453 (simpleImportDecl $ mkModuleName "GHC.Stack")
55− { 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
54+ {ideclQualified = importDeclQualified, ideclAs = Just $ noLoc ghcStackModuleName}
6155
6256#if __GLASGOW_HASKELL__ >= 900
6357updateHsModule :: HsModule -> HsModule
@@ -166,17 +160,15 @@ updateLHsType = traverse
166160
167161-- Main process
168162updateHsType :: HsType GhcPs -> (Any, HsType GhcPs)
169−updateHsType ty@(HsQualTy xty ctxt body) =
170− if hasHasCallStack (unLoc ctxt)
171− then pure ty
172− else flagASTModified $ HsQualTy xty (fmap appendHSC ctxt) body
163+updateHsType (HsQualTy xty ctxt body) =
164+ flagASTModified $ HsQualTy xty (fmap appendHSC ctxt) body
173165updateHsType ty@HsTyVar {} =
174166 flagASTModified $ HsQualTy xQualTy (noLoc $ appendHSC []) (noLoc ty)
175167updateHsType ty@HsAppTy {} =
176168 flagASTModified $ HsQualTy xQualTy (noLoc $ appendHSC []) (noLoc ty)
177169updateHsType ty@HsFunTy {} =
178170 flagASTModified $ HsQualTy xQualTy (noLoc $ appendHSC []) (noLoc ty)
179−updateHsType ty@HsListTy {} =
171+updateHsType ty@HsListTy {} =
180172 flagASTModified $ HsQualTy xQualTy (noLoc $ appendHSC []) (noLoc ty)
181173updateHsType ty@HsTupleTy {} =
182174 flagASTModified $ HsQualTy xQualTy (noLoc $ appendHSC []) (noLoc ty)
@@ -196,13 +188,6 @@ flagASTModified a = (Any True, a)
196188appendHSC :: HsContext GhcPs -> HsContext GhcPs
197189appendHSC cs = mkHSC : cs
198190
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−
206191-- make HasCallStack => constraint
207192mkHSC :: LHsType GhcPs
208193mkHSC = noLoc $ HsTyVar xQualTy NotPromoted lId