diff --git a/hsdev.cabal b/hsdev.cabal --- a/hsdev.cabal +++ b/hsdev.cabal @@ -1,5 +1,5 @@ name: hsdev -version: 0.3.3.1 +version: 0.3.3.2 synopsis: Haskell development library description: Haskell development library and tool with support of autocompletion, symbol info, go to declaration, find references, hayoo search etc. @@ -195,7 +195,7 @@ mtl >= 2.2.1 && < 2.3, network >= 3.0 && < 3.1, network-uri >= 2.6 && < 2.7, - optparse-applicative >= 0.12.1.0 && < 0.15, + optparse-applicative >= 0.12.1.0 && < 0.16, process >= 1.4.2.0 && < 1.7, regex-pcre-builtin >= 0.94.4 && < 0.95, scientific >= 0.3.4.9 && < 0.4, @@ -232,7 +232,7 @@ monad-loops >= 0.4.3 && < 0.5, mtl >= 2.2.1 && < 2.3, network >= 3.0 && < 3.1, - optparse-applicative >= 0.12.1.0 && < 0.15, + optparse-applicative >= 0.12.1.0 && < 0.16, process >= 1.4.2.0 && < 1.7, text >= 1.2.2.2 && < 1.3, transformers >= 0.5.2.0 && < 0.6, diff --git a/src/HsDev/Client/Commands.hs b/src/HsDev/Client/Commands.hs --- a/src/HsDev/Client/Commands.hs +++ b/src/HsDev/Client/Commands.hs @@ -467,31 +467,39 @@ fixRefacts' = fixCorrs' ^.. each . Tools.note newCorrs' = AutoFix.update fixRefacts' upCorrs' liftM concat $ mapM runFix files -runCommand (Rename nm newName fpath) = toValue $ do +runCommand (Rename nm newName mloc fpath) = toValue $ do m <- refineSourceModule fpath let mname = m ^. moduleId . moduleName - makeNote mloc r = Tools.Note { - Tools._noteSource = mloc, + makeNote loc r = Tools.Note { + Tools._noteSource = loc, Tools._noteRegion = r, Tools._noteLevel = Nothing, Tools._note = AutoFix.Refact "rename" (AutoFix.replace (AutoFix.fromRegion r) newName) } - defRenames <- do - -- FIXME: Doesn't take scope into account. If you have modules with same names in different project, it will rename symbols from both - defRegions <- query @_ @Region "select n.line, n.column, n.line_to, n.column_to from names as n, modules as m where m.id == n.module_id and m.name == ? and n.name == ? and def_line is not null;" ( - mname, - nm) - return $ map (makeNote (m ^. moduleId . moduleLocation)) defRegions - - usageRenames <- do - -- FIXME: Same as above: doesn't take scope into account - usageRegions <- query @_ @(Only Path :. Region) "select m.file, n.line, n.column, n.line_to, n.column_to from names as n, modules as m where n.module_id == m.id and m.file is not null and n.resolved_module == ? and n.resolved_name == ?;" ( - mname, - nm) - return $ map (\(Only p :. r) -> makeNote (FileModule p Nothing) r) usageRegions - - return $ defRenames ++ usageRenames + msum [ + do + topRegions <- query @_ @Region "select n.line, n.column, n.line_to, n.column_to from names as n, modules as m where m.id == n.module_id and m.name == ? and n.name == ? and ((n.def_line is not null and n.def_column is not null) or (n.def_line == ? and n.def_column == ?)) and n.symbol_id is not null;" ( + mname, + nm, + fmap fst mloc, + fmap snd mloc) + guard (not $ null topRegions) + let + defRenames = map (makeNote (m ^. moduleId . moduleLocation)) topRegions + usageRenames <- do + usageRegions <- query @_ @(Only Path :. Region) "select m.file, n.line, n.column, n.line_to, n.column_to from names as n, modules as m where n.module_id == m.id and m.file is not null and n.resolved_module == ? and n.resolved_name == ?;" ( + mname, + nm) + return $ map (\(Only p :. r) -> makeNote (FileModule p Nothing) r) usageRegions + return $ ordNub (defRenames ++ usageRenames), + do + localRegions <- query @_ @Region "select n.line, n.column, n.line_to, n.column_to from names as n, modules as m where m.id == n.module_id and m.name == ? and n.name == ? and n.def_line == ? and n.def_column == ? and n.symbol_id is null;" ( + mname, + nm, + fmap fst mloc, + fmap snd mloc) + return $ map (makeNote (m ^. moduleId . moduleLocation)) localRegions] runCommand (GhcEval exprs mfile) = toValue $ do mfile' <- traverse actualFileContents mfile case mfile' of diff --git a/src/HsDev/Server/Types.hs b/src/HsDev/Server/Types.hs --- a/src/HsDev/Server/Types.hs +++ b/src/HsDev/Server/Types.hs @@ -509,7 +509,11 @@ typesClear :: Bool } | AutoFix [Note OutputMessage] | Refactor [Note Refact] [Note Refact] Bool | - Rename Text Text Path | + Rename { + renameSymbol :: Text, + renameTo :: Text, + renameLocal :: Maybe (Int, Int), + renameContextFile :: Path } | GhcEval { ghcEvalExpressions :: [String], ghcEvalSource :: Maybe FileSource } | GhcType { ghcTypeExpressions :: [String], ghcTypeSource :: Maybe FileSource } | Langs | @@ -634,7 +638,7 @@ option readJSON (long "data" <> metavar "message" <> help "messages to fix") <*> option readJSON (long "rest" <> metavar "correction" <> short 'r' <> help "update corrections") <*> pureFlag), - cmd "rename" "get rename refactors" (Rename <$> textArgument idm <*> textArgument idm <*> ctx), + cmd "rename" "get rename refactors" (Rename <$> textArgument idm <*> textArgument idm <*> (liftA2 (,) <$> optional lineArg <*> optional columnArg) <*> ctx), cmd "ghc" "ghc commands" ( subparser (cmd "eval" "evaluate expression" (GhcEval <$> many (strArgument idm) <*> optional cmdP)) <|> subparser (cmd "type" "expression type" (GhcType <$> many (strArgument idm) <*> optional cmdP))), @@ -675,6 +679,7 @@ cabalFlag :: Parser Bool clearFlag :: Parser Bool +columnArg :: Parser Int contentsArg :: Parser Text ctx :: Parser Path depProjArg :: Parser Bool @@ -688,6 +693,7 @@ holdFlag :: Parser Bool inferFlag :: Parser Bool inspectionFlag :: Parser Bool +lineArg :: Parser Int lintOpts :: Parser [String] localsFlag :: Parser Bool moduleArg :: Parser Text @@ -703,6 +709,7 @@ cabalFlag = switch (long "cabal") clearFlag = switch (long "clear" <> short 'c' <> help "clear run, drop previous state") +columnArg = option auto (long "column" <> short 'c' <> help "column of symbol definition, required only for local symbols") contentsArg = textOption (long "contents" <> help "text contents") ctx = fileArg depProjArg = fmap not $ switch (long "no-project" <> help "don't scan related project") @@ -716,6 +723,7 @@ holdFlag = switch (long "hold" <> short 'h' <> help "don't return any response") inferFlag = switch (long "infer" <> help "infer types") inspectionFlag = switch (long "inspection" <> short 'i' <> help "return inspection data") +lineArg = option auto (long "line" <> short 'l' <> help "line of symbol definition, required only for local symbols") lintOpts = many (strOption (long "lint" <> metavar "option" <> short 'l' <> help "options for hlint")) localsFlag = switch (long "locals" <> short 'l' <> help "look in local declarations") moduleArg = textOption (long "module" <> metavar "name" <> short 'm' <> help "module name") @@ -796,7 +804,7 @@ toJSON (Types fs ghcs c) = cmdJson "types" ["files" .= fs, "ghc-opts" .= ghcs, "clear" .= c] toJSON (AutoFix ns) = cmdJson "autofixes" ["messages" .= ns] toJSON (Refactor ns rests pure') = cmdJson "refactor" ["messages" .= ns, "rest" .= rests, "pure" .= pure'] - toJSON (Rename n n' f) = cmdJson "rename" ["name" .= n, "new-name" .= n', "file" .= f] + toJSON (Rename n n' mloc f) = cmdJson "rename" ["name" .= n, "new-name" .= n', "line" .= fmap fst mloc, "column" .= fmap snd mloc, "file" .= f] toJSON (GhcEval exprs f) = cmdJson "ghc eval" ["exprs" .= exprs, "file" .= f] toJSON (GhcType exprs f) = cmdJson "ghc type" ["exprs" .= exprs, "file" .= f] toJSON Langs = cmdJson "langs" [] @@ -862,7 +870,7 @@ guardCmd "types" v *> (Types <$> v .::?! "files" <*> v .::?! "ghc-opts" <*> (v .:: "clear" <|> pure False)), guardCmd "autofixes" v *> (AutoFix <$> v .:: "messages"), guardCmd "refactor" v *> (Refactor <$> v .:: "messages" <*> v .::?! "rest" <*> (v .:: "pure" <|> pure True)), - guardCmd "rename" v *> (Rename <$> v .:: "name" <*> v .:: "new-name" <*> v .:: "file"), + guardCmd "rename" v *> (Rename <$> v .:: "name" <*> v .:: "new-name" <*> (liftA2 (,) <$> v .::? "line" <*> v .::? "column") <*> v .:: "file"), guardCmd "ghc eval" v *> (GhcEval <$> v .::?! "exprs" <*> v .::? "file"), guardCmd "ghc type" v *> (GhcType <$> v .::?! "exprs" <*> v .::? "file"), guardCmd "langs" v *> pure Langs, diff --git a/src/HsDev/Tools/Refact.hs b/src/HsDev/Tools/Refact.hs --- a/src/HsDev/Tools/Refact.hs +++ b/src/HsDev/Tools/Refact.hs @@ -23,6 +23,9 @@ _refactAction :: Replace Text } deriving (Eq, Show) +instance Ord Refact where + compare (Refact lmsg _) (Refact rmsg _) = compare lmsg rmsg + instance ToJSON Refact where toJSON (Refact msg cor) = object [ "message" .= msg, diff --git a/src/HsDev/Tools/Types.hs b/src/HsDev/Tools/Types.hs --- a/src/HsDev/Tools/Types.hs +++ b/src/HsDev/Tools/Types.hs @@ -48,6 +48,9 @@ makeLenses ''Note +instance Ord a => Ord (Note a) where + compare (Note lsrc lrgn llev lnote) (Note rsrc rrgn rlev rnote) = compare (lsrc, lrgn, llev, lnote) (rsrc, rrgn, rlev, rnote) + instance Functor Note where fmap f (Note s r l n) = Note s r l (f n)