{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Contains a debug function to dump parts of the GHC.Hs AST. It uses a syb
-- traversal which falls back to displaying based on the constructor name, so
-- can be used to dump anything having a @Data.Data@ instance.

module GHC.Hs.Dump (
        -- * Dumping ASTs
        showAstData,
        showAstDataFull,
        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.Utils.Outputable

import Data.Data hiding (Fixity)
import qualified Data.ByteString as B

-- | Should source spans be removed from output.
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)

-- | Should EpAnnotations be removed from output.
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)

-- | Show the full AST as the compiler sees it.
showAstDataFull :: Data a => a -> SDoc
showAstDataFull :: forall a. Data a => a -> SDoc
showAstDataFull = forall a. Data a => BlankSrcSpan -> BlankEpAnnotations -> a -> SDoc
showAstData BlankSrcSpan
NoBlankSrcSpan BlankEpAnnotations
NoBlankEpAnnotations

-- | Show a GHC syntax tree. This parameterised because it is also used for
-- comparing ASTs in ppr roundtripping tests, where the SrcSpan's are blanked
-- out, to avoid comparing locations, only structure
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 forall doc. IsDoc doc => doc -> doc -> doc
$$ 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 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` EpAnn NoEpAnns -> SDoc
annotationNoEpAnns
              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` forall {doc}. IsLine doc => OccName -> doc
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 = forall doc. IsLine doc => doc -> doc
parens forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text (Constr -> String
showConstr (forall a. Data a => a -> Constr
toConstr a
t))
                                  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => [doc] -> doc
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     = forall doc. IsLine doc => String -> doc
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 = forall doc. IsLine doc => doc -> doc
braces forall a b. (a -> b) -> a -> b
$
                            forall doc. IsLine doc => String -> doc
text String
"FastString:"
                        forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
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 = forall doc. IsLine doc => String -> doc
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 []    = forall doc. IsLine doc => doc -> doc
brackets forall doc. IsOutput doc => doc
empty
            list [t
x]   = forall doc. IsLine doc => doc -> doc
brackets (forall a. Data a => a -> SDoc
showAstData' t
x)
            list (t
x1 : t
x2 : [t]
xs) =  (forall doc. IsLine doc => String -> doc
text String
"[" forall doc. IsLine doc => doc -> doc -> doc
<> forall a. Data a => a -> SDoc
showAstData' t
x1)
                                forall doc. IsDoc doc => doc -> doc -> doc
$$ forall {t}. Data t => t -> [t] -> SDoc
go t
x2 [t]
xs
              where
                go :: t -> [t] -> SDoc
go t
y [] = forall doc. IsLine doc => String -> doc
text String
"," forall doc. IsLine doc => doc -> doc -> doc
<> forall a. Data a => a -> SDoc
showAstData' t
y forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
"]"
                go t
y1 (t
y2 : [t]
ys) = (forall doc. IsLine doc => String -> doc
text String
"," forall doc. IsLine doc => doc -> doc -> doc
<> forall a. Data a => a -> SDoc
showAstData' t
y1) forall doc. IsDoc doc => doc -> doc -> doc
$$ t -> [t] -> SDoc
go t
y2 [t]
ys

            -- Eliminate word-size dependence
            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 = forall doc. IsLine doc => doc -> doc
