packages feed

ghc-syb 0.1.2.2 → 0.2.0.0

raw patch · 4 files changed

+480/−740 lines, 4 filesdep −sybPVP ok

version bump matches the API change (PVP)

Dependencies removed: syb

API changes (from Hackage documentation)

- GHC.SYB.Utils: Parser :: Stage
- GHC.SYB.Utils: Renamer :: Stage
- GHC.SYB.Utils: TypeChecker :: Stage
- GHC.SYB.Utils: data Stage
- GHC.SYB.Utils: everythingBut :: GenericQ Bool -> (r -> r -> r) -> r -> GenericQ r -> GenericQ r
- GHC.SYB.Utils: everythingStaged :: Stage -> (r -> r -> r) -> r -> GenericQ r -> GenericQ r
- GHC.SYB.Utils: instance Eq Stage
- GHC.SYB.Utils: instance Ord Stage
- GHC.SYB.Utils: instance Show Stage
- GHC.SYB.Utils: showData :: (Data a) => Stage -> Int -> a -> String

Files

+ GHC/SYB/Instances.hs view
@@ -0,0 +1,473 @@+{- | "GHC.Syb.Instances" provides instances of Data\/Typeable+     for Ghc Api types, using standalone deriving.++Most instances are standard; to provide 'Data' instances +abstract types, we use one of two schemes:++- no traversal: 'SrcSpan', 'Module', 'ModuleName', 'OccName', 'Name', +                'FastString', 'DataCon', 'Var', 'TyCon', 'Class'++@+    abstractConstr   n = mkConstr (abstractDataType n) ("{abstract:"++n++"}") [] Prefix+    abstractDataType n = mkDataType n [abstractConstr n]+@++@+    instance Data SrcSpan where+      -- don't traverse?+      toConstr _   = abstractConstr "SrcSpan"+      gunfold _ _  = error "gunfold"+      dataTypeOf _ = mkNoRepType "SrcSpan"+@++- abstract traversal: 'NameSet', 'Bag'++@+    instance Data NameSet where+      gfoldl k z s = z mkNameSet `k` nameSetToList s -- traverse abstractly+      toConstr _   = abstractConstr "NameSet"+      gunfold _ _  = error "gunfold"+      dataTypeOf _ = mkNoRepType "NameSet"+@++Please report any issues, either with these abstract instances or with+these modules going out of sync with GHC head, to the package maintainer.++-}+module GHC.SYB.Instances where++import GHC hiding(TyCon)+import SrcLoc+import RdrName+import OccName+import FastString+import Bag+import Module+import BasicTypes+import Var+import ForeignCall++import CoreSyn+import Literal+import CostCentre++import Data.Data+import NameSet+import TypeRep+import qualified TyCon++#include "Typeable.h"++#ifdef __HADDOCK__+#else++-- TODO: good for generalized show, but is this sound in general?+abstractConstr   n = mkConstr (abstractDataType n) ("{abstract:"++n++"}") [] Prefix+abstractDataType n = mkDataType n [abstractConstr n]++#ifndef CAN_SPELL+mkNoRepType = mkNorepType+#endif++-- Typeable0++INSTANCE_TYPEABLE0(SrcSpan,srcSpanTc,"SrcSpan")+instance Data SrcSpan where+  -- don't traverse?+  toConstr _   = abstractConstr "SrcSpan"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = mkNoRepType "SrcSpan"++INSTANCE_TYPEABLE0(Module,moduleTc,"Module")+instance Data Module where+  -- don't traverse?+  toConstr _   = abstractConstr "Module"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = mkNoRepType "Module"++INSTANCE_TYPEABLE0(ModuleName,moduleNameTc,"ModuleName")+instance Data ModuleName where+  -- don't traverse?+  toConstr _   = abstractConstr "ModuleName"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = mkNoRepType "ModuleName"++deriving instance Typeable RdrName+deriving instance Data RdrName++INSTANCE_TYPEABLE0(OccName,occNameTc,"OccName")+instance Data OccName where+  -- don't traverse?+  toConstr _   = abstractConstr "OccName"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = mkNoRepType "OccName"++INSTANCE_TYPEABLE0(Name,nameTc,"Name")+instance Data Name where+  -- don't traverse?+  toConstr _   = abstractConstr "Name"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = mkNoRepType "Name"++deriving instance Typeable FastString+instance Data FastString where+  -- don't traverse?+  toConstr _   = abstractConstr "FastString"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = mkNoRepType "FastString"++deriving instance Typeable HsExplicitForAll+deriving instance Data HsExplicitForAll++deriving instance Typeable HsBang+deriving instance Data HsBang++deriving instance Typeable Boxity+deriving instance Data Boxity++deriving instance Typeable OverLitVal+deriving instance Data OverLitVal++deriving instance Typeable RecFlag+deriving instance Data RecFlag++deriving instance Typeable BasicTypes.Fixity+deriving instance Data BasicTypes.Fixity++deriving instance Typeable HsArrAppType+deriving instance Data HsArrAppType++deriving instance Typeable FixityDirection+deriving instance Data FixityDirection++INSTANCE_TYPEABLE0(DataCon,dataConTc,"DataCon")+instance Data DataCon where+  -- don't traverse?+  toConstr _   = abstractConstr "DataCon"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = mkNoRepType "DataCon"++INSTANCE_TYPEABLE0(Var,varTc,"Var")+instance Data Var where+  -- don't traverse?+  toConstr _   = abstractConstr "Var"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = mkNoRepType "Var"++deriving instance Typeable InlineSpec+deriving instance Data InlineSpec++#ifdef CONSTRUCTOR_LIKE_IDS+deriving instance Typeable InlinePragma+deriving instance Data InlinePragma++deriving instance Typeable RuleMatchInfo+deriving instance Data RuleMatchInfo+#endif++deriving instance Typeable ForeignImport+deriving instance Data ForeignImport++deriving instance Typeable ForeignExport+deriving instance Data ForeignExport++deriving instance Typeable CImportSpec+deriving instance Data CImportSpec++deriving instance Typeable CExportSpec+deriving instance Data CExportSpec++#if HAS_DN_STUFF+deriving instance Typeable DNCallSpec+deriving instance Data DNCallSpec+#endif++deriving instance Typeable Safety+deriving instance Data Safety++deriving instance Typeable CCallConv+deriving instance Data CCallConv++#if HAS_DN_STUFF+deriving instance Typeable DNKind+deriving instance Data DNKind++deriving instance Typeable DNType+deriving instance Data DNType+#endif++deriving instance Typeable CCallTarget+deriving instance Data CCallTarget++deriving instance Typeable Activation+deriving instance Data Activation++INSTANCE_TYPEABLE0(NameSet,nameSetTc,"NameSet")+instance Data NameSet where+  gfoldl k z s = z mkNameSet `k` nameSetToList s -- traverse abstractly+  toConstr _   = abstractConstr "NameSet"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = mkNoRepType "NameSet"++#if HAS_FOTYPE+deriving instance Typeable FoType+deriving instance Data FoType+#endif++deriving instance Typeable FamilyFlavour+deriving instance Data FamilyFlavour++deriving instance Typeable NewOrData+deriving instance Data NewOrData++INSTANCE_TYPEABLE0(TyCon.TyCon,tyConTc,"TyCon")+instance Data TyCon.TyCon where+  -- don't traverse?+  toConstr _   = abstractConstr "TyCon.TyCon"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = mkNoRepType "TyCon.TyCon"++INSTANCE_TYPEABLE0(Class,classTc,"Class")+instance Data Class where+  -- don't traverse?+  toConstr _   = abstractConstr "Class"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = mkNoRepType "Class"++deriving instance Typeable Prag+deriving instance Data Prag++deriving instance Typeable HsWrapper+deriving instance Data HsWrapper++deriving instance Typeable PredType+deriving instance Data PredType++deriving instance Typeable Type+deriving instance Data Type++deriving instance Typeable HsLit+deriving instance Data HsLit++deriving instance Typeable Note+deriving instance Data Note++deriving instance Typeable AltCon+deriving instance Data AltCon++deriving instance Typeable Literal+deriving instance Data Literal++deriving instance Typeable CostCentre+deriving instance Data CostCentre++#ifdef HAS_FUNCTION_OR_DATA+deriving instance Typeable FunctionOrData+deriving instance Data FunctionOrData+#endif++deriving instance Typeable IsDupdCC+deriving instance Data IsDupdCC++deriving instance Typeable IsCafCC+deriving instance Data IsCafCC++#if HAS_SIMPLE_DOCS+deriving instance Typeable HsDocString+deriving instance Data HsDocString++deriving instance Typeable DocDecl+deriving instance Data DocDecl+#else+deriving instance Typeable1 DocDecl+deriving instance Data a => Data (DocDecl a)+#endif++-- Typeable1++deriving instance Typeable1 Located+deriving instance Data e => Data (Located e)++deriving instance Typeable1 HsModule+deriving instance Data a => Data (HsModule a)++#if !HAS_SIMPLE_DOCS+deriving instance Typeable1 HsDoc+deriving instance Data a => Data (HsDoc a)++deriving instance Typeable1 HaddockModInfo+deriving instance Data a => Data (HaddockModInfo a)+#endif++deriving instance Typeable1 HsDecl+deriving instance Data a => Data (HsDecl a)++deriving instance Typeable1 ImportDecl+deriving instance Data a => Data (ImportDecl a)++deriving instance Typeable1 IE+deriving instance Data a => Data (IE a)++deriving instance Typeable1 TyClDecl+deriving instance Data a => Data (TyClDecl a)++deriving instance Typeable1 SpliceDecl+deriving instance Data a => Data (SpliceDecl a)++deriving instance Typeable1 RuleDecl+deriving instance Data a => Data (RuleDecl a)++deriving instance Typeable WarningTxt+deriving instance Data WarningTxt++deriving instance Typeable1 WarnDecl+deriving instance Data a => Data (WarnDecl a)++deriving instance Typeable1 ForeignDecl+deriving instance Data a => Data (ForeignDecl a)++deriving instance Typeable1 DefaultDecl+deriving instance Data a => Data (DefaultDecl a)++deriving instance Typeable1 Sig+deriving instance Data a => Data (Sig a)++deriving instance Typeable1 DerivDecl+deriving instance Data a => Data (DerivDecl a)++deriving instance Typeable1 InstDecl+deriving instance Data a => Data (InstDecl a)++deriving instance Typeable1 HsPred+deriving instance Data a => Data (HsPred a)++deriving instance Typeable1 HsType+deriving instance Data a => Data (HsType a)++deriving instance Typeable1 ConDecl+deriving instance Data a => Data (ConDecl a)++INSTANCE_TYPEABLE1(Bag,bagTc,"Bag")+instance Data a => Data (Bag a) where+  gfoldl k z b = z listToBag `k` bagToList b -- traverse abstract type abstractly+  toConstr _   = abstractConstr $ "Bag("++show (typeOf (undefined::a))++")"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = mkNoRepType "Bag"++deriving instance Typeable1 HsTyVarBndr+deriving instance Data a => Data (HsTyVarBndr a)++deriving instance Typeable1 ResType+deriving instance Data a => Data (ResType a)++deriving instance Typeable1 HsSplice+deriving instance Data a => Data (HsSplice a)++deriving instance Typeable1 ConDeclField+deriving instance Data a => Data (ConDeclField a)++deriving instance Typeable1 IPName+deriving instance Data a => Data (IPName a)++deriving instance Typeable1 MatchGroup+deriving instance Data a => Data (MatchGroup a)++deriving instance Typeable1 Pat+deriving instance Data a => Data (Pat a)++deriving instance Typeable1 GRHSs+deriving instance Data a => Data (GRHSs a)++deriving instance Typeable1 HsExpr+deriving instance Data a => Data (HsExpr a)++deriving instance Typeable1 HsQuasiQuote+deriving instance Data a => Data (HsQuasiQuote a)++deriving instance Typeable1 HsOverLit+deriving instance Data a => Data (HsOverLit a)++deriving instance Typeable1 ArithSeqInfo+deriving instance Data a => Data (ArithSeqInfo a)++deriving instance Typeable1 HsBracket+deriving instance Data a => Data (HsBracket a)++deriving instance Typeable1 HsCmdTop+deriving instance Data a => Data (HsCmdTop a)++deriving instance Typeable1 HsGroup+deriving instance Data a => Data (HsGroup a)++deriving instance Typeable1 FixitySig+deriving instance Data a => Data (FixitySig a)++deriving instance Typeable1 HsIPBinds+deriving instance Data a => Data (HsIPBinds a)++deriving instance Typeable1 IPBind+deriving instance Data a => Data (IPBind a)++deriving instance Typeable1 GroupByClause+deriving instance Data a => Data (GroupByClause a)++deriving instance Typeable1 HsStmtContext+deriving instance Data a => Data (HsStmtContext a)++deriving instance Typeable1 HsMatchContext+deriving instance Data a => Data (HsMatchContext a)++deriving instance Typeable1 GRHS+deriving instance Data a => Data (GRHS a)++deriving instance Typeable1 Match+deriving instance Data a => Data (Match a)++deriving instance Typeable1 RuleBndr+deriving instance Data a => Data (RuleBndr a)++deriving instance Typeable1 Bind+deriving instance Data a => Data (Bind a)++deriving instance Typeable1 Expr+deriving instance Data a => Data (Expr a)++#if HAS_TUPARG+deriving instance Typeable1 HsTupArg+deriving instance Data a => Data (HsTupArg a)+#endif++-- Typeable2++deriving instance Typeable2 HsBindLR+deriving instance (Data a,Data b) => Data (HsBindLR a b)++deriving instance Typeable2 StmtLR+deriving instance (Data a,Data b) => Data (StmtLR a b)++deriving instance Typeable2 HsLocalBindsLR+deriving instance (Data a,Data b) => Data (HsLocalBindsLR a b)++deriving instance Typeable2 HsValBindsLR+deriving instance (Data a,Data b) => Data (HsValBindsLR a b)++deriving instance Typeable2 HsConDetails+deriving instance (Data a,Data b) => Data (HsConDetails a b)++deriving instance Typeable2 HsRecFields+deriving instance (Data a,Data b) => Data (HsRecFields a b)++deriving instance Typeable2 HsRecField+deriving instance (Data a,Data b) => Data (HsRecField a b)++#ifdef HAS_ANNOTATIONS+deriving instance Data a => Data (AnnDecl a)+deriving instance Typeable1 AnnDecl++deriving instance Data a => Data (AnnProvenance a)+deriving instance Typeable1 AnnProvenance+#endif++-- end of ifdef __HADDOCK__+#endif+
ghc-syb.cabal view
@@ -1,30 +1,27 @@ name:            ghc-syb-version:         0.1.2.2+version:         0.2.0.0 license:         BSD3 license-file:    LICENSE author:          Claus Reinke copyright:       (c) Claus Reinke 2008 maintainer:      Thomas Schilling <nominolo@googlemail.com> homepage:        http://github.com/nominolo/ghc-syb-description:     Scrap Your Boilerplate instances and utils for the GHC API.-synopsis:        SYB instances for the GHC API+description:     Data and Typeable instances for the GHC API.+synopsis:        Data and Typeable instances for the GHC API. category:        Development stability:       provisional build-type:      Simple cabal-version:   >= 1.2.3-tested-with:     GHC ==6.10.1, GHC ==6.10.4--- extra-source-files: README+tested-with:     GHC ==6.10.4, GHC ==6.12.1  library   build-depends:   base >= 4 && < 5,-                   syb >= 0.1 && < 0.2,                    ghc >= 6.10 && < 6.14-  hs-source-dirs:  src+  hs-source-dirs:  .   extensions:      CPP, TypeSynonymInstances, StandaloneDeriving,                    DeriveDataTypeable, ScopedTypeVariables,-                   RankNTypes-  exposed-modules: GHC.SYB.Instances,-                   GHC.SYB.Utils+                   Rank2Types+  exposed-modules: GHC.SYB.Instances   if impl(ghc >= 6.12)     cpp-options:   -DCAN_SPELL -DHAS_SIMPLE_DOCS -DHAS_TUPARG   if impl(ghc < 6.12)
− src/GHC/SYB/Instances.hs
@@ -1,473 +0,0 @@-{- | "GHC.Syb.Instances" provides instances of Data\/Typeable-     for Ghc Api types, using standalone deriving.--Most instances are standard; to provide 'Data' instances -abstract types, we use one of two schemes:--- no traversal: 'SrcSpan', 'Module', 'ModuleName', 'OccName', 'Name', -                'FastString', 'DataCon', 'Var', 'TyCon', 'Class'--@-    abstractConstr   n = mkConstr (abstractDataType n) ("{abstract:"++n++"}") [] Prefix-    abstractDataType n = mkDataType n [abstractConstr n]-@--@-    instance Data SrcSpan where-      -- don't traverse?-      toConstr _   = abstractConstr "SrcSpan"-      gunfold _ _  = error "gunfold"-      dataTypeOf _ = mkNoRepType "SrcSpan"-@--- abstract traversal: 'NameSet', 'Bag'--@-    instance Data NameSet where-      gfoldl k z s = z mkNameSet `k` nameSetToList s -- traverse abstractly-      toConstr _   = abstractConstr "NameSet"-      gunfold _ _  = error "gunfold"-      dataTypeOf _ = mkNoRepType "NameSet"-@--Please report any issues, either with these abstract instances or with-these modules going out of sync with GHC head, to the package maintainer.---}-module GHC.SYB.Instances where--import GHC hiding(TyCon)-import SrcLoc-import RdrName-import OccName-import FastString-import Bag-import Module-import BasicTypes-import Var-import ForeignCall--import CoreSyn-import Literal-import CostCentre--import Data.Data-import NameSet-import TypeRep-import qualified TyCon--#include "Typeable.h"--#ifdef __HADDOCK__-#else---- TODO: good for generalized show, but is this sound in general?-abstractConstr   n = mkConstr (abstractDataType n) ("{abstract:"++n++"}") [] Prefix-abstractDataType n = mkDataType n [abstractConstr n]--#ifndef CAN_SPELL-mkNoRepType = mkNorepType-#endif---- Typeable0--INSTANCE_TYPEABLE0(SrcSpan,srcSpanTc,"SrcSpan")-instance Data SrcSpan where-  -- don't traverse?-  toConstr _   = abstractConstr "SrcSpan"-  gunfold _ _  = error "gunfold"-  dataTypeOf _ = mkNoRepType "SrcSpan"--INSTANCE_TYPEABLE0(Module,moduleTc,"Module")-instance Data Module where-  -- don't traverse?-  toConstr _   = abstractConstr "Module"-  gunfold _ _  = error "gunfold"-  dataTypeOf _ = mkNoRepType "Module"--INSTANCE_TYPEABLE0(ModuleName,moduleNameTc,"ModuleName")-instance Data ModuleName where-  -- don't traverse?-  toConstr _   = abstractConstr "ModuleName"-  gunfold _ _  = error "gunfold"-  dataTypeOf _ = mkNoRepType "ModuleName"--deriving instance Typeable RdrName-deriving instance Data RdrName--INSTANCE_TYPEABLE0(OccName,occNameTc,"OccName")-instance Data OccName where-  -- don't traverse?-  toConstr _   = abstractConstr "OccName"-  gunfold _ _  = error "gunfold"-  dataTypeOf _ = mkNoRepType "OccName"--INSTANCE_TYPEABLE0(Name,nameTc,"Name")-instance Data Name where-  -- don't traverse?-  toConstr _   = abstractConstr "Name"-  gunfold _ _  = error "gunfold"-  dataTypeOf _ = mkNoRepType "Name"--deriving instance Typeable FastString-instance Data FastString where-  -- don't traverse?-  toConstr _   = abstractConstr "FastString"-  gunfold _ _  = error "gunfold"-  dataTypeOf _ = mkNoRepType "FastString"--deriving instance Typeable HsExplicitForAll-deriving instance Data HsExplicitForAll--deriving instance Typeable HsBang-deriving instance Data HsBang--deriving instance Typeable Boxity-deriving instance Data Boxity--deriving instance Typeable OverLitVal-deriving instance Data OverLitVal--deriving instance Typeable RecFlag-deriving instance Data RecFlag--deriving instance Typeable BasicTypes.Fixity-deriving instance Data BasicTypes.Fixity--deriving instance Typeable HsArrAppType-deriving instance Data HsArrAppType--deriving instance Typeable FixityDirection-deriving instance Data FixityDirection--INSTANCE_TYPEABLE0(DataCon,dataConTc,"DataCon")-instance Data DataCon where-  -- don't traverse?-  toConstr _   = abstractConstr "DataCon"-  gunfold _ _  = error "gunfold"-  dataTypeOf _ = mkNoRepType "DataCon"--INSTANCE_TYPEABLE0(Var,varTc,"Var")-instance Data Var where-  -- don't traverse?-  toConstr _   = abstractConstr "Var"-  gunfold _ _  = error "gunfold"-  dataTypeOf _ = mkNoRepType "Var"--deriving instance Typeable InlineSpec-deriving instance Data InlineSpec--#ifdef CONSTRUCTOR_LIKE_IDS-deriving instance Typeable InlinePragma-deriving instance Data InlinePragma--deriving instance Typeable RuleMatchInfo-deriving instance Data RuleMatchInfo-#endif--deriving instance Typeable ForeignImport-deriving instance Data ForeignImport--deriving instance Typeable ForeignExport-deriving instance Data ForeignExport--deriving instance Typeable CImportSpec-deriving instance Data CImportSpec--deriving instance Typeable CExportSpec-deriving instance Data CExportSpec--#if HAS_DN_STUFF-deriving instance Typeable DNCallSpec-deriving instance Data DNCallSpec-#endif--deriving instance Typeable Safety-deriving instance Data Safety--deriving instance Typeable CCallConv-deriving instance Data CCallConv--#if HAS_DN_STUFF-deriving instance Typeable DNKind-deriving instance Data DNKind--deriving instance Typeable DNType-deriving instance Data DNType-#endif--deriving instance Typeable CCallTarget-deriving instance Data CCallTarget--deriving instance Typeable Activation-deriving instance Data Activation--INSTANCE_TYPEABLE0(NameSet,nameSetTc,"NameSet")-instance Data NameSet where-  gfoldl k z s = z mkNameSet `k` nameSetToList s -- traverse abstractly-  toConstr _   = abstractConstr "NameSet"-  gunfold _ _  = error "gunfold"-  dataTypeOf _ = mkNoRepType "NameSet"--#if HAS_FOTYPE-deriving instance Typeable FoType-deriving instance Data FoType-#endif--deriving instance Typeable FamilyFlavour-deriving instance Data FamilyFlavour--deriving instance Typeable NewOrData-deriving instance Data NewOrData--INSTANCE_TYPEABLE0(TyCon.TyCon,tyConTc,"TyCon")-instance Data TyCon.TyCon where-  -- don't traverse?-  toConstr _   = abstractConstr "TyCon.TyCon"-  gunfold _ _  = error "gunfold"-  dataTypeOf _ = mkNoRepType "TyCon.TyCon"--INSTANCE_TYPEABLE0(Class,classTc,"Class")-instance Data Class where-  -- don't traverse?-  toConstr _   = abstractConstr "Class"-  gunfold _ _  = error "gunfold"-  dataTypeOf _ = mkNoRepType "Class"--deriving instance Typeable Prag-deriving instance Data Prag--deriving instance Typeable HsWrapper-deriving instance Data HsWrapper--deriving instance Typeable PredType-deriving instance Data PredType--deriving instance Typeable Type-deriving instance Data Type--deriving instance Typeable HsLit-deriving instance Data HsLit--deriving instance Typeable Note-deriving instance Data Note--deriving instance Typeable AltCon-deriving instance Data AltCon--deriving instance Typeable Literal-deriving instance Data Literal--deriving instance Typeable CostCentre-deriving instance Data CostCentre--#ifdef HAS_FUNCTION_OR_DATA-deriving instance Typeable FunctionOrData-deriving instance Data FunctionOrData-#endif--deriving instance Typeable IsDupdCC-deriving instance Data IsDupdCC--deriving instance Typeable IsCafCC-deriving instance Data IsCafCC--#if HAS_SIMPLE_DOCS-deriving instance Typeable HsDocString-deriving instance Data HsDocString--deriving instance Typeable DocDecl-deriving instance Data DocDecl-#else-deriving instance Typeable1 DocDecl-deriving instance Data a => Data (DocDecl a)-#endif---- Typeable1--deriving instance Typeable1 Located-deriving instance Data e => Data (Located e)--deriving instance Typeable1 HsModule-deriving instance Data a => Data (HsModule a)--#if !HAS_SIMPLE_DOCS-deriving instance Typeable1 HsDoc-deriving instance Data a => Data (HsDoc a)--deriving instance Typeable1 HaddockModInfo-deriving instance Data a => Data (HaddockModInfo a)-#endif--deriving instance Typeable1 HsDecl-deriving instance Data a => Data (HsDecl a)--deriving instance Typeable1 ImportDecl-deriving instance Data a => Data (ImportDecl a)--deriving instance Typeable1 IE-deriving instance Data a => Data (IE a)--deriving instance Typeable1 TyClDecl-deriving instance Data a => Data (TyClDecl a)--deriving instance Typeable1 SpliceDecl-deriving instance Data a => Data (SpliceDecl a)--deriving instance Typeable1 RuleDecl-deriving instance Data a => Data (RuleDecl a)--deriving instance Typeable WarningTxt-deriving instance Data WarningTxt--deriving instance Typeable1 WarnDecl-deriving instance Data a => Data (WarnDecl a)--deriving instance Typeable1 ForeignDecl-deriving instance Data a => Data (ForeignDecl a)--deriving instance Typeable1 DefaultDecl-deriving instance Data a => Data (DefaultDecl a)--deriving instance Typeable1 Sig-deriving instance Data a => Data (Sig a)--deriving instance Typeable1 DerivDecl-deriving instance Data a => Data (DerivDecl a)--deriving instance Typeable1 InstDecl-deriving instance Data a => Data (InstDecl a)--deriving instance Typeable1 HsPred-deriving instance Data a => Data (HsPred a)--deriving instance Typeable1 HsType-deriving instance Data a => Data (HsType a)--deriving instance Typeable1 ConDecl-deriving instance Data a => Data (ConDecl a)--INSTANCE_TYPEABLE1(Bag,bagTc,"Bag")-instance Data a => Data (Bag a) where-  gfoldl k z b = z listToBag `k` bagToList b -- traverse abstract type abstractly-  toConstr _   = abstractConstr $ "Bag("++show (typeOf (undefined::a))++")"-  gunfold _ _  = error "gunfold"-  dataTypeOf _ = mkNoRepType "Bag"--deriving instance Typeable1 HsTyVarBndr-deriving instance Data a => Data (HsTyVarBndr a)--deriving instance Typeable1 ResType-deriving instance Data a => Data (ResType a)--deriving instance Typeable1 HsSplice-deriving instance Data a => Data (HsSplice a)--deriving instance Typeable1 ConDeclField-deriving instance Data a => Data (ConDeclField a)--deriving instance Typeable1 IPName-deriving instance Data a => Data (IPName a)--deriving instance Typeable1 MatchGroup-deriving instance Data a => Data (MatchGroup a)--deriving instance Typeable1 Pat-deriving instance Data a => Data (Pat a)--deriving instance Typeable1 GRHSs-deriving instance Data a => Data (GRHSs a)--deriving instance Typeable1 HsExpr-deriving instance Data a => Data (HsExpr a)--deriving instance Typeable1 HsQuasiQuote-deriving instance Data a => Data (HsQuasiQuote a)--deriving instance Typeable1 HsOverLit-deriving instance Data a => Data (HsOverLit a)--deriving instance Typeable1 ArithSeqInfo-deriving instance Data a => Data (ArithSeqInfo a)--deriving instance Typeable1 HsBracket-deriving instance Data a => Data (HsBracket a)--deriving instance Typeable1 HsCmdTop-deriving instance Data a => Data (HsCmdTop a)--deriving instance Typeable1 HsGroup-deriving instance Data a => Data (HsGroup a)--deriving instance Typeable1 FixitySig-deriving instance Data a => Data (FixitySig a)--deriving instance Typeable1 HsIPBinds-deriving instance Data a => Data (HsIPBinds a)--deriving instance Typeable1 IPBind-deriving instance Data a => Data (IPBind a)--deriving instance Typeable1 GroupByClause-deriving instance Data a => Data (GroupByClause a)--deriving instance Typeable1 HsStmtContext-deriving instance Data a => Data (HsStmtContext a)--deriving instance Typeable1 HsMatchContext-deriving instance Data a => Data (HsMatchContext a)--deriving instance Typeable1 GRHS-deriving instance Data a => Data (GRHS a)--deriving instance Typeable1 Match-deriving instance Data a => Data (Match a)--deriving instance Typeable1 RuleBndr-deriving instance Data a => Data (RuleBndr a)--deriving instance Typeable1 Bind-deriving instance Data a => Data (Bind a)--deriving instance Typeable1 Expr-deriving instance Data a => Data (Expr a)--#if HAS_TUPARG-deriving instance Typeable1 HsTupArg-deriving instance Data a => Data (HsTupArg a)-#endif---- Typeable2--deriving instance Typeable2 HsBindLR-deriving instance (Data a,Data b) => Data (HsBindLR a b)--deriving instance Typeable2 StmtLR-deriving instance (Data a,Data b) => Data (StmtLR a b)--deriving instance Typeable2 HsLocalBindsLR-deriving instance (Data a,Data b) => Data (HsLocalBindsLR a b)--deriving instance Typeable2 HsValBindsLR-deriving instance (Data a,Data b) => Data (HsValBindsLR a b)--deriving instance Typeable2 HsConDetails-deriving instance (Data a,Data b) => Data (HsConDetails a b)--deriving instance Typeable2 HsRecFields-deriving instance (Data a,Data b) => Data (HsRecFields a b)--deriving instance Typeable2 HsRecField-deriving instance (Data a,Data b) => Data (HsRecField a b)--#ifdef HAS_ANNOTATIONS-deriving instance Data a => Data (AnnDecl a)-deriving instance Typeable1 AnnDecl--deriving instance Data a => Data (AnnProvenance a)-deriving instance Typeable1 AnnProvenance-#endif---- end of ifdef __HADDOCK__-#endif-
− src/GHC/SYB/Utils.hs
@@ -1,257 +0,0 @@-{- | "GHC.Syb.Utils" provides common utilities for the Ghc Api,-     either based on Data\/Typeable or for use with Data.Generics-     over Ghc Api types.--example output of 'showData' on 'parsedSource', 'renamedSource', and-'typecheckedSource' for a trivial @HelloWorld@ module, compared with-'ppr' output:--@-------------------------- pretty-printed parsedSource-module HelloWorld where-main = putStrLn "Hello, World!"-------------------------- pretty-printed renamedSource-Just (HelloWorld.main = System.IO.putStrLn "Hello, World!",-      [import Prelude],-      Nothing,-      Nothing,--(HaddockModInfo- (Nothing)- (Nothing)- (Nothing)- (Nothing)))-------------------------- pretty-printed typecheckedSource-Just <AbsBinds [] [] [HelloWorld.main <= [] main]-        HelloWorld.main :: GHC.IOBase.IO ()-        []-        { main = System.IO.putStrLn "Hello, World!" }>-------------------------- shown parsedSource--(L {HelloWorld.hs:1:0}- (HsModule-  (Just-   (L {HelloWorld.hs:1:7-16} {ModuleName: HelloWorld}))-  (Nothing)-  []-  [-   (L {HelloWorld.hs:2:0-30}-    (ValD-     (FunBind-      (L {HelloWorld.hs:2:0-3}-       (Unqual {OccName: main}))-      (False)-      (MatchGroup-       [-        (L {HelloWorld.hs:2:0-30}-         (Match-          []-          (Nothing)-          (GRHSs-           [-            (L {HelloWorld.hs:2:7-30}-             (GRHS-              []-              (L {HelloWorld.hs:2:7-30}-               (HsApp-                (L {HelloWorld.hs:2:7-14}-                 (HsVar-                  (Unqual {OccName: putStrLn})))-                (L {HelloWorld.hs:2:16-30}-                 (HsLit-                  (HsString {FastString: "Hello, World!"})))))))]-           (EmptyLocalBinds))))] {!type placeholder here?!})-      (WpHole) {!NameSet placeholder here!}-      (Nothing))))]-  (Nothing)-  (HaddockModInfo-   (Nothing)-   (Nothing)-   (Nothing)-   (Nothing))-  (Nothing)))-------------------------- shown renamedSource--((,,,,)- (HsGroup-  (ValBindsOut-   [-    ((,)-     (NonRecursive) {Bag(Located (HsBind Name)):-     [-      (L {HelloWorld.hs:2:0-30}-       (FunBind-        (L {HelloWorld.hs:2:0-3} {Name: HelloWorld.main})-        (False)-        (MatchGroup-         [-          (L {HelloWorld.hs:2:0-30}-           (Match-            []-            (Nothing)-            (GRHSs-             [-              (L {HelloWorld.hs:2:7-30}-               (GRHS-                []-                (L {HelloWorld.hs:2:7-30}-                 (HsApp-                  (L {HelloWorld.hs:2:7-14}-                   (HsVar {Name: System.IO.putStrLn}))-                  (L {HelloWorld.hs:2:16-30}-                   (HsLit-                    (HsString {FastString: "Hello, World!"})))))))]-             (EmptyLocalBinds))))] {!type placeholder here?!})-        (WpHole) {NameSet:-        [{Name: System.IO.putStrLn}]}-        (Nothing)))]})]-   [])-  []-  []-  []-  []-  []-  []-  []-  []-  [])- [-  (L {Implicit import declaration}-   (ImportDecl-    (L {Implicit import declaration} {ModuleName: Prelude})-    (False)-    (False)-    (Nothing)-    (Nothing)))]- (Nothing)- (Nothing)- (HaddockModInfo-  (Nothing)-  (Nothing)-  (Nothing)-  (Nothing)))-------------------------- shown typecheckedSource-{Bag(Located (HsBind Var)):-[- (L {HelloWorld.hs:2:0-30}-  (AbsBinds-   []-   []-   [-    ((,,,)-     [] {Var: HelloWorld.main} {Var: main}-     [])] {Bag(Located (HsBind Var)):-   [-    (L {HelloWorld.hs:2:0-30}-     (FunBind-      (L {HelloWorld.hs:2:0-3} {Var: main})-      (False)-      (MatchGroup-       [-        (L {HelloWorld.hs:2:0-30}-         (Match-          []-          (Nothing)-          (GRHSs-           [-            (L {HelloWorld.hs:2:7-30}-             (GRHS-              []-              (L {HelloWorld.hs:2:7-30}-               (HsApp-                (L {HelloWorld.hs:2:7-14}-                 (HsVar {Var: System.IO.putStrLn}))-                (L {HelloWorld.hs:2:16-30}-                 (HsLit-                  (HsString {FastString: "Hello, World!"})))))))]-           (EmptyLocalBinds))))] GHC.IOBase.IO ())-      (WpHole) {!NameSet placeholder here!}-      (Nothing)))]}))]}-@--}-module GHC.SYB.Utils where--import Data.Generics---- import qualified GHC.Paths-import PprTyThing-import DynFlags-import GHC-import Outputable-import SrcLoc-import qualified OccName(occNameString)-import Bag(Bag,bagToList)-import Var(Var)-import FastString(FastString)-import NameSet(NameSet,nameSetToList)--import GHC.SYB.Instances-import Data.List---- | Ghc Ast types tend to have undefined holes, to be filled---   by later compiler phases. We tag Asts with their source,---   so that we can avoid such holes based on who generated the Asts.-data Stage = Parser | Renamer | TypeChecker deriving (Eq,Ord,Show)---- | Generic Data-based show, with special cases for GHC Ast types,---   and simplistic indentation-based layout (the 'Int' parameter); ---   showing abstract types abstractly and avoiding known potholes ---   (based on the 'Stage' that generated the Ast)-showData :: Data a => Stage -> Int -> a -> String-showData stage n = -  generic `ext1Q` list `extQ` string `extQ` fastString `extQ` srcSpan -          `extQ` name `extQ` occName `extQ` moduleName `extQ` var `extQ` dataCon-          `extQ` bagName `extQ` bagRdrName `extQ` bagVar `extQ` nameSet-          `extQ` postTcType `extQ` fixity-  where generic :: Data a => a -> String-        generic t = indent n ++ "(" ++ showConstr (toConstr t)-                 ++ space (concat (intersperse " " (gmapQ (showData stage (n+1)) t))) ++ ")"-        space "" = ""-        space s  = ' ':s-        indent n = "\n" ++ replicate n ' ' -        string     = show :: String -> String-        fastString = ("{FastString: "++) . (++"}") . show :: FastString -> String-        list l     = indent n ++ "[" -                              ++ concat (intersperse "," (map (showData stage (n+1)) l)) ++ "]"--        name       = ("{Name: "++) . (++"}") . showSDoc . ppr :: Name -> String-        occName    = ("{OccName: "++) . (++"}") .  OccName.occNameString -        moduleName = ("{ModuleName: "++) . (++"}") . showSDoc . ppr :: ModuleName -> String-        srcSpan    = ("{"++) . (++"}") . showSDoc . ppr :: SrcSpan -> String-        var        = ("{Var: "++) . (++"}") . showSDoc . ppr :: Var -> String-        dataCon    = ("{DataCon: "++) . (++"}") . showSDoc . ppr :: DataCon -> String--        bagRdrName:: Bag (Located (HsBind RdrName)) -> String-        bagRdrName = ("{Bag(Located (HsBind RdrName)): "++) . (++"}") . list . bagToList -        bagName   :: Bag (Located (HsBind Name)) -> String-        bagName    = ("{Bag(Located (HsBind Name)): "++) . (++"}") . list . bagToList -        bagVar    :: Bag (Located (HsBind Var)) -> String-        bagVar     = ("{Bag(Located (HsBind Var)): "++) . (++"}") . list . bagToList --        nameSet | stage `elem` [Parser,TypeChecker] -                = const ("{!NameSet placeholder here!}") :: NameSet -> String-                | otherwise     -                = ("{NameSet: "++) . (++"}") . list . nameSetToList --        postTcType | stage<TypeChecker = const "{!type placeholder here?!}" :: PostTcType -> String-                   | otherwise     = showSDoc . ppr :: Type -> String--        fixity | stage<Renamer = const "{!fixity placeholder here?!}" :: GHC.Fixity -> String-               | otherwise     = ("{Fixity: "++) . (++"}") . showSDoc . ppr :: GHC.Fixity -> String---- | Like 'everything', but avoid known potholes, based on the 'Stage' that---   generated the Ast.-everythingStaged :: Stage -> (r -> r -> r) -> r -> GenericQ r -> GenericQ r-everythingStaged stage k z f x -  | (const False `extQ` postTcType `extQ` fixity `extQ` nameSet) x = z-  | otherwise = foldl k (f x) (gmapQ (everythingStaged stage k z f) x)-  where nameSet    = const (stage `elem` [Parser,TypeChecker]) :: NameSet -> Bool-        postTcType = const (stage<TypeChecker)                 :: PostTcType -> Bool-        fixity     = const (stage<Renamer)                     :: GHC.Fixity -> Bool---- | A variation of 'everything', using a 'GenericQ Bool' to skip---   parts of the input 'Data'.-everythingBut :: GenericQ Bool -> (r -> r -> r) -> r -> GenericQ r -> GenericQ r-everythingBut q k z f x -  | q x       = z-  | otherwise = foldl k (f x) (gmapQ (everythingBut q k z f) x)