mirror of
https://github.com/typeable/haskell-stack-trace-plugin.git
synced 2024-09-17 15:07:15 +03:00
added support for GHC 8.10
This commit is contained in:
parent
50a8d04b88
commit
f42e35a844
4
.github/workflows/cabal.yml
vendored
4
.github/workflows/cabal.yml
vendored
@ -17,7 +17,7 @@ jobs:
|
||||
runs-on: ubuntu-18.04
|
||||
strategy:
|
||||
matrix:
|
||||
ghc: ["8.6.5", "8.8.1"]
|
||||
ghc: ["8.6.5", "8.8.1", "8.10.4"]
|
||||
cabal: ["3.0"]
|
||||
|
||||
steps:
|
||||
@ -53,4 +53,4 @@ jobs:
|
||||
- name: Build & Test
|
||||
run: |
|
||||
cabal v2-build --flag dev
|
||||
cabal v2-test --flag dev
|
||||
cabal v2-test --flag dev
|
||||
|
@ -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.
|
||||
@ -20,7 +20,7 @@ extra-source-files:
|
||||
CHANGELOG.md
|
||||
Readme.md
|
||||
|
||||
tested-with: GHC ==8.6.5 || ==8.8.1
|
||||
tested-with: GHC ==8.6.5 || ==8.8.1 || ==8.10.4
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
@ -32,13 +32,13 @@ flag dev
|
||||
default: False
|
||||
|
||||
common common-opts
|
||||
build-depends: base >=4.12 && <4.14
|
||||
build-depends: base >=4.12 && <4.15
|
||||
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
|
||||
exposed-modules: StackTrace.Plugin
|
||||
|
||||
if flag(dev)
|
||||
|
@ -1,11 +1,17 @@
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
module StackTrace.Plugin (plugin) where
|
||||
|
||||
import Control.Arrow (first)
|
||||
import Data.Monoid (Any(Any, getAny))
|
||||
import GhcPlugins
|
||||
#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,11 +34,19 @@ parsedPlugin _ _ pm = do
|
||||
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}
|
||||
|
||||
updateHsModule :: HsModule GhcPs -> HsModule GhcPs
|
||||
updateHsModule hsm =
|
||||
@ -91,17 +105,24 @@ updateHsType :: HsType GhcPs -> (Any, HsType GhcPs)
|
||||
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
|
||||
#else
|
||||
xQualTy :: NoExtField
|
||||
xQualTy = NoExtField
|
||||
#endif
|
||||
|
||||
flagASTModified :: a -> (Any, a)
|
||||
flagASTModified a = (Any True, a)
|
||||
|
||||
@ -110,7 +131,7 @@ appendHSC cs = mkHSC : cs
|
||||
|
||||
-- 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"
|
||||
|
Loading…
Reference in New Issue
Block a user