From 08b241e283b5a8d8a7783701ee7d40c52552fafb Mon Sep 17 00:00:00 2001 From: Alex Naspo Date: Fri, 27 Aug 2021 22:49:25 -0400 Subject: [PATCH 1/3] Move pragmas completion to pragmas plugin --- .../IDE/Plugin/Completions/Logic.hs | 29 ----------------- .../src/Ide/Plugin/Pragmas.hs | 32 ++++++++++++++++++- 2 files changed, 31 insertions(+), 30 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 5371583955..5bacd40297 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -299,11 +299,6 @@ mkExtCompl label = Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing -mkPragmaCompl :: T.Text -> T.Text -> CompletionItem -mkPragmaCompl label insertText = - CompletionItem label (Just CiKeyword) Nothing Nothing - Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just Snippet) - Nothing Nothing Nothing Nothing Nothing Nothing fromIdentInfo :: Uri -> IdentInfo -> Maybe T.Text -> CompItem fromIdentInfo doc IdentInfo{..} q = CI @@ -600,14 +595,7 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu , enteredQual `T.isPrefixOf` label ] - filtListWithSnippet f list suffix = - [ toggleSnippets caps config (f label (snippet <> suffix)) - | (snippet, label) <- list - , Fuzzy.test fullPrefix label - ] - filtImportCompls = filtListWith (mkImportCompl enteredQual) importableModules - filtPragmaCompls = filtListWithSnippet mkPragmaCompl validPragmas filtOptsCompls = filtListWith mkExtCompl filtKeywordCompls | T.null prefixModule = filtListWith mkExtCompl (optKeywords ideOpts) @@ -628,8 +616,6 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu -> return [] | "{-# options_ghc" `T.isPrefixOf` T.toLower fullLine -> return $ filtOptsCompls (map (T.pack . stripLeading '-') $ flagsForCompletion False) - | "{-# " `T.isPrefixOf` fullLine - -> return $ filtPragmaCompls (pragmaSuffix fullLine) | otherwise -> do -- assumes that nubOrdBy is stable let uniqueFiltCompls = nubOrdBy uniqueCompl filtCompls @@ -655,21 +641,6 @@ uniqueCompl x y = -- helper functions for pragmas -- --------------------------------------------------------------------- -validPragmas :: [(T.Text, T.Text)] -validPragmas = - [ ("LANGUAGE ${1:extension}" , "LANGUAGE") - , ("OPTIONS_GHC -${1:option}" , "OPTIONS_GHC") - , ("INLINE ${1:function}" , "INLINE") - , ("NOINLINE ${1:function}" , "NOINLINE") - , ("INLINABLE ${1:function}" , "INLINABLE") - , ("WARNING ${1:message}" , "WARNING") - , ("DEPRECATED ${1:message}" , "DEPRECATED") - , ("ANN ${1:annotation}" , "ANN") - , ("RULES" , "RULES") - , ("SPECIALIZE ${1:function}" , "SPECIALIZE") - , ("SPECIALIZE INLINE ${1:function}", "SPECIALIZE INLINE") - ] - pragmaSuffix :: T.Text -> T.Text pragmaSuffix fullLine | "}" `T.isSuffixOf` fullLine = mempty diff --git a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs index 444722e18d..541828274e 100644 --- a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs +++ b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs @@ -163,9 +163,16 @@ completion _ide _ complParams = do | "{-# LANGUAGE" `T.isPrefixOf` VFS.fullLine pfix = J.List $ map buildCompletion (Fuzzy.simpleFilter (VFS.prefixText pfix) allPragmas) + -- if there already is a closing bracket - complete without one + | isPragmaPrefix (VFS.fullLine pfix) && "}" `T.isSuffixOf` VFS.fullLine pfix + = J.List $ map (\(a, b, c) -> mkPragmaCompl a b c) (validPragmas Nothing) + -- if there is no closing bracket - complete with one + | isPragmaPrefix (VFS.fullLine pfix) + = J.List $ map (\(a, b, c) -> mkPragmaCompl a b c) (validPragmas (Just "}")) | otherwise = J.List [] result Nothing = J.List [] + isPragmaPrefix line = "{-#" `T.isPrefixOf` line buildCompletion p = J.CompletionItem { _label = p, @@ -187,8 +194,31 @@ completion _ide _ complParams = do _xdata = Nothing } _ -> return $ J.List [] - ----------------------------------------------------------------------- +validPragmas :: Maybe T.Text -> [(T.Text, T.Text, T.Text)] +validPragmas mSuffix = + [ ("LANGUAGE ${1:extension} #-" <> suffix , "LANGUAGE", "{-# LANGUAGE #-}") + , ("OPTIONS_GHC -${1:option} #-" <> suffix , "OPTIONS_GHC", "{-# OPTIONS_GHC #-}") + , ("INLINE ${1:function} #-" <> suffix , "INLINE", "{-# INLINE #-}") + , ("NOINLINE ${1:function} #-" <> suffix , "NOINLINE", "{-# NOINLINE #-}") + , ("INLINABLE ${1:function} #-"<> suffix , "INLINABLE", "{-# INLINABLE #-}") + , ("WARNING ${1:message} #-" <> suffix , "WARNING", "{-# WARNING #-}") + , ("DEPRECATED ${1:message} #-" <> suffix , "DEPRECATED", "{-# DEPRECATED #-}") + , ("ANN ${1:annotation} #-" <> suffix , "ANN", "{-# ANN #-}") + , ("RULES #-" <> suffix , "RULES", "{-# RULES #-}") + , ("SPECIALIZE ${1:function} #-" <> suffix , "SPECIALIZE", "{-# SPECIALIZE #-}") + , ("SPECIALIZE INLINE ${1:function} #-"<> suffix , "SPECIALIZE INLINE", "{-# SPECIALIZE INLINE #-}") + ] + where suffix = case mSuffix of + (Just s) -> s + Nothing -> "" + + +mkPragmaCompl :: T.Text -> T.Text -> T.Text -> J.CompletionItem +mkPragmaCompl insertText label detail = + J.CompletionItem label (Just J.CiKeyword) Nothing (Just detail) + Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just J.Snippet) + Nothing Nothing Nothing Nothing Nothing Nothing -- | Find first line after the last file header pragma -- Defaults to line 0 if the file contains no shebang(s), OPTIONS_GHC pragma(s), or LANGUAGE pragma(s) From 546788c737d36df3f727c35b1cddb51cbecdfac9 Mon Sep 17 00:00:00 2001 From: Alex Naspo Date: Sat, 28 Aug 2021 19:11:26 -0400 Subject: [PATCH 2/3] update pragmas plugin tests --- plugins/hls-pragmas-plugin/test/Main.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/plugins/hls-pragmas-plugin/test/Main.hs b/plugins/hls-pragmas-plugin/test/Main.hs index 987586083b..fb239f16d5 100644 --- a/plugins/hls-pragmas-plugin/test/Main.hs +++ b/plugins/hls-pragmas-plugin/test/Main.hs @@ -207,10 +207,11 @@ completionTests = item ^. L.kind @?= Just CiKeyword item ^. L.insertTextFormat @?= Just Snippet item ^. L.insertText @?= Just "LANGUAGE ${1:extension} #-}" + item ^. L.detail @?= Just "{-# LANGUAGE #-}" - , testCase "completes pragmas no close" $ runSessionWithServer pragmasPlugin testDataDir $ do + , testCase "completes pragmas with existing closing bracket" $ runSessionWithServer pragmasPlugin testDataDir $ do doc <- openDoc "Completion.hs" "haskell" - let te = TextEdit (Range (Position 0 4) (Position 0 24)) "" + let te = TextEdit (Range (Position 0 4) (Position 0 33)) "" _ <- applyEdit doc te compls <- getCompletions doc (Position 0 4) let item = head $ filter ((== "LANGUAGE") . (^. L.label)) compls @@ -218,7 +219,8 @@ completionTests = item ^. L.label @?= "LANGUAGE" item ^. L.kind @?= Just CiKeyword item ^. L.insertTextFormat @?= Just Snippet - item ^. L.insertText @?= Just "LANGUAGE ${1:extension}" + item ^. L.insertText @?= Just "LANGUAGE ${1:extension} #-" + item ^. L.detail @?= Just "{-# LANGUAGE #-}" , testCase "completes options pragma" $ runSessionWithServer pragmasPlugin testDataDir $ do doc <- openDoc "Completion.hs" "haskell" From 81791f107fa09c50662066f4169b1c126d918716 Mon Sep 17 00:00:00 2001 From: Alex Naspo Date: Sun, 29 Aug 2021 21:29:50 -0400 Subject: [PATCH 3/3] move options pragmas to pragmas plugin return empty list from logic completions when opts or pragma start fix empty list logic --- .../IDE/Plugin/Completions/Logic.hs | 20 ++----------------- .../src/Ide/Plugin/Pragmas.hs | 20 +++++++++++++++++++ 2 files changed, 22 insertions(+), 18 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 5bacd40297..cacd881954 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -596,26 +596,18 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu ] filtImportCompls = filtListWith (mkImportCompl enteredQual) importableModules - filtOptsCompls = filtListWith mkExtCompl filtKeywordCompls | T.null prefixModule = filtListWith mkExtCompl (optKeywords ideOpts) | otherwise = [] - stripLeading :: Char -> String -> String - stripLeading _ [] = [] - stripLeading c (s:ss) - | s == c = ss - | otherwise = s:ss if | "import " `T.isPrefixOf` fullLine -> return filtImportCompls -- we leave this condition here to avoid duplications and return empty list - -- since HLS implements this completion (#haskell-language-server/pull/662) - | "{-# language" `T.isPrefixOf` T.toLower fullLine + -- since HLS implements these completions (#haskell-language-server/pull/662) + | "{-# " `T.isPrefixOf` fullLine -> return [] - | "{-# options_ghc" `T.isPrefixOf` T.toLower fullLine - -> return $ filtOptsCompls (map (T.pack . stripLeading '-') $ flagsForCompletion False) | otherwise -> do -- assumes that nubOrdBy is stable let uniqueFiltCompls = nubOrdBy uniqueCompl filtCompls @@ -637,14 +629,6 @@ uniqueCompl x y = then EQ else compare (insertText x) (insertText y) other -> other --- --------------------------------------------------------------------- --- helper functions for pragmas --- --------------------------------------------------------------------- - -pragmaSuffix :: T.Text -> T.Text -pragmaSuffix fullLine - | "}" `T.isSuffixOf` fullLine = mempty - | otherwise = " #-}" -- --------------------------------------------------------------------- -- helper functions for infix backticks diff --git a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs index 541828274e..a939cf57bb 100644 --- a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs +++ b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs @@ -150,6 +150,9 @@ allPragmas = -- --------------------------------------------------------------------- +flags :: [T.Text] +flags = map (T.pack . stripLeading '-') $ flagsForCompletion False + completion :: PluginMethodHandler IdeState 'J.TextDocumentCompletion completion _ide _ complParams = do let (J.TextDocumentIdentifier uri) = complParams ^. J.textDocument @@ -163,6 +166,9 @@ completion _ide _ complParams = do | "{-# LANGUAGE" `T.isPrefixOf` VFS.fullLine pfix = J.List $ map buildCompletion (Fuzzy.simpleFilter (VFS.prefixText pfix) allPragmas) + | "{-# options_ghc" `T.isPrefixOf` T.toLower (VFS.fullLine pfix) + = J.List $ map mkExtCompl + (Fuzzy.simpleFilter (VFS.prefixText pfix) flags) -- if there already is a closing bracket - complete without one | isPragmaPrefix (VFS.fullLine pfix) && "}" `T.isSuffixOf` VFS.fullLine pfix = J.List $ map (\(a, b, c) -> mkPragmaCompl a b c) (validPragmas Nothing) @@ -248,3 +254,17 @@ checkPragma name = check check l = isPragma l && getName l == name getName l = T.take (T.length name) $ T.dropWhile isSpace $ T.drop 3 l isPragma = T.isPrefixOf "{-#" + + +stripLeading :: Char -> String -> String +stripLeading _ [] = [] +stripLeading c (s:ss) + | s == c = ss + | otherwise = s:ss + + +mkExtCompl :: T.Text -> J.CompletionItem +mkExtCompl label = + J.CompletionItem label (Just J.CiKeyword) Nothing Nothing + Nothing Nothing Nothing Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing Nothing Nothing