{-
(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 hsSyn 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 HsDumpAst (
        -- * Dumping ASTs
        showAstData,
        BlankSrcSpan(..),
    ) where

import GhcPrelude

import Data.Data hiding (Fixity)
import Bag
import BasicTypes
import FastString
import NameSet
import Name
import DataCon
import SrcLoc
import HsSyn
import OccName hiding (occName)
import Var
import Module
import Outputable

import qualified Data.ByteString as B

data BlankSrcSpan = BlankSrcSpan | NoBlankSrcSpan
                  deriving (BlankSrcSpan -> BlankSrcSpan -> Bool
(BlankSrcSpan -> BlankSrcSpan -> Bool)
-> (BlankSrcSpan -> BlankSrcSpan -> Bool) -> Eq BlankSrcSpan
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
(Int -> BlankSrcSpan -> ShowS)
-> (BlankSrcSpan -> String)
-> ([BlankSrcSpan] -> ShowS)
-> Show BlankSrcSpan
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)

-- | 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 -> a -> SDoc
showAstData :: BlankSrcSpan -> a -> SDoc
showAstData b :: BlankSrcSpan
b a0 :: a
a0 = SDoc
blankLine SDoc -> SDoc -> SDoc
$$ a -> SDoc
forall a. Data a => a -> SDoc
showAstData' a
a0
  where
    showAstData' :: Data a => a -> SDoc
    showAstData' :: a -> SDoc
showAstData' =
      a -> SDoc
forall a. Data a => a -> SDoc
generic
              (a -> SDoc) -> (forall e. Data e => [e] -> SDoc) -> a -> SDoc
forall d (t :: * -> *) q.
(Data d, Typeable t) =>
(d -> q) -> (forall e. Data e => t e -> q) -> d -> q
`ext1Q` forall e. Data e => [e] -> SDoc
list
              (a -> SDoc) -> (String -> SDoc) -> a -> SDoc
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` String -> SDoc
string (a -> SDoc) -> (FastString -> SDoc) -> a -> SDoc
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` FastString -> SDoc
fastString (a -> SDoc) -> (SrcSpan -> SDoc) -> a -> SDoc
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` SrcSpan -> SDoc
srcSpan
              (a -> SDoc) -> (HsLit GhcPs -> SDoc) -> a -> SDoc
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` HsLit GhcPs -> SDoc
lit (a -> SDoc) -> (HsLit GhcRn -> SDoc) -> a -> SDoc
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` HsLit GhcRn -> SDoc
litr (a -> SDoc) -> (HsLit GhcTc -> SDoc) -> a -> SDoc
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` HsLit GhcTc -> SDoc
litt
              (a -> SDoc) -> (ByteString -> SDoc) -> a -> SDoc
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` ByteString -> SDoc
bytestring
              (a -> SDoc) -> (Name -> SDoc) -> a -> SDoc
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Name -> SDoc
name (a -> SDoc) -> (OccName -> SDoc) -> a -> SDoc
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` OccName -> SDoc
occName (a -> SDoc) -> (ModuleName -> SDoc) -> a -> SDoc
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` ModuleName -> SDoc
moduleName (a -> SDoc) -> (Var -> SDoc) -> a -> SDoc
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Var -> SDoc
var
              (a -> SDoc) -> (DataCon -> SDoc) -> a -> SDoc
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` DataCon -> SDoc
dataCon
              (a -> SDoc) -> (Bag (Located (HsBind GhcRn)) -> SDoc) -> a -> SDoc
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Bag (Located (HsBind GhcRn)) -> SDoc
bagName (a -> SDoc) -> (Bag (Located (HsBind GhcPs)) -> SDoc) -> a -> SDoc
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Bag (Located (HsBind GhcPs)) -> SDoc
bagRdrName (a -> SDoc) -> (Bag (Located (HsBind GhcTc)) -> SDoc) -> a -> SDoc
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Bag (Located (HsBind GhcTc)) -> SDoc
bagVar (a -> SDoc) -> (NameSet -> SDoc) -> a -> SDoc
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` NameSet -> SDoc
nameSet
              (a -> SDoc) -> (Fixity -> SDoc) -> a -> SDoc
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Fixity -> SDoc
fixity
              (a -> SDoc)
-> (forall d1 d2. (Data d1, Data d2) => GenLocated d1 d2 -> SDoc)
-> a
-> SDoc
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 d1 d2. (Data d1, Data d2) => GenLocated d1 d2 -> SDoc
forall b loc. (Data b, Data loc) => GenLocated loc b -> SDoc
located

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

            string :: String -> SDoc
            string :: String -> SDoc
string     = String -> SDoc
text (String -> SDoc) -> ShowS -> String -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
normalize_newlines ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. Show a => a -> String
show

            fastString :: FastString -> SDoc
            fastString :: FastString -> SDoc
fastString s :: FastString
s = SDoc -> SDoc
braces (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                            String -> SDoc
text "FastString: "
                         SDoc -> SDoc -> SDoc
<> String -> SDoc
text (ShowS
normalize_newlines ShowS -> (FastString -> String) -> FastString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> String
forall a. Show a => a -> String
show (FastString -> String) -> FastString -> String
forall a b. (a -> b) -> a -> b
$ FastString
s)

            bytestring :: B.ByteString -> SDoc
            bytestring :: ByteString -> SDoc
bytestring = String -> SDoc
text (String -> SDoc) -> (ByteString -> String) -> ByteString -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
normalize_newlines ShowS -> (ByteString -> String) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
forall a. Show a => a -> String
show

            list :: [t] -> SDoc
list []    = SDoc -> SDoc
brackets SDoc
empty
            list [x :: t
x]   = SDoc -> SDoc
brackets (t -> SDoc
forall a. Data a => a -> SDoc
showAstData' t
x)
            list (x1 :: t
x1 : x2 :: t
x2 : xs :: [t]
xs) =  (String -> SDoc
text "[" SDoc -> SDoc -> SDoc
<> t -> SDoc
forall a. Data a => a -> SDoc
showAstData' t
x1)
                                SDoc -> SDoc -> SDoc
$$ t -> [t] -> SDoc
forall t. Data t => t -> [t] -> SDoc
go t
x2 [t]
xs
              where
                go :: t -> [t] -> SDoc
go y :: t
y [] = String -> SDoc
text "," SDoc -> SDoc -> SDoc
<> t -> SDoc
forall a. Data a => a -> SDoc
showAstData' t
y SDoc -> SDoc -> SDoc
<> String -> SDoc
text "]"
                go y1 :: t
y1 (y2 :: t
y2 : ys :: [t]
ys) = (String -> SDoc
text "," SDoc -> SDoc -> SDoc
<> t -> SDoc
forall a. Data a => a -> SDoc
showAstData' t
y1) SDoc -> SDoc -> SDoc
$$ t -> [t] -> SDoc
go t
y2 [t]
ys

            -- Eliminate word-size dependence
            lit :: HsLit GhcPs -> SDoc
            lit :: HsLit GhcPs -> SDoc
lit (HsWordPrim   s :: XHsWordPrim GhcPs
s x :: Integer
x) = String -> Integer -> SourceText -> SDoc
numericLit "HsWord{64}Prim" Integer
x SourceText
XHsWordPrim GhcPs
s
            lit (HsWord64Prim s :: XHsWord64Prim GhcPs
s x :: Integer
x) = String -> Integer -> SourceText -> SDoc
numericLit "HsWord{64}Prim" Integer
x SourceText
XHsWord64Prim GhcPs
s
            lit (HsIntPrim    s :: XHsIntPrim GhcPs
s x :: Integer
x) = String -> Integer -> SourceText -> SDoc
numericLit "HsInt{64}Prim"  Integer
x SourceText
XHsIntPrim GhcPs
s
            lit (HsInt64Prim  s :: XHsInt64Prim GhcPs
s x :: Integer
x) = String -> Integer -> SourceText -> SDoc
numericLit "HsInt{64}Prim"  Integer
x SourceText
XHsInt64Prim GhcPs
s
            lit l :: HsLit GhcPs
l                  = HsLit GhcPs -> SDoc
forall a. Data a => a -> SDoc
generic HsLit GhcPs
l

            litr :: HsLit GhcRn -> SDoc
            litr :: HsLit GhcRn -> SDoc
litr (HsWordPrim   s :: XHsWordPrim GhcRn
s x :: Integer
x) = String -> Integer -> SourceText -> SDoc
numericLit "HsWord{64}Prim" Integer
x SourceText
XHsWordPrim GhcRn
s
            litr (HsWord64Prim s :: XHsWord64Prim GhcRn
s x :: Integer
x) = String -> Integer -> SourceText -> SDoc
numericLit "HsWord{64}Prim" Integer
x SourceText
XHsWord64Prim GhcRn
s
            litr (HsIntPrim    s :: XHsIntPrim GhcRn
s x :: Integer
x) = String -> Integer -> SourceText -> SDoc
numericLit "HsInt{64}Prim"  Integer
x SourceText
XHsIntPrim GhcRn
s
            litr (HsInt64Prim  s :: XHsInt64Prim GhcRn
s x :: Integer
x) = String -> Integer -> SourceText -> SDoc
numericLit "HsInt{64}Prim"  Integer
x SourceText
XHsInt64Prim GhcRn
s
            litr l :: HsLit GhcRn
l                  = HsLit GhcRn -> SDoc
forall a. Data a => a -> SDoc
generic HsLit GhcRn
l

            litt :: HsLit GhcTc -> SDoc
            litt :: HsLit GhcTc -> SDoc
litt (HsWordPrim   s :: XHsWordPrim GhcTc
s x :: Integer
x) = String -> Integer -> SourceText -> SDoc
numericLit "HsWord{64}Prim" Integer
x SourceText
XHsWordPrim GhcTc
s
            litt (HsWord64Prim s :: XHsWord64Prim GhcTc
s x :: Integer
x) = String -> Integer -> SourceText -> SDoc
numericLit "HsWord{64}Prim" Integer
x SourceText
XHsWord64Prim GhcTc
s
            litt (HsIntPrim    s :: XHsIntPrim GhcTc
s x :: Integer
x) = String -> Integer -> SourceText -> SDoc
numericLit "HsInt{64}Prim"  Integer
x SourceText
XHsIntPrim GhcTc
s
            litt (HsInt64Prim  s :: XHsInt64Prim GhcTc
s x :: Integer
x) = String -> Integer -> SourceText -> SDoc
numericLit "HsInt{64}Prim"  Integer
x SourceText
XHsInt64Prim GhcTc
s
            litt l :: HsLit GhcTc
l                  = HsLit GhcTc -> SDoc
forall a. Data a => a -> SDoc
generic HsLit GhcTc
l

            numericLit :: String -> Integer -> SourceText -> SDoc
            numericLit :: String -> Integer -> SourceText -> SDoc
numericLit tag :: String
tag x :: Integer
x s :: SourceText
s = SDoc -> SDoc
braces (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
hsep [ String -> SDoc
text String
tag
                                               , Integer -> SDoc
forall a. Data a => a -> SDoc
generic Integer
x
                                               , SourceText -> SDoc
forall a. Data a => a -> SDoc
generic SourceText
s ]

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

            occName :: OccName -> SDoc
occName n :: OccName
n  =  SDoc -> SDoc
braces (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                          String -> SDoc
text "OccName: "
                       SDoc -> SDoc -> SDoc
<> String -> SDoc
text (OccName -> String
OccName.occNameString OccName
n)

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

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

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

            dataCon :: DataCon -> SDoc
            dataCon :: DataCon -> SDoc
dataCon c :: DataCon
c  = SDoc -> SDoc
braces (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text "DataCon: " SDoc -> SDoc -> SDoc
<> DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
c

            bagRdrName:: Bag (Located (HsBind GhcPs)) -> SDoc
            bagRdrName :: Bag (Located (HsBind GhcPs)) -> SDoc
bagRdrName bg :: Bag (Located (HsBind GhcPs))
bg =  SDoc -> SDoc
braces (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                             String -> SDoc
text "Bag(Located (HsBind GhcPs)):"
                          SDoc -> SDoc -> SDoc
$$ ([Located (HsBind GhcPs)] -> SDoc
forall e. Data e => [e] -> SDoc
list ([Located (HsBind GhcPs)] -> SDoc)
-> (Bag (Located (HsBind GhcPs)) -> [Located (HsBind GhcPs)])
-> Bag (Located (HsBind GhcPs))
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bag (Located (HsBind GhcPs)) -> [Located (HsBind GhcPs)]
forall a. Bag a -> [a]
bagToList (Bag (Located (HsBind GhcPs)) -> SDoc)
-> Bag (Located (HsBind GhcPs)) -> SDoc
forall a b. (a -> b) -> a -> b
$ Bag (Located (HsBind GhcPs))
bg)

            bagName   :: Bag (Located (HsBind GhcRn)) -> SDoc
            bagName :: Bag (Located (HsBind GhcRn)) -> SDoc
bagName bg :: Bag (Located (HsBind GhcRn))
bg  =  SDoc -> SDoc
braces (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                           String -> SDoc
text "Bag(Located (HsBind Name)):"
                        SDoc -> SDoc -> SDoc
$$ ([Located (HsBind GhcRn)] -> SDoc
forall e. Data e => [e] -> SDoc
list ([Located (HsBind GhcRn)] -> SDoc)
-> (Bag (Located (HsBind GhcRn)) -> [Located (HsBind GhcRn)])
-> Bag (Located (HsBind GhcRn))
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bag (Located (HsBind GhcRn)) -> [Located (HsBind GhcRn)]
forall a. Bag a -> [a]
bagToList (Bag (Located (HsBind GhcRn)) -> SDoc)
-> Bag (Located (HsBind GhcRn)) -> SDoc
forall a b. (a -> b) -> a -> b
$ Bag (Located (HsBind GhcRn))
bg)

            bagVar    :: Bag (Located (HsBind GhcTc)) -> SDoc
            bagVar :: Bag (Located (HsBind GhcTc)) -> SDoc
bagVar bg :: Bag (Located (HsBind GhcTc))
bg  =  SDoc -> SDoc
braces (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                          String -> SDoc
text "Bag(Located (HsBind Var)):"
                       SDoc -> SDoc -> SDoc
$$ ([Located (HsBind GhcTc)] -> SDoc
forall e. Data e => [e] -> SDoc
list ([Located (HsBind GhcTc)] -> SDoc)
-> (Bag (Located (HsBind GhcTc)) -> [Located (HsBind GhcTc)])
-> Bag (Located (HsBind GhcTc))
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bag (Located (HsBind GhcTc)) -> [Located (HsBind GhcTc)]
forall a. Bag a -> [a]
bagToList (Bag (Located (HsBind GhcTc)) -> SDoc)
-> Bag (Located (HsBind GhcTc)) -> SDoc
forall a b. (a -> b) -> a -> b
$ Bag (Located (HsBind GhcTc))
bg)

            nameSet :: NameSet -> SDoc
nameSet ns :: NameSet
ns =  SDoc -> SDoc
braces (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                          String -> SDoc
text "NameSet:"
                       SDoc -> SDoc -> SDoc
$$ ([Name] -> SDoc
forall e. Data e => [e] -> SDoc
list ([Name] -> SDoc) -> (NameSet -> [Name]) -> NameSet -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSet -> [Name]
nameSetElemsStable (NameSet -> SDoc) -> NameSet -> SDoc
forall a b. (a -> b) -> a -> b
$ NameSet
ns)

            fixity :: Fixity -> SDoc
            fixity :: Fixity -> SDoc
fixity fx :: Fixity
fx =  SDoc -> SDoc
braces (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                         String -> SDoc
text "Fixity: "
                      SDoc -> SDoc -> SDoc
<> Fixity -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fixity
fx

            located :: (Data b,Data loc) => GenLocated loc b -> SDoc
            located :: GenLocated loc b -> SDoc
located (L ss :: loc
ss a :: b
a) = SDoc -> SDoc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                   case loc -> Maybe SrcSpan
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast loc
ss of
                        Just (SrcSpan
s :: SrcSpan) ->
                          SrcSpan -> SDoc
srcSpan SrcSpan
s
                        Nothing -> String -> SDoc
text "nnnnnnnn"
                      SDoc -> SDoc -> SDoc
$$ b -> SDoc
forall a. Data a => a -> SDoc
showAstData' b
a

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

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


-- | The type constructor for queries
newtype Q q x = Q { 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 :: (a -> q) -> (b -> q) -> a -> q
extQ f :: a -> q
f g :: b -> q
g a :: a
a = q -> (b -> q) -> Maybe b -> q
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> q
f a
a) b -> q
g (a -> Maybe b
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 :: (d -> q) -> (forall e. Data e => t e -> q) -> d -> q
ext1Q def :: d -> q
def ext :: forall e. Data e => t e -> q
ext = Q q d -> d -> q
forall q x. Q q x -> x -> q
unQ (((d -> q) -> Q q d
forall q x. (x -> q) -> Q q x
Q d -> q
def) Q q d -> (forall d. Data d => Q q (t d)) -> Q q d
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
c a -> (forall d. Data d => c (t d)) -> c a
`ext1` ((t d -> q) -> Q q (t d)
forall q x. (x -> q) -> Q q x
Q t d -> 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 :: (d -> q)
-> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q) -> d -> q
ext2Q def :: d -> q
def ext :: forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q
ext = Q q d -> d -> q
forall q x. Q q x -> x -> q
unQ (((d -> q) -> Q q d
forall q x. (x -> q) -> Q q x
Q d -> q
def) Q q d
-> (forall d1 d2. (Data d1, Data d2) => Q q (t d1 d2)) -> Q q d
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
c a -> (forall d1 d2. (Data d1, Data d2) => c (t d1 d2)) -> c a
`ext2` ((t d1 d2 -> q) -> Q q (t d1 d2)
forall q x. (x -> q) -> Q q x
Q t d1 d2 -> 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 :: c a -> (forall d. Data d => c (t d)) -> c a
ext1 def :: c a
def ext :: forall d. Data d => c (t d)
ext = c a -> (c a -> c a) -> Maybe (c a) -> c a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe c a
def c a -> c a
forall a. a -> a
id ((forall d. Data d => c (t d)) -> Maybe (c a)
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 :: c a -> (forall d1 d2. (Data d1, Data d2) => c (t d1 d2)) -> c a
ext2 def :: c a
def ext :: forall d1 d2. (Data d1, Data d2) => c (t d1 d2)
ext = c a -> (c a -> c a) -> Maybe (c a) -> c a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe c a
def c a -> c a
forall a. a -> a
id ((forall d1 d2. (Data d1, Data d2) => c (t d1 d2)) -> Maybe (c a)
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)