haskell-tools-refactor 0.5.0.0 → 0.6.0.0

raw patch · 67 files changed

+1127/−559 lines, 67 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/GetModules.hs +270/−164
• Language/Haskell/Tools/Refactor/ListOperations.hs +35/−32
• Language/Haskell/Tools/Refactor/Perform.hs +27/−17
• Language/Haskell/Tools/Refactor/Predefined/DollarApp1.hs +16/−0
• Language/Haskell/Tools/Refactor/Predefined/DollarApp2.hs +23/−0
• Language/Haskell/Tools/Refactor/Predefined/DollarApp3.hs +44/−0
• Language/Haskell/Tools/Refactor/Predefined/ExtractBinding.hs +41/−32
• Language/Haskell/Tools/Refactor/Predefined/FloatOut.hs +9/−9
• Language/Haskell/Tools/Refactor/Predefined/GenerateTypeSignature.hs +31/−32
• Language/Haskell/Tools/Refactor/Predefined/HelloRefactor.hs +17/−0
• Language/Haskell/Tools/Refactor/Predefined/OrganizeImports.hs +105/−69
• Language/Haskell/Tools/Refactor/Predefined/RenameDefinition.hs +21/−20
• Language/Haskell/Tools/Refactor/Prepare.hs +29/−24
• Language/Haskell/Tools/Refactor/RefactorBase.hs +39/−38
• Language/Haskell/Tools/Refactor/Session.hs +38/−32
• examples/CPP/ConditionalCode.hs +8/−0
• examples/CPP/ConditionalImport.hs +10/−0
• examples/CPP/ConditionalImport_res.hs +8/−0
• examples/CPP/JustEnabled.hs +2/−0
• examples/Decl/ClassInfix.hs +10/−0
• examples/Decl/ClosedTypeFamily.hs +3/−1
• examples/Decl/DefaultDecl.hs +3/−0
• examples/Decl/FunFixity.hs +5/−0
• examples/Decl/GADT.hs +7/−3
• examples/Decl/GadtConWithCtx.hs +5/−0
• examples/Decl/InfixAssertion.hs +9/−0
• examples/Decl/InfixInstances.hs +8/−0
• examples/Decl/InfixPatSyn.hs +10/−0
• examples/Decl/MixedInstance.hs +11/−0
• examples/Decl/PatternSynonym.hs +8/−3
• examples/Expr/EmptyLet.hs +6/−0
• examples/Expr/FunSection.hs +6/−0
• examples/Expr/PatternAndDo.hs +10/−0
• examples/Expr/SccPragma.hs +4/−0
• examples/Expr/SemicolonDo.hs +7/−0
• examples/Expr/TupleSections.hs +3/−1
• examples/Module/ImportOp.hs +3/−0
• examples/Module/Imported.hs +6/−0
• examples/Module/LangPragmas.hs +4/−0
• examples/Pattern/NestedWildcard.hs +7/−0
• examples/Pattern/OperatorPattern.hs +3/−0
• examples/Refactor/ExtractBinding/SiblingDefs.hs +7/−0
• examples/Refactor/ExtractBinding/SiblingDefs_res.hs +8/−0
• examples/Refactor/ExtractBinding/ViewPattern.hs +4/−0
• examples/Refactor/GenerateTypeSignature/PolymorphSubMulti.hs +1/−1
• examples/Refactor/GenerateTypeSignature/PolymorphSubMulti_res.hs +1/−1
• examples/Refactor/OrganizeImports/Fields.hs +6/−0
• examples/Refactor/OrganizeImports/Fields_res.hs +6/−0
• examples/Refactor/OrganizeImports/KeepCtorOfMarshalled.hs +5/−0
• examples/Refactor/OrganizeImports/KeepCtorOfMarshalled_res.hs +5/−0
• examples/Refactor/OrganizeImports/KeepHiding.hs +6/−0
• examples/Refactor/OrganizeImports/KeepHiding_res.hs +6/−0
• examples/Refactor/OrganizeImports/KeepPrelude.hs +3/−0
• examples/Refactor/OrganizeImports/KeepPrelude_res.hs +3/−0
• examples/Refactor/OrganizeImports/MakeExplicit/ConSourceHiddenType.hs +3/−0
• examples/Refactor/OrganizeImports/MakeExplicit/ImportCon.hs +1/−2
• examples/Refactor/OrganizeImports/MakeExplicit/ImportCon_res.hs +1/−2
• examples/Refactor/OrganizeImports/MakeExplicit/Renamed.hs +5/−0
• examples/Refactor/OrganizeImports/MakeExplicit/Renamed_res.hs +5/−0
• examples/Refactor/OrganizeImports/NarrowSpec_res.hs +1/−1
• examples/Refactor/RenameDefinition/FunnyDo.hs +5/−0
• examples/Refactor/RenameDefinition/FunnyDo_res.hs +5/−0
• examples/TH/Splice/UseQual.hs +6/−0
• examples/TH/Splice/UseQualMulti.hs +8/−0
• examples/Type/TupleAssert.hs +5/−0
• haskell-tools-refactor.cabal +20/−15
• test/Main.hs +90/−60

@@ -3,13 +3,16 @@            , LambdaCase
            , TemplateHaskell
            , FlexibleContexts
+           , TypeApplications
+           , RankNTypes
            #-}
 -- | Representation and operations for module collections (libraries, executables, ...) in the framework.
 module Language.Haskell.Tools.Refactor.GetModules where
 
+import Control.Monad
 import Control.Reference
 import Data.Function (on)
-import Data.List (intersperse, find, sortBy)
+import Data.List
 import qualified Data.Map as Map
 import Data.Maybe
 import Distribution.Compiler
@@ -21,11 +24,11 @@ import Distribution.PackageDescription.Parse
 import Distribution.System
 import Distribution.Verbosity (silent)
-import Language.Haskell.Extension
+import Language.Haskell.Extension as Cabal
 import System.Directory
 import System.FilePath.Posix
 
-import DynFlags (DynFlags, xopt_set, xopt_unset)
+import DynFlags
 import qualified DynFlags as GHC
 import GHC hiding (ModuleName)
 import qualified Language.Haskell.TH.LanguageExtensions as GHC
@@ -35,6 +38,8 @@ import Language.Haskell.Tools.AST (Dom, IdDom)
 import Language.Haskell.Tools.Refactor.RefactorBase
 
+import Debug.Trace
+
 -- | The modules of a library, executable, test or benchmark. A package contains one or more module collection.
 data ModuleCollection
   = ModuleCollection { _mcId :: ModuleCollectionId
@@ -42,6 +47,7 @@                      , _mcSourceDirs :: [FilePath]
                      , _mcModules :: Map.Map SourceFileKey ModuleRecord
                      , _mcFlagSetup :: DynFlags -> IO DynFlags -- ^ Sets up the ghc environment for compiling the modules of this collection
+                     , _mcLoadFlagSetup :: DynFlags -> IO DynFlags -- ^ Sets up the ghc environment for dependency analysis
                      , _mcDependencies :: [ModuleCollectionId]
                      }
 
@@ -49,19 +55,22 @@   (==) = (==) `on` _mcId
 
 instance Show ModuleCollection where
-  show (ModuleCollection id root srcDirs mods _ deps) 
+  show (ModuleCollection id root srcDirs mods _ _ deps)
     = "ModuleCollection (" ++ show id ++ ") " ++ root ++ " " ++ show srcDirs ++ " (" ++ show mods ++ ") " ++ show deps
 
+containingMC :: FilePath -> Simple Traversal [ModuleCollection] ModuleCollection
+containingMC fp = traversal & filtered (\mc -> _mcRoot mc `isPrefixOf` fp)
+
 -- | The state of a module.
-data ModuleRecord 
+data ModuleRecord
        = ModuleNotLoaded { _recModuleWillNeedCode :: Bool }
        | ModuleParsed { _parsedRecModule :: UnnamedModule (Dom RdrName)
                       , _modRecMS :: ModSummary
                       }
        | ModuleRenamed { _renamedRecModule :: UnnamedModule (Dom Name)
-                       , _modRecMS :: ModSummary 
+                       , _modRecMS :: ModSummary
                        }
-       | ModuleTypeChecked { _typedRecModule :: UnnamedModule IdDom 
+       | ModuleTypeChecked { _typedRecModule :: UnnamedModule IdDom
                            , _modRecMS :: ModSummary
                            }
        | ModuleCodeGenerated { _typedRecModule :: UnnamedModule IdDom
@@ -108,11 +117,11 @@ removeModule moduleName = map (mcModules .- Map.filterWithKey (\k _ -> moduleName /= (k ^. sfkModuleName)))
 
 hasGeneratedCode :: SourceFileKey -> [ModuleCollection] -> Bool
-hasGeneratedCode key = maybe False (\case (_, ModuleCodeGenerated {}) -> True; _ -> False) 
+hasGeneratedCode key = maybe False (\case (_, ModuleCodeGenerated {}) -> True; _ -> False)
                          . find ((key ==) . fst) . concatMap (Map.assocs . (^. mcModules))
 
 needsGeneratedCode :: SourceFileKey -> [ModuleCollection] -> Bool
-needsGeneratedCode key = maybe False (\case (_, ModuleCodeGenerated {}) -> True; (_, ModuleNotLoaded True) -> True; _ -> False) 
+needsGeneratedCode key = maybe False (\case (_, ModuleCodeGenerated {}) -> True; (_, ModuleNotLoaded True) -> True; _ -> False)
                            . find ((key ==) . fst) . concatMap (Map.assocs . (^. mcModules))
 
 codeGeneratedFor :: SourceFileKey -> [ModuleCollection] -> [ModuleCollection]
@@ -121,7 +130,7 @@                                                            r -> r) key)
 
 isAlreadyLoaded :: SourceFileKey -> [ModuleCollection] -> Bool
-isAlreadyLoaded key = maybe False (\case (_, ModuleNotLoaded {}) -> False; _ -> True) 
+isAlreadyLoaded key = maybe False (\case (_, ModuleNotLoaded {}) -> False; _ -> True)
                          . find ((key ==) . fst) . concatMap (Map.assocs . (^. mcModules))
 
 -- | Gets all ModuleCollections from a list of source directories. It also orders the source directories that are package roots so that
@@ -151,23 +160,23 @@        case find (\p -> takeExtension p == ".cabal") files of
           Just cabalFile -> modulesFromCabalFile root cabalFile
           Nothing        -> do mods <- modulesFromDirectory root root
-                               return [ModuleCollection (DirectoryMC root) root [root] (Map.fromList $ map ((, ModuleNotLoaded False) . SourceFileKey NormalHs) mods) return []]
+                               return [ModuleCollection (DirectoryMC root) root [root] (Map.fromList $ map ((, ModuleNotLoaded False) . SourceFileKey NormalHs) mods) return 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)
-  where goOn fp = let path = searchRoot </> fp 
-                   in do isDir <- doesDirectoryExist path  
+  where goOn fp = let path = searchRoot </> fp
+                   in do isDir <- doesDirectoryExist path
                          if isDir
-                           then modulesFromDirectory root path 
-                           else if takeExtension path == ".hs" 
-                                  then return [concat $ intersperse "." $ splitDirectories $ dropExtension $ makeRelative root path] 
+                           then modulesFromDirectory root path
+                           else if takeExtension path == ".hs"
+                                  then return [concat $ intersperse "." $ splitDirectories $ dropExtension $ makeRelative root path]
                                   else return []
-                                  
+
 srcDirFromRoot :: FilePath -> String -> FilePath
-srcDirFromRoot fileName "" = fileName 
-srcDirFromRoot fileName moduleName 
+srcDirFromRoot fileName "" = fileName
+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.
@@ -175,29 +184,30 @@ modulesFromCabalFile :: FilePath -> FilePath -> IO [ModuleCollection]
 -- now adding all conditional entries, regardless of flags
 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)) 
+  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 -> Maybe ModuleCollection
-        toModuleCollection pkg tmc 
-          = let bi = getBuildInfo tmc 
+        toModuleCollection pkg tmc
+          = let bi = getBuildInfo tmc
              in if buildable bi
-                  then Just $ ModuleCollection (mkModuleCollKey (pkgName $ package pkg) tmc) 
+                  then Just $ ModuleCollection (mkModuleCollKey (pkgName $ package pkg) tmc)
                                 root
-                                (map (normalise . (root </>)) $ hsSourceDirs bi) 
-                                (Map.fromList $ map ((, ModuleNotLoaded False) . SourceFileKey NormalHs . moduleName) (getModuleNames tmc)) 
+                                (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)) 
+                                (loadFlagsFromBuildInfo 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 
+        setupFlags = either (\deps -> error $ "Missing dependencies: " ++ show deps) fst
+                       . finalizePackageDescription [] (const True) buildPlatform
                                                     (unknownCompilerInfo buildCompilerId NoAbiTag) []
 
-class ToModuleCollection t where 
+class ToModuleCollection t where
   mkModuleCollKey :: PackageName -> t -> ModuleCollectionId
   getBuildInfo :: t -> BuildInfo
   getModuleNames :: t -> [ModuleName]
@@ -223,153 +233,249 @@   getBuildInfo = benchmarkBuildInfo
   getModuleNames = benchmarkModules
 
+isDirectoryMC :: ModuleCollection -> Bool
+isDirectoryMC mc = case mc ^. mcId of DirectoryMC{} -> True; _ -> False
 
 compileInContext :: ModuleCollection -> [ModuleCollection] -> DynFlags -> IO DynFlags
-compileInContext mc mcs dfs 
-  = (\dfs' -> applyDependencies mcs (mc ^. mcDependencies) dfs') 
+compileInContext mc mcs dfs
+  = (\dfs' -> applyDependencies mcs (mc ^. mcDependencies) (selectEnabled dfs'))
        <$> (mc ^. mcFlagSetup $ dfs)
+  where selectEnabled = if isDirectoryMC mc then id else onlyUseEnabled
 
 applyDependencies :: [ModuleCollection] -> [ModuleCollectionId] -> DynFlags -> DynFlags
-applyDependencies mcs ids dfs = dfs { GHC.packageFlags = catMaybes $ map (dependencyToPkgFlag mcs) ids }
+applyDependencies mcs ids dfs
+  = dfs { GHC.packageFlags = GHC.packageFlags dfs ++ (catMaybes $ map (dependencyToPkgFlag mcs) ids) }
 
+onlyUseEnabled :: DynFlags -> DynFlags
+onlyUseEnabled = GHC.setGeneralFlag' GHC.Opt_HideAllPackages
+
 dependencyToPkgFlag :: [ModuleCollection] -> ModuleCollectionId -> Maybe (GHC.PackageFlag)
-dependencyToPkgFlag mcs lib@(LibraryMC pkgName) 
-  = if isNothing $ find (\mc -> (mc ^. mcId) == lib) mcs 
+dependencyToPkgFlag mcs lib@(LibraryMC pkgName)
+  = if isNothing $ find (\mc -> (mc ^. mcId) == lib) mcs
       then Just $ GHC.ExposePackage pkgName (GHC.PackageArg pkgName) (GHC.ModRenaming True [])
       else Nothing
 dependencyToPkgFlag _ _ = Nothing
 
-enableAllPackages :: [ModuleCollection] -> DynFlags -> DynFlags
-enableAllPackages mcs dfs = applyDependencies mcs allDeps dfs
+setupLoadFlags :: [ModuleCollection] -> DynFlags -> IO DynFlags
+setupLoadFlags mcs dfs = applyDependencies mcs allDeps . selectEnabled <$> useSavedFlags dfs
   where allDeps = mcs ^? traversal & mcDependencies & traversal
+        selectEnabled = if any (\(mc,rest) -> isDirectoryMC mc && isIndependentMc mc rest) (breaks mcs) then id else onlyUseEnabled
+        useSavedFlags = foldl @[] (>=>) return (mcs ^? traversal & mcLoadFlagSetup)
+        isIndependentMc mc rest = not $ any (`isPrefixOf` (mc ^. mcRoot)) (map (^. mcRoot) rest)
 
