packages feed

haskell-tools-refactor 0.1.3.0 → 0.2.0.0

raw patch · 18 files changed

+494/−1212 lines, 18 filesdep +Cabaldep +HUnitdep +haskell-tools-refactordep ~haskell-tools-astdep ~haskell-tools-ast-fromghcdep ~haskell-tools-ast-gensetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: Cabal, HUnit, haskell-tools-refactor, polyparse

Dependency ranges changed: haskell-tools-ast, haskell-tools-ast-fromghc, haskell-tools-ast-gen, haskell-tools-ast-trf, haskell-tools-prettyprint

API changes (from Hackage documentation)

- Language.Haskell.Tools.Refactor: astView :: String -> String -> IO String
- Language.Haskell.Tools.Refactor: demoRefactor :: String -> String -> String -> IO ()
- Language.Haskell.Tools.Refactor: instance (GHC.Generics.Generic sema, GHC.Generics.Generic src) => GHC.Generics.Generic (Language.Haskell.Tools.AST.SemaInfoTypes.NodeInfo sema src)
- Language.Haskell.Tools.Refactor: instance GHC.Generics.Generic SrcLoc.SrcSpan
- Language.Haskell.Tools.Refactor: onlineASTView :: FilePath -> String -> IO (Either String String)
- Language.Haskell.Tools.Refactor: onlineRefactor :: String -> FilePath -> String -> IO (Either String String)
- Language.Haskell.Tools.Refactor: parseRenamed :: ModSummary -> Ghc (Ann Module (Dom Name) SrcTemplateStage)
- Language.Haskell.Tools.Refactor: performRefactor :: String -> String -> String -> IO (Either String String)
- Language.Haskell.Tools.Refactor.RefactorBase: RefactorT :: WriterT [Name] (ReaderT (RefactorCtx dom) m) a -> RefactorT dom m a
- Language.Haskell.Tools.Refactor.RefactorBase: instance (GHC.Base.Monad m, DynFlags.HasDynFlags m) => DynFlags.HasDynFlags (Language.Haskell.Tools.Refactor.RefactorBase.RefactorT dom m)
- Language.Haskell.Tools.Refactor.RefactorBase: instance Control.Monad.IO.Class.MonadIO m => Control.Monad.IO.Class.MonadIO (Language.Haskell.Tools.Refactor.RefactorBase.RefactorT dom m)
- Language.Haskell.Tools.Refactor.RefactorBase: instance Control.Monad.Trans.Class.MonadTrans (Language.Haskell.Tools.Refactor.RefactorBase.RefactorT dom)
- Language.Haskell.Tools.Refactor.RefactorBase: instance Exception.ExceptionMonad m => Exception.ExceptionMonad (Language.Haskell.Tools.Refactor.RefactorBase.RefactorT dom m)
- Language.Haskell.Tools.Refactor.RefactorBase: instance GHC.Base.Applicative m => GHC.Base.Applicative (Language.Haskell.Tools.Refactor.RefactorBase.RefactorT dom m)
- Language.Haskell.Tools.Refactor.RefactorBase: instance GHC.Base.Functor m => GHC.Base.Functor (Language.Haskell.Tools.Refactor.RefactorBase.RefactorT dom m)
- Language.Haskell.Tools.Refactor.RefactorBase: instance GHC.Base.Monad m => Control.Monad.Reader.Class.MonadReader (Language.Haskell.Tools.Refactor.RefactorBase.RefactorCtx dom) (Language.Haskell.Tools.Refactor.RefactorBase.RefactorT dom m)
- Language.Haskell.Tools.Refactor.RefactorBase: instance GHC.Base.Monad m => Control.Monad.Writer.Class.MonadWriter [Name.Name] (Language.Haskell.Tools.Refactor.RefactorBase.RefactorT dom m)
- Language.Haskell.Tools.Refactor.RefactorBase: instance GHC.Base.Monad m => GHC.Base.Monad (Language.Haskell.Tools.Refactor.RefactorBase.RefactorT dom m)
- Language.Haskell.Tools.Refactor.RefactorBase: instance GhcMonad.GhcMonad m => GhcMonad.GhcMonad (Language.Haskell.Tools.Refactor.RefactorBase.RefactorT dom m)
- Language.Haskell.Tools.Refactor.RefactorBase: newtype RefactorT dom m a
- Language.Haskell.Tools.Refactor.RefactorBase: type RefactoredModule dom = Refactor dom (Ann Module dom SrcTemplateStage)
+ Language.Haskell.Tools.Refactor: IsHsBoot :: IsBoot
+ Language.Haskell.Tools.Refactor: NormalHs :: IsBoot
+ Language.Haskell.Tools.Refactor: analyzeCommand :: String -> String -> [String] -> RefactorCommand
+ Language.Haskell.Tools.Refactor: data IsBoot
+ 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: 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.GetModules: getModules :: FilePath -> IO [String]
+ Language.Haskell.Tools.Refactor.GetModules: modulesFromCabalFile :: FilePath -> IO [String]
+ Language.Haskell.Tools.Refactor.GetModules: modulesFromDirectory :: FilePath -> FilePath -> IO [String]
+ Language.Haskell.Tools.Refactor.IfToGuards: ifToGuards :: Domain dom => RealSrcSpan -> LocalRefactoring dom
+ Language.Haskell.Tools.Refactor.RefactorBase: ContentChanged :: (ModuleDom dom) -> RefactorChange dom
+ Language.Haskell.Tools.Refactor.RefactorBase: LocalRefactorT :: WriterT [Name] (ReaderT (RefactorCtx dom) m) a -> LocalRefactorT dom m a
+ Language.Haskell.Tools.Refactor.RefactorBase: ModuleRemoved :: String -> RefactorChange dom
+ Language.Haskell.Tools.Refactor.RefactorBase: [fromContentChanged] :: RefactorChange dom -> (ModuleDom dom)
+ Language.Haskell.Tools.Refactor.RefactorBase: [refCtxRoot] :: RefactorCtx dom -> Ann Module dom SrcTemplateStage
+ Language.Haskell.Tools.Refactor.RefactorBase: [removedModuleName] :: RefactorChange dom -> String
+ Language.Haskell.Tools.Refactor.RefactorBase: class Monad m => RefactorMonad m
+ Language.Haskell.Tools.Refactor.RefactorBase: data RefactorChange 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.RefactorBase: instance Control.Monad.IO.Class.MonadIO m => Control.Monad.IO.Class.MonadIO (Language.Haskell.Tools.Refactor.RefactorBase.LocalRefactorT dom m)
+ Language.Haskell.Tools.Refactor.RefactorBase: instance Control.Monad.Trans.Class.MonadTrans (Language.Haskell.Tools.Refactor.RefactorBase.LocalRefactorT dom)
+ Language.Haskell.Tools.Refactor.RefactorBase: instance Exception.ExceptionMonad m => Exception.ExceptionMonad (Language.Haskell.Tools.Refactor.RefactorBase.LocalRefactorT dom m)
+ Language.Haskell.Tools.Refactor.RefactorBase: instance GHC.Base.Applicative m => GHC.Base.Applicative (Language.Haskell.Tools.Refactor.RefactorBase.LocalRefactorT dom m)
+ Language.Haskell.Tools.Refactor.RefactorBase: instance GHC.Base.Functor m => GHC.Base.Functor (Language.Haskell.Tools.Refactor.RefactorBase.LocalRefactorT dom m)
+ Language.Haskell.Tools.Refactor.RefactorBase: instance GHC.Base.Monad m => Control.Monad.Reader.Class.MonadReader (Language.Haskell.Tools.Refactor.RefactorBase.RefactorCtx dom) (Language.Haskell.Tools.Refactor.RefactorBase.LocalRefactorT dom m)
+ Language.Haskell.Tools.Refactor.RefactorBase: instance GHC.Base.Monad m => Control.Monad.Writer.Class.MonadWriter [Name.Name] (Language.Haskell.Tools.Refactor.RefactorBase.LocalRefactorT dom m)
+ Language.Haskell.Tools.Refactor.RefactorBase: instance GHC.Base.Monad m => GHC.Base.Monad (Language.Haskell.Tools.Refactor.RefactorBase.LocalRefactorT dom m)
+ Language.Haskell.Tools.Refactor.RefactorBase: instance GhcMonad.GhcMonad m => GhcMonad.GhcMonad (Language.Haskell.Tools.Refactor.RefactorBase.LocalRefactorT dom m)
+ Language.Haskell.Tools.Refactor.RefactorBase: instance Language.Haskell.Tools.Refactor.RefactorBase.RefactorMonad (Language.Haskell.Tools.Refactor.RefactorBase.LocalRefactor dom)
+ Language.Haskell.Tools.Refactor.RefactorBase: instance Language.Haskell.Tools.Refactor.RefactorBase.RefactorMonad Language.Haskell.Tools.Refactor.RefactorBase.Refactor
+ Language.Haskell.Tools.Refactor.RefactorBase: instance Language.Haskell.Tools.Refactor.RefactorBase.RefactorMonad m => Language.Haskell.Tools.Refactor.RefactorBase.RefactorMonad (Control.Monad.Trans.State.Lazy.StateT s m)
+ Language.Haskell.Tools.Refactor.RefactorBase: liftGhc :: RefactorMonad m => Ghc a -> m a
+ Language.Haskell.Tools.Refactor.RefactorBase: localRefactoring :: HasModuleInfo dom => LocalRefactoring dom -> Refactoring dom
+ Language.Haskell.Tools.Refactor.RefactorBase: localRefactoringRes :: HasModuleInfo dom => ((UnnamedModule dom -> UnnamedModule dom) -> a -> a) -> UnnamedModule dom -> LocalRefactor dom a -> Refactor a
+ Language.Haskell.Tools.Refactor.RefactorBase: newtype LocalRefactorT dom m a
+ Language.Haskell.Tools.Refactor.RefactorBase: type LocalRefactor dom = LocalRefactorT dom Refactor
+ Language.Haskell.Tools.Refactor.RefactorBase: type LocalRefactoring dom = UnnamedModule dom -> LocalRefactor dom (UnnamedModule dom)
+ Language.Haskell.Tools.Refactor.RefactorBase: type ModuleDom dom = (String, UnnamedModule dom)
+ Language.Haskell.Tools.Refactor.RefactorBase: type Refactoring dom = ModuleDom dom -> [ModuleDom dom] -> Refactor [RefactorChange dom]
+ Language.Haskell.Tools.Refactor.RefactorBase: type UnnamedModule dom = Ann Module dom SrcTemplateStage
+ Language.Haskell.Tools.Refactor.RefactorBase: validModuleName :: String -> Bool
- Language.Haskell.Tools.Refactor: parseTyped :: ModSummary -> Ghc (Ann Module IdDom SrcTemplateStage)
+ Language.Haskell.Tools.Refactor: parseTyped :: ModSummary -> Ghc TypedModule
- Language.Haskell.Tools.Refactor: performCommand :: (SemanticInfo' dom SameInfoModuleCls ~ ModuleInfo n, DomGenerateExports dom, OrganizeImportsDomain dom n, DomainRenameDefinition dom, ExtractBindingDomain dom, GenerateSignatureDomain dom) => RefactorCommand -> Ann Module dom SrcTemplateStage -> Ghc (Either String (Ann Module dom SrcTemplateStage))
+ 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.ExtractBinding: doExtract :: ExtractBindingDomain dom => String -> Ann' Expr dom -> Ann' Expr dom -> StateT (Maybe (Ann' ValueBind dom)) (Refactor dom) (Ann' Expr dom)
+ 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 -> Ann' Module dom -> RefactoredModule 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 -> Ann' Module dom -> RefactoredModule 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)) (Refactor dom) (Ann' Expr 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: isConflicting :: ExtractBindingDomain dom => String -> Ann' SimpleName dom -> Bool
+ Language.Haskell.Tools.Refactor.ExtractBinding: isConflicting :: ExtractBindingDomain dom => String -> Ann' QualifiedName dom -> Bool
- Language.Haskell.Tools.Refactor.ExtractBinding: type ExtractBindingDomain dom = (Domain dom, HasNameInfo (SemanticInfo' dom SameInfoNameCls), HasDefiningInfo (SemanticInfo' dom SameInfoNameCls), HasScopeInfo (SemanticInfo' dom SameInfoExprCls))
+ Language.Haskell.Tools.Refactor.ExtractBinding: type ExtractBindingDomain dom = (Domain dom, HasNameInfo dom, HasDefiningInfo dom, HasScopeInfo dom)
- Language.Haskell.Tools.Refactor.GenerateExports: generateExports :: DomGenerateExports dom => Ann Module dom SrcTemplateStage -> RefactoredModule dom
+ Language.Haskell.Tools.Refactor.GenerateExports: generateExports :: DomGenerateExports dom => LocalRefactoring dom
- Language.Haskell.Tools.Refactor.GenerateExports: type DomGenerateExports dom = (Domain dom, HasNameInfo (SemanticInfo' dom SameInfoNameCls))
+ 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)) -> Ann' Module dom -> RefactoredModule 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 -> Ann' Module dom -> RefactoredModule dom
+ Language.Haskell.Tools.Refactor.GenerateTypeSignature: generateTypeSignature' :: GenerateSignatureDomain dom => RealSrcSpan -> LocalRefactoring dom
- Language.Haskell.Tools.Refactor.GenerateTypeSignature: type GenerateSignatureDomain dom = (Domain dom, HasIdInfo (SemanticInfo' dom SameInfoNameCls), Eq (SemanticInfo' dom SameInfoNameCls), SemanticInfo' dom SameInfoImportCls ~ ImportInfo Id)
+ Language.Haskell.Tools.Refactor.GenerateTypeSignature: type GenerateSignatureDomain dom = (HasModuleInfo dom, HasIdInfo dom, HasImportInfo dom)
- Language.Haskell.Tools.Refactor.OrganizeImports: organizeImports :: forall n dom. OrganizeImportsDomain dom n => Ann Module dom SrcTemplateStage -> RefactoredModule dom
+ Language.Haskell.Tools.Refactor.OrganizeImports: organizeImports :: forall dom. OrganizeImportsDomain dom => LocalRefactoring dom
- Language.Haskell.Tools.Refactor.OrganizeImports: type OrganizeImportsDomain dom n = (Domain dom, HasNameInfo (SemanticInfo' dom SameInfoNameCls), SemanticInfo' dom SameInfoImportCls ~ ImportInfo n, NamedThing n)
+ Language.Haskell.Tools.Refactor.OrganizeImports: type OrganizeImportsDomain dom = (Domain dom, HasNameInfo dom, HasImportInfo dom)
- Language.Haskell.Tools.Refactor.RefactorBase: RefactorCtx :: Module -> [Ann ImportDecl dom SrcTemplateStage] -> RefactorCtx dom
+ Language.Haskell.Tools.Refactor.RefactorBase: RefactorCtx :: Module -> Ann Module dom SrcTemplateStage -> [Ann ImportDecl dom SrcTemplateStage] -> RefactorCtx dom
- Language.Haskell.Tools.Refactor.RefactorBase: [fromRefactorT] :: RefactorT dom m a -> WriterT [Name] (ReaderT (RefactorCtx dom) m) a
+ Language.Haskell.Tools.Refactor.RefactorBase: [fromRefactorT] :: LocalRefactorT dom m a -> WriterT [Name] (ReaderT (RefactorCtx dom) m) a
- Language.Haskell.Tools.Refactor.RefactorBase: addGeneratedImports :: (Monad m) => ReaderT (RefactorCtx dom) m (Ann Module dom SrcTemplateStage, [Name]) -> ReaderT (RefactorCtx dom) m (Ann Module dom SrcTemplateStage)
+ Language.Haskell.Tools.Refactor.RefactorBase: addGeneratedImports :: [Name] -> Ann Module dom SrcTemplateStage -> Ann Module dom SrcTemplateStage
- Language.Haskell.Tools.Refactor.RefactorBase: classifyName :: Name -> Refactor dom NameClass
+ Language.Haskell.Tools.Refactor.RefactorBase: classifyName :: RefactorMonad m => Name -> m NameClass
- Language.Haskell.Tools.Refactor.RefactorBase: refactError :: String -> Refactor n a
+ Language.Haskell.Tools.Refactor.RefactorBase: refactError :: RefactorMonad m => String -> m a
- Language.Haskell.Tools.Refactor.RefactorBase: referenceName :: (SemanticInfo' dom SameInfoImportCls ~ ImportInfo n, Eq n, NamedThing n) => n -> Refactor dom (Ann Name 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' :: (SemanticInfo' dom SameInfoImportCls ~ ImportInfo n, Eq n, NamedThing n) => ([String] -> Name -> Ann nt dom SrcTemplateStage) -> n -> Refactor dom (Ann nt dom SrcTemplateStage)
+ Language.Haskell.Tools.Refactor.RefactorBase: referenceName' :: (HasImportInfo dom, HasModuleInfo dom) => ([String] -> Name -> Ann nt dom SrcTemplateStage) -> Name -> LocalRefactor dom (Ann nt dom SrcTemplateStage)
- Language.Haskell.Tools.Refactor.RefactorBase: referenceOperator :: (SemanticInfo' dom SameInfoImportCls ~ ImportInfo n, Eq n, NamedThing n) => n -> Refactor dom (Ann Operator dom SrcTemplateStage)
+ Language.Haskell.Tools.Refactor.RefactorBase: referenceOperator :: (HasImportInfo dom, HasModuleInfo dom) => Name -> LocalRefactor dom (Ann Operator dom SrcTemplateStage)
- Language.Haskell.Tools.Refactor.RefactorBase: runRefactor :: (SemanticInfo' dom SameInfoModuleCls ~ ModuleInfo n) => Ann Module dom SrcTemplateStage -> (Ann Module dom SrcTemplateStage -> RefactoredModule dom) -> Ghc (Either String (Ann Module dom SrcTemplateStage))
+ Language.Haskell.Tools.Refactor.RefactorBase: runRefactor :: (HasModuleInfo dom) => ModuleDom dom -> [ModuleDom dom] -> Refactoring dom -> Ghc (Either String [RefactorChange dom])
- Language.Haskell.Tools.Refactor.RefactorBase: type Refactor dom = RefactorT dom (ExceptT String Ghc)
+ Language.Haskell.Tools.Refactor.RefactorBase: type Refactor = ExceptT String Ghc
- Language.Haskell.Tools.Refactor.RenameDefinition: renameDefinition :: DomainRenameDefinition dom => Name -> String -> Ann Module dom SrcTemplateStage -> RefactoredModule dom
+ 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 -> Ann Module dom SrcTemplateStage -> RefactoredModule dom
+ Language.Haskell.Tools.Refactor.RenameDefinition: renameDefinition' :: forall dom. DomainRenameDefinition dom => RealSrcSpan -> String -> Refactoring dom
- Language.Haskell.Tools.Refactor.RenameDefinition: type DomainRenameDefinition dom = (Domain dom, HasNameInfo (SemanticInfo' dom SameInfoNameCls), Data (SemanticInfo' dom SameInfoNameCls), HasScopeInfo (SemanticInfo' dom SameInfoNameCls), HasDefiningInfo (SemanticInfo' dom SameInfoNameCls))
+ Language.Haskell.Tools.Refactor.RenameDefinition: type DomainRenameDefinition dom = (HasNameInfo dom, HasScopeInfo dom, HasDefiningInfo dom, HasImplicitFieldsInfo dom, HasModuleInfo dom)

Files

Language/Haskell/Tools/Refactor.hs view
@@ -6,7 +6,11 @@            , 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
@@ -18,10 +22,6 @@ import Language.Haskell.Tools.AnnTrf.PlaceComments
 import Language.Haskell.Tools.PrettyPrint.RoseTree
 import Language.Haskell.Tools.PrettyPrint
-import Language.Haskell.Tools.Refactor.RangeDebug
-import Language.Haskell.Tools.Refactor.RangeDebug.Instances
-import Language.Haskell.Tools.Refactor.ASTDebug
-import Language.Haskell.Tools.Refactor.ASTDebug.Instances
 
 import GHC hiding (loadModule)
 import Panic (handleGhcException)
@@ -30,10 +30,11 @@ import Bag
 import Var
 import SrcLoc
-import Module
+import Module as GHC
 import FastString
 import HscTypes
 import GHC.Paths ( libdir )
+import CmdLineParser
  
 import Data.List
 import Data.List.Split
@@ -41,9 +42,7 @@ import qualified Data.Map as Map
 import Data.Maybe
 import Data.Typeable
-import Data.Time.Clock
 import Data.IORef
-import Data.Either.Combinators
 import Control.Monad
 import Control.Monad.State
 import Control.Monad.IO.Class
@@ -54,13 +53,13 @@ import System.FilePath
 import Data.Generics.Uniplate.Operations
 
-import Language.Haskell.Tools.Refactor.DebugGhcAST
 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.Refactor.RefactorBase
+import Language.Haskell.Tools.Refactor.GetModules
 
 import Language.Haskell.TH.LanguageExtensions
  
@@ -68,103 +67,62 @@ import StringBuffer            
 
 import Debug.Trace
-    
-data RefactorCommand = NoRefactor 
-                     | OrganizeImports
-                     | GenerateExports
-                     | GenerateSignature RealSrcSpan
-                     | RenameDefinition RealSrcSpan String
-                     | ExtractBinding RealSrcSpan String
-    deriving Show
 
-performCommand :: (SemanticInfo' dom SameInfoModuleCls ~ AST.ModuleInfo n, DomGenerateExports dom, OrganizeImportsDomain dom n, DomainRenameDefinition dom, ExtractBindingDomain dom, GenerateSignatureDomain dom) 
-               => RefactorCommand -> Ann AST.Module dom SrcTemplateStage -> Ghc (Either String (Ann AST.Module dom SrcTemplateStage))
-performCommand rf mod = runRefactor mod $ selectCommand rf
-  where selectCommand  NoRefactor = return
-        selectCommand OrganizeImports = organizeImports
-        selectCommand GenerateExports = generateExports 
-        selectCommand (GenerateSignature sp) = generateTypeSignature' sp
-        selectCommand (RenameDefinition sp str) = renameDefinition' sp str
-        selectCommand (ExtractBinding sp str) = extractBinding' sp str
 
-readCommand :: String -> String -> RefactorCommand
-readCommand fileName s = case splitOn " " s of 
-  [""] -> NoRefactor
-  ("CheckSource":_) -> NoRefactor
-  ("OrganizeImports":_) -> OrganizeImports
-  ("GenerateExports":_) -> GenerateExports
-  ["GenerateSignature", sp] -> GenerateSignature (readSrcSpan fileName sp)
-  ["RenameDefinition", sp, name] -> RenameDefinition (readSrcSpan fileName sp) name
-  ["ExtractBinding", sp, name] -> ExtractBinding (readSrcSpan fileName sp) name
-  
-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)
-
-onlineRefactor :: String -> FilePath -> String -> IO (Either String String)
-onlineRefactor command workingDir moduleStr
-  = do withBinaryFile fileName WriteMode (`hPutStr` moduleStr)
-       modOpts <- runGhc (Just libdir) $ ms_hspp_opts <$> loadModule workingDir moduleName
-       if | xopt Cpp modOpts -> return (Left "The use of C preprocessor is not supported, please turn off Cpp extension")
-          | xopt TemplateHaskell modOpts -> return (Left "The use of Template Haskell is not supported yet, please turn off TemplateHaskell extension")
-          | xopt EmptyCase modOpts -> return (Left "The ranges in the AST are not correct for empty cases, therefore the EmptyCase extension is disabled")
-          | xopt ImplicitParams modOpts -> return (Left "Implicit parameters are erased early on by the compiler, we cannot support them")
-          | otherwise -> do 
-              res <- performRefactor command workingDir moduleName
-              removeFile fileName
-              return res
-  where moduleName = "Test"
-        fileName = workingDir </> (moduleName ++ ".hs")
+-- | Use the given source directories
+useDirs :: [FilePath] -> Ghc ()
+useDirs workingDirs = do
+  dynflags <- getSessionDynFlags
+  setSessionDynFlags dynflags { importPaths = importPaths dynflags ++ workingDirs }
+  return ()
 
-onlineASTView :: FilePath -> String -> IO (Either String String)
-onlineASTView workingDir moduleStr
-  = do withBinaryFile fileName WriteMode (`hPutStr` moduleStr)
-       modOpts <- runGhc (Just libdir) $ ms_hspp_opts <$> loadModule workingDir moduleName
-       if | xopt Cpp modOpts -> return (Left "The use of C preprocessor is not supported, please turn off Cpp extension")
-          | xopt TemplateHaskell modOpts -> return (Left "The use of Template Haskell is not supported yet, please turn off TemplateHaskell extension")
-          | xopt EmptyCase modOpts -> return (Left "The ranges in the AST are not correct for empty cases, therefore the EmptyCase extension is disabled")
-          | xopt ImplicitParams modOpts -> return (Left "Implicit parameters are erased early on by the compiler, we cannot support them")
-          | otherwise -> do 
-              res <- astView workingDir moduleName
-              removeFile fileName
-              return (Right res)
-  where moduleName = "Test"
-        fileName = workingDir </> (moduleName ++ ".hs")
+-- | 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 ()
 
-performRefactor :: String -> String -> String -> IO (Either String String)
-performRefactor command workingDir target = 
-  runGhc (Just libdir) $
-    (mapRight prettyPrint <$> (refact =<< parseTyped =<< loadModule workingDir target))
-  where refact = performCommand (readCommand (workingDir </> (map (\case '.' -> '\\'; c -> c) target ++ ".hs")) command)
+-- | 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"
 
-astView :: String -> String -> IO String
-astView workingDir target = 
-  runGhc (Just libdir) $
-    (astDebug <$> (parseTyped =<< loadModule workingDir target))
+-- | 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 dflags <- getSessionDynFlags
-       -- don't generate any code
-       setSessionDynFlags 
-         $ flip gopt_set Opt_KeepRawTokenStream
-         $ flip gopt_set Opt_NoHsMain
-         $ dflags { importPaths = [workingDir]
-                  , hscTarget = HscInterpreted
-                  , ghcLink = LinkInMemory
-                  , ghcMode = CompManager 
-                  }
+  = do initGhcFlags
+       useDirs [workingDir]
        target <- guessTarget moduleName Nothing
        setTargets [target]
        load LoadAllTargets
        getModSummary $ mkModuleName moduleName
     
-parseTyped :: ModSummary -> Ghc (Ann AST.Module IdDom SrcTemplateStage)
+-- | 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
@@ -172,75 +130,62 @@       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 (ms_mod modSum) (pm_parsed_source p)
+           =<< (do parseTrf <- runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModule modSum (pm_parsed_source p)
                    runTrf (fst annots) (getPragmaComments $ snd annots)
-                     $ trfModuleRename (ms_mod $ modSum) parseTrf
+                     $ trfModuleRename modSum parseTrf
                          (fromJust $ tm_renamed_source tc) 
                          (pm_parsed_source p)))
 
-parseRenamed :: ModSummary -> Ghc (Ann AST.Module (Dom GHC.Name) SrcTemplateStage)
-parseRenamed 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) 
-    <$> (do parseTrf <- runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModule (ms_mod modSum) (pm_parsed_source p)
-            runTrf (fst annots) (getPragmaComments $ snd annots)
-              $ trfModuleRename (ms_mod $ modSum) parseTrf
-                  (fromJust $ tm_renamed_source tc) 
-                  (pm_parsed_source p))
-    
--- | Should be only used for testing
-demoRefactor :: String -> String -> String -> IO ()
-demoRefactor command workingDir moduleName = 
-  runGhc (Just libdir) $ do
-    modSum <- loadModule workingDir moduleName
-    p <- parseModule modSum
-    t <- typecheckModule p
-        
-    let r = tm_renamed_source t
-    let annots = pm_annotations $ tm_parsed_module t
+-- | 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
 
-    -- liftIO $ putStrLn $ show annots
-    liftIO $ putStrLn $ show (pm_parsed_source p)
-    liftIO $ putStrLn "==========="
-    liftIO $ putStrLn $ show (fromJust $ tm_renamed_source t)
-    --liftIO $ putStrLn $ show (typecheckedSource t)
-    liftIO $ putStrLn "=========== parsed:"
-    --transformed <- runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModule (pm_parsed_source p)
-    parseTrf <- runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModule (ms_mod modSum) (pm_parsed_source p)
-    liftIO $ putStrLn $ srcInfoDebug parseTrf
-    liftIO $ putStrLn "=========== typed:"
-    transformed <- addTypeInfos (typecheckedSource t) =<< (runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModuleRename (ms_mod $ modSum) parseTrf (fromJust $ tm_renamed_source t) (pm_parsed_source p))
-    liftIO $ putStrLn $ srcInfoDebug transformed
-    liftIO $ putStrLn "=========== ranges fixed:"
-    let commented = fixRanges $ placeComments (getNormalComments $ snd annots) transformed
-    liftIO $ putStrLn $ srcInfoDebug commented
-    liftIO $ putStrLn "=========== cut up:"
-    let cutUp = cutUpRanges commented
-    liftIO $ putStrLn $ srcInfoDebug cutUp
-    liftIO $ putStrLn $ show $ getLocIndices cutUp
-    liftIO $ putStrLn $ show $ mapLocIndices (fromJust $ ms_hspp_buf $ pm_mod_summary p) (getLocIndices cutUp)
-    liftIO $ putStrLn "=========== sourced:"
-    let sourced = rangeToSource (fromJust $ ms_hspp_buf $ pm_mod_summary p) cutUp
-    liftIO $ putStrLn $ srcInfoDebug sourced
-    liftIO $ putStrLn "=========== pretty printed:"
-    let prettyPrinted = prettyPrint sourced
-    liftIO $ putStrLn prettyPrinted
-    transformed <- performCommand (readCommand (fromJust $ ml_hs_file $ ms_location modSum) command) sourced
-    case transformed of 
-      Right correctlyTransformed -> do
-        liftIO $ putStrLn "=========== transformed AST:"
-        liftIO $ putStrLn $ srcInfoDebug correctlyTransformed
-        liftIO $ putStrLn "=========== transformed & prettyprinted:"
-        let prettyPrinted = prettyPrint correctlyTransformed
-        liftIO $ putStrLn prettyPrinted
-        liftIO $ putStrLn "==========="
-      Left transformProblem -> do
-        liftIO $ putStrLn "==========="
-        liftIO $ putStrLn transformProblem
-        liftIO $ putStrLn "==========="
+-- | 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)
   
-deriving instance Generic SrcSpan
-deriving instance (Generic sema, Generic src) => Generic (NodeInfo sema src)
+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)
+
+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
− Language/Haskell/Tools/Refactor/ASTDebug.hs
@@ -1,223 +0,0 @@-{-# LANGUAGE TypeOperators
-           , DefaultSignatures
-           , StandaloneDeriving
-           , FlexibleContexts
-           , FlexibleInstances
-           , MultiParamTypeClasses
-           , TypeFamilies
-           , TemplateHaskell
-           , OverloadedStrings
-           , ConstraintKinds
-           , LambdaCase
-           , ViewPatterns
-           , ScopedTypeVariables
-           , UndecidableInstances
-           #-}
--- | A module for displaying the AST in a tree view.
-module Language.Haskell.Tools.Refactor.ASTDebug where
-
-import GHC.Generics
-import Control.Reference
-import Control.Applicative
-import Data.Sequence as Seq
-import Data.Foldable
-import Data.Maybe
-import Data.List as List
-import SrcLoc
-import Outputable
-
-import DynFlags as GHC
-import Name as GHC
-import Id as GHC
-import RdrName as GHC
-import Unique as GHC
-
-import Language.Haskell.Tools.AST
-import Language.Haskell.Tools.AST.FromGHC
-import Language.Haskell.Tools.AnnTrf.RangeToRangeTemplate
-import Language.Haskell.Tools.AnnTrf.RangeTemplate
-import Language.Haskell.Tools.AnnTrf.SourceTemplate
-import Language.Haskell.Tools.Refactor.RangeDebug
-
-
-data DebugNode dom = TreeNode { _nodeLabel :: String
-                              , _nodeSubtree :: TreeDebugNode dom
-                              }
-                   | SimpleNode { _nodeLabel :: String
-                                , _nodeValue :: String
-                                }
-
-deriving instance Domain dom => Show (DebugNode dom)
-
-data TreeDebugNode dom
-  = TreeDebugNode { _nodeName :: String
-                  , _nodeInfo :: SemanticInfoType dom
-                  , _children :: [DebugNode dom]
-                  }
-
-deriving instance Domain dom => Show (TreeDebugNode dom)
-
-data SemanticInfoType dom 
-  = DefaultInfoType { semaInfoTypeRng :: SrcSpan 
-                    }
-  | NameInfoType { semaInfoTypeName :: SemanticInfo' dom SameInfoNameCls
-                 , semaInfoTypeRng :: SrcSpan 
-                 }
-  | ExprInfoType { semaInfoTypeExpr :: SemanticInfo' dom SameInfoExprCls
-                 , semaInfoTypeRng :: SrcSpan
-                 }
-  | ImportInfoType { semaInfoTypeImport :: SemanticInfo' dom SameInfoImportCls
-                   , semaInfoTypeRng :: SrcSpan
-                   }
-  | ModuleInfoType { semaInfoTypeModule :: SemanticInfo' dom SameInfoModuleCls
-                   , semaInfoTypeRng :: SrcSpan
-                   }
-
-deriving instance Domain dom => Show (SemanticInfoType dom)
-
-makeReferences ''DebugNode
-makeReferences ''TreeDebugNode
-
-type AssocSema dom = ( AssocData (SemanticInfo' dom SameInfoModuleCls), AssocData (SemanticInfo' dom SameInfoImportCls)
-                     , AssocData (SemanticInfo' dom SameInfoNameCls), AssocData (SemanticInfo' dom SameInfoExprCls) )
-
-astDebug :: (ASTDebug e dom st, AssocSema dom) => e dom st -> String
-astDebug ast = toList (astDebugToJson (astDebug' ast))
-
-astDebugToJson :: AssocSema dom => [DebugNode dom] -> Seq Char
-astDebugToJson nodes = fromList "[ " >< childrenJson >< fromList " ]"
-    where treeNodes = List.filter (\case TreeNode {} -> True; _ -> False) nodes
-          childrenJson = case map debugTreeNode treeNodes of 
-                           first:rest -> first >< foldl (><) Seq.empty (fmap (fromList ", " ><) (fromList rest))
-                           []         -> Seq.empty
-          debugTreeNode (TreeNode "" s) = astDebugElemJson s
-          debugTreeNode (TreeNode (dropWhile (=='_') -> l) s) = astDebugElemJson (nodeName .- (("<span class='astlab'>" ++ l ++ "</span>: ") ++) $ s)
-
-astDebugElemJson :: AssocSema dom => TreeDebugNode dom -> Seq Char
-astDebugElemJson (TreeDebugNode name info children) 
-  = fromList "{ \"text\" : \"" >< fromList name 
-     >< fromList "\", \"state\" : { \"opened\" : true }, \"a_attr\" : { \"data-range\" : \"" 
-     >< fromList (shortShowSpan (semaInfoTypeRng info))
-     >< fromList "\", \"data-elems\" : \"" 
-     >< foldl (><) Seq.empty dataElems
-     >< fromList "\", \"data-sema\" : \"" 
-     >< fromList (showSema info)
-     >< fromList "\" }, \"children\" : " 
-     >< astDebugToJson children >< fromList " }"
-  where dataElems = catMaybes (map (\case SimpleNode l v -> Just (fromList (formatScalarElem l v)); _ -> Nothing) children)
-        formatScalarElem l v = "<div class='scalarelem'><span class='astlab'>" ++ l ++ "</span>: " ++ tail (init (show v)) ++ "</div>"
-        showSema info = "<div class='semaname'>" ++ assocName info ++ "</div>" 
-                          ++ concatMap (\(l,i) -> "<div class='scalarelem'><span class='astlab'>" ++ l ++ "</span>: " ++ i ++ "</div>") (toAssoc info) 
-
-class AssocData a where
-  assocName :: a -> String
-  toAssoc :: a -> [(String, String)]
-
-instance AssocSema dom => AssocData (SemanticInfoType dom) where
-  assocName s@(DefaultInfoType {}) = "NoSemanticInfo"
-  assocName s@(NameInfoType {}) = assocName (semaInfoTypeName s)
-  assocName s@(ExprInfoType {}) = assocName (semaInfoTypeExpr s)
-  assocName s@(ImportInfoType {}) = assocName (semaInfoTypeImport s)
-  assocName s@(ModuleInfoType {}) = assocName (semaInfoTypeModule s)
-
-  toAssoc s@(DefaultInfoType {}) = []
-  toAssoc s@(NameInfoType {}) = toAssoc (semaInfoTypeName s)
-  toAssoc s@(ExprInfoType {}) = toAssoc (semaInfoTypeExpr s)
-  toAssoc s@(ImportInfoType {}) = toAssoc (semaInfoTypeImport s)
-  toAssoc s@(ModuleInfoType {}) = toAssoc (semaInfoTypeModule s)
-
-
-instance AssocData ScopeInfo where
-  assocName (ScopeInfo {}) = "ScopeInfo"
-  toAssoc (ScopeInfo locals) = [ ("namesInScope", inspectScope locals) ]
-
-instance InspectableName n => AssocData (NameInfo n) where
-  assocName (NameInfo {}) = "NameInfo"
-  assocName (AmbiguousNameInfo {}) = "AmbiguousNameInfo"
-  assocName (ImplicitNameInfo {}) = "ImplicitNameInfo"
-
-  toAssoc (NameInfo locals defined nameInfo) = [ ("name", inspect nameInfo)
-                                               , ("isDefined", show defined)
-                                               , ("namesInScope", inspectScope locals) 
-                                               ]
-  toAssoc (AmbiguousNameInfo locals defined name _) = [ ("name", inspect name)
-                                                      , ("isDefined", show defined)
-                                                      , ("namesInScope", inspectScope locals) 
-                                                      ]
-  toAssoc (ImplicitNameInfo locals defined name) = [ ("name", name)
-                                                   , ("isDefined", show defined)
-                                                   , ("namesInScope", inspectScope locals) 
-                                                   ]
-instance AssocData CNameInfo where
-  assocName (CNameInfo {}) = "CNameInfo"
-  toAssoc (CNameInfo locals defined nameInfo) = [ ("name", inspect nameInfo)
-                                                , ("isDefined", show defined)
-                                                , ("namesInScope", inspectScope locals) 
-                                                ]
-
-instance InspectableName n => AssocData (ModuleInfo n) where
-  assocName (ModuleInfo {}) = "ModuleInfo"
-  toAssoc (ModuleInfo mod imps) = [ ("moduleName", showSDocUnsafe (ppr mod))
-                                  , ("implicitImports", concat (intersperse ", " (map inspect imps)))
-                                  ]
-  
-instance InspectableName n => AssocData (ImportInfo n) where
-  assocName (ImportInfo {}) = "ImportInfo"
-  toAssoc (ImportInfo mod avail imported) = [ ("moduleName", showSDocUnsafe (ppr mod)) 
-                                            , ("availableNames", concat (intersperse ", " (map inspect avail))) 
-                                            , ("importedNames", concat (intersperse ", " (map inspect imported))) 
-                                            ]                                            
-
-inspectScope :: InspectableName n => [[n]] -> String
-inspectScope = concat . intersperse " | " . map (concat . intersperse ", " . map inspect)
-
-class InspectableName n where
-  inspect :: n -> String
-
-instance InspectableName GHC.Name where
-  inspect name = showSDocUnsafe (ppr name) ++ "[" ++ show (getUnique name) ++ "]"
-
-instance InspectableName GHC.RdrName where
-  inspect name = showSDocUnsafe (ppr name)
-
-instance InspectableName GHC.Id where
-  inspect name = showSDocUnsafe (ppr name) ++ "[" ++ show (getUnique name) ++ "] :: " ++ showSDocOneLine unsafeGlobalDynFlags (ppr (idType name))
-
-class (Domain dom, SourceInfo st) 
-         => ASTDebug e dom st where
-  astDebug' :: e dom st -> [DebugNode dom]
-  default astDebug' :: (GAstDebug (Rep (e dom st)) dom, Generic (e dom st)) => e dom st -> [DebugNode dom]
-  astDebug' = gAstDebug . from
-
-class GAstDebug f dom where 
-  gAstDebug :: f p -> [DebugNode dom]
-  
-instance GAstDebug V1 dom where
-  gAstDebug _ = error "GAstDebug V1"
-  
-instance GAstDebug U1 dom where
-  gAstDebug U1 = []  
-  
-instance (GAstDebug f dom, GAstDebug g dom) => GAstDebug (f :+: g) dom where
-  gAstDebug (L1 x) = gAstDebug x
-  gAstDebug (R1 x) = gAstDebug x
-  
-instance (GAstDebug f dom, GAstDebug g dom) => GAstDebug (f :*: g) dom where
-  gAstDebug (x :*: y) 
-    = gAstDebug x ++ gAstDebug y
-
-instance {-# OVERLAPPING #-} ASTDebug e dom st => GAstDebug (K1 i (e dom st)) dom where
-  gAstDebug (K1 x) = astDebug' x
-  
-instance {-# OVERLAPPABLE #-} Show x => GAstDebug (K1 i x) dom where
-  gAstDebug (K1 x) = [SimpleNode "" (show x)]
-        
-instance (GAstDebug f dom, Constructor c) => GAstDebug (M1 C c f) dom where
-  gAstDebug c@(M1 x) = [TreeNode "" (TreeDebugNode (conName c) undefined (gAstDebug x))]
-
-instance (GAstDebug f dom, Selector s) => GAstDebug (M1 S s f) dom where
-  gAstDebug s@(M1 x) = traversal&nodeLabel .= selName s $ gAstDebug x
-
--- don't have to do anything with datatype metainfo
-instance GAstDebug f dom => GAstDebug (M1 D t f) dom where
-  gAstDebug (M1 x) = gAstDebug x
− Language/Haskell/Tools/Refactor/ASTDebug/Instances.hs
@@ -1,150 +0,0 @@-{-# LANGUAGE FlexibleContexts
-           , FlexibleInstances
-           , MultiParamTypeClasses
-           , StandaloneDeriving
-           , DeriveGeneric
-           , UndecidableInstances 
-           , TypeFamilies
-           #-}
-module Language.Haskell.Tools.Refactor.ASTDebug.Instances where
-
-import Language.Haskell.Tools.Refactor.ASTDebug
-
-import GHC.Generics
-import Control.Reference
-
-import Language.Haskell.Tools.AST
-
--- Annotations
-instance {-# OVERLAPPING #-} (ASTDebug SimpleName dom st) => ASTDebug (Ann SimpleName) dom st where
-  astDebug' (Ann a e) = traversal&nodeSubtree&nodeInfo .= (NameInfoType (a ^. semanticInfo) (getRange (a ^. sourceInfo))) $ astDebug' e
-
-instance {-# OVERLAPPING #-} (ASTDebug Expr dom st) => ASTDebug (Ann Expr) dom st where
-  astDebug' (Ann a e) = traversal&nodeSubtree&nodeInfo .= (ExprInfoType (a ^. semanticInfo) (getRange (a ^. sourceInfo))) $ astDebug' e
-
-instance {-# OVERLAPPING #-} (ASTDebug ImportDecl dom st) => ASTDebug (Ann ImportDecl) dom st where
-  astDebug' (Ann a e) = traversal&nodeSubtree&nodeInfo .= (ImportInfoType (a ^. semanticInfo) (getRange (a ^. sourceInfo))) $ astDebug' e
-
-instance {-# OVERLAPPING #-} (ASTDebug Module dom st) => ASTDebug (Ann Module) dom st where
-  astDebug' (Ann a e) = traversal&nodeSubtree&nodeInfo .= (ModuleInfoType (a ^. semanticInfo) (getRange (a ^. sourceInfo))) $ astDebug' e
-
-instance {-# OVERLAPPABLE #-} (ASTDebug e dom st) => ASTDebug (Ann e) dom st where
-  astDebug' (Ann a e) = traversal&nodeSubtree&nodeInfo .= DefaultInfoType (getRange (a ^. sourceInfo)) $ astDebug' e
-
-instance (ASTDebug e dom st) => ASTDebug (AnnList e) dom st where
-  astDebug' (AnnList a ls) = [TreeNode "" (TreeDebugNode "*" (DefaultInfoType (getRange (a ^. sourceInfo))) (concatMap astDebug' ls))]
-  
-instance (ASTDebug e dom st) => ASTDebug (AnnMaybe e) dom st where
-  astDebug' (AnnMaybe a e) = [TreeNode "" (TreeDebugNode "?" (DefaultInfoType (getRange (a ^. sourceInfo))) (maybe [] astDebug' e))]
-
--- Modules
-instance (Domain dom, SourceInfo st) => ASTDebug Module dom st
-instance (Domain dom, SourceInfo st) => ASTDebug ModuleHead dom st
-instance (Domain dom, SourceInfo st) => ASTDebug ExportSpecList dom st
-instance (Domain dom, SourceInfo st) => ASTDebug ExportSpec dom st
-instance (Domain dom, SourceInfo st) => ASTDebug IESpec dom st
-instance (Domain dom, SourceInfo st) => ASTDebug SubSpec dom st
-instance (Domain dom, SourceInfo st) => ASTDebug ModulePragma dom st
-instance (Domain dom, SourceInfo st) => ASTDebug FilePragma dom st
-instance (Domain dom, SourceInfo st) => ASTDebug ImportDecl dom st
-instance (Domain dom, SourceInfo st) => ASTDebug ImportSpec dom st
-instance (Domain dom, SourceInfo st) => ASTDebug ImportQualified dom st
-instance (Domain dom, SourceInfo st) => ASTDebug ImportSource dom st
-instance (Domain dom, SourceInfo st) => ASTDebug ImportSafe dom st
-instance (Domain dom, SourceInfo st) => ASTDebug TypeNamespace dom st
-instance (Domain dom, SourceInfo st) => ASTDebug ImportRenaming dom st
-
--- Declarations
-instance (Domain dom, SourceInfo st) => ASTDebug Decl dom st
-instance (Domain dom, SourceInfo st) => ASTDebug ClassBody dom st
-instance (Domain dom, SourceInfo st) => ASTDebug ClassElement dom st
-instance (Domain dom, SourceInfo st) => ASTDebug DeclHead dom st
-instance (Domain dom, SourceInfo st) => ASTDebug InstBody dom st
-instance (Domain dom, SourceInfo st) => ASTDebug InstBodyDecl dom st
-instance (Domain dom, SourceInfo st) => ASTDebug GadtConDecl dom st
-instance (Domain dom, SourceInfo st) => ASTDebug GadtConType dom st
-instance (Domain dom, SourceInfo st) => ASTDebug GadtField dom st
-instance (Domain dom, SourceInfo st) => ASTDebug FunDeps dom st
-instance (Domain dom, SourceInfo st) => ASTDebug FunDep dom st
-instance (Domain dom, SourceInfo st) => ASTDebug ConDecl dom st
-instance (Domain dom, SourceInfo st) => ASTDebug FieldDecl dom st
-instance (Domain dom, SourceInfo st) => ASTDebug Deriving dom st
-instance (Domain dom, SourceInfo st) => ASTDebug InstanceRule dom st
-instance (Domain dom, SourceInfo st) => ASTDebug InstanceHead dom st
-instance (Domain dom, SourceInfo st) => ASTDebug TypeEqn dom st
-instance (Domain dom, SourceInfo st) => ASTDebug KindConstraint dom st
-instance (Domain dom, SourceInfo st) => ASTDebug TyVar dom st
-instance (Domain dom, SourceInfo st) => ASTDebug Type dom st
-instance (Domain dom, SourceInfo st) => ASTDebug Kind dom st
-instance (Domain dom, SourceInfo st) => ASTDebug Context dom st
-instance (Domain dom, SourceInfo st) => ASTDebug Assertion dom st
-instance (Domain dom, SourceInfo st) => ASTDebug Expr dom st
-instance (Domain dom, SourceInfo st) => ASTDebug (Stmt' Expr) dom st
-instance (Domain dom, SourceInfo st) => ASTDebug (Stmt' Cmd) dom st
-instance (Domain dom, SourceInfo st) => ASTDebug CompStmt dom st
-instance (Domain dom, SourceInfo st) => ASTDebug ValueBind dom st
-instance (Domain dom, SourceInfo st) => ASTDebug Pattern dom st
-instance (Domain dom, SourceInfo st) => ASTDebug PatternField dom st
-instance (Domain dom, SourceInfo st) => ASTDebug Splice dom st
-instance (Domain dom, SourceInfo st) => ASTDebug QQString dom st
-instance (Domain dom, SourceInfo st) => ASTDebug Match dom st
-instance (Domain dom, SourceInfo st, ASTDebug expr dom st, Generic (expr dom st)) => ASTDebug (Alt' expr) dom st
-instance (Domain dom, SourceInfo st) => ASTDebug Rhs dom st
-instance (Domain dom, SourceInfo st) => ASTDebug GuardedRhs dom st
-instance (Domain dom, SourceInfo st) => ASTDebug FieldUpdate dom st
-instance (Domain dom, SourceInfo st) => ASTDebug Bracket dom st
-instance (Domain dom, SourceInfo st) => ASTDebug TopLevelPragma dom st
-instance (Domain dom, SourceInfo st) => ASTDebug Rule dom st
-instance (Domain dom, SourceInfo st) => ASTDebug AnnotationSubject dom st
-instance (Domain dom, SourceInfo st) => ASTDebug MinimalFormula dom st
-instance (Domain dom, SourceInfo st) => ASTDebug ExprPragma dom st
-instance (Domain dom, SourceInfo st) => ASTDebug SourceRange dom st
-instance (Domain dom, SourceInfo st) => ASTDebug Number dom st
-instance (Domain dom, SourceInfo st) => ASTDebug QuasiQuote dom st
-instance (Domain dom, SourceInfo st) => ASTDebug RhsGuard dom st
-instance (Domain dom, SourceInfo st) => ASTDebug LocalBind dom st
-instance (Domain dom, SourceInfo st) => ASTDebug LocalBinds dom st
-instance (Domain dom, SourceInfo st) => ASTDebug FixitySignature dom st
-instance (Domain dom, SourceInfo st) => ASTDebug TypeSignature dom st
-instance (Domain dom, SourceInfo st) => ASTDebug ListCompBody dom st
-instance (Domain dom, SourceInfo st) => ASTDebug TupSecElem dom st
-instance (Domain dom, SourceInfo st) => ASTDebug TypeFamily dom st
-instance (Domain dom, SourceInfo st) => ASTDebug TypeFamilySpec dom st
-instance (Domain dom, SourceInfo st) => ASTDebug InjectivityAnn dom st
-instance (Domain dom, SourceInfo st, ASTDebug expr dom st, Generic (expr dom st)) => ASTDebug (CaseRhs' expr) dom st
-instance (Domain dom, SourceInfo st, ASTDebug expr dom st, Generic (expr dom st)) => ASTDebug (GuardedCaseRhs' expr) dom st
-instance (Domain dom, SourceInfo st) => ASTDebug PatternSynonym dom st
-instance (Domain dom, SourceInfo st) => ASTDebug PatSynRhs dom st
-instance (Domain dom, SourceInfo st) => ASTDebug PatSynLhs dom st
-instance (Domain dom, SourceInfo st) => ASTDebug PatSynWhere dom st
-instance (Domain dom, SourceInfo st) => ASTDebug PatternTypeSignature dom st
-instance (Domain dom, SourceInfo st) => ASTDebug Role dom st
-instance (Domain dom, SourceInfo st) => ASTDebug Cmd dom st
-instance (Domain dom, SourceInfo st) => ASTDebug LanguageExtension dom st
-instance (Domain dom, SourceInfo st) => ASTDebug MatchLhs dom st
-
--- Literal
-instance (Domain dom, SourceInfo st) => ASTDebug Literal dom st
-instance (Domain dom, SourceInfo st, ASTDebug k dom st, Generic (k dom st)) => ASTDebug (Promoted k) dom st
-
--- Base
-instance (Domain dom, SourceInfo st) => ASTDebug Operator dom st
-instance (Domain dom, SourceInfo st) => ASTDebug Name dom st
-instance (Domain dom, SourceInfo st) => ASTDebug SimpleName dom st
-instance (Domain dom, SourceInfo st) => ASTDebug ModuleName dom st
-instance (Domain dom, SourceInfo st) => ASTDebug UnqualName dom st
-instance (Domain dom, SourceInfo st) => ASTDebug StringNode dom st
-instance (Domain dom, SourceInfo st) => ASTDebug DataOrNewtypeKeyword dom st
-instance (Domain dom, SourceInfo st) => ASTDebug DoKind dom st
-instance (Domain dom, SourceInfo st) => ASTDebug TypeKeyword dom st
-instance (Domain dom, SourceInfo st) => ASTDebug OverlapPragma dom st
-instance (Domain dom, SourceInfo st) => ASTDebug CallConv dom st
-instance (Domain dom, SourceInfo st) => ASTDebug ArrowAppl dom st
-instance (Domain dom, SourceInfo st) => ASTDebug Safety dom st
-instance (Domain dom, SourceInfo st) => ASTDebug ConlikeAnnot dom st
-instance (Domain dom, SourceInfo st) => ASTDebug Assoc dom st
-instance (Domain dom, SourceInfo st) => ASTDebug Precedence dom st
-instance (Domain dom, SourceInfo st) => ASTDebug LineNumber dom st
-instance (Domain dom, SourceInfo st) => ASTDebug PhaseControl dom st
-instance (Domain dom, SourceInfo st) => ASTDebug PhaseNumber dom st
-instance (Domain dom, SourceInfo st) => ASTDebug PhaseInvert dom st
+ Language/Haskell/Tools/Refactor/DataToNewtype.hs view
@@ -0,0 +1,20 @@+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/DebugGhcAST.hs
@@ -1,368 +0,0 @@-{-# LANGUAGE StandaloneDeriving
-           , TypeSynonymInstances 
-           , FlexibleInstances 
-           #-}
--- | A module for showing GHC's syntax tree representation.
-module Language.Haskell.Tools.Refactor.DebugGhcAST where
-
-import Language.Haskell.Tools.Refactor.RangeDebug
-import Language.Haskell.Tools.AST.FromGHC.GHCUtils
-import Language.Haskell.Tools.AST (shortShowSpan)
-
-import GHC
-import HsSyn
-import HsDecls
-import Module
-import Coercion
-import SrcLoc
-import RdrName
-import BasicTypes
-import Outputable
-import TyCon
-import PlaceHolder
-import ForeignCall
-import Var
-import ConLike
-import PatSyn
-import TcEvidence
-import Bag
-import BooleanFormula
-import FieldLabel
-import CoreSyn
-import UniqFM
-import OccName
-
-instance Show a => Show (Located a) where
-  show (L l a) = "L(" ++ shortShowSpan l ++ ") (" ++ show a ++ ")"
-
-deriving instance Show (ABExport RdrName)
-deriving instance Show (AmbiguousFieldOcc RdrName)
-deriving instance Show (AnnDecl RdrName)
-deriving instance Show (AnnProvenance RdrName)
-deriving instance Show (ApplicativeArg RdrName RdrName)
-deriving instance Show (ArithSeqInfo RdrName)
-deriving instance Show (BooleanFormula (Located RdrName))
-deriving instance Show (ClsInstDecl RdrName)
-deriving instance Show (ConDecl RdrName)
-deriving instance Show (ConDeclField RdrName)
-deriving instance Show (DataFamInstDecl RdrName)
-deriving instance Show (DefaultDecl RdrName)
-deriving instance Show (DerivDecl RdrName)
-deriving instance Show (FamilyDecl RdrName)
-deriving instance Show (FamilyInfo RdrName)
-deriving instance Show (FamilyResultSig RdrName)
-deriving instance Show (FieldLbl RdrName)
-deriving instance Show (FieldOcc RdrName)
-deriving instance Show (FixitySig RdrName)
-deriving instance Show (ForeignDecl RdrName)
-deriving instance Show a => Show (GRHS RdrName a)
-deriving instance Show a => Show (GRHSs RdrName a)
-deriving instance Show (InjectivityAnn RdrName)
-deriving instance Show (HsAppType RdrName)
-deriving instance Show (HsBindLR RdrName RdrName)
-deriving instance Show (HsBracket RdrName)
-deriving instance Show (HsCmd RdrName)
-deriving instance Show (HsCmdTop RdrName)
-deriving instance Show (HsConDeclDetails RdrName)
-deriving instance Show (HsConPatDetails RdrName)
-deriving instance Show (HsDataDefn RdrName)
-deriving instance Show (HsDecl RdrName)
-deriving instance Show (HsExpr RdrName)
-deriving instance Show (HsGroup RdrName)
-deriving instance Show (HsLocalBindsLR RdrName RdrName)
-deriving instance Show (HsMatchContext RdrName)
-deriving instance Show (HsModule RdrName)
-deriving instance Show (HsOverLit RdrName)
-deriving instance Show (HsPatSynDetails (Located RdrName))
-deriving instance Show (HsPatSynDir RdrName)
-deriving instance Show (HsRecFields RdrName (LPat RdrName))
-deriving instance Show (HsRecordBinds RdrName)
-deriving instance Show (HsSplice RdrName)
-deriving instance Show (HsStmtContext RdrName)
-deriving instance Show (HsTupArg RdrName)
-deriving instance Show (HsTyVarBndr RdrName)
-deriving instance Show (HsType RdrName)
-deriving instance Show (HsValBindsLR RdrName RdrName)
-deriving instance Show (HsWildCardInfo RdrName)
-deriving instance Show (IE RdrName)
-deriving instance Show (ImportDecl RdrName)
-deriving instance Show (InstDecl RdrName)
-deriving instance Show (LHsQTyVars RdrName)
-deriving instance Show a => Show (Match RdrName a)
-deriving instance Show (MatchFixity RdrName)
-deriving instance Show a => Show (MatchGroup RdrName a)
-deriving instance Show (ParStmtBlock RdrName RdrName)
-deriving instance Show (Pat RdrName)
-deriving instance Show (PatSynBind RdrName RdrName)
-deriving instance Show (RecordPatSynField (Located RdrName))
-deriving instance Show (RoleAnnotDecl RdrName)
-deriving instance Show (RuleBndr RdrName)
-deriving instance Show (RuleDecl RdrName)
-deriving instance Show (RuleDecls RdrName)
-deriving instance Show (Sig RdrName)
-deriving instance Show (SpliceDecl RdrName)
-deriving instance Show (SyntaxExpr RdrName)
-deriving instance Show a => Show (StmtLR RdrName RdrName a)
-deriving instance Show (TyClDecl RdrName)
-deriving instance Show (TyClGroup RdrName)
-deriving instance Show a => Show (TyFamEqn RdrName a)
-deriving instance Show (TyFamInstDecl RdrName)
-deriving instance Show (VectDecl RdrName)
-deriving instance Show (WarnDecl RdrName)
-deriving instance Show (WarnDecls RdrName)
-
-
-deriving instance Show (ABExport Name)
-deriving instance Show (AmbiguousFieldOcc Name)
-deriving instance Show (AnnDecl Name)
-deriving instance Show (AnnProvenance Name)
-deriving instance Show (ApplicativeArg Name Name)
-deriving instance Show (ArithSeqInfo Name)
-deriving instance Show (BooleanFormula (Located Name))
-deriving instance Show (ClsInstDecl Name)
-deriving instance Show (ConDecl Name)
-deriving instance Show (ConDeclField Name)
-deriving instance Show (DataFamInstDecl Name)
-deriving instance Show (DefaultDecl Name)
-deriving instance Show (DerivDecl Name)
-deriving instance Show (FamilyDecl Name)
-deriving instance Show (FamilyInfo Name)
-deriving instance Show (FamilyResultSig Name)
-deriving instance Show (FieldLbl Name)
-deriving instance Show (FieldOcc Name)
-deriving instance Show (FixitySig Name)
-deriving instance Show (ForeignDecl Name)
-deriving instance Show a => Show (GRHS Name a)
-deriving instance Show a => Show (GRHSs Name a)
-deriving instance Show (InjectivityAnn Name)
-deriving instance Show (HsAppType Name)
-deriving instance Show (HsBindLR Name Name)
-deriving instance Show (HsBracket Name)
-deriving instance Show (HsCmd Name)
-deriving instance Show (HsCmdTop Name)
-deriving instance Show (HsConDeclDetails Name)
-deriving instance Show (HsConPatDetails Name)
-deriving instance Show (HsDataDefn Name)
-deriving instance Show (HsDecl Name)
-deriving instance Show (HsExpr Name)
-deriving instance Show (HsGroup Name)
-deriving instance Show (HsLocalBindsLR Name Name)
-deriving instance Show (HsMatchContext Name)
-deriving instance Show (HsModule Name)
-deriving instance Show (HsOverLit Name)
-deriving instance Show (HsPatSynDetails (Located Name))
-deriving instance Show (HsPatSynDir Name)
-deriving instance Show (HsRecFields Name (LPat Name))
-deriving instance Show (HsRecordBinds Name)
-deriving instance Show (HsSplice Name)
-deriving instance Show (HsStmtContext Name)
-deriving instance Show (HsTupArg Name)
-deriving instance Show (HsTyVarBndr Name)
-deriving instance Show (HsType Name)
-deriving instance Show (HsValBindsLR Name Name)
-deriving instance Show (HsWildCardInfo Name)
-deriving instance Show (IE Name)
-deriving instance Show (ImportDecl Name)
-deriving instance Show (InstDecl Name)
-deriving instance Show (LHsQTyVars Name)
-deriving instance Show a => Show (Match Name a)
-deriving instance Show (MatchFixity Name)
-deriving instance Show a => Show (MatchGroup Name a)
-deriving instance Show (ParStmtBlock Name Name)
-deriving instance Show (Pat Name)
-deriving instance Show (PatSynBind Name Name)
-deriving instance Show (RecordPatSynField (Located Name))
-deriving instance Show (RoleAnnotDecl Name)
-deriving instance Show (RuleBndr Name)
-deriving instance Show (RuleDecl Name)
-deriving instance Show (RuleDecls Name)
-deriving instance Show (Sig Name)
-deriving instance Show (SpliceDecl Name)
-deriving instance Show (SyntaxExpr Name)
-deriving instance Show a => Show (StmtLR Name Name a)
-deriving instance Show (TyClDecl Name)
-deriving instance Show (TyClGroup Name)
-deriving instance Show a => Show (TyFamEqn Name a)
-deriving instance Show (TyFamInstDecl Name)
-deriving instance Show (VectDecl Name)
-deriving instance Show (WarnDecl Name)
-deriving instance Show (WarnDecls Name)
-
-
-deriving instance Show (ABExport Id)
-deriving instance Show (AmbiguousFieldOcc Id)
-deriving instance Show (AnnDecl Id)
-deriving instance Show (AnnProvenance Id)
-deriving instance Show (ApplicativeArg Id Id)
-deriving instance Show (ArithSeqInfo Id)
-deriving instance Show (BooleanFormula (Located Id))
-deriving instance Show (ClsInstDecl Id)
-deriving instance Show (ConDecl Id)
-deriving instance Show (ConDeclField Id)
-deriving instance Show (DataFamInstDecl Id)
-deriving instance Show (DefaultDecl Id)
-deriving instance Show (DerivDecl Id)
-deriving instance Show (FamilyDecl Id)
-deriving instance Show (FamilyInfo Id)
-deriving instance Show (FamilyResultSig Id)
-deriving instance Show (FieldLbl Id)
-deriving instance Show (FieldOcc Id)
-deriving instance Show (FixitySig Id)
-deriving instance Show (ForeignDecl Id)
-deriving instance Show a => Show (GRHS Id a)
-deriving instance Show a => Show (GRHSs Id a)
-deriving instance Show (InjectivityAnn Id)
-deriving instance Show (HsAppType Id)
-deriving instance Show (HsBindLR Id Id)
-deriving instance Show (HsBracket Id)
-deriving instance Show (HsCmd Id)
-deriving instance Show (HsCmdTop Id)
-deriving instance Show (HsConDeclDetails Id)
-deriving instance Show (HsConPatDetails Id)
-deriving instance Show (HsDataDefn Id)
-deriving instance Show (HsDecl Id)
-deriving instance Show (HsExpr Id)
-deriving instance Show (HsGroup Id)
-deriving instance Show (HsLocalBindsLR Id Id)
-deriving instance Show (HsMatchContext Id)
-deriving instance Show (HsModule Id)
-deriving instance Show (HsOverLit Id)
-deriving instance Show (HsPatSynDetails (Located Id))
-deriving instance Show (HsPatSynDir Id)
-deriving instance Show (HsRecFields Id (LPat Id))
-deriving instance Show (HsRecordBinds Id)
-deriving instance Show (HsSplice Id)
-deriving instance Show (HsStmtContext Id)
-deriving instance Show (HsTupArg Id)
-deriving instance Show (HsTyVarBndr Id)
-deriving instance Show (HsType Id)
-deriving instance Show (HsValBindsLR Id Id)
-deriving instance Show (HsWildCardInfo Id)
-deriving instance Show (IE Id)
-deriving instance Show (ImportDecl Id)
-deriving instance Show (InstDecl Id)
-deriving instance Show (LHsQTyVars Id)
-deriving instance Show a => Show (Match Id a)
-deriving instance Show (MatchFixity Id)
-deriving instance Show a => Show (MatchGroup Id a)
-deriving instance Show (ParStmtBlock Id Id)
-deriving instance Show (Pat Id)
-deriving instance Show (PatSynBind Id Id)
-deriving instance Show (RecordPatSynField (Located Id))
-deriving instance Show (RoleAnnotDecl Id)
-deriving instance Show (RuleBndr Id)
-deriving instance Show (RuleDecl Id)
-deriving instance Show (RuleDecls Id)
-deriving instance Show (Sig Id)
-deriving instance Show (SpliceDecl Id)
-deriving instance Show (SyntaxExpr Id)
-deriving instance Show a => Show (StmtLR Id Id a)
-deriving instance Show (TyClDecl Id)
-deriving instance Show (TyClGroup Id)
-deriving instance Show a => Show (TyFamEqn Id a)
-deriving instance Show (TyFamInstDecl Id)
-deriving instance Show (VectDecl Id)
-deriving instance Show (WarnDecl Id)
-deriving instance Show (WarnDecls Id)
-
-deriving instance Show Activation
-deriving instance Show HsArrAppType
-deriving instance Show Boxity
-deriving instance Show CType
-deriving instance Show CImportSpec
-deriving instance Show CExportSpec
-deriving instance Show CCallConv
-deriving instance Show CCallTarget
-deriving instance Show ConLike
-deriving instance Show DocDecl
-deriving instance Show Fixity
-deriving instance Show FixityDirection
-deriving instance Show ForeignImport
-deriving instance Show ForeignExport
-deriving instance Show Header
-deriving instance Show HsIPName
-deriving instance Show HsLit
-deriving instance Show HsTupleSort
-deriving instance Show HsSrcBang
-deriving instance Show InlinePragma
-deriving instance Show NewOrData
-deriving instance Show Origin
-deriving instance Show OverLitVal
-deriving instance Show OverlapMode
-deriving instance Show PlaceHolder
-deriving instance Show Role
-deriving instance Show RecFlag
-deriving instance Show SpliceExplicitFlag
-deriving instance Show TcSpecPrag
-deriving instance Show TcSpecPrags
-deriving instance Show TransForm
-deriving instance Show WarningTxt
-deriving instance Show PendingRnSplice
-deriving instance Show PendingTcSplice
-
-instance Show UnboundVar where
-  show (OutOfScope n _) = "OutOfScope " ++ show n
-  show (TrueExprHole n) = "TrueExprHole " ++ show n
-
-
-
-instance Show ModuleName where
-  show = showSDocUnsafe . ppr
-instance Show TyCon where
-  show = showSDocUnsafe . ppr
-instance Show ClsInst where
-  show = showSDocUnsafe . ppr
-instance Show Type where
-  show = showSDocUnsafe . ppr
-instance Show OccName where
-  show = showSDocUnsafe . ppr
--- instance Show RdrName where
-  -- show = showSDocUnsafe . ppr
-  
-deriving instance Show RdrName
-deriving instance Show Module
-deriving instance Show StringLiteral
-deriving instance Show UntypedSpliceFlavour
-deriving instance Show SrcUnpackedness
-deriving instance Show SrcStrictness
-deriving instance Show IEWildcard
-
-deriving instance Show t => Show (HsImplicitBndrs RdrName t)
-deriving instance Show t => Show (HsImplicitBndrs Name t)
-deriving instance Show t => Show (HsImplicitBndrs Id t)
-deriving instance Show t => Show (HsWildCardBndrs RdrName t)
-deriving instance Show t => Show (HsWildCardBndrs Name t)
-deriving instance Show t => Show (HsWildCardBndrs Id t)
-deriving instance (Show a, Show b) => Show (HsRecField' a b)
-
-
-instance Show UnitId where
-  show = showSDocUnsafe . ppr
-instance Show Name where
-  show = showSDocUnsafe . ppr
-instance Show HsTyLit where
-  show = showSDocUnsafe . ppr
-instance Show Var where
-  show = showSDocUnsafe . ppr
-instance Show DataCon where
-  show = showSDocUnsafe . ppr
-instance Show PatSyn where
-  show = showSDocUnsafe . ppr
-instance Show TcEvBinds where
-  show = showSDocUnsafe . ppr
-instance Show HsWrapper where
-  show = showSDocUnsafe . ppr
-instance Show Class where
-  show = showSDocUnsafe . ppr
-instance Show TcCoercion where
-  show = showSDocUnsafe . ppr
-instance Outputable a => Show (UniqFM a) where
-  show = showSDocUnsafe . ppr
-instance Outputable a => Show (Tickish a) where
-  show = showSDocUnsafe . ppr
-instance OutputableBndr a => Show (HsIPBinds a) where
-  show = showSDocUnsafe . ppr
-  
-instance Show a => Show (Bag a) where
-  show = show . bagToList
-
+ Language/Haskell/Tools/Refactor/DollarApp.hs view
@@ -0,0 +1,54 @@+{-# 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 view
@@ -31,19 +31,18 @@ type Ann' e dom = Ann e dom SrcTemplateStage 
 type AnnMaybe' e dom = AnnMaybe e dom SrcTemplateStage 
 
-type ExtractBindingDomain dom = ( Domain dom, HasNameInfo (SemanticInfo' dom SameInfoNameCls), HasDefiningInfo (SemanticInfo' dom SameInfoNameCls)
-                                , HasScopeInfo (SemanticInfo' dom SameInfoExprCls) )
+type ExtractBindingDomain dom = ( Domain dom, HasNameInfo dom, HasDefiningInfo dom, HasScopeInfo dom )
 
-extractBinding' :: ExtractBindingDomain dom => RealSrcSpan -> String -> Ann' Module dom -> RefactoredModule 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 -> Ann' Module dom -> RefactoredModule dom
+                   -> String -> LocalRefactoring dom
 extractBinding selectDecl selectExpr name mod
-  = let conflicting = any (isConflicting name) (mod ^? selectDecl & biplateRef :: [Ann' SimpleName dom])
+  = 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)
@@ -53,13 +52,13 @@                    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' SimpleName dom -> Bool
+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)) (Refactor dom) (Ann' Expr dom)
+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 
@@ -108,7 +107,7 @@ isParenLikeExpr (QuasiQuoteExpr {}) = True
 isParenLikeExpr _ = False
 
-doExtract :: ExtractBindingDomain dom => String -> Ann' Expr dom -> Ann' Expr dom -> StateT (Maybe (Ann' ValueBind dom)) (Refactor dom) (Ann' Expr dom)
+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)))
Language/Haskell/Tools/Refactor/GenerateExports.hs view
@@ -16,10 +16,10 @@ import Language.Haskell.Tools.AST.Gen
 import Language.Haskell.Tools.Refactor.RefactorBase
 
-type DomGenerateExports dom = (Domain dom, HasNameInfo (SemanticInfo' dom SameInfoNameCls))
+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 => Ann Module dom SrcTemplateStage -> RefactoredModule dom
+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 
Language/Haskell/Tools/Refactor/GenerateTypeSignature.hs view
@@ -31,10 +31,9 @@ 
 type Ann' e dom = Ann e dom SrcTemplateStage
 type AnnList' e dom = AnnList e dom SrcTemplateStage
-type GenerateSignatureDomain dom = ( Domain dom, HasIdInfo (SemanticInfo' dom SameInfoNameCls), Eq (SemanticInfo' dom SameInfoNameCls)
-                                   , SemanticInfo' dom SameInfoImportCls ~ ImportInfo Id ) 
+type GenerateSignatureDomain dom = ( HasModuleInfo dom, HasIdInfo dom, HasImportInfo dom ) 
 
-generateTypeSignature' :: GenerateSignatureDomain dom => RealSrcSpan -> Ann' Module dom -> RefactoredModule 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
@@ -45,14 +44,14 @@                            -> (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
-                           -> Ann' Module dom -> RefactoredModule dom
+                           -> 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 (Refactor dom) (AnnList' d dom)
+                -> AnnList' d dom -> StateT Bool (LocalRefactor dom) (AnnList' d dom)
 genTypeSig vbAccess ls 
   | Just vb <- vbAccess ls 
   , not (typeSignatureAlreadyExist ls vb)
@@ -70,11 +69,11 @@   | otherwise = return ls
 
 
-generateTSFor :: GenerateSignatureDomain dom => GHC.Name -> GHC.Type -> Refactor dom (Ann' TypeSignature dom)
+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 -> Refactor dom (Ann' AST.Type dom) 
+generateTypeFor :: GenerateSignatureDomain dom => Int -> GHC.Type -> LocalRefactor dom (Ann' AST.Type dom) 
 generateTypeFor prec t 
   -- context
   | (break (not . isPredTy) -> (preds, other), rt) <- splitFunTys t
@@ -89,7 +88,7 @@   | (op, [at,rt]) <- splitAppTys t
   , Just tc <- tyConAppTyCon_maybe op
   , isSymOcc (getOccName (getName tc))
-  = wrapParen 0 <$> (mkTyInfix <$> generateTypeFor 10 at <*> referenceOperator (getTCId tc) <*> generateTypeFor 10 rt)
+  = wrapParen 0 <$> (mkTyInfix <$> generateTypeFor 10 at <*> referenceOperator (idName $ getTCId tc) <*> generateTypeFor 10 rt)
   -- tuple types
   | Just (tc, tas) <- splitTyConApp_maybe t
   , isTupleTyCon tc
@@ -109,13 +108,13 @@   = wrapParen 10 <$> (mkTyApp <$> generateTypeFor 10 tf <*> generateTypeFor 11 ta)
   -- type constructor
   | Just tc <- tyConAppTyCon_maybe t
-  = mkTyVar <$> referenceName (getTCId tc)
+  = mkTyVar <$> referenceName (idName $ getTCId tc)
   -- type variable
   | Just tv <- getTyVar_maybe t
-  = mkTyVar <$> referenceName tv
+  = mkTyVar <$> referenceName (idName tv)
   -- forall type
   | (tvs@(_:_), t') <- splitForAllTys t
-  = wrapParen (-1) <$> (mkTyForall (mkTypeVarList (map getName tvs)) <$> generateTypeFor 0 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
@@ -123,19 +122,19 @@         getTCId :: GHC.TyCon -> GHC.Id
         getTCId tc = GHC.mkVanillaGlobal (GHC.tyConName tc) (tyConKind tc)
 
-        generateAssertionFor :: GenerateSignatureDomain dom => GHC.Type -> Refactor dom (Ann' AST.Assertion dom)
+        generateAssertionFor :: GenerateSignatureDomain dom => GHC.Type -> LocalRefactor dom (Ann' AST.Assertion dom)
         generateAssertionFor t 
           | Just (tc, types) <- splitTyConApp_maybe t
-          = mkClassAssert <$> referenceName (getTCId tc) <*> mapM (generateTypeFor 0) types
+          = 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` catMaybes (map semanticsId $ concatMap (^? bindName) (filter isTypeSig $ ls ^? annList&element))
+  getBindingName vb `elem` (map semanticsId $ concatMap (^? bindName) (filter isTypeSig $ ls ^? annList&element))
   
 getBindingName :: GenerateSignatureDomain dom => Ann' ValueBind dom -> GHC.Id
-getBindingName vb = case catMaybes $ map semanticsId $ nub $ vb ^? bindingName of 
+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
@@ -0,0 +1,40 @@+module Language.Haskell.Tools.Refactor.GetModules where
+
+import Data.List (intersperse, find)
+import Distribution.Verbosity (silent)
+import Distribution.ModuleName (components)
+import Distribution.PackageDescription
+import Distribution.PackageDescription.Configuration
+import Distribution.PackageDescription.Parse
+import System.FilePath.Posix
+import System.Directory
+
+-- | 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 root
+  = do files <- listDirectory root
+       case find (\p -> takeExtension p == ".cabal") files of
+          Just cabalFile -> modulesFromCabalFile (root </> cabalFile)
+          Nothing        -> modulesFromDirectory root root
+
+
+modulesFromCabalFile :: FilePath -> IO [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) 
+
+modulesFromDirectory :: FilePath -> FilePath -> IO [String]
+-- now recognizing only .hs files
+modulesFromDirectory root searchRoot = concat <$> (mapM goOn =<< listDirectory searchRoot)
+  where goOn fp = let path = searchRoot </> fp 
+                   in do isDir <- doesDirectoryExist path  
+                         if isDir
+                           then modulesFromDirectory root path 
+                           else if takeExtension path == ".hs" 
+                                  then return [concat $ intersperse "." $ splitDirectories $ dropExtension $ makeRelative root path] 
+                                  else return []
+ Language/Haskell/Tools/Refactor/IfToGuards.hs view
@@ -0,0 +1,34 @@+{-# 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/OrganizeImports.hs view
@@ -29,56 +29,54 @@ import Language.Haskell.Tools.AnnTrf.SourceTemplate
 import Language.Haskell.Tools.AnnTrf.SourceTemplateHelpers
 import Language.Haskell.Tools.PrettyPrint
-import Language.Haskell.Tools.Refactor.DebugGhcAST
 import Language.Haskell.Tools.AST.Gen
 import Language.Haskell.Tools.Refactor.RefactorBase
 import Debug.Trace
 
-type OrganizeImportsDomain dom n = (Domain dom, HasNameInfo (SemanticInfo' dom SameInfoNameCls), SemanticInfo' dom SameInfoImportCls ~ ImportInfo n, NamedThing n)
+type OrganizeImportsDomain dom = ( Domain dom, HasNameInfo dom, HasImportInfo dom )
 
-organizeImports :: forall n dom . OrganizeImportsDomain dom n 
-                => Ann Module dom SrcTemplateStage -> RefactoredModule 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 SimpleName dom SrcTemplateStage])
+                                $ (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 n dom . OrganizeImportsDomain dom n 
-              => [GHC.Name] -> [Ann ImportDecl dom SrcTemplateStage] -> Refactor dom [Ann ImportDecl dom SrcTemplateStage]
+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 -> Refactor dom [Ann ImportDecl dom SrcTemplateStage]
+  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 (^. semantics) all) one 
+                 Nothing -> delete one all) <$> narrowImport names (map (semanticsImportedModule . (^. semantics)) all) one 
         
-narrowImport :: OrganizeImportsDomain dom n
-             => [GHC.Name] -> [ImportInfo n] -> Ann ImportDecl dom SrcTemplateStage 
-                           -> Refactor dom (Maybe (Ann ImportDecl dom SrcTemplateStage))
+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 (otherModules ^? traversal&importedModule&filtered (== importedMod) :: [GHC.Module]) > 1 
+      then if length (filter (== importedMod) otherModules) > 1 
               then pure Nothing
               else Just <$> (element&importSpec !- replaceWithJust (mkImportSpecList []) $ imp)
       else pure (Just imp)
-  where actuallyImported = map getName (fromJust (imp ^? annotation&semanticInfo&importedNames)) `intersect` usedNames
-        Just importedMod = imp ^? annotation&semanticInfo&importedModule
+  where actuallyImported = semanticsImported (imp ^. semantics) `intersect` usedNames
+        importedMod = semanticsImportedModule $ imp ^. semantics
     
 -- | Narrows the import specification (explicitely imported elements)
-narrowImportSpecs :: forall dom n . OrganizeImportsDomain dom n
-                  => [GHC.Name] -> AnnList IESpec dom SrcTemplateStage -> Refactor dom (AnnList IESpec dom SrcTemplateStage)
+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 -> Refactor dom (IESpec dom SrcTemplateStage)
+  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)
@@ -95,7 +93,7 @@             || ((ie ^? element&ieSubspec&annJust&element&essList&annList) /= [])
             || (case ie ^? element&ieSubspec&annJust&element of Just SubSpecAll -> True; _ -> False)     
   
-narrowImportSubspecs :: OrganizeImportsDomain dom n => [GHC.Name] -> Ann SubSpec dom SrcTemplateStage -> Ann SubSpec dom SrcTemplateStage
+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 _)) 
− Language/Haskell/Tools/Refactor/RangeDebug.hs
@@ -1,53 +0,0 @@-{-# LANGUAGE TypeOperators
-           , DefaultSignatures
-           , StandaloneDeriving
-           , FlexibleContexts
-           , FlexibleInstances
-           , MultiParamTypeClasses
-           , TypeFamilies
-           #-}
--- | A module for displaying debug info about the source annotations of the syntax tree in different phases.
-module Language.Haskell.Tools.Refactor.RangeDebug where
-
-import GHC.Generics
-import Control.Reference
-import SrcLoc
-import Language.Haskell.Tools.AST
-import Language.Haskell.Tools.AST.FromGHC
-import Language.Haskell.Tools.AnnTrf.RangeToRangeTemplate
-import Language.Haskell.Tools.AnnTrf.RangeTemplate
-import Language.Haskell.Tools.AnnTrf.SourceTemplate
-
-srcInfoDebug :: TreeDebug e dom st => e dom st -> String
-srcInfoDebug = treeDebug' 0
-      
-class (SourceInfo st, Domain dom, Show (e dom st))
-        => TreeDebug e dom st where
-  treeDebug' :: Int -> e dom st -> String
-  default treeDebug' :: (GTreeDebug (Rep (e dom st)), Generic (e dom st), Domain dom) => Int -> e dom st -> String
-  treeDebug' i = gTreeDebug i . from
-
-class GTreeDebug f where 
-  gTreeDebug :: Int -> f p -> String
-  
-instance GTreeDebug V1 where
-  gTreeDebug _ = error "GTreeDebug V1"
-  
-instance GTreeDebug U1 where
-  gTreeDebug _ U1 = ""  
-  
-instance (GTreeDebug f, GTreeDebug g) => GTreeDebug (f :+: g) where
-  gTreeDebug i (L1 x) = gTreeDebug i x
-  gTreeDebug i (R1 x) = gTreeDebug i x
-  
-instance (GTreeDebug f, GTreeDebug g) => GTreeDebug (f :*: g) where
-  gTreeDebug i (x :*: y) = gTreeDebug i x ++ gTreeDebug i y
-
-instance {-# OVERLAPPING #-} TreeDebug e dom st => GTreeDebug (K1 i (e dom st)) where
-  gTreeDebug i (K1 x) = treeDebug' i x
-  
-instance {-# OVERLAPPABLE #-} GTreeDebug (K1 i c) where
-  gTreeDebug i (K1 x) = ""
-        
-instance GTreeDebug f => GTreeDebug (M1 i t f) where
-  gTreeDebug i (M1 x) = gTreeDebug i x
− Language/Haskell/Tools/Refactor/RangeDebug/Instances.hs
@@ -1,139 +0,0 @@-{-# LANGUAGE FlexibleContexts
-           , FlexibleInstances
-           , MultiParamTypeClasses
-           , StandaloneDeriving
-           , DeriveGeneric
-           , UndecidableInstances 
-           #-}
-module Language.Haskell.Tools.Refactor.RangeDebug.Instances where
-
-import Language.Haskell.Tools.Refactor.RangeDebug
-
-import GHC.Generics
-import Control.Reference
-
-import Language.Haskell.Tools.AST
-
--- Annotations
-instance TreeDebug e dom st => TreeDebug (Ann e) dom st where
-  treeDebug' i (Ann a e) = identLine i ++ show (a ^. sourceInfo) ++ " " ++ take 40 (show e) ++ "..." ++ treeDebug' (i+1) e
-  
-identLine :: Int -> String
-identLine i = "\n" ++ replicate (i*2) ' '
-  
-instance TreeDebug e dom st => TreeDebug (AnnList e) dom st where
-  treeDebug' i (AnnList a ls) = identLine i ++ show (a ^. sourceInfo) ++ " <*>" ++ concatMap (treeDebug' (i + 1)) ls 
-  
-instance TreeDebug e dom st => TreeDebug (AnnMaybe e) dom st where
-  treeDebug' i (AnnMaybe a e) = identLine i ++ show (a ^. sourceInfo) ++ " <?>" ++ maybe "" (\e -> treeDebug' (i + 1) e) e
-  
--- Modules
-instance (SourceInfo st, Domain dom) => TreeDebug Module dom st
-instance (SourceInfo st, Domain dom) => TreeDebug ModuleHead dom st
-instance (SourceInfo st, Domain dom) => TreeDebug ExportSpecList dom st
-instance (SourceInfo st, Domain dom) => TreeDebug ExportSpec dom st
-instance (SourceInfo st, Domain dom) => TreeDebug IESpec dom st
-instance (SourceInfo st, Domain dom) => TreeDebug SubSpec dom st
-instance (SourceInfo st, Domain dom) => TreeDebug ModulePragma dom st
-instance (SourceInfo st, Domain dom) => TreeDebug FilePragma dom st
-instance (SourceInfo st, Domain dom) => TreeDebug ImportDecl dom st
-instance (SourceInfo st, Domain dom) => TreeDebug ImportSpec dom st
-instance (SourceInfo st, Domain dom) => TreeDebug ImportQualified dom st
-instance (SourceInfo st, Domain dom) => TreeDebug ImportSource dom st
-instance (SourceInfo st, Domain dom) => TreeDebug ImportSafe dom st
-instance (SourceInfo st, Domain dom) => TreeDebug TypeNamespace dom st
-instance (SourceInfo st, Domain dom) => TreeDebug ImportRenaming dom st
-
--- Declarations
-instance (SourceInfo st, Domain dom) => TreeDebug Decl dom st
-instance (SourceInfo st, Domain dom) => TreeDebug ClassBody dom st
-instance (SourceInfo st, Domain dom) => TreeDebug ClassElement dom st
-instance (SourceInfo st, Domain dom) => TreeDebug DeclHead dom st
-instance (SourceInfo st, Domain dom) => TreeDebug InstBody dom st
-instance (SourceInfo st, Domain dom) => TreeDebug InstBodyDecl dom st
-instance (SourceInfo st, Domain dom) => TreeDebug GadtConDecl dom st
-instance (SourceInfo st, Domain dom) => TreeDebug GadtConType dom st
-instance (SourceInfo st, Domain dom) => TreeDebug GadtField dom st
-instance (SourceInfo st, Domain dom) => TreeDebug FunDeps dom st
-instance (SourceInfo st, Domain dom) => TreeDebug FunDep dom st
-instance (SourceInfo st, Domain dom) => TreeDebug ConDecl dom st
-instance (SourceInfo st, Domain dom) => TreeDebug FieldDecl dom st
-instance (SourceInfo st, Domain dom) => TreeDebug Deriving dom st
-instance (SourceInfo st, Domain dom) => TreeDebug InstanceRule dom st
-instance (SourceInfo st, Domain dom) => TreeDebug InstanceHead dom st
-instance (SourceInfo st, Domain dom) => TreeDebug TypeEqn dom st
-instance (SourceInfo st, Domain dom) => TreeDebug KindConstraint dom st
-instance (SourceInfo st, Domain dom) => TreeDebug TyVar dom st
-instance (SourceInfo st, Domain dom) => TreeDebug Type dom st
-instance (SourceInfo st, Domain dom) => TreeDebug Kind dom st
-instance (SourceInfo st, Domain dom) => TreeDebug Context dom st
-instance (SourceInfo st, Domain dom) => TreeDebug Assertion dom st
-instance (SourceInfo st, Domain dom) => TreeDebug Expr dom st
-instance (SourceInfo st, Domain dom, TreeDebug expr dom st, Generic (expr dom st)) => TreeDebug (Stmt' expr) dom st
-instance (SourceInfo st, Domain dom) => TreeDebug CompStmt dom st
-instance (SourceInfo st, Domain dom) => TreeDebug ValueBind dom st
-instance (SourceInfo st, Domain dom) => TreeDebug Pattern dom st
-instance (SourceInfo st, Domain dom) => TreeDebug PatternField dom st
-instance (SourceInfo st, Domain dom) => TreeDebug Splice dom st
-instance (SourceInfo st, Domain dom) => TreeDebug QQString dom st
-instance (SourceInfo st, Domain dom) => TreeDebug Match dom st
-instance (SourceInfo st, Domain dom, TreeDebug expr dom st, Generic (expr dom st)) => TreeDebug (Alt' expr) dom st
-instance (SourceInfo st, Domain dom) => TreeDebug Rhs dom st
-instance (SourceInfo st, Domain dom) => TreeDebug GuardedRhs dom st
-instance (SourceInfo st, Domain dom) => TreeDebug FieldUpdate dom st
-instance (SourceInfo st, Domain dom) => TreeDebug Bracket dom st
-instance (SourceInfo st, Domain dom) => TreeDebug TopLevelPragma dom st
-instance (SourceInfo st, Domain dom) => TreeDebug Rule dom st
-instance (SourceInfo st, Domain dom) => TreeDebug AnnotationSubject dom st
-instance (SourceInfo st, Domain dom) => TreeDebug MinimalFormula dom st
-instance (SourceInfo st, Domain dom) => TreeDebug ExprPragma dom st
-instance (SourceInfo st, Domain dom) => TreeDebug SourceRange dom st
-instance (SourceInfo st, Domain dom) => TreeDebug Number dom st
-instance (SourceInfo st, Domain dom) => TreeDebug QuasiQuote dom st
-instance (SourceInfo st, Domain dom) => TreeDebug RhsGuard dom st
-instance (SourceInfo st, Domain dom) => TreeDebug LocalBind dom st
-instance (SourceInfo st, Domain dom) => TreeDebug LocalBinds dom st
-instance (SourceInfo st, Domain dom) => TreeDebug FixitySignature dom st
-instance (SourceInfo st, Domain dom) => TreeDebug TypeSignature dom st
-instance (SourceInfo st, Domain dom) => TreeDebug ListCompBody dom st
-instance (SourceInfo st, Domain dom) => TreeDebug TupSecElem dom st
-instance (SourceInfo st, Domain dom) => TreeDebug TypeFamily dom st
-instance (SourceInfo st, Domain dom) => TreeDebug TypeFamilySpec dom st
-instance (SourceInfo st, Domain dom) => TreeDebug InjectivityAnn dom st
-instance (SourceInfo st, Domain dom, TreeDebug expr dom st, Generic (expr dom st)) => TreeDebug (CaseRhs' expr) dom st
-instance (SourceInfo st, Domain dom, TreeDebug expr dom st, Generic (expr dom st)) => TreeDebug (GuardedCaseRhs' expr) dom st
-instance (SourceInfo st, Domain dom) => TreeDebug PatternSynonym dom st
-instance (SourceInfo st, Domain dom) => TreeDebug PatSynRhs dom st
-instance (SourceInfo st, Domain dom) => TreeDebug PatSynLhs dom st
-instance (SourceInfo st, Domain dom) => TreeDebug PatSynWhere dom st
-instance (SourceInfo st, Domain dom) => TreeDebug PatternTypeSignature dom st
-instance (SourceInfo st, Domain dom) => TreeDebug Role dom st
-instance (SourceInfo st, Domain dom) => TreeDebug Cmd dom st
-instance (SourceInfo st, Domain dom) => TreeDebug LanguageExtension dom st
-instance (SourceInfo st, Domain dom) => TreeDebug MatchLhs dom st
-
--- Literal
-instance (SourceInfo st, Domain dom) => TreeDebug Literal dom st
-instance (SourceInfo st, Domain dom, TreeDebug k dom st, Generic (k dom st)) => TreeDebug (Promoted k) dom st
-
--- Base
-instance (SourceInfo st, Domain dom) => TreeDebug Operator dom st
-instance (SourceInfo st, Domain dom) => TreeDebug Name dom st
-instance (SourceInfo st, Domain dom) => TreeDebug SimpleName dom st
-instance (SourceInfo st, Domain dom) => TreeDebug ModuleName dom st
-instance (SourceInfo st, Domain dom) => TreeDebug UnqualName dom st
-instance (SourceInfo st, Domain dom) => TreeDebug StringNode dom st
-instance (SourceInfo st, Domain dom) => TreeDebug DataOrNewtypeKeyword dom st
-instance (SourceInfo st, Domain dom) => TreeDebug DoKind dom st
-instance (SourceInfo st, Domain dom) => TreeDebug TypeKeyword dom st
-instance (SourceInfo st, Domain dom) => TreeDebug OverlapPragma dom st
-instance (SourceInfo st, Domain dom) => TreeDebug CallConv dom st
-instance (SourceInfo st, Domain dom) => TreeDebug ArrowAppl dom st
-instance (SourceInfo st, Domain dom) => TreeDebug Safety dom st
-instance (SourceInfo st, Domain dom) => TreeDebug ConlikeAnnot dom st
-instance (SourceInfo st, Domain dom) => TreeDebug Assoc dom st
-instance (SourceInfo st, Domain dom) => TreeDebug Precedence dom st
-instance (SourceInfo st, Domain dom) => TreeDebug LineNumber dom st
-instance (SourceInfo st, Domain dom) => TreeDebug PhaseControl dom st
-instance (SourceInfo st, Domain dom) => TreeDebug PhaseNumber dom st
-instance (SourceInfo st, Domain dom) => TreeDebug PhaseInvert dom st
Language/Haskell/Tools/Refactor/RefactorBase.hs view
@@ -3,10 +3,14 @@            , ViewPatterns
            , StandaloneDeriving
            , LambdaCase
+           , FlexibleInstances
+           , FlexibleContexts
+           , TypeSynonymInstances
+           , MultiWayIf
            #-}
 module Language.Haskell.Tools.Refactor.RefactorBase where
 
-import Language.Haskell.Tools.AST
+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
@@ -27,22 +31,46 @@ import Control.Monad.Reader
 import Control.Monad.Trans.Except
 import Control.Monad.Writer
+import Control.Monad.State
 
--- | The information a refactoring can use
-data RefactorCtx dom = RefactorCtx { refModuleName :: GHC.Module
-                                   , refCtxImports :: [Ann ImportDecl dom SrcTemplateStage] 
-                                   }
+type UnnamedModule dom = Ann AST.Module dom SrcTemplateStage
 
+-- | The name of the module and the AST
+type ModuleDom dom = (String, UnnamedModule dom)
+
+-- | A refactoring that only affects one module
+type LocalRefactoring dom = UnnamedModule dom -> LocalRefactor dom (UnnamedModule dom)
+
+-- | The type of a refactoring
+type Refactoring dom = ModuleDom dom -> [ModuleDom dom] -> Refactor [RefactorChange dom]
+
+-- | Change in the project, modification or removal of a module.
+data RefactorChange dom = ContentChanged { fromContentChanged :: (ModuleDom dom) }
+                        | ModuleRemoved { removedModuleName :: String }
+
 -- | Performs the given refactoring, transforming it into a Ghc action
-runRefactor :: (SemanticInfo' dom SameInfoModuleCls ~ ModuleInfo n) 
-            => Ann Module dom SrcTemplateStage -> (Ann Module dom SrcTemplateStage -> RefactoredModule dom) -> Ghc (Either String (Ann Module dom SrcTemplateStage))
-runRefactor mod trf = let init = RefactorCtx (fromJust $ mod ^? semantics&defModuleName) (mod ^? element&modImports&annList)
-                       in runExceptT $ runReaderT (addGeneratedImports (runWriterT (fromRefactorT $ trf mod))) init
+runRefactor :: (HasModuleInfo dom) => ModuleDom dom -> [ModuleDom dom] -> Refactoring dom -> Ghc (Either String [RefactorChange dom])
+runRefactor mod mods trf = runExceptT $ trf mod mods
 
+-- | Wraps a refactoring that only affects one module. Performs the per-module finishing touches.
+localRefactoring :: HasModuleInfo dom => LocalRefactoring dom -> Refactoring dom
+localRefactoring ref (name, mod) _ 
+  = (\m -> [ContentChanged (name, m)]) <$> localRefactoringRes id mod (ref mod)
+
+-- | Transform the result of the local refactoring
+localRefactoringRes :: HasModuleInfo dom
+                    => ((UnnamedModule dom -> UnnamedModule dom) -> a -> a) 
+                          -> UnnamedModule dom 
+                          -> LocalRefactor dom a
+                          -> Refactor a
+localRefactoringRes access mod trf
+  = let init = RefactorCtx (semanticsModule $ mod ^. semantics) mod (mod ^? element&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 :: (Monad m) => ReaderT (RefactorCtx dom) m (Ann Module dom SrcTemplateStage, [GHC.Name]) -> ReaderT (RefactorCtx dom) m (Ann Module dom SrcTemplateStage)
-addGeneratedImports = 
-  fmap (\(m,names) -> element&modImports&annListElems .- (++ addImports names) $ m)
+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]
         addImports names = map createImport $ groupBy ((==) `on` GHC.nameModule) $ nub $ sort names
 
@@ -77,26 +105,48 @@   
 
 -- | Input and output information for the refactoring
-newtype RefactorT dom m a = RefactorT { fromRefactorT :: WriterT [GHC.Name] (ReaderT (RefactorCtx dom) m) a }
+newtype LocalRefactorT dom m a = LocalRefactorT { fromRefactorT :: WriterT [GHC.Name] (ReaderT (RefactorCtx dom) m) a }
   deriving (Functor, Applicative, Monad, MonadReader (RefactorCtx dom), MonadWriter [GHC.Name], MonadIO, HasDynFlags, ExceptionMonad, GhcMonad)
 
-instance MonadTrans (RefactorT dom) where
-  lift = RefactorT . lift . lift
+-- | The information a refactoring can use
+data RefactorCtx dom = RefactorCtx { refModuleName :: GHC.Module
+                                   , refCtxRoot :: Ann Module dom SrcTemplateStage
+                                   , refCtxImports :: [Ann ImportDecl dom SrcTemplateStage] 
+                                   }
 
-refactError :: String -> Refactor n a
-refactError = lift . throwE
+instance MonadTrans (LocalRefactorT dom) where
+  lift = LocalRefactorT . lift . lift
 
--- | The refactoring monad
-type Refactor dom = RefactorT dom (ExceptT String Ghc)
+-- | A monad that can be used to refactor
+class Monad m => RefactorMonad m where
+  refactError :: String -> m a
+  liftGhc :: Ghc a -> m a
 
-type RefactoredModule dom = Refactor dom (Ann Module dom SrcTemplateStage)
+instance RefactorMonad Refactor where
+  refactError = throwE
+  liftGhc = lift
 
+instance RefactorMonad (LocalRefactor dom) where
+  refactError = lift . refactError
+  liftGhc = lift . liftGhc
+
+instance RefactorMonad m => RefactorMonad (StateT s m) where
+  refactError = lift . refactError
+  liftGhc = lift . liftGhc
+
+-- | The refactoring monad for a given module
+type LocalRefactor dom = LocalRefactorT dom Refactor
+
+-- | The refactoring monad for the whole project
+type Refactor = ExceptT String Ghc
+
 registeredNamesFromPrelude :: [GHC.Name]
 registeredNamesFromPrelude = GHC.basicKnownKeyNames ++ map GHC.tyConName GHC.wiredInTyCons
 
 otherNamesFromPrelude :: [String]
 otherNamesFromPrelude 
  -- TODO: extend and revise this list
+ -- TODO: prelude names are simply existing names?? No need to check??
   = ["GHC.Base.Maybe", "GHC.Base.Just", "GHC.Base.Nothing", "GHC.Base.maybe", "GHC.Base.either", "GHC.Base.not"
     , "Data.Tuple.curry", "Data.Tuple.uncurry", "GHC.Base.compare", "GHC.Base.max", "GHC.Base.min", "GHC.Base.id"]
 
@@ -105,29 +155,29 @@   Just mod -> GHC.moduleNameString (GHC.moduleName mod) ++ "." ++ GHC.occNameString (GHC.nameOccName name)
   Nothing -> GHC.occNameString (GHC.nameOccName name)
 
-referenceName :: (SemanticInfo' dom SameInfoImportCls ~ ImportInfo n, Eq n, GHC.NamedThing n) 
-              => n -> Refactor dom (Ann Name dom SrcTemplateStage)
+referenceName :: (HasImportInfo dom, HasModuleInfo dom) => GHC.Name -> LocalRefactor dom (Ann Name dom SrcTemplateStage)
 referenceName = referenceName' mkQualName'
 
-referenceOperator :: (SemanticInfo' dom SameInfoImportCls ~ ImportInfo n, Eq n, GHC.NamedThing n) 
-                  => n -> Refactor dom (Ann Operator dom SrcTemplateStage)
+referenceOperator :: (HasImportInfo dom, HasModuleInfo dom) => GHC.Name -> LocalRefactor dom (Ann Operator dom SrcTemplateStage)
 referenceOperator = referenceName' mkQualOp'
 
 -- | Create a name that references the definition. Generates an import if the definition is not yet imported.
-referenceName' :: (SemanticInfo' dom SameInfoImportCls ~ ImportInfo n, Eq n, GHC.NamedThing n) 
-               => ([String] -> GHC.Name -> Ann nt dom SrcTemplateStage) -> n -> Refactor dom (Ann nt dom SrcTemplateStage)
-referenceName' makeName n@(GHC.getName -> name) 
+referenceName' :: (HasImportInfo dom, HasModuleInfo dom) 
+               => ([String] -> GHC.Name -> Ann nt dom SrcTemplateStage) -> GHC.Name -> LocalRefactor dom (Ann nt dom SrcTemplateStage)
+referenceName' makeName name 
   | name `elem` registeredNamesFromPrelude || qualifiedName name `elem` otherNamesFromPrelude
   = return $ makeName [] name -- imported from prelude
   | otherwise 
-  = do RefactorCtx {refCtxImports = imports, refModuleName = thisModule} <- ask
+  = do RefactorCtx {refCtxRoot = mod, refCtxImports = imports, refModuleName = thisModule} <- ask
        if maybe True (thisModule ==) (GHC.nameModule_maybe name) 
          then return $ makeName [] name -- in the same module, use simple name
-         else let possibleImports = filter ((n `elem`) . (\imp -> fromJust $ imp ^? semantics&importedNames)) imports
-               in if null possibleImports 
-                    then do tell [name]
-                            return $ makeName [] name
-                    else return $ referenceBy makeName name possibleImports -- use it according to the best available import
+         else let possibleImports = filter ((name `elem`) . (\imp -> semanticsImported $ imp ^. semantics)) imports
+                  fromPrelude = name `elem` semanticsImplicitImports (mod ^. semantics)
+               in if | fromPrelude -> return $ makeName [] name
+                     | null possibleImports -> do tell [name]
+                                                  return $ makeName [] name
+                     | otherwise -> return $ referenceBy makeName name possibleImports 
+                                     -- 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
@@ -150,8 +200,8 @@                | SynonymOperator  -- ^ Type definitions with operator-like names
 
 -- | Get which category does a given name belong to
-classifyName :: GHC.Name -> Refactor dom NameClass
-classifyName n = lookupName n >>= return . \case 
+classifyName :: RefactorMonad m => GHC.Name -> m NameClass
+classifyName n = liftGhc (lookupName n) >>= return . \case 
     Just (AnId id) | isop     -> ValueOperator
     Just (AnId id)            -> Variable
     Just (AConLike id) | isop -> DataCtorOperator
@@ -162,6 +212,9 @@     Nothing                   -> Variable
   where isop = GHC.isSymOcc (GHC.getOccName n) 
 
+-- | Checks if a given name is a valid module name
+validModuleName :: String -> Bool
+validModuleName s = all (nameValid Ctor) (splitOn "." s) 
 
 -- | Check if a given name is valid for a given kind of definition
 nameValid :: NameClass -> String -> Bool
Language/Haskell/Tools/Refactor/RenameDefinition.hs view
@@ -15,12 +15,15 @@ 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
@@ -30,39 +33,82 @@ 
 import Debug.Trace
 
-type DomainRenameDefinition dom = ( Domain dom, HasNameInfo (SemanticInfo' dom SameInfoNameCls), Data (SemanticInfo' dom SameInfoNameCls)
-                                  , HasScopeInfo (SemanticInfo' dom SameInfoNameCls), HasDefiningInfo (SemanticInfo' dom SameInfoNameCls) )
+type DomainRenameDefinition dom = ( HasNameInfo dom, HasScopeInfo dom, HasDefiningInfo dom
+                                  , HasImplicitFieldsInfo dom, HasModuleInfo dom )
 
-renameDefinition' :: forall dom . DomainRenameDefinition dom => RealSrcSpan -> String -> Ann Module dom SrcTemplateStage -> RefactoredModule dom
-renameDefinition' sp str mod
-  = case (getNodeContaining sp mod :: Maybe (Ann SimpleName dom SrcTemplateStage)) >>= (fmap getName . (semanticsName =<<) . (^? semantics)) of 
-      Just n -> renameDefinition n str mod
-      Nothing -> refactError "No name is selected"
+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"
 
-renameDefinition :: DomainRenameDefinition dom => GHC.Name -> String -> Ann Module dom SrcTemplateStage -> RefactoredModule dom
-renameDefinition toChange newName mod 
-    = do nameCls <- classifyName toChange
-         (res,defFound) <- runStateT (biplateRef !~ changeName toChange newName $ mod) False
+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 res
+            | otherwise -> return $ map ContentChanged changedModules
   where     
-    changeName :: DomainRenameDefinition dom => GHC.Name -> String -> Ann SimpleName dom SrcTemplateStage -> StateT Bool (Refactor dom) (Ann SimpleName dom SrcTemplateStage)
-    changeName toChange str elem 
-      = if | fmap getName (semanticsName (elem ^. semantics)) == Just toChange
-               && semanticsDefining (elem ^. semantics) == False
-               && any @[] ((str ==) . occNameString . getOccName) (semanticsScope (elem ^. semantics) ^? Ref.element 0 & traversal)
-             -> lift $ refactError "The definition clashes with an existing one" -- name clash with an external definition
-           | fmap getName (semanticsName (elem ^. semantics)) == Just toChange
-             -> do modify (|| semanticsDefining (elem ^. semantics))
-                   return $ element & unqualifiedName .= mkNamePart str $ elem
-           | let namesInScope = semanticsScope (elem ^. semantics)
-              in case semanticsName (elem ^. semantics) of 
-                   Just (getName -> exprName) -> str == occNameString (getOccName exprName) && sameNamespace toChange exprName
-                                                   && conflicts toChange exprName namesInScope
-                   Nothing -> False -- ambiguous names
-             -> lift $ refactError "The definition clashes with an existing one" -- local name clash
-           | otherwise -> return elem
+    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) 
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple+import Distribution.Simple
 main = defaultMain
haskell-tools-refactor.cabal view
@@ -1,5 +1,5 @@ name:                haskell-tools-refactor
-version:             0.1.3.0
+version:             0.2.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
@@ -19,11 +19,10 @@                      , Language.Haskell.Tools.Refactor.RenameDefinition
                      , Language.Haskell.Tools.Refactor.ExtractBinding
                      , Language.Haskell.Tools.Refactor.RefactorBase
-  other-modules:       Language.Haskell.Tools.Refactor.RangeDebug
-                     , Language.Haskell.Tools.Refactor.RangeDebug.Instances
-                     , Language.Haskell.Tools.Refactor.ASTDebug
-                     , Language.Haskell.Tools.Refactor.ASTDebug.Instances
-                     , Language.Haskell.Tools.Refactor.DebugGhcAST
+                     , Language.Haskell.Tools.Refactor.DataToNewtype
+                     , Language.Haskell.Tools.Refactor.IfToGuards
+                     , Language.Haskell.Tools.Refactor.DollarApp
+                     , Language.Haskell.Tools.Refactor.GetModules
   build-depends:       base                      >=4.9 && <5.0
                      , ghc                       >=8.0 && <8.1
                      , mtl                       >=2.2 && <2.3
@@ -34,14 +33,42 @@                      , transformers              >=0.5 && <0.6
                      , references                >=0.3.2 && <1.0
                      , split                     >=0.2 && <1.0
-                     , time                      >=1.5 && <2.0
                      , filepath                  >=1.4 && <2.0
-                     , either                    >=4.0 && <5.0
-                     , haskell-tools-ast         >=0.1.3 && <0.2
-                     , haskell-tools-ast-fromghc >=0.1.3 && <0.2
-                     , haskell-tools-ast-gen     >=0.1.3 && <0.2
-                     , haskell-tools-ast-trf     >=0.1.3 && <0.2
-                     , haskell-tools-prettyprint >=0.1.3 && <0.2
+                     , 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
   default-language:    Haskell2010
-  +  
+test-suite haskell-tools-test
+  type:                exitcode-stdio-1.0
+  ghc-options:         -with-rtsopts=-M2g
+  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
+  default-language:    Haskell2010