Skip to content
This repository was archived by the owner on Oct 7, 2020. It is now read-only.

Commit 637bff5

Browse files
alanzalanz
authored
Merge pull request #1267 from fendor/completions-backtick-aware
Support infix completions
2 parents 4f85fee + 742c7be commit 637bff5

File tree

3 files changed

+114
-9
lines changed

3 files changed

+114
-9
lines changed

‎src/Haskell/Ide/Engine/Support/HieExtras.hs

Lines changed: 50 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -103,13 +103,16 @@ data CompItem = CI
103103
, importedFrom :: T.Text
104104
, thingType :: Maybe Type
105105
, label :: T.Text
106+
, isInfix :: Maybe Backtick
106107
}
107108

109+
data Backtick = Surrounded | LeftSide
110+
108111
instance Eq CompItem where
109-
(CI n1 _ _ _) == (CI n2 _ _ _) = n1 == n2
112+
ci1 == ci2 = origName ci1 == origName ci2
110113

111114
instance Ord CompItem where
112-
compare (CI n1 _ _ _) (CI n2 _ _ _) = compare n1 n2
115+
compare ci1 ci2 = origName ci1 `compare` origName ci2
113116

114117
occNameToComKind :: OccName -> J.CompletionItemKind
115118
occNameToComKind oc
@@ -125,16 +128,21 @@ mkQuery name importedFrom = name <> " module:" <> importedFrom
125128
<> " is:exact"
126129

127130
mkCompl :: CompItem -> J.CompletionItem
128-
mkCompl CI{origName,importedFrom,thingType,label} =
131+
mkCompl CI{origName,importedFrom,thingType,label,isInfix} =
129132
J.CompletionItem label kind (Just $ maybe "" (<>"\n") typeText <> importedFrom)
130133
Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just J.Snippet)
131134
Nothing Nothing Nothing Nothing hoogleQuery
132135
where kind = Just $ occNameToComKind $ occName origName
133136
hoogleQuery = Just $ toJSON $ mkQuery label importedFrom
134137
argTypes = maybe [] getArgs thingType
135-
insertText
136-
| [] <- argTypes = label
137-
| otherwise = label <> " " <> argText
138+
insertText = case isInfix of
139+
Nothing -> case argTypes of
140+
[] -> label
141+
_ -> label <> " " <> argText
142+
Just LeftSide -> label <> "`"
143+
144+
Just Surrounded -> label
145+
138146
argText :: T.Text
139147
argText = mconcat $ List.intersperse " " $ zipWith snippet [1..] argTypes
140148
stripForall t
@@ -224,17 +232,20 @@ instance ModuleCache CachedCompletions where
224232

225233
typeEnv = md_types $ snd $ tm_internals_ tm
226234
toplevelVars = mapMaybe safeTyThingId $ typeEnvElts typeEnv
227-
varToCompl var = CI name (showModName curMod) typ label
235+
236+
varToCompl :: Var -> CompItem
237+
varToCompl var = CI name (showModName curMod) typ label Nothing
228238
where
229239
typ = Just $ varType var
230240
name = Var.varName var
231241
label = T.pack $ showGhc name
232242

243+
toplevelCompls :: [CompItem]
233244
toplevelCompls = map varToCompl toplevelVars
234245

235246
toCompItem :: ModuleName -> Name -> CompItem
236247
toCompItem mn n =
237-
CI n (showModName mn) Nothing (T.pack $ showGhc n)
248+
CI n (showModName mn) Nothing (T.pack $ showGhc n) Nothing
238249

239250
allImportsInfo :: [(Bool, T.Text, ModuleName, Maybe (Bool, [Name]))]
240251
allImportsInfo = map getImpInfo importDeclerations
@@ -369,6 +380,26 @@ getCompletions uri prefixInfo (WithSnippets withSnippets) =
369380
d = T.length fullLine - T.length (stripTypeStuff partialLine)
370381
in Position l (c - d)
371382

383+
hasTrailingBacktick =
384+
if T.length fullLine <= trailingBacktickIndex
385+
then False
386+
else (fullLine `T.index` trailingBacktickIndex) == '`'
387+
388+
trailingBacktickIndex = let Position _ cursorColumn = VFS.cursorPos prefixInfo in cursorColumn
389+
390+
isUsedAsInfix = if backtickIndex < 0
391+
then False
392+
else (fullLine `T.index` backtickIndex) == '`'
393+
394+
backtickIndex =
395+
let Position _ cursorColumn = VFS.cursorPos prefixInfo
396+
prefixLength = T.length prefixText
397+
moduleLength = if prefixModule == ""
398+
then 0
399+
else T.length prefixModule + 1 {- Because of "." -}
400+
in
401+
cursorColumn - (prefixLength + moduleLength) - 1 {- Points to the first letter of either the module or prefix text -}
402+
372403
filtModNameCompls =
373404
map mkModCompl
374405
$ mapMaybe (T.stripPrefix enteredQual)
@@ -378,13 +409,23 @@ getCompletions uri prefixInfo (WithSnippets withSnippets) =
378409
where
379410
isTypeCompl = isTcOcc . occName . origName
380411
-- completions specific to the current context
381-
ctxCompls = case context of
412+
ctxCompls' = case context of
382413
TypeContext -> filter isTypeCompl compls
383414
ValueContext -> filter (not . isTypeCompl) compls
415+
-- Add whether the text to insert has backticks
416+
ctxCompls = map (\comp -> comp { isInfix = infixCompls }) ctxCompls'
417+
418+
infixCompls :: Maybe Backtick
419+
infixCompls = case (isUsedAsInfix, hasTrailingBacktick) of
420+
(True, False) -> Just LeftSide
421+
(True, True) -> Just Surrounded
422+
_ -> Nothing
423+
384424
compls = if T.null prefixModule
385425
then unqualCompls
386426
else Map.findWithDefault [] prefixModule qualCompls
387427

