git.iko.soy/typeable/haskell-stack-trace-plugin
on master help sign in
Avoid redundant-constraints warnings (fixes #9)
4154d9ewaddlaw
CHANGELOG.md+1
compare with master
unifiedsplit
@@ -5,6 +5,7 @@
5## 0.1.3.0
5## 0.1.3.0
6
6
7- Added support `where` clause [#11](https://github.com/waddlaw/haskell-stack-trace-plugin/pull/11) (@waddlaw)
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)
8
9
9## 0.1.2.0 -- 2021-05-21
10## 0.1.2.0 -- 2021-05-21
10
11
Readme.md+2−2
@@ -32,10 +32,10 @@ f3 = f4 0
32
32
33-- HsQualTy
33-- HsQualTy
34f4 :: Show a => a -> Int
34f4 :: Show a => a -> Int
35−f4 _ = f5 0 0
35+f4 n = f5 (show n) 0
36
36
37-- HsFunTy
37-- HsFunTy
38−f5 :: Int -> Int -> Int
38+f5 :: String -> Int -> Int
39f5 _ _ = head f6
39f5 _ _ = head f6
40
40
41-- HsListTy
41-- HsListTy
example/Main.hs+2−2
@@ -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 _ = f5 0 0
21+f4 n = f5 (show n) 0
22
22
23-- HsFunTy
23-- HsFunTy
24−f5 :: Int -> Int -> Int
24+f5 :: String -> Int -> Int
25f5 _ _ = head f6
25f5 _ _ = head f6
26
26
27-- HsListTy
27-- HsListTy
haskell-stack-trace-plugin.cabal+1−1
@@ -72,5 +72,5 @@ executable example
72 import: common-opts
72 import: common-opts
73 main-is: Main.hs
73 main-is: Main.hs
74 hs-source-dirs: example
74 hs-source-dirs: example
75− ghc-options: -fplugin=StackTrace.Plugin
75+ ghc-options: -fplugin=StackTrace.Plugin -Wredundant-constraints
76 build-depends: haskell-stack-trace-plugin
76 build-depends: haskell-stack-trace-plugin
src/StackTrace/Plugin.hs+11−2
@@ -160,8 +160,10 @@ updateLHsType = traverse
160
160
161-- Main process
161-- Main process
162updateHsType :: HsType GhcPs -> (Any, HsType GhcPs)
162updateHsType :: HsType GhcPs -> (Any, HsType GhcPs)
163−updateHsType (HsQualTy xty ctxt body) =
163+updateHsType ty@(HsQualTy xty ctxt body) =
164+ if hasHasCallStack (unLoc ctxt)
165+ then pure ty
164− flagASTModified $ HsQualTy xty (fmap appendHSC ctxt) body
166+ else flagASTModified $ HsQualTy xty (fmap appendHSC ctxt) body
165updateHsType ty@HsTyVar {} =
167updateHsType ty@HsTyVar {} =
166 flagASTModified $ HsQualTy xQualTy (noLoc $ appendHSC []) (noLoc ty)
168 flagASTModified $ HsQualTy xQualTy (noLoc $ appendHSC []) (noLoc ty)
167updateHsType ty@HsAppTy {} =
169updateHsType ty@HsAppTy {} =
@@ -188,6 +190,13 @@ flagASTModified a = (Any True, a)
188appendHSC :: HsContext GhcPs -> HsContext GhcPs
190appendHSC :: HsContext GhcPs -> HsContext GhcPs
189appendHSC cs = mkHSC : cs
191appendHSC cs = mkHSC : cs
190
192
193+hasHasCallStack :: HsContext GhcPs -> Bool
194+hasHasCallStack = any (checkHsType . unLoc)
195+ where
196+ checkHsType :: HsType GhcPs -> Bool
197+ checkHsType (HsTyVar _ _ lid) = unLoc lid == (mkRdrUnqual $ mkClsOcc "HasCallStack")
198+ checkHsType _ = False
199+
191-- make HasCallStack => constraint
200-- make HasCallStack => constraint
192mkHSC :: LHsType GhcPs
201mkHSC :: LHsType GhcPs
193mkHSC = noLoc $ HsTyVar xQualTy NotPromoted lId
202mkHSC = noLoc $ HsTyVar xQualTy NotPromoted lId