fd163cd · ghcide · git.iko.soy

git.iko.soy/ghcide

on master help sign in

Insert imports code action (#295)

fd163cdPepe Iborra7 years ago

src/Development/IDE/LSP/CodeAction.hs+81−7

compare with master

unifiedsplit

@@ -16,6 +16,7 @@ import Development.IDE.GHC.Compat

16import Development.IDE.Core.Rules

17import Development.IDE.Core.RuleTypes

18import Development.IDE.Core.Shake

19+import Development.IDE.GHC.Error

19import Development.IDE.LSP.Server

20import Development.IDE.LSP.Server

20import Development.IDE.Types.Location

21import Development.IDE.Types.Location

21import qualified Data.HashMap.Strict as Map

22import qualified Data.HashMap.Strict as Map

@@ -85,8 +86,22 @@ executeAddSignatureCommand _lsp _ideState ExecuteCommandParams{..}

85 | otherwise

86 | otherwise

86 = return (Null, Nothing)

87 = return (Null, Nothing)

88−suggestAction :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]

89+suggestAction :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]

90+suggestAction text diag = concat

91+ [ suggestAddExtension diag

92+ , suggestExtendImport text diag

93+ , suggestFillHole diag

94+ , suggestFillTypeWildcard diag

95+ , suggestFixConstructorImport text diag

96+ , suggestModuleTypo diag

97+ , suggestRemoveRedundantImport text diag

98+ , suggestReplaceIdentifier text diag

99+ , suggestSignature True diag

100+ ]

101+

102+

103+suggestRemoveRedundantImport :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]

89−suggestAction contents diag@Diagnostic{_range=_range@Range{..},..}

104+suggestRemoveRedundantImport contents Diagnostic{_range=_range@Range{..},..}

90-- The qualified import of ‘many’ from module ‘Control.Applicative’ is redundant

105-- The qualified import of ‘many’ from module ‘Control.Applicative’ is redundant

91 | Just [_, bindings] <- matchRegex _message "The( qualified)? import of ‘([^’]*)’ from module [^ ]* is redundant"

106 | Just [_, bindings] <- matchRegex _message "The( qualified)? import of ‘([^’]*)’ from module [^ ]* is redundant"

92 , Just c <- contents

107 , Just c <- contents

@@ -100,7 +115,10 @@ suggestAction contents diag@Diagnostic{_range=_range@Range{..},..}

100-- To import instances alone, use: import Data.List()

115-- To import instances alone, use: import Data.List()

101 | _message =~ ("The( qualified)? import of [^ ]* is redundant" :: String)

116 | _message =~ ("The( qualified)? import of [^ ]* is redundant" :: String)

102 = [("Remove import", [TextEdit (extendToWholeLineIfPossible contents _range) ""])]

117 = [("Remove import", [TextEdit (extendToWholeLineIfPossible contents _range) ""])]

118+ | otherwise = []

103

119

120+suggestReplaceIdentifier :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]

121+suggestReplaceIdentifier contents Diagnostic{_range=_range@Range{..},..}

104-- File.hs:52:41: error:

122-- File.hs:52:41: error:

105-- * Variable not in scope:

123-- * Variable not in scope:

106-- suggestAcion :: Maybe T.Text -> Range -> Range

124-- suggestAcion :: Maybe T.Text -> Range -> Range

@@ -114,7 +132,10 @@ suggestAction contents diag@Diagnostic{_range=_range@Range{..},..}

114-- Module ‘Data.Text’ does not export ‘isPrfixOf’.

132-- Module ‘Data.Text’ does not export ‘isPrfixOf’.

115 | renameSuggestions@(_:_) <- extractRenamableTerms _message

133 | renameSuggestions@(_:_) <- extractRenamableTerms _message

116 = [ ("Replace with ‘" <> name <> "’", [mkRenameEdit contents _range name]) | name <- renameSuggestions ]

134 = [ ("Replace with ‘" <> name <> "’", [mkRenameEdit contents _range name]) | name <- renameSuggestions ]

135+ | otherwise = []

117

136

137+suggestFillTypeWildcard :: Diagnostic -> [(T.Text, [TextEdit])]

