{-# LANGUAGE CPP #-}
module Development.IDE.GHC.Dump(showAstDataHtml) where
import qualified Data.ByteString                       as B
import           Data.Data                             hiding (Fixity)
import           Development.IDE.GHC.Compat            hiding (LocatedA,
                                                        NameAnn)
import           Development.IDE.GHC.Compat.ExactPrint
import           Development.IDE.GHC.Compat.Util
import           Generics.SYB                          (ext1Q, ext2Q, extQ)
import           GHC.Hs                                hiding (AnnLet)
import           GHC.Hs.Dump
import           GHC.Plugins                           hiding (AnnLet)
import           Prelude                               hiding ((<>))

-- | Show a GHC syntax tree in HTML.
showAstDataHtml :: (Data a, ExactPrint a, Outputable a) => a -> SDoc
showAstDataHtml :: forall a. (Data a, ExactPrint a, Outputable a) => a -> SDoc
showAstDataHtml a
a0 = SDoc -> SDoc
html forall a b. (a -> b) -> a -> b
$
    SDoc
header SDoc -> SDoc -> SDoc
$$
    SDoc -> SDoc
body ([(String, SDoc)] -> String -> SDoc -> SDoc
tag' [(String
"id",String -> SDoc
text (forall a. Show a => a -> String
show @String String
"myUL"))] String
"ul" forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
vcat
        [
            SDoc -> SDoc
li (SDoc -> SDoc
pre forall a b. (a -> b) -> a -> b
$ String -> SDoc
text (forall ast. ExactPrint ast => ast -> String
exactPrint a
a0)),
            SDoc -> SDoc
li (forall a. Data a => a -> SDoc
showAstDataHtml' a
a0),
            SDoc -> SDoc
li (SDoc -> SDoc -> SDoc
nested SDoc
"Raw" forall a b. (a -> b) -> a -> b
$ SDoc -> SDoc
pre forall a b. (a -> b) -> a -> b
$ forall a. Data a => BlankSrcSpan -> BlankEpAnnotations -> a -> SDoc
showAstData BlankSrcSpan
NoBlankSrcSpan BlankEpAnnotations
NoBlankEpAnnotations a
a0)
        ])
  where
    tag :: String -> SDoc -> SDoc
tag = [(String, SDoc)] -> String -> SDoc -> SDoc
tag' []
    tag' :: [(String, SDoc)] -> String -> SDoc -> SDoc
tag' [(String, SDoc)]
attrs String
t SDoc
cont =
        SDoc -> SDoc
angleBrackets (String -> SDoc
text String
t SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
hcat [String -> SDoc
text String
aSDoc -> SDoc -> SDoc
<>Char -> SDoc
char Char
'=' SDoc -> SDoc -> SDoc
<>SDoc
v | (String
a,SDoc
v) <- [(String, SDoc)]
attrs])
        SDoc -> SDoc -> SDoc
<> SDoc
cont
        SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
angleBrackets (Char -> SDoc
char Char
'/' SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
t)
    ul :: SDoc -> SDoc
ul = [(String, SDoc)] -> String -> SDoc -> SDoc
tag' [(String
"class", String -> SDoc
text (forall a. Show a => a -> String
show @String String
"nested"))] String
"ul"
    li :: SDoc -> SDoc
li = String -> SDoc -> SDoc
tag String
"li"
    caret :: SDoc -> SDoc
caret SDoc
x = [(String, SDoc)] -> String -> SDoc -> SDoc
tag' [(String
"class", String -> SDoc
text String
"caret")] String
"span" SDoc
"" SDoc -> SDoc -> SDoc
<+> SDoc
x
    nested :: SDoc -> SDoc -> SDoc
nested SDoc
foo SDoc
cts
#if !MIN_VERSION_ghc(9,3,0)
      | SDoc
cts forall a. Eq a => a -> a -> Bool
== SDoc
empty = SDoc
foo
#endif
      | Bool
otherwise = SDoc
foo SDoc -> SDoc -> SDoc
$$ (SDoc -> SDoc
caret forall a b. (a -> b) -> a -> b
$ SDoc -> SDoc
ul SDoc
cts)
    body :: SDoc -> SDoc
