Remove snippets for infix forms

Author: pepeiborra

ghcide/src/Development/IDE/Plugin/Completions/Logic.hs

@@ -159,9 +159,21 @@ showModName = T.pack . moduleNameString
 --     Nothing Nothing Nothing Nothing Nothing
 
 mkCompl :: PluginId -> IdeOptions -> CompItem -> IO CompletionItem
-mkCompl pId IdeOptions{..} CI{compKind,insertText, importedFrom,typeText,label,docs, additionalTextEdits} = do
+mkCompl
+  pId
+  IdeOptions {..}
+  CI
+    { compKind,
+      isInfix,
+      insertText,
+      importedFrom,
+      typeText,
+      label,
+      docs,
+      additionalTextEdits
+    } = do
   mbCommand <- mkAdditionalEditsCommand pId `traverse` additionalTextEdits
-  return CompletionItem
+  let ci = CompletionItem
                  {_label = label,
                   _kind = kind,
                   _tags = Nothing,
@@ -178,6 +190,7 @@ mkCompl pId IdeOptions{..} CI{compKind,insertText, importedFrom,typeText,label,d
                   _commitCharacters = Nothing,
                   _command = mbCommand,
                   _xdata = Nothing}
+  return $ removeSnippetsWhen (isJust isInfix) ci
 
   where kind = Just compKind
         docs' = imported : spanDocToMarkdown docs
@@ -446,15 +459,22 @@ ppr :: Outputable a => a -> T.Text
 ppr = T.pack . prettyPrint
 
 toggleSnippets :: ClientCapabilities -> WithSnippets -> CompletionItem -> CompletionItem
-toggleSnippets ClientCapabilities { _textDocument } (WithSnippets with) x
-  | with && supported = x
-  | otherwise = x { _insertTextFormat = Just PlainText
-                  , _insertText       = Nothing
-                  }
+toggleSnippets ClientCapabilities {_textDocument} (WithSnippets with) =
+  removeSnippetsWhen (not $ with && supported)
   where
     supported =
       Just True == (_textDocument >>= _completion >>= _completionItem >>= _snippetSupport)
 
+removeSnippetsWhen :: Bool -> CompletionItem -> CompletionItem
+removeSnippetsWhen condition x =
+  if condition
+    then
+      x
+        { _insertTextFormat = Just PlainText,
+          _insertText = Nothing
+        }
+    else x
+
 -- | Returns the cached completions for the given module and position.
 getCompletions
     :: PluginId

ghcide/src/Development/IDE/Plugin/Completions/Types.hs

@@ -14,6 +14,7 @@ import Data.Aeson (FromJSON, ToJSON)
 import Data.Text (Text)
 import GHC.Generics (Generic)
 import Language.Haskell.LSP.Types (CompletionItemKind, Uri)
+
 data Backtick = Surrounded | LeftSide
   deriving (Eq, Ord, Show)
 
@@ -28,6 +29,7 @@ data ExtendImport = ExtendImport
   }
   deriving (Eq, Show, Generic)
   deriving anyclass (FromJSON, ToJSON)
+
 data CompItem = CI
   { compKind     :: CompletionItemKind
   , insertText   :: T.Text         -- ^ Snippet for the completion

test/functional/Completion.hs

@@ -286,8 +286,8 @@ snippetTests = testGroup "snippets" [
         liftIO $ do
             item ^. label @?= "filter"
             item ^. kind @?= Just CiFunction
-            item ^. insertTextFormat @?= Just Snippet
-            item ^. insertText @?= Just "filter ${1:a -> Bool} ${2:[a]}"
+            item ^. insertTextFormat @?= Just PlainText
+            item ^. insertText @?= Nothing
 
     , testCase "work for infix functions in backticks" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
         doc <- openDoc "Completion.hs" "haskell"
@@ -300,8 +300,8 @@ snippetTests = testGroup "snippets" [
         liftIO $ do
             item ^. label @?= "filter"
             item ^. kind @?= Just CiFunction
-            item ^. insertTextFormat @?= Just Snippet
-            item ^. insertText @?= Just "filter ${1:a -> Bool} ${2:[a]}"
+            item ^. insertTextFormat @?= Just PlainText
+            item ^. insertText @?= Nothing
 
     , testCase "work for qualified infix functions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
         doc <- openDoc "Completion.hs" "haskell"
@@ -314,8 +314,8 @@ snippetTests = testGroup "snippets" [
         liftIO $ do
             item ^. label @?= "intersperse"
             item ^. kind @?= Just CiFunction
-            item ^. insertTextFormat @?= Just Snippet
-            item ^. insertText @?= Just "intersperse ${1:a} ${2:[a]}"
+            item ^. insertTextFormat @?= Just PlainText
+            item ^. insertText @?= Nothing
 
     , testCase "work for qualified infix functions in backticks" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
         doc <- openDoc "Completion.hs" "haskell"
@@ -328,8 +328,8 @@ snippetTests = testGroup "snippets" [
         liftIO $ do
             item ^. label @?= "intersperse"
             item ^. kind @?= Just CiFunction
-            item ^. insertTextFormat @?= Just Snippet
-            item ^. insertText @?= Just "intersperse ${1:a} ${2:[a]}"
+            item ^. insertTextFormat @?= Just PlainText
+            item ^. insertText @?= Nothing
 
     , testCase "respects lsp configuration" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
         doc <- openDoc "Completion.hs" "haskell"