138+suggestFillTypeWildcard Diagnostic{_range=_range@Range{..},..}

118-- Foo.hs:3:8: error:

139-- Foo.hs:3:8: error:

119-- * Found type wildcard `_' standing for `p -> p1 -> p'

140-- * Found type wildcard `_' standing for `p -> p1 -> p'

120

141

@@ -122,7 +143,10 @@ suggestAction contents diag@Diagnostic{_range=_range@Range{..},..}

122 , " standing for " `T.isInfixOf` _message

143 , " standing for " `T.isInfixOf` _message

123 , typeSignature <- extractWildCardTypeSignature _message

144 , typeSignature <- extractWildCardTypeSignature _message

124 = [("Use type signature: ‘" <> typeSignature <> "’", [TextEdit _range typeSignature])]

145 = [("Use type signature: ‘" <> typeSignature <> "’", [TextEdit _range typeSignature])]

146+ | otherwise = []

125

147

148+suggestAddExtension :: Diagnostic -> [(T.Text, [TextEdit])]

149+suggestAddExtension Diagnostic{_range=_range@Range{..},..}

126-- File.hs:22:8: error:

150-- File.hs:22:8: error:

127-- Illegal lambda-case (use -XLambdaCase)

151-- Illegal lambda-case (use -XLambdaCase)

128-- File.hs:22:6: error:

152-- File.hs:22:6: error:

@@ -145,7 +169,10 @@ suggestAction contents diag@Diagnostic{_range=_range@Range{..},..}

145-- In the instance declaration for `Unit (m a)'

169-- In the instance declaration for `Unit (m a)'

146 | exts@(_:_) <- filter (`Set.member` ghcExtensions) $ T.split (not . isAlpha) $ T.replace "-X" "" _message

170 | exts@(_:_) <- filter (`Set.member` ghcExtensions) $ T.split (not . isAlpha) $ T.replace "-X" "" _message

147 = [("Add " <> x <> " extension", [TextEdit (Range (Position 0 0) (Position 0 0)) $ "{-# LANGUAGE " <> x <> " #-}\n"]) | x <- exts]

171 = [("Add " <> x <> " extension", [TextEdit (Range (Position 0 0) (Position 0 0)) $ "{-# LANGUAGE " <> x <> " #-}\n"]) | x <- exts]

172+ | otherwise = []

148

173

174+suggestModuleTypo :: Diagnostic -> [(T.Text, [TextEdit])]

175+suggestModuleTypo Diagnostic{_range=_range@Range{..},..}

149-- src/Development/IDE/Core/Compile.hs:58:1: error:

176-- src/Development/IDE/Core/Compile.hs:58:1: error:

150-- Could not find module ‘Data.Cha’

177-- Could not find module ‘Data.Cha’

151-- Perhaps you meant Data.Char (from base-4.12.0.0)

178-- Perhaps you meant Data.Char (from base-4.12.0.0)

@@ -154,7 +181,10 @@ suggestAction contents diag@Diagnostic{_range=_range@Range{..},..}

154 findSuggestedModules = map (head . T.words) . drop 2 . T.lines

181 findSuggestedModules = map (head . T.words) . drop 2 . T.lines

155 proposeModule mod = ("replace with " <> mod, [TextEdit _range mod])

182 proposeModule mod = ("replace with " <> mod, [TextEdit _range mod])

156 in map proposeModule $ nubOrd $ findSuggestedModules _message

183 in map proposeModule $ nubOrd $ findSuggestedModules _message

184+ | otherwise = []

157

185

186+suggestFillHole :: Diagnostic -> [(T.Text, [TextEdit])]

187+suggestFillHole Diagnostic{_range=_range@Range{..},..}

158-- ...Development/IDE/LSP/CodeAction.hs:103:9: warning:

188-- ...Development/IDE/LSP/CodeAction.hs:103:9: warning:

159-- * Found hole: _ :: Int -> String

189-- * Found hole: _ :: Int -> String

160-- * In the expression: _

190-- * In the expression: _