+breaks :: [a] -> [(a,[a])]
+breaks [] = []
+breaks (e:rest) = (e,rest) : map (\(x,ls) -> (x,e:ls)) (breaks rest)
+
+loadFlagsFromBuildInfo :: BuildInfo -> DynFlags -> IO DynFlags
+loadFlagsFromBuildInfo bi@BuildInfo{ cppOptions } df
+  = do (df',unused,warnings) <- parseDynamicFlags df (map (L noSrcSpan) $ cppOptions)
+       mapM_ putStrLn (map unLoc warnings ++ map (("Flag is not used: " ++) . unLoc) unused)
+       return (setupLoadExtensions df')
+  where setupLoadExtensions = foldl (.) id (map setExtensionFlag' $ catMaybes $ map translateExtension loadExtensions)
+        loadExtensions = [PatternSynonyms | patternSynonymsNeeded] ++ [ExplicitNamespaces | explicitNamespacesNeeded]
+                           ++ [PackageImports | packageImportsNeeded] ++ [CPP | cppNeeded] ++ [MagicHash | magicHashNeeded]
+        explicitNamespacesNeeded = not $ null $ map EnableExtension [ExplicitNamespaces, TypeFamilies, TypeOperators] `intersect` usedExtensions bi
+        patternSynonymsNeeded = EnableExtension PatternSynonyms `elem` usedExtensions bi
+        packageImportsNeeded = EnableExtension PackageImports `elem` usedExtensions bi
+        cppNeeded = EnableExtension CPP `elem` usedExtensions bi
+        magicHashNeeded = EnableExtension MagicHash `elem` usedExtensions bi
+
 flagsFromBuildInfo :: BuildInfo -> DynFlags -> IO DynFlags
 -- the import pathes are already set globally
 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                               
-                                  ) (usedExtensions bi))
-                          $ df
-  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
-        translateExtension RecursiveDo = flip xopt_set GHC.RecursiveDo
-        translateExtension ParallelListComp = flip xopt_set GHC.ParallelListComp
-        translateExtension MultiParamTypeClasses = flip xopt_set GHC.MultiParamTypeClasses
-        translateExtension MonomorphismRestriction = flip xopt_set GHC.MonomorphismRestriction
-        translateExtension FunctionalDependencies = flip xopt_set GHC.FunctionalDependencies
-        translateExtension RankNTypes = flip xopt_set GHC.RankNTypes
-        translateExtension ExistentialQuantification = flip xopt_set GHC.ExistentialQuantification
-        translateExtension ScopedTypeVariables = flip xopt_set GHC.ScopedTypeVariables
-        translateExtension PatternSignatures = flip xopt_set GHC.PatternSynonyms
-        translateExtension ImplicitParams = flip xopt_set GHC.ImplicitParams
-        translateExtension FlexibleContexts = flip xopt_set GHC.FlexibleContexts
-        translateExtension FlexibleInstances = flip xopt_set GHC.FlexibleInstances
-        translateExtension EmptyDataDecls = flip xopt_set GHC.EmptyDataDecls
-        translateExtension CPP = flip xopt_set GHC.Cpp
-        translateExtension KindSignatures = flip xopt_set GHC.KindSignatures
-        translateExtension BangPatterns = flip xopt_set GHC.BangPatterns
-        translateExtension TypeSynonymInstances = flip xopt_set GHC.TypeSynonymInstances
-        translateExtension TemplateHaskell = flip xopt_set GHC.TemplateHaskell
-        translateExtension ForeignFunctionInterface = flip xopt_set GHC.ForeignFunctionInterface
-        translateExtension Arrows = flip xopt_set GHC.Arrows
-        translateExtension ImplicitPrelude = flip xopt_set GHC.ImplicitPrelude
-        translateExtension NamedFieldPuns = flip xopt_set GHC.RecordPuns
-        translateExtension PatternGuards = flip xopt_set GHC.PatternGuards
-        translateExtension GeneralizedNewtypeDeriving = flip xopt_set GHC.GeneralizedNewtypeDeriving
-        translateExtension RestrictedTypeSynonyms = flip xopt_unset GHC.LiberalTypeSynonyms
-        translateExtension MagicHash = flip xopt_set GHC.MagicHash
-        translateExtension TypeFamilies = flip xopt_set GHC.TypeFamilies
-        translateExtension StandaloneDeriving = flip xopt_set GHC.StandaloneDeriving
-        translateExtension UnicodeSyntax = flip xopt_set GHC.UnicodeSyntax
-        translateExtension UnliftedFFITypes = flip xopt_set GHC.UnliftedFFITypes
-        translateExtension InterruptibleFFI = flip xopt_set GHC.InterruptibleFFI
-        translateExtension CApiFFI = flip xopt_set GHC.CApiFFI
-        translateExtension LiberalTypeSynonyms = flip xopt_set GHC.LiberalTypeSynonyms
-        translateExtension TypeOperators = flip xopt_set GHC.TypeOperators
-        translateExtension RecordWildCards = flip xopt_set GHC.RecordWildCards
-        translateExtension RecordPuns = flip xopt_set GHC.RecordPuns
-        translateExtension DisambiguateRecordFields = flip xopt_set GHC.DisambiguateRecordFields
-        translateExtension TraditionalRecordSyntax = flip xopt_set GHC.TraditionalRecordSyntax
-        translateExtension OverloadedStrings = flip xopt_set GHC.OverloadedStrings
-        translateExtension GADTs = flip xopt_set GHC.GADTs
-        translateExtension GADTSyntax = flip xopt_set GHC.GADTSyntax
-        translateExtension MonoPatBinds = flip xopt_set GHC.MonoPatBinds
-        translateExtension RelaxedPolyRec = flip xopt_set GHC.RelaxedPolyRec
-        translateExtension ExtendedDefaultRules = flip xopt_set GHC.ExtendedDefaultRules
-        translateExtension UnboxedTuples = flip xopt_set GHC.UnboxedTuples
-        translateExtension DeriveDataTypeable = flip xopt_set GHC.DeriveDataTypeable
-        translateExtension DeriveGeneric = flip xopt_set GHC.DeriveGeneric
-        translateExtension DefaultSignatures = flip xopt_set GHC.DefaultSignatures
-        translateExtension InstanceSigs = flip xopt_set GHC.InstanceSigs
-        translateExtension ConstrainedClassMethods = flip xopt_set GHC.ConstrainedClassMethods
-        translateExtension PackageImports = flip xopt_set GHC.PackageImports
-        translateExtension ImpredicativeTypes = flip xopt_set GHC.ImpredicativeTypes
-        translateExtension PostfixOperators = flip xopt_set GHC.PostfixOperators
-        translateExtension QuasiQuotes = flip xopt_set GHC.QuasiQuotes
-        translateExtension TransformListComp = flip xopt_set GHC.TransformListComp
-        translateExtension MonadComprehensions = flip xopt_set GHC.MonadComprehensions
-        translateExtension ViewPatterns = flip xopt_set GHC.ViewPatterns
-        translateExtension TupleSections = flip xopt_set GHC.TupleSections
-        translateExtension GHCForeignImportPrim = flip xopt_set GHC.GHCForeignImportPrim
-        translateExtension NPlusKPatterns = flip xopt_set GHC.NPlusKPatterns
-        translateExtension DoAndIfThenElse = flip xopt_set GHC.DoAndIfThenElse
-        translateExtension MultiWayIf = flip xopt_set GHC.MultiWayIf
-        translateExtension LambdaCase = flip xopt_set GHC.LambdaCase
-        translateExtension RebindableSyntax = flip xopt_set GHC.RebindableSyntax
-        translateExtension ExplicitForAll = flip xopt_set GHC.ExplicitForAll
-        translateExtension DatatypeContexts = flip xopt_set GHC.DatatypeContexts
-        translateExtension MonoLocalBinds = flip xopt_set GHC.MonoLocalBinds
-        translateExtension DeriveFunctor = flip xopt_set GHC.DeriveFunctor
-        translateExtension DeriveTraversable = flip xopt_set GHC.DeriveTraversable
-        translateExtension DeriveFoldable = flip xopt_set GHC.DeriveFoldable
-        translateExtension NondecreasingIndentation = flip xopt_set GHC.NondecreasingIndentation
-        translateExtension ConstraintKinds = flip xopt_set GHC.ConstraintKinds
-        translateExtension PolyKinds = flip xopt_set GHC.PolyKinds
-        translateExtension DataKinds = flip xopt_set GHC.DataKinds
-        translateExtension ParallelArrays = flip xopt_set GHC.ParallelArrays
-        translateExtension RoleAnnotations = flip xopt_set GHC.RoleAnnotations
-        translateExtension OverloadedLists = flip xopt_set GHC.OverloadedLists
-        translateExtension EmptyCase = flip xopt_set GHC.EmptyCase
-        translateExtension AutoDeriveTypeable = flip xopt_set GHC.AutoDeriveTypeable
-        translateExtension NegativeLiterals = flip xopt_set GHC.NegativeLiterals
-        translateExtension BinaryLiterals = flip xopt_set GHC.BinaryLiterals
-        translateExtension NumDecimals = flip xopt_set GHC.NumDecimals
-        translateExtension NullaryTypeClasses = flip xopt_set GHC.NullaryTypeClasses
-        translateExtension ExplicitNamespaces = flip xopt_set GHC.ExplicitNamespaces
-        translateExtension AllowAmbiguousTypes = flip xopt_set GHC.AllowAmbiguousTypes
-        translateExtension JavaScriptFFI = flip xopt_set GHC.JavaScriptFFI
-        translateExtension PatternSynonyms = flip xopt_set GHC.PatternSynonyms
-        translateExtension PartialTypeSignatures = flip xopt_set GHC.PartialTypeSignatures
-        translateExtension NamedWildCards = flip xopt_set GHC.NamedWildCards
-        translateExtension DeriveAnyClass = flip xopt_set GHC.DeriveAnyClass
-        translateExtension DeriveLift = flip xopt_set GHC.DeriveLift
-        translateExtension StaticPointers = flip xopt_set GHC.StaticPointers
-        translateExtension StrictData = flip xopt_set GHC.StrictData
-        translateExtension Strict = flip xopt_set GHC.Strict
-        translateExtension ApplicativeDo = flip xopt_set GHC.ApplicativeDo
-        translateExtension DuplicateRecordFields = flip xopt_set GHC.DuplicateRecordFields
-        translateExtension TypeApplications = flip xopt_set GHC.TypeApplications
-        translateExtension TypeInType = flip xopt_set GHC.TypeInType
-        translateExtension UndecidableSuperClasses = flip xopt_set GHC.UndecidableSuperClasses
-        translateExtension MonadFailDesugaring = flip xopt_set GHC.MonadFailDesugaring
-        translateExtension TemplateHaskellQuotes = flip xopt_set GHC.TemplateHaskellQuotes
-        translateExtension OverloadedLabels = flip xopt_set GHC.OverloadedLabels
+  = do (df',unused,warnings) <- parseDynamicFlags df (map (L noSrcSpan) $ concatMap snd options)
+       mapM_ putStrLn (map unLoc warnings ++ map (("Flag is not used: " ++) . unLoc) unused)
+       return $ (flip lang_set (toGhcLang =<< defaultLanguage bi))
+         $ foldl (.) id (map (\case EnableExtension ext -> setEnabled True ext
+                                    DisableExtension ext -> setEnabled False ext
+                        ) (usedExtensions bi))
+         $ foldr (.) id (map (setEnabled True) (languageDefault (defaultLanguage bi)))
+         $ df'
+  where toGhcLang Cabal.Haskell98 = Just GHC.Haskell98
+        toGhcLang Cabal.Haskell2010 = Just GHC.Haskell2010
+        toGhcLang _ = Nothing
 
-        translateExtension Safe = \df -> df { GHC.safeHaskell = GHC.Sf_Safe }
-        translateExtension SafeImports = \df -> df { GHC.safeHaskell = GHC.Sf_Safe }
-        translateExtension Trustworthy = \df -> df { GHC.safeHaskell = GHC.Sf_Trustworthy }
-        translateExtension Unsafe = \df -> df { GHC.safeHaskell = GHC.Sf_Unsafe }
+        -- We don't put the default settings (ImplicitPrelude, MonomorphismRestriction) here
+        -- because that overrides the opposite extensions (NoImplicitPrelude, NoMonomorphismRestriction)
+        -- enabled in modules.
+        languageDefault (Just Cabal.Haskell2010)
+          = [ DatatypeContexts, DoAndIfThenElse, EmptyDataDecls, ForeignFunctionInterface
+            , PatternGuards, RelaxedPolyRec, TraditionalRecordSyntax ]
+        -- Haskell 98 is the default
+        languageDefault _
+          = [ DatatypeContexts, NondecreasingIndentation, NPlusKPatterns, TraditionalRecordSyntax ]
 
-        -- Couldn't find the equivalent of these extensions
-        translateExtension Rank2Types = id
-        translateExtension PolymorphicComponents = id
-        translateExtension Generics = id
-        translateExtension ExtensibleRecords = id
-        translateExtension NewQualifiedOperators = id
-        translateExtension XmlSyntax = id
-        translateExtension HereDocuments = id
-        translateExtension RegularPatterns = id
+        setEnabled enable ext
+          = case translateExtension ext of
+              Just e -> (if enable then setExtensionFlag' else unSetExtensionFlag') e
+              Nothing -> id
+
+-- * Not imported from DynFlags.hs, so I copied it here
+setExtensionFlag', unSetExtensionFlag' :: GHC.Extension -> DynFlags -> DynFlags
+setExtensionFlag' f dflags = foldr ($) (xopt_set dflags f) deps
+  where
+    deps = [ if turn_on then setExtensionFlag'   d
+                        else unSetExtensionFlag' d
+           | (f', turn_on, d) <- impliedXFlags, f' == f ]
+unSetExtensionFlag' f dflags = xopt_unset dflags f
+
+turnOn = True
+turnOff = False
+
+impliedXFlags :: [(GHC.Extension, Bool, GHC.Extension)]
+impliedXFlags
+  = [ (GHC.RankNTypes,                turnOn, GHC.ExplicitForAll)
+    , (GHC.ScopedTypeVariables,       turnOn, GHC.ExplicitForAll)
+    , (GHC.LiberalTypeSynonyms,       turnOn, GHC.ExplicitForAll)
+    , (GHC.ExistentialQuantification, turnOn, GHC.ExplicitForAll)
+    , (GHC.FlexibleInstances,         turnOn, GHC.TypeSynonymInstances)
+    , (GHC.FunctionalDependencies,    turnOn, GHC.MultiParamTypeClasses)
+    , (GHC.MultiParamTypeClasses,     turnOn, GHC.ConstrainedClassMethods)
+    , (GHC.TypeFamilyDependencies,    turnOn, GHC.TypeFamilies)
+    , (GHC.RebindableSyntax, turnOff, GHC.ImplicitPrelude)
+    , (GHC.GADTs,            turnOn, GHC.GADTSyntax)
+    , (GHC.GADTs,            turnOn, GHC.MonoLocalBinds)
+    , (GHC.TypeFamilies,     turnOn, GHC.MonoLocalBinds)
+    , (GHC.TypeFamilies,     turnOn, GHC.KindSignatures)
+    , (GHC.PolyKinds,        turnOn, GHC.KindSignatures)
+    , (GHC.TypeInType,       turnOn, GHC.DataKinds)
+    , (GHC.TypeInType,       turnOn, GHC.PolyKinds)
+    , (GHC.TypeInType,       turnOn, GHC.KindSignatures)
+    , (GHC.AutoDeriveTypeable, turnOn, GHC.DeriveDataTypeable)
+    , (GHC.TypeFamilies,     turnOn, GHC.ExplicitNamespaces)
+    , (GHC.TypeOperators, turnOn, GHC.ExplicitNamespaces)
+    , (GHC.ImpredicativeTypes,  turnOn, GHC.RankNTypes)
+    , (GHC.RecordWildCards,     turnOn, GHC.DisambiguateRecordFields)
+    , (GHC.ParallelArrays, turnOn, GHC.ParallelListComp)
+    , (GHC.JavaScriptFFI, turnOn, GHC.InterruptibleFFI)
+    , (GHC.DeriveTraversable, turnOn, GHC.DeriveFunctor)
+    , (GHC.DeriveTraversable, turnOn, GHC.DeriveFoldable)
+    , (GHC.DuplicateRecordFields, turnOn, GHC.DisambiguateRecordFields)
+    , (GHC.TemplateHaskell, turnOn, GHC.TemplateHaskellQuotes)
+    , (GHC.Strict, turnOn, GHC.StrictData)
+  ]
+
+-- * Mapping of Cabal haskell extensions to their GHC counterpart
+
+-- | Map the cabal extensions to the ones that GHC recognizes
+translateExtension AllowAmbiguousTypes = Just GHC.AllowAmbiguousTypes
+translateExtension ApplicativeDo = Just GHC.ApplicativeDo
+translateExtension Arrows = Just GHC.Arrows
+translateExtension AutoDeriveTypeable = Just GHC.AutoDeriveTypeable
+translateExtension BangPatterns = Just GHC.BangPatterns
+translateExtension BinaryLiterals = Just GHC.BinaryLiterals
+translateExtension CApiFFI = Just GHC.CApiFFI
+translateExtension ConstrainedClassMethods = Just GHC.ConstrainedClassMethods
+translateExtension ConstraintKinds = Just GHC.ConstraintKinds
+translateExtension CPP = Just GHC.Cpp
+translateExtension DataKinds = Just GHC.DataKinds
+translateExtension DatatypeContexts = Just GHC.DatatypeContexts
+translateExtension DefaultSignatures = Just GHC.DefaultSignatures
+translateExtension DeriveAnyClass = Just GHC.DeriveAnyClass
+translateExtension DeriveDataTypeable = Just GHC.DeriveDataTypeable
+translateExtension DeriveFoldable = Just GHC.DeriveFoldable
+translateExtension DeriveFunctor = Just GHC.DeriveFunctor
+translateExtension DeriveGeneric = Just GHC.DeriveGeneric
+translateExtension DeriveLift = Just GHC.DeriveLift
+translateExtension DeriveTraversable = Just GHC.DeriveTraversable
+translateExtension DisambiguateRecordFields = Just GHC.DisambiguateRecordFields
+translateExtension DoAndIfThenElse = Just GHC.DoAndIfThenElse
+translateExtension DoRec = Just GHC.RecursiveDo
+translateExtension DuplicateRecordFields = Just GHC.DuplicateRecordFields
+translateExtension EmptyCase = Just GHC.EmptyCase
+translateExtension EmptyDataDecls = Just GHC.EmptyDataDecls
+translateExtension ExistentialQuantification = Just GHC.ExistentialQuantification
+translateExtension ExplicitForAll = Just GHC.ExplicitForAll
+translateExtension ExplicitNamespaces = Just GHC.ExplicitNamespaces
+translateExtension ExtendedDefaultRules = Just GHC.ExtendedDefaultRules
+translateExtension FlexibleContexts = Just GHC.FlexibleContexts
+translateExtension FlexibleInstances = Just GHC.FlexibleInstances
+translateExtension ForeignFunctionInterface = Just GHC.ForeignFunctionInterface
+translateExtension FunctionalDependencies = Just GHC.FunctionalDependencies
+translateExtension GADTs = Just GHC.GADTs
+translateExtension GADTSyntax = Just GHC.GADTSyntax
+translateExtension GeneralizedNewtypeDeriving = Just GHC.GeneralizedNewtypeDeriving
+translateExtension GHCForeignImportPrim = Just GHC.GHCForeignImportPrim
+translateExtension ImplicitParams = Just GHC.ImplicitParams
+translateExtension ImplicitPrelude = Just GHC.ImplicitPrelude
+translateExtension ImpredicativeTypes = Just GHC.ImpredicativeTypes
+translateExtension IncoherentInstances = Just GHC.IncoherentInstances
+translateExtension InstanceSigs = Just GHC.InstanceSigs
+translateExtension InterruptibleFFI = Just GHC.InterruptibleFFI
+translateExtension JavaScriptFFI = Just GHC.JavaScriptFFI
+translateExtension KindSignatures = Just GHC.KindSignatures
+translateExtension LambdaCase = Just GHC.LambdaCase
+translateExtension LiberalTypeSynonyms = Just GHC.LiberalTypeSynonyms
+translateExtension MagicHash = Just GHC.MagicHash
+translateExtension MonadComprehensions = Just GHC.MonadComprehensions
+translateExtension MonadFailDesugaring = Just GHC.MonadFailDesugaring
+translateExtension MonoLocalBinds = Just GHC.MonoLocalBinds
+translateExtension MonomorphismRestriction = Just GHC.MonomorphismRestriction
+translateExtension MonoPatBinds = Just GHC.MonoPatBinds
+translateExtension MultiParamTypeClasses = Just GHC.MultiParamTypeClasses
+translateExtension MultiWayIf = Just GHC.MultiWayIf
+translateExtension NamedFieldPuns = Just GHC.RecordPuns
+translateExtension NamedWildCards = Just GHC.NamedWildCards
+translateExtension NegativeLiterals = Just GHC.NegativeLiterals
+translateExtension NondecreasingIndentation = Just GHC.NondecreasingIndentation
+translateExtension NPlusKPatterns = Just GHC.NPlusKPatterns
+translateExtension NullaryTypeClasses = Just GHC.NullaryTypeClasses
+translateExtension NumDecimals = Just GHC.NumDecimals
+translateExtension OverlappingInstances = Just GHC.OverlappingInstances
+translateExtension OverloadedLabels = Just GHC.OverloadedLabels
+translateExtension OverloadedLists = Just GHC.OverloadedLists
+translateExtension OverloadedStrings = Just GHC.OverloadedStrings
+translateExtension PackageImports = Just GHC.PackageImports
+translateExtension ParallelArrays = Just GHC.ParallelArrays
+translateExtension ParallelListComp = Just GHC.ParallelListComp
+translateExtension PartialTypeSignatures = Just GHC.PartialTypeSignatures
+translateExtension PatternGuards = Just GHC.PatternGuards
+translateExtension PatternSignatures = Just GHC.PatternSynonyms
+translateExtension PatternSynonyms = Just GHC.PatternSynonyms
+translateExtension PolyKinds = Just GHC.PolyKinds
+translateExtension PostfixOperators = Just GHC.PostfixOperators
+translateExtension QuasiQuotes = Just GHC.QuasiQuotes
+translateExtension RankNTypes = Just GHC.RankNTypes
+translateExtension RebindableSyntax = Just GHC.RebindableSyntax
+translateExtension RecordPuns = Just GHC.RecordPuns
+translateExtension RecordWildCards = Just GHC.RecordWildCards
+translateExtension RecursiveDo = Just GHC.RecursiveDo
+translateExtension RelaxedPolyRec = Just GHC.RelaxedPolyRec
+translateExtension RestrictedTypeSynonyms = Nothing -- flip xopt_unset GHC.LiberalTypeSynonyms
+translateExtension RoleAnnotations = Just GHC.RoleAnnotations
+translateExtension ScopedTypeVariables = Just GHC.ScopedTypeVariables
+translateExtension StandaloneDeriving = Just GHC.StandaloneDeriving
+translateExtension StaticPointers = Just GHC.StaticPointers
+translateExtension Strict = Just GHC.Strict
+translateExtension StrictData = Just GHC.StrictData
+translateExtension TemplateHaskell = Just GHC.TemplateHaskell
+translateExtension TemplateHaskellQuotes = Just GHC.TemplateHaskellQuotes
+translateExtension TraditionalRecordSyntax = Just GHC.TraditionalRecordSyntax
+translateExtension TransformListComp = Just GHC.TransformListComp
+translateExtension TupleSections = Just GHC.TupleSections
+translateExtension TypeApplications = Just GHC.TypeApplications
+translateExtension TypeFamilies = Just GHC.TypeFamilies
+translateExtension TypeInType = Just GHC.TypeInType
+translateExtension TypeOperators = Just GHC.TypeOperators
+translateExtension TypeSynonymInstances = Just GHC.TypeSynonymInstances
+translateExtension UnboxedTuples = Just GHC.UnboxedTuples
+translateExtension UndecidableInstances = Just GHC.UndecidableInstances
+translateExtension UndecidableSuperClasses = Just GHC.UndecidableSuperClasses
+translateExtension UnicodeSyntax = Just GHC.UnicodeSyntax
+translateExtension UnliftedFFITypes = Just GHC.UnliftedFFITypes
+translateExtension ViewPatterns = Just GHC.ViewPatterns
+
+translateExtension Safe = Nothing -- \df -> df { GHC.safeHaskell = GHC.Sf_Safe }
+translateExtension SafeImports = Nothing -- \df -> df { GHC.safeHaskell = GHC.Sf_Safe }
+translateExtension Trustworthy = Nothing -- \df -> df { GHC.safeHaskell = GHC.Sf_Trustworthy }
+translateExtension Unsafe = Nothing -- \df -> df { GHC.safeHaskell = GHC.Sf_Unsafe }
+
+translateExtension Rank2Types = Just GHC.RankNTypes
+translateExtension PolymorphicComponents = Just GHC.RankNTypes
+translateExtension Generics = Nothing -- it does nothing, deprecated extension
+translateExtension NewQualifiedOperators = Nothing -- it does nothing, deprecated extension
+translateExtension ExtensibleRecords = Nothing -- not in GHC
+translateExtension XmlSyntax = Nothing -- not in GHC
+translateExtension HereDocuments = Nothing -- not in GHC
+translateExtension RegularPatterns = Nothing -- not in GHC

@@ -1,13 +1,14 @@ {-# LANGUAGE TupleSections #-}
--- | Defines operation on AST lists. 
+-- | Defines operation on AST lists.
 -- AST lists carry source information so simple list modification is not enough.
 module Language.Haskell.Tools.Refactor.ListOperations where
 
 import Control.Reference
+import Data.List (findIndices)
 
 import Language.Haskell.Tools.AST
 import Language.Haskell.Tools.AST.Rewrite (AnnList)
-import Language.Haskell.Tools.Transform (srcTmpDefaultSeparator, srcTmpSeparators)
+import Language.Haskell.Tools.Transform (srcTmpDefaultSeparator, srcTmpSeparators, srcTmpIndented)
 
 -- | 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.
@@ -16,33 +17,35 @@ 
 filterListIndexed :: (Int -> Ann e dom SrcTemplateStage -> Bool) -> AnnList e dom -> AnnList e dom
 filterListIndexed pred (AnnListG (NodeInfo sema src) elems)
-  = let (filteredElems, separators) = filterElems 0 elems (src ^. srcTmpSeparators)
-     in AnnListG (NodeInfo sema (srcTmpSeparators .= separators $ src)) filteredElems
-  where filterElems i (elem:ls) (sep:seps) 
-          | pred i elem = let (elems',seps') = filterElems' (i+1) ls (sep:seps) in (elem:elems', seps')
-          | otherwise = filterElems (i+1) ls seps
-        filterElems i elems [] = (filter (pred i) elems, [])
-        filterElems _ [] seps = ([], seps)
-        
-        filterElems' i (elem:ls) (sep:seps) 
-          | pred i elem = let (elems',seps') = filterElems' (i+1) ls seps in (elem:elems', sep:seps')
-          | otherwise = filterElems' (i+1) ls seps
-        filterElems' i elems [] = (filter (pred i) elems, [])
-        filterElems' _ [] seps = ([], seps)
-                            
+  = 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
+
+-- | 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
+
 -- | Inserts the element in the places where the two positioning functions (one checks the element before, one the element after)
--- allows the placement.         
-insertWhere :: Ann e dom SrcTemplateStage -> (Maybe (Ann e dom SrcTemplateStage) -> Bool) 
-                 -> (Maybe (Ann e dom SrcTemplateStage) -> Bool) -> AnnList e dom 
+-- allows the placement.
+insertWhere :: Bool -> Ann e dom SrcTemplateStage -> (Maybe (Ann e dom SrcTemplateStage) -> Bool)
+                 -> (Maybe (Ann e dom SrcTemplateStage) -> Bool) -> AnnList e dom
                  -> AnnList e dom
-insertWhere e before after al 
+insertWhere indented e before after al
   = let index = insertIndex before after (al ^? annList)
-     in case index of 
+     in case index of
           Nothing -> al
-          Just ind -> annListElems .- insertAt ind e 
-                        $ (if isEmptyAnnList then id else annListAnnot&sourceInfo .- addDefaultSeparator ind)
-                        $ al 
-  where addDefaultSeparator i al = srcTmpSeparators .- insertAt i (al ^. srcTmpDefaultSeparator) $ al
+          Just ind -> annListElems .- insertAt ind e
+                        $ (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
         insertAt n e ls = let (bef,aft) = splitAt n ls in bef ++ [e] ++ aft
         isEmptyAnnList = (null :: [x] -> Bool) $ (al ^? annList)
 
@@ -53,23 +56,23 @@   | otherwise = Nothing
 insertIndex before after list@(first:_)
   | before Nothing && after (Just first) = Just 0
-  | otherwise = (+1) <$> insertIndex' before after list 
-  where insertIndex' before after (curr:rest@(next:_)) 
+  | otherwise = (+1) <$> insertIndex' before after list
+  where insertIndex' before after (curr:rest@(next:_))
           | before (Just curr) && after (Just next) = Just 0
           | otherwise = (+1) <$> insertIndex' before after rest
-        insertIndex' before after (curr:[]) 
+        insertIndex' before after (curr:[])
           | before (Just curr) && after Nothing = Just 0
           | otherwise = Nothing
-        insertIndex' before after [] 
+        insertIndex' before after []
           | 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 
+zipWithSeparators (AnnListG (NodeInfo _ src) elems)
+  | [] <- src ^. srcTmpSeparators
   = zip ("" : repeat (src ^. srcTmpDefaultSeparator)) elems
-  | otherwise 
+  | otherwise
   = zip ("" : seps ++ repeat (last seps)) elems
   where seps = src ^. srcTmpSeparators

@@ -29,15 +29,15 @@ import GHC
 
 -- | Executes a given command on the selected module and given other modules
-performCommand :: (HasModuleInfo dom, DomGenerateExports dom, OrganizeImportsDomain dom, DomainRenameDefinition dom, ExtractBindingDomain dom, GenerateSignatureDomain dom) 
+performCommand :: (HasModuleInfo dom, DomGenerateExports dom, OrganizeImportsDomain dom, DomainRenameDefinition dom, ExtractBindingDomain dom, GenerateSignatureDomain dom)
                => RefactorCommand -> ModuleDom dom -- ^ The module in which the refactoring is performed
                                   -> [ModuleDom dom] -- ^ Other modules
                                   -> Ghc (Either String [RefactorChange dom])
 performCommand rf mod mods = runRefactor mod mods $ selectCommand rf
   where selectCommand NoRefactor = localRefactoring return
         selectCommand OrganizeImports = localRefactoring organizeImports
-        selectCommand ProjectOrganizeImports = projectOrganizeImports 
-        selectCommand GenerateExports = localRefactoring generateExports 
+        selectCommand ProjectOrganizeImports = projectOrganizeImports
+        selectCommand GenerateExports = localRefactoring generateExports
         selectCommand (GenerateSignature sp) = localRefactoring $ generateTypeSignature' (correctRefactorSpan (snd mod) sp)
         selectCommand (RenameDefinition sp str) = renameDefinition' (correctRefactorSpan (snd mod) sp) str
         selectCommand (ExtractBinding sp str) = localRefactoring $ extractBinding' (correctRefactorSpan (snd mod) sp) str
@@ -45,7 +45,7 @@         selectCommand (FloatOut sp) = localRefactoring $ floatOut (correctRefactorSpan (snd mod) sp)
 
 -- | A refactoring command
-data RefactorCommand = NoRefactor 
+data RefactorCommand = NoRefactor
                      | OrganizeImports
                      | ProjectOrganizeImports
                      | GenerateExports
@@ -57,21 +57,31 @@     deriving Show
 
 -- | Recognize a command from its textual representation
-readCommand :: String -> RefactorCommand
+readCommand :: String -> Either 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
-analyzeCommand "OrganizeImports" _ = OrganizeImports
-analyzeCommand "ProjectOrganizeImports" _ = ProjectOrganizeImports
-analyzeCommand "GenerateExports" _ = GenerateExports
-analyzeCommand "GenerateSignature" [sp] = GenerateSignature (readSrcSpan sp)
-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
+analyzeCommand :: String -> [String] -> Either String RefactorCommand
+analyzeCommand "" _ = Right NoRefactor
+analyzeCommand "CheckSource" _ = Right NoRefactor
+analyzeCommand "OrganizeImports" _ = Right OrganizeImports
+analyzeCommand "ProjectOrganizeImports" _ = Right ProjectOrganizeImports
+analyzeCommand "GenerateExports" _ = Right GenerateExports
+analyzeCommand "GenerateSignature" [sp] = Right $ GenerateSignature (readSrcSpan sp)
+analyzeCommand "GenerateSignature" _ = Left $ "GenerateSignature needs one argument: the source range of the definition"
+analyzeCommand "RenameDefinition" [sp, newName] = Right $ RenameDefinition (readSrcSpan sp) newName
+analyzeCommand "RenameDefinition" _ = Left $ "RenameDefinition needs two arguments: the source range of the name and the new name"
+analyzeCommand "ExtractBinding" [sp, newName] = Right $ ExtractBinding (readSrcSpan sp) newName
+analyzeCommand "ExtractBinding" _ = Left $ "RenameDefinition needs two arguments: the source range of the expression and the new name"
+analyzeCommand "InlineBinding" [sp] = Right $ InlineBinding (readSrcSpan sp)
+analyzeCommand "InlineBinding" _ = Left $ "InlineBinding needs one argument: the source range of the definition"
+analyzeCommand "FloatOut" [sp] = Right $ FloatOut (readSrcSpan sp)
+analyzeCommand "FloatOut" _ = Left $ "FloatOut needs one argument: the source range of the definition"
+analyzeCommand ref _ = Left $ "Unknown command: " ++ ref
 
+refactorCommands :: [String]
+refactorCommands
+  = [ "CheckSource", "OrganizeImports", "ProjectOrganizeImports", "GenerateExports"
+    , "GenerateSignature", "RenameDefinition", "ExtractBinding", "InlineBinding"
+    , "FloatOut" ]

@@ -0,0 +1,16 @@+module Language.Haskell.Tools.Refactor.Predefined.DollarApp1 where
+
+import Language.Haskell.Tools.Refactor
+
+import Control.Reference
+import SrcLoc (RealSrcSpan)
+
+tryItOut :: String -> String -> IO ()
+tryItOut = tryRefactor (localRefactoring . dollarApp)
+
+dollarApp :: Domain dom => RealSrcSpan -> LocalRefactoring dom
+dollarApp sp = return . (nodesContained sp .- replaceExpr)
+
+replaceExpr :: Expr dom -> Expr dom
+replaceExpr (App fun (Paren arg)) = mkInfixApp fun (mkUnqualOp "$") arg
+replaceExpr e = e

@@ -0,0 +1,23 @@+{-# LANGUAGE FlexibleContexts #-}
+module Language.Haskell.Tools.Refactor.Predefined.DollarApp2 where
+
+import Language.Haskell.Tools.Refactor
+
+import Control.Reference
+import SrcLoc (RealSrcSpan)
+import Unique (getUnique)
+import Id (idName)
+import PrelNames (dollarIdKey)
+import PrelInfo (wiredInIds)
+
+tryItOut :: String -> String -> IO ()
+tryItOut = tryRefactor (localRefactoring . dollarApp)
+
+dollarApp :: (HasImportInfo dom, HasModuleInfo dom) => RealSrcSpan -> LocalRefactoring dom
+dollarApp sp = nodesContained sp !~ replaceExpr
+
+replaceExpr :: (HasImportInfo dom, HasModuleInfo dom) => Expr dom -> LocalRefactor dom (Expr dom)
+replaceExpr (App fun (Paren arg)) = mkInfixApp fun <$> referenceOperator dollarName <*> pure arg
+replaceExpr e = pure e
+
+[dollarName] = map idName $ filter ((dollarIdKey==) . getUnique) wiredInIds

@@ -0,0 +1,44 @@+{-# LANGUAGE ViewPatterns, FlexibleContexts, ConstraintKinds #-}
+module Language.Haskell.Tools.Refactor.Predefined.DollarApp3 where
+
+import Language.Haskell.Tools.Refactor
+
+import BasicTypes (Fixity(..))
+import Id (idName)
+import qualified Name as GHC (Name)
+import PrelInfo (wiredInIds)
+import PrelNames (dollarIdKey)
+import SrcLoc (RealSrcSpan, SrcSpan)
+import Unique (getUnique)
+
+import Control.Monad.State
+import Control.Reference ((^.), (!~), biplateRef)
+
+tryItOut :: String -> String -> IO ()
+tryItOut = tryRefactor (localRefactoring . dollarApp)
+
+type DollarMonad dom = StateT [SrcSpan] (LocalRefactor dom)
+type DollarDomain dom = (HasImportInfo dom, HasModuleInfo dom, HasFixityInfo dom, HasNameInfo dom)
+
+dollarApp :: DollarDomain dom => RealSrcSpan -> LocalRefactoring dom
+dollarApp sp = flip evalStateT [] . ((nodesContained sp !~ (\e -> get >>= replaceExpr e))
+                                        >=> (biplateRef !~ parenExpr))
+
+replaceExpr :: DollarDomain dom => Expr dom -> [SrcSpan] -> DollarMonad dom (Expr dom)
+replaceExpr (App fun (Paren arg)) _ = do modify $ (getRange arg :)
+                                         mkInfixApp fun <$> lift (referenceOperator dollarName) <*> pure arg
+replaceExpr e _ = return e
+
+parenExpr :: Expr dom -> DollarMonad dom (Expr dom)
+parenExpr e = (exprLhs !~ parenDollar True) =<< (exprRhs !~ parenDollar False $ e)
+
+parenDollar :: Bool -> Expr dom -> DollarMonad dom (Expr dom)
+parenDollar lhs expr@(InfixApp _ _ arg)
+  = do replacedRanges <- get
+       if getRange arg `elem` replacedRanges && (lhs || getRange expr `notElem` replacedRanges)
+         then return $ mkParen expr
+         else return expr
+parenDollar _ e = return e
+
+dollarName :: GHC.Name
+[dollarName] = map idName $ filter ((dollarIdKey==) . getUnique) wiredInIds

@@ -6,6 +6,7 @@            , TypeApplications
            , ConstraintKinds
            , TypeFamilies
+           , MultiWayIf
            #-}
 module Language.Haskell.Tools.Refactor.Predefined.ExtractBinding (extractBinding', ExtractBindingDomain, tryItOut) where
 
@@ -20,7 +21,7 @@ import Control.Monad.State
 import Control.Reference
 import Data.Generics.Uniplate.Data ()
-import Data.List (find)
+import Data.List (find, intersperse)
 import Data.Maybe
 
 import Language.Haskell.Tools.Refactor
@@ -34,27 +35,35 @@ 
 extractBinding' :: ExtractBindingDomain dom => RealSrcSpan -> String -> LocalRefactoring dom
 extractBinding' 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"
+  = if isNothing (isValidBindingName name)
+      then extractBinding sp (nodesContaining sp) (nodesContaining sp) name mod
+      else refactError $ "The given name is not a valid for the extracted binding: " ++ fromJust (isValidBindingName name)
 
 -- | 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 
+extractBinding :: forall dom . ExtractBindingDomain dom
                => RealSrcSpan -> Simple Traversal (Module dom) (ValueBind dom)
                    -> Simple Traversal (ValueBind dom) (Expr dom)
                    -> String -> LocalRefactoring dom
 extractBinding sp selectDecl selectExpr name mod
-  = let conflicting = any (isConflicting name) (mod ^? selectDecl & biplateRef :: [QualifiedName dom])
+  = let conflicting = filter (isConflicting name) ((take 1 $ reverse $ mod ^? selectDecl) ^? biplateRef :: [QualifiedName dom])
         exprRanges = map getRange (mod ^? selectDecl & selectExpr)
         decl = last (mod ^? selectDecl)
-     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."
+        declPats = decl ^? valBindPat &+& funBindMatches & annList & matchLhs
+                                            & (matchLhsArgs & annList &+& matchLhsLhs &+& matchLhsRhs &+& matchLhsArgs & annList)
+     in case exprRanges of
+          exprRange:_ ->
+            if | not (null conflicting)
+               -> refactError $ "The given name causes name conflict with the definition(s) at: " ++ concat (intersperse "," (map (shortShowSpan . getRange) conflicting))
+               | any (`containsRange` exprRange) $ map getRange declPats
+               -> refactError "Extract binding cannot be applied to view pattern expressions."
+               | otherwise
+               -> 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."
+  where RealSrcSpan sp1 `containsRange` RealSrcSpan sp2 = sp1 `containsSpan` sp2
+        _ `containsRange` _ = False
 
 -- | 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
@@ -63,11 +72,11 @@       && (GHC.occNameString . GHC.getOccName <$> semanticsName used) == Just name
 
 -- Replaces the selected expression with a call and generates the called binding.
-extractThatBind :: ExtractBindingDomain dom 
+extractThatBind :: ExtractBindingDomain dom
                 => 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 
+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
@@ -93,14 +102,14 @@                   && 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)) 
+                    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) 
+                    return (mkInfixApp (generateCall name params) rop rhs)
             -- normal case
             el | isParenLikeExpr el && hasParameter -> mkParen <$> doExtract name cont e
                | otherwise -> doExtract name cont e
@@ -109,28 +118,28 @@         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 
+        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 
+        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 
+        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)
 -- this uses the state monad to only add the local binding to the first selected element
-addLocalBinding exprRange local bind 
+addLocalBinding exprRange local bind
   = do done <- get
        if not done then do put True
                            return $ indentBody $ doAddBinding exprRange local bind
-                   else return bind 
+                   else return bind
   where
     doAddBinding _ local sb@(SimpleBind {}) = valBindLocals .- insertLocalBind local $ sb
-    doAddBinding (RealSrcSpan rng) local fb@(FunctionBind {}) 
-      = funBindMatches & annList & filtered (isInside rng) & matchBinds 
+    doAddBinding (RealSrcSpan rng) local fb@(FunctionBind {})
+      = funBindMatches & annList & filtered (isInside rng) & matchBinds
           .- insertLocalBind local $ fb
     doAddBinding _ _ _ = error "doAddBinding: invalid expression range"
 
@@ -141,9 +150,9 @@ 
 -- | Puts a value definition into a list of local binds
 insertLocalBind :: ValueBind dom -> MaybeLocalBinds dom -> MaybeLocalBinds dom
-insertLocalBind toInsert locals 
+insertLocalBind toInsert locals
   | isAnnNothing locals = mkLocalBinds [mkLocalValBind toInsert]
-  | otherwise = annJust & localBinds .- insertWhere (mkLocalValBind toInsert) (const True) isNothing $ locals
+  | otherwise = annJust & localBinds .- insertWhere True (mkLocalValBind toInsert) (const True) isNothing $ locals
 
 -- | All expressions that are bound stronger than function application.
 isParenLikeExpr :: Expr dom -> Bool
@@ -165,13 +174,13 @@ isParenLikeExpr _ = False
 
 -- | Replaces the expression with the call and stores the binding of the call in its state
-doExtract :: ExtractBindingDomain dom 
+doExtract :: ExtractBindingDomain dom
           => String -> Expr dom -> Expr dom -> StateT (Maybe (ValueBind dom)) (LocalRefactor dom) (Expr dom)
 doExtract name cont e@(Lambda (AnnList bindings) inner)
   = do let params = getExternalBinds cont e
        put (Just (generateBind name (map mkVarPat params ++ bindings) inner))
        return (generateCall name params)
-doExtract name cont e 
+doExtract name cont e
   = do let params = getExternalBinds cont e
        put (Just (generateBind name (map mkVarPat params) e))
        return (generateCall name params)
@@ -189,8 +198,8 @@         exprToName :: Expr dom -> Name dom
         exprToName e | Just n <- e ^? exprName                     = n
                      | Just op <- e ^? exprOperator & operatorName = mkParenName op
-                     | otherwise                                   = error "exprToName: name not found" 
-        
+                     | otherwise                                   = error "exprToName: name not found"
+
         notInScopeForExtracted :: GHC.Name -> Bool
         notInScopeForExtracted n = not $ n `inScope` semanticsScope cont
 
@@ -217,5 +226,5 @@ generateBind name [] e = mkSimpleBind (mkVarPat $ mkNormalName $ mkSimpleName name) (mkUnguardedRhs e) Nothing
 generateBind name args e = mkFunctionBind [mkMatch (mkMatchLhs (mkNormalName $ mkSimpleName name) args) (mkUnguardedRhs e) Nothing]
 
-isValidBindingName :: String -> Bool
+isValidBindingName :: String -> Maybe String
 isValidBindingName = nameValid Variable

@@ -21,9 +21,9 @@ type FloatOutDefinition dom = (HasNameInfo dom, HasScopeInfo dom)
 
 floatOut :: FloatOutDefinition dom => RealSrcSpan -> LocalRefactoring dom
-floatOut sp mod 
+floatOut sp mod
   = do (mod', st) <- runStateT (nodesContaining sp !~ extractAndInsert sp $ mod) NotEncountered
-       case st of NotEncountered -> refactError "No definition is selected."
+       case st of NotEncountered -> refactError "No definition is selected. The selection range must be inside the definition."
                   Extracted bnds -> -- insert it to the global definition list
                                     return $ modDecl & annListElems .- (++ map toTopLevel bnds) $ removeEmpties mod'
                   Inserted -> -- already inserted to a local scope
@@ -38,9 +38,9 @@ data FloatState dom = NotEncountered | Extracted [LocalBind dom] | Inserted
 
 extractAndInsert :: FloatOutDefinition dom => RealSrcSpan -> LocalBindList dom -> StateT (FloatState dom) (LocalRefactor dom) (LocalBindList dom)
-extractAndInsert sp locs 
+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: " 
+  | 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)
@@ -49,7 +49,7 @@                               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 
+          where nameIsSelected [n] = n `elem` concatMap (^? elementName) selected
                 nameIsSelected _ = False
 
         filteredLocs = filterList (\e -> not (getRange e `elem` floatedElemRanges)) locs
@@ -64,13 +64,13 @@ 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 
+          where outerScope = concat $ take 1 $ drop 2 $ semanticsScope bndName
                 nameStr = fmap (occNameString . getOccName) $ semanticsName bndName
-        implicits = map (occNameString . getOccName) 
+        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)+        getPossibleImplicits qn = concat (take 2 $ semanticsScope qn) \\ catMaybes (map semanticsName bndNames)

@@ -1,13 +1,13 @@ {-# LANGUAGE ViewPatterns
            , FlexibleContexts
            , ScopedTypeVariables
-           , RankNTypes 
+           , RankNTypes
            , TypeApplications
            , TypeFamilies
            , ConstraintKinds
            , TupleSections
            #-}
-module Language.Haskell.Tools.Refactor.Predefined.GenerateTypeSignature 
+module Language.Haskell.Tools.Refactor.Predefined.GenerateTypeSignature
   (generateTypeSignature, generateTypeSignature', GenerateSignatureDomain, tryItOut) where
 
 import GHC hiding (Module)
@@ -27,49 +27,49 @@ 
 import Language.Haskell.Tools.Refactor as AST
 
-type GenerateSignatureDomain dom = ( HasModuleInfo dom, HasIdInfo dom, HasImportInfo dom, HasScopeInfo dom ) 
+type GenerateSignatureDomain dom = ( HasModuleInfo dom, HasIdInfo dom, HasImportInfo dom, HasScopeInfo dom )
 
 tryItOut :: String -> String -> IO ()
 tryItOut = tryRefactor (localRefactoring . generateTypeSignature')
 
 generateTypeSignature' :: GenerateSignatureDomain dom => RealSrcSpan -> LocalRefactoring dom
-generateTypeSignature' sp = generateTypeSignature (nodesContaining sp) (nodesContaining sp) (getValBindInList sp) 
+generateTypeSignature' sp = generateTypeSignature (nodesContaining sp) (nodesContaining sp) (getValBindInList sp)
 
 -- | Perform the refactoring on either local or top-level definition
-generateTypeSignature :: GenerateSignatureDomain dom => Simple Traversal (Module dom) (DeclList dom) 
+generateTypeSignature :: GenerateSignatureDomain dom => Simple Traversal (Module dom) (DeclList dom)
                                 -- ^ Access for a top-level definition if it is the selected definition
-                           -> Simple Traversal (Module dom) (LocalBindList dom) 
+                           -> Simple Traversal (Module dom) (LocalBindList dom)
                                 -- ^ Access for a definition list if it contains the selected definition
-                           -> (forall d . (BindingElem d) => AnnList d dom -> Maybe (ValueBind dom)) 
+                           -> (forall d . (BindingElem d) => AnnList d dom -> Maybe (ValueBind dom))
                                 -- ^ Selector for either local or top-level declaration in the definition list
                            -> LocalRefactoring dom
 generateTypeSignature topLevelRef localRef vbAccess mod
   = let typeSigs = universeBi mod
         bindings = universeBi mod
         findTypeSigFor id = find (\ts -> any (id ==) $ map semanticsId (ts ^? tsName & annList & simpleName))
-        bindsWithSigs = catMaybes $ concatMap (\b -> map (\n -> let id = semanticsId n in fmap (id,,b) (findTypeSigFor id typeSigs)) (b ^? bindingName)) bindings 
+        bindsWithSigs = catMaybes $ concatMap (\b -> map (\n -> let id = semanticsId n in fmap (id,,b) (findTypeSigFor id typeSigs)) (b ^? bindingName)) bindings
         scopedSigs = hasScopedTypeSignatures mod
      in flip evalStateT False .
           (topLevelRef !~ genTypeSig scopedSigs bindsWithSigs vbAccess
              <=< localRef !~ genTypeSig scopedSigs bindsWithSigs vbAccess) $ mod
-  
+
 hasScopedTypeSignatures :: Module dom -> Bool
 hasScopedTypeSignatures mod = "ScopedTypeVariables" `elem` (mod ^? filePragmas & annList & lpPragmas & annList & langExt :: [String])
 
-genTypeSig :: forall dom d . (GenerateSignatureDomain dom, BindingElem d) => Bool -> [(GHC.Var, TypeSignature dom, ValueBind dom)] -> (AnnList d dom -> Maybe (ValueBind dom))  
+genTypeSig :: forall dom d . (GenerateSignatureDomain dom, BindingElem d) => Bool -> [(GHC.Var, TypeSignature dom, ValueBind dom)] -> (AnnList d dom -> Maybe (ValueBind dom))
                 -> AnnList d dom -> StateT Bool (LocalRefactor dom) (AnnList d dom)
-genTypeSig scopedSigs sigBinds vbAccess ls 
-  | Just vb <- vbAccess ls 
+genTypeSig scopedSigs sigBinds vbAccess ls
+  | Just vb <- vbAccess ls
   , not (typeSignatureAlreadyExist ls vb)
-    = if isSimpleBinding vb 
-        then 
+    = if isSimpleBinding vb
+        then
           do let id = getBindingName vb
-                 isTheBind (Just decl) 
+                 isTheBind (Just decl)
                    = isBinding decl && map semanticsId (decl ^? elementName) == map semanticsId (vb ^? bindingName)
                  isTheBind _ = False
-                 
+
              alreadyGenerated <- get
-             if alreadyGenerated 
+             if alreadyGenerated
                then return ls
                else do put True
                        -- checking for possible situations when we cannot generate signature because of
@@ -77,12 +77,12 @@                        let dangerousTypeVars = dangerousTVs scopedSigs sigBinds
                            myTvs = concatMap @[] (getExternalTVs . idType . semanticsId) (vb ^? bindingName)
                        if not $ null @[] $ myTvs `intersect` dangerousTypeVars
-                         then refactError $ "Could not generate type signature: the type variable(s) " 
-                                              ++ concat (intersperse ", " $ map (showSDocUnsafe . ppr) (myTvs `intersect` dangerousTypeVars)) 
+                         then refactError $ "Could not generate type signature: the type variable(s) "
+                                              ++ concat (intersperse ", " $ map (showSDocUnsafe . ppr) (myTvs `intersect` dangerousTypeVars))
                                               ++ " cannot be captured. (Use ScopedTypeVariables and forall-ed type signatures)"
-                         else do 
+                         else do
                            typeSig <- lift $ generateTSFor (getName id) (idType id)
-                           return $ insertWhere (createTypeSig typeSig) (const True) isTheBind ls
+                           return $ insertWhere True (createTypeSig typeSig) (const True) isTheBind ls
         else refactError "Signature can only be generated for simple value bindings."
   | otherwise = return ls
   where isSimpleBinding vb = case vb of SimpleBind (AST.VarPat {}) _ _ -> True
@@ -97,13 +97,13 @@ generateTSFor n t = mkTypeSignature (mkUnqualName' n) <$> generateTypeFor (-1) (dropForAlls t)
 
 -- | Generates the source-level type for a GHC internal type
-generateTypeFor :: GenerateSignatureDomain dom => Int -> GHC.Type -> LocalRefactor dom (AST.Type dom) 
-generateTypeFor prec t 
+generateTypeFor :: GenerateSignatureDomain dom => Int -> GHC.Type -> LocalRefactor dom (AST.Type dom)
+generateTypeFor prec t
   -- context
   | (break (not . isPredTy) -> (preds, other), rt) <- splitFunTys t
   , not (null preds)
-  = do ctx <- case preds of [pred] -> mkContextOne <$> generateAssertionFor pred
-                            _ -> mkContextMulti <$> mapM generateAssertionFor preds
+  = do ctx <- case preds of [pred] -> mkContext <$> generateAssertionFor pred
+                            _      -> mkContext <$> (mkTupleAssertion <$> mapM generateAssertionFor preds)
        wrapParen 0 <$> (mkCtxType ctx <$> generateTypeFor 0 (mkFunTys other rt))
   -- function
   | Just (at, rt) <- splitFunTy_maybe t
@@ -147,19 +147,18 @@         getTCId tc = GHC.mkVanillaGlobal (GHC.tyConName tc) (tyConKind tc)
 
         generateAssertionFor :: GenerateSignatureDomain dom => GHC.Type -> LocalRefactor dom (Assertion dom)
-        generateAssertionFor t 
+        generateAssertionFor t
           | Just (tc, types) <- splitTyConApp_maybe t
           = mkClassAssert <$> referenceName (idName $ getTCId tc) <*> mapM (generateTypeFor 0) types
           | otherwise = error "generateAssertionFor: type not supported yet."
-        -- TODO: infix things
-    
+
 -- | Check whether the definition already has a type signature
 typeSignatureAlreadyExist :: (GenerateSignatureDomain dom, BindingElem d) => AnnList d dom -> ValueBind dom -> Bool
-typeSignatureAlreadyExist ls vb = 
+typeSignatureAlreadyExist ls vb =
   getBindingName vb `elem` (map semanticsId $ concatMap (^? elementName) (filter isTypeSig $ ls ^? annList))
-  
+
 getBindingName :: GenerateSignatureDomain dom => ValueBind dom -> GHC.Id
-getBindingName vb = case nub $ map semanticsId $ vb ^? bindingName of 
+getBindingName vb = case nub $ map semanticsId $ vb ^? bindingName of
   [n] -> n
   [] -> error "Trying to generate a signature for a binding with no name"
   _ -> error "Trying to generate a signature for a binding with multiple names"
@@ -174,4 +173,4 @@   | otherwise = []
 
 isForalledTS :: TypeSignature dom -> Bool
-isForalledTS ts = not $ null @[] $ ts ^? tsType & typeBounded & annList+isForalledTS ts = not $ null @[] $ ts ^? tsType & typeBounded & annList

@@ -0,0 +1,17 @@+module Language.Haskell.Tools.Refactor.Predefined.HelloRefactor where
+
+import Language.Haskell.Tools.PrettyPrint (prettyPrint)
+import Language.Haskell.Tools.Refactor
+
+import Control.Reference
+import Debug.Trace (trace)
+import SrcLoc (RealSrcSpan)
+
+tryItOut :: String -> String -> IO ()
+tryItOut = tryRefactor (localRefactoring . helloRefactor)
+
+helloRefactor :: Domain dom => RealSrcSpan -> LocalRefactoring dom
+helloRefactor sp = return . (nodesContained sp .- helloExpr)
+
+helloExpr :: Expr dom -> Expr dom
+helloExpr e = trace ("\n### Hello: " ++ prettyPrint e) $ e

@@ -1,14 +1,15 @@-{-# LANGUAGE LambdaCase 
+{-# LANGUAGE LambdaCase
            , ScopedTypeVariables
            , FlexibleContexts
            , TypeFamilies
            , ConstraintKinds
            , TupleSections
+           , TypeApplications
            #-}
 module Language.Haskell.Tools.Refactor.Predefined.OrganizeImports (organizeImports, OrganizeImportsDomain, projectOrganizeImports) where
 
 import ConLike (ConLike(..))
-import DataCon (FieldLbl(..), dataConTyCon)
+import DataCon (dataConTyCon)
 import DynFlags (xopt)
 import FamInstEnv (FamInst(..))
 import GHC (TyThing(..), lookupName)
@@ -18,11 +19,12 @@ import InstEnv (ClsInst(..))
 import Language.Haskell.TH.LanguageExtensions as GHC (Extension(..))
 import Name (NamedThing(..))
-import TyCon (tyConFieldLabels, tyConDataCons, isClassTyCon)
+import OccName (HasOccName(..), isSymOcc)
+import qualified PrelNames as GHC (fromStringName)
+import TyCon (TyCon(..), tyConFamInst_maybe)
 
 import Control.Applicative ((<$>), Alternative(..))
 import Control.Monad
-import Control.Monad.Trans (MonadTrans(..))
 import Control.Reference hiding (element)
 import Data.Function hiding ((&))
 import Data.Generics.Uniplate.Data (universeBi)
@@ -39,23 +41,49 @@ 
 organizeImports :: forall dom . OrganizeImportsDomain dom => LocalRefactoring dom
 organizeImports mod
-  = do ms <- lift $ GHC.getModSummary (GHC.moduleName $ semanticsModule mod)
-       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 noNarrowingSubspecs exportedModules usedNames prelInstances prelFamInsts . sortImports $ mod
+  = do usedTyThings <- catMaybes <$> mapM lookupName usedNames
+       let dfs = semanticsDynFlags mod
+           noNarrowingImports
+             = xopt TemplateHaskell dfs -- no narrowing if TH is present (we don't know what will be used)
+                || xopt QuasiQuotes dfs -- no narrowing if TH quotes are present (we don't know what will be used)
+                || (xopt FlexibleInstances dfs && noNarrowingSubspecs) -- arbitrary ctors might be needed when using imported data families
+           noNarrowingSubspecs
+             = -- both standalone deriving and FFI marshalling can cause constructors to be used in the generated code
+               xopt GHC.StandaloneDeriving dfs || hasMarshalling
+                   -- while pattern synonyms are not handled correctly, we disable subspec narrowing to be safe
+                || patternSynonymAreUsed usedTyThings
+       if noNarrowingImports
+         then -- we don't know what definitions the generated code will use
+              return $ modImports .- sortImports $ mod
+         else modImports !~ narrowImports noNarrowingSubspecs exportedModules (addFromString dfs usedNames) exportedNames prelInstances prelFamInsts . sortImports $ mod
   where prelInstances = semanticsPrelOrphanInsts mod
         prelFamInsts = semanticsPrelFamInsts mod
+        addFromString dfs = if xopt OverloadedStrings dfs then (GHC.fromStringName :) else id
         usedNames = map getName $ catMaybes $ map semanticsName
                         -- obviously we don't want the names in the imports to be considered, but both from
                         -- the declarations (used), both from the module head (re-exported) will count as usage
                       $ (universeBi (mod ^. modHead) ++ universeBi (mod ^. modDecl) :: [QualifiedName dom])
-        exportedModules = mod ^? modHead & annJust & mhExports & annJust 
-                                   & espExports & annList & exportModuleName & moduleNameString
-        
+        -- Prelude is not actually exported, but we don't want to remove it if it is explicitly there
+        -- otherwise, we might add new imported elements that cause conflicts.
+        exportedModules = "Prelude" : (mod ^? modHead & annJust & mhExports & annJust
+                                                & espExports & annList & exportModuleName & moduleNameString)
+
+        -- Exported definitions must be kept imported
+        exports = mod ^? modHead & annJust & mhExports & annJust & espExports & annList & exportDecl
+        exportedNames = catMaybes $ map getExported exports
+        getExported e = fmap (,hasChild) name
+          where name = semanticsName (e ^. ieName & simpleName)
+                hasChild = (case e ^? ieSubspec & annJust of Just SubAll -> True; _ -> False)
+                             || not (null @[] (e ^? ieSubspec & annJust & essList & annList))
+
+        -- Checks if the module uses foreign import/export that requires marshalling. In this case no
+        -- subspecifiers could be narrowed because constructors might be needed.
+        hasMarshalling = not $ null @[] (mod ^? modDecl & annList & declForeignType)
+
+        -- Can this name be part of the source code?
+        -- isSourceName n = ':' `notElem` occNameString (occName n)
+        patternSynonymAreUsed tts = any (\case AConLike (PatSynCon _) -> True; _ -> False) tts
+
 -- | 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)
@@ -65,10 +93,10 @@         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)])]
         breakApart res [] = res
-        breakApart res ((sep, e) : rest) | length (filter ('\n' ==) sep) > 1 
+        breakApart res ((sep, e) : rest) | length (filter ('\n' ==) sep) > 1
           = breakApart ((sep, [("",e)]) : res) rest
         breakApart ((lastSep, lastRes) : res) (elem : rest)
           = breakApart ((lastSep, elem : lastRes) : res) rest
@@ -78,53 +106,65 @@         imports = zipWithSeparators ls
 
 -- | Modify an import to only import  names that are used.
-narrowImports :: forall dom . OrganizeImportsDomain dom 
-              => 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)
+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
+  where impsNeeded = neededImports exportedModules (usedNames ++ map fst exportedNames) prelInsts prelFamInsts (imps ^. annListElems)
 
 -- | Reduces the number of definitions used from an import
 narrowImport :: OrganizeImportsDomain dom
-             => Bool -> [String] -> [GHC.Name] -> ImportDecl dom -> LocalRefactor dom (ImportDecl dom)
-narrowImport noNarrowSubspecs exportedModules usedNames imp
+             => Bool -> [String] -> [GHC.Name] -> [(GHC.Name, Bool)] -> ImportDecl dom -> LocalRefactor dom (ImportDecl dom)
+narrowImport noNarrowSubspecs exportedModules usedNames exportedNames 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 noNarrowSubspecs usedNames $ imp
+  = importSpec&annJust&importSpecList !~ narrowImportSpecs noNarrowSubspecs usedNames exportedNames $ imp
+  | importIsHiding imp
+  = return imp -- a hiding import is not changed, because the wildcard importing of class and datatype
+               -- members could bring into scope the exact definition that was hidden
   | 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 noNarrowSubspecs (semanticsImported imp) (catMaybes namedThings)
-       return $ if not hasPatSyn && length groups < 4 
+       let -- to explicitly import pattern synonyms or type operators we need to enable an extension, and the user might not expect this
+           hasRiskyDef = any isRiskyDef namedThings
+           groups = groupThings noNarrowSubspecs (semanticsImported imp)
+                      (filter ((`elem` semanticsImported imp) . fst) exportedNames) (catMaybes namedThings)
+       return $ if not hasRiskyDef && length groups < 4
          then importSpec .- replaceWithJust (createImportSpec groups) $ imp
-         else imp 
+         else imp
   where actuallyImported = semanticsImported imp `intersect` usedNames
+        isRiskyDef (Just (AConLike (PatSynCon _))) = True
+        isRiskyDef (Just (ATyCon tc)) = isSymOcc (occName (tyConName tc))
+        isRiskyDef _ = False
 
 -- | 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
+groupThings :: Bool -> [GHC.Name] -> [(GHC.Name, Bool)] -> [TyThing] -> [(GHC.Name, Bool)]
+groupThings noNarrowSubspecs importable exported
+  = map last . groupBy ((==) `on` fst) . sort . (exported ++) . 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)
+        createImportFromTyThing tt | Just (td, isDataType) <- getTopDef tt
+          = if (td `elem` importable || isDataType) then (td, True)
+                                                    else (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
+-- | Gets the importable definition for a (looked up) name. The bool flag tells if it is from
+-- a data type.
+getTopDef :: TyThing -> Maybe (GHC.Name, Bool)
 getTopDef (AnId id) | isRecordSelector id
-  = Just $ case recordSelectorTyCon id of RecSelData tc -> getName tc
-                                          RecSelPatSyn ps -> getName ps
-getTopDef (AnId id) = fmap (getName . dataConTyCon) (isDataConWorkId_maybe id <|> isDataConId_maybe id) 
-                        <|> fmap getName (isClassOpId_maybe id)
-getTopDef (AConLike (RealDataCon dc)) = Just (getName $ dataConTyCon dc)
+  = case recordSelectorTyCon id of RecSelData tc -> Just (getName tc, True)
+                                   RecSelPatSyn ps -> Just (getName ps, False)
+getTopDef (AnId id)
+  | Just n <- fmap (getName . dataConTyCon) (isDataConWorkId_maybe id <|> isDataConId_maybe id)
+  = Just (n, True)
+getTopDef (AnId id) = fmap ((,False) . getName) (isClassOpId_maybe id)
+getTopDef (AConLike (RealDataCon dc))
+  = case tyConFamInst_maybe (dataConTyCon dc) of
+      Just (dataFam, _) -> Just (getName dataFam, True)
+      _                 -> Just (getName $ dataConTyCon dc, True)
 getTopDef (AConLike (PatSynCon _)) = error "getTopDef: should not be called with pattern synonyms"
 getTopDef (ATyCon _) = Nothing
 
@@ -139,44 +179,40 @@ neededImports exportedModules usedNames prelInsts prelFamInsts imps = neededImports' usedNames [] imps
   where neededImports' _ _ [] = []
         -- keep the import if any definition is needed from it
-        neededImports' usedNames kept (imp : rest) 
-          | not (null actuallyImported) 
+        neededImports' usedNames kept (imp : rest)
+          | not (null actuallyImported)
                || (imp ^. importModule & moduleNameString) `elem` exportedModules
                || maybe False (`elem` exportedModules) (imp ^? importAs & annJust & importRename & moduleNameString)
             = True : neededImports' usedNames (imp : kept) rest
           where actuallyImported = semanticsImported imp `intersect` usedNames
-        neededImports' usedNames kept (imp : rest) 
+        neededImports' usedNames kept (imp : rest)
             = needed : neededImports' usedNames (if needed then imp : kept else kept) rest
           where needed = any (`notElem` otherClsInstances) (map is_dfun $ semanticsOrphanInsts imp)
                            || any (`notElem` otherFamInstances) (map fi_axiom $ semanticsFamInsts imp)
                 otherClsInstances = map is_dfun (concatMap semanticsOrphanInsts kept ++ prelInsts)
                 otherFamInstances = map fi_axiom (concatMap semanticsFamInsts kept ++ prelFamInsts)
 
--- | Narrows the import specification (explicitely imported elements)
+-- | Narrows the import specification (explicitly imported elements)
 narrowImportSpecs :: forall dom . OrganizeImportsDomain dom
-                  => Bool -> [GHC.Name] -> IESpecList dom -> LocalRefactor dom (IESpecList dom)
-narrowImportSpecs noNarrowSubspecs usedNames 
-  = (if noNarrowSubspecs then return else (annList !~ narrowSpecSubspec usedNames))
+                  => Bool -> [GHC.Name] -> [(GHC.Name, Bool)] -> IESpecList dom -> LocalRefactor dom (IESpecList dom)
+narrowImportSpecs noNarrowSubspecs usedNames exportedNames
+  = (if noNarrowSubspecs then return else return . (annList .- narrowImportSubspecs neededNames exportedNames))
        >=> return . filterList isNeededSpec
-  where narrowSpecSubspec :: [GHC.Name] -> IESpec dom -> LocalRefactor dom (IESpec dom)
-        narrowSpecSubspec usedNames spec 
-          = do let Just specName = semanticsName =<< (spec ^? ieName&simpleName)
-               Just tt <- GHC.lookupName (getName specName)
-               let subspecsInScope = case tt of ATyCon tc | not (isClassTyCon tc) 
-                                                  -> (map getName (tyConDataCons tc) ++ map flSelector (tyConFieldLabels tc)) `intersect` usedNames
-                                                _ -> usedNames
-               ieSubspec !- narrowImportSubspecs subspecsInScope $ spec
-  
+  where neededNames = usedNames ++ map fst exportedNames
+
         isNeededSpec :: IESpec dom -> Bool
-        isNeededSpec ie = 
-          -- if the name is used, it is needed
-          fmap getName (semanticsName =<< (ie ^? ieName&simpleName)) `elem` map Just usedNames
+        isNeededSpec ie =
+          (semanticsName (ie ^. ieName&simpleName)) `elem` map Just neededNames
           -- if the name is not used, but some of its constructors are used, it is needed
             || ((ie ^? ieSubspec&annJust&essList&annList) /= [])
-            || (case ie ^? ieSubspec&annJust of Just SubAll -> True; _ -> False)     
+            -- its a bit hard to decide if there is an element inside (for example bundled pattern synonyms)
+            || (case ie ^? ieSubspec&annJust of Just SubAll -> True; _ -> False)
 
 -- | Reduces the number of definitions imported from a sub-specifier.
-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)
+narrowImportSubspecs :: OrganizeImportsDomain dom => [GHC.Name] -> [(GHC.Name, Bool)] -> IESpec dom -> IESpec dom
+narrowImportSubspecs neededNames exportedNames ss | noNarrowingForThis = ss
+  | otherwise
+  = ieSubspec & annJust & essList .- filterList (\n -> (semanticsName (n ^. simpleName)) `elem` map Just neededNames) $ ss
+  where noNarrowingForThis = case semanticsName (ss ^. ieName&simpleName) of
+                               Just name -> lookup name exportedNames == Just True
+                               _ -> False

@@ -6,6 +6,7 @@            , TypeFamilies
            , FlexibleContexts
            , ViewPatterns
+           , TupleSections
            #-}
 module Language.Haskell.Tools.Refactor.Predefined.RenameDefinition (renameDefinition, renameDefinition', DomainRenameDefinition) where
 
@@ -27,8 +28,8 @@ 
 renameDefinition' :: forall dom . DomainRenameDefinition dom => RealSrcSpan -> String -> Refactoring dom
 renameDefinition' sp str mod mods
-  = case (getNodeContaining sp (snd mod) :: Maybe (QualifiedName dom)) >>= (fmap getName . semanticsName) of 
-      Just name -> do let sameNames = bindsWithSameName name (snd mod ^? biplateRef) 
+  = case (getNodeContaining sp (snd mod) :: Maybe (QualifiedName dom)) >>= (fmap getName . semanticsName) of
+      Just name -> do let sameNames = bindsWithSameName name (snd mod ^? biplateRef)
                       renameDefinition name sameNames str mod mods
         where bindsWithSameName :: GHC.Name -> [FieldWildcard dom] -> [GHC.Name]
               bindsWithSameName name wcs = catMaybes $ map ((lookup name) . semanticsImplicitFlds) wcs
@@ -37,33 +38,33 @@                    Nothing -> refactError "No name is selected"
 
 renameModule :: forall dom . DomainRenameDefinition dom => String -> String -> Refactoring dom
-renameModule from to m mods 
-    | any (nameConflict to) (map snd $ m:mods) = refactError "Name conflict when renaming module" 
-    | not (validModuleName to) = refactError "The given name is not a valid module name" 
-    | otherwise = -- here it is important that the delete is the last, because rename 
+renameModule 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])
-                    $ localRefactoring (replaceModuleNames >=> alterNormalNames) m mods
-  where alterChange from to (ContentChanged (mod,res)) 
-          | (mod ^. sfkModuleName) == from 
+                    $ mapM (\(name,mod) -> ContentChanged . (name,) <$> localRefactoringRes id mod (replaceModuleNames =<< alterNormalNames mod)) (m:mods)
+  where alterChange from to (ContentChanged (mod,res))
+          | (mod ^. sfkModuleName) == from
           = ModuleCreated to res (SourceFileKey NormalHs from)
-        alterChange _ _ c = c 
+        alterChange _ _ c = c
 
         replaceModuleNames :: LocalRefactoring dom
         replaceModuleNames = biplateRef @_ @(ModuleName dom) & filtered (\e -> (e ^. moduleNameString) == from) != mkModuleName to
 
         alterNormalNames :: LocalRefactoring dom
-        alterNormalNames mod = if from `elem` moduleQualifiers mod 
+        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)) 
+        moduleQualifiers mod = mod ^? modImports & annList & filtered (\m -> isAnnNothing (m ^. importAs))
                                               & importModule & moduleNameString
 
         nameConflict :: String -> Module dom -> Bool
-        nameConflict to mod 
+        nameConflict to mod
           = let modName = mod ^? modHead&annJust&mhName&moduleNameString
                 imports = mod ^? modImports&annList
                 importNames = map (\imp -> fromMaybe (imp ^. importModule) (imp ^? importAs&annJust&importRename) ^. moduleNameString) imports
@@ -73,10 +74,10 @@ renameDefinition toChangeOrig toChangeWith newName mod mods
     = do nameCls <- classifyName toChangeOrig
          (changedModules,defFound) <- runStateT (catMaybes <$> mapM (renameInAModule toChangeOrig toChangeWith newName) (mod:mods)) False
-         if | not (nameValid nameCls newName) -> refactError "The new name is not valid"
-            | not defFound -> refactError "The definition to rename was not found"
+         if | isJust (nameValid nameCls newName) -> refactError $ "The new name is not valid: " ++ fromJust (nameValid nameCls newName)
+            | not defFound -> refactError "The definition to rename was not found. Maybe it is in another package."
             | otherwise -> return $ map ContentChanged changedModules
-  where     
+  where
     renameInAModule :: DomainRenameDefinition dom => GHC.Name -> [GHC.Name] -> String -> ModuleDom dom -> StateT Bool Refactor (Maybe (ModuleDom dom))
     renameInAModule toChangeOrig toChangeWith newName (name, mod)
       = mapStateT (localRefactoringRes (\f (a,s) -> (fmap (\(n,r) -> (n, f r)) a,s)) mod) $
@@ -84,7 +85,7 @@              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 -> [GHC.Name] -> String -> QualifiedName dom
                                                          -> StateT Bool (StateT Bool (LocalRefactor dom)) (QualifiedName dom)
     changeName toChangeOrig toChangeWith str name
       | maybe False (`elem` toChange) actualName
@@ -93,11 +94,11 @@       = refactError $ "The definition clashes with an existing one at: " ++ shortShowSpan (getRange name) -- name clash with an external definition
       | maybe False (`elem` toChange) actualName
       = do put True -- state that something is changed in the local state
-           when (actualName == Just toChangeOrig) 
+           when (actualName == Just toChangeOrig)
              $ lift $ modify (|| semanticsDefining name) -- state that the definition is renamed in the global state
            return $ unqualifiedName .= mkNamePart str $ name -- found the changed name (or a name that have to be changed too)
       | let namesInScope = semanticsScope name
-         in case semanticsName name of 
+         in case semanticsName name of
               Just (getName -> exprName) -> str == occNameString (getOccName exprName) && sameNamespace toChangeOrig exprName
                                               && conflicts toChangeOrig exprName namesInScope
               Nothing -> False -- ambiguous names
@@ -107,7 +108,7 @@             actualName = fmap getName (semanticsName name)
 
 conflicts :: GHC.Name -> GHC.Name -> [[GHC.Name]] -> Bool
-conflicts overwrites overwritten (scopeBlock : scope) 
+conflicts overwrites overwritten (scopeBlock : scope)
   | overwritten `elem` scopeBlock && overwrites `notElem` scopeBlock = False
   | overwrites `elem` scopeBlock = True
   | otherwise = conflicts overwrites overwritten scope

@@ -21,6 +21,7 @@ import GHC.Paths ( libdir )
 import Packages
 import SrcLoc
+import StringBuffer
 
 import Control.Exception
 import Control.Monad
@@ -40,6 +41,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
@@ -47,22 +49,22 @@       initGhcFlags
       useDirs ["."]
       mod <- loadModule "." moduleName >>= parseTyped
-      res <- runRefactor (SourceFileKey NormalHs moduleName, mod) [] 
-               $ refact $ correctRefactorSpan mod $ readSrcSpan span 
+      res <- runRefactor (SourceFileKey NormalHs moduleName, mod) []
+               $ refact $ correctRefactorSpan mod $ readSrcSpan span
       case res of Right r -> liftIO $ mapM_ (putStrLn . prettyPrint . snd . fromContentChanged) r
                   Left err -> liftIO $ putStrLn err
 
 -- | Adjust the source range to be applied to the refactored module
 correctRefactorSpan :: UnnamedModule dom -> RealSrcSpan -> RealSrcSpan
-correctRefactorSpan mod sp = mkRealSrcSpan (updateSrcFile fileName $ realSrcSpanStart sp) 
+correctRefactorSpan mod sp = mkRealSrcSpan (updateSrcFile fileName $ realSrcSpanStart sp)
                                            (updateSrcFile fileName $ realSrcSpanEnd sp)
-  where fileName = case srcSpanStart $ getRange mod of RealSrcLoc loc -> srcLocFile loc 
+  where fileName = case srcSpanStart $ getRange mod of RealSrcLoc loc -> srcLocFile loc
                                                        _ -> error "correctRefactorSpan: no real span"
-        updateSrcFile fn loc = mkRealSrcLoc fn (srcLocLine loc) (srcLocCol loc) 
+        updateSrcFile fn loc = mkRealSrcLoc fn (srcLocLine loc) (srcLocCol loc)
 
 -- | Set the given flags for the GHC session
 useFlags :: [String] -> Ghc [String]
-useFlags args = do 
+useFlags args = do
   let lArgs = map (L noSrcSpan) args
   dynflags <- getSessionDynFlags
   -- TODO: print errors and warnings?
@@ -73,8 +75,8 @@ 
 -- | Reloads the package database based on the session flags
 reloadPkgDb :: Ghc ()
-reloadPkgDb = void $ setSessionDynFlags . fst =<< liftIO . initPackages . (\df -> df { pkgDatabase = Nothing }) 
-                                              =<< getSessionDynFlags 
+reloadPkgDb = void $ setSessionDynFlags . fst =<< liftIO . initPackages . (\df -> df { pkgDatabase = Nothing })
+                                              =<< getSessionDynFlags
 
 -- | Initialize GHC flags to default values that support refactoring
 initGhcFlags :: Ghc ()
@@ -87,13 +89,13 @@ initGhcFlags' :: Bool -> Ghc ()
 initGhcFlags' needsCodeGen = do
   dflags <- getSessionDynFlags
-  void $ setSessionDynFlags 
+  void $ setSessionDynFlags
     $ flip gopt_set Opt_KeepRawTokenStream
     $ flip gopt_set Opt_NoHsMain
     $ dflags { importPaths = []
              , hscTarget = if needsCodeGen then HscInterpreted else HscNothing
              , ghcLink = if needsCodeGen then LinkInMemory else NoLink
-             , ghcMode = CompManager 
+             , ghcMode = CompManager
              , packageFlags = ExposePackage "template-haskell" (PackageArg "template-haskell") (ModRenaming True []) : packageFlags dflags
              }
 
@@ -108,7 +110,7 @@ deregisterDirs workingDirs = do
   dynflags <- getSessionDynFlags
   void $ setSessionDynFlags dynflags { importPaths = importPaths dynflags \\ workingDirs }
-  
+
 -- | Translates module name and working directory into the name of the file where the given module should be defined
 toFileName :: FilePath -> String -> FilePath
 toFileName workingDir mod = normalise $ workingDir </> map (\case '.' -> pathSeparator; c -> c) mod ++ ".hs"
@@ -119,9 +121,9 @@ 
 -- | Get the source directory where the module is located.
 getSourceDir :: ModSummary -> IO FilePath
-getSourceDir ms 
+getSourceDir ms
   = do filePath <- canonicalizePath $ getModSumOrig ms
-       let modNameParts = splitOn "." $ GHC.moduleNameString (moduleName (ms_mod ms)) 
+       let modNameParts = splitOn "." $ GHC.moduleNameString (moduleName (ms_mod ms))
            filePathParts = splitPath filePath
        let srcDirParts = reverse $ drop (length modNameParts) $ reverse filePathParts
        return $ joinPath srcDirParts
@@ -130,16 +132,20 @@ getModSumOrig :: ModSummary -> FilePath
 getModSumOrig = normalise . fromMaybe (error "getModSumOrig: The given module doesn't have haskell source file.") . ml_hs_file . ms_location
 
+-- | Gets the module name
+getModSumName :: ModSummary -> String
+getModSumName = GHC.moduleNameString . moduleName . ms_mod
+
 -- | Load the summary of a module given by the working directory and module name.
 loadModule :: String -> String -> Ghc ModSummary
-loadModule workingDir moduleName 
+loadModule workingDir moduleName
   = do initGhcFlagsForTest
        useDirs [workingDir]
        target <- guessTarget moduleName Nothing
        setTargets [target]
        void $ load (LoadUpTo $ mkModuleName moduleName)
        getModSummary $ mkModuleName moduleName
-    
+
 -- | The final version of our AST, with type infromation added
 type TypedModule = Ann AST.UModule IdDom SrcTemplateStage
 
@@ -148,21 +154,20 @@ parseTyped modSum = withAlteredDynFlags (return . normalizeFlags) $ do
   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
   let annots = pm_annotations p
-      srcBuffer = fromJust $ ms_hspp_buf $ pm_mod_summary p
-  prepareAST srcBuffer . placeComments (getNormalComments $ snd annots) 
-    <$> (addTypeInfos (typecheckedSource tc) 
+  srcBuffer <- if hasCppExtension
+                    then liftIO $ hGetStringBuffer (getModSumOrig ms)
+                    else return (fromJust $ ms_hspp_buf $ pm_mod_summary p)
+  (if hasCppExtension then prepareASTCpp else prepareAST) srcBuffer . placeComments (fst annots) (getNormalComments $ snd annots)
+    <$> (addTypeInfos (typecheckedSource tc)
            =<< (do parseTrf <- runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModule ms (pm_parsed_source p)
                    runTrf (fst annots) (getPragmaComments $ snd annots)
                      $ trfModuleRename ms parseTrf
-                         (fromJust $ tm_renamed_source tc) 
+                         (fromJust $ tm_renamed_source tc)
                          (pm_parsed_source p)))
 
 -- | Modifies the dynamic flags for performing a ghc task
@@ -199,9 +204,9 @@ 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)
-  _ -> error "readSrcLoc: panic: splitOn gives empty list"+  _ -> error "readSrcLoc: panic: splitOn gives empty list"

@@ -72,6 +72,7 @@ -- | Exceptions that can occur while loading modules or during internal operations (not during performing the refactor).
 data RefactorException = IllegalExtensions [String]
                        | SourceCodeProblem ErrorMessages
+                       | ModuleNotInPackage String
                        | UnknownException String
   deriving (Show, Typeable)
 
@@ -81,8 +82,9 @@ instance Exception RefactorException where
   displayException (SourceCodeProblem prob)
     = "Source code problem: " ++ showSDocUnsafe (vcat (pprErrMsgBagWithLoc prob))
-  displayException (IllegalExtensions exts) 
+  displayException (IllegalExtensions exts)
     = "The following extensions are not allowed: " ++ (concat $ intersperse ", " exts) ++ "."
+  displayException (ModuleNotInPackage modName) = "The module is not in the package: " ++ modName
   displayException (UnknownException ex) = "An unexpected problem appeared: " ++ ex ++ "."
 
 instance Show (RefactorChange dom) where
@@ -96,13 +98,13 @@ 
 -- | Wraps a refactoring that only affects one module. Performs the per-module finishing touches.
 localRefactoring :: HasModuleInfo dom => LocalRefactoring dom -> Refactoring dom
-localRefactoring ref (name, mod) _ 
+localRefactoring ref (name, mod) _
   = (\m -> [ContentChanged (name, m)]) <$> localRefactoringRes id mod (ref mod)
 
 -- | Transform the result of the local refactoring
 localRefactoringRes :: HasModuleInfo dom
-                    => ((UnnamedModule dom -> UnnamedModule dom) -> a -> a) 
-                          -> UnnamedModule dom 
+                    => ((UnnamedModule dom -> UnnamedModule dom) -> a -> a)
+                          -> UnnamedModule dom
                           -> LocalRefactor dom a
                           -> Refactor a
 localRefactoringRes access mod trf
@@ -158,8 +160,8 @@ instance ExceptionMonad m => ExceptionMonad (ExceptT s m) where
   gcatch e c = ExceptT (runExceptT e `gcatch` (runExceptT . c))
   gmask m = ExceptT $ gmask (\f -> runExceptT $ m (ExceptT . f . runExceptT))
-  
 
+
 -- | 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)
