diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 5371583955..cacd881954 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,36 +595,19 @@ 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) | 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 - -> return [] - | "{-# options_ghc" `T.isPrefixOf` T.toLower fullLine - -> return $ filtOptsCompls (map (T.pack . stripLeading '-') $ flagsForCompletion False) + -- since HLS implements these completions (#haskell-language-server/pull/662) | "{-# " `T.isPrefixOf` fullLine - -> return $ filtPragmaCompls (pragmaSuffix fullLine) + -> return [] | otherwise -> do -- assumes that nubOrdBy is stable let uniqueFiltCompls = nubOrdBy uniqueCompl filtCompls @@ -651,29 +629,6 @@ uniqueCompl x y = then EQ else compare (insertText x) (insertText y) other -> other --- --------------------------------------------------------------------- --- 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 - | 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 444722e18d..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,9 +166,19 @@ 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) + -- 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 +200,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) @@ -218,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 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"