@@ -187,9 +217,36 @@ suggestAction contents diag@Diagnostic{_range=_range@Range{..},..}

187 extractFitNames = map (T.strip . head . T.splitOn " :: ")

217 extractFitNames = map (T.strip . head . T.splitOn " :: ")

188 in map proposeHoleFit $ nubOrd $ findSuggestedHoleFits _message

218 in map proposeHoleFit $ nubOrd $ findSuggestedHoleFits _message

189

219

190− | tlb@[_] <- suggestSignature True diag = tlb

220+ | otherwise = []

191

221

192−suggestAction _ _ = []

222+suggestExtendImport :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]

223+suggestExtendImport contents Diagnostic{_range=_range,..}

224+ | Just [binding, mod, srcspan] <-

225+ matchRegex _message

226+ "Perhaps you want to add ‘([^’]*)’ to the import list in the import of ‘([^’]*)’ *\$(.*)\$.$"

227+ , Just c <- contents

228+ = let range = case [ x | (x,"") <- readSrcSpan (T.unpack srcspan)] of

229+ [s] -> let x = srcSpanToRange s

230+ in x{_end = (_end x){_character = succ (_character (_end x))}}

231+ _ -> error "bug in srcspan parser"

232+ importLine = textInRange range c

233+ in [("Add " <> binding <> " to the import list of " <> mod

234+ , [TextEdit range (addBindingToImportList binding importLine)])]

235+ | otherwise = []

236+

237+suggestFixConstructorImport :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]

238+suggestFixConstructorImport _ Diagnostic{_range=_range,..}

239+ -- ‘Success’ is a data constructor of ‘Result’

240+ -- To import it use

241+ -- import Data.Aeson.Types( Result( Success ) )

242+ -- or

243+ -- import Data.Aeson.Types( Result(..) ) (lsp-ui)

244+ | Just [constructor, typ] <-

245+ matchRegex _message

246+ "‘([^’]*)’ is a data constructor of ‘([^’]*)’ To import it use"

247+ = let fixedImport = typ <> "(" <> constructor <> ")"

248+ in [("Fix import of " <> fixedImport, [TextEdit _range fixedImport])]

249+ | otherwise = []

193

250

194suggestSignature :: Bool -> Diagnostic -> [(T.Text, [TextEdit])]

251suggestSignature :: Bool -> Diagnostic -> [(T.Text, [TextEdit])]

195suggestSignature isQuickFix Diagnostic{_range=_range@Range{..},..}

252suggestSignature isQuickFix Diagnostic{_range=_range@Range{..},..}

@@ -282,6 +339,7 @@ splitTextAtPosition (Position row col) x

282 = (T.intercalate "\n" $ preRow ++ [preCol], T.intercalate "\n" $ postCol : postRow)

339 = (T.intercalate "\n" $ preRow ++ [preCol], T.intercalate "\n" $ postCol : postRow)

283 | otherwise = (x, T.empty)

340 | otherwise = (x, T.empty)

284

341