braces forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => [doc] -> doc
hsep [ forall doc. IsLine doc => String -> doc
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 = forall doc. IsLine doc => doc -> doc
parens forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"NoSourceText"
            sourceText (SourceText String
src) = case BlankSrcSpan
bs of
              BlankSrcSpan
NoBlankSrcSpan   -> forall doc. IsLine doc => doc -> doc
parens forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"SourceText" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
src
              BlankSrcSpan
BlankSrcSpanFile -> forall doc. IsLine doc => doc -> doc
parens forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"SourceText" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
src
              BlankSrcSpan
_                -> forall doc. IsLine doc => doc -> doc
parens forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"SourceText" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"blanked"

            epaAnchor :: EpaLocation -> SDoc
            epaAnchor :: EpaLocation -> SDoc
epaAnchor (EpaSpan RealSrcSpan
r Maybe BufSpan
_) = forall doc. IsLine doc => doc -> doc
parens forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"EpaSpan" forall doc. IsLine doc => doc -> doc -> doc
<+> RealSrcSpan -> SDoc
realSrcSpan RealSrcSpan
r
            epaAnchor (EpaDelta DeltaPos
d [LEpaComment]
cs) = case BlankEpAnnotations
ba of
              BlankEpAnnotations
NoBlankEpAnnotations -> forall doc. IsLine doc => doc -> doc
parens forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"EpaDelta" forall doc. IsLine doc => doc -> doc -> doc
<+> DeltaPos -> SDoc
deltaPos DeltaPos
d forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Data a => a -> SDoc
showAstData' [LEpaComment]
cs
              BlankEpAnnotations
BlankEpAnnotations -> forall doc. IsLine doc => doc -> doc
parens forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"EpaDelta" forall doc. IsLine doc => doc -> doc -> doc
<+> DeltaPos -> SDoc
deltaPos DeltaPos
d forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"blanked"

            deltaPos :: DeltaPos -> SDoc
            deltaPos :: DeltaPos -> SDoc
deltaPos (SameLine Int
c) = forall doc. IsLine doc => doc -> doc
parens forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"SameLine" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Int
c
            deltaPos (DifferentLine Int
l Int
c) = forall doc. IsLine doc => doc -> doc
parens forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"DifferentLine" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Int
l forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Int
c

            name :: Name -> SDoc
            name :: Name -> SDoc
name Name
nm    = forall doc. IsLine doc => doc -> doc
braces forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"Name:" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Name
nm

            occName :: OccName -> doc
occName OccName
n  =  forall doc. IsLine doc => doc -> doc
braces forall a b. (a -> b) -> a -> b
$
                          forall doc. IsLine doc => String -> doc
text String
"OccName:"
                      forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => FastString -> doc
ftext (OccName -> FastString
occNameFS OccName
n)

            moduleName :: ModuleName -> SDoc
            moduleName :: ModuleName -> SDoc
moduleName ModuleName
m = forall doc. IsLine doc => doc -> doc
braces forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"ModuleName:" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr ModuleName
m

            srcSpan :: SrcSpan -> SDoc
            srcSpan :: SrcSpan -> SDoc
srcSpan SrcSpan
ss = case BlankSrcSpan
bs of
             BlankSrcSpan
BlankSrcSpan -> forall doc. IsLine doc => String -> doc
text String
"{ ss }"
             BlankSrcSpan
NoBlankSrcSpan -> forall doc. IsLine doc => doc -> doc
braces forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => Char -> doc
char Char
' ' forall doc. IsLine doc => doc -> doc -> doc
<>
                             (SDoc -> Int -> SDoc -> SDoc
hang (forall a. Outputable a => a -> SDoc
ppr SrcSpan
ss) Int
1
                                   -- TODO: show annotations here
                                   (forall doc. IsLine doc => String -> doc
text String
""))
             BlankSrcSpan
BlankSrcSpanFile -> forall doc. IsLine doc => doc -> doc
braces forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => Char -> doc
char Char
' ' forall doc. IsLine doc => doc -> doc -> doc
<>
                             (SDoc -> Int -> SDoc -> SDoc
hang (Bool -> SrcSpan -> SDoc
pprUserSpan Bool
False SrcSpan
ss) Int
1
                                   -- TODO: show annotations here
                                   (forall doc. IsLine doc => String -> doc
text String
""))

            realSrcSpan :: RealSrcSpan -> SDoc
            realSrcSpan :: RealSrcSpan -> SDoc
realSrcSpan RealSrcSpan
ss = case BlankSrcSpan
bs of
             BlankSrcSpan
BlankSrcSpan -> forall doc. IsLine doc => String -> doc
text String
"{ ss }"
             BlankSrcSpan
NoBlankSrcSpan -> forall doc. IsLine doc => doc -> doc
braces forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => Char -> doc
char Char
' ' forall doc. IsLine doc => doc -> doc -> doc
<>
                             (SDoc -> Int -> SDoc -> SDoc
hang (forall a. Outputable a => a -> SDoc
ppr RealSrcSpan
ss) Int
1
                                   -- TODO: show annotations here
                                   (forall doc. IsLine doc => String -> doc
text String
""))
             BlankSrcSpan
BlankSrcSpanFile -> forall doc. IsLine doc => doc -> doc
braces forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => Char -> doc
char Char
' ' forall doc. IsLine doc => doc -> doc -> doc
<>
                             (SDoc -> Int -> SDoc -> SDoc
hang (Bool -> RealSrcSpan -> SDoc
pprUserRealSpan Bool
False RealSrcSpan
ss) Int
1
                                   -- TODO: show annotations here
                                   (forall doc. IsLine doc => String -> doc
text String
""))


            addEpAnn :: AddEpAnn -> SDoc
            addEpAnn :: AddEpAnn -> SDoc
addEpAnn (AddEpAnn AnnKeywordId
a EpaLocation
s) = case BlankEpAnnotations
ba of
             BlankEpAnnotations
BlankEpAnnotations -> forall doc. IsLine doc => doc -> doc
parens
                                      forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"blanked:" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"AddEpAnn"
             BlankEpAnnotations
NoBlankEpAnnotations ->
              forall doc. IsLine doc => doc -> doc
parens forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"AddEpAnn" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr AnnKeywordId
a forall doc. IsLine doc => doc -> doc -> doc
<+> EpaLocation -> SDoc
epaAnchor EpaLocation
s

            var  :: Var -> SDoc
            var :: Var -> SDoc
var Var
v      = forall doc. IsLine doc => doc -> doc
braces forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"Var:" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Var
v

            dataCon :: DataCon -> SDoc
            dataCon :: DataCon -> SDoc
dataCon DataCon
c  = forall doc. IsLine doc => doc -> doc
braces forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"DataCon:" forall doc. IsLine doc => doc -> doc -> doc
<+> 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 =  forall doc. IsLine doc => doc -> doc
braces forall a b. (a -> b) -> a -> b
$
                             forall doc. IsLine doc => String -> doc
text String
"Bag(LocatedA (HsBind GhcPs)):"
                          forall doc. IsDoc doc => doc -> doc -> doc
$$ (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  =  forall doc. IsLine doc => doc -> doc
braces forall a b. (a -> b) -> a -> b
$
                           forall doc. IsLine doc => String -> doc
text String
"Bag(LocatedA (HsBind Name)):"
                        forall doc. IsDoc doc => doc -> doc -> doc
$$ (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  =  forall doc. IsLine doc => doc -> doc
braces forall a b. (a -> b) -> a -> b
$
                          forall doc. IsLine doc => String -> doc
text String
"Bag(LocatedA (HsBind Var)):"
                       forall doc. IsDoc doc => doc -> doc -> doc
$$ (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 =  forall doc. IsLine doc => doc -> doc
braces forall a b. (a -> b) -> a -> b
$
                          forall doc. IsLine doc => String -> doc
text String
"NameSet:"
                       forall doc. IsDoc doc => doc -> doc -> doc
$$ (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 =  forall doc. IsLine doc => doc -> doc
braces forall a b. (a -> b) -> a -> b
$
                         forall doc. IsLine doc => String -> doc
text String
"Fixity:"
                     forall doc. IsLine doc => doc -> doc -> doc
<+> 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)
              = forall doc. IsLine doc => doc -> doc
parens (forall doc. IsLine doc => String -> doc
text String
"L"
                        forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => [doc] -> doc
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' (forall doc. IsLine doc => String -> doc
text String
"EpAnn [AddEpAnn]")

            annotationModule :: EpAnn AnnsModule -> SDoc
            annotationModule :: EpAnn AnnsModule -> SDoc
annotationModule = forall a. (Data a, Typeable a) => SDoc -> EpAnn a -> SDoc
annotation' (forall doc. IsLine doc => String -> doc
text String
"EpAnn AnnsModule")

            annotationAddEpAnn :: EpAnn AddEpAnn -> SDoc
            annotationAddEpAnn :: EpAnn AddEpAnn -> SDoc
annotationAddEpAnn = forall a. (Data a, Typeable a) => SDoc -> EpAnn a -> SDoc
annotation' (forall doc. IsLine doc => String -> doc
text String
"EpAnn AddEpAnn")

            annotationGrhsAnn :: EpAnn GrhsAnn -> SDoc
            annotationGrhsAnn :: EpAnn GrhsAnn -> SDoc
annotationGrhsAnn = forall a. (Data a, Typeable a) => SDoc -> EpAnn a -> SDoc
annotation' (forall doc. IsLine doc => String -> doc
text String
"EpAnn GrhsAnn")

            annotationEpAnnHsCase :: EpAnn EpAnnHsCase -> SDoc
            annotationEpAnnHsCase :: EpAnn EpAnnHsCase -> SDoc
annotationEpAnnHsCase = forall a. (Data a, Typeable a) => SDoc -> EpAnn a -> SDoc
annotation' (forall doc. IsLine doc => String -> doc
text String
"EpAnn EpAnnHsCase")

            annotationAnnList :: EpAnn AnnList -> SDoc
            annotationAnnList :: EpAnn AnnList -> SDoc
