4fc09fa · ghcide · git.iko.soy

git.iko.soy/ghcide

on master help sign in

Code actions for filling typed holes (#69)

4fc09fajacg7 years ago

.hlint.yaml+2

compare with master

unifiedsplit

@@ -81,7 +81,9 @@

81 - Development.IDE.GHC.Compat

82 - Development.IDE.GHC.Util

83 - Development.IDE.Import.FindImports

84+ - Development.IDE.LSP.CodeAction

84 - Development.IDE.Spans.Calculate

85 - Development.IDE.Spans.Calculate

86+ - Main

86- flags:

88- flags:

87 - default: false

89 - default: false

ghcide.cabal+9

@@ -171,6 +171,14 @@ test-suite ghcide-tests

171 containers,

172 extra,

173 filepath,

174+ --------------------------------------------------------------

175+ -- The MIN_GHC_API_VERSION macro relies on MIN_VERSION pragmas

176+ -- which require depending on ghc. So the tests need to depend

177+ -- on ghc if they need to use MIN_GHC_API_VERSION. Maybe a

178+ -- better solution can be found, but this is a quick solution

179+ -- which works for now.

180+ ghc,

181+ --------------------------------------------------------------

174 haskell-lsp-types,

182 haskell-lsp-types,

175 lens,

183 lens,

176 lsp-test,

184 lsp-test,

@@ -179,6 +187,7 @@ test-suite ghcide-tests

179 tasty-hunit,

187 tasty-hunit,

180 text

188 text

181 hs-source-dirs: test/cabal test/exe test/src

189 hs-source-dirs: test/cabal test/exe test/src

190+ include-dirs: include

182 ghc-options: -threaded

191 ghc-options: -threaded

183 main-is: Main.hs

192 main-is: Main.hs

184 other-modules:

193 other-modules:

src/Development/IDE/LSP/CodeAction.hs+43−2

@@ -2,6 +2,8 @@

2-- SPDX-License-Identifier: Apache-2.0

4{-# LANGUAGE DuplicateRecordFields #-}

5+{-# LANGUAGE CPP #-}

6+#include "ghc-api-version.h"

6-- | Go to the definition of a variable.

8-- | Go to the definition of a variable.

7module Development.IDE.LSP.CodeAction

9module Development.IDE.LSP.CodeAction

@@ -102,13 +104,52 @@ suggestAction contents Diagnostic{_range=_range@Range{..},..}

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

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

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

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

104 | "Could not find module" `T.isInfixOf` _message

106 | "Could not find module" `T.isInfixOf` _message

105− , "Perhaps you meant" `T.isInfixOf` _message

107+ , "Perhaps you meant" `T.isInfixOf` _message = let

106− = map proposeModule $ nubOrd $ findSuggestedModules _message where

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

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

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

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

110+ in map proposeModule $ nubOrd $ findSuggestedModules _message

111+

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

113+-- * Found hole: _ :: Int -> String

114+-- * In the expression: _

115+-- In the expression: _ a

116+-- In an equation for ‘foo’: foo a = _ a

117+-- * Relevant bindings include

118+-- a :: Int

119+-- (bound at ...Development/IDE/LSP/CodeAction.hs:103:5)

120+-- foo :: Int -> String

121+-- (bound at ...Development/IDE/LSP/CodeAction.hs:103:1)

122+-- Valid hole fits include

123+-- foo :: Int -> String

124+-- (bound at ...Development/IDE/LSP/CodeAction.hs:103:1)

125+-- show :: forall a. Show a => a -> String

126+-- with show @Int

127+-- (imported from ‘Prelude’ at ...Development/IDE/LSP/CodeAction.hs:7:8-37

128+-- (and originally defined in ‘GHC.Show’))

129+-- mempty :: forall a. Monoid a => a

130+-- with mempty @(Int -> String)

131+-- (imported from ‘Prelude’ at ...Development/IDE/LSP/CodeAction.hs:7:8-37

132+-- (and originally defined in ‘GHC.Base’)) (lsp-ui)

133+

134+ | topOfHoleFitsMarker `T.isInfixOf` _message = let

135+ findSuggestedHoleFits :: T.Text -> [T.Text]

136+ findSuggestedHoleFits = extractFitNames . selectLinesWithFits . dropPreceding . T.lines

137+ proposeHoleFit name = ("replace hole `" <> holeName <> "` with " <> name, [TextEdit _range name])

138+ holeName = T.strip $ last $ T.splitOn ":" $ head . T.splitOn "::" $ head $ filter ("Found hole" `T.isInfixOf`) $ T.lines _message

139+ dropPreceding = dropWhile (not . (topOfHoleFitsMarker `T.isInfixOf`))

140+ selectLinesWithFits = filter ("::" `T.isInfixOf`)

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

142+ in map proposeHoleFit $ nubOrd $ findSuggestedHoleFits _message

109

143

110suggestAction _ _ = []

144suggestAction _ _ = []

111

145

146+topOfHoleFitsMarker =

147+#if MIN_GHC_API_VERSION(8,6,0)

148+ "Valid hole fits include"

149+#else

150+ "Valid substitutions include"

151+#endif

152+

112mkRenameEdit :: Maybe T.Text -> Range -> T.Text -> TextEdit

153mkRenameEdit :: Maybe T.Text -> Range -> T.Text -> TextEdit

113mkRenameEdit contents range name =

154mkRenameEdit contents range name =

114 if fromMaybe False maybeIsInfixFunction

155 if fromMaybe False maybeIsInfixFunction

test/exe/Main.hs+72

@@ -2,6 +2,8 @@

2-- SPDX-License-Identifier: Apache-2.0

4{-# LANGUAGE DuplicateRecordFields #-}

5+{-# LANGUAGE CPP #-}

6+#include "ghc-api-version.h"

6module Main (main) where

8module Main (main) where

@@ -232,6 +234,7 @@ codeActionTests = testGroup "code actions"

232 , typeWildCardActionTests

234 , typeWildCardActionTests

233 , removeImportTests

235 , removeImportTests

234 , importRenameActionTests

236 , importRenameActionTests

237+ , fillTypedHoleTests

235 ]

238 ]

236

239

237renameActionTests :: TestTree

240renameActionTests :: TestTree

@@ -453,6 +456,75 @@ importRenameActionTests = testGroup "import rename actions"

453 ]

456 ]

454 liftIO $ expectedContentAfterAction @=? contentAfterAction

457 liftIO $ expectedContentAfterAction @=? contentAfterAction

455

458

459+fillTypedHoleTests :: TestTree

460+fillTypedHoleTests = let

461+

462+ sourceCode :: T.Text -> T.Text -> T.Text -> T.Text

463+ sourceCode a b c = T.unlines

464+ [ "module Testing where"

465+ , ""

466+ , "globalConvert :: Int -> String"

467+ , "globalConvert = undefined"

468+ , ""

469+ , "globalInt :: Int"

470+ , "globalInt = 3"

471+ , ""

472+ , "bar :: Int -> Int -> String"

473+ , "bar n parameterInt = " <> a <> " (n + " <> b <> " + " <> c <> ") where"

474+ , " localConvert = (flip replicate) 'x'"

475+

476+ ]

477+

478+ check :: T.Text -> T.Text -> T.Text -> T.Text -> T.Text -> T.Text -> T.Text -> TestTree

479+ check actionTitle

480+ oldA oldB oldC

481+ newA newB newC = testSession (T.unpack actionTitle) $ do

482+ let originalCode = sourceCode oldA oldB oldC

483+ let expectedCode = sourceCode newA newB newC

484+ doc <- openDoc' "Testing.hs" "haskell" originalCode

485+ _ <- waitForDiagnostics

486+ actionsOrCommands <- getCodeActions doc (Range (Position 9 0) (Position 9 maxBound))

487+ let chosenAction = pickActionWithTitle actionTitle actionsOrCommands

488+ executeCodeAction chosenAction

489+ modifiedCode <- documentContents doc

490+ liftIO $ expectedCode @=? modifiedCode

491+

492+ pickActionWithTitle title actions = head

493+ [ action

494+ | CACodeAction action@CodeAction{ _title = actionTitle } <- actions

495+ , title == actionTitle ]

496+

497+ in

498+ testGroup "fill typed holes"

499+ [ check "replace hole `_` with show"

500+ "_" "n" "n"

501+ "show" "n" "n"

502+

503+ , check "replace hole `_` with globalConvert"

504+ "_" "n" "n"

505+ "globalConvert" "n" "n"

506+

507+#if MIN_GHC_API_VERSION(8,6,0)

508+ , check "replace hole `_convertme` with localConvert"

509+ "_convertme" "n" "n"

510+ "localConvert" "n" "n"

511+#endif

512+

513+ , check "replace hole `_b` with globalInt"

514+ "_a" "_b" "_c"

515+ "_a" "globalInt" "_c"

516+

517+ , check "replace hole `_c` with globalInt"

518+ "_a" "_b" "_c"

519+ "_a" "_b" "globalInt"

520+

521+#if MIN_GHC_API_VERSION(8,6,0)

522+ , check "replace hole `_c` with parameterInt"

523+ "_a" "_b" "_c"

524+ "_a" "_b" "parameterInt"

525+#endif

526+ ]

527+

456----------------------------------------------------------------------

528----------------------------------------------------------------------

457-- Utils

529-- Utils

458

530