haskell-stack-trace-plugin (empty) → 0.1.0.0
raw patch · 6 files changed
+291/−0 lines, 6 filesdep +basedep +ghcdep +haskell-stack-trace-plugin
Dependencies added: base, ghc, haskell-stack-trace-plugin
Files
- CHANGELOG.md +5/−0
- LICENSE +20/−0
- Readme.md +103/−0
- example/Main.hs +41/−0
- haskell-stack-trace-plugin.cabal +41/−0
- src/StackTrace/Plugin.hs +81/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for haskell-stack-trace-pugin++## 0.1.0.0 -- 2018-12-07++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2018 Shinya Yamaguchi++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Readme.md view
@@ -0,0 +1,103 @@+# haskell-stack-trace-plugin++This plugin allow implicitly add `HasCallStack` class to every top-level function for all module. Hence, we can to get completely continuous call stack.++1. (implicitly) Import [GHC.Stack](https://www.stackage.org/haddock/lts-12.21/base-4.11.1.0/GHC-Stack.html) for all modules.+2. Add [HasCallStack](https://www.stackage.org/haddock/lts-12.21/base-4.11.1.0/GHC-Stack.html#t:HasCallStack) constraint for all top-level functions.++Requirement: (8.6 <= on GHC)++## Synopsis++```haskell+module Main where++import Data.Maybe (fromJust)++main :: IO ()+main = print f1++f1 :: Int+f1 = f2++f2 :: Int+f2 = f3++-- HsQualTy+f3 :: HasCallStack => Int+f3 = f4 0++-- HsQualTy+f4 :: Show a => a -> Int+f4 _ = f5 0 0++-- HsFunTy+f5 :: Int -> Int -> Int+f5 _ _ = head f6++-- HsListTy+f6 :: [Int]+f6 = [fst f7]++-- HsTupleTy+f7 :: (Int, Int)+f7 = (fromJust f8, fromJust f8)++-- HsAppTy+f8 :: Maybe Int+f8 = Just fError++-- HsTyVar+fError :: Int+fError = error "fError"+```++This example get error:++```shell+$ cabal new-build+example/Main.hs:15:7: error:+ Not in scope: type constructor or class ‘HasCallStack’+ |+15 | f3 :: HasCallStack => Int+ | ^^^^^^^^^^^^+```++Yes, add `import GHC.Stack` to above example.++Fix and rebuild!++```shell+$ cabal new-run+example: fError+CallStack (from HasCallStack):+ error, called at example/Main.hs:41:10 in main:Main+```++Hmm, it is not useful. But, you will to be happy when enable this plugin.++```cabal+ ghc-options:+ -fplugin=StackTrace.Plugin+```++```shell+$ cabal new-run+...++example: fError+CallStack (from HasCallStack):+ error, called at example/Main.hs:40:10 in main:Main+ fError, called at example/Main.hs:36:11 in main:Main+ f8, called at example/Main.hs:32:16 in main:Main+ f7, called at example/Main.hs:28:11 in main:Main+ f6, called at example/Main.hs:24:15 in main:Main+ f5, called at example/Main.hs:20:8 in main:Main+ f4, called at example/Main.hs:16:6 in main:Main+ f3, called at example/Main.hs:12:6 in main:Main+ f2, called at example/Main.hs:9:6 in main:Main+ f1, called at example/Main.hs:6:14 in main:Main+ main, called at example/Main.hs:6:1 in main:Main+```++Great!!!
+ example/Main.hs view
@@ -0,0 +1,41 @@+module Main where++import Data.Maybe (fromJust)+import GHC.Stack++main :: IO ()+main = print f1++f1 :: Int+f1 = f2++f2 :: Int+f2 = f3++-- HsQualTy+f3 :: HasCallStack => Int+f3 = f4 0++-- HsQualTy+f4 :: Show a => a -> Int+f4 _ = f5 0 0++-- HsFunTy+f5 :: Int -> Int -> Int+f5 _ _ = head f6++-- HsListTy+f6 :: [Int]+f6 = [fst f7]++-- HsTupleTy+f7 :: (Int, Int)+f7 = (fromJust f8, fromJust f8)++-- HsAppTy+f8 :: Maybe Int+f8 = Just fError++-- HsTyVar+fError :: Int+fError = error "fError"
+ haskell-stack-trace-plugin.cabal view
@@ -0,0 +1,41 @@+name: haskell-stack-trace-plugin+version: 0.1.0.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.+homepage: https://github.com/waddlaw/haskell-stack-trace-plugin+bug-reports: https://github.com/waddlaw/haskell-stack-trace-plugin/issues+license: MIT+license-file: LICENSE+author: Shinya Yamaguchi+maintainer: ingronze@gmail.com+copyright: 2018 Shinya Yamaguchi+category: Compiler Plugin, Development, Debug+build-type: Simple+extra-source-files: CHANGELOG.md, Readme.md+cabal-version: >=1.10+tested-with: GHC == 8.6.2++source-repository head+ type: git+ location: git://github.com/waddlaw/haskell-stack-trace-plugin++library+ hs-source-dirs: src+ build-depends:+ base >=4.12 && <4.13,+ ghc==8.6.2++ exposed-modules:+ StackTrace.Plugin++ default-language: Haskell2010++executable example+ main-is: Main.hs+ hs-source-dirs: example+ default-language: Haskell2010+ ghc-options:+ -fplugin=StackTrace.Plugin+ build-depends:+ base >=4.12 && <4.13,+ haskell-stack-trace-plugin
+ src/StackTrace/Plugin.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE OverloadedStrings #-}+module StackTrace.Plugin (plugin) where+ +import GhcPlugins+import TcRnTypes (IfM, TcM, TcGblEnv, tcg_binds, tcg_rn_decls)+import HsExtension (GhcTc, GhcRn)+import HsDecls (HsGroup)+import HsExpr (LHsExpr)+import HsSyn++import Data.Maybe++plugin :: Plugin+plugin = defaultPlugin+ { parsedResultAction = parsedPlugin+ }++parsedPlugin :: [CommandLineOption] -> ModSummary -> HsParsedModule -> Hsc HsParsedModule+parsedPlugin _ _ pm = do+ dflags <- getDynFlags++ let extract = hsmodImports . unLoc+ addGHCStackMod = noLoc $ simpleImportDecl $ mkModuleName "GHC.Stack"++ m = updateHsModule addGHCStackMod updateHsmodDecl <$> hpm_module pm+ pm' = pm { hpm_module = m }++ return pm'++updateHsModule :: LImportDecl GhcPs -> (LHsDecl GhcPs -> LHsDecl GhcPs) -> HsModule GhcPs -> HsModule GhcPs+updateHsModule importDecl update hsm = hsm+ { hsmodImports = importDecl:decls+ , hsmodDecls = map update lhss+ }+ where+ decls = hsmodImports hsm+ lhss = hsmodDecls hsm++--------------++updateHsmodDecl :: LHsDecl GhcPs -> LHsDecl GhcPs+updateHsmodDecl = fmap updateHsDecl++updateHsDecl :: HsDecl GhcPs -> HsDecl GhcPs+updateHsDecl (SigD xSig s) = SigD xSig (updateSig s)+updateHsDecl decl = decl++updateSig :: Sig GhcPs -> Sig GhcPs+updateSig (TypeSig xSig ls t) = TypeSig xSig ls (updateLHsSigWcType t)+updateSig sig = sig++updateLHsSigWcType :: LHsSigWcType GhcPs -> LHsSigWcType GhcPs+updateLHsSigWcType lhs@HsWC{} = lhs { hswc_body = updateLHsSigType (hswc_body lhs) }+updateLHsSigWcType lhs@XHsWildCardBndrs{} = lhs++updateLHsSigType :: LHsSigType GhcPs -> LHsSigType GhcPs+updateLHsSigType lhs@HsIB{} = lhs { hsib_body = updateLHsType (hsib_body lhs )}+updateLHsSigType lhs@XHsImplicitBndrs{} = lhs++updateLHsType :: LHsType GhcPs -> LHsType GhcPs+updateLHsType = fmap updateHsType++-- Main process+updateHsType :: HsType GhcPs -> HsType GhcPs+updateHsType ty@(HsQualTy xty ctxt body) = HsQualTy xty (fmap appendHSC ctxt) body+updateHsType ty@HsTyVar{} = HsQualTy noExt (noLoc $ appendHSC []) (noLoc ty)+updateHsType ty@HsAppTy{} = HsQualTy noExt (noLoc $ appendHSC []) (noLoc ty)+updateHsType ty@HsFunTy{} = HsQualTy noExt (noLoc $ appendHSC []) (noLoc ty)+updateHsType ty@HsListTy{} = HsQualTy noExt (noLoc $ appendHSC []) (noLoc ty)+updateHsType ty@HsTupleTy{} = HsQualTy noExt (noLoc $ appendHSC []) (noLoc ty)+updateHsType ty = ty++appendHSC :: HsContext GhcPs -> HsContext GhcPs+appendHSC cs = mkHSC : cs++-- make HasCallStack => constraint+mkHSC :: LHsType GhcPs+mkHSC = noLoc $ HsTyVar noExt NotPromoted lId++lId :: Located (IdP GhcPs)+lId = noLoc $ mkRdrUnqual $ mkClsOcc "HasCallStack"