f5e9de9...master · typeable/haskell-stack-trace-plugin

git.iko.soy/typeable/haskell-stack-trace-plugin

CHANGELOG.md+1

since splitsnapshots

@@ -5,6 +5,7 @@

5## 0.1.3.0

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## 0.1.2.0 -- 2021-05-21

10## 0.1.2.0 -- 2021-05-21

Readme.md+6−4

@@ -5,8 +5,10 @@

6This plugin allow implicitly add `HasCallStack` class to every top-level function for all module. Hence, we can to get completely continuous call stack.

8−1. (implicitly) Import [GHC.Stack](https://hackage.haskell.org/package/base-4.12.0.0/docs/GHC-Stack.html) for all modules.

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-4.12.0.0/docs/GHC-Stack.html#t:HasCallStack) constraint for all top-level functions.

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

11Requirement: (8.6 <= on GHC)

13Requirement: (8.6 <= on GHC)

@@ -32,10 +34,10 @@ f3 = f4 0

33-- HsQualTy

35-- HsQualTy

34f4 :: Show a => a -> Int

36f4 :: Show a => a -> Int

35−f4 _ = f5 0 0

37+f4 n = f5 (show n) 0

37-- HsFunTy

39-- HsFunTy

38−f5 :: Int -> Int -> Int

40+f5 :: String -> Int -> Int

39f5 _ _ = head f6

41f5 _ _ = head f6

41-- HsListTy

43-- HsListTy

example/Main.hs+2−2

@@ -18,10 +18,10 @@ f3 = f4 0

19-- HsQualTy

20f4 :: Show a => a -> Int

21−f4 _ = f5 0 0

21+f4 n = f5 (show n) 0

23-- HsFunTy

24−f5 :: Int -> Int -> Int

24+f5 :: String -> Int -> Int

25f5 _ _ = head f6

27-- HsListTy

haskell-stack-trace-plugin.cabal+3−3

@@ -32,13 +32,13 @@ flag dev

32 default: False

34common common-opts

35− build-depends: base >=4.12 && <4.16

35+ build-depends: base >=4.12 && <4.18

36 default-language: Haskell2010

38library

39 import: common-opts

40 hs-source-dirs: src

41− build-depends: ghc ^>=8.6 || ^>=8.8 || ^>=8.10 || ^>=9.0

41+ build-depends: ghc ^>=8.6 || ^>=8.8 || ^>=8.10 || ^>=9.0 || ^>=9.2 || ^>=9.4

42 exposed-modules: StackTrace.Plugin

44 if flag(dev)

@@ -72,5 +72,5 @@ executable example

72 import: common-opts

73 main-is: Main.hs

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

src/StackTrace/Plugin.hs+20−5

@@ -5,6 +5,7 @@ module StackTrace.Plugin (plugin) where

6import Control.Arrow (first)

7import Data.Monoid (Any(Any, getAny))

8+import GHC.Types.SrcLoc

8#if __GLASGOW_HASKELL__ >= 900

9#if __GLASGOW_HASKELL__ >= 900

9import GHC.Plugins

10import GHC.Plugins

10#else

11#else

@@ -49,9 +50,14 @@ importDeclQualified = QualifiedPre

50ghcStackImport :: Located (ImportDecl (GhcPass p))

51ghcStackImport :: Located (ImportDecl (GhcPass p))

51ghcStackImport =

52ghcStackImport =

52− noLoc $

53+ L srcSpan $

53 (simpleImportDecl $ mkModuleName "GHC.Stack")

54 (simpleImportDecl $ mkModuleName "GHC.Stack")

54− {ideclQualified = importDeclQualified, ideclAs = Just $ noLoc ghcStackModuleName}

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

56#if __GLASGOW_HASKELL__ >= 900

62#if __GLASGOW_HASKELL__ >= 900

57updateHsModule :: HsModule -> HsModule

63updateHsModule :: HsModule -> HsModule

@@ -160,15 +166,17 @@ updateLHsType = traverse

160

166

161-- Main process

167-- Main process

162updateHsType :: HsType GhcPs -> (Any, HsType GhcPs)

168updateHsType :: HsType GhcPs -> (Any, HsType GhcPs)

163−updateHsType (HsQualTy xty ctxt body) =

169+updateHsType ty@(HsQualTy xty ctxt body) =

170+ if hasHasCallStack (unLoc ctxt)

171+ then pure ty

164− flagASTModified $ HsQualTy xty (fmap appendHSC ctxt) body

172+ else flagASTModified $ HsQualTy xty (fmap appendHSC ctxt) body

165updateHsType ty@HsTyVar {} =

173updateHsType ty@HsTyVar {} =

166 flagASTModified $ HsQualTy xQualTy (noLoc $ appendHSC []) (noLoc ty)

174 flagASTModified $ HsQualTy xQualTy (noLoc $ appendHSC []) (noLoc ty)

167updateHsType ty@HsAppTy {} =

175updateHsType ty@HsAppTy {} =

168 flagASTModified $ HsQualTy xQualTy (noLoc $ appendHSC []) (noLoc ty)

176 flagASTModified $ HsQualTy xQualTy (noLoc $ appendHSC []) (noLoc ty)

169updateHsType ty@HsFunTy {} =

177updateHsType ty@HsFunTy {} =

170 flagASTModified $ HsQualTy xQualTy (noLoc $ appendHSC []) (noLoc ty)

178 flagASTModified $ HsQualTy xQualTy (noLoc $ appendHSC []) (noLoc ty)

171−updateHsType ty@HsListTy {} =

179+updateHsType ty@HsListTy {} =

172 flagASTModified $ HsQualTy xQualTy (noLoc $ appendHSC []) (noLoc ty)

180 flagASTModified $ HsQualTy xQualTy (noLoc $ appendHSC []) (noLoc ty)

173updateHsType ty@HsTupleTy {} =

181updateHsType ty@HsTupleTy {} =

174 flagASTModified $ HsQualTy xQualTy (noLoc $ appendHSC []) (noLoc ty)

182 flagASTModified $ HsQualTy xQualTy (noLoc $ appendHSC []) (noLoc ty)

@@ -188,6 +196,13 @@ flagASTModified a = (Any True, a)

188appendHSC :: HsContext GhcPs -> HsContext GhcPs

196appendHSC :: HsContext GhcPs -> HsContext GhcPs

189appendHSC cs = mkHSC : cs

197appendHSC cs = mkHSC : cs

190

198

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+

191-- make HasCallStack => constraint

206-- make HasCallStack => constraint

192mkHSC :: LHsType GhcPs

207mkHSC :: LHsType GhcPs

193mkHSC = noLoc $ HsTyVar xQualTy NotPromoted lId

208mkHSC = noLoc $ HsTyVar xQualTy NotPromoted lId