packages feed

haskell-tools-refactor 0.4.1.3 → 0.5.0.0

raw patch · 69 files changed

+645/−127 lines, 69 filesdep +old-timedep +polyparsedep ~haskell-tools-astdep ~haskell-tools-backend-ghcdep ~haskell-tools-prettyprintPVP ok

version bump matches the API change (PVP)

Dependencies added: old-time, polyparse

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

API changes (from Hackage documentation)

- Language.Haskell.Tools.Refactor.ListOperations: replaceWithJust :: Ann e dom SrcTemplateStage -> AnnMaybe e dom -> AnnMaybe e dom
+ Language.Haskell.Tools.Refactor: data Ann (elem :: * -> * -> *) dom stage :: (* -> * -> *) -> * -> * -> *
+ Language.Haskell.Tools.Refactor.Helpers: normalizeElements :: [Ann e dom SrcTemplateStage] -> [Ann e dom SrcTemplateStage]
+ Language.Haskell.Tools.Refactor.Helpers: removeEmptyBnds :: Simple Traversal (Module dom) (ValueBind dom) -> Simple Traversal (Module dom) (Expr dom) -> Module dom -> Module dom
+ Language.Haskell.Tools.Refactor.Helpers: replaceWithJust :: Ann e dom SrcTemplateStage -> AnnMaybe e dom -> AnnMaybe e dom
+ Language.Haskell.Tools.Refactor.Helpers: replaceWithNothing :: AnnMaybe e dom -> AnnMaybe e dom
+ Language.Haskell.Tools.Refactor.Perform: FloatOut :: RealSrcSpan -> RefactorCommand
+ Language.Haskell.Tools.Refactor.Predefined.FloatOut: Extracted :: [LocalBind dom] -> FloatState dom
+ Language.Haskell.Tools.Refactor.Predefined.FloatOut: Inserted :: FloatState dom
+ Language.Haskell.Tools.Refactor.Predefined.FloatOut: NotEncountered :: FloatState dom
+ Language.Haskell.Tools.Refactor.Predefined.FloatOut: checkConflict :: forall dom. FloatOutDefinition dom => LocalBind dom -> ([String], [String])
+ Language.Haskell.Tools.Refactor.Predefined.FloatOut: data FloatState dom
+ Language.Haskell.Tools.Refactor.Predefined.FloatOut: extractAndInsert :: FloatOutDefinition dom => RealSrcSpan -> LocalBindList dom -> StateT (FloatState dom) (LocalRefactor dom) (LocalBindList dom)
+ Language.Haskell.Tools.Refactor.Predefined.FloatOut: floatOut :: FloatOutDefinition dom => RealSrcSpan -> LocalRefactoring dom
+ Language.Haskell.Tools.Refactor.Predefined.FloatOut: type FloatOutDefinition dom = (HasNameInfo dom, HasScopeInfo dom)
+ Language.Haskell.Tools.Refactor.Prepare: reloadPkgDb :: Ghc ()
+ Language.Haskell.Tools.Refactor.RefactorBase: IllegalExtensions :: [String] -> RefactorException
+ Language.Haskell.Tools.Refactor.RefactorBase: SourceCodeProblem :: ErrorMessages -> RefactorException
+ Language.Haskell.Tools.Refactor.RefactorBase: UnknownException :: String -> RefactorException
+ Language.Haskell.Tools.Refactor.RefactorBase: data RefactorException
+ Language.Haskell.Tools.Refactor.RefactorBase: instance GHC.Exception.Exception Language.Haskell.Tools.Refactor.RefactorBase.RefactorException
+ Language.Haskell.Tools.Refactor.RefactorBase: instance GHC.Show.Show ErrUtils.ErrorMessages
+ Language.Haskell.Tools.Refactor.RefactorBase: instance GHC.Show.Show Language.Haskell.Tools.Refactor.RefactorBase.RefactorException
- Language.Haskell.Tools.Refactor.Session: handleErrors :: ExceptionMonad m => m a -> m (Either String a)
+ Language.Haskell.Tools.Refactor.Session: handleErrors :: ExceptionMonad m => m a -> m (Either RefactorException a)
- Language.Haskell.Tools.Refactor.Session: loadPackagesFrom :: IsRefactSessionState st => (ModSummary -> IO a) -> [FilePath] -> StateT st Ghc (Either String ([a], [String]))
+ Language.Haskell.Tools.Refactor.Session: loadPackagesFrom :: IsRefactSessionState st => (ModSummary -> IO a) -> [FilePath] -> StateT st Ghc (Either RefactorException ([a], [String]))
- Language.Haskell.Tools.Refactor.Session: reloadChangedModules :: IsRefactSessionState st => (ModSummary -> IO a) -> (ModSummary -> Bool) -> StateT st Ghc (Either String [a])
+ Language.Haskell.Tools.Refactor.Session: reloadChangedModules :: IsRefactSessionState st => (ModSummary -> IO a) -> (ModSummary -> Bool) -> StateT st Ghc (Either RefactorException [a])

Files

Language/Haskell/Tools/Refactor.hs view
@@ -1,22 +1,23 @@ -- | Defines the API for refactorings
 module Language.Haskell.Tools.Refactor 
-  ( module Language.Haskell.Tools.AST.SemaInfoClasses
-  , module Language.Haskell.Tools.AST.Rewrite
-  , module Language.Haskell.Tools.AST.References
-  , module Language.Haskell.Tools.AST.Helpers
-  , module Language.Haskell.Tools.Refactor.RefactorBase
-  , module Language.Haskell.Tools.AST.ElementTypes
-  , module Language.Haskell.Tools.Refactor.Prepare
-  , module Language.Haskell.Tools.Refactor.ListOperations
-  , module Language.Haskell.Tools.Refactor.BindingElem
-  , module Language.Haskell.Tools.IndentationUtils
-  , HasSourceInfo(..), HasRange(..), annListElems, annListAnnot, annList, annJust, annMaybe, isAnnNothing, Domain
-  , shortShowSpan, SrcTemplateStage, SourceInfoTraversal(..)
-  -- elements of source templates
-  , sourceTemplateNodeRange, sourceTemplateNodeElems
-  , sourceTemplateListRange, srcTmpListBefore, srcTmpListAfter, srcTmpDefaultSeparator, srcTmpIndented, srcTmpSeparators
-  , sourceTemplateOptRange, srcTmpOptBefore, srcTmpOptAfter
-  ) where
+    ( module Language.Haskell.Tools.AST.SemaInfoClasses
+    , module Language.Haskell.Tools.AST.Rewrite
+    , module Language.Haskell.Tools.AST.References
+    , module Language.Haskell.Tools.AST.Helpers
+    , module Language.Haskell.Tools.Refactor.RefactorBase
+  , module Language.Haskell.Tools.Refactor.Helpers
+    , module Language.Haskell.Tools.AST.ElementTypes
+    , module Language.Haskell.Tools.Refactor.Prepare
+    , module Language.Haskell.Tools.Refactor.ListOperations
+    , module Language.Haskell.Tools.Refactor.BindingElem
+    , module Language.Haskell.Tools.IndentationUtils
+  , Ann, HasSourceInfo(..), HasRange(..), annListElems, annListAnnot, annList, annJust, annMaybe, isAnnNothing, Domain
+    , shortShowSpan, SrcTemplateStage, SourceInfoTraversal(..)
+    -- elements of source templates
+    , sourceTemplateNodeRange, sourceTemplateNodeElems
+    , sourceTemplateListRange, srcTmpListBefore, srcTmpListAfter, srcTmpDefaultSeparator, srcTmpIndented, srcTmpSeparators
+    , sourceTemplateOptRange, srcTmpOptBefore, srcTmpOptAfter
+    ) where
 
 -- Important: Haddock doesn't support the rename all exported modules and export them at once hack
 
@@ -27,9 +28,10 @@ import Language.Haskell.Tools.AST.SemaInfoClasses
 import Language.Haskell.Tools.IndentationUtils
 import Language.Haskell.Tools.Refactor.BindingElem
+import Language.Haskell.Tools.Refactor.Helpers
 import Language.Haskell.Tools.Refactor.ListOperations
 import Language.Haskell.Tools.Refactor.Prepare
 import Language.Haskell.Tools.Refactor.RefactorBase
 import Language.Haskell.Tools.Transform
 
-import Language.Haskell.Tools.AST.Ann+import Language.Haskell.Tools.AST.Ann
Language/Haskell/Tools/Refactor/BindingElem.hs view
@@ -7,7 +7,7 @@ import Control.Reference
 import Language.Haskell.Tools.AST
 import Language.Haskell.Tools.AST.Rewrite
-import SrcLoc (RealSrcSpan(..))
+import SrcLoc (RealSrcSpan)
 
 -- | A type class for handling definitions that can appear as both top-level and local definitions
 class NamedElement d => BindingElem d where
Language/Haskell/Tools/Refactor/GetModules.hs view
@@ -4,6 +4,7 @@            , TemplateHaskell
            , FlexibleContexts
            #-}
+-- | Representation and operations for module collections (libraries, executables, ...) in the framework.
 module Language.Haskell.Tools.Refactor.GetModules where
 
 import Control.Reference
@@ -11,12 +12,14 @@ import Data.List (intersperse, find, sortBy)
 import qualified Data.Map as Map
 import Data.Maybe
+import Distribution.Compiler
 import Distribution.ModuleName (components)
 import Distribution.ModuleName
 import Distribution.Package (Dependency(..), PackageName(..), pkgName)
 import Distribution.PackageDescription
 import Distribution.PackageDescription.Configuration
 import Distribution.PackageDescription.Parse
+import Distribution.System
 import Distribution.Verbosity (silent)
 import Language.Haskell.Extension
 import System.Directory
@@ -49,6 +52,7 @@   show (ModuleCollection id root srcDirs mods _ deps) 
     = "ModuleCollection (" ++ show id ++ ") " ++ root ++ " " ++ show srcDirs ++ " (" ++ show mods ++ ") " ++ show deps
 
