module Language.Haskell.Exts.Annotated.Syntax (
Module(..), ModuleHead(..), WarningText(..), ExportSpecList(..), ExportSpec(..),
ImportDecl(..), ImportSpecList(..), ImportSpec(..), Assoc(..),
Decl(..), DeclHead(..), InstHead(..), Binds(..), IPBind(..),
ClassDecl(..), InstDecl(..), Deriving(..),
DataOrNew(..), ConDecl(..), FieldDecl(..), QualConDecl(..), GadtDecl(..), BangType(..),
Match(..), Rhs(..), GuardedRhs(..),
Context(..), FunDep(..), Asst(..),
Type(..), Boxed(..), Kind(..), TyVarBind(..),
Exp(..), Stmt(..), QualStmt(..), FieldUpdate(..),
Alt(..), GuardedAlts(..), GuardedAlt(..), XAttr(..),
Pat(..), PatField(..), PXAttr(..), RPat(..), RPatOp(..),
Literal(..),
ModuleName(..), QName(..), Name(..), QOp(..), Op(..),
SpecialCon(..), CName(..), IPName(..), XName(..),
Bracket(..), Splice(..),
Safety(..), CallConv(..),
ModulePragma(..), Tool(..),
Rule(..), RuleVar(..), Activation(..),
Annotation(..),
prelude_mod, main_mod,
main_name,
unit_con_name, tuple_con_name, list_cons_name, unboxed_singleton_con_name,
unit_con, tuple_con, unboxed_singleton_con,
as_name, qualified_name, hiding_name, minus_name, bang_name, dot_name, star_name,
export_name, safe_name, unsafe_name, threadsafe_name,
stdcall_name, ccall_name, cplusplus_name, dotnet_name, jvm_name, js_name,
forall_name, family_name,
unit_tycon_name, fun_tycon_name, list_tycon_name, tuple_tycon_name, unboxed_singleton_tycon_name,
unit_tycon, fun_tycon, list_tycon, tuple_tycon, unboxed_singleton_tycon,
Annotated(..), (=~=),
) where
#ifdef __GLASGOW_HASKELL__
#ifdef BASE4
import Data.Data
#else
import Data.Generics (Data(..),Typeable(..))
#endif
#endif
import Data.Foldable (Foldable)
import Data.Traversable (Traversable)
data ModuleName l = ModuleName l String
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data SpecialCon l
= UnitCon l
| ListCon l
| FunCon l
| TupleCon l Boxed Int
| Cons l
| UnboxedSingleCon l
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data QName l
= Qual l (ModuleName l) (Name l)
| UnQual l (Name l)
| Special l (SpecialCon l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data Name l
= Ident l String
| Symbol l String
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data IPName l
= IPDup l String
| IPLin l String
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data QOp l
= QVarOp l (QName l)
| QConOp l (QName l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data Op l
= VarOp l (Name l)
| ConOp l (Name l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data CName l
= VarName l (Name l)
| ConName l (Name l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data Module l
= Module l (Maybe (ModuleHead l)) [ModulePragma l] [ImportDecl l] [Decl l]
| XmlPage l (ModuleName l) [ModulePragma l] (XName l) [XAttr l] (Maybe (Exp l)) [Exp l]
| XmlHybrid l (Maybe (ModuleHead l)) [ModulePragma l] [ImportDecl l] [Decl l]
(XName l) [XAttr l] (Maybe (Exp l)) [Exp l]
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data ModuleHead l = ModuleHead l (ModuleName l) (Maybe (WarningText l)) (Maybe (ExportSpecList l))
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data ExportSpecList l
= ExportSpecList l [ExportSpec l]
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data ExportSpec l
= EVar l (QName l)
| EAbs l (QName l)
| EThingAll l (QName l)
| EThingWith l (QName l) [CName l]
| EModuleContents l (ModuleName l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data ImportDecl l = ImportDecl
{ importAnn :: l
, importModule :: (ModuleName l)
, importQualified :: Bool
, importSrc :: Bool
, importPkg :: Maybe String
, importAs :: Maybe (ModuleName l)
, importSpecs :: Maybe (ImportSpecList l)
}
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data ImportSpecList l
= ImportSpecList l Bool [ImportSpec l]
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data ImportSpec l
= IVar l (Name l)
| IAbs l (Name l)
| IThingAll l (Name l)
| IThingWith l (Name l) [CName l]
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data Assoc l
= AssocNone l
| AssocLeft l
| AssocRight l
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data Decl l
= TypeDecl l (DeclHead l) (Type l)
| TypeFamDecl l (DeclHead l) (Maybe (Kind l))
| DataDecl l (DataOrNew l) (Maybe (Context l)) (DeclHead l) [QualConDecl l] (Maybe (Deriving l))
| GDataDecl l (DataOrNew l) (Maybe (Context l)) (DeclHead l) (Maybe (Kind l)) [GadtDecl l] (Maybe (Deriving l))
| DataFamDecl l (Maybe (Context l)) (DeclHead l) (Maybe (Kind l))
| TypeInsDecl l (Type l) (Type l)
| DataInsDecl l (DataOrNew l) (Type l) [QualConDecl l] (Maybe (Deriving l))
| GDataInsDecl l (DataOrNew l) (Type l) (Maybe (Kind l)) [GadtDecl l] (Maybe (Deriving l))
| ClassDecl l (Maybe (Context l)) (DeclHead l) [FunDep l] (Maybe [ClassDecl l])
| InstDecl l (Maybe (Context l)) (InstHead l) (Maybe [InstDecl l])
| DerivDecl l (Maybe (Context l)) (InstHead l)
| InfixDecl l (Assoc l) (Maybe Int) [Op l]
| DefaultDecl l [Type l]
| SpliceDecl l (Exp l)
| TypeSig l [Name l] (Type l)
| FunBind l [Match l]
| PatBind l (Pat l) (Maybe (Type l)) (Rhs l) (Maybe (Binds l))
| ForImp l (CallConv l) (Maybe (Safety l)) (Maybe String) (Name l) (Type l)
| ForExp l (CallConv l) (Maybe String) (Name l) (Type l)
| RulePragmaDecl l [Rule l]
| DeprPragmaDecl l [([Name l], String)]
| WarnPragmaDecl l [([Name l], String)]
| InlineSig l Bool (Maybe (Activation l)) (QName l)
| InlineConlikeSig l (Maybe (Activation l)) (QName l)
| SpecSig l (Maybe (Activation l)) (QName l) [Type l]
| SpecInlineSig l Bool (Maybe (Activation l)) (QName l) [Type l]
| InstSig l (Maybe (Context l)) (InstHead l)
| AnnPragma l (Annotation l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data Annotation l
= Ann l (Name l) (Exp l)
| TypeAnn l (Name l) (Exp l)
| ModuleAnn l (Exp l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data DataOrNew l = DataType l | NewType l
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data DeclHead l
= DHead l (Name l) [TyVarBind l]
| DHInfix l (TyVarBind l) (Name l) (TyVarBind l)
| DHParen l (DeclHead l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data InstHead l
= IHead l (QName l) [Type l]
| IHInfix l (Type l) (QName l) (Type l)
| IHParen l (InstHead l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data Deriving l = Deriving l [InstHead l]
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data Binds l
= BDecls l [Decl l]
| IPBinds l [IPBind l]
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data IPBind l = IPBind l (IPName l) (Exp l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data Match l
= Match l (Name l) [Pat l] (Rhs l) (Maybe (Binds l))
| InfixMatch l (Pat l) (Name l) [Pat l] (Rhs l) (Maybe (Binds l))
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data QualConDecl l
= QualConDecl l
(Maybe [TyVarBind l]) (Maybe (Context l))
(ConDecl l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data ConDecl l
= ConDecl l (Name l) [BangType l]
| InfixConDecl l (BangType l) (Name l) (BangType l)
| RecDecl l (Name l) [FieldDecl l]
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data FieldDecl l = FieldDecl l [Name l] (BangType l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data GadtDecl l
= GadtDecl l (Name l) (Type l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data ClassDecl l
= ClsDecl l (Decl l)
| ClsDataFam l (Maybe (Context l)) (DeclHead l) (Maybe (Kind l))
| ClsTyFam l (DeclHead l) (Maybe (Kind l))
| ClsTyDef l (Type l) (Type l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data InstDecl l
= InsDecl l (Decl l)
| InsType l (Type l) (Type l)
| InsData l (DataOrNew l) (Type l) [QualConDecl l] (Maybe (Deriving l))
| InsGData l (DataOrNew l) (Type l) (Maybe (Kind l)) [GadtDecl l] (Maybe (Deriving l))
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data BangType l
= BangedTy l (Type l)
| UnBangedTy l (Type l)
| UnpackedTy l (Type l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data Rhs l
= UnGuardedRhs l (Exp l)
| GuardedRhss l [GuardedRhs l]
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data GuardedRhs l
= GuardedRhs l [Stmt l] (Exp l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data Type l
= TyForall l
(Maybe [TyVarBind l])
(Maybe (Context l))
(Type l)
| TyFun l (Type l) (Type l)
| TyTuple l Boxed [Type l]
| TyList l (Type l)
| TyApp l (Type l) (Type l)
| TyVar l (Name l)
| TyCon l (QName l)
| TyParen l (Type l)
| TyInfix l (Type l) (QName l) (Type l)
| TyKind l (Type l) (Kind l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data Boxed = Boxed | Unboxed
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data)
#else
deriving (Eq,Ord,Show)
#endif
data TyVarBind l
= KindedVar l (Name l) (Kind l)
| UnkindedVar l (Name l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data Kind l
= KindStar l
| KindBang l
| KindFn l (Kind l) (Kind l)
| KindParen l (Kind l)
| KindVar l (Name l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data FunDep l
= FunDep l [Name l] [Name l]
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data Context l
= CxSingle l (Asst l)
| CxTuple l [Asst l]
| CxParen l (Context l)
| CxEmpty l
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data Asst l
= ClassA l (QName l) [Type l]
| InfixA l (Type l) (QName l) (Type l)
| IParam l (IPName l) (Type l)
| EqualP l (Type l) (Type l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data Literal l
= Char l Char String
| String l String String
| Int l Integer String
| Frac l Rational String
| PrimInt l Integer String
| PrimWord l Integer String
| PrimFloat l Rational String
| PrimDouble l Rational String
| PrimChar l Char String
| PrimString l String String
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data Exp l
= Var l (QName l)
| IPVar l (IPName l)
| Con l (QName l)
| Lit l (Literal l)
| InfixApp l (Exp l) (QOp l) (Exp l)
| App l (Exp l) (Exp l)
| NegApp l (Exp l)
| Lambda l [Pat l] (Exp l)
| Let l (Binds l) (Exp l)
| If l (Exp l) (Exp l) (Exp l)
| Case l (Exp l) [Alt l]
| Do l [Stmt l]
| MDo l [Stmt l]
| Tuple l Boxed [Exp l]
| TupleSection l Boxed [Maybe (Exp l)]
| List l [Exp l]
| Paren l (Exp l)
| LeftSection l (Exp l) (QOp l)
| RightSection l (QOp l) (Exp l)
| RecConstr l (QName l) [FieldUpdate l]
| RecUpdate l (Exp l) [FieldUpdate l]
| EnumFrom l (Exp l)
| EnumFromTo l (Exp l) (Exp l)
| EnumFromThen l (Exp l) (Exp l)
| EnumFromThenTo l (Exp l) (Exp l) (Exp l)
| ListComp l (Exp l) [QualStmt l]
| ParComp l (Exp l) [[QualStmt l]]
| ExpTypeSig l (Exp l) (Type 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) [XAttr l] (Maybe (Exp l)) [Exp l]
| XETag l (XName l) [XAttr l] (Maybe (Exp l))
| XPcdata l String
| XExpTag l (Exp l)
| XChildTag l [Exp l]
| CorePragma l String (Exp l)
| SCCPragma l String (Exp l)
| GenPragma l String (Int, Int) (Int, Int) (Exp l)
| Proc l (Pat l) (Exp l)
| LeftArrApp l (Exp l) (Exp l)
| RightArrApp l (Exp l) (Exp l)
| LeftArrHighApp l (Exp l) (Exp l)
| RightArrHighApp l (Exp l) (Exp l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data XName l
= XName l String
| XDomName l String String
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data XAttr l = XAttr l (XName l) (Exp l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data Bracket l
= ExpBracket l (Exp l)
| PatBracket l (Pat l)
| TypeBracket l (Type l)
| DeclBracket l [Decl l]
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data Splice l
= IdSplice l String
| ParenSplice l (Exp l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data Safety l
= PlayRisky l
| PlaySafe l Bool
| PlayInterruptible l
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data CallConv l
= StdCall l
| CCall l
| CPlusPlus l
| DotNet l
| Jvm l
| Js l
| CApi l
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data ModulePragma l
= LanguagePragma l [Name l]
| OptionsPragma l (Maybe Tool) String
| AnnModulePragma l (Annotation l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data Tool = GHC | HUGS | NHC98 | YHC | HADDOCK | UnknownTool String
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data)
#else
deriving (Eq,Ord,Show)
#endif
data Activation l
= ActiveFrom l Int
| ActiveUntil l Int
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data Rule l
= Rule l String (Maybe (Activation l)) (Maybe [RuleVar l]) (Exp l) (Exp l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data RuleVar l
= RuleVar l (Name l)
| TypedRuleVar l (Name l) (Type l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data WarningText l
= DeprText l String
| WarnText l String
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data Pat l
= PVar l (Name l)
| PLit l (Literal l)
| PNeg l (Pat l)
| PNPlusK l (Name l) Integer
| PInfixApp l (Pat l) (QName l) (Pat l)
| PApp l (QName l) [Pat l]
| PTuple l Boxed [Pat l]
| PList l [Pat l]
| PParen l (Pat l)
| PRec l (QName l) [PatField l]
| PAsPat l (Name l) (Pat l)
| PWildCard l
| PIrrPat l (Pat l)
| PatTypeSig l (Pat l) (Type l)
| PViewPat l (Exp l) (Pat l)
| PRPat l [RPat l]
| PXTag l (XName l) [PXAttr l] (Maybe (Pat l)) [Pat l]
| PXETag l (XName l) [PXAttr l] (Maybe (Pat l))
| PXPcdata l String
| PXPatTag l (Pat l)
| PXRPats l [RPat l]
| PExplTypeArg l (QName l) (Type l)
| PQuasiQuote l String String
| PBangPat l (Pat l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data PXAttr l = PXAttr l (XName l) (Pat l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data RPatOp l
= RPStar l
| RPStarG l
| RPPlus l
| RPPlusG l
| RPOpt l
| RPOptG l
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data RPat l
= RPOp l (RPat l) (RPatOp l)
| RPEither l (RPat l) (RPat l)
| RPSeq l [RPat l]
| RPGuard l (Pat l) [Stmt l]
| RPCAs l (Name l) (RPat l)
| RPAs l (Name l) (RPat l)
| RPParen l (RPat l)
| RPPat l (Pat l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data PatField l
= PFieldPat l (QName l) (Pat l)
| PFieldPun l (Name l)
| PFieldWildcard l
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data Stmt l
= Generator l (Pat l) (Exp l)
| Qualifier l (Exp l)
| LetStmt l (Binds l)
| RecStmt l [Stmt l]
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data QualStmt l
= QualStmt l (Stmt l)
| ThenTrans l (Exp l)
| ThenBy l (Exp l) (Exp l)
| GroupBy l (Exp l)
| GroupUsing l (Exp l)
| GroupByUsing l (Exp l) (Exp l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data FieldUpdate l
= FieldUpdate l (QName l) (Exp l)
| FieldPun l (Name l)
| FieldWildcard l
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data Alt l
= Alt l (Pat l) (GuardedAlts l) (Maybe (Binds l))
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data GuardedAlts l
= UnGuardedAlt l (Exp l)
| GuardedAlts l [GuardedAlt l]
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
data GuardedAlt l
= GuardedAlt l [Stmt l] (Exp l)
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Ord,Show,Typeable,Data,Foldable,Traversable)
#else
deriving (Eq,Ord,Show)
#endif
prelude_mod, main_mod :: l -> ModuleName l
prelude_mod l = ModuleName l "Prelude"
main_mod l = ModuleName l "Main"
main_name :: l -> Name l
main_name l = Ident l "main"
unit_con_name :: l -> QName l
unit_con_name l = Special l (UnitCon l)
tuple_con_name :: l -> Boxed -> Int -> QName l
tuple_con_name l b i = Special l (TupleCon l b (i+1))
list_cons_name :: l -> QName l
list_cons_name l = Special l (Cons l)
unboxed_singleton_con_name :: l -> QName l
unboxed_singleton_con_name l = Special l (UnboxedSingleCon l)
unit_con :: l -> Exp l
unit_con l = Con l $ unit_con_name l
tuple_con :: l -> Boxed -> Int -> Exp l
tuple_con l b i = Con l (tuple_con_name l b i)
unboxed_singleton_con :: l -> Exp l
unboxed_singleton_con l = Con l (unboxed_singleton_con_name l)
as_name, qualified_name, hiding_name, minus_name, bang_name, dot_name, star_name :: l -> Name l
as_name l = Ident l "as"
qualified_name l = Ident l "qualified"
hiding_name l = Ident l "hiding"
minus_name l = Symbol l "-"
bang_name l = Symbol l "!"
dot_name l = Symbol l "."
star_name l = Symbol l "*"
export_name, safe_name, unsafe_name, threadsafe_name,
stdcall_name, ccall_name, cplusplus_name, dotnet_name,
jvm_name, js_name, forall_name, family_name :: l -> Name l
export_name l = Ident l "export"
safe_name l = Ident l "safe"
unsafe_name l = Ident l "unsafe"
threadsafe_name l = Ident l "threadsafe"
stdcall_name l = Ident l "stdcall"
ccall_name l = Ident l "ccall"
cplusplus_name l = Ident l "cplusplus"
dotnet_name l = Ident l "dotnet"
jvm_name l = Ident l "jvm"
js_name l = Ident l "js"
forall_name l = Ident l "forall"
family_name l = Ident l "family"
unit_tycon_name, fun_tycon_name, list_tycon_name, unboxed_singleton_tycon_name :: l -> QName l
unit_tycon_name l = unit_con_name l
fun_tycon_name l = Special l (FunCon l)
list_tycon_name l = Special l (ListCon l)
unboxed_singleton_tycon_name l = Special l (UnboxedSingleCon l)
tuple_tycon_name :: l -> Boxed -> Int -> QName l
tuple_tycon_name l b i = tuple_con_name l b i
unit_tycon, fun_tycon, list_tycon, unboxed_singleton_tycon :: l -> Type l
unit_tycon l = TyCon l $ unit_tycon_name l
fun_tycon l = TyCon l $ fun_tycon_name l
list_tycon l = TyCon l $ list_tycon_name l
unboxed_singleton_tycon l = TyCon l $ unboxed_singleton_tycon_name l
tuple_tycon :: l -> Boxed -> Int -> Type l
tuple_tycon l b i = TyCon l (tuple_tycon_name l b i)
(=~=) :: (Annotated a, Eq (a ())) => a l1 -> a l2 -> Bool
a =~= b = fmap (const ()) a == fmap (const ()) b
instance Functor ModuleName where
fmap f (ModuleName l s) = ModuleName (f l) s
instance Functor SpecialCon where
fmap f sc = case sc of
UnitCon l -> UnitCon (f l)
ListCon l -> ListCon (f l)
FunCon l -> FunCon (f l)
TupleCon l b n -> TupleCon (f l) b n
Cons l -> Cons (f l)
UnboxedSingleCon l -> UnboxedSingleCon (f l)
instance Functor QName where
fmap f qn = case qn of
Qual l mn n -> Qual (f l) (fmap f mn) (fmap f n)
UnQual l n -> UnQual (f l) (fmap f n)
Special l sc -> Special (f l) (fmap f sc)
instance Functor Name where
fmap f (Ident l s) = Ident (f l) s
fmap f (Symbol l s) = Symbol (f l) s
instance Functor IPName where
fmap f (IPDup l s) = IPDup (f l) s
fmap f (IPLin l s) = IPLin (f l) s
instance Functor QOp where
fmap f (QVarOp l qn) = QVarOp (f l) (fmap f qn)
fmap f (QConOp l qn) = QConOp (f l) (fmap f qn)
instance Functor Op where
fmap f (VarOp l n) = VarOp (f l) (fmap f n)
fmap f (ConOp l n) = ConOp (f l) (fmap f n)
instance Functor CName where
fmap f (VarName l n) = VarName (f l) (fmap f n)
fmap f (ConName l n) = ConName (f l) (fmap f n)
instance Functor Module where
fmap f (Module l mmh ops iss dcls) =
Module (f l) (fmap (fmap f) mmh) (map (fmap f) ops) (map (fmap f) iss) (map (fmap f) dcls)
fmap f (XmlPage l mn os xn xas me es) =
XmlPage (f l) (fmap f mn) (map (fmap f) os) (fmap f xn) (map (fmap f) xas) (fmap (fmap f) me) (map (fmap f) es)
fmap f (XmlHybrid l mmh ops iss dcls xn xas me es) =
XmlHybrid (f l) (fmap (fmap f) mmh) (map (fmap f) ops) (map (fmap f) iss) (map (fmap f) dcls)
(fmap f xn) (map (fmap f) xas) (fmap (fmap f) me) (map (fmap f) es)
instance Functor ModuleHead where
fmap f (ModuleHead l mn mwt mexpl) =
ModuleHead (f l) (fmap f mn) (fmap (fmap f) mwt) (fmap (fmap f) mexpl)
instance Functor ExportSpecList where
fmap f (ExportSpecList l ess) = ExportSpecList (f l) (map (fmap f) ess)
instance Functor ExportSpec where
fmap f es = case es of
EVar l qn -> EVar (f l) (fmap f qn)
EAbs l qn -> EAbs (f l) (fmap f qn)
EThingAll l qn -> EThingAll (f l) (fmap f qn)
EThingWith l qn cns -> EThingWith (f l) (fmap f qn) (map (fmap f) cns)
EModuleContents l mn -> EModuleContents (f l) (fmap f mn)
instance Functor ImportDecl where
fmap f (ImportDecl l mn qual src pkg mmn mis) =
ImportDecl (f l) (fmap f mn) qual src pkg (fmap (fmap f) mmn) (fmap (fmap f) mis)
instance Functor ImportSpecList where
fmap f (ImportSpecList l b iss) = ImportSpecList (f l) b (map (fmap f) iss)
instance Functor ImportSpec where
fmap f is = case is of
IVar l n -> IVar (f l) (fmap f n)
IAbs l n -> IAbs (f l) (fmap f n)
IThingAll l n -> IThingAll (f l) (fmap f n)
IThingWith l n cns -> IThingWith (f l) (fmap f n) (map (fmap f) cns)
instance Functor Assoc where
fmap f (AssocNone l) = AssocNone (f l)
fmap f (AssocLeft l) = AssocLeft (f l)
fmap f (AssocRight l) = AssocRight (f l)
instance Functor Decl where
fmap f decl = case decl of
TypeDecl l dh t -> TypeDecl (f l) (fmap f dh) (fmap f t)
TypeFamDecl l dh mk -> TypeFamDecl (f l) (fmap f dh) (fmap (fmap f) mk)
DataDecl l dn mcx dh cds ders ->
DataDecl (f l) (fmap f dn) (fmap (fmap f) mcx) (fmap f dh) (map (fmap f) cds) (fmap (fmap f) ders)
GDataDecl l dn mcx dh mk gds ders ->
GDataDecl (f l) (fmap f dn) (fmap (fmap f) mcx) (fmap f dh) (fmap (fmap f) mk) (map (fmap f) gds) (fmap (fmap f) ders)
DataFamDecl l mcx dh mk -> DataFamDecl (f l) (fmap (fmap f) mcx) (fmap f dh) (fmap (fmap f) mk)
TypeInsDecl l t1 t2 -> TypeInsDecl (f l) (fmap f t1) (fmap f t2)
DataInsDecl l dn t cds ders -> DataInsDecl (f l) (fmap f dn) (fmap f t) (map (fmap f) cds) (fmap (fmap f) ders)
GDataInsDecl l dn t mk gds ders -> GDataInsDecl (f l) (fmap f dn) (fmap f t) (fmap (fmap f) mk) (map (fmap f) gds) (fmap (fmap f) ders)
ClassDecl l mcx dh fds mcds -> ClassDecl (f l) (fmap (fmap f) mcx) (fmap f dh) (map (fmap f) fds) (fmap (map (fmap f)) mcds)
InstDecl l mcx ih mids -> InstDecl (f l) (fmap (fmap f) mcx) (fmap f ih) (fmap (map (fmap f)) mids)
DerivDecl l mcx ih -> DerivDecl (f l) (fmap (fmap f) mcx) (fmap f ih)
InfixDecl l a k ops -> InfixDecl (f l) (fmap f a) k (map (fmap f) ops)
DefaultDecl l ts -> DefaultDecl (f l) (map (fmap f) ts)
SpliceDecl l sp -> SpliceDecl (f l) (fmap f sp)
TypeSig l ns t -> TypeSig (f l) (map (fmap f) ns) (fmap f t)
FunBind l ms -> FunBind (f l) (map (fmap f) ms)
PatBind l p mt rhs bs -> PatBind (f l) (fmap f p) (fmap (fmap f) mt) (fmap f rhs) (fmap (fmap f) bs)
ForImp l cc msf s n t -> ForImp (f l) (fmap f cc) (fmap (fmap f) msf) s (fmap f n) (fmap f t)
ForExp l cc s n t -> ForExp (f l) (fmap f cc) s (fmap f n) (fmap f t)
RulePragmaDecl l rs -> RulePragmaDecl (f l) (map (fmap f) rs)
DeprPragmaDecl l nss -> DeprPragmaDecl (f l) (map (wp f) nss)
WarnPragmaDecl l nss -> WarnPragmaDecl (f l) (map (wp f) nss)
InlineSig l b mact qn -> InlineSig (f l) b (fmap (fmap f) mact) (fmap f qn)
InlineConlikeSig l mact qn -> InlineConlikeSig (f l) (fmap (fmap f) mact) (fmap f qn)
SpecInlineSig l b mact qn ts -> SpecInlineSig (f l) b (fmap (fmap f) mact) (fmap f qn) (map (fmap f) ts)
SpecSig l mact qn ts -> SpecSig (f l) (fmap (fmap f) mact) (fmap f qn) (map (fmap f) ts)
InstSig l mcx ih -> InstSig (f l) (fmap (fmap f) mcx) (fmap f ih)
AnnPragma l ann -> AnnPragma (f l) (fmap f ann)
where wp f (ns, s) = (map (fmap f) ns, s)
instance Functor Annotation where
fmap f (Ann l n e) = Ann (f l) (fmap f n) (fmap f e)
fmap f (TypeAnn l n e) = TypeAnn (f l) (fmap f n) (fmap f e)
fmap f (ModuleAnn l e) = ModuleAnn (f l) (fmap f e)
instance Functor DataOrNew where
fmap f (DataType l) = DataType (f l)
fmap f (NewType l) = NewType (f l)
instance Functor DeclHead where
fmap f (DHead l n tvs) = DHead (f l) (fmap f n) (map (fmap f) tvs)
fmap f (DHInfix l tva n tvb) = DHInfix (f l) (fmap f tva) (fmap f n) (fmap f tvb)
fmap f (DHParen l dh) = DHParen (f l) (fmap f dh)
instance Functor InstHead where
fmap f (IHead l qn ts) = IHead (f l) (fmap f qn) (map (fmap f) ts)
fmap f (IHInfix l ta qn tb) = IHInfix (f l) (fmap f ta) (fmap f qn) (fmap f tb)
fmap f (IHParen l ih) = IHParen (f l) (fmap f ih)
instance Functor Deriving where
fmap f (Deriving l ihs) = Deriving (f l) (map (fmap f) ihs)
instance Functor Binds where
fmap f (BDecls l decls) = BDecls (f l) (map (fmap f) decls)
fmap f (IPBinds l ibs) = IPBinds (f l) (map (fmap f) ibs)
instance Functor IPBind where
fmap f (IPBind l ipn e) = IPBind (f l) (fmap f ipn) (fmap f e)
instance Functor Match where
fmap f (Match l n ps rhs bs) =
Match (f l) (fmap f n) (map (fmap f) ps) (fmap f rhs) (fmap (fmap f) bs)
fmap f (InfixMatch l a n ps rhs bs) =
InfixMatch (f l) (fmap f a) (fmap f n) (map (fmap f) ps) (fmap f rhs) (fmap (fmap f) bs)
instance Functor QualConDecl where
fmap f (QualConDecl l mtvs mcx cd) = QualConDecl (f l) (fmap (map (fmap f)) mtvs) (fmap (fmap f) mcx) (fmap f cd)
instance Functor ConDecl where
fmap f (ConDecl l n bts) = ConDecl (f l) (fmap f n) (map (fmap f) bts)
fmap f (InfixConDecl l ta n tb) = InfixConDecl (f l) (fmap f ta) (fmap f n) (fmap f tb)
fmap f (RecDecl l n fds) = RecDecl (f l) (fmap f n) (map (fmap f) fds)
instance Functor FieldDecl where
fmap f (FieldDecl l ns t) = FieldDecl (f l) (map (fmap f) ns) (fmap f t)
instance Functor GadtDecl where
fmap f (GadtDecl l n t) = GadtDecl (f l) (fmap f n) (fmap f t)
instance Functor ClassDecl where
fmap f (ClsDecl l d) = ClsDecl (f l) (fmap f d)
fmap f (ClsDataFam l mcx dh mk) = ClsDataFam (f l) (fmap (fmap f) mcx) (fmap f dh) (fmap (fmap f) mk)
fmap f (ClsTyFam l dh mk) = ClsTyFam (f l) (fmap f dh) (fmap (fmap f) mk)
fmap f (ClsTyDef l t1 t2) = ClsTyDef (f l) (fmap f t1) (fmap f t2)
instance Functor InstDecl where
fmap f id = case id of
InsDecl l d -> InsDecl (f l) (fmap f d)
InsType l t1 t2 -> InsType (f l) (fmap f t1) (fmap f t2)
InsData l dn t cds ders
-> InsData (f l) (fmap f dn) (fmap f t) (map (fmap f) cds) (fmap (fmap f) ders)
InsGData l dn t mk gds ders
-> InsGData (f l) (fmap f dn) (fmap f t) (fmap (fmap f) mk) (map (fmap f) gds) (fmap (fmap f) ders)
instance Functor BangType where
fmap f (BangedTy l t) = BangedTy (f l) (fmap f t)
fmap f (UnBangedTy l t) = UnBangedTy (f l) (fmap f t)
fmap f (UnpackedTy l t) = UnpackedTy (f l) (fmap f t)
instance Functor Rhs where
fmap f (UnGuardedRhs l e) = UnGuardedRhs (f l) (fmap f e)
fmap f (GuardedRhss l grhss) = GuardedRhss (f l) (map (fmap f) grhss)
instance Functor GuardedRhs where
fmap f (GuardedRhs l ss e) = GuardedRhs (f l) (map (fmap f) ss) (fmap f e)
instance Functor Type where
fmap f t = case t of
TyForall l mtvs mcx t -> TyForall (f l) (fmap (map (fmap f)) mtvs) (fmap (fmap f) mcx) (fmap f t)
TyFun l t1 t2 -> TyFun (f l) (fmap f t1) (fmap f t2)
TyTuple l b ts -> TyTuple (f l) b (map (fmap f) ts)
TyList l t -> TyList (f l) (fmap f t)
TyApp l t1 t2 -> TyApp (f l) (fmap f t1) (fmap f t2)
TyVar l n -> TyVar (f l) (fmap f n)
TyCon l qn -> TyCon (f l) (fmap f qn)
TyParen l t -> TyParen (f l) (fmap f t)
TyInfix l ta qn tb -> TyInfix (f l) (fmap f ta) (fmap f qn) (fmap f tb)
TyKind l t k -> TyKind (f l) (fmap f t) (fmap f k)
instance Functor TyVarBind where
fmap f (KindedVar l n k) = KindedVar (f l) (fmap f n) (fmap f k)
fmap f (UnkindedVar l n) = UnkindedVar (f l) (fmap f n)
instance Functor Kind where
fmap f (KindStar l) = KindStar (f l)
fmap f (KindBang l) = KindBang (f l)
fmap f (KindFn l k1 k2) = KindFn (f l) (fmap f k1) (fmap f k2)
fmap f (KindParen l k) = KindParen (f l) (fmap f k)
fmap f (KindVar l n) = KindVar (f l) (fmap f n)
instance Functor FunDep where
fmap f (FunDep l ns1 ns2) = FunDep (f l) (map (fmap f) ns1) (map (fmap f) ns2)
instance Functor Context where
fmap f (CxSingle l asst) = CxSingle (f l) (fmap f asst)
fmap f (CxTuple l assts) = CxTuple (f l) (map (fmap f) assts)
fmap f (CxParen l ctxt) = CxParen (f l) (fmap f ctxt)
fmap f (CxEmpty l) = CxEmpty (f l)
instance Functor Asst where
fmap f asst = case asst of
ClassA l qn ts -> ClassA (f l) (fmap f qn) (map (fmap f) ts)
InfixA l ta qn tb -> InfixA (f l) (fmap f ta) (fmap f qn) (fmap f tb)
IParam l ipn t -> IParam (f l) (fmap f ipn) (fmap f t)
EqualP l t1 t2 -> EqualP (f l) (fmap f t1) (fmap f t2)
instance Functor Literal where
fmap f lit = case lit of
Char l c rw -> Char (f l) c rw
String l s rw -> String (f l) s rw
Int l i rw -> Int (f l) i rw
Frac l r rw -> Frac (f l) r rw
PrimInt l i rw -> PrimInt (f l) i rw
PrimWord l i rw -> PrimWord (f l) i rw
PrimFloat l r rw -> PrimFloat (f l) r rw
PrimDouble l r rw -> PrimDouble (f l) r rw
PrimChar l c rw -> PrimChar (f l) c rw
PrimString l s rw -> PrimString (f l) s rw
instance Functor Exp where
fmap f e = case e of
Var l qn -> Var (f l) (fmap f qn)
IPVar l ipn -> IPVar (f l) (fmap f ipn)
Con l qn -> Con (f l) (fmap f qn)
Lit l lit -> Lit (f l) (fmap f lit)
InfixApp l e1 qop e2 -> InfixApp (f l) (fmap f e1) (fmap f qop) (fmap f e2)
App l e1 e2 -> App (f l) (fmap f e1) (fmap f e2)
NegApp l e -> NegApp (f l) (fmap f e)
Lambda l ps e -> Lambda (f l) (map (fmap f) ps) (fmap f e)
Let l bs e -> Let (f l) (fmap f bs) (fmap f e)
If l ec et ee -> If (f l) (fmap f ec) (fmap f et) (fmap f ee)
Case l e alts -> Case (f l) (fmap f e) (map (fmap f) alts)
Do l ss -> Do (f l) (map (fmap f) ss)
MDo l ss -> MDo (f l) (map (fmap f) ss)
Tuple l bx es -> Tuple (f l) bx (map (fmap f) es)
TupleSection l bx mes -> TupleSection (f l) bx (map (fmap (fmap f)) mes)
List l es -> List (f l) (map (fmap f) es)
Paren l e -> Paren (f l) (fmap f e)
LeftSection l e qop -> LeftSection (f l) (fmap f e) (fmap f qop)
RightSection l qop e -> RightSection (f l) (fmap f qop) (fmap f e)
RecConstr l qn fups -> RecConstr (f l) (fmap f qn) (map (fmap f) fups)
RecUpdate l e fups -> RecUpdate (f l) (fmap f e) (map (fmap f) fups)
EnumFrom l e -> EnumFrom (f l) (fmap f e)
EnumFromTo l ef et -> EnumFromTo (f l) (fmap f ef) (fmap f et)
EnumFromThen l ef et -> EnumFromThen (f l) (fmap f ef) (fmap f et)
EnumFromThenTo l ef eth eto -> EnumFromThenTo (f l) (fmap f ef) (fmap f eth) (fmap f eto)
ListComp l e qss -> ListComp (f l) (fmap f e) (map (fmap f) qss)
ParComp l e qsss -> ParComp (f l) (fmap f e) (map (map (fmap f)) qsss)
ExpTypeSig l e t -> ExpTypeSig (f l) (fmap f e) (fmap f t)
VarQuote l qn -> VarQuote (f l) (fmap f qn)
TypQuote l qn -> TypQuote (f l) (fmap f qn)
BracketExp l br -> BracketExp (f l) (fmap f br)
SpliceExp l sp -> SpliceExp (f l) (fmap f sp)
QuasiQuote l sn se -> QuasiQuote (f l) sn se
XTag l xn xas me es -> XTag (f l) (fmap f xn) (map (fmap f) xas) (fmap (fmap f) me) (map (fmap f) es)
XETag l xn xas me -> XETag (f l) (fmap f xn) (map (fmap f) xas) (fmap (fmap f) me)
XPcdata l s -> XPcdata (f l) s
XExpTag l e -> XExpTag (f l) (fmap f e)
XChildTag l es -> XChildTag (f l) (map (fmap f) es)
CorePragma l s e -> CorePragma (f l) s (fmap f e)
SCCPragma l s e -> SCCPragma (f l) s (fmap f e)
GenPragma l s n12 n34 e -> GenPragma (f l) s n12 n34 (fmap f e)
Proc l p e -> Proc (f l) (fmap f p) (fmap f e)
LeftArrApp l e1 e2 -> LeftArrApp (f l) (fmap f e1) (fmap f e2)
RightArrApp l e1 e2 -> RightArrApp (f l) (fmap f e1) (fmap f e2)
LeftArrHighApp l e1 e2 -> LeftArrHighApp (f l) (fmap f e1) (fmap f e2)
RightArrHighApp l e1 e2 -> RightArrHighApp (f l) (fmap f e1) (fmap f e2)
instance Functor XName where
fmap f (XName l s) = XName (f l) s
fmap f (XDomName l sd sn) = XDomName (f l) sd sn
instance Functor XAttr where
fmap f (XAttr l xn e) = XAttr (f l) (fmap f xn) (fmap f e)
instance Functor Bracket where
fmap f (ExpBracket l e) = ExpBracket (f l) (fmap f e)
fmap f (PatBracket l p) = PatBracket (f l) (fmap f p)
fmap f (TypeBracket l t) = TypeBracket (f l) (fmap f t)
fmap f (DeclBracket l ds) = DeclBracket (f l) (map (fmap f) ds)
instance Functor Splice where
fmap f (IdSplice l s) = IdSplice (f l) s
fmap f (ParenSplice l e) = ParenSplice (f l) (fmap f e)
instance Functor Safety where
fmap f (PlayRisky l) = PlayRisky (f l)
fmap f (PlaySafe l b) = PlaySafe (f l) b
fmap f (PlayInterruptible l) = PlayInterruptible (f l)
instance Functor CallConv where
fmap f (StdCall l) = StdCall (f l)
fmap f (CCall l) = CCall (f l)
fmap f (CPlusPlus l) = CPlusPlus (f l)
fmap f (DotNet l) = DotNet (f l)
fmap f (Jvm l) = Jvm (f l)
fmap f (Js l) = Js (f l)
fmap f (CApi l) = CApi (f l)
instance Functor ModulePragma where
fmap f (LanguagePragma l ns) = LanguagePragma (f l) (map (fmap f) ns)
fmap f (OptionsPragma l mt s) = OptionsPragma (f l) mt s
fmap f (AnnModulePragma l ann) = AnnModulePragma (f l) (fmap f ann)
instance Functor Activation where
fmap f (ActiveFrom l k) = ActiveFrom (f l) k
fmap f (ActiveUntil l k) = ActiveUntil (f l) k
instance Functor Rule where
fmap f (Rule l s mact mrvs e1 e2) =
Rule (f l) s (fmap (fmap f) mact) (fmap (map (fmap f)) mrvs) (fmap f e1) (fmap f e2)
instance Functor RuleVar where
fmap f (RuleVar l n) = RuleVar (f l) (fmap f n)
fmap f (TypedRuleVar l n t) = TypedRuleVar (f l) (fmap f n) (fmap f t)
instance Functor WarningText where
fmap f (DeprText l s) = DeprText (f l) s
fmap f (WarnText l s) = WarnText (f l) s
instance Functor Pat where
fmap f p = case p of
PVar l n -> PVar (f l) (fmap f n)
PLit l lit -> PLit (f l) (fmap f lit)
PNeg l p -> PNeg (f l) (fmap f p)
PNPlusK l n k -> PNPlusK (f l) (fmap f n) k
PInfixApp l pa qn pb -> PInfixApp (f l) (fmap f pa) (fmap f qn) (fmap f pb)
PApp l qn ps -> PApp (f l) (fmap f qn) (map (fmap f) ps)
PTuple l bx ps -> PTuple (f l) bx (map (fmap f) ps)
PList l ps -> PList (f l) (map (fmap f) ps)
PParen l p -> PParen (f l) (fmap f p)
PRec l qn pfs -> PRec (f l) (fmap f qn) (map (fmap f) pfs)
PAsPat l n p -> PAsPat (f l) (fmap f n) (fmap f p)
PWildCard l -> PWildCard (f l)
PIrrPat l p -> PIrrPat (f l) (fmap f p)
PatTypeSig l p t -> PatTypeSig (f l) (fmap f p) (fmap f t)
PViewPat l e p -> PViewPat (f l) (fmap f e) (fmap f p)
PRPat l rps -> PRPat (f l) (map (fmap f) rps)
PXTag l xn pxas mp ps -> PXTag (f l) (fmap f xn) (map (fmap f) pxas) (fmap (fmap f) mp) (map (fmap f) ps)
PXETag l xn pxas mp -> PXETag (f l) (fmap f xn) (map (fmap f) pxas) (fmap (fmap f) mp)
PXPcdata l s -> PXPcdata (f l) s
PXPatTag l p -> PXPatTag (f l) (fmap f p)
PXRPats l rps -> PXRPats (f l) (map (fmap f) rps)
PExplTypeArg l qn t -> PExplTypeArg (f l) (fmap f qn) (fmap f t)
PQuasiQuote l sn st -> PQuasiQuote (f l) sn st
PBangPat l p -> PBangPat (f l) (fmap f p)
instance Functor PXAttr where
fmap f (PXAttr l xn p) = PXAttr (f l) (fmap f xn) (fmap f p)
instance Functor RPatOp where
fmap f (RPStar l) = RPStar (f l)
fmap f (RPStarG l) = RPStarG (f l)
fmap f (RPPlus l) = RPPlus (f l)
fmap f (RPPlusG l) = RPPlusG (f l)
fmap f (RPOpt l) = RPOpt (f l)
fmap f (RPOptG l) = RPOptG (f l)
instance Functor RPat where
fmap f rp = case rp of
RPOp l rp rop -> RPOp (f l) (fmap f rp) (fmap f rop)
RPEither l rp1 rp2 -> RPEither (f l) (fmap f rp1) (fmap f rp2)
RPSeq l rps -> RPSeq (f l) (map (fmap f) rps)
RPGuard l p ss -> RPGuard (f l) (fmap f p) (map (fmap f) ss)
RPCAs l n rp -> RPCAs (f l) (fmap f n) (fmap f rp)
RPAs l n rp -> RPAs (f l) (fmap f n) (fmap f rp)
RPParen l rp -> RPParen (f l) (fmap f rp)
RPPat l p -> RPPat (f l) (fmap f p)
instance Functor PatField where
fmap f (PFieldPat l qn p) = PFieldPat (f l) (fmap f qn) (fmap f p)
fmap f (PFieldPun l n) = PFieldPun (f l) (fmap f n)
fmap f (PFieldWildcard l) = PFieldWildcard (f l)
instance Functor Stmt where
fmap f (Generator l p e) = Generator (f l) (fmap f p) (fmap f e)
fmap f (Qualifier l e) = Qualifier (f l) (fmap f e)
fmap f (LetStmt l bs) = LetStmt (f l) (fmap f bs)
fmap f (RecStmt l ss) = RecStmt (f l) (map (fmap f) ss)
instance Functor QualStmt where
fmap f (QualStmt l s) = QualStmt (f l) (fmap f s)
fmap f (ThenTrans l e) = ThenTrans (f l) (fmap f e)
fmap f (ThenBy l e1 e2) = ThenBy (f l) (fmap f e1) (fmap f e2)
fmap f (GroupBy l e) = GroupBy (f l) (fmap f e)
fmap f (GroupUsing l e) = GroupUsing (f l) (fmap f e)
fmap f (GroupByUsing l e1 e2) = GroupByUsing (f l) (fmap f e1) (fmap f e2)
instance Functor FieldUpdate where
fmap f (FieldUpdate l qn e) = FieldUpdate (f l) (fmap f qn) (fmap f e)
fmap f (FieldPun l n) = FieldPun (f l) (fmap f n)
fmap f (FieldWildcard l) = FieldWildcard (f l)
instance Functor Alt where
fmap f (Alt l p gs bs) = Alt (f l) (fmap f p) (fmap f gs) (fmap (fmap f) bs)
instance Functor GuardedAlts where
fmap f (UnGuardedAlt l e) = UnGuardedAlt (f l) (fmap f e)
fmap f (GuardedAlts l galts) = GuardedAlts (f l) (map (fmap f) galts)
instance Functor GuardedAlt where
fmap f (GuardedAlt l ss e) = GuardedAlt (f l) (map (fmap f) ss) (fmap f e)
class Functor ast => Annotated ast where
ann :: ast l -> l
amap :: (l -> l) -> ast l -> ast l
instance Annotated ModuleName where
ann (ModuleName l _) = l
amap f (ModuleName l n) = ModuleName (f l) n
instance Annotated SpecialCon where
ann sc = case sc of
UnitCon l -> l
ListCon l -> l
FunCon l -> l
TupleCon l _ _ -> l
Cons l -> l
UnboxedSingleCon l -> l
amap = fmap
instance Annotated QName where
ann qn = case qn of
Qual l mn n -> l
UnQual l n -> l
Special l sc -> l
amap f qn = case qn of
Qual l mn n -> Qual (f l) mn n
UnQual l n -> UnQual (f l) n
Special l sc -> Special (f l) sc
instance Annotated Name where
ann (Ident l s) = l
ann (Symbol l s) = l
amap = fmap
instance Annotated IPName where
ann (IPDup l s) = l
ann (IPLin l s) = l
amap = fmap
instance Annotated QOp where
ann (QVarOp l qn) = l
ann (QConOp l qn) = l
amap f (QVarOp l qn) = QVarOp (f l) qn
amap f (QConOp l qn) = QConOp (f l) qn
instance Annotated Op where
ann (VarOp l n) = l
ann (ConOp l n) = l
amap f (VarOp l n) = VarOp (f l) n
amap f (ConOp l n) = ConOp (f l) n
instance Annotated CName where
ann (VarName l n) = l
ann (ConName l n) = l
amap f (VarName l n) = VarName (f l) n
amap f (ConName l n) = ConName (f l) n
instance Annotated Module where
ann (Module l mmh ops iss dcls) = l
ann (XmlPage l mn os xn xas me es) = l
ann (XmlHybrid l mmh ops iss dcls xn xas me es) = l
amap f (Module l mmh ops iss dcls) =
Module (f l) mmh ops iss dcls
amap f (XmlPage l mn os xn xas me es) =
XmlPage (f l) mn os xn xas me es
amap f (XmlHybrid l mmh ops iss dcls xn xas me es) =
XmlHybrid (f l) mmh ops iss dcls xn xas me es
instance Annotated ModuleHead where
ann (ModuleHead l n mwt mesl) = l
amap f (ModuleHead l n mwt mesl) = ModuleHead (f l) n mwt mesl
instance Annotated ExportSpecList where
ann (ExportSpecList l ess) = l
amap f (ExportSpecList l ess) = ExportSpecList (f l) ess
instance Annotated ExportSpec where
ann es = case es of
EVar l qn -> l
EAbs l qn -> l
EThingAll l qn -> l
EThingWith l qn cns -> l
EModuleContents l mn -> l
amap f es = case es of
EVar l qn -> EVar (f l) qn
EAbs l qn -> EAbs (f l) qn
EThingAll l qn -> EThingAll (f l) qn
EThingWith l qn cns -> EThingWith (f l) qn cns
EModuleContents l mn -> EModuleContents (f l) mn
instance Annotated ImportDecl where
ann (ImportDecl l mn qual src pkg mmn mis) = l
amap f (ImportDecl l mn qual src pkg mmn mis) =
ImportDecl (f l) mn qual src pkg mmn mis
instance Annotated ImportSpecList where
ann (ImportSpecList l b iss) = l
amap f (ImportSpecList l b iss) = ImportSpecList (f l) b iss
instance Annotated ImportSpec where
ann is = case is of
IVar l n -> l
IAbs l n -> l
IThingAll l n -> l
IThingWith l n cns -> l
amap f is = case is of
IVar l n -> IVar (f l) n
IAbs l n -> IAbs (f l) n
IThingAll l n -> IThingAll (f l) n
IThingWith l n cns -> IThingWith (f l) n cns
instance Annotated Assoc where
ann (AssocNone l) = l
ann (AssocLeft l) = l
ann (AssocRight l) = l
amap = fmap
instance Annotated Deriving where
ann (Deriving l ihs) = l
amap f (Deriving l ihs) = Deriving (f l) ihs
instance Annotated Decl where
ann decl = case decl of
TypeDecl l dh t -> l
TypeFamDecl l dh mk -> l
DataDecl l dn cx dh cds ders -> l
GDataDecl l dn cx dh mk gds ders -> l
DataFamDecl l cx dh mk -> l
TypeInsDecl l t1 t2 -> l
DataInsDecl l dn t cds ders -> l
GDataInsDecl l dn t mk gds ders -> l
ClassDecl l cx dh fds cds -> l
InstDecl l cx ih ids -> l
DerivDecl l cx ih -> l
InfixDecl l a k ops -> l
DefaultDecl l ts -> l
SpliceDecl l sp -> l
TypeSig l ns t -> l
FunBind l ms -> l
PatBind l p mt rhs bs -> l
ForImp l cc msf s n t -> l
ForExp l cc s n t -> l
RulePragmaDecl l rs -> l
DeprPragmaDecl l nss -> l
WarnPragmaDecl l nss -> l
InlineSig l b act qn -> l
InlineConlikeSig l act qn -> l
SpecSig l act qn ts -> l
SpecInlineSig l b act qn ts -> l
InstSig l cx ih -> l
AnnPragma l ann -> l
amap f decl = case decl of
TypeDecl l dh t -> TypeDecl (f l) dh t
TypeFamDecl l dh mk -> TypeFamDecl (f l) dh mk
DataDecl l dn mcx dh cds ders ->
DataDecl (f l) dn mcx dh cds ders
GDataDecl l dn mcx dh mk gds ders ->
GDataDecl (f l) dn mcx dh mk gds ders
DataFamDecl l mcx dh mk -> DataFamDecl (f l) mcx dh mk
TypeInsDecl l t1 t2 -> TypeInsDecl (f l) t1 t2
DataInsDecl l dn t cds ders -> DataInsDecl (f l) dn t cds ders
GDataInsDecl l dn t mk gds ders -> GDataInsDecl (f l) dn t mk gds ders
ClassDecl l mcx dh fds cds -> ClassDecl (f l) mcx dh fds cds
InstDecl l mcx ih ids -> InstDecl (f l) mcx ih ids
DerivDecl l mcx ih -> DerivDecl (f l) mcx ih
InfixDecl l a k ops -> InfixDecl (f l) a k ops
DefaultDecl l ts -> DefaultDecl (f l) ts
SpliceDecl l sp -> SpliceDecl (f l) sp
TypeSig l ns t -> TypeSig (f l) ns t
FunBind l ms -> FunBind (f l) ms
PatBind l p mt rhs bs -> PatBind (f l) p mt rhs bs
ForImp l cc msf s n t -> ForImp (f l) cc msf s n t
ForExp l cc s n t -> ForExp (f l) cc s n t
RulePragmaDecl l rs -> RulePragmaDecl (f l) rs
DeprPragmaDecl l nss -> DeprPragmaDecl (f l) nss
WarnPragmaDecl l nss -> WarnPragmaDecl (f l) nss
InlineSig l b act qn -> InlineSig (f l) b act qn
InlineConlikeSig l act qn -> InlineConlikeSig (f l) act qn
SpecSig l act qn ts -> SpecSig (f l) act qn ts
SpecInlineSig l b act qn ts -> SpecInlineSig (f l) b act qn ts
InstSig l mcx ih -> InstSig (f l) mcx ih
AnnPragma l ann -> AnnPragma (f l) ann
instance Annotated Annotation where
ann (Ann l n e) = l
ann (TypeAnn l n e) = l
ann (ModuleAnn l e) = l
amap f (Ann l n e) = Ann (f l) n e
amap f (TypeAnn l n e) = TypeAnn (f l) n e
amap f (ModuleAnn l e) = ModuleAnn (f l) e
instance Annotated DataOrNew where
ann (DataType l) = l
ann (NewType l) = l
amap = fmap
instance Annotated DeclHead where
ann (DHead l n tvs) = l
ann (DHInfix l tva n tvb) = l
ann (DHParen l dh) = l
amap f (DHead l n tvs) = DHead (f l) n tvs
amap f (DHInfix l tva n tvb) = DHInfix (f l) tva n tvb
amap f (DHParen l dh) = DHParen (f l) dh
instance Annotated InstHead where
ann (IHead l qn ts) = l
ann (IHInfix l ta qn tb) = l
ann (IHParen l ih) = l
amap f (IHead l qn ts) = IHead (f l) qn ts
amap f (IHInfix l ta qn tb) = IHInfix (f l) ta qn tb
amap f (IHParen l ih) = IHParen (f l) ih
instance Annotated Binds where
ann (BDecls l decls) = l
ann (IPBinds l ibs) = l
amap f (BDecls l decls) = BDecls (f l) decls
amap f (IPBinds l ibs) = IPBinds (f l) ibs
instance Annotated IPBind where
ann (IPBind l ipn e) = l
amap f (IPBind l ipn e) = IPBind (f l) ipn e
instance Annotated Match where
ann (Match l n ps rhs bs) = l
ann (InfixMatch l a n b rhs bs) = l
amap f (Match l n ps rhs bs) = Match (f l) n ps rhs bs
amap f (InfixMatch l a n b rhs bs) = InfixMatch (f l) a n b rhs bs
instance Annotated QualConDecl where
ann (QualConDecl l tvs cx cd) = l
amap f (QualConDecl l tvs cx cd) = QualConDecl (f l) tvs cx cd
instance Annotated ConDecl where
ann (ConDecl l n bts) = l
ann (InfixConDecl l ta n tb) = l
ann (RecDecl l n nsbts) = l
amap f (ConDecl l n bts) = ConDecl (f l) n bts
amap f (InfixConDecl l ta n tb) = InfixConDecl (f l) ta n tb
amap f (RecDecl l n fds) = RecDecl (f l) n fds
instance Annotated FieldDecl where
ann (FieldDecl l ns t) = l
amap f (FieldDecl l ns t) = FieldDecl (f l) ns t
instance Annotated GadtDecl where
ann (GadtDecl l n t) = l
amap f (GadtDecl l n t) = GadtDecl (f l) n t
instance Annotated ClassDecl where
ann (ClsDecl l d) = l
ann (ClsDataFam l cx dh mk) = l
ann (ClsTyFam l dh mk) = l
ann (ClsTyDef l t1 t2) = l
amap f (ClsDecl l d) = ClsDecl (f l) d
amap f (ClsDataFam l mcx dh mk) = ClsDataFam (f l) mcx dh mk
amap f (ClsTyFam l dh mk) = ClsTyFam (f l) dh mk
amap f (ClsTyDef l t1 t2) = ClsTyDef (f l) t1 t2
instance Annotated InstDecl where
ann id = case id of
InsDecl l d -> l
InsType l t1 t2 -> l
InsData l dn t cds ders -> l
InsGData l dn t mk gds ders -> l
amap f id = case id of
InsDecl l d -> InsDecl (f l) d
InsType l t1 t2 -> InsType (f l) t1 t2
InsData l dn t cds ders -> InsData (f l) dn t cds ders
InsGData l dn t mk gds ders -> InsGData (f l) dn t mk gds ders
instance Annotated BangType where
ann (BangedTy l t) = l
ann (UnBangedTy l t) = l
ann (UnpackedTy l t) = l
amap f (BangedTy l t) = BangedTy (f l) t
amap f (UnBangedTy l t) = UnBangedTy (f l) t
amap f (UnpackedTy l t) = UnpackedTy (f l) t
instance Annotated Rhs where
ann (UnGuardedRhs l e) = l
ann (GuardedRhss l grhss) = l
amap f (UnGuardedRhs l e) = UnGuardedRhs (f l) e
amap f (GuardedRhss l grhss) = GuardedRhss (f l) grhss
instance Annotated GuardedRhs where
ann (GuardedRhs l ss e) = l
amap f (GuardedRhs l ss e) = GuardedRhs (f l) ss e
instance Annotated Type where
ann t = case t of
TyForall l mtvs cx t -> l
TyFun l t1 t2 -> l
TyTuple l b ts -> l
TyList l t -> l
TyApp l t1 t2 -> l
TyVar l n -> l
TyCon l qn -> l
TyParen l t -> l
TyInfix l ta qn tb -> l
TyKind l t k -> l
amap f t = case t of
TyForall l mtvs mcx t -> TyForall (f l) mtvs mcx t
TyFun l t1 t2 -> TyFun (f l) t1 t2
TyTuple l b ts -> TyTuple (f l) b ts
TyList l t -> TyList (f l) t
TyApp l t1 t2 -> TyApp (f l) t1 t2
TyVar l n -> TyVar (f l) n
TyCon l qn -> TyCon (f l) qn
TyParen l t -> TyParen (f l) t
TyInfix l ta qn tb -> TyInfix (f l) ta qn tb
TyKind l t k -> TyKind (f l) t k
instance Annotated TyVarBind where
ann (KindedVar l n k) = l
ann (UnkindedVar l n) = l
amap f (KindedVar l n k) = KindedVar (f l) n k
amap f (UnkindedVar l n) = UnkindedVar (f l) n
instance Annotated Kind where
ann (KindStar l) = l
ann (KindBang l) = l
ann (KindFn l k1 k2) = l
ann (KindParen l k) = l
ann (KindVar l v) = l
amap f (KindStar l) = KindStar (f l)
amap f (KindBang l) = KindBang (f l)
amap f (KindFn l k1 k2) = KindFn (f l) k1 k2
amap f (KindParen l k) = KindParen (f l) k
amap f (KindVar l n) = KindVar (f l) n
instance Annotated FunDep where
ann (FunDep l ns1 ns2) = l
amap f (FunDep l ns1 ns2) = FunDep (f l) ns1 ns2
instance Annotated Context where
ann (CxSingle l asst ) = l
ann (CxTuple l assts) = l
ann (CxParen l ctxt ) = l
ann (CxEmpty l) = l
amap f (CxSingle l asst ) = CxSingle (f l) asst
amap f (CxTuple l assts) = CxTuple (f l) assts
amap f (CxParen l ctxt ) = CxParen (f l) ctxt
amap f (CxEmpty l) = CxEmpty (f l)
instance Annotated Asst where
ann asst = case asst of
ClassA l qn ts -> l
InfixA l ta qn tb -> l
IParam l ipn t -> l
EqualP l t1 t2 -> l
amap f asst = case asst of
ClassA l qn ts -> ClassA (f l) qn ts
InfixA l ta qn tb -> InfixA (f l) ta qn tb
IParam l ipn t -> IParam (f l) ipn t
EqualP l t1 t2 -> EqualP (f l) t1 t2
instance Annotated Literal where
ann lit = case lit of
Char l c rw -> l
String l s rw -> l
Int l i rw -> l
Frac l r rw -> l
PrimInt l i rw -> l
PrimWord l i rw -> l
PrimFloat l r rw -> l
PrimDouble l r rw -> l
PrimChar l c rw -> l
PrimString l s rw -> l
amap = fmap
instance Annotated Exp where
ann e = case e of
Var l qn -> l
IPVar l ipn -> l
Con l qn -> l
Lit l lit -> l
InfixApp l e1 qop e2 -> l
App l e1 e2 -> l
NegApp l e -> l
Lambda l ps e -> l
Let l bs e -> l
If l ec et ee -> l
Case l e alts -> l
Do l ss -> l
MDo l ss -> l
Tuple l bx es -> l
TupleSection l bx mes -> l
List l es -> l
Paren l e -> l
LeftSection l e qop -> l
RightSection l qop e -> l
RecConstr l qn fups -> l
RecUpdate l e fups -> l
EnumFrom l e -> l
EnumFromTo l ef et -> l
EnumFromThen l ef et -> l
EnumFromThenTo l ef eth eto -> l
ListComp l e qss -> l
ParComp l e qsss -> l
ExpTypeSig l e t -> l
VarQuote l qn -> l
TypQuote l qn -> l
BracketExp l br -> l
SpliceExp l sp -> l
QuasiQuote l sn se -> l
XTag l xn xas me es -> l
XETag l xn xas me -> l
XPcdata l s -> l
XExpTag l e -> l
XChildTag l es -> l
CorePragma l s e -> l
SCCPragma l s e -> l
GenPragma l s n12 n34 e -> l
Proc l p e -> l
LeftArrApp l e1 e2 -> l
RightArrApp l e1 e2 -> l
LeftArrHighApp l e1 e2 -> l
RightArrHighApp l e1 e2 -> l
amap f e = case e of
Var l qn -> Var (f l) qn
IPVar l ipn -> IPVar (f l) ipn
Con l qn -> Con (f l) qn
Lit l lit -> Lit (f l) lit
InfixApp l e1 qop e2 -> InfixApp (f l) e1 qop e2
App l e1 e2 -> App (f l) e1 e2
NegApp l e -> NegApp (f l) e
Lambda l ps e -> Lambda (f l) ps e
Let l bs e -> Let (f l) bs e
If l ec et ee -> If (f l) ec et ee
Case l e alts -> Case (f l) e alts
Do l ss -> Do (f l) ss
MDo l ss -> MDo (f l) ss
Tuple l bx es -> Tuple (f l) bx es
TupleSection l bx mes -> TupleSection (f l) bx mes
List l es -> List (f l) es
Paren l e -> Paren (f l) e
LeftSection l e qop -> LeftSection (f l) e qop
RightSection l qop e -> RightSection (f l) qop e
RecConstr l qn fups -> RecConstr (f l) qn fups
RecUpdate l e fups -> RecUpdate (f l) e fups
EnumFrom l e -> EnumFrom (f l) e
EnumFromTo l ef et -> EnumFromTo (f l) ef et
EnumFromThen l ef et -> EnumFromThen (f l) ef et
EnumFromThenTo l ef eth eto -> EnumFromThenTo (f l) ef eth eto
ListComp l e qss -> ListComp (f l) e qss
ParComp l e qsss -> ParComp (f l) e qsss
ExpTypeSig l e t -> ExpTypeSig (f l) e t
VarQuote l qn -> VarQuote (f l) qn
TypQuote l qn -> TypQuote (f l) qn
BracketExp l br -> BracketExp (f l) br
SpliceExp l sp -> SpliceExp (f l) sp
QuasiQuote l sn se -> QuasiQuote (f l) sn se
XTag l xn xas me es -> XTag (f l) xn xas me es
XETag l xn xas me -> XETag (f l) xn xas me
XPcdata l s -> XPcdata (f l) s
XExpTag l e -> XExpTag (f l) e
XChildTag l es -> XChildTag (f l) es
CorePragma l s e -> CorePragma (f l) s e
SCCPragma l s e -> SCCPragma (f l) s e
GenPragma l s n12 n34 e -> GenPragma (f l) s n12 n34 e
Proc l p e -> Proc (f l) p e
LeftArrApp l e1 e2 -> LeftArrApp (f l) e1 e2
RightArrApp l e1 e2 -> RightArrApp (f l) e1 e2
LeftArrHighApp l e1 e2 -> LeftArrHighApp (f l) e1 e2
RightArrHighApp l e1 e2 -> RightArrHighApp (f l) e1 e2
instance Annotated XName where
ann (XName l s) = l
ann (XDomName l sd sn) = l
amap = fmap
instance Annotated XAttr where
ann (XAttr l xn e) = l
amap f (XAttr l xn e) = XAttr (f l) xn e
instance Annotated Bracket where
ann (ExpBracket l e) = l
ann (PatBracket l p) = l
ann (TypeBracket l t) = l
ann (DeclBracket l ds) = l
amap f (ExpBracket l e) = ExpBracket (f l) e
amap f (PatBracket l p) = PatBracket (f l) p
amap f (TypeBracket l t) = TypeBracket (f l) t
amap f (DeclBracket l ds) = DeclBracket (f l) ds
instance Annotated Splice where
ann (IdSplice l s) = l
ann (ParenSplice l e) = l
amap f (IdSplice l s) = IdSplice (f l) s
amap f (ParenSplice l e) = ParenSplice (f l) e
instance Annotated Safety where
ann (PlayRisky l) = l
ann (PlaySafe l b) = l
ann (PlayInterruptible l) = l
amap = fmap
instance Annotated CallConv where
ann (StdCall l) = l
ann (CCall l) = l
ann (CPlusPlus l) = l
ann (DotNet l) = l
ann (Jvm l) = l
ann (Js l) = l
ann (CApi l) = l
amap = fmap
instance Annotated ModulePragma where
ann (LanguagePragma l ns) = l
ann (OptionsPragma l mt s) = l
ann (AnnModulePragma l a) = l
amap f (LanguagePragma l ns) = LanguagePragma (f l) ns
amap f (AnnModulePragma l a) = AnnModulePragma (f l) a
amap f p = fmap f p
instance Annotated Activation where
ann (ActiveFrom l k) = l
ann (ActiveUntil l k) = l
amap = fmap
instance Annotated Rule where
ann (Rule l s act mrvs e1 e2) = l
amap f (Rule l s act mrvs e1 e2) = Rule (f l) s act mrvs e1 e2
instance Annotated RuleVar where
ann (RuleVar l n) = l
ann (TypedRuleVar l n t) = l
amap f (RuleVar l n) = RuleVar (f l) n
amap f (TypedRuleVar l n t) = TypedRuleVar (f l) n t
instance Annotated WarningText where
ann (DeprText l s) = l
ann (WarnText l s) = l
amap = fmap
instance Annotated Pat where
ann p = case p of
PVar l n -> l
PLit l lit -> l
PNeg l p -> l
PNPlusK l n k -> l
PInfixApp l pa qn pb -> l
PApp l qn ps -> l
PTuple l bx ps -> l
PList l ps -> l
PParen l p -> l
PRec l qn pfs -> l
PAsPat l n p -> l
PWildCard l -> l
PIrrPat l p -> l
PatTypeSig l p t -> l
PViewPat l e p -> l
PRPat l rps -> l
PXTag l xn pxas mp ps -> l
PXETag l xn pxas mp -> l
PXPcdata l s -> l
PXPatTag l p -> l
PXRPats l rps -> l
PExplTypeArg l qn t -> l
PQuasiQuote l sn st -> l
PBangPat l p -> l
amap f p = case p of
PVar l n -> PVar (f l) n
PLit l lit -> PLit (f l) lit
PNeg l p -> PNeg (f l) p
PNPlusK l n k -> PNPlusK (f l) n k
PInfixApp l pa qn pb -> PInfixApp (f l) pa qn pb
PApp l qn ps -> PApp (f l) qn ps
PTuple l bx ps -> PTuple (f l) bx ps
PList l ps -> PList (f l) ps
PParen l p -> PParen (f l) p
PRec l qn pfs -> PRec (f l) qn pfs
PAsPat l n p -> PAsPat (f l) n p
PWildCard l -> PWildCard (f l)
PIrrPat l p -> PIrrPat (f l) p
PatTypeSig l p t -> PatTypeSig (f l) p t
PViewPat l e p -> PViewPat (f l) e p
PRPat l rps -> PRPat (f l) rps
PXTag l xn pxas mp ps -> PXTag (f l) xn pxas mp ps
PXETag l xn pxas mp -> PXETag (f l) xn pxas mp
PXPcdata l s -> PXPcdata (f l) s
PXPatTag l p -> PXPatTag (f l) p
PXRPats l rps -> PXRPats (f l) rps
PExplTypeArg l qn t -> PExplTypeArg (f l) qn t
PQuasiQuote l sn st -> PQuasiQuote (f l) sn st
PBangPat l p -> PBangPat (f l) p
instance Annotated PXAttr where
ann (PXAttr l xn p) = l
amap f (PXAttr l xn p) = PXAttr (f l) xn p
instance Annotated RPatOp where
ann (RPStar l) = l
ann (RPStarG l) = l
ann (RPPlus l) = l
ann (RPPlusG l) = l
ann (RPOpt l) = l
ann (RPOptG l) = l
amap = fmap
instance Annotated RPat where
ann rp = case rp of
RPOp l rp rop -> l
RPEither l rp1 rp2 -> l
RPSeq l rps -> l
RPGuard l p ss -> l
RPCAs l n rp -> l
RPAs l n rp -> l
RPParen l rp -> l
RPPat l p -> l
amap f rp = case rp of
RPOp l rp rop -> RPOp (f l) rp rop
RPEither l rp1 rp2 -> RPEither (f l) rp1 rp2
RPSeq l rps -> RPSeq (f l) rps
RPGuard l p ss -> RPGuard (f l) p ss
RPCAs l n rp -> RPCAs (f l) n rp
RPAs l n rp -> RPAs (f l) n rp
RPParen l rp -> RPParen (f l) rp
RPPat l p -> RPPat (f l) p
instance Annotated PatField where
ann (PFieldPat l qn p) = l
ann (PFieldPun l n) = l
ann (PFieldWildcard l) = l
amap f (PFieldPat l qn p) = PFieldPat (f l) qn p
amap f (PFieldPun l n) = PFieldPun (f l) n
amap f (PFieldWildcard l) = PFieldWildcard (f l)
instance Annotated Stmt where
ann (Generator l p e) = l
ann (Qualifier l e) = l
ann (LetStmt l bs) = l
ann (RecStmt l ss) = l
amap f (Generator l p e) = Generator (f l) p e
amap f (Qualifier l e) = Qualifier (f l) e
amap f (LetStmt l bs) = LetStmt (f l) bs
amap f (RecStmt l ss) = RecStmt (f l) ss
instance Annotated QualStmt where
ann (QualStmt l s) = l
ann (ThenTrans l e) = l
ann (ThenBy l e1 e2) = l
ann (GroupBy l e) = l
ann (GroupUsing l e) = l
ann (GroupByUsing l e1 e2) = l
amap f (QualStmt l s) = QualStmt (f l) s
amap f (ThenTrans l e) = ThenTrans (f l) e
amap f (ThenBy l e1 e2) = ThenBy (f l) e1 e2
amap f (GroupBy l e) = GroupBy (f l) e
amap f (GroupUsing l e) = GroupUsing (f l) e
amap f (GroupByUsing l e1 e2) = GroupByUsing (f l) e1 e2
instance Annotated FieldUpdate where
ann (FieldUpdate l qn e) = l
ann (FieldPun l n) = l
ann (FieldWildcard l) = l
amap f (FieldUpdate l qn e) = FieldUpdate (f l) qn e
amap f (FieldPun l n) = FieldPun (f l) n
amap f (FieldWildcard l) = FieldWildcard (f l)
instance Annotated Alt where
ann (Alt l p gs bs) = l
amap f (Alt l p gs bs) = Alt (f l) p gs bs
instance Annotated GuardedAlts where
ann (UnGuardedAlt l e) = l
ann (GuardedAlts l galts) = l
amap f (UnGuardedAlt l e) = UnGuardedAlt (f l) e
amap f (GuardedAlts l galts) = GuardedAlts (f l) galts
instance Annotated GuardedAlt where
ann (GuardedAlt l ss e) = l
amap f (GuardedAlt l ss e) = GuardedAlt (f l) ss e