HaRe 0.7.1.1 → 0.7.1.2

raw patch · 4 files changed

+41/−5 lines, 4 files

Files

• HaRe.cabal +1/−1
• src/Language/Haskell/Refact/MoveDef.hs +3/−3
• src/Language/Haskell/Refact/Utils.hs +35/−0
• src/Language/Haskell/Refact/Utils/Monad.hs +2/−1

@@ -1,5 +1,5 @@ Name:                           HaRe-Version:                        0.7.1.1+Version:                        0.7.1.2 Author:                         Chris Brown, Huiqing Li, Simon Thompson, Alan Zimmerman Maintainer:                     Alan Zimmerman Stability:                      Alpha

@@ -1466,12 +1466,12 @@          -- =applyTP (once_tdTP (failTP `adhocTP` worker))          = everywhereMStaged SYB.Renamer (SYB.mkM worker) bind             -- where worker ((HsMatch loc1 name pats rhs ds)::HsMatchP)-            where worker (GHC.Match pats1 typ rhs)+            where worker (GHC.Match pats2 typ rhs)                     = do                          let pats'=filter (\x->not ((patToPNT x /= Nothing) &&-                                          elem (gfromJust "rmParamsInDemotedDecls" $ patToPNT x) ps)) pats1+                                          elem (gfromJust "rmParamsInDemotedDecls" $ patToPNT x) ps)) pats2 -                         let (startPos,endPos) = getBiggestStartEndLoc pats1+                         let (startPos,endPos) = getBiggestStartEndLoc pats2                          -- error $ "rmParamsInDemotedDecls:(startPos,endPos)=" ++ (show (startPos,endPos)) -- ++AZ++                          -- error $ "rmParamsInDemotedDecls:(prettyprint pats')=" ++ (prettyprint pats) -- ++AZ++                          if (emptyList pats')

@@ -56,6 +56,7 @@ import Language.Haskell.Refact.Utils.TypeSyn import Language.Haskell.Refact.Utils.TypeUtils import System.Directory+import System.FilePath.Posix  import qualified Digraph       as GHC import qualified FastString    as GHC@@ -117,6 +118,13 @@ getModuleGhc targetFile = do   -- TODO: consult cached store of multiple module graphs, one for   --       each main file.+  mTarget <- identifyTargetModule targetFile+  case mTarget of+    Nothing -> return ()+    Just tm -> do+      activateModule tm+      return ()+   mm <- getModuleMaybe targetFile   case mm of     Just ms -> getModuleDetails ms@@ -124,12 +132,39 @@  -- --------------------------------------------------------------------- +identifyTargetModule :: FilePath -> RefactGhc (Maybe TargetModule)+identifyTargetModule targetFile = do+  currentDirectory <- liftIO getCurrentDirectory+  target1 <- liftIO $ canonicalizePath targetFile+  target2 <- liftIO $ canonicalizePath (combine currentDirectory targetFile)+  graphs <- gets rsModuleGraph++  let ff = catMaybes $ map (findInTarget target1 target2) graphs+  case ff of+    [] -> return Nothing+    ms -> return (Just (head ms))++findInTarget :: FilePath -> FilePath -> ([FilePath],GHC.ModuleGraph) -> Maybe TargetModule+findInTarget f1 f2 (fps,graph) = r+  where+    r = case filter (compModFiles f1 f2) graph of+          [] -> Nothing+          ms -> Just (fps,head ms)+    compModFiles :: FilePath-> FilePath -> GHC.ModSummary -> Bool+    compModFiles fileName1 fileName2 ms =+      case GHC.ml_hs_file $ GHC.ms_location ms of+        Nothing -> False+        Just fn -> fn == fileName1 || fn == fileName2++-- ---------------------------------------------------------------------+ -- | In the existing GHC session, put the requested TypeCheckedModule -- into the RefactGhc Monad, after ensuring that its originating -- target is the currently loaded one  activateModule :: TargetModule -> RefactGhc GHC.ModSummary activateModule (target, modSum) = do+  logm $ "activateModule:" ++ show (target,GHC.ms_mod modSum)   newModSum <- ensureTargetLoaded (target,modSum)   getModuleDetails newModSum   return newModSum

@@ -214,7 +214,8 @@                        [] -> return ()                        _ -> loadModuleGraphGhc (Just libTgts) -                     -- liftIO $ warningM "HaRe" $ "initGhcSession:loadModuleGraphGhc done"+                     -- moduleGraph <- gets rsModuleGraph+                     -- logm $ "initGhcSession:rsModuleGraph=" ++ (show moduleGraph)        Nothing -> do           let maybeMainFile = rsetMainFile settings