+-- | The state of a module.
 data ModuleRecord 
        = ModuleNotLoaded { _recModuleWillNeedCode :: Bool }
        | ModuleParsed { _parsedRecModule :: UnnamedModule (Dom RdrName)
@@ -64,7 +68,7 @@                              , _modRecMS :: ModSummary
                              }
 
--- | This data structure identifies a module collection
+-- | This data structure identifies a module collection.
 data ModuleCollectionId = DirectoryMC FilePath
                         | LibraryMC String
                         | ExecutableMC String String
@@ -93,7 +97,7 @@   show (ModuleNotLoaded code) = "ModuleNotLoaded " ++ show code
   show mr = GHC.moduleNameString $ GHC.moduleName $ GHC.ms_mod $ fromJust $ mr ^? modRecMS
 
-
+-- | Find the module collection where the given module is.
 lookupModuleColl :: String -> [ModuleCollection] -> Maybe (ModuleCollection)
 lookupModuleColl moduleName = find (any ((moduleName ==) . (^. sfkModuleName)) . Map.keys . (^. mcModules))
 
@@ -149,6 +153,7 @@           Nothing        -> do mods <- modulesFromDirectory root root
                                return [ModuleCollection (DirectoryMC root) root [root] (Map.fromList $ map ((, ModuleNotLoaded False) . SourceFileKey NormalHs) mods) return []]
 
+-- | Load the module giving a directory. All modules loaded from the folder and subfolders.
 modulesFromDirectory :: FilePath -> FilePath -> IO [String]
 -- now recognizing only .hs files
 modulesFromDirectory root searchRoot = concat <$> (mapM goOn =<< listDirectory searchRoot)
@@ -165,24 +170,32 @@ srcDirFromRoot fileName moduleName 
   = srcDirFromRoot (takeDirectory fileName) (dropWhile (/= '.') $ dropWhile (== '.') moduleName)
 
+-- | Load the module using a cabal file. The modules described in the cabal file will be loaded.
+-- The flags and extensions set in the cabal file will be used by default.
 modulesFromCabalFile :: FilePath -> FilePath -> IO [ModuleCollection]
 -- now adding all conditional entries, regardless of flags
-modulesFromCabalFile root cabal = getModules . flattenPackageDescription <$> readPackageDescription silent (root </> cabal)
-  where getModules pkg = maybe [] ((:[]) . toModuleCollection pkg) (library pkg) 
-                           ++ map (toModuleCollection pkg) (executables pkg) 
-                           ++ map (toModuleCollection pkg) (testSuites pkg) 
-                           ++ map (toModuleCollection pkg) (benchmarks pkg)
+modulesFromCabalFile root cabal = getModules . setupFlags <$> readPackageDescription silent (root </> cabal)
+  where getModules pkg = maybe [] (maybe [] (:[]) . toModuleCollection pkg) (library pkg) 
+                           ++ catMaybes (map (toModuleCollection pkg) (executables pkg)) 
+                           ++ catMaybes (map (toModuleCollection pkg) (testSuites pkg)) 
+                           ++ catMaybes (map (toModuleCollection pkg) (benchmarks pkg))
            
-        toModuleCollection :: ToModuleCollection tmc => PackageDescription -> tmc -> ModuleCollection
-        toModuleCollection pkg tmc = let bi = getBuildInfo tmc 
-                                      in ModuleCollection (mkModuleCollKey (pkgName $ package pkg) tmc) 
-                                                          root
-                                                          (map (normalise . (root </>)) $ hsSourceDirs bi) 
-                                                          (Map.fromList $ map ((, ModuleNotLoaded False) . SourceFileKey NormalHs . moduleName) (getModuleNames tmc)) 
-                                                          (flagsFromBuildInfo bi)
-                                                          (map (\(Dependency pkgName _) -> LibraryMC (unPackageName pkgName)) (targetBuildDepends bi)) 
+        toModuleCollection :: ToModuleCollection tmc => PackageDescription -> tmc -> Maybe ModuleCollection
+        toModuleCollection pkg tmc 
+          = let bi = getBuildInfo tmc 
+             in if buildable bi
+                  then Just $ ModuleCollection (mkModuleCollKey (pkgName $ package pkg) tmc) 
+                                root
+                                (map (normalise . (root </>)) $ hsSourceDirs bi) 
+                                (Map.fromList $ map ((, ModuleNotLoaded False) . SourceFileKey NormalHs . moduleName) (getModuleNames tmc)) 
+                                (flagsFromBuildInfo bi)
+                                (map (\(Dependency pkgName _) -> LibraryMC (unPackageName pkgName)) (targetBuildDepends bi)) 
+                  else Nothing
 
         moduleName = concat . intersperse "." . components
+        setupFlags = either (\deps -> error $ "Missing dependencies: " ++ show deps) fst 
+                       . finalizePackageDescription [] (const True) buildPlatform 
+                                                    (unknownCompilerInfo buildCompilerId NoAbiTag) []
 
 class ToModuleCollection t where 
   mkModuleCollKey :: PackageName -> t -> ModuleCollectionId
@@ -197,7 +210,8 @@ instance ToModuleCollection Executable where
   mkModuleCollKey pn exe = ExecutableMC (unPackageName pn) (exeName exe)
   getBuildInfo = buildInfo
-  getModuleNames = exeModules
+  getModuleNames e = {- fromString (toModuleName $ modulePath e) : -} exeModules e
+    where toModuleName = map (\case c | c `elem` pathSeparators -> '.'; c -> c) . dropExtension
 
 instance ToModuleCollection TestSuite where
   mkModuleCollKey pn test = TestSuiteMC (unPackageName pn) (testName test)
@@ -231,13 +245,14 @@ 
 flagsFromBuildInfo :: BuildInfo -> DynFlags -> IO DynFlags
 -- the import pathes are already set globally
-flagsFromBuildInfo BuildInfo{ defaultExtensions, options } df
+flagsFromBuildInfo bi@BuildInfo{ options } df
   = do (df,_,_) <- parseDynamicFlags df (map (L noSrcSpan) $ concatMap snd options)
        return $ foldl (.) id (map (\case EnableExtension ext -> translateExtension ext
                                          _                   -> id                               
-                                  ) defaultExtensions)
+                                  ) (usedExtensions bi))
                           $ df
-  where translateExtension OverlappingInstances = flip xopt_set GHC.OverlappingInstances
+  where -- | Map the cabal extensions to the ones that GHC recognizes
+        translateExtension OverlappingInstances = flip xopt_set GHC.OverlappingInstances
         translateExtension UndecidableInstances = flip xopt_set GHC.UndecidableInstances
         translateExtension IncoherentInstances = flip xopt_set GHC.IncoherentInstances
         translateExtension DoRec = flip xopt_set GHC.RecursiveDo
+ Language/Haskell/Tools/Refactor/Helpers.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE LambdaCase
+           , RankNTypes
+           , FlexibleContexts
+           #-}
+-- | Helper functions for defining refactorings.
+module Language.Haskell.Tools.Refactor.Helpers where
+
+import Control.Reference
+import Data.Function (on)
+import Data.List (sortBy, nubBy)
+
+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)
+
+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 .= Nothing
+
+-- | Remove the container (where or let) when the last binding is removed.
+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 _ _ _) 
+          = (valBindLocals .- removeIfEmpty) . (valBindRhs .- removeEmptyGuards) $ sb
+        removeEmptyBindsAndGuards fb@(FunctionBind _) 
+          = (funBindMatches & annList & matchBinds .- removeIfEmpty) . (funBindMatches & annList & matchRhs .- removeEmptyGuards) $ fb
+
+        removeEmptyGuards rhs = rhsGuards & annList & guardStmts .- filterList (\case GuardLet (AnnList []) -> False; _ -> True) $ rhs
+
+        removeIfEmpty mb@(AnnJust (LocalBinds (AnnList []))) = annMaybe .= Nothing $ mb
+        removeIfEmpty mb = mb
+
+        removeEmptyLetsAndStmts (Let (AnnList []) e) = e
+        removeEmptyLetsAndStmts e = exprStmts .- removeEmptyStmts $ e
+
+        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)
+normalizeElements :: [Ann e dom SrcTemplateStage] -> [Ann e dom SrcTemplateStage]
+normalizeElements elems = nubBy ((==) `on` getRange) $ sortBy (compare `on` srcSpanStart . getRange) elems
Language/Haskell/Tools/Refactor/ListOperations.hs view
@@ -6,7 +6,7 @@ import Control.Reference
 
 import Language.Haskell.Tools.AST
-import Language.Haskell.Tools.AST.Rewrite (AnnMaybe(..), AnnList(..))
+import Language.Haskell.Tools.AST.Rewrite (AnnList)
 import Language.Haskell.Tools.Transform (srcTmpDefaultSeparator, srcTmpSeparators)
 
 -- | Filters the elements of the list. By default it removes the separator before the element.
@@ -64,13 +64,12 @@           | before Nothing && after Nothing = Just 0
           | otherwise = Nothing
 
+-- | 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 (AnnListG (NodeInfo _ src) elems) 
   | [] <- src ^. srcTmpSeparators 
-  = map (src ^. srcTmpDefaultSeparator ,) elems
+  = zip ("" : repeat (src ^. srcTmpDefaultSeparator)) elems
   | otherwise 
   = zip ("" : seps ++ repeat (last seps)) elems
   where seps = src ^. srcTmpSeparators
-
-replaceWithJust :: Ann e dom SrcTemplateStage -> AnnMaybe e dom -> AnnMaybe e dom           
-replaceWithJust e (AnnMaybeG temp _) = AnnMaybeG temp (Just e)
Language/Haskell/Tools/Refactor/Perform.hs view
@@ -17,6 +17,7 @@ 
 import Language.Haskell.Tools.AST as AST
 import Language.Haskell.Tools.Refactor.Predefined.ExtractBinding
+import Language.Haskell.Tools.Refactor.Predefined.FloatOut
 import Language.Haskell.Tools.Refactor.Predefined.GenerateExports
 import Language.Haskell.Tools.Refactor.Predefined.GenerateTypeSignature
 import Language.Haskell.Tools.Refactor.Predefined.InlineBinding