@@ -167,7 +169,7 @@ -- | The information a refactoring can use
 data RefactorCtx dom = RefactorCtx { refModuleName :: GHC.Module
                                    , refCtxRoot :: Ann UModule dom SrcTemplateStage
-                                   , refCtxImports :: [Ann UImportDecl dom SrcTemplateStage] 
+                                   , refCtxImports :: [Ann UImportDecl dom SrcTemplateStage]
                                    }
 
 instance MonadTrans (LocalRefactorT dom) where
@@ -200,14 +202,14 @@ registeredNamesFromPrelude = GHC.basicKnownKeyNames ++ map GHC.tyConName GHC.wiredInTyCons
 
 otherNamesFromPrelude :: [String]
-otherNamesFromPrelude 
+otherNamesFromPrelude
  -- TODO: extend and revise this list
  -- TODO: prelude names are simply existing names?? No need to check??
   = ["GHC.Base.Maybe", "GHC.Base.Just", "GHC.Base.Nothing", "GHC.Base.maybe", "GHC.Base.either", "GHC.Base.not"
     , "Data.Tuple.curry", "Data.Tuple.uncurry", "GHC.Base.compare", "GHC.Base.max", "GHC.Base.min", "GHC.Base.id"]
 
 qualifiedName :: GHC.Name -> String
