{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module GHC.Hs.Dump (
showAstData,
BlankSrcSpan(..),
BlankEpAnnotations(..),
) where
import GHC.Prelude
import GHC.Hs
import GHC.Core.DataCon
import GHC.Data.Bag
import GHC.Data.FastString
import GHC.Types.Name.Set
import GHC.Types.Name
import GHC.Types.SrcLoc
import GHC.Types.Var
import GHC.Types.SourceText
import GHC.Unit.Module
import GHC.Utils.Outputable
import Data.Data hiding (Fixity)
import qualified Data.ByteString as B
data BlankSrcSpan = BlankSrcSpan | BlankSrcSpanFile | NoBlankSrcSpan
deriving (BlankSrcSpan -> BlankSrcSpan -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlankSrcSpan -> BlankSrcSpan -> Bool
$c/= :: BlankSrcSpan -> BlankSrcSpan -> Bool
== :: BlankSrcSpan -> BlankSrcSpan -> Bool
$c== :: BlankSrcSpan -> BlankSrcSpan -> Bool
Eq,Int -> BlankSrcSpan -> ShowS
[BlankSrcSpan] -> ShowS
BlankSrcSpan -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlankSrcSpan] -> ShowS
$cshowList :: [BlankSrcSpan] -> ShowS
show :: BlankSrcSpan -> String
$cshow :: BlankSrcSpan -> String
showsPrec :: Int -> BlankSrcSpan -> ShowS
$cshowsPrec :: Int -> BlankSrcSpan -> ShowS
Show)
data BlankEpAnnotations = BlankEpAnnotations | NoBlankEpAnnotations
deriving (BlankEpAnnotations -> BlankEpAnnotations -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlankEpAnnotations -> BlankEpAnnotations -> Bool
$c/= :: BlankEpAnnotations -> BlankEpAnnotations -> Bool
== :: BlankEpAnnotations -> BlankEpAnnotations -> Bool
$c== :: BlankEpAnnotations -> BlankEpAnnotations -> Bool
Eq,Int -> BlankEpAnnotations -> ShowS
[BlankEpAnnotations] -> ShowS
BlankEpAnnotations -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlankEpAnnotations] -> ShowS
$cshowList :: [BlankEpAnnotations] -> ShowS
show :: BlankEpAnnotations -> String
$cshow :: BlankEpAnnotations -> String
showsPrec :: Int -> BlankEpAnnotations -> ShowS
$cshowsPrec :: Int -> BlankEpAnnotations -> ShowS
Show)
showAstData :: Data a => BlankSrcSpan -> BlankEpAnnotations -> a -> SDoc
showAstData :: forall a. Data a => BlankSrcSpan -> BlankEpAnnotations -> a -> SDoc
showAstData BlankSrcSpan
bs BlankEpAnnotations
ba a
a0 = SDoc
blankLine SDoc -> SDoc -> SDoc
$$ forall a. Data a => a -> SDoc
showAstData' a
a0
where
showAstData' :: Data a => a -> SDoc
showAstData' :: forall a. Data a => a -> SDoc
showAstData' =
forall a. Data a => a -> SDoc
generic
forall d (t :: * -> *) q.
(Data d, Typeable t) =>
(d -> q) -> (forall e. Data e => t e -> q) -> d -> q
`ext1Q` forall {t}. Data t => [t] -> SDoc
list
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` String -> SDoc
string forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` FastString -> SDoc
fastString forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` SrcSpan -> SDoc
srcSpan forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` RealSrcSpan -> SDoc
realSrcSpan
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` EpAnn [AddEpAnn] -> SDoc
annotation
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` EpAnn AnnsModule -> SDoc
annotationModule
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` EpAnn AddEpAnn -> SDoc
annotationAddEpAnn
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` EpAnn GrhsAnn -> SDoc
annotationGrhsAnn
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` EpAnn EpAnnHsCase -> SDoc
annotationEpAnnHsCase
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` EpAnn AnnsLet -> SDoc
annotationEpAnnHsLet
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` EpAnn AnnList -> SDoc
annotationAnnList
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` EpAnn EpAnnImportDecl -> SDoc
annotationEpAnnImportDecl
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` EpAnn AnnParen -> SDoc
annotationAnnParen
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` EpAnn TrailingAnn -> SDoc
annotationTrailingAnn
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` EpAnn EpaLocation -> SDoc
annotationEpaLocation
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` AddEpAnn -> SDoc
addEpAnn
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` HsLit GhcPs -> SDoc
lit forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` HsLit GhcRn -> SDoc
litr forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` HsLit GhcTc -> SDoc
litt
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` SourceText -> SDoc
sourceText
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` DeltaPos -> SDoc
deltaPos
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` EpaLocation -> SDoc
epaAnchor
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` ByteString -> SDoc
bytestring
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Name -> SDoc
name forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` OccName -> SDoc
occName forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` ModuleName -> SDoc
moduleName forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Var -> SDoc
var
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` DataCon -> SDoc
dataCon
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Bag (LocatedA (HsBind GhcRn)) -> SDoc
bagName forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Bag (LocatedA (HsBind GhcPs)) -> SDoc
bagRdrName forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Bag (LocatedA (HsBind GhcTc)) -> SDoc
bagVar forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` NameSet -> SDoc
nameSet
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Fixity -> SDoc
fixity
forall d (t :: * -> * -> *) q.
(Data d, Typeable t) =>
(d -> q)
-> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q) -> d -> q
`ext2Q` forall a b. (Data a, Data b) => GenLocated a b -> SDoc
located
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` SrcSpanAnn' (EpAnn AnnListItem) -> SDoc
srcSpanAnnA
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` SrcSpanAnn' (EpAnn AnnList) -> SDoc
srcSpanAnnL
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` SrcSpanAnn' (EpAnn AnnPragma) -> SDoc
srcSpanAnnP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` SrcSpanAnn' (EpAnn AnnContext) -> SDoc
srcSpanAnnC
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` SrcSpanAnn' (EpAnn NameAnn) -> SDoc
srcSpanAnnN
where generic :: Data a => a -> SDoc
generic :: forall a. Data a => a -> SDoc
generic a
t = SDoc -> SDoc
parens forall a b. (a -> b) -> a -> b
$ String -> SDoc
text (Constr -> String
showConstr (forall a. Data a => a -> Constr
toConstr a
t))
SDoc -> SDoc -> SDoc
$$ [SDoc] -> SDoc
vcat (forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
gmapQ forall a. Data a => a -> SDoc
showAstData' a
t)
string :: String -> SDoc
string :: String -> SDoc
string = String -> SDoc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
normalize_newlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
fastString :: FastString -> SDoc
fastString :: FastString -> SDoc
fastString FastString
s = SDoc -> SDoc
braces forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"FastString:"
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text (ShowS
normalize_newlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ FastString
s)
bytestring :: B.ByteString -> SDoc
bytestring :: ByteString -> SDoc
bytestring = String -> SDoc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
normalize_newlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
list :: [t] -> SDoc
list [] = SDoc -> SDoc
brackets SDoc
empty
list [t
x] = SDoc -> SDoc
brackets (forall a. Data a => a -> SDoc
showAstData' t
x)
list (t
x1 : t
x2 : [t]
xs) = (String -> SDoc
text String
"[" SDoc -> SDoc -> SDoc
<> forall a. Data a => a -> SDoc
showAstData' t
x1)
SDoc -> SDoc -> SDoc
$$ forall {t}. Data t => t -> [t] -> SDoc
go t
x2 [t]
xs
where
go :: t -> [t] -> SDoc
go t
y [] = String -> SDoc
text String
"," SDoc -> SDoc -> SDoc
<> forall a. Data a => a -> SDoc
showAstData' t
y SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"]"
go t
y1 (t
y2 : [t]
ys) = (String -> SDoc
text String
"," SDoc -> SDoc -> SDoc
<> forall a. Data a => a -> SDoc
showAstData' t
y1) SDoc -> SDoc -> SDoc
$$ t -> [t] -> SDoc
go t
y2 [t]
ys
lit :: HsLit GhcPs -> SDoc
lit :: HsLit GhcPs -> SDoc
lit (HsWordPrim XHsWordPrim GhcPs
s Integer
x) = String -> Integer -> SourceText -> SDoc
numericLit String
"HsWord{64}Prim" Integer
x XHsWordPrim GhcPs
s
lit (HsWord64Prim XHsWord64Prim GhcPs
s Integer
x) = String -> Integer -> SourceText -> SDoc
numericLit String
"HsWord{64}Prim" Integer
x XHsWord64Prim GhcPs
s
lit (HsIntPrim XHsIntPrim GhcPs
s Integer
x) = String -> Integer -> SourceText -> SDoc
numericLit String
"HsInt{64}Prim" Integer
x XHsIntPrim GhcPs
s
lit (HsInt64Prim XHsInt64Prim GhcPs
s Integer
x) = String -> Integer -> SourceText -> SDoc
numericLit String
"HsInt{64}Prim" Integer
x XHsInt64Prim GhcPs
s
lit HsLit GhcPs
l = forall a. Data a => a -> SDoc
generic HsLit GhcPs
l
litr :: HsLit GhcRn -> SDoc
litr :: HsLit GhcRn -> SDoc
litr (HsWordPrim XHsWordPrim GhcRn
s Integer
x) = String -> Integer -> SourceText -> SDoc
numericLit String
"HsWord{64}Prim" Integer
x XHsWordPrim GhcRn
s
litr (HsWord64Prim XHsWord64Prim GhcRn
s Integer
x) = String -> Integer -> SourceText -> SDoc
numericLit String
"HsWord{64}Prim" Integer
x XHsWord64Prim GhcRn
s
litr (HsIntPrim XHsIntPrim GhcRn
s Integer
x) = String -> Integer -> SourceText -> SDoc
numericLit String
"HsInt{64}Prim" Integer
x XHsIntPrim GhcRn
s
litr (HsInt64Prim XHsInt64Prim GhcRn
s Integer
x) = String -> Integer -> SourceText -> SDoc
numericLit String
"HsInt{64}Prim" Integer
x XHsInt64Prim GhcRn
s
litr HsLit GhcRn
l = forall a. Data a => a -> SDoc
generic HsLit GhcRn
l
litt :: HsLit GhcTc -> SDoc
litt :: HsLit GhcTc -> SDoc
litt (HsWordPrim XHsWordPrim GhcTc
s Integer
x) = String -> Integer -> SourceText -> SDoc
numericLit String
"HsWord{64}Prim" Integer
x XHsWordPrim GhcTc
s
litt (HsWord64Prim XHsWord64Prim GhcTc
s Integer
x) = String -> Integer -> SourceText -> SDoc
numericLit String
"HsWord{64}Prim" Integer
x XHsWord64Prim GhcTc
s
litt (HsIntPrim XHsIntPrim GhcTc
s Integer
x) = String -> Integer -> SourceText -> SDoc
numericLit String
"HsInt{64}Prim" Integer
x XHsIntPrim GhcTc
s
litt (HsInt64Prim XHsInt64Prim GhcTc
s Integer
x) = String -> Integer -> SourceText -> SDoc
numericLit String
"HsInt{64}Prim" Integer
x XHsInt64Prim GhcTc
s
litt HsLit GhcTc
l = forall a. Data a => a -> SDoc
generic HsLit GhcTc
l
numericLit :: String -> Integer -> SourceText -> SDoc
numericLit :: String -> Integer -> SourceText -> SDoc
numericLit String
tag Integer
x SourceText
s = SDoc -> SDoc
braces forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
hsep [ String -> SDoc
text String
tag
, forall a. Data a => a -> SDoc
generic Integer
x
, forall a. Data a => a -> SDoc
generic SourceText
s ]
sourceText :: SourceText -> SDoc
sourceText :: SourceText -> SDoc
sourceText SourceText
NoSourceText = SDoc -> SDoc
parens forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"NoSourceText"
sourceText (SourceText String
src) = case BlankSrcSpan
bs of
BlankSrcSpan
NoBlankSrcSpan -> SDoc -> SDoc
parens forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"SourceText" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
src
BlankSrcSpan
BlankSrcSpanFile -> SDoc -> SDoc
parens forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"SourceText" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
src
BlankSrcSpan
_ -> SDoc -> SDoc
parens forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"SourceText" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"blanked"
epaAnchor :: EpaLocation -> SDoc
epaAnchor :: EpaLocation -> SDoc
epaAnchor (EpaSpan RealSrcSpan
r) = SDoc -> SDoc
parens forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"EpaSpan" SDoc -> SDoc -> SDoc
<+> RealSrcSpan -> SDoc
realSrcSpan RealSrcSpan
r
epaAnchor (EpaDelta DeltaPos
d [LEpaComment]
cs) = case BlankEpAnnotations
ba of
BlankEpAnnotations
NoBlankEpAnnotations -> SDoc -> SDoc
parens forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"EpaDelta" SDoc -> SDoc -> SDoc
<+> DeltaPos -> SDoc
deltaPos DeltaPos
d SDoc -> SDoc -> SDoc
<+> forall a. Data a => a -> SDoc
showAstData' [LEpaComment]
cs
BlankEpAnnotations
BlankEpAnnotations -> SDoc -> SDoc
parens forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"EpaDelta" SDoc -> SDoc -> SDoc
<+> DeltaPos -> SDoc
deltaPos DeltaPos
d SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"blanked"
deltaPos :: DeltaPos -> SDoc
deltaPos :: DeltaPos -> SDoc
deltaPos (SameLine Int
c) = SDoc -> SDoc
parens forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"SameLine" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Int
c
deltaPos (DifferentLine Int
l Int
c) = SDoc -> SDoc
parens forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"DifferentLine" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Int
l SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Int
c
name :: Name -> SDoc
name :: Name -> SDoc
name Name
nm = SDoc -> SDoc
braces forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Name:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Name
nm
occName :: OccName -> SDoc
occName OccName
n = SDoc -> SDoc
braces forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"OccName:"
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text (OccName -> String
occNameString OccName
n)
moduleName :: ModuleName -> SDoc
moduleName :: ModuleName -> SDoc
moduleName ModuleName
m = SDoc -> SDoc
braces forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"ModuleName:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr ModuleName
m
srcSpan :: SrcSpan -> SDoc
srcSpan :: SrcSpan -> SDoc
srcSpan SrcSpan
ss = case BlankSrcSpan
bs of
BlankSrcSpan
BlankSrcSpan -> String -> SDoc
text String
"{ ss }"
BlankSrcSpan
NoBlankSrcSpan -> SDoc -> SDoc
braces forall a b. (a -> b) -> a -> b
$ Char -> SDoc
char Char
' ' SDoc -> SDoc -> SDoc
<>
(SDoc -> Int -> SDoc -> SDoc
hang (forall a. Outputable a => a -> SDoc
ppr SrcSpan
ss) Int
1
(String -> SDoc
text String
""))
BlankSrcSpan
BlankSrcSpanFile -> SDoc -> SDoc
braces forall a b. (a -> b) -> a -> b
$ Char -> SDoc
char Char
' ' SDoc -> SDoc -> SDoc
<>
(SDoc -> Int -> SDoc -> SDoc
hang (Bool -> SrcSpan -> SDoc
pprUserSpan Bool
False SrcSpan
ss) Int
1
(String -> SDoc
text String
""))
realSrcSpan :: RealSrcSpan -> SDoc
realSrcSpan :: RealSrcSpan -> SDoc
realSrcSpan RealSrcSpan
ss = case BlankSrcSpan
bs of
BlankSrcSpan
BlankSrcSpan -> String -> SDoc
text String
"{ ss }"
BlankSrcSpan
NoBlankSrcSpan -> SDoc -> SDoc
braces forall a b. (a -> b) -> a -> b
$ Char -> SDoc
char Char
' ' SDoc -> SDoc -> SDoc
<>
(SDoc -> Int -> SDoc -> SDoc
hang (forall a. Outputable a => a -> SDoc
ppr RealSrcSpan
ss) Int
1
(String -> SDoc
text String
""))
BlankSrcSpan
BlankSrcSpanFile -> SDoc -> SDoc
braces forall a b. (a -> b) -> a -> b
$ Char -> SDoc
char Char
' ' SDoc -> SDoc -> SDoc
<>
(SDoc -> Int -> SDoc -> SDoc
hang (Bool -> RealSrcSpan -> SDoc
pprUserRealSpan Bool
False RealSrcSpan
ss) Int
1
(String -> SDoc
text String
""))
addEpAnn :: AddEpAnn -> SDoc
addEpAnn :: AddEpAnn -> SDoc
addEpAnn (AddEpAnn AnnKeywordId
a EpaLocation
s) = case BlankEpAnnotations
ba of
BlankEpAnnotations
BlankEpAnnotations -> SDoc -> SDoc
parens
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"blanked:" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"AddEpAnn"
BlankEpAnnotations
NoBlankEpAnnotations ->
SDoc -> SDoc
parens forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"AddEpAnn" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr AnnKeywordId
a SDoc -> SDoc -> SDoc
<+> EpaLocation -> SDoc
epaAnchor EpaLocation
s
var :: Var -> SDoc
var :: Var -> SDoc
var Var
v = SDoc -> SDoc
braces forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Var:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Var
v
dataCon :: DataCon -> SDoc
dataCon :: DataCon -> SDoc
dataCon DataCon
c = SDoc -> SDoc
braces forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"DataCon:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr DataCon
c
bagRdrName:: Bag (LocatedA (HsBind GhcPs)) -> SDoc
bagRdrName :: Bag (LocatedA (HsBind GhcPs)) -> SDoc
bagRdrName Bag (LocatedA (HsBind GhcPs))
bg = SDoc -> SDoc
braces forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Bag(LocatedA (HsBind GhcPs)):"
SDoc -> SDoc -> SDoc
$$ (forall {t}. Data t => [t] -> SDoc
list forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Bag a -> [a]
bagToList forall a b. (a -> b) -> a -> b
$ Bag (LocatedA (HsBind GhcPs))
bg)
bagName :: Bag (LocatedA (HsBind GhcRn)) -> SDoc
bagName :: Bag (LocatedA (HsBind GhcRn)) -> SDoc
bagName Bag (LocatedA (HsBind GhcRn))
bg = SDoc -> SDoc
braces forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Bag(LocatedA (HsBind Name)):"
SDoc -> SDoc -> SDoc
$$ (forall {t}. Data t => [t] -> SDoc
list forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Bag a -> [a]
bagToList forall a b. (a -> b) -> a -> b
$ Bag (LocatedA (HsBind GhcRn))
bg)
bagVar :: Bag (LocatedA (HsBind GhcTc)) -> SDoc
bagVar :: Bag (LocatedA (HsBind GhcTc)) -> SDoc
bagVar Bag (LocatedA (HsBind GhcTc))
bg = SDoc -> SDoc
braces forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Bag(LocatedA (HsBind Var)):"
SDoc -> SDoc -> SDoc
$$ (forall {t}. Data t => [t] -> SDoc
list forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Bag a -> [a]
bagToList forall a b. (a -> b) -> a -> b
$ Bag (LocatedA (HsBind GhcTc))
bg)
nameSet :: NameSet -> SDoc
nameSet NameSet
ns = SDoc -> SDoc
braces forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"NameSet:"
SDoc -> SDoc -> SDoc
$$ (forall {t}. Data t => [t] -> SDoc
list forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSet -> [Name]
nameSetElemsStable forall a b. (a -> b) -> a -> b
$ NameSet
ns)
fixity :: Fixity -> SDoc
fixity :: Fixity -> SDoc
fixity Fixity
fx = SDoc -> SDoc
braces forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Fixity:"
SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Fixity
fx
located :: (Data a, Data b) => GenLocated a b -> SDoc
located :: forall a b. (Data a, Data b) => GenLocated a b -> SDoc
located (L a
ss b
a)
= SDoc -> SDoc
parens (String -> SDoc
text String
"L"
SDoc -> SDoc -> SDoc
$$ [SDoc] -> SDoc
vcat [forall a. Data a => a -> SDoc
showAstData' a
ss, forall a. Data a => a -> SDoc
showAstData' b
a])
annotation :: EpAnn [AddEpAnn] -> SDoc
annotation :: EpAnn [AddEpAnn] -> SDoc
annotation = forall a. (Data a, Typeable a) => SDoc -> EpAnn a -> SDoc
annotation' (String -> SDoc
text String
"EpAnn [AddEpAnn]")
annotationModule :: EpAnn AnnsModule -> SDoc
annotationModule :: EpAnn AnnsModule -> SDoc
annotationModule = forall a. (Data a, Typeable a) => SDoc -> EpAnn a -> SDoc
annotation' (String -> SDoc
text String
"EpAnn AnnsModule")
annotationAddEpAnn :: EpAnn AddEpAnn -> SDoc
annotationAddEpAnn :: EpAnn AddEpAnn -> SDoc
annotationAddEpAnn = forall a. (Data a, Typeable a) => SDoc -> EpAnn a -> SDoc
annotation' (String -> SDoc
text String
"EpAnn AddEpAnn")
annotationGrhsAnn :: EpAnn GrhsAnn -> SDoc
annotationGrhsAnn :: EpAnn GrhsAnn -> SDoc
annotationGrhsAnn = forall a. (Data a, Typeable a) => SDoc -> EpAnn a -> SDoc
annotation' (String -> SDoc
text String
"EpAnn GrhsAnn")
annotationEpAnnHsCase :: EpAnn EpAnnHsCase -> SDoc
annotationEpAnnHsCase :: EpAnn EpAnnHsCase -> SDoc
annotationEpAnnHsCase = forall a. (Data a, Typeable a) => SDoc -> EpAnn a -> SDoc
annotation' (String -> SDoc
text String
"EpAnn EpAnnHsCase")
annotationEpAnnHsLet :: EpAnn AnnsLet -> SDoc
annotationEpAnnHsLet :: EpAnn AnnsLet -> SDoc
annotationEpAnnHsLet = forall a. (Data a, Typeable a) => SDoc -> EpAnn a -> SDoc
annotation' (String -> SDoc
text String
"EpAnn AnnsLet")
annotationAnnList :: EpAnn AnnList -> SDoc
annotationAnnList :: EpAnn AnnList -> SDoc
annotationAnnList = forall a. (Data a, Typeable a) => SDoc -> EpAnn a -> SDoc
annotation' (String -> SDoc
text String
"EpAnn AnnList")
annotationEpAnnImportDecl :: EpAnn EpAnnImportDecl -> SDoc
annotationEpAnnImportDecl :: EpAnn EpAnnImportDecl -> SDoc
annotationEpAnnImportDecl = forall a. (Data a, Typeable a) => SDoc -> EpAnn a -> SDoc
annotation' (String -> SDoc
text String
"EpAnn EpAnnImportDecl")
annotationAnnParen :: EpAnn AnnParen -> SDoc
annotationAnnParen :: EpAnn AnnParen -> SDoc
annotationAnnParen = forall a. (Data a, Typeable a) => SDoc -> EpAnn a -> SDoc
annotation' (String -> SDoc
text String
"EpAnn AnnParen")
annotationTrailingAnn :: EpAnn TrailingAnn -> SDoc
annotationTrailingAnn :: EpAnn TrailingAnn -> SDoc
annotationTrailingAnn = forall a. (Data a, Typeable a) => SDoc -> EpAnn a -> SDoc
annotation' (String -> SDoc
text String
"EpAnn TrailingAnn")
annotationEpaLocation :: EpAnn EpaLocation -> SDoc
annotationEpaLocation :: EpAnn EpaLocation -> SDoc
annotationEpaLocation = forall a. (Data a, Typeable a) => SDoc -> EpAnn a -> SDoc
annotation' (String -> SDoc
text String
"EpAnn EpaLocation")
annotation' :: forall a .(Data a, Typeable a)
=> SDoc -> EpAnn a -> SDoc
annotation' :: forall a. (Data a, Typeable a) => SDoc -> EpAnn a -> SDoc
annotation' SDoc
tag EpAnn a
anns = case BlankEpAnnotations
ba of
BlankEpAnnotations
BlankEpAnnotations -> SDoc -> SDoc
parens (String -> SDoc
text String
"blanked:" SDoc -> SDoc -> SDoc
<+> SDoc
tag)
BlankEpAnnotations
NoBlankEpAnnotations -> SDoc -> SDoc
parens forall a b. (a -> b) -> a -> b
$ String -> SDoc
text (Constr -> String
showConstr (forall a. Data a => a -> Constr
toConstr EpAnn a
anns))
SDoc -> SDoc -> SDoc
$$ [SDoc] -> SDoc
vcat (forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
gmapQ forall a. Data a => a -> SDoc
showAstData' EpAnn a
anns)
srcSpanAnnA :: SrcSpanAnn' (EpAnn AnnListItem) -> SDoc
srcSpanAnnA :: SrcSpanAnn' (EpAnn AnnListItem) -> SDoc
srcSpanAnnA = forall a. (Typeable a, Data a) => SDoc -> SrcSpanAnn' a -> SDoc
locatedAnn'' (String -> SDoc
text String
"SrcSpanAnnA")
srcSpanAnnL :: SrcSpanAnn' (EpAnn AnnList) -> SDoc
srcSpanAnnL :: SrcSpanAnn' (EpAnn AnnList) -> SDoc
srcSpanAnnL = forall a. (Typeable a, Data a) => SDoc -> SrcSpanAnn' a -> SDoc
locatedAnn'' (String -> SDoc
text String
"SrcSpanAnnL")
srcSpanAnnP :: SrcSpanAnn' (EpAnn AnnPragma) -> SDoc
srcSpanAnnP :: SrcSpanAnn' (EpAnn AnnPragma) -> SDoc
srcSpanAnnP = forall a. (Typeable a, Data a) => SDoc -> SrcSpanAnn' a -> SDoc
locatedAnn'' (String -> SDoc
text String
"SrcSpanAnnP")
srcSpanAnnC :: SrcSpanAnn' (EpAnn AnnContext) -> SDoc
srcSpanAnnC :: SrcSpanAnn' (EpAnn AnnContext) -> SDoc
srcSpanAnnC = forall a. (Typeable a, Data a) => SDoc -> SrcSpanAnn' a -> SDoc
locatedAnn'' (String -> SDoc
text String
"SrcSpanAnnC")
srcSpanAnnN :: SrcSpanAnn' (EpAnn NameAnn) -> SDoc
srcSpanAnnN :: SrcSpanAnn' (EpAnn NameAnn) -> SDoc
srcSpanAnnN = forall a. (Typeable a, Data a) => SDoc -> SrcSpanAnn' a -> SDoc
locatedAnn'' (String -> SDoc
text String
"SrcSpanAnnN")
locatedAnn'' :: forall a. (Typeable a, Data a)
=> SDoc -> SrcSpanAnn' a -> SDoc
locatedAnn'' :: forall a. (Typeable a, Data a) => SDoc -> SrcSpanAnn' a -> SDoc
locatedAnn'' SDoc
tag SrcSpanAnn' a
ss = SDoc -> SDoc
parens forall a b. (a -> b) -> a -> b
$
case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast SrcSpanAnn' a
ss of
Just ((SrcSpanAnn a
ann SrcSpan
s) :: SrcSpanAnn' a) ->
case BlankEpAnnotations
ba of
BlankEpAnnotations
BlankEpAnnotations
-> SDoc -> SDoc
parens (String -> SDoc
text String
"blanked:" SDoc -> SDoc -> SDoc
<+> SDoc
tag)
BlankEpAnnotations
NoBlankEpAnnotations
-> String -> SDoc
text String
"SrcSpanAnn" SDoc -> SDoc -> SDoc
<+> forall a. Data a => a -> SDoc
showAstData' a
ann
SDoc -> SDoc -> SDoc
<+> SrcSpan -> SDoc
srcSpan SrcSpan
s
Maybe (SrcSpanAnn' a)
Nothing -> String -> SDoc
text String
"locatedAnn:unmatched" SDoc -> SDoc -> SDoc
<+> SDoc
tag
SDoc -> SDoc -> SDoc
<+> (SDoc -> SDoc
parens forall a b. (a -> b) -> a -> b
$ String -> SDoc
text (Constr -> String
showConstr (forall a. Data a => a -> Constr
toConstr SrcSpanAnn' a
ss)))
normalize_newlines :: String -> String
normalize_newlines :: ShowS
normalize_newlines (Char
'\\':Char
'r':Char
'\\':Char
'n':String
xs) = Char
'\\'forall a. a -> [a] -> [a]
:Char
'n'forall a. a -> [a] -> [a]
:ShowS
normalize_newlines String
xs
normalize_newlines (Char
x:String
xs) = Char
xforall a. a -> [a] -> [a]
:ShowS
normalize_newlines String
xs
normalize_newlines [] = []
newtype Q q x = Q { forall q x. Q q x -> x -> q
unQ :: x -> q }
extQ :: ( Typeable a
, Typeable b
)
=> (a -> q)
-> (b -> q)
-> a
-> q
extQ :: forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
extQ a -> q
f b -> q
g a
a = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> q
f a
a) b -> q
g (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
a)
ext1Q :: (Data d, Typeable t)
=> (d -> q)
-> (forall e. Data e => t e -> q)
-> d -> q
ext1Q :: forall d (t :: * -> *) q.
(Data d, Typeable t) =>
(d -> q) -> (forall e. Data e => t e -> q) -> d -> q
ext1Q d -> q
def forall e. Data e => t e -> q
ext = forall q x. Q q x -> x -> q
unQ ((forall q x. (x -> q) -> Q q x
Q d -> q
def) forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
c a -> (forall d. Data d => c (t d)) -> c a
`ext1` (forall q x. (x -> q) -> Q q x
Q forall e. Data e => t e -> q
ext))
ext2Q :: (Data d, Typeable t)
=> (d -> q)
-> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q)
-> d -> q
ext2Q :: forall d (t :: * -> * -> *) q.
(Data d, Typeable t) =>
(d -> q)
-> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q) -> d -> q
ext2Q d -> q
def forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q
ext = forall q x. Q q x -> x -> q
unQ ((forall q x. (x -> q) -> Q q x
Q d -> q
def) forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
c a -> (forall d1 d2. (Data d1, Data d2) => c (t d1 d2)) -> c a
`ext2` (forall q x. (x -> q) -> Q q x
Q forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q
ext))
ext1 :: (Data a, Typeable t)
=> c a
-> (forall d. Data d => c (t d))
-> c a
ext1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
c a -> (forall d. Data d => c (t d)) -> c a
ext1 c a
def forall d. Data d => c (t d)
ext = forall b a. b -> (a -> b) -> Maybe a -> b
maybe c a
def forall a. a -> a
id (forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c a)
dataCast1 forall d. Data d => c (t d)
ext)
ext2 :: (Data a, Typeable t)
=> c a
-> (forall d1 d2. (Data d1, Data d2) => c (t d1 d2))
-> c a
ext2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
c a -> (forall d1 d2. (Data d1, Data d2) => c (t d1 d2)) -> c a
ext2 c a
def forall d1 d2. (Data d1, Data d2) => c (t d1 d2)
ext = forall b a. b -> (a -> b) -> Maybe a -> b
maybe c a
def forall a. a -> a
id (forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a)
dataCast2 forall d1 d2. (Data d1, Data d2) => c (t d1 d2)
ext)