HaRe 0.8.2.2 → 0.8.2.3

raw patch · 11 files changed

+269/−277 lines, 11 filesdep ~ghc-modPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: ghc-mod

API changes (from Hackage documentation)

Files

• ChangeLog +6/−0
• HaRe.cabal +4/−4
• src/Language/Haskell/Refact/HaRe.hs +6/−2
• src/Language/Haskell/Refact/Refactoring/Case.hs +8/−6
• src/Language/Haskell/Refact/Refactoring/DupDef.hs +11/−10
• src/Language/Haskell/Refact/Refactoring/MoveDef.hs +3/−0
• src/Language/Haskell/Refact/Refactoring/Renaming.hs +218/−226
• src/Language/Haskell/Refact/Utils/Utils.hs +4/−21
• test/RenamingSpec.hs +5/−5
• test/UtilsSpec.hs +3/−2
• test/testdata/testdata.cabal +1/−1

@@ -1,3 +1,9 @@+2016-01-20 v0.8.2.3+	* Use ghc-mod version to 5.5 now it is released+	* Expose commands working in RefactGhc, so the ghc-mod session can+	be shared in haskell-ide-engine. By @cocreature+	* Internal only, heavily clean up the ...Refactoring.Rename+	module. By @glittershark 2016-01-07 v0.8.2.2 	* Lock ghc-mod version to 0.5.4 to prevent issues when 0.5.5 comes out 	* Set minimum bound on ghc-exactprint, the behaviour of layout has

@@ -1,5 +1,5 @@ Name:                           HaRe-Version:                        0.8.2.2+Version:                        0.8.2.3 Author:                         Chris Brown, Huiqing Li, Simon Thompson, Alan Zimmerman Maintainer:                     Alan Zimmerman Stability:                      Alpha@@ -121,7 +121,7 @@                                 , ghc-paths                                 , ghc-prim                                 , ghc-syb-utils-                                , ghc-mod == 5.4.*+                                , ghc-mod >= 5.5.0.0                                 , mtl                                 , old-time                                 , pretty@@ -193,7 +193,7 @@                                 , ghc-paths                                 , ghc-prim                                 , ghc-syb-utils-                                , ghc-mod == 5.4.*+                                , ghc-mod >= 5.5.0.0                                 , mtl                                 , old-time                                 , parsec >= 3.1.6@@ -285,7 +285,7 @@     , ghc-paths     , ghc-prim     , ghc-syb-utils-    , ghc-mod == 5.4.*+    , ghc-mod >= 5.5.0.0     , hspec     , mtl     , old-time

@@ -12,11 +12,17 @@   -- * Refactorings  , ifToCase+ , compIfToCase  , duplicateDef+ , compDuplicateDef  , liftToTopLevel+ , compLiftToTopLevel  , liftOneLevel+ , compLiftOneLevel  , demote+ , compDemote  , rename+ , compRename  -- , swapArgs  , roundTrip @@ -32,5 +38,3 @@ import Language.Haskell.Refact.Utils.Monad import Language.Haskell.Refact.Utils.Types import qualified Language.Haskell.GhcMod as GM (Options(..),defaultOptions)--