428+
388429
mkImportCompl label = (J.detail ?~ label) . mkModCompl $ fromMaybe
389430
""
390431
(T.stripPrefix enteredQual label)

‎test/functional/CompletionSpec.hs

Lines changed: 61 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -250,6 +250,67 @@ spec = describe "completions" $ do
250250
item ^. insertTextFormat `shouldBe` Just Snippet
251251
item ^. insertText `shouldBe` Just "mapM ${1:a -> m b} ${2:t a}"
252252

253+
it "work for infix functions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
254+
doc <- openDoc "Completion.hs" "haskell"
255+
_ <- skipManyTill loggingNotification (count 2 noDiagnostics)
256+
257+
let te = TextEdit (Range (Position 5 7) (Position 5 24)) "even `filte"
258+
_ <- applyEdit doc te
259+
260+
compls <- getCompletions doc (Position 5 18)
261+
let item = head $ filter ((== "filter") . (^. label)) compls
262+
liftIO $ do
263+
item ^. label `shouldBe` "filter"
264+
item ^. kind `shouldBe` Just CiFunction
265+
item ^. insertTextFormat `shouldBe` Just Snippet
266+
item ^. insertText `shouldBe` Just "filter`"
267+
268+
it "work for infix functions in backticks" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
269+
doc <- openDoc "Completion.hs" "haskell"
270+
_ <- skipManyTill loggingNotification (count 2 noDiagnostics)
271+
272+
let te = TextEdit (Range (Position 5 7) (Position 5 24)) "even `filte`"
273+
_ <- applyEdit doc te
274+
275+
compls <- getCompletions doc (Position 5 18)
276+
let item = head $ filter ((== "filter") . (^. label)) compls
277+
liftIO $ do
278+
item ^. label `shouldBe` "filter"
279+
item ^. kind `shouldBe` Just CiFunction
280+
item ^. insertTextFormat `shouldBe` Just Snippet
281+
item ^. insertText `shouldBe` Just "filter"
282+
283+
it "work for qualified infix functions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
284+
doc <- openDoc "Completion.hs" "haskell"
285+
_ <- skipManyTill loggingNotification (count 2 noDiagnostics)
286+
287+
let te = TextEdit (Range (Position 5 7) (Position 5 24)) "\"\" `Data.List.interspe"
288+
_ <- applyEdit doc te
289+
290+
compls <- getCompletions doc (Position 5 29)
291+
let item = head $ filter ((== "intersperse") . (^. label)) compls
292+
liftIO $ do
293+
item ^. label `shouldBe` "intersperse"
294+
item ^. kind `shouldBe` Just CiFunction
295+
item ^. insertTextFormat `shouldBe` Just Snippet
296+
item ^. insertText `shouldBe` Just "intersperse`"
297+
298+
it "work for qualified infix functions in backticks" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
299+
doc <- openDoc "Completion.hs" "haskell"
300+
_ <- skipManyTill loggingNotification (count 2 noDiagnostics)
301+
302+
let te = TextEdit (Range (Position 5 7) (Position 5 24)) "\"\" `Data.List.interspe`"
303+
_ <- applyEdit doc te
304+
305+
306+
compls <- getCompletions doc (Position 5 29)
307+
let item = head $ filter ((== "intersperse") . (^. label)) compls
308+
liftIO $ do
309+
item ^. label `shouldBe` "intersperse"
310+
item ^. kind `shouldBe` Just CiFunction
311+
item ^. insertTextFormat `shouldBe` Just Snippet
312+
item ^. insertText `shouldBe` Just "intersperse"
313+
253314
it "respects lsp configuration" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
254315
doc <- openDoc "Completion.hs" "haskell"
255316
_ <- skipManyTill loggingNotification (count 2 noDiagnostics)

‎test/testdata/completion/Completion.hs

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,3 +4,6 @@ import qualified Data.List
44

55
main :: IO ()
66
main = putStrLn "hello"
7+
8+
foo :: Either a b -> Either a b
9+
foo = id

0 commit comments

Comments
 (0)