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

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

CHANGELOG.md−1

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

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)

10## 0.1.2.0 -- 2021-05-21

9## 0.1.2.0 -- 2021-05-21

Readme.md+4−6

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

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/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

13Requirement: (8.6 <= on GHC)

11Requirement: (8.6 <= on GHC)

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

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

39-- HsFunTy

37-- HsFunTy

40−f5 :: String -> Int -> Int

38+f5 :: Int -> Int -> Int

41f5 _ _ = head f6

39f5 _ _ = head f6

43-- HsListTy

41-- HsListTy

example/Main.hs+2−2

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

19-- HsQualTy

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

21−f4 n = f5 (show n) 0

21+f4 _ = f5 0 0

23-- HsFunTy

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

24+f5 :: Int -> 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.18

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

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 || ^>=9.2 || ^>=9.4

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

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 -Wredundant-constraints

75+ ghc-options: -fplugin=StackTrace.Plugin

76 build-depends: haskell-stack-trace-plugin

src/StackTrace/Plugin.hs+5−20

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

6import Control.Arrow (first)

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

8−import GHC.Types.SrcLoc

9#if __GLASGOW_HASKELL__ >= 900

8#if __GLASGOW_HASKELL__ >= 900

10import GHC.Plugins

9import GHC.Plugins

11#else

10#else

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

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

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

52ghcStackImport =

51ghcStackImport =

53− L srcSpan $

52+ noLoc $

54 (simpleImportDecl $ mkModuleName "GHC.Stack")

53 (simpleImportDecl $ mkModuleName "GHC.Stack")

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

54+ {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

62#if __GLASGOW_HASKELL__ >= 900

56#if __GLASGOW_HASKELL__ >= 900

63updateHsModule :: HsModule -> HsModule

57updateHsModule :: HsModule -> HsModule

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

166

160

167-- Main process

161-- Main process

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

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

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

163+updateHsType (HsQualTy xty ctxt body) =

170− if hasHasCallStack (unLoc ctxt)

171− then pure ty

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

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

173updateHsType ty@HsTyVar {} =

165updateHsType ty@HsTyVar {} =

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

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

175updateHsType ty@HsAppTy {} =

167updateHsType ty@HsAppTy {} =

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

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

177updateHsType ty@HsFunTy {} =

169updateHsType ty@HsFunTy {} =

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

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

179−updateHsType ty@HsListTy {} =

171+updateHsType ty@HsListTy {} =

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

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

181updateHsType ty@HsTupleTy {} =

173updateHsType ty@HsTupleTy {} =

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

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

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

196appendHSC :: HsContext GhcPs -> HsContext GhcPs

188appendHSC :: HsContext GhcPs -> HsContext GhcPs

197appendHSC cs = mkHSC : cs

189appendHSC cs = mkHSC : cs

198

190

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

191-- make HasCallStack => constraint

207mkHSC :: LHsType GhcPs

192mkHSC :: LHsType GhcPs

208mkHSC = noLoc $ HsTyVar xQualTy NotPromoted lId

193mkHSC = noLoc $ HsTyVar xQualTy NotPromoted lId