haskell-tools-debug (empty) → 0.4.1.0
raw patch · 7 files changed
+702/−0 lines, 7 filesdep +basedep +ghcdep +ghc-pathssetup-changed
Dependencies added: base, ghc, ghc-paths, haskell-tools-ast, haskell-tools-backend-ghc, haskell-tools-prettyprint, haskell-tools-refactor, references
Files
- LICENSE +29/−0
- Language/Haskell/Tools/Debug.hs +84/−0
- Language/Haskell/Tools/DebugGhcAST.hs +368/−0
- Language/Haskell/Tools/RangeDebug.hs +51/−0
- Language/Haskell/Tools/RangeDebug/Instances.hs +139/−0
- Setup.hs +2/−0
- haskell-tools-debug.cabal +29/−0
+ LICENSE view
@@ -0,0 +1,29 @@+Haskell-Tools is Copyright (c) Boldizsár Németh, 2016, all rights reserved, +and is distributed as free software under the following license. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +- Redistributions of source code must retain the above copyright +notice, this list of conditions, and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright +notice, this list of conditions, and the following disclaimer in the +documentation and/or other materials provided with the distribution. + +- The names of the copyright holders may not be used to endorse or +promote products derived from this software without specific prior +written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY +EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR +BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE +OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN +IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Language/Haskell/Tools/Debug.hs view
@@ -0,0 +1,84 @@+ {-# LANGUAGE StandaloneDeriving + , DeriveGeneric + #-} +module Language.Haskell.Tools.Debug where + +import Control.Monad.IO.Class +import GHC.Generics hiding (moduleName) +import Data.Maybe + +import GHC hiding (loadModule) +import GHC.Paths ( libdir ) +import Module as GHC +import SrcLoc +import HscTypes + +import Language.Haskell.Tools.AST +import Language.Haskell.Tools.AST.FromGHC +import Language.Haskell.Tools.Transform +import Language.Haskell.Tools.PrettyPrint +import Language.Haskell.Tools.DebugGhcAST +import Language.Haskell.Tools.RangeDebug +import Language.Haskell.Tools.RangeDebug.Instances +import Language.Haskell.Tools.Refactor.Prepare +import Language.Haskell.Tools.Refactor.Perform +import Language.Haskell.Tools.Refactor.RefactorBase + +-- | Should be only used for testing +demoRefactor :: String -> String -> [String] -> String -> IO () +demoRefactor command workingDir args moduleName = + runGhc (Just libdir) $ do + initGhcFlags + useFlags args + useDirs [workingDir] + modSum <- loadModule workingDir moduleName + p <- parseModule modSum + t <- typecheckModule p + + let r = tm_renamed_source t + let annots = pm_annotations $ tm_parsed_module t + + liftIO $ putStrLn $ show annots + liftIO $ putStrLn "===========" + liftIO $ putStrLn $ show (pm_parsed_source p) + liftIO $ putStrLn "===========" + liftIO $ putStrLn $ show (fromJust $ tm_renamed_source t) + liftIO $ putStrLn "===========" + liftIO $ putStrLn $ show (typecheckedSource t) + liftIO $ putStrLn "=========== parsed:" + --transformed <- runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModule (pm_parsed_source p) + parseTrf <- runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModule modSum (pm_parsed_source p) + liftIO $ putStrLn $ srcInfoDebug parseTrf + liftIO $ putStrLn "=========== typed:" + transformed <- addTypeInfos (typecheckedSource t) =<< (runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModuleRename modSum parseTrf (fromJust $ tm_renamed_source t) (pm_parsed_source p)) + liftIO $ putStrLn $ srcInfoDebug transformed + liftIO $ putStrLn "=========== ranges fixed:" + let commented = fixRanges $ placeComments (getNormalComments $ snd annots) transformed + liftIO $ putStrLn $ srcInfoDebug commented + liftIO $ putStrLn "=========== cut up:" + let cutUp = cutUpRanges commented + liftIO $ putStrLn $ srcInfoDebug cutUp + liftIO $ putStrLn $ show $ getLocIndices cutUp + liftIO $ putStrLn $ show $ mapLocIndices (fromJust $ ms_hspp_buf $ pm_mod_summary p) (getLocIndices cutUp) + liftIO $ putStrLn "=========== sourced:" + let sourced = rangeToSource (fromJust $ ms_hspp_buf $ pm_mod_summary p) cutUp + liftIO $ putStrLn $ srcInfoDebug sourced + liftIO $ putStrLn "=========== pretty printed:" + let prettyPrinted = prettyPrint sourced + liftIO $ putStrLn prettyPrinted + transformed <- performCommand (readCommand command) ((SourceFileKey NormalHs moduleName), sourced) [] + case transformed of + Right [ContentChanged (_, correctlyTransformed)] -> do + liftIO $ putStrLn "=========== transformed AST:" + liftIO $ putStrLn $ srcInfoDebug correctlyTransformed + liftIO $ putStrLn "=========== transformed & prettyprinted:" + let prettyPrinted = prettyPrint correctlyTransformed + liftIO $ putStrLn prettyPrinted + liftIO $ putStrLn "===========" + Left transformProblem -> do + liftIO $ putStrLn "===========" + liftIO $ putStrLn transformProblem + liftIO $ putStrLn "===========" + +deriving instance Generic SrcSpan +deriving instance (Generic sema, Generic src) => Generic (NodeInfo sema src)
+ Language/Haskell/Tools/DebugGhcAST.hs view
@@ -0,0 +1,368 @@+{-# LANGUAGE StandaloneDeriving + , TypeSynonymInstances + , FlexibleInstances + #-} +-- | A module for showing GHC's syntax tree representation. +module Language.Haskell.Tools.DebugGhcAST where + +import Language.Haskell.Tools.RangeDebug +import Language.Haskell.Tools.AST.FromGHC.GHCUtils +import Language.Haskell.Tools.AST (shortShowSpan) + +import GHC +import HsSyn +import HsDecls +import Module +import Coercion +import SrcLoc +import RdrName +import BasicTypes +import Outputable +import TyCon +import PlaceHolder +import ForeignCall +import Var +import ConLike +import PatSyn +import TcEvidence +import Bag +import BooleanFormula +import FieldLabel +import CoreSyn +import UniqFM +import OccName + +instance Show a => Show (Located a) where + show (L l a) = "L(" ++ shortShowSpan l ++ ") (" ++ show a ++ ")" + +deriving instance Show (ABExport RdrName) +deriving instance Show (AmbiguousFieldOcc RdrName) +deriving instance Show (AnnDecl RdrName) +deriving instance Show (AnnProvenance RdrName) +deriving instance Show (ApplicativeArg RdrName RdrName) +deriving instance Show (ArithSeqInfo RdrName) +deriving instance Show (BooleanFormula (Located RdrName)) +deriving instance Show (ClsInstDecl RdrName) +deriving instance Show (ConDecl RdrName) +deriving instance Show (ConDeclField RdrName) +deriving instance Show (DataFamInstDecl RdrName) +deriving instance Show (DefaultDecl RdrName) +deriving instance Show (DerivDecl RdrName) +deriving instance Show (FamilyDecl RdrName) +deriving instance Show (FamilyInfo RdrName) +deriving instance Show (FamilyResultSig RdrName) +deriving instance Show (FieldLbl RdrName) +deriving instance Show (FieldOcc RdrName) +deriving instance Show (FixitySig RdrName) +deriving instance Show (ForeignDecl RdrName) +deriving instance Show a => Show (GRHS RdrName a) +deriving instance Show a => Show (GRHSs RdrName a) +deriving instance Show (InjectivityAnn RdrName) +deriving instance Show (HsAppType RdrName) +deriving instance Show (HsBindLR RdrName RdrName) +deriving instance Show (HsBracket RdrName) +deriving instance Show (HsCmd RdrName) +deriving instance Show (HsCmdTop RdrName) +deriving instance Show (HsConDeclDetails RdrName) +deriving instance Show (HsConPatDetails RdrName) +deriving instance Show (HsDataDefn RdrName) +deriving instance Show (HsDecl RdrName) +deriving instance Show (HsExpr RdrName) +deriving instance Show (HsGroup RdrName) +deriving instance Show (HsLocalBindsLR RdrName RdrName) +deriving instance Show (HsMatchContext RdrName) +deriving instance Show (HsModule RdrName) +deriving instance Show (HsOverLit RdrName) +deriving instance Show (HsPatSynDetails (Located RdrName)) +deriving instance Show (HsPatSynDir RdrName) +deriving instance Show (HsRecFields RdrName (LPat RdrName)) +deriving instance Show (HsRecordBinds RdrName) +deriving instance Show (HsSplice RdrName) +deriving instance Show (HsStmtContext RdrName) +deriving instance Show (HsTupArg RdrName) +deriving instance Show (HsTyVarBndr RdrName) +deriving instance Show (HsType RdrName) +deriving instance Show (HsValBindsLR RdrName RdrName) +deriving instance Show (HsWildCardInfo RdrName) +deriving instance Show (IE RdrName) +deriving instance Show (ImportDecl RdrName) +deriving instance Show (InstDecl RdrName) +deriving instance Show (LHsQTyVars RdrName) +deriving instance Show a => Show (Match RdrName a) +deriving instance Show (MatchFixity RdrName) +deriving instance Show a => Show (MatchGroup RdrName a) +deriving instance Show (ParStmtBlock RdrName RdrName) +deriving instance Show (Pat RdrName) +deriving instance Show (PatSynBind RdrName RdrName) +deriving instance Show (RecordPatSynField (Located RdrName)) +deriving instance Show (RoleAnnotDecl RdrName) +deriving instance Show (RuleBndr RdrName) +deriving instance Show (RuleDecl RdrName) +deriving instance Show (RuleDecls RdrName) +deriving instance Show (Sig RdrName) +deriving instance Show (SpliceDecl RdrName) +deriving instance Show (SyntaxExpr RdrName) +deriving instance Show a => Show (StmtLR RdrName RdrName a) +deriving instance Show (TyClDecl RdrName) +deriving instance Show (TyClGroup RdrName) +deriving instance Show a => Show (TyFamEqn RdrName a) +deriving instance Show (TyFamInstDecl RdrName) +deriving instance Show (VectDecl RdrName) +deriving instance Show (WarnDecl RdrName) +deriving instance Show (WarnDecls RdrName) + + +deriving instance Show (ABExport Name) +deriving instance Show (AmbiguousFieldOcc Name) +deriving instance Show (AnnDecl Name) +deriving instance Show (AnnProvenance Name) +deriving instance Show (ApplicativeArg Name Name) +deriving instance Show (ArithSeqInfo Name) +deriving instance Show (BooleanFormula (Located Name)) +deriving instance Show (ClsInstDecl Name) +deriving instance Show (ConDecl Name) +deriving instance Show (ConDeclField Name) +deriving instance Show (DataFamInstDecl Name) +deriving instance Show (DefaultDecl Name) +deriving instance Show (DerivDecl Name) +deriving instance Show (FamilyDecl Name) +deriving instance Show (FamilyInfo Name) +deriving instance Show (FamilyResultSig Name) +deriving instance Show (FieldLbl Name) +deriving instance Show (FieldOcc Name) +deriving instance Show (FixitySig Name) +deriving instance Show (ForeignDecl Name) +deriving instance Show a => Show (GRHS Name a) +deriving instance Show a => Show (GRHSs Name a) +deriving instance Show (InjectivityAnn Name) +deriving instance Show (HsAppType Name) +deriving instance Show (HsBindLR Name Name) +deriving instance Show (HsBracket Name) +deriving instance Show (HsCmd Name) +deriving instance Show (HsCmdTop Name) +deriving instance Show (HsConDeclDetails Name) +deriving instance Show (HsConPatDetails Name) +deriving instance Show (HsDataDefn Name) +deriving instance Show (HsDecl Name) +deriving instance Show (HsExpr Name) +deriving instance Show (HsGroup Name) +deriving instance Show (HsLocalBindsLR Name Name) +deriving instance Show (HsMatchContext Name) +deriving instance Show (HsModule Name) +deriving instance Show (HsOverLit Name) +deriving instance Show (HsPatSynDetails (Located Name)) +deriving instance Show (HsPatSynDir Name) +deriving instance Show (HsRecFields Name (LPat Name)) +deriving instance Show (HsRecordBinds Name) +deriving instance Show (HsSplice Name) +deriving instance Show (HsStmtContext Name) +deriving instance Show (HsTupArg Name) +deriving instance Show (HsTyVarBndr Name) +deriving instance Show (HsType Name) +deriving instance Show (HsValBindsLR Name Name) +deriving instance Show (HsWildCardInfo Name) +deriving instance Show (IE Name) +deriving instance Show (ImportDecl Name) +deriving instance Show (InstDecl Name) +deriving instance Show (LHsQTyVars Name) +deriving instance Show a => Show (Match Name a) +deriving instance Show (MatchFixity Name) +deriving instance Show a => Show (MatchGroup Name a) +deriving instance Show (ParStmtBlock Name Name) +deriving instance Show (Pat Name) +deriving instance Show (PatSynBind Name Name) +deriving instance Show (RecordPatSynField (Located Name)) +deriving instance Show (RoleAnnotDecl Name) +deriving instance Show (RuleBndr Name) +deriving instance Show (RuleDecl Name) +deriving instance Show (RuleDecls Name) +deriving instance Show (Sig Name) +deriving instance Show (SpliceDecl Name) +deriving instance Show (SyntaxExpr Name) +deriving instance Show a => Show (StmtLR Name Name a) +deriving instance Show (TyClDecl Name) +deriving instance Show (TyClGroup Name) +deriving instance Show a => Show (TyFamEqn Name a) +deriving instance Show (TyFamInstDecl Name) +deriving instance Show (VectDecl Name) +deriving instance Show (WarnDecl Name) +deriving instance Show (WarnDecls Name) + + +deriving instance Show (ABExport Id) +deriving instance Show (AmbiguousFieldOcc Id) +deriving instance Show (AnnDecl Id) +deriving instance Show (AnnProvenance Id) +deriving instance Show (ApplicativeArg Id Id) +deriving instance Show (ArithSeqInfo Id) +deriving instance Show (BooleanFormula (Located Id)) +deriving instance Show (ClsInstDecl Id) +deriving instance Show (ConDecl Id) +deriving instance Show (ConDeclField Id) +deriving instance Show (DataFamInstDecl Id) +deriving instance Show (DefaultDecl Id) +deriving instance Show (DerivDecl Id) +deriving instance Show (FamilyDecl Id) +deriving instance Show (FamilyInfo Id) +deriving instance Show (FamilyResultSig Id) +deriving instance Show (FieldLbl Id) +deriving instance Show (FieldOcc Id) +deriving instance Show (FixitySig Id) +deriving instance Show (ForeignDecl Id) +deriving instance Show a => Show (GRHS Id a) +deriving instance Show a => Show (GRHSs Id a) +deriving instance Show (InjectivityAnn Id) +deriving instance Show (HsAppType Id) +deriving instance Show (HsBindLR Id Id) +deriving instance Show (HsBracket Id) +deriving instance Show (HsCmd Id) +deriving instance Show (HsCmdTop Id) +deriving instance Show (HsConDeclDetails Id) +deriving instance Show (HsConPatDetails Id) +deriving instance Show (HsDataDefn Id) +deriving instance Show (HsDecl Id) +deriving instance Show (HsExpr Id) +deriving instance Show (HsGroup Id) +deriving instance Show (HsLocalBindsLR Id Id) +deriving instance Show (HsMatchContext Id) +deriving instance Show (HsModule Id) +deriving instance Show (HsOverLit Id) +deriving instance Show (HsPatSynDetails (Located Id)) +deriving instance Show (HsPatSynDir Id) +deriving instance Show (HsRecFields Id (LPat Id)) +deriving instance Show (HsRecordBinds Id) +deriving instance Show (HsSplice Id) +deriving instance Show (HsStmtContext Id) +deriving instance Show (HsTupArg Id) +deriving instance Show (HsTyVarBndr Id) +deriving instance Show (HsType Id) +deriving instance Show (HsValBindsLR Id Id) +deriving instance Show (HsWildCardInfo Id) +deriving instance Show (IE Id) +deriving instance Show (ImportDecl Id) +deriving instance Show (InstDecl Id) +deriving instance Show (LHsQTyVars Id) +deriving instance Show a => Show (Match Id a) +deriving instance Show (MatchFixity Id) +deriving instance Show a => Show (MatchGroup Id a) +deriving instance Show (ParStmtBlock Id Id) +deriving instance Show (Pat Id) +deriving instance Show (PatSynBind Id Id) +deriving instance Show (RecordPatSynField (Located Id)) +deriving instance Show (RoleAnnotDecl Id) +deriving instance Show (RuleBndr Id) +deriving instance Show (RuleDecl Id) +deriving instance Show (RuleDecls Id) +deriving instance Show (Sig Id) +deriving instance Show (SpliceDecl Id) +deriving instance Show (SyntaxExpr Id) +deriving instance Show a => Show (StmtLR Id Id a) +deriving instance Show (TyClDecl Id) +deriving instance Show (TyClGroup Id) +deriving instance Show a => Show (TyFamEqn Id a) +deriving instance Show (TyFamInstDecl Id) +deriving instance Show (VectDecl Id) +deriving instance Show (WarnDecl Id) +deriving instance Show (WarnDecls Id) + +deriving instance Show Activation +deriving instance Show HsArrAppType +deriving instance Show Boxity +deriving instance Show CType +deriving instance Show CImportSpec +deriving instance Show CExportSpec +deriving instance Show CCallConv +deriving instance Show CCallTarget +deriving instance Show ConLike +deriving instance Show DocDecl +deriving instance Show Fixity +deriving instance Show FixityDirection +deriving instance Show ForeignImport +deriving instance Show ForeignExport +deriving instance Show Header +deriving instance Show HsIPName +deriving instance Show HsLit +deriving instance Show HsTupleSort +deriving instance Show HsSrcBang +deriving instance Show InlinePragma +deriving instance Show NewOrData +deriving instance Show Origin +deriving instance Show OverLitVal +deriving instance Show OverlapMode +deriving instance Show PlaceHolder +deriving instance Show Role +deriving instance Show RecFlag +deriving instance Show SpliceExplicitFlag +deriving instance Show TcSpecPrag +deriving instance Show TcSpecPrags +deriving instance Show TransForm +deriving instance Show WarningTxt +deriving instance Show PendingRnSplice +deriving instance Show PendingTcSplice + +instance Show UnboundVar where + show (OutOfScope n _) = "OutOfScope " ++ show n + show (TrueExprHole n) = "TrueExprHole " ++ show n + + + +instance Show ModuleName where + show = showSDocUnsafe . ppr +instance Show TyCon where + show = showSDocUnsafe . ppr +instance Show ClsInst where + show = showSDocUnsafe . ppr +instance Show Type where + show = showSDocUnsafe . ppr +instance Show OccName where + show = showSDocUnsafe . ppr +-- instance Show RdrName where + -- show = showSDocUnsafe . ppr + +deriving instance Show RdrName +deriving instance Show Module +deriving instance Show StringLiteral +deriving instance Show UntypedSpliceFlavour +deriving instance Show SrcUnpackedness +deriving instance Show SrcStrictness +deriving instance Show IEWildcard + +deriving instance Show t => Show (HsImplicitBndrs RdrName t) +deriving instance Show t => Show (HsImplicitBndrs Name t) +deriving instance Show t => Show (HsImplicitBndrs Id t) +deriving instance Show t => Show (HsWildCardBndrs RdrName t) +deriving instance Show t => Show (HsWildCardBndrs Name t) +deriving instance Show t => Show (HsWildCardBndrs Id t) +deriving instance (Show a, Show b) => Show (HsRecField' a b) + + +instance Show UnitId where + show = showSDocUnsafe . ppr +instance Show Name where + show = showSDocUnsafe . ppr +instance Show HsTyLit where + show = showSDocUnsafe . ppr +instance Show Var where + show = showSDocUnsafe . ppr +instance Show DataCon where + show = showSDocUnsafe . ppr +instance Show PatSyn where + show = showSDocUnsafe . ppr +instance Show TcEvBinds where + show = showSDocUnsafe . ppr +instance Show HsWrapper where + show = showSDocUnsafe . ppr +instance Show Class where + show = showSDocUnsafe . ppr +instance Show TcCoercion where + show = showSDocUnsafe . ppr +instance Outputable a => Show (UniqFM a) where + show = showSDocUnsafe . ppr +instance Outputable a => Show (Tickish a) where + show = showSDocUnsafe . ppr +instance OutputableBndr a => Show (HsIPBinds a) where + show = showSDocUnsafe . ppr + +instance Show a => Show (Bag a) where + show = show . bagToList +
+ Language/Haskell/Tools/RangeDebug.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE TypeOperators + , DefaultSignatures + , StandaloneDeriving + , FlexibleContexts + , FlexibleInstances + , MultiParamTypeClasses + , TypeFamilies + #-} +-- | A module for displaying debug info about the source annotations of the syntax tree in different phases. +module Language.Haskell.Tools.RangeDebug where + +import GHC.Generics +import Control.Reference +import SrcLoc +import Language.Haskell.Tools.AST +import Language.Haskell.Tools.AST.FromGHC +import Language.Haskell.Tools.Transform + +srcInfoDebug :: TreeDebug e dom st => e dom st -> String +srcInfoDebug = treeDebug' 0 + +class (SourceInfo st, Domain dom, Show (e dom st)) + => TreeDebug e dom st where + treeDebug' :: Int -> e dom st -> String + default treeDebug' :: (GTreeDebug (Rep (e dom st)), Generic (e dom st), Domain dom) => Int -> e dom st -> String + treeDebug' i = gTreeDebug i . from + +class GTreeDebug f where + gTreeDebug :: Int -> f p -> String + +instance GTreeDebug V1 where + gTreeDebug _ = error "GTreeDebug V1" + +instance GTreeDebug U1 where + gTreeDebug _ U1 = "" + +instance (GTreeDebug f, GTreeDebug g) => GTreeDebug (f :+: g) where + gTreeDebug i (L1 x) = gTreeDebug i x + gTreeDebug i (R1 x) = gTreeDebug i x + +instance (GTreeDebug f, GTreeDebug g) => GTreeDebug (f :*: g) where + gTreeDebug i (x :*: y) = gTreeDebug i x ++ gTreeDebug i y + +instance {-# OVERLAPPING #-} TreeDebug e dom st => GTreeDebug (K1 i (e dom st)) where + gTreeDebug i (K1 x) = treeDebug' i x + +instance {-# OVERLAPPABLE #-} GTreeDebug (K1 i c) where + gTreeDebug i (K1 x) = "" + +instance GTreeDebug f => GTreeDebug (M1 i t f) where + gTreeDebug i (M1 x) = gTreeDebug i x
+ Language/Haskell/Tools/RangeDebug/Instances.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE FlexibleContexts + , FlexibleInstances + , MultiParamTypeClasses + , StandaloneDeriving + , DeriveGeneric + , UndecidableInstances + #-} +module Language.Haskell.Tools.RangeDebug.Instances where + +import Language.Haskell.Tools.RangeDebug + +import GHC.Generics +import Control.Reference + +import Language.Haskell.Tools.AST + +-- Annotations +instance TreeDebug e dom st => TreeDebug (Ann e) dom st where + treeDebug' i (Ann a e) = identLine i ++ show (a ^. sourceInfo) ++ " " ++ take 40 (show e) ++ "..." ++ treeDebug' (i+1) e + +identLine :: Int -> String +identLine i = "\n" ++ replicate (i*2) ' ' + +instance TreeDebug e dom st => TreeDebug (AnnListG e) dom st where + treeDebug' i (AnnListG a ls) = identLine i ++ show (a ^. sourceInfo) ++ " <*>" ++ concatMap (treeDebug' (i + 1)) ls + +instance TreeDebug e dom st => TreeDebug (AnnMaybeG e) dom st where + treeDebug' i (AnnMaybeG a e) = identLine i ++ show (a ^. sourceInfo) ++ " <?>" ++ maybe "" (\e -> treeDebug' (i + 1) e) e + +-- Modules +instance (SourceInfo st, Domain dom) => TreeDebug UModule dom st +instance (SourceInfo st, Domain dom) => TreeDebug UModuleHead dom st +instance (SourceInfo st, Domain dom) => TreeDebug UExportSpecs dom st +instance (SourceInfo st, Domain dom) => TreeDebug UExportSpec dom st +instance (SourceInfo st, Domain dom) => TreeDebug UIESpec dom st +instance (SourceInfo st, Domain dom) => TreeDebug USubSpec dom st +instance (SourceInfo st, Domain dom) => TreeDebug UModulePragma dom st +instance (SourceInfo st, Domain dom) => TreeDebug UFilePragma dom st +instance (SourceInfo st, Domain dom) => TreeDebug UImportDecl dom st +instance (SourceInfo st, Domain dom) => TreeDebug UImportSpec dom st +instance (SourceInfo st, Domain dom) => TreeDebug UImportQualified dom st +instance (SourceInfo st, Domain dom) => TreeDebug UImportSource dom st +instance (SourceInfo st, Domain dom) => TreeDebug UImportSafe dom st +instance (SourceInfo st, Domain dom) => TreeDebug UTypeNamespace dom st +instance (SourceInfo st, Domain dom) => TreeDebug UImportRenaming dom st + +-- Declarations +instance (SourceInfo st, Domain dom) => TreeDebug UDecl dom st +instance (SourceInfo st, Domain dom) => TreeDebug UClassBody dom st +instance (SourceInfo st, Domain dom) => TreeDebug UClassElement dom st +instance (SourceInfo st, Domain dom) => TreeDebug UDeclHead dom st +instance (SourceInfo st, Domain dom) => TreeDebug UInstBody dom st +instance (SourceInfo st, Domain dom) => TreeDebug UInstBodyDecl dom st +instance (SourceInfo st, Domain dom) => TreeDebug UGadtConDecl dom st +instance (SourceInfo st, Domain dom) => TreeDebug UGadtConType dom st +instance (SourceInfo st, Domain dom) => TreeDebug UFieldWildcard dom st +instance (SourceInfo st, Domain dom) => TreeDebug UFunDeps dom st +instance (SourceInfo st, Domain dom) => TreeDebug UFunDep dom st +instance (SourceInfo st, Domain dom) => TreeDebug UConDecl dom st +instance (SourceInfo st, Domain dom) => TreeDebug UFieldDecl dom st +instance (SourceInfo st, Domain dom) => TreeDebug UDeriving dom st +instance (SourceInfo st, Domain dom) => TreeDebug UInstanceRule dom st +instance (SourceInfo st, Domain dom) => TreeDebug UInstanceHead dom st +instance (SourceInfo st, Domain dom) => TreeDebug UTypeEqn dom st +instance (SourceInfo st, Domain dom) => TreeDebug UKindConstraint dom st +instance (SourceInfo st, Domain dom) => TreeDebug UTyVar dom st +instance (SourceInfo st, Domain dom) => TreeDebug UType dom st +instance (SourceInfo st, Domain dom) => TreeDebug UKind dom st +instance (SourceInfo st, Domain dom) => TreeDebug UContext dom st +instance (SourceInfo st, Domain dom) => TreeDebug UAssertion dom st +instance (SourceInfo st, Domain dom) => TreeDebug UExpr dom st +instance (SourceInfo st, Domain dom, TreeDebug expr dom st, Generic (expr dom st)) => TreeDebug (UStmt' expr) dom st +instance (SourceInfo st, Domain dom) => TreeDebug UCompStmt dom st +instance (SourceInfo st, Domain dom) => TreeDebug UValueBind dom st +instance (SourceInfo st, Domain dom) => TreeDebug UPattern dom st +instance (SourceInfo st, Domain dom) => TreeDebug UPatternField dom st +instance (SourceInfo st, Domain dom) => TreeDebug USplice dom st +instance (SourceInfo st, Domain dom) => TreeDebug QQString dom st +instance (SourceInfo st, Domain dom) => TreeDebug UMatch dom st +instance (SourceInfo st, Domain dom, TreeDebug expr dom st, Generic (expr dom st)) => TreeDebug (UAlt' expr) dom st +instance (SourceInfo st, Domain dom) => TreeDebug URhs dom st +instance (SourceInfo st, Domain dom) => TreeDebug UGuardedRhs dom st +instance (SourceInfo st, Domain dom) => TreeDebug UFieldUpdate dom st +instance (SourceInfo st, Domain dom) => TreeDebug UBracket dom st +instance (SourceInfo st, Domain dom) => TreeDebug UTopLevelPragma dom st +instance (SourceInfo st, Domain dom) => TreeDebug URule dom st +instance (SourceInfo st, Domain dom) => TreeDebug UAnnotationSubject dom st +instance (SourceInfo st, Domain dom) => TreeDebug UMinimalFormula dom st +instance (SourceInfo st, Domain dom) => TreeDebug UExprPragma dom st +instance (SourceInfo st, Domain dom) => TreeDebug USourceRange dom st +instance (SourceInfo st, Domain dom) => TreeDebug Number dom st +instance (SourceInfo st, Domain dom) => TreeDebug UQuasiQuote dom st +instance (SourceInfo st, Domain dom) => TreeDebug URhsGuard dom st +instance (SourceInfo st, Domain dom) => TreeDebug ULocalBind dom st +instance (SourceInfo st, Domain dom) => TreeDebug ULocalBinds dom st +instance (SourceInfo st, Domain dom) => TreeDebug UFixitySignature dom st +instance (SourceInfo st, Domain dom) => TreeDebug UTypeSignature dom st +instance (SourceInfo st, Domain dom) => TreeDebug UListCompBody dom st +instance (SourceInfo st, Domain dom) => TreeDebug UTupSecElem dom st +instance (SourceInfo st, Domain dom) => TreeDebug UTypeFamily dom st +instance (SourceInfo st, Domain dom) => TreeDebug UTypeFamilySpec dom st +instance (SourceInfo st, Domain dom) => TreeDebug UInjectivityAnn dom st +instance (SourceInfo st, Domain dom, TreeDebug expr dom st, Generic (expr dom st)) => TreeDebug (UCaseRhs' expr) dom st +instance (SourceInfo st, Domain dom, TreeDebug expr dom st, Generic (expr dom st)) => TreeDebug (UGuardedCaseRhs' expr) dom st +instance (SourceInfo st, Domain dom) => TreeDebug UPatternSynonym dom st +instance (SourceInfo st, Domain dom) => TreeDebug UPatSynRhs dom st +instance (SourceInfo st, Domain dom) => TreeDebug UPatSynLhs dom st +instance (SourceInfo st, Domain dom) => TreeDebug UPatSynWhere dom st +instance (SourceInfo st, Domain dom) => TreeDebug UPatternTypeSignature dom st +instance (SourceInfo st, Domain dom) => TreeDebug URole dom st +instance (SourceInfo st, Domain dom) => TreeDebug UCmd dom st +instance (SourceInfo st, Domain dom) => TreeDebug ULanguageExtension dom st +instance (SourceInfo st, Domain dom) => TreeDebug UMatchLhs dom st + +-- ULiteral +instance (SourceInfo st, Domain dom) => TreeDebug ULiteral dom st +instance (SourceInfo st, Domain dom, TreeDebug k dom st, Generic (k dom st)) => TreeDebug (UPromoted k) dom st + +-- Base +instance (SourceInfo st, Domain dom) => TreeDebug UOperator dom st +instance (SourceInfo st, Domain dom) => TreeDebug UName dom st +instance (SourceInfo st, Domain dom) => TreeDebug UQualifiedName dom st +instance (SourceInfo st, Domain dom) => TreeDebug UModuleName dom st +instance (SourceInfo st, Domain dom) => TreeDebug UNamePart dom st +instance (SourceInfo st, Domain dom) => TreeDebug UStringNode dom st +instance (SourceInfo st, Domain dom) => TreeDebug UDataOrNewtypeKeyword dom st +instance (SourceInfo st, Domain dom) => TreeDebug UDoKind dom st +instance (SourceInfo st, Domain dom) => TreeDebug TypeKeyword dom st +instance (SourceInfo st, Domain dom) => TreeDebug UOverlapPragma dom st +instance (SourceInfo st, Domain dom) => TreeDebug UCallConv dom st +instance (SourceInfo st, Domain dom) => TreeDebug UArrowAppl dom st +instance (SourceInfo st, Domain dom) => TreeDebug USafety dom st +instance (SourceInfo st, Domain dom) => TreeDebug UConlikeAnnot dom st +instance (SourceInfo st, Domain dom) => TreeDebug Assoc dom st +instance (SourceInfo st, Domain dom) => TreeDebug Precedence dom st +instance (SourceInfo st, Domain dom) => TreeDebug LineNumber dom st +instance (SourceInfo st, Domain dom) => TreeDebug UPhaseControl dom st +instance (SourceInfo st, Domain dom) => TreeDebug PhaseNumber dom st +instance (SourceInfo st, Domain dom) => TreeDebug PhaseInvert dom st
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple +main = defaultMain
+ haskell-tools-debug.cabal view
@@ -0,0 +1,29 @@+name: haskell-tools-debug +version: 0.4.1.0 +synopsis: Debugging Tools for Haskell-tools +description: Debugging Tools for Haskell-tools +homepage: https://github.com/haskell-tools/haskell-tools +license: BSD3 +license-file: LICENSE +author: Boldizsar Nemeth +maintainer: nboldi@elte.hu +category: Language +build-type: Simple +cabal-version: >=1.10 + +library + ghc-options: -O2 + exposed-modules: Language.Haskell.Tools.Debug + other-modules: Language.Haskell.Tools.DebugGhcAST + , Language.Haskell.Tools.RangeDebug + , Language.Haskell.Tools.RangeDebug.Instances + build-depends: base >= 4.9 && < 4.10 + , references >= 0.3 && < 0.4 + , ghc >= 8.0 && < 8.1 + , ghc-paths >= 0.1 && < 0.2 + , haskell-tools-ast >= 0.4 && < 0.5 + , haskell-tools-backend-ghc >= 0.4 && < 0.5 + , haskell-tools-refactor >= 0.4 && < 0.5 + , haskell-tools-prettyprint >= 0.4 && < 0.5 + default-language: Haskell2010 +