From ef51319b57bd23c8efe5978c5799729a3aca93c8 Mon Sep 17 00:00:00 2001 From: fendor Date: Thu, 23 May 2019 14:54:36 +0200 Subject: [PATCH 1/4] Support infix completions --- src/Haskell/Ide/Engine/Support/HieExtras.hs | 60 +++++++++++++++++---- 1 file changed, 51 insertions(+), 9 deletions(-) diff --git a/src/Haskell/Ide/Engine/Support/HieExtras.hs b/src/Haskell/Ide/Engine/Support/HieExtras.hs index 30aea954a..6ad6f016c 100644 --- a/src/Haskell/Ide/Engine/Support/HieExtras.hs +++ b/src/Haskell/Ide/Engine/Support/HieExtras.hs @@ -75,6 +75,7 @@ import SrcLoc import TcEnv import Type import Var +import System.IO (hPutStrLn, stderr) -- --------------------------------------------------------------------- @@ -103,13 +104,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 +129,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 +233,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 +381,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 +410,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) From 3c8f462d6f402afbe3314a21332d36f630c25b94 Mon Sep 17 00:00:00 2001 From: fendor Date: Thu, 23 May 2019 15:04:42 +0200 Subject: [PATCH 2/4] Remove unused imports --- src/Haskell/Ide/Engine/Support/HieExtras.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Haskell/Ide/Engine/Support/HieExtras.hs b/src/Haskell/Ide/Engine/Support/HieExtras.hs index 6ad6f016c..c2cc1a085 100644 --- a/src/Haskell/Ide/Engine/Support/HieExtras.hs +++ b/src/Haskell/Ide/Engine/Support/HieExtras.hs @@ -75,7 +75,6 @@ import SrcLoc import TcEnv import Type import Var -import System.IO (hPutStrLn, stderr) -- --------------------------------------------------------------------- From 203846a616619340a80aa93b8c627768159eaa63 Mon Sep 17 00:00:00 2001 From: fendor Date: Mon, 27 May 2019 19:52:05 +0200 Subject: [PATCH 3/4] Add tests for infix completions --- test/functional/CompletionSpec.hs | 61 ++++++++++++++++++++++++++ test/testdata/completion/Completion.hs | 3 ++ 2 files changed, 64 insertions(+) diff --git a/test/functional/CompletionSpec.hs b/test/functional/CompletionSpec.hs index 26e127dec..b3ffa45e6 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 17) + 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 17) + 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 34) + 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 "`Data.List.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 34) + 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 "`Data.List.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 From 742c7bebcbafc482fedd9c207a0902cb4370b82b Mon Sep 17 00:00:00 2001 From: fendor Date: Thu, 30 May 2019 17:00:41 +0200 Subject: [PATCH 4/4] Fix tests --- test/functional/CompletionSpec.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/test/functional/CompletionSpec.hs b/test/functional/CompletionSpec.hs index b3ffa45e6..e703b5923 100644 --- a/test/functional/CompletionSpec.hs +++ b/test/functional/CompletionSpec.hs @@ -257,13 +257,13 @@ spec = describe "completions" $ do let te = TextEdit (Range (Position 5 7) (Position 5 24)) "even `filte" _ <- applyEdit doc te - compls <- getCompletions doc (Position 5 17) + 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`" + item ^. insertText `shouldBe` Just "filter`" it "work for infix functions in backticks" $ runSession hieCommand fullCaps "test/testdata/completion" $ do doc <- openDoc "Completion.hs" "haskell" @@ -272,13 +272,13 @@ spec = describe "completions" $ do let te = TextEdit (Range (Position 5 7) (Position 5 24)) "even `filte`" _ <- applyEdit doc te - compls <- getCompletions doc (Position 5 17) + 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`" + item ^. insertText `shouldBe` Just "filter" it "work for qualified infix functions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do doc <- openDoc "Completion.hs" "haskell" @@ -287,13 +287,13 @@ spec = describe "completions" $ do let te = TextEdit (Range (Position 5 7) (Position 5 24)) "\"\" `Data.List.interspe" _ <- applyEdit doc te - compls <- getCompletions doc (Position 5 34) + 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 "`Data.List.intersperse`" + 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" @@ -303,13 +303,13 @@ spec = describe "completions" $ do _ <- applyEdit doc te - compls <- getCompletions doc (Position 5 34) + 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 "`Data.List.intersperse`" + item ^. insertText `shouldBe` Just "intersperse" it "respects lsp configuration" $ runSession hieCommand fullCaps "test/testdata/completion" $ do doc <- openDoc "Completion.hs" "haskell"