-qualifiedName name = case GHC.nameModule_maybe name of 
+qualifiedName name = case GHC.nameModule_maybe name of
   Just mod -> GHC.moduleNameString (GHC.moduleName mod) ++ "." ++ GHC.occNameString (GHC.nameOccName name)
   Nothing -> GHC.occNameString (GHC.nameOccName name)
 
@@ -218,46 +220,46 @@ referenceOperator = referenceName' mkQualOp'
 
 -- | Create a name that references the definition. Generates an import if the definition is not yet imported.
-referenceName' :: (HasImportInfo dom, HasModuleInfo dom) 
+referenceName' :: (HasImportInfo dom, HasModuleInfo dom)
                => ([String] -> GHC.Name -> Ann nt dom SrcTemplateStage) -> GHC.Name -> LocalRefactor dom (Ann nt dom SrcTemplateStage)
-referenceName' makeName name 
+referenceName' makeName name
   | name `elem` registeredNamesFromPrelude || qualifiedName name `elem` otherNamesFromPrelude
   = return $ makeName [] name -- imported from prelude
-  | otherwise 
+  | otherwise
   = do RefactorCtx {refCtxRoot = mod, refCtxImports = imports, refModuleName = thisModule} <- ask
-       if maybe True (thisModule ==) (GHC.nameModule_maybe name) 
+       if maybe True (thisModule ==) (GHC.nameModule_maybe name)
          then return $ makeName [] name -- in the same module, use simple name
          else let possibleImports = filter ((name `elem`) . (\imp -> semanticsImported $ imp ^. semantics)) imports
                   fromPrelude = name `elem` semanticsImplicitImports (mod ^. semantics)
                in if | fromPrelude -> return $ makeName [] name
                      | null possibleImports -> do tell [name]
                                                   return $ makeName [] name
