haskell-tools-refactor 0.6.0.0 → 0.7.0.0

raw patch · 34 files changed

+478/−138 lines, 34 filesdep ~haskell-tools-astdep ~haskell-tools-backend-ghcdep ~haskell-tools-prettyprintPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: haskell-tools-ast, haskell-tools-backend-ghc, haskell-tools-prettyprint, haskell-tools-refactor, haskell-tools-rewrite

API changes (from Hackage documentation)

Files

• Language/Haskell/Tools/Refactor.hs +2/−1
• Language/Haskell/Tools/Refactor/ChangeAST.hs +40/−0
• Language/Haskell/Tools/Refactor/GetModules.hs +5/−2
• Language/Haskell/Tools/Refactor/Helpers.hs +12/−8
• Language/Haskell/Tools/Refactor/ListOperations.hs +39/−14
• Language/Haskell/Tools/Refactor/Predefined/InlineBinding.hs +37/−37
• Language/Haskell/Tools/Refactor/Predefined/OrganizeImports.hs +15/−8
• Language/Haskell/Tools/Refactor/Predefined/RenameDefinition.hs +37/−18
• Language/Haskell/Tools/Refactor/RefactorBase.hs +96/−6
• Language/Haskell/Tools/Refactor/Session.hs +11/−10
• examples/CPP/ConditionalImport.hs +1/−1
• examples/CPP/ConditionalImportBegin.hs +10/−0
• examples/CPP/ConditionalImportBegin_res.hs +9/−0
• examples/CPP/ConditionalImportEnd.hs +10/−0
• examples/CPP/ConditionalImportEnd_res.hs +9/−0
• examples/CPP/ConditionalImportHalfRemoved.hs +10/−0
• examples/CPP/ConditionalImportHalfRemoved_res.hs +10/−0
• examples/CPP/ConditionalImportMulti.hs +11/−0
• examples/CPP/ConditionalImportMulti_res.hs +11/−0
• examples/CPP/ConditionalImportOrder.hs +13/−0
• examples/CPP/ConditionalImportOrder_res.hs +13/−0
• examples/CPP/ConditionalImport_res.hs +2/−0
• examples/Module/Import.hs +2/−2
• examples/Refactor/RenameDefinition/CrossRename.hs +8/−0
• examples/Refactor/RenameDefinition/ImplicitParams.hs +0/−10
• examples/Refactor/RenameDefinition/ImplicitParams_res.hs +0/−10
• examples/Refactor/RenameDefinition/MergeFields.hs +10/−0
• examples/Refactor/RenameDefinition/MergeFields_RenameY.hs +6/−0
• examples/Refactor/RenameDefinition/MergeFields_RenameY_res.hs +6/−0
• examples/Refactor/RenameDefinition/MergeFields_res.hs +10/−0
• examples/Refactor/RenameDefinition/RenameModuleAlias.hs +4/−0
• examples/Refactor/RenameDefinition/RenameModuleAlias_res.hs +4/−0
• haskell-tools-refactor.cabal +11/−10
• test/Main.hs +14/−1

@@ -1,5 +1,5 @@ -- | Defines the API for refactorings
-module Language.Haskell.Tools.Refactor 
+module Language.Haskell.Tools.Refactor
     ( module Language.Haskell.Tools.AST.SemaInfoClasses
     , module Language.Haskell.Tools.AST.Rewrite
     , module Language.Haskell.Tools.AST.References
@@ -17,6 +17,7 @@     , sourceTemplateNodeRange, sourceTemplateNodeElems
     , sourceTemplateListRange, srcTmpListBefore, srcTmpListAfter, srcTmpDefaultSeparator, srcTmpIndented, srcTmpSeparators
     , sourceTemplateOptRange, srcTmpOptBefore, srcTmpOptAfter
+    , SourceTemplateTextElem(..), sourceTemplateText
     ) where
 
 -- Important: Haddock doesn't support the rename all exported modules and export them at once hack

@@ -0,0 +1,40 @@+{-# LANGUAGE LambdaCase, TupleSections, AllowAmbiguousTypes #-}
+-- | Operations for changing the AST
+module Language.Haskell.Tools.Refactor.ChangeAST (removeChild, removeSeparator) where
+
+import Control.Reference
+import Control.Monad.State
+import Control.Monad.Writer
+import Data.List
+import Data.Maybe
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.Transform
+import Language.Haskell.Tools.Refactor.RefactorBase
+import SrcLoc
+
+import Debug.Trace
+
+-- | Remove a separator from the AST while keeping the textual parts of it that should not be removed (like preprocessor pragmas).
+removeSeparator :: ([SourceTemplateTextElem], SrcSpan) -> LocalRefactor dom ()
+removeSeparator (txts, range) = tell staying
+  where staying = mapMaybe (\case StayingText str lnEnd -> Just (Right (range, str, lnEnd))
+                                  _ -> Nothing) txts
+
+-- | Remove an element from the AST while keeping the textual parts of it that should not be removed (like preprocessor pragmas).
+removeChild :: (SourceInfoTraversal e) => e dom SrcTemplateStage -> LocalRefactor dom ()
+removeChild e = tell $ map Right $ keptText e
+
+-- | Extracts all text elements that should be kept
+keptText :: SourceInfoTraversal e => e dom SrcTemplateStage -> [(SrcSpan,String,String)]
+keptText = execWriter . sourceInfoTraverse (SourceInfoTrf
+  (\ni -> mapM_ writeStaying (mapMaybe (\case (TextElem elems range) -> Just (elems,range)
+                                              _ -> Nothing)
+                                       (ni ^? sourceTemplateNodeElems & traversal)) >> return ni)
+  (\ni -> mapM_ writeStaying (ni ^. srcTmpSeparators) >> return ni)
+  pure)
+
+-- | Writes the elements to be kept into a writer monad with ranges and default line ending.
+writeStaying :: ([SourceTemplateTextElem], SrcSpan) -> Writer [(SrcSpan,String,String)] ()
+writeStaying (txts, range) = tell staying
+  where staying = mapMaybe (\case StayingText str lnEnd -> Just (range, str, lnEnd)
+                                  _ -> Nothing) txts

@@ -104,7 +104,10 @@ 
 instance Show ModuleRecord where
   show (ModuleNotLoaded code) = "ModuleNotLoaded " ++ show code
-  show mr = GHC.moduleNameString $ GHC.moduleName $ GHC.ms_mod $ fromJust $ mr ^? modRecMS
+  show mr@(ModuleParsed {}) = "ModuleParsed (" ++ (GHC.moduleNameString $ GHC.moduleName $ GHC.ms_mod $ fromJust $ mr ^? modRecMS) ++ ")"
+  show mr@(ModuleRenamed {}) = "ModuleRenamed (" ++ (GHC.moduleNameString $ GHC.moduleName $ GHC.ms_mod $ fromJust $ mr ^? modRecMS) ++ ")"
+  show mr@(ModuleTypeChecked {}) = "ModuleTypeChecked (" ++ (GHC.moduleNameString $ GHC.moduleName $ GHC.ms_mod $ fromJust $ mr ^? modRecMS) ++ ")"
+  show mr@(ModuleCodeGenerated {}) = "ModuleCodeGenerated (" ++ (GHC.moduleNameString $ GHC.moduleName $ GHC.ms_mod $ fromJust $ mr ^? modRecMS) ++ ")"
 
 -- | Find the module collection where the given module is.
 lookupModuleColl :: String -> [ModuleCollection] -> Maybe (ModuleCollection)
@@ -122,7 +125,7 @@ 
 needsGeneratedCode :: SourceFileKey -> [ModuleCollection] -> Bool
 needsGeneratedCode key = maybe False (\case (_, ModuleCodeGenerated {}) -> True; (_, ModuleNotLoaded True) -> True; _ -> False)
-                           . find ((key ==) . fst) . concatMap (Map.assocs . (^. mcModules))
+                           . find (((sfkIsBoot .= NormalHs $ key) ==) . fst) . concatMap (Map.assocs . (^. mcModules))
 
 codeGeneratedFor :: SourceFileKey -> [ModuleCollection] -> [ModuleCollection]
 codeGeneratedFor key = map (mcModules .- Map.adjust (\case (ModuleTypeChecked mod ms) -> ModuleCodeGenerated mod ms

@@ -6,29 +6,33 @@ module Language.Haskell.Tools.Refactor.Helpers where
 
 import Control.Reference
+import Control.Monad.Writer
+import Control.Monad.State
 import Data.Function (on)
-import Data.List (sortBy, nubBy)
+import Data.List (sortBy, nubBy, partition)
+import Data.Maybe
 
 import Language.Haskell.Tools.AST as AST
 import Language.Haskell.Tools.AST.Rewrite as AST
 import Language.Haskell.Tools.Refactor.ListOperations (filterList)
 
-import SrcLoc (srcSpanStart)
+import SrcLoc
+import Language.Haskell.Tools.Transform
 
-replaceWithJust :: Ann e dom SrcTemplateStage -> AnnMaybe e dom -> AnnMaybe e dom           
+replaceWithJust :: Ann e dom SrcTemplateStage -> AnnMaybe e dom -> AnnMaybe e dom
 replaceWithJust e = annMaybe .= Just e
 
-replaceWithNothing :: AnnMaybe e dom -> AnnMaybe e dom           
+replaceWithNothing :: AnnMaybe e dom -> AnnMaybe e dom
 replaceWithNothing = annMaybe .= Nothing
 
 -- | Remove the container (where or let) when the last binding is removed.
-removeEmptyBnds :: Simple Traversal (Module dom) (ValueBind dom) 
+removeEmptyBnds :: Simple Traversal (Module dom) (ValueBind dom)
                      -> Simple Traversal (Module dom) (Expr dom)
                      -> AST.Module dom -> AST.Module dom
 removeEmptyBnds binds exprs = (binds .- removeEmptyBindsAndGuards) . (exprs .- removeEmptyLetsAndStmts)
-  where removeEmptyBindsAndGuards sb@(SimpleBind _ _ _) 
+  where removeEmptyBindsAndGuards sb@(SimpleBind _ _ _)
           = (valBindLocals .- removeIfEmpty) . (valBindRhs .- removeEmptyGuards) $ sb
-        removeEmptyBindsAndGuards fb@(FunctionBind _) 
+        removeEmptyBindsAndGuards fb@(FunctionBind _)
           = (funBindMatches & annList & matchBinds .- removeIfEmpty) . (funBindMatches & annList & matchRhs .- removeEmptyGuards) $ fb
 
         removeEmptyGuards rhs = rhsGuards & annList & guardStmts .- filterList (\case GuardLet (AnnList []) -> False; _ -> True) $ rhs
@@ -39,7 +43,7 @@         removeEmptyLetsAndStmts (Let (AnnList []) e) = e
         removeEmptyLetsAndStmts e = exprStmts .- removeEmptyStmts $ e
 
-        removeEmptyStmts ls = (annList & cmdStmtBinds .- removeEmptyStmts) 
+        removeEmptyStmts ls = (annList & cmdStmtBinds .- removeEmptyStmts)
                                 . filterList (\case LetStmt (AnnList []) -> False; _ -> True) $ ls
 
 -- | Puts the elements in the orginal order and remove duplicates (elements with the same source range)

@@ -4,34 +4,59 @@ module Language.Haskell.Tools.Refactor.ListOperations where
 
 import Control.Reference
+import Control.Applicative
+import Control.Monad.IO.Class
 import Data.List (findIndices)
 
 import Language.Haskell.Tools.AST
 import Language.Haskell.Tools.AST.Rewrite (AnnList)
-import Language.Haskell.Tools.Transform (srcTmpDefaultSeparator, srcTmpSeparators, srcTmpIndented)
+import Language.Haskell.Tools.Transform
+import Language.Haskell.Tools.Refactor.RefactorBase
+import Language.Haskell.Tools.Refactor.ChangeAST
+import SrcLoc
 
 -- | Filters the elements of the list. By default it removes the separator before the element.
 -- Of course, if the first element is removed, the following separator is removed as well.
-filterList :: (Ann e dom SrcTemplateStage -> Bool) -> AnnList e dom -> AnnList e dom
+filterList :: SourceInfoTraversal e => (Ann e dom SrcTemplateStage -> Bool) -> AnnList e dom -> AnnList e dom
 filterList pred = filterListIndexed (const pred)
 
-filterListIndexed :: (Int -> Ann e dom SrcTemplateStage -> Bool) -> AnnList e dom -> AnnList e dom
+filterListIndexed :: SourceInfoTraversal e => (Int -> Ann e dom SrcTemplateStage -> Bool) -> AnnList e dom -> AnnList e dom
 filterListIndexed pred (AnnListG (NodeInfo sema src) elems)
-  = AnnListG (NodeInfo sema (srcTmpIndented .- fmap filterIndents $ srcTmpSeparators .- filterSeparators $ src)) filteredElems
+  =  AnnListG (NodeInfo sema (srcTmpIndented .- fmap filterIndents $ srcTmpSeparators .- filterSeparators $ src)) filteredElems
   where elementsKept = findIndices (uncurry pred) (zip [0..] elems)
         filteredElems = sublist elementsKept elems
         filterIndents = sublist elementsKept
         filterSeparators = take (length elementsKept - 1) . sublist elementsKept
 
+-- | A version of filterList that cares about keeping non-removable code elements (like preprocessor pragmas)
+filterListSt :: SourceInfoTraversal e => (Ann e dom SrcTemplateStage -> Bool) -> AnnList e dom -> LocalRefactor dom (AnnList e dom)
+filterListSt pred = filterListIndexedSt (const pred)
+
+-- | A version of filterListIndexed that cares about keeping non-removable code elements (like preprocessor pragmas)
+filterListIndexedSt :: SourceInfoTraversal e => (Int -> Ann e dom SrcTemplateStage -> Bool) -> AnnList e dom -> LocalRefactor dom (AnnList e dom)
+filterListIndexedSt pred (AnnListG (NodeInfo sema src) elems)
+  = do mapM_ removeChild removedElems
+       mapM_ removeSeparator removedSeparators
+       return $ AnnListG (NodeInfo sema (srcTmpIndented .- fmap filterIndents $ srcTmpSeparators .- filterSeparators $ src)) filteredElems
+  where elementsKept = findIndices (uncurry pred) (zip [0..] elems)
+        filteredElems = sublist elementsKept elems
+        removedSeparators :: [([SourceTemplateTextElem], SrcSpan)]
+        removedSeparators = notSublist elementsKept (src ^. srcTmpSeparators) ++ lastSepRemoved
+        lastSepRemoved = if (length elems - 1) `notElem` elementsKept
+                           then take 1 (reverse (sublist elementsKept $ src ^. srcTmpSeparators)) else []
+        removedElems = notSublist elementsKept elems
+        filterIndents = sublist elementsKept
+        filterSeparators = take (length elementsKept - 1) . sublist elementsKept
+
+
 -- | Selects the given indices from a list
 sublist :: [Int] -> [a] -> [a]
-sublist = sublist' 0
-  where sublist' i [] _ = []
-        sublist' i _ [] = []
-        sublist' i (ind:more) (e:rest)
-          | i == ind  = e : sublist' (i+1) more rest
-          | otherwise = sublist' (i+1) (ind:more) rest
+sublist indices = map snd . filter ((`elem` indices) . fst) . zip [0..]
 
+-- | Selects all but the given indices from a list
+notSublist :: [Int] -> [a] -> [a]
+notSublist indices = map snd . filter ((`notElem` indices) . fst) . zip [0..]
+
 -- | Inserts the element in the places where the two positioning functions (one checks the element before, one the element after)
 -- allows the placement.
 insertWhere :: Bool -> Ann e dom SrcTemplateStage -> (Maybe (Ann e dom SrcTemplateStage) -> Bool)
@@ -45,7 +70,7 @@                         $ (if isEmptyAnnList then id else annListAnnot&sourceInfo .- setIndented ind . addDefaultSeparator ind)
                         $ al
   where setIndented i = srcTmpIndented .- fmap (insertAt i indented)
-        addDefaultSeparator i al = srcTmpSeparators .- insertAt i (al ^. srcTmpDefaultSeparator) $ al
+        addDefaultSeparator i al = srcTmpSeparators .- insertAt i ([NormalText $ al ^. srcTmpDefaultSeparator], noSrcSpan) $ al
         insertAt n e ls = let (bef,aft) = splitAt n ls in bef ++ [e] ++ aft
         isEmptyAnnList = (null :: [x] -> Bool) $ (al ^? annList)
 
@@ -69,10 +94,10 @@ 
 -- | Gets the elements and separators from a list. The first separator is zipped to the second element.
 -- To the first element, the "" string is zipped.
-zipWithSeparators :: AnnList e dom -> [(String, Ann e dom SrcTemplateStage)]
+zipWithSeparators :: AnnList e dom -> [(([SourceTemplateTextElem], SrcSpan), Ann e dom SrcTemplateStage)]
 zipWithSeparators (AnnListG (NodeInfo _ src) elems)
   | [] <- src ^. srcTmpSeparators
-  = zip ("" : repeat (src ^. srcTmpDefaultSeparator)) elems
+  = zip (([], noSrcSpan) : repeat ([NormalText $ src ^. srcTmpDefaultSeparator], noSrcSpan)) elems
   | otherwise
-  = zip ("" : seps ++ repeat (last seps)) elems
+  = zip (([], noSrcSpan) : seps ++ repeat (_2 .= noSrcSpan $ last seps)) elems
   where seps = src ^. srcTmpSeparators

@@ -30,7 +30,7 @@ type InlineBindingDomain dom = ( HasNameInfo dom, HasDefiningInfo dom, HasScopeInfo dom, HasModuleInfo dom )
 
 inlineBinding :: forall dom . InlineBindingDomain dom => RealSrcSpan -> Refactoring dom
-inlineBinding span namedMod@(_,mod) mods 
+inlineBinding span namedMod@(_,mod) mods
   = let topLevel :: Simple Traversal (Module dom) (DeclList dom)
         topLevel = nodesContaining span
         local :: Simple Traversal (Module dom) (LocalBindList dom)
@@ -40,58 +40,58 @@         elemAccess :: (BindingElem d) => AnnList d dom -> Maybe (ValueBind dom)
         elemAccess = getValBindInList span
         removed = catMaybes $ map elemAccess (mod ^? topLevel) ++ map elemAccess (mod ^? local)
-     in case reverse removed of 
+     in case reverse removed of
           [] -> refactError "No binding is selected."
-          removedBinding:_ -> 
+          removedBinding:_ ->
            let [removedBindingName] = nub $ catMaybes $ map semanticsName (removedBinding ^? bindingName)
             in if | any (containInlined removedBindingName) mods
-                    -> refactError "Cannot inline the definition, it is used in other modules." 
-                  | _:_ <- mod ^? modHead & annJust & mhExports & annJust & biplateRef 
+                    -> refactError "Cannot inline the definition, it is used in other modules."
+                  | _:_ <- mod ^? modHead & annJust & mhExports & annJust & biplateRef
                                           & filtered (\n -> semanticsName (n :: QualifiedName dom) == Just removedBindingName)
                     -> refactError "Cannot inline the definition, it is present in the export list."
                   | otherwise -> localRefactoring (inlineBinding' topLevel local exprs removedBinding removedBindingName) namedMod mods
 
 -- | Performs the inline binding on a single module.
-inlineBinding' :: InlineBindingDomain dom 
-                    => Simple Traversal (Module dom) (DeclList dom) 
-                    -> Simple Traversal (Module dom) (LocalBindList dom) 
-                    -> Simple Traversal (Module dom) (Expr dom) 
+inlineBinding' :: InlineBindingDomain dom
+                    => Simple Traversal (Module dom) (DeclList dom)
+                    -> Simple Traversal (Module dom) (LocalBindList dom)
+                    -> Simple Traversal (Module dom) (Expr dom)
                     -> ValueBind dom -> GHC.Name
                     -> LocalRefactoring dom
 inlineBinding' topLevelRef localRef exprRef removedBinding removedBindingName mod
   = do replacement <- createReplacement removedBinding
        let RealSrcSpan bindingSpan = getRange removedBinding
        (mod', used) <- runStateT (descendBiM (replaceInvocations bindingSpan removedBindingName replacement) mod) False
-       if not used 
+       if not used
          then refactError "The selected definition is not used, it can be safely deleted."
          else return $ removeBindingAndSig topLevelRef localRef exprRef removedBindingName mod'
 
 -- | True if the given module contains the name of the inlined definition.
 containInlined :: forall dom . InlineBindingDomain dom => GHC.Name -> ModuleDom dom -> Bool
-containInlined name (_,mod) 
+containInlined name (_,mod)
   = any (\qn -> semanticsName qn == Just name) $ (mod ^? biplateRef :: [QualifiedName dom])
 
 -- | Removes the inlined binding and the accompanying type and fixity signatures.
-removeBindingAndSig :: InlineBindingDomain dom 
-                         => Simple Traversal (Module dom) (DeclList dom) 
-                         -> Simple Traversal (Module dom) (LocalBindList dom) 
-                         -> Simple Traversal (Module dom) (Expr dom) 
+removeBindingAndSig :: InlineBindingDomain dom
+                         => Simple Traversal (Module dom) (DeclList dom)
+                         -> Simple Traversal (Module dom) (LocalBindList dom)
+                         -> Simple Traversal (Module dom) (Expr dom)
                          -> GHC.Name -> AST.Module dom
                          -> AST.Module dom
 removeBindingAndSig topLevelRef localRef exprRef name
-  = removeEmptyBnds (topLevelRef & annList & declValBind &+& localRef & annList & localVal) exprRef 
+  = removeEmptyBnds (topLevelRef & annList & declValBind &+& localRef & annList & localVal) exprRef
       . (topLevelRef .- removeBindingAndSig' name) . (localRef .- removeBindingAndSig' name)
 
-removeBindingAndSig' :: (InlineBindingDomain dom, BindingElem d) => GHC.Name -> AnnList d dom -> AnnList d dom
+removeBindingAndSig' :: SourceInfoTraversal d => (InlineBindingDomain dom, BindingElem d) => GHC.Name -> AnnList d dom -> AnnList d dom
 removeBindingAndSig' name = (annList .- removeNameFromSigBind) . filterList notThatBindOrSig
-  where notThatBindOrSig e 
+  where notThatBindOrSig e
           | Just sb <- e ^? sigBind = nub (map semanticsName (sb ^? tsName & annList & simpleName)) /= [Just name]
           | Just vb <- e ^? valBind = nub (map semanticsName (vb ^? bindingName)) /= [Just name]
           | Just fs <- e ^? fixitySig = nub (map semanticsName (fs ^? fixityOperators & annList & operatorName)) /= [Just name]
           | otherwise = True
-        
-        removeNameFromSigBind d 
-          | Just sb <- d ^? sigBind 
+
+        removeNameFromSigBind d
+          | Just sb <- d ^? sigBind
           = createTypeSig $ tsName .- filterList (\n -> semanticsName (n ^. simpleName) /= Just name) $ sb
           | Just fs <- d ^? fixitySig
           = createFixitySig $ fixityOperators .- filterList (\n -> semanticsName (n ^. operatorName) /= Just name) $ fs
@@ -99,22 +99,22 @@ 
 -- | As a top-down transformation, replaces the occurrences of the binding with generated expressions. This method passes
 -- the captured arguments of the function call to generate simpler results.
-replaceInvocations :: InlineBindingDomain dom 
+replaceInvocations :: InlineBindingDomain dom
                    => RealSrcSpan -> GHC.Name -> ([[GHC.Name]] -> [Expr dom] -> Expr dom) -> Expr dom -> StateT Bool (LocalRefactor dom) (Expr dom)
 replaceInvocations bindingRange name replacement expr
   | (Var n, args) <- splitApps expr
   , semanticsName (n ^. simpleName) == Just name
-  = case getRange expr of 
+  = case getRange expr of
       RealSrcSpan ownRange | bindingRange `containsSpan` ownRange
         -> lift $ refactError "Cannot inline definitions containing direct recursion."
       _ -> do put True
               replacement (semanticsScope expr) <$> mapM (descendM (replaceInvocations bindingRange name replacement)) args
-  | otherwise 
+  | otherwise
   = descendM (replaceInvocations bindingRange name replacement) expr
 
 -- | Splits an application into function and arguments. Works also for operators.
 splitApps :: Expr dom -> (Expr dom, [Expr dom])
-splitApps (App f a) = case splitApps f of (fun, args) -> (fun, args ++ [a]) 
+splitApps (App f a) = case splitApps f of (fun, args) -> (fun, args ++ [a])
 splitApps (InfixApp l (NormalOp qn) r) = (mkVar (mkParenName qn), [l,r])
 splitApps (InfixApp l (BacktickOp qn) r) = (mkVar (mkNormalName qn), [l,r])
 splitApps (Paren expr) = splitApps expr
@@ -127,7 +127,7 @@ 
 -- | Create an expression that is equivalent to calling the given bind.
 createReplacement :: InlineBindingDomain dom => ValueBind dom -> LocalRefactor dom ([[GHC.Name]] -> [Expr dom] -> Expr dom)
-createReplacement (SimpleBind (VarPat _) (UnguardedRhs e) locals) 
+createReplacement (SimpleBind (VarPat _) (UnguardedRhs e) locals)
   = return $ \_ args -> joinApps (parenIfNeeded $ wrapLocals locals e) args
 createReplacement (SimpleBind _ _ _)
   = refactError "Cannot inline, illegal simple bind. Only variable left-hand sides and unguarded right-hand sides are accepted."
@@ -140,9 +140,9 @@                                                  -- function bind has at least one match
   = return $ \sc args -> let numArgs = getArgNum (head (matches ^? annList & matchLhs)) - length args
                              newArgs = take numArgs $ map mkName $ filter notInScope $ map (("x" ++ ) . show @Int) [1..]
-                             notInScope str = not $ any (any ((== str) . occNameString . getOccName)) sc 
-                          in parenIfNeeded $ createLambda (map mkVarPat newArgs) 
-                                           $ mkCase (mkTuple $ map mkVar newArgs ++ args) 
+                             notInScope str = not $ any (any ((== str) . occNameString . getOccName)) sc
+                          in parenIfNeeded $ createLambda (map mkVarPat newArgs)
+                                           $ mkCase (mkTuple $ map mkVar newArgs ++ args)
                                            $ map replaceMatch (matches ^? annList)
   where getArgNum (MatchLhs _ (AnnList args)) = length args
         getArgNum (InfixLhs _ _ _ (AnnList more)) = length more + 2
@@ -150,7 +150,7 @@ -- | Replaces names with expressions according to a mapping.
 replaceExprs :: InlineBindingDomain dom => [(GHC.Name, Expr dom)] -> Expr dom -> Expr dom
 replaceExprs [] = id
-replaceExprs replaces = (uniplateRef .-) $ \case 
+replaceExprs replaces = (uniplateRef .-) $ \case
     Var n | Just name <- semanticsName (n ^. simpleName)
           , Just replace <- lookup name replaces
           -> replace
@@ -159,10 +159,10 @@ -- | Matches a pattern list with an expression list and generates bindings. Matches until an argument cannot be matched.
 matchArguments :: InlineBindingDomain dom => [Pattern dom] -> [Expr dom] -> ([(GHC.Name, Expr dom)], [Pattern dom], [Expr dom])
 matchArguments (ParenPat p : pats) exprs = matchArguments (p:pats) exprs
-matchArguments (p:pats) (e:exprs) 
+matchArguments (p:pats) (e:exprs)
   | Just replacement <- staticPatternMatch p e
   = case matchArguments pats exprs of (replacements, patterns, expressions) -> (replacement ++ replacements, patterns, expressions)
-  | otherwise 
+  | otherwise
   = ([], p:pats, e:exprs)
 matchArguments pats [] = ([], pats, [])
 matchArguments [] exprs = ([], [], exprs)
@@ -172,9 +172,9 @@ staticPatternMatch (VarPat n) e
   | Just name <- semanticsName $ n ^. simpleName
   = Just [(name, e)]
-staticPatternMatch (AppPat n (AnnList args)) e 
+staticPatternMatch (AppPat n (AnnList args)) e
   | (Var n', exprs) <- splitApps e
-  , length args == length exprs 
+  , length args == length exprs
       && semanticsName (n ^. simpleName) == semanticsName (n' ^. simpleName)
   , Just subs <- sequence $ zipWith staticPatternMatch args exprs
   = Just $ concat subs
@@ -195,9 +195,9 @@         toAltGuardedRhs (GuardedRhs (AnnList guards) expr) = mkGuardedCaseRhs guards expr
 
 wrapLocals :: MaybeLocalBinds dom -> Expr dom -> Expr dom
-wrapLocals bnds = case bnds ^? annJust & localBinds & annList of 
+wrapLocals bnds = case bnds ^? annJust & localBinds & annList of
                     [] -> id
-                    localBinds -> mkLet localBinds 
+                    localBinds -> mkLet localBinds
 
 -- | True for patterns that need to be parenthesized if in a lambda
 compositePat :: Pattern dom -> Bool
@@ -223,4 +223,4 @@ 
 createLambda :: [Pattern dom] -> Expr dom -> Expr dom
 createLambda [] = id
-createLambda pats = mkLambda (map (\p -> if compositePat p then mkParenPat p else p) pats)+createLambda pats = mkLambda (map (\p -> if compositePat p then mkParenPat p else p) pats)

@@ -22,6 +22,7 @@ import OccName (HasOccName(..), isSymOcc)
 import qualified PrelNames as GHC (fromStringName)
 import TyCon (TyCon(..), tyConFamInst_maybe)
+import SrcLoc
 
 import Control.Applicative ((<$>), Alternative(..))
 import Control.Monad
@@ -33,6 +34,8 @@ 
 import Language.Haskell.Tools.Refactor as AST
 
+import Debug.Trace
+
 type OrganizeImportsDomain dom = ( HasNameInfo dom, HasImportInfo dom, HasModuleInfo dom )
 
 projectOrganizeImports :: forall dom . OrganizeImportsDomain dom => Refactoring dom
@@ -86,22 +89,26 @@ 
 -- | Sorts the imports in alphabetical order
 sortImports :: forall dom . ImportDeclList dom -> ImportDeclList dom
-sortImports ls = srcInfo & srcTmpSeparators .= filter (not . null) (concatMap (\(sep,elems) -> sep : map fst elems) reordered)
+sortImports ls = srcInfo & srcTmpSeparators .= filter (not . null . fst) (concatMap (\(sep,elems) -> sep : map fst elems) reordered)
                    $ annListElems .= concatMap (map snd . snd) reordered
                    $ ls
-  where reordered :: [(String, [(String, ImportDecl dom)])]
+  where reordered :: [(([SourceTemplateTextElem], SrcSpan), [(([SourceTemplateTextElem], SrcSpan), ImportDecl dom)])]
         reordered = map (_2 .- sortBy (compare `on` (^. _2 & importModule & AST.moduleNameString))) parts
 
         parts = map (_2 .- reverse) $ reverse $ breakApart [] imports
 
-        breakApart :: [(String, [(String, ImportDecl dom)])] -> [(String, ImportDecl dom)] -> [(String, [(String, ImportDecl dom)])]
+        -- break up the list of imports to import groups
+        breakApart :: [(([SourceTemplateTextElem], SrcSpan), [(([SourceTemplateTextElem], SrcSpan), ImportDecl dom)])]
+                        -> [(([SourceTemplateTextElem], SrcSpan), ImportDecl dom)]
+                        -> [(([SourceTemplateTextElem], SrcSpan), [(([SourceTemplateTextElem], SrcSpan), ImportDecl dom)])]
         breakApart res [] = res
-        breakApart res ((sep, e) : rest) | length (filter ('\n' ==) sep) > 1
-          = breakApart ((sep, [("",e)]) : res) rest
+        breakApart res ((sep, e) : rest) | length (filter ('\n' ==) (sep ^? _1 & traversal & sourceTemplateText & traversal)) > 1
+                                            || "\n#" `isInfixOf` (sep ^? _1 & traversal & sourceTemplateText & traversal)
+          = breakApart ((sep, [(([], noSrcSpan),e)]) : res) rest
         breakApart ((lastSep, lastRes) : res) (elem : rest)
           = breakApart ((lastSep, elem : lastRes) : res) rest
         breakApart [] ((sep, e) : rest)
-          = breakApart [(sep, [("",e)])] rest
+          = breakApart [(sep, [(([], noSrcSpan),e)])] rest
 
         imports = zipWithSeparators ls
 
@@ -109,8 +116,8 @@ narrowImports :: forall dom . OrganizeImportsDomain dom
               => Bool -> [String] -> [GHC.Name] -> [(GHC.Name, Bool)] -> [ClsInst] -> [FamInst] -> ImportDeclList dom -> LocalRefactor dom (ImportDeclList dom)
 narrowImports noNarrowSubspecs exportedModules usedNames exportedNames prelInsts prelFamInsts imps
-  = annListElems & traversal !~ narrowImport noNarrowSubspecs exportedModules usedNames exportedNames
-      $ filterListIndexed (\i _ -> impsNeeded !! i) imps
+  = (annListElems & traversal !~ narrowImport noNarrowSubspecs exportedModules usedNames exportedNames)
+      =<< filterListIndexedSt (\i _ -> impsNeeded !! i) imps
   where impsNeeded = neededImports exportedModules (usedNames ++ map fst exportedNames) prelInsts prelFamInsts (imps ^. annListElems)
 
 -- | Reduces the number of definitions used from an import

@@ -10,9 +10,15 @@            #-}
 module Language.Haskell.Tools.Refactor.Predefined.RenameDefinition (renameDefinition, renameDefinition', DomainRenameDefinition) where
 
-import qualified GHC (RealSrcSpan, NamedThing(..), Name)
+import qualified GHC
 import Name (OccName(..), NamedThing(..), occNameString)
 import SrcLoc (RealSrcSpan)
+import Id
+import IdInfo
+import Outputable
+import Type
+import TyCon
+import DataCon
 
 import Control.Monad.State
 import Control.Reference as Ref
@@ -20,6 +26,7 @@ import Data.List
 import Data.List.Split (splitOn)
 import Data.Maybe
+import Debug.Trace
 
 import Language.Haskell.Tools.Refactor
 
@@ -34,16 +41,17 @@         where bindsWithSameName :: GHC.Name -> [FieldWildcard dom] -> [GHC.Name]
               bindsWithSameName name wcs = catMaybes $ map ((lookup name) . semanticsImplicitFlds) wcs
       Nothing -> case getNodeContaining sp (snd mod) of
-                   Just modName -> renameModule (modName ^. moduleNameString) str mod mods
+                   Just modName -> renameModule (any @[] (sp `isInside`) ((snd mod) ^? modImports&annList&importAs))
+                                                (modName ^. moduleNameString) str mod mods
                    Nothing -> refactError "No name is selected"
 
-renameModule :: forall dom . DomainRenameDefinition dom => String -> String -> Refactoring dom
-renameModule from to m mods
+renameModule :: forall dom . DomainRenameDefinition dom => Bool -> String -> String -> Refactoring dom
+renameModule isAlias from to m mods
     | any (nameConflict to) (map snd $ m:mods) = refactError "Name conflict when renaming module"
     | isJust (validModuleName to) = refactError $ "The given name is not a valid module name: " ++ fromJust (validModuleName to)
     | otherwise = -- here it is important that the delete is the last, because rename
                   -- can still use the info about the deleted module
-                  fmap (\ls -> map (alterChange from to) ls ++ [ModuleRemoved from])
+                  (if isAlias then id else (fmap (\ls -> map (alterChange from to) ls ++ [ModuleRemoved from])))
                     $ mapM (\(name,mod) -> ContentChanged . (name,) <$> localRefactoringRes id mod (replaceModuleNames =<< alterNormalNames mod)) (m:mods)
   where alterChange from to (ContentChanged (mod,res))
           | (mod ^. sfkModuleName) == from
@@ -54,14 +62,9 @@         replaceModuleNames = biplateRef @_ @(ModuleName dom) & filtered (\e -> (e ^. moduleNameString) == from) != mkModuleName to
 
         alterNormalNames :: LocalRefactoring dom
-        alterNormalNames mod = if from `elem` moduleQualifiers mod
-           then biplateRef @_ @(QualifiedName dom) & filtered (\e -> concat (intersperse "." (e ^? qualifiers&annList&simpleNameStr)) == from)
-                  !- (\e -> mkQualifiedName (splitOn "." to) (e ^. unqualifiedName&simpleNameStr)) $ mod
-           else return mod
-
-        moduleQualifiers :: Module dom -> [String]
-        moduleQualifiers mod = mod ^? modImports & annList & filtered (\m -> isAnnNothing (m ^. importAs))
-                                              & importModule & moduleNameString
+        alterNormalNames mod =
+           biplateRef @_ @(QualifiedName dom) & filtered (\e -> concat (intersperse "." (e ^? qualifiers&annList&simpleNameStr)) == from)
+             !- (\e -> mkQualifiedName (splitOn "." to) (e ^. unqualifiedName&simpleNameStr)) $ mod
 
         nameConflict :: String -> Module dom -> Bool
         nameConflict to mod
@@ -81,16 +84,21 @@     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
+          do origTT <- GHC.lookupName toChangeOrig
+             let origId = case origTT of
+                            Just (GHC.AnId id) -> Just id
+                            _ -> Nothing
+             (res, isChanged) <- runStateT (biplateRef !~ changeName toChangeOrig origId toChangeWith newName $ mod) False
              if isChanged then return $ Just (name, res)
                           else return Nothing
 
-    changeName :: DomainRenameDefinition dom => GHC.Name -> [GHC.Name] -> String -> QualifiedName dom
+    changeName :: DomainRenameDefinition dom => GHC.Name -> Maybe Id -> [GHC.Name] -> String -> QualifiedName dom
                                                          -> StateT Bool (StateT Bool (LocalRefactor dom)) (QualifiedName dom)
-    changeName toChangeOrig toChangeWith str name
+    changeName toChangeOrig origId toChangeWith str name
       | maybe False (`elem` toChange) actualName
           && semanticsDefining name == False
-          && any @[] ((str ==) . occNameString . getOccName) (semanticsScope name ^? Ref.element 0 & traversal & filtered (sameNamespace toChangeOrig))
+          && any @[] (\n -> str == occNameString (getOccName n) && not (mergeableFields origId n))
+                     (scopeUpToDef (semanticsScope name) ^? traversal & 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
@@ -99,13 +107,24 @@            return $ unqualifiedName .= mkNamePart str $ name -- found the changed name (or a name that have to be changed too)
       | let namesInScope = semanticsScope name
          in case semanticsName name of
-              Just (getName -> exprName) -> str == occNameString (getOccName exprName) && sameNamespace toChangeOrig exprName
+              Just (getName -> exprName) -> str == occNameString (getOccName exprName)
+                                              && sameNamespace toChangeOrig exprName
                                               && conflicts toChangeOrig exprName namesInScope
+                                              && not (mergeableFields origId exprName)
               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)
+            scopeUpToDef sc = let (inside, outside) = span (null . (toChange `intersect`)) sc
+                               in inside ++ take 1 outside
+            mergeableFields (Just orig) conflict
+              | isRecordSelector orig
+              , RecSelData tc <- recordSelectorTyCon orig
+              = let selectorsWithTypes = concatMap (\dc -> map (\fld -> (flSelector fld, dataConFieldType dc (flLabel fld))) (dataConFieldLabels dc))
+                                                   (filter (\dc -> toChangeOrig `notElem` map flSelector (dataConFieldLabels dc)) (tyConDataCons tc))
+                 in maybe False (`eqType` funResultTy (idType orig)) (lookup conflict selectorsWithTypes)
+            mergeableFields _ _ = False
 
 conflicts :: GHC.Name -> GHC.Name -> [[GHC.Name]] -> Bool
 conflicts overwrites overwritten (scopeBlock : scope)

@@ -8,12 +8,14 @@            , TypeSynonymInstances
            , MultiWayIf
            , TemplateHaskell
+           , ViewPatterns
            #-}
 -- | Basic utilities and types for defining refactorings.
 module Language.Haskell.Tools.Refactor.RefactorBase where
 
 import Language.Haskell.Tools.AST as AST
 import Language.Haskell.Tools.AST.Rewrite
+import Language.Haskell.Tools.Transform
 
 import Bag as GHC
 import DynFlags (HasDynFlags(..))
@@ -26,14 +28,17 @@ import qualified PrelNames as GHC
 import qualified TyCon as GHC
 import qualified TysWiredIn as GHC
+import SrcLoc
 
 import Control.Exception
 import Control.Monad.Reader
-import Control.Monad.State
+import qualified Control.Monad.State as LazySt
+import Control.Monad.State.Strict
 import Control.Monad.Trans.Except
 import Control.Monad.Writer
 import Control.Reference hiding (element)
 import Data.Char
+import Data.Either
 import Data.Function (on)
 import Data.List
 import Data.List.Split
@@ -109,9 +114,78 @@                           -> Refactor a
 localRefactoringRes access mod trf
   = let init = RefactorCtx (semanticsModule $ mod ^. semantics) mod (mod ^? modImports&annList)
-     in flip runReaderT init $ do (mod, newNames) <- runWriterT (fromRefactorT trf)
-                                  return $ access (addGeneratedImports newNames) mod
+     in flip runReaderT init $ do (mod, recorded) <- runWriterT (fromRefactorT trf)
+                                  return $ access (insertText (rights recorded) . addGeneratedImports (lefts recorded)) mod
 
+-- | Re-inserts the elements removed from the AST that should be kept (for example preprocessor directives)
+insertText :: SourceInfoTraversal p => [(SrcSpan,String,String)] -> p dom SrcTemplateStage -> p dom SrcTemplateStage
+insertText [] p = p
+insertText inserted p
+  -- this traverses the AST and finds the positions where the removed elements can be added
+  = evalState (sourceInfoTraverseUp (SourceInfoTrf
+                (\stn -> sourceTemplateNodeElems !~ takeWhatPrecedesElem (stn ^. sourceTemplateNodeRange) $ stn)
+                (srcTmpSeparators !~ takeWhatPrecedesSep)
+                pure) (return ()) (return ()) p) (map Right $ sortOn (^. _1) inserted)
+  where
+   -- insert fragments into list separators
+   takeWhatPrecedesSep :: [([SourceTemplateTextElem], SrcSpan)] -> State [Either SrcSpan (SrcSpan,String,String)] [([SourceTemplateTextElem], SrcSpan)]
+   takeWhatPrecedesSep seps = takeWhatPrecedes Nothing (Just . (^. _2))
+                                               (\str -> _1 .- (++ [StayingText str ""]))
+                                               (\str -> _1 .- ([StayingText str ""] ++))
+                                               seps
+
+   -- insert fragments into AST elements
+   takeWhatPrecedesElem :: SrcSpan -> [SourceTemplateElem] -> State [Either SrcSpan (SrcSpan,String,String)] [SourceTemplateElem]
+   takeWhatPrecedesElem rng elems = takeWhatPrecedes (Just rng) (^? sourceTemplateTextRange)
+                                                                (\s -> sourceTemplateTextElem .- (++ [StayingText s ""]))
+                                                                (\s -> sourceTemplateTextElem .- ([StayingText s ""] ++))
+                                                                elems
+
+   -- finds the position of the fragment where there are elements in the template both before and after the fragment
+   -- puts holes into the list of inserted fragments where child elements are located
+   -- uses these holes to determine where should the fragment be added
+   takeWhatPrecedes :: Maybe SrcSpan -> (a -> Maybe SrcSpan) -> (String -> a -> a) -> (String -> a -> a) -> [a] -> State [Either SrcSpan (SrcSpan,String,String)] [a]
+   takeWhatPrecedes rng access append prepend elems
+     | ranges <- mapMaybe access elems
+     , not (null ranges)
+     = do let start = srcSpanStart $ fromMaybe (head ranges) rng
+              end = srcSpanEnd $ fromMaybe (last ranges) rng
+          toInsert <- get
+          let (prefix,rest) = break ((>= start) . srcSpanStart . either id (\(sp,_,_) -> sp)) toInsert
+              (middle,suffix) = break ((> end) . srcSpanEnd . either id (\(sp,_,_) -> sp)) rest
+          put $ prefix ++ Left (mkSrcSpan start end) : suffix
+          return $ mergeInserted access append prepend False middle elems
+     where mergeInserted :: (a -> Maybe SrcSpan) -> (String -> a -> a) -> (String -> a -> a) -> Bool -> [Either SrcSpan (SrcSpan,String,String)] -> [a] -> [a]
+           -- no fragments left
+           mergeInserted _ _ _ _ [] elems = elems
+           mergeInserted access append prepend prep insert@(Right (insertSpan,insertStr,ln):toInsert) (fstElem:elems)
+              -- insert a fragment to the end of the current element if the next elment is after the fragment
+              | Just fstElemSpace <- access fstElem -- TODO: is this needed?
+              , not prep && case mapMaybe access elems of sp:_ -> srcSpanStart sp >= srcSpanEnd insertSpan
+                                                          _ -> True
+              = mergeInserted access append prepend prep toInsert (append (ln ++ insertStr ++ ln) fstElem : elems)
+              -- insert the fragment before the current elem if we need an element before (we skipped a child)
+              -- and the current element is after the inserted fragment
+              | Just fstElemSpace <- access fstElem
+              , prep && srcSpanStart fstElemSpace >= srcSpanEnd insertSpan
+              = mergeInserted access append prepend prep toInsert (prepend (ln ++ insertStr ++ ln) fstElem : elems)
+              | isJust (access fstElem) && prep
+              = mergeInserted access append prepend False insert (fstElem : elems) -- switch back to append mode
+              | otherwise
+              = fstElem : mergeInserted access append prepend (if isJust (access fstElem) then False else prep) insert elems -- move on and switch back to append mode
+           -- when found a hole
+           mergeInserted access append prepend prep insert@(Left sp : toInsert) (fstElem:elems)
+              | Just fstElemSpace <- access fstElem
+              = if srcSpanStart fstElemSpace > srcSpanEnd sp
+                  -- switch to prepend mode
+                  then mergeInserted access append prepend True toInsert (fstElem:elems)
+                  -- skip elements that are not after the fragment
+                  else fstElem : mergeInserted access append prepend prep insert elems
+              | otherwise
+              = fstElem : mergeInserted access append prepend True toInsert elems -- switch to prepend mode and move on
+           mergeInserted _ _ _ _ _ [] = [] -- maybe error
+   takeWhatPrecedes _ _ _ _ elems = return elems
+
 -- | Adds the imports that bring names into scope that are needed by the refactoring
 addGeneratedImports :: [GHC.Name] -> Ann UModule dom SrcTemplateStage -> Ann UModule dom SrcTemplateStage
 addGeneratedImports names m = modImports&annListElems .- (++ addImports names) $ m
@@ -145,6 +219,18 @@   gcatch r c = StateT (\ctx -> runStateT r ctx `gcatch` (flip runStateT ctx . c))
   gmask m = StateT $ \ctx -> gmask (\f -> runStateT (m (\a -> StateT $ \ctx' -> f (runStateT a ctx'))) ctx)
 
+instance (Monad m, HasDynFlags m) => HasDynFlags (LazySt.StateT s m) where
+  getDynFlags = lift getDynFlags
+
+instance (GhcMonad m) => GhcMonad (LazySt.StateT s m) where
+  getSession = lift getSession
+  setSession env = lift (setSession env)
+
+instance (ExceptionMonad m) => ExceptionMonad (LazySt.StateT s m) where
+  gcatch r c = LazySt.StateT (\ctx -> LazySt.runStateT r ctx `gcatch` (flip LazySt.runStateT ctx . c))
+  gmask m = LazySt.StateT $ \ctx -> gmask (\f -> LazySt.runStateT (m (\a -> LazySt.StateT $ \ctx' -> f (LazySt.runStateT a ctx'))) ctx)
+
+
 instance GhcMonad m => GhcMonad (ReaderT s m) where
   getSession = lift getSession
   setSession env = lift (setSession env)
@@ -163,8 +249,8 @@ 
 
 -- | Input and output information for the refactoring
-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)
+newtype LocalRefactorT dom m a = LocalRefactorT { fromRefactorT :: WriterT [Either GHC.Name (SrcSpan, String, String)] (ReaderT (RefactorCtx dom) m) a }
+  deriving (Functor, Applicative, Monad, MonadReader (RefactorCtx dom), MonadWriter [Either GHC.Name (SrcSpan, String, String)], MonadIO, HasDynFlags, ExceptionMonad, GhcMonad)
 
 -- | The information a refactoring can use
 data RefactorCtx dom = RefactorCtx { refModuleName :: GHC.Module
@@ -192,6 +278,10 @@   refactError = lift . refactError
   liftGhc = lift . liftGhc
 
+instance RefactorMonad m => RefactorMonad (LazySt.StateT s m) where
+  refactError = lift . refactError
+  liftGhc = lift . liftGhc
+
 -- | The refactoring monad for a given module
 type LocalRefactor dom = LocalRefactorT dom Refactor
 
@@ -232,7 +322,7 @@          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]
+                     | null possibleImports -> do tell [Left name]
                                                   return $ makeName [] name
                      | otherwise -> return $ referenceBy makeName name possibleImports
                                      -- use it according to the best available import

@@ -5,7 +5,7 @@ module Language.Haskell.Tools.Refactor.Session where
 
 import Control.Exception
-import Control.Monad.State
+import Control.Monad.State.Strict
 import Control.Reference
 import qualified Data.List as List
 import qualified Data.Map as Map
@@ -27,8 +27,6 @@ import Language.Haskell.Tools.Refactor.Prepare
 import Language.Haskell.Tools.Refactor.RefactorBase
 
-import Debug.Trace
-
 -- | The state common for refactoring tools, carrying the state of modules.
 data RefactorSessionState
   = RefactorSessionState { __refSessMCs :: [ModuleCollection]
@@ -59,10 +57,10 @@      lift $ mapM_ addTarget $ map (\mod -> (Target (TargetModule (GHC.mkModuleName mod)) True Nothing)) modNames
      handleErrors $ withAlteredDynFlags (liftIO . setupLoadFlags allModColls) $ do
        modsForColls <- lift $ depanal [] True
-       liftIO $ loadCallback modsForColls
        let modsToParse = flattenSCCs $ topSortModuleGraph False modsForColls Nothing
-           actuallyCompiled = filter (not . (`elem` alreadyExistingMods) . modSumName) modsToParse
-       void $ checkEvaluatedMods report modsToParse
+           actuallyCompiled = filter (\ms -> modSumName ms `notElem` alreadyExistingMods) modsToParse
+       liftIO $ loadCallback actuallyCompiled
+       void $ checkEvaluatedMods (\_ -> return ()) modsToParse
        mods <- mapM (loadModule report) actuallyCompiled
        return (mods, ignored)
 
@@ -115,20 +113,21 @@   allModColls <- gets (^. refSessMCs)
   withAlteredDynFlags (liftIO . setupLoadFlags allModColls) $ do
     allMods <- lift $ depanal [] True
-    liftIO $ loadCallback (filter selected allMods)
     let (allModsGraph, lookup) = moduleGraphNodes False allMods
         changedMods = catMaybes $ map (\ms -> lookup (ms_hsc_src ms) (moduleName $ ms_mod ms))
                         $ filter selected allMods
         recompMods = map (ms_mod . getModFromNode) $ reachablesG (transposeG allModsGraph) changedMods
         sortedMods = reverse $ topologicalSortG allModsGraph
-    return $ filter ((`elem` recompMods) . ms_mod) $ map getModFromNode sortedMods
+        sortedRecompMods = filter ((`elem` recompMods) . ms_mod) $ map getModFromNode sortedMods
+    liftIO $ loadCallback sortedRecompMods
+    return sortedRecompMods
 
 -- | Reload a given module. Perform a callback.
 reloadModule :: IsRefactSessionState st => (ModSummary -> IO a) -> ModSummary -> StateT st Ghc a
 reloadModule report ms = do
   mcs <- gets (^. refSessMCs)
   let modName = modSumName ms
-      codeGen = hasGeneratedCode (keyFromMS ms) mcs
+      codeGen = needsGeneratedCode (keyFromMS ms) mcs
   case lookupModuleColl modName mcs of
     Just mc -> do
       let dfs = ms_hspp_opts ms
@@ -150,7 +149,9 @@   where reloadIfNeeded ms mcs
           = let key = keyFromMS ms
               in if not (hasGeneratedCode key mcs)
-                   then do modify $ refSessMCs .- codeGeneratedFor key
+                   then do md <- gets (^. refSessMCs)
+                           modify $ refSessMCs .- codeGeneratedFor key
+                           md <- gets (^. refSessMCs)
                            if (isAlreadyLoaded key mcs) then
                                -- The module is already loaded but code is not generated. Need to reload.
                                Just <$> lift (codeGenForModule report (codeGeneratedFor key mcs) ms)

@@ -3,7 +3,7 @@ 
 import Data.List
 #ifndef USE_DATA_LIST
-import Control.Monad
+import Control.Monad (Monad(..))
 #endif
 import Data.List
 

@@ -0,0 +1,10 @@+{-# LANGUAGE CPP #-}
+module CPP.ConditionalImportBegin where
+
+#ifndef USE_DATA_LIST
+import Control.Monad ((>>))
+#endif
+import Data.List
+import Data.List
+
+a = Nothing >> Nothing

@@ -0,0 +1,9 @@+{-# LANGUAGE CPP #-}
+module CPP.ConditionalImportBegin where
+
+#ifndef USE_DATA_LIST
+import Control.Monad ((>>))
+#endif
+
+
+a = Nothing >> Nothing

@@ -0,0 +1,10 @@+{-# LANGUAGE CPP #-}
+module CPP.ConditionalImportEnd where
+
+import Data.List
+import Data.List
+#ifndef USE_DATA_LIST
+import Control.Monad ((>>))
+#endif
+
+a = Nothing >> Nothing

@@ -0,0 +1,9 @@+{-# LANGUAGE CPP #-}
+module CPP.ConditionalImportEnd where
+
+
+#ifndef USE_DATA_LIST
+import Control.Monad ((>>))
+#endif
+
+a = Nothing >> Nothing

@@ -0,0 +1,10 @@+{-# LANGUAGE CPP #-}
+module CPP.ConditionalImportHalfRemoved where
+
+import Data.List
+#ifndef USE_DATA_LIST
+import Control.Monad ((>>))
+#endif
+import Control.Applicative ((<$>))
+
+a = id <$> (Nothing >> Nothing)

@@ -0,0 +1,10 @@+{-# LANGUAGE CPP #-}
+module CPP.ConditionalImportHalfRemoved where
+
+
+#ifndef USE_DATA_LIST
+import Control.Monad ((>>))
+#endif
+import Control.Applicative ((<$>))
+
+a = id <$> (Nothing >> Nothing)

@@ -0,0 +1,11 @@+{-# LANGUAGE CPP #-}
+module CPP.ConditionalImportMulti where
+
+import Data.List
+#ifndef USE_DATA_LIST
+import Control.Applicative ((<$>))
+import Control.Monad ((>>))
+#endif
+import Data.List
+
+a = id <$> (Nothing >> Nothing)

@@ -0,0 +1,11 @@+{-# LANGUAGE CPP #-}
+module CPP.ConditionalImportMulti where
+
+
+#ifndef USE_DATA_LIST
+import Control.Applicative ((<$>))
+import Control.Monad ((>>))
+#endif
+
+
+a = id <$> (Nothing >> Nothing)

@@ -0,0 +1,13 @@+{-# LANGUAGE CPP #-}
+module CPP.ConditionalImportOrder where
+
+import Data.List (intersperse)
+#ifndef USE_DATA_LIST
+import Control.Monad (Monad(..))
+#endif
+import Control.Applicative ((<$>))
+
+a = Nothing >> Nothing
+
+b = id <$> Nothing
+c = intersperse "," ["a","b"]

@@ -0,0 +1,13 @@+{-# LANGUAGE CPP #-}
+module CPP.ConditionalImportOrder where
+
+import Data.List (intersperse)
+#ifndef USE_DATA_LIST
+import Control.Monad (Monad(..))
+#endif
+import Control.Applicative ((<$>))
+
+a = Nothing >> Nothing
+
+b = id <$> Nothing
+c = intersperse "," ["a","b"]

@@ -1,8 +1,10 @@ {-# LANGUAGE CPP #-}
 module CPP.ConditionalImport where
 
+
 #ifndef USE_DATA_LIST
 import Control.Monad (Monad(..))
 #endif
+
 
 a = Nothing >> Nothing

@@ -1,4 +1,4 @@-{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE PackageImports, Safe #-}
 module Module.Import where
 
 import Data.List
@@ -8,4 +8,4 @@ import Data.List as List
 import Data.List(map,(++))
 import Data.Function hiding ((&))
-import Control.Monad.Writer hiding (Alt, Writer())
+import safe Control.Monad.Writer hiding (Alt, Writer())

@@ -0,0 +1,8 @@+module Refactor.RenameDefinition.CrossRename where
+
+-- Renaming f to g should fail
+f x = x
+
+ff x = g
+  where
+    g = f 'g'

@@ -1,10 +0,0 @@-{-# LANGUAGE ImplicitParams #-}
-
-module Refactor.RenameDefinition.ImplicitParams where
-
-import Data.List
-
-sort' :: (?cmp :: a -> a -> Ordering) => [a] -> [a]
-sort' = sortBy ?cmp
-
-main = let ?cmp = compare in putStrLn (show (sort' [3,1,2]))

@@ -1,10 +0,0 @@-{-# LANGUAGE ImplicitParams #-}
-
-module Refactor.RenameDefinition.ImplicitParams where
-
-import Data.List
-
-sort' :: (?compare :: a -> a -> Ordering) => [a] -> [a]
-sort' = sortBy ?compare
-
-main = let ?cmp = compare in putStrLn (show (sort' [3,1,2]))

@@ -0,0 +1,10 @@+module Refactor.RenameDefinition.MergeFields where
+
+data A = B { x :: Double } | C { y :: Double }
+
+data A2 = A2 { x2 :: Double, y2 :: Double }
+
+data A3 = B3 { x3 :: Double } | C3 { y3 :: Int }
+
+f a = case a of B {} -> x a
+                C {} -> y a

@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.MergeFields_RenameY where
+
+data A = B { x :: Double } | C { y :: Double }
+
+f a = case a of B {} -> x a
+                C {} -> y a

@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.MergeFields_RenameY where
+
+data A = B { x :: Double } | C { x :: Double }
+
+f a = case a of B {} -> x a
+                C {} -> x a

@@ -0,0 +1,10 @@+module Refactor.RenameDefinition.MergeFields where
+
+data A = B { y :: Double } | C { y :: Double }
+
+data A2 = A2 { x2 :: Double, y2 :: Double }
+
+data A3 = B3 { x3 :: Double } | C3 { y3 :: Int }
+
+f a = case a of B {} -> y a
+                C {} -> y a

@@ -0,0 +1,4 @@+module Refactor.RenameDefinition.RenameModuleAlias where
+
+import Data.List as LL
+foo = LL.intersperse "," ["a","b"]

@@ -0,0 +1,4 @@+module Refactor.RenameDefinition.RenameModuleAlias where
+
+import Data.List as L
+foo = L.intersperse "," ["a","b"]

@@ -1,5 +1,5 @@ name:                haskell-tools-refactor
-version:             0.6.0.0
+version:             0.7.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
@@ -61,6 +61,7 @@                      , Language.Haskell.Tools.Refactor.ListOperations
                      , Language.Haskell.Tools.Refactor.Session
                      , Language.Haskell.Tools.Refactor.Helpers
+                     , Language.Haskell.Tools.Refactor.ChangeAST
 
                      , Language.Haskell.Tools.Refactor.Predefined.GenerateTypeSignature
                      , Language.Haskell.Tools.Refactor.Predefined.OrganizeImports
@@ -90,10 +91,10 @@                      , template-haskell          >= 2.11 && < 2.12
                      , ghc                       >= 8.0  && < 8.1
                      , Cabal                     >= 1.24 && < 1.25
-                     , haskell-tools-ast         >= 0.6  && < 0.7
-                     , haskell-tools-backend-ghc >= 0.6  && < 0.7
-                     , haskell-tools-rewrite     >= 0.6  && < 0.7
-                     , haskell-tools-prettyprint >= 0.6  && < 0.7
+                     , haskell-tools-ast         >= 0.7  && < 0.8
+                     , haskell-tools-backend-ghc >= 0.7  && < 0.8
+                     , haskell-tools-rewrite     >= 0.7  && < 0.8
+                     , haskell-tools-prettyprint >= 0.7  && < 0.8
   default-language:    Haskell2010
 
 test-suite haskell-tools-test
@@ -118,11 +119,11 @@                      , ghc                       >= 8.0  && < 8.1
                      , ghc-paths                 >= 0.1  && < 0.2
                      , Cabal                     >= 1.24 && < 1.25
-                     , haskell-tools-ast         >= 0.6  && < 0.7
-                     , haskell-tools-backend-ghc >= 0.6  && < 0.7
-                     , haskell-tools-rewrite     >= 0.6  && < 0.7
-                     , haskell-tools-prettyprint >= 0.6  && < 0.7
-                     , haskell-tools-refactor    >= 0.6  && < 0.7
+                     , haskell-tools-ast         >= 0.7  && < 0.8
+                     , haskell-tools-backend-ghc >= 0.7  && < 0.8
+                     , haskell-tools-rewrite     >= 0.7  && < 0.8
+                     , haskell-tools-prettyprint >= 0.7  && < 0.8
+                     , haskell-tools-refactor    >= 0.7  && < 0.8
                      -- libraries used by the examples
                      , old-time                  >= 1.1  && < 1.2
                      , polyparse                 >= 1.12 && < 1.13

@@ -253,6 +253,11 @@   , "Refactor.OrganizeImports.TemplateHaskell"
   , "Refactor.OrganizeImports.NarrowType"
   , "CPP.ConditionalImport"
+  , "CPP.ConditionalImportBegin"
+  , "CPP.ConditionalImportEnd"
+  , "CPP.ConditionalImportHalfRemoved"
+  , "CPP.ConditionalImportMulti"
+  , "CPP.ConditionalImportOrder"
   ]
 
 generateSignatureTests =
@@ -309,12 +314,14 @@   , ("Refactor.RenameDefinition.TypeOperators", "4:13-4:15", "x1")
   , ("Refactor.RenameDefinition.NoPrelude", "4:1-4:2", "map")
   , ("Refactor.RenameDefinition.UnusedDef", "3:1-3:2", "map")
-  , ("Refactor.RenameDefinition.ImplicitParams", "8:17-8:20", "compare")
   , ("Refactor.RenameDefinition.SameCtorAndType", "3:6-3:13", "P2D")
   , ("Refactor.RenameDefinition.RoleAnnotation", "4:11-4:12", "AA")
   , ("Refactor.RenameDefinition.TypeBracket", "6:6-6:7", "B")
   , ("Refactor.RenameDefinition.ValBracket", "8:11-8:12", "B")
   , ("Refactor.RenameDefinition.FunnyDo", "3:1-3:2", "aaa")
+  , ("Refactor.RenameDefinition.RenameModuleAlias", "3:21-3:23", "L")
+  , ("Refactor.RenameDefinition.MergeFields", "3:14-3:15", "y")
+  , ("Refactor.RenameDefinition.MergeFields_RenameY", "3:34-3:35", "x")
   ]
 
 wrongRenameDefinitionTests =
@@ -330,6 +337,12 @@   , ("Refactor.RenameDefinition.WrongName", "9:19-9:19", ".+++.")
   , ("Refactor.RenameDefinition.WrongName", "11:3-11:3", ":+++:")
   , ("Refactor.RenameDefinition.IllegalQualRename", "4:30-4:34", "Bl")
+  , ("Refactor.RenameDefinition.CrossRename", "4:1-4:2", "g")
+  , ("Refactor.RenameDefinition.MergeFields", "5:16-5:18", "y2") -- fld in the same ctor
+  , ("Refactor.RenameDefinition.MergeFields", "5:30-5:32", "x2") -- fld in the same ctor
+  , ("Refactor.RenameDefinition.MergeFields", "5:16-5:18", "y") -- fld belongs to other type
+  , ("Refactor.RenameDefinition.MergeFields", "7:16-7:18", "y3") -- types does not match
+  , ("Refactor.RenameDefinition.MergeFields", "7:38-7:40", "x3") -- types does not match
   ]
 
 extractBindingTests =