diff --git a/src/Haskell/Ide/Engine/Support/HieExtras.hs b/src/Haskell/Ide/Engine/Support/HieExtras.hs index 30aea954a..c2cc1a085 100644 --- a/src/Haskell/Ide/Engine/Support/HieExtras.hs +++ b/src/Haskell/Ide/Engine/Support/HieExtras.hs @@ -103,13 +103,16 @@ data CompItem = CI , importedFrom :: T.Text , thingType :: Maybe Type , label :: T.Text + , isInfix :: Maybe Backtick } +data Backtick = Surrounded | LeftSide + instance Eq CompItem where - (CI n1 _ _ _) == (CI n2 _ _ _) = n1 == n2 + ci1 == ci2 = origName ci1 == origName ci2 instance Ord CompItem where - compare (CI n1 _ _ _) (CI n2 _ _ _) = compare n1 n2 + compare ci1 ci2 = origName ci1 `compare` origName ci2 occNameToComKind :: OccName -> J.CompletionItemKind occNameToComKind oc @@ -125,16 +128,21 @@ mkQuery name importedFrom = name <> " module:" <> importedFrom <> " is:exact" mkCompl :: CompItem -> J.CompletionItem -mkCompl CI{origName,importedFrom,thingType,label} = +mkCompl CI{origName,importedFrom,thingType,label,isInfix} = J.CompletionItem label kind (Just $ maybe "" (<>"\n") typeText <> importedFrom) Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just J.Snippet) Nothing Nothing Nothing Nothing hoogleQuery where kind = Just $ occNameToComKind $ occName origName hoogleQuery = Just $ toJSON $ mkQuery label importedFrom argTypes = maybe [] getArgs thingType - insertText - | [] <- argTypes = label - | otherwise = label <> " " <> argText + insertText = case isInfix of + Nothing -> case argTypes of + [] -> label + _ -> label <> " " <> argText + Just LeftSide -> label <> "`" + + Just Surrounded -> label + argText :: T.Text argText = mconcat $ List.intersperse " " $ zipWith snippet [1..] argTypes stripForall t @@ -224,17 +232,20 @@ instance ModuleCache CachedCompletions where typeEnv = md_types $ snd $ tm_internals_ tm toplevelVars = mapMaybe safeTyThingId $ typeEnvElts typeEnv - varToCompl var = CI name (showModName curMod) typ label + + varToCompl :: Var -> CompItem + varToCompl var = CI name (showModName curMod) typ label Nothing where typ = Just $ varType var name = Var.varName var label = T.pack $ showGhc name + toplevelCompls :: [CompItem] toplevelCompls = map varToCompl toplevelVars toCompItem :: ModuleName -> Name -> CompItem toCompItem mn n = - CI n (showModName mn) Nothing (T.pack $ showGhc n) + CI n (showModName mn) Nothing (T.pack $ showGhc n) Nothing allImportsInfo :: [(Bool, T.Text, ModuleName, Maybe (Bool, [Name]))] allImportsInfo = map getImpInfo importDeclerations @@ -369,6 +380,26 @@ getCompletions uri prefixInfo (WithSnippets withSnippets) = d = T.length fullLine - T.length (stripTypeStuff partialLine) in Position l (c - d) + hasTrailingBacktick = + if T.length fullLine <= trailingBacktickIndex + then False + else (fullLine `T.index` trailingBacktickIndex) == '`' + + trailingBacktickIndex = let Position _ cursorColumn = VFS.cursorPos prefixInfo in cursorColumn + + isUsedAsInfix = if backtickIndex < 0 + then False + else (fullLine `T.index` backtickIndex) == '`' + + backtickIndex = + let Position _ cursorColumn = VFS.cursorPos prefixInfo + prefixLength = T.length prefixText + moduleLength = if prefixModule == "" + then 0 + else T.length prefixModule + 1 {- Because of "." -} + in + cursorColumn - (prefixLength + moduleLength) - 1 {- Points to the first letter of either the module or prefix text -} + filtModNameCompls = map mkModCompl $ mapMaybe (T.stripPrefix enteredQual) @@ -378,13 +409,23 @@ getCompletions uri prefixInfo (WithSnippets withSnippets) = where isTypeCompl = isTcOcc . occName . origName -- completions specific to the current context - ctxCompls = case context of + ctxCompls' = case context of TypeContext -> filter isTypeCompl compls ValueContext -> filter (not . isTypeCompl) compls + -- Add whether the text to insert has backticks + ctxCompls = map (\comp -> comp { isInfix = infixCompls }) ctxCompls' + + infixCompls :: Maybe Backtick + infixCompls = case (isUsedAsInfix, hasTrailingBacktick) of + (True, False) -> Just LeftSide + (True, True) -> Just Surrounded + _ -> Nothing + compls = if T.null prefixModule then unqualCompls else Map.findWithDefault [] prefixModule qualCompls + mkImportCompl label = (J.detail ?~ label) . mkModCompl $ fromMaybe "" (T.stripPrefix enteredQual label) diff --git a/test/functional/CompletionSpec.hs b/test/functional/CompletionSpec.hs index 26e127dec..e703b5923 100644 --- a/test/functional/CompletionSpec.hs +++ b/test/functional/CompletionSpec.hs @@ -250,6 +250,67 @@ spec = describe "completions" $ do item ^. insertTextFormat `shouldBe` Just Snippet item ^. insertText `shouldBe` Just "mapM ${1:a -> m b} ${2:t a}" + it "work for infix functions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + _ <- skipManyTill loggingNotification (count 2 noDiagnostics) + + let te = TextEdit (Range (Position 5 7) (Position 5 24)) "even `filte" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 5 18) + let item = head $ filter ((== "filter") . (^. label)) compls + liftIO $ do + item ^. label `shouldBe` "filter" + item ^. kind `shouldBe` Just CiFunction + item ^. insertTextFormat `shouldBe` Just Snippet + item ^. insertText `shouldBe` Just "filter`" + + it "work for infix functions in backticks" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + _ <- skipManyTill loggingNotification (count 2 noDiagnostics) + + let te = TextEdit (Range (Position 5 7) (Position 5 24)) "even `filte`" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 5 18) + let item = head $ filter ((== "filter") . (^. label)) compls + liftIO $ do + item ^. label `shouldBe` "filter" + item ^. kind `shouldBe` Just CiFunction + item ^. insertTextFormat `shouldBe` Just Snippet + item ^. insertText `shouldBe` Just "filter" + + it "work for qualified infix functions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + _ <- skipManyTill loggingNotification (count 2 noDiagnostics) + + let te = TextEdit (Range (Position 5 7) (Position 5 24)) "\"\" `Data.List.interspe" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 5 29) + let item = head $ filter ((== "intersperse") . (^. label)) compls + liftIO $ do + item ^. label `shouldBe` "intersperse" + item ^. kind `shouldBe` Just CiFunction + item ^. insertTextFormat `shouldBe` Just Snippet + item ^. insertText `shouldBe` Just "intersperse`" + + it "work for qualified infix functions in backticks" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + _ <- skipManyTill loggingNotification (count 2 noDiagnostics) + + let te = TextEdit (Range (Position 5 7) (Position 5 24)) "\"\" `Data.List.interspe`" + _ <- applyEdit doc te + + + compls <- getCompletions doc (Position 5 29) + let item = head $ filter ((== "intersperse") . (^. label)) compls + liftIO $ do + item ^. label `shouldBe` "intersperse" + item ^. kind `shouldBe` Just CiFunction + item ^. insertTextFormat `shouldBe` Just Snippet + item ^. insertText `shouldBe` Just "intersperse" + it "respects lsp configuration" $ runSession hieCommand fullCaps "test/testdata/completion" $ do doc <- openDoc "Completion.hs" "haskell" _ <- skipManyTill loggingNotification (count 2 noDiagnostics) diff --git a/test/testdata/completion/Completion.hs b/test/testdata/completion/Completion.hs index 722de38d5..d6480903b 100644 --- a/test/testdata/completion/Completion.hs +++ b/test/testdata/completion/Completion.hs @@ -4,3 +4,6 @@ import qualified Data.List main :: IO () main = putStrLn "hello" + +foo :: Either a b -> Either a b +foo = id \ No newline at end of file