-                     | otherwise -> return $ referenceBy makeName name possibleImports 
+                     | otherwise -> return $ referenceBy makeName name possibleImports
                                      -- use it according to the best available import
 
 -- | Reference the name by the shortest suitable import
 referenceBy :: ([String] -> GHC.Name -> Ann nt dom SrcTemplateStage) -> GHC.Name -> [Ann UImportDecl dom SrcTemplateStage] -> Ann nt dom SrcTemplateStage
-referenceBy makeName name imps = 
+referenceBy makeName name imps =
   let prefixes = map importQualifier imps
    in makeName (minimumBy (compare `on` (length . concat)) prefixes) name
   where importQualifier :: Ann UImportDecl dom SrcTemplateStage -> [String]
-        importQualifier imp 
-          = if isJust (imp ^? importQualified&annJust) 
-              then case imp ^? importAs&annJust&importRename of 
+        importQualifier imp
+          = if isJust (imp ^? importQualified&annJust)
+              then case imp ^? importAs&annJust&importRename of
                       Nothing -> splitOn "." (imp ^. importModule&moduleNameString) -- fully qualified import
                       Just asName -> splitOn "." (asName ^. moduleNameString) -- the name given by as clause
               else [] -- unqualified import
 
 -- | Different classes of definitions that have different kind of names.
 data NameClass = Variable         -- ^ Normal value definitions: functions, variables