body SDoc
cts = String -> SDoc -> SDoc
tag String
"body" forall a b. (a -> b) -> a -> b
$ SDoc
cts SDoc -> SDoc -> SDoc
$$ String -> SDoc -> SDoc
tag String
"script" (String -> SDoc
text String
js)
    header :: SDoc
header = String -> SDoc -> SDoc
tag String
"head" forall a b. (a -> b) -> a -> b
$ String -> SDoc -> SDoc
tag String
"style" forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
css
    html :: SDoc -> SDoc
html = String -> SDoc -> SDoc
tag String
"html"
    pre :: SDoc -> SDoc
pre = String -> SDoc -> SDoc
tag String
"pre"
    showAstDataHtml' :: Data a => a -> SDoc
    showAstDataHtml' :: forall a. Data a => a -> SDoc
showAstDataHtml' =
      (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 {a}. Data a => [a] -> SDoc
list
              forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` String -> SDoc
string forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` FastString -> SDoc
fastString forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` SrcSpan -> SDoc
srcSpan forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` RealSrcSpan -> SDoc
realSrcSpan
              forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` EpAnn [AddEpAnn] -> SDoc
annotation
              forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` EpAnn AnnsModule -> SDoc
annotationModule
              forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` EpAnn AddEpAnn -> SDoc
annotationAddEpAnn
              forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` EpAnn GrhsAnn -> SDoc
annotationGrhsAnn
              forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` EpAnn EpAnnHsCase -> SDoc
annotationEpAnnHsCase
              forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` EpAnn AnnsLet -> SDoc
annotationEpAnnHsLet
              forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` EpAnn AnnList -> SDoc
annotationAnnList
              forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` EpAnn EpAnnImportDecl -> SDoc
annotationEpAnnImportDecl
              forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` EpAnn AnnParen -> SDoc
annotationAnnParen
              forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` EpAnn TrailingAnn -> SDoc
annotationTrailingAnn
              forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` EpAnn EpaLocation -> SDoc
annotationEpaLocation
              forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` AddEpAnn -> SDoc
addEpAnn
              forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` HsLit GhcPs -> SDoc
lit forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` HsLit GhcRn -> SDoc
litr forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` HsLit GhcTc -> SDoc
litt
              forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` SourceText -> SDoc
sourceText
              forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` DeltaPos -> SDoc
deltaPos
              forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` EpaLocation -> SDoc
epaAnchor
              forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` AnchorOperation -> SDoc
anchorOp
              forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` ByteString -> SDoc
bytestring
              forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` Name -> SDoc
name forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` OccName -> SDoc
occName forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` ModuleName -> SDoc
moduleName forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` Var -> SDoc
var
              forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` DataCon -> SDoc
dataCon
              forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` Bag (LocatedA (HsBind GhcRn)) -> SDoc
bagName forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` Bag (LocatedA (HsBind GhcPs)) -> SDoc
bagRdrName forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` Bag (LocatedA (HsBind GhcTc)) -> SDoc
bagVar forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` NameSet -> SDoc
nameSet
              forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`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 r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` SrcSpanAnn' (EpAnn AnnListItem) -> SDoc
srcSpanAnnA
              forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` SrcSpanAnn' (EpAnn AnnList) -> SDoc
srcSpanAnnL
              forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` SrcSpanAnn' (EpAnn AnnPragma) -> SDoc
srcSpanAnnP
              forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` SrcSpanAnn' (EpAnn AnnContext) -> SDoc
srcSpanAnnC
              forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` SrcSpanAnn' (EpAnn NameAnn) -> SDoc
srcSpanAnnN
              )

      where generic :: Data a => a -> SDoc
            generic :: forall a. Data a => a -> SDoc
generic a
t = SDoc -> SDoc -> SDoc
nested (String -> SDoc
text forall a b. (a -> b) -> a -> b
$ Constr -> String
showConstr (forall a. Data a => a -> Constr
toConstr a
t))
                     ([SDoc] -> SDoc
vcat (forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
gmapQ (SDoc -> SDoc
li forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => a -> SDoc
showAstDataHtml') a
t))

            string :: String -> SDoc
            string :: String -> SDoc
string = String -> SDoc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
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 (String -> String
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
. String -> String
normalize_newlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

            list :: [a] -> SDoc
list []  = SDoc -> SDoc
brackets SDoc
empty
            list [a
x] = SDoc
"[]" SDoc -> SDoc -> SDoc
$$ forall a. Data a => a -> SDoc
showAstDataHtml' a
x
            list [a]
xs  = SDoc -> SDoc -> SDoc
nested SDoc
"[]" ([SDoc] -> SDoc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (SDoc -> SDoc
li forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => a -> SDoc
showAstDataHtml') [a]
xs)

            -- 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 = 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     = String -> SDoc
text String
"NoSourceText"
            sourceText (SourceText String
src) = String -> SDoc
text String
"SourceText" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
src

            epaAnchor :: EpaLocation -> SDoc
#if MIN_VERSION_ghc(9,5,0)
            epaAnchor (EpaSpan r _)  = text "EpaSpan" <+> realSrcSpan r
#else
            epaAnchor :: EpaLocation -> SDoc
epaAnchor (EpaSpan RealSrcSpan
r)  = String -> SDoc
text String
"EpaSpan" SDoc -> SDoc -> SDoc
<+> RealSrcSpan -> SDoc
realSrcSpan RealSrcSpan
r
#endif
            epaAnchor (EpaDelta DeltaPos
d [LEpaComment]
cs) = String -> SDoc
text String
"EpaDelta" SDoc -> SDoc -> SDoc
<+> DeltaPos -> SDoc
deltaPos DeltaPos
d SDoc -> SDoc -> SDoc
<+> forall a. Data a => a -> SDoc
showAstDataHtml' [LEpaComment]
cs

            anchorOp :: AnchorOperation -> SDoc
            anchorOp :: AnchorOperation -> SDoc
anchorOp AnchorOperation
UnchangedAnchor  = SDoc
"UnchangedAnchor"
            anchorOp (MovedAnchor DeltaPos
dp) = SDoc
"MovedAnchor " SDoc -> SDoc -> SDoc
<> DeltaPos -> SDoc
deltaPos DeltaPos
dp

            deltaPos :: DeltaPos -> SDoc
            deltaPos :: DeltaPos -> SDoc
deltaPos (SameLine Int
c) = String -> SDoc
text String
"SameLine" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Int
c
            deltaPos (DifferentLine Int
l Int
c) = 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 = Char -> SDoc
char Char
' ' SDoc -> SDoc -> SDoc
<>
                             (SDoc -> Int -> SDoc -> SDoc
hang (forall a. Outputable a => a -> SDoc
ppr SrcSpan
ss) Int
1
                                   -- TODO: show annotations here
                                   (String -> SDoc
text String
""))

            realSrcSpan :: RealSrcSpan -> SDoc
            realSrcSpan :: RealSrcSpan -> SDoc
realSrcSpan RealSrcSpan
ss = 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
                                   -- TODO: show annotations here
                                   (String -> SDoc
text String
""))

            addEpAnn :: AddEpAnn -> SDoc
            addEpAnn :: AddEpAnn -> SDoc
addEpAnn (AddEpAnn AnnKeywordId
a EpaLocation
s) = 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 {a}. Data a => [a] -> 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 {a}. Data a => [a] -> 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 {a}. Data a => [a] -> 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 {a}. Data a => [a] -> 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 -> SDoc
nested SDoc
"L" forall a b. (a -> b) -> a -> b
$ (SDoc -> SDoc
li (forall a. Data a => a -> SDoc
showAstDataHtml' a
ss) SDoc -> SDoc -> SDoc
$$ SDoc -> SDoc
li (forall a. Data a => a -> SDoc
showAstDataHtml' 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")

#if MIN_VERSION_ghc(9,4,0)
            annotationEpAnnHsLet :: EpAnn NoEpAnns -> SDoc
            annotationEpAnnHsLet = annotation' (text "EpAnn NoEpAnns")
#else
            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")
#endif

            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 = SDoc -> SDoc -> SDoc
nested (String -> SDoc
text forall a b. (a -> b) -> a -> b
$ Constr -> String
showConstr (forall a. Data a => a -> Constr
toConstr EpAnn a
anns))
              ([SDoc] -> SDoc
vcat (forall a b. (a -> b) -> [a] -> [b]
map SDoc -> SDoc
li forall a b. (a -> b) -> a -> b
$ forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
gmapQ forall a. Data a => a -> SDoc
showAstDataHtml' 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 =
              case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast SrcSpanAnn' a
ss of
                Just ((SrcSpanAnn a
ann SrcSpan
s) :: SrcSpanAnn' a) ->
                      SDoc -> SDoc -> SDoc
nested SDoc
"SrcSpanAnn" forall a b. (a -> b) -> a -> b
$ (
                                 SDoc -> SDoc
li(forall a. Data a => a -> SDoc
showAstDataHtml' a
ann)
                              SDoc -> SDoc -> SDoc
$$ SDoc -> SDoc
li(SrcSpan -> SDoc
srcSpan SrcSpan
s))
                Maybe (SrcSpanAnn' a)
Nothing -> String -> SDoc
text String
"locatedAnn:unmatched" SDoc -> SDoc -> SDoc
<+> SDoc
tag
                           SDoc -> SDoc -> SDoc
<+> (String -> SDoc
text (Constr -> String
showConstr (forall a. Data a => a -> Constr
toConstr SrcSpanAnn' a
ss)))


normalize_newlines :: String -> String
normalize_newlines :: String -> String
normalize_newlines (Char
'\\':Char
'r':Char
'\\':Char
'n':String
xs) = Char
'\\'forall a. a -> [a] -> [a]
:Char
'n'forall a. a -> [a] -> [a]
:String -> String
normalize_newlines String
xs
normalize_newlines (Char
x:String
xs)                 = Char
xforall a. a -> [a] -> [a]
:String -> String
normalize_newlines String
xs
normalize_newlines []                     = []

css :: String
css :: String
css = [String] -> String
unlines
  [ String
"body {background-color: black; color: white ;}"
  , String
"/* Remove default bullets */"
  , String
"ul, #myUL {"
  , String
"  list-style-type: none;"
  , String
"}"
  , String
"/* Remove margins and padding from the parent ul */"
  , String
"#myUL {"
  , String
"  margin: 0;                       "
  , String
"  padding: 0;                      "
  , String
"}                                  "
  , String
"/* Style the caret/arrow */        "
  , String
".caret {                           "
  , String
"  cursor: pointer;                 "
  , String
"  user-select: none; /* Prevent text selection */"
  , String
"}                                  "
  , String
"/* Create the caret/arrow with a unicode, and style it */"
  , String
".caret::before {                   "
  , String
"  content: \"\\25B6 \";                "
  , String
"  color: white;                    "
  , String
"  display: inline-block;           "
  , String
"  margin-right: 6px;               "
  , String
"}                                  "
  , String
"/* Rotate the caret/arrow icon when clicked on (using JavaScript) */"
  , String
".caret-down::before {              "
  , String
"  transform: rotate(90deg);        "
  , String
"}                                  "
  , String
"/* Hide the nested list */         "
  , String
".nested {                          "
  , String
"  display: none;                   "
  , String
"}                                  "
  , String
"/* Show the nested list when the user clicks on the caret/arrow (with JavaScript) */"
  , String
".active {                          "
  , String
"  display: block;}"
  ]

js :: String
js :: String
js = [String] -> String
unlines
  [ String
"var toggler = document.getElementsByClassName(\"caret\");"
  , String
"var i;"
  , String
"for (i = 0; i < toggler.length; i++) {"
  , String
"  toggler[i].addEventListener(\"click\", function() {"
  , String
"    this.parentElement.querySelector(\".nested\").classList.toggle(\"active\");"
  , String
"    this.classList.toggle(\"caret-down\");"
  , String
"  }); }"
  ]