HaRe 0.7.0.2 → 0.7.0.3
raw patch · 13 files changed
+139/−198 lines, 13 files
Files
- HaRe.cabal +3/−3
- elisp/hare.el +81/−81
- src/Language/Haskell/Refact/DupDef.hs +0/−1
- src/Language/Haskell/Refact/MoveDef.hs +1/−2
- src/Language/Haskell/Refact/SwapArgs.hs +6/−15
- src/Language/Haskell/Refact/Utils.hs +7/−23
- src/Language/Haskell/Refact/Utils/GhcUtils.hs +37/−13
- src/Language/Haskell/Refact/Utils/GhcVersionSpecific.hs +0/−1
- src/Language/Haskell/Refact/Utils/Monad.hs +1/−22
- src/Language/Haskell/Refact/Utils/RenamedSourceUtils.hs +0/−24
- src/Language/Haskell/Refact/Utils/TypeSyn.hs +0/−10
- src/Language/Haskell/Refact/Utils/TypeUtils.hs +1/−1
- src/MainHaRe.hs +2/−2
HaRe.cabal view
@@ -1,5 +1,5 @@ Name: HaRe-Version: 0.7.0.2+Version: 0.7.0.3 Author: Chris Brown, Huiqing Li, Simon Thompson, Alan Zimmerman Maintainer: Alan Zimmerman Stability: Alpha@@ -43,8 +43,8 @@ Category: Development, Refactoring Cabal-Version: >= 1.8 Build-Type: Simple-Data-Dir: . data-files: elisp/*.el+data-Dir: . Library Build-Depends: base >= 4.0 && < 4.7@@ -96,6 +96,7 @@ Executable ghc-hare -- Main-Is: Main.hs Main-Is: MainHaRe.hs+ -- Other-Modules: Paths_HaRe -- GHC-Options: -Wall -- GHC-Options: -prof -fprof-auto -rtsopts -caf-all Hs-Source-Dirs:@@ -124,7 +125,6 @@ , Strafunski-StrategyLib , syz , HaRe >= 0.7.0.0- -- Other-Modules: Paths_HaRe Extensions: CPP
elisp/hare.el view
@@ -218,24 +218,24 @@ ;; (car dirs) ;; nil)) -(defun log-search-result(curfilename logmsg)- (let ((dir (is-a-monitored-file curfilename)))- (if (equal nil dir)- nil- (cond- ((equal version-control-system 'ClearCase)- (add-logmsg-to-logfile-clearcase logmsg))- ((or (equal version-control-system 'Git)- (equal version-control-system 'SVN))- (write-to-refac-logfile dir logmsg "Clone Detection"))- (t nil)- ))))+;; (defun log-search-result(curfilename logmsg)+;; (let ((dir (is-a-monitored-file curfilename)))+;; (if (equal nil dir)+;; nil+;; (cond+;; ((equal version-control-system 'ClearCase)+;; (add-logmsg-to-logfile-clearcase logmsg))+;; ((or (equal version-control-system 'Git)+;; (equal version-control-system 'SVN))+;; (write-to-refac-logfile dir logmsg "Clone Detection"))+;; (t nil)+;; )))) -(defun add-logmsg-to-logfile-clearcase(logmsg)- "Add logmsg to the refactor log file which is stored in a clearase repository." - (run-hook-with-args 'before-commit-functions (list refactor-log-file) nil)- (run-hook-with-args 'after-commit-functions refactor-log-file logmsg)-)+;; (defun add-logmsg-to-logfile-clearcase(logmsg)+;; "Add logmsg to the refactor log file which is stored in a clearase repository." +;; (run-hook-with-args 'before-commit-functions (list refactor-log-file) nil)+;; (run-hook-with-args 'after-commit-functions refactor-log-file logmsg)+;; ) (defun prepare-to-commit() ";make sure the files are writeable when cleaecase is used as the repository."@@ -246,10 +246,10 @@ (defun commit() "commit the refactoring result."- (if (equal version-control-system 'ClearCase)- (prepare-to-commit)- nil- )+ ;; (if (equal version-control-system 'ClearCase)+ ;; (prepare-to-commit)+ ;; nil+ ;; ) (do-commit) ) @@ -746,7 +746,7 @@ (defun hare-menu-init() "Init HaRe menus." (interactive)- (define-key erlang-mode-map "\C-c\C-w_" 'hare-refactor-undo)+ ;; (define-key erlang-mode-map "\C-c\C-w_" 'hare-refactor-undo) ;; (define-key erlang-mode-map "\C-c\C-wb" 'erl-wrangler-code-inspector-var-instances) ;; (define-key erlang-mode-map "\C-c\C-we" 'remove-highlights) ;; (define-key erlang-mode-map "\C-c\C-wrv" 'erl-refactor-rename-var)@@ -793,65 +793,65 @@ 'undefined)) (t nil))) -(defun hare-refactor-undo()- "Undo the latest refactoring."- (interactive)- (let (buffer (current-buffer))- (if (y-or-n-p "Undo a refactoring will also undo the editings done after the refactoring, undo anyway?")- (progn- (if (equal version-control-system 'ClearCase)- nil- ;; (erl-spawn- ;; (erl-send-rpc wrangler-erl-node 'wrangler_undo_server 'files_to_change (list))- ;; (erl-receive (buffer)- ;; ((['rex ['badrpc rsn]]- ;; (message "Undo failed: %S" rsn))- ;; (['rex ['error rsn]]- ;; (message "Undo failed: %s" rsn))- ;; (['rex ['ok files-to-recover filenames-to-recover]]- ;; (progn- ;; (setq files-to-write files-to-recover)- ;; (setq files-to-rename filenames-to-recover)- ;; (prepare-to-commit) )))))- nil- )- ;; (erl-spawn- ;; (erl-send-rpc wrangler-erl-node 'wrangler_undo_server 'undo_emacs (list))- ;; (erl-receive (buffer)- ;; ((['rex ['badrpc rsn]]- ;; (message "Undo failed: %S" rsn))- ;; (['rex ['error rsn]]- ;; (message "Undo failed: %s" rsn))- ;; (['rex ['ok modified1 logmsg curfile]]- ;; (dolist (f modified1)- ;; (let ((oldfilename (car f))- ;; (newfilename (car (cdr f)))- ;; (buffer (get-file-buffer-1 (car (cdr f)))))- ;; (if buffer (if (not (equal oldfilename newfilename))- ;; (with-current-buffer buffer- ;; (progn (set-visited-file-name oldfilename)- ;; (revert-buffer nil t t)))- ;; (with-current-buffer buffer (revert-buffer nil t t)))- ;; nil)))- ;; (let ((dir (is-a-monitored-file curfile)))- ;; (if (equal nil dir)- ;; nil- ;; (cond- ;; ((equal version-control-system 'ClearCase)- ;; (let* ((reason (read-string "Reason for undo: " nil nil "" nil))- ;; (new-logmsg (concat "UNDO: " logmsg "Reason: " reason "\n")))- ;; (add-logmsg-to-logfile-clearcase new-logmsg)))- ;; ((or (equal version-control-system 'Git)- ;; (equal version-control-system 'SVN))- ;; (let ((reason (read-string "Reason for undo: " nil nil "" nil)))- ;; (write-to-refac-logfile dir (concat "UNDO: " logmsg "Reason: " reason "\n") "UNDO"))- ;; )- ;; (t nil))- ;; (message "Undo succeeded")))))))- )- (message "Undo aborted."))- )- )+;; (defun hare-refactor-undo()+;; "Undo the latest refactoring."+;; (interactive)+;; (let (buffer (current-buffer))+;; (if (y-or-n-p "Undo a refactoring will also undo the editings done after the refactoring, undo anyway?")+;; (progn+;; ;; (if (equal version-control-system 'ClearCase)+;; ;; nil+;; ;; ;; (erl-spawn+;; ;; ;; (erl-send-rpc wrangler-erl-node 'wrangler_undo_server 'files_to_change (list))+;; ;; ;; (erl-receive (buffer)+;; ;; ;; ((['rex ['badrpc rsn]]+;; ;; ;; (message "Undo failed: %S" rsn))+;; ;; ;; (['rex ['error rsn]]+;; ;; ;; (message "Undo failed: %s" rsn))+;; ;; ;; (['rex ['ok files-to-recover filenames-to-recover]]+;; ;; ;; (progn+;; ;; ;; (setq files-to-write files-to-recover)+;; ;; ;; (setq files-to-rename filenames-to-recover)+;; ;; ;; (prepare-to-commit) )))))+;; ;; nil+;; ;; )+;; ;; (erl-spawn+;; ;; (erl-send-rpc wrangler-erl-node 'wrangler_undo_server 'undo_emacs (list))+;; ;; (erl-receive (buffer)+;; ;; ((['rex ['badrpc rsn]]+;; ;; (message "Undo failed: %S" rsn))+;; ;; (['rex ['error rsn]]+;; ;; (message "Undo failed: %s" rsn))+;; ;; (['rex ['ok modified1 logmsg curfile]]+;; ;; (dolist (f modified1)+;; ;; (let ((oldfilename (car f))+;; ;; (newfilename (car (cdr f)))+;; ;; (buffer (get-file-buffer-1 (car (cdr f)))))+;; ;; (if buffer (if (not (equal oldfilename newfilename))+;; ;; (with-current-buffer buffer+;; ;; (progn (set-visited-file-name oldfilename)+;; ;; (revert-buffer nil t t)))+;; ;; (with-current-buffer buffer (revert-buffer nil t t)))+;; ;; nil)))+;; ;; (let ((dir (is-a-monitored-file curfile)))+;; ;; (if (equal nil dir)+;; ;; nil+;; ;; (cond+;; ;; ((equal version-control-system 'ClearCase)+;; ;; (let* ((reason (read-string "Reason for undo: " nil nil "" nil))+;; ;; (new-logmsg (concat "UNDO: " logmsg "Reason: " reason "\n")))+;; ;; (add-logmsg-to-logfile-clearcase new-logmsg)))+;; ;; ((or (equal version-control-system 'Git)+;; ;; (equal version-control-system 'SVN))+;; ;; (let ((reason (read-string "Reason for undo: " nil nil "" nil)))+;; ;; (write-to-refac-logfile dir (concat "UNDO: " logmsg "Reason: " reason "\n") "UNDO"))+;; ;; )+;; ;; (t nil))+;; ;; (message "Undo succeeded")))))))+;; )+;; (message "Undo aborted."))+;; )+;; ) (defun preview-commit-cancel(current-file-name modified renamed)
src/Language/Haskell/Refact/DupDef.hs view
@@ -12,7 +12,6 @@ import Data.Maybe import Language.Haskell.GhcMod-import Language.Haskell.GhcMod.Internal import Language.Haskell.Refact.Utils import Language.Haskell.Refact.Utils.GhcUtils import Language.Haskell.Refact.Utils.GhcVersionSpecific
src/Language/Haskell/Refact/MoveDef.hs view
@@ -27,7 +27,6 @@ import Data.Maybe import Language.Haskell.GhcMod-import Language.Haskell.GhcMod.Internal import Language.Haskell.Refact.Utils import Language.Haskell.Refact.Utils.GhcUtils import Language.Haskell.Refact.Utils.GhcVersionSpecific@@ -44,7 +43,7 @@ -- --------------------------------------------------------------------- -data Direction = UptoTopLevel | UpOneLevel | Down+-- data Direction = UptoTopLevel | UpOneLevel | Down {--------This function handles refactorings involving moving a definition--------
src/Language/Haskell/Refact/SwapArgs.hs view
@@ -1,34 +1,25 @@ {-# LANGUAGE ScopedTypeVariables #-} module Language.Haskell.Refact.SwapArgs (swapArgs) where -import qualified Data.Generics.Schemes as SYB+-- import qualified Data.Generics.Schemes as SYB import qualified Data.Generics.Aliases as SYB import qualified GHC.SYB.Utils as SYB import qualified FastString as GHC import qualified Name as GHC import qualified GHC-import qualified DynFlags as GHC-import qualified Outputable as GHC-import qualified MonadUtils as GHC-import qualified RdrName as GHC-import qualified OccName as GHC--import GHC.Paths ( libdir )-import Control.Monad-import Control.Monad.State-import Data.Data-import Data.Maybe+-- import qualified DynFlags as GHC+-- import qualified Outputable as GHC+-- import qualified MonadUtils as GHC+-- import qualified RdrName as GHC+-- import qualified OccName as GHC import Language.Haskell.GhcMod-import Language.Haskell.GhcMod.Internal import Language.Haskell.Refact.Utils import Language.Haskell.Refact.Utils.GhcUtils import Language.Haskell.Refact.Utils.LocUtils import Language.Haskell.Refact.Utils.Monad import Language.Haskell.Refact.Utils.MonadFunctions--- import Language.Haskell.Refact.Utils.TokenUtils--- import Language.Haskell.Refact.Utils.TypeSyn import Language.Haskell.Refact.Utils.TypeUtils import Debug.Trace
src/Language/Haskell/Refact/Utils.hs view
@@ -54,36 +54,16 @@ import Language.Haskell.Refact.Utils.TypeUtils import System.Directory --- import qualified Bag as GHC--- import qualified BasicTypes as GHC--- import qualified Coercion as GHC import qualified Digraph as GHC import qualified DynFlags as GHC--- import qualified ErrUtils as GHC import qualified FastString as GHC--- import qualified ForeignCall as GHC import qualified GHC--- import qualified GHC as GHC--- import qualified GHC.Paths as GHC--- import qualified HsSyn as GHC--- import qualified InstEnv as GHC--- import qualified Module as GHC--- import qualified MonadUtils as GHC--- import qualified NameSet as GHC--- import qualified OccName as GHC import qualified Outputable as GHC--- import qualified RdrName as GHC--- import qualified SrcLoc as GHC--- import qualified StaticFlags as GHC--- import qualified TcEvidence as GHC--- import qualified TcType as GHC--- import qualified TypeRep as GHC--- import qualified Var as GHC import qualified Data.Generics as SYB import qualified GHC.SYB.Utils as SYB -import Debug.Trace+-- import Debug.Trace -- --------------------------------------------------------------------- @@ -115,6 +95,7 @@ -- --------------------------------------------------------------------- +pwd :: IO FilePath pwd = getCurrentDirectory -- ---------------------------------------------------------------------@@ -150,7 +131,9 @@ case maybeTargetFile of Just targetFile -> do -- Prefix with * to force interpretation, for inscopes- target <- GHC.guessTarget ("*" ++ targetFile) Nothing+ -- target <- GHC.guessTarget ("*" ++ targetFile) Nothing+ -- NOTE: does not seem to be required+ target <- GHC.guessTarget (targetFile) Nothing GHC.setTargets [target] GHC.load GHC.LoadAllTargets return ()@@ -222,11 +205,12 @@ let [(_,modSum)] = mm getModuleDetails modSum -+{- getExports (GHC.L _ hsmod) = case hsmod of GHC.HsModule _ (Just exports) _ _ _ _ -> exports _ -> []+-} -- ---------------------------------------------------------------------
src/Language/Haskell/Refact/Utils/GhcUtils.hs view
@@ -56,9 +56,11 @@ import Control.Monad import Data.Data import Data.Maybe-import GHC-import NameSet +import qualified GHC as GHC+import qualified HsTypes as GHC+import qualified NameSet as GHC+ import Data.Generics.Strafunski.StrategyLib.StrategyLib import qualified Data.Generics.Zipper as Z@@ -167,13 +169,24 @@ -- | Checks whether the current item is undesirable for analysis in the current -- AST Stage.-checkItemStage :: Typeable a => SYB.Stage -> a -> Bool-checkItemStage stage x = (const False `SYB.extQ` postTcType `SYB.extQ` fixity `SYB.extQ` nameSet) x- where nameSet = const (stage `elem` [SYB.Parser,SYB.TypeChecker]) :: NameSet -> Bool- postTcType = const (stage < SYB.TypeChecker ) :: GHC.PostTcType -> Bool- fixity = const (stage < SYB.Renamer ) :: GHC.Fixity -> Bool+checkItemStage :: (Typeable a, Data a) => SYB.Stage -> a -> Bool+checkItemStage stage x = (checkItemStage1 stage x) || (checkItemStage2 stage x) -checkItemRenamer :: Typeable a => a -> Bool+-- Check the Typeable items+checkItemStage1 :: (Typeable a) => SYB.Stage -> a -> Bool+checkItemStage1 stage x = (const False `SYB.extQ` postTcType `SYB.extQ` fixity `SYB.extQ` nameSet) x+ where nameSet = const (stage `elem` [SYB.Parser,SYB.TypeChecker]) :: GHC.NameSet -> Bool+ postTcType = const (stage < SYB.TypeChecker ) :: GHC.PostTcType -> Bool+ fixity = const (stage < SYB.Renamer ) :: GHC.Fixity -> Bool++-- | Check the Typeable1 items+checkItemStage2 :: Data a => SYB.Stage -> a -> Bool+checkItemStage2 stage x = (const False `SYB.ext1Q` hsWithBndrs) x+ where+ hsWithBndrs = const (stage < SYB.Renamer) :: GHC.HsWithBndrs a -> Bool+++checkItemRenamer :: (Data a, Typeable a) => a -> Bool checkItemRenamer x = checkItemStage SYB.Renamer x @@ -242,10 +255,19 @@ checkItemStage' :: forall m. (MonadPlus m) => SYB.Stage -> TU () m checkItemStage' stage = failTU `adhocTU` postTcType `adhocTU` fixity `adhocTU` nameSet- where nameSet = const (guard $ stage `elem` [SYB.Parser,SYB.TypeChecker]) :: NameSet -> m ()+ where nameSet = const (guard $ stage `elem` [SYB.Parser,SYB.TypeChecker]) :: GHC.NameSet -> m () postTcType = const (guard $ stage<SYB.TypeChecker) :: GHC.PostTcType -> m () fixity = const (guard $ stage<SYB.Renamer) :: GHC.Fixity -> m () +{-+-- | Check the Typeable1 items+checkItemStage2' :: forall m. (MonadPlus m) => SYB.Stage -> TU () m+checkItemStage2' stage x = failTU `adhocTU` hsWithBndrs+ where+ hsWithBndrs :: (Data t) => GHC.HsWithBndrs t -> m ()+ hsWithBndrs = const (guard $ stage < SYB.Renamer)+-}+ checkItemRenamer' :: (MonadPlus m) => TU () m checkItemRenamer' = checkItemStage' SYB.Renamer @@ -305,17 +327,21 @@ | isJust maybeNameSet = checkItemStage stage (fromJust maybeNameSet) | isJust maybePostTcType = checkItemStage stage (fromJust maybePostTcType) | isJust maybeFixity = checkItemStage stage (fromJust maybeFixity)+ -- | isJust maybeHsWithBndrs = checkItemStage stage (fromJust maybeHsWithBndrs) | otherwise = False where- maybeNameSet :: Maybe NameSet+ maybeNameSet :: Maybe GHC.NameSet maybeNameSet = Z.getHole z - maybePostTcType :: Maybe PostTcType+ maybePostTcType :: Maybe GHC.PostTcType maybePostTcType = Z.getHole z maybeFixity :: Maybe GHC.Fixity maybeFixity = Z.getHole z + -- maybeHsWithBndrs :: (Data b) => Maybe (GHC.HsWithBndrs b)+ -- maybeHsWithBndrs = Z.getHole z+ -- --------------------------------------------------------------------- -- | Climb the tree until a predicate holds@@ -369,6 +395,4 @@ [(zz,t)] -> t stage zz _ -> return z return z'--
src/Language/Haskell/Refact/Utils/GhcVersionSpecific.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE CPP #-} - -- |This module contains all the code that depends on a specific -- version of GHC, and should be the only one requiring CPP module Language.Haskell.Refact.Utils.GhcVersionSpecific
src/Language/Haskell/Refact/Utils/Monad.hs view
@@ -27,31 +27,10 @@ import Exception import qualified Control.Monad.IO.Class as MU --- import qualified Bag as GHC--- import qualified BasicTypes as GHC--- import qualified Coercion as GHC--- import qualified Digraph as GHC-import qualified DynFlags as GHC--- import qualified ErrUtils as GHC--- import qualified FastString as GHC--- import qualified ForeignCall as GHC import qualified GHC as GHC import qualified GHC.Paths as GHC import qualified GhcMonad as GHC--- import qualified HsSyn as GHC--- import qualified InstEnv as GHC--- import qualified Module as GHC import qualified MonadUtils as GHC--- import qualified NameSet as GHC--- import qualified OccName as GHC--- import qualified Outputable as GHC--- import qualified RdrName as GHC--- import qualified SrcLoc as GHC--- import qualified StaticFlags as GHC--- import qualified TcEvidence as GHC--- import qualified TcType as GHC--- import qualified TypeRep as GHC--- import qualified Var as GHC import Data.List import Language.Haskell.GhcMod@@ -191,7 +170,7 @@ , lineSeparator = LineSeparator "\n" } _readLog <- initializeFlagsWithCradle opt cradle (options settings) True- -- setTargetFile fileName+ -- setTargetFile fileNames -- checkSlowAndSet void $ GHC.load GHC.LoadAllTargets -- liftIO readLog
src/Language/Haskell/Refact/Utils/RenamedSourceUtils.hs view
@@ -9,32 +9,8 @@ ) where -- Modules from GHC-import qualified Bag as GHC-import qualified BasicTypes as GHC-import qualified Coercion as GHC-import qualified HsDecls as GHC-import qualified Digraph as GHC-import qualified DynFlags as GHC-import qualified ErrUtils as GHC-import qualified FastString as GHC-import qualified ForeignCall as GHC import qualified GHC as GHC-import qualified GHC.Paths as GHC-import qualified HsPat as GHC-import qualified HsSyn as GHC-import qualified InstEnv as GHC-import qualified Module as GHC-import qualified MonadUtils as GHC-import qualified Name as GHC import qualified NameSet as GHC-import qualified OccName as GHC-import qualified Outputable as GHC-import qualified RdrName as GHC-import qualified SrcLoc as GHC-import qualified TcEvidence as GHC-import qualified TcType as GHC-import qualified TypeRep as GHC-import qualified Var as GHC import qualified Data.Generics as SYB import qualified GHC.SYB.Utils as SYB
src/Language/Haskell/Refact/Utils/TypeSyn.hs view
@@ -12,21 +12,11 @@ -- Modules from GHC--- import qualified FastString as GHC import qualified GHC as GHC--- import qualified GhcMonad as GHC--- import qualified HsExpr as GHC import qualified Name as GHC import qualified Outputable as GHC--- import qualified RdrName as GHC--- import qualified SrcLoc as GHC -- import Data.Generics---- showGhc :: a -> String--- showGhc a = error "showGhc undefined" {-
src/Language/Haskell/Refact/Utils/TypeUtils.hs view
@@ -431,7 +431,7 @@ GHC.IEVar _ -> True _ -> False - modIsUnQualifedImported mod' modName+ modIsUnQualifedImported _mod' modName =let -- imps =hsModImports mod -- imp@(GHC.L _ (GHC.ImportDecl (GHC.L _ modName) qualify _source _safe isQualified _isImplicit as h)) in isJust $ find (\(GHC.L _ (GHC.ImportDecl (GHC.L _ modName1) _qualify _source _safe isQualified _isImplicit _as _h))
src/MainHaRe.hs view
@@ -87,7 +87,7 @@ , Option "s" ["sandbox"] (ReqArg (\s opts -> opts { rsetSandbox = Just s }) "path") "specify cabal-dev sandbox (default 'cabal-dev`)"- , Option "v" ["verbosw"]+ , Option "v" ["verbose"] (NoArg (\opts -> opts { rsetVerboseLevel = Debug })) "debug logging on" ]@@ -146,7 +146,7 @@ -- rename wants FilePath -> String -> SimpPos "rename" -> runFunc $ rename opt cradle cmdArg1 cmdArg2 (parseSimpPos cmdArg3 cmdArg4) - "show" -> putStr (show (opt,cradle))+ "show" -> putStrLn (show (opt,cradle)) cmd -> throw (NoSuchCommand cmd) putStr (show res)