annotationAnnList = forall a. (Data a, Typeable a) => SDoc -> EpAnn a -> SDoc
annotation' (forall doc. IsLine doc => String -> doc
text String
"EpAnn AnnList")

            annotationEpAnnImportDecl :: EpAnn EpAnnImportDecl -> SDoc
            annotationEpAnnImportDecl :: EpAnn EpAnnImportDecl -> SDoc
annotationEpAnnImportDecl = forall a. (Data a, Typeable a) => SDoc -> EpAnn a -> SDoc
annotation' (forall doc. IsLine doc => String -> doc
text String
"EpAnn EpAnnImportDecl")

            annotationAnnParen :: EpAnn AnnParen -> SDoc
            annotationAnnParen :: EpAnn AnnParen -> SDoc
annotationAnnParen = forall a. (Data a, Typeable a) => SDoc -> EpAnn a -> SDoc
annotation' (forall doc. IsLine doc => String -> doc
text String
"EpAnn AnnParen")

            annotationTrailingAnn :: EpAnn TrailingAnn -> SDoc
            annotationTrailingAnn :: EpAnn TrailingAnn -> SDoc
annotationTrailingAnn = forall a. (Data a, Typeable a) => SDoc -> EpAnn a -> SDoc
annotation' (forall doc. IsLine doc => String -> doc
text String
"EpAnn TrailingAnn")

            annotationEpaLocation :: EpAnn EpaLocation -> SDoc
            annotationEpaLocation :: EpAnn EpaLocation -> SDoc