@@ -1,5 +1,8 @@ {-# LANGUAGE StandaloneDeriving #-}-module Language.Haskell.Refact.Refactoring.Case(ifToCase) where+module Language.Haskell.Refact.Refactoring.Case+  ( ifToCase+  , compIfToCase+  ) where  import qualified Data.Generics         as SYB import qualified GHC.SYB.Utils         as SYB@@ -25,14 +28,14 @@ ifToCase :: RefactSettings -> GM.Options -> FilePath -> SimpPos -> SimpPos -> IO [FilePath] ifToCase settings opts fileName beginPos endPos = do   absFileName <- canonicalizePath fileName-  runRefacSession settings opts (comp absFileName beginPos endPos)+  runRefacSession settings opts (compIfToCase absFileName beginPos endPos) -comp :: FilePath -> SimpPos -> SimpPos -> RefactGhc [ApplyRefacResult]-comp fileName beginPos endPos = do+compIfToCase :: FilePath -> SimpPos -> SimpPos -> RefactGhc [ApplyRefacResult]+compIfToCase fileName beginPos endPos = do        parseSourceFileGhc fileName        parsed <- getRefactParsed        oldAnns <- liftT getAnnsT-       logm $ "Case.comp:parsed=" ++ (showAnnData oldAnns 0 parsed) -- ++AZ+++       logm $ "Case.compIfToCase:parsed=" ++ (showAnnData oldAnns 0 parsed) -- ++AZ++        let expr = locToExp beginPos endPos parsed        case expr of          Just exp1@(GHC.L _ (GHC.HsIf _ _ _ _))@@ -144,4 +147,3 @@   -- EOF-

@@ -3,7 +3,9 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -module Language.Haskell.Refact.Refactoring.DupDef(duplicateDef) where+module Language.Haskell.Refact.Refactoring.DupDef+  ( duplicateDef+  , compDuplicateDef ) where  import qualified Data.Generics as SYB import qualified GHC.SYB.Utils as SYB@@ -30,10 +32,10 @@ duplicateDef :: RefactSettings -> GM.Options -> FilePath -> String -> SimpPos -> IO [FilePath] duplicateDef settings opts fileName newName (row,col) = do   absFileName <- canonicalizePath fileName-  runRefacSession settings opts (comp absFileName newName (row,col))+  runRefacSession settings opts (compDuplicateDef absFileName newName (row,col)) -comp :: FilePath -> String -> SimpPos -> RefactGhc [ApplyRefacResult]-comp fileName newName (row, col) = do+compDuplicateDef :: FilePath -> String -> SimpPos -> RefactGhc [ApplyRefacResult]+compDuplicateDef fileName newName (row, col) = do   if isVarId newName     then       do@@ -41,14 +43,14 @@         renamed <- getRefactRenamed         parsed  <- getRefactParsed         targetModule <- getRefactTargetModule-        logm $ "DupDef.comp:got targetModule"+        logm $ "DupDef.compDuplicateDef:got targetModule"          let (Just (modName,_)) = getModuleName parsed         let maybePn = locToName (row, col) renamed         case maybePn of           Just pn ->             do-              logm $ "DupDef.comp:about to applyRefac for:pn=" ++ SYB.showData SYB.Parser 0 pn+              logm $ "DupDef.compDuplicateDef:about to applyRefac for:pn=" ++ SYB.showData SYB.Parser 0 pn               (refactoredMod,(isDone,nn)) <- applyRefac (doDuplicating pn newName) (RSFile fileName)               logm $ "DupDef.com:isDone=" ++ show isDone               case isDone of@@ -58,7 +60,7 @@                   if modIsExported modName renamed                    then                     do-                       logm $ "DupDef.comp:about to clientMods"+                       logm $ "DupDef.compDuplicateDef:about to clientMods"                        clients <- clientModsAndFiles targetModule                        logm ("DupDef: clients=" ++ (showGhc clients)) -- ++AZ++ debug                        refactoredClients <- mapM (refactorInClientMod (GHC.unLoc pn) modName nn)@@ -75,9 +77,9 @@ doDuplicating :: GHC.Located GHC.Name -> String               -> RefactGhc (DupDefResult,GHC.Name) doDuplicating pn newName = do-   logm $ "DupDef.comp:doDuplicating entered"+   logm $ "DupDef.compDuplicateDef:doDuplicating entered"    inscopes <- getRefactInscopes-   logm $ "DupDef.comp:doDuplicating got inscopes"+   logm $ "DupDef.compDuplicateDef:doDuplicating got inscopes"    reallyDoDuplicating pn newName inscopes  @@ -286,4 +288,3 @@          where getModName (GHC.L _ (GHC.ImportDecl _ _modName1 _qualify _source _safe _isQualified _isImplicit as _h))                  = if isJust as then (fromJust as)                                 else modName-

@@ -6,8 +6,11 @@  module Language.Haskell.Refact.Refactoring.MoveDef   ( liftToTopLevel+  , compLiftToTopLevel   , liftOneLevel+  , compLiftOneLevel   , demote+  , compDemote   -- ,liftingInClientMod   ) where 

@@ -1,4 +1,7 @@-module Language.Haskell.Refact.Refactoring.Renaming (rename) where+module Language.Haskell.Refact.Refactoring.Renaming+  ( rename+  , compRename+  ) where  import qualified Data.Generics.Schemes as SYB import qualified Data.Generics.Aliases as SYB@@ -9,6 +12,7 @@ import qualified RdrName               as GHC  import Control.Monad+import Data.Maybe import Data.List  import qualified Language.Haskell.GhcMod as GM (Options(..))@@ -44,64 +48,72 @@ -}  -- | Rename the given identifier.-rename :: RefactSettings -> GM.Options-   -> FilePath -> String -> SimpPos-   -> IO [FilePath]+rename :: RefactSettings+       -> GM.Options+       -> FilePath+       -> String+       -> SimpPos+       -> IO [FilePath] rename settings opts fileName newName (row,col) = do   absFileName <- canonicalizePath fileName-  runRefacSession settings opts (comp absFileName newName (row,col))+  runRefacSession settings opts (compRename absFileName newName (row,col))  -- | Body of the refactoring-comp :: FilePath -> String -> SimpPos -> RefactGhc [ApplyRefacResult]-comp fileName newName (row,col) = do+compRename :: FilePath -> String -> SimpPos -> RefactGhc [ApplyRefacResult]+compRename fileName newName (row,col) = do     logm $ "Renaming.comp: (fileName,newName,(row,col))=" ++ show (fileName,newName,(row,col))     parseSourceFileGhc fileName-    renamed <- getRefactRenamed-    parsed  <- getRefactParsed -    modu <- getModule+    renamed      <- getRefactRenamed+    parsed       <- getRefactParsed+    modu         <- getModule     targetModule <- getRefactTargetModule-    let modName = case getModuleName parsed of-                    Just (mn,_) -> mn-                    Nothing -> GHC.mkModuleName "Main"-    let maybePn = locToName (row, col) renamed++    let modName = maybe (GHC.mkModuleName "Main") fst $ getModuleName parsed+        maybePn = locToName (row, col) renamed+     logm $ "Renamed.comp:maybePn=" ++ showGhc maybePn -- ++AZ+++     case maybePn of         Just pn@(GHC.L _ n) -> do-           logm $ "Renaming:(n,modu)=" ++ showGhc (n,modu)+            logm $ "Renaming:(n,modu)=" ++ showGhc (n,modu) -           let (GHC.L _ rdrName) = gfromJust "Renaming.comp.2" $ locToRdrName (row, col) parsed-           let rdrNameStr = GHC.occNameString $ GHC.rdrNameOcc rdrName-           logm $ "Renaming: rdrName=" ++ SYB.showData SYB.Parser 0 rdrName-           logm $ "Renaming: occname rdrName=" ++ show (GHC.occNameString $ GHC.rdrNameOcc rdrName)+            let (GHC.L _ rdrName) = gfromJust "Renaming.comp.2" $ locToRdrName (row, col) parsed+            let rdrNameStr = GHC.occNameString $ GHC.rdrNameOcc rdrName+            logm $ "Renaming: rdrName=" ++ SYB.showData SYB.Parser 0 rdrName+            logm $ "Renaming: occname rdrName=" ++ show (GHC.occNameString $ GHC.rdrNameOcc rdrName) -           unless (nameToString n /= newName) $ error "The new name is same as the old name"-           unless (isValidNewName n rdrNameStr newName) $ error $ "Invalid new name:" ++ newName ++ "!"+            unless (nameToString n /= newName) $ error "The new name is same as the old name"+            unless (isValidNewName n rdrNameStr newName) $ error $ "Invalid new name:" ++ newName ++ "!"  -           logm $ "Renaming.comp: before GHC.nameModule,n=" ++ showGhc n+            logm $ "Renaming.comp: before GHC.nameModule,n=" ++ showGhc n -           let defineMod = case GHC.nameModule_maybe n of-                            Just mn -> GHC.moduleName mn-                            Nothing -> modName+            let defineMod = case GHC.nameModule_maybe n of+                             Just mn -> GHC.moduleName mn+                             Nothing -> modName -           -- TODO: why do we have this restriction?-           unless (defineMod == modName ) ( error ("This identifier is defined in module " ++ GHC.moduleNameString defineMod ++-                                         ", please do renaming in that module!"))-           logm $ "Renaming.comp:(isMainModule modu,pn)=" ++ (showGhcQual (isMainModule modu,pn))-           if isMainModule modu && showGhcQual pn == "Main.main"-             then error "The 'main' function defined in a 'Main' module should not be renamed!"-             else do-               logm $ "Renaming.comp: not main module"-               newNameGhc <- mkNewGhcName (Just modu) newName-               (refactoredMod,nIsExported) <- applyRefac (doRenaming pn rdrNameStr newName newNameGhc modName) RSAlreadyLoaded-               logm $ "Renaming:nIsExported=" ++ show nIsExported-               if nIsExported  --no matter whether this pn is used or not.-                   then do clients <- clientModsAndFiles targetModule-                           logm ("Renaming: clients=" ++ show clients) -- ++AZ++ debug-                           refactoredClients <- mapM (renameInClientMod n newName newNameGhc) clients-                           return $ refactoredMod:(concat refactoredClients)-                   else  return [refactoredMod]+            -- TODO: why do we have this restriction?+            unless (defineMod == modName) . error $ mconcat [ "This identifier is defined in module "+                                                            , GHC.moduleNameString defineMod+                                                            , ", please do renaming in that module!"+                                                            ]+            logm $ "Renaming.comp:(isMainModule modu,pn)=" ++ showGhcQual (isMainModule modu,pn)+            when (isMainModule modu && showGhcQual pn == "Main.main") $+                error "The 'main' function defined in a 'Main' module should not be renamed!"++            logm "Renaming.comp: not main module"+            newNameGhc <- mkNewGhcName (Just modu) newName+            (refactoredMod, nIsExported) <- applyRefac (doRenaming pn rdrNameStr newName newNameGhc modName)+                                           RSAlreadyLoaded++            logm $ "Renaming:nIsExported=" ++ show nIsExported+            if nIsExported  --no matter whether this pn is used or not.+                then do clients <- clientModsAndFiles targetModule+                        logm ("Renaming: clients=" ++ show clients) -- ++AZ++ debug+                        refactoredClients <- mapM (renameInClientMod n newName newNameGhc) clients+                        return $ refactoredMod : concat refactoredClients+                else return [refactoredMod]         Nothing -> error "Invalid cursor position!"  @@ -111,123 +123,115 @@  --------Rename a value variable name-------------------------------- doRenaming pn@(GHC.L _ oldn) rdrNameStr newNameStr newNameGhc modName = do-  logm $ "doRenaming:(pn,rdrNameStr,newNameStr) = " ++ (showGhc (pn,rdrNameStr,newNameStr))-  renamed <- getRefactRenamed-  void $ SYB.everywhereM (SYB.mkM renameInMod-                         ) renamed-  logm "doRenaming done"-  nIsExported <- isExported oldn-  return nIsExported-   where-     -- 1. The name is declared in a module(top level name)-     renameInMod :: GHC.RenamedSource -> RefactGhc GHC.RenamedSource-     renameInMod ren-        | True = do-           logm $ "renameInMod"-           renameTopLevelVarName oldn newNameStr newNameGhc modName ren True True-+    logm $ "doRenaming:(pn,rdrNameStr,newNameStr) = " ++ showGhc (pn,rdrNameStr,newNameStr)+    renamed <- getRefactRenamed+    void $ SYB.everywhereM (SYB.mkM renameInMod) renamed+    logm "doRenaming done"+    isExported oldn+  where+    -- 1. The name is declared in a module(top level name)+    renameInMod :: GHC.RenamedSource -> RefactGhc GHC.RenamedSource+    renameInMod ren = do+        logm "renameInMod"+        renameTopLevelVarName oldn newNameStr newNameGhc modName ren True True  renameTopLevelVarName :: GHC.Name -> String -> GHC.Name -> GHC.ModuleName -> GHC.RenamedSource-                         -> Bool -> Bool -> RefactGhc GHC.RenamedSource+                      -> Bool -> Bool -> RefactGhc GHC.RenamedSource renameTopLevelVarName oldPN newName newNameGhc modName renamed existChecking exportChecking = do-     logm $ "renameTopLevelVarName:(existChecking,exportChecking)=" ++ (show (existChecking,exportChecking))-     causeAmbiguity <- causeAmbiguityInExports oldPN newNameGhc-      -- f' contains names imported from other modules;-      -- d' contains the top level names declared in this module;-     (f',d') <- hsFDsFromInside renamed-      --filter those qualified free variables in f'-     -- let (f,d) = ((nub.map pNtoName.filter (not.isQualifiedPN)) f', (nub.map pNtoName) d')-     let (f,d) = (map nameToString f',map nameToString d')-     logm $ "renameTopLevelVarName:f=" ++ (show f)-     logm $ "renameTopLevelVarName:d=" ++ (show d)-     let newNameStr = nameToString newNameGhc-     logm $ "renameTopLevelVarName:(newName,newNameStr)=" ++ (show (newName,newNameStr))-     scopeClashNames <- inScopeNames newName-     logm $ "renameTopLevelVarName:(f')=" ++ (showGhc f')-     logm $ "renameTopLevelVarName:(scopeClashNames,intersection)=" ++ (showGhc (scopeClashNames,intersect scopeClashNames f'))-     logm $ "renameTopLevelVarName:(oldPN,modName)=" ++ (showGhc (oldPN,modName))-     if (nonEmptyList $ intersect scopeClashNames f')-       then error ("The new name will cause ambiguous occurrence problem,"-                   ++" please select another new name or qualify the use of ' "-                   ++ newName ++ "' before renaming!\n") -- Another implementation option is to add the qualifier-                                                         -- to newName automatically.-       else if existChecking && elem newNameStr (d \\ [nameToString oldPN])  --only check the declared names here.-             then error ("Name '"++newName++"'  already existed\n") --the same name has been declared in this module.-             else if exportChecking && causeNameClashInExports oldPN newNameGhc modName renamed-                    then error ("The new name will cause conflicting exports, please select another new name!")-                    else if exportChecking && causeAmbiguity -- causeAmbiguityInExports oldPN  newNameGhc {- inscps -} renamed-                          then error $"The new name will cause ambiguity in the exports of module "++ show modName ++ ", please select another name!"-                          else do  -- get all of those declared names visible to oldPN at where oldPN is used.+    logm $ "renameTopLevelVarName:(existChecking, exportChecking)=" ++ show (existChecking, exportChecking)+    causeAmbiguity <- causeAmbiguityInExports oldPN newNameGhc+     -- f' contains names imported from other modules;+     -- d' contains the top level names declared in this module;+    (f', d') <- hsFDsFromInside renamed+     --filter those qualified free variables in f'+    -- let (f,d) = ((nub.map pNtoName.filter (not.isQualifiedPN)) f', (nub.map pNtoName) d')+    let (f, d) = (map nameToString f', map nameToString d')+    logm $ "renameTopLevelVarName:f=" ++ show f+    logm $ "renameTopLevelVarName:d=" ++ show d -                                 logm $ "renameTopLevelVarName:basic tests done"+    let newNameStr = nameToString newNameGhc+    logm $ "renameTopLevelVarName:(newName,newNameStr)=" ++ show (newName, newNameStr) -                                 isInScopeUnqual <- isInScopeAndUnqualifiedGhc newName (Just newNameGhc)-                                 logm $ "renameTopLevelVarName:after isInScopeUnqual"-                                 logm $ "renameTopLevelVarName:oldPN=" ++ showGhc oldPN-                                 ds <- hsVisibleNames oldPN renamed-                                 logm $ "renameTopLevelVarName:ds computed=" ++ (show ds)-                                 if existChecking && elem newName ((nub (ds `union` f)) \\[nameToString oldPN])-                                   then error ("Name '"++newName++"'  already existed, or rename '"-                                                ++nameToString oldPN++ "' to '"++newName++-                                                "' will change the program's semantics!\n")-                                   else if exportChecking && isInScopeUnqual -- isInScopeAndUnqualifiedGhc newName Nothing-                                          then do-                                               logm $ "renameTopLevelVarName start..:should have qualified"-                                               parsed <- getRefactParsed-                                               parsed' <- renamePN oldPN newNameGhc True parsed-                                               putRefactParsed parsed' mempty-                                               logm $ "renameTopLevelVarName done:should have qualified"-                                               r' <- getRefactRenamed-                                               return r'-                                          else do-                                               logm $ "renameTopLevelVarName start.."-                                               parsed <- getRefactParsed-                                               parsed' <- renamePN oldPN newNameGhc False parsed-                                               putRefactParsed parsed' mempty-                                               logm $ "renameTopLevelVarName done"-                                               r' <- getRefactRenamed-                                               return r'+    scopeClashNames <- inScopeNames newName --- ---------------------------------------------------------------------+    logm $ "renameTopLevelVarName:(f')=" ++ showGhc f'+    logm $ "renameTopLevelVarName:(scopeClashNames,intersection)=" +++           showGhc (scopeClashNames, scopeClashNames `intersect` f')+    logm $ "renameTopLevelVarName:(oldPN,modName)=" ++ showGhc (oldPN,modName) +    -- Another implementation option is to add the qualifier to newName automatically.+    when (nonEmptyList $ intersect scopeClashNames f') .+        error $ mconcat [ "The new name will cause an ambiguous occurrence problem, "+                        , "please select another new name or qualify the use of '"+                        , newName ++ "' before renaming!\n"]++    when (existChecking && newNameStr `elem` d \\ [nameToString oldPN]) . -- only check the declared names here+        --the same name has been declared in this module.+        error $ mconcat ["Name '", newName, "' already exists in this module\n"]++    when (exportChecking && causeNameClashInExports oldPN newNameGhc modName renamed) $+        error "The new name will cause conflicting exports, please select another new name!"+    when (exportChecking && causeAmbiguity) . -- causeAmbiguityInExports oldPN  newNameGhc {- inscps -} renamed+        error $ mconcat ["The new name will cause ambiguity in the exports of module '"+                        , show modName+                        , "' , please select another name!"]+    -- get all of those declared names visible to oldPN at where oldPN is used.++    logm "renameTopLevelVarName:basic tests done"++    isInScopeUnqual <- isInScopeAndUnqualifiedGhc newName (Just newNameGhc)+    logm "renameTopLevelVarName:after isInScopeUnqual"+    logm $ "renameTopLevelVarName:oldPN=" ++ showGhc oldPN+    ds <- hsVisibleNames oldPN renamed+    logm $ "renameTopLevelVarName:ds computed=" ++ show ds+    when (existChecking && newName `elem` nub (ds `union` f) \\ [nameToString oldPN]) .+        error $ mconcat [ "Name '", newName, "' already exists, or renaming '", nameToString oldPN,  "' to '"+                        , newName, "' will change the program's semantics!\n"]++    logm "renameTopLevelVarName start..:should have qualified"+    parsed <- renamePN oldPN newNameGhc (exportChecking && isInScopeUnqual) =<< getRefactParsed+    putRefactParsed parsed mempty+    logm "renameTopLevelVarName done:should have qualified"+    getRefactRenamed++------------------------------------------------------------------------+ renameInClientMod :: GHC.Name -> String -> GHC.Name -> TargetModule                   -> RefactGhc [ApplyRefacResult] renameInClientMod oldPN newName newNameGhc targetModule = do-      logm $ "renameInClientMod:(oldPN,newNameGhc,targetModule)=" ++ (showGhc (oldPN,newNameGhc,targetModule)) -- ++AZ++-      logm $ "renameInClientMod:(newNameGhc module)=" ++ (showGhc (GHC.nameModule newNameGhc)) -- ++AZ++-      getTargetGhc targetModule+    logm $ "renameInClientMod:(oldPN,newNameGhc,targetModule)=" ++ showGhc (oldPN,newNameGhc,targetModule) -- ++AZ+++    logm $ "renameInClientMod:(newNameGhc module)=" ++ showGhc (GHC.nameModule newNameGhc) -- ++AZ+++    getTargetGhc targetModule -      renamed <- getRefactRenamed-      modName <- getRefactModuleName+    renamed <- getRefactRenamed+    modName <- getRefactModuleName -      -- We need to find the old name in the module, and get it as a-      -- GHC.Name to know what to look for in the call to renamePN', as it-      -- checks the GHC.nameUnique value.-      -- gnames <- GHC.getNamesInScope-      -- let clientModule = GHC.nameModule oldPN-      -- let clientInscopes = filter (\n -> clientModule == GHC.nameModule n) gnames-      -- logm $ "renameInClientMod:(clientInscopes)=" ++ showGhcQual (clientInscopes)-      -- let newNames = filter (\n -> showGhcQual n == showGhcQual oldPN) clientInscopes-      newNames <- equivalentNameInNewMod oldPN-      logm $ "renameInClientMod:(newNames)=" ++ showGhcQual (newNames)+    -- We need to find the old name in the module, and get it as a+    -- GHC.Name to know what to look for in the call to renamePN', as it+    -- checks the GHC.nameUnique value.+    -- gnames <- GHC.getNamesInScope+    -- let clientModule = GHC.nameModule oldPN+    -- let clientInscopes = filter (\n -> clientModule == GHC.nameModule n) gnames+    -- logm $ "renameInClientMod:(clientInscopes)=" ++ showGhcQual (clientInscopes)+    -- let newNames = filter (\n -> showGhcQual n == showGhcQual oldPN) clientInscopes+    newNames <- equivalentNameInNewMod oldPN+    logm $ "renameInClientMod:(newNames)=" ++ showGhcQual newNames -      -- newNames       <- inScopeNames (showGhcQual oldPN)-      -- newNamesUnqual <- inScopeNames (showGhc     oldPN)-      -- logm $ "renameInClientMod:(newNamesUnqual,oldPN)=" ++ showGhcQual (newNamesUnqual,oldPN)-      -- logm $ "renameInClientMod:(newNames,oldPN)=" ++ showGhcQual (newNames,oldPN)-      -- logm $ "renameInClientMod:(uniques:newNames,oldPN)=" ++ showGhcQual (map GHC.nameUnique newNames,GHC.nameUnique oldPN)-      case newNames of+    -- newNames       <- inScopeNames (showGhcQual oldPN)+    -- newNamesUnqual <- inScopeNames (showGhc     oldPN)+    -- logm $ "renameInClientMod:(newNamesUnqual,oldPN)=" ++ showGhcQual (newNamesUnqual,oldPN)+    -- logm $ "renameInClientMod:(newNames,oldPN)=" ++ showGhcQual (newNames,oldPN)+    -- logm $ "renameInClientMod:(uniques:newNames,oldPN)=" ++ showGhcQual (map GHC.nameUnique newNames,GHC.nameUnique oldPN)+    case newNames of         []        -> return []-        [oldName] ->-          if findPN oldName renamed-             then doRenameInClientMod oldName modName renamed-             else do-               logm $ "renameInClientMod:name not present in module, returning"-               return []-        ns  -> error $ "HaRe:renameInClientMod:could not find name to replace,got:" ++ showGhcQual ns+        [oldName] | findPN oldName renamed -> doRenameInClientMod oldName modName renamed+                  | otherwise -> do+                      logm "renameInClientMod: name not present in module, returning"+                      return []+        ns -> error $ "HaRe: renameInClientMod: could not find name to replace, got:" ++ showGhcQual ns    where-     doRenameInClientMod oldNameGhc modName renamed = do+    doRenameInClientMod oldNameGhc modName renamed = do         -- There are two different tests we need to do here         -- 1. Does the new name clash with some existing name in the         --    client mod, in which case it must be qualified@@ -235,108 +239,96 @@         --    be qualified in the replacement, according to the import         isInScopeUnqual    <- isInScopeAndUnqualifiedGhc (nameToString oldPN) Nothing         isInScopeUnqualNew <- isInScopeAndUnqualifiedGhc newName              Nothing-        logm $ "renameInClientMod: (isInScopeAndUnqual,isInScopeUnqualNew)=" ++ (show (isInScopeUnqual,isInScopeUnqualNew)) -- ++AZ+++        logm $ "renameInClientMod: (isInScopeAndUnqual,isInScopeUnqualNew)=" +++               show (isInScopeUnqual, isInScopeUnqualNew) -- ++AZ+++         if isInScopeUnqualNew -- ++AZ++: should this be negated?-         then-          do-             -- (refactoredMod,_) <- applyRefac (refactRenameSimple oldPN newName newNameGhc True) RSAlreadyLoaded-             (refactoredMod,_) <- applyRefac (refactRenameSimple oldNameGhc newName newNameGhc True) RSAlreadyLoaded-             return [refactoredMod]-         else-          do-             if causeNameClashInExports oldPN newNameGhc modName renamed-               then error $"The new name will cause conflicting exports in module "++ show newName ++ ", please select another name!"-               else do-                 -- (refactoredMod,_) <- applyRefac (refactRenameComplex oldPN newName newNameGhc) RSAlreadyLoaded-                 (refactoredMod,_) <- applyRefac (refactRenameComplex oldNameGhc newName newNameGhc) RSAlreadyLoaded-                 -- TODO: implement rest of this-                 return [refactoredMod]+            then do+                (refactoredMod, _) <- applyRefac (refactRenameSimple oldNameGhc newName newNameGhc True)+                                                RSAlreadyLoaded+                return [refactoredMod]+            else do+                when (causeNameClashInExports oldPN newNameGhc modName renamed) .+                    error $ mconcat [ "The new name will cause conflicting exports in module"+                                    , show newName, ", please select another name!"]+                -- (refactoredMod,_) <- applyRefac (refactRenameComplex oldPN newName newNameGhc) RSAlreadyLoaded+                (refactoredMod, _) <- applyRefac (refactRenameComplex oldNameGhc newName newNameGhc)+                                                RSAlreadyLoaded+                -- TODO: implement rest of this+                return [refactoredMod] -     refactRenameSimple :: GHC.Name -> String -> GHC.Name -> Bool -> RefactGhc ()-     refactRenameSimple old newStr new useQual = do-       logm $ "refactRenameSimple:(old,newStr,new,useQual)=" ++ showGhc (old,newStr,new,useQual)-       qualifyTopLevelVar newStr-       parsed <- getRefactParsed-       parsed' <- renamePN old new useQual parsed-       putRefactParsed parsed' mempty-       return ()+    refactRenameSimple :: GHC.Name -> String -> GHC.Name -> Bool -> RefactGhc ()+    refactRenameSimple old newStr new useQual = do+        logm $ "refactRenameSimple:(old,newStr,new,useQual)=" ++ showGhc (old, newStr, new, useQual)+        qualifyTopLevelVar newStr+        parsed <- renamePN old new useQual =<< getRefactParsed+        putRefactParsed parsed mempty+        return () -     refactRenameComplex :: GHC.Name -> String -> GHC.Name -> RefactGhc ()-     refactRenameComplex old new newGhc = do-       logm $ "refactRenameComplex:(old,new,newGhc)=" ++ showGhc (old,new,newGhc)-       qualifyTopLevelVar new-       worker old new newGhc+    refactRenameComplex :: GHC.Name -> String -> GHC.Name -> RefactGhc ()+    refactRenameComplex old new newGhc = do+        logm $ "refactRenameComplex:(old,new,newGhc)=" ++ showGhc (old, new, newGhc)+        qualifyTopLevelVar new+        worker old new newGhc -     qualifyTopLevelVar :: String -> RefactGhc ()-     qualifyTopLevelVar new = do-       toQualify <- inScopeNames new-       logm $ "renameInClientMod.qualifyTopLevelVar:new:toQualify=" ++ (show new) ++ ":" ++ (showGhc toQualify)-       mapM_ qualifyToplevelName toQualify-       return ()+    qualifyTopLevelVar :: String -> RefactGhc ()+    qualifyTopLevelVar new = do+        toQualify <- inScopeNames new+        logm $ "renameInClientMod.qualifyTopLevelVar:new:toQualify=" ++ show new ++ ":" ++ showGhc toQualify+        mapM_ qualifyToplevelName toQualify+        return () -     worker :: GHC.Name -> String -> GHC.Name -> RefactGhc ()-     worker oldPN' newName' newNameGhc' = do-       logm $ "renameInClientMod.worker:(oldPN',newName',newNameGhc')=" ++ showGhc (oldPN',newName',newNameGhc')-       renamed <- getRefactRenamed-       parsed <- getRefactParsed-       isInScopeUnqualNew <- isInScopeAndUnqualifiedGhc newName' Nothing-       vs <- hsVisibleNames oldPN' renamed   --Does this check names other than variable names?-       logm $ "renameInClientMod.worker:(vs,oldPN',isInScopeUnqualNew)=" ++ showGhc (vs,oldPN',isInScopeUnqualNew)-       parsed' <- if elem newName' ((nub vs) \\ [nameToString oldPN'])  || isInScopeUnqualNew-         then renamePN oldPN' newNameGhc' True  parsed --rename to qualified Name-         else renamePN oldPN' newNameGhc' False parsed -- do not qualify-       putRefactParsed parsed' mempty-       return ()+    worker :: GHC.Name -> String -> GHC.Name -> RefactGhc ()+    worker oldPN' newName' newNameGhc' = do+        logm $ "renameInClientMod.worker:(oldPN',newName',newNameGhc')=" +++               showGhc (oldPN', newName', newNameGhc')+        isInScopeUnqualNew <- isInScopeAndUnqualifiedGhc newName' Nothing+        vs <- hsVisibleNames oldPN' =<< getRefactRenamed  -- Does this check names other than variable names?+        logm $ "renameInClientMod.worker:(vs,oldPN',isInScopeUnqualNew)=" +++               showGhc (vs, oldPN', isInScopeUnqualNew) +        parsed <- renamePN oldPN' newNameGhc'+                          (newName' `elem` (nub vs \\ [nameToString oldPN']) || isInScopeUnqualNew)+                          =<< getRefactParsed+        putRefactParsed parsed mempty+        return ()  causeAmbiguityInExports :: GHC.Name -> GHC.Name -> RefactGhc Bool-causeAmbiguityInExports old newName {- inscps -}  = do+causeAmbiguityInExports old newName {- inscps -} = do     (GHC.L _ (GHC.HsModule _ exps _imps _decls _ _)) <- getRefactParsed     isInScopeUnqual <- isInScopeAndUnqualifiedGhc (nameToString old) Nothing     let usedUnqual = usedWithoutQualR newName exps-    logm $ "causeAmbiguityInExports:(isInScopeUnqual,usedUnqual)" ++ (show (isInScopeUnqual,usedUnqual))+    logm $ "causeAmbiguityInExports:(isInScopeUnqual,usedUnqual)" ++ show (isInScopeUnqual, usedUnqual)     return (isInScopeUnqual && usedUnqual) - isValidNewName :: GHC.Name -> String -> String -> Bool isValidNewName oldName rdrNameStr newName = res- where-   doTest :: Bool -> Bool -> String -> Bool-   doTest isCategory isRightType errStr =-      if isCategory-         then if isRightType-               then True-               else error errStr-         else True+  where+    doTest :: Bool -> Bool -> String -> Bool+    doTest isCategory isRightType errStr = not isCategory || isRightType || error errStr -   tyconOk = doTest (GHC.isTyConName oldName)-                    (isConId newName)-                    "Invalid type constructor/class name!"+    tyconOk = doTest (GHC.isTyConName oldName) (isConId newName) "Invalid type constructor/class name!" -   dataConOk = doTest (GHC.isDataConName oldName)-                      (isConId newName)-                      "Invalid data constructor name!"+    dataConOk = doTest (GHC.isDataConName oldName) (isConId newName) "Invalid data constructor name!" -   tyVarOk = doTest (GHC.isTyVarName oldName)-                    (isVarId newName)-                    "Invalid type variable name!"+    tyVarOk = doTest (GHC.isTyVarName oldName) (isVarId newName) "Invalid type variable name!" -   oldName' = rdrNameStr-   matchNamesOk-     | {- GHC.isValName oldName || -} GHC.isVarName oldName-              = if isVarId oldName' && not (isVarId newName)-                   then error "The new name should be an identifier!"-                   else if isOperator oldName' && not (isOperator newName)-                          then error "The new name should be an operator!"-                          else if (isVarId oldName' && isVarId newName) ||-                                   (isOperator oldName' && isOperator newName)-                                  then True-                                  -- else error "Invalid new name!"-                                  else error $ "Invalid new name!" ++ (show (oldName',newName,isVarId oldName',isVarId newName,isOperator oldName',isOperator newName))-     | otherwise = True+    oldName' = rdrNameStr+    matchNamesOk+        | {- GHC.isValName oldName || -} GHC.isVarName oldName+        = if isVarId oldName' && not (isVarId newName)+              then error "The new name should be an identifier!"+              else if isOperator oldName' && not (isOperator newName)+                       then error "The new name should be an operator!"+                       else (isVarId oldName' && isVarId newName)+                         || (isOperator oldName' && isOperator newName)+                         || (error $ "Invalid new name!" ++ show ( oldName', newName+                                                                , isVarId oldName'+                                                                , isVarId newName+                                                                , isOperator oldName'+                                                                , isOperator newName ))+        | otherwise = True -   res = tyconOk && dataConOk {- && fieldOk && instanceOk -} &&-         tyVarOk && matchNamesOk+    res = tyconOk && dataConOk {- && fieldOk && instanceOk -} && tyVarOk && matchNamesOk  -- EOF-

@@ -16,7 +16,6 @@         -- * The bits that do the work        , runRefacSession-       , runRefactGhcCd        , applyRefac        , refactDone @@ -26,6 +25,9 @@        , clientModsAndFiles        , serverModsAndFiles +       , modifiedFiles+       , writeRefactoredFiles+        ) where  import Control.Exception@@ -198,7 +200,7 @@         , rsModule        = Nothing         } -  (refactoredMods,_s) <- runRefactGhcCd comp initialState opt+  (refactoredMods,_s) <- runRefactGhc comp initialState opt    let verbosity = rsetVerboseLevel (rsSettings initialState)   writeRefactoredFiles verbosity refactoredMods@@ -206,24 +208,6 @@  -- --------------------------------------------------------------------- -runRefactGhcCd ::-  RefactGhc a -> RefactState -> GM.Options -> IO (a, RefactState)-runRefactGhcCd comp initialState opt = do--  let-    runMain :: IO a -> IO a-    runMain progMain = do-      catches progMain [-        Handler $ \(GM.GMEWrongWorkingDirectory projDir _curDir) -> do-          cdAndDo projDir progMain-        ]--    fullComp = runRefactGhc comp initialState opt--  runMain fullComp---- ---------------------------------------------------------------------- cdAndDo :: FilePath -> IO a -> IO a cdAndDo path fn = do   old <- getCurrentDirectory@@ -467,4 +451,3 @@                  $ map summaryNodeSummary $ GHC.reachableG mg modNode    return serverMods-

@@ -354,7 +354,7 @@     it "naming clash at top level IdIn3" $ do      -- rename logTestSettings testOptions Nothing "./Renaming/IdIn3.hs" "foo" (10,1)      res <- catchException (ct $ rename defaultTestSettings testOptions "./Renaming/IdIn3.hs" "foo" (10,1))-     (show res) `shouldBe` "Just \"Name 'foo'  already existed\\n\""+     (show res) `shouldBe` "Just \"Name 'foo' already exists in this module\\n\""      -- --------------------------------- @@ -368,7 +368,7 @@     it "naming clash IdIn5" $ do      -- rename logTestSettings testOptions "./Renaming/IdIn5.hs" "y" (10,1)      res <- catchException (ct $ rename defaultTestSettings testOptions "./Renaming/IdIn5.hs" "y" (10,1))-     (show res) `shouldBe` "Just \"Name 'y'  already existed, or rename 'IdIn5.x' to 'y' will change the program's semantics!\\n\""+     (show res) `shouldBe` "Just \"Name 'y' already exists, or renaming 'IdIn5.x' to 'y' will change the program's semantics!\\n\""      -- --------------------------------- @@ -382,14 +382,14 @@     it "will not rename existing name Field2" $ do      -- rename logTestSettings testOptions Nothing "./Renaming/Field2.hs" "absPoint" (5,18)      res <- catchException (ct $ rename defaultTestSettings testOptions "./Renaming/Field2.hs" "absPoint" (5,18))-     (show res) `shouldBe` "Just \"Name 'absPoint'  already existed\\n\""+     (show res) `shouldBe` "Just \"Name 'absPoint' already exists in this module\\n\""      -- ---------------------------------      it "must qualify clashes Qualifier" $ do      -- rename logTestSettings testOptions "./Renaming/Qualifier.hs" "sum" (13,1)      res <- catchException (ct $ rename defaultTestSettings testOptions "./Renaming/Qualifier.hs" "sum" (13,1))-     (show res) `shouldBe` "Just \"The new name will cause ambiguous occurrence problem, please select another new name or qualify the use of ' sum' before renaming!\\n\""+     (show res) `shouldBe` "Just \"The new name will cause an ambiguous occurrence problem, please select another new name or qualify the use of 'sum' before renaming!\\n\""      -- --------------------------------- @@ -610,6 +610,6 @@      r' <- ct $ mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"Renaming/RenameInExportedType2.hs\"]"      -}- + -- --------------------------------------------------------------------- -- Helper functions

@@ -581,14 +581,15 @@   describe "directoryManagement" $ do     it "loads a file from a sub directory" $ do       t <- ct $ parsedFileGhc "./FreeAndDeclared/DeclareS.hs"+      fileName <- canonicalizePath "./test/testdata/FreeAndDeclared/DeclareS.hs"       let renamed = fromJust $ GHC.tm_renamed_source t       let         comp = do-          parseSourceFileGhc "./FreeAndDeclared/DeclareS.hs"+          parseSourceFileGhc fileName           r <- hsFreeAndDeclaredPNs renamed           return r       ((res),_s) <- cdAndDo "./test/testdata/FreeAndDeclared" $-                     runRefactGhcCd comp initialState testOptions+                     runRefactGhc comp initialState testOptions        -- Free Vars       (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (fst res)) `shouldBe` "[]"

@@ -4,7 +4,7 @@ Maintainer: Alan Zimmerman Cabal-Version: >= 1.10 Build-Type: Simple-Other-Extensions: CPP+-- Other-Extensions: CPP  Executable bcpp   Main-Is: BCpp.hs