-               | Ctor             -- ^ Data constructors 
+               | Ctor             -- ^ Data constructors
                | ValueOperator    -- ^ Functions with operator-like names
                | DataCtorOperator -- ^ Constructors with operator-like names
                | SynonymOperator  -- ^ UType definitions with operator-like names
 
 -- | Get which category does a given name belong to
 classifyName :: RefactorMonad m => GHC.Name -> m NameClass
-classifyName n = liftGhc (lookupName n) >>= return . \case 
+classifyName n = liftGhc (lookupName n) >>= return . \case
     Just (AnId {}) | isop     -> ValueOperator
     Just (AnId {})            -> Variable
     Just (AConLike {}) | isop -> DataCtorOperator
@@ -267,37 +269,36 @@     Just (ACoAxiom {})        -> error "classifyName: ACoAxiom"
     Nothing | isop            -> ValueOperator
     Nothing                   -> Variable
-  where isop = GHC.isSymOcc (GHC.getOccName n) 
+  where isop = GHC.isSymOcc (GHC.getOccName n)
 
 -- | Checks if a given name is a valid module name
-validModuleName :: String -> Bool
-validModuleName s = all (nameValid Ctor) (splitOn "." s) 
+validModuleName :: String -> Maybe String
+validModuleName s = foldl mappend mempty $ map (nameValid Ctor) (splitOn "." s)
 
 -- | Check if a given name is valid for a given kind of definition
-nameValid :: NameClass -> String -> Bool
-nameValid _ "" = False
-nameValid _ str | str `elem` reservedNames = False
+nameValid :: NameClass -> String -> Maybe String
+nameValid _ "" = Just "An empty name is not valid"
+nameValid _ str | str `elem` reservedNames = Just $ "'" ++ str ++ "' is a reserved name"
   where -- TODO: names reserved by extensions
         reservedNames = [ "case", "class", "data", "default", "deriving", "do", "else", "if", "import", "in", "infix"
                         , "infixl", "infixr", "instance", "let", "module", "newtype", "of", "then", "type", "where", "_"
                         , "..", ":", "::", "=", "\\", "|", "<-", "->", "@", "~", "=>", "[]"
                         ]
 -- Operators that are data constructors (must start with ':')
-nameValid DataCtorOperator (':' : nameRest)
-  = all isOperatorChar nameRest
--- UType families and synonyms that are operators (can start with ':')
-nameValid SynonymOperator (c : nameRest)
-  = isOperatorChar c && all isOperatorChar nameRest
+nameValid DataCtorOperator (':' : nameRest) | all isOperatorChar nameRest = Nothing
+nameValid DataCtorOperator _ = Just "A constructor operator must start with ':' and only contain operator characters."
+-- Type families and synonyms that are operators (can start with ':')
+nameValid SynonymOperator name | all isOperatorChar name = Nothing
+nameValid SynonymOperator _ = Just "An operator must only contain operator characters."
 -- Normal value operators (cannot start with ':')
-nameValid ValueOperator (c : nameRest)
-  = isOperatorChar c && c /= ':' && all isOperatorChar nameRest
+nameValid ValueOperator (c : nameRest) | isOperatorChar c && c /= ':' && all isOperatorChar nameRest = Nothing
+nameValid ValueOperator _ = Just "An operator that is a value must only contain operator characters and cannot start with ':'"
 -- Data and type constructors (start with uppercase)
-nameValid Ctor (c : nameRest)
-  = isUpper c && isIdStartChar c && all (\c -> isIdStartChar c || isDigit c) nameRest
+nameValid Ctor (c : nameRest) | isUpper c && isIdStartChar c && all (\c -> isIdStartChar c || isDigit c) nameRest = Nothing
+nameValid Ctor _ = Just "A constructor or module name must start with an uppercase letter, and only contain letters, digits, apostrhophe or underscore"
 -- Variables and type variables (start with lowercase)
-nameValid Variable (c : nameRest)
-  = isLower c && isIdStartChar c && all (\c -> isIdStartChar c || isDigit c) nameRest
-nameValid _ _ = False
+nameValid Variable (c : nameRest) | isLower c && isIdStartChar c && all (\c -> isIdStartChar c || isDigit c) nameRest = Nothing
+nameValid Variable _ = Just "The name of a value must start with lowercase, and only contain letters, digits, apostrhophe or underscore"
 
 isIdStartChar :: Char -> Bool
 isIdStartChar c = (isLetter c && isAscii c) || c == '\'' || c == '_'
@@ -305,4 +306,4 @@ isOperatorChar :: Char -> Bool
 isOperatorChar c = (isPunctuation c || isSymbol c) && isAscii c
 
-makeReferences ''SourceFileKey+makeReferences ''SourceFileKey

@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell 
+{-# LANGUAGE TemplateHaskell
            , TupleSections
            #-}
 -- | Common operations for managing refactoring sessions, for example loading packages, re-loading modules.
@@ -46,17 +46,20 @@   initSession = RefactorSessionState []
 
 -- | 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 =
+loadPackagesFrom :: IsRefactSessionState st => (ModSummary -> IO a) -> ([ModSummary] -> IO ()) -> (st -> FilePath -> IO [FilePath]) -> [FilePath] -> StateT st Ghc (Either RefactorException ([a], [String]))
+loadPackagesFrom report loadCallback additionalSrcDirs packages =
   do modColls <- liftIO $ getAllModules packages
      modify $ refSessMCs .- (++ modColls)
      allModColls <- gets (^. refSessMCs)
-     lift $ useDirs (modColls ^? traversal & mcSourceDirs & traversal)
+     st <- get
+     moreSrcDirs <- liftIO $ mapM (additionalSrcDirs st) packages
+     lift $ useDirs ((modColls ^? traversal & mcSourceDirs & traversal) ++ concat moreSrcDirs)
      let (ignored, modNames) = extractDuplicates $ map (^. sfkModuleName) $ concat $ map Map.keys $ modColls ^? traversal & mcModules
          alreadyExistingMods = concatMap (map (^. sfkModuleName) . Map.keys . (^. mcModules)) (allModColls List.\\ modColls)
      lift $ mapM_ addTarget $ map (\mod -> (Target (TargetModule (GHC.mkModuleName mod)) True Nothing)) modNames
-     handleErrors $ withAlteredDynFlags (return . enableAllPackages allModColls) $ do
+     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
@@ -64,7 +67,7 @@        return (mods, ignored)
 
   where extractDuplicates :: Eq a => [a] -> ([a],[a])
-        extractDuplicates (a:rest) 
+        extractDuplicates (a:rest)
           = case extractDuplicates rest of (repl, orig) -> if a `elem` orig then (a:repl, orig) else (repl, a:orig)
         extractDuplicates [] = ([],[])
 
@@ -75,24 +78,24 @@ 
 -- | Handle GHC exceptions and RefactorException.
 handleErrors :: ExceptionMonad m => m a -> m (Either RefactorException a)
-handleErrors action = handleSourceError (return . Left . SourceCodeProblem . srcErrorMessages) (Right <$> action) 
+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)
 
-getMods :: (Monad m, IsRefactSessionState st) 
+getMods :: (Monad m, IsRefactSessionState st)
         => Maybe SourceFileKey -> StateT st m ( Maybe (SourceFileKey, UnnamedModule IdDom)
                                               , [(SourceFileKey, UnnamedModule IdDom)] )
-getMods actMod 
+getMods actMod
   = do mcs <- gets (^. refSessMCs)
        return $ ( (_2 !~ (^? typedRecModule)) =<< flip lookupModInSCs mcs =<< actMod
                 , filter ((actMod /=) . Just . fst) $ concatMap (catMaybes . map (_2 !~ (^? typedRecModule)) . Map.assocs . (^. mcModules)) mcs )
 
-getFileMods :: (GhcMonad m, IsRefactSessionState st) 
+getFileMods :: (GhcMonad m, IsRefactSessionState st)
         => FilePath -> StateT st m ( Maybe (SourceFileKey, UnnamedModule IdDom)
                                    , [(SourceFileKey, UnnamedModule IdDom)] )