342+-- | Returns [start .. end[

285textInRange :: Range -> T.Text -> T.Text

343textInRange :: Range -> T.Text -> T.Text

286textInRange (Range (Position startRow startCol) (Position endRow endCol)) text =

344textInRange (Range (Position startRow startCol) (Position endRow endCol)) text =

287 case compare startRow endRow of

345 case compare startRow endRow of

@@ -338,11 +396,27 @@ dropBindingsFromImportLine bindings_ importLine =

338 joinCloseParens (x : rest) = x : joinCloseParens rest

396 joinCloseParens (x : rest) = x : joinCloseParens rest

339 joinCloseParens [] = []

397 joinCloseParens [] = []

340

398

399+-- | Extends an import list with a new binding.

400+-- Assumes an import statement of the form:

401+-- import (qualified) A (..) ..

402+-- Places the new binding first, preserving whitespace.

403+-- Copes with multi-line import lists

404+addBindingToImportList :: T.Text -> T.Text -> T.Text

405+addBindingToImportList binding importLine = case T.breakOn "(" importLine of

406+ (pre, T.uncons -> Just (_, rest)) ->

407+ case T.uncons (T.dropWhile isSpace rest) of

408+ Just (')', _) -> T.concat [pre, "(", binding, rest]

409+ _ -> T.concat [pre, "(", binding, ", ", rest]

410+ _ ->

411+ error

412+ $ "importLine does not have the expected structure: "

413+ <> T.unpack importLine

414+

341-- | Returns Just (the submatches) for the first capture, or Nothing.

415-- | Returns Just (the submatches) for the first capture, or Nothing.

342matchRegex :: T.Text -> T.Text -> Maybe [T.Text]

416matchRegex :: T.Text -> T.Text -> Maybe [T.Text]

343−matchRegex message regex = case message =~~ regex of

417+matchRegex message regex = case T.unwords (T.words message) =~~ regex of

344− Just (_ :: T.Text, _ :: T.Text, _ :: T.Text, bindings) -> Just bindings

418+ Just (_ :: T.Text, _ :: T.Text, _ :: T.Text, bindings) -> Just bindings

345− Nothing -> Nothing

419+ Nothing -> Nothing

346

420

347setHandlersCodeAction :: PartialHandlers

421setHandlersCodeAction :: PartialHandlers

348setHandlersCodeAction = PartialHandlers $ \WithMessage{..} x -> return x{

422setHandlersCodeAction = PartialHandlers $ \WithMessage{..} x -> return x{

src/Development/IDE/Types/Location.hs+43−1

@@ -21,15 +21,19 @@ module Development.IDE.Types.Location

21 , filePathToUri

22 , filePathToUri'

23 , uriToFilePath'

24+ , readSrcSpan

24 ) where

25 ) where

27+import Control.Applicative

26import Language.Haskell.LSP.Types (Location(..), Range(..), Position(..))

28import Language.Haskell.LSP.Types (Location(..), Range(..), Position(..))

27import Control.DeepSeq

29import Control.DeepSeq

30+import Control.Monad

28import Data.Binary

31import Data.Binary

29import Data.Maybe as Maybe

32import Data.Maybe as Maybe

30import Data.Hashable

33import Data.Hashable

31import Data.String

34import Data.String

32import qualified Data.Text as T

35import qualified Data.Text as T

36+import FastString

33import Network.URI

37import Network.URI

34import System.FilePath

38import System.FilePath

35import qualified System.FilePath.Posix as FPP

39import qualified System.FilePath.Posix as FPP

@@ -43,6 +47,8 @@ import Language.Haskell.LSP.Types as LSP (

43 , toNormalizedUri

47 , toNormalizedUri

44 , fromNormalizedUri

48 , fromNormalizedUri

45 )

49 )

50+import GHC

51+import Text.ParserCombinators.ReadP as ReadP

48-- | Newtype wrapper around FilePath that always has normalized slashes.

54-- | Newtype wrapper around FilePath that always has normalized slashes.

@@ -120,6 +126,42 @@ noFilePath = "<unknown>"

120noRange :: Range

126noRange :: Range

121noRange = Range (Position 0 0) (Position 100000 0)

127noRange = Range (Position 0 0) (Position 100000 0)

122

128

123−

124showPosition :: Position -> String

129showPosition :: Position -> String

125showPosition Position{..} = show (_line + 1) ++ ":" ++ show (_character + 1)

130showPosition Position{..} = show (_line + 1) ++ ":" ++ show (_character + 1)

131+

132+-- | Parser for the GHC output format

133+readSrcSpan :: ReadS SrcSpan

134+readSrcSpan = readP_to_S (singleLineSrcSpanP <|> multiLineSrcSpanP)

135+ where

136+ singleLineSrcSpanP, multiLineSrcSpanP :: ReadP SrcSpan

137+ singleLineSrcSpanP = do

138+ fp <- filePathP

139+ l <- readS_to_P reads <* char ':'

140+ c0 <- readS_to_P reads

141+ c1 <- (char '-' *> readS_to_P reads) <|> pure c0

142+ let from = mkSrcLoc fp l c0

143+ to = mkSrcLoc fp l c1

144+ return $ mkSrcSpan from to

145+

146+ multiLineSrcSpanP = do

147+ fp <- filePathP

148+ s <- parensP (srcLocP fp)

149+ void $ char '-'

150+ e <- parensP (srcLocP fp)

151+ return $ mkSrcSpan s e

152+

153+ parensP :: ReadP a -> ReadP a

154+ parensP = between (char '(') (char ')')

155+

156+ filePathP :: ReadP FastString

157+ filePathP = fromString <$> (readFilePath <* char ':') <|> pure ""

158+

159+ srcLocP :: FastString -> ReadP SrcLoc

160+ srcLocP fp = do

161+ l <- readS_to_P reads

162+ void $ char ','

163+ c <- readS_to_P reads

164+ return $ mkSrcLoc fp l c

165+

166+ readFilePath :: ReadP FilePath

167+ readFilePath = some ReadP.get

test/exe/Main.hs+150

@@ -14,6 +14,7 @@ import Control.Monad

14import Control.Monad.IO.Class (liftIO)

15import Data.Char (toLower)

16import Data.Foldable

17+import Data.List

17import Development.IDE.GHC.Util

18import Development.IDE.GHC.Util

18import qualified Data.Text as T

19import qualified Data.Text as T

19import Development.IDE.Test

20import Development.IDE.Test

@@ -389,6 +390,8 @@ codeActionTests = testGroup "code actions"

389 [ renameActionTests

390 [ renameActionTests

390 , typeWildCardActionTests

391 , typeWildCardActionTests

391 , removeImportTests

392 , removeImportTests

393+ , extendImportTests

394+ , fixConstructorImportTests

392 , importRenameActionTests

395 , importRenameActionTests

393 , fillTypedHoleTests

396 , fillTypedHoleTests

394 , addSigActionTests

397 , addSigActionTests

@@ -689,6 +692,153 @@ removeImportTests = testGroup "remove import actions"

689 liftIO $ expectedContentAfterAction @=? contentAfterAction

692 liftIO $ expectedContentAfterAction @=? contentAfterAction

690 ]

693 ]

691

694

695+extendImportTests :: TestTree

696+extendImportTests = testGroup "extend import actions"

697+ [ testSession "extend single line import with value" $ template

698+ (T.unlines

699+ [ "module ModuleA where"

700+ , "stuffA :: Double"

701+ , "stuffA = 0.00750"

702+ , "stuffB :: Integer"

703+ , "stuffB = 123"

704+ ])

705+ (T.unlines

706+ [ "module ModuleB where"

707+ , "import ModuleA as A (stuffB)"

708+ , "main = print (stuffA, stuffB)"

709+ ])

710+ (Range (Position 3 17) (Position 3 18))

711+ "Add stuffA to the import list of ModuleA"

712+ (T.unlines

713+ [ "module ModuleB where"

714+ , "import ModuleA as A (stuffA, stuffB)"

715+ , "main = print (stuffA, stuffB)"

716+ ])

717+ , testSession "extend single line import with type" $ template

718+ (T.unlines

719+ [ "module ModuleA where"

720+ , "type A = Double"

721+ ])

722+ (T.unlines

723+ [ "module ModuleB where"

724+ , "import ModuleA ()"

725+ , "b :: A"

726+ , "b = 0"

727+ ])

728+ (Range (Position 2 5) (Position 2 5))

729+ "Add A to the import list of ModuleA"

730+ (T.unlines

731+ [ "module ModuleB where"

732+ , "import ModuleA (A)"

733+ , "b :: A"

734+ , "b = 0"

735+ ])

736+ , (`xfail` "known broken") $ testSession "extend single line import with constructor" $ template

737+ (T.unlines

738+ [ "module ModuleA where"

739+ , "data A = Constructor"

740+ ])

741+ (T.unlines

742+ [ "module ModuleB where"

743+ , "import ModuleA (A)"

744+ , "b :: A"

745+ , "b = Constructor"

746+ ])

747+ (Range (Position 2 5) (Position 2 5))

748+ "Add Constructor to the import list of ModuleA"

749+ (T.unlines

750+ [ "module ModuleB where"

751+ , "import ModuleA (A(Constructor))"

752+ , "b :: A"

753+ , "b = Constructor"

754+ ])

755+ , testSession "extend single line qualified import with value" $ template

756+ (T.unlines

757+ [ "module ModuleA where"

758+ , "stuffA :: Double"

759+ , "stuffA = 0.00750"

760+ , "stuffB :: Integer"

761+ , "stuffB = 123"

762+ ])

763+ (T.unlines

764+ [ "module ModuleB where"

765+ , "import qualified ModuleA as A (stuffB)"

766+ , "main = print (A.stuffA, A.stuffB)"

767+ ])

768+ (Range (Position 3 17) (Position 3 18))

769+ "Add stuffA to the import list of ModuleA"

770+ (T.unlines

771+ [ "module ModuleB where"

772+ , "import qualified ModuleA as A (stuffA, stuffB)"

773+ , "main = print (A.stuffA, A.stuffB)"

774+ ])

775+ , testSession "extend multi line import with value" $ template

776+ (T.unlines

777+ [ "module ModuleA where"

778+ , "stuffA :: Double"

779+ , "stuffA = 0.00750"

780+ , "stuffB :: Integer"

781+ , "stuffB = 123"

782+ ])

783+ (T.unlines

784+ [ "module ModuleB where"

785+ , "import ModuleA (stuffB"

786+ , " )"

787+ , "main = print (stuffA, stuffB)"

788+ ])

789+ (Range (Position 3 17) (Position 3 18))

790+ "Add stuffA to the import list of ModuleA"

791+ (T.unlines

792+ [ "module ModuleB where"

793+ , "import ModuleA (stuffA, stuffB"

794+ , " )"

795+ , "main = print (stuffA, stuffB)"

796+ ])

797+ ]

798+ where

799+ template contentA contentB range expectedAction expectedContentB = do

800+ _docA <- openDoc' "ModuleA.hs" "haskell" contentA

801+ docB <- openDoc' "ModuleB.hs" "haskell" contentB

802+ _ <- waitForDiagnostics

803+ CACodeAction action@CodeAction { _title = actionTitle } : _

804+ <- sortOn (\(CACodeAction CodeAction{_title=x}) -> x) <$>

805+ getCodeActions docB range

806+ liftIO $ expectedAction @=? actionTitle

807+ executeCodeAction action

808+ contentAfterAction <- documentContents docB

809+ liftIO $ expectedContentB @=? contentAfterAction

810+

811+fixConstructorImportTests :: TestTree

812+fixConstructorImportTests = testGroup "fix import actions"

813+ [ testSession "fix constructor import" $ template

814+ (T.unlines

815+ [ "module ModuleA where"

816+ , "data A = Constructor"

817+ ])

818+ (T.unlines

819+ [ "module ModuleB where"

820+ , "import ModuleA(Constructor)"

821+ ])

822+ (Range (Position 1 10) (Position 1 11))

823+ "Fix import of A(Constructor)"

824+ (T.unlines

825+ [ "module ModuleB where"

826+ , "import ModuleA(A(Constructor))"

827+ ])

828+ ]

829+ where

830+ template contentA contentB range expectedAction expectedContentB = do

831+ _docA <- openDoc' "ModuleA.hs" "haskell" contentA

832+ docB <- openDoc' "ModuleB.hs" "haskell" contentB

833+ _diags <- waitForDiagnostics

834+ CACodeAction action@CodeAction { _title = actionTitle } : _

835+ <- sortOn (\(CACodeAction CodeAction{_title=x}) -> x) <$>

836+ getCodeActions docB range

837+ liftIO $ expectedAction @=? actionTitle

838+ executeCodeAction action

839+ contentAfterAction <- documentContents docB

840+ liftIO $ expectedContentB @=? contentAfterAction

841+

692importRenameActionTests :: TestTree

842importRenameActionTests :: TestTree

693importRenameActionTests = testGroup "import rename actions"

843importRenameActionTests = testGroup "import rename actions"

694 [ testSession "Data.Mape -> Data.Map" $ check "Map"

844 [ testSession "Data.Mape -> Data.Map" $ check "Map"