annotationEpaLocation = forall a. (Data a, Typeable a) => SDoc -> EpAnn a -> SDoc
annotation' (forall doc. IsLine doc => String -> doc
text String
"EpAnn EpaLocation")

            annotationNoEpAnns :: EpAnn NoEpAnns -> SDoc
            annotationNoEpAnns :: EpAnn NoEpAnns -> SDoc
annotationNoEpAnns = forall a. (Data a, Typeable a) => SDoc -> EpAnn a -> SDoc
annotation' (forall doc. IsLine doc => String -> doc
text String
"EpAnn NoEpAnns")

            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 -> forall doc. IsLine doc => doc -> doc
parens (forall doc. IsLine doc => String -> doc
text String
"blanked:" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
tag)
             BlankEpAnnotations
NoBlankEpAnnotations -> forall doc. IsLine doc => doc -> doc
parens forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text (Constr -> String
showConstr (forall a. Data a => a -> Constr
toConstr EpAnn a
anns))
                                               forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => [doc] -> doc
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'' (forall doc. IsLine doc => String -> doc
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'' (forall doc. IsLine doc => String -> doc
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'' (forall doc. IsLine doc => String -> doc
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'' (forall doc. IsLine doc => String -> doc
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'' (forall doc. IsLine doc => String -> doc
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 = forall doc. IsLine doc => doc -> doc
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
                      -> forall doc. IsLine doc => doc -> doc
parens (forall doc. IsLine doc => String -> doc
text String
"blanked:" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
tag)
                    BlankEpAnnotations
NoBlankEpAnnotations
                      -> forall doc. IsLine doc => String -> doc
text String
"SrcSpanAnn" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Data a => a -> SDoc
showAstData' a
ann
                              forall doc. IsLine doc => doc -> doc -> doc
<+> SrcSpan -> SDoc
srcSpan SrcSpan
s
                Maybe (SrcSpanAnn' a)
Nothing -> forall doc. IsLine doc => String -> doc
text String
"locatedAnn:unmatched" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
tag
                           forall doc. IsLine doc => doc -> doc -> doc
<+> (forall doc. IsLine doc => doc -> doc
parens forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
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 []                     = []

{-
************************************************************************
*                                                                      *
* Copied from syb
*                                                                      *
************************************************************************
-}


-- | The type constructor for queries
newtype Q q x = Q { forall q x. Q q x -> x -> q
unQ :: x -> q }

-- | Extend a generic query by a type-specific case
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)

-- | Type extension of queries for type constructors
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))


-- | Type extension of queries for type constructors
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))

-- | Flexible type extension
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)



-- | Flexible type extension
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)