{-# LANGUAGE CPP #-}
module Development.IDE.GHC.Dump(showAstDataHtml) where
import           Data.Data                       hiding (Fixity)
import           Development.IDE.GHC.Compat      hiding (NameAnn)
import           Development.IDE.GHC.Compat.ExactPrint
#if MIN_VERSION_ghc(8,10,1)
import           GHC.Hs.Dump
#else
import           HsDumpAst
#endif
#if MIN_VERSION_ghc(9,2,1)
import qualified Data.ByteString                 as B
import           Development.IDE.GHC.Compat.Util
import           Generics.SYB                    (ext1Q, ext2Q, extQ)
import           GHC.Hs
#endif
#if MIN_VERSION_ghc(9,0,1)
import           GHC.Plugins
#else
import           GhcPlugins
#endif
import           Prelude                         hiding ((<>))

-- | Show a GHC syntax tree in HTML.
#if MIN_VERSION_ghc(9,2,1)
showAstDataHtml :: (Data a, ExactPrint a, Outputable a) => a -> SDoc
#else
showAstDataHtml :: (Data a, Outputable a) => a -> SDoc
#endif
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
        [
#if MIN_VERSION_ghc(9,2,1)
            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)
#else
            li (nested "Raw" $ pre $ showAstData NoBlankSrcSpan
#if MIN_VERSION_ghc(9,3,0)
                                                 NoBlankEpAnnotations
#endif
                                                 a0)
#endif
        ])
  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,2,1) && !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"
#if MIN_VERSION_ghc(9,2,1)
    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 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` AnchorOperation -> SDoc
anchorOp
              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 -> 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
            epaAnchor :: EpaLocation -> SDoc
epaAnchor (EpaSpan RealSrcSpan
r)  = String -> SDoc
text String
"EpaSpan" SDoc -> SDoc -> SDoc
<+> RealSrcSpan -> SDoc
realSrcSpan RealSrcSpan
r
            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")

            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 = 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)))
#endif


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
"  }); }"
  ]