haskell-stack-trace-plugin 0.1.1.1 → 0.1.2.0
raw patch · 4 files changed
+59/−21 lines, 4 filesdep ~basedep ~bytestringdep ~ghcPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, bytestring, ghc, hspec, typed-process
API changes (from Hackage documentation)
Files
- CHANGELOG.md +5/−0
- LICENSE +1/−1
- haskell-stack-trace-plugin.cabal +11/−13
- src/StackTrace/Plugin.hs +42/−7
CHANGELOG.md view
@@ -2,6 +2,11 @@ ## Unreleased changes +## 0.1.2.0 -- 2021-05-21++- Added support for GHC 8.10 [#7](https://github.com/waddlaw/haskell-stack-trace-plugin/pull/7) (@etorreborre)+- Added support for GHC 9.0 @waddlaw+ ## 0.1.1.1 -- 2020-01-18 - Allow GHC-8.8.1
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2018-2020 Shinya Yamaguchi+Copyright (c) 2018-2021 Shinya Yamaguchi Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the
haskell-stack-trace-plugin.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: haskell-stack-trace-plugin-version: 0.1.1.1+version: 0.1.2.0 synopsis: haskell-stack-trace-plugin description: 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 @@ license: MIT license-file: LICENSE author: Shinya Yamaguchi-maintainer: ingronze@gmail.com-copyright: 2018-2020 Shinya Yamaguchi+maintainer: a@wado.dev+copyright: 2018-2021 Shinya Yamaguchi category: Compiler Plugin, Development, Debug build-type: Simple extra-source-files: CHANGELOG.md Readme.md -tested-with: GHC ==8.6.5 || ==8.8.1+tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1 source-repository head type: git@@ -32,22 +32,20 @@ default: False common common-opts- build-depends: base >=4.12 && <4.14+ build-depends: base >=4.12 && <4.16 default-language: Haskell2010 library import: common-opts hs-source-dirs: src- build-depends: ghc ^>=8.6 || ^>=8.8+ build-depends: ghc ^>=8.6 || ^>=8.8 || ^>=8.10 || ^>=9.0 exposed-modules: StackTrace.Plugin if flag(dev) ghc-options: -Wall -Werror -Wcompat -Wincomplete-uni-patterns- -Wnoncanonical-monad-instances- -Wno-missing-home-modules+ -Wnoncanonical-monad-instances -Wno-missing-home-modules - -- -Wincomplete-record-updates else ghc-options: -Wall @@ -57,11 +55,11 @@ hs-source-dirs: test type: exitcode-stdio-1.0 build-depends:- , bytestring ^>=0.10- , hspec ^>=2.7- , typed-process ^>=0.2.6+ , bytestring >=0.10 && <0.12+ , hspec ^>=2.8+ , typed-process ^>=0.2 - build-tool-depends: hspec-discover:hspec-discover ^>=2.7+ build-tool-depends: hspec-discover:hspec-discover ^>=2.8 other-modules: StackTrace.PluginSpec if flag(dev)
src/StackTrace/Plugin.hs view
@@ -1,11 +1,22 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-} module StackTrace.Plugin (plugin) where import Control.Arrow (first) import Data.Monoid (Any(Any, getAny))+#if __GLASGOW_HASKELL__ >= 900+import GHC.Plugins+#else+ import GhcPlugins+#endif+#if __GLASGOW_HASKELL__ >= 810+import GHC.Hs+#endif+#if __GLASGOW_HASKELL__ < 810 import HsSyn+#endif type Traversal s t a b = forall f. Applicative f =>@@ -28,13 +39,25 @@ ghcStackModuleName :: ModuleName ghcStackModuleName = mkModuleName "AutoImported.GHC.Stack" +#if __GLASGOW_HASKELL__ < 810+importDeclQualified :: Bool+importDeclQualified = True+#else+importDeclQualified :: ImportDeclQualifiedStyle+importDeclQualified = QualifiedPre+#endif+ ghcStackImport :: Located (ImportDecl (GhcPass p)) ghcStackImport = noLoc $ (simpleImportDecl $ mkModuleName "GHC.Stack")- {ideclQualified = True, ideclAs = Just $ noLoc ghcStackModuleName}+ {ideclQualified = importDeclQualified, ideclAs = Just $ noLoc ghcStackModuleName} +#if __GLASGOW_HASKELL__ >= 900+updateHsModule :: HsModule -> HsModule+#else updateHsModule :: HsModule GhcPs -> HsModule GhcPs+#endif updateHsModule hsm = hsm {hsmodImports = hsmodImports', hsmodDecls = hsmodDecls'} where@@ -76,12 +99,16 @@ updateLHsSigWsType :: Traversal' (LHsSigWcType GhcPs) (LHsSigType GhcPs) updateLHsSigWsType f lhs@HsWC {} = (\x -> lhs {hswc_body = x}) <$> f (hswc_body lhs)+#if __GLASGOW_HASKELL__ < 900 updateLHsSigWsType _ lhs = pure lhs+#endif updateLHsSigType :: Traversal' (LHsSigType GhcPs) (LHsType GhcPs) updateLHsSigType f lhs@HsIB {} = (\x -> lhs {hsib_body = x}) <$> f (hsib_body lhs)+#if __GLASGOW_HASKELL__ < 900 updateLHsSigType _ lhs = pure lhs+#endif updateLHsType :: Traversal' (LHsType GhcPs) (HsType GhcPs) updateLHsType = traverse@@ -91,17 +118,25 @@ updateHsType (HsQualTy xty ctxt body) = flagASTModified $ HsQualTy xty (fmap appendHSC ctxt) body updateHsType ty@HsTyVar {} =- flagASTModified $ HsQualTy noExt (noLoc $ appendHSC []) (noLoc ty)+ flagASTModified $ HsQualTy xQualTy (noLoc $ appendHSC []) (noLoc ty) updateHsType ty@HsAppTy {} =- flagASTModified $ HsQualTy noExt (noLoc $ appendHSC []) (noLoc ty)+ flagASTModified $ HsQualTy xQualTy (noLoc $ appendHSC []) (noLoc ty) updateHsType ty@HsFunTy {} =- flagASTModified $ HsQualTy noExt (noLoc $ appendHSC []) (noLoc ty)+ flagASTModified $ HsQualTy xQualTy (noLoc $ appendHSC []) (noLoc ty) updateHsType ty@HsListTy {} =- flagASTModified $ HsQualTy noExt (noLoc $ appendHSC []) (noLoc ty)+ flagASTModified $ HsQualTy xQualTy (noLoc $ appendHSC []) (noLoc ty) updateHsType ty@HsTupleTy {} =- flagASTModified $ HsQualTy noExt (noLoc $ appendHSC []) (noLoc ty)+ flagASTModified $ HsQualTy xQualTy (noLoc $ appendHSC []) (noLoc ty) updateHsType ty = pure ty +#if __GLASGOW_HASKELL__ < 810+xQualTy :: NoExt+xQualTy = noExt+#else+xQualTy :: NoExtField+xQualTy = NoExtField+#endif+ flagASTModified :: a -> (Any, a) flagASTModified a = (Any True, a) @@ -110,7 +145,7 @@ -- make HasCallStack => constraint mkHSC :: LHsType GhcPs-mkHSC = noLoc $ HsTyVar noExt NotPromoted lId+mkHSC = noLoc $ HsTyVar xQualTy NotPromoted lId lId :: Located (IdP GhcPs) lId = noLoc $ mkRdrQual ghcStackModuleName $ mkClsOcc "HasCallStack"