-getFileMods fname 
+getFileMods fname
   = do mcs <- gets (^. refSessMCs)
        let mods = map (\(k,m) -> (fromJust $ m ^? modRecMS, k))
                       (concatMap Map.assocs $ (mcs ^? traversal & mcModules :: [Map.Map SourceFileKey ModuleRecord]))
@@ -101,17 +104,18 @@                    [] -> getMods Nothing
 
 -- | 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
+reloadChangedModules :: IsRefactSessionState st => (ModSummary -> IO a) -> ([ModSummary] -> IO ()) -> (ModSummary -> Bool) -> StateT st Ghc (Either RefactorException [a])
+reloadChangedModules report loadCallback isChanged = handleErrors $ do
+  reachable <- getReachableModules loadCallback isChanged
   void $ checkEvaluatedMods report reachable
   mapM (reloadModule report) reachable
 
-getReachableModules :: IsRefactSessionState st => (ModSummary -> Bool) -> StateT st Ghc [ModSummary]
-getReachableModules selected = do 
+getReachableModules :: IsRefactSessionState st => ([ModSummary] -> IO ()) -> (ModSummary -> Bool) -> StateT st Ghc [ModSummary]
+getReachableModules loadCallback selected = do
   allModColls <- gets (^. refSessMCs)
-  withAlteredDynFlags (return . enableAllPackages allModColls) $ do
+  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
@@ -121,19 +125,21 @@ 
 -- | 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
+reloadModule report ms = do
   mcs <- gets (^. refSessMCs)
-  let mc = fromMaybe (error $ "reloadModule: The following module is not found: " ++ modName) $ lookupModuleColl modName mcs
+  let modName = modSumName ms
       codeGen = hasGeneratedCode (keyFromMS ms) mcs
-  let dfs = ms_hspp_opts ms 
-  dfs' <- liftIO $ compileInContext mc mcs dfs
-  let ms' = ms { ms_hspp_opts = dfs' }
-  newm <- lift $ withAlteredDynFlags (liftIO . compileInContext mc mcs) $ 
-    parseTyped (if codeGen then forceCodeGen ms' else ms')
-  modify $ refSessMCs & traversal & filtered (\mc' -> (mc' ^. mcRoot) == (mc ^. mcRoot)) & mcModules 
-             .- Map.insert (keyFromMS ms) ((if codeGen then ModuleCodeGenerated else ModuleTypeChecked) newm ms)
-  liftIO $ report ms
+  case lookupModuleColl modName mcs of
+    Just mc -> do
+      let dfs = ms_hspp_opts ms
+      dfs' <- liftIO $ compileInContext mc mcs dfs
+      let ms' = ms { ms_hspp_opts = dfs' }
+      newm <- lift $ withAlteredDynFlags (liftIO . compileInContext mc mcs) $
+        parseTyped (if codeGen then forceCodeGen ms' else ms')
+      modify $ refSessMCs & traversal & filtered (\mc' -> (mc' ^. mcRoot) == (mc ^. mcRoot)) & mcModules
+                 .- Map.insert (keyFromMS ms) ((if codeGen then ModuleCodeGenerated else ModuleTypeChecked) newm ms)
+      liftIO $ report ms
+    Nothing -> liftIO $ throwIO $ ModuleNotInPackage modName
 
 checkEvaluatedMods :: IsRefactSessionState st => (ModSummary -> IO a) -> [ModSummary] -> StateT st Ghc [a]
 checkEvaluatedMods report mods = do
@@ -141,11 +147,11 @@     mcs <- gets (^. refSessMCs)
     res <- forM modsNeedCode $ \ms -> reloadIfNeeded ms mcs
     return $ catMaybes res
-  where reloadIfNeeded ms mcs 
+  where reloadIfNeeded ms mcs
           = let key = keyFromMS ms
               in if not (hasGeneratedCode key mcs)
                    then do modify $ refSessMCs .- codeGeneratedFor key
-                           if (isAlreadyLoaded key mcs) then 
+                           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)
                              else return Nothing
@@ -154,13 +160,13 @@ -- | 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 
+codeGenForModule report mcs ms
   = let modName = modSumName ms
         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)
-           liftIO $ report ms 
+           liftIO $ report ms
 
 -- | Check which modules can be reached from the module, if it uses template haskell.
 getEvaluatedMods :: [ModSummary] -> Ghc [GHC.ModSummary]

