{-# LANGUAGE DeriveFunctor #-}
{-# OPTIONS_HADDOCK hide #-}
module Language.Haskell.Exts.ParseSyntax where
import Language.Haskell.Exts.Syntax hiding ( Type(..), Asst(..), Exp(..), FieldUpdate(..), XAttr(..), Context(..) )
import qualified Language.Haskell.Exts.Syntax as S ( Type(..), Promoted(..) )
data PExp l
= Var l (QName l)
| OverloadedLabel l String
| IPVar l (IPName l)
| Con l (QName l)
| Lit l (Literal l)
| InfixApp l (PExp l) (QOp l) (PExp l)
| App l (PExp l) (PExp l)
| NegApp l (PExp l)
| Lambda l [Pat l] (PExp l)
| Let l (Binds l) (PExp l)
| If l (PExp l) (PExp l) (PExp l)
| MultiIf l [GuardedRhs l]
| Case l (PExp l) [Alt l]
| Do l [Stmt l]
| MDo l [Stmt l]
| TupleSection l Boxed [Maybe (PExp l)]
| UnboxedSum l Int Int (PExp l)
| List l [PExp l]
| ParArray l [PExp l]
| Paren l (PExp l)
| RecConstr l (QName l) [PFieldUpdate l]
| RecUpdate l (PExp l) [PFieldUpdate l]
| EnumFrom l (PExp l)
| EnumFromTo l (PExp l) (PExp l)
| EnumFromThen l (PExp l) (PExp l)
| EnumFromThenTo l (PExp l) (PExp l) (PExp l)
| ParArrayFromTo l (PExp l) (PExp l)
| ParArrayFromThenTo l (PExp l) (PExp l) (PExp l)
| ParComp l (PExp l) [[QualStmt l]]
| ParArrayComp l (PExp l) [[QualStmt l]]
| ExpTypeSig l (PExp l) (S.Type l)
| AsPat l (Name l) (PExp l)
| WildCard l
| IrrPat l (PExp l)
| PostOp l (PExp l) (QOp l)
| PreOp l (QOp l) (PExp l)
| ViewPat l (PExp l) (Pat l)
| SeqRP l [PExp l]
| GuardRP l (PExp l) [Stmt l]
| EitherRP l (PExp l) (PExp l)
| CAsRP l (Name l) (PExp l)
| VarQuote l (QName l)
| TypQuote l (QName l)
| BracketExp l (Bracket l)
| SpliceExp l (Splice l)
| QuasiQuote l String String
| XTag l (XName l) [ParseXAttr l] (Maybe (PExp l)) [PExp l]
| XETag l (XName l) [ParseXAttr l] (Maybe (PExp l))
| XPcdata l String
| XExpTag l (PExp l)
| XChildTag l [PExp l]
| XRPats l [PExp l]
| CorePragma l String (PExp l)
| SCCPragma l String (PExp l)
| GenPragma l String (Int, Int) (Int, Int) (PExp l)
| BangPat l (PExp l)
| Proc l (Pat l) (PExp l)
| LeftArrApp l (PExp l) (PExp l)
| RightArrApp l (PExp l) (PExp l)
| LeftArrHighApp l (PExp l) (PExp l)
| RightArrHighApp l (PExp l) (PExp l)
| ArrOp l (PExp l)
| LCase l [Alt l]
| TypeApp l (S.Type l)
deriving (PExp l -> PExp l -> Bool
(PExp l -> PExp l -> Bool)
-> (PExp l -> PExp l -> Bool) -> Eq (PExp l)
forall l. Eq l => PExp l -> PExp l -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PExp l -> PExp l -> Bool
$c/= :: forall l. Eq l => PExp l -> PExp l -> Bool
== :: PExp l -> PExp l -> Bool
$c== :: forall l. Eq l => PExp l -> PExp l -> Bool
Eq,Int -> PExp l -> ShowS
[PExp l] -> ShowS
PExp l -> String
(Int -> PExp l -> ShowS)
-> (PExp l -> String) -> ([PExp l] -> ShowS) -> Show (PExp l)
forall l. Show l => Int -> PExp l -> ShowS
forall l. Show l => [PExp l] -> ShowS
forall l. Show l => PExp l -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PExp l] -> ShowS
$cshowList :: forall l. Show l => [PExp l] -> ShowS
show :: PExp l -> String
$cshow :: forall l. Show l => PExp l -> String
showsPrec :: Int -> PExp l -> ShowS
$cshowsPrec :: forall l. Show l => Int -> PExp l -> ShowS
Show,a -> PExp b -> PExp a
(a -> b) -> PExp a -> PExp b
(forall a b. (a -> b) -> PExp a -> PExp b)
-> (forall a b. a -> PExp b -> PExp a) -> Functor PExp
forall a b. a -> PExp b -> PExp a
forall a b. (a -> b) -> PExp a -> PExp b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PExp b -> PExp a
$c<$ :: forall a b. a -> PExp b -> PExp a
fmap :: (a -> b) -> PExp a -> PExp b
$cfmap :: forall a b. (a -> b) -> PExp a -> PExp b
Functor)
data PFieldUpdate l
= FieldUpdate l (QName l) (PExp l)
| FieldPun l (QName l)
| FieldWildcard l
deriving (PFieldUpdate l -> PFieldUpdate l -> Bool
(PFieldUpdate l -> PFieldUpdate l -> Bool)
-> (PFieldUpdate l -> PFieldUpdate l -> Bool)
-> Eq (PFieldUpdate l)
forall l. Eq l => PFieldUpdate l -> PFieldUpdate l -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PFieldUpdate l -> PFieldUpdate l -> Bool
$c/= :: forall l. Eq l => PFieldUpdate l -> PFieldUpdate l -> Bool
== :: PFieldUpdate l -> PFieldUpdate l -> Bool
$c== :: forall l. Eq l => PFieldUpdate l -> PFieldUpdate l -> Bool
Eq,Int -> PFieldUpdate l -> ShowS
[PFieldUpdate l] -> ShowS
PFieldUpdate l -> String
(Int -> PFieldUpdate l -> ShowS)
-> (PFieldUpdate l -> String)
-> ([PFieldUpdate l] -> ShowS)
-> Show (PFieldUpdate l)
forall l. Show l => Int -> PFieldUpdate l -> ShowS
forall l. Show l => [PFieldUpdate l] -> ShowS
forall l. Show l => PFieldUpdate l -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PFieldUpdate l] -> ShowS
$cshowList :: forall l. Show l => [PFieldUpdate l] -> ShowS
show :: PFieldUpdate l -> String
$cshow :: forall l. Show l => PFieldUpdate l -> String
showsPrec :: Int -> PFieldUpdate l -> ShowS
$cshowsPrec :: forall l. Show l => Int -> PFieldUpdate l -> ShowS
Show,a -> PFieldUpdate b -> PFieldUpdate a
(a -> b) -> PFieldUpdate a -> PFieldUpdate b
(forall a b. (a -> b) -> PFieldUpdate a -> PFieldUpdate b)
-> (forall a b. a -> PFieldUpdate b -> PFieldUpdate a)
-> Functor PFieldUpdate
forall a b. a -> PFieldUpdate b -> PFieldUpdate a
forall a b. (a -> b) -> PFieldUpdate a -> PFieldUpdate b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PFieldUpdate b -> PFieldUpdate a
$c<$ :: forall a b. a -> PFieldUpdate b -> PFieldUpdate a
fmap :: (a -> b) -> PFieldUpdate a -> PFieldUpdate b
$cfmap :: forall a b. (a -> b) -> PFieldUpdate a -> PFieldUpdate b
Functor)
data ParseXAttr l = XAttr l (XName l) (PExp l)
deriving (ParseXAttr l -> ParseXAttr l -> Bool
(ParseXAttr l -> ParseXAttr l -> Bool)
-> (ParseXAttr l -> ParseXAttr l -> Bool) -> Eq (ParseXAttr l)
forall l. Eq l => ParseXAttr l -> ParseXAttr l -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseXAttr l -> ParseXAttr l -> Bool
$c/= :: forall l. Eq l => ParseXAttr l -> ParseXAttr l -> Bool
== :: ParseXAttr l -> ParseXAttr l -> Bool
$c== :: forall l. Eq l => ParseXAttr l -> ParseXAttr l -> Bool
Eq,Int -> ParseXAttr l -> ShowS
[ParseXAttr l] -> ShowS
ParseXAttr l -> String
(Int -> ParseXAttr l -> ShowS)
-> (ParseXAttr l -> String)
-> ([ParseXAttr l] -> ShowS)
-> Show (ParseXAttr l)
forall l. Show l => Int -> ParseXAttr l -> ShowS
forall l. Show l => [ParseXAttr l] -> ShowS
forall l. Show l => ParseXAttr l -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseXAttr l] -> ShowS
$cshowList :: forall l. Show l => [ParseXAttr l] -> ShowS
show :: ParseXAttr l -> String
$cshow :: forall l. Show l => ParseXAttr l -> String
showsPrec :: Int -> ParseXAttr l -> ShowS
$cshowsPrec :: forall l. Show l => Int -> ParseXAttr l -> ShowS
Show,a -> ParseXAttr b -> ParseXAttr a
(a -> b) -> ParseXAttr a -> ParseXAttr b
(forall a b. (a -> b) -> ParseXAttr a -> ParseXAttr b)
-> (forall a b. a -> ParseXAttr b -> ParseXAttr a)
-> Functor ParseXAttr
forall a b. a -> ParseXAttr b -> ParseXAttr a
forall a b. (a -> b) -> ParseXAttr a -> ParseXAttr b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ParseXAttr b -> ParseXAttr a
$c<$ :: forall a b. a -> ParseXAttr b -> ParseXAttr a
fmap :: (a -> b) -> ParseXAttr a -> ParseXAttr b
$cfmap :: forall a b. (a -> b) -> ParseXAttr a -> ParseXAttr b
Functor)
instance Annotated PExp where
ann :: PExp l -> l
ann PExp l
e = case PExp l
e of
Var l
l QName l
_ -> l
l
OverloadedLabel l
l String
_ -> l
l
IPVar l
l IPName l
_ -> l
l
Con l
l QName l
_ -> l
l
Lit l
l Literal l
_ -> l
l
InfixApp l
l PExp l
_ QOp l
_ PExp l
_ -> l
l
App l
l PExp l
_ PExp l
_ -> l
l
NegApp l
l PExp l
_ -> l
l
Lambda l
l [Pat l]
_ PExp l
_ -> l
l
Let l
l Binds l
_ PExp l
_ -> l
l
If l
l PExp l
_ PExp l
_ PExp l
_ -> l
l
Case l
l PExp l
_ [Alt l]
_ -> l
l
Do l
l [Stmt l]
_ -> l
l
MDo l
l [Stmt l]
_ -> l
l
TupleSection l
l Boxed
_ [Maybe (PExp l)]
_ -> l
l
UnboxedSum l
l Int
_ Int
_ PExp l
_ -> l
l
List l
l [PExp l]
_ -> l
l
ParArray l
l [PExp l]
_ -> l
l
Paren l
l PExp l
_ -> l
l
RecConstr l
l QName l
_ [PFieldUpdate l]
_ -> l
l
RecUpdate l
l PExp l
_ [PFieldUpdate l]
_ -> l
l
EnumFrom l
l PExp l
_ -> l
l
EnumFromTo l
l PExp l
_ PExp l
_ -> l
l
EnumFromThen l
l PExp l
_ PExp l
_ -> l
l
EnumFromThenTo l
l PExp l
_ PExp l
_ PExp l
_ -> l
l
ParArrayFromTo l
l PExp l
_ PExp l
_ -> l
l
ParArrayFromThenTo l
l PExp l
_ PExp l
_ PExp l
_ -> l
l
ParComp l
l PExp l
_ [[QualStmt l]]
_ -> l
l
ParArrayComp l
l PExp l
_ [[QualStmt l]]
_ -> l
l
ExpTypeSig l
l PExp l
_ Type l
_ -> l
l
AsPat l
l Name l
_ PExp l
_ -> l
l
WildCard l
l -> l
l
IrrPat l
l PExp l
_ -> l
l
PostOp l
l PExp l
_ QOp l
_ -> l
l
PreOp l
l QOp l
_ PExp l
_ -> l
l
ViewPat l
l PExp l
_ Pat l
_ -> l
l
SeqRP l
l [PExp l]
_ -> l
l
GuardRP l
l PExp l
_ [Stmt l]
_ -> l
l
EitherRP l
l PExp l
_ PExp l
_ -> l
l
CAsRP l
l Name l
_ PExp l
_ -> l
l
VarQuote l
l QName l
_ -> l
l
TypQuote l
l QName l
_ -> l
l
BracketExp l
l Bracket l
_ -> l
l
SpliceExp l
l Splice l
_ -> l
l
QuasiQuote l
l String
_ String
_ -> l
l
XTag l
l XName l
_ [ParseXAttr l]
_ Maybe (PExp l)
_ [PExp l]
_ -> l
l
XETag l
l XName l
_ [ParseXAttr l]
_ Maybe (PExp l)
_ -> l
l
XPcdata l
l String
_ -> l
l
XExpTag l
l PExp l
_ -> l
l
XChildTag l
l [PExp l]
_ -> l
l
XRPats l
l [PExp l]
_ -> l
l
CorePragma l
l String
_ PExp l
_ -> l
l
SCCPragma l
l String
_ PExp l
_ -> l
l
GenPragma l
l String
_ (Int, Int)
_ (Int, Int)
_ PExp l
_ -> l
l
BangPat l
l PExp l
_ -> l
l
Proc l
l Pat l
_ PExp l
_ -> l
l
LeftArrApp l
l PExp l
_ PExp l
_ -> l
l
RightArrApp l
l PExp l
_ PExp l
_ -> l
l
LeftArrHighApp l
l PExp l
_ PExp l
_ -> l
l
RightArrHighApp l
l PExp l
_ PExp l
_ -> l
l
ArrOp l
l PExp l
_ -> l
l
LCase l
l [Alt l]
_ -> l
l
MultiIf l
l [GuardedRhs l]
_ -> l
l
TypeApp l
l Type l
_ -> l
l
amap :: (l -> l) -> PExp l -> PExp l
amap l -> l
f PExp l
e' = case PExp l
e' of
Var l
l QName l
qn -> l -> QName l -> PExp l
forall l. l -> QName l -> PExp l
Var (l -> l
f l
l) QName l
qn
OverloadedLabel l
l String
qn -> l -> String -> PExp l
forall l. l -> String -> PExp l
OverloadedLabel (l -> l
f l
l) String
qn
IPVar l
l IPName l
ipn -> l -> IPName l -> PExp l
forall l. l -> IPName l -> PExp l
IPVar (l -> l
f l
l) IPName l
ipn
Con l
l QName l
qn -> l -> QName l -> PExp l
forall l. l -> QName l -> PExp l
Con (l -> l
f l
l) QName l
qn
Lit l
l Literal l
lit -> l -> Literal l -> PExp l
forall l. l -> Literal l -> PExp l
Lit (l -> l
f l
l) Literal l
lit
InfixApp l
l PExp l
e1 QOp l
qop PExp l
e2 -> l -> PExp l -> QOp l -> PExp l -> PExp l
forall l. l -> PExp l -> QOp l -> PExp l -> PExp l
InfixApp (l -> l
f l
l) PExp l
e1 QOp l
qop PExp l
e2
App l
l PExp l
e1 PExp l
e2 -> l -> PExp l -> PExp l -> PExp l
forall l. l -> PExp l -> PExp l -> PExp l
App (l -> l
f l
l) PExp l
e1 PExp l
e2
NegApp l
l PExp l
e -> l -> PExp l -> PExp l
forall l. l -> PExp l -> PExp l
NegApp (l -> l
f l
l) PExp l
e
Lambda l
l [Pat l]
ps PExp l
e -> l -> [Pat l] -> PExp l -> PExp l
forall l. l -> [Pat l] -> PExp l -> PExp l
Lambda (l -> l
f l
l) [Pat l]
ps PExp l
e
Let l
l Binds l
bs PExp l
e -> l -> Binds l -> PExp l -> PExp l
forall l. l -> Binds l -> PExp l -> PExp l
Let (l -> l
f l
l) Binds l
bs PExp l
e
If l
l PExp l
ec PExp l
et PExp l
ee -> l -> PExp l -> PExp l -> PExp l -> PExp l
forall l. l -> PExp l -> PExp l -> PExp l -> PExp l
If (l -> l
f l
l) PExp l
ec PExp l
et PExp l
ee
Case l
l PExp l
e [Alt l]
alts -> l -> PExp l -> [Alt l] -> PExp l
forall l. l -> PExp l -> [Alt l] -> PExp l
Case (l -> l
f l
l) PExp l
e [Alt l]
alts
Do l
l [Stmt l]
ss -> l -> [Stmt l] -> PExp l
forall l. l -> [Stmt l] -> PExp l
Do (l -> l
f l
l) [Stmt l]
ss
MDo l
l [Stmt l]
ss -> l -> [Stmt l] -> PExp l
forall l. l -> [Stmt l] -> PExp l
MDo (l -> l
f l
l) [Stmt l]
ss
TupleSection l
l Boxed
bx [Maybe (PExp l)]
mes -> l -> Boxed -> [Maybe (PExp l)] -> PExp l
forall l. l -> Boxed -> [Maybe (PExp l)] -> PExp l
TupleSection (l -> l
f l
l) Boxed
bx [Maybe (PExp l)]
mes
UnboxedSum l
l Int
b Int
a PExp l
e -> l -> Int -> Int -> PExp l -> PExp l
forall l. l -> Int -> Int -> PExp l -> PExp l
UnboxedSum (l -> l
f l
l) Int
b Int
a PExp l
e
List l
l [PExp l]
es -> l -> [PExp l] -> PExp l
forall l. l -> [PExp l] -> PExp l
List (l -> l
f l
l) [PExp l]
es
ParArray l
l [PExp l]
es -> l -> [PExp l] -> PExp l
forall l. l -> [PExp l] -> PExp l
ParArray (l -> l
f l
l) [PExp l]
es
Paren l
l PExp l
e -> l -> PExp l -> PExp l
forall l. l -> PExp l -> PExp l
Paren (l -> l
f l
l) PExp l
e
RecConstr l
l QName l
qn [PFieldUpdate l]
fups -> l -> QName l -> [PFieldUpdate l] -> PExp l
forall l. l -> QName l -> [PFieldUpdate l] -> PExp l
RecConstr (l -> l
f l
l) QName l
qn [PFieldUpdate l]
fups
RecUpdate l
l PExp l
e [PFieldUpdate l]
fups -> l -> PExp l -> [PFieldUpdate l] -> PExp l
forall l. l -> PExp l -> [PFieldUpdate l] -> PExp l
RecUpdate (l -> l
f l
l) PExp l
e [PFieldUpdate l]
fups
EnumFrom l
l PExp l
e -> l -> PExp l -> PExp l
forall l. l -> PExp l -> PExp l
EnumFrom (l -> l
f l
l) PExp l
e
EnumFromTo l
l PExp l
ef PExp l
et -> l -> PExp l -> PExp l -> PExp l
forall l. l -> PExp l -> PExp l -> PExp l
EnumFromTo (l -> l
f l
l) PExp l
ef PExp l
et
EnumFromThen l
l PExp l
ef PExp l
et -> l -> PExp l -> PExp l -> PExp l
forall l. l -> PExp l -> PExp l -> PExp l
EnumFromThen (l -> l
f l
l) PExp l
ef PExp l
et
EnumFromThenTo l
l PExp l
ef PExp l
eth PExp l
eto -> l -> PExp l -> PExp l -> PExp l -> PExp l
forall l. l -> PExp l -> PExp l -> PExp l -> PExp l
EnumFromThenTo (l -> l
f l
l) PExp l
ef PExp l
eth PExp l
eto
ParArrayFromTo l
l PExp l
ef PExp l
et -> l -> PExp l -> PExp l -> PExp l
forall l. l -> PExp l -> PExp l -> PExp l
ParArrayFromTo (l -> l
f l
l) PExp l
ef PExp l
et
ParArrayFromThenTo l
l PExp l
ef PExp l
eth PExp l
eto -> l -> PExp l -> PExp l -> PExp l -> PExp l
forall l. l -> PExp l -> PExp l -> PExp l -> PExp l
ParArrayFromThenTo (l -> l
f l
l) PExp l
ef PExp l
eth PExp l
eto
ParComp l
l PExp l
e [[QualStmt l]]
qsss -> l -> PExp l -> [[QualStmt l]] -> PExp l
forall l. l -> PExp l -> [[QualStmt l]] -> PExp l
ParComp (l -> l
f l
l) PExp l
e [[QualStmt l]]
qsss
ParArrayComp l
l PExp l
e [[QualStmt l]]
qsss -> l -> PExp l -> [[QualStmt l]] -> PExp l
forall l. l -> PExp l -> [[QualStmt l]] -> PExp l
ParArrayComp (l -> l
f l
l) PExp l
e [[QualStmt l]]
qsss
ExpTypeSig l
l PExp l
e Type l
t -> l -> PExp l -> Type l -> PExp l
forall l. l -> PExp l -> Type l -> PExp l
ExpTypeSig (l -> l
f l
l) PExp l
e Type l
t
AsPat l
l Name l
n PExp l
e -> l -> Name l -> PExp l -> PExp l
forall l. l -> Name l -> PExp l -> PExp l
AsPat (l -> l
f l
l) Name l
n PExp l
e
WildCard l
l -> l -> PExp l
forall l. l -> PExp l
WildCard (l -> l
f l
l)
IrrPat l
l PExp l
e -> l -> PExp l -> PExp l
forall l. l -> PExp l -> PExp l
IrrPat (l -> l
f l
l) PExp l
e
PostOp l
l PExp l
e QOp l
op -> l -> PExp l -> QOp l -> PExp l
forall l. l -> PExp l -> QOp l -> PExp l
PostOp (l -> l
f l
l) PExp l
e QOp l
op
PreOp l
l QOp l
op PExp l
e -> l -> QOp l -> PExp l -> PExp l
forall l. l -> QOp l -> PExp l -> PExp l
PreOp (l -> l
f l
l) QOp l
op PExp l
e
ViewPat l
l PExp l
e1 Pat l
e2 -> l -> PExp l -> Pat l -> PExp l
forall l. l -> PExp l -> Pat l -> PExp l
ViewPat (l -> l
f l
l) PExp l
e1 Pat l
e2
SeqRP l
l [PExp l]
es -> l -> [PExp l] -> PExp l
forall l. l -> [PExp l] -> PExp l
SeqRP (l -> l
f l
l) [PExp l]
es
GuardRP l
l PExp l
e [Stmt l]
ss -> l -> PExp l -> [Stmt l] -> PExp l
forall l. l -> PExp l -> [Stmt l] -> PExp l
GuardRP (l -> l
f l
l) PExp l
e [Stmt l]
ss
EitherRP l
l PExp l
e1 PExp l
e2 -> l -> PExp l -> PExp l -> PExp l
forall l. l -> PExp l -> PExp l -> PExp l
EitherRP (l -> l
f l
l) PExp l
e1 PExp l
e2
CAsRP l
l Name l
n PExp l
e -> l -> Name l -> PExp l -> PExp l
forall l. l -> Name l -> PExp l -> PExp l
CAsRP (l -> l
f l
l) Name l
n PExp l
e
BangPat l
l PExp l
e -> l -> PExp l -> PExp l
forall l. l -> PExp l -> PExp l
BangPat (l -> l
f l
l) PExp l
e
VarQuote l
l QName l
qn -> l -> QName l -> PExp l
forall l. l -> QName l -> PExp l
VarQuote (l -> l
f l
l) QName l
qn
TypQuote l
l QName l
qn -> l -> QName l -> PExp l
forall l. l -> QName l -> PExp l
TypQuote (l -> l
f l
l) QName l
qn
BracketExp l
l Bracket l
br -> l -> Bracket l -> PExp l
forall l. l -> Bracket l -> PExp l
BracketExp (l -> l
f l
l) Bracket l
br
SpliceExp l
l Splice l
sp -> l -> Splice l -> PExp l
forall l. l -> Splice l -> PExp l
SpliceExp (l -> l
f l
l) Splice l
sp
QuasiQuote l
l String
sn String
se -> l -> String -> String -> PExp l
forall l. l -> String -> String -> PExp l
QuasiQuote (l -> l
f l
l) String
sn String
se
XTag l
l XName l
xn [ParseXAttr l]
xas Maybe (PExp l)
me [PExp l]
es -> l
-> XName l
-> [ParseXAttr l]
-> Maybe (PExp l)
-> [PExp l]
-> PExp l
forall l.
l
-> XName l
-> [ParseXAttr l]
-> Maybe (PExp l)
-> [PExp l]
-> PExp l
XTag (l -> l
f l
l) XName l
xn [ParseXAttr l]
xas Maybe (PExp l)
me [PExp l]
es
XETag l
l XName l
xn [ParseXAttr l]
xas Maybe (PExp l)
me -> l -> XName l -> [ParseXAttr l] -> Maybe (PExp l) -> PExp l
forall l.
l -> XName l -> [ParseXAttr l] -> Maybe (PExp l) -> PExp l
XETag (l -> l
f l
l) XName l
xn [ParseXAttr l]
xas Maybe (PExp l)
me
XPcdata l
l String
s -> l -> String -> PExp l
forall l. l -> String -> PExp l
XPcdata (l -> l
f l
l) String
s
XExpTag l
l PExp l
e -> l -> PExp l -> PExp l
forall l. l -> PExp l -> PExp l
XExpTag (l -> l
f l
l) PExp l
e
XChildTag l
l [PExp l]
es -> l -> [PExp l] -> PExp l
forall l. l -> [PExp l] -> PExp l
XChildTag (l -> l
f l
l) [PExp l]
es
XRPats l
l [PExp l]
es -> l -> [PExp l] -> PExp l
forall l. l -> [PExp l] -> PExp l
XRPats (l -> l
f l
l) [PExp l]
es
CorePragma l
l String
s PExp l
e -> l -> String -> PExp l -> PExp l
forall l. l -> String -> PExp l -> PExp l
CorePragma (l -> l
f l
l) String
s PExp l
e
SCCPragma l
l String
s PExp l
e -> l -> String -> PExp l -> PExp l
forall l. l -> String -> PExp l -> PExp l
SCCPragma (l -> l
f l
l) String
s PExp l
e
GenPragma l
l String
s (Int, Int)
n12 (Int, Int)
n34 PExp l
e -> l -> String -> (Int, Int) -> (Int, Int) -> PExp l -> PExp l
forall l.
l -> String -> (Int, Int) -> (Int, Int) -> PExp l -> PExp l
GenPragma (l -> l
f l
l) String
s (Int, Int)
n12 (Int, Int)
n34 PExp l
e
Proc l
l Pat l
p PExp l
e -> l -> Pat l -> PExp l -> PExp l
forall l. l -> Pat l -> PExp l -> PExp l
Proc (l -> l
f l
l) Pat l
p PExp l
e
LeftArrApp l
l PExp l
e1 PExp l
e2 -> l -> PExp l -> PExp l -> PExp l
forall l. l -> PExp l -> PExp l -> PExp l
LeftArrApp (l -> l
f l
l) PExp l
e1 PExp l
e2
RightArrApp l
l PExp l
e1 PExp l
e2 -> l -> PExp l -> PExp l -> PExp l
forall l. l -> PExp l -> PExp l -> PExp l
RightArrApp (l -> l
f l
l) PExp l
e1 PExp l
e2
LeftArrHighApp l
l PExp l
e1 PExp l
e2 -> l -> PExp l -> PExp l -> PExp l
forall l. l -> PExp l -> PExp l -> PExp l
LeftArrHighApp (l -> l
f l
l) PExp l
e1 PExp l
e2
RightArrHighApp l
l PExp l
e1 PExp l
e2 -> l -> PExp l -> PExp l -> PExp l
forall l. l -> PExp l -> PExp l -> PExp l
RightArrHighApp (l -> l
f l
l) PExp l
e1 PExp l
e2
ArrOp l
l PExp l
e -> l -> PExp l -> PExp l
forall l. l -> PExp l -> PExp l
ArrOp (l -> l
f l
l) PExp l
e
LCase l
l [Alt l]
alts -> l -> [Alt l] -> PExp l
forall l. l -> [Alt l] -> PExp l
LCase (l -> l
f l
l) [Alt l]
alts
MultiIf l
l [GuardedRhs l]
alts -> l -> [GuardedRhs l] -> PExp l
forall l. l -> [GuardedRhs l] -> PExp l
MultiIf (l -> l
f l
l) [GuardedRhs l]
alts
TypeApp l
l Type l
ty -> l -> Type l -> PExp l
forall l. l -> Type l -> PExp l
TypeApp (l -> l
f l
l) Type l
ty
instance Annotated PFieldUpdate where
ann :: PFieldUpdate l -> l
ann (FieldUpdate l
l QName l
_ PExp l
_) = l
l
ann (FieldPun l
l QName l
_) = l
l
ann (FieldWildcard l
l) = l
l
amap :: (l -> l) -> PFieldUpdate l -> PFieldUpdate l
amap l -> l
f (FieldUpdate l
l QName l
qn PExp l
e) = l -> QName l -> PExp l -> PFieldUpdate l
forall l. l -> QName l -> PExp l -> PFieldUpdate l
FieldUpdate (l -> l
f l
l) QName l
qn PExp l
e
amap l -> l
f (FieldPun l
l QName l
n) = l -> QName l -> PFieldUpdate l
forall l. l -> QName l -> PFieldUpdate l
FieldPun (l -> l
f l
l) QName l
n
amap l -> l
f (FieldWildcard l
l) = l -> PFieldUpdate l
forall l. l -> PFieldUpdate l
FieldWildcard (l -> l
f l
l)
instance Annotated ParseXAttr where
ann :: ParseXAttr l -> l
ann (XAttr l
l XName l
_ PExp l
_) = l
l
amap :: (l -> l) -> ParseXAttr l -> ParseXAttr l
amap l -> l
f (XAttr l
l XName l
xn PExp l
e) = l -> XName l -> PExp l -> ParseXAttr l
forall l. l -> XName l -> PExp l -> ParseXAttr l
XAttr (l -> l
f l
l) XName l
xn PExp l
e
p_unit_con :: l -> PExp l
p_unit_con :: l -> PExp l
p_unit_con l
l = l -> QName l -> PExp l
forall l. l -> QName l -> PExp l
Con l
l (l -> QName l
forall l. l -> QName l
unit_con_name l
l)
p_tuple_con :: l -> Boxed -> Int -> PExp l
p_tuple_con :: l -> Boxed -> Int -> PExp l
p_tuple_con l
l Boxed
b Int
i = l -> QName l -> PExp l
forall l. l -> QName l -> PExp l
Con l
l (l -> Boxed -> Int -> QName l
forall l. l -> Boxed -> Int -> QName l
tuple_con_name l
l Boxed
b Int
i)
p_unboxed_singleton_con :: l -> PExp l
p_unboxed_singleton_con :: l -> PExp l
p_unboxed_singleton_con l
l = l -> QName l -> PExp l
forall l. l -> QName l -> PExp l
Con l
l (l -> QName l
forall l. l -> QName l
unboxed_singleton_con_name l
l)
data PContext l
= CxSingle l (PAsst l)
| CxTuple l [PAsst l]
| CxEmpty l
deriving (PContext l -> PContext l -> Bool
(PContext l -> PContext l -> Bool)
-> (PContext l -> PContext l -> Bool) -> Eq (PContext l)
forall l. Eq l => PContext l -> PContext l -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PContext l -> PContext l -> Bool
$c/= :: forall l. Eq l => PContext l -> PContext l -> Bool
== :: PContext l -> PContext l -> Bool
$c== :: forall l. Eq l => PContext l -> PContext l -> Bool
Eq, Int -> PContext l -> ShowS
[PContext l] -> ShowS
PContext l -> String
(Int -> PContext l -> ShowS)
-> (PContext l -> String)
-> ([PContext l] -> ShowS)
-> Show (PContext l)
forall l. Show l => Int -> PContext l -> ShowS
forall l. Show l => [PContext l] -> ShowS
forall l. Show l => PContext l -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PContext l] -> ShowS
$cshowList :: forall l. Show l => [PContext l] -> ShowS
show :: PContext l -> String
$cshow :: forall l. Show l => PContext l -> String
showsPrec :: Int -> PContext l -> ShowS
$cshowsPrec :: forall l. Show l => Int -> PContext l -> ShowS
Show, a -> PContext b -> PContext a
(a -> b) -> PContext a -> PContext b
(forall a b. (a -> b) -> PContext a -> PContext b)
-> (forall a b. a -> PContext b -> PContext a) -> Functor PContext
forall a b. a -> PContext b -> PContext a
forall a b. (a -> b) -> PContext a -> PContext b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PContext b -> PContext a
$c<$ :: forall a b. a -> PContext b -> PContext a
fmap :: (a -> b) -> PContext a -> PContext b
$cfmap :: forall a b. (a -> b) -> PContext a -> PContext b
Functor)
instance Annotated PContext where
ann :: PContext l -> l
ann (CxSingle l
l PAsst l
_ ) = l
l
ann (CxTuple l
l [PAsst l]
_) = l
l
ann (CxEmpty l
l) = l
l
amap :: (l -> l) -> PContext l -> PContext l
amap l -> l
f (CxSingle l
l PAsst l
asst ) = l -> PAsst l -> PContext l
forall l. l -> PAsst l -> PContext l
CxSingle (l -> l
f l
l) PAsst l
asst
amap l -> l
f (CxTuple l
l [PAsst l]
assts) = l -> [PAsst l] -> PContext l
forall l. l -> [PAsst l] -> PContext l
CxTuple (l -> l
f l
l) [PAsst l]
assts
amap l -> l
f (CxEmpty l
l) = l -> PContext l
forall l. l -> PContext l
CxEmpty (l -> l
f l
l)
data PType l
= TyForall l
(Maybe [TyVarBind l])
(Maybe (PContext l))
(PType l)
| TyStar l
| TyFun l (PType l) (PType l)
| TyTuple l Boxed [PType l]
| TyUnboxedSum l [PType l]
| TyList l (PType l)
| TyParArray l (PType l)
| TyApp l (PType l) (PType l)
| TyVar l (Name l)
| TyCon l (QName l)
| TyParen l (PType l)
| TyPred l (PAsst l)
| TyInfix l (PType l) (MaybePromotedName l) (PType l)
| TyKind l (PType l) (Kind l)
| TyPromoted l (S.Promoted l)
| TyEquals l (PType l) (PType l)
| TySplice l (Splice l)
| TyBang l (BangType l) (Unpackedness l) (PType l)
| TyWildCard l (Maybe (Name l))
| TyQuasiQuote l String String
deriving (PType l -> PType l -> Bool
(PType l -> PType l -> Bool)
-> (PType l -> PType l -> Bool) -> Eq (PType l)
forall l. Eq l => PType l -> PType l -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PType l -> PType l -> Bool
$c/= :: forall l. Eq l => PType l -> PType l -> Bool
== :: PType l -> PType l -> Bool
$c== :: forall l. Eq l => PType l -> PType l -> Bool
Eq, Int -> PType l -> ShowS
[PType l] -> ShowS
PType l -> String
(Int -> PType l -> ShowS)
-> (PType l -> String) -> ([PType l] -> ShowS) -> Show (PType l)
forall l. Show l => Int -> PType l -> ShowS
forall l. Show l => [PType l] -> ShowS
forall l. Show l => PType l -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PType l] -> ShowS
$cshowList :: forall l. Show l => [PType l] -> ShowS
show :: PType l -> String
$cshow :: forall l. Show l => PType l -> String
showsPrec :: Int -> PType l -> ShowS
$cshowsPrec :: forall l. Show l => Int -> PType l -> ShowS
Show, a -> PType b -> PType a
(a -> b) -> PType a -> PType b
(forall a b. (a -> b) -> PType a -> PType b)
-> (forall a b. a -> PType b -> PType a) -> Functor PType
forall a b. a -> PType b -> PType a
forall a b. (a -> b) -> PType a -> PType b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PType b -> PType a
$c<$ :: forall a b. a -> PType b -> PType a
fmap :: (a -> b) -> PType a -> PType b
$cfmap :: forall a b. (a -> b) -> PType a -> PType b
Functor)
instance Annotated PType where
ann :: PType l -> l
ann PType l
t = case PType l
t of
TyForall l
l Maybe [TyVarBind l]
_ Maybe (PContext l)
_ PType l
_ -> l
l
TyStar l
l -> l
l
TyFun l
l PType l
_ PType l
_ -> l
l
TyTuple l
l Boxed
_ [PType l]
_ -> l
l
TyUnboxedSum l
l [PType l]
_ -> l
l
TyList l
l PType l
_ -> l
l
TyParArray l
l PType l
_ -> l
l
TyApp l
l PType l
_ PType l
_ -> l
l
TyVar l
l Name l
_ -> l
l
TyCon l
l QName l
_ -> l
l
TyParen l
l PType l
_ -> l
l
TyInfix l
l PType l
_ MaybePromotedName l
_ PType l
_ -> l
l
TyKind l
l PType l
_ Kind l
_ -> l
l
TyPromoted l
l Promoted l
_ -> l
l
TyEquals l
l PType l
_ PType l
_ -> l
l
TyPred l
l PAsst l
_ -> l
l
TySplice l
l Splice l
_ -> l
l
TyBang l
l BangType l
_ Unpackedness l
_ PType l
_ -> l
l
TyWildCard l
l Maybe (Name l)
_ -> l
l
TyQuasiQuote l
l String
_ String
_ -> l
l
amap :: (l -> l) -> PType l -> PType l
amap l -> l
f PType l
t' = case PType l
t' of
TyForall l
l Maybe [TyVarBind l]
mtvs Maybe (PContext l)
mcx PType l
t -> l
-> Maybe [TyVarBind l] -> Maybe (PContext l) -> PType l -> PType l
forall l.
l
-> Maybe [TyVarBind l] -> Maybe (PContext l) -> PType l -> PType l
TyForall (l -> l
f l
l) Maybe [TyVarBind l]
mtvs Maybe (PContext l)
mcx PType l
t
TyStar l
l -> l -> PType l
forall l. l -> PType l
TyStar (l -> l
f l
l)
TyFun l
l PType l
t1 PType l
t2 -> l -> PType l -> PType l -> PType l
forall l. l -> PType l -> PType l -> PType l
TyFun (l -> l
f l
l) PType l
t1 PType l
t2
TyTuple l
l Boxed
b [PType l]
ts -> l -> Boxed -> [PType l] -> PType l
forall l. l -> Boxed -> [PType l] -> PType l
TyTuple (l -> l
f l
l) Boxed
b [PType l]
ts
TyUnboxedSum l
l [PType l]
ts -> l -> [PType l] -> PType l
forall l. l -> [PType l] -> PType l
TyUnboxedSum (l -> l
f l
l) [PType l]
ts
TyList l
l PType l
t -> l -> PType l -> PType l
forall l. l -> PType l -> PType l
TyList (l -> l
f l
l) PType l
t
TyParArray l
l PType l
t -> l -> PType l -> PType l
forall l. l -> PType l -> PType l
TyParArray (l -> l
f l
l) PType l
t
TyApp l
l PType l
t1 PType l
t2 -> l -> PType l -> PType l -> PType l
forall l. l -> PType l -> PType l -> PType l
TyApp (l -> l
f l
l) PType l
t1 PType l
t2
TyVar l
l Name l
n -> l -> Name l -> PType l
forall l. l -> Name l -> PType l
TyVar (l -> l
f l
l) Name l
n
TyCon l
l QName l
qn -> l -> QName l -> PType l
forall l. l -> QName l -> PType l
TyCon (l -> l
f l
l) QName l
qn
TyParen l
l PType l
t -> l -> PType l -> PType l
forall l. l -> PType l -> PType l
TyParen (l -> l
f l
l) PType l
t
TyInfix l
l PType l
ta MaybePromotedName l
qn PType l
tb -> l -> PType l -> MaybePromotedName l -> PType l -> PType l
forall l. l -> PType l -> MaybePromotedName l -> PType l -> PType l
TyInfix (l -> l
f l
l) PType l
ta MaybePromotedName l
qn PType l
tb
TyKind l
l PType l
t Kind l
k -> l -> PType l -> Kind l -> PType l
forall l. l -> PType l -> Kind l -> PType l
TyKind (l -> l
f l
l) PType l
t Kind l
k
TyPromoted l
l Promoted l
p -> l -> Promoted l -> PType l
forall l. l -> Promoted l -> PType l
TyPromoted (l -> l
f l
l) Promoted l
p
TyEquals l
l PType l
t1 PType l
t2 -> l -> PType l -> PType l -> PType l
forall l. l -> PType l -> PType l -> PType l
TyEquals (l -> l
f l
l) PType l
t1 PType l
t2
TyPred l
l PAsst l
asst -> l -> PAsst l -> PType l
forall l. l -> PAsst l -> PType l
TyPred (l -> l
f l
l) PAsst l
asst
TySplice l
l Splice l
s -> l -> Splice l -> PType l
forall l. l -> Splice l -> PType l
TySplice (l -> l
f l
l) Splice l
s
TyBang l
l BangType l
b Unpackedness l
u PType l
t -> l -> BangType l -> Unpackedness l -> PType l -> PType l
forall l. l -> BangType l -> Unpackedness l -> PType l -> PType l
TyBang (l -> l
f l
l) BangType l
b Unpackedness l
u PType l
t
TyWildCard l
l Maybe (Name l)
mn -> l -> Maybe (Name l) -> PType l
forall l. l -> Maybe (Name l) -> PType l
TyWildCard (l -> l
f l
l) Maybe (Name l)
mn
TyQuasiQuote l
l String
n String
s -> l -> String -> String -> PType l
forall l. l -> String -> String -> PType l
TyQuasiQuote (l -> l
f l
l) String
n String
s
data PAsst l
= TypeA l (PType l)
| IParam l (IPName l) (PType l)
| ParenA l (PAsst l)
deriving (PAsst l -> PAsst l -> Bool
(PAsst l -> PAsst l -> Bool)
-> (PAsst l -> PAsst l -> Bool) -> Eq (PAsst l)
forall l. Eq l => PAsst l -> PAsst l -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PAsst l -> PAsst l -> Bool
$c/= :: forall l. Eq l => PAsst l -> PAsst l -> Bool
== :: PAsst l -> PAsst l -> Bool
$c== :: forall l. Eq l => PAsst l -> PAsst l -> Bool
Eq, Int -> PAsst l -> ShowS
[PAsst l] -> ShowS
PAsst l -> String
(Int -> PAsst l -> ShowS)
-> (PAsst l -> String) -> ([PAsst l] -> ShowS) -> Show (PAsst l)
forall l. Show l => Int -> PAsst l -> ShowS
forall l. Show l => [PAsst l] -> ShowS
forall l. Show l => PAsst l -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PAsst l] -> ShowS
$cshowList :: forall l. Show l => [PAsst l] -> ShowS
show :: PAsst l -> String
$cshow :: forall l. Show l => PAsst l -> String
showsPrec :: Int -> PAsst l -> ShowS
$cshowsPrec :: forall l. Show l => Int -> PAsst l -> ShowS
Show, a -> PAsst b -> PAsst a
(a -> b) -> PAsst a -> PAsst b
(forall a b. (a -> b) -> PAsst a -> PAsst b)
-> (forall a b. a -> PAsst b -> PAsst a) -> Functor PAsst
forall a b. a -> PAsst b -> PAsst a
forall a b. (a -> b) -> PAsst a -> PAsst b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PAsst b -> PAsst a
$c<$ :: forall a b. a -> PAsst b -> PAsst a
fmap :: (a -> b) -> PAsst a -> PAsst b
$cfmap :: forall a b. (a -> b) -> PAsst a -> PAsst b
Functor)
instance Annotated PAsst where
ann :: PAsst l -> l
ann PAsst l
asst = case PAsst l
asst of
TypeA l
l PType l
_ -> l
l
IParam l
l IPName l
_ PType l
_ -> l
l
ParenA l
l PAsst l
_ -> l
l
amap :: (l -> l) -> PAsst l -> PAsst l
amap l -> l
f PAsst l
asst = case PAsst l
asst of
TypeA l
l PType l
t -> l -> PType l -> PAsst l
forall l. l -> PType l -> PAsst l
TypeA (l -> l
f l
l) PType l
t
IParam l
l IPName l
ipn PType l
t -> l -> IPName l -> PType l -> PAsst l
forall l. l -> IPName l -> PType l -> PAsst l
IParam (l -> l
f l
l) IPName l
ipn PType l
t
ParenA l
l PAsst l
a -> l -> PAsst l -> PAsst l
forall l. l -> PAsst l -> PAsst l
ParenA (l -> l
f l
l) PAsst l
a