packages feed

haskell-tools-refactor 0.2.0.0 → 0.3.0.0

raw patch · 25 files changed

+1676/−952 lines, 25 filesdep +haskell-tools-backend-ghcdep +haskell-tools-rewritedep +old-timedep −haskell-tools-ast-fromghcdep −haskell-tools-ast-gendep −haskell-tools-ast-trfdep ~Cabaldep ~HUnitdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: haskell-tools-backend-ghc, haskell-tools-rewrite, old-time

Dependencies removed: haskell-tools-ast-fromghc, haskell-tools-ast-gen, haskell-tools-ast-trf

Dependency ranges changed: Cabal, HUnit, base, either, filepath, haskell-tools-ast, haskell-tools-prettyprint, haskell-tools-refactor, polyparse, references, split, template-haskell, time

API changes (from Hackage documentation)

- Language.Haskell.Tools.Refactor: ExtractBinding :: RealSrcSpan -> String -> RefactorCommand
- Language.Haskell.Tools.Refactor: GenerateExports :: RefactorCommand
- Language.Haskell.Tools.Refactor: GenerateSignature :: RealSrcSpan -> RefactorCommand
- Language.Haskell.Tools.Refactor: IsHsBoot :: IsBoot
- Language.Haskell.Tools.Refactor: NoRefactor :: RefactorCommand
- Language.Haskell.Tools.Refactor: NormalHs :: IsBoot
- Language.Haskell.Tools.Refactor: OrganizeImports :: RefactorCommand
- Language.Haskell.Tools.Refactor: RenameDefinition :: RealSrcSpan -> String -> RefactorCommand
- Language.Haskell.Tools.Refactor: analyzeCommand :: String -> String -> [String] -> RefactorCommand
- Language.Haskell.Tools.Refactor: data IsBoot
- Language.Haskell.Tools.Refactor: data RefactorCommand
- Language.Haskell.Tools.Refactor: initGhcFlags :: Ghc ()
- Language.Haskell.Tools.Refactor: instance GHC.Classes.Eq Language.Haskell.Tools.Refactor.IsBoot
- Language.Haskell.Tools.Refactor: instance GHC.Classes.Ord Language.Haskell.Tools.Refactor.IsBoot
- Language.Haskell.Tools.Refactor: instance GHC.Show.Show Language.Haskell.Tools.Refactor.IsBoot
- Language.Haskell.Tools.Refactor: instance GHC.Show.Show Language.Haskell.Tools.Refactor.RefactorCommand
- Language.Haskell.Tools.Refactor: loadModule :: String -> String -> Ghc ModSummary
- Language.Haskell.Tools.Refactor: parseTyped :: ModSummary -> Ghc TypedModule
- Language.Haskell.Tools.Refactor: performCommand :: (HasModuleInfo dom, DomGenerateExports dom, OrganizeImportsDomain dom, DomainRenameDefinition dom, ExtractBindingDomain dom, GenerateSignatureDomain dom) => RefactorCommand -> ModuleDom dom -> [ModuleDom dom] -> Ghc (Either String [RefactorChange dom])
- Language.Haskell.Tools.Refactor: readCommand :: String -> String -> RefactorCommand
- Language.Haskell.Tools.Refactor: readSrcLoc :: String -> String -> RealSrcLoc
- Language.Haskell.Tools.Refactor: readSrcSpan :: String -> String -> RealSrcSpan
- Language.Haskell.Tools.Refactor: toBootFileName :: String -> String -> FilePath
- Language.Haskell.Tools.Refactor: toFileName :: String -> String -> FilePath
- Language.Haskell.Tools.Refactor: tryRefactor :: Refactoring IdDom -> String -> IO ()
- Language.Haskell.Tools.Refactor: type TypedModule = Ann Module IdDom SrcTemplateStage
- Language.Haskell.Tools.Refactor: useDirs :: [FilePath] -> Ghc ()
- Language.Haskell.Tools.Refactor: useFlags :: [String] -> Ghc [String]
- Language.Haskell.Tools.Refactor.DataToNewtype: dataToNewtype :: Domain dom => LocalRefactoring dom
- Language.Haskell.Tools.Refactor.DollarApp: dollarApp :: DollarDomain dom => RealSrcSpan -> LocalRefactoring dom
- Language.Haskell.Tools.Refactor.ExtractBinding: actualContainingExpr :: SourceInfo st => SrcSpan -> Simple Traversal (Ann ValueBind dom st) (Ann Expr dom st)
- Language.Haskell.Tools.Refactor.ExtractBinding: addLocalBinding :: SrcSpan -> SrcSpan -> Ann' ValueBind dom -> ValueBind dom SrcTemplateStage -> State Bool (ValueBind dom SrcTemplateStage)
- Language.Haskell.Tools.Refactor.ExtractBinding: doExtract :: ExtractBindingDomain dom => String -> Ann' Expr dom -> Ann' Expr dom -> StateT (Maybe (Ann' ValueBind dom)) (LocalRefactor dom) (Ann' Expr dom)
- Language.Haskell.Tools.Refactor.ExtractBinding: extractBinding :: forall dom. ExtractBindingDomain dom => Simple Traversal (Ann' Module dom) (Ann' ValueBind dom) -> Simple Traversal (Ann' ValueBind dom) (Ann' Expr dom) -> String -> LocalRefactoring dom
- Language.Haskell.Tools.Refactor.ExtractBinding: extractBinding' :: ExtractBindingDomain dom => RealSrcSpan -> String -> LocalRefactoring dom
- Language.Haskell.Tools.Refactor.ExtractBinding: extractThatBind :: ExtractBindingDomain dom => String -> Ann' Expr dom -> Ann' Expr dom -> StateT (Maybe (Ann' ValueBind dom)) (LocalRefactor dom) (Ann' Expr dom)
- Language.Haskell.Tools.Refactor.ExtractBinding: generateBind :: String -> [Ann' Pattern dom] -> Ann' Expr dom -> Ann' ValueBind dom
- Language.Haskell.Tools.Refactor.ExtractBinding: generateCall :: String -> [Ann' Name dom] -> Ann' Expr dom
- Language.Haskell.Tools.Refactor.ExtractBinding: getExternalBinds :: ExtractBindingDomain dom => Ann' Expr dom -> Ann' Expr dom -> [Ann' Name dom]
- Language.Haskell.Tools.Refactor.ExtractBinding: insertLocalBind :: SrcSpan -> Ann' ValueBind dom -> AnnMaybe' LocalBinds dom -> AnnMaybe' LocalBinds dom
- Language.Haskell.Tools.Refactor.ExtractBinding: isConflicting :: ExtractBindingDomain dom => String -> Ann' QualifiedName dom -> Bool
- Language.Haskell.Tools.Refactor.ExtractBinding: isParenLikeExpr :: Expr dom st -> Bool
- Language.Haskell.Tools.Refactor.ExtractBinding: isValidBindingName :: String -> Bool
- Language.Haskell.Tools.Refactor.ExtractBinding: type Ann' e dom = Ann e dom SrcTemplateStage
- Language.Haskell.Tools.Refactor.ExtractBinding: type AnnMaybe' e dom = AnnMaybe e dom SrcTemplateStage
- Language.Haskell.Tools.Refactor.ExtractBinding: type ExtractBindingDomain dom = (Domain dom, HasNameInfo dom, HasDefiningInfo dom, HasScopeInfo dom)
- Language.Haskell.Tools.Refactor.GenerateExports: createExports :: DomGenerateExports dom => [(Name, Bool)] -> Ann ExportSpecList dom SrcTemplateStage
- Language.Haskell.Tools.Refactor.GenerateExports: generateExports :: DomGenerateExports dom => LocalRefactoring dom
- Language.Haskell.Tools.Refactor.GenerateExports: getTopLevelDeclName :: DomGenerateExports dom => Decl dom SrcTemplateStage -> Maybe Name
- Language.Haskell.Tools.Refactor.GenerateExports: getTopLevels :: DomGenerateExports dom => Ann Module dom SrcTemplateStage -> [(Name, Bool)]
- Language.Haskell.Tools.Refactor.GenerateExports: type DomGenerateExports dom = (Domain dom, HasNameInfo dom)
- Language.Haskell.Tools.Refactor.GenerateTypeSignature: generateTypeSignature :: GenerateSignatureDomain dom => Simple Traversal (Ann' Module dom) (AnnList' Decl dom) -> Simple Traversal (Ann' Module dom) (AnnList' LocalBind dom) -> (forall d. (Show (d dom SrcTemplateStage), Data (d dom SrcTemplateStage), Typeable d, BindingElem d) => AnnList' d dom -> Maybe (Ann' ValueBind dom)) -> LocalRefactoring dom
- Language.Haskell.Tools.Refactor.GenerateTypeSignature: generateTypeSignature' :: GenerateSignatureDomain dom => RealSrcSpan -> LocalRefactoring dom
- Language.Haskell.Tools.Refactor.GenerateTypeSignature: type GenerateSignatureDomain dom = (HasModuleInfo dom, HasIdInfo dom, HasImportInfo dom)
- Language.Haskell.Tools.Refactor.IfToGuards: ifToGuards :: Domain dom => RealSrcSpan -> LocalRefactoring dom
- Language.Haskell.Tools.Refactor.OrganizeImports: organizeImports :: forall dom. OrganizeImportsDomain dom => LocalRefactoring dom
- Language.Haskell.Tools.Refactor.OrganizeImports: type OrganizeImportsDomain dom = (Domain dom, HasNameInfo dom, HasImportInfo dom)
- Language.Haskell.Tools.Refactor.RefactorBase: instance (GHC.Base.Monad m, DynFlags.HasDynFlags m) => DynFlags.HasDynFlags (Language.Haskell.Tools.Refactor.RefactorBase.LocalRefactorT dom m)
- Language.Haskell.Tools.Refactor.RenameDefinition: renameDefinition :: DomainRenameDefinition dom => Name -> [Name] -> String -> Refactoring dom
- Language.Haskell.Tools.Refactor.RenameDefinition: renameDefinition' :: forall dom. DomainRenameDefinition dom => RealSrcSpan -> String -> Refactoring dom
- Language.Haskell.Tools.Refactor.RenameDefinition: type DomainRenameDefinition dom = (HasNameInfo dom, HasScopeInfo dom, HasDefiningInfo dom, HasImplicitFieldsInfo dom, HasModuleInfo dom)
+ Language.Haskell.Tools.Refactor: annJust :: (Functor w, Applicative w, Monad w, Functor r, Applicative r, MonadPlus r, Morph Maybe r) => Reference w r (MU *) (MU *) (AnnMaybeG e d s) (AnnMaybeG e d s) (Ann e d s) (Ann e d s)
+ Language.Haskell.Tools.Refactor: annList :: (RefMonads w r, MonadPlus r, Morph Maybe r, Morph [] r) => Reference w r (MU *) (MU *) (AnnListG e d s) (AnnListG e d s) (Ann e d s) (Ann e d s)
+ Language.Haskell.Tools.Refactor: annListElems :: RefMonads w r => Reference w r (MU *) (MU *) (AnnListG elem0 dom0 stage0) (AnnListG elem0 dom0 stage0) [Ann elem0 dom0 stage0] [Ann elem0 dom0 stage0]
+ Language.Haskell.Tools.Refactor: class (Typeable * d, Data d, (~) * (SemanticInfo' d SameInfoDefaultCls) NoSemanticInfo, Data (SemanticInfo' d SameInfoNameCls), Data (SemanticInfo' d SameInfoExprCls), Data (SemanticInfo' d SameInfoImportCls), Data (SemanticInfo' d SameInfoModuleCls), Data (SemanticInfo' d SameInfoWildcardCls), Show (SemanticInfo' d SameInfoNameCls), Show (SemanticInfo' d SameInfoExprCls), Show (SemanticInfo' d SameInfoImportCls), Show (SemanticInfo' d SameInfoModuleCls), Show (SemanticInfo' d SameInfoWildcardCls)) => Domain d
+ Language.Haskell.Tools.Refactor: class HasRange a
+ Language.Haskell.Tools.Refactor: getRange :: HasRange a => a -> SrcSpan
+ Language.Haskell.Tools.Refactor: isAnnNothing :: AnnMaybeG e d s -> Bool
+ Language.Haskell.Tools.Refactor: setRange :: HasRange a => SrcSpan -> a -> a
+ Language.Haskell.Tools.Refactor.BindingElem: class NamedElement d => BindingElem d
+ Language.Haskell.Tools.Refactor.BindingElem: createBinding :: BindingElem d => ValueBind dom -> Ann d dom SrcTemplateStage
+ Language.Haskell.Tools.Refactor.BindingElem: createTypeSig :: BindingElem d => TypeSignature dom -> Ann d dom SrcTemplateStage
+ Language.Haskell.Tools.Refactor.BindingElem: getValBindInList :: (BindingElem d) => RealSrcSpan -> AnnListG d dom SrcTemplateStage -> Maybe (ValueBind dom)
+ Language.Haskell.Tools.Refactor.BindingElem: instance Language.Haskell.Tools.Refactor.BindingElem.BindingElem Language.Haskell.Tools.AST.Representation.Binds.ULocalBind
+ Language.Haskell.Tools.Refactor.BindingElem: instance Language.Haskell.Tools.Refactor.BindingElem.BindingElem Language.Haskell.Tools.AST.Representation.Decls.UDecl
+ Language.Haskell.Tools.Refactor.BindingElem: isBinding :: BindingElem d => Ann d dom SrcTemplateStage -> Bool
+ Language.Haskell.Tools.Refactor.BindingElem: isTypeSig :: BindingElem d => Ann d dom SrcTemplateStage -> Bool
+ Language.Haskell.Tools.Refactor.BindingElem: sigBind :: BindingElem d => Simple Partial (Ann d dom SrcTemplateStage) (TypeSignature dom)
+ Language.Haskell.Tools.Refactor.BindingElem: valBind :: BindingElem d => Simple Partial (Ann d dom SrcTemplateStage) (ValueBind dom)
+ Language.Haskell.Tools.Refactor.BindingElem: valBindsInList :: BindingElem d => Simple Traversal (AnnListG d dom SrcTemplateStage) (ValueBind dom)
+ Language.Haskell.Tools.Refactor.GetModules: srcDirFromRoot :: FilePath -> String -> FilePath
+ Language.Haskell.Tools.Refactor.ListOperations: filterList :: (Ann e dom SrcTemplateStage -> Bool) -> AnnListG e dom SrcTemplateStage -> AnnListG e dom SrcTemplateStage
+ Language.Haskell.Tools.Refactor.ListOperations: insertIndex :: (Maybe (Ann e dom SrcTemplateStage) -> Bool) -> (Maybe (Ann e dom SrcTemplateStage) -> Bool) -> [Ann e dom SrcTemplateStage] -> Maybe Int
+ Language.Haskell.Tools.Refactor.ListOperations: insertWhere :: Ann e dom SrcTemplateStage -> (Maybe (Ann e dom SrcTemplateStage) -> Bool) -> (Maybe (Ann e dom SrcTemplateStage) -> Bool) -> AnnListG e dom SrcTemplateStage -> AnnListG e dom SrcTemplateStage
+ Language.Haskell.Tools.Refactor.ListOperations: replaceList :: [Ann e dom SrcTemplateStage] -> AnnListG e dom SrcTemplateStage -> AnnListG e dom SrcTemplateStage
+ Language.Haskell.Tools.Refactor.ListOperations: replaceWithJust :: Ann e dom SrcTemplateStage -> AnnMaybe e dom -> AnnMaybe e dom
+ Language.Haskell.Tools.Refactor.Perform: ExtractBinding :: RealSrcSpan -> String -> RefactorCommand
+ Language.Haskell.Tools.Refactor.Perform: GenerateExports :: RefactorCommand
+ Language.Haskell.Tools.Refactor.Perform: GenerateSignature :: RealSrcSpan -> RefactorCommand
+ Language.Haskell.Tools.Refactor.Perform: NoRefactor :: RefactorCommand
+ Language.Haskell.Tools.Refactor.Perform: OrganizeImports :: RefactorCommand
+ Language.Haskell.Tools.Refactor.Perform: RenameDefinition :: RealSrcSpan -> String -> RefactorCommand
+ Language.Haskell.Tools.Refactor.Perform: analyzeCommand :: String -> String -> [String] -> RefactorCommand
+ Language.Haskell.Tools.Refactor.Perform: data RefactorCommand
+ Language.Haskell.Tools.Refactor.Perform: instance GHC.Show.Show Language.Haskell.Tools.Refactor.Perform.RefactorCommand
+ Language.Haskell.Tools.Refactor.Perform: performCommand :: (HasModuleInfo dom, DomGenerateExports dom, OrganizeImportsDomain dom, DomainRenameDefinition dom, ExtractBindingDomain dom, GenerateSignatureDomain dom) => RefactorCommand -> ModuleDom dom -> [ModuleDom dom] -> Ghc (Either String [RefactorChange dom])
+ Language.Haskell.Tools.Refactor.Perform: readCommand :: String -> String -> RefactorCommand
+ Language.Haskell.Tools.Refactor.Predefined.DataToNewtype: dataToNewtype :: Domain dom => LocalRefactoring dom
+ Language.Haskell.Tools.Refactor.Predefined.DollarApp: dollarApp :: DollarDomain dom => RealSrcSpan -> LocalRefactoring dom
+ Language.Haskell.Tools.Refactor.Predefined.DollarApp: type DollarDomain dom = (HasImportInfo dom, HasModuleInfo dom, HasFixityInfo dom, HasNameInfo dom)
+ Language.Haskell.Tools.Refactor.Predefined.ExtractBinding: extractBinding' :: ExtractBindingDomain dom => RealSrcSpan -> String -> LocalRefactoring dom
+ Language.Haskell.Tools.Refactor.Predefined.ExtractBinding: type ExtractBindingDomain dom = (HasNameInfo dom, HasDefiningInfo dom, HasScopeInfo dom)
+ Language.Haskell.Tools.Refactor.Predefined.GenerateExports: generateExports :: DomGenerateExports dom => LocalRefactoring dom
+ Language.Haskell.Tools.Refactor.Predefined.GenerateExports: type DomGenerateExports dom = (Domain dom, HasNameInfo dom)
+ Language.Haskell.Tools.Refactor.Predefined.GenerateTypeSignature: generateTypeSignature :: GenerateSignatureDomain dom => Simple Traversal (Module dom) (DeclList dom) -> Simple Traversal (Module dom) (LocalBindList dom) -> (forall d. (BindingElem d) => AnnList d dom -> Maybe (ValueBind dom)) -> LocalRefactoring dom
+ Language.Haskell.Tools.Refactor.Predefined.GenerateTypeSignature: generateTypeSignature' :: GenerateSignatureDomain dom => RealSrcSpan -> LocalRefactoring dom
+ Language.Haskell.Tools.Refactor.Predefined.GenerateTypeSignature: type GenerateSignatureDomain dom = (HasModuleInfo dom, HasIdInfo dom, HasImportInfo dom)
+ Language.Haskell.Tools.Refactor.Predefined.IfToGuards: ifToGuards :: Domain dom => RealSrcSpan -> LocalRefactoring dom
+ Language.Haskell.Tools.Refactor.Predefined.OrganizeImports: organizeImports :: forall dom. OrganizeImportsDomain dom => LocalRefactoring dom
+ Language.Haskell.Tools.Refactor.Predefined.OrganizeImports: type OrganizeImportsDomain dom = (HasNameInfo dom, HasImportInfo dom)
+ Language.Haskell.Tools.Refactor.Predefined.RenameDefinition: renameDefinition :: DomainRenameDefinition dom => Name -> [Name] -> String -> Refactoring dom
+ Language.Haskell.Tools.Refactor.Predefined.RenameDefinition: renameDefinition' :: forall dom. DomainRenameDefinition dom => RealSrcSpan -> String -> Refactoring dom
+ Language.Haskell.Tools.Refactor.Predefined.RenameDefinition: type DomainRenameDefinition dom = (HasNameInfo dom, HasScopeInfo dom, HasDefiningInfo dom, HasImplicitFieldsInfo dom, HasModuleInfo dom)
+ Language.Haskell.Tools.Refactor.Prepare: IsHsBoot :: IsBoot
+ Language.Haskell.Tools.Refactor.Prepare: NormalHs :: IsBoot
+ Language.Haskell.Tools.Refactor.Prepare: data IsBoot
+ Language.Haskell.Tools.Refactor.Prepare: initGhcFlags :: Ghc ()
+ Language.Haskell.Tools.Refactor.Prepare: instance GHC.Classes.Eq Language.Haskell.Tools.Refactor.Prepare.IsBoot
+ Language.Haskell.Tools.Refactor.Prepare: instance GHC.Classes.Ord Language.Haskell.Tools.Refactor.Prepare.IsBoot
+ Language.Haskell.Tools.Refactor.Prepare: instance GHC.Show.Show Language.Haskell.Tools.Refactor.Prepare.IsBoot
+ Language.Haskell.Tools.Refactor.Prepare: loadModule :: String -> String -> Ghc ModSummary
+ Language.Haskell.Tools.Refactor.Prepare: parseTyped :: ModSummary -> Ghc TypedModule
+ Language.Haskell.Tools.Refactor.Prepare: readSrcLoc :: String -> String -> RealSrcLoc
+ Language.Haskell.Tools.Refactor.Prepare: readSrcSpan :: String -> String -> RealSrcSpan
+ Language.Haskell.Tools.Refactor.Prepare: toBootFileName :: String -> String -> FilePath
+ Language.Haskell.Tools.Refactor.Prepare: toFileName :: String -> String -> FilePath
+ Language.Haskell.Tools.Refactor.Prepare: tryRefactor :: Refactoring IdDom -> String -> IO ()
+ Language.Haskell.Tools.Refactor.Prepare: type TypedModule = Ann UModule IdDom SrcTemplateStage
+ Language.Haskell.Tools.Refactor.Prepare: useDirs :: [FilePath] -> Ghc ()
+ Language.Haskell.Tools.Refactor.Prepare: useFlags :: [String] -> Ghc [String]
+ Language.Haskell.Tools.Refactor.RefactorBase: instance (DynFlags.HasDynFlags m, GHC.Base.Monad m) => DynFlags.HasDynFlags (Language.Haskell.Tools.Refactor.RefactorBase.LocalRefactorT dom m)
- Language.Haskell.Tools.Refactor.GetModules: getModules :: FilePath -> IO [String]
+ Language.Haskell.Tools.Refactor.GetModules: getModules :: FilePath -> IO [([FilePath], [String])]
- Language.Haskell.Tools.Refactor.GetModules: modulesFromCabalFile :: FilePath -> IO [String]
+ Language.Haskell.Tools.Refactor.GetModules: modulesFromCabalFile :: FilePath -> IO [([FilePath], [String])]
- Language.Haskell.Tools.Refactor.RefactorBase: RefactorCtx :: Module -> Ann Module dom SrcTemplateStage -> [Ann ImportDecl dom SrcTemplateStage] -> RefactorCtx dom
+ Language.Haskell.Tools.Refactor.RefactorBase: RefactorCtx :: Module -> Ann UModule dom SrcTemplateStage -> [Ann UImportDecl dom SrcTemplateStage] -> RefactorCtx dom
- Language.Haskell.Tools.Refactor.RefactorBase: [refCtxImports] :: RefactorCtx dom -> [Ann ImportDecl dom SrcTemplateStage]
+ Language.Haskell.Tools.Refactor.RefactorBase: [refCtxImports] :: RefactorCtx dom -> [Ann UImportDecl dom SrcTemplateStage]
- Language.Haskell.Tools.Refactor.RefactorBase: [refCtxRoot] :: RefactorCtx dom -> Ann Module dom SrcTemplateStage
+ Language.Haskell.Tools.Refactor.RefactorBase: [refCtxRoot] :: RefactorCtx dom -> Ann UModule dom SrcTemplateStage
- Language.Haskell.Tools.Refactor.RefactorBase: addGeneratedImports :: [Name] -> Ann Module dom SrcTemplateStage -> Ann Module dom SrcTemplateStage
+ Language.Haskell.Tools.Refactor.RefactorBase: addGeneratedImports :: [Name] -> Ann UModule dom SrcTemplateStage -> Ann UModule dom SrcTemplateStage
- Language.Haskell.Tools.Refactor.RefactorBase: referenceBy :: ([String] -> Name -> Ann nt dom SrcTemplateStage) -> Name -> [Ann ImportDecl dom SrcTemplateStage] -> Ann nt dom SrcTemplateStage
+ Language.Haskell.Tools.Refactor.RefactorBase: referenceBy :: ([String] -> Name -> Ann nt dom SrcTemplateStage) -> Name -> [Ann UImportDecl dom SrcTemplateStage] -> Ann nt dom SrcTemplateStage
- Language.Haskell.Tools.Refactor.RefactorBase: referenceName :: (HasImportInfo dom, HasModuleInfo dom) => Name -> LocalRefactor dom (Ann Name dom SrcTemplateStage)
+ Language.Haskell.Tools.Refactor.RefactorBase: referenceName :: (HasImportInfo dom, HasModuleInfo dom) => Name -> LocalRefactor dom (Ann UName dom SrcTemplateStage)
- Language.Haskell.Tools.Refactor.RefactorBase: referenceOperator :: (HasImportInfo dom, HasModuleInfo dom) => Name -> LocalRefactor dom (Ann Operator dom SrcTemplateStage)
+ Language.Haskell.Tools.Refactor.RefactorBase: referenceOperator :: (HasImportInfo dom, HasModuleInfo dom) => Name -> LocalRefactor dom (Ann UOperator dom SrcTemplateStage)
- Language.Haskell.Tools.Refactor.RefactorBase: type UnnamedModule dom = Ann Module dom SrcTemplateStage
+ Language.Haskell.Tools.Refactor.RefactorBase: type UnnamedModule dom = Ann UModule dom SrcTemplateStage

Files

Language/Haskell/Tools/Refactor.hs view
@@ -1,191 +1,27 @@-{-# LANGUAGE StandaloneDeriving
-           , DeriveGeneric
-           , LambdaCase
-           , ScopedTypeVariables
-           , BangPatterns
-           , MultiWayIf
-           , FlexibleContexts
-           , TypeFamilies
-           , TupleSections
-           , TemplateHaskell
-           , ViewPatterns
-           #-}
--- | Defines common utilities for using refactorings. Provides an interface for both demo, command line and integrated tools.
-module Language.Haskell.Tools.Refactor where
-
-import Language.Haskell.Tools.AST.FromGHC
-import Language.Haskell.Tools.AST as AST
-import Language.Haskell.Tools.AnnTrf.RangeToRangeTemplate
-import Language.Haskell.Tools.AnnTrf.RangeTemplateToSourceTemplate
-import Language.Haskell.Tools.AnnTrf.SourceTemplate
-import Language.Haskell.Tools.AnnTrf.RangeTemplate
-import Language.Haskell.Tools.AnnTrf.PlaceComments
-import Language.Haskell.Tools.PrettyPrint.RoseTree
-import Language.Haskell.Tools.PrettyPrint
+-- | Defines the API for refactorings
+module Language.Haskell.Tools.Refactor 
+  ( module Language.Haskell.Tools.AST.SemaInfoClasses
+  , module Language.Haskell.Tools.AST.Rewrite
+  , module Language.Haskell.Tools.AST.References
+  , module Language.Haskell.Tools.AST.Helpers
+  , module Language.Haskell.Tools.Refactor.RefactorBase
+  , module Language.Haskell.Tools.AST.ElementTypes
+  , module Language.Haskell.Tools.Refactor.Prepare
+  , module Language.Haskell.Tools.Refactor.ListOperations
+  , module Language.Haskell.Tools.Refactor.BindingElem
+  , HasRange(..), annListElems, annList, annJust, isAnnNothing, Domain
+  ) where
 
-import GHC hiding (loadModule)
-import Panic (handleGhcException)
-import Outputable
-import BasicTypes
-import Bag
-import Var
-import SrcLoc
-import Module as GHC
-import FastString
-import HscTypes
-import GHC.Paths ( libdir )
-import CmdLineParser
- 
-import Data.List
-import Data.List.Split
-import GHC.Generics hiding (moduleName)
-import qualified Data.Map as Map
-import Data.Maybe
-import Data.Typeable
-import Data.IORef
-import Control.Monad
-import Control.Monad.State
-import Control.Monad.IO.Class
-import Control.Reference
-import Control.Exception
-import System.Directory
-import System.IO
-import System.FilePath
-import Data.Generics.Uniplate.Operations
+-- Important: Haddock doesn't support the rename all exported modules and export them at once hack
 
-import Language.Haskell.Tools.Refactor.OrganizeImports
-import Language.Haskell.Tools.Refactor.GenerateTypeSignature
-import Language.Haskell.Tools.Refactor.GenerateExports
-import Language.Haskell.Tools.Refactor.RenameDefinition
-import Language.Haskell.Tools.Refactor.ExtractBinding
+import Language.Haskell.Tools.AST.SemaInfoClasses
+import Language.Haskell.Tools.AST.Rewrite
+import Language.Haskell.Tools.AST.References
+import Language.Haskell.Tools.AST.Helpers
 import Language.Haskell.Tools.Refactor.RefactorBase
-import Language.Haskell.Tools.Refactor.GetModules
-
-import Language.Haskell.TH.LanguageExtensions
- 
-import DynFlags
-import StringBuffer            
-
-import Debug.Trace
-
-
--- | Use the given source directories
-useDirs :: [FilePath] -> Ghc ()
-useDirs workingDirs = do
-  dynflags <- getSessionDynFlags
-  setSessionDynFlags dynflags { importPaths = importPaths dynflags ++ workingDirs }
-  return ()
-
--- | Set the given flags for the GHC session
-useFlags :: [String] -> Ghc [String]
-useFlags args = do 
-  let lArgs = map (L noSrcSpan) args
-  dynflags <- getSessionDynFlags
-  let ((leftovers, errors, warnings), newDynFlags) = (runCmdLine $ processArgs flagsAll lArgs) dynflags
-  setSessionDynFlags newDynFlags
-  return $ map unLoc leftovers
-
--- | Initialize GHC flags to default values that support refactoring
-initGhcFlags :: Ghc ()
-initGhcFlags = do
-  dflags <- getSessionDynFlags
-  setSessionDynFlags 
-    $ flip gopt_set Opt_KeepRawTokenStream
-    $ flip gopt_set Opt_NoHsMain
-    $ dflags { importPaths = []
-             , hscTarget = HscAsm -- needed for static pointers
-             , ghcLink = LinkInMemory
-             , ghcMode = CompManager 
-             , packageFlags = ExposePackage "template-haskell" (PackageArg "template-haskell") (ModRenaming True []) : packageFlags dflags
-             }
-  return ()
-
--- | Translates module name and working directory into the name of the file where the given module should be defined
-toFileName :: String -> String -> FilePath
-toFileName workingDir mod = normalise $ workingDir </> map (\case '.' -> pathSeparator; c -> c) mod ++ ".hs"
-
--- | Translates module name and working directory into the name of the file where the boot module should be defined
-toBootFileName :: String -> String -> FilePath
-toBootFileName workingDir mod = normalise $ workingDir </> map (\case '.' -> pathSeparator; c -> c) mod ++ ".hs-boot"
-
--- | Load the summary of a module given by the working directory and module name.
-loadModule :: String -> String -> Ghc ModSummary
-loadModule workingDir moduleName 
-  = do initGhcFlags
-       useDirs [workingDir]
-       target <- guessTarget moduleName Nothing
-       setTargets [target]
-       load LoadAllTargets
-       getModSummary $ mkModuleName moduleName
-    
--- | The final version of our AST, with type infromation added
-type TypedModule = Ann AST.Module IdDom SrcTemplateStage
-
--- | Get the typed representation from a type-correct program.
-parseTyped :: ModSummary -> Ghc TypedModule
-parseTyped modSum = do
-  p <- parseModule modSum
-  tc <- typecheckModule p
-  let annots = pm_annotations p
-      srcBuffer = fromJust $ ms_hspp_buf $ pm_mod_summary p
-  rangeToSource srcBuffer . cutUpRanges . fixRanges . placeComments (getNormalComments $ snd annots) 
-    <$> (addTypeInfos (typecheckedSource tc) 
-           =<< (do parseTrf <- runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModule modSum (pm_parsed_source p)
-                   runTrf (fst annots) (getPragmaComments $ snd annots)
-                     $ trfModuleRename modSum parseTrf
-                         (fromJust $ tm_renamed_source tc) 
-                         (pm_parsed_source p)))
-
--- | Executes a given command on the selected module and given other modules
-performCommand :: (HasModuleInfo dom, DomGenerateExports dom, OrganizeImportsDomain dom, DomainRenameDefinition dom, ExtractBindingDomain dom, GenerateSignatureDomain dom) 
-               => RefactorCommand -> ModuleDom dom -- ^ The module in which the refactoring is performed
-                                  -> [ModuleDom dom] -- ^ Other modules
-                                  -> Ghc (Either String [RefactorChange dom])
-performCommand rf mod mods = runRefactor mod mods $ selectCommand rf
-  where selectCommand NoRefactor = localRefactoring return
-        selectCommand OrganizeImports = localRefactoring organizeImports
-        selectCommand GenerateExports = localRefactoring generateExports 
-        selectCommand (GenerateSignature sp) = localRefactoring $ generateTypeSignature' sp
-        selectCommand (RenameDefinition sp str) = renameDefinition' sp str
-        selectCommand (ExtractBinding sp str) = localRefactoring $ extractBinding' sp str
-
--- | A refactoring command
-data RefactorCommand = NoRefactor 
-                     | OrganizeImports
-                     | GenerateExports
-                     | GenerateSignature RealSrcSpan
-                     | RenameDefinition RealSrcSpan String
-                     | ExtractBinding RealSrcSpan String
-    deriving Show
-
-readCommand :: String -> String -> RefactorCommand
-readCommand fileName (splitOn " " -> refact:args) = analyzeCommand fileName refact args
-
-analyzeCommand :: String -> String -> [String] -> RefactorCommand
-analyzeCommand _ "" _ = NoRefactor
-analyzeCommand _ "CheckSource" _ = NoRefactor
-analyzeCommand _ "OrganizeImports" _ = OrganizeImports
-analyzeCommand _ "GenerateExports" _ = GenerateExports
-analyzeCommand fileName "GenerateSignature" [sp] = GenerateSignature (readSrcSpan fileName sp)
-analyzeCommand fileName "RenameDefinition" [sp, newName] = RenameDefinition (readSrcSpan fileName sp) newName
-analyzeCommand fileName "ExtractBinding" [sp, newName] = ExtractBinding (readSrcSpan fileName sp) newName
-
-readSrcSpan :: String -> String -> RealSrcSpan
-readSrcSpan fileName s = case splitOn "-" s of
-  [from,to] -> mkRealSrcSpan (readSrcLoc fileName from) (readSrcLoc fileName to)
-  
-readSrcLoc :: String -> String -> RealSrcLoc
-readSrcLoc fileName s = case splitOn ":" s of
-  [line,col] -> mkRealSrcLoc (mkFastString fileName) (read line) (read col)
-
-data IsBoot = NormalHs | IsHsBoot deriving (Eq, Ord, Show)
+import Language.Haskell.Tools.AST.ElementTypes
+import Language.Haskell.Tools.Refactor.Prepare
+import Language.Haskell.Tools.Refactor.ListOperations
+import Language.Haskell.Tools.Refactor.BindingElem
 
-tryRefactor :: Refactoring IdDom -> String -> IO ()
-tryRefactor refact moduleName 
-  = runGhc (Just libdir) $ do
-      initGhcFlags
-      useDirs ["."]
-      mod <- loadModule "." moduleName >>= parseTyped
-      res <- runRefactor (toFileName "." moduleName, mod) [] refact 
-      case res of Right r -> liftIO $ mapM_ (putStrLn . prettyPrint . snd . fromContentChanged) r
-                  Left err -> liftIO $ putStrLn err
+import Language.Haskell.Tools.AST.Ann
+ Language/Haskell/Tools/Refactor/BindingElem.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE FlexibleContexts
+           , TypeFamilies
+           #-}
+-- | Utilities for transformations that work on both top-level and local definitions
+module Language.Haskell.Tools.Refactor.BindingElem where
+
+import Control.Reference
+import Language.Haskell.Tools.AST.Rewrite
+import Language.Haskell.Tools.AST.ElementTypes
+import Language.Haskell.Tools.AST
+import SrcLoc
+
+-- | A type class for handling definitions that can appear as both top-level and local definitions
+class NamedElement d => BindingElem d where
+
+  -- | Accesses a type signature definition in a local or top-level definition
+  sigBind :: Simple Partial (Ann d dom SrcTemplateStage) (TypeSignature dom)
+
+  -- | Accesses a value or function definition in a local or top-level definition
+  valBind :: Simple Partial (Ann d dom SrcTemplateStage) (ValueBind dom)
+
+  -- | Creates a new definition from a type signature
+  createTypeSig :: TypeSignature dom -> Ann d dom SrcTemplateStage
+
+  -- | Creates a new definition from a value or function definition
+  createBinding :: ValueBind dom -> Ann d dom SrcTemplateStage
+
+  -- | Checks if a given definition is a type signature
+  isTypeSig :: Ann d dom SrcTemplateStage -> Bool
+  
+  -- | Checks if a given definition is a function or value binding
+  isBinding :: Ann d dom SrcTemplateStage -> Bool
+  
+instance BindingElem UDecl where
+  sigBind = declTypeSig
+  valBind = declValBind
+  createTypeSig = mkTypeSigDecl
+  createBinding = mkValueBinding
+  isTypeSig TypeSigDecl {} = True
+  isTypeSig _ = False
+  isBinding ValueBinding {} = True
+  isBinding _ = False
+
+instance BindingElem ULocalBind where
+  sigBind = localSig
+  valBind = localVal
+  createTypeSig = mkLocalTypeSig
+  createBinding = mkLocalValBind
+  isTypeSig LocalTypeSig {} = True
+  isTypeSig _ = False
+  isBinding LocalValBind {} = True
+  isBinding _ = False
+     
+getValBindInList :: (BindingElem d) => RealSrcSpan -> AnnListG d dom SrcTemplateStage -> Maybe (ValueBind dom)
+getValBindInList sp ls = case ls ^? valBindsInList & filtered (isInside sp) of
+  [] -> Nothing
+  [n] -> Just n
+  _ -> error "getValBindInList: Multiple nodes"
+
+valBindsInList :: BindingElem d => Simple Traversal (AnnListG d dom SrcTemplateStage) (ValueBind dom)
+valBindsInList = annList & valBind
− Language/Haskell/Tools/Refactor/DataToNewtype.hs
@@ -1,20 +0,0 @@-module Language.Haskell.Tools.Refactor.DataToNewtype (dataToNewtype) where
-
-import Language.Haskell.Tools.AST
-import Language.Haskell.Tools.AST.Gen
-import Language.Haskell.Tools.Refactor.RefactorBase
-
-import Language.Haskell.Tools.Refactor (tryRefactor)
-
-tryItOut moduleName = tryRefactor (localRefactoring $ dataToNewtype) moduleName
-
-dataToNewtype :: Domain dom => LocalRefactoring dom
-dataToNewtype (Ann mi mod@(Module { _modDecl = AnnList li ls })) 
-  = return (Ann mi mod { _modDecl = AnnList li (map changeDeclaration ls) })
-
-changeDeclaration :: Ann Decl dom SrcTemplateStage -> Ann Decl dom SrcTemplateStage
-changeDeclaration (Ann a dd@(DataDecl {})) 
-  | annLength (_declCons dd) == 1 
-      && annLength (_conDeclArgs (_element (_annListElems (_declCons dd) !! 0))) == 1
-  = Ann a dd{ _declNewtype = mkNewtypeKeyword }
-changeDeclaration decl = decl
− Language/Haskell/Tools/Refactor/DollarApp.hs
@@ -1,54 +0,0 @@-{-# LANGUAGE ViewPatterns, FlexibleContexts, ConstraintKinds #-}
-module Language.Haskell.Tools.Refactor.DollarApp (dollarApp) where
-
-import Language.Haskell.Tools.AST
-import Language.Haskell.Tools.AST.Gen
-import Language.Haskell.Tools.PrettyPrint
-import Language.Haskell.Tools.Refactor
-import Language.Haskell.Tools.Refactor.RefactorBase
-
-import SrcLoc (RealSrcSpan, SrcSpan)
-import Unique (getUnique)
-import Id (idName)
-import PrelNames (dollarIdKey)
-import PrelInfo (wiredInIds)
-import BasicTypes (Fixity(..))
-
-import Control.Monad.State
-import Control.Reference hiding (element)
-import Data.Generics.Uniplate.Data
-import Debug.Trace
-
-tryItOut moduleName sp = tryRefactor (localRefactoring $ dollarApp (readSrcSpan (toFileName "." moduleName) sp)) moduleName
-
-type RefactMonad dom = StateT [SrcSpan] (LocalRefactor dom)
-type DollarDomain dom = (HasImportInfo dom, HasModuleInfo dom, HasFixityInfo dom, HasNameInfo dom)
-
-dollarApp :: DollarDomain dom => RealSrcSpan -> LocalRefactoring dom
-dollarApp sp = flip evalStateT [] . ((nodesContained sp !~ (\e -> get >>= replaceExpr e)) >=> (biplateRef !~ parenExpr))
-
-replaceExpr :: DollarDomain dom => Ann Expr dom SrcTemplateStage -> [SrcSpan] -> RefactMonad dom (Ann Expr dom SrcTemplateStage)
-replaceExpr expr@(e -> App fun (e -> Paren (e -> InfixApp _ op arg))) replacedRanges
-  | not (getRange arg `elem` replacedRanges)
-  , sema <- op ^. element&operatorName&semantics
-  , semanticsName sema /= Just dollarName 
-  , case semanticsFixity sema of Just (Fixity _ p _) | p > 0 -> False; _ -> True
-  = return expr
-replaceExpr (e -> App fun (e -> Paren arg)) _ = do modify $ (getRange arg :)
-                                                   mkInfixApp fun <$> lift (referenceOperator dollarName) <*> pure arg
-replaceExpr e _ = return e
-
-parenExpr :: Ann Expr dom SrcTemplateStage -> RefactMonad dom (Ann Expr dom SrcTemplateStage)
-parenExpr e = (element&exprLhs !~ parenDollar True) =<< (element&exprRhs !~ parenDollar False $ e)
-
-parenDollar :: Bool -> Ann Expr dom SrcTemplateStage -> RefactMonad dom (Ann Expr dom SrcTemplateStage)
-parenDollar lhs expr@(e -> InfixApp _ _ arg) 
-  = do replacedRanges <- get
-       if getRange arg `elem` replacedRanges && (lhs || getRange expr `notElem` replacedRanges)
-         then return $ mkParen expr
-         else return expr
-parenDollar _ e = return e
-
-e = (^. element)
-
-[dollarName] = map idName $ filter ((dollarIdKey==) . getUnique) wiredInIds
− Language/Haskell/Tools/Refactor/ExtractBinding.hs
@@ -1,161 +0,0 @@-
-{-# LANGUAGE ViewPatterns
-           , ScopedTypeVariables
-           , RankNTypes
-           , FlexibleContexts
-           , TypeApplications
-           , ConstraintKinds
-           , TypeFamilies
-           #-}
-module Language.Haskell.Tools.Refactor.ExtractBinding where
-
-import qualified GHC
-import qualified Var as GHC
-import qualified OccName as GHC hiding (varName)
-import SrcLoc
-import Unique
-
-import Data.Char
-import Data.Maybe
-import Data.Generics.Uniplate.Data
-import Control.Reference hiding (element)
-import Control.Monad.State
-import Language.Haskell.Tools.AST
-import Language.Haskell.Tools.AnnTrf.SourceTemplate
-import Language.Haskell.Tools.AST.Gen
-import Language.Haskell.Tools.Refactor.RefactorBase
-import Language.Haskell.Tools.AnnTrf.SourceTemplateHelpers
-
-import Debug.Trace
-
-type Ann' e dom = Ann e dom SrcTemplateStage 
-type AnnMaybe' e dom = AnnMaybe e dom SrcTemplateStage 
-
-type ExtractBindingDomain dom = ( Domain dom, HasNameInfo dom, HasDefiningInfo dom, HasScopeInfo dom )
-
-extractBinding' :: ExtractBindingDomain dom => RealSrcSpan -> String -> LocalRefactoring dom
-extractBinding' sp name mod
-  = if isValidBindingName name then extractBinding (nodesContaining sp) (nodesContaining sp) name mod
-                               else refactError "The given name is not a valid for the extracted binding"
-
-extractBinding :: forall dom . ExtractBindingDomain dom => Simple Traversal (Ann' Module dom) (Ann' ValueBind dom)
-                   -> Simple Traversal (Ann' ValueBind dom) (Ann' Expr dom)
-                   -> String -> LocalRefactoring dom
-extractBinding selectDecl selectExpr name mod
-  = let conflicting = any (isConflicting name) (mod ^? selectDecl & biplateRef :: [Ann' QualifiedName dom])
-        exprRange = getRange $ head (mod ^? selectDecl & selectExpr & annotation & sourceInfo)
-        decl = last (mod ^? selectDecl)
-        declRange = getRange $ last (mod ^? selectDecl & annotation & sourceInfo)
-     in if conflicting
-           then refactError "The given name causes name conflict."
-           else do (res, st) <- runStateT (selectDecl&selectExpr !~ extractThatBind name (head $ decl ^? actualContainingExpr exprRange) $ mod) Nothing
-                   case st of Just def -> return $ evalState (selectDecl&element !~ addLocalBinding declRange exprRange def $ res) False
-                              Nothing -> refactError "There is no applicable expression to extract."
-
-isConflicting :: ExtractBindingDomain dom => String -> Ann' QualifiedName dom -> Bool
-isConflicting name used
-  = semanticsDefining (used ^. semantics)
-      && (GHC.occNameString . GHC.getOccName <$> semanticsName (used ^. semantics)) == Just name
-
--- Replaces the selected expression with a call and generates the called binding.
-extractThatBind :: ExtractBindingDomain dom => String -> Ann' Expr dom -> Ann' Expr dom -> StateT (Maybe (Ann' ValueBind dom)) (LocalRefactor dom) (Ann' Expr dom)
-extractThatBind name cont e 
-  = do ret <- get
-       if (isJust ret) then return e 
-          else case (e ^. element) of
-            Paren {} | hasParameter -> element & exprInner !~ doExtract name cont $ e
-                     | otherwise -> doExtract name cont (fromJust $ e ^? element & exprInner)
-            Var {} -> lift $ refactError "The selected expression is too simple to be extracted."
-            el | isParenLikeExpr el && hasParameter -> mkParen <$> doExtract name cont e
-            el -> doExtract name cont e
-  where hasParameter = not (null (getExternalBinds cont e))
-
-addLocalBinding :: SrcSpan -> SrcSpan -> Ann' ValueBind dom -> ValueBind dom SrcTemplateStage -> State Bool (ValueBind dom SrcTemplateStage)
-addLocalBinding declRange exprRange local bind 
-  = do done <- get
-       if not done then do put True
-                           return $ doAddBinding declRange exprRange local bind
-                   else return bind 
-  where
-    doAddBinding declRng _ local sb@(SimpleBind {}) = valBindLocals .- insertLocalBind declRng local $ sb
-    doAddBinding declRng (RealSrcSpan rng) local fb@(FunBind {}) 
-      = funBindMatches & annList & filtered (isInside rng) & element & matchBinds .- insertLocalBind declRng local $ fb
-
-insertLocalBind :: SrcSpan -> Ann' ValueBind dom -> AnnMaybe' LocalBinds dom -> AnnMaybe' LocalBinds dom
-insertLocalBind declRng toInsert locals 
-  | isAnnNothing locals
-  , RealSrcSpan rng <- declRng = -- creates the new where clause indented 2 spaces from the declaration
-                                 mkLocalBinds (srcLocCol (realSrcSpanStart rng) + 2) [mkLocalValBind toInsert]
-  | otherwise = annJust & element & localBinds .- insertWhere (mkLocalValBind toInsert) (const True) isNothing $ locals
-
--- | All expressions that are bound stronger than function application.
-isParenLikeExpr :: Expr dom st -> Bool
-isParenLikeExpr (If {}) = True
-isParenLikeExpr (Paren {}) = True
-isParenLikeExpr (List {}) = True
-isParenLikeExpr (ParArray {}) = True
-isParenLikeExpr (LeftSection {}) = True
-isParenLikeExpr (RightSection {}) = True
-isParenLikeExpr (RecCon {}) = True
-isParenLikeExpr (RecUpdate {}) = True
-isParenLikeExpr (Enum {}) = True
-isParenLikeExpr (ParArrayEnum {}) = True
-isParenLikeExpr (ListComp {}) = True
-isParenLikeExpr (ParArrayComp {}) = True
-isParenLikeExpr (BracketExpr {}) = True
-isParenLikeExpr (Splice {}) = True
-isParenLikeExpr (QuasiQuoteExpr {}) = True
-isParenLikeExpr _ = False
-
-doExtract :: ExtractBindingDomain dom => String -> Ann' Expr dom -> Ann' Expr dom -> StateT (Maybe (Ann' ValueBind dom)) (LocalRefactor dom) (Ann' Expr dom)
-doExtract name cont e@((^. element) -> lam@(Lambda {}))
-  = do let params = getExternalBinds cont e
-       put (Just (generateBind name (map mkVarPat params ++ (lam ^? exprBindings&annList)) (fromJust $ lam ^? exprInner)))
-       return (generateCall name params)
-doExtract name cont e 
-  = do let params = getExternalBinds cont e
-       put (Just (generateBind name (map mkVarPat params) e))
-       return (generateCall name params)
-
--- | Gets the values that have to be passed to the extracted definition
-getExternalBinds :: ExtractBindingDomain dom => Ann' Expr dom -> Ann' Expr dom -> [Ann' Name dom]
-getExternalBinds cont expr = map exprToName $ keepFirsts $ filter isApplicableName (expr ^? uniplateRef)
-  where isApplicableName name@(getExprNameInfo -> Just nm) = inScopeForOriginal nm && notInScopeForExtracted nm
-        isApplicableName _ = False
-
-        getExprNameInfo :: ExtractBindingDomain dom => Ann' Expr dom -> Maybe GHC.Name
-        getExprNameInfo expr = semanticsName =<< (listToMaybe $ expr ^? element & (exprName&element&simpleName &+& exprOperator&element&operatorName) 
-                                                                                & semantics)
-
-        -- | Creates the parameter value to pass the name (operators are passed in parentheses)
-        exprToName :: Ann' Expr dom -> Ann' Name dom
-        exprToName e | Just n <- e ^? element & exprName                               = n
-                     | Just op <- e ^? element & exprOperator & element & operatorName = mkParenName op
-        
-        notInScopeForExtracted :: GHC.Name -> Bool
-        notInScopeForExtracted n = notElem @[] n (semanticsScope (cont ^. semantics) ^? traversal & traversal)
-
-        inScopeForOriginal :: GHC.Name -> Bool
-        inScopeForOriginal n = elem @[] n (semanticsScope (expr ^. semantics) ^? traversal & traversal)
-
-        keepFirsts (e:rest) = e : keepFirsts (filter (/= e) rest)
-        keepFirsts [] = []
-
-actualContainingExpr :: SourceInfo st => SrcSpan -> Simple Traversal (Ann ValueBind dom st) (Ann Expr dom st)
-actualContainingExpr (RealSrcSpan rng) = element & accessRhs & element & accessExpr
-  where accessRhs :: SourceInfo st => Simple Traversal (ValueBind dom st) (Ann Rhs dom st)
-        accessRhs = valBindRhs &+& funBindMatches & annList & filtered (isInside rng) & element & matchRhs
-        accessExpr :: SourceInfo st => Simple Traversal (Rhs dom st) (Ann Expr dom st)
-        accessExpr = rhsExpr &+& rhsGuards & annList & filtered (isInside rng) & element & guardExpr
-
--- | Generates the expression that calls the local binding
-generateCall :: String -> [Ann' Name dom] -> Ann' Expr dom
-generateCall name args = foldl (\e a -> mkApp e (mkVar a)) (mkVar $ mkNormalName $ mkSimpleName name) args
-
--- | Generates the local binding for the selected expression
-generateBind :: String -> [Ann' Pattern dom] -> Ann' Expr dom -> Ann' ValueBind dom
-generateBind name [] e = mkSimpleBind (mkVarPat $ mkNormalName $ mkSimpleName name) (mkUnguardedRhs e) Nothing
-generateBind name args e = mkFunctionBind [mkMatch (mkNormalMatchLhs (mkNormalName $ mkSimpleName name) args) (mkUnguardedRhs e) Nothing]
-
-isValidBindingName :: String -> Bool
-isValidBindingName = nameValid Variable
− Language/Haskell/Tools/Refactor/GenerateExports.hs
@@ -1,54 +0,0 @@-{-# LANGUAGE TupleSections
-           , ConstraintKinds
-           , TypeFamilies
-           , FlexibleContexts
-           #-}
-module Language.Haskell.Tools.Refactor.GenerateExports where
-
-import Control.Reference hiding (element)
-
-import qualified GHC
-
-import Data.Maybe
-
-import Language.Haskell.Tools.AST
-import Language.Haskell.Tools.AnnTrf.SourceTemplate
-import Language.Haskell.Tools.AST.Gen
-import Language.Haskell.Tools.Refactor.RefactorBase
-
-type DomGenerateExports dom = (Domain dom, HasNameInfo dom)
-
--- | Creates an export list that imports standalone top-level definitions with all of their contained definitions
-generateExports :: DomGenerateExports dom => LocalRefactoring dom
-generateExports mod = return (element & modHead & annJust & element & mhExports & annMaybe .= Just (createExports (getTopLevels mod)) $ mod)
-
--- | Get all the top-level definitions with flags that mark if they can contain other top-level definitions 
--- (classes and data declarations).
-getTopLevels :: DomGenerateExports dom => Ann Module dom SrcTemplateStage -> [(GHC.Name, Bool)]
-getTopLevels mod = catMaybes $ map (\d -> fmap (,exportContainOthers d) (getTopLevelDeclName d)) (mod ^? element & modDecl & annList & element)
-  where exportContainOthers :: Decl dom SrcTemplateStage -> Bool
-        exportContainOthers (DataDecl {}) = True
-        exportContainOthers (ClassDecl {}) = True
-        exportContainOthers _ = False
-
--- | Get all the standalone top level definitions (their GHC unique names) in a module. 
--- You could also do getting all the names with a biplate reference and select the top-level ones, but this is more efficient.
-getTopLevelDeclName :: DomGenerateExports dom => Decl dom SrcTemplateStage -> Maybe GHC.Name
-getTopLevelDeclName (d @ TypeDecl {}) = semanticsName =<< listToMaybe (d ^? declHead & dhNames)
-getTopLevelDeclName (d @ TypeFamilyDecl {}) = semanticsName =<< listToMaybe (d ^? declTypeFamily & element & tfHead & dhNames)
-getTopLevelDeclName (d @ ClosedTypeFamilyDecl {}) = semanticsName =<< listToMaybe (d ^? declHead & dhNames)
-getTopLevelDeclName (d @ DataDecl {}) = semanticsName =<< listToMaybe (d ^? declHead & dhNames)
-getTopLevelDeclName (d @ GDataDecl {}) = semanticsName =<< listToMaybe (d ^? declHead & dhNames)
-getTopLevelDeclName (d @ ClassDecl {}) = semanticsName =<< listToMaybe (d ^? declHead & dhNames)
-getTopLevelDeclName (d @ PatternSynonymDecl {}) 
-  = semanticsName =<< listToMaybe (d ^? declPatSyn & element & patLhs & element & (patName & element & simpleName &+& patSynOp & element & operatorName) & semantics)
-getTopLevelDeclName (d @ ValueBinding {}) = semanticsName =<< listToMaybe (d ^? declValBind & bindingName)
-getTopLevelDeclName (d @ ForeignImport {}) = semanticsName =<< listToMaybe (d ^? declName & element & simpleName & semantics)
-getTopLevelDeclName _ = Nothing
-
--- | Create the export for a give name.
-createExports :: DomGenerateExports dom => [(GHC.Name, Bool)] -> Ann ExportSpecList dom SrcTemplateStage
-createExports elems = mkExportSpecList $ map (mkExportSpec . createExport) elems
-  where createExport (n, False) = mkIeSpec (mkUnqualName' (GHC.getName n)) Nothing
-        createExport (n, True)  = mkIeSpec (mkUnqualName' (GHC.getName n)) (Just mkSubAll)
-
− Language/Haskell/Tools/Refactor/GenerateTypeSignature.hs
@@ -1,140 +0,0 @@-{-# LANGUAGE ViewPatterns
-           , FlexibleContexts
-           , ScopedTypeVariables
-           , RankNTypes 
-           , TypeApplications
-           , TypeFamilies
-           , ConstraintKinds
-           #-}
-module Language.Haskell.Tools.Refactor.GenerateTypeSignature (generateTypeSignature, generateTypeSignature', GenerateSignatureDomain) where
-
-import GHC hiding (Module)
-import Type as GHC
-import TyCon as GHC
-import OccName as GHC
-import Outputable as GHC
-import TysWiredIn as GHC
-import Id as GHC
-
-import Data.List
-import Data.Maybe
-import Data.Data
-import Data.Generics.Uniplate.Data
-import Control.Monad
-import Control.Monad.State
-import Control.Reference hiding (element)
-import Language.Haskell.Tools.AnnTrf.SourceTemplate
-import Language.Haskell.Tools.AnnTrf.SourceTemplateHelpers
-import Language.Haskell.Tools.AST.Gen
-import Language.Haskell.Tools.AST as AST
-import Language.Haskell.Tools.Refactor.RefactorBase
-
-type Ann' e dom = Ann e dom SrcTemplateStage
-type AnnList' e dom = AnnList e dom SrcTemplateStage
-type GenerateSignatureDomain dom = ( HasModuleInfo dom, HasIdInfo dom, HasImportInfo dom ) 
-
-generateTypeSignature' :: GenerateSignatureDomain dom => RealSrcSpan -> LocalRefactoring dom
-generateTypeSignature' sp = generateTypeSignature (nodesContaining sp) (nodesContaining sp) (getValBindInList sp) 
-
--- | Perform the refactoring on either local or top-level definition
-generateTypeSignature :: GenerateSignatureDomain dom => Simple Traversal (Ann' Module dom) (AnnList' Decl dom) 
-                                -- ^ Access for a top-level definition if it is the selected definition
-                           -> Simple Traversal (Ann' Module dom) (AnnList' LocalBind dom) 
-                                -- ^ Access for a definition list if it contains the selected definition
-                           -> (forall d . (Show (d dom SrcTemplateStage), Data (d dom SrcTemplateStage), Typeable d, BindingElem d) 
-                                => AnnList' d dom -> Maybe (Ann' ValueBind dom)) 
-                                -- ^ Selector for either local or top-level declaration in the definition list
-                           -> LocalRefactoring dom
-generateTypeSignature topLevelRef localRef vbAccess
-  = flip evalStateT False .
-     (topLevelRef !~ genTypeSig vbAccess
-        <=< localRef !~ genTypeSig vbAccess)
-  
-genTypeSig :: (GenerateSignatureDomain dom, BindingElem d) => (AnnList' d dom -> Maybe (Ann' ValueBind dom))  
-                -> AnnList' d dom -> StateT Bool (LocalRefactor dom) (AnnList' d dom)
-genTypeSig vbAccess ls 
-  | Just vb <- vbAccess ls 
-  , not (typeSignatureAlreadyExist ls vb)
-    = do let id = getBindingName vb
-             isTheBind (Just ((^.element) -> decl)) 
-               = isBinding decl && map semanticsId (decl ^? bindName) == map semanticsId (vb ^? bindingName)
-             isTheBind _ = False
-             
-         alreadyGenerated <- get
-         if alreadyGenerated 
-           then return ls
-           else do put True
-                   typeSig <- lift $ generateTSFor (getName id) (idType id)
-                   return $ insertWhere (wrapperAnn $ createTypeSig typeSig) (const True) isTheBind ls
-  | otherwise = return ls
-
-
-generateTSFor :: GenerateSignatureDomain dom => GHC.Name -> GHC.Type -> LocalRefactor dom (Ann' TypeSignature dom)
-generateTSFor n t = mkTypeSignature (mkUnqualName' n) <$> generateTypeFor (-1) (dropForAlls t)
-
--- | Generates the source-level type for a GHC internal type
-generateTypeFor :: GenerateSignatureDomain dom => Int -> GHC.Type -> LocalRefactor dom (Ann' AST.Type dom) 
-generateTypeFor prec t 
-  -- context
-  | (break (not . isPredTy) -> (preds, other), rt) <- splitFunTys t
-  , not (null preds)
-  = do ctx <- case preds of [pred] -> mkContextOne <$> generateAssertionFor pred
-                            _ -> mkContextMulti <$> mapM generateAssertionFor preds
-       wrapParen 0 <$> (mkTyCtx ctx <$> generateTypeFor 0 (mkFunTys other rt))
-  -- function
-  | Just (at, rt) <- splitFunTy_maybe t
-  = wrapParen 0 <$> (mkTyFun <$> generateTypeFor 10 at <*> generateTypeFor 0 rt)
-  -- type operator (we don't know the precedences, so always use parentheses)
-  | (op, [at,rt]) <- splitAppTys t
-  , Just tc <- tyConAppTyCon_maybe op
-  , isSymOcc (getOccName (getName tc))
-  = wrapParen 0 <$> (mkTyInfix <$> generateTypeFor 10 at <*> referenceOperator (idName $ getTCId tc) <*> generateTypeFor 10 rt)
-  -- tuple types
-  | Just (tc, tas) <- splitTyConApp_maybe t
-  , isTupleTyCon tc
-  = mkTyTuple <$> mapM (generateTypeFor (-1)) tas
-  -- string type
-  | Just (ls, [et]) <- splitTyConApp_maybe t
-  , Just ch <- tyConAppTyCon_maybe et
-  , listTyCon == ls
-  , charTyCon == ch
-  = return $ mkTyVar (mkNormalName $ mkSimpleName "String")
-  -- list types
-  | Just (tc, [et]) <- splitTyConApp_maybe t
-  , listTyCon == tc
-  = mkTyList <$> generateTypeFor (-1) et
-  -- type application
-  | Just (tf, ta) <- splitAppTy_maybe t
-  = wrapParen 10 <$> (mkTyApp <$> generateTypeFor 10 tf <*> generateTypeFor 11 ta)
-  -- type constructor
-  | Just tc <- tyConAppTyCon_maybe t
-  = mkTyVar <$> referenceName (idName $ getTCId tc)
-  -- type variable
-  | Just tv <- getTyVar_maybe t
-  = mkTyVar <$> referenceName (idName tv)
-  -- forall type
-  | (tvs@(_:_), t') <- splitForAllTys t
-  = wrapParen (-1) <$> (mkTyForall (map (mkTypeVar' . getName) tvs) <$> generateTypeFor 0 t')
-  | otherwise = error ("Cannot represent type: " ++ showSDocUnsafe (ppr t))
-  where wrapParen :: Int -> Ann' AST.Type dom -> Ann' AST.Type dom
-        wrapParen prec' node = if prec' < prec then mkTyParen node else node
-
-        getTCId :: GHC.TyCon -> GHC.Id
-        getTCId tc = GHC.mkVanillaGlobal (GHC.tyConName tc) (tyConKind tc)
-
-        generateAssertionFor :: GenerateSignatureDomain dom => GHC.Type -> LocalRefactor dom (Ann' AST.Assertion dom)
-        generateAssertionFor t 
-          | Just (tc, types) <- splitTyConApp_maybe t
-          = mkClassAssert <$> referenceName (idName $ getTCId tc) <*> mapM (generateTypeFor 0) types
-        -- TODO: infix things
-    
--- | Check whether the definition already has a type signature
-typeSignatureAlreadyExist :: (GenerateSignatureDomain dom, BindingElem d) => AnnList' d dom -> Ann' ValueBind dom -> Bool
-typeSignatureAlreadyExist ls vb = 
-  getBindingName vb `elem` (map semanticsId $ concatMap (^? bindName) (filter isTypeSig $ ls ^? annList&element))
-  
-getBindingName :: GenerateSignatureDomain dom => Ann' ValueBind dom -> GHC.Id
-getBindingName vb = case nub $ map semanticsId $ vb ^? bindingName of 
-  [n] -> n
-  [] -> error "Trying to generate a signature for a binding with no name"
-  _ -> error "Trying to generate a signature for a binding with multiple names"
Language/Haskell/Tools/Refactor/GetModules.hs view
@@ -11,22 +11,27 @@ 
 -- | Get modules of the project with the indicated root directory.
 -- If there is a cabal file, it uses that, otherwise it just scans the directory recursively for haskell sourcefiles.
-getModules :: FilePath -> IO [String]
+getModules :: FilePath -> IO [([FilePath], [String])]
 getModules root
   = do files <- listDirectory root
        case find (\p -> takeExtension p == ".cabal") files of
           Just cabalFile -> modulesFromCabalFile (root </> cabalFile)
-          Nothing        -> modulesFromDirectory root root
+          Nothing        -> do mods <- modulesFromDirectory root root
+                               return [([root], mods)]
 
 
-modulesFromCabalFile :: FilePath -> IO [String]
+modulesFromCabalFile :: FilePath -> IO [([FilePath], [String])]
 -- now adding all conditional entries, regardless of flags
 modulesFromCabalFile cabal = getModules . flattenPackageDescription <$> readPackageDescription silent cabal
-  where getModules pkg = map (concat . intersperse "." . components) 
-                           $ maybe [] libModules (library pkg) 
-                               ++ concatMap exeModules (executables pkg) 
-                               ++ concatMap testModules (testSuites pkg) 
-                               ++ concatMap benchmarkModules (benchmarks pkg) 
+  where getModules :: PackageDescription -> [([FilePath], [String])]
+        getModules pkg = map (\(bi, mods) -> ( map (normalise . (takeDirectory cabal </>)) $ hsSourceDirs bi
+                                             , map (concat . intersperse "." . components) mods) )
+                           $ maybe [] ((:[]) . libRecord) (library pkg) ++ map exeRecord (executables pkg) 
+                               ++ map testRecord (testSuites pkg) ++ map benchRecord (benchmarks pkg) 
+        libRecord lib = (libBuildInfo lib, libModules lib)
+        exeRecord exe = (buildInfo exe, exeModules exe)
+        testRecord test = (testBuildInfo test, testModules test)
+        benchRecord bench = (benchmarkBuildInfo bench, benchmarkModules bench)
 
 modulesFromDirectory :: FilePath -> FilePath -> IO [String]
 -- now recognizing only .hs files
@@ -38,3 +43,8 @@                            else if takeExtension path == ".hs" 
                                   then return [concat $ intersperse "." $ splitDirectories $ dropExtension $ makeRelative root path] 
                                   else return []
+
+srcDirFromRoot :: FilePath -> String -> FilePath
+srcDirFromRoot fileName "" = fileName 
+srcDirFromRoot fileName moduleName 
+  = srcDirFromRoot (takeDirectory fileName) (dropWhile (/= '.') $ dropWhile (== '.') moduleName)
− Language/Haskell/Tools/Refactor/IfToGuards.hs
@@ -1,34 +0,0 @@-{-# LANGUAGE RankNTypes, FlexibleContexts, ViewPatterns #-}
-module Language.Haskell.Tools.Refactor.IfToGuards (ifToGuards) where
-
-import Language.Haskell.Tools.AST
-import Language.Haskell.Tools.AST.Gen
-import Language.Haskell.Tools.Refactor.RefactorBase
-
-import Control.Reference hiding (element)
-import SrcLoc
-import Data.Generics.Uniplate.Data
-
-import Language.Haskell.Tools.Refactor
-
-tryItOut moduleName sp = tryRefactor (localRefactoring $ ifToGuards (readSrcSpan (toFileName "." moduleName) sp)) moduleName
-
-ifToGuards :: Domain dom => RealSrcSpan -> LocalRefactoring dom
-ifToGuards sp = return . (nodesContaining sp .- ifToGuards')
-
-ifToGuards' :: Ann ValueBind dom SrcTemplateStage -> Ann ValueBind dom SrcTemplateStage
-ifToGuards' (e -> SimpleBind (e -> VarPat name) (e -> UnguardedRhs (e -> If pred thenE elseE)) locals) 
-  = mkFunctionBind [mkMatch (mkNormalMatchLhs name []) (createSimpleIfRhss pred thenE elseE) (locals ^. annMaybe) ]
-ifToGuards' fbs@(e -> FunBind _) 
-  = element&funBindMatches&annList&element&matchRhs .- trfRhs $ fbs
-  where trfRhs :: Ann Rhs dom SrcTemplateStage -> Ann Rhs dom SrcTemplateStage
-        trfRhs (e -> UnguardedRhs (e -> If pred thenE elseE)) = createSimpleIfRhss pred thenE elseE
-        trfRhs e = e -- don't transform already guarded right-hand sides to avoid multiple evaluation of the same condition
-
-e = (^. element)
-
-createSimpleIfRhss :: Ann Expr dom SrcTemplateStage -> Ann Expr dom SrcTemplateStage -> Ann Expr dom SrcTemplateStage -> Ann Rhs dom SrcTemplateStage
-createSimpleIfRhss pred thenE elseE = mkGuardedRhss [ mkGuardedRhs [mkGuardCheck pred] thenE
-                                                    , mkGuardedRhs [mkGuardCheck (mkVar (mkName "otherwise"))] elseE
-                                                    ]
-
+ Language/Haskell/Tools/Refactor/ListOperations.hs view
@@ -0,0 +1,57 @@+module Language.Haskell.Tools.Refactor.ListOperations where
+
+import SrcLoc
+import Data.String
+import Data.List
+import Control.Reference
+import Data.Function (on)
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AST.Rewrite
+import Language.Haskell.Tools.Transform
+
+filterList :: (Ann e dom SrcTemplateStage -> Bool) -> AnnListG e dom SrcTemplateStage -> AnnListG e dom SrcTemplateStage
+-- QUESTION: is it OK? No problem from losing separators?
+filterList pred ls = replaceList (filter pred (ls ^. annListElems)) ls   
+       
+-- | Replaces the list with a new one with the given elements, keeping the most common separator as the new one.
+replaceList :: [Ann e dom SrcTemplateStage] -> AnnListG e dom SrcTemplateStage -> AnnListG e dom SrcTemplateStage
+replaceList elems (AnnListG (NodeInfo sema src) _)
+  = AnnListG (NodeInfo sema (listSep mostCommonSeparator)) elems
+  where mostCommonSeparator  
+          = case group $ sort (src ^. srcTmpSeparators) of 
+                   [] -> src ^. srcTmpDefaultSeparator
+                   nonempty@(_:_) -> head $ maximumBy (compare `on` length) nonempty
+                            
+-- | Inserts the element in the places where the two positioning functions (one checks the element before, one the element after)
+-- allows the placement.         
+insertWhere :: Ann e dom SrcTemplateStage -> (Maybe (Ann e dom SrcTemplateStage) -> Bool) 
+                 -> (Maybe (Ann e dom SrcTemplateStage) -> Bool) -> AnnListG e dom SrcTemplateStage 
+                 -> AnnListG e dom SrcTemplateStage
+insertWhere e before after al 
+  = let index = insertIndex before after (al ^? annList)
+     in case index of 
+          Nothing -> al
+          Just ind -> annListElems .- insertAt ind e 
+                        $ (if isEmptyAnnList then id else annListAnnot&sourceInfo .- addDefaultSeparator ind)
+                        $ al 
+  where addDefaultSeparator i al = srcTmpSeparators .- insertAt i (al ^. srcTmpDefaultSeparator) $ al
+        insertAt n e ls = let (bef,aft) = splitAt n ls in bef ++ [e] ++ aft
+        isEmptyAnnList = (null :: [x] -> Bool) $ (al ^? annList)
+
+-- | Checks where the element will be inserted given the two positioning functions.
+insertIndex :: (Maybe (Ann e dom SrcTemplateStage) -> Bool) -> (Maybe (Ann e dom SrcTemplateStage) -> Bool) -> [Ann e dom SrcTemplateStage] -> Maybe Int
+insertIndex before after []
+  | before Nothing && after Nothing = Just 0
+  | otherwise = Nothing
+insertIndex before after list@(first:_)
+  | before Nothing && after (Just first) = Just 0
+  | otherwise = (+1) <$> insertIndex' before after list 
+  where insertIndex' before after (curr:rest@(next:_)) 
+          | before (Just curr) && after (Just next) = Just 0
+          | otherwise = (+1) <$> insertIndex' before after rest
+        insertIndex' before after (curr:[]) 
+          | before (Just curr) && after Nothing = Just 0
+          | otherwise = Nothing
+
+replaceWithJust :: Ann e dom SrcTemplateStage -> AnnMaybe e dom -> AnnMaybe e dom           
+replaceWithJust e (AnnMaybeG temp _) = AnnMaybeG temp (Just e)
− Language/Haskell/Tools/Refactor/OrganizeImports.hs
@@ -1,100 +0,0 @@-{-# LANGUAGE LambdaCase 
-           , ScopedTypeVariables
-           , FlexibleContexts
-           , TypeFamilies
-           , ConstraintKinds
-           #-}
-module Language.Haskell.Tools.Refactor.OrganizeImports (organizeImports, OrganizeImportsDomain) where
-
-import SrcLoc
-import Name hiding (Name)
-import GHC (Ghc, GhcMonad, lookupGlobalName, TyThing(..), moduleNameString, moduleName)
-import qualified GHC
-import TyCon
-import ConLike
-import DataCon
-import Outputable (Outputable(..), ppr, showSDocUnsafe)
-
-import Control.Reference hiding (element)
-import Control.Monad
-import Control.Monad.IO.Class
-import Data.Function hiding ((&))
-import Data.String
-import Data.Maybe
-import Data.Data
-import Data.List
-import Data.Generics.Uniplate.Data
-import Language.Haskell.Tools.AST as AST
-import Language.Haskell.Tools.AST.FromGHC
-import Language.Haskell.Tools.AnnTrf.SourceTemplate
-import Language.Haskell.Tools.AnnTrf.SourceTemplateHelpers
-import Language.Haskell.Tools.PrettyPrint
-import Language.Haskell.Tools.AST.Gen
-import Language.Haskell.Tools.Refactor.RefactorBase
-import Debug.Trace
-
-type OrganizeImportsDomain dom = ( Domain dom, HasNameInfo dom, HasImportInfo dom )
-
-organizeImports :: forall dom . OrganizeImportsDomain dom => LocalRefactoring dom
-organizeImports mod
-  = element&modImports&annListElems !~ narrowImports usedNames . sortImports $ mod
-  where usedNames = map getName $ catMaybes
-                                $ map (semanticsName . (^. (annotation&semanticInfo)))
-                                $ (universeBi (mod ^. element&modHead) ++ universeBi (mod ^. element&modDecl) :: [Ann QualifiedName dom SrcTemplateStage])
-        
--- | Sorts the imports in alphabetical order
-sortImports :: [Ann ImportDecl dom SrcTemplateStage] -> [Ann ImportDecl dom SrcTemplateStage]
-sortImports = sortBy (compare `on` (^. element&importModule&element&AST.moduleNameString))
-
--- | Modify an import to only import  names that are used.
-narrowImports :: forall dom . OrganizeImportsDomain dom 
-              => [GHC.Name] -> [Ann ImportDecl dom SrcTemplateStage] -> LocalRefactor dom [Ann ImportDecl dom SrcTemplateStage]
-narrowImports usedNames imps = foldM (narrowOneImport usedNames) imps imps 
-  where narrowOneImport :: [GHC.Name] -> [Ann ImportDecl dom SrcTemplateStage] -> Ann ImportDecl dom SrcTemplateStage -> LocalRefactor dom [Ann ImportDecl dom SrcTemplateStage]
-        narrowOneImport names all one =
-          (\case Just x -> map (\e -> if e == one then x else e) all
-                 Nothing -> delete one all) <$> narrowImport names (map (semanticsImportedModule . (^. semantics)) all) one 
-        
-narrowImport :: OrganizeImportsDomain dom
-             => [GHC.Name] -> [GHC.Module] -> Ann ImportDecl dom SrcTemplateStage 
-                           -> LocalRefactor dom (Maybe (Ann ImportDecl dom SrcTemplateStage))
-narrowImport usedNames otherModules imp
-  | importIsExact (imp ^. element) 
-  = Just <$> (element&importSpec&annJust&element&importSpecList !~ narrowImportSpecs usedNames $ imp)
-  | otherwise 
-  = if null actuallyImported
-      then if length (filter (== importedMod) otherModules) > 1 
-              then pure Nothing
-              else Just <$> (element&importSpec !- replaceWithJust (mkImportSpecList []) $ imp)
-      else pure (Just imp)
-  where actuallyImported = semanticsImported (imp ^. semantics) `intersect` usedNames
-        importedMod = semanticsImportedModule $ imp ^. semantics
-    
--- | Narrows the import specification (explicitely imported elements)
-narrowImportSpecs :: forall dom . OrganizeImportsDomain dom
-                  => [GHC.Name] -> AnnList IESpec dom SrcTemplateStage -> LocalRefactor dom (AnnList IESpec dom SrcTemplateStage)
-narrowImportSpecs usedNames 
-  = (annList&element !~ narrowSpecSubspec usedNames) 
-       >=> return . filterList isNeededSpec
-  where narrowSpecSubspec :: [GHC.Name] -> IESpec dom SrcTemplateStage -> LocalRefactor dom (IESpec dom SrcTemplateStage)
-        narrowSpecSubspec usedNames spec 
-          = do let Just specName = semanticsName =<< (spec ^? ieName&element&simpleName&annotation&semanticInfo)
-               Just tt <- GHC.lookupName (getName specName)
-               let subspecsInScope = case tt of ATyCon tc | not (isClassTyCon tc) 
-                                                  -> map getName (tyConDataCons tc) `intersect` usedNames
-                                                _ -> usedNames
-               ieSubspec&annJust !- narrowImportSubspecs subspecsInScope $ spec
-  
-        isNeededSpec :: Ann IESpec dom SrcTemplateStage -> Bool
-        isNeededSpec ie = 
-          -- if the name is used, it is needed
-          fmap getName (semanticsName =<< (ie ^? element&ieName&element&simpleName&annotation&semanticInfo)) `elem` map Just usedNames
-          -- if the name is not used, but some of its constructors are used, it is needed
-            || ((ie ^? element&ieSubspec&annJust&element&essList&annList) /= [])
-            || (case ie ^? element&ieSubspec&annJust&element of Just SubSpecAll -> True; _ -> False)     
-  
-narrowImportSubspecs :: OrganizeImportsDomain dom => [GHC.Name] -> Ann SubSpec dom SrcTemplateStage -> Ann SubSpec dom SrcTemplateStage
-narrowImportSubspecs [] (Ann _ SubSpecAll) = mkSubList []
-narrowImportSubspecs _ ss@(Ann _ SubSpecAll) = ss
-narrowImportSubspecs usedNames ss@(Ann _ (SubSpecList _)) 
-  = element&essList .- filterList (\n -> fmap getName (semanticsName =<< (n ^? element&simpleName&annotation&semanticInfo)) `elem` map Just usedNames) $ ss
+ Language/Haskell/Tools/Refactor/Perform.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE StandaloneDeriving
+           , DeriveGeneric
+           , LambdaCase
+           , ScopedTypeVariables
+           , BangPatterns
+           , MultiWayIf
+           , FlexibleContexts
+           , TypeFamilies
+           , TupleSections
+           , TemplateHaskell
+           , ViewPatterns
+           #-}
+-- | Defines common utilities for using refactorings. Provides an interface for both demo, command line and integrated tools.
+module Language.Haskell.Tools.Refactor.Perform where
+
+import Language.Haskell.Tools.AST.FromGHC
+import Language.Haskell.Tools.AST as AST
+import Language.Haskell.Tools.Transform
+import Language.Haskell.Tools.PrettyPrint
+ 
+import Data.List
+import Data.List.Split
+import GHC.Generics hiding (moduleName)
+import qualified Data.Map as Map
+import Data.Maybe
+import Data.Typeable
+import Data.IORef
+import Control.Monad
+import Control.Monad.State
+import Control.Monad.IO.Class
+import Control.Reference
+import Control.Exception
+import System.Directory
+import System.IO
+import System.FilePath
+import Data.Generics.Uniplate.Operations
+
+import Language.Haskell.Tools.Refactor.Predefined.OrganizeImports
+import Language.Haskell.Tools.Refactor.Predefined.GenerateTypeSignature
+import Language.Haskell.Tools.Refactor.Predefined.GenerateExports
+import Language.Haskell.Tools.Refactor.Predefined.RenameDefinition
+import Language.Haskell.Tools.Refactor.Predefined.ExtractBinding
+import Language.Haskell.Tools.Refactor.RefactorBase
+import Language.Haskell.Tools.Refactor.GetModules
+import Language.Haskell.Tools.Refactor.Prepare
+
+import Language.Haskell.TH.LanguageExtensions
+import GHC
+import SrcLoc
+          
+
+import Debug.Trace
+
+
+-- | Executes a given command on the selected module and given other modules
+performCommand :: (HasModuleInfo dom, DomGenerateExports dom, OrganizeImportsDomain dom, DomainRenameDefinition dom, ExtractBindingDomain dom, GenerateSignatureDomain dom) 
+               => RefactorCommand -> ModuleDom dom -- ^ The module in which the refactoring is performed
+                                  -> [ModuleDom dom] -- ^ Other modules
+                                  -> Ghc (Either String [RefactorChange dom])
+performCommand rf mod mods = runRefactor mod mods $ selectCommand rf
+  where selectCommand NoRefactor = localRefactoring return
+        selectCommand OrganizeImports = localRefactoring organizeImports
+        selectCommand GenerateExports = localRefactoring generateExports 
+        selectCommand (GenerateSignature sp) = localRefactoring $ generateTypeSignature' (correctSp mod sp)
+        selectCommand (RenameDefinition sp str) = renameDefinition' (correctSp mod sp) str
+        selectCommand (ExtractBinding sp str) = localRefactoring $ extractBinding' (correctSp mod sp) str
+
+        correctSp mod sp = mkRealSrcSpan (updateSrcFile fileName $ realSrcSpanStart sp) 
+                                         (updateSrcFile fileName $ realSrcSpanEnd sp)
+        fileName = case srcSpanStart $ getRange (snd mod) of RealSrcLoc loc -> srcLocFile loc 
+        updateSrcFile fn loc = mkRealSrcLoc fn (srcLocLine loc) (srcLocCol loc) 
+
+-- | A refactoring command
+data RefactorCommand = NoRefactor 
+                     | OrganizeImports
+                     | GenerateExports
+                     | GenerateSignature RealSrcSpan
+                     | RenameDefinition RealSrcSpan String
+                     | ExtractBinding RealSrcSpan String
+    deriving Show
+
+readCommand :: String -> String -> RefactorCommand
+readCommand fileName (splitOn " " -> refact:args) = analyzeCommand fileName refact args
+
+analyzeCommand :: String -> String -> [String] -> RefactorCommand
+analyzeCommand _ "" _ = NoRefactor
+analyzeCommand _ "CheckSource" _ = NoRefactor
+analyzeCommand _ "OrganizeImports" _ = OrganizeImports
+analyzeCommand _ "GenerateExports" _ = GenerateExports
+analyzeCommand fileName "GenerateSignature" [sp] = GenerateSignature (readSrcSpan fileName sp)
+analyzeCommand fileName "RenameDefinition" [sp, newName] = RenameDefinition (readSrcSpan fileName sp) newName
+analyzeCommand fileName "ExtractBinding" [sp, newName] = ExtractBinding (readSrcSpan fileName sp) newName
+analyzeCommand _ ref _ = error $ "Unknown command: " ++ ref
+
+ Language/Haskell/Tools/Refactor/Predefined/DataToNewtype.hs view
@@ -0,0 +1,15 @@+module Language.Haskell.Tools.Refactor.Predefined.DataToNewtype (dataToNewtype) where
+
+import Control.Reference
+
+import Language.Haskell.Tools.Refactor
+
+tryItOut moduleName = tryRefactor (localRefactoring $ dataToNewtype) moduleName
+
+dataToNewtype :: Domain dom => LocalRefactoring dom
+dataToNewtype = return . (modDecl & annList .- changeDeclaration)
+
+changeDeclaration :: Decl dom -> Decl dom
+changeDeclaration dd@(DataDecl DataKeyword ctx declHead (AnnList [ConDecl name (AnnList [arg])]) derivs)
+  = declNewtype .= mkNewtypeKeyword $ dd
+changeDeclaration decl = decl
+ Language/Haskell/Tools/Refactor/Predefined/DollarApp.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE ViewPatterns, FlexibleContexts, ConstraintKinds #-}
+module Language.Haskell.Tools.Refactor.Predefined.DollarApp (dollarApp, DollarDomain) where
+
+import Language.Haskell.Tools.Refactor
+
+import SrcLoc (RealSrcSpan, SrcSpan)
+import Unique (getUnique)
+import Id (idName)
+import PrelNames (dollarIdKey)
+import PrelInfo (wiredInIds)
+import BasicTypes (Fixity(..))
+
+import Control.Monad.State
+import Control.Reference hiding (element)
+import Data.Generics.Uniplate.Data
+import Debug.Trace
+
+tryItOut moduleName sp 
+  = tryRefactor (localRefactoring $ dollarApp (readSrcSpan (toFileName "." moduleName) sp)) moduleName
+
+type DollarMonad dom = StateT [SrcSpan] (LocalRefactor dom)
+type DollarDomain dom = (HasImportInfo dom, HasModuleInfo dom, HasFixityInfo dom, HasNameInfo dom)
+
+dollarApp :: DollarDomain dom => RealSrcSpan -> LocalRefactoring dom
+dollarApp sp = flip evalStateT [] . ((nodesContained sp !~ (\e -> get >>= replaceExpr e)) 
+                                        >=> (biplateRef !~ parenExpr))
+
+replaceExpr :: DollarDomain dom => Expr dom -> [SrcSpan] -> DollarMonad dom (Expr dom)
+replaceExpr expr@(App fun (Paren (InfixApp _ op arg))) replacedRanges
+  | not (getRange arg `elem` replacedRanges)
+  , semanticsName (op ^. operatorName) /= Just dollarName 
+  , case semanticsFixity (op ^. operatorName) of Just (Fixity _ p _) | p > 0 -> False; _ -> True
+  = return expr
+replaceExpr (App fun (Paren arg)) _ = do modify $ (getRange arg :)
+                                         mkInfixApp fun <$> lift (referenceOperator dollarName) <*> pure arg
+replaceExpr e _ = return e
+
+parenExpr :: Expr dom -> DollarMonad dom (Expr dom)
+parenExpr e = (exprLhs !~ parenDollar True) =<< (exprRhs !~ parenDollar False $ e)
+
+parenDollar :: Bool -> Expr dom -> DollarMonad dom (Expr dom)
+parenDollar lhs expr@(InfixApp _ _ arg) 
+  = do replacedRanges <- get
+       if getRange arg `elem` replacedRanges && (lhs || getRange expr `notElem` replacedRanges)
+         then return $ mkParen expr
+         else return expr
+parenDollar _ e = return e
+
+[dollarName] = map idName $ filter ((dollarIdKey==) . getUnique) wiredInIds
+ Language/Haskell/Tools/Refactor/Predefined/ExtractBinding.hs view
@@ -0,0 +1,163 @@+
+{-# LANGUAGE ViewPatterns
+           , ScopedTypeVariables
+           , RankNTypes
+           , FlexibleContexts
+           , TypeApplications
+           , ConstraintKinds
+           , TypeFamilies
+           #-}
+module Language.Haskell.Tools.Refactor.Predefined.ExtractBinding (extractBinding', ExtractBindingDomain) where
+
+import qualified GHC
+import qualified Var as GHC
+import qualified OccName as GHC hiding (varName)
+import SrcLoc
+import Unique
+
+import Data.Char
+import Data.Maybe
+import Data.Generics.Uniplate.Data
+import Control.Reference hiding (element)
+import Control.Monad.State
+
+import Language.Haskell.Tools.Refactor
+
+type ExtractBindingDomain dom = ( HasNameInfo dom, HasDefiningInfo dom, HasScopeInfo dom )
+
+extractBinding' :: ExtractBindingDomain dom => RealSrcSpan -> String -> LocalRefactoring dom
+extractBinding' sp name mod
+  = if isValidBindingName name then extractBinding (nodesContaining sp) (nodesContaining sp) name mod
+                               else refactError "The given name is not a valid for the extracted binding"
+
+-- | Safely performs the transformation to introduce the local binding and replace the expression with the call.
+-- Checks if the introduction of the name causes a name conflict.
+extractBinding :: forall dom . ExtractBindingDomain dom 
+               => Simple Traversal (Module dom) (ValueBind dom)
+                   -> Simple Traversal (ValueBind dom) (Expr dom)
+                   -> String -> LocalRefactoring dom
+extractBinding selectDecl selectExpr name mod
+  = let conflicting = any (isConflicting name) (mod ^? selectDecl & biplateRef :: [QualifiedName dom])
+        exprRange = getRange $ head (mod ^? selectDecl & selectExpr)
+        decl = last (mod ^? selectDecl)
+        declRange = getRange $ last (mod ^? selectDecl)
+     in if conflicting
+           then refactError "The given name causes name conflict."
+           else do (res, st) <- runStateT (selectDecl&selectExpr !~ extractThatBind name (head $ decl ^? actualContainingExpr exprRange) $ mod) Nothing
+                   case st of Just def -> return $ evalState (selectDecl !~ addLocalBinding declRange exprRange def $ res) False
+                              Nothing -> refactError "There is no applicable expression to extract."
+
+-- | Decides if a new name defined to be the given string will conflict with the given AST element
+isConflicting :: ExtractBindingDomain dom => String -> QualifiedName dom -> Bool
+isConflicting name used
+  = semanticsDefining used
+      && (GHC.occNameString . GHC.getOccName <$> semanticsName used) == Just name
+
+-- Replaces the selected expression with a call and generates the called binding.
+extractThatBind :: ExtractBindingDomain dom 
+                => String -> Expr dom -> Expr dom -> StateT (Maybe (ValueBind dom)) (LocalRefactor dom) (Expr dom)
+extractThatBind name cont e 
+  = do ret <- get
+       if (isJust ret) then return e 
+          else case e of
+            Paren {} | hasParameter -> exprInner !~ doExtract name cont $ e
+                     | otherwise    -> doExtract name cont (fromJust $ e ^? exprInner)
+            Var {} -> lift $ refactError "The selected expression is too simple to be extracted."
+            el | isParenLikeExpr el && hasParameter -> mkParen <$> doExtract name cont e
+            el -> doExtract name cont e
+  where hasParameter = not (null (getExternalBinds cont e))
+
+-- | Adds a local binding to the 
+addLocalBinding :: SrcSpan -> SrcSpan -> ValueBind dom -> ValueBind dom -> State Bool (ValueBind dom)
+-- this uses the state monad to only add the local binding to the first selected element
+addLocalBinding declRange exprRange local bind 
+  = do done <- get
+       if not done then do put True
+                           return $ doAddBinding declRange exprRange local bind
+                   else return bind 
+  where
+    doAddBinding declRng _ local sb@(SimpleBind {}) = valBindLocals .- insertLocalBind declRng local $ sb
+    doAddBinding declRng (RealSrcSpan rng) local fb@(FunctionBind {}) 
+      = funBindMatches & annList & filtered (isInside rng) & matchBinds 
+          .- insertLocalBind declRng local $ fb
+
+-- | Puts a value definition into a list of local binds
+insertLocalBind :: SrcSpan -> ValueBind dom -> MaybeLocalBinds dom -> MaybeLocalBinds dom
+insertLocalBind declRng toInsert locals 
+  | isAnnNothing locals
+  , RealSrcSpan rng <- declRng = -- creates the new where clause indented 2 spaces from the declaration
+                                 mkLocalBinds (srcLocCol (realSrcSpanStart rng) + 2) [mkLocalValBind toInsert]
+  | otherwise = annJust & localBinds .- insertWhere (mkLocalValBind toInsert) (const True) isNothing $ locals
+
+-- | All expressions that are bound stronger than function application.
+isParenLikeExpr :: Expr dom -> Bool
+isParenLikeExpr (If {}) = True
+isParenLikeExpr (Paren {}) = True
+isParenLikeExpr (List {}) = True
+isParenLikeExpr (ParArray {}) = True
+isParenLikeExpr (LeftSection {}) = True
+isParenLikeExpr (RightSection {}) = True
+isParenLikeExpr (RecCon {}) = True
+isParenLikeExpr (RecUpdate {}) = True
+isParenLikeExpr (Enum {}) = True
+isParenLikeExpr (ParArrayEnum {}) = True
+isParenLikeExpr (ListComp {}) = True
+isParenLikeExpr (ParArrayComp {}) = True
+isParenLikeExpr (BracketExpr {}) = True
+isParenLikeExpr (SpliceExpr {}) = True
+isParenLikeExpr (QuasiQuoteExpr {}) = True
+isParenLikeExpr _ = False
+
+-- | Replaces the expression with the call and stores the binding of the call in its state
+doExtract :: ExtractBindingDomain dom 
+          => String -> Expr dom -> Expr dom -> StateT (Maybe (ValueBind dom)) (LocalRefactor dom) (Expr dom)
+doExtract name cont e@(Lambda (AnnList bindings) inner)
+  = do let params = getExternalBinds cont e
+       put (Just (generateBind name (map mkVarPat params ++ bindings) inner))
+       return (generateCall name params)
+doExtract name cont e 
+  = do let params = getExternalBinds cont e
+       put (Just (generateBind name (map mkVarPat params) e))
+       return (generateCall name params)
+
+-- | Gets the values that have to be passed to the extracted definition
+getExternalBinds :: ExtractBindingDomain dom => Expr dom -> Expr dom -> [Name dom]
+getExternalBinds cont expr = map exprToName $ keepFirsts $ filter isApplicableName (expr ^? uniplateRef)
+  where isApplicableName name@(getExprNameInfo -> Just nm) = inScopeForOriginal nm && notInScopeForExtracted nm
+        isApplicableName _ = False
+
+        getExprNameInfo :: ExtractBindingDomain dom => Expr dom -> Maybe GHC.Name
+        getExprNameInfo expr = semanticsName =<< (listToMaybe $ expr ^? (exprName&simpleName &+& exprOperator&operatorName))
+
+        -- | Creates the parameter value to pass the name (operators are passed in parentheses)
+        exprToName :: Expr dom -> Name dom
+        exprToName e | Just n <- e ^? exprName                     = n
+                     | Just op <- e ^? exprOperator & operatorName = mkParenName op
+        
+        notInScopeForExtracted :: GHC.Name -> Bool
+        notInScopeForExtracted n = not $ n `inScope` semanticsScope cont
+
+        inScopeForOriginal :: GHC.Name -> Bool
+        inScopeForOriginal n = n `inScope` semanticsScope expr
+
+        keepFirsts (e:rest) = e : keepFirsts (filter (/= e) rest)
+        keepFirsts [] = []
+
+actualContainingExpr :: SrcSpan -> Simple Traversal (ValueBind dom) (Expr dom)
+actualContainingExpr (RealSrcSpan rng) = accessRhs & accessExpr
+  where accessRhs :: Simple Traversal (ValueBind dom) (Rhs dom)
+        accessRhs = valBindRhs &+& funBindMatches & annList & filtered (isInside rng) & matchRhs
+        accessExpr :: Simple Traversal (Rhs dom) (Expr dom)
+        accessExpr = rhsExpr &+& rhsGuards & annList & filtered (isInside rng) & guardExpr
+
+-- | Generates the expression that calls the local binding
+generateCall :: String -> [Name dom] -> Expr dom
+generateCall name args = foldl (\e a -> mkApp e (mkVar a)) (mkVar $ mkNormalName $ mkSimpleName name) args
+
+-- | Generates the local binding for the selected expression
+generateBind :: String -> [Pattern dom] -> Expr dom -> ValueBind dom
+generateBind name [] e = mkSimpleBind (mkVarPat $ mkNormalName $ mkSimpleName name) (mkUnguardedRhs e) Nothing
+generateBind name args e = mkFunctionBind [mkMatch (mkMatchLhs (mkNormalName $ mkSimpleName name) args) (mkUnguardedRhs e) Nothing]
+
+isValidBindingName :: String -> Bool
+isValidBindingName = nameValid Variable
+ Language/Haskell/Tools/Refactor/Predefined/GenerateExports.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE TupleSections
+           , ConstraintKinds
+           , TypeFamilies
+           , FlexibleContexts
+           #-}
+module Language.Haskell.Tools.Refactor.Predefined.GenerateExports (generateExports, DomGenerateExports) where
+
+import Control.Reference hiding (element)
+
+import qualified GHC
+
+import Data.Maybe
+import Control.Applicative ((<|>))
+
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.Transform
+import Language.Haskell.Tools.AST.Rewrite
+import Language.Haskell.Tools.AST.ElementTypes
+import Language.Haskell.Tools.Refactor.RefactorBase
+
+type DomGenerateExports dom = (Domain dom, HasNameInfo dom)
+
+-- | Creates an export list that imports standalone top-level definitions with all of their contained definitions
+generateExports :: DomGenerateExports dom => LocalRefactoring dom
+generateExports mod = return (modHead & annJust & mhExports & annMaybe 
+                                .= Just (createExports (getTopLevels mod)) $ mod)
+
+-- | Get all the top-level definitions with flags that mark if they can contain other top-level definitions 
+-- (classes and data declarations).
+getTopLevels :: DomGenerateExports dom => Module dom -> [(GHC.Name, Bool)]
+getTopLevels mod = catMaybes $ map (\d -> fmap (,exportContainOthers d) 
+                                               (foldl (<|>) Nothing $ map semanticsName $ d ^? elementName))
+                                   (mod ^? modDecl & annList)
+  where exportContainOthers :: Decl dom -> Bool
+        exportContainOthers (DataDecl {}) = True
+        exportContainOthers (ClassDecl {}) = True
+        exportContainOthers _ = False
+
+-- | Create the export for a give name.
+createExports :: DomGenerateExports dom => [(GHC.Name, Bool)] -> ExportSpecs dom
+createExports elems = mkExportSpecs $ map (mkExportSpec . createExport) elems
+  where createExport (n, False) = mkIESpec (mkUnqualName' (GHC.getName n)) Nothing
+        createExport (n, True)  = mkIESpec (mkUnqualName' (GHC.getName n)) (Just mkSubAll)
+
+ Language/Haskell/Tools/Refactor/Predefined/GenerateTypeSignature.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE ViewPatterns
+           , FlexibleContexts
+           , ScopedTypeVariables
+           , RankNTypes 
+           , TypeApplications
+           , TypeFamilies
+           , ConstraintKinds
+           #-}
+module Language.Haskell.Tools.Refactor.Predefined.GenerateTypeSignature (generateTypeSignature, generateTypeSignature', GenerateSignatureDomain) where
+
+import GHC hiding (Module)
+import Type as GHC
+import TyCon as GHC
+import OccName as GHC
+import Outputable as GHC
+import TysWiredIn as GHC
+import Id as GHC
+
+import Data.List
+import Data.Maybe
+import Data.Data
+import Data.Generics.Uniplate.Data
+import Control.Monad
+import Control.Monad.State
+import Control.Reference hiding (element)
+
+import Language.Haskell.Tools.Refactor as AST
+
+type GenerateSignatureDomain dom = ( HasModuleInfo dom, HasIdInfo dom, HasImportInfo dom ) 
+
+generateTypeSignature' :: GenerateSignatureDomain dom => RealSrcSpan -> LocalRefactoring dom
+generateTypeSignature' sp = generateTypeSignature (nodesContaining sp) (nodesContaining sp) (getValBindInList sp) 
+
+-- | Perform the refactoring on either local or top-level definition
+generateTypeSignature :: GenerateSignatureDomain dom => Simple Traversal (Module dom) (DeclList dom) 
+                                -- ^ Access for a top-level definition if it is the selected definition
+                           -> Simple Traversal (Module dom) (LocalBindList dom) 
+                                -- ^ Access for a definition list if it contains the selected definition
+                           -> (forall d . (BindingElem d) => AnnList d dom -> Maybe (ValueBind dom)) 
+                                -- ^ Selector for either local or top-level declaration in the definition list
+                           -> LocalRefactoring dom
+generateTypeSignature topLevelRef localRef vbAccess
+  = flip evalStateT False .
+     (topLevelRef !~ genTypeSig vbAccess
+        <=< localRef !~ genTypeSig vbAccess)
+  
+genTypeSig :: (GenerateSignatureDomain dom, BindingElem d) => (AnnList d dom -> Maybe (ValueBind dom))  
+                -> AnnList d dom -> StateT Bool (LocalRefactor dom) (AnnList d dom)
+genTypeSig vbAccess ls 
+  | Just vb <- vbAccess ls 
+  , not (typeSignatureAlreadyExist ls vb)
+    = do let id = getBindingName vb
+             isTheBind (Just decl) 
+               = isBinding decl && map semanticsId (decl ^? elementName) == map semanticsId (vb ^? bindingName)
+             isTheBind _ = False
+             
+         alreadyGenerated <- get
+         if alreadyGenerated 
+           then return ls
+           else do put True
+                   typeSig <- lift $ generateTSFor (getName id) (idType id)
+                   return $ insertWhere (createTypeSig typeSig) (const True) isTheBind ls
+  | otherwise = return ls
+
+
+generateTSFor :: GenerateSignatureDomain dom => GHC.Name -> GHC.Type -> LocalRefactor dom (TypeSignature dom)
+generateTSFor n t = mkTypeSignature (mkUnqualName' n) <$> generateTypeFor (-1) (dropForAlls t)
+
+-- | Generates the source-level type for a GHC internal type
+generateTypeFor :: GenerateSignatureDomain dom => Int -> GHC.Type -> LocalRefactor dom (AST.Type dom) 
+generateTypeFor prec t 
+  -- context
+  | (break (not . isPredTy) -> (preds, other), rt) <- splitFunTys t
+  , not (null preds)
+  = do ctx <- case preds of [pred] -> mkContextOne <$> generateAssertionFor pred
+                            _ -> mkContextMulti <$> mapM generateAssertionFor preds
+       wrapParen 0 <$> (mkCtxType ctx <$> generateTypeFor 0 (mkFunTys other rt))
+  -- function
+  | Just (at, rt) <- splitFunTy_maybe t
+  = wrapParen 0 <$> (mkFunctionType <$> generateTypeFor 10 at <*> generateTypeFor 0 rt)
+  -- type operator (we don't know the precedences, so always use parentheses)
+  | (op, [at,rt]) <- splitAppTys t
+  , Just tc <- tyConAppTyCon_maybe op
+  , isSymOcc (getOccName (getName tc))
+  = wrapParen 0 <$> (mkInfixTypeApp <$> generateTypeFor 10 at <*> referenceOperator (idName $ getTCId tc) <*> generateTypeFor 10 rt)
+  -- tuple types
+  | Just (tc, tas) <- splitTyConApp_maybe t
+  , isTupleTyCon tc
+  = mkTupleType <$> mapM (generateTypeFor (-1)) tas
+  -- string type
+  | Just (ls, [et]) <- splitTyConApp_maybe t
+  , Just ch <- tyConAppTyCon_maybe et
+  , listTyCon == ls
+  , charTyCon == ch
+  = return $ mkVarType (mkNormalName $ mkSimpleName "String")
+  -- list types
+  | Just (tc, [et]) <- splitTyConApp_maybe t
+  , listTyCon == tc
+  = mkListType <$> generateTypeFor (-1) et
+  -- type application
+  | Just (tf, ta) <- splitAppTy_maybe t
+  = wrapParen 10 <$> (mkTypeApp <$> generateTypeFor 10 tf <*> generateTypeFor 11 ta)
+  -- type constructor
+  | Just tc <- tyConAppTyCon_maybe t
+  = mkVarType <$> referenceName (idName $ getTCId tc)
+  -- type variable
+  | Just tv <- getTyVar_maybe t
+  = mkVarType <$> referenceName (idName tv)
+  -- forall type
+  | (tvs@(_:_), t') <- splitForAllTys t
+  = wrapParen (-1) <$> (mkForallType (map (mkTypeVar' . getName) tvs) <$> generateTypeFor 0 t')
+  | otherwise = error ("Cannot represent type: " ++ showSDocUnsafe (ppr t))
+  where wrapParen :: Int -> AST.Type dom -> AST.Type dom
+        wrapParen prec' node = if prec' < prec then mkParenType node else node
+
+        getTCId :: GHC.TyCon -> GHC.Id
+        getTCId tc = GHC.mkVanillaGlobal (GHC.tyConName tc) (tyConKind tc)
+
+        generateAssertionFor :: GenerateSignatureDomain dom => GHC.Type -> LocalRefactor dom (Assertion dom)
+        generateAssertionFor t 
+          | Just (tc, types) <- splitTyConApp_maybe t
+          = mkClassAssert <$> referenceName (idName $ getTCId tc) <*> mapM (generateTypeFor 0) types
+        -- TODO: infix things
+    
+-- | Check whether the definition already has a type signature
+typeSignatureAlreadyExist :: (GenerateSignatureDomain dom, BindingElem d) => AnnList d dom -> ValueBind dom -> Bool
+typeSignatureAlreadyExist ls vb = 
+  getBindingName vb `elem` (map semanticsId $ concatMap (^? elementName) (filter isTypeSig $ ls ^? annList))
+  
+getBindingName :: GenerateSignatureDomain dom => ValueBind dom -> GHC.Id
+getBindingName vb = case nub $ map semanticsId $ vb ^? bindingName of 
+  [n] -> n
+  [] -> error "Trying to generate a signature for a binding with no name"
+  _ -> error "Trying to generate a signature for a binding with multiple names"
+ Language/Haskell/Tools/Refactor/Predefined/IfToGuards.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE RankNTypes, FlexibleContexts, ViewPatterns #-}
+module Language.Haskell.Tools.Refactor.Predefined.IfToGuards (ifToGuards) where
+
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AST.Rewrite
+import Language.Haskell.Tools.Refactor.RefactorBase
+
+import Control.Reference hiding (element)
+import SrcLoc
+import Data.Generics.Uniplate.Data
+
+import Language.Haskell.Tools.AST.ElementTypes
+import Language.Haskell.Tools.Refactor
+
+tryItOut moduleName sp = tryRefactor (localRefactoring $ ifToGuards (readSrcSpan (toFileName "." moduleName) sp)) moduleName
+
+ifToGuards :: Domain dom => RealSrcSpan -> LocalRefactoring dom
+ifToGuards sp = return . (nodesContaining sp .- ifToGuards')
+
+ifToGuards' :: ValueBind dom -> ValueBind dom
+ifToGuards' (SimpleBind (VarPat name) (UnguardedRhs (If pred thenE elseE)) locals) 
+  = mkFunctionBind [mkMatch (mkMatchLhs name []) (createSimpleIfRhss pred thenE elseE) (locals ^. annMaybe) ]
+ifToGuards' fbs@(FunctionBind {}) 
+  = funBindMatches&annList&matchRhs .- trfRhs $ fbs
+  where trfRhs :: Rhs dom -> Rhs dom
+        trfRhs (UnguardedRhs (If pred thenE elseE)) = createSimpleIfRhss pred thenE elseE
+        trfRhs e = e -- don't transform already guarded right-hand sides to avoid multiple evaluation of the same condition
+
+createSimpleIfRhss :: Expr dom -> Expr dom -> Expr dom -> Rhs dom
+createSimpleIfRhss pred thenE elseE = mkGuardedRhss [ mkGuardedRhs [mkGuardCheck pred] thenE
+                                                    , mkGuardedRhs [mkGuardCheck (mkVar (mkName "otherwise"))] elseE
+                                                    ]
+
+ Language/Haskell/Tools/Refactor/Predefined/OrganizeImports.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE LambdaCase 
+           , ScopedTypeVariables
+           , FlexibleContexts
+           , TypeFamilies
+           , ConstraintKinds
+           #-}
+module Language.Haskell.Tools.Refactor.Predefined.OrganizeImports (organizeImports, OrganizeImportsDomain) where
+
+import SrcLoc
+import Name hiding (Name)
+import GHC (Ghc, GhcMonad, lookupGlobalName, TyThing(..), moduleNameString, moduleName)
+import qualified GHC
+import TyCon
+import ConLike
+import DataCon
+import Outputable (Outputable(..), ppr, showSDocUnsafe)
+
+import Control.Reference hiding (element)
+import Control.Monad
+import Control.Monad.IO.Class
+import Data.Function hiding ((&))
+import Data.String
+import Data.Maybe
+import Data.Data
+import Data.List
+import Data.Generics.Uniplate.Data
+
+import Language.Haskell.Tools.Refactor as AST
+
+type OrganizeImportsDomain dom = ( HasNameInfo dom, HasImportInfo dom )
+
+organizeImports :: forall dom . OrganizeImportsDomain dom => LocalRefactoring dom
+organizeImports mod
+  = modImports&annListElems !~ narrowImports usedNames . sortImports $ mod
+  where usedNames = map getName $ catMaybes $ map semanticsName
+                        -- obviously we don't want the names in the imports to be considered, but both from
+                        -- the declarations (used), both from the module head (re-exported) will count as usage
+                      $ (universeBi (mod ^. modHead) ++ universeBi (mod ^. modDecl) :: [QualifiedName dom])
+        
+-- | Sorts the imports in alphabetical order
+sortImports :: [ImportDecl dom] -> [ImportDecl dom]
+sortImports = sortBy (compare `on` (^. importModule&AST.moduleNameString))
+
+-- | Modify an import to only import  names that are used.
+narrowImports :: forall dom . OrganizeImportsDomain dom 
+              => [GHC.Name] -> [ImportDecl dom] -> LocalRefactor dom [ImportDecl dom]
+narrowImports usedNames imps = foldM (narrowOneImport usedNames) imps imps 
+  where narrowOneImport :: [GHC.Name] -> [ImportDecl dom] -> ImportDecl dom -> LocalRefactor dom [ImportDecl dom]
+        narrowOneImport names all one =
+          (\case Just x -> map (\e -> if e == one then x else e) all
+                 Nothing -> delete one all) <$> narrowImport names (map semanticsImportedModule all) one 
+
+-- | Reduces the number of definitions used from an import
+narrowImport :: OrganizeImportsDomain dom
+             => [GHC.Name] -> [GHC.Module] -> ImportDecl dom 
+                           -> LocalRefactor dom (Maybe (ImportDecl dom))
+narrowImport usedNames otherModules imp
+  | importIsExact imp
+  = Just <$> (importSpec&annJust&importSpecList !~ narrowImportSpecs usedNames $ imp)
+  | otherwise 
+  = if null actuallyImported
+      then if length (filter (== importedMod) otherModules) > 1 
+              then pure Nothing
+              else Just <$> (importSpec !- replaceWithJust (mkImportSpecList []) $ imp)
+      else pure (Just imp)
+  where actuallyImported = semanticsImported imp `intersect` usedNames
+        importedMod = semanticsImportedModule imp
+    
+-- | Narrows the import specification (explicitely imported elements)
+narrowImportSpecs :: forall dom . OrganizeImportsDomain dom
+                  => [GHC.Name] -> IESpecList dom -> LocalRefactor dom (IESpecList dom)
+narrowImportSpecs usedNames 
+  = (annList !~ narrowSpecSubspec usedNames) 
+       >=> return . filterList isNeededSpec
+  where narrowSpecSubspec :: [GHC.Name] -> IESpec dom -> LocalRefactor dom (IESpec dom)
+        narrowSpecSubspec usedNames spec 
+          = do let Just specName = semanticsName =<< (spec ^? ieName&simpleName)
+               Just tt <- GHC.lookupName (getName specName)
+               let subspecsInScope = case tt of ATyCon tc | not (isClassTyCon tc) 
+                                                  -> map getName (tyConDataCons tc) `intersect` usedNames
+                                                _ -> usedNames
+               ieSubspec&annJust !- narrowImportSubspecs subspecsInScope $ spec
+  
+        isNeededSpec :: IESpec dom -> Bool
+        isNeededSpec ie = 
+          -- if the name is used, it is needed
+          fmap getName (semanticsName =<< (ie ^? ieName&simpleName)) `elem` map Just usedNames
+          -- if the name is not used, but some of its constructors are used, it is needed
+            || ((ie ^? ieSubspec&annJust&essList&annList) /= [])
+            || (case ie ^? ieSubspec&annJust of Just SubAll -> True; _ -> False)     
+
+-- | Reduces the number of definitions imported from a sub-specifier.
+narrowImportSubspecs :: OrganizeImportsDomain dom => [GHC.Name] -> SubSpec dom -> SubSpec dom
+narrowImportSubspecs [] SubAll = mkSubList []
+narrowImportSubspecs _ ss@SubAll = ss
+narrowImportSubspecs usedNames ss@(SubList {}) 
+  = essList .- filterList (\n -> fmap getName (semanticsName =<< (n ^? simpleName)) `elem` map Just usedNames) $ ss
+ Language/Haskell/Tools/Refactor/Predefined/RenameDefinition.hs view
@@ -0,0 +1,121 @@+{-# LANGUAGE ScopedTypeVariables
+           , LambdaCase
+           , MultiWayIf
+           , TypeApplications
+           , ConstraintKinds
+           , TypeFamilies
+           , FlexibleContexts
+           , ViewPatterns
+           #-}
+module Language.Haskell.Tools.Refactor.Predefined.RenameDefinition (renameDefinition, renameDefinition', DomainRenameDefinition) where
+
+import Name hiding (Name)
+import GHC (Ghc, TyThing(..), lookupName)
+import qualified GHC
+import OccName
+import SrcLoc
+import Outputable
+import Unique
+
+import Control.Reference as Ref
+import Control.Monad.State
+import Control.Monad.Trans.Except
+import Data.Data
+import Data.List.Split
+import Data.List
+import Data.Maybe
+import Data.Generics.Uniplate.Data
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.Transform
+import Language.Haskell.Tools.AST.Rewrite
+import Language.Haskell.Tools.AST.ElementTypes
+import Language.Haskell.Tools.Refactor.RefactorBase
+
+import Debug.Trace
+
+type DomainRenameDefinition dom = ( HasNameInfo dom, HasScopeInfo dom, HasDefiningInfo dom
+                                  , HasImplicitFieldsInfo dom, HasModuleInfo dom )
+
+renameDefinition' :: forall dom . DomainRenameDefinition dom => RealSrcSpan -> String -> Refactoring dom
+renameDefinition' sp str mod mods
+  = case (getNodeContaining sp (snd mod) :: Maybe (QualifiedName dom)) >>= (fmap getName . semanticsName) of 
+      Just name -> do let sameNames = bindsWithSameName name (snd mod ^? biplateRef) 
+                      renameDefinition name sameNames str mod mods
+        where bindsWithSameName :: GHC.Name -> [FieldWildcard dom] -> [GHC.Name]
+              bindsWithSameName name wcs = catMaybes $ map ((lookup name) . semanticsImplicitFlds) wcs
+      Nothing -> case getNodeContaining sp (snd mod) of
+                   Just modName -> renameModule (modName ^. moduleNameString) str mod mods
+                   Nothing -> refactError "No name is selected"
+
+renameModule :: forall dom . DomainRenameDefinition dom => String -> String -> Refactoring dom
+renameModule from to m mods 
+    | any (nameConflict to) (map snd $ m:mods) = refactError "UName conflict when renaming module" 
+    | not (validModuleName to) = refactError "The given name is not a valid module name" 
+    | otherwise = fmap (\ls -> ModuleRemoved from : map (\(ContentChanged (mod,res)) -> ContentChanged (if mod == from then to else mod, res)) ls)
+                    $ localRefactoring (replaceModuleNames >=> alterNormalNames) m mods
+  where replaceModuleNames :: LocalRefactoring dom
+        replaceModuleNames = biplateRef @_ @(ModuleName dom) & filtered (\e -> (e ^. moduleNameString) == from) != mkModuleName to
+
+        alterNormalNames :: LocalRefactoring dom
+        alterNormalNames mod = if from `elem` moduleQualifiers mod 
+           then biplateRef @_ @(QualifiedName dom) & filtered (\e -> concat (intersperse "." (e ^? qualifiers&annList&simpleNameStr)) == from)
+                  !- (\e -> mkQualifiedName (splitOn "." to) (e ^. unqualifiedName&simpleNameStr)) $ mod
+           else return mod
+
+        moduleQualifiers :: Module dom -> [String]
+        moduleQualifiers mod = mod ^? modImports & annList & filtered (\m -> isAnnNothing (m ^. importAs)) 
+                                              & importModule & moduleNameString
+
+        nameConflict :: String -> Module dom -> Bool
+        nameConflict to mod 
+          = let modName = mod ^? modHead&annJust&mhName&moduleNameString
+                imports = mod ^? modImports&annList
+                importNames = map (\imp -> fromMaybe (imp ^. importModule) (imp ^? importAs&annJust&importRename) ^. moduleNameString) imports
+             in modName == Just to || to `elem` importNames
+
+renameDefinition :: DomainRenameDefinition dom => GHC.Name -> [GHC.Name] -> String -> Refactoring dom
+renameDefinition toChangeOrig toChangeWith newName mod mods
+    = do nameCls <- classifyName toChangeOrig
+         (changedModules,defFound) <- runStateT (catMaybes <$> mapM (renameInAModule toChangeOrig toChangeWith newName) (mod:mods)) False
+         if | not (nameValid nameCls newName) -> refactError "The new name is not valid"
+            | not defFound -> refactError "The definition to rename was not found"
+            | otherwise -> return $ map ContentChanged changedModules
+  where     
+    renameInAModule :: DomainRenameDefinition dom => GHC.Name -> [GHC.Name] -> String -> ModuleDom dom -> StateT Bool Refactor (Maybe (ModuleDom dom))
+    renameInAModule toChangeOrig toChangeWith newName (name, mod)
+      = mapStateT (localRefactoringRes (\f (a,s) -> (fmap (\(n,r) -> (n, f r)) a,s)) mod) $
+          do (res, isChanged) <- runStateT (biplateRef !~ changeName toChangeOrig toChangeWith newName $ mod) False
+             if isChanged then return $ Just (name, res)
+                          else return Nothing
+
+    changeName :: DomainRenameDefinition dom => GHC.Name -> [GHC.Name] -> String -> QualifiedName dom 
+                                                         -> StateT Bool (StateT Bool (LocalRefactor dom)) (QualifiedName dom)
+    changeName toChangeOrig toChangeWith str name
+      | maybe False (`elem` toChange) actualName
+          && semanticsDefining name == False
+          && any @[] ((str ==) . occNameString . getOccName) (semanticsScope name ^? Ref.element 0 & traversal & filtered (sameNamespace toChangeOrig))
+      = refactError $ "The definition clashes with an existing one at: " ++ shortShowSpan (getRange name) -- name clash with an external definition
+      | maybe False (`elem` toChange) actualName
+      = do put True -- state that something is changed in the local state
+           when (actualName == Just toChangeOrig) 
+             $ lift $ modify (|| semanticsDefining name) -- state that the definition is renamed in the global state
+           return $ unqualifiedName .= mkNamePart str $ name -- found the changed name (or a name that have to be changed too)
+      | let namesInScope = semanticsScope name
+         in case semanticsName name of 
+              Just (getName -> exprName) -> str == occNameString (getOccName exprName) && sameNamespace toChangeOrig exprName
+                                              && conflicts toChangeOrig exprName namesInScope
+              Nothing -> False -- ambiguous names
+      = refactError $ "The definition clashes with an existing one: " ++ shortShowSpan (getRange name) -- local name clash
+      | otherwise = return name -- not the changed name, leave as before
+      where toChange = toChangeOrig : toChangeWith
+            actualName = fmap getName (semanticsName name)
+
+conflicts :: GHC.Name -> GHC.Name -> [[GHC.Name]] -> Bool
+conflicts overwrites overwritten (scopeBlock : scope) 
+  | overwritten `elem` scopeBlock && overwrites `notElem` scopeBlock = False
+  | overwrites `elem` scopeBlock = True
+  | otherwise = conflicts overwrites overwritten scope
+conflicts _ _ [] = False
+
+sameNamespace :: GHC.Name -> GHC.Name -> Bool
+sameNamespace n1 n2 = occNameSpace (getOccName n1) == occNameSpace (getOccName n2)
+ Language/Haskell/Tools/Refactor/Prepare.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE StandaloneDeriving
+           , DeriveGeneric
+           , LambdaCase
+           , ScopedTypeVariables
+           , BangPatterns
+           , MultiWayIf
+           , FlexibleContexts
+           , TypeFamilies
+           , TupleSections
+           , TemplateHaskell
+           , ViewPatterns
+           #-}
+-- | Defines utility methods that prepare Haskell modules for refactoring
+module Language.Haskell.Tools.Refactor.Prepare where
+
+import GHC hiding (loadModule)
+import Panic (handleGhcException)
+import Outputable
+import BasicTypes
+import Bag
+import Var
+import SrcLoc
+import Module as GHC
+import FastString
+import HscTypes
+import GHC.Paths ( libdir )
+import CmdLineParser
+import DynFlags
+import StringBuffer
+
+import Control.Monad.IO.Class
+import System.FilePath
+import Data.Maybe
+import Data.List.Split
+
+import Language.Haskell.Tools.AST as AST
+import Language.Haskell.Tools.AST.FromGHC
+import Language.Haskell.Tools.PrettyPrint
+import Language.Haskell.Tools.Transform
+import Language.Haskell.Tools.Refactor.RefactorBase
+
+tryRefactor :: Refactoring IdDom -> String -> IO ()
+tryRefactor refact moduleName 
+  = runGhc (Just libdir) $ do
+      initGhcFlags
+      useDirs ["."]
+      mod <- loadModule "." moduleName >>= parseTyped
+      res <- runRefactor (toFileName "." moduleName, mod) [] refact 
+      case res of Right r -> liftIO $ mapM_ (putStrLn . prettyPrint . snd . fromContentChanged) r
+                  Left err -> liftIO $ putStrLn err
+
+-- | Set the given flags for the GHC session
+useFlags :: [String] -> Ghc [String]
+useFlags args = do 
+  let lArgs = map (L noSrcSpan) args
+  dynflags <- getSessionDynFlags
+  let ((leftovers, errors, warnings), newDynFlags) = (runCmdLine $ processArgs flagsAll lArgs) dynflags
+  setSessionDynFlags newDynFlags
+  return $ map unLoc leftovers
+
+-- | Initialize GHC flags to default values that support refactoring
+initGhcFlags :: Ghc ()
+initGhcFlags = do
+  dflags <- getSessionDynFlags
+  setSessionDynFlags 
+    $ flip gopt_set Opt_KeepRawTokenStream
+    $ flip gopt_set Opt_NoHsMain
+    $ dflags { importPaths = []
+             , hscTarget = HscAsm -- needed for static pointers
+             , ghcLink = LinkInMemory
+             , ghcMode = CompManager 
+             , packageFlags = ExposePackage "template-haskell" (PackageArg "template-haskell") (ModRenaming True []) : packageFlags dflags
+             }
+  return () 
+
+-- | Use the given source directories
+useDirs :: [FilePath] -> Ghc ()
+useDirs workingDirs = do
+  dynflags <- getSessionDynFlags
+  setSessionDynFlags dynflags { importPaths = importPaths dynflags ++ workingDirs }
+  return ()
+  
+-- | Translates module name and working directory into the name of the file where the given module should be defined
+toFileName :: String -> String -> FilePath
+toFileName workingDir mod = normalise $ workingDir </> map (\case '.' -> pathSeparator; c -> c) mod ++ ".hs"
+
+-- | Translates module name and working directory into the name of the file where the boot module should be defined
+toBootFileName :: String -> String -> FilePath
+toBootFileName workingDir mod = normalise $ workingDir </> map (\case '.' -> pathSeparator; c -> c) mod ++ ".hs-boot"
+
+-- | Load the summary of a module given by the working directory and module name.
+loadModule :: String -> String -> Ghc ModSummary
+loadModule workingDir moduleName 
+  = do initGhcFlags
+       useDirs [workingDir]
+       target <- guessTarget moduleName Nothing
+       setTargets [target]
+       load LoadAllTargets
+       getModSummary $ mkModuleName moduleName
+    
+-- | The final version of our AST, with type infromation added
+type TypedModule = Ann AST.UModule IdDom SrcTemplateStage
+
+-- | Get the typed representation from a type-correct program.
+parseTyped :: ModSummary -> Ghc TypedModule
+parseTyped modSum = do
+  p <- parseModule modSum
+  tc <- typecheckModule p
+  let annots = pm_annotations p
+      srcBuffer = fromJust $ ms_hspp_buf $ pm_mod_summary p
+  prepareAST srcBuffer . placeComments (getNormalComments $ snd annots) 
+    <$> (addTypeInfos (typecheckedSource tc) 
+           =<< (do parseTrf <- runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModule modSum (pm_parsed_source p)
+                   runTrf (fst annots) (getPragmaComments $ snd annots)
+                     $ trfModuleRename modSum parseTrf
+                         (fromJust $ tm_renamed_source tc) 
+                         (pm_parsed_source p)))
+
+data IsBoot = NormalHs | IsHsBoot deriving (Eq, Ord, Show)
+
+readSrcSpan :: String -> String -> RealSrcSpan
+readSrcSpan fileName s = case splitOn "-" s of
+  [from,to] -> mkRealSrcSpan (readSrcLoc fileName from) (readSrcLoc fileName to)
+  
+readSrcLoc :: String -> String -> RealSrcLoc
+readSrcLoc fileName s = case splitOn ":" s of
+  [line,col] -> mkRealSrcLoc (mkFastString fileName) (read line) (read col)
Language/Haskell/Tools/Refactor/RefactorBase.hs view
@@ -11,9 +11,8 @@ module Language.Haskell.Tools.Refactor.RefactorBase where
 
 import Language.Haskell.Tools.AST as AST
-import Language.Haskell.Tools.AST.Gen
-import Language.Haskell.Tools.AnnTrf.SourceTemplateHelpers
-import Language.Haskell.Tools.AnnTrf.SourceTemplate
+import Language.Haskell.Tools.AST.Rewrite
+import Language.Haskell.Tools.Transform
 import GHC (Ghc, GhcMonad(..), TyThing(..), lookupName)
 import Exception (ExceptionMonad(..))
 import DynFlags (HasDynFlags(..))
@@ -33,7 +32,7 @@ import Control.Monad.Writer
 import Control.Monad.State
 
-type UnnamedModule dom = Ann AST.Module dom SrcTemplateStage
+type UnnamedModule dom = Ann AST.UModule dom SrcTemplateStage
 
 -- | The name of the module and the AST
 type ModuleDom dom = (String, UnnamedModule dom)
@@ -64,20 +63,20 @@                           -> LocalRefactor dom a
                           -> Refactor a
 localRefactoringRes access mod trf
-  = let init = RefactorCtx (semanticsModule $ mod ^. semantics) mod (mod ^? element&modImports&annList)
+  = let init = RefactorCtx (semanticsModule $ mod ^. semantics) mod (mod ^? modImports&annList)
      in flip runReaderT init $ do (mod, newNames) <- runWriterT (fromRefactorT trf)
                                   return $ access (addGeneratedImports newNames) mod
 
 -- | Adds the imports that bring names into scope that are needed by the refactoring
-addGeneratedImports :: [GHC.Name] -> Ann Module dom SrcTemplateStage -> Ann Module dom SrcTemplateStage
-addGeneratedImports names m = element&modImports&annListElems .- (++ addImports names) $ m
-  where addImports :: [GHC.Name] -> [Ann ImportDecl dom SrcTemplateStage]
+addGeneratedImports :: [GHC.Name] -> Ann UModule dom SrcTemplateStage -> Ann UModule dom SrcTemplateStage
+addGeneratedImports names m = modImports&annListElems .- (++ addImports names) $ m
+  where addImports :: [GHC.Name] -> [Ann UImportDecl dom SrcTemplateStage]
         addImports names = map createImport $ groupBy ((==) `on` GHC.nameModule) $ nub $ sort names
 
         -- TODO: group names like constructors into correct IESpecs
-        createImport :: [GHC.Name] -> Ann ImportDecl dom SrcTemplateStage
+        createImport :: [GHC.Name] -> Ann UImportDecl dom SrcTemplateStage
         createImport names = mkImportDecl False False False Nothing (mkModuleName $ GHC.moduleNameString $ GHC.moduleName $ GHC.nameModule $ head names)
-                                          Nothing (Just $ mkImportSpecList (map (\n -> mkIeSpec (mkUnqualName' n) Nothing) names))
+                                          Nothing (Just $ mkImportSpecList (map (\n -> mkIESpec (mkUnqualName' n) Nothing) names))
 
 instance (GhcMonad m, Monoid s) => GhcMonad (WriterT s m) where
   getSession = lift getSession
@@ -110,8 +109,8 @@ 
 -- | The information a refactoring can use
 data RefactorCtx dom = RefactorCtx { refModuleName :: GHC.Module
-                                   , refCtxRoot :: Ann Module dom SrcTemplateStage
-                                   , refCtxImports :: [Ann ImportDecl dom SrcTemplateStage] 
+                                   , refCtxRoot :: Ann UModule dom SrcTemplateStage
+                                   , refCtxImports :: [Ann UImportDecl dom SrcTemplateStage] 
                                    }
 
 instance MonadTrans (LocalRefactorT dom) where
@@ -155,10 +154,10 @@   Just mod -> GHC.moduleNameString (GHC.moduleName mod) ++ "." ++ GHC.occNameString (GHC.nameOccName name)
   Nothing -> GHC.occNameString (GHC.nameOccName name)
 
-referenceName :: (HasImportInfo dom, HasModuleInfo dom) => GHC.Name -> LocalRefactor dom (Ann Name dom SrcTemplateStage)
+referenceName :: (HasImportInfo dom, HasModuleInfo dom) => GHC.Name -> LocalRefactor dom (Ann UName dom SrcTemplateStage)
 referenceName = referenceName' mkQualName'
 
-referenceOperator :: (HasImportInfo dom, HasModuleInfo dom) => GHC.Name -> LocalRefactor dom (Ann Operator dom SrcTemplateStage)
+referenceOperator :: (HasImportInfo dom, HasModuleInfo dom) => GHC.Name -> LocalRefactor dom (Ann UOperator dom SrcTemplateStage)
 referenceOperator = referenceName' mkQualOp'
 
 -- | Create a name that references the definition. Generates an import if the definition is not yet imported.
@@ -180,15 +179,15 @@                                      -- use it according to the best available import
 
 -- | Reference the name by the shortest suitable import
-referenceBy :: ([String] -> GHC.Name -> Ann nt dom SrcTemplateStage) -> GHC.Name -> [Ann ImportDecl dom SrcTemplateStage] -> Ann nt dom SrcTemplateStage
+referenceBy :: ([String] -> GHC.Name -> Ann nt dom SrcTemplateStage) -> GHC.Name -> [Ann UImportDecl dom SrcTemplateStage] -> Ann nt dom SrcTemplateStage
 referenceBy makeName name imps = 
   let prefixes = map importQualifier imps
    in makeName (minimumBy (compare `on` (length . concat)) prefixes) name
-  where importQualifier :: Ann ImportDecl dom SrcTemplateStage -> [String]
+  where importQualifier :: Ann UImportDecl dom SrcTemplateStage -> [String]
         importQualifier imp 
-          = if isJust (imp ^? element&importQualified&annJust) 
-              then case imp ^? element&importAs&annJust&element&importRename&element of 
-                      Nothing -> splitOn "." (imp ^. element&importModule&element&moduleNameString) -- fully qualified import
+          = if isJust (imp ^? importQualified&annJust) 
+              then case imp ^? importAs&annJust&importRename of 
+                      Nothing -> splitOn "." (imp ^. importModule&moduleNameString) -- fully qualified import
                       Just asName -> splitOn "." (asName ^. moduleNameString) -- the name given by as clause
               else [] -- unqualified import
 
@@ -197,7 +196,7 @@                | Ctor             -- ^ Data constructors 
                | ValueOperator    -- ^ Functions with operator-like names
                | DataCtorOperator -- ^ Constructors with operator-like names
-               | SynonymOperator  -- ^ Type definitions with operator-like names
+               | SynonymOperator  -- ^ UType definitions with operator-like names
 
 -- | Get which category does a given name belong to
 classifyName :: RefactorMonad m => GHC.Name -> m NameClass
@@ -228,7 +227,7 @@ -- Operators that are data constructors (must start with ':')
 nameValid DataCtorOperator (':' : nameRest)
   = all isOperatorChar nameRest
--- Type families and synonyms that are operators (can start with ':')
+-- UType families and synonyms that are operators (can start with ':')
 nameValid SynonymOperator (c : nameRest)
   = isOperatorChar c && all isOperatorChar nameRest
 -- Normal value operators (cannot start with ':')
− Language/Haskell/Tools/Refactor/RenameDefinition.hs
@@ -1,121 +0,0 @@-{-# LANGUAGE ScopedTypeVariables
-           , LambdaCase
-           , MultiWayIf
-           , TypeApplications
-           , ConstraintKinds
-           , TypeFamilies
-           , FlexibleContexts
-           , ViewPatterns
-           #-}
-module Language.Haskell.Tools.Refactor.RenameDefinition (renameDefinition, renameDefinition', DomainRenameDefinition) where
-
-import Name hiding (Name)
-import GHC (Ghc, TyThing(..), lookupName)
-import qualified GHC
-import OccName
-import SrcLoc
-import Outputable
-import Unique
-
-import Control.Reference hiding (element)
-import qualified Control.Reference as Ref
-import Control.Monad.State
-import Control.Monad.Trans.Except
-import Data.Data
-import Data.List.Split
-import Data.List
-import Data.Maybe
-import Data.Generics.Uniplate.Data
-import Language.Haskell.Tools.AST
-import Language.Haskell.Tools.AnnTrf.SourceTemplate
-import Language.Haskell.Tools.AST.Gen
-import Language.Haskell.Tools.Refactor.RefactorBase
-
-import Debug.Trace
-
-type DomainRenameDefinition dom = ( HasNameInfo dom, HasScopeInfo dom, HasDefiningInfo dom
-                                  , HasImplicitFieldsInfo dom, HasModuleInfo dom )
-
-renameDefinition' :: forall dom . DomainRenameDefinition dom => RealSrcSpan -> String -> Refactoring dom
-renameDefinition' sp str mod mods
-  = case (getNodeContaining sp (snd mod) :: Maybe (Ann QualifiedName dom SrcTemplateStage)) >>= (fmap getName . (semanticsName =<<) . (^? semantics)) of 
-      Just name -> do let sameNames = bindsWithSameName name (snd mod ^? biplateRef) 
-                      renameDefinition name sameNames str mod mods
-        where bindsWithSameName :: GHC.Name -> [Ann FieldWildcard dom SrcTemplateStage] -> [GHC.Name]
-              bindsWithSameName name wcs = catMaybes $ map ((lookup name) . semanticsImplicitFlds . (^. semantics)) wcs
-      Nothing -> case getNodeContaining sp (snd mod) of
-                   Just modName -> renameModule (modName ^. element&moduleNameString) str mod mods
-                   Nothing -> refactError "No name is selected"
-
-renameModule :: forall dom . DomainRenameDefinition dom => String -> String -> Refactoring dom
-renameModule from to m mods 
-    | any (nameConflict to) (map snd $ m:mods) = refactError "Name conflict when renaming module" 
-    | not (validModuleName to) = refactError "The given name is not a valid module name" 
-    | otherwise = fmap (\ls -> ModuleRemoved from : map (\(ContentChanged (mod,res)) -> ContentChanged (if mod == from then to else mod, res)) ls)
-                    $ localRefactoring (replaceModuleNames >=> alterNormalNames) m mods
-  where replaceModuleNames :: LocalRefactoring dom
-        replaceModuleNames = biplateRef @_ @(Ann ModuleName dom SrcTemplateStage) & filtered (\e -> (e ^. element&moduleNameString) == from) != mkModuleName to
-
-        alterNormalNames :: LocalRefactoring dom
-        alterNormalNames mod = if from `elem` moduleQualifiers mod 
-           then biplateRef @_ @(Ann QualifiedName dom SrcTemplateStage) & filtered (\e -> concat (intersperse "." (e ^? element&qualifiers&annList&element&simpleNameStr)) == from)
-                  !- (\e -> mkQualifiedName (splitOn "." to) (e ^. element&unqualifiedName&element&simpleNameStr)) $ mod
-           else return mod
-
-        moduleQualifiers :: Ann Module dom SrcTemplateStage -> [String]
-        moduleQualifiers mod = mod ^? element & modImports & annList & element & filtered (\m -> isAnnNothing (m ^. importAs)) 
-                                              & importModule & element & moduleNameString
-
-        nameConflict :: String -> Ann Module dom SrcTemplateStage -> Bool
-        nameConflict to mod 
-          = let modName = mod ^? element&modHead&annJust&element&mhName&element&moduleNameString
-                imports = mod ^? element&modImports&annList&element
-                importNames = map (\imp -> fromMaybe (imp ^. importModule) (imp ^? importAs&annJust&element&importRename) ^. element&moduleNameString) imports
-             in modName == Just to || to `elem` importNames
-
-renameDefinition :: DomainRenameDefinition dom => GHC.Name -> [GHC.Name] -> String -> Refactoring dom
-renameDefinition toChangeOrig toChangeWith newName mod mods
-    = do nameCls <- classifyName toChangeOrig
-         (changedModules,defFound) <- runStateT (catMaybes <$> mapM (renameInAModule toChangeOrig toChangeWith newName) (mod:mods)) False
-         if | not (nameValid nameCls newName) -> refactError "The new name is not valid"
-            | not defFound -> refactError "The definition to rename was not found"
-            | otherwise -> return $ map ContentChanged changedModules
-  where     
-    renameInAModule :: DomainRenameDefinition dom => GHC.Name -> [GHC.Name] -> String -> ModuleDom dom -> StateT Bool Refactor (Maybe (ModuleDom dom))
-    renameInAModule toChangeOrig toChangeWith newName (name, mod)
-      = mapStateT (localRefactoringRes (\f (a,s) -> (fmap (\(n,r) -> (n, f r)) a,s)) mod) $
-          do (res, isChanged) <- runStateT (biplateRef !~ changeName toChangeOrig toChangeWith newName $ mod) False
-             if isChanged then return $ Just (name, res)
-                          else return Nothing
-
-    changeName :: DomainRenameDefinition dom => GHC.Name -> [GHC.Name] -> String -> Ann QualifiedName dom SrcTemplateStage 
-                                                         -> StateT Bool (StateT Bool (LocalRefactor dom)) (Ann QualifiedName dom SrcTemplateStage)
-    changeName toChangeOrig toChangeWith str name
-      | maybe False (`elem` toChange) actualName
-          && semanticsDefining (name ^. semantics) == False
-          && any @[] ((str ==) . occNameString . getOccName) (semanticsScope (name ^. semantics) ^? Ref.element 0 & traversal & filtered (sameNamespace toChangeOrig))
-      = refactError $ "The definition clashes with an existing one at: " ++ shortShowSpan (getRange name) -- name clash with an external definition
-      | maybe False (`elem` toChange) actualName
-      = do put True -- state that something is changed in the local state
-           when (actualName == Just toChangeOrig) 
-             $ lift $ modify (|| semanticsDefining (name ^. semantics)) -- state that the definition is renamed in the global state
-           return $ element & unqualifiedName .= mkNamePart str $ name -- found the changed name (or a name that have to be changed too)
-      | let namesInScope = semanticsScope (name ^. semantics)
-         in case semanticsName (name ^. semantics) of 
-              Just (getName -> exprName) -> str == occNameString (getOccName exprName) && sameNamespace toChangeOrig exprName
-                                              && conflicts toChangeOrig exprName namesInScope
-              Nothing -> False -- ambiguous names
-      = refactError $ "The definition clashes with an existing one: " ++ shortShowSpan (getRange name) -- local name clash
-      | otherwise = return name -- not the changed name, leave as before
-      where toChange = toChangeOrig : toChangeWith
-            actualName = fmap getName (semanticsName (name ^. semantics))
-
-conflicts :: GHC.Name -> GHC.Name -> [[GHC.Name]] -> Bool
-conflicts overwrites overwritten (scopeBlock : scope) 
-  | overwritten `elem` scopeBlock && overwrites `notElem` scopeBlock = False
-  | overwrites `elem` scopeBlock = True
-  | otherwise = conflicts overwrites overwritten scope
-conflicts _ _ [] = False
-
-sameNamespace :: GHC.Name -> GHC.Name -> Bool
-sameNamespace n1 n2 = occNameSpace (getOccName n1) == occNameSpace (getOccName n2)
haskell-tools-refactor.cabal view
@@ -1,5 +1,5 @@ name:                haskell-tools-refactor
-version:             0.2.0.0
+version:             0.3.0.0
 synopsis:            Refactoring Tool for Haskell
 description:         Contains a set of refactorings based on the Haskell-Tools framework to easily transform a Haskell program. For the descriptions of the implemented refactorings, see the homepage.
 homepage:            https://github.com/haskell-tools/haskell-tools
@@ -13,62 +13,67 @@ 
 library
   exposed-modules:     Language.Haskell.Tools.Refactor
-                     , Language.Haskell.Tools.Refactor.GenerateTypeSignature
-                     , Language.Haskell.Tools.Refactor.OrganizeImports
-                     , Language.Haskell.Tools.Refactor.GenerateExports
-                     , Language.Haskell.Tools.Refactor.RenameDefinition
-                     , Language.Haskell.Tools.Refactor.ExtractBinding
-                     , Language.Haskell.Tools.Refactor.RefactorBase
-                     , Language.Haskell.Tools.Refactor.DataToNewtype
-                     , Language.Haskell.Tools.Refactor.IfToGuards
-                     , Language.Haskell.Tools.Refactor.DollarApp
+                     , Language.Haskell.Tools.Refactor.BindingElem
                      , Language.Haskell.Tools.Refactor.GetModules
-  build-depends:       base                      >=4.9 && <5.0
-                     , ghc                       >=8.0 && <8.1
-                     , mtl                       >=2.2 && <2.3
-                     , uniplate                  >=1.6 && <1.7
-                     , ghc-paths                 >=0.1 && <0.2
-                     , containers                >=0.5 && <0.6
-                     , directory                 >=1.2 && <1.3
-                     , transformers              >=0.5 && <0.6
-                     , references                >=0.3.2 && <1.0
-                     , split                     >=0.2 && <1.0
-                     , filepath                  >=1.4 && <2.0
-                     , haskell-tools-ast         >=0.2 && <0.3
-                     , haskell-tools-ast-fromghc >=0.2 && <0.3
-                     , haskell-tools-ast-gen     >=0.2 && <0.3
-                     , haskell-tools-ast-trf     >=0.2 && <0.3
-                     , haskell-tools-prettyprint >=0.2 && <0.3
-                     , template-haskell          >=2.0 && <3.0
-                     , Cabal                     >=1.24 && <2.0
+                     , Language.Haskell.Tools.Refactor.RefactorBase
+                     , Language.Haskell.Tools.Refactor.Prepare
+                     , Language.Haskell.Tools.Refactor.Perform
+                     , Language.Haskell.Tools.Refactor.ListOperations
+
+                     , Language.Haskell.Tools.Refactor.Predefined.GenerateTypeSignature
+                     , Language.Haskell.Tools.Refactor.Predefined.OrganizeImports
+                     , Language.Haskell.Tools.Refactor.Predefined.GenerateExports
+                     , Language.Haskell.Tools.Refactor.Predefined.RenameDefinition
+                     , Language.Haskell.Tools.Refactor.Predefined.ExtractBinding
+                     , Language.Haskell.Tools.Refactor.Predefined.DataToNewtype
+                     , Language.Haskell.Tools.Refactor.Predefined.IfToGuards
+                     , Language.Haskell.Tools.Refactor.Predefined.DollarApp
+                     
+  build-depends:       base                      >= 4.9  && < 4.10
+                     , mtl                       >= 2.2  && < 2.3
+                     , uniplate                  >= 1.6  && < 1.7
+                     , ghc-paths                 >= 0.1  && < 0.2
+                     , containers                >= 0.5  && < 0.6
+                     , directory                 >= 1.2  && < 1.3
+                     , transformers              >= 0.5  && < 0.6
+                     , references                >= 0.3  && < 0.4
+                     , split                     >= 0.2  && < 0.3
+                     , filepath                  >= 1.4  && < 1.5
+                     , template-haskell          >= 2.11 && < 2.12
+                     , ghc                       >= 8.0  && < 8.1
+                     , Cabal                     >= 1.24 && < 1.25
+                     , haskell-tools-ast         >= 0.3  && < 0.4
+                     , haskell-tools-backend-ghc >= 0.3  && < 0.4
+                     , haskell-tools-rewrite     >= 0.3  && < 0.4
+                     , haskell-tools-prettyprint >= 0.3  && < 0.4
   default-language:    Haskell2010
   
 test-suite haskell-tools-test
   type:                exitcode-stdio-1.0
   ghc-options:         -with-rtsopts=-M2g
-  hs-source-dirs:      ../../test
+  hs-source-dirs:      test
   main-is:             Main.hs
-  build-depends:       base                      >=4.9   && <5.0
-                     , HUnit                     >=1.3   && <2.0
-                     , ghc                       >=8.0   && <8.1
-                     , ghc-paths                 >=0.1   && <0.2
-                     , transformers              >=0.5   && <0.6
-                     , either                    >=4.0   && <5.0
-                     , filepath                  >=1.4   && <2.0
-                     , haskell-tools-ast         >=0.2 && <0.3
-                     , haskell-tools-ast-fromghc >=0.2 && <0.3
-                     , haskell-tools-ast-gen     >=0.2 && <0.3
-                     , haskell-tools-ast-trf     >=0.2 && <0.3
-                     , haskell-tools-prettyprint >=0.2 && <0.3
-                     , haskell-tools-refactor    >=0.2 && <0.3
-                     , mtl                       >=2.2 && <2.3
-                     , uniplate                  >=1.6 && <1.7
-                     , containers                >=0.5 && <0.6
-                     , directory                 >=1.2 && <1.3
-                     , references                >=0.3.2 && <1.0
-                     , split                     >=0.2 && <1.0
-                     , time                      >=1.5 && <2.0
-                     , template-haskell          >=2.0 && <3.0
-                     , Cabal                     >=1.24 && <2.0
-                     , polyparse                 >=1.12 && <2.0
+  build-depends:       base                      >= 4.9  && < 4.10
+                     , HUnit                     >= 1.3  && < 1.4
+                     , transformers              >= 0.5  && < 0.6
+                     , either                    >= 4.4  && < 4.5
+                     , filepath                  >= 1.4  && < 1.5
+                     , mtl                       >= 2.2  && < 2.3
+                     , uniplate                  >= 1.6  && < 1.7
+                     , containers                >= 0.5  && < 0.6
+                     , directory                 >= 1.2  && < 1.3
+                     , references                >= 0.3  && < 0.4
+                     , split                     >= 0.2  && < 0.3
+                     , time                      >= 1.6  && < 1.7
+                     , old-time                  >= 1.1  && < 1.2
+                     , polyparse                 >= 1.12 && < 1.13
+                     , template-haskell          >= 2.11 && < 2.12
+                     , ghc                       >= 8.0  && < 8.1
+                     , ghc-paths                 >= 0.1  && < 0.2
+                     , Cabal                     >= 1.24 && < 1.25
+                     , haskell-tools-ast         >= 0.3  && < 0.4
+                     , haskell-tools-backend-ghc >= 0.3  && < 0.4
+                     , haskell-tools-rewrite     >= 0.3  && < 0.4
+                     , haskell-tools-prettyprint >= 0.3  && < 0.4
+                     , haskell-tools-refactor    >= 0.3  && < 0.4
   default-language:    Haskell2010
+ test/Main.hs view
@@ -0,0 +1,563 @@+{-# LANGUAGE LambdaCase
+           , ViewPatterns
+           , TypeFamilies
+           #-}
+module Main where
+
+import GHC hiding (loadModule, ParsedModule)
+import DynFlags
+import GHC.Paths ( libdir )
+import Module as GHC
+
+import Control.Monad.IO.Class
+import Control.Monad
+import Data.Maybe
+import Data.List
+import Data.Either.Combinators
+import Test.HUnit hiding (test)
+import System.IO
+import System.Exit
+import System.FilePath
+
+import Language.Haskell.Tools.AST as AST
+import Language.Haskell.Tools.AST.Rewrite as G
+import Language.Haskell.Tools.AST.FromGHC
+import Language.Haskell.Tools.Transform
+import Language.Haskell.Tools.PrettyPrint
+import Language.Haskell.Tools.Refactor.Perform
+import Language.Haskell.Tools.Refactor.Prepare
+import Language.Haskell.Tools.Refactor.GetModules
+import Language.Haskell.Tools.Refactor.Predefined.OrganizeImports
+import Language.Haskell.Tools.Refactor.Predefined.GenerateTypeSignature
+import Language.Haskell.Tools.Refactor.Predefined.GenerateExports
+import Language.Haskell.Tools.Refactor.Predefined.RenameDefinition
+import Language.Haskell.Tools.Refactor.Predefined.ExtractBinding
+import Language.Haskell.Tools.Refactor.RefactorBase
+
+import Language.Haskell.Tools.Refactor.Predefined.DataToNewtype
+import Language.Haskell.Tools.Refactor.Predefined.IfToGuards
+import Language.Haskell.Tools.Refactor.Predefined.DollarApp
+
+main :: IO ()
+main = run nightlyTests
+
+run :: [Test] -> IO ()
+run tests = do results <- runTestTT $ TestList tests
+               if errors results + failures results > 0 
+                  then exitFailure
+                  else exitSuccess
+
+nightlyTests :: [Test]
+nightlyTests = unitTests 
+                 ++ map makeCpphsTest cppHsTests
+                 ++ map makeInstanceControlTest instanceControlTests
+
+unitTests :: [Test]
+unitTests = genTests ++ functionalTests
+
+functionalTests :: [Test]
+functionalTests = map makeReprintTest checkTestCases
+              ++ map makeOrganizeImportsTest organizeImportTests
+              ++ map makeGenerateSignatureTest generateSignatureTests
+              ++ map makeGenerateExportsTest generateExportsTests
+              ++ map makeRenameDefinitionTest renameDefinitionTests
+              ++ map makeWrongRenameDefinitionTest wrongRenameDefinitionTests
+              ++ map makeExtractBindingTest extractBindingTests
+              ++ map makeWrongExtractBindingTest wrongExtractBindingTests
+              ++ map makeMultiModuleTest multiModuleTests
+              ++ map makeMiscRefactorTest miscRefactorTests
+  where checkTestCases = languageTests 
+                          ++ organizeImportTests 
+                          ++ map fst generateSignatureTests 
+                          ++ generateExportsTests
+                          ++ map (\(mod,_,_) -> mod) renameDefinitionTests
+                          ++ map (\(mod,_,_) -> mod) wrongRenameDefinitionTests
+                          ++ map (\(mod,_,_) -> mod) extractBindingTests
+                          ++ map (\(mod,_,_) -> mod) wrongExtractBindingTests
+
+rootDir = ".." </> ".." </> "examples"
+        
+languageTests =
+  [ "Decl.AmbiguousFields"
+  , "Decl.AnnPragma"
+  , "Decl.ClosedTypeFamily"
+  , "Decl.CtorOp"
+  , "Decl.DataFamily"
+  , "Decl.DataType"
+  , "Decl.DataTypeDerivings"
+  , "Decl.FunBind"
+  , "Decl.FunctionalDeps"
+  , "Decl.FunGuards"
+  , "Decl.GADT"
+  , "Decl.InjectiveTypeFamily"
+  , "Decl.InlinePragma"
+  , "Decl.InstanceOverlaps"
+  , "Decl.InstanceSpec"
+  , "Decl.LocalBindings"
+  , "Decl.LocalFixity"
+  , "Decl.MultipleFixity"
+  , "Decl.MultipleSigs"
+  , "Decl.OperatorBind"
+  , "Decl.OperatorDecl"
+  , "Decl.ParamDataType"
+  , "Decl.PatternBind"
+  , "Decl.PatternSynonym"
+  , "Decl.RecordPatternSynonyms"
+  , "Decl.RecordType"
+  , "Decl.RewriteRule"
+  , "Decl.SpecializePragma"
+  , "Decl.StandaloneDeriving"
+  , "Decl.TypeClass"
+  , "Decl.TypeClassMinimal"
+  , "Decl.TypeFamily"
+  , "Decl.TypeFamilyKindSig"
+  , "Decl.TypeInstance"
+  , "Decl.TypeRole"
+  , "Decl.TypeSynonym"
+  , "Decl.ValBind"
+  , "Expr.ArrowNotation"
+  , "Expr.Case"
+  , "Expr.DoNotation"
+  , "Expr.GeneralizedListComp"
+  , "Expr.EmptyCase"
+  , "Expr.If"
+  , "Expr.ImplicitParams"
+  , "Expr.LambdaCase"
+  , "Expr.ListComp"
+  , "Expr.MultiwayIf"
+  , "Expr.Negate"
+  , "Expr.Operator"
+  , "Expr.ParenName"
+  , "Expr.ParListComp"
+  , "Expr.RecordPuns"
+  , "Expr.RecordWildcards"
+  , "Expr.RecursiveDo"
+  , "Expr.Sections"
+  , "Expr.StaticPtr"
+  , "Expr.TupleSections"
+  , "Module.Simple"
+  , "Module.GhcOptionsPragma"
+  , "Module.Export"
+  , "Module.NamespaceExport"
+  , "Module.Import"
+  , "Pattern.Backtick"
+  , "Pattern.Constructor"
+  , "Pattern.ImplicitParams"
+  , "Pattern.Infix"
+  , "Pattern.NPlusK"
+  , "Pattern.Record"
+  , "Type.Bang"
+  , "Type.Builtin"
+  , "Type.Ctx"
+  , "Type.ExplicitTypeApplication"
+  , "Type.Forall"
+  , "Type.Primitives"
+  , "Type.TypeOperators"
+  , "Type.Unpack"
+  , "Type.Wildcard"
+  , "TH.Brackets"
+  , "TH.QuasiQuote.Define"
+  , "TH.QuasiQuote.Use"
+  , "TH.Splice.Define"
+  , "TH.Splice.Use"
+  , "Refactor.CommentHandling.CommentTypes"
+  , "Refactor.CommentHandling.BlockComments"
+  , "Refactor.CommentHandling.Crosslinking"
+  , "Refactor.CommentHandling.FunctionArgs"
+  ]
+
+cppHsTests = 
+  [ "Language.Preprocessor.Cpphs"
+  , "Language.Preprocessor.Unlit"
+  , "Language.Preprocessor.Cpphs.CppIfdef"
+  , "Language.Preprocessor.Cpphs.HashDefine"
+  , "Language.Preprocessor.Cpphs.MacroPass"
+  , "Language.Preprocessor.Cpphs.Options"
+  , "Language.Preprocessor.Cpphs.Position"
+  , "Language.Preprocessor.Cpphs.ReadFirst"
+  , "Language.Preprocessor.Cpphs.RunCpphs"
+  , "Language.Preprocessor.Cpphs.SymTab"
+  , "Language.Preprocessor.Cpphs.Tokenise"
+  ]
+
+instanceControlTests = 
+  [ "Control.Instances.Test"
+  , "Control.Instances.Morph"
+  , "Control.Instances.ShortestPath"
+  , "Control.Instances.TypeLevelPrelude"
+  ]
+        
+organizeImportTests = 
+  [ "Refactor.OrganizeImports.Narrow"
+  , "Refactor.OrganizeImports.Reorder"
+  , "Refactor.OrganizeImports.Unused"
+  , "Refactor.OrganizeImports.Ctor"
+  , "Refactor.OrganizeImports.Class"
+  , "Refactor.OrganizeImports.Operator"
+  , "Refactor.OrganizeImports.SameName"
+  , "Refactor.OrganizeImports.Removed"
+  ]
+  
+generateSignatureTests = 
+  [ ("Refactor.GenerateTypeSignature.Simple", "3:1-3:10")
+  , ("Refactor.GenerateTypeSignature.Function", "3:1-3:15")
+  , ("Refactor.GenerateTypeSignature.HigherOrder", "3:1-3:14")
+  , ("Refactor.GenerateTypeSignature.Polymorph", "3:1-3:10")
+  , ("Refactor.GenerateTypeSignature.PolymorphSub", "5:3-5:4")
+  , ("Refactor.GenerateTypeSignature.PolymorphSubMulti", "5:3-5:4")
+  , ("Refactor.GenerateTypeSignature.Placement", "4:1-4:10")
+  , ("Refactor.GenerateTypeSignature.Tuple", "3:1-3:18")
+  , ("Refactor.GenerateTypeSignature.Complex", "3:1-3:21")
+  , ("Refactor.GenerateTypeSignature.Local", "4:3-4:12")
+  , ("Refactor.GenerateTypeSignature.Let", "3:9-3:18")
+  , ("Refactor.GenerateTypeSignature.TypeDefinedInModule", "3:1-3:1")
+  , ("Refactor.GenerateTypeSignature.BringToScope.AlreadyQualImport", "6:1-6:2")
+  ]
+
+generateExportsTests = 
+  [ "Refactor.GenerateExports.Normal"
+  , "Refactor.GenerateExports.Operators"
+  ]
+
+renameDefinitionTests =
+  [ ("Refactor.RenameDefinition.AmbiguousFields", "4:14-4:15", "xx")
+  , ("Refactor.RenameDefinition.RecordField", "3:22-3:23", "xCoord")
+  , ("Refactor.RenameDefinition.Constructor", "3:14-3:19", "Point2D")
+  , ("Refactor.RenameDefinition.Type", "5:16-5:16", "Point2D")
+  , ("Refactor.RenameDefinition.Function", "3:1-3:2", "q")
+  , ("Refactor.RenameDefinition.QualName", "3:1-3:2", "q")
+  , ("Refactor.RenameDefinition.BacktickName", "3:1-3:2", "g")
+  , ("Refactor.RenameDefinition.ParenName", "4:3-4:5", "<->")
+  , ("Refactor.RenameDefinition.RecordWildcards", "4:32-4:33", "yy")
+  , ("Refactor.RenameDefinition.RecordPatternSynonyms", "4:16-4:17", "xx")
+  , ("Refactor.RenameDefinition.ClassMember", "7:3-7:4", "q")
+  , ("Refactor.RenameDefinition.LocalFunction", "4:5-4:6", "g")
+  , ("Refactor.RenameDefinition.LayoutAware", "3:1-3:2", "main")
+  , ("Refactor.RenameDefinition.Arg", "4:3-4:4", "y")
+  , ("Refactor.RenameDefinition.FunTypeVar", "3:6-3:7", "x")
+  , ("Refactor.RenameDefinition.FunTypeVarLocal", "5:10-5:11", "b")
+  , ("Refactor.RenameDefinition.ClassTypeVar", "3:9-3:10", "f")
+  , ("Refactor.RenameDefinition.TypeOperators", "4:13-4:15", "x1")
+  , ("Refactor.RenameDefinition.NoPrelude", "4:1-4:2", "map")
+  , ("Refactor.RenameDefinition.UnusedDef", "3:1-3:2", "map")
+  , ("Refactor.RenameDefinition.ImplicitParams", "8:17-8:20", "compare")
+  , ("Refactor.RenameDefinition.SameCtorAndType", "3:6-3:13", "P2D")
+  , ("Refactor.RenameDefinition.RoleAnnotation", "4:11-4:12", "AA")
+  , ("Refactor.RenameDefinition.TypeBracket", "6:6-6:7", "B")
+  , ("Refactor.RenameDefinition.ValBracket", "8:11-8:12", "B")
+  ]
+
+wrongRenameDefinitionTests =
+  [ ("Refactor.RenameDefinition.LibraryFunction", "4:5-4:7", "identity")
+  , ("Refactor.RenameDefinition.NameClash", "5:9-5:10", "h")
+  , ("Refactor.RenameDefinition.NameClash", "3:1-3:2", "map")
+  , ("Refactor.RenameDefinition.WrongName", "4:1-4:2", "F")
+  , ("Refactor.RenameDefinition.WrongName", "4:1-4:2", "++")
+  , ("Refactor.RenameDefinition.WrongName", "7:6-7:7", "x")
+  , ("Refactor.RenameDefinition.WrongName", "7:6-7:7", ":+:")
+  , ("Refactor.RenameDefinition.WrongName", "7:10-7:11", "x")
+  , ("Refactor.RenameDefinition.WrongName", "9:6-9:7", "A")
+  , ("Refactor.RenameDefinition.WrongName", "9:19-9:19", ".+++.")
+  , ("Refactor.RenameDefinition.WrongName", "11:3-11:3", ":+++:")
+  , ("Refactor.RenameDefinition.IllegalQualRename", "4:30-4:34", "Bl")
+  ]
+
+extractBindingTests =
+  [ ("Refactor.ExtractBinding.Simple", "3:19-3:27", "exaggerate")
+  , ("Refactor.ExtractBinding.Parentheses", "3:23-3:62", "sqDistance")
+  , ("Refactor.ExtractBinding.AddToExisting", "3:10-3:12", "b")
+  , ("Refactor.ExtractBinding.LocalDefinition", "4:13-4:16", "y")
+  , ("Refactor.ExtractBinding.ClassInstance", "6:30-6:35", "g")
+  , ("Refactor.ExtractBinding.ListComprehension", "5:25-5:39", "notDivisible")
+  , ("Refactor.ExtractBinding.Records", "5:5-5:39", "plus")
+  , ("Refactor.ExtractBinding.RecordWildcards", "6:5-6:27", "plus")
+  ]
+
+wrongExtractBindingTests = 
+  [ ("Refactor.ExtractBinding.TooSimple", "3:19-3:20", "x")
+  , ("Refactor.ExtractBinding.NameConflict", "3:19-3:27", "stms")
+  ]
+
+multiModuleTests =
+  [ ("RenameDefinition 5:5-5:6 bb", "A", "Refactor" </> "RenameDefinition" </> "MultiModule", [])
+  , ("RenameDefinition 1:8-1:9 C", "B", "Refactor" </> "RenameDefinition" </> "RenameModule", ["B"])
+  , ("RenameDefinition 3:8-3:9 C", "A", "Refactor" </> "RenameDefinition" </> "RenameModule", ["B"])
+  , ("RenameDefinition 6:1-6:9 hello", "Use", "Refactor" </> "RenameDefinition" </> "SpliceDecls", [])
+  , ("RenameDefinition 5:1-5:5 exprSplice", "Define", "Refactor" </> "RenameDefinition" </> "SpliceExpr", [])
+  , ("RenameDefinition 6:1-6:4 spliceTyp", "Define", "Refactor" </> "RenameDefinition" </> "SpliceType", [])
+  ]
+
+miscRefactorTests =
+  [ ("Refactor.DataToNewtype.Cases", \_ _ -> dataToNewtype)
+  , ("Refactor.IfToGuards.Simple", \wd mod -> ifToGuards (readSrcSpan (toFileName wd mod) "3:11-3:33"))
+  , ("Refactor.DollarApp.FirstSingle", \wd mod -> dollarApp (readSrcSpan (toFileName wd mod) "5:5-5:12"))
+  , ("Refactor.DollarApp.FirstMulti", \wd mod -> dollarApp (readSrcSpan (toFileName wd mod) "5:5-5:16"))
+  , ("Refactor.DollarApp.InfixOperator", \wd mod -> dollarApp (readSrcSpan (toFileName wd mod) "5:5-5:16"))
+  , ("Refactor.DollarApp.AnotherOperator", \wd mod -> dollarApp (readSrcSpan (toFileName wd mod) "5:5-5:15"))
+  , ("Refactor.DollarApp.ImportDollar", \wd mod -> dollarApp (readSrcSpan (toFileName wd mod) "6:5-6:12"))
+  ]
+
+makeMultiModuleTest :: (String, String, String, [String]) -> Test
+makeMultiModuleTest (refact, mod, root, removed)
+  = TestLabel (root ++ ":" ++ mod) $ TestCase 
+      $ do res <- performRefactors refact (rootDir </> root) [] mod
+           case res of Right result -> checkResults result removed
+                       Left err -> assertFailure $ "The transformation failed : " ++ err
+  where checkResults :: [(String, Maybe String)] -> [String] -> IO ()
+        checkResults ((name, Just mod):rest) removed = 
+          do expected <- loadExpected False ((rootDir </> root) ++ "_res") name
+             assertEqual "The transformed result is not what is expected" (standardizeLineEndings expected)
+                                                                          (standardizeLineEndings mod)
+             checkResults rest removed
+        checkResults ((name, Nothing) : rest) removed = checkResults rest (delete name removed)
+        checkResults [] [] = return ()
+        checkResults [] removed = assertFailure $ "Modules has not been marked as removed: " ++ concat (intersperse ", " removed)
+
+createTest :: String -> [String] -> String -> Test
+createTest refactoring args mod
+  = TestLabel mod $ TestCase $ checkCorrectlyTransformed (refactoring ++ (concatMap (" "++) args)) rootDir mod
+
+createFailTest :: String -> [String] -> String -> Test
+createFailTest refactoring args mod
+  = TestLabel mod $ TestCase $ checkTransformFails (refactoring ++ (concatMap (" "++) args)) rootDir mod
+
+makeOrganizeImportsTest :: String -> Test
+makeOrganizeImportsTest = createTest "OrganizeImports" []
+
+makeGenerateSignatureTest :: (String, String) -> Test
+makeGenerateSignatureTest (mod, rng) = createTest "GenerateSignature" [rng] mod
+
+makeGenerateExportsTest :: String -> Test
+makeGenerateExportsTest mod = createTest "GenerateExports" [] mod
+
+makeRenameDefinitionTest :: (String, String, String) -> Test
+makeRenameDefinitionTest (mod, rng, newName) = createTest "RenameDefinition" [rng, newName] mod
+
+makeWrongRenameDefinitionTest :: (String, String, String) -> Test
+makeWrongRenameDefinitionTest (mod, rng, newName) = createFailTest "RenameDefinition" [rng, newName] mod
+
+makeExtractBindingTest :: (String, String, String) -> Test
+makeExtractBindingTest (mod, rng, newName) = createTest "ExtractBinding" [rng, newName] mod
+  
+makeWrongExtractBindingTest :: (String, String, String) -> Test
+makeWrongExtractBindingTest (mod, rng, newName) = createFailTest "ExtractBinding" [rng, newName] mod
+
+checkCorrectlyTransformed :: String -> String -> String -> IO ()
+checkCorrectlyTransformed command workingDir moduleName
+  = do expected <- loadExpected True workingDir moduleName
+       res <- performRefactor command workingDir [] moduleName
+       assertEqual "The transformed result is not what is expected" (Right (standardizeLineEndings expected)) 
+                                                                    (mapRight standardizeLineEndings res)
+makeMiscRefactorTest :: (String, FilePath -> String -> LocalRefactoring IdDom) -> Test
+makeMiscRefactorTest (moduleName, refact)
+  = TestLabel moduleName $ TestCase $
+      do expected <- loadExpected True rootDir moduleName
+         res <- testRefactor (localRefactoring (refact rootDir moduleName)) moduleName
+         assertEqual "The transformed result is not what is expected" (Right (standardizeLineEndings expected)) 
+                                                                    (mapRight standardizeLineEndings res)
+        
+testRefactor :: Refactoring IdDom -> String -> IO (Either String String)
+testRefactor refact moduleName 
+  = runGhc (Just libdir) $ do
+      initGhcFlags
+      useDirs [rootDir]
+      mod <- loadModule rootDir moduleName >>= parseTyped
+      res <- runRefactor (toFileName rootDir moduleName, mod) [] refact 
+      case res of Right r -> return $ Right $ prettyPrint $ snd $ fromContentChanged $ head r
+                  Left err -> return $ Left err
+
+checkTransformFails :: String -> String -> String -> IO ()
+checkTransformFails command workingDir moduleName
+  = do res <- performRefactor command workingDir [] moduleName
+       assertBool "The transform should fail for the given input" (isLeft res)
+       
+loadExpected :: Bool -> String -> String -> IO String
+loadExpected resSuffix workingDir moduleName = 
+  do -- need to use binary or line endings will be translated
+     expectedHandle <- openBinaryFile (workingDir </> map (\case '.' -> pathSeparator; c -> c) moduleName ++ (if resSuffix then "_res" else "") ++ ".hs") ReadMode
+     hGetContents expectedHandle
+
+standardizeLineEndings = filter (/= '\r')
+       
+makeReprintTest :: String -> Test       
+makeReprintTest mod = TestLabel mod $ TestCase (checkCorrectlyPrinted rootDir mod)
+
+makeCpphsTest :: String -> Test       
+makeCpphsTest mod = TestLabel mod $ TestCase (checkCorrectlyPrinted (rootDir </> "CppHs") mod)
+
+makeInstanceControlTest :: String -> Test       
+makeInstanceControlTest mod = TestLabel mod $ TestCase (checkCorrectlyPrinted (rootDir </> "InstanceControl") mod)
+
+checkCorrectlyPrinted :: String -> String -> IO ()
+checkCorrectlyPrinted workingDir moduleName 
+  = do -- need to use binary or line endings will be translated
+       expectedHandle <- openBinaryFile (workingDir </> map (\case '.' -> pathSeparator; c -> c) moduleName ++ ".hs") ReadMode
+       expected <- hGetContents expectedHandle
+       (actual, actual', actual'') <- runGhc (Just libdir) $ do
+         parsed <- loadModule workingDir moduleName
+         actual <- prettyPrint <$> parseAST parsed
+         actual' <- prettyPrint <$> parseRenamed parsed
+         actual'' <- prettyPrint <$> parseTyped parsed
+         return (actual, actual', actual'')
+       assertEqual "The original and the transformed source differ" expected actual
+       assertEqual "The original and the transformed source differ" expected actual'
+       assertEqual "The original and the transformed source differ" expected actual''
+
+
+performRefactors :: String -> String -> [String] -> String -> IO (Either String [(String, Maybe String)])
+performRefactors command workingDir flags target = do 
+  mods <- getModules workingDir
+  runGhc (Just libdir) $ do
+    initGhcFlags
+    useFlags flags
+    useDirs (concatMap fst mods)
+    setTargets (map (\mod -> (Target (TargetModule (GHC.mkModuleName mod)) True Nothing)) (concatMap snd mods))
+    load LoadAllTargets
+    allMods <- getModuleGraph
+    selectedMod <- getModSummary (GHC.mkModuleName target)
+    let otherModules = filter (not . (\ms -> ms_mod ms == ms_mod selectedMod && ms_hsc_src ms == ms_hsc_src selectedMod)) allMods 
+    targetMod <- parseTyped selectedMod
+    otherMods <- mapM parseTyped otherModules
+    res <- performCommand (readCommand (toFileName workingDir target) command) 
+                          (target, targetMod) (zip (map (GHC.moduleNameString . moduleName . ms_mod) otherModules) otherMods)
+    return $ (\case Right r -> Right $ (map (\case ContentChanged (n,m) -> (n, Just $ prettyPrint m)
+                                                   ModuleRemoved m -> (m, Nothing)
+                                            )) r
+                    Left l -> Left l) 
+           $ res
+
+type ParsedModule = Ann AST.UModule (Dom RdrName) SrcTemplateStage
+
+parseAST :: ModSummary -> Ghc ParsedModule
+parseAST modSum = do
+  p <- parseModule modSum
+  let annots = pm_annotations p
+      srcBuffer = fromJust $ ms_hspp_buf $ pm_mod_summary p
+  prepareAST srcBuffer . placeComments (snd annots) 
+     <$> (runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModule modSum $ pm_parsed_source p)          
+
+type RenamedModule = Ann AST.UModule (Dom GHC.Name) SrcTemplateStage
+
+parseRenamed :: ModSummary -> Ghc RenamedModule
+parseRenamed modSum = do
+  p <- parseModule modSum
+  tc <- typecheckModule p
+  let annots = pm_annotations p
+      srcBuffer = fromJust $ ms_hspp_buf $ pm_mod_summary p
+  prepareAST srcBuffer . placeComments (getNormalComments $ snd annots) 
+    <$> (do parseTrf <- runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModule modSum (pm_parsed_source p)
+            runTrf (fst annots) (getPragmaComments $ snd annots)
+              $ trfModuleRename modSum parseTrf
+                  (fromJust $ tm_renamed_source tc) 
+                  (pm_parsed_source p))
+
+performRefactor :: String -> FilePath -> [String] -> String -> IO (Either String String)
+performRefactor command workingDir flags target = 
+  runGhc (Just libdir) $ do
+    initGhcFlags
+    useFlags flags
+    useDirs [workingDir]
+    ((\case Right r -> Right (newContent r); Left l -> Left l) <$> (refact =<< parseTyped =<< loadModule workingDir target))
+  where refact m = performCommand (readCommand (toFileName workingDir target) command) (target,m) []
+        newContent (ContentChanged (_, newContent) : ress) = prettyPrint newContent
+        newContent (_ : ress) = newContent ress
+
+-- tests for ast-gen
+
+genTests :: [Test]
+genTests = testBase ++ map makeGenTest testExprs ++ map makeGenTest testPatterns ++ map makeGenTest testType 
+             ++ map makeGenTest testBinds ++ map makeGenTest testDecls ++ map makeGenTest testModules
+
+makeGenTest :: SourceInfoTraversal elem => (String, Ann elem dom SrcTemplateStage) -> Test
+makeGenTest (expected, ast) = TestLabel expected $ TestCase $ assertEqual "The generated AST is not what is expected" expected (prettyPrint ast)
+
+testBase
+  = [ makeGenTest ("A.b", mkNormalName $ mkQualifiedName ["A"] "b")
+    , makeGenTest ("A.+", mkQualOp ["A"] "+")
+    , makeGenTest ("`mod`", mkBacktickOp [] "mod")
+    , makeGenTest ("(+)", mkParenName $ mkSimpleName "+")
+    ]
+
+testExprs 
+  = [ ("a + 3", mkInfixApp (mkVar (mkName "a")) (mkUnqualOp "+") (mkLit $ mkIntLit 3)) 
+    , ("(\"xx\"++)", mkLeftSection (mkLit (mkStringLit "xx")) (mkUnqualOp "++"))
+    , ("(1, [2, 3])", mkTuple [ mkLit (mkIntLit 1), mkList [ mkLit (mkIntLit 2), mkLit (mkIntLit 3) ] ])
+    , ("P { x = 1 }", mkRecCon (mkName "P") [ mkFieldUpdate (mkName "x") (mkLit $ mkIntLit 1) ])
+    , ("if f a then x else y", mkIf (mkApp (mkVar $ mkName "f") (mkVar $ mkName "a")) (mkVar $ mkName "x") (mkVar $ mkName "y"))
+    , ("let nat = [0..] in !z", mkLet [mkLocalValBind $ mkSimpleBind' (mkName "nat") (mkEnum (mkLit (mkIntLit 0)) Nothing Nothing)] 
+                                      (mkPrefixApp (mkUnqualOp "!") (mkVar $ mkName "z")) )
+    , (    "case x of Just y -> y\n"
+        ++ "          Nothing -> 0", mkCase (mkVar (mkName "x")) [ mkAlt (mkAppPat (mkName "Just") [mkVarPat (mkName "y")]) (mkCaseRhs $ mkVar (mkName "y")) Nothing
+                                                                 , mkAlt (mkVarPat $ mkName "Nothing") (mkCaseRhs $ mkLit $ mkIntLit 0) Nothing
+                                                                 ])
+    , (    "if | x > y -> x\n"
+        ++ "   | otherwise -> y", mkMultiIf [ mkGuardedCaseRhs [mkGuardCheck $ mkInfixApp (mkVar (mkName "x")) (mkUnqualOp ">") (mkVar (mkName "y"))] (mkVar (mkName "x"))
+                                            , mkGuardedCaseRhs [mkGuardCheck $ mkVar (mkName "otherwise")] (mkVar (mkName "y"))
+                                            ])
+    , (    "do x <- a\n"
+        ++ "   return x", mkDoBlock [ G.mkBindStmt (mkVarPat (mkName "x")) (mkVar (mkName "a"))
+                                    , mkExprStmt (mkApp (mkVar $ mkName "return") (mkVar $ mkName "x"))
+                                    ])
+    ]
+
+testPatterns
+  = [ ("~[0, a]", mkIrrefutablePat $ mkListPat [ mkLitPat (mkIntLit 0), mkVarPat (mkName "a") ])
+    , ("p@Point{ x = 1 }", mkAsPat (mkName "p") $ mkRecPat (mkName "Point") [ mkPatternField (mkName "x") (mkLitPat (mkIntLit 1)) ])
+    , ("!(_, f -> 3)", mkBangPat $ mkTuplePat [mkWildPat, mkViewPat (mkVar $ mkName "f") (mkLitPat (mkIntLit 3))])
+    ]
+
+testType
+  = [ ("forall x . Eq x => x -> ()", mkForallType [mkTypeVar (mkName "x")] 
+                                       $ mkCtxType (mkContextOne (mkClassAssert (mkName "Eq") [mkVarType (mkName "x")])) 
+                                       $ mkFunctionType (mkVarType (mkName "x")) (mkVarType (mkName "()")))
+    , ("(A :+: B) (x, x)", mkTypeApp (mkParenType $ mkInfixTypeApp (mkVarType (mkName "A")) (mkUnqualOp ":+:") (mkVarType (mkName "B")))
+                                  (mkTupleType [ mkVarType (mkName "x"), mkVarType (mkName "x") ]))
+    ]
+
+testBinds
+  = [(    "x = (a, b) where a = 3\n"
+       ++ "                 b = 4", mkSimpleBind (mkVarPat (mkName "x")) (mkUnguardedRhs (mkTuple [(mkVar (mkName "a")), (mkVar (mkName "b"))]))
+                                                 (Just $ mkLocalBinds' [ mkLocalValBind $ mkSimpleBind' (mkName "a") (mkLit $ mkIntLit 3)
+                                                                       , mkLocalValBind $ mkSimpleBind' (mkName "b") (mkLit $ mkIntLit 4)
+                                                                       ]) )
+    ,(    "f i 0 = i\n"
+       ++ "f i x = x", mkFunctionBind' (mkName "f") [ ([mkVarPat $ mkName "i", mkLitPat $ mkIntLit 0], mkVar $ mkName "i")
+                                                    , ([mkVarPat $ mkName "i", mkVarPat $ mkName "x"], mkVar $ mkName "x")
+                                                    ])
+    ]
+
+testDecls
+  = [ ("id :: a -> a", mkTypeSigDecl $ mkTypeSignature (mkName "id") (mkFunctionType (mkVarType (mkName "a")) (mkVarType (mkName "a"))))
+    , ("id x = x", mkValueBinding $ mkFunctionBind' (mkName "id") [([mkVarPat $ mkName "x"], mkVar $ mkName "x")])
+    , ("data A a = A a deriving Show", mkDataDecl mkDataKeyword Nothing (mkDeclHeadApp (mkNameDeclHead (mkName "A")) (mkTypeVar (mkName "a"))) 
+                                         [mkConDecl (mkName "A") [mkVarType (mkName "a")]] (Just $ mkDeriving [mkInstanceHead (mkName "Show")]))
+    , ("data A = A { x :: Int }", mkDataDecl mkDataKeyword Nothing (mkNameDeclHead (mkName "A")) 
+                                    [mkRecordConDecl (mkName "A") [mkFieldDecl [mkName "x"] (mkVarType (mkName "Int"))]] Nothing)
+    , (    "class A t => C t where f :: t\n"
+        ++ "                       type T t :: *"
+      , mkClassDecl (Just $ mkContextOne (mkClassAssert (mkName "A") [mkVarType (mkName "t")])) 
+                    (mkDeclHeadApp (mkNameDeclHead (mkName "C")) (mkTypeVar (mkName "t"))) []
+                    (Just $ mkClassBody [ mkClassElemSig $ mkTypeSignature (mkName "f") (mkVarType (mkName "t"))
+                                        , mkClassElemTypeFam (mkDeclHeadApp (mkNameDeclHead (mkName "T")) (mkTypeVar (mkName "t"))) 
+                                                             (Just $ mkTypeFamilyKindSpec $ mkKindConstraint $ mkKindStar)
+                                        ])
+      )
+    , ("instance C Int where f = 0", mkInstanceDecl Nothing (mkInstanceRule Nothing $ mkAppInstanceHead (mkInstanceHead $ mkName "C") (mkVarType (mkName "Int"))) 
+                                                    (Just $ mkInstanceBody [mkInstanceBind $ mkSimpleBind' (mkName "f") (mkLit $ mkIntLit 0)]))
+    , ("infixl 6 +", mkFixityDecl $ mkInfixL 6 (mkUnqualOp "+"))
+    ]
+
+testModules
+  = [ ("", G.mkModule [] Nothing [] [])
+    , ("module Test(x, A(a), B(..)) where", G.mkModule [] (Just $ mkModuleHead (G.mkModuleName "Test") (Just $ mkExportSpecs [
+                                                mkExportSpec $ mkIESpec (mkName "x") Nothing
+                                              , mkExportSpec $ mkIESpec (mkName "A") (Just $ mkSubList [mkName "a"])
+                                              , mkExportSpec $ mkIESpec (mkName "B") (Just mkSubAll)
+                                            ]) Nothing) [] [])
+    , ("\nimport qualified A\n"
+      ++ "import B as BB(x)\n"
+      ++ "import B hiding (x)", G.mkModule [] Nothing [ mkImportDecl False True False Nothing (G.mkModuleName "A") Nothing Nothing
+                                                      , mkImportDecl False False False Nothing (G.mkModuleName "B") (Just $ G.mkModuleName "BB") (Just $ mkImportSpecList [mkIESpec (mkName "x") Nothing])
+                                                      , mkImportDecl False False False Nothing (G.mkModuleName "B") Nothing (Just $ mkImportHidingList [mkIESpec (mkName "x") Nothing])
+                                                      ] [])
+    ]