@@ -0,0 +1,8 @@+{-# LANGUAGE CPP #-}
+module CPP.ConditionalCode where
+
+#if __GLASGOW_HASKELL__ >= 800
+version = "GHC 8"
+#else
+version = "not GHC 8"
+#endif

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

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

@@ -0,0 +1,2 @@+{-# LANGUAGE CPP #-}
+module CPP.JustEnabled where

@@ -0,0 +1,10 @@+module Decl.ClassInfix where
+
+import Control.Applicative
+
+class Applicative f => MonoidApplicative f where
+   infixl 4 +<*>
+   (+<*>) :: f (a -> a) -> f a -> f a
+
+   infixl 5 ><
+   (><) :: Monoid a => f a -> f a -> f a

@@ -4,4 +4,6 @@ type family F a where
   F Int  = Bool
   F Bool = Char
-  F a    = Bool+  F a    = Bool
+
+type family ClosedEmpty t where

@@ -0,0 +1,3 @@+module Decl.DefaultDecl where
+
+default ()

@@ -0,0 +1,5 @@+module Decl.FunFixity where
+
+infixl `snoc`
+snoc :: [a] -> a -> [a]
+snoc xs x = xs ++ [x]

@@ -1,5 +1,9 @@-{-# LANGUAGE GADTs, KindSignatures #-}
+{-# LANGUAGE GADTs, KindSignatures, DeriveDataTypeable #-}
 module Decl.GADT where
 
-data G2 a :: * where
-  G2A :: { g2a :: a, g2b :: Int } -> G2 a+import Data.Typeable
+
+data DMap k f where
+    Tip :: DMap k f
+    Bin :: !Int -> !(k v) -> f v -> !(DMap k f) -> !(DMap k f) -> DMap k f
+    deriving Typeable

@@ -0,0 +1,5 @@+{-# LANGUAGE GADTs #-}
+module Decl.GadtConWithCtx where
+
+data Concurrently m a where
+  Concurrently :: Monad m => { runConcurrently :: m a } -> Concurrently m a

@@ -0,0 +1,9 @@+{-# LANGUAGE DataKinds, TypeOperators, KindSignatures, TypeFamilies #-}
+module Decl.InfixAssertion where
+
+import GHC.TypeLits
+
+data Proxy (n :: Nat) = Proxy
+
+divSNat :: (1 <= b) => Proxy b -> Proxy b
+divSNat n = n

@@ -0,0 +1,8 @@+{-# LANGUAGE TypeOperators, TypeFamilies #-}
+module Decl.InfixInstances where
+
+data Zipper h i a = Zipper
+data (:@) a i
+infixl 8 :>
+type family (:>) h p
+type instance h :> (a :@ i) = Zipper h i a

@@ -0,0 +1,10 @@+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
+module Decl.InfixPatSyn where
+
+pattern x :. xs <- (uncons -> Just (x,xs)) where
+  x:.xs = cons x xs
+infixr 5 :.
+
+cons x xs = x:xs
+uncons (x:xs) = Just (x,xs)
+uncons [] = Nothing

@@ -0,0 +1,11 @@+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-}
+module Decl.MixedInstance where
+
+data Canvas = Canvas
+data V2 = V2
+
+class Backend c v e where
+  data Options c v e :: *
+
+instance Backend Canvas V2 Double where
+  data Options Canvas V2 Double = CanvasOptions

@@ -1,4 +1,4 @@-{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
 module Decl.PatternSynonym where
 
 data Type = App String [Type]
@@ -13,11 +13,16 @@    where Maybe (App "()" []) = App "Bool" []
          Maybe t = App "Maybe" [t]
 
+pattern (:<) :: [a] -> a -> [a]
+pattern (:<) xs x <- ((\ys -> (init ys,last ys)) -> (xs,x))
+  where
+    (:<) xs x = xs ++ [x]
+
 ------ this is not supported yet
 -- class ListLike a where
---   pattern Head :: e -> a e
+--   pattern Head :: e -> a e0
 --   pattern Tail :: a e -> a e
 
 -- instance ListLike [] where
 --   pattern Head h = h:_
---   pattern Tail t = _:t+--   pattern Tail t = _:t

@@ -0,0 +1,6 @@+module Expr.EmptyLet where
+
+a = let in ()
+
+m = do let
+       putStrLn "hello"

@@ -0,0 +1,6 @@+module Expr.FunSection where
+
+data Rule = Rule {
+    rulePath :: String -> Bool }
+
+f r = filter (`rulePath` r)

@@ -0,0 +1,10 @@+{-# LANGUAGE RecordWildCards #-}
+module Expr.PatternAndDo where
+
+import Control.Monad
+import Control.Monad.Identity
+
+data A = A { x :: Int }
+
+a = forM_ [] $ \A {..} -> do
+      Identity "Hello"

@@ -0,0 +1,4 @@+module Expr.SccPragma where
+
+f x = {-# SCC "drawComponent" #-}
+        case x of () -> ()

@@ -0,0 +1,7 @@+module Expr.SemicolonDo where
+
+import Control.Monad.Identity
+
+a = do { n <- Identity ()
+            ; return ()
+            }

@@ -2,4 +2,6 @@ module Expr.TupleSections where
 
 f1 = (1,,)
-f2 = (,1)+f2 = (,1)
+
+x = (,("x", []))

@@ -0,0 +1,3 @@+module Module.ImportOp where
+
+import Module.Imported ((:-)(..))

@@ -0,0 +1,6 @@+{-# LANGUAGE TypeOperators #-}
+module Module.Imported where
+
+infixr 8 :-
+-- | A stack datatype. Just a better looking tuple.
+data a :- b = a :- b deriving (Eq, Show)

@@ -0,0 +1,4 @@+{-# LANGUAGE LambdaCase #-}
+{-#LANGUAGE LambdaCase #-}
+{-# LANGUAGE LambdaCase#-}
+module Module.LangPragmas where

@@ -0,0 +1,7 @@+{-# LANGUAGE NamedFieldPuns, RecordWildCards #-}
+module Pattern.NestedWildcard where
+
+data A = A { b :: B, ai :: Int }
+data B = B { bi :: Int }
+
+h A { b = B {..}, .. } = bi + ai

@@ -0,0 +1,3 @@+module Pattern.OperatorPattern where
+
+child r (_:ps) = r ps

@@ -0,0 +1,7 @@+module Refactor.ExtractBinding.SiblingDefs where
+
+f = 1
+  where
+    g = a
+      where a = 1
+    h = 2

@@ -0,0 +1,8 @@+module Refactor.ExtractBinding.SiblingDefs where
+
+f = 1
+  where
+    g = a
+      where a = 1
+    h = a
+      where a = 2

@@ -0,0 +1,4 @@+{-# LANGUAGE ViewPatterns #-}
+module Refactor.ExtractBinding.ViewPattern where
+
+f (id . id -> x) = x

@@ -2,4 +2,4 @@ 
 f :: (Num a, Ord a) => a -> a
 f a = g a where
-  g a = if a > 0 then a + 1 else a+  g a = if a > 0 then a + 1 else a

@@ -3,4 +3,4 @@ f :: (Num a, Ord a) => a -> a
 f a = g a where
   g :: (Num t, Ord t) => t -> t
-  g a = if a > 0 then a + 1 else a+  g a = if a > 0 then a + 1 else a

@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.Fields where
+
+import Control.Monad.Trans (MonadTrans(..))
+import Control.Monad.State (Monad(..), StateT(runStateT))
+
+x = runStateT (lift putStrLn >> return ()) ()

@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.Fields where
+
+import Control.Monad.State (Monad(..), StateT(runStateT))
+import Control.Monad.Trans (MonadTrans(..))
+
+x = runStateT (lift putStrLn >> return ()) ()

@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.KeepCtorOfMarshalled where
+
+import Foreign.C.String
+
+foreign import ccall unsafe "abc" abc :: CString -> IO ()

@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.KeepCtorOfMarshalled where
+
+import Foreign.C.String (CString(..))
+
+foreign import ccall unsafe "abc" abc :: CString -> IO ()

@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.KeepHiding where
+
+import Data.Map hiding (map)
+
+m :: Map Int String
+m = empty

@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.KeepHiding where
+
+import Data.Map hiding (map)
+
+m :: Map Int String
+m = empty

@@ -0,0 +1,3 @@+module Refactor.OrganizeImports.KeepPrelude where
+
+import Prelude ()

@@ -0,0 +1,3 @@+module Refactor.OrganizeImports.KeepPrelude where
+
+import Prelude ()

@@ -0,0 +1,3 @@+module Refactor.OrganizeImports.MakeExplicit.ConSourceHiddenType (A(B)) where
+
+import Refactor.OrganizeImports.MakeExplicit.Source

@@ -1,6 +1,5 @@ module Refactor.OrganizeImports.MakeExplicit.ImportCon where
 
-import Refactor.OrganizeImports.MakeExplicit.Source
+import Refactor.OrganizeImports.MakeExplicit.ConSourceHiddenType
 
 x = B
-

@@ -1,6 +1,5 @@ module Refactor.OrganizeImports.MakeExplicit.ImportCon where
 
-import Refactor.OrganizeImports.MakeExplicit.Source (A(..))
+import Refactor.OrganizeImports.MakeExplicit.ConSourceHiddenType (A(..))
 
 x = B
-

@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.MakeExplicit.Renamed where
+
+import Refactor.OrganizeImports.MakeExplicit.Source as Src
+
+x = B

@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.MakeExplicit.Renamed where
+
+import Refactor.OrganizeImports.MakeExplicit.Source as Src (A(..))
+
+x = B

@@ -1,5 +1,5 @@ module Refactor.OrganizeImports.NarrowSpec where
 
-import Control.Monad.State (State)
+import Control.Monad.State (State(..))
 
 type St = State ()

@@ -0,0 +1,5 @@+module Refactor.RenameDefinition.FunnyDo where
+
+a = do return (); return ()
+       Just 3; return ()
+       Nothing

@@ -0,0 +1,5 @@+module Refactor.RenameDefinition.FunnyDo where
+
+aaa = do return (); return ()
+         Just 3; return ()
+         Nothing

@@ -0,0 +1,6 @@+{-# LANGUAGE TemplateHaskell #-}
+module TH.Splice.UseQual where
+
+import qualified TH.Splice.Define as Def
+
+$(Def.def "x")

@@ -0,0 +1,8 @@+{-# LANGUAGE TemplateHaskell #-}
+module TH.Splice.UseQualMulti where
+
+import qualified TH.Splice.Define as Def
+import qualified TH.Splice.Define as Def2
+
+$(Def.def "x")
+$(Def2.def "y")

@@ -0,0 +1,5 @@+{-# LANGUAGE ConstraintKinds #-}
+module Type.TupleAssert where
+
+f :: (Ord a, (Show a, Eq a)) => a -> String
+f = show

@@ -1,5 +1,5 @@ name:                haskell-tools-refactor
-version:             0.5.0.0
+version:             0.6.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
@@ -11,7 +11,8 @@ build-type:          Simple
 cabal-version:       >=1.10
 
-extra-source-files: examples/CppHs/Language/Preprocessor/*.hs
+extra-source-files: examples/CPP/*.hs
+                  , examples/CppHs/Language/Preprocessor/*.hs
                   , examples/CppHs/Language/Preprocessor/Cpphs/*.hs
                   , examples/CppHs/Language/Preprocessor/Cpphs/*.hs
                   , examples/Decl/*.hs
@@ -50,7 +51,7 @@                   , examples/Type/*.hs
 
 library
-  ghc-options:         -O2
+  ghc-options: -O2
   exposed-modules:     Language.Haskell.Tools.Refactor
                      , Language.Haskell.Tools.Refactor.BindingElem
                      , Language.Haskell.Tools.Refactor.GetModules
@@ -71,7 +72,11 @@                      , Language.Haskell.Tools.Refactor.Predefined.DollarApp
                      , Language.Haskell.Tools.Refactor.Predefined.InlineBinding
                      , Language.Haskell.Tools.Refactor.Predefined.FloatOut
-                     
+                     , Language.Haskell.Tools.Refactor.Predefined.HelloRefactor
+                     , Language.Haskell.Tools.Refactor.Predefined.DollarApp1
+                     , Language.Haskell.Tools.Refactor.Predefined.DollarApp2
+                     , Language.Haskell.Tools.Refactor.Predefined.DollarApp3
+
   build-depends:       base                      >= 4.9  && < 4.10
                      , mtl                       >= 2.2  && < 2.3
                      , uniplate                  >= 1.6  && < 1.7
@@ -85,15 +90,15 @@                      , template-haskell          >= 2.11 && < 2.12
                      , ghc                       >= 8.0  && < 8.1
                      , Cabal                     >= 1.24 && < 1.25
-                     , 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-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
   default-language:    Haskell2010
-  
+
 test-suite haskell-tools-test
   type:                exitcode-stdio-1.0
-  ghc-options:         -with-rtsopts=-M2g -O2
+  ghc-options:         -with-rtsopts=-M2g
   hs-source-dirs:      test
   main-is:             Main.hs
   build-depends:       base                      >= 4.9  && < 4.10
@@ -113,11 +118,11 @@                      , ghc                       >= 8.0  && < 8.1
                      , ghc-paths                 >= 0.1  && < 0.2
                      , Cabal                     >= 1.24 && < 1.25
-                     , 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
+                     , 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
                      -- libraries used by the examples
                      , old-time                  >= 1.1  && < 1.2
                      , polyparse                 >= 1.12 && < 1.13

@@ -11,6 +11,7 @@ import DynFlags
 import GHC.Paths ( libdir )
 import Module as GHC
+import StringBuffer
 
 import Control.Reference
 import Control.Monad.IO.Class
@@ -49,16 +50,16 @@ main = defaultMain nightlyTests
 
 nightlyTests :: TestTree
-nightlyTests 
-  = testGroup "all tests" [ testGroup "functional tests" functionalTests 
+nightlyTests
+  = testGroup "all tests" [ testGroup "functional tests" functionalTests
                           , testGroup "CppHs tests" $ map makeCpphsTest cppHsTests
                           , testGroup "instance-control tests" $ map makeInstanceControlTest instanceControlTests
                           ]
 
 functionalTests :: [TestTree]
-functionalTests 
+functionalTests
   = [ testGroup "reprint tests" (map makeReprintTest checkTestCases)
-    , testGroup "refactor tests" 
+    , testGroup "refactor tests"
         $ map makeOrganizeImportsTest organizeImportTests
             ++ map makeGenerateSignatureTest generateSignatureTests
             ++ map makeWrongGenerateSigTest wrongGenerateSigTests
@@ -75,9 +76,9 @@             ++ map (makeMultiModuleTest checkMultiFail) wrongMultiModuleTests
             ++ map makeMiscRefactorTest miscRefactorTests
     ]
-  where checkTestCases = languageTests 
-                          ++ organizeImportTests 
-                          ++ map fst generateSignatureTests 
+  where checkTestCases = languageTests
+                          ++ organizeImportTests
+                          ++ map fst generateSignatureTests
                           ++ generateExportsTests
                           ++ map (\(mod,_,_) -> mod) renameDefinitionTests
                           ++ map (\(mod,_,_) -> mod) wrongRenameDefinitionTests
@@ -86,19 +87,27 @@                           ++ map (\(mod,_) -> mod) inlineBindingTests
 
 rootDir = "examples"
-        
+
 languageTests =
-  [ "Decl.AmbiguousFields"
+  [ "CPP.JustEnabled"
+  , "CPP.ConditionalCode"
+  , "Decl.AmbiguousFields"
   , "Decl.AnnPragma"
+  , "Decl.ClassInfix"
   , "Decl.ClosedTypeFamily"
   , "Decl.CtorOp"
   , "Decl.DataFamily"
   , "Decl.DataType"
   , "Decl.DataTypeDerivings"
+  , "Decl.DefaultDecl"
   , "Decl.FunBind"
   , "Decl.FunctionalDeps"
   , "Decl.FunGuards"
   , "Decl.GADT"
+  , "Decl.GadtConWithCtx"
+  , "Decl.InfixAssertion"
+  , "Decl.InfixInstances"
+  , "Decl.InfixPatSyn"
   , "Decl.InjectiveTypeFamily"
   , "Decl.InlinePragma"
   , "Decl.InstanceOverlaps"
@@ -131,6 +140,7 @@   , "Expr.DoNotation"
   , "Expr.GeneralizedListComp"
   , "Expr.EmptyCase"
+  , "Expr.FunSection"
   , "Expr.If"
   , "Expr.ImplicitParams"
   , "Expr.LambdaCase"
@@ -140,10 +150,12 @@   , "Expr.Operator"
   , "Expr.ParenName"
   , "Expr.ParListComp"
+  , "Expr.PatternAndDo"
   , "Expr.RecordPuns"
   , "Expr.RecordWildcards"
   , "Expr.RecursiveDo"
   , "Expr.Sections"
+  , "Expr.SemicolonDo"
   , "Expr.StaticPtr"
   , "Expr.TupleSections"
   , "Module.Simple"
@@ -151,12 +163,16 @@   , "Module.Export"
   , "Module.NamespaceExport"
   , "Module.Import"
+  , "Module.ImportOp"
+  , "Module.LangPragmas"
   , "Module.PatternImport"
   , "Pattern.Backtick"
   , "Pattern.Constructor"
   , "Pattern.ImplicitParams"
   , "Pattern.Infix"
+  , "Pattern.NestedWildcard"
   , "Pattern.NPlusK"
+  , "Pattern.OperatorPattern"
   , "Pattern.Record"
   , "Type.Bang"
   , "Type.Builtin"
@@ -164,6 +180,7 @@   , "Type.ExplicitTypeApplication"
   , "Type.Forall"
   , "Type.Primitives"
+  , "Type.TupleAssert"
   , "Type.TypeOperators"
   , "Type.Unpack"
   , "Type.Wildcard"
@@ -172,13 +189,15 @@   , "TH.QuasiQuote.Use"
   , "TH.Splice.Define"
   , "TH.Splice.Use"
+  , "TH.Splice.UseQual"
+  , "TH.Splice.UseQualMulti"
   , "Refactor.CommentHandling.CommentTypes"
   , "Refactor.CommentHandling.BlockComments"
   , "Refactor.CommentHandling.Crosslinking"
   , "Refactor.CommentHandling.FunctionArgs"
   ]
 
-cppHsTests = 
+cppHsTests =
   [ "Language.Preprocessor.Cpphs"
   , "Language.Preprocessor.Unlit"
   , "Language.Preprocessor.Cpphs.CppIfdef"
@@ -192,23 +211,27 @@   , "Language.Preprocessor.Cpphs.Tokenise"
   ]
 
-instanceControlTests = 
+instanceControlTests =
   [ "Control.Instances.Test"
   , "Control.Instances.Morph"
   , "Control.Instances.ShortestPath"
   , "Control.Instances.TypeLevelPrelude"
   ]
-        
-organizeImportTests = 
+
+organizeImportTests =
   [ "Refactor.OrganizeImports.Narrow"
   , "Refactor.OrganizeImports.Reorder"
   , "Refactor.OrganizeImports.Ctor"
   , "Refactor.OrganizeImports.Class"
+  , "Refactor.OrganizeImports.Fields"
   , "Refactor.OrganizeImports.Operator"
   , "Refactor.OrganizeImports.SameName"
   , "Refactor.OrganizeImports.Removed"
   , "Refactor.OrganizeImports.ReorderGroups"
   , "Refactor.OrganizeImports.ReorderComment"
+  , "Refactor.OrganizeImports.KeepCtorOfMarshalled"
+  , "Refactor.OrganizeImports.KeepHiding"
+  , "Refactor.OrganizeImports.KeepPrelude"
   , "Refactor.OrganizeImports.KeepReexported"
   , "Refactor.OrganizeImports.KeepRenamedReexported"
   , "Refactor.OrganizeImports.MakeExplicit.ImportOne"
@@ -221,6 +244,7 @@   , "Refactor.OrganizeImports.MakeExplicit.ImportFour"
   , "Refactor.OrganizeImports.MakeExplicit.ImportFunHiddenClass"
   , "Refactor.OrganizeImports.MakeExplicit.ImportFunOutOfClass"
+  , "Refactor.OrganizeImports.MakeExplicit.Renamed"
   , "Refactor.OrganizeImports.InstanceCarry.ImportOrphan"
   , "Refactor.OrganizeImports.InstanceCarry.ImportNonOrphan"
   , "Refactor.OrganizeImports.NarrowQual"
@@ -228,9 +252,10 @@   , "Refactor.OrganizeImports.StandaloneDeriving"
   , "Refactor.OrganizeImports.TemplateHaskell"
   , "Refactor.OrganizeImports.NarrowType"
+  , "CPP.ConditionalImport"
   ]
-  
-generateSignatureTests = 
+
+generateSignatureTests =
   [ ("Refactor.GenerateTypeSignature.Simple", "3:1-3:10")
   , ("Refactor.GenerateTypeSignature.Function", "3:1-3:15")
   , ("Refactor.GenerateTypeSignature.HigherOrder", "3:1-3:14")
@@ -248,7 +273,7 @@   , ("Refactor.GenerateTypeSignature.CanCaptureVariableHasOtherDef", "8:10-8:10")
   ]
 
-wrongGenerateSigTests = 
+wrongGenerateSigTests =
   [ ("Refactor.GenerateTypeSignature.CannotCaptureVariable", "7:10-7:10")
   , ("Refactor.GenerateTypeSignature.CannotCaptureVariableNoExt", "8:10-8:10")
   , ("Refactor.GenerateTypeSignature.ComplexLhs", "3:1")
@@ -257,7 +282,7 @@   , ("Refactor.GenerateTypeSignature.ComplexLhs", "6:1")
   ]
 
-generateExportsTests = 
+generateExportsTests =
   [ "Refactor.GenerateExports.Normal"
   , "Refactor.GenerateExports.Operators"
   ]
@@ -289,6 +314,7 @@   , ("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")
   ]
 
 wrongRenameDefinitionTests =
@@ -327,11 +353,13 @@   , ("Refactor.ExtractBinding.AssocOp", "3:9-3:14", "b")
   , ("Refactor.ExtractBinding.AssocOpRightAssoc", "3:5-3:12", "g")
   , ("Refactor.ExtractBinding.AssocOpMiddle", "3:9-3:14", "b")
+  , ("Refactor.ExtractBinding.SiblingDefs", "7:9-7:10", "a")
   ]
 
-wrongExtractBindingTests = 
+wrongExtractBindingTests =
   [ ("Refactor.ExtractBinding.TooSimple", "3:19-3:20", "x")
   , ("Refactor.ExtractBinding.NameConflict", "3:19-3:27", "stms")
+  , ("Refactor.ExtractBinding.ViewPattern", "4:4-4:11", "idid")
   ]
 
 inlineBindingTests =
@@ -354,7 +382,7 @@   , ("Refactor.InlineBinding.LetGuard", "3:9-3:10")
   ]
 
-wrongInlineBindingTests = 
+wrongInlineBindingTests =
   [ ("Refactor.InlineBinding.Recursive", "4:1-4:2")
   , ("Refactor.InlineBinding.InExportList", "4:1-4:2")
   , ("Refactor.InlineBinding.NotOccurring", "3:1")
@@ -400,23 +428,23 @@   , ("Refactor.DollarApp.ImportDollar", \m -> dollarApp (correctRefactorSpan m $ readSrcSpan "6:5-6:12"))
   ]
 
-makeMultiModuleTest :: ((String, String, String, [String]) -> Either String [(String, Maybe String)] -> IO ()) 
+makeMultiModuleTest :: ((String, String, String, [String]) -> Either String [(String, Maybe String)] -> IO ())
                          -> (String, String, String, [String]) -> TestTree
 makeMultiModuleTest checker test@(refact, mod, root, removed)
-  = testCase (root ++ ":" ++ mod) 
+  = testCase (root ++ ":" ++ mod)
       $ do res <- performRefactors refact (rootDir </> root) [] mod
            checker test res
-           
+
 checkMultiResults :: (String, String, String, [String]) -> Either String [(String, Maybe String)] -> IO ()
 checkMultiResults _ (Left err) = assertFailure $ "The transformation failed : " ++ err
-checkMultiResults test@(_,_,root,removed) (Right ((name, Just mod):rest)) = 
+checkMultiResults test@(_,_,root,removed) (Right ((name, Just mod):rest)) =
   do expected <- loadExpected False ((rootDir </> root) ++ "_res") name
      assertEqual "The transformed result is not what is expected" (standardizeLineEndings expected)
                                                                   (standardizeLineEndings mod)
      checkMultiResults test (Right rest)
 checkMultiResults (r,m,root,removed) (Right ((name, Nothing) : rest)) = checkMultiResults (r,m,root,delete name removed) (Right rest)
 checkMultiResults (_,_,_,[]) (Right []) = return ()
-checkMultiResults (_,_,_,removed) (Right []) 
+checkMultiResults (_,_,_,removed) (Right [])
   = assertFailure $ "Modules has not been marked as removed: " ++ concat (intersperse ", " removed)
 
 checkMultiFail :: (String, String, String, [String]) -> Either String [(String, Maybe String)] -> IO ()
@@ -454,40 +482,40 @@ 
 makeWrongExtractBindingTest :: (String, String, String) -> TestTree
 makeWrongExtractBindingTest (mod, rng, newName) = createFailTest "ExtractBinding" [rng, newName] mod
-  
+
 makeInlineBindingTest :: (String, String) -> TestTree
 makeInlineBindingTest (mod, rng) = createTest "InlineBinding" [rng] mod
-  
+
 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
        res <- performRefactor command workingDir [] moduleName
-       assertEqual "The transformed result is not what is expected" (Right (standardizeLineEndings expected)) 
+       assertEqual "The transformed result is not what is expected" (Right (standardizeLineEndings expected))
                                                                     (mapRight standardizeLineEndings res)
 makeMiscRefactorTest :: (String, UnnamedModule IdDom -> LocalRefactoring IdDom) -> TestTree
 makeMiscRefactorTest (moduleName, refact)
   = testCase moduleName $
       do expected <- loadExpected True rootDir moduleName
          res <- testRefactor refact moduleName
-         assertEqual "The transformed result is not what is expected" (Right (standardizeLineEndings expected)) 
+         assertEqual "The transformed result is not what is expected" (Right (standardizeLineEndings expected))
                                                                       (mapRight standardizeLineEndings res)
-        
+
 testRefactor :: (UnnamedModule IdDom -> LocalRefactoring IdDom) -> String -> IO (Either String String)
-testRefactor refact moduleName 
+testRefactor refact moduleName
   = runGhc (Just libdir) $ do
       initGhcFlags
       useDirs [rootDir]
       mod <- loadModule rootDir moduleName >>= parseTyped
-      res <- runRefactor (SourceFileKey NormalHs moduleName, mod) [] (localRefactoring $ refact mod) 
+      res <- runRefactor (SourceFileKey NormalHs moduleName, mod) [] (localRefactoring $ refact mod)
       case res of Right r -> return $ Right $ prettyPrint $ snd $ fromContentChanged $ head r
                   Left err -> return $ Left err
 
@@ -495,26 +523,26 @@ checkTransformFails command workingDir moduleName
   = do res <- performRefactor command workingDir [] moduleName
        assertBool "The transform should fail for the given input" (isLeft res)
-       
+
 loadExpected :: Bool -> String -> String -> IO String
-loadExpected resSuffix workingDir moduleName = 
+loadExpected resSuffix workingDir moduleName =
   do -- need to use binary or line endings will be translated
      expectedHandle <- openBinaryFile (workingDir </> map (\case '.' -> pathSeparator; c -> c) moduleName ++ (if resSuffix then "_res" else "") ++ ".hs") ReadMode
      hGetContents expectedHandle
 
 standardizeLineEndings = filter (/= '\r')
-       
-makeReprintTest :: String -> TestTree       
+
+makeReprintTest :: String -> TestTree
 makeReprintTest mod = testCase mod (checkCorrectlyPrinted rootDir mod)
 
-makeCpphsTest :: String -> TestTree       
+makeCpphsTest :: String -> TestTree
 makeCpphsTest mod = testCase mod (checkCorrectlyPrinted (rootDir </> "CppHs") mod)
 
-makeInstanceControlTest :: String -> TestTree       
+makeInstanceControlTest :: String -> TestTree
 makeInstanceControlTest mod = testCase mod (checkCorrectlyPrinted (rootDir </> "InstanceControl") mod)
 
 checkCorrectlyPrinted :: String -> String -> IO ()
-checkCorrectlyPrinted workingDir moduleName 
+checkCorrectlyPrinted workingDir moduleName
   = do -- need to use binary or line endings will be translated
        expectedHandle <- openBinaryFile (workingDir </> map (\case '.' -> pathSeparator; c -> c) moduleName ++ ".hs") ReadMode
        expected <- hGetContents expectedHandle
@@ -524,12 +552,12 @@          actual' <- prettyPrint <$> parseRenamed parsed
          actual'' <- prettyPrint <$> parseTyped parsed
          return (actual, actual', actual'')
-       assertEqual "The original and the transformed source differ" expected actual
-       assertEqual "The original and the transformed source differ" expected actual'
-       assertEqual "The original and the transformed source differ" expected actual''
+       assertEqual "Parsed: The original and the transformed source differ" expected actual
+       assertEqual "Renamed: The original and the transformed source differ" expected actual'
+       assertEqual "Typechecked: The original and the transformed source differ" expected actual''
 
 performRefactors :: String -> String -> [String] -> String -> IO (Either String [(String, Maybe String)])
-performRefactors command workingDir flags target = do 
+performRefactors command workingDir flags target = do
     mods <- getAllModules [workingDir]
     runGhc (Just libdir) $ do
       initGhcFlagsForTest
@@ -539,55 +567,57 @@       load LoadAllTargets
       allMods <- getModuleGraph
       selectedMod <- getModSummary (GHC.mkModuleName target)
-      let otherModules = filter (not . (\ms -> ms_mod ms == ms_mod selectedMod && ms_hsc_src ms == ms_hsc_src selectedMod)) allMods 
+      let otherModules = filter (not . (\ms -> ms_mod ms == ms_mod selectedMod && ms_hsc_src ms == ms_hsc_src selectedMod)) allMods
       targetMod <- parseTyped selectedMod
       otherMods <- mapM parseTyped otherModules
-      res <- performCommand (readCommand command) 
+      res <- performCommand (either error id $ readCommand command)
                             (SourceFileKey NormalHs target, targetMod) (zip (map keyFromMS otherModules) otherMods)
       return $ (\case Right r -> Right $ (map (\case ContentChanged (n,m) -> (n ^. sfkModuleName, Just $ prettyPrint m)
                                                      ModuleCreated n m _ -> (n, Just $ prettyPrint m)
                                                      ModuleRemoved m -> (m, Nothing)
                                               )) r
-                      Left l -> Left l) 
+                      Left l -> Left l)
              $ res
 
 type ParsedModule = Ann AST.UModule (Dom RdrName) SrcTemplateStage
 
 parseAST :: ModSummary -> Ghc ParsedModule
 parseAST modSum = 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
       ms = if hasStaticFlags then forceAsmGen modSum else modSum
   p <- parseModule ms
+  sourceOrigin <- if hasCppExtension then liftIO $ hGetStringBuffer (getModSumOrig ms)
+                                     else return (fromJust $ ms_hspp_buf $ pm_mod_summary p)
   let annots = pm_annotations p
-      srcBuffer = fromJust $ ms_hspp_buf $ pm_mod_summary p
-  prepareAST srcBuffer . placeComments (snd annots) 
-     <$> (runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModule ms $ pm_parsed_source p)          
+  (if hasCppExtension then prepareASTCpp else prepareAST) sourceOrigin . placeComments (fst annots) (getNormalComments $ snd annots)
+     <$> (runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModule ms $ pm_parsed_source p)
 
 type RenamedModule = Ann AST.UModule (Dom GHC.Name) SrcTemplateStage
 
 parseRenamed :: ModSummary -> Ghc RenamedModule
 parseRenamed modSum = 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
       ms = if hasStaticFlags then forceAsmGen modSum else modSum
   p <- parseModule ms
+  sourceOrigin <- if hasCppExtension then liftIO $ hGetStringBuffer (getModSumOrig ms)
+                                     else return (fromJust $ ms_hspp_buf $ pm_mod_summary p)
   tc <- typecheckModule p
   let annots = pm_annotations p
-      srcBuffer = fromJust $ ms_hspp_buf $ pm_mod_summary p
-  prepareAST srcBuffer . placeComments (getNormalComments $ snd annots) 
+  (if hasCppExtension then prepareASTCpp else prepareAST) sourceOrigin . placeComments (fst annots) (getNormalComments $ snd annots)
     <$> (do parseTrf <- runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModule ms (pm_parsed_source p)
             runTrf (fst annots) (getPragmaComments $ snd annots)
               $ trfModuleRename ms parseTrf
-                  (fromJust $ tm_renamed_source tc) 
+                  (fromJust $ tm_renamed_source tc)
                   (pm_parsed_source p))
 
 performRefactor :: String -> FilePath -> [String] -> String -> IO (Either String String)
-performRefactor command workingDir flags target = 
+performRefactor command workingDir flags target =
   runGhc (Just libdir) $ do
     useFlags flags
     ((\case Right r -> Right (newContent r); Left l -> Left l) <$> (refact =<< parseTyped =<< loadModule workingDir target))
-  where refact m = performCommand (readCommand command) (SourceFileKey NormalHs target,m) []
+  where refact m = performCommand (either error id $ readCommand command) (SourceFileKey NormalHs target,m) []
         newContent (ContentChanged (_, newContent) : ress) = prettyPrint newContent
         newContent ((ModuleCreated _ newContent _) : ress) = prettyPrint newContent
         newContent (_ : ress) = newContent ress