packages feed

haskell-tools-rewrite (empty) → 0.3.0.0

raw patch · 30 files changed

+3577/−0 lines, 30 filesdep +basedep +containersdep +ghcsetup-changed

Dependencies added: base, containers, ghc, haskell-tools-ast, haskell-tools-prettyprint, mtl, references

Files

+ LICENSE view
@@ -0,0 +1,29 @@+Haskell-Tools is Copyright (c) Boldizsár Németh, 2016, all rights reserved,
+and is distributed as free software under the following license.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+- Redistributions of source code must retain the above copyright
+notice, this list of conditions, and the following disclaimer.
+
+- Redistributions in binary form must reproduce the above copyright
+notice, this list of conditions, and the following disclaimer in the
+documentation and/or other materials provided with the distribution.
+
+- The names of the copyright holders may not be used to endorse or
+promote products derived from this software without specific prior
+written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY
+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
+BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
+IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Language/Haskell/Tools/AST/ElementTypes.hs view
@@ -0,0 +1,394 @@+module Language.Haskell.Tools.AST.ElementTypes where
+
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.Transform
+
+type AnnList node dom = AnnListG node dom SrcTemplateStage 
+type AnnMaybe node dom = AnnMaybeG node dom SrcTemplateStage 
+
+-- * Modules
+
+-- | The representation of a haskell module, that is a separate compilation unit.
+-- It may or may not have a header.
+type Module dom = Ann UModule dom SrcTemplateStage
+
+-- | Module declaration with name and (optional) exports
+type ModuleHead dom = Ann UModuleHead dom SrcTemplateStage
+
+-- | A list of export specifications surrounded by parentheses
+type ExportSpecs dom = Ann UExportSpecs dom SrcTemplateStage
+
+-- | Export specifier
+type ExportSpec dom = Ann UExportSpec dom SrcTemplateStage
+
+-- | Marks a name to be imported or exported with related names (subspecifier)
+type IESpec dom = Ann UIESpec dom SrcTemplateStage
+
+-- | Marks how related names will be imported or exported with a given name
+type SubSpec dom = Ann USubSpec dom SrcTemplateStage
+
+-- | Pragmas that must be used after the module head  
+type ModulePragma dom = Ann UModulePragma dom SrcTemplateStage
+
+-- | Pragmas that must be used before defining the module         
+type FilePragma dom = Ann UFilePragma dom SrcTemplateStage
+
+-- | An import declaration: @import Module.Name@         
+type ImportDecl dom = Ann UImportDecl dom SrcTemplateStage
+
+-- | Restriction on the imported names
+type ImportSpec dom = Ann UImportSpec dom SrcTemplateStage
+
+-- | Marks the import as qualified: @qualified@
+type ImportQualified dom = Ann UImportQualified dom SrcTemplateStage
+
+-- | Marks the import as source: @{-\# SOURCE \#-}@
+type ImportSource dom = Ann UImportSource dom SrcTemplateStage
+
+-- | Marks the import as safe: @safe@
+type ImportSafe dom = Ann UImportSafe dom SrcTemplateStage
+
+-- | Marks an imported name to belong to the type namespace: @type@
+type TypeNamespace dom = Ann UTypeNamespace dom SrcTemplateStage
+
+-- | Renaming imports (@ as A @)
+type ImportRenaming dom = Ann UImportRenaming dom SrcTemplateStage
+
+-- | The name of a module
+type ModuleName dom = Ann UModuleName dom SrcTemplateStage
+
+-- | The name of the enabled language extension, for example (@ LambdaCase @)
+type LanguageExtension dom = Ann ULanguageExtension dom SrcTemplateStage
+
+-- * Declarations
+
+-- | Haskell declaration
+type Decl dom = Ann UDecl dom SrcTemplateStage
+
+-- | The list of declarations that can appear in a typeclass
+type ClassBody dom = Ann UClassBody dom SrcTemplateStage
+
+-- | Members of a class declaration 
+type ClassElement dom = Ann UClassElement dom SrcTemplateStage
+
+-- The declared (possibly parameterized) type (@ A x :+: B y @).
+type DeclHead dom = Ann UDeclHead dom SrcTemplateStage
+
+-- | Instance body is the implementation of the class functions (@ where a x = 1; b x = 2 @)
+type InstBody dom = Ann UInstBody dom SrcTemplateStage
+
+-- | Declarations inside an instance declaration.
+type InstBodyDecl dom = Ann UInstBodyDecl dom SrcTemplateStage
+
+-- | GADT constructor declaration (@ D1 :: { val :: Int } -> T String @)
+type GadtConDecl dom = Ann UGadtConDecl dom SrcTemplateStage
+
+-- | Type of GADT constructors (can be record types: @{ val :: Int }@)
+type GadtConType dom = Ann UGadtConType dom SrcTemplateStage
+
+-- | Marker for a field wildcard. Only needed to attach semantic information in a type-safe way.
+type FieldWildcard dom = Ann UFieldWildcard dom SrcTemplateStage
+
+-- | A list of functional dependencies: @ | a -> b, c -> d @ separated by commas  
+type FunDeps dom = Ann UFunDeps dom SrcTemplateStage
+
+-- | A functional dependency, given on the form @l1 ... ln -> r1 ... rn@         
+type FunDep dom = Ann UFunDep dom SrcTemplateStage
+
+-- | A constructor declaration for a datatype
+type ConDecl dom = Ann UConDecl dom SrcTemplateStage
+
+-- | The @data@ or the @newtype@ keyword to define ADTs.
+type DataOrNewtypeKeyword dom = Ann UDataOrNewtypeKeyword dom SrcTemplateStage
+
+-- | Field declaration (@ fld :: Int @)
+type FieldDecl dom = Ann UFieldDecl dom SrcTemplateStage
+
+-- | A deriving clause following a data type declaration. (@ deriving Show @ or @ deriving (Show, Eq) @)
+type Deriving dom = Ann UDeriving dom SrcTemplateStage
+
+-- | The instance declaration rule, which is, roughly, the part of the instance declaration before the where keyword.
+type InstanceRule dom = Ann UInstanceRule dom SrcTemplateStage
+
+-- | The specification of the class instance declaration
+type InstanceHead dom = Ann UInstanceHead dom SrcTemplateStage
+
+-- | Overlap pragmas. Can be applied to class declarations and class instance declarations.    
+type OverlapPragma dom = Ann UOverlapPragma dom SrcTemplateStage
+
+-- | Type equations as found in closed type families (@ T A = S @)
+type TypeEqn dom = Ann UTypeEqn dom SrcTemplateStage
+
+-- | Top level pragmas
+type TopLevelPragma dom = Ann UTopLevelPragma dom SrcTemplateStage
+
+-- | A rewrite rule (@ "map/map" forall f g xs. map f (map g xs) = map (f.g) xs @)
+type Rule dom = Ann URule dom SrcTemplateStage
+
+-- | Annotation allows you to connect an expression to any declaration. 
+type AnnotationSubject dom = Ann UAnnotationSubject dom SrcTemplateStage
+
+-- | Formulas of minimal annotations declaring which functions should be defined.
+type MinimalFormula dom = Ann UMinimalFormula dom SrcTemplateStage
+
+-- | In-AST source ranges (for generated pragmas)
+type SourceRange dom = Ann USourceRange dom SrcTemplateStage
+
+-- | Open type and data families
+type TypeFamily dom = Ann UTypeFamily dom SrcTemplateStage
+
+-- | Type family specification with kinds specification and injectivity.
+type TypeFamilySpec dom = Ann UTypeFamilySpec dom SrcTemplateStage
+
+-- | Injectivity annotation for type families (@ = r | r -> a @)
+type InjectivityAnn dom = Ann UInjectivityAnn dom SrcTemplateStage
+
+-- | Pattern synonyms: @ pattern Arrow t1 t2 = App "->" [t1, t2] @
+type PatternSynonym dom = Ann UPatternSynonym dom SrcTemplateStage
+
+-- | Right-hand side of pattern synonym
+type PatSynRhs dom = Ann UPatSynRhs dom SrcTemplateStage
+
+-- | Left hand side of a pattern synonym
+type PatSynLhs dom = Ann UPatSynLhs dom SrcTemplateStage
+
+-- | Where clause of pattern synonym (explicit expression direction)
+type PatSynWhere dom = Ann UPatSynWhere dom SrcTemplateStage
+
+-- | Pattern type signature declaration (@ pattern Succ :: Int -> Int @)
+type PatternSignature dom = Ann UPatternTypeSignature dom SrcTemplateStage
+
+-- | Role annotations for types
+type Role dom = Ann URole dom SrcTemplateStage
+
+-- | Call conventions of foreign functions
+type CallConv dom = Ann UCallConv dom SrcTemplateStage
+
+-- | Safety annotations for foreign calls
+type Safety dom = Ann USafety dom SrcTemplateStage
+
+-- | A @CONLIKE@ modifier for an @INLINE@ pragma.
+type ConlikeAnnot dom = Ann UConlikeAnnot dom SrcTemplateStage
+
+-- | Controls the activation of a rewrite rule (@ [1] @)
+type PhaseControl dom = Ann UPhaseControl dom SrcTemplateStage
+
+-- * Binds
+
+-- | Value binding for top-level and local bindings
+type ValueBind dom = Ann UValueBind dom SrcTemplateStage
+
+-- | Clause of function binding   
+type Match dom = Ann UMatch dom SrcTemplateStage
+
+-- | Something on the left side of the match
+type MatchLhs dom = Ann UMatchLhs dom SrcTemplateStage
+
+-- | Right hand side of a value binding (possible with guards): (@ = 3 @ or @ | x == 1 = 3; | otherwise = 4 @)
+type Rhs dom = Ann URhs dom SrcTemplateStage
+
+-- | A guarded right-hand side of a value binding (@ | x > 3 = 2 @)      
+type GuardedRhs dom = Ann UGuardedRhs dom SrcTemplateStage
+
+-- | Guards for value bindings and pattern matches (@ Just v <- x, v > 1 @)
+type RhsGuard dom = Ann URhsGuard dom SrcTemplateStage
+
+-- | Bindings that are enabled in local blocks (where or let).
+type LocalBind dom = Ann ULocalBind dom SrcTemplateStage
+
+-- | Local bindings attached to a declaration (@ where x = 42 @)             
+type LocalBinds dom = Ann ULocalBinds dom SrcTemplateStage
+
+-- | A fixity signature (@ infixl 5 +, - @).
+type FixitySignature dom = Ann UFixitySignature dom SrcTemplateStage
+
+-- | A type signature (@ f :: Int -> Int @)
+type TypeSignature dom = Ann UTypeSignature dom SrcTemplateStage
+
+
+-- * Types
+
+-- | Haskell types
+type Type dom = Ann UType dom SrcTemplateStage
+
+-- | Type variable declarations (with possible kind annotation)
+type TyVar dom = Ann UTyVar dom SrcTemplateStage
+
+-- One or more assertions
+type Context dom = Ann UContext dom SrcTemplateStage
+
+-- | A single assertion in the context
+type Assertion dom = Ann UAssertion dom SrcTemplateStage
+
+-- * Kinds
+
+-- | Kind constraint (@ :: * -> * @)
+type KindConstraint dom = Ann UKindConstraint dom SrcTemplateStage
+
+-- | Haskell kinds
+type Kind dom = Ann UKind dom SrcTemplateStage
+
+-- | Values promoted to the kind level
+type PromotedKind dom = Ann (UPromoted UKind) dom SrcTemplateStage
+
+-- * Expressions
+
+-- | Haskell expressions
+type Expr dom = Ann UExpr dom SrcTemplateStage
+
+-- | Clause of case expression (@ Just x -> x + 1 @)
+type Alt dom = Ann UAlt dom SrcTemplateStage
+
+-- | Right hand side of a match (possible with guards): (@ -> 3 @ or @ | x == 1 -> 3; | otherwise -> 4 @)
+type CaseRhs dom = Ann UCaseRhs dom SrcTemplateStage
+
+-- | A guarded right-hand side of pattern matches binding (@ | x > 3 -> 2 @)      
+type GuardedCaseRhs dom = Ann UGuardedCaseRhs dom SrcTemplateStage
+
+-- | Field update expressions
+type FieldUpdate dom = Ann UFieldUpdate dom SrcTemplateStage
+
+-- | An element of a tuple section that can be an expression or missing (indicating a value from a parameter)
+type TupSecElem dom = Ann UTupSecElem dom SrcTemplateStage
+
+-- | Pragmas that can be applied to expressions
+type ExprPragma dom = Ann UExprPragma dom SrcTemplateStage
+
+-- | Special expressions for arrows
+type Cmd dom = Ann UCmd dom SrcTemplateStage
+
+-- | Clause of case expression for commands
+type CmdAlt dom = Ann UCmdAlt dom SrcTemplateStage
+
+-- | Arrow directions
+type ArrowApp dom = Ann UArrowAppl dom SrcTemplateStage
+
+-- * Statements
+
+-- | A statement in a do-notation
+type Stmt dom = Ann UStmt dom SrcTemplateStage
+
+-- | Keywords @do@ or @mdo@ to start a do-block
+type DoKind dom = Ann UDoKind dom SrcTemplateStage
+
+-- | List comprehension statement
+type CompStmt dom = Ann UCompStmt dom SrcTemplateStage
+
+-- | Body of a list comprehension: (@ | x <- [1..10] @)
+type ListCompBody dom = Ann UListCompBody dom SrcTemplateStage
+
+-- | A do-notation for arrows
+type CmdStmt dom = Ann UCmdStmt dom SrcTemplateStage
+
+-- * Patterns
+
+-- | Representation of patterns for pattern bindings
+type Pattern dom = Ann UPattern dom SrcTemplateStage
+
+-- Field specification of a record pattern
+type PatternField dom = Ann UPatternField dom SrcTemplateStage
+
+-- * Template Haskell
+
+-- | A template haskell splice          
+type Splice dom = Ann USplice dom SrcTemplateStage
+
+-- | Template Haskell bracket expressions
+type Bracket dom = Ann UBracket dom SrcTemplateStage
+
+-- | Template haskell quasi-quotation: @[quoter|str]@  
+type QuasiQuote dom = Ann UQuasiQuote dom SrcTemplateStage
+
+-- * Literals
+
+-- | Haskell literals
+type Literal dom = Ann ULiteral dom SrcTemplateStage
+
+-- * Names
+
+-- | A definition that functions as an operator
+type Operator dom = Ann UOperator dom SrcTemplateStage
+
+-- | A definition that functions as a name
+type Name dom = Ann UName dom SrcTemplateStage
+
+-- | Possible qualified names. Contains also implicit names.
+-- Linear implicit parameter: @%x@. Non-linear implicit parameter: @?x@.
+type QualifiedName dom = Ann UQualifiedName dom SrcTemplateStage
+
+-- | Parts of a qualified name.         
+type NamePart dom = Ann UNamePart dom SrcTemplateStage
+
+-- | Program elements formatted as string literals (import packages, pragma texts)
+type StringNode dom = Ann UStringNode dom SrcTemplateStage
+
+-- * Optional AST elements
+
+type MaybeContext dom = AnnMaybe UContext dom
+type MaybeDeriving dom = AnnMaybe UDeriving dom
+type MaybeLocalBinds dom = AnnMaybe ULocalBinds dom
+type MaybeTypeFamilySpec dom = AnnMaybe UTypeFamilySpec dom
+type MaybeKindConstraint dom = AnnMaybe UKindConstraint dom
+type MaybeClassBody dom = AnnMaybe UClassBody dom
+type MaybeInstBody dom = AnnMaybe UInstBody dom
+type MaybeExpr dom = AnnMaybe UExpr dom
+type MaybeExportSpecs dom = AnnMaybe UExportSpecs dom
+type MaybeImportQualified dom = AnnMaybe UImportQualified dom
+type MaybeImportSource dom = AnnMaybe UImportSource dom
+type MaybeImportSafe dom = AnnMaybe UImportSafe dom
+type MaybeImportSpec dom = AnnMaybe UImportSpec dom
+type MaybeModuleHead dom = AnnMaybe UModuleHead dom
+type MaybeModulePragma dom = AnnMaybe UModulePragma dom
+type MaybeSubSpec dom = AnnMaybe USubSpec dom
+type MaybeStringNode dom = AnnMaybe UStringNode dom
+type MaybeImportRenaming dom = AnnMaybe UImportRenaming dom
+type MaybeSafety dom = AnnMaybe USafety dom
+type MaybePhaseControl dom = AnnMaybe UPhaseControl dom
+type MaybeConlikeAnnot dom = AnnMaybe UConlikeAnnot dom
+type MaybeFunDeps dom = AnnMaybe UFunDeps dom
+
+
+-- * AST elements with multiplicity
+
+type MatchList dom = AnnList UMatch dom
+type DeclList dom = AnnList UDecl dom
+type PatternList dom = AnnList UPattern dom
+type OperatorList dom = AnnList UOperator dom
+type NameList dom = AnnList UName dom
+type LocalBindList dom = AnnList ULocalBind dom
+type IESpecList dom = AnnList UIESpec dom
+type RhsGuardList dom = AnnList URhsGuard dom
+type GuardedRhsList dom = AnnList UGuardedRhs dom
+type GuardedCaseRhsList dom = AnnList UGuardedCaseRhs dom
+type ConDeclList dom = AnnList UConDecl dom
+type TypeEqnList dom = AnnList UTypeEqn dom
+type TypeList dom = AnnList UType dom
+type FieldDeclList dom = AnnList UFieldDecl dom
+type ExprList dom = AnnList UExpr dom
+type FieldUpdateList dom = AnnList UFieldUpdate dom
+type GadtConDeclList dom = AnnList UGadtConDecl dom
+type ClassElementList dom = AnnList UClassElement dom
+type InstBodyDeclList dom = AnnList UInstBodyDecl dom
+type InstanceHeadList dom = AnnList UInstanceHead dom
+type AltList dom = AnnList UAlt dom
+type StmtList dom = AnnList UStmt dom
+type KindList dom = AnnList UKind dom
+type TyVarList dom = AnnList UTyVar dom
+type ListCompBodyList dom = AnnList UListCompBody dom
+type ExportSpecList dom = AnnList UExportSpec dom
+type FilePragmaList dom = AnnList UFilePragma dom
+type ImportDeclList dom = AnnList UImportDecl dom
+type PatternFieldList dom = AnnList UPatternField dom
+type AssertionList dom = AnnList UAssertion dom
+type CompStmtList dom = AnnList UCompStmt dom
+type RuleList dom = AnnList URule dom
+type RoleList dom = AnnList URole dom
+type MinimalFormulaList dom = AnnList UMinimalFormula dom
+type FunDepList dom = AnnList UFunDep dom
+type TupSecElemList dom = AnnList UTupSecElem dom
+type CmdList dom = AnnList UCmd dom
+type CmdAltList dom = AnnList UCmdAlt dom
+type CmdStmtList dom = AnnList UCmdStmt dom
+type LanguageExtensionList dom = AnnList ULanguageExtension dom
+type StringNodeList dom = AnnList UStringNode dom
+type NamePartList dom = AnnList UNamePart dom
+ Language/Haskell/Tools/AST/Gen.hs view
@@ -0,0 +1,26 @@+-- | Public interface for the modules that can be used to generate parts the AST.
+module Language.Haskell.Tools.AST.Gen 
+  ( module Language.Haskell.Tools.AST.Gen.Modules
+  , module Language.Haskell.Tools.AST.Gen.Decls
+  , module Language.Haskell.Tools.AST.Gen.Binds
+  , module Language.Haskell.Tools.AST.Gen.Types
+  , module Language.Haskell.Tools.AST.Gen.Kinds
+  , module Language.Haskell.Tools.AST.Gen.Exprs
+  , module Language.Haskell.Tools.AST.Gen.Stmts
+  , module Language.Haskell.Tools.AST.Gen.Literals
+  , module Language.Haskell.Tools.AST.Gen.Patterns
+  , module Language.Haskell.Tools.AST.Gen.Names
+  , module Language.Haskell.Tools.AST.Gen.TH
+  ) where
+
+import Language.Haskell.Tools.AST.Gen.Modules
+import Language.Haskell.Tools.AST.Gen.Decls
+import Language.Haskell.Tools.AST.Gen.Binds
+import Language.Haskell.Tools.AST.Gen.Types
+import Language.Haskell.Tools.AST.Gen.Kinds
+import Language.Haskell.Tools.AST.Gen.Exprs
+import Language.Haskell.Tools.AST.Gen.Stmts
+import Language.Haskell.Tools.AST.Gen.Literals
+import Language.Haskell.Tools.AST.Gen.Patterns
+import Language.Haskell.Tools.AST.Gen.Names
+import Language.Haskell.Tools.AST.Gen.TH
+ Language/Haskell/Tools/AST/Gen/Binds.hs view
@@ -0,0 +1,115 @@+-- | Generation of binding-level AST fragments for refactorings.
+-- The bindings defined here create a the annotated version of the AST constructor with the same name.
+-- For example, @mkMatch@ creates the annotated version of the @UMatch@ constructor.
+{-# LANGUAGE OverloadedStrings
+           , TypeFamilies
+           #-}
+module Language.Haskell.Tools.AST.Gen.Binds where
+
+import qualified Name as GHC
+import Data.List
+import Data.String
+import Data.Function (on)
+import Control.Reference
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AST.ElementTypes
+import Language.Haskell.Tools.AST.Gen.Patterns
+import Language.Haskell.Tools.AST.Gen.Utils
+import Language.Haskell.Tools.AST.Gen.Names
+import Language.Haskell.Tools.Transform
+
+-- | A simplified function to generate simple value bindings without local definitions, guards or complex lhs.
+mkSimpleBind' :: Name dom -> Expr dom -> ValueBind dom
+mkSimpleBind' n e = mkSimpleBind (mkVarPat n) (mkUnguardedRhs e) Nothing
+
+-- | Creates a value binding (@ v = "12" @).
+mkSimpleBind :: Pattern dom -> Rhs dom -> Maybe (LocalBinds dom) -> ValueBind dom
+mkSimpleBind p r l = mkAnn (child <> child <> child) (USimpleBind p r (mkAnnMaybe opt l))
+
+-- | Creates a function binding (@ f 0 = 1; f x = x @). All matches must have the same name.
+mkFunctionBind :: [Match dom] -> ValueBind dom
+mkFunctionBind = mkAnn child . UFunBind . mkAnnList indentedList
+
+-- | A simplified function for creating function bindings without local definitions or guards.
+mkFunctionBind' :: Name dom -> [([Pattern dom], Expr dom)] -> ValueBind dom
+mkFunctionBind' name matches = mkFunctionBind $ map (\(args, rhs) -> mkMatch (mkMatchLhs name args) (mkUnguardedRhs rhs) Nothing) matches
+
+-- | Creates a clause of function binding   
+mkMatch :: MatchLhs dom -> Rhs dom -> Maybe (LocalBinds dom) -> Match dom
+mkMatch lhs rhs locs 
+  = mkAnn (child <> child <> child) 
+      $ UMatch lhs rhs (mkAnnMaybe (optBefore " ") locs)
+
+-- | Creates a match lhs with the function name and parameter names (@ f a b @)
+mkMatchLhs :: Name dom -> [Pattern dom] -> MatchLhs dom
+mkMatchLhs n pats = mkAnn (child <> child) $ UNormalLhs n (mkAnnList (listSepBefore " " " ") pats)
+
+-- | Creates an infix match lhs for an operator (@ a + b @)
+mkInfixLhs :: Pattern dom -> Operator dom -> Pattern dom -> [Pattern dom] -> MatchLhs dom
+mkInfixLhs lhs op rhs pats = mkAnn (child <> child <> child <> child) $ UInfixLhs lhs op rhs (mkAnnList (listSepBefore " " " ") pats)
+
+-- | Local bindings attached to a declaration (@ where x = 42 @)
+mkLocalBinds :: Int -> [LocalBind dom] -> MaybeLocalBinds dom
+-- TODO: make the indentation automatic
+mkLocalBinds col = mkAnnMaybe (optBefore ("\n" ++ replicate (col - 1) ' ' ++ "where ")) 
+                     . Just . mkAnn child . ULocalBinds . mkAnnList indentedList
+
+mkLocalBinds' :: [LocalBind dom] -> LocalBinds dom
+mkLocalBinds' = mkAnn (" where " <> child) . ULocalBinds . mkAnnList indentedList
+
+-- | Creates a local binding for a value
+mkLocalValBind :: ValueBind dom -> LocalBind dom
+mkLocalValBind = mkAnn child . ULocalValBind
+
+-- | Creates a local type signature
+mkLocalTypeSig :: TypeSignature dom -> LocalBind dom
+mkLocalTypeSig = mkAnn child . ULocalSignature
+
+-- | Creates a local fixity declaration
+mkLocalFixity :: FixitySignature dom -> LocalBind dom
+mkLocalFixity = mkAnn child . ULocalFixity
+
+-- | Creates a type signature (@ f :: Int -> Int @)
+mkTypeSignature :: Name dom -> Type dom -> TypeSignature dom
+mkTypeSignature n t = mkAnn (child <> " :: " <> child) (UTypeSignature (mkAnnList (listSep ", ") [n]) t)
+
+-- | Creates a left-associative fixity declaration (@ infixl 5 +, - @).
+mkInfixL :: Int -> Operator dom -> FixitySignature dom
+mkInfixL prec op = mkAnn (child <> " " <> child <> " " <> child) 
+                     $ UFixitySignature (mkAnn "infixl" AssocLeft) (mkAnn (fromString (show prec)) (Precedence prec)) (mkAnnList (listSep ", ") [op])
+
+-- | Creates a right-associative fixity declaration (@ infixr 5 +, - @).
+mkInfixR :: Int -> Operator dom -> FixitySignature dom
+mkInfixR prec op = mkAnn (child <> " " <> child <> " " <> child) 
+                     $ UFixitySignature (mkAnn "infixr" AssocRight) (mkAnn (fromString (show prec)) (Precedence prec)) (mkAnnList (listSep ", ") [op])
+
+-- | Creates a non-associative fixity declaration (@ infix 5 +, - @).
+mkInfix :: Int -> Operator dom -> FixitySignature dom
+mkInfix prec op = mkAnn (child <> " " <> child <> " " <> child) 
+                    $ UFixitySignature (mkAnn "infix" AssocNone) (mkAnn (fromString (show prec)) (Precedence prec)) (mkAnnList (listSep ", ") [op])
+
+-- | Creates an unguarded right-hand-side (@ = 3 @)
+mkUnguardedRhs :: Expr dom -> Rhs dom
+mkUnguardedRhs = mkAnn (" = " <> child) . UUnguardedRhs
+
+-- | Creates an unguarded right-hand-side (@ | x == 1 = 3; | otherwise = 4 @)
+mkGuardedRhss :: [GuardedRhs dom] -> Rhs dom
+mkGuardedRhss = mkAnn child . UGuardedRhss . mkAnnList indentedList
+
+-- | Creates a guarded right-hand side of a value binding (@ | x > 3 = 2 @)    
+mkGuardedRhs :: [RhsGuard dom] -> Expr dom -> GuardedRhs dom
+mkGuardedRhs guards expr = mkAnn ("| " <> child <> " = " <> child) $ UGuardedRhs (mkAnnList (listSep ", ") guards) expr
+
+-- | Creates a bind statement in a pattern guard (@ Just v <- x @)
+mkGuardBind :: Pattern dom -> Expr dom -> RhsGuard dom
+mkGuardBind pat expr = mkAnn (child <> " <- " <> child) $ UGuardBind pat expr
+
+-- | Creates a let statement in a pattern guard (@ let x = 3 @)
+mkGuardLet :: [LocalBind dom] -> RhsGuard dom
+mkGuardLet = mkAnn ("let " <> child) . UGuardLet . mkAnnList indentedList
+
+-- | Creates an expression to check for a pattern guard
+mkGuardCheck :: Expr dom -> RhsGuard dom
+mkGuardCheck = mkAnn child . UGuardCheck
+
+-- pragmas are omitted
+ Language/Haskell/Tools/AST/Gen/Decls.hs view
@@ -0,0 +1,483 @@+-- | Generation of declaration-level AST fragments for refactorings.
+-- The bindings defined here create a the annotated version of the AST constructor with the same name.
+-- For example, @mkTypeSignature@ creates the annotated version of the @UTypeSignature@ AST constructor.
+{-# LANGUAGE OverloadedStrings
+           , TypeFamilies
+           #-}
+module Language.Haskell.Tools.AST.Gen.Decls where
+
+import qualified Name as GHC
+import Data.List
+import Data.String
+import Data.Function (on)
+import Control.Reference
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AST.ElementTypes
+import Language.Haskell.Tools.AST.Gen.Utils
+import Language.Haskell.Tools.AST.Gen.Names
+import Language.Haskell.Tools.Transform
+
+-- | Creates a type synonym ( @type String = [Char]@ )
+mkTypeDecl :: DeclHead dom -> Type dom -> Decl dom 
+mkTypeDecl dh typ = mkAnn (child <> " :: " <> child) $ UTypeDecl dh typ
+
+-- | Creates a standalone deriving declaration (@ deriving instance X T @)
+mkStandaloneDeriving :: Maybe (OverlapPragma dom) -> InstanceRule dom -> Decl dom
+mkStandaloneDeriving overlap instRule = mkAnn ("deriving instance" <> child <> child) 
+                                          $ UDerivDecl (mkAnnMaybe (optBefore " ") overlap) instRule
+
+-- | Creates a fixity declaration (@ infixl 5 +, - @)
+mkFixityDecl :: FixitySignature dom -> Decl dom
+mkFixityDecl = mkAnn child . UFixityDecl
+
+-- | Creates default types (@ default (T1, T2) @)
+mkDefaultDecl :: [Type dom] -> Decl dom
+mkDefaultDecl = mkAnn ("default (" <> child <> ")") . UDefaultDecl . mkAnnList (listSep ", ")
+
+-- | Creates type signature declaration (@ f :: Int -> Int @)
+mkTypeSigDecl :: TypeSignature dom -> Decl dom
+mkTypeSigDecl = mkAnn child . UTypeSigDecl
+
+-- | Creates a function or value binding (@ f x = 12 @)
+mkValueBinding :: ValueBind dom -> Decl dom
+mkValueBinding = mkAnn child . UValueBinding
+
+-- | Creates a Template Haskell splice declaration (@ $(generateDecls) @)
+mkSpliceDecl :: Splice dom -> Decl dom
+mkSpliceDecl = mkAnn child . USpliceDecl
+
+-- * Data type definitions
+
+-- | Creates a data or newtype declaration.
+mkDataDecl :: DataOrNewtypeKeyword dom -> Maybe (Context dom) -> DeclHead dom -> [ConDecl dom] -> Maybe (Deriving dom) -> Decl dom
+mkDataDecl keyw ctx dh cons derivs 
+  = mkAnn (child <> " " <> child <> child <> child <> child) 
+      $ UDataDecl keyw (mkAnnMaybe (optBefore " ") ctx) dh 
+                 (mkAnnList (listSepBefore " | " " = ") cons) (mkAnnMaybe (optBefore " deriving ") derivs)
+
+-- | Creates a GADT-style data or newtype declaration.
+mkGADTDataDecl :: DataOrNewtypeKeyword dom -> Maybe (Context dom) -> DeclHead dom -> Maybe (KindConstraint dom)
+                    -> [GadtConDecl dom] -> Maybe (Deriving dom) -> Decl dom
+mkGADTDataDecl keyw ctx dh kind cons derivs 
+  = mkAnn (child <> " " <> child <> child <> child <> child <> child) 
+      $ UGDataDecl keyw (mkAnnMaybe (optBefore " ") ctx) dh 
+                  (mkAnnMaybe (optBefore " ") kind) (mkAnnList (listSepBefore " | " " = ") cons) (mkAnnMaybe (optBefore " deriving ") derivs)
+
+-- | Creates a GADT constructor declaration (@ D1 :: Int -> T String @)
+mkGadtConDecl :: [Name dom] -> Type dom -> GadtConDecl dom
+mkGadtConDecl names typ = mkAnn (child <> " :: " <> child) $ UGadtConDecl (mkAnnList (listSep ", ") names) (mkAnn child $ UGadtNormalType typ)
+
+-- | Creates a GADT constructor declaration with record syntax (@ D1 :: { val :: Int } -> T String @)
+mkGadtRecordConDecl :: [Name dom] -> [FieldDecl dom] -> Type dom -> GadtConDecl dom
+mkGadtRecordConDecl names flds typ 
+  = mkAnn (child <> " :: " <> child) $ UGadtConDecl (mkAnnList (listSep ", ") names) 
+      $ mkAnn (child <> " -> " <> child) $ UGadtRecordType (mkAnnList (listSepBeforeAfter ", " "{ " " }") flds) typ
+
+-- | Creates an ordinary data constructor (@ C t1 t2 @)
+mkConDecl :: Name dom -> [Type dom] -> ConDecl dom
+mkConDecl name args = mkAnn (child <> child) $ UConDecl name (mkAnnList (listSepBefore " " " ") args)
+
+-- | Creates a record data constructor (@ Point { x :: Double, y :: Double } @)
+mkRecordConDecl :: Name dom -> [FieldDecl dom] -> ConDecl dom
+mkRecordConDecl name fields = mkAnn (child <> " { " <> child <> " }") $ URecordDecl name (mkAnnList (listSep ", ") fields)
+
+-- | Creates an infix data constructor (@ t1 :+: t2 @)
+mkInfixConDecl :: Type dom -> Operator dom -> Type dom -> ConDecl dom
+mkInfixConDecl lhs op rhs = mkAnn (child <> " " <> child <> " " <> child) $ UInfixConDecl lhs op rhs
+
+-- | Creates a field declaration (@ fld :: Int @) for a constructor
+mkFieldDecl :: [Name dom] -> Type dom -> FieldDecl dom
+mkFieldDecl names typ = mkAnn (child <> " :: " <> child) $ UFieldDecl (mkAnnList (listSep ", ") names) typ
+
+-- | Creates a deriving clause following a data type declaration. (@ deriving Show @ or @ deriving (Show, Eq) @)
+mkDeriving :: [InstanceHead dom] -> Deriving dom
+mkDeriving [deriv] = mkAnn child $ UDerivingOne deriv
+mkDeriving derivs = mkAnn ("(" <> child <> ")") $ UDerivings (mkAnnList (listSep ", ") derivs)
+
+-- | The @data@ keyword in a type definition
+mkDataKeyword :: DataOrNewtypeKeyword dom
+mkDataKeyword = mkAnn "data" UDataKeyword
+
+-- | The @newtype@ keyword in a type definition
+mkNewtypeKeyword :: DataOrNewtypeKeyword dom
+mkNewtypeKeyword = mkAnn "newtype" UNewtypeKeyword
+
+-- * Class declarations
+
+-- | Creates a type class declaration (@ class X a where f = ... @)
+mkClassDecl :: Maybe (Context dom) -> DeclHead dom -> [FunDep dom] -> Maybe (ClassBody dom) -> Decl dom
+mkClassDecl ctx dh funDeps body 
+  = let fdeps = case funDeps of [] -> Nothing
+                                _ -> Just $ mkAnn child $ UFunDeps $ mkAnnList (listSep ", ") funDeps
+     in mkAnn ("class " <> child <> child <> child <> child) 
+          $ UClassDecl (mkAnnMaybe (optAfter " ") ctx) dh (mkAnnMaybe (optBefore " | ") fdeps) (mkAnnMaybe opt body) 
+
+-- | Creates the list of declarations that can appear in a typeclass
+mkClassBody :: [ClassElement dom] -> ClassBody dom
+mkClassBody = mkAnn (" where " <> child) . UClassBody . mkAnnList indentedList
+
+-- | Creates a type signature as class element: @ f :: A -> B @
+mkClassElemSig :: TypeSignature dom -> ClassElement dom
+mkClassElemSig = mkAnn child . UClsSig
+
+-- | Creates a default binding as class element: @ f x = "aaa" @
+mkClassElemDef :: ValueBind dom -> ClassElement dom
+mkClassElemDef = mkAnn child . UClsDef
+
+-- | Creates an associated type synonym in class: @ type T y :: * @ 
+mkClassElemTypeFam :: DeclHead dom -> Maybe (TypeFamilySpec dom) -> ClassElement dom
+mkClassElemTypeFam dh tfSpec = mkAnn ("type " <> child) $ UClsTypeFam (mkAnn (child <> child) $ UTypeFamily dh (mkAnnMaybe opt tfSpec))
+
+-- | Creates an associated data synonym in class: @ data T y :: * @ 
+mkClassElemDataFam :: DeclHead dom -> Maybe (KindConstraint dom) -> ClassElement dom
+mkClassElemDataFam dh kind = mkAnn ("data " <> child) $ UClsTypeFam (mkAnn (child <> child) $ UDataFamily dh (mkAnnMaybe opt kind))
+
+-- | Creates a default choice for type synonym in class: @ type T x = TE @ or @ type instance T x = TE @
+mkClsDefaultType :: DeclHead dom -> Type dom -> ClassElement dom
+mkClsDefaultType dh typ = mkAnn ("type " <> child <> " = " <> child) $ UClsTypeDef dh typ
+
+-- | Creates a default signature (by using @DefaultSignatures@) in class: @ default enum :: (Generic a, GEnum (Rep a)) => [a] @
+mkClsDefaultSig :: Name dom -> Type dom -> ClassElement dom
+mkClsDefaultSig dh typ = mkAnn ("default " <> child <> " :: " <> child) $ UClsDefSig dh typ
+
+-- | Creates a functional dependency, given on the form @l1 ... ln -> r1 ... rn@
+mkFunDep :: [Name dom] -> [Name dom] -> FunDep dom
+mkFunDep lhss rhss = mkAnn (child <> " -> " <> child) 
+                       $ UFunDep (mkAnnList (listSep ", ") lhss) (mkAnnList (listSep ", ") rhss)
+
+-- | Minimal pragma: @ {-\# MINIMAL (==) | (/=) \#-} @ in a class
+mkClsMinimal :: MinimalFormula dom -> ClassElement dom
+mkClsMinimal = mkAnn ("{-# MINIMAL " <> child <> " #-}") . UClsMinimal
+
+mkMinimalName :: Name dom -> MinimalFormula dom
+mkMinimalName = mkAnn child . UMinimalName
+
+mkMinimalParen :: MinimalFormula dom -> MinimalFormula dom
+mkMinimalParen = mkAnn ("(" <> child <> ")") . UMinimalParen
+
+-- | One of the minimal formulas are needed (@ min1 | min2 @)
+mkMinimalOr :: [MinimalFormula dom] -> MinimalFormula dom
+mkMinimalOr = mkAnn child . UMinimalOr . mkAnnList (listSep " | ")
+
+-- | Both of the minimal formulas are needed (@ min1 , min2 @)
+mkMinimalAnd :: [MinimalFormula dom] -> MinimalFormula dom
+mkMinimalAnd = mkAnn child . UMinimalAnd . mkAnnList (listSep ", ")
+
+-- * Declaration heads
+
+-- | Type or class name as a declaration head
+mkNameDeclHead :: Name dom -> DeclHead dom
+mkNameDeclHead = mkAnn child . UDeclHead
+
+-- | Parenthesized type as a declaration head
+mkParenDeclHead :: DeclHead dom -> DeclHead dom
+mkParenDeclHead = mkAnn child . UDHParen
+
+-- | Application in a declaration head
+mkDeclHeadApp :: DeclHead dom -> TyVar dom -> DeclHead dom
+mkDeclHeadApp dh tv = mkAnn (child <> " " <> child) $ UDHApp dh tv
+
+-- | Infix application of the type/class name to the left operand in a declaration head
+mkInfixDeclHead :: TyVar dom -> Operator dom -> TyVar dom -> DeclHead dom
+mkInfixDeclHead lhs op rhs = mkAnn (child <> " " <> child <> " " <> child) $ UDHInfix lhs op rhs
+
+-- * Type class instance declarations
+
+-- | Creates a type class instance declaration (@ instance X T [where f = ...] @)
+mkInstanceDecl :: Maybe (OverlapPragma dom) -> InstanceRule dom -> Maybe (InstBody dom) -> Decl dom
+mkInstanceDecl overlap instRule body = mkAnn ("instance " <> child <> child <> child) 
+                                 $ UInstDecl (mkAnnMaybe (optBefore " ") overlap) instRule (mkAnnMaybe opt body)
+
+-- | The instance declaration rule, which is, roughly, the part of the instance declaration before the where keyword.
+mkInstanceRule :: Maybe (Context dom) -> InstanceHead dom -> InstanceRule dom
+mkInstanceRule ctx ih 
+  = mkAnn (child <> child <> child) $ UInstanceRule (mkAnnMaybe (optBefore " ") Nothing) (mkAnnMaybe (optBefore " ") ctx) ih
+
+-- | Type or class name as a part of the instance declaration
+mkInstanceHead :: Name dom -> InstanceHead dom
+mkInstanceHead = mkAnn child . UInstanceHeadCon
+
+-- | Infix application of the type/class name to the left operand as a part of the instance declaration
+mkInfixInstanceHead :: Type dom -> Name dom -> InstanceHead dom
+mkInfixInstanceHead typ n = mkAnn (child <> child) $ UInstanceHeadInfix typ n
+
+-- | Parenthesized instance head as a part of the instance declaration
+mkParenInstanceHead :: InstanceHead dom -> InstanceHead dom
+mkParenInstanceHead = mkAnn ("(" <> child <> ")") . UInstanceHeadParen
+
+-- | Application to one more type as a part of the instance declaration
+mkAppInstanceHead :: InstanceHead dom -> Type dom -> InstanceHead dom
+mkAppInstanceHead fun arg = mkAnn (child <> " " <> child) $ UInstanceHeadApp fun arg
+
+-- | Instance body is the implementation of the class functions (@ where a x = 1; b x = 2 @)
+mkInstanceBody :: [InstBodyDecl dom] -> InstBody dom
+mkInstanceBody = mkAnn (" where " <> child) . UInstBody . mkAnnList indentedList
+
+-- | A normal declaration (@ f x = 12 @) in a type class instance
+mkInstanceBind :: ValueBind dom -> InstBodyDecl dom
+mkInstanceBind = mkAnn child . UInstBodyNormalDecl
+
+-- | Type signature in instance definition with @InstanceSigs@
+mkInstanceTypeSig :: TypeSignature dom -> InstBodyDecl dom
+mkInstanceTypeSig = mkAnn child . UInstBodyTypeSig
+
+-- | An associated type definition (@ type A X = B @) in a type class instance
+mkInstanceTypeFamilyDef :: TypeEqn dom -> InstBodyDecl dom
+mkInstanceTypeFamilyDef = mkAnn child . UInstBodyTypeDecl
+
+-- | An associated data type implementation (@ data A X = C1 | C2 @) int a type class instance
+mkInstanceDataFamilyDef :: DataOrNewtypeKeyword dom -> InstanceRule dom -> [ConDecl dom] -> Maybe (Deriving dom) -> InstBodyDecl dom
+mkInstanceDataFamilyDef keyw instRule cons derivs 
+  = mkAnn (child <> " " <> child <> child <> child) 
+      $ UInstBodyDataDecl keyw instRule (mkAnnList (listSepBefore " | " " = ") cons) (mkAnnMaybe (optBefore " deriving ") derivs)
+
+-- | An associated data type implemented using GADT style int a type class instance
+mkInstanceDataFamilyGADTDef :: DataOrNewtypeKeyword dom -> InstanceRule dom -> Maybe (KindConstraint dom) -> [GadtConDecl dom] 
+                                 -> Maybe (Deriving dom) -> InstBodyDecl dom
+mkInstanceDataFamilyGADTDef keyw instRule kind cons derivs 
+  = mkAnn (child <> " " <> child <> child <> child) 
+      $ UInstBodyGadtDataDecl mkDataKeyword instRule (mkAnnMaybe opt kind) (mkAnnList (listSepBefore " | " " = ") cons) 
+                             (mkAnnMaybe (optBefore " deriving ") derivs)
+
+-- | Specialize instance pragma (no phase selection is allowed) in a type class instance
+mkInstanceSpecializePragma :: Type dom -> InstBodyDecl dom
+mkInstanceSpecializePragma = mkAnn ("{-# SPECIALIZE " <> child <> " #-}") . USpecializeInstance
+
+-- | @OVERLAP@ pragma for type instance definitions
+mkEnableOverlap :: OverlapPragma dom     
+mkEnableOverlap = mkAnn "{-# OVERLAP #-}" UEnableOverlap
+
+-- | @NO_OVERLAP@ pragma for type instance definitions
+mkDisableOverlap :: OverlapPragma dom    
+mkDisableOverlap = mkAnn "{-# NO_OVERLAP #-}" UDisableOverlap
+
+-- | @OVERLAPPABLE@ pragma for type instance definitions
+mkOverlappable :: OverlapPragma dom      
+mkOverlappable = mkAnn "{-# OVERLAPPABLE #-}" UOverlappable
+
+-- | @OVERLAPPING@ pragma for type instance definitions
+mkOverlapping :: OverlapPragma dom       
+mkOverlapping = mkAnn "{-# OVERLAPPING #-}" UOverlapping
+
+-- | @OVERLAPS@ pragma for type instance definitions
+mkOverlaps :: OverlapPragma dom          
+mkOverlaps = mkAnn "{-# OVERLAPS #-}" UOverlaps
+
+-- | @INCOHERENT@ pragma for type instance definitions
+mkIncoherentOverlap :: OverlapPragma dom 
+mkIncoherentOverlap = mkAnn "{-# INCOHERENT #-}" UIncoherentOverlap
+
+-- * Type roles
+
+-- | Creates a role annotations (@ type role Ptr representational @)
+mkRoleDecl :: QualifiedName dom -> [Role dom] -> Decl dom
+mkRoleDecl name roles = mkAnn ("type role " <> child <> child) $ URoleDecl name $ mkAnnList (listSepBefore " " " ") roles
+
+-- | Marks a given type parameter as @nominal@.
+mkNominalRole :: Role dom
+mkNominalRole = mkAnn "nominal" UNominal 
+
+-- | Marks a given type parameter as @representational@.
+mkRepresentationalRole :: Role dom
+mkRepresentationalRole = mkAnn "representational" URepresentational
+
+-- | Marks a given type parameter as @phantom@.
+mkPhantomRole :: Role dom
+mkPhantomRole = mkAnn "phantom" UPhantom
+
+-- * Foreign imports and exports
+
+-- | Creates a foreign import (@ foreign import foo :: Int -> IO Int @)
+mkForeignImport :: CallConv dom -> Maybe (Safety dom) -> Name dom -> Type dom -> Decl dom
+mkForeignImport cc safety name typ = mkAnn (child <> child <> " " <> child <> " :: " <> child) 
+                                       $ UForeignImport cc (mkAnnMaybe (optBefore " ") safety) name typ
+
+-- | Creates a foreign export (@ foreign export ccall foo :: Int -> IO Int @)
+mkForeignExport :: CallConv dom -> Name dom -> Type dom -> Decl dom
+mkForeignExport cc name typ = mkAnn (child <> " " <> child <> " :: " <> child) $ UForeignExport cc name typ
+
+-- | Specifies @stdcall@ calling convention for foreign import/export.
+mkStdCall :: CallConv dom
+mkStdCall = mkAnn "stdcall" UStdCall
+
+-- | Specifies @ccall@ calling convention for foreign import/export.
+mkCCall :: CallConv dom
+mkCCall = mkAnn "ccall" UCCall
+
+-- | Specifies @capi@ calling convention for foreign import/export.
+mkCApi :: CallConv dom
+mkCApi = mkAnn "capi" UCApi
+
+-- | Specifies that the given foreign import is @unsafe@.
+mkUnsafe :: Safety dom
+mkUnsafe = mkAnn "unsafe" UUnsafe 
+
+-- * Type and data families
+
+-- | Creates a type family declaration ( @type family F x@ )
+mkTypeFamily :: DeclHead dom -> Maybe (TypeFamilySpec dom) -> Decl dom
+mkTypeFamily dh famSpec = mkAnn child $ UTypeFamilyDecl (mkAnn (child <> child) $ UTypeFamily dh (mkAnnMaybe (optBefore " ") famSpec))
+
+-- | Creates a closed type family declaration ( @type family F x where F Int = (); F a = Int@ )
+mkClosedTypeFamily :: DeclHead dom -> Maybe (KindConstraint dom) -> [TypeEqn dom] -> Decl dom
+mkClosedTypeFamily dh kind typeqs = mkAnn (child <> child <> " where " <> child) 
+                                      $ UClosedTypeFamilyDecl dh (mkAnnMaybe (optBefore " ") kind) (mkAnnList indentedList typeqs)
+
+-- | Creates a data family declaration (@ data family A a :: * -> * @)   
+mkDataFamily :: DeclHead dom -> Maybe (KindConstraint dom) -> Decl dom
+mkDataFamily dh kind = mkAnn child $ UTypeFamilyDecl (mkAnn (child <> child) $ UDataFamily dh (mkAnnMaybe (optBefore " ") kind))
+
+-- | Specifies the kind of a type family (@ :: * -> * @)
+mkTypeFamilyKindSpec :: KindConstraint dom -> TypeFamilySpec dom
+mkTypeFamilyKindSpec = mkAnn child . UTypeFamilyKind
+
+-- | Specifies the injectivity of a type family (@ = r | r -> a @)
+mkTypeFamilyInjectivitySpec :: Name dom -> [Name dom] -> TypeFamilySpec dom
+mkTypeFamilyInjectivitySpec res dependent 
+  = mkAnn child (UTypeFamilyInjectivity $ mkAnn (child <> " -> " <> child) $ UInjectivityAnn res (mkAnnList (listSep " ") dependent))
+
+-- | Type equations as found in closed type families (@ T A = S @)
+mkTypeEqn :: Type dom -> Type dom -> TypeEqn dom
+mkTypeEqn lhs rhs = mkAnn (child <> " = " <> child) $ UTypeEqn lhs rhs
+
+-- | Creates a type family instance declaration (@ type instance Fam T = AssignedT @)
+mkTypeInstance :: InstanceRule dom -> Type dom -> Decl dom
+mkTypeInstance instRule typ = mkAnn ("type instance " <> child <> " = " <> child) $ UTypeInstDecl instRule typ
+
+-- | Creates a data instance declaration (@ data instance Fam T = Con1 | Con2 @)
+mkDataInstance :: DataOrNewtypeKeyword dom -> InstanceRule dom -> [ConDecl dom] -> Maybe (Deriving dom) -> Decl dom
+mkDataInstance keyw instRule cons derivs 
+  = mkAnn (child <> " instance " <> child <> " = " <> child <> child) 
+      $ UDataInstDecl keyw instRule (mkAnnList (listSepBefore " | " " = ") cons) (mkAnnMaybe (optBefore " deriving ") derivs)
+
+-- | Creates a GADT-style data instance declaration (@ data instance Fam T where ... @)
+mkGadtDataInstance :: DataOrNewtypeKeyword dom -> InstanceRule dom -> Maybe (KindConstraint dom) -> [GadtConDecl dom] -> Decl dom
+mkGadtDataInstance keyw instRule kind cons 
+  = mkAnn (child <> " instance " <> child <> child <> " where " <> child) 
+      $ UGDataInstDecl keyw instRule (mkAnnMaybe (optBefore " ") kind) (mkAnnList indentedList cons)
+
+-- * Pattern synonyms
+
+-- | Creates a pattern synonym (@ pattern Arrow t1 t2 = App \"->\" [t1, t2] @)
+mkPatternSynonym :: PatSynLhs dom -> PatSynRhs dom -> Decl dom
+mkPatternSynonym lhs rhs = mkAnn child $ UPatternSynonymDecl $ mkAnn ("pattern " <> child <> " " <> child) $ UPatternSynonym lhs rhs
+
+-- | Creates a left hand side of a pattern synonym with a constructor name and arguments (@ Arrow t1 t2 @)
+mkConPatSyn :: Name dom -> [Name dom] -> PatSynLhs dom
+mkConPatSyn con args = mkAnn (child <> child) $ UNormalPatSyn con $ mkAnnList (listSepBefore " " " ") args
+
+-- | Creates an infix pattern synonym left-hand side (@ t1 :+: t2 @)
+mkInfixPatSyn :: Name dom -> Operator dom -> Name dom -> PatSynLhs dom
+mkInfixPatSyn lhs op rhs = mkAnn (child <> " " <> child <> " " <> child) $ UInfixPatSyn lhs op rhs
+
+-- | Creates a record-style pattern synonym left-hand side (@ Arrow { arrowFrom, arrowTo } @)
+mkRecordPatSyn :: Name dom -> [Name dom] -> PatSynLhs dom
+mkRecordPatSyn con args = mkAnn (child <> child) $ URecordPatSyn con $ mkAnnList (listSepBeforeAfter ", " "{ " " }") args
+
+-- | Creates an automatically two-way pattern synonym (@ = App \"Int\" [] @)
+mkSymmetricPatSyn :: Pattern dom -> PatSynRhs dom
+mkSymmetricPatSyn = mkAnn ("= " <> child) . flip UBidirectionalPatSyn (mkAnnMaybe opt Nothing)
+
+-- | Creates a pattern synonym that can be only used for pattenr matching but not for combining (@ <- App \"Int\" [] @)
+mkOneWayPatSyn :: Pattern dom -> PatSynRhs dom
+mkOneWayPatSyn = mkAnn ("<- " <> child) . UOneDirectionalPatSyn
+
+-- | Creates a pattern synonym with the other direction explicitely specified (@ <- App \"Int\" [] where Int = App \"Int\" [] @)
+mkTwoWayPatSyn :: Pattern dom -> [Match dom] -> PatSynRhs dom
+mkTwoWayPatSyn pat match = mkAnn ("<- " <> child <> child) $ UBidirectionalPatSyn pat $ mkAnnMaybe (optBefore " where ") 
+                             $ Just $ mkAnn child $ UPatSynWhere $ mkAnnList indentedList match
+
+-- | Creates a pattern type signature declaration (@ pattern Succ :: Int -> Int @)
+mkPatternSignatureDecl :: PatternSignature dom -> Decl dom
+mkPatternSignatureDecl = mkAnn child . UPatTypeSigDecl
+
+mkPatternSignature :: Name dom -> Type dom -> PatternSignature dom
+mkPatternSignature name typ = mkAnn (child <> " :: " <> child) $ UPatternTypeSignature name typ
+
+-- * Top level pragmas
+
+-- | Creates a top-level pragmas
+mkPragmaDecl :: TopLevelPragma dom -> Decl dom
+mkPragmaDecl = mkAnn child . UPragmaDecl
+
+-- | A pragma that introduces source rewrite rules (@ {-\# RULES "map/map" [2]  forall f g xs. map f (map g xs) = map (f.g) xs \#-} @)
+mkRulePragma :: [Rule dom] -> TopLevelPragma dom
+mkRulePragma = mkAnn ("{-# RULES " <> child <> " #-}") . URulePragma . mkAnnList (listSep ", ")
+
+-- | A pragma that marks definitions as deprecated (@ {-\# DEPRECATED f "f will be replaced by g" \#-} @)
+mkDeprPragma :: [Name dom] -> String -> TopLevelPragma dom
+mkDeprPragma defs msg = mkAnn ("{-# DEPRECATED " <> child <> " " <> child <> " #-}") 
+                          $ UDeprPragma (mkAnnList (listSep ", ") defs) $ mkAnn ("\"" <> child <> "\"") $ UStringNode msg
+
+-- | A pragma that marks definitions as deprecated (@ {-\# WARNING unsafePerformIO "you should know what you are doing" \#-} @)
+mkWarningPragma :: [Name dom] -> String -> TopLevelPragma dom
+mkWarningPragma defs msg = mkAnn ("{-# WARNING " <> child <> " " <> child <> " #-}") 
+                             $ UWarningPragma (mkAnnList (listSep ", ") defs) $ mkAnn ("\"" <> child <> "\"") $ UStringNode msg
+
+-- | A pragma that annotates a definition with an arbitrary value (@ {-\# ANN f 42 \#-} @)
+mkAnnPragma :: AnnotationSubject dom -> Expr dom -> TopLevelPragma dom
+mkAnnPragma subj ann = mkAnn ("{-# ANN " <> child <> " " <> child <> " #-}") $ UAnnPragma subj ann
+
+-- | A pragma that marks a function for inlining to the compiler (@ {-\# INLINE thenUs \#-} @)
+mkInlinePragma :: Maybe (ConlikeAnnot dom) -> Maybe (PhaseControl dom) -> Name dom -> TopLevelPragma dom
+mkInlinePragma conlike phase name 
+  = mkAnn ("{-# INLINE " <> child <> child <> child <> " #-}") 
+      $ UInlinePragma (mkAnnMaybe (optAfter " ") conlike) (mkAnnMaybe (optAfter " ") phase) name
+
+-- | A pragma that forbids a function from being inlined by the compiler (@ {-\# NOINLINE f \#-} @)
+mkNoInlinePragma :: Maybe (ConlikeAnnot dom) -> Maybe (PhaseControl dom) -> Name dom -> TopLevelPragma dom
+mkNoInlinePragma conlike phase name 
+  = mkAnn ("{-# NOINLINE " <> child <> child <> child <> " #-}") 
+     $ UNoInlinePragma (mkAnnMaybe (optAfter " ") conlike) (mkAnnMaybe (optAfter " ") phase) name
+
+-- | A pragma that marks a function that it may be inlined by the compiler (@ {-\# INLINABLE thenUs \#-} @)
+mkInlinablePragma :: Maybe (PhaseControl dom) -> Name dom -> TopLevelPragma dom
+mkInlinablePragma phase name
+  = mkAnn ("{-# INLINEABLE " <> child <> child <> " #-}") 
+     $ UInlinablePragma (mkAnnMaybe (optAfter " ") phase) name
+
+-- | A pragma for maintaining line numbers in generated sources (@ {-\# LINE 123 "somefile" \#-} @)
+mkLinePragma :: Int -> Maybe (StringNode dom) -> TopLevelPragma dom
+mkLinePragma line filename 
+  = mkAnn ("{-# LINE " <> child <> child <> " #-}") 
+     $ ULinePragma (mkAnn child $ LineNumber line) (mkAnnMaybe (optBefore " ") filename)
+
+-- | A pragma that tells the compiler that a polymorph function should be optimized for a given type (@ {-\# SPECIALISE f :: Int -> b -> b \#-} @)
+mkSpecializePragma :: Maybe (PhaseControl dom) -> Name dom -> [Type dom] -> TopLevelPragma dom
+mkSpecializePragma phase def specTypes 
+  = mkAnn ("{-# SPECIALIZE " <> child <> child <> " " <> child <> " #-}") 
+     $ USpecializePragma (mkAnnMaybe (optBefore " ") phase) def $ mkAnnList (listSep ", ") specTypes
+
+-- | Marks that the pragma should be applied from a given compile phase (@ [2] @)
+mkPhaseControlFrom :: Integer -> PhaseControl dom
+mkPhaseControlFrom phaseNum 
+  = mkAnn ("[" <> child <> child <> "]") $ UPhaseControl (mkAnnMaybe opt Nothing) (mkAnn child $ PhaseNumber phaseNum)
+
+-- | Marks that the pragma should be applied until a given compile phase (@ [~2] @)
+mkPhaseControlUntil :: Integer -> PhaseControl dom
+mkPhaseControlUntil phaseNum 
+  = mkAnn ("[" <> child <> child <> "]") $ UPhaseControl (mkAnnMaybe opt $ Just $ mkAnn "~" PhaseInvert) 
+                                                         (mkAnn child $ PhaseNumber phaseNum)
+
+-- | A rewrite rule (@ "map/map" forall f g xs. map f (map g xs) = map (f.g) xs @)
+mkRewriteRule :: String -> Maybe (PhaseControl dom) -> [TyVar dom] -> Expr dom -> Expr dom -> Rule dom
+mkRewriteRule name phase vars lhs rhs
+  = mkAnn (child <> " " <> child <> child <> child <> " = " <> child)
+      $ URule (mkAnn ("\"" <> child <> "\"") $ UStringNode name) (mkAnnMaybe (optAfter " ") phase)
+              (mkAnnList (listSepBeforeAfter " " "forall " ". ") vars) lhs rhs
+
+-- | The definition with the given name is annotated
+mkNameAnnotation :: Name dom -> AnnotationSubject dom
+mkNameAnnotation name = mkAnn child $ UNameAnnotation name
+
+-- | A type with the given name is annotated
+mkTypeAnnotation :: Name dom -> AnnotationSubject dom
+mkTypeAnnotation name = mkAnn ("type " <> child) $ UTypeAnnotation name
+
+-- | The whole module is annotated
+mkModuleAnnotation :: AnnotationSubject dom
+mkModuleAnnotation = mkAnn "module" UModuleAnnotation
+
+-- | A @CONLIKE@ modifier for an @INLINE@ pragma.
+mkConlikeAnnotation :: ConlikeAnnot dom
+mkConlikeAnnotation = mkAnn "CONLIKE" UConlikeAnnot
+ Language/Haskell/Tools/AST/Gen/Exprs.hs view
@@ -0,0 +1,316 @@+-- | Generation of expression-level AST fragments for refactorings.
+-- The bindings defined here create a the annotated version of the AST constructor with the same name.
+-- For example, @mkApp@ creates the annotated version of the @App@ AST constructor.
+{-# LANGUAGE OverloadedStrings 
+           , TypeFamilies
+           #-}
+module Language.Haskell.Tools.AST.Gen.Exprs where
+
+import qualified Name as GHC
+import Data.List
+import Data.String
+import Data.Function (on)
+import Control.Reference
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AST.ElementTypes
+import Language.Haskell.Tools.AST.Gen.Utils
+import Language.Haskell.Tools.AST.Gen.Names
+import Language.Haskell.Tools.Transform
+
+-- * Expressions
+
+-- | Create a expression for a variable or a data constructor (@ a @)
+mkVar :: Name dom -> Expr dom
+mkVar = mkAnn child . UVar
+
+-- | Create a literal expression (@ 42 @)
+mkLit :: Literal dom -> Expr dom
+mkLit = mkAnn child . ULit
+
+-- | Create a infix operator application expression (@ a + b @)
+mkInfixApp :: Expr dom -> Operator dom -> Expr dom -> Expr dom
+mkInfixApp lhs op rhs = mkAnn (child <> " " <> child <> " " <> child) $ UInfixApp lhs op rhs
+
+-- | Create a prefix operator application expression (@ -x @)
+mkPrefixApp :: Operator dom -> Expr dom -> Expr dom
+mkPrefixApp op rhs = mkAnn (child <> child) $ UPrefixApp op rhs
+
+-- | Create a function application expression (@ f 4 @)
+mkApp :: Expr dom -> Expr dom -> Expr dom
+mkApp f e = mkAnn (child <> " " <> child) (UApp f e)
+
+-- | Create a lambda expression (@ \\a b -> a + b @)
+mkLambda :: [Pattern dom] -> Expr dom -> Expr dom
+mkLambda pats rhs = mkAnn ("\\" <> child <> " -> " <> child) $ ULambda (mkAnnList (listSep " ") pats) rhs
+
+-- | Create a local binding (@ let x = 2; y = 3 in e x y @)
+mkLet :: [LocalBind dom] -> Expr dom -> Expr dom
+mkLet pats expr = mkAnn ("let " <> child <> " in " <> child) $ ULet (mkAnnList indentedList pats) expr
+
+-- | Create a if expression (@ if a then b else c @)
+mkIf :: Expr dom -> Expr dom -> Expr dom -> Expr dom
+mkIf cond then_ else_ = mkAnn ("if " <> child <> " then " <> child <> " else " <> child) $ UIf cond then_ else_
+
+-- | Create a multi way if expressions with @MultiWayIf@ extension (@ if | guard1 -> expr1; guard2 -> expr2 @)
+mkMultiIf :: [GuardedCaseRhs dom] -> Expr dom
+mkMultiIf cases = mkAnn ("if" <> child) $ UMultiIf (mkAnnList indentedList cases)
+
+-- | Create a pattern matching expression (@ case expr of pat1 -> expr1; pat2 -> expr2 @)
+mkCase :: Expr dom -> [Alt dom] -> Expr dom
+mkCase expr cases = mkAnn ("case " <> child <> " of " <> child) $ UCase expr (mkAnnList indentedList cases)
+
+-- | Create a do-notation expressions (@ do x <- act1; act2 @)
+mkDoBlock :: [Stmt dom] -> Expr dom
+mkDoBlock stmts = mkAnn (child <> " " <> child) $ UDo (mkAnn "do" UDoKeyword) (mkAnnList indentedList stmts)
+
+-- | Create a tuple expression (@ (e1, e2, e3) @)
+mkTuple :: [Expr dom] -> Expr dom
+mkTuple exprs = mkAnn ("(" <> child <> ")") $ UTuple (mkAnnList (listSep ", ") exprs)
+
+-- | Create a unboxed tuple expression (@ (\# e1, e2, e3 \#) @)
+mkUnboxedTuple :: [Expr dom] -> Expr dom
+mkUnboxedTuple exprs = mkAnn ("(# " <> child <> " #)") $ UTuple (mkAnnList (listSep ", ") exprs)
+
+-- | Create a tuple section, enabled with @TupleSections@ (@ (a,,b) @). One of the elements must be missing.
+mkTupleSection :: [Maybe (Expr dom)] -> Expr dom
+mkTupleSection elems 
+  = let tupSecs = map (maybe (mkAnn "" Missing) (mkAnn child . Present)) elems
+     in mkAnn ("(" <> child <> ")") $ UTupleSection (mkAnnList (listSep ", ") tupSecs)
+
+-- | Create a unboxed tuple section, enabled with @TupleSections@ (@ (\#a,,b\#) @). One of the elements must be missing.
+mkTupleUnboxedSection :: [Maybe (Expr dom)] -> Expr dom
+mkTupleUnboxedSection elems 
+  = let tupSecs = map (maybe (mkAnn "" Missing) (mkAnn child . Present)) elems
+     in mkAnn ("(" <> child <> ")") $ UTupleSection (mkAnnList (listSep ", ") tupSecs)
+
+-- | Create a list expression: @[1,2,3]@
+mkList :: [Expr dom] -> Expr dom
+mkList exprs = mkAnn ("[" <> child <> "]") $ UList (mkAnnList (listSep ", ") exprs)
+
+-- | Create a parallel array expression: @[: 1,2,3 :]@
+mkParArray :: [Expr dom] -> Expr dom
+mkParArray exprs = mkAnn ("[: " <> child <> " :]") $ UParArray (mkAnnList (listSep ", ") exprs)
+
+-- | Create a parenthesized expression: @( a + b )@
+mkParen :: Expr dom -> Expr dom
+mkParen = mkAnn ("(" <> child <> ")") . UParen
+
+-- | Create a left operator section: @(1+)@
+mkLeftSection :: Expr dom -> Operator dom -> Expr dom
+mkLeftSection lhs op = mkAnn ("(" <> child <> child <> ")") $ ULeftSection lhs op
+
+-- | Create a right operator section: @(+1)@
+mkRightSection :: Operator dom -> Expr dom -> Expr dom
+mkRightSection op rhs = mkAnn ("(" <> child <> child <> ")") $ URightSection op rhs
+
+-- | Create a record value construction: @Point { x = 3, y = -2 }@
+mkRecCon :: Name dom -> [FieldUpdate dom] -> Expr dom
+mkRecCon name flds = mkAnn (child <> " { " <> child <> " }") $ URecCon name (mkAnnList (listSep ", ") flds)
+
+-- | Create a record value  update: @p1 { x = 3, y = -2 }@
+mkRecUpdate :: Expr dom -> [FieldUpdate dom] -> Expr dom
+mkRecUpdate expr flds = mkAnn (child <> " { " <> child <> " }") $ URecUpdate expr (mkAnnList (listSep ", ") flds)
+
+-- | Create a enumeration expression (@ [1,3..10] @)
+mkEnum :: Expr dom -> Maybe (Expr dom) -> Maybe (Expr dom) -> Expr dom
+mkEnum from step to = mkAnn ("[" <> child <> child <> ".." <> child <> "]") $ UEnum from (mkAnnMaybe (optBefore ",") step) (mkAnnMaybe (optBefore ",") to)
+
+-- | Create a parallel array enumeration (@ [: 1,3 .. 10 :] @)
+mkParArrayEnum :: Expr dom -> Maybe (Expr dom) -> Expr dom -> Expr dom
+mkParArrayEnum from step to
+  = mkAnn ("[: " <> child <> child <> ".." <> child <> " :]") 
+      $ UParArrayEnum from (mkAnnMaybe (optBefore ",") step) to
+
+-- | Create a list comprehension (@ [ (x, y) | x <- xs | y <- ys ] @)
+mkListComp :: Expr dom -> [ListCompBody dom] -> Expr dom
+mkListComp expr stmts 
+  = mkAnn ("[ " <> child <> " | " <> child <> " ]") 
+      $ UListComp expr $ mkAnnList (listSep " | ") stmts
+
+-- | Create a parallel array comprehensions @ [: (x, y) | x <- xs , y <- ys :] @ enabled by @ParallelArrays@
+mkParArrayComp :: Expr dom -> [ListCompBody dom] -> Expr dom
+mkParArrayComp expr stmts 
+  = mkAnn ("[: " <> child <> " | " <> child <> " :]") 
+      $ UParArrayComp expr $ mkAnnList (listSep " | ") stmts
+
+-- | Create a explicit type signature (@ x :: Int @)
+mkExprTypeSig :: Expr dom -> Type dom -> Expr dom
+mkExprTypeSig lhs typ = mkAnn (child <> " :: " <> child) $ UTypeSig lhs typ
+
+-- | Create a explicit type application (@ show \@Integer (read "5") @)
+mkExplicitTypeApp :: Expr dom -> Type dom -> Expr dom
+mkExplicitTypeApp expr typ = mkAnn (child <> " @" <> child) $ UExplTypeApp expr typ
+
+-- | @'x@ for template haskell reifying of expressions
+mkVarQuote :: Name dom -> Expr dom
+mkVarQuote = mkAnn ("'" <> child) . UVarQuote
+
+-- | @''T@ for template haskell reifying of types
+mkTypeQuote :: Name dom -> Expr dom
+mkTypeQuote = mkAnn ("''" <> child) . UTypeQuote
+
+-- | Create a template haskell bracket expression
+mkBracketExpr :: Bracket dom -> Expr dom
+mkBracketExpr = mkAnn child . UBracketExpr
+
+-- | Create a template haskell splice expression, for example: @$(gen a)@ or @$x@
+mkSpliceExpr :: Splice dom -> Expr dom
+mkSpliceExpr = mkAnn child . USplice
+
+-- | Create a template haskell quasi quote expression, for example: @[quoter| a + b ]@
+mkQuasiQuoteExpr :: QuasiQuote dom -> Expr dom
+mkQuasiQuoteExpr = mkAnn child . UQuasiQuoteExpr
+
+-- | Creates a pragma that marks an expression.
+mkExprPragma :: ExprPragma dom -> Expr dom -> Expr dom
+mkExprPragma pragma expr = mkAnn (child <> " " <> child) $ UExprPragma pragma expr
+
+-- | Create a arrow definition: @proc a -> f -< a+1@
+mkProcExpr :: Pattern dom -> Cmd dom -> Expr dom
+mkProcExpr pat cmd = mkAnn ("proc " <> child <> " -> " <> child) $ UProc pat cmd
+
+-- | Create a arrow definition: @proc a -> f -< a+1@
+mkArrowApp :: Expr dom -> ArrowApp dom -> Expr dom -> Expr dom
+mkArrowApp lhs arrow rhs = mkAnn (child <> " " <> child <> " " <> child) $ UArrowApp lhs arrow rhs
+
+-- | Create a lambda case ( @\case 0 -> 1; 1 -> 2@ )
+mkLambdaCase :: [Alt dom] -> Expr dom
+mkLambdaCase = mkAnn ("\\case" <> child) . ULamCase . mkAnnList indentedList
+
+-- | Create a static pointer expression (@ static e @). The inner expression must be closed (cannot have variables bound outside)
+mkStaticPointer :: Expr dom -> Expr dom
+mkStaticPointer = mkAnn ("static" <> child) . UStaticPtr
+
+
+
+-- * Field updates
+
+-- | Create a update of a field (@ x = 1 @)
+mkFieldUpdate :: Name dom -> Expr dom -> FieldUpdate dom
+mkFieldUpdate name val = mkAnn (child <> " = " <> child) $ UNormalFieldUpdate name val
+
+-- | Create a update the field to the value of the same name (@ x @)
+mkFieldPun :: Name dom -> FieldUpdate dom
+mkFieldPun name = mkAnn child $ UFieldPun name
+
+-- | Create a update the fields of the bounded names to their values (@ .. @). Must be the last initializer. Cannot be used in a record update expression.
+mkFieldWildcard :: FieldUpdate dom
+mkFieldWildcard = mkAnn child $ UFieldWildcard $ mkAnn ".." FldWildcard
+
+
+-- * Pattern matching and guards
+
+-- | Create a clause of case expression (@ Just x -> x + 1 @)
+mkAlt :: Pattern dom -> CaseRhs dom -> Maybe (LocalBinds dom) -> Alt dom
+mkAlt pat rhs locals = mkAnn (child <> child <> child) $ UAlt pat rhs (mkAnnMaybe (optBefore " where ") locals)
+
+-- | Create a unguarded right-hand side a pattern match (@ -> 3 @)
+mkCaseRhs :: Expr dom -> CaseRhs dom
+mkCaseRhs = mkAnn (" -> " <> child) . UUnguardedCaseRhs
+
+-- | Create a guarded right-hand sides of a pattern match (@ | x == 1 -> 3; | otherwise -> 4 @)
+mkGuardedCaseRhss :: [GuardedCaseRhs dom] -> CaseRhs dom
+mkGuardedCaseRhss = mkAnn child . UGuardedCaseRhss . mkAnnList indentedList
+
+-- | Creates a guarded right-hand side of pattern matches binding (@ | x > 3 -> 2 @)      
+mkGuardedCaseRhs :: [RhsGuard dom] -> Expr dom -> GuardedCaseRhs dom
+mkGuardedCaseRhs guards expr = mkAnn (" | " <> child <> " -> " <> child) $ UGuardedCaseRhs (mkAnnList (listSep ", ") guards) expr
+
+-- * Pragmas that can be applied to expressions
+
+-- | Creates a @CORE@ pragma for adding notes to expressions.
+mkCorePragma :: String -> ExprPragma dom
+mkCorePragma = mkAnn ("{-# CORE " <> child <> " #-}") . UCorePragma 
+                 . mkAnn ("\"" <> child <> "\"") . UStringNode
+
+-- | Creates an @SCC@ pragma for defining cost centers for profiling
+mkSccPragma :: String -> ExprPragma dom
+mkSccPragma = mkAnn ("{-# SCC " <> child <> " #-}") . USccPragma 
+                . mkAnn ("\"" <> child <> "\"") . UStringNode
+
+-- | Creates a pragma that describes if an expression was generated from a code fragment by an external tool (@ {-\# GENERATED "Happy.y" 1:15-1:25 \#-} @)
+mkGeneratedPragma :: SourceRange dom -> ExprPragma dom
+mkGeneratedPragma = mkAnn ("{-# GENERATED " <> child <> " #-}") . UGeneratedPragma 
+
+-- | Create a in-AST source ranges (for generated pragmas)
+mkSourceRange :: String -> Integer -> Integer -> Integer -> Integer -> SourceRange dom
+mkSourceRange file fromLine fromCol toLine toCol
+  = mkAnn (child <> " " <> child <> ":" <> child <> "-" <> child <> ":" <> child)
+      $ USourceRange (mkAnn ("\"" <> child <> "\"") $ UStringNode file)
+          (mkNumber fromLine) (mkNumber fromCol) (mkNumber toLine) (mkNumber toCol)
+  where mkNumber = mkAnn child . Number
+
+-- * Commands
+
+-- | An arrow application command (@ f -< x + 1 @)
+mkArrowAppCmd :: Expr dom -> ArrowApp dom -> Expr dom -> Cmd dom
+mkArrowAppCmd lhs arrow rhs 
+  = mkAnn (child <> " " <> child <> " " <> child)
+      $ UArrowAppCmd lhs arrow rhs
+
+-- | A form command (@ (|untilA (increment -< x+y) (within 0.5 -< x)|) @)
+mkArrowFromCmd :: Expr dom -> [Cmd dom] -> Cmd dom
+mkArrowFromCmd expr cmds 
+  = mkAnn ("(| " <> child <> child <> " |)")
+      $ UArrowFormCmd expr $ mkAnnList (listSepBefore " " " ") cmds
+
+-- | A function application command
+mkAppCmd :: Cmd dom -> Expr dom -> Cmd dom
+mkAppCmd cmd expr = mkAnn (child <> " " <> child)
+                      $ UAppCmd cmd expr
+
+-- | An infix command application
+mkInfixCmd :: Cmd dom -> Name dom -> Cmd dom -> Cmd dom
+mkInfixCmd lhs op rhs = mkAnn (child <> " " <> child <> " " <> child)
+                          $ UInfixCmd lhs op rhs
+
+-- | A lambda command 
+mkLambdaCmd :: [Pattern dom] -> Cmd dom -> Cmd dom
+mkLambdaCmd args cmd = mkAnn ("\\" <> child <> " -> " <> child)
+                         $ ULambdaCmd (mkAnnList (listSep " ") args) cmd
+
+-- | A parenthesized command
+mkParenCmd :: Cmd dom -> Cmd dom
+mkParenCmd cmd = mkAnn ("(" <> child <> ")") $ UParenCmd cmd
+
+-- | A pattern match command
+mkCaseCmd :: Expr dom -> [CmdAlt dom] -> Cmd dom
+mkCaseCmd expr alts 
+  = mkAnn ("case " <> child <> " of " <> child) 
+      $ UCaseCmd expr $ mkAnnList indentedList alts
+
+-- | An if command (@ if f x y then g -< x+1 else h -< y+2 @)
+mkIfCmd :: Expr dom -> Cmd dom -> Cmd dom -> Cmd dom
+mkIfCmd pred then_ else_ 
+  = mkAnn ("if " <> child <> " then " <> child <> " else " <> child) 
+      $ UIfCmd pred then_ else_
+
+-- | A local binding command (@ let z = x+y @)
+mkLetCmd :: [LocalBind dom] -> Cmd dom -> Cmd dom
+mkLetCmd binds cmd
+  = mkAnn ("let " <> child <> " in " <> child) 
+      $ ULetCmd (mkAnnList indentedList binds) cmd
+
+-- | A do-notation in a command
+mkDoCmd :: [CmdStmt dom] -> Cmd dom
+mkDoCmd stmts = mkAnn ("do " <> child) $ UDoCmd (mkAnnList indentedList stmts)
+
+-- | Left arrow application: @-<@
+mkLeftAppl :: ArrowApp dom
+mkLeftAppl = mkAnn "-<" ULeftAppl
+
+-- | Right arrow application: @>-@
+mkRightAppl :: ArrowApp dom
+mkRightAppl = mkAnn ">-" URightAppl
+
+-- | Left arrow high application: @-<<@
+mkLeftHighAppl :: ArrowApp dom
+mkLeftHighAppl = mkAnn "-<<" ULeftHighApp
+
+-- | Right arrow high application: @>>-@
+mkRightHighAppl :: ArrowApp dom
+mkRightHighAppl = mkAnn ">>-" URightHighApp
+
+
+
+
+ Language/Haskell/Tools/AST/Gen/Kinds.hs view
@@ -0,0 +1,73 @@+-- | Generation of statement-level AST fragments for refactorings.
+-- The bindings defined here are the AST constructor names with an "mk" prefix.
+{-# LANGUAGE OverloadedStrings 
+           , TypeFamilies 
+           #-}
+module Language.Haskell.Tools.AST.Gen.Kinds where
+
+import qualified Name as GHC
+import Data.List
+import Data.String
+import Data.Function (on)
+import Control.Reference
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AST.ElementTypes
+import Language.Haskell.Tools.AST.Gen.Utils
+import Language.Haskell.Tools.AST.Gen.Names
+import Language.Haskell.Tools.Transform
+
+-- | Kind constraint (@ :: * -> * @)
+mkKindConstraint :: Kind dom -> KindConstraint dom
+mkKindConstraint = mkAnn (" :: " <> child) . UKindConstraint
+
+-- | @*@, the kind of types
+mkKindStar :: Kind dom
+mkKindStar = mkAnn "*" UStarKind
+
+-- | @#@, the kind of unboxed types
+mkKindUnbox :: Kind dom
+mkKindUnbox = mkAnn "#" UUnboxKind
+
+-- | @->@, the kind of type constructor
+mkKindFun :: Kind dom -> Kind dom -> Kind dom
+mkKindFun lhs rhs = mkAnn (child <> " -> " <> child) $ UFunKind lhs rhs
+
+-- | A parenthesised kind
+mkKindParen :: Kind dom -> Kind dom
+mkKindParen = mkAnn ("(" <> child <> ")") . UParenKind
+
+-- | Kind variable (using @PolyKinds@ extension)
+mkKindVar :: Name dom -> Kind dom
+mkKindVar = mkAnn child . UVarKind
+
+-- | Kind application (@ k1 k2 @)
+mkKindApp :: Kind dom -> Kind dom -> Kind dom
+mkKindApp lhs rhs = mkAnn (child <> " " <> child) $ UAppKind lhs rhs
+
+-- | A list kind (@ [k] @)
+mkKindList :: Kind dom -> Kind dom
+mkKindList = mkAnn ("[" <> child <> "]") . UListKind
+
+-- | Numeric value promoted to the kind level.
+mkIntKind :: Integer -> Kind dom
+mkIntKind i = mkAnn child $ UPromotedKind $ mkAnn (fromString $ show i) (UPromotedInt i)
+
+-- | String value promoted to the kind level.
+mkStringKind :: String -> Kind dom
+mkStringKind i = mkAnn child $ UPromotedKind $ mkAnn (fromString $ show i) (UPromotedString i)
+
+-- | A data constructor value promoted to the kind level.
+mkConKind :: Name dom -> Kind dom
+mkConKind = mkAnn child . UPromotedKind . mkAnn child . UPromotedCon
+
+-- | A list of elements as a kind.
+mkListKind :: [Kind dom] -> Kind dom
+mkListKind = mkAnn child . UPromotedKind . mkAnn ("[" <> child <> "]") . UPromotedList . mkAnnList (listSep ", ")
+
+-- | A tuple of elements as a kind.
+mkTupleKind :: [Kind dom] -> Kind dom
+mkTupleKind = mkAnn child . UPromotedKind . mkAnn ("(" <> child <> ")") . UPromotedTuple . mkAnnList (listSep ", ")
+
+-- | Kind of the unit value @()@. 
+mkUnitKind :: Kind dom
+mkUnitKind = mkAnn child $ UPromotedKind $ mkAnn "()" UPromotedUnit
+ Language/Haskell/Tools/AST/Gen/Literals.hs view
@@ -0,0 +1,57 @@+-- | Generation of literals for refactorings.
+-- The bindings defined here are the AST constructor names with an "mk" prefix.
+{-# LANGUAGE OverloadedStrings 
+           , TypeFamilies 
+           #-}
+module Language.Haskell.Tools.AST.Gen.Literals where
+
+import qualified Name as GHC
+import Data.List
+import Data.String
+import Data.Function (on)
+import Control.Reference
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AST.ElementTypes
+import Language.Haskell.Tools.AST.Gen.Utils
+import Language.Haskell.Tools.AST.Gen.Names
+import Language.Haskell.Tools.Transform
+
+-- | Character literal: @'c'@
+mkCharLit :: Char -> Literal dom
+mkCharLit c = mkAnn (fromString $ show c) $ UCharLit c
+
+-- | String literal: @"abc"@
+mkStringLit :: String -> Literal dom
+mkStringLit s = mkAnn (fromString $ show s) $ UStringLit s
+
+-- | Integer literal: @12@
+mkIntLit :: Integer -> Literal dom
+mkIntLit i = mkAnn (fromString $ show i) $ UIntLit i
+
+-- | Fractional literal: @3.14@
+mkFracLit :: Rational -> Literal dom
+mkFracLit f = mkAnn (fromString $ show f) $ UFracLit f
+
+-- | Primitive integer literal (of type @Int#@): @32#@
+mkPrimIntLit :: Integer -> Literal dom
+mkPrimIntLit i = mkAnn (fromString $ show i ++ "#") $ UPrimIntLit i
+
+-- | Primitive word literal (of type @Word#@): @32##@
+mkPrimWordLit :: Integer -> Literal dom
+mkPrimWordLit i = mkAnn (fromString $ show i ++ "##") $ UPrimWordLit i
+
+-- | Primitive float literal (of type @Float#@): @3.14#@
+mkPrimFloatLit :: Rational -> Literal dom
+mkPrimFloatLit f = mkAnn (fromString $ show f ++ "#") $ UPrimFloatLit f
+
+-- | Primitive double literal (of type @Double#@): @3.14##@
+mkPrimDoubleLit :: Rational -> Literal dom
+mkPrimDoubleLit f = mkAnn (fromString $ show f ++ "##") $ UPrimDoubleLit f
+
+-- | Primitive character literal (of type @Char#@): @'c'#@
+mkPrimCharLit :: Char -> Literal dom
+mkPrimCharLit c = mkAnn (fromString $ show c ++ "#") $ UPrimCharLit c
+
+-- | Primitive string literal (of type @Addr#@): @"xxx"#@
+mkPrimStringLit :: String -> Literal dom
+mkPrimStringLit s = mkAnn (fromString $ show s ++ "#") $ UPrimStringLit s
+ Language/Haskell/Tools/AST/Gen/Modules.hs view
@@ -0,0 +1,103 @@+-- | Generation of UModule-level AST fragments for refactorings.
+-- The bindings defined here create a the annotated version of the AST constructor with the same name.
+-- For example, @mkModule@ creates the annotated version of the @UModule@ AST constructor.
+{-# LANGUAGE OverloadedStrings
+           , TypeFamilies
+           #-}
+module Language.Haskell.Tools.AST.Gen.Modules where
+
+import qualified Name as GHC
+import Data.List
+import Data.String
+import Data.Function (on)
+import Control.Reference
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AST.ElementTypes
+import Language.Haskell.Tools.AST.Gen.Utils
+import Language.Haskell.Tools.AST.Gen.Names
+import Language.Haskell.Tools.Transform
+
+-- | The representation of a haskell module, that is a separate compilation unit.
+-- It may or may not have a header.
+mkModule :: [FilePragma dom] -> Maybe (ModuleHead dom) -> [ImportDecl dom] -> [Decl dom] -> Module dom
+mkModule filePrags head imps decls 
+  = mkAnn (child <> child <> child <> child) 
+      $ UModule (mkAnnList (listSepAfter "\n" "\n") filePrags) (mkAnnMaybe opt head)
+                (mkAnnList (indentedListBefore "\n") imps) (mkAnnList (indentedListBefore "\n") decls)
+               
+-- | Module declaration with name and (optional) exports
+mkModuleHead :: ModuleName dom -> Maybe (ExportSpecs dom) -> Maybe (ModulePragma dom) -> ModuleHead dom
+mkModuleHead n es pr = mkAnn ("module " <> child <> child <> child <> " where") $ UModuleHead n (mkAnnMaybe opt es) (mkAnnMaybe (optBefore "\n") pr)
+
+-- | A list of export specifications surrounded by parentheses
+mkExportSpecs :: [ExportSpec dom] -> ExportSpecs dom
+mkExportSpecs = mkAnn ("(" <> child <> ")") . UExportSpecs . mkAnnList (listSep ", ")
+
+-- | Export a name and related names
+mkExportSpec :: IESpec dom -> ExportSpec dom
+mkExportSpec = mkAnn child . UDeclExport
+
+-- | The export of an imported module (@ module A @)
+mkModuleExport :: ModuleName dom -> ExportSpec dom
+mkModuleExport = mkAnn ("module " <> child) . UModuleExport
+
+-- | Marks a name to be imported or exported with related names (subspecifier)
+mkIESpec :: Name dom -> Maybe (SubSpec dom) -> IESpec dom
+mkIESpec name ss = mkAnn (child <> child) (UIESpec name (mkAnnMaybe opt ss))
+
+-- | @(a,b,c)@: a class exported with some of its methods, or a datatype exported with some of its constructors.
+mkSubList :: [Name dom] -> SubSpec dom
+mkSubList = mkAnn ("(" <> child <> ")") . USubSpecList . mkAnnList (listSep ", ")
+
+-- | @(..)@: a class exported with all of its methods, or a datatype exported with all of its constructors.
+mkSubAll :: SubSpec dom
+mkSubAll = mkAnn "(..)" USubSpecAll
+
+-- | An import declaration: @import Module.Name@         
+mkImportDecl :: Bool -> Bool -> Bool -> Maybe String -> ModuleName dom -> Maybe (ModuleName dom) -> Maybe (ImportSpec dom) 
+                  -> ImportDecl dom       
+mkImportDecl source qualified safe pkg name rename spec
+  = mkAnn ("import " <> child <> child <> child <> child <> child <> child <> child) $
+      UImportDecl (if source then justVal (mkAnn "{-# SOURCE #-} " UImportSource) else noth)
+                  (if qualified then justVal (mkAnn "qualified " UImportQualified) else noth)
+                  (if safe then justVal (mkAnn "safe " UImportSafe) else noth)
+                  (case pkg of Just str -> justVal (mkStringNode str); _ -> noth)
+                  name (mkAnnMaybe opt (fmap (mkAnn (" as " <> child) . UImportRenaming) rename)) (mkAnnMaybe opt spec)
+
+-- | Restrict the import definition to ONLY import the listed names
+mkImportSpecList :: [IESpec dom] -> ImportSpec dom
+mkImportSpecList = mkAnn ("(" <> child <> ")") . UImportSpecList . mkAnnList (listSep ", ")
+
+-- | Restrict the import definition to DONT import the listed names
+mkImportHidingList :: [IESpec dom] -> ImportSpec dom
+mkImportHidingList = mkAnn (" hiding (" <> child <> ")") . UImportSpecHiding . mkAnnList (listSep ", ")
+
+-- | The name of a module
+mkModuleName :: String -> ModuleName dom
+mkModuleName s = mkAnn (fromString s) (UModuleName s)
+
+-- * Pragmas
+
+-- | @LANGUAGE@ pragma, listing the enabled language extensions in that file
+mkLanguagePragma :: [String] -> FilePragma dom
+mkLanguagePragma extensions 
+  = mkAnn ("{-# LANGUAGE " <> child <> " #-}") $ ULanguagePragma 
+      $ mkAnnList (listSep ", ") (map (\ext -> mkAnn (fromString ext) (ULanguageExtension ext)) extensions)
+
+-- | @OPTIONS@ pragma, possibly qualified with a tool, e.g. OPTIONS_GHC
+mkOptionsGHC :: String -> FilePragma dom
+mkOptionsGHC opts 
+  = mkAnn ("{-# OPTIONS_GHC " <> child <> " #-}") $ UOptionsPragma 
+      $ mkStringNode opts
+
+-- | A warning pragma attached to the module
+mkModuleWarningPragma :: [String] -> ModulePragma dom
+mkModuleWarningPragma msg 
+  = mkAnn ("{-# WARNING " <> child <> " #-}") $ UModuleWarningPragma 
+      $ mkAnnList (listSep " ") $ map mkStringNode msg
+
+-- | A deprecated pragma attached to the module
+mkModuleDeprecatedPragma :: [String] -> ModulePragma dom
+mkModuleDeprecatedPragma msg 
+  = mkAnn ("{-# DEPRECATED " <> child <> " #-}") $ UModuleDeprecatedPragma 
+      $ mkAnnList (listSep " ") $ map mkStringNode msg
+ Language/Haskell/Tools/AST/Gen/Names.hs view
@@ -0,0 +1,88 @@+-- | Generation of basic AST fragments (names for example) for refactorings
+{-# LANGUAGE OverloadedStrings
+           , ViewPatterns
+           , TypeFamilies
+           #-}
+module Language.Haskell.Tools.AST.Gen.Names where
+
+import qualified Name as GHC
+import qualified Module as GHC
+import Data.List
+import Data.String
+import Data.Function (on)
+import Control.Reference
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AST.ElementTypes
+import Language.Haskell.Tools.AST.Gen.Utils
+import Language.Haskell.Tools.Transform
+
+-- | Creates a simple, unqualified name
+mkName :: String -> Name dom
+mkName = mkNormalName . mkSimpleName
+
+mkQualOp :: [String] -> String -> Operator dom
+mkQualOp quals = mkAnn child . UNormalOp . mkQualifiedName quals
+
+mkBacktickOp :: [String] -> String -> Operator dom
+mkBacktickOp quals = mkAnn ("`" <> child <> "`") . UBacktickOp . mkQualifiedName quals
+
+-- | Creates an annotated qualified operator: @A.B.+@ or @\`A.B.mod\`@.
+mkQualOp' :: [String] -> GHC.Name -> Operator dom
+mkQualOp' quals n | GHC.isSymOcc (GHC.getOccName n) = mkAnn child $ UNormalOp $ mkQualifiedName' quals n
+                  | otherwise                       = mkAnn ("`" <> child <> "`") $ UBacktickOp $ mkQualifiedName' quals n
+
+-- | Creates an annotated unqualified operator: @+@ or @\`mod\`@.
+mkUnqualOp' :: GHC.Name -> Operator dom
+mkUnqualOp' n | GHC.isSymOcc (GHC.getOccName n) = mkAnn child $ UNormalOp $ mkSimpleName' n
+              | otherwise                       = mkAnn ("`" <> child <> "`") $ UBacktickOp $ mkSimpleName' n
+  
+mkUnqualOp :: String -> Operator dom
+mkUnqualOp = mkAnn child . UNormalOp . mkSimpleName
+
+-- | Creates an annotated qualified (non-operator) binding name: @A.B.f@ or @(A.B.+)@
+mkQualName' :: [String] -> GHC.Name -> Name dom
+mkQualName' quals n | GHC.isSymOcc (GHC.getOccName n) = mkAnn ("(" <> child <> ")") $ UParenName $ mkQualifiedName' quals n
+                    | otherwise                       = mkAnn child $ UNormalName $ mkQualifiedName' quals n
+
+-- | Creates an annotated unqualified (non-operator) binding name: @f@ or @(+)@
+mkUnqualName' :: GHC.Name -> Name dom
+mkUnqualName' n | GHC.isSymOcc (GHC.getOccName n) = mkAnn ("(" <> child <> ")") $ UParenName $ mkSimpleName' n
+                | otherwise                       = mkAnn child $ UNormalName $ mkSimpleName' n
+
+mkNormalName :: QualifiedName dom -> Name dom
+mkNormalName = mkAnn child . UNormalName
+
+-- | Creates a parenthesized name: @ foldl (+) 0 @
+mkParenName :: QualifiedName dom -> Name dom
+mkParenName = mkAnn ("(" <> child <> ")") . UParenName
+
+-- | Creates an implicit name: @ ?var @
+mkImplicitName :: QualifiedName dom -> Name dom
+mkImplicitName = mkAnn ("?" <> child) . UImplicitName
+
+-- | Creates an annotated qualified simple name
+mkQualifiedName' :: [String] -> GHC.Name -> QualifiedName dom
+mkQualifiedName' quals n = mkQualifiedName quals (GHC.occNameString $ GHC.getOccName n)
+
+mkQualifiedName :: [String] -> String -> QualifiedName dom
+mkQualifiedName [] n = mkSimpleName n
+mkQualifiedName quals name
+  = mkAnn (child <> "." <> child)
+          (UQualifiedName (mkAnnList (listSep ".") $ map mkNamePart quals) (mkNamePart name))
+
+-- | Creates a part of a qualified name.         
+mkNamePart :: String -> NamePart dom
+mkNamePart s = mkAnn (fromString s) (UNamePart s)
+
+-- | Creates a simple (unqualified) name
+mkSimpleName' :: GHC.Name -> QualifiedName dom
+mkSimpleName' = mkSimpleName . GHC.occNameString . GHC.getOccName
+
+-- | Creates a simple (unqualified) name
+mkSimpleName :: String -> QualifiedName dom
+mkSimpleName n = mkAnn (child <> child) 
+                       (UQualifiedName emptyList (mkNamePart n))
+
+-- | Creates a quoted text
+mkStringNode :: String -> StringNode dom
+mkStringNode s = mkAnn (fromString s) (UStringNode s)
+ Language/Haskell/Tools/AST/Gen/Patterns.hs view
@@ -0,0 +1,102 @@+-- | Generation of pattern-level AST fragments for refactorings.
+-- The bindings defined here create a the annotated version of the AST constructor with the same name.
+-- For example, @mkVarPat@ creates the annotated version of the @VarPat@ AST constructor.
+{-# LANGUAGE OverloadedStrings 
+           , TypeFamilies
+           #-}
+module Language.Haskell.Tools.AST.Gen.Patterns where
+
+import qualified Name as GHC
+import Data.List
+import Data.String
+import Data.Function (on)
+import Control.Reference
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AST.ElementTypes
+import Language.Haskell.Tools.AST.Gen.Utils
+import Language.Haskell.Tools.AST.Gen.Names
+import Language.Haskell.Tools.Transform
+
+-- | Pattern name binding
+mkVarPat :: Name dom -> Pattern dom
+mkVarPat = mkAnn child . UVarPat
+
+-- | Literal pattern
+mkLitPat :: Literal dom -> Pattern dom
+mkLitPat = mkAnn child . ULitPat
+
+-- | Infix constructor application pattern (@ a :+: b @)
+mkInfixAppPat :: Pattern dom -> Operator dom -> Pattern dom -> Pattern dom
+mkInfixAppPat lhs op rhs = mkAnn (child <> " " <> child <> " " <> child) $ UInfixAppPat lhs op rhs
+
+-- | Constructor application pattern (@ Point x y @)
+mkAppPat :: Name dom -> [Pattern dom] -> Pattern dom
+mkAppPat n pat = mkAnn (child <> child) $ UAppPat n (mkAnnList (listSepBefore " " " ") pat)
+
+-- | Tuple pattern (@ (x,y) @)
+mkTuplePat :: [Pattern dom] -> Pattern dom
+mkTuplePat pats = mkAnn ("(" <> child <> ")") $ UTuplePat (mkAnnList (listSep ", ") pats)
+
+-- | Unboxed tuple pattern (@ (\# x, y \#) @)
+mkUnboxTuplePat :: [Pattern dom] -> Pattern dom
+mkUnboxTuplePat pats = mkAnn ("(# " <> child <> " #)") $ UUnboxTuplePat (mkAnnList (listSep ", ") pats)
+
+-- | List pattern (@ [1,2,a,x] @)
+mkListPat :: [Pattern dom] -> Pattern dom
+mkListPat pats = mkAnn ("[" <> child <> "]") $ UListPat (mkAnnList (listSep ", ") pats)
+
+-- | Parallel array pattern (@ [:1,2,a,x:] @)
+mkParArrayPat :: [Pattern dom] -> Pattern dom
+mkParArrayPat pats = mkAnn ("[:" <> child <> ":]") $ UParArrPat (mkAnnList (listSep ", ") pats)
+
+-- | Parenthesised patterns
+mkParenPat :: Pattern dom -> Pattern dom
+mkParenPat = mkAnn ("(" <> child <> ")") . UParenPat
+
+-- | Record pattern (@ Point { x = 3, y } @)
+mkRecPat :: Name dom -> [PatternField dom] -> Pattern dom
+mkRecPat name flds = mkAnn (child <> "{ " <> child <> " }") $ URecPat name (mkAnnList (listSep ", ") flds)
+
+-- | As-pattern (explicit name binding) (@ ls\@(hd:_) @)
+mkAsPat :: Name dom -> Pattern dom -> Pattern dom
+mkAsPat name pat = mkAnn (child <> "@" <> child) $ UAsPat name pat
+
+-- | Wildcard pattern: (@ _ @)
+mkWildPat :: Pattern dom
+mkWildPat = mkAnn "_" UWildPat
+
+-- | Irrefutable pattern (@ ~(x:_) @)
+mkIrrefutablePat :: Pattern dom -> Pattern dom
+mkIrrefutablePat = mkAnn ("~" <> child) . UIrrefutablePat
+
+-- | Bang pattern (@ !x @)
+mkBangPat :: Pattern dom -> Pattern dom
+mkBangPat = mkAnn ("!" <> child) . UBangPat
+
+-- | Pattern with explicit type signature (@ x :: Int @)
+mkTypeSigPat :: Pattern dom -> Type dom -> Pattern dom
+mkTypeSigPat pat typ = mkAnn (child <> " :: " <> child) $ UTypeSigPat pat typ
+
+-- | View pattern (@ f -> Just 1 @)
+mkViewPat :: Expr dom -> Pattern dom -> Pattern dom
+mkViewPat name pat = mkAnn (child <> " -> " <> child) $ UViewPat name pat
+
+-- | Splice patterns: @$(generateX inp)@
+mkSplicePat :: Splice dom -> Pattern dom
+mkSplicePat = mkAnn child . USplicePat
+
+-- | Quasi-quoted patterns: @[| 1 + 2 |]@
+mkQuasiQuotePat :: QuasiQuote dom -> Pattern dom
+mkQuasiQuotePat = mkAnn child . UQuasiQuotePat
+
+-- | Named field pattern (@ p = Point 3 2 @)
+mkPatternField :: Name dom -> Pattern dom -> PatternField dom
+mkPatternField name pat = mkAnn (child <> " = " <> child) $ UNormalFieldPattern name pat
+
+-- | Named field pun (@ p @)
+mkFieldPunPattern :: Name dom -> PatternField dom
+mkFieldPunPattern name = mkAnn child $ UFieldPunPattern name
+
+-- | Wildcard field pattern (@ .. @)
+mkFieldWildcardPattern :: PatternField dom
+mkFieldWildcardPattern = mkAnn child $ UFieldWildcardPattern $ mkAnn ".." FldWildcard
+ Language/Haskell/Tools/AST/Gen/Stmts.hs view
@@ -0,0 +1,73 @@+-- | Generation of statement-level AST fragments for refactorings.
+-- The bindings defined here are the AST constructor names with an "mk" prefix.
+{-# LANGUAGE OverloadedStrings 
+           , TypeFamilies 
+           #-}
+module Language.Haskell.Tools.AST.Gen.Stmts where
+
+import qualified Name as GHC
+import Data.List
+import Data.String
+import Data.Function (on)
+import Control.Reference
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AST.ElementTypes
+import Language.Haskell.Tools.AST.Gen.Utils
+import Language.Haskell.Tools.AST.Gen.Names
+import Language.Haskell.Tools.Transform
+
+-- | Creates a binding statement (@ x <- action @)
+mkBindStmt :: Pattern dom -> Expr dom -> Stmt dom
+mkBindStmt bound expr = mkAnn (child <> " <- " <> child) $ UBindStmt bound expr
+
+-- | Creates a non-binding statement (@ action @)
+mkExprStmt :: Expr dom -> Stmt dom
+mkExprStmt = mkAnn child . UExprStmt
+
+-- | Creates a let statement (@ let x = 3; y = 4 @)
+mkLetStmt :: [LocalBind dom] -> Stmt dom
+mkLetStmt = mkAnn ("let " <> child) . ULetStmt . mkAnnList indentedList
+
+-- | Creates a recursive binding statement with (@ rec b <- f a c; c <- f b a @)
+mkRecStmt :: [Stmt dom] -> Stmt dom
+mkRecStmt = mkAnn ("rec " <> child) . URecStmt . mkAnnList indentedList
+
+-- * List comprehensions
+
+-- | Body of a list comprehension: (@ | x <- [1..10] @)
+mkListCompBody :: [CompStmt dom] -> ListCompBody dom
+mkListCompBody = mkAnn child . UListCompBody . mkAnnList (listSep " ")
+
+-- | Normal monadic statement of a list comprehension
+mkCompStmt :: Stmt dom -> CompStmt dom
+mkCompStmt = mkAnn child . UCompStmt
+
+-- | Then statements by @TransformListComp@ (@ then sortWith by (x + y) @)
+mkThenStmt :: Expr dom -> Maybe (Expr dom) -> CompStmt dom
+mkThenStmt th by = mkAnn ("then " <> child) 
+                     $ UThenStmt th $ mkAnnMaybe (optBefore " by ") by
+
+-- | Grouping statements by @TransformListComp@ (@ then group by (x + y) using groupWith @) 
+mkGroupStmt :: Maybe (Expr dom) -> Maybe (Expr dom) -> CompStmt dom
+mkGroupStmt by using = mkAnn ("then group" <> child) 
+                         $ UGroupStmt (mkAnnMaybe (optBefore " by ") by)
+                                      (mkAnnMaybe (optBefore " using ") using)
+
+-- * Commands
+
+-- | Creates a binding command (@ x <- action @)
+mkBindCmd :: Pattern dom -> Cmd dom -> CmdStmt dom
+mkBindCmd bound expr = mkAnn (child <> " <- " <> child) $ UBindStmt bound expr
+
+-- | Creates a non-binding command (@ action @)
+mkExprCmd :: Cmd dom -> CmdStmt dom
+mkExprCmd = mkAnn child . UExprStmt
+
+-- | Creates a let command (@ let x = 3; y = 4 @)
+mkLetStmtCmd :: [LocalBind dom] -> CmdStmt dom
+mkLetStmtCmd = mkAnn ("let " <> child) . ULetStmt . mkAnnList indentedList
+
+-- | Creates a recursive binding command with (@ rec b <- f a c; c <- f b a @)
+mkRecCmd :: [CmdStmt dom] -> CmdStmt dom
+mkRecCmd = mkAnn ("rec " <> child) . URecStmt . mkAnnList indentedList
+
+ Language/Haskell/Tools/AST/Gen/TH.hs view
@@ -0,0 +1,46 @@+-- | Generation of Template Haskell AST fragments for refactorings.
+{-# LANGUAGE OverloadedStrings
+           , TypeFamilies 
+           #-}
+module Language.Haskell.Tools.AST.Gen.TH where
+
+import qualified Name as GHC
+import Data.List
+import Data.String
+import Data.Function (on)
+import Control.Reference
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AST.ElementTypes
+import Language.Haskell.Tools.AST.Gen.Names
+import Language.Haskell.Tools.AST.Gen.Utils
+import Language.Haskell.Tools.Transform
+
+-- | A simple name splice: @$generateX@
+mkIdSplice :: Name dom -> Splice dom
+mkIdSplice n = mkAnn ("$" <> child) $ UIdSplice n
+
+-- | A splice with parentheses: @$(generate input)@
+mkParenSplice :: Expr dom -> Splice dom
+mkParenSplice n = mkAnn ("$(" <> child <> ")") $ UParenSplice n
+
+-- | Template haskell quasi-quotation: @[quoter|str]@  
+mkQuasiQuote :: Name dom -> String -> QuasiQuote dom
+mkQuasiQuote n s = mkAnn ("[" <> child <> "|" <> child <> "|]")
+                     $ UQuasiQuote n (mkAnn (fromString s) (QQString s))
+
+-- | Expression bracket (@ [| x + y |] @)
+mkExprBracket :: Expr dom -> Bracket dom
+mkExprBracket = mkAnn ("[|" <> child <> "|]") . UExprBracket
+
+-- | Pattern bracket (@ [p| Point x y |] @)
+mkPatternBracket :: Pattern dom -> Bracket dom
+mkPatternBracket = mkAnn ("[p|" <> child <> "|]") . UPatternBracket
+
+-- | Type bracket (@ [t| (Int,Int) |] @)
+mkTypeBracket :: Type dom -> Bracket dom
+mkTypeBracket = mkAnn ("[t|" <> child <> "|]") . UTypeBracket
+
+-- | Declaration bracket (@ [d| f :: Int -> Int; f x = x*x |] @)
+mkDeclsBracket :: [Decl dom] -> Bracket dom
+mkDeclsBracket = mkAnn ("[d|" <> child <> "|]") . UDeclsBracket . mkAnnList indentedList
+
+ Language/Haskell/Tools/AST/Gen/Types.hs view
@@ -0,0 +1,164 @@+-- | Generation of type-level AST fragments for refactorings.
+-- The bindings defined here create a the annotated version of the AST constructor with the same name.
+-- For example, @mkTyForall@ creates the annotated version of the @TyForall@ AST constructor.
+{-# LANGUAGE OverloadedStrings
+           , TypeFamilies 
+           #-}
+module Language.Haskell.Tools.AST.Gen.Types where
+
+import qualified Name as GHC
+import Data.List
+import Data.String
+import Data.Function (on)
+import Control.Reference
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AST.ElementTypes
+import Language.Haskell.Tools.AST.Gen.Names
+import Language.Haskell.Tools.AST.Gen.Kinds
+import Language.Haskell.Tools.AST.Gen.Utils
+import Language.Haskell.Tools.Transform
+
+-- * Generation of types
+
+-- | Forall types (@ forall x y . type @)
+mkForallType :: [TyVar dom] -> Type dom -> Type dom
+mkForallType vars t = mkAnn ("forall " <> child <> " . " <> child) (UTyForall (mkAnnList (listSep " ") vars) t)
+
+-- | Simplified creation of type variables
+mkTypeVar' :: GHC.Name -> TyVar dom
+mkTypeVar' = mkTypeVar . mkUnqualName'
+
+-- | Type with a context (@ forall x y . type @)
+mkCtxType :: Context dom -> Type dom -> Type dom
+mkCtxType ctx t = mkAnn (child <> " " <> child) (UTyCtx ctx t)
+
+-- | Function types (@ a -> b @)
+mkFunctionType :: Type dom -> Type dom -> Type dom
+mkFunctionType at rt = mkAnn (child <> " -> " <> child) (UTyFun at rt)
+
+-- | Tuple types (@ (a,b) @)
+mkTupleType :: [Type dom] -> Type dom
+mkTupleType args = mkAnn ("(" <> child <> ")") (UTyTuple (mkAnnList (listSep ", ") args))
+
+-- | Unboxed tuple types (@ (\#a,b\#) @)
+mkUnboxedTupleType :: [Type dom] -> Type dom
+mkUnboxedTupleType args = mkAnn ("(#" <> child <> "#)") (UTyUnbTuple (mkAnnList (listSep ", ") args))
+
+-- | List type with special syntax (@ [a] @)
+mkListType :: Type dom -> Type dom
+mkListType = mkAnn ("[" <> child <> "]") . UTyList
+
+-- | Parallel array type (@ [:a:] @)
+mkParArrayType :: Type dom -> Type dom
+mkParArrayType = mkAnn ("[:" <> child <> ":]") . UTyParArray
+
+-- | Type application (@ F a @)
+mkTypeApp :: Type dom -> Type dom -> Type dom
+mkTypeApp ft at = mkAnn (child <> " " <> child) (UTyApp ft at)
+
+-- | Infix type constructor (@ (a <: b) @)
+mkInfixTypeApp :: Type dom -> Operator dom -> Type dom -> Type dom
+mkInfixTypeApp left op right = mkAnn (child <> " " <> child <> " " <> child) (UTyInfix left op right)
+             
+-- | Type surrounded by parentheses (@ (T a) @)
+mkParenType :: Type dom -> Type dom
+mkParenType = mkAnn ("(" <> child <> ")") . UTyParen
+
+-- | Creates a simple type variable
+mkTypeVar :: Name dom -> TyVar dom
+mkTypeVar n = mkAnn (child <> child) (UTyVarDecl n noth)
+
+-- | Creates a type variable with kind specification (@ t :: * @)
+mkKindedTypeVar :: Name dom -> Kind dom -> TyVar dom
+mkKindedTypeVar n k = mkAnn (child <> child) (UTyVarDecl n (justVal (mkKindConstraint k)))
+
+-- | Type variable or constructor (@ a @)
+mkVarType :: Name dom -> Type dom
+mkVarType = wrapperAnn . UTyVar
+
+-- | Type with explicit kind signature (@ a :: * @)
+mkKindedType :: Type dom -> Kind dom -> Type dom
+mkKindedType t k = mkAnn (child <> " :: " <> child) (UTyKinded t k)
+
+-- | Strict type marked with @!@.
+mkBangType :: Type dom -> Type dom
+mkBangType = mkAnn ("!" <> child) . UTyBang
+
+-- | Lazy type marked with @~@. (Should only be used if @Strict@ or @StrictData@ language extension is used)
+mkLazyType :: Type dom -> Type dom
+mkLazyType = mkAnn ("~" <> child) . UTyLazy
+
+-- | Strict type marked with UNPACK pragma. (Usually contains the bang mark.)
+mkUnpackType :: Type dom -> Type dom
+mkUnpackType = mkAnn ("{-# UNPACK #-} " <> child) . UTyUnpack
+
+-- | Strict type marked with UNPACK pragma. (Usually contains the bang mark.)
+mkNoUnpackType :: Type dom -> Type dom
+mkNoUnpackType = mkAnn ("{-# NOUNPACK #-} " <> child) . UTyNoUnpack
+
+-- | A wildcard type (@ _ @) with @-XPartialTypeSignatures@
+mkWildcardType :: Type dom
+mkWildcardType = mkAnn "_" UTyWildcard
+
+-- | A named wildcard type (@ _t @) with @-XPartialTypeSignatures@
+mkNamedWildcardType :: Name dom -> Type dom
+mkNamedWildcardType = mkAnn ("_" <> child) . UTyNamedWildc
+
+-- | A Template Haskell splice type (@ $(genType) @).
+mkSpliceType :: Splice dom -> Type dom
+mkSpliceType = mkAnn child . UTySplice
+
+-- | A Template Haskell quasi-quote type (@ [quoter| ... ] @).
+mkQuasiQuoteType :: QuasiQuote dom -> Type dom
+mkQuasiQuoteType = mkAnn child . UTyQuasiQuote
+
+
+-- | Numeric value promoted to the kind level.
+mkPromotedIntType :: Integer -> Type dom
+mkPromotedIntType i = mkAnn child $ UTyPromoted $ mkAnn (fromString $ show i) (UPromotedInt i)
+
+-- | String value promoted to the kind level.
+mkPromotedStringType :: String -> Type dom
+mkPromotedStringType i = mkAnn child $ UTyPromoted $ mkAnn (fromString $ show i) (UPromotedString i)
+
+-- | A data constructor value promoted to the kind level.
+mkPromotedConType :: Name dom -> Type dom
+mkPromotedConType = mkAnn child . UTyPromoted . mkAnn child . UPromotedCon
+
+-- | A list of elements as a kind.
+mkPromotedListType :: [Type dom] -> Type dom
+mkPromotedListType = mkAnn child . UTyPromoted . mkAnn ("[" <> child <> "]") . UPromotedList . mkAnnList (listSep ", ")
+
+-- | A tuple of elements as a kind.
+mkPromotedTupleType :: [Type dom] -> Type dom
+mkPromotedTupleType = mkAnn child . UTyPromoted . mkAnn ("(" <> child <> ")") . UPromotedTuple . mkAnnList (listSep ", ")
+
+-- | Kind of the unit value @()@. 
+mkPromotedUnitType :: Type dom
+mkPromotedUnitType = mkAnn child $ UTyPromoted $ mkAnn "()" UPromotedUnit
+
+-- * Generation of contexts
+
+-- | Creates a context of one assertion (@ C a => ... @)
+mkContextOne :: Assertion dom -> Context dom
+mkContextOne = mkAnn (child <> " =>") . UContextOne
+
+-- | Creates a context of a set of assertions (@ (C1 a, C2 b) => ... @, but can be one: @ (C a) => ... @)
+mkContextMulti :: [Assertion dom] -> Context dom
+mkContextMulti = mkAnn ("(" <> child <> ") =>") . UContextMulti . mkAnnList (listSep ", ")
+
+-- * Generation of assertions
+
+-- | Class assertion (@Cls x@)
+mkClassAssert :: Name dom -> [Type dom] -> Assertion dom
+-- fixme: class assertion without parameters should not have the last space
+mkClassAssert n args = mkAnn (child <> " " <> child) $ UClassAssert n (mkAnnList (listSep " ") args)
+
+-- | Infix class assertion, also contains type equations (@ a ~ X y @)
+mkInfixAssert :: Type dom -> Operator dom -> Type dom -> Assertion dom
+mkInfixAssert left op right = mkAnn (child <> " " <> child <> " " <> child) $ UInfixAssert left op right
+
+-- | Creates an assertion for implicit parameter binding (@ ?cmp :: a -> a -> Bool @)
+mkImplicitAssert :: Name dom -> Type dom -> Assertion dom
+mkImplicitAssert n t = mkAnn (child <> " :: " <> child) $ UImplicitAssert n t
+
+ Language/Haskell/Tools/AST/Gen/Utils.hs view
@@ -0,0 +1,37 @@+-- | Utility methods for generating parts of the AST for refactorings
+{-# LANGUAGE FlexibleInstances
+           , TypeFamilies
+           #-}
+module Language.Haskell.Tools.AST.Gen.Utils where
+
+import Control.Reference
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AST.ElementTypes
+import Language.Haskell.Tools.Transform
+
+fromTemplate :: src -> NodeInfo sema src
+fromTemplate = NodeInfo (error "The newly generated AST fragments have no semantic info")
+
+emptyList :: AnnList e dom
+emptyList = AnnListG (fromTemplate list) []
+
+justVal :: Ann e dom SrcTemplateStage -> AnnMaybeG e dom SrcTemplateStage
+justVal e = AnnMaybeG (fromTemplate opt) (Just e)
+
+noth :: AnnMaybe e dom
+noth = AnnMaybeG (fromTemplate opt) Nothing
+
+mkAnn :: SpanInfo SrcTemplateStage -> e dom SrcTemplateStage -> Ann e dom SrcTemplateStage
+mkAnn temp = Ann (fromTemplate temp)
+
+-- | Annotation for a simple wrapper AST node
+wrapperAnn :: e dom SrcTemplateStage -> Ann e dom SrcTemplateStage
+wrapperAnn = mkAnn child
+
+-- | Transforms the list of elements to an AnnListG with the given source template.
+mkAnnList :: ListInfo SrcTemplateStage -> [Ann e dom SrcTemplateStage] -> AnnList e dom
+mkAnnList temp = AnnListG (fromTemplate temp)
+
+-- | Transforms the Maybe element to an AnnMaybeG with the given source template.
+mkAnnMaybe :: OptionalInfo SrcTemplateStage -> Maybe (Ann e dom SrcTemplateStage) -> AnnMaybe e dom
+mkAnnMaybe temp = AnnMaybeG (fromTemplate temp)
+ Language/Haskell/Tools/AST/Match.hs view
@@ -0,0 +1,26 @@+-- | Public interface for the modules that can be used to pattern match on the AST.
+module Language.Haskell.Tools.AST.Match 
+  ( module Language.Haskell.Tools.AST.Match.Modules
+  , module Language.Haskell.Tools.AST.Match.Decls
+  , module Language.Haskell.Tools.AST.Match.Binds
+  , module Language.Haskell.Tools.AST.Match.Types
+  , module Language.Haskell.Tools.AST.Match.Kinds
+  , module Language.Haskell.Tools.AST.Match.Exprs
+  , module Language.Haskell.Tools.AST.Match.Stmts
+  , module Language.Haskell.Tools.AST.Match.Literals
+  , module Language.Haskell.Tools.AST.Match.Patterns
+  , module Language.Haskell.Tools.AST.Match.Names
+  , module Language.Haskell.Tools.AST.Match.TH
+  ) where
+
+import Language.Haskell.Tools.AST.Match.Modules
+import Language.Haskell.Tools.AST.Match.Decls
+import Language.Haskell.Tools.AST.Match.Binds
+import Language.Haskell.Tools.AST.Match.Types
+import Language.Haskell.Tools.AST.Match.Kinds
+import Language.Haskell.Tools.AST.Match.Exprs
+import Language.Haskell.Tools.AST.Match.Stmts
+import Language.Haskell.Tools.AST.Match.Literals
+import Language.Haskell.Tools.AST.Match.Patterns
+import Language.Haskell.Tools.AST.Match.Names
+import Language.Haskell.Tools.AST.Match.TH
+ Language/Haskell/Tools/AST/Match/Binds.hs view
@@ -0,0 +1,82 @@+-- | UPattern matching on binding-level AST fragments for refactorings.
+{-# LANGUAGE PatternSynonyms #-}
+module Language.Haskell.Tools.AST.Match.Binds where
+
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AST.ElementTypes
+
+-- | Non-function binding (@ v = "12" @)  
+pattern SimpleBind :: Pattern dom -> Rhs dom -> MaybeLocalBinds dom -> ValueBind dom
+pattern SimpleBind p r l <- Ann _ (USimpleBind p r l)
+
+-- | Function binding (@ f 0 = 1; f x = x @). All matches must have the same name.
+pattern FunctionBind :: MatchList dom -> ValueBind dom
+pattern FunctionBind matches <- Ann _ (UFunBind matches)
+
+-- | Clause of function binding 
+pattern Match :: MatchLhs dom -> Rhs dom -> MaybeLocalBinds dom -> Match dom
+pattern Match lhs rhs locs <- Ann _ (UMatch lhs rhs locs)
+
+-- | A match lhs with the function name and parameter names (@ f a b @)
+pattern MatchLhs :: Name dom -> PatternList dom -> MatchLhs dom
+pattern MatchLhs n pats <- Ann _ (UNormalLhs n pats)
+
+-- | An infix match lhs for an operator (@ a + b @)
+pattern InfixLhs :: Pattern dom -> Operator dom -> Pattern dom -> PatternList dom -> MatchLhs dom
+pattern InfixLhs lhs op rhs pats <- Ann _ (UInfixLhs lhs op rhs pats)
+
+-- | Local bindings attached to a declaration (@ where x = 42 @)
+pattern LocalBinds :: LocalBindList dom -> LocalBinds dom
+pattern LocalBinds binds <- Ann _ (ULocalBinds binds)
+
+-- | A local binding for a value
+pattern LocalValBind :: ValueBind dom -> LocalBind dom
+pattern LocalValBind bind <- Ann _ (ULocalValBind bind)
+
+-- | A local type signature
+pattern LocalTypeSig :: TypeSignature dom -> LocalBind dom
+pattern LocalTypeSig typeSig <- Ann _ (ULocalSignature typeSig)
+
+-- | A local fixity declaration
+pattern LocalFixity :: FixitySignature dom -> LocalBind dom
+pattern LocalFixity fixity <- Ann _ (ULocalFixity fixity)
+
+-- | A type signature (@ f :: Int -> Int @)
+pattern TypeSignature :: NameList dom -> Type dom -> TypeSignature dom
+pattern TypeSignature n t <- Ann _ (UTypeSignature n t)
+
+-- | A left-associative fixity declaration (@ infixl 5 +, - @).
+pattern InfixL :: Int -> OperatorList dom -> FixitySignature dom
+pattern InfixL prec op <- Ann _ (UFixitySignature (Ann _ AssocLeft) (Ann _ (Precedence prec)) op)
+
+-- | A right-associative fixity declaration (@ infixr 5 +, - @).
+pattern InfixR :: Int -> OperatorList dom -> FixitySignature dom
+pattern InfixR prec op <- Ann _ (UFixitySignature (Ann _ AssocRight) (Ann _ (Precedence prec)) op)
+
+-- | A non-associative fixity declaration (@ infix 5 +, - @).
+pattern Infix :: Int -> OperatorList dom -> FixitySignature dom
+pattern Infix prec op <- Ann _ (UFixitySignature (Ann _ AssocNone) (Ann _ (Precedence prec)) op)
+
+-- | An unguarded right-hand-side (@ = 3 @)
+pattern UnguardedRhs :: Expr dom -> Rhs dom
+pattern UnguardedRhs expr <- Ann _ (UUnguardedRhs expr)
+
+-- | An unguarded right-hand-side (@ | x == 1 = 3; | otherwise = 4 @)
+pattern GuardedRhss :: GuardedRhsList dom -> Rhs dom
+pattern GuardedRhss rhss <- Ann _ (UGuardedRhss rhss)
+
+-- | A guarded right-hand side of a value binding (@ | x > 3 = 2 @)    
+pattern GuardedRhs :: RhsGuardList dom -> Expr dom -> GuardedRhs dom
+pattern GuardedRhs guards expr <- Ann _ (UGuardedRhs guards expr)
+
+-- | A bind statement in a pattern guard (@ Just v <- x @)
+pattern GuardBind :: Pattern dom -> Expr dom -> RhsGuard dom
+pattern GuardBind pat expr <- Ann _ (UGuardBind pat expr)
+
+-- | A let statement in a pattern guard (@ let x = 3 @)
+pattern GuardLet :: LocalBindList dom -> RhsGuard dom
+pattern GuardLet binds <- Ann _ (UGuardLet binds)
+
+-- | An expression to check for a pattern guard
+pattern GuardCheck :: Expr dom -> RhsGuard dom
+pattern GuardCheck expr <- Ann _ (UGuardCheck expr)
+ Language/Haskell/Tools/AST/Match/Decls.hs view
@@ -0,0 +1,431 @@+-- | UPattern matching on declaration-level AST fragments for refactorings.
+{-# LANGUAGE PatternSynonyms #-}
+module Language.Haskell.Tools.AST.Match.Decls where
+
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AST.ElementTypes
+import Language.Haskell.Tools.AST.Match.Names
+
+-- WORKAROUND: nested pattern synonyms don't work in GHC 8.0, so I replaced them with longer but working pattern
+
+-- * Declarations
+
+-- | A type synonym ( @type String = [Char]@ )
+pattern TypeDecl :: DeclHead dom -> Type dom -> Decl dom 
+pattern TypeDecl dh typ <- Ann _ (UTypeDecl dh typ)
+
+-- | Standalone deriving declaration (@ deriving instance X T @)
+pattern StandaloneDeriving :: InstanceRule dom -> Decl dom
+pattern StandaloneDeriving instRule <- Ann _ (UDerivDecl _ instRule)
+
+-- | Fixity declaration (@ infixl 5 +, - @)
+pattern FixityDecl :: FixitySignature dom -> Decl dom
+pattern FixityDecl fixity <- Ann _ (UFixityDecl fixity)
+
+-- | Default types (@ default (T1, T2) @)
+pattern DefaultDecl :: TypeList dom -> Decl dom
+pattern DefaultDecl types <- Ann _ (UDefaultDecl types)
+
+-- | Type signature declaration (@ f :: Int -> Int @)
+pattern TypeSigDecl :: TypeSignature dom -> Decl dom
+pattern TypeSigDecl typeSig <- Ann _ (UTypeSigDecl typeSig)
+
+-- | Function or value binding (@ f x = 12 @)
+pattern ValueBinding :: ValueBind dom -> Decl dom
+pattern ValueBinding bind <- Ann _ (UValueBinding bind)
+
+-- | A Template Haskell splice declaration (@ $(generateDecls) @)
+pattern SpliceDecl :: Splice dom -> Decl dom
+pattern SpliceDecl sp <- Ann _ (USpliceDecl sp)
+
+-- * Data type definitions
+
+-- | A data or newtype declaration. Empty data type declarations without 
+-- where keyword are always belong to DataDecl.
+pattern DataDecl :: DataOrNewtypeKeyword dom -> MaybeContext dom -> DeclHead dom -> ConDeclList dom -> MaybeDeriving dom -> Decl dom
+pattern DataDecl keyw ctx dh cons derivs <- Ann _ (UDataDecl keyw ctx dh cons derivs)
+
+-- | A GADT-style data or newtype declaration.
+pattern GADTDataDecl :: DataOrNewtypeKeyword dom -> MaybeContext dom -> DeclHead dom -> MaybeKindConstraint dome -> AnnListG UGadtConDecl dom stage -> MaybeDeriving dom -> Decl dom
+pattern GADTDataDecl keyw ctx dh kind cons derivs  <- Ann _ (UGDataDecl keyw ctx dh kind cons derivs )
+
+-- | GADT constructor declaration (@ D1 :: Int -> T String @)
+pattern GadtConDecl :: NameList dom -> Type dom -> GadtConDecl dom
+pattern GadtConDecl names typ <- Ann _ (UGadtConDecl names (Ann _ (UGadtNormalType typ)))
+
+-- | GADT constructor declaration with record syntax (@ D1 :: { val :: Int } -> T String @)
+pattern GadtRecordConDecl :: NameList dom -> FieldDeclList dom -> Type dom -> GadtConDecl dom
+pattern GadtRecordConDecl names fields typ <- Ann _ (UGadtConDecl names (Ann _ (UGadtRecordType fields typ)))
+
+-- | Ordinary data constructor (@ C t1 t2 @)
+pattern ConDecl :: Name dom -> TypeList dom -> ConDecl dom
+pattern ConDecl name args <- Ann _ (UConDecl name args)
+
+-- | Creates a record data constructor (@ Point { x :: Double, y :: Double } @)
+pattern RecordConDecl :: Name dom -> FieldDeclList dom -> ConDecl dom
+pattern RecordConDecl name fields <- Ann _ (URecordDecl name fields)
+
+-- | Infix data constructor (@ t1 :+: t2 @)
+pattern InfixConDecl :: Type dom -> Operator dom -> Type dom -> ConDecl dom
+pattern InfixConDecl lhs op rhs <- Ann _ (UInfixConDecl lhs op rhs)
+
+-- | Field declaration (@ fld :: Int @)
+pattern FieldDecl :: NameList dom -> Type dom -> FieldDecl dom
+pattern FieldDecl names typ <- Ann _ (UFieldDecl names typ)
+
+-- | A deriving clause without parentheses (@ deriving Show @.
+pattern DerivingOne :: InstanceHead dom -> Deriving dom
+pattern DerivingOne deriv <- Ann _ (UDerivingOne deriv)
+
+-- | A deriving clause with parentheses @ deriving (Show, Eq) @)
+pattern DerivingMulti :: InstanceHeadList dom -> Deriving dom
+pattern DerivingMulti derivs <- Ann _ (UDerivings derivs)
+
+pattern DataKeyword :: DataOrNewtypeKeyword dom
+pattern DataKeyword <- Ann _ UDataKeyword
+
+pattern NewtypeKeyword :: DataOrNewtypeKeyword dom
+pattern NewtypeKeyword <- Ann _ UNewtypeKeyword
+
+-- | A list of functional dependencies: @ | a -> b, c -> d @ separated by commas  
+pattern FunDeps :: FunDepList dom -> FunDeps dom
+pattern FunDeps fds <- Ann _ (UFunDeps fds)
+
+-- | A functional dependency, given on the form @l1 ... ln -> r1 ... rn@      
+pattern FunDep :: NameList dom -> NameList dom -> FunDep dom
+pattern FunDep lhs rhs <- Ann _ (UFunDep lhs rhs)
+
+-- * Type class declarations
+
+-- | Type class declaration (@ class X a [where f = ...] @)
+pattern ClassDecl :: MaybeContext dom -> DeclHead dom -> MaybeFunDeps dom -> MaybeClassBody dom -> Decl dom
+pattern ClassDecl ctx dh fdeps body <- Ann _ (UClassDecl ctx dh fdeps body)
+
+-- | The list of declarations that can appear in a typeclass
+pattern ClassBody :: ClassElementList dom -> ClassBody dom
+pattern ClassBody body <- Ann _ (UClassBody body)
+
+-- | Type signature: @ f :: A -> B @ as a class member
+pattern ClassElemSig :: TypeSignature dom -> ClassElement dom
+pattern ClassElemSig typeSig <- Ann _ (UClsSig typeSig)
+
+-- | Default binding: @ f x = "aaa" @ as a class member
+pattern ClassElemDef :: ValueBind dom -> ClassElement dom
+pattern ClassElemDef def <- Ann _ (UClsDef def)
+
+-- | Declaration of an associated type synonym: @ type T x :: * @ in a class
+pattern ClassElemTypeFam :: DeclHead dom -> MaybeTypeFamilySpec dom -> ClassElement dom
+pattern ClassElemTypeFam dh tfSpec <- Ann _ (UClsTypeFam (Ann _ (UTypeFamily dh tfSpec)))
+
+-- | Declaration of an associated data synonym: @ data T x :: * @ in a class
+pattern ClassElemDataFam :: DeclHead dom -> MaybeKindConstraint dome -> ClassElement dom
+pattern ClassElemDataFam dh kind <- Ann _ (UClsTypeFam (Ann _ (UDataFamily dh kind)))
+
+-- | Default choice for type synonym: @ type T x = TE @ or @ type instance T x = TE @ in a class
+pattern ClsDefaultType :: DeclHead dom -> Type dom -> ClassElement dom
+pattern ClsDefaultType dh typ <- Ann _ (UClsTypeDef dh typ)
+
+-- | Default signature (by using @DefaultSignatures@): @ default enum :: (Generic a, GEnum (Rep a)) => [a] @
+pattern ClsDefaultSig :: Name dom -> Type dom -> ClassElement dom
+pattern ClsDefaultSig name typ <- Ann _ (UClsDefSig name typ)
+
+-- | Minimal pragma: @ {-\# MINIMAL (==) | (/=) \#-} @ in a class
+pattern ClsMinimal :: MinimalFormula dom -> ClassElement dom
+pattern ClsMinimal min <- Ann _ (UClsMinimal min)
+
+pattern MinimalName :: Name dom -> MinimalFormula dom
+pattern MinimalName name <- Ann _ (UMinimalName name)
+
+pattern MinimalParen :: MinimalFormula dom -> MinimalFormula dom
+pattern MinimalParen min <- Ann _ (UMinimalParen min)
+
+-- | One of the minimal formulas are needed (@ min1 | min2 @)
+pattern MinimalOr :: MinimalFormulaList dom -> MinimalFormula dom
+pattern MinimalOr mins <- Ann _ (UMinimalOr mins)
+
+-- | Both of the minimal formulas are needed (@ min1 , min2 @)
+pattern MinimalAnd :: MinimalFormulaList dom -> MinimalFormula dom
+pattern MinimalAnd mins <- Ann _ (UMinimalAnd mins)
+
+-- * Declaration heads
+
+-- | Type or class name as a declaration head
+pattern NameDeclHead :: Name dom -> DeclHead dom
+pattern NameDeclHead name <- Ann _ (UDeclHead name)
+
+-- | Parenthesized type as a declaration head
+pattern ParenDeclHead :: DeclHead dom -> DeclHead dom
+pattern ParenDeclHead dh <- Ann _ (UDHParen dh)
+
+-- | Type application as a declaration head
+pattern DeclHeadApp :: DeclHead dom -> TyVar dom -> DeclHead dom
+pattern DeclHeadApp dh tv <- Ann _ (UDHApp dh tv)
+
+-- | Infix type application as a declaration head
+pattern InfixDeclHead :: TyVar dom -> Operator dom -> TyVar dom -> DeclHead dom
+pattern InfixDeclHead lhs op rhs <- Ann _ (UDHInfix lhs op rhs)
+
+-- * Type class instance declarations
+
+-- | Instance declaration (@ instance X T [where f = ...] @)
+pattern InstanceDecl :: InstanceRule dom -> MaybeInstBody dom -> Decl dom
+pattern InstanceDecl instRule body <- Ann _ (UInstDecl _ instRule body)
+
+-- | Instance body is the implementation of the class functions (@ where a x = 1; b x = 2 @)
+pattern InstanceBody :: InstBodyDeclList dom -> InstBody dom
+pattern InstanceBody defs <- Ann _ (UInstBody defs)
+
+-- | A normal value binding (@ f x = 12 @) inside a class instance
+pattern InstanceBind :: ValueBind dom -> InstBodyDecl dom
+pattern InstanceBind bind <- Ann _ (UInstBodyNormalDecl bind)
+
+-- | Type signature in instance definition with @InstanceSigs@
+pattern InstanceTypeSig :: TypeSignature dom -> InstBodyDecl dom
+pattern InstanceTypeSig typeSig <- Ann _ (UInstBodyTypeSig typeSig)
+
+-- | An associated type definition (@ type A X = B @) in a class instance
+pattern InstanceTypeFamilyDef :: TypeEqn dom -> InstBodyDecl dom
+pattern InstanceTypeFamilyDef typeEq <- Ann _ (UInstBodyTypeDecl typeEq)
+
+-- | An associated data definition (@ data A X = B Int | C @) in a class instance
+pattern InstanceDataFamilyDef :: DataOrNewtypeKeyword dom -> InstanceRule dom -> ConDeclList dom -> MaybeDeriving dom -> InstBodyDecl dom
+pattern InstanceDataFamilyDef keyw instRule cons derivs  <- Ann _ (UInstBodyDataDecl keyw instRule cons derivs )
+
+-- | An associated data definition as a GADT (@ data A X where B :: Int -> A X @) in a class instance
+pattern InstanceDataFamilyGADTDef :: DataOrNewtypeKeyword dom -> InstanceRule dom -> MaybeKindConstraint dome -> AnnListG UGadtConDecl dom stage 
+                                       -> MaybeDeriving dom -> InstBodyDecl dom
+pattern InstanceDataFamilyGADTDef keyw instRule kind cons derivs <- Ann _ (UInstBodyGadtDataDecl keyw instRule kind cons derivs)
+
+-- | Specialize instance pragma in a class instance  (no phase selection is allowed)
+pattern InstanceSpecializePragma :: Type dom -> InstBodyDecl dom
+pattern InstanceSpecializePragma typ <- Ann _ (USpecializeInstance typ)
+
+-- | Instance head as an instance rule (@ X a => Y a @)
+pattern InstanceRule :: AnnMaybeG (AnnListG UTyVar) dom stage -> MaybeContext dom -> InstanceHead dom -> InstanceRule dom
+pattern InstanceRule tvs ctx ih <- Ann _ (UInstanceRule tvs ctx ih)
+
+-- | Type or class name as an instance head
+pattern InstanceHead :: Name dom -> InstanceHead dom
+pattern InstanceHead name <- Ann _ (UInstanceHeadCon name)
+
+-- | Infix application of the type/class name to the left operand as an instance head
+pattern InfixInstanceHead :: Type dom -> Name dom -> InstanceHead dom
+pattern InfixInstanceHead typ n <- Ann _ (UInstanceHeadInfix typ n)
+
+-- | Parenthesized instance head
+pattern ParenInstanceHead :: InstanceHead dom -> InstanceHead dom
+pattern ParenInstanceHead ih <- Ann _ (UInstanceHeadParen ih)
+
+-- | Type application as an instance head 
+pattern AppInstanceHead :: InstanceHead dom -> Type dom -> InstanceHead dom
+pattern AppInstanceHead fun arg <- Ann _ (UInstanceHeadApp fun arg)
+
+-- | @OVERLAP@ pragma
+pattern EnableOverlap :: OverlapPragma dom     
+pattern EnableOverlap <- Ann _ UEnableOverlap 
+
+-- | @NO_OVERLAP@ pragma
+pattern DisableOverlap :: OverlapPragma dom    
+pattern DisableOverlap <- Ann _ UDisableOverlap 
+
+-- | @OVERLAPPABLE@ pragma
+pattern Overlappable :: OverlapPragma dom      
+pattern Overlappable <- Ann _ UOverlappable 
+
+-- | @OVERLAPPING@ pragma
+pattern Overlapping :: OverlapPragma dom       
+pattern Overlapping <- Ann _ UOverlapping 
+
+-- | @OVERLAPS@ pragma
+pattern Overlaps :: OverlapPragma dom          
+pattern Overlaps <- Ann _ UOverlaps 
+
+-- | @INCOHERENT@ pragma
+pattern IncoherentOverlap :: OverlapPragma dom 
+pattern IncoherentOverlap <- Ann _ UIncoherentOverlap 
+
+-- * Type roles
+
+-- | Role annotations (@ type role Ptr representational @)
+pattern RoleDecl :: QualifiedName dom -> RoleList dom -> Decl dom
+pattern RoleDecl name roles <- Ann _ (URoleDecl name roles)
+
+pattern NominalRole :: Role dom
+pattern NominalRole <- Ann _ UNominal
+
+pattern RepresentationalRole :: Role dom
+pattern RepresentationalRole <- Ann _ URepresentational
+
+pattern PhantomRole :: Role dom
+pattern PhantomRole <- Ann _ UPhantom
+
+-- * Foreign imports and exports
+
+-- | Foreign import (@ foreign import foo :: Int -> IO Int @)
+pattern ForeignImport :: CallConv dom -> MaybeSafety dom -> Name dom -> Type dom -> Decl dom
+pattern ForeignImport cc safety name typ <- Ann _ (UForeignImport cc safety name typ)
+
+-- | Foreign export (@ foreign export ccall foo :: Int -> IO Int @)
+pattern ForeignExport :: CallConv dom -> Name dom -> Type dom -> Decl dom
+pattern ForeignExport cc name typ <- Ann _ (UForeignExport cc name typ)
+
+-- | Specifies @stdcall@ calling convention for foreign import/export.
+pattern StdCall :: CallConv dom
+pattern StdCall <- Ann _ UStdCall
+
+-- | Specifies @ccall@ calling convention for foreign import/export.
+pattern CCall :: CallConv dom
+pattern CCall <- Ann _ UCCall
+
+-- | Specifies @capi@ calling convention for foreign import/export.
+pattern CApi :: CallConv dom
+pattern CApi <- Ann _ UCApi
+
+-- | Specifies that the given foreign import is @unsafe@.
+pattern Unsafe :: Safety dom
+pattern Unsafe <- Ann _ UUnsafe 
+
+-- * Pattern synonyms
+
+-- | Pattern synonyms (@ pattern Arrow t1 t2 = App \"->\" [t1, t2] @)
+pattern PatternSynonym :: PatSynLhs dom -> PatSynRhs dom -> Decl dom
+pattern PatternSynonym lhs rhs <- Ann _ (UPatternSynonymDecl (Ann _ (UPatternSynonym lhs rhs)))
+
+-- | A left hand side with a constructor name and arguments (@ Arrow t1 t2 @)
+pattern ConPatSyn :: Name dom -> NameList dom -> PatSynLhs dom
+pattern ConPatSyn con args <- Ann _ (UNormalPatSyn con args)
+
+-- | An infix pattern synonym left-hand side (@ t1 :+: t2 @)
+pattern InfixPatSyn :: Name dom -> Operator dom -> Name dom -> PatSynLhs dom
+pattern InfixPatSyn lhs op rhs <- Ann _ (UInfixPatSyn lhs op rhs)
+
+-- | A record-style pattern synonym left-hand side (@ Arrow { arrowFrom, arrowTo } @)
+pattern RecordPatSyn :: Name dom -> NameList dom -> PatSynLhs dom
+pattern RecordPatSyn con args <- Ann _ (URecordPatSyn con args)
+
+-- | An automatically two-way pattern synonym (@ = App \"Int\" [] @)
+pattern SymmetricPatSyn :: Pattern dom -> PatSynRhs dom
+pattern SymmetricPatSyn pat <- Ann _ (UBidirectionalPatSyn pat AnnNothing)
+
+-- | A pattern synonym that can be only used for pattenr matching but not for combining (@ <- App \"Int\" [] @)
+pattern OneWayPatSyn :: Pattern dom -> PatSynRhs dom
+pattern OneWayPatSyn pat <- Ann _ (UOneDirectionalPatSyn pat)
+
+-- | A pattern synonym with the other direction explicitely specified (@ <- App \"Int\" [] where Int = App \"Int\" [] @)
+pattern TwoWayPatSyn :: Pattern dom -> MatchList dom -> PatSynRhs dom
+pattern TwoWayPatSyn pat match <- Ann _ (UBidirectionalPatSyn pat (AnnJust (Ann _ (UPatSynWhere match))))
+
+-- | Pattern type signature declaration (@ pattern Succ :: Int -> Int @)
+pattern PatternSignatureDecl :: PatternSignature dom -> Decl dom
+pattern PatternSignatureDecl patsig <- Ann _ (UPatTypeSigDecl patsig)
+
+pattern PatternSignature :: Name dom -> Type dom -> PatternSignature dom
+pattern PatternSignature name typ <- Ann _ (UPatternTypeSignature name typ)
+
+-- * Type families
+
+-- | Type family declaration (@ type family A a :: * -> * @)
+pattern TypeFamily :: DeclHead dom -> MaybeTypeFamilySpec dom -> Decl dom
+pattern TypeFamily dh famSpec <- Ann _ (UTypeFamilyDecl (Ann _ (UTypeFamily dh famSpec)))
+
+-- | Data family declaration (@ data family A a :: * -> * @)
+pattern DataFamily :: DeclHead dom -> MaybeKindConstraint dom -> Decl dom
+pattern DataFamily dh kind <- Ann _ (UTypeFamilyDecl (Ann _ (UDataFamily dh kind)))
+
+-- | Type family instance declaration (@ type instance Fam T = AssignedT @)
+pattern TypeInstance :: InstanceRule dom -> Type dom -> Decl dom
+pattern TypeInstance instRule typ <- Ann _ (UTypeInstDecl instRule typ)
+
+-- | Data instance declaration (@ data instance Fam T = Con1 | Con2 @)
+pattern DataInstance :: DataOrNewtypeKeyword dom -> InstanceRule dom -> ConDeclList dom -> MaybeDeriving dom -> Decl dom
+pattern DataInstance keyw instRule cons derivs  <- Ann _ (UDataInstDecl keyw instRule cons derivs )
+
+-- | GADT-style data instance declaration (@ data instance Fam T where ... @)
+pattern GadtDataInstance :: DataOrNewtypeKeyword dom -> InstanceRule dom -> MaybeKindConstraint dome -> GadtConDeclList dom -> Decl dom
+pattern GadtDataInstance keyw instRule kind cons  <- Ann _ (UGDataInstDecl keyw instRule kind cons )
+
+-- | A closed type family declaration
+pattern ClosedTypeFamily :: DeclHead dom -> MaybeKindConstraint dom -> TypeEqnList dom -> Decl dom
+pattern ClosedTypeFamily dh kind typeqs <- Ann _ (UClosedTypeFamilyDecl dh kind typeqs)
+
+-- | Specifies the kind of a type family (@ :: * -> * @)
+pattern TypeFamilyKindSpec :: KindConstraint dom -> TypeFamilySpec dom
+pattern TypeFamilyKindSpec kind <- Ann _ (UTypeFamilyKind kind)
+
+-- | Specifies the injectivity of a type family (@ = r | r -> a @)
+pattern TypeFamilyInjectivitySpec :: Name dom -> NameList dom -> TypeFamilySpec dom
+pattern TypeFamilyInjectivitySpec res dependent <- Ann _ (UTypeFamilyInjectivity (Ann _ (UInjectivityAnn res dependent)))
+
+-- | Type equations as found in closed type families (@ T A = S @)
+pattern TypeEqn :: Type dom -> Type dom -> TypeEqn dom
+pattern TypeEqn lhs rhs <- Ann _ (UTypeEqn lhs rhs)
+
+-- * Top level pragmas
+
+-- | Top-level pragmas
+pattern PragmaDecl :: TopLevelPragma dom -> Decl dom
+pattern PragmaDecl pragma <- Ann _ (UPragmaDecl pragma)
+
+-- | A pragma that introduces source rewrite rules (@ {-\# RULES "map/map" [2]  forall f g xs. map f (map g xs) = map (f.g) xs \#-} @)
+pattern RulePragma :: RuleList dom -> TopLevelPragma dom
+pattern RulePragma rules <- Ann _ (URulePragma rules)
+
+-- | A pragma that marks definitions as deprecated (@ {-\# DEPRECATED f "f will be replaced by g" \#-} @)
+pattern DeprPragma :: NameList dom -> String -> TopLevelPragma dom
+pattern DeprPragma defs msg <- Ann _ (UDeprPragma defs (Ann _ (UStringNode msg)))
+
+-- | A pragma that marks definitions as deprecated (@ {-\# WARNING unsafePerformIO "you should know what you are doing" \#-} @)
+pattern WarningPragma :: NameList dom -> String -> TopLevelPragma dom
+pattern WarningPragma defs msg <- Ann _ (UWarningPragma defs (Ann _ (UStringNode msg)))
+
+-- | A pragma that annotates a definition with an arbitrary value (@ {-\# ANN f 42 \#-} @)
+pattern AnnPragma :: AnnotationSubject dom -> Expr dom -> TopLevelPragma dom
+pattern AnnPragma subj ann <- Ann _ (UAnnPragma subj ann)
+
+-- | A pragma that marks a function for inlining to the compiler (@ {-\# INLINE thenUs \#-} @)
+pattern InlinePragma :: MaybeConlikeAnnot dom -> MaybePhaseControl dom -> Name dom -> TopLevelPragma dom
+pattern InlinePragma conlike phase name <- Ann _ (UInlinePragma conlike phase name)
+
+-- | A pragma that forbids a function from being inlined by the compiler (@ {-\# NOINLINE f \#-} @)
+pattern NoInlinePragma :: MaybeConlikeAnnot dom -> MaybePhaseControl dom -> Name dom -> TopLevelPragma dom
+pattern NoInlinePragma conlike phase name <- Ann _ (UNoInlinePragma conlike phase name)
+
+-- | A pragma that marks a function that it may be inlined by the compiler (@ {-\# INLINABLE thenUs \#-} @)
+pattern InlinablePragma :: MaybePhaseControl dom -> Name dom -> TopLevelPragma dom
+pattern InlinablePragma phase name <- Ann _ (UInlinablePragma phase name)
+
+-- | A pragma for maintaining line numbers in generated sources (@ {-\# LINE 123 \"somefile\" \#-} @)
+pattern LinePragma :: Int -> MaybeStringNode dom -> TopLevelPragma dom
+pattern LinePragma line filename <- Ann _ (ULinePragma (Ann _ (LineNumber line)) filename)
+
+-- | A pragma that tells the compiler that a polymorph function should be optimized for a given type (@ {-\# SPECIALISE f :: Int -> b -> b \#-} @)
+pattern SpecializePragma :: MaybePhaseControl dom -> Name dom -> TypeList dom -> TopLevelPragma dom
+pattern SpecializePragma phase def specTypes <- Ann _ (USpecializePragma phase def specTypes)
+
+-- | Marks that the pragma should be applied from a given compile phase (@ [2] @)
+pattern PhaseControlFrom :: Integer -> PhaseControl dom
+pattern PhaseControlFrom phaseNum <- Ann _ (UPhaseControl AnnNothing (Ann _ (PhaseNumber phaseNum)))
+
+-- | Marks that the pragma should be applied until a given compile phase (@ [~2] @)
+pattern PhaseControlUntil :: Integer -> PhaseControl dom
+pattern PhaseControlUntil phaseNum <- Ann _ (UPhaseControl (AnnJust _) (Ann _ (PhaseNumber phaseNum)))
+
+-- | A rewrite rule (@ "map/map" forall f g xs. map f (map g xs) = map (f.g) xs @)
+pattern RewriteRule :: String -> MaybePhaseControl dom -> TyVarList dom -> Expr dom -> Expr dom -> Rule dom
+pattern RewriteRule name phase vars lhs rhs <- Ann _ (URule (Ann _ (UStringNode name)) phase vars lhs rhs)
+
+-- | The definition with the given name is annotated
+pattern NameAnnotation :: Name dom -> AnnotationSubject dom
+pattern NameAnnotation name <- Ann _ (UNameAnnotation name)
+
+-- | A type with the given name is annotated
+pattern TypeAnnotation :: Name dom -> AnnotationSubject dom
+pattern TypeAnnotation name <- Ann _ (UTypeAnnotation name)
+
+-- | The whole module is annotated
+pattern ModuleAnnotation :: AnnotationSubject dom
+pattern ModuleAnnotation <- Ann _ UModuleAnnotation
+
+-- | A @CONLIKE@ modifier for an @INLINE@ pragma.
+pattern ConlikeAnnotation :: ConlikeAnnot dom
+pattern ConlikeAnnotation <- Ann _ UConlikeAnnot
+ Language/Haskell/Tools/AST/Match/Exprs.hs view
@@ -0,0 +1,296 @@+-- | UPattern matching expression-level AST fragments for refactorings.
+{-# LANGUAGE PatternSynonyms #-}
+module Language.Haskell.Tools.AST.Match.Exprs where
+
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AST.ElementTypes
+import Language.Haskell.Tools.AST.Match.Stmts
+import Language.Haskell.Tools.AST.Match.Names
+
+-- * Expressions
+
+-- | An expression for a variable or a data constructor (@ a @)
+pattern Var :: Name dom -> Expr dom
+pattern Var name <- Ann _ (UVar name)
+
+-- | A literal expression (@ 42 @)
+pattern Lit :: Literal dom -> Expr dom
+pattern Lit lit <- Ann _ (ULit lit)
+
+-- | An infix operator application (@ a + b @)
+pattern InfixApp :: Expr dom -> Operator dom -> Expr dom -> Expr dom
+pattern InfixApp lhs op rhs <- Ann _ (UInfixApp lhs op rhs)
+
+-- | Prefix operator application (@ -x @)
+pattern PrefixApp :: Operator dom -> Expr dom -> Expr dom
+pattern PrefixApp op rhs <- Ann _ (UPrefixApp op rhs)
+
+-- | Function application (@ f 4 @)
+pattern App :: Expr dom -> Expr dom -> Expr dom
+pattern App f e <- Ann _ (UApp f e)
+
+-- | Lambda expression (@ \\a b -> a + b @)
+pattern Lambda :: PatternList dom -> Expr dom -> Expr dom
+pattern Lambda pats rhs <- Ann _ (ULambda pats rhs)
+
+-- | Local binding (@ let x = 2; y = 3 in e x y @)
+pattern Let :: LocalBindList dom -> Expr dom -> Expr dom
+pattern Let pats expr <- Ann _ (ULet pats expr)
+
+-- | If expression (@ if a then b else c @)
+pattern If :: Expr dom -> Expr dom -> Expr dom -> Expr dom
+pattern If cond then_ else_ <- Ann _ (UIf cond then_ else_)
+
+-- | Multi way if expressions with @MultiWayIf@ extension (@ if | guard1 -> expr1; guard2 -> expr2 @)
+pattern MultiIf :: GuardedCaseRhsList dom -> Expr dom
+pattern MultiIf cases <- Ann _ (UMultiIf cases)
+
+-- | Pattern matching expression (@ case expr of pat1 -> expr1; pat2 -> expr2 @)
+pattern Case :: Expr dom -> AltList dom -> Expr dom
+pattern Case expr cases <- Ann _ (UCase expr cases)
+
+-- | Do-notation expressions (@ do x <- act1; act2 @)
+pattern Do :: StmtList dom -> Expr dom
+pattern Do stmts <- Ann _ (UDo DoKeyword stmts)
+
+pattern ParArrayComp :: Expr dom -> ListCompBodyList dom -> Expr dom
+pattern ParArrayComp expr stmts <- Ann _ (UParArrayComp expr stmts)
+
+-- | Tuple expression (@ (e1, e2, e3) @)
+pattern Tuple :: ExprList dom -> Expr dom
+pattern Tuple exprs <- Ann _ (UTuple exprs)
+
+-- | Unboxed tuple expression (@ (\# e1, e2, e3 \#) @)
+pattern UnboxedTuple :: ExprList dom -> Expr dom
+pattern UnboxedTuple exprs <- Ann _ (UUnboxedTuple exprs)
+
+-- | Tuple section, enabled with @TupleSections@ (@ (a,,b) @). One of the elements must be missing.
+pattern TupleSection :: TupSecElemList dom -> Expr dom
+pattern TupleSection elems <- Ann _ (UTupleSection elems)
+
+-- | Unboxed tuple section enabled with @TupleSections@ (@ (# a,,b #) @). One of the elements must be missing.
+pattern UnboxedTupleSection :: TupSecElemList dom -> Expr dom
+pattern UnboxedTupleSection elems <- Ann _ (UUnboxedTupSec elems)
+
+-- | List expression: @[1,2,3]@
+pattern List :: ExprList dom -> Expr dom
+pattern List exprs <- Ann _ (UList exprs)
+
+-- | Parallel array expression: @[: 1,2,3 :]@
+pattern ParArray :: ExprList dom -> Expr dom
+pattern ParArray exprs <- Ann _ (UParArray exprs)
+
+-- | Parenthesized expression: @( a + b )@
+pattern Paren :: Expr dom -> Expr dom
+pattern Paren expr <- Ann _ (UParen expr)
+
+-- | Left operator section: @(1+)@
+pattern LeftSection :: Expr dom -> Operator dom -> Expr dom
+pattern LeftSection lhs op <- Ann _ (ULeftSection lhs op)
+
+-- | Right operator section: @(+1)@
+pattern RightSection :: Operator dom -> Expr dom -> Expr dom
+pattern RightSection op lhs <- Ann _ (URightSection op lhs)
+
+-- | Record value construction: @Point { x = 3, y = -2 }@
+pattern RecCon :: Name dom -> FieldUpdateList dom -> Expr dom
+pattern RecCon name flds <- Ann _ (URecCon name flds)
+
+-- | Record value update: @p1 { x = 3, y = -2 }@
+pattern RecUpdate :: Expr dom -> FieldUpdateList dom -> Expr dom
+pattern RecUpdate expr flds <- Ann _ (URecUpdate expr flds)
+
+-- | Enumeration expression (@ [1,3..10] @)
+pattern Enum :: Expr dom -> MaybeExpr dom -> MaybeExpr dom -> Expr dom
+pattern Enum from step to <- Ann _ (UEnum from step to)
+
+-- | Parallel array enumeration (@ [: 1,3 .. 10 :] @)
+pattern ParArrayEnum :: Expr dom -> MaybeExpr dom -> Expr dom -> Expr dom
+pattern ParArrayEnum from step to <- Ann _ (UParArrayEnum from step to)
+
+-- | List comprehension (@ [ (x, y) | x <- xs | y <- ys ] @)
+pattern ListComp :: Expr dom -> ListCompBodyList dom -> Expr dom
+pattern ListComp expr bodies <- Ann _ (UListComp expr bodies)
+
+-- | Parallel array comprehensions @ [: (x, y) | x <- xs , y <- ys :] @ enabled by @ParallelArrays@
+pattern ParArrayListComp :: Expr dom -> ListCompBodyList dom -> Expr dom
+pattern ParArrayListComp expr bodies <- Ann _ (UParArrayComp expr bodies)
+
+-- | Explicit type signature (@ x :: Int @)
+pattern TypeSig :: Expr dom -> Type dom -> Expr dom
+pattern TypeSig lhs typ <- Ann _ (UTypeSig lhs typ)
+
+-- | Explicit type application (@ show \@Integer (read "5") @)
+pattern ExplicitTypeApp :: Expr dom -> Type dom -> Expr dom
+pattern ExplicitTypeApp lhs typ <- Ann _ (UExplTypeApp lhs typ)
+
+-- | @'x@ for template haskell reifying of expressions
+pattern VarQuote :: Name dom -> Expr dom
+pattern VarQuote name <- Ann _ (UVarQuote name)
+
+-- | @''T@ for template haskell reifying of types
+pattern TypeQuote :: Name dom -> Expr dom
+pattern TypeQuote name <- Ann _ (UTypeQuote name)
+
+-- | Template haskell bracket expression
+pattern BracketExpr :: Bracket dom -> Expr dom
+pattern BracketExpr brack <- Ann _ (UBracketExpr brack)
+
+-- | Template haskell splice expression, for example: @$(gen a)@ or @$x@
+pattern SpliceExpr :: Splice dom -> Expr dom
+pattern SpliceExpr splice <- Ann _ (USplice splice)
+
+-- | Template haskell quasi-quotation: @[$quoter|str]@
+pattern QuasiQuoteExpr :: QuasiQuote dom -> Expr dom
+pattern QuasiQuoteExpr qq <- Ann _ (UQuasiQuoteExpr qq)
+
+-- | Template haskell quasi-quotation: @[$quoter|str]@
+pattern ExprPragma :: ExprPragma dom -> Expr dom -> Expr dom
+pattern ExprPragma pragma expr <- Ann _ (UExprPragma pragma expr)
+
+-- | Arrow definition: @proc a -> f -< a+1@
+pattern Proc :: Pattern dom -> Cmd dom -> Expr dom
+pattern Proc pat cmd <- Ann _ (UProc pat cmd)
+
+-- | Arrow definition: @proc a -> f -< a+1@
+pattern ArrowApp :: Expr dom -> ArrowApp dom -> Expr dom -> Expr dom
+pattern ArrowApp lhs arrow rhs <- Ann _ (UArrowApp lhs arrow rhs)
+
+-- | Lambda case ( @\case 0 -> 1; 1 -> 2@ )
+pattern LambdaCase :: AltList dom -> Expr dom
+pattern LambdaCase alts <- Ann _ (ULamCase alts)
+
+-- | Static pointer expression (@ static e @). The inner expression must be closed (cannot have variables bound outside)
+pattern StaticPointer :: Expr dom -> Expr dom
+pattern StaticPointer expr <- Ann _ (UStaticPtr expr)
+
+
+-- * Field updates
+
+-- | Update of a field (@ x = 1 @)
+pattern NormalFieldUpdate :: Name dom -> Expr dom -> FieldUpdate dom
+pattern NormalFieldUpdate n e <- Ann _ (UNormalFieldUpdate n e)
+
+-- | Update the field to the value of the same name (@ x @)
+pattern FieldPun :: Name dom -> FieldUpdate dom
+pattern FieldPun n <- Ann _ (UFieldPun n)
+
+-- | Update the fields of the bounded names to their values (@ .. @). Must be the last initializer. Cannot be used in a record update expression.
+pattern FieldWildcard :: FieldWildcard dom -> FieldUpdate dom
+pattern FieldWildcard wc <- Ann _ (UFieldWildcard wc)
+
+-- * Tuple sections
+
+-- | An existing element in a tuple section
+pattern TupSecPresent :: Expr dom -> TupSecElem dom
+pattern TupSecPresent expr <- Ann _ (Present expr)
+
+-- | A missing element in a tuple section
+pattern TupSecMissing :: TupSecElem dom
+pattern TupSecMissing <- Ann _ Missing
+
+-- * Pattern matching and guards
+
+-- | Clause of case expression (@ Just x -> x + 1 @)
+pattern Alt :: Pattern dom -> CaseRhs dom -> MaybeLocalBinds dom -> Alt dom
+pattern Alt pat rhs locals <- Ann _ (UAlt pat rhs locals) 
+
+-- | Unguarded right-hand side a pattern match (@ -> 3 @)
+pattern CaseRhs :: Expr dom -> CaseRhs dom
+pattern CaseRhs e <- Ann _ (UUnguardedCaseRhs e)
+
+-- | Guarded right-hand sides of a pattern match (@ | x == 1 -> 3; | otherwise -> 4 @)
+pattern GuardedCaseRhss :: GuardedCaseRhsList dom -> CaseRhs dom
+pattern GuardedCaseRhss cases <- Ann _ (UGuardedCaseRhss cases)
+
+-- | A guarded right-hand side of pattern matches binding (@ | x > 3 -> 2 @)      
+pattern GuardedCaseRhs :: RhsGuardList dom -> Expr dom -> GuardedCaseRhs dom
+pattern GuardedCaseRhs guards expr <- Ann _ (UGuardedCaseRhs guards expr)
+
+-- * Pragmas that can be applied to expressions
+
+-- | A @CORE@ pragma for adding notes to expressions.
+pattern CorePragma :: String -> ExprPragma dom
+pattern CorePragma str <- Ann _ (UCorePragma (Ann _ (UStringNode str)))
+
+-- | An @SCC@ pragma for defining cost centers for profiling
+pattern SccPragma :: String -> ExprPragma dom
+pattern SccPragma str <- Ann _ (USccPragma (Ann _ (UStringNode str)))
+
+-- | A pragma that describes if an expression was generated from a code fragment by an external tool (@ {-# GENERATED "Happy.y" 1:15-1:25 #-} @)
+pattern GeneratedPragma :: SourceRange dom -> ExprPragma dom
+pattern GeneratedPragma rng <- Ann _ (UGeneratedPragma rng)
+
+
+-- | In-AST source ranges (for generated pragmas)
+pattern SourceRange :: String -> Integer -> Integer -> Integer -> Integer -> SourceRange dom
+pattern SourceRange file fromLine fromCol toLine toCol 
+          <- Ann _ (USourceRange 
+                     (Ann _ (UStringNode file))
+                     (Ann _ (Number fromLine))
+                     (Ann _ (Number fromCol))
+                     (Ann _ (Number toLine))
+                     (Ann _ (Number toCol)))
+-- * Commands
+
+-- | An arrow application command (@ f -< x + 1 @)
+pattern ArrowAppCmd :: Expr dom -> ArrowApp dom -> Expr dom -> Cmd dom
+pattern ArrowAppCmd lhs arrow rhs <- Ann _ (UArrowAppCmd lhs arrow rhs)
+
+-- | A form command (@ (|untilA (increment -< x+y) (within 0.5 -< x)|) @)
+pattern ArrowFormCmd :: Expr dom -> CmdList dom -> Cmd dom
+pattern ArrowFormCmd expr cmds <- Ann _ (UArrowFormCmd expr cmds)
+
+-- | A function application command
+pattern AppCmd :: Cmd dom -> Expr dom -> Cmd dom
+pattern AppCmd cmd expr <- Ann _ (UAppCmd cmd expr)
+
+-- | An infix command application
+pattern InfixCmd :: Cmd dom -> Name dom -> Cmd dom -> Cmd dom
+pattern InfixCmd lhs op rhs <- Ann _ (UInfixCmd lhs op rhs)
+
+-- | An infix command application
+pattern LambdaCmd :: PatternList dom -> Cmd dom -> Cmd dom
+pattern LambdaCmd pats cmd <- Ann _ (ULambdaCmd pats cmd)
+
+-- | A parenthesized command
+pattern ParenCmd :: Cmd dom -> Cmd dom
+pattern ParenCmd cmd <- Ann _ (UParenCmd cmd)
+
+-- | A pattern match command
+pattern CaseCmd :: Expr dom -> CmdAltList dom -> Cmd dom
+pattern CaseCmd expr alts <- Ann _ (UCaseCmd expr alts)
+
+-- | An if command (@ if f x y then g -< x+1 else h -< y+2 @)
+pattern IfCmd :: Expr dom -> Cmd dom -> Cmd dom -> Cmd dom
+pattern IfCmd pred then_ else_ <- Ann _ (UIfCmd pred then_ else_)
+
+-- | A local binding command (@ let z = x+y @)
+pattern LetCmd :: LocalBindList dom -> Cmd dom -> Cmd dom
+pattern LetCmd locals cmd <- Ann _ (ULetCmd locals cmd)
+
+-- | A local binding command (@ let z = x+y @)
+pattern DoCmd :: CmdStmtList dom -> Cmd dom
+pattern DoCmd stmts <- Ann _ (UDoCmd stmts)
+
+
+-- | Left arrow application: @-<@
+pattern LeftAppl :: ArrowApp dom
+pattern LeftAppl <- Ann _ ULeftAppl 
+
+-- | Right arrow application: @>-@
+pattern RightAppl :: ArrowApp dom
+pattern RightAppl <- Ann _ URightAppl 
+
+-- | Left arrow high application: @-<<@
+pattern LeftHighApp :: ArrowApp dom
+pattern LeftHighApp <- Ann _ ULeftHighApp 
+
+-- | Right arrow high application: @>>-@
+pattern RightHighApp :: ArrowApp dom
+pattern RightHighApp <- Ann _ URightHighApp 
+
+
+
+
+
+ Language/Haskell/Tools/AST/Match/Kinds.hs view
@@ -0,0 +1,62 @@+-- | UPattern matching on statement-level AST fragments for refactorings.
+{-# LANGUAGE PatternSynonyms #-}
+module Language.Haskell.Tools.AST.Match.Kinds where
+
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AST.ElementTypes
+
+-- | Kind constraint (@ :: * -> * @)
+pattern KindConstraint :: Kind dom -> KindConstraint dom
+pattern KindConstraint k <- Ann _ (UKindConstraint k)
+
+-- | @*@, the kind of types
+pattern StarKind :: Kind dom
+pattern StarKind <- Ann _ UStarKind
+
+-- | @#@, the kind of unboxed types
+pattern UnboxKind :: Kind dom
+pattern UnboxKind <- Ann _ UUnboxKind
+
+-- | @->@, the kind of type constructor
+pattern FunKind :: Kind dom -> Kind dom -> Kind dom
+pattern FunKind a r <- Ann _ (UFunKind a r)
+
+-- | A parenthesised kind
+pattern ParenKind :: Kind dom -> Kind dom
+pattern ParenKind k <- Ann _ (UParenKind k)
+
+-- | Kind variable (using @PolyKinds@ extension)
+pattern VarKind :: Name dom -> Kind dom
+pattern VarKind v <- Ann _ (UVarKind v)
+
+-- | Kind application (@ k1 k2 @)
+pattern AppKind :: Kind dom -> Kind dom -> Kind dom
+pattern AppKind f a <- Ann _ (UAppKind f a)
+
+-- | A list kind (@ [k] @)
+pattern ListKind :: Kind dom -> Kind dom
+pattern ListKind k <- Ann _ (UListKind k)
+
+-- | Numeric value promoted to the kind level.
+pattern IntKind :: Integer -> Kind dom
+pattern IntKind i <- Ann _ (UPromotedKind (Ann _ (UPromotedInt i)))
+
+-- | String value promoted to the kind level.
+pattern StringKind :: String -> Kind dom
+pattern StringKind s <- Ann _ (UPromotedKind (Ann _ (UPromotedString s)))
+
+-- | A data constructor value promoted to the kind level.
+pattern ConKind :: Name dom -> Kind dom
+pattern ConKind s <- Ann _ (UPromotedKind (Ann _ (UPromotedCon s)))
+
+-- | A list of elements as a kind.
+pattern ListKindPromoted :: KindList dom -> Kind dom
+pattern ListKindPromoted elems <- Ann _ (UPromotedKind (Ann _ (UPromotedList elems)))
+
+-- | A tuple of elements as a kind.
+pattern TupleKind :: KindList dom -> Kind dom
+pattern TupleKind elems <- Ann _ (UPromotedKind (Ann _ (UPromotedTuple elems)))
+
+-- | Kind of the unit value @()@. 
+pattern UnitKind :: Kind dom
+pattern UnitKind <- Ann _ (UPromotedKind (Ann _ UPromotedUnit))
+ Language/Haskell/Tools/AST/Match/Literals.hs view
@@ -0,0 +1,46 @@+-- | UPattern matching on literals for refactorings.
+{-# LANGUAGE PatternSynonyms #-}
+module Language.Haskell.Tools.AST.Match.Literals where
+
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AST.ElementTypes
+
+-- | Character literal: @'c'@
+pattern CharLit :: Char -> Literal dom
+pattern CharLit c <- Ann _ (UCharLit c)
+
+-- | String literal: @"abc"@
+pattern StringLit :: String -> Literal dom
+pattern StringLit s <- Ann _ (UStringLit s)
+
+-- | Integer literal: @12@
+pattern IntLit :: Integer -> Literal dom
+pattern IntLit i <- Ann _ (UIntLit i)
+
+-- | Fractional literal: @3.14@
+pattern FracLit :: Rational -> Literal dom
+pattern FracLit f <- Ann _ (UFracLit f)
+
+-- | Primitive integer literal (of type @Int#@): @32#@
+pattern PrimIntLit :: Integer -> Literal dom
+pattern PrimIntLit i <- Ann _ (UPrimIntLit i)
+
+-- | Primitive word literal (of type @Word#@): @32##@
+pattern PrimWordLit :: Integer -> Literal dom
+pattern PrimWordLit i <- Ann _ (UPrimWordLit i)
+
+-- | Primitive float literal (of type @Float#@): @3.14#@
+pattern PrimFloatLit :: Rational -> Literal dom
+pattern PrimFloatLit i <- Ann _ (UPrimFloatLit i)
+
+-- | Primitive double literal (of type @Double#@): @3.14##@
+pattern PrimDoubleLit :: Rational -> Literal dom
+pattern PrimDoubleLit i <- Ann _ (UPrimDoubleLit i)
+
+-- | Primitive character literal (of type @Char#@): @'c'#@
+pattern PrimCharLit :: Char -> Literal dom
+pattern PrimCharLit i <- Ann _ (UPrimCharLit i)
+
+-- | Primitive string literal (of type @Addr#@): @"xxx"#@
+pattern PrimStringLit :: String -> Literal dom
+pattern PrimStringLit s <- Ann _ (UPrimStringLit s)
+ Language/Haskell/Tools/AST/Match/Modules.hs view
@@ -0,0 +1,82 @@+-- | UPattern matching on UModule-level AST fragments for refactorings.
+{-# LANGUAGE PatternSynonyms #-}
+module Language.Haskell.Tools.AST.Match.Modules where
+
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AST.ElementTypes
+
+-- | The representation of a haskell module, that is a separate compilation unit.
+-- It may or may not have a header.
+pattern Module :: FilePragmaList dom -> MaybeModuleHead dom
+              -> ImportDeclList dom -> DeclList dom -> Module dom
+pattern Module filePrags head imps decls  <- Ann _ (UModule filePrags head imps decls )
+
+-- | Module declaration with name and (optional) exports
+pattern ModuleHead :: ModuleName dom -> MaybeExportSpecs dom 
+                  -> MaybeModulePragma dom -> ModuleHead dom
+pattern ModuleHead n es pr <- Ann _ (UModuleHead n es pr)
+
+-- | A list of export specifications surrounded by parentheses
+pattern ExportSpecs :: ExportSpecList dom -> ExportSpecs dom
+pattern ExportSpecs specs <- Ann _ (UExportSpecs specs)
+
+-- | Export a name and related names
+pattern ExportSpec :: IESpec dom -> ExportSpec dom
+pattern ExportSpec ieSpec <- Ann _ (UDeclExport ieSpec)
+
+-- | The export of an imported module (@ module A @)
+pattern ModuleExport :: ModuleName dom -> ExportSpec dom
+pattern ModuleExport name <- Ann _ (UModuleExport name)
+
+-- | Marks a name to be imported or exported with related names (subspecifier)
+pattern IESpec :: Name dom -> MaybeSubSpec dom -> IESpec dom
+pattern IESpec name ss <- Ann _ (UIESpec name ss)
+
+-- | @(..)@: a class exported with all of its methods, or a datatype exported with all of its constructors.
+pattern SubAll :: SubSpec dom
+pattern SubAll <- Ann _ USubSpecAll
+
+-- | @(a,b,c)@: a class exported with some of its methods, or a datatype exported with some of its constructors.
+pattern SubList :: NameList dom -> SubSpec dom
+pattern SubList names <- Ann _ (USubSpecList names)
+
+
+pattern ImportDecl :: MaybeImportSource dom -> MaybeImportQualified dom 
+                        -> MaybeImportSafe dom -> MaybeStringNode dom
+                        -> ModuleName dom -> MaybeImportRenaming dom
+                        -> MaybeImportSpec dom -> ImportDecl dom       
+pattern ImportDecl source qualified safe pkg name rename spec <- Ann _ (UImportDecl source qualified safe pkg name rename spec)
+
+pattern ImportRenaming :: ModuleName dom -> ImportRenaming dom
+pattern ImportRenaming name <- Ann _ (UImportRenaming name)
+
+pattern ImportSpecList :: IESpecList dom -> ImportSpec dom
+pattern ImportSpecList ieSpecs <- Ann _ (UImportSpecList ieSpecs)
+
+pattern ImportHidingList :: IESpecList dom -> ImportSpec dom
+pattern ImportHidingList hidings <- Ann _ (UImportSpecHiding hidings)
+
+pattern ModuleName :: String -> ModuleName dom
+pattern ModuleName s <- Ann _ (UModuleName s)
+
+-- * Pragmas
+
+-- | @LANGUAGE@ pragma, listing the enabled language extensions in that file
+pattern LanguagePragma :: LanguageExtensionList dom -> FilePragma dom
+pattern LanguagePragma exts <- Ann _ (ULanguagePragma exts)
+
+-- | @OPTIONS@ pragma, possibly qualified with a tool, e.g. OPTIONS_GHC
+pattern OptionsPragma :: String -> FilePragma dom
+pattern OptionsPragma opt <- Ann _ (UOptionsPragma (Ann _ (UStringNode opt)))
+
+-- | The name of the enabled language extension, for example (@ LambdaCase @)
+pattern LanguageExtension :: String -> LanguageExtension dom
+pattern LanguageExtension ext <- Ann _ (ULanguageExtension ext)
+
+-- | A warning pragma attached to the module
+pattern ModuleWarningPragma :: StringNodeList dom -> ModulePragma dom
+pattern ModuleWarningPragma msgs <- Ann _ (UModuleWarningPragma msgs)
+
+-- | A deprecated pragma attached to the module
+pattern ModuleDeprecatedPragma :: StringNodeList dom -> ModulePragma dom
+pattern ModuleDeprecatedPragma msgs <- Ann _ (UModuleDeprecatedPragma msgs)
+ Language/Haskell/Tools/AST/Match/Names.hs view
@@ -0,0 +1,38 @@+-- | Generation of basic AST fragments (names for example) for refactorings
+{-# LANGUAGE PatternSynonyms #-}
+module Language.Haskell.Tools.AST.Match.Names where
+
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AST.ElementTypes
+
+-- | A normal operator used as an operator.
+pattern NormalOp :: QualifiedName dom -> Operator dom
+pattern NormalOp n <- Ann _ (UNormalOp n)
+
+-- | A normal name used as an operator with backticks: @ a \`mod\` b @
+pattern BacktickOp :: QualifiedName dom -> Operator dom
+pattern BacktickOp n <- Ann _ (UBacktickOp n)
+
+-- | A normal, non-operator name.
+pattern NormalName :: QualifiedName dom -> Name dom
+pattern NormalName n <- Ann _ (UNormalName n)
+
+-- | Parenthesized name: @ foldl (+) 0 @
+pattern ParenName :: QualifiedName dom -> Name dom
+pattern ParenName n <- Ann _ (UParenName n)
+
+-- | Creates an implicit name: @ ?var @
+pattern ImplicitName :: QualifiedName dom -> Name dom
+pattern ImplicitName n <- Ann _ (UImplicitName n)
+
+-- | Program elements formatted as string literals (import packages, pragma texts)
+pattern StringNode :: String -> StringNode dom
+pattern StringNode s <- Ann _ (UStringNode s )
+
+-- | Possibly qualified name.
+pattern QualifiedName :: NamePartList dom -> NamePart dom -> QualifiedName dom
+pattern QualifiedName quals unqual <- Ann _ (UQualifiedName quals unqual)
+
+-- | Parts of a qualified name.
+pattern NamePart :: String -> NamePart dom
+pattern NamePart str <- Ann _ (UNamePart str)
+ Language/Haskell/Tools/AST/Match/Patterns.hs view
@@ -0,0 +1,93 @@+-- | UPattern matching on pattern-level AST fragments for refactorings.
+{-# LANGUAGE PatternSynonyms #-}
+module Language.Haskell.Tools.AST.Match.Patterns where
+
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AST.ElementTypes
+
+-- | Pattern name binding
+pattern VarPat :: Name dom -> Pattern dom
+pattern VarPat var <- Ann _ (UVarPat var)
+
+-- | Literal pattern
+pattern LitPat :: Literal dom -> Pattern dom
+pattern LitPat lit <- Ann _ (ULitPat lit)
+
+-- | Infix constructor application pattern (@ a :+: b @)
+pattern InfixAppPat :: Pattern dom -> Operator dom -> Pattern dom -> Pattern dom
+pattern InfixAppPat lhs op rhs <- Ann _ (UInfixAppPat lhs op rhs)
+
+-- | Constructor application pattern (@ Point x y @)
+pattern AppPat :: Name dom -> PatternList dom -> Pattern dom
+pattern AppPat n pat <- Ann _ (UAppPat n pat)
+
+-- | Tuple pattern (@ (x,y) @)
+pattern TuplePat :: PatternList dom -> Pattern dom
+pattern TuplePat pats <- Ann _ (UTuplePat pats)
+
+-- | Unboxed tuple pattern (@ (\# x, y \#) @)
+pattern UnboxTuplePat :: PatternList dom -> Pattern dom
+pattern UnboxTuplePat pats <- Ann _ (UUnboxTuplePat pats)
+
+-- | List pattern (@ [1,2,a,x] @)
+pattern ListPat :: PatternList dom -> Pattern dom
+pattern ListPat pats <- Ann _ (UListPat pats)
+
+-- | Parallel array pattern (@ [:1,2,a,x:] @)
+pattern ParArrayPat :: PatternList dom -> Pattern dom
+pattern ParArrayPat pats <- Ann _ (UParArrPat pats)
+
+-- | Parenthesised patterns
+pattern ParenPat :: Pattern dom -> Pattern dom
+pattern ParenPat pat <- Ann _ (UParenPat pat)
+
+-- | Record pattern (@ Point { x = 3, y } @)
+pattern RecPat :: Name dom -> PatternFieldList dom -> Pattern dom
+pattern RecPat name flds <- Ann _ (URecPat name flds)
+
+-- | As-pattern (explicit name binding) (@ ls\@(hd:_) @)
+pattern AsPat :: Name dom -> Pattern dom -> Pattern dom
+pattern AsPat name pat <- Ann _ (UAsPat name pat)
+
+-- | Wildcard pattern: (@ _ @)
+pattern WildPat :: Pattern dom
+pattern WildPat <- Ann _ UWildPat
+
+-- | Irrefutable pattern (@ ~(x:_) @)
+pattern IrrefutablePat :: Pattern dom -> Pattern dom
+pattern IrrefutablePat pat <- Ann _ (UIrrefutablePat pat)
+
+-- | Bang pattern (@ !x @)
+pattern BangPat :: Pattern dom -> Pattern dom
+pattern BangPat pat <- Ann _ (UBangPat pat)
+
+-- | Pattern with explicit type signature (@ x :: Int @)
+pattern TypeSigPat :: Pattern dom -> Type dom -> Pattern dom
+pattern TypeSigPat pat typ <- Ann _ (UTypeSigPat pat typ)
+
+-- | View pattern (@ f -> Just 1 @)
+pattern ViewPat :: Expr dom -> Pattern dom -> Pattern dom
+pattern ViewPat name pat <- Ann _ (UViewPat name pat)
+
+-- | Splice patterns: @$(generateX inp)@
+pattern SplicePat :: Splice dom -> Pattern dom
+pattern SplicePat splice <- Ann _ (USplicePat splice)
+
+-- | Quasi-quoted patterns: @[| 1 + 2 |]@
+pattern QuasiQuotePat :: QuasiQuote dom -> Pattern dom
+pattern QuasiQuotePat qq <- Ann _ (UQuasiQuotePat qq)
+
+pattern NPlusKPat :: Name dom -> Literal dom -> Pattern dom
+pattern NPlusKPat name lit <- Ann _ (UNPlusKPat name lit)
+
+-- | Named field pattern (@ p = Point 3 2 @)
+pattern FieldPattern :: Name dom -> Pattern dom -> PatternField dom
+pattern FieldPattern name pat <- Ann _ (UNormalFieldPattern name pat)
+
+-- | Named field pun (@ p @)
+pattern FieldPunPattern :: Name dom -> PatternField dom
+pattern FieldPunPattern name <- Ann _ (UFieldPunPattern name)
+
+-- | Wildcard field pattern (@ .. @)
+pattern FieldWildcardPattern :: FieldWildcard dom -> PatternField dom
+pattern FieldWildcardPattern wildc <- Ann _ (UFieldWildcardPattern wildc)
+ Language/Haskell/Tools/AST/Match/Stmts.hs view
@@ -0,0 +1,66 @@+-- | UPattern matching on statement-level AST fragments for refactorings.
+{-# LANGUAGE PatternSynonyms #-}
+module Language.Haskell.Tools.AST.Match.Stmts where
+
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AST.ElementTypes
+
+-- * Do-notation
+
+-- | Binding statement (@ x <- action @)
+pattern BindStmt :: Pattern dom -> Expr dom -> Stmt dom
+pattern BindStmt bound expr <- Ann _ (UBindStmt bound expr)
+
+-- | Non-binding statement (@ action @)
+pattern ExprStmt :: Expr dom -> Stmt dom
+pattern ExprStmt expr <- Ann _ (UExprStmt expr)
+
+-- | Let statement (@ let x = 3; y = 4 @)
+pattern LetStmt :: LocalBindList dom -> Stmt dom
+pattern LetStmt binds <- Ann _ (ULetStmt binds)
+
+-- | A recursive binding statement with (@ rec b <- f a c; c <- f b a @)
+pattern RecStmt :: StmtList dom -> Stmt dom
+pattern RecStmt stmts <- Ann _ (URecStmt stmts)
+
+pattern DoKeyword :: DoKind dom
+pattern DoKeyword <- Ann _ UDoKeyword
+
+pattern MDoKeyword :: DoKind dom
+pattern MDoKeyword <- Ann _ UMDoKeyword
+
+-- * List comprehensions
+
+-- | Body of a list comprehension: (@ | x <- [1..10] @)
+pattern ListCompBody :: CompStmtList dom -> ListCompBody dom
+pattern ListCompBody stmts <- Ann _ (UListCompBody stmts)
+
+-- | Normal monadic statement of a list comprehension
+pattern CompStmt :: Stmt dom -> CompStmt dom
+pattern CompStmt stmt <- Ann _ (UCompStmt stmt)
+
+-- | Then statements by @TransformListComp@ (@ then sortWith by (x + y) @)
+pattern ThenStmt :: Expr dom -> MaybeExpr dom -> CompStmt dom
+pattern ThenStmt then_ by <- Ann _ (UThenStmt then_ by)
+
+-- | Grouping statements by @TransformListComp@ (@ then group by (x + y) using groupWith @) 
+pattern GroupStmt :: MaybeExpr dom -> MaybeExpr dom -> CompStmt dom
+pattern GroupStmt by using <- Ann _ (UGroupStmt by using)
+
+-- * Commands
+
+-- | Binding statement command (@ x <- action @)
+pattern BindStmtCmd :: Pattern dom -> Cmd dom -> CmdStmt dom
+pattern BindStmtCmd bound expr <- Ann _ (UBindStmt bound expr)
+
+-- | Non-binding statement command (@ action @)
+pattern ExprStmtCmd :: Cmd dom -> CmdStmt dom
+pattern ExprStmtCmd expr <- Ann _ (UExprStmt expr)
+
+-- | Let statement command (@ let x = 3; y = 4 @)
+pattern LetStmtCmd :: LocalBindList dom -> CmdStmt dom
+pattern LetStmtCmd binds <- Ann _ (ULetStmt binds)
+
+-- | A recursive binding statement command with (@ rec b <- f a c; c <- f b a @)
+pattern RecStmtCmd :: CmdStmtList dom -> CmdStmt dom
+pattern RecStmtCmd stmts <- Ann _ (URecStmt stmts)
+ Language/Haskell/Tools/AST/Match/TH.hs view
@@ -0,0 +1,39 @@+-- | Pattern matching on Template Haskell AST fragments for refactorings.
+{-# LANGUAGE PatternSynonyms
+           #-}
+module Language.Haskell.Tools.AST.Match.TH where
+
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AST.ElementTypes
+
+-- | A simple name splice: @$generateX@
+pattern IdSplice :: Name dom -> Splice dom
+pattern IdSplice n <- Ann _ (UIdSplice n)
+
+-- | A splice with parentheses: @$(generate input)@
+pattern ParenSplice :: Expr dom -> Splice dom
+pattern ParenSplice e <- Ann _ (UParenSplice e)
+
+-- | Template haskell quasi-quotation: @[quoter|str]@  
+pattern QuasiQuote :: Name dom -> String -> QuasiQuote dom
+pattern QuasiQuote n qqStr <- Ann _ (UQuasiQuote n (Ann _ (QQString qqStr)))
+
+-- | Expression bracket (@ [| x + y |] @)
+pattern ExprBracket :: Expr dom -> Bracket dom
+pattern ExprBracket e <- Ann _ (UExprBracket e)
+
+-- | Pattern bracket (@ [p| Point x y |] @)
+pattern PatternBracket :: Pattern dom -> Bracket dom
+pattern PatternBracket p <- Ann _ (UPatternBracket p)
+
+-- | Type bracket (@ [t| (Int,Int) |] @)
+pattern TypeBracket :: Type dom -> Bracket dom
+pattern TypeBracket t <- Ann _ (UTypeBracket t)
+
+-- | Declaration bracket (@ [d| f :: Int -> Int; f x = x*x |] @)
+pattern DeclsBracket :: DeclList dom -> Bracket dom
+pattern DeclsBracket d <- Ann _ (UDeclsBracket d)
+
+
+
+
+ Language/Haskell/Tools/AST/Match/Types.hs view
@@ -0,0 +1,147 @@+-- | UPattern matching on type-level AST fragments for refactorings.
+{-# LANGUAGE PatternSynonyms
+           #-}
+module Language.Haskell.Tools.AST.Match.Types where
+
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AST.ElementTypes
+
+-- * Types
+
+-- | Forall types (@ forall x y . type @)
+pattern ForallType :: TyVarList dom -> Type dom -> Type dom
+pattern ForallType vars t <- Ann _ (UTyForall vars t)
+
+-- | Type with a context (@ forall x y . type @)
+pattern CtxType :: Context dom -> Type dom -> Type dom
+pattern CtxType ctx t <- Ann _ (UTyCtx ctx t)
+
+-- | Function types (@ a -> b @)
+pattern FunctionType :: Type dom -> Type dom -> Type dom
+pattern FunctionType at rt <- Ann _ (UTyFun at rt)
+
+-- | Tuple types (@ (a,b) @)
+pattern TupleType :: TypeList dom -> Type dom
+pattern TupleType args <- Ann _ (UTyTuple args)
+
+-- | Unboxed tuple types (@ (\#a,b\#) @)
+pattern UnboxedTupleType :: TypeList dom -> Type dom
+pattern UnboxedTupleType args <- Ann _ (UTyUnbTuple args)
+
+-- | List type with special syntax (@ [a] @)
+pattern ListType :: Type dom -> Type dom
+pattern ListType t <- Ann _ (UTyList t)
+
+-- | Parallel array type (@ [:a:] @)
+pattern ParArrayType :: Type dom -> Type dom
+pattern ParArrayType t <- Ann _ (UTyParArray t)
+
+-- | Type application (@ F a @)
+pattern TypeApp :: Type dom -> Type dom -> Type dom
+pattern TypeApp ft at <- Ann _ (UTyApp ft at)
+
+-- | Infix type constructor (@ (a <: b) @)
+pattern InfixTypeApp :: Type dom -> Operator dom -> Type dom -> Type dom
+pattern InfixTypeApp left op right <- Ann _ (UTyInfix left op right)
+
+-- | Type surrounded by parentheses (@ (T a) @)
+pattern ParenType :: Type dom -> Type dom
+pattern ParenType t <- Ann _ (UTyParen t)
+
+-- | Type variable or constructor (@ a @)
+pattern VarType :: Name dom -> Type dom
+pattern VarType n <- Ann _ (UTyVar n)
+
+-- | Type with explicit kind signature (@ a :: * @)
+pattern KindedType :: Type dom -> Kind dom -> Type dom
+pattern KindedType t k <- Ann _ (UTyKinded t k)
+
+-- | Strict type marked with @!@.
+pattern BangType :: Type dom -> Type dom
+pattern BangType n <- Ann _ (UTyBang n)
+
+-- | Lazy type marked with @~@. (Should only be used if @Strict@ or @StrictData@ language extension is used)
+pattern LazyType :: Type dom -> Type dom
+pattern LazyType n <- Ann _ (UTyLazy n)
+
+-- | Strict type marked with UNPACK pragma. (Usually contains the bang mark.)
+pattern UnpackType :: Type dom -> Type dom
+pattern UnpackType n <- Ann _ (UTyUnpack n)
+
+-- | Strict type marked with NOUNPACK pragma. (Usually contains the bang mark.)
+pattern NoUnpackType :: Type dom -> Type dom
+pattern NoUnpackType t <- Ann _ (UTyNoUnpack t)
+
+-- | A wildcard type (@ _ @) with @-XPartialTypeSignatures@
+pattern WildcardType :: Type dom
+pattern WildcardType <- Ann _ UTyWildcard
+
+-- | A named wildcard type (@ _t @) with @-XPartialTypeSignatures@
+pattern NamedWildcardType :: Name dom -> Type dom
+pattern NamedWildcardType n <- Ann _ (UTyNamedWildc n)
+
+-- | A Template Haskell splice type (@ $(genType) @).
+pattern SpliceType :: Splice dom -> Type dom
+pattern SpliceType spl <- Ann _ (UTySplice spl)
+
+-- | A Template Haskell splice type (@ $(genType) @).
+pattern QuasiQuoteType :: QuasiQuote dom -> Type dom
+pattern QuasiQuoteType spl <- Ann _ (UTyQuasiQuote spl)
+
+-- | Numeric value promoted to the type level.
+pattern PromotedIntType :: Integer -> Type dom
+pattern PromotedIntType i <- Ann _ (UTyPromoted (Ann _ (UPromotedInt i)))
+
+-- | String value promoted to the type level.
+pattern PromotedStringType :: String -> Type dom
+pattern PromotedStringType s <- Ann _ (UTyPromoted (Ann _ (UPromotedString s)))
+
+-- | A data constructor value promoted to the type level.
+pattern PromotedConType :: Name dom -> Type dom
+pattern PromotedConType s <- Ann _ (UTyPromoted (Ann _ (UPromotedCon s)))
+
+-- | A list of elements as a type.
+pattern PromotedListType :: TypeList dom -> Type dom
+pattern PromotedListType elems <- Ann _ (UTyPromoted (Ann _ (UPromotedList elems)))
+
+-- | A tuple of elements as a type.
+pattern PromotedTupleType :: TypeList dom -> Type dom
+pattern PromotedTupleType elems <- Ann _ (UTyPromoted (Ann _ (UPromotedTuple elems)))
+
+-- | Kind of the unit value @()@. 
+pattern PromotedUnitType :: Type dom
+pattern PromotedUnitType <- Ann _ (UTyPromoted (Ann _ UPromotedUnit))
+
+-- * Type variable
+
+-- | Type variable declaration
+pattern TyVarDecl :: Name dom -> TyVar dom
+pattern TyVarDecl n <- Ann _ (UTyVarDecl n _)
+
+-- | Kinded type variable declaration (@ v :: * @)
+pattern KindedTyVarDecl :: Name dom -> Kind dom -> TyVar dom
+pattern KindedTyVarDecl n k <- Ann _ (UTyVarDecl n (AnnJust (Ann _ (UKindConstraint k))))
+
+-- * Contexts
+
+-- | One assertion (@ C a => ... @)
+pattern ContextOne :: Assertion dom -> Context dom
+pattern ContextOne n <- Ann _ (UContextOne n)
+
+-- | A set of assertions (@ (C1 a, C2 b) => ... @, but can be one: @ (C a) => ... @)
+pattern ContextMulti :: AssertionList dom -> Context dom
+pattern ContextMulti n <- Ann _ (UContextMulti n)
+
+-- * Assertions
+
+-- | Class assertion (@Cls x@)
+pattern ClassAssert :: Name dom -> TypeList dom -> Assertion dom
+pattern ClassAssert n args <- Ann _ (UClassAssert n args)
+
+-- | Infix class assertion, also contains type equations (@ a ~ X y @)
+pattern InfixAssert :: Type dom -> Operator dom -> Type dom -> Assertion dom
+pattern InfixAssert left op right <- Ann _ (UInfixAssert left op right)
+
+-- | Assertion for implicit parameter binding (@ ?cmp :: a -> a -> Bool @)
+pattern ImplicitAssert :: Name dom -> Type dom -> Assertion dom
+pattern ImplicitAssert n t <- Ann _ (UImplicitAssert n t)
+ Language/Haskell/Tools/AST/Rewrite.hs view
@@ -0,0 +1,12 @@+-- | Public interface for the modules that can be used to rewrite the AST. 
+-- Contains modules for constructing parts of the AST and modules 
+-- for pattern matching (deconstructing) parts of the AST.
+module Language.Haskell.Tools.AST.Rewrite 
+  ( module Language.Haskell.Tools.AST.Gen
+  , module Language.Haskell.Tools.AST.Match
+  , module Language.Haskell.Tools.AST.ElementTypes
+  ) where
+
+import Language.Haskell.Tools.AST.Gen
+import Language.Haskell.Tools.AST.Match
+import Language.Haskell.Tools.AST.ElementTypes
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain
+ haskell-tools-rewrite.cabal view
@@ -0,0 +1,49 @@+name:                haskell-tools-rewrite
+version:             0.3.0.0
+synopsis:            Facilities for generating new parts of the Haskell-Tools AST
+description:         Contains utility functions to generate parts of the Haskell-Tools AST. Generates these elements to be compatible with the source annotations that are already present on the AST. The package is divided into modules based on which language elements can the given module generate. This packages should be used during the transformations to generate parts of the new AST.
+homepage:            https://github.com/haskell-tools/haskell-tools
+license:             BSD3
+license-file:        LICENSE
+author:              Boldizsar Nemeth
+maintainer:          nboldi@elte.hu
+category:            Language
+build-type:          Simple
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     Language.Haskell.Tools.AST.Rewrite
+                     , Language.Haskell.Tools.AST.ElementTypes
+                     , Language.Haskell.Tools.AST.Gen
+                     , Language.Haskell.Tools.AST.Match
+                     , Language.Haskell.Tools.AST.Gen.Modules
+                     , Language.Haskell.Tools.AST.Gen.Decls
+                     , Language.Haskell.Tools.AST.Gen.Binds
+                     , Language.Haskell.Tools.AST.Gen.Types
+                     , Language.Haskell.Tools.AST.Gen.Kinds
+                     , Language.Haskell.Tools.AST.Gen.Exprs
+                     , Language.Haskell.Tools.AST.Gen.Literals
+                     , Language.Haskell.Tools.AST.Gen.Stmts
+                     , Language.Haskell.Tools.AST.Gen.Patterns
+                     , Language.Haskell.Tools.AST.Gen.Names
+                     , Language.Haskell.Tools.AST.Gen.TH
+                     , Language.Haskell.Tools.AST.Match.Modules
+                     , Language.Haskell.Tools.AST.Match.Decls
+                     , Language.Haskell.Tools.AST.Match.Binds
+                     , Language.Haskell.Tools.AST.Match.Types
+                     , Language.Haskell.Tools.AST.Match.Kinds
+                     , Language.Haskell.Tools.AST.Match.Exprs
+                     , Language.Haskell.Tools.AST.Match.Literals
+                     , Language.Haskell.Tools.AST.Match.Stmts
+                     , Language.Haskell.Tools.AST.Match.Patterns
+                     , Language.Haskell.Tools.AST.Match.Names
+                     , Language.Haskell.Tools.AST.Match.TH
+  other-modules:       Language.Haskell.Tools.AST.Gen.Utils
+  build-depends:       base                      >= 4.9  && < 4.10
+                     , mtl                       >= 2.2  && < 2.3
+                     , containers                >= 0.5  && < 0.6
+                     , references                >= 0.3  && < 0.4
+                     , ghc                       >= 8.0  && < 8.1
+                     , haskell-tools-ast         >= 0.3  && < 0.4
+                     , haskell-tools-prettyprint >= 0.3  && < 0.4
+  default-language:    Haskell2010