@@ -41,6 +42,7 @@         selectCommand (RenameDefinition sp str) = renameDefinition' (correctRefactorSpan (snd mod) sp) str
         selectCommand (ExtractBinding sp str) = localRefactoring $ extractBinding' (correctRefactorSpan (snd mod) sp) str
         selectCommand (InlineBinding sp) = inlineBinding (correctRefactorSpan (snd mod) sp)
+        selectCommand (FloatOut sp) = localRefactoring $ floatOut (correctRefactorSpan (snd mod) sp)
 
 -- | A refactoring command
 data RefactorCommand = NoRefactor 
@@ -51,12 +53,15 @@                      | RenameDefinition RealSrcSpan String
                      | ExtractBinding RealSrcSpan String
                      | InlineBinding RealSrcSpan
+                     | FloatOut RealSrcSpan
     deriving Show
 
+-- | Recognize a command from its textual representation
 readCommand :: String -> RefactorCommand
 readCommand (splitOn " " -> refact:args) = analyzeCommand refact args
 readCommand _ = error "panic: splitOn resulted empty"
 
+-- | Check the parts and return the command
 analyzeCommand :: String -> [String] -> RefactorCommand
 analyzeCommand "" _ = NoRefactor
 analyzeCommand "CheckSource" _ = NoRefactor
@@ -67,5 +72,6 @@ analyzeCommand "RenameDefinition" [sp, newName] = RenameDefinition (readSrcSpan sp) newName
 analyzeCommand "ExtractBinding" [sp, newName] = ExtractBinding (readSrcSpan sp) newName
 analyzeCommand "InlineBinding" [sp] = InlineBinding (readSrcSpan sp)
+analyzeCommand "FloatOut" [sp] = FloatOut (readSrcSpan sp)
 analyzeCommand ref _ = error $ "Unknown command: " ++ ref
 
Language/Haskell/Tools/Refactor/Predefined/ExtractBinding.hs view
@@ -10,16 +10,23 @@ module Language.Haskell.Tools.Refactor.Predefined.ExtractBinding (extractBinding', ExtractBindingDomain, tryItOut) where
 
 import qualified GHC
+import Name (nameModule_maybe)
 import qualified OccName as GHC (occNameString)
-import SrcLoc (SrcSpan(..), RealSrcSpan(..))
+import OccName (HasOccName(..))
+import PrelNames
+import RdrName (isOrig_maybe)
+import SrcLoc
 
 import Control.Monad.State
 import Control.Reference
 import Data.Generics.Uniplate.Data ()
+import Data.List (find)
 import Data.Maybe
 
 import Language.Haskell.Tools.Refactor
 
+-- | We need name information to identify bindings, and scope information to check which
+-- entities must be directly passed as parameters.
 type ExtractBindingDomain dom = ( HasNameInfo dom, HasDefiningInfo dom, HasScopeInfo dom )
 
 tryItOut :: String -> String -> String -> IO ()
@@ -27,24 +34,27 @@ 
 extractBinding' :: ExtractBindingDomain dom => RealSrcSpan -> String -> LocalRefactoring dom
 extractBinding' sp name mod
-  = if isValidBindingName name then extractBinding (nodesContaining sp) (nodesContaining sp) name mod
+  = if isValidBindingName name then extractBinding sp (nodesContaining sp) (nodesContaining sp) name mod
                                else refactError "The given name is not a valid for the extracted binding"
 
 -- | Safely performs the transformation to introduce the local binding and replace the expression with the call.
 -- Checks if the introduction of the name causes a name conflict.
 extractBinding :: forall dom . ExtractBindingDomain dom 
-               => Simple Traversal (Module dom) (ValueBind dom)
+               => RealSrcSpan -> Simple Traversal (Module dom) (ValueBind dom)
                    -> Simple Traversal (ValueBind dom) (Expr dom)
                    -> String -> LocalRefactoring dom
-extractBinding selectDecl selectExpr name mod
+extractBinding sp selectDecl selectExpr name mod
   = let conflicting = any (isConflicting name) (mod ^? selectDecl & biplateRef :: [QualifiedName dom])
-        exprRange = getRange $ head (mod ^? selectDecl & selectExpr)
+        exprRanges = map getRange (mod ^? selectDecl & selectExpr)
         decl = last (mod ^? selectDecl)
-     in if conflicting
-           then refactError "The given name causes name conflict."
-           else do (res, st) <- runStateT (selectDecl&selectExpr !~ extractThatBind name (head $ decl ^? actualContainingExpr exprRange) $ mod) Nothing
-                   case st of Just def -> return $ evalState (selectDecl !~ addLocalBinding exprRange def $ res) False
-                              Nothing -> refactError "There is no applicable expression to extract."
+     in case exprRanges of 
+          exprRange:_ -> 
+            if conflicting
+              then refactError "The given name causes name conflict."
+              else do (res, st) <- runStateT (selectDecl&selectExpr !~ extractThatBind sp name (head $ decl ^? actualContainingExpr exprRange) $ mod) Nothing
+                      case st of Just def -> return $ evalState (selectDecl !~ addLocalBinding exprRange def $ res) False
+                                 Nothing -> refactError "There is no applicable expression to extract."
+          [] -> refactError "There is no applicable expression to extract."
 
 -- | Decides if a new name defined to be the given string will conflict with the given AST element
 isConflicting :: ExtractBindingDomain dom => String -> QualifiedName dom -> Bool
@@ -54,17 +64,60 @@ 
 -- Replaces the selected expression with a call and generates the called binding.
 extractThatBind :: ExtractBindingDomain dom 
-                => String -> Expr dom -> Expr dom -> StateT (Maybe (ValueBind dom)) (LocalRefactor dom) (Expr dom)
-extractThatBind name cont e 
-  = do ret <- get
+                => RealSrcSpan -> String -> Expr dom -> Expr dom -> StateT (Maybe (ValueBind dom)) (LocalRefactor dom) (Expr dom)
+extractThatBind sp name cont e 
+  = do ret <- get -- being in a state monad to only apply the 
        if (isJust ret) then return e 
           else case e of
+            -- only the expression inside the parameters should be extracted
             Paren {} | hasParameter -> exprInner !~ doExtract name cont $ e
                      | otherwise    -> doExtract name cont (fromJust $ e ^? exprInner)
+            -- a single variable cannot be extracted (would lead to precedence problems)
             Var {} -> lift $ refactError "The selected expression is too simple to be extracted."
+            -- extract operator sections
+            InfixApp lhs op rhs
+               | (lhs `outside` sp) && (sp `encloses` op) && (sp `encloses` rhs)
+               -> do let params = getExternalBinds cont rhs ++ opName op
+                     put (Just (generateBind name (map mkVarPat params) (mkRightSection op (parenIfInfix rhs))))
+                     return (mkApp (generateCall name params) (parenIfInfix lhs))
+               | (sp `encloses` lhs) && (sp `encloses` op) && (rhs `outside` sp)
+               -> do let params = getExternalBinds cont lhs ++ opName op
+                     put (Just (generateBind name (map mkVarPat params) (mkLeftSection (parenIfInfix lhs) op)))
+                     return (mkApp (generateCall name params) (parenIfInfix rhs))
+              where parenIfInfix e@(InfixApp {}) = mkParen e
+                    parenIfInfix e = e
+            -- extract parts of known associative infix operators
+            InfixApp (InfixApp lhs lop mid) rop rhs -- correction for left-associative operators
+              | (Just lName, Just rName) <- (semanticsName (lop ^. operatorName), semanticsName (rop ^. operatorName))
+              , (lop `outside` sp) && (sp `encloses` mid) && (sp `encloses` rhs)
+                  && lName == rName && isKnownCommutativeOp lName
+              -> do let params = getExternalBinds cont mid ++ opName rop ++ getExternalBinds cont rhs
+                    put (Just (generateBind name (map mkVarPat params) (mkInfixApp mid rop rhs)))
+                    return (mkInfixApp lhs lop (generateCall name params)) 
+            InfixApp lhs lop (InfixApp mid rop rhs) -- correction for right-associative operators
+              | (Just lName, Just rName) <- (semanticsName (lop ^. operatorName), semanticsName (rop ^. operatorName))
+              , (sp `encloses` lhs) && (sp `encloses` mid) && (rop `outside` sp)
+                  && lName == rName && isKnownCommutativeOp lName
+              -> do let params = getExternalBinds cont lhs ++ opName lop ++ getExternalBinds cont mid
+                    put (Just (generateBind name (map mkVarPat params) (mkInfixApp lhs lop mid)))
+                    return (mkInfixApp (generateCall name params) rop rhs) 
+            -- normal case
             el | isParenLikeExpr el && hasParameter -> mkParen <$> doExtract name cont e
                | otherwise -> doExtract name cont e
   where hasParameter = not (null (getExternalBinds cont e))
+        -- True if the elem is completely inside the given source range
+        sp `encloses` elem = case getRange elem of RealSrcSpan enc -> sp `containsSpan` enc
+                                                   _               -> False
+        -- True if the elem is completely outside the given range (no overlapping)
+        elem `outside` sp = case getRange elem of RealSrcSpan out -> realSrcSpanStart sp > realSrcSpanEnd out 
+                                                                       || realSrcSpanEnd sp < realSrcSpanStart out
+                                                  _ -> False
+        opName op = case semanticsName (op ^. operatorName) of 
+                      Nothing -> []
+                      Just n -> [mkUnqualName' n | not $ n `inScope` semanticsScope cont]
+        isKnownCommutativeOp :: GHC.Name -> Bool
+        isKnownCommutativeOp n = isJust $ find (maybe False (\(mn, occ) -> (nameModule_maybe n) == Just mn && occName n == occ) . isOrig_maybe) ops 
+          where ops = [plus_RDR, times_RDR, append_RDR, and_RDR, {- or_RDR, -} compose_RDR] -- somehow or is missing... WHY?
 
 -- | Adds a local binding to the where clause of the enclosing binding
 addLocalBinding :: SrcSpan -> ValueBind dom -> ValueBind dom -> State Bool (ValueBind dom)
+ Language/Haskell/Tools/Refactor/Predefined/FloatOut.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE LambdaCase
+           , ConstraintKinds
+           , FlexibleContexts
+           , ViewPatterns
+           , TypeApplications
+           , ScopedTypeVariables
+           #-}
+module Language.Haskell.Tools.Refactor.Predefined.FloatOut where
+
+import Control.Monad.State
+import Control.Reference
+import Data.List
+import Data.Maybe (Maybe(..), catMaybes)
+
+import Language.Haskell.Tools.Refactor
+
+import Name as GHC (Name, NamedThing(..), occNameString)
+import OccName (occNameString)
+import SrcLoc (RealSrcSpan)
+
+type FloatOutDefinition dom = (HasNameInfo dom, HasScopeInfo dom)
+
+floatOut :: FloatOutDefinition dom => RealSrcSpan -> LocalRefactoring dom
+floatOut sp mod 
+  = do (mod', st) <- runStateT (nodesContaining sp !~ extractAndInsert sp $ mod) NotEncountered
+       case st of NotEncountered -> refactError "No definition is selected."
+                  Extracted bnds -> -- insert it to the global definition list
+                                    return $ modDecl & annListElems .- (++ map toTopLevel bnds) $ removeEmpties mod'
+                  Inserted -> -- already inserted to a local scope
+                               return (removeEmpties mod')
+  where toTopLevel :: LocalBind dom -> Decl dom
+        toTopLevel (LocalValBind vb) = mkValueBinding vb
+        toTopLevel (LocalTypeSig sg) = mkTypeSigDecl sg
+        toTopLevel (LocalFixity fx) = mkFixityDecl fx
+
+        removeEmpties = removeEmptyBnds (nodesContaining sp) (nodesContaining sp)
+
+data FloatState dom = NotEncountered | Extracted [LocalBind dom] | Inserted
+
+extractAndInsert :: FloatOutDefinition dom => RealSrcSpan -> LocalBindList dom -> StateT (FloatState dom) (LocalRefactor dom) (LocalBindList dom)
+extractAndInsert sp locs 
+  | hasSharedSig = refactError "Cannot float out a definition, since it has a signature shared with other bindings that stay in the scope."
+  | not (null nameConflicts) = refactError $ "Cannot float out a definition, since it would cause a name conflicts in the target scope: " 
+                                                ++ concat (intersperse ", " nameConflicts)
+  | not (null implicitConflicts) = refactError $ "Cannot float out a definition, since it uses the implicit parameters: "
+                                                   ++ concat (intersperse ", " implicitConflicts)
+  | otherwise = get >>= \case NotEncountered -> put (Extracted floated) >> return filteredLocs
+                              Extracted binds -> put Inserted >> (return $ annListElems .- (++ binds) $ locs)
+                              Inserted -> return locs
+  where selected = locs ^? annList & filtered (isInside sp)
+        floated = normalizeElements $ selected ++ (locs ^? annList & filtered (nameIsSelected . (^? elementName)))
+          where nameIsSelected [n] = n `elem` concatMap (^? elementName) selected 
+                nameIsSelected _ = False
+
+        filteredLocs = filterList (\e -> not (getRange e `elem` floatedElemRanges)) locs
+          where floatedElemRanges = map getRange floated
+        hasSharedSig = any (\e -> not $ null ((filteredLocs ^? annList & elementName) `intersect` (e ^? elementName))) selected
+        conflicts = map checkConflict selected
+
+        nameConflicts = concat $ map fst conflicts
+        implicitConflicts = concat $ map snd conflicts
+
+checkConflict :: forall dom . FloatOutDefinition dom => LocalBind dom -> ([String], [String])
+checkConflict bnd = (concatMap @[] getConflict bndNames, implicits)
+  where bndNames = bnd ^? elementName
+        getConflict bndName = filter ((== nameStr) . Just) $ map (occNameString . getOccName) outerScope
+          where outerScope = concat $ take 1 $ drop 2 $ semanticsScope bndName 
+                nameStr = fmap (occNameString . getOccName) $ semanticsName bndName
+        implicits = map (occNameString . getOccName) 
+                        (concatMap getPossibleImplicits bndNames `intersect` getQNames (bnd ^? biplateRef))
+        
+        getQNames :: [QualifiedName dom] -> [GHC.Name]
+        getQNames = catMaybes . map semanticsName
+
+        getPossibleImplicits :: QualifiedName dom -> [GHC.Name]
+        getPossibleImplicits qn = concat (take 2 $ semanticsScope qn) \\ catMaybes (map semanticsName bndNames)
Language/Haskell/Tools/Refactor/Predefined/GenerateExports.hs view
@@ -8,11 +8,12 @@ import Control.Reference ((^?), (.=), (&))
 import Language.Haskell.Tools.Refactor
 
-import qualified GHC (NamedThing(..), Name(..))
+import qualified GHC (NamedThing(..), Name)
 
 import Control.Applicative ((<|>))
 import Data.Maybe (Maybe(..), catMaybes)
 
+-- | We need name information to generate exports
 type DomGenerateExports dom = (Domain dom, HasNameInfo dom)
 
 -- | Creates an export list that imports standalone top-level definitions with all of their contained definitions
Language/Haskell/Tools/Refactor/Predefined/IfToGuards.hs view
@@ -4,7 +4,7 @@ import Control.Reference ((^.), (.-), (&))
 import Data.Generics.Uniplate.Data ()
 import Language.Haskell.Tools.Refactor
-import SrcLoc (RealSrcSpan(..))
+import SrcLoc (RealSrcSpan)
 
 tryItOut :: String -> String -> IO ()
 tryItOut = tryRefactor (localRefactoring . ifToGuards)
Language/Haskell/Tools/Refactor/Predefined/InlineBinding.hs view
@@ -19,8 +19,8 @@ import Data.List (nub)
 import Data.Maybe (Maybe(..), catMaybes)
 
-import Name as GHC (NamedThing(..), Name(..), occNameString)
-import SrcLoc as GHC (SrcSpan(..), RealSrcSpan(..), containsSpan)
+import Name as GHC (NamedThing(..), Name, occNameString)
+import SrcLoc as GHC (SrcSpan(..), RealSrcSpan, containsSpan)
 
 import Language.Haskell.Tools.Refactor as AST
 
@@ -35,6 +35,8 @@         topLevel = nodesContaining span
         local :: Simple Traversal (Module dom) (LocalBindList dom)
         local = nodesContaining span
+        exprs :: Simple Traversal (Module dom) (Expr dom)
+        exprs = nodesContaining span
         elemAccess :: (BindingElem d) => AnnList d dom -> Maybe (ValueBind dom)
         elemAccess = getValBindInList span
         removed = catMaybes $ map elemAccess (mod ^? topLevel) ++ map elemAccess (mod ^? local)
@@ -47,21 +49,22 @@                   | _:_ <- 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 removedBinding removedBindingName) namedMod mods
+                  | 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) 
                     -> ValueBind dom -> GHC.Name
                     -> LocalRefactoring dom
-inlineBinding' topLevelRef localRef removedBinding removedBindingName mod
+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 
          then refactError "The selected definition is not used, it can be safely deleted."
-         else return $ removeBindingAndSig topLevelRef localRef removedBindingName mod'
+         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
@@ -72,10 +75,12 @@ 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 name
-  = (topLevelRef .- removeBindingAndSig' name) . (localRef .- removeBindingAndSig' name)
+removeBindingAndSig topLevelRef localRef exprRef name
+  = 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' name = (annList .- removeNameFromSigBind) . filterList notThatBindOrSig
@@ -131,7 +136,8 @@                          in joinApps (parenIfNeeded (createLambda matchedPats (wrapLocals locals (replaceExprs argReplacement expr)))) appliedArgs
   where getArgsOf (MatchLhs _ (AnnList args)) = args
         getArgsOf (InfixLhs lhs _ rhs (AnnList more)) = lhs:rhs:more
-createReplacement (FunctionBind matches) 
+createReplacement (FunctionBind matches)
+                                                 -- 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 
Language/Haskell/Tools/Refactor/Predefined/OrganizeImports.hs view
@@ -16,7 +16,7 @@ import Id
 import IdInfo (RecSelParent(..))
 import InstEnv (ClsInst(..))
-import Language.Haskell.TH.LanguageExtensions (Extension(..))
+import Language.Haskell.TH.LanguageExtensions as GHC (Extension(..))
 import Name (NamedThing(..))
 import TyCon (tyConFieldLabels, tyConDataCons, isClassTyCon)
 
@@ -40,12 +40,13 @@ organizeImports :: forall dom . OrganizeImportsDomain dom => LocalRefactoring dom
 organizeImports mod
   = do ms <- lift $ GHC.getModSummary (GHC.moduleName $ semanticsModule mod)
-       let th = xopt TemplateHaskell $ GHC.ms_hspp_opts ms
-       if th 
+       let noNarrowingImports = xopt TemplateHaskell (GHC.ms_hspp_opts ms)
+           noNarrowingSubspecs = xopt GHC.StandaloneDeriving (GHC.ms_hspp_opts ms)
+       if noNarrowingImports 
          then -- don't change the imports for template haskell modules 
               -- (we don't know what definitions the generated code will use)
               return $ modImports .- sortImports $ mod 
-         else modImports !~ narrowImports exportedModules usedNames prelInstances prelFamInsts . sortImports $ mod
+         else modImports !~ narrowImports noNarrowingSubspecs exportedModules usedNames prelInstances prelFamInsts . sortImports $ mod
   where prelInstances = semanticsPrelOrphanInsts mod
         prelFamInsts = semanticsPrelFamInsts mod
         usedNames = map getName $ catMaybes $ map semanticsName
@@ -78,39 +79,45 @@ 
 -- | Modify an import to only import  names that are used.
 narrowImports :: forall dom . OrganizeImportsDomain dom 
-              => [String] -> [GHC.Name] -> [ClsInst] -> [FamInst] -> ImportDeclList dom -> LocalRefactor dom (ImportDeclList dom)
-narrowImports exportedModules usedNames prelInsts prelFamInsts imps 
-  = annListElems & traversal !~ narrowImport exportedModules usedNames 
+              => Bool -> [String] -> [GHC.Name] -> [ClsInst] -> [FamInst] -> ImportDeclList dom -> LocalRefactor dom (ImportDeclList dom)
+narrowImports noNarrowSubspecs exportedModules usedNames prelInsts prelFamInsts imps 
+  = annListElems & traversal !~ narrowImport noNarrowSubspecs exportedModules usedNames 
       $ filterListIndexed (\i _ -> neededImps !! i) imps
   where neededImps = neededImports exportedModules usedNames prelInsts prelFamInsts (imps ^. annListElems)
 
 -- | Reduces the number of definitions used from an import
 narrowImport :: OrganizeImportsDomain dom
-             => [String] -> [GHC.Name] -> ImportDecl dom -> LocalRefactor dom (ImportDecl dom)
-narrowImport exportedModules usedNames imp
+             => Bool -> [String] -> [GHC.Name] -> ImportDecl dom -> LocalRefactor dom (ImportDecl dom)
+narrowImport noNarrowSubspecs exportedModules usedNames imp
   | (imp ^. importModule & moduleNameString) `elem` exportedModules
       || maybe False (`elem` exportedModules) (imp ^? importAs & annJust & importRename & moduleNameString)
   = return imp -- dont change an import if it is exported as-is (module export)
   | importIsExact imp
-  = importSpec&annJust&importSpecList !~ narrowImportSpecs usedNames $ imp
+  = importSpec&annJust&importSpecList !~ narrowImportSpecs noNarrowSubspecs usedNames $ imp
   | otherwise
   = do namedThings <- mapM lookupName actuallyImported
        let -- to explicitely import pattern synonyms we need to enable an extension, and the user might not expect this
            hasPatSyn = any (\case Just (AConLike (PatSynCon _)) -> True; _ -> False) namedThings
-           groups = groupThings (semanticsImported imp) (catMaybes namedThings)
+           groups = groupThings noNarrowSubspecs (semanticsImported imp) (catMaybes namedThings)
        return $ if not hasPatSyn && length groups < 4 
          then importSpec .- replaceWithJust (createImportSpec groups) $ imp
          else imp 
   where actuallyImported = semanticsImported imp `intersect` usedNames
 
-groupThings :: [GHC.Name] -> [TyThing] -> [(GHC.Name, Bool)]
-groupThings importable = nub . sort . map createImportFromTyThing
+-- | Group things as importable definitions. The second member of the pair will be true, when there is a sub-name
+-- that should be imported apart from the name of the importable definition.
+groupThings :: Bool -> [GHC.Name] -> [TyThing] -> [(GHC.Name, Bool)]
+groupThings noNarrowSubspecs importable 
+  = map last . groupBy ((==) `on` fst) . sort . map createImportFromTyThing
   where createImportFromTyThing :: TyThing -> (GHC.Name, Bool)
         createImportFromTyThing tt | Just td <- getTopDef tt
           = if (td `elem` importable) then (td, True) 
                                       else (getName tt, False)
-          | otherwise = (getName tt, False)
+        createImportFromTyThing tt@(ATyCon {}) = (getName tt, noNarrowSubspecs)
+        createImportFromTyThing tt = (getName tt, False)
 
+-- | Gets the importable definition for a (looked up) name. For example a class function is only importable
+-- in a class, so it gets the name of the class.
 getTopDef :: TyThing -> Maybe GHC.Name
 getTopDef (AnId id) | isRecordSelector id
   = Just $ case recordSelectorTyCon id of RecSelData tc -> getName tc
@@ -119,7 +126,7 @@                         <|> fmap getName (isClassOpId_maybe id)
 getTopDef (AConLike (RealDataCon dc)) = Just (getName $ dataConTyCon dc)
 getTopDef (AConLike (PatSynCon _)) = error "getTopDef: should not be called with pattern synonyms"
-getTopDef tc@(ATyCon _) = Just (getName tc)
+getTopDef (ATyCon _) = Nothing
 
 createImportSpec :: [(GHC.Name, Bool)] -> ImportSpec dom
 createImportSpec elems = mkImportSpecList $ map createIESpec elems
@@ -147,9 +154,9 @@ 
 -- | Narrows the import specification (explicitely imported elements)
 narrowImportSpecs :: forall dom . OrganizeImportsDomain dom
-                  => [GHC.Name] -> IESpecList dom -> LocalRefactor dom (IESpecList dom)
-narrowImportSpecs usedNames 
-  = (annList !~ narrowSpecSubspec usedNames) 
+                  => Bool -> [GHC.Name] -> IESpecList dom -> LocalRefactor dom (IESpecList dom)
+narrowImportSpecs noNarrowSubspecs usedNames 
+  = (if noNarrowSubspecs then return else (annList !~ narrowSpecSubspec usedNames))
        >=> return . filterList isNeededSpec
   where narrowSpecSubspec :: [GHC.Name] -> IESpec dom -> LocalRefactor dom (IESpec dom)
         narrowSpecSubspec usedNames spec 
@@ -158,7 +165,7 @@                let subspecsInScope = case tt of ATyCon tc | not (isClassTyCon tc) 
                                                   -> (map getName (tyConDataCons tc) ++ map flSelector (tyConFieldLabels tc)) `intersect` usedNames
                                                 _ -> usedNames
-               ieSubspec&annJust !- narrowImportSubspecs subspecsInScope $ spec
+               ieSubspec !- narrowImportSubspecs subspecsInScope $ spec
   
         isNeededSpec :: IESpec dom -> Bool
         isNeededSpec ie = 
@@ -169,10 +176,7 @@             || (case ie ^? ieSubspec&annJust of Just SubAll -> True; _ -> False)     
 
 -- | Reduces the number of definitions imported from a sub-specifier.
-narrowImportSubspecs :: OrganizeImportsDomain dom => [GHC.Name] -> SubSpec dom -> SubSpec dom
-narrowImportSubspecs [] SubAll = mkSubList []
-narrowImportSubspecs _ ss@SubAll = ss
-narrowImportSubspecs usedNames ss@(SubList {}) 
-  = essList .- filterList (\n -> fmap getName (semanticsName =<< (n ^? simpleName)) `elem` map Just usedNames) $ ss
-
-
+narrowImportSubspecs :: OrganizeImportsDomain dom => [GHC.Name] -> MaybeSubSpec dom -> MaybeSubSpec dom
+narrowImportSubspecs [] = replaceWithNothing
+narrowImportSubspecs usedNames
+  = annJust & essList .- filterList (\n -> fmap getName (semanticsName =<< (n ^? simpleName)) `elem` map Just usedNames)
Language/Haskell/Tools/Refactor/Predefined/RenameDefinition.hs view
@@ -9,9 +9,9 @@            #-}
 module Language.Haskell.Tools.Refactor.Predefined.RenameDefinition (renameDefinition, renameDefinition', DomainRenameDefinition) where
 
-import qualified GHC (RealSrcSpan(..), NamedThing(..), Name(..))
+import qualified GHC (RealSrcSpan, NamedThing(..), Name)
 import Name (OccName(..), NamedThing(..), occNameString)
-import SrcLoc (RealSrcSpan(..))
+import SrcLoc (RealSrcSpan)
 
 import Control.Monad.State
 import Control.Reference as Ref
Language/Haskell/Tools/Refactor/Prepare.hs view
@@ -19,12 +19,15 @@ import GHC hiding (loadModule)
 import qualified GHC (loadModule)
 import GHC.Paths ( libdir )
+import Packages
 import SrcLoc
 
+import Control.Exception
 import Control.Monad
 import Control.Monad.IO.Class
+import Control.Monad.Trans
 import Data.IntSet (member)
-import Data.List ((\\))
+import Data.List ((\\), intersperse, isSuffixOf)
 import Data.List.Split
 import Data.Maybe
 import Language.Haskell.TH.LanguageExtensions
@@ -37,6 +40,7 @@ import Language.Haskell.Tools.Refactor.RefactorBase
 import Language.Haskell.Tools.Transform
 
+-- | A quick function to try the refactorings
 tryRefactor :: (RealSrcSpan -> Refactoring IdDom) -> String -> String -> IO ()
 tryRefactor refact moduleName span
   = runGhc (Just libdir) $ do
@@ -64,8 +68,14 @@   -- TODO: print errors and warnings?
   let ((leftovers, _, _), newDynFlags) = (runCmdLine $ processArgs flagsAll lArgs) dynflags
   void $ setSessionDynFlags newDynFlags
+  when (any ("-package-db" `isSuffixOf`) args) reloadPkgDb
   return $ map unLoc leftovers
 
+-- | Reloads the package database based on the session flags
+reloadPkgDb :: Ghc ()
+reloadPkgDb = void $ setSessionDynFlags . fst =<< liftIO . initPackages . (\df -> df { pkgDatabase = Nothing }) 
+                                              =<< getSessionDynFlags 
+
 -- | Initialize GHC flags to default values that support refactoring
 initGhcFlags :: Ghc ()
 initGhcFlags = initGhcFlags' False
@@ -73,6 +83,7 @@ initGhcFlagsForTest :: Ghc ()
 initGhcFlagsForTest = initGhcFlags' True
 
+-- | Sets up basic flags and settings for GHC
 initGhcFlags' :: Bool -> Ghc ()
 initGhcFlags' needsCodeGen = do
   dflags <- getSessionDynFlags
@@ -86,12 +97,13 @@              , packageFlags = ExposePackage "template-haskell" (PackageArg "template-haskell") (ModRenaming True []) : packageFlags dflags
              }
 
--- | Use the given source directories
+-- | Use the given source directories when searching for imported modules
 useDirs :: [FilePath] -> Ghc ()
 useDirs workingDirs = do
   dynflags <- getSessionDynFlags
   void $ setSessionDynFlags dynflags { importPaths = importPaths dynflags ++ workingDirs }
 
+-- | Don't use the given source directories when searching for imported modules
 deregisterDirs :: [FilePath] -> Ghc ()
 deregisterDirs workingDirs = do
   dynflags <- getSessionDynFlags
@@ -105,6 +117,7 @@ toBootFileName :: FilePath -> String -> FilePath
 toBootFileName workingDir mod = normalise $ workingDir </> map (\case '.' -> pathSeparator; c -> c) mod ++ ".hs-boot"
 
+-- | Get the source directory where the module is located.
 getSourceDir :: ModSummary -> IO FilePath
 getSourceDir ms 
   = do filePath <- canonicalizePath $ getModSumOrig ms
@@ -113,6 +126,7 @@        let srcDirParts = reverse $ drop (length modNameParts) $ reverse filePathParts
        return $ joinPath srcDirParts
 
+-- | Gets the path to the source file of the module.
 getModSumOrig :: ModSummary -> FilePath
 getModSumOrig = normalise . fromMaybe (error "getModSumOrig: The given module doesn't have haskell source file.") . ml_hs_file . ms_location
 
@@ -132,9 +146,12 @@ -- | Get the typed representation from a type-correct program.
 parseTyped :: ModSummary -> Ghc TypedModule
 parseTyped modSum = withAlteredDynFlags (return . normalizeFlags) $ do
-  let compExts = extensionFlags $ ms_hspp_opts modSum
-      hasStaticFlags = fromEnum StaticPointers `member` compExts
+  let hasStaticFlags = StaticPointers `xopt` ms_hspp_opts modSum
+      hasCppExtension = Cpp `xopt` ms_hspp_opts modSum
+      hasUnicodeExtension = UnicodeSyntax `xopt` ms_hspp_opts modSum
       ms = if hasStaticFlags then forceAsmGen (modSumNormalizeFlags modSum) else (modSumNormalizeFlags modSum)
+  when (hasCppExtension || hasUnicodeExtension) 
+    $ throw (IllegalExtensions (["CPP" | hasCppExtension] ++ ["UnicodeSyntax" | hasUnicodeExtension]))
   p <- parseModule ms
   tc <- typecheckModule p
   void $ GHC.loadModule tc -- when used with loadModule, the module will be loaded twice
@@ -177,11 +194,13 @@ normalizeFlags :: DynFlags -> DynFlags
 normalizeFlags = updOptLevel 0
 
+-- | Read a source range from our textual format: @line:col-line:col@ or @line:col@
 readSrcSpan :: String -> RealSrcSpan
 readSrcSpan s = case splitOn "-" s of
   [one] -> mkRealSrcSpan (readSrcLoc one) (readSrcLoc one)
   [from,to] -> mkRealSrcSpan (readSrcLoc from) (readSrcLoc to)
   
+-- | Read a source location from our format: @line:col@
 readSrcLoc :: String -> RealSrcLoc
 readSrcLoc s = case splitOn ":" s of
   [line,col] -> mkRealSrcLoc (mkFastString "file-name-should-be-fixed") (read line) (read col)
Language/Haskell/Tools/Refactor/RefactorBase.hs view
@@ -9,20 +9,25 @@            , MultiWayIf
            , TemplateHaskell
            #-}
+-- | 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 Bag as GHC
 import DynFlags (HasDynFlags(..))
+import ErrUtils as GHC
 import Exception (ExceptionMonad(..))
 import GHC (Ghc, GhcMonad(..), TyThing(..), lookupName)
 import qualified Module as GHC
 import qualified Name as GHC
+import Outputable
 import qualified PrelNames as GHC
 import qualified TyCon as GHC
 import qualified TysWiredIn as GHC
 
+import Control.Exception
 import Control.Monad.Reader
 import Control.Monad.State
 import Control.Monad.Trans.Except
@@ -33,7 +38,9 @@ import Data.List
 import Data.List.Split
 import Data.Maybe
+import Data.Typeable
 
+-- | A type for the input and result of refactoring a module
 type UnnamedModule dom = Ann AST.UModule dom SrcTemplateStage
 
 -- | The name of the module and the AST
@@ -62,6 +69,22 @@                                         , sameLocation :: SourceFileKey
                                         }
 
+-- | Exceptions that can occur while loading modules or during internal operations (not during performing the refactor).
+data RefactorException = IllegalExtensions [String]
+                       | SourceCodeProblem ErrorMessages
+                       | UnknownException String
+  deriving (Show, Typeable)
+
+instance Show ErrorMessages where
+  show = show . bagToList
+
+instance Exception RefactorException where
+  displayException (SourceCodeProblem prob)
+    = "Source code problem: " ++ showSDocUnsafe (vcat (pprErrMsgBagWithLoc prob))
+  displayException (IllegalExtensions exts) 
+    = "The following extensions are not allowed: " ++ (concat $ intersperse ", " exts) ++ "."
+  displayException (UnknownException ex) = "An unexpected problem appeared: " ++ ex ++ "."
+
 instance Show (RefactorChange dom) where
   show (ContentChanged (n, _)) = "ContentChanged (" ++ show n  ++ ")"
   show (ModuleRemoved n) = "ModuleRemoved " ++ n
@@ -95,8 +118,11 @@ 
         -- TODO: group names like constructors into correct IESpecs
         createImport :: [GHC.Name] -> Ann UImportDecl dom SrcTemplateStage
+        -- works on groupby result, so list is nonempty
         createImport names = mkImportDecl False False False Nothing (mkModuleName $ GHC.moduleNameString $ GHC.moduleName $ GHC.nameModule $ head names)
                                           Nothing (Just $ mkImportSpecList (map (\n -> mkIESpec (mkUnqualName' n) Nothing) names))
+
+-- some instances missing from GHC
 
 instance (GhcMonad m, Monoid s) => GhcMonad (WriterT s m) where
   getSession = lift getSession
Language/Haskell/Tools/Refactor/Session.hs view
@@ -1,8 +1,10 @@ {-# LANGUAGE TemplateHaskell 
            , TupleSections
            #-}
+-- | Common operations for managing refactoring sessions, for example loading packages, re-loading modules.
 module Language.Haskell.Tools.Refactor.Session where
 
+import Control.Exception
 import Control.Monad.State
 import Control.Reference
 import qualified Data.List as List
@@ -25,12 +27,16 @@ 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]
                          }
 
 makeReferences ''RefactorSessionState
 
+-- | A common class for the state of refactoring tools
 class IsRefactSessionState st where
   refSessMCs :: Simple Lens st [ModuleCollection]
   initSession :: st
@@ -39,9 +45,9 @@   refSessMCs = _refSessMCs
   initSession = RefactorSessionState []
 
-
-loadPackagesFrom :: IsRefactSessionState st => (ModSummary -> IO a) -> [FilePath] -> StateT st Ghc (Either String ([a], [String]))
-loadPackagesFrom report packages = 
+-- | Load packages from the given directories. Loads modules, performs the given callback action, warns for duplicate modules.
+loadPackagesFrom :: IsRefactSessionState st => (ModSummary -> IO a) -> [FilePath] -> StateT st Ghc (Either RefactorException ([a], [String]))
+loadPackagesFrom report packages =
   do modColls <- liftIO $ getAllModules packages
      modify $ refSessMCs .- (++ modColls)
      allModColls <- gets (^. refSessMCs)
@@ -67,9 +73,10 @@           needsCodeGen <- gets (needsGeneratedCode (keyFromMS ms) . (^. refSessMCs))
           reloadModule report (if needsCodeGen then forceCodeGen ms else ms)
 
-handleErrors :: ExceptionMonad m => m a -> m (Either String a)
-handleErrors action = handleSourceError (return . Left . errorsText) (Right <$> action)
-  where errorsText = concat . List.intersperse "\n\n" . map showSDocUnsafe . pprErrMsgBagWithLoc . srcErrorMessages
+-- | Handle GHC exceptions and RefactorException.
+handleErrors :: ExceptionMonad m => m a -> m (Either RefactorException a)
+handleErrors action = handleSourceError (return . Left . SourceCodeProblem . srcErrorMessages) (Right <$> action) 
+                        `gcatch` (return . Left)
 
 keyFromMS :: ModSummary -> SourceFileKey
 keyFromMS ms = SourceFileKey (case ms_hsc_src ms of HsSrcFile -> NormalHs; _ -> IsHsBoot) (modSumName ms)
@@ -93,7 +100,8 @@        case sfs of sf:_ -> getMods (Just sf)
                    [] -> getMods Nothing
 
-reloadChangedModules :: IsRefactSessionState st => (ModSummary -> IO a) -> (ModSummary -> Bool) -> StateT st Ghc (Either String [a])
+-- | Reload the modules that have been changed (given by predicate). Pefrom the callback.
+reloadChangedModules :: IsRefactSessionState st => (ModSummary -> IO a) -> (ModSummary -> Bool) -> StateT st Ghc (Either RefactorException [a])
 reloadChangedModules report isChanged = handleErrors $ do
   reachable <- getReachableModules isChanged
   void $ checkEvaluatedMods report reachable
@@ -111,11 +119,12 @@         sortedMods = reverse $ topologicalSortG allModsGraph
     return $ filter ((`elem` recompMods) . ms_mod) $ map getModFromNode sortedMods
 
+-- | Reload a given module. Perform a callback.
 reloadModule :: IsRefactSessionState st => (ModSummary -> IO a) -> ModSummary -> StateT st Ghc a
 reloadModule report ms = do 
   let modName = modSumName ms
   mcs <- gets (^. refSessMCs)
-  let Just mc = lookupModuleColl modName mcs
+  let mc = fromMaybe (error $ "reloadModule: The following module is not found: " ++ modName) $ lookupModuleColl modName mcs
       codeGen = hasGeneratedCode (keyFromMS ms) mcs
   let dfs = ms_hspp_opts ms 
   dfs' <- liftIO $ compileInContext mc mcs dfs
@@ -142,10 +151,12 @@                              else return Nothing
                    else return Nothing
 
+-- | Re-load the module with code generation enabled. Must be used when the module had already been loaded,
+-- but code generation were not enabled by then.
 codeGenForModule :: (ModSummary -> IO a) -> [ModuleCollection] -> ModSummary -> Ghc a
 codeGenForModule report mcs ms 
   = let modName = modSumName ms
-        Just mc = lookupModuleColl modName mcs
+        mc = fromMaybe (error $ "codeGenForModule: The following module is not found: " ++ modName) $ lookupModuleColl modName mcs
      in -- TODO: don't recompile, only load?
         do withAlteredDynFlags (liftIO . compileInContext mc mcs)
              $ void $ parseTyped (forceCodeGen ms)
examples/Module/Import.hs view
@@ -8,4 +8,4 @@ import Data.List as List
 import Data.List(map,(++))
 import Data.Function hiding ((&))
-import Control.Monad.Writer hiding (Alt)
+import Control.Monad.Writer hiding (Alt, Writer())
+ examples/Refactor/ExtractBinding/AssocOp.hs view
@@ -0,0 +1,3 @@+module Refactor.ExtractBinding.AssocOp where
+
+a = 1 + 2 + 3
+ examples/Refactor/ExtractBinding/AssocOpMiddle.hs view
@@ -0,0 +1,3 @@+module Refactor.ExtractBinding.AssocOpMiddle where
+
+a = 1 * 2 * 3 * 4
+ examples/Refactor/ExtractBinding/AssocOpMiddle_res.hs view
@@ -0,0 +1,4 @@+module Refactor.ExtractBinding.AssocOpMiddle where
+
+a = 1 * b * 4
+  where b = 2 * 3
+ examples/Refactor/ExtractBinding/AssocOpRightAssoc.hs view
@@ -0,0 +1,3 @@+module Refactor.ExtractBinding.AssocOpRightAssoc where
+
+f = id . id . id
+ examples/Refactor/ExtractBinding/AssocOpRightAssoc_res.hs view
@@ -0,0 +1,4 @@+module Refactor.ExtractBinding.AssocOpRightAssoc where
+
+f = g . id
+  where g = id . id
+ examples/Refactor/ExtractBinding/AssocOp_res.hs view
@@ -0,0 +1,4 @@+module Refactor.ExtractBinding.AssocOp where
+
+a = 1 + b
+  where b = 2 + 3
+ examples/Refactor/ExtractBinding/LeftSection.hs view
@@ -0,0 +1,3 @@+module Refactor.ExtractBinding.LeftSection where
+
+a = 1 + 2
+ examples/Refactor/ExtractBinding/LeftSection_res.hs view
@@ -0,0 +1,4 @@+module Refactor.ExtractBinding.LeftSection where
+
+a = f 2
+  where f = (1 +)
+ examples/Refactor/ExtractBinding/RightSection.hs view
@@ -0,0 +1,3 @@+module Refactor.ExtractBinding.RightSection where
+
+a = 1 + 2
+ examples/Refactor/ExtractBinding/RightSection_res.hs view
@@ -0,0 +1,4 @@+module Refactor.ExtractBinding.RightSection where
+
+a = f 1
+  where f = (+ 2)
+ examples/Refactor/ExtractBinding/SectionInfix.hs view
@@ -0,0 +1,3 @@+module Refactor.ExtractBinding.SectionInfix where
+
+a = 1 + 2 + 3
+ examples/Refactor/ExtractBinding/SectionInfix_res.hs view
@@ -0,0 +1,4 @@+module Refactor.ExtractBinding.SectionInfix where
+
+a = f 3
+  where f = ((1 + 2) +)
+ examples/Refactor/ExtractBinding/SectionWithLocals.hs view
@@ -0,0 +1,6 @@+module Refactor.ExtractBinding.SectionWithLocals where
+
+a x = let y = 2
+          z = 3
+          (<->) = (-)
+       in x <-> (y + z)
+ examples/Refactor/ExtractBinding/SectionWithLocals_res.hs view
@@ -0,0 +1,7 @@+module Refactor.ExtractBinding.SectionWithLocals where
+
+a x = let y = 2
+          z = 3
+          (<->) = (-)
+       in f y z (<->) x
+  where f y z (<->) = (<-> (y + z))
+ examples/Refactor/FloatOut/FloatLocals.hs view
@@ -0,0 +1,5 @@+module Refactor.FloatOut.FloatLocals where
+
+f = g
+  where g = h
+          where h = id
+ examples/Refactor/FloatOut/FloatLocals_res.hs view
@@ -0,0 +1,5 @@+module Refactor.FloatOut.FloatLocals where
+
+f = g
+  where g = h
+        h = id
+ examples/Refactor/FloatOut/ImplicitLocal.hs view
@@ -0,0 +1,5 @@+module Refactor.FloatOut.ImplicitLocal where
+
+f = g
+  where g = h
+        h = ()
+ examples/Refactor/FloatOut/ImplicitParam.hs view
@@ -0,0 +1,4 @@+module Refactor.FloatOut.ImplicitParam where
+
+f a = g
+  where g = a
+ examples/Refactor/FloatOut/MoveFixity.hs view
@@ -0,0 +1,5 @@+module Refactor.FloatOut.MoveFixity where
+
+f = 3 <+> 4
+  where infixl 6 <+>
+        a <+> b = a + b
+ examples/Refactor/FloatOut/MoveFixity_res.hs view
@@ -0,0 +1,5 @@+module Refactor.FloatOut.MoveFixity where
+
+f = 3 <+> 4
+infixl 6 <+>
+a <+> b = a + b
+ examples/Refactor/FloatOut/MoveSignature.hs view
@@ -0,0 +1,5 @@+module Refactor.FloatOut.MoveSignature where
+
+f = g
+  where g :: a -> a
+        g = id
+ examples/Refactor/FloatOut/MoveSignature_res.hs view
@@ -0,0 +1,5 @@+module Refactor.FloatOut.MoveSignature where
+
+f = g
+g :: a -> a
+g = id
+ examples/Refactor/FloatOut/NameCollosion.hs view
@@ -0,0 +1,6 @@+module Refactor.FloatOut.NameCollosion where
+
+f = g
+  where g = id
+
+g = ()
+ examples/Refactor/FloatOut/NameCollosionWithImport.hs view
@@ -0,0 +1,4 @@+module Refactor.FloatOut.NameCollosionWithImport where
+
+f = id
+  where id = ()
+ examples/Refactor/FloatOut/NameCollosionWithLocal.hs view
@@ -0,0 +1,6 @@+module Refactor.FloatOut.NameCollosionWithLocal where
+
+f = g
+  where g = h
+          where h = id
+        h = ()
+ examples/Refactor/FloatOut/NoCollosion.hs view
@@ -0,0 +1,7 @@+module Refactor.FloatOut.NoCollosion where
+
+f = g
+  where g = h
+          where h = id
+
+h = ()
+ examples/Refactor/FloatOut/NoCollosion_res.hs view
@@ -0,0 +1,7 @@+module Refactor.FloatOut.NoCollosion where
+
+f = g
+  where g = h
+        h = id
+
+h = ()
+ examples/Refactor/FloatOut/SharedSignature.hs view
@@ -0,0 +1,6 @@+module Refactor.FloatOut.SharedSignature where
+
+f = g
+  where g, h :: a -> a
+        g = id
+        h = id
+ examples/Refactor/FloatOut/ToTopLevel.hs view
@@ -0,0 +1,4 @@+module Refactor.FloatOut.ToTopLevel where
+
+f = g
+  where g = id
+ examples/Refactor/FloatOut/ToTopLevel_res.hs view
@@ -0,0 +1,4 @@+module Refactor.FloatOut.ToTopLevel where
+
+f = g
+g = id
examples/Refactor/GenerateTypeSignature/HigherOrder_res.hs view
@@ -1,4 +1,4 @@ module Refactor.GenerateTypeSignature.HigherOrder where
 
-app :: (t -> t1) -> t -> t1
+app :: (t1 -> t) -> t1 -> t
 app f x = f x
examples/Refactor/GenerateTypeSignature/PolymorphSubMulti_res.hs view
@@ -2,5 +2,5 @@ 
 f :: (Num a, Ord a) => a -> a
 f a = g a where
-  g :: (Ord t, Num t) => t -> t
+  g :: (Num t, Ord t) => t -> t
   g a = if a > 0 then a + 1 else a
examples/Refactor/GenerateTypeSignature/Tuple_res.hs view
@@ -1,4 +1,4 @@ module Refactor.GenerateTypeSignature.Tuple where
 
-tuple :: t -> t1 -> (t, t1)
+tuple :: t1 -> t -> (t1, t)
 tuple x y = (x,y)
+ examples/Refactor/InlineBinding/LetBind.hs view
@@ -0,0 +1,3 @@+module Refactor.InlineBinding.LetBind where
+
+a = let x = () in x
+ examples/Refactor/InlineBinding/LetBind_res.hs view
@@ -0,0 +1,3 @@+module Refactor.InlineBinding.LetBind where
+
+a = ()
+ examples/Refactor/InlineBinding/LetGuard.hs view
@@ -0,0 +1,5 @@+module Refactor.InlineBinding.LetGuard where
+
+a | let x = 3
+  , x == 3
+  = ()
+ examples/Refactor/InlineBinding/LetGuard_res.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.LetGuard where
+
+a | 3 == 3
+  = ()
+ examples/Refactor/InlineBinding/LetStmt.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.LetStmt where
+
+a = do let x = () 
+       putStrLn (show x)
+ examples/Refactor/InlineBinding/LetStmt_res.hs view
@@ -0,0 +1,3 @@+module Refactor.InlineBinding.LetStmt where
+
+a = do putStrLn (show ())
examples/Refactor/InlineBinding/LocalNested_res.hs view
@@ -1,5 +1,4 @@ module Refactor.InlineBinding.LocalNested where
 
 a = b
-  where b = ()
-          where +  where b = ()
examples/Refactor/InlineBinding/Local_res.hs view
@@ -1,4 +1,3 @@ module Refactor.InlineBinding.Local where
 
-b = ()
-  where +b = ()
+ examples/Refactor/OrganizeImports/NarrowSpec.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.NarrowSpec where
+
+import Control.Monad.State (State(..))
+
+type St = State ()
+ examples/Refactor/OrganizeImports/NarrowSpec_res.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.NarrowSpec where
+
+import Control.Monad.State (State)
+
+type St = State ()
+ examples/Refactor/OrganizeImports/NarrowType.hs view
@@ -0,0 +1,8 @@+module Refactor.OrganizeImports.NarrowType where
+
+import Control.Monad.State
+
+type St = State ()
+type StT = StateT () IO
+
+f = runStateT
+ examples/Refactor/OrganizeImports/NarrowType_res.hs view
@@ -0,0 +1,8 @@+module Refactor.OrganizeImports.NarrowType where
+
+import Control.Monad.State (StateT(..), State)
+
+type St = State ()
+type StT = StateT () IO
+
+f = runStateT
+ examples/Refactor/OrganizeImports/StandaloneDeriving.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE StandaloneDeriving #-}
+module Refactor.OrganizeImports.StandaloneDeriving where
+
+import Control.Monad.State (State(..), StateT)
+
+type St = State ()
+ examples/Refactor/OrganizeImports/StandaloneDeriving_res.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE StandaloneDeriving #-}
+module Refactor.OrganizeImports.StandaloneDeriving where
+
+import Control.Monad.State (State(..))
+
+type St = State ()
+ examples/Refactor/OrganizeImports/TemplateHaskell.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE TemplateHaskell #-}
+module Refactor.OrganizeImports.TemplateHaskell where
+
+import Control.Monad.Writer
+import Control.Monad.State (State(..))
+ examples/Refactor/OrganizeImports/TemplateHaskell_res.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE TemplateHaskell #-}
+module Refactor.OrganizeImports.TemplateHaskell where
+
+import Control.Monad.State (State(..))
+import Control.Monad.Writer
examples/Type/TypeOperators.hs view
@@ -4,4 +4,7 @@ infixr 6 :+:
 data a :+: r = a :+: r 
 
-type X = Int :+: Char :+: String+type X = Int :+: Char :+: String
+
+type (:&:) = (,)
+infixr :&:
haskell-tools-refactor.cabal view
@@ -1,5 +1,5 @@ name:                haskell-tools-refactor
-version:             0.4.1.3
+version:             0.5.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
@@ -43,6 +43,7 @@                   , examples/Refactor/RenameDefinition/SpliceExpr_res/*.hs
                   , examples/Refactor/RenameDefinition/SpliceType/*.hs
                   , examples/Refactor/RenameDefinition/SpliceType_res/*.hs
+                  , examples/Refactor/FloatOut/*.hs
                   , examples/TH/*.hs
                   , examples/TH/QuasiQuote/*.hs
                   , examples/TH/Splice/*.hs
@@ -58,6 +59,7 @@                      , Language.Haskell.Tools.Refactor.Perform
                      , Language.Haskell.Tools.Refactor.ListOperations
                      , Language.Haskell.Tools.Refactor.Session
+                     , Language.Haskell.Tools.Refactor.Helpers
 
                      , Language.Haskell.Tools.Refactor.Predefined.GenerateTypeSignature
                      , Language.Haskell.Tools.Refactor.Predefined.OrganizeImports
@@ -68,6 +70,7 @@                      , Language.Haskell.Tools.Refactor.Predefined.IfToGuards
                      , Language.Haskell.Tools.Refactor.Predefined.DollarApp
                      , Language.Haskell.Tools.Refactor.Predefined.InlineBinding
+                     , Language.Haskell.Tools.Refactor.Predefined.FloatOut
                      
   build-depends:       base                      >= 4.9  && < 4.10
                      , mtl                       >= 2.2  && < 2.3
@@ -82,10 +85,10 @@                      , template-haskell          >= 2.11 && < 2.12
                      , ghc                       >= 8.0  && < 8.1
                      , Cabal                     >= 1.24 && < 1.25
-                     , haskell-tools-ast         >= 0.4  && < 0.5
-                     , haskell-tools-backend-ghc >= 0.4  && < 0.5
-                     , haskell-tools-rewrite     >= 0.4  && < 0.5
-                     , haskell-tools-prettyprint >= 0.4  && < 0.5
+                     , haskell-tools-ast         >= 0.5  && < 0.6
+                     , haskell-tools-backend-ghc >= 0.5  && < 0.6
+                     , haskell-tools-rewrite     >= 0.5  && < 0.6
+                     , haskell-tools-prettyprint >= 0.5  && < 0.6
   default-language:    Haskell2010
   
 test-suite haskell-tools-test
@@ -110,9 +113,12 @@                      , ghc                       >= 8.0  && < 8.1
                      , ghc-paths                 >= 0.1  && < 0.2
                      , Cabal                     >= 1.24 && < 1.25
-                     , haskell-tools-ast         >= 0.4  && < 0.5
-                     , haskell-tools-backend-ghc >= 0.4  && < 0.5
-                     , haskell-tools-rewrite     >= 0.4  && < 0.5
-                     , haskell-tools-prettyprint >= 0.4  && < 0.5
-                     , haskell-tools-refactor    >= 0.4  && < 0.5
+                     , haskell-tools-ast         >= 0.5  && < 0.6
+                     , haskell-tools-backend-ghc >= 0.5  && < 0.6
+                     , haskell-tools-rewrite     >= 0.5  && < 0.6
+                     , haskell-tools-prettyprint >= 0.5  && < 0.6
+                     , haskell-tools-refactor    >= 0.5  && < 0.6
+                     -- libraries used by the examples
+                     , old-time                  >= 1.1  && < 1.2
+                     , polyparse                 >= 1.12 && < 1.13
   default-language:    Haskell2010
test/Main.hs view
@@ -69,6 +69,8 @@             ++ map makeWrongExtractBindingTest wrongExtractBindingTests
             ++ map makeInlineBindingTest inlineBindingTests
             ++ map makeWrongInlineBindingTest wrongInlineBindingTests
+            ++ map makeFloatOutTest floatOutTests
+            ++ map makeWrongFloatOutTest wrongFloatOutTests
             ++ map (makeMultiModuleTest checkMultiResults) multiModuleTests
             ++ map (makeMultiModuleTest checkMultiFail) wrongMultiModuleTests
             ++ map makeMiscRefactorTest miscRefactorTests
@@ -222,6 +224,10 @@   , "Refactor.OrganizeImports.InstanceCarry.ImportOrphan"
   , "Refactor.OrganizeImports.InstanceCarry.ImportNonOrphan"
   , "Refactor.OrganizeImports.NarrowQual"
+  , "Refactor.OrganizeImports.NarrowSpec"
+  , "Refactor.OrganizeImports.StandaloneDeriving"
+  , "Refactor.OrganizeImports.TemplateHaskell"
+  , "Refactor.OrganizeImports.NarrowType"
   ]
   
 generateSignatureTests = 
@@ -314,6 +320,13 @@   , ("Refactor.ExtractBinding.IndentationMultiLine", "3:12-3:18", "extracted")
   , ("Refactor.ExtractBinding.IndentationOperator", "3:13-3:20", "extracted")
   , ("Refactor.ExtractBinding.ExtractedFormatting", "4:5-5:7", "extracted")
+  , ("Refactor.ExtractBinding.LeftSection", "3:5-3:8", "f")
+  , ("Refactor.ExtractBinding.RightSection", "3:7-3:10", "f")
+  , ("Refactor.ExtractBinding.SectionWithLocals", "6:13-6:24", "f")
+  , ("Refactor.ExtractBinding.SectionInfix", "3:5-3:12", "f")
+  , ("Refactor.ExtractBinding.AssocOp", "3:9-3:14", "b")
+  , ("Refactor.ExtractBinding.AssocOpRightAssoc", "3:5-3:12", "g")
+  , ("Refactor.ExtractBinding.AssocOpMiddle", "3:9-3:14", "b")
   ]
 
 wrongExtractBindingTests = 
@@ -336,6 +349,9 @@   , ("Refactor.InlineBinding.MultiMatchGuarded", "4:1-4:2")
   , ("Refactor.InlineBinding.RemoveSignatures", "5:1-5:2")
   , ("Refactor.InlineBinding.FilterSignatures", "5:1-5:2")
+  , ("Refactor.InlineBinding.LetBind", "3:9-3:10")
+  , ("Refactor.InlineBinding.LetStmt", "3:12-3:13")
+  , ("Refactor.InlineBinding.LetGuard", "3:9-3:10")
   ]
 
 wrongInlineBindingTests = 
@@ -344,7 +360,23 @@   , ("Refactor.InlineBinding.NotOccurring", "3:1")
   ]
 
+floatOutTests =
+  [ ("Refactor.FloatOut.ToTopLevel", "4:10")
+  , ("Refactor.FloatOut.FloatLocals", "5:18")
+  , ("Refactor.FloatOut.MoveSignature", "5:10")
+  , ("Refactor.FloatOut.MoveFixity", "5:11-5:14")
+  , ("Refactor.FloatOut.NoCollosion", "5:18")
+  ]
 
+wrongFloatOutTests =
+  [ ("Refactor.FloatOut.NameCollosion", "4:10")
+  , ("Refactor.FloatOut.NameCollosionWithImport", "4:11")
+  , ("Refactor.FloatOut.NameCollosionWithLocal", "5:18")
+  , ("Refactor.FloatOut.SharedSignature", "5:10")
+  , ("Refactor.FloatOut.ImplicitLocal", "4:10")
+  , ("Refactor.FloatOut.ImplicitParam", "4:10")
+  ]
+
 multiModuleTests =
   [ ("RenameDefinition 5:5-5:6 bb", "A", "Refactor" </> "RenameDefinition" </> "MultiModule", [])
   , ("RenameDefinition 1:8-1:9 C", "B", "Refactor" </> "RenameDefinition" </> "RenameModule", ["B"])
@@ -428,7 +460,13 @@   
 makeWrongInlineBindingTest :: (String, String) -> TestTree
 makeWrongInlineBindingTest (mod, rng) = createFailTest "InlineBinding" [rng] mod
-
+  
+makeFloatOutTest :: (String, String) -> TestTree
+makeFloatOutTest (mod, rng) = createTest "FloatOut" [rng] mod
+  
+makeWrongFloatOutTest :: (String, String) -> TestTree
+makeWrongFloatOutTest (mod, rng) = createFailTest "FloatOut" [rng] mod
+  
 checkCorrectlyTransformed :: String -> String -> String -> IO ()
 checkCorrectlyTransformed command workingDir moduleName
   = do expected <- loadExpected True workingDir moduleName