haskell-tools-debug 1.0.0.4 → 1.0.1.1

raw patch · 6 files changed

+321/−132 lines, 6 filesdep +classyplatedep +criteriondep +mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: classyplate, criterion, mtl, uniplate

API changes (from Hackage documentation)

+ Language.Haskell.Tools.Debug: forcedTypecheck :: ModSummary -> ParsedModule -> Ghc (Maybe RenamedSource, TypecheckedSource)

Files

Language/Haskell/Tools/Debug.hs +58/−14
Language/Haskell/Tools/Debug/DebugGhcAST.hs +1/−0
Language/Haskell/Tools/Debug/RangeDebug.hs +7/−3
Language/Haskell/Tools/Debug/RangeDebugInstances.hs +115/−114
Language/Haskell/Tools/Debug/Show.hs +134/−0
haskell-tools-debug.cabal +6/−1

Language/Haskell/Tools/Debug.hs view

@@ -1,7 +1,9 @@- {-# LANGUAGE DeriveGeneric, LambdaCase, StandaloneDeriving #-}
+ {-# LANGUAGE DeriveGeneric, LambdaCase, ScopedTypeVariables, StandaloneDeriving #-}+
 module Language.Haskell.Tools.Debug where
 
-import Control.Monad (Monad(..), (=<<), forM_)
+import Control.Exception
+import Control.Monad
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Reference ((^.))
 import Data.List.Split (splitOn)
@@ -9,11 +11,23 @@ import GHC.Generics (Generic(..))
 import System.FilePath (pathSeparator, (</>), (<.>))
 
-import DynFlags (xopt)
 import GHC hiding (loadModule)
 import GHC.Paths ( libdir )
 import Language.Haskell.TH.LanguageExtensions (Extension(..))
 import StringBuffer (hGetStringBuffer)
+import Outputable
+import HscMain
+import HscTypes
+import TcRnDriver
+import TcRnTypes
+import TcRnMonad
+import Data.IORef
+import UniqSupply
+import DynFlags
+import ErrUtils
+import Bag
+import RdrName
+import Exception
 
 import Language.Haskell.Tools.AST (NodeInfo(..))
 import Language.Haskell.Tools.BackendGHC
@@ -32,41 +46,53 @@     initGhcFlags
     _ <- useFlags args
     useDirs [workingDir]
+    
+    liftIO $ putStrLn "=========== parsed source:"
     ms <- loadModule workingDir moduleName
+    
+    dfs <- getSessionDynFlags
+    -- setSessionDynFlags (dfs `dopt_set` Opt_D_dump_rn_trace `dopt_set` Opt_D_dump_tc_trace)
+    
     p <- parseModule ms
-    t <- typecheckModule p
-
-    let annots = pm_annotations $ tm_parsed_module t
-        hasCPP = Cpp `xopt` ms_hspp_opts ms
-
+    let annots = pm_annotations $ p
+    liftIO $ putStrLn $ show (pm_parsed_source p)
     liftIO $ putStrLn "=========== tokens:"
     liftIO $ putStrLn $ show (fst annots)
     liftIO $ putStrLn "=========== comments:"
     liftIO $ putStrLn $ show (snd annots)
-    liftIO $ putStrLn "=========== parsed source:"
-    liftIO $ putStrLn $ show (pm_parsed_source p)
     liftIO $ putStrLn "=========== renamed source:"
-    liftIO $ putStrLn $ show (fromJust $ tm_renamed_source t)
+    
+    (rnSrc, tcSrc) <- ((\t -> (tm_renamed_source t, typecheckedSource t)) <$> typecheckModule p)
+                         `gcatch` \(e :: SomeException) -> forcedTypecheck ms p
+    liftIO $ putStrLn $ show rnSrc
+    
+    -- liftIO $ putStrLn $ show (fromJust $ tm_renamed_source t)
     liftIO $ putStrLn "=========== typechecked source:"
-    liftIO $ putStrLn $ show (typecheckedSource t)
+    liftIO $ putStrLn $ show tcSrc
+    
+    let hasCPP = Cpp `xopt` ms_hspp_opts ms
+    
     liftIO $ putStrLn "=========== parsed:"
     --transformed <- runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModule (pm_parsed_source p)
     parseTrf <- runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModule ms (pm_parsed_source p)
     liftIO $ putStrLn $ srcInfoDebug parseTrf
+    
     liftIO $ putStrLn "=========== typed:"
-    transformed <- addTypeInfos (typecheckedSource t) =<< (runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModuleRename ms parseTrf (fromJust $ tm_renamed_source t) (pm_parsed_source p))
+    transformed <- addTypeInfos tcSrc =<< (runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModuleRename ms parseTrf (fromJust $ rnSrc) (pm_parsed_source p))
     liftIO $ putStrLn $ srcInfoDebug transformed
+    
     liftIO $ putStrLn "=========== ranges fixed:"
     sourceOrigin <- if hasCPP then liftIO $ hGetStringBuffer (workingDir </> map (\case '.' -> pathSeparator; c -> c) moduleName <.> "hs")
                               else return (fromJust $ ms_hspp_buf $ pm_mod_summary p)
     let commented = fixRanges $ placeComments (fst annots) (getNormalComments $ snd annots) $ fixMainRange sourceOrigin 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 sourceOrigin (getLocIndices cutUp)
+    
     liftIO $ putStrLn "=========== sourced:"
     let sourced = (if hasCPP then extractStayingElems else id) $ rangeToSource sourceOrigin cutUp
     liftIO $ putStrLn $ srcInfoDebug sourced
@@ -101,3 +127,21 @@ 
 deriving instance Generic SrcSpan
 deriving instance Generic (NodeInfo sema src)
+
+forcedTypecheck :: ModSummary -> ParsedModule -> Ghc (Maybe RenamedSource, TypecheckedSource)
+forcedTypecheck ms p = do
+  env <- getSession
+  store <- liftIO $ newIORef (error "not found")
+  let hpm = HsParsedModule (pm_parsed_source p) (pm_extra_src_files p) (pm_annotations p)
+  (msgs, Just (gblEnv, lclEnv)) <- liftIO $ runTcInteractive env $ (,) <$> getGblEnv <*> getLclEnv 
+  let finalizeModule = do gbl <- getGblEnv
+                          liftIO $ writeIORef store ( (,,,) <$> tcg_rn_decls gbl
+                                                            <*> return (tcg_rn_imports gbl)
+                                                            <*> return (tcg_rn_exports gbl)
+                                                            <*> return (tcg_doc_hdr gbl)
+                                                    , tcg_binds gbl)
+  liftIO $ modifyIORef (tcg_th_modfinalizers gblEnv) (finalizeModule :)
+  let gblEnv' = gblEnv { tcg_rn_exports = Just [], tcg_rn_decls = Just emptyRnGroup }
+  liftIO $ initTcRnIf 'a' env gblEnv' lclEnv $ void (tcRnModuleTcRnM env HsSrcFile hpm (ms_mod ms, getLoc (pm_parsed_source p)))
+                                                 `gcatch` \(e :: SomeException) -> return ()
+  liftIO $ readIORef store

Language/Haskell/Tools/Debug/DebugGhcAST.hs view

@@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts, FlexibleInstances, StandaloneDeriving, UndecidableInstances #-}
+
 -- | A module for showing GHC's syntax tree representation.
 module Language.Haskell.Tools.Debug.DebugGhcAST where

Language/Haskell/Tools/Debug/RangeDebug.hs view

@@ -1,17 +1,21 @@-{-# LANGUAGE DefaultSignatures, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeFamilies, TypeOperators #-}
+{-# LANGUAGE ConstraintKinds, DefaultSignatures, FlexibleContexts, FlexibleInstances, GADTs, MultiParamTypeClasses, TypeOperators #-}
+
 -- | A module for displaying debug info about the source annotations of the syntax tree in different phases.
 module Language.Haskell.Tools.Debug.RangeDebug where
 
 import Control.Reference ()
 import GHC.Generics
-import Language.Haskell.Tools.AST (SourceInfo(..), Domain(..))
+import Language.Haskell.Tools.AST
 import Language.Haskell.Tools.BackendGHC ()
 import Language.Haskell.Tools.PrettyPrint.Prepare ()
+import Language.Haskell.Tools.Debug.Show ()
 
+type ShowSrcInfo st = (Show (SpanInfo st), Show (ListInfo st), Show (OptionalInfo st)) 
+
 srcInfoDebug :: TreeDebug e dom st => e dom st -> String
 srcInfoDebug = treeDebug' 0
 
-class (SourceInfo st, Domain dom, Show (e dom st))
+class (ShowSrcInfo 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

Language/Haskell/Tools/Debug/RangeDebugInstances.hs view

@@ -1,7 +1,8 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeFamilies, UndecidableInstances #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs, MultiParamTypeClasses, UndecidableInstances #-}
+
 module Language.Haskell.Tools.Debug.RangeDebugInstances where
 
-import Language.Haskell.Tools.Debug.RangeDebug (TreeDebug(..))
+import Language.Haskell.Tools.Debug.RangeDebug
 
 import Control.Reference ((^.))
 import GHC.Generics (Generic(..))
@@ -9,131 +10,131 @@ import Language.Haskell.Tools.AST
 
 -- Annotations
-instance TreeDebug e dom st => TreeDebug (Ann e) dom st where
+instance (TreeDebug e dom st, ShowSrcInfo 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
+instance (TreeDebug e dom st, ShowSrcInfo 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
+instance (TreeDebug e dom st, ShowSrcInfo 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 UImportModifier 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
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UModule dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UModuleHead dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UExportSpecs dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UExportSpec dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UIESpec dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug USubSpec dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UModulePragma dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UFilePragma dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UImportDecl dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UImportSpec dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UImportModifier dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UImportQualified dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UImportSource dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UImportSafe dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UTypeNamespace dom st
+instance (ShowSrcInfo 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 UDeriveStrategy 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 URuleVar 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
-instance (SourceInfo st, Domain dom) => TreeDebug UInlinePragma dom st
-instance (SourceInfo st, Domain dom) => TreeDebug USpecializePragma dom st
-instance (SourceInfo st, Domain dom) => TreeDebug UUnboxedSumPlaceHolder dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UDecl dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UClassBody dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UClassElement dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UDeclHead dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UInstBody dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UInstBodyDecl dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UGadtConDecl dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UGadtConType dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UFieldWildcard dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UFunDeps dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UFunDep dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UConDecl dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UFieldDecl dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UDeriving dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UDeriveStrategy dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UInstanceRule dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UInstanceHead dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UTypeEqn dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UKindConstraint dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UTyVar dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UType dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UKind dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UContext dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UAssertion dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UExpr dom st
+instance (ShowSrcInfo st, Domain dom, TreeDebug expr dom st, Generic (expr dom st)) => TreeDebug (UStmt' expr) dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UCompStmt dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UValueBind dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UPattern dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UPatternField dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug USplice dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug QQString dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UMatch dom st
+instance (ShowSrcInfo st, Domain dom, TreeDebug expr dom st, Generic (expr dom st)) => TreeDebug (UAlt' expr) dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug URhs dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UGuardedRhs dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UFieldUpdate dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UBracket dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UTopLevelPragma dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug URule dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug URuleVar dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UAnnotationSubject dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UMinimalFormula dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UExprPragma dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug USourceRange dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug Number dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UQuasiQuote dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug URhsGuard dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug ULocalBind dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug ULocalBinds dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UFixitySignature dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UTypeSignature dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UListCompBody dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UTupSecElem dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UTypeFamily dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UTypeFamilySpec dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UInjectivityAnn dom st
+instance (ShowSrcInfo st, Domain dom, TreeDebug expr dom st, Generic (expr dom st)) => TreeDebug (UCaseRhs' expr) dom st
+instance (ShowSrcInfo st, Domain dom, TreeDebug expr dom st, Generic (expr dom st)) => TreeDebug (UGuardedCaseRhs' expr) dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UPatternSynonym dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UPatSynRhs dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UPatSynLhs dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UPatSynWhere dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UPatternTypeSignature dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug URole dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UCmd dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug ULanguageExtension dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UMatchLhs dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UInlinePragma dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug USpecializePragma dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UUnboxedSumPlaceHolder 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
+instance (ShowSrcInfo st, Domain dom) => TreeDebug ULiteral dom st
+instance (ShowSrcInfo 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
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UOperator dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UName dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UQualifiedName dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UModuleName dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UNamePart dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UStringNode dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UDataOrNewtypeKeyword dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UDoKind dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug TypeKeyword dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UOverlapPragma dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UCallConv dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UArrowAppl dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug USafety dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UConlikeAnnot dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug Assoc dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug Precedence dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug LineNumber dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug UPhaseControl dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug PhaseNumber dom st
+instance (ShowSrcInfo st, Domain dom) => TreeDebug PhaseInvert dom st

+ Language/Haskell/Tools/Debug/Show.hs view

@@ -0,0 +1,134 @@+-- | Show instance for Haskell AST representation ignoring source and semantic information
+{-# LANGUAGE FlexibleContexts, StandaloneDeriving #-}
+
+module Language.Haskell.Tools.Debug.Show () where
+
+import Language.Haskell.Tools.AST
+
+-- Annotations
+instance (Show (e dom stage)) => Show (Ann e dom stage) where
+  show (Ann _ e) = show e
+
+instance (Show (e dom stage)) => Show (AnnMaybeG e dom stage) where
+  show (AnnMaybeG _ e) = show e
+
+instance (Show (e dom stage)) => Show (AnnListG e dom stage) where
+  show (AnnListG _ e) = show e
+
+-- Modules
+deriving instance Show (UModule dom stage)
+deriving instance Show (UModuleHead dom stage)
+deriving instance Show (UExportSpecs dom stage)
+deriving instance Show (UExportSpec dom stage)
+deriving instance Show (UIESpec dom stage)
+deriving instance Show (USubSpec dom stage)
+deriving instance Show (UModulePragma dom stage)
+deriving instance Show (UFilePragma dom stage)
+deriving instance Show (UImportDecl dom stage)
+deriving instance Show (UImportSpec dom stage)
+deriving instance Show (UImportModifier dom stage)
+deriving instance Show (UImportQualified dom stage)
+deriving instance Show (UImportSource dom stage)
+deriving instance Show (UImportSafe dom stage)
+deriving instance Show (UTypeNamespace dom stage)
+deriving instance Show (UImportRenaming dom stage)
+
+-- Declarations
+deriving instance Show (UDecl dom stage)
+deriving instance Show (UClassBody dom stage)
+deriving instance Show (UClassElement dom stage)
+deriving instance Show (UDeclHead dom stage)
+deriving instance Show (UInstBody dom stage)
+deriving instance Show (UInstBodyDecl dom stage)
+deriving instance Show (UGadtConDecl dom stage)
+deriving instance Show (UGadtConType dom stage)
+deriving instance Show (UFieldWildcard dom stage)
+deriving instance Show (UFunDeps dom stage)
+deriving instance Show (UFunDep dom stage)
+deriving instance Show (UConDecl dom stage)
+deriving instance Show (UFieldDecl dom stage)
+deriving instance Show (UDeriving dom stage)
+deriving instance Show (UDeriveStrategy dom stage)
+deriving instance Show (UInstanceRule dom stage)
+deriving instance Show (UInstanceHead dom stage)
+deriving instance Show (UTypeEqn dom stage)
+deriving instance Show (UKindConstraint dom stage)
+deriving instance Show (UTyVar dom stage)
+deriving instance Show (UType dom stage)
+deriving instance Show (UKind dom stage)
+deriving instance Show (UContext dom stage)
+deriving instance Show (UAssertion dom stage)
+deriving instance Show (UExpr dom stage)
+deriving instance Show (expr dom stage) => Show (UStmt' expr dom stage)
+deriving instance Show (UCompStmt dom stage)
+deriving instance Show (UValueBind dom stage)
+deriving instance Show (UPattern dom stage)
+deriving instance Show (UPatternField dom stage)
+deriving instance Show (USplice dom stage)
+deriving instance Show (QQString dom stage)
+deriving instance Show (UMatch dom stage)
+deriving instance Show (expr dom stage) => Show (UAlt' expr dom stage)
+deriving instance Show (URhs dom stage)
+deriving instance Show (UGuardedRhs dom stage)
+deriving instance Show (UFieldUpdate dom stage)
+deriving instance Show (UBracket dom stage)
+deriving instance Show (UTopLevelPragma dom stage)
+deriving instance Show (URule dom stage)
+deriving instance Show (URuleVar dom stage)
+deriving instance Show (UAnnotationSubject dom stage)
+deriving instance Show (UMinimalFormula dom stage)
+deriving instance Show (UExprPragma dom stage)
+deriving instance Show (USourceRange dom stage)
+deriving instance Show (Number dom stage)
+deriving instance Show (UQuasiQuote dom stage)
+deriving instance Show (URhsGuard dom stage)
+deriving instance Show (ULocalBind dom stage)
+deriving instance Show (ULocalBinds dom stage)
+deriving instance Show (UFixitySignature dom stage)
+deriving instance Show (UTypeSignature dom stage)
+deriving instance Show (UListCompBody dom stage)
+deriving instance Show (UTupSecElem dom stage)
+deriving instance Show (UTypeFamily dom stage)
+deriving instance Show (UTypeFamilySpec dom stage)
+deriving instance Show (UInjectivityAnn dom stage)
+deriving instance Show (expr dom stage) => Show (UCaseRhs' expr dom stage)
+deriving instance Show (expr dom stage) => Show (UGuardedCaseRhs' expr dom stage)
+deriving instance Show (UPatternSynonym dom stage)
+deriving instance Show (UPatSynRhs dom stage)
+deriving instance Show (UPatSynLhs dom stage)
+deriving instance Show (UPatSynWhere dom stage)
+deriving instance Show (UPatternTypeSignature dom stage)
+deriving instance Show (URole dom stage)
+deriving instance Show (UCmd dom stage)
+deriving instance Show (ULanguageExtension dom stage)
+deriving instance Show (UMatchLhs dom stage)
+deriving instance Show (UInlinePragma dom stage)
+deriving instance Show (USpecializePragma dom stage)
+deriving instance Show (UUnboxedSumPlaceHolder dom stage)
+
+
+-- ULiteral
+deriving instance Show (ULiteral dom stage)
+deriving instance Show (k dom stage) => Show (UPromoted k dom stage)
+
+-- Base
+deriving instance Show (UOperator dom stage)
+deriving instance Show (UName dom stage)
+deriving instance Show (UQualifiedName dom stage)
+deriving instance Show (UModuleName dom stage)
+deriving instance Show (UNamePart dom stage)
+deriving instance Show (UStringNode dom stage)
+deriving instance Show (UDataOrNewtypeKeyword dom stage)
+deriving instance Show (UDoKind dom stage)
+deriving instance Show (TypeKeyword dom stage)
+deriving instance Show (UOverlapPragma dom stage)
+deriving instance Show (UCallConv dom stage)
+deriving instance Show (UArrowAppl dom stage)
+deriving instance Show (USafety dom stage)
+deriving instance Show (UConlikeAnnot dom stage)
+deriving instance Show (Assoc dom stage)
+deriving instance Show (Precedence dom stage)
+deriving instance Show (LineNumber dom stage)
+deriving instance Show (UPhaseControl dom stage)
+deriving instance Show (PhaseNumber dom stage)
+deriving instance Show (PhaseInvert dom stage)

haskell-tools-debug.cabal view

@@ -1,5 +1,5 @@ name:                haskell-tools-debug
-version:             1.0.0.4
+version:             1.0.1.1
 synopsis:            Debugging Tools for Haskell-tools
 description:         Debugging Tools for Haskell-tools
 homepage:            https://github.com/haskell-tools/haskell-tools
@@ -14,6 +14,7 @@ library
   exposed-modules:     Language.Haskell.Tools.Debug
   other-modules:       Language.Haskell.Tools.Debug.DebugGhcAST
+                     , Language.Haskell.Tools.Debug.Show
                      , Language.Haskell.Tools.Debug.RangeDebug
                      , Language.Haskell.Tools.Debug.RangeDebugInstances
   build-depends:       base                      >= 4.10 && < 4.11
@@ -28,6 +29,10 @@                      , haskell-tools-refactor    >= 1.0 && < 1.1
                      , haskell-tools-prettyprint >= 1.0 && < 1.1
                      , haskell-tools-builtin-refactorings >= 1.0 && < 1.1
+                     , uniplate                  >= 1.6 && < 1.7
+                     , classyplate               >= 0.3 && < 0.4
+                     , criterion                 >= 1.1 && < 1.5
+                     , mtl                       >= 2.2 && < 2.3
   default-language:    Haskell2010
 
 executable ht-debug