Skip to content

Commit

Permalink
Fix some pragma completion cases (#2474)
Browse files Browse the repository at this point in the history 
* Update pragmas test to be more robust

* Make in-line pragma completions more robust

* Minor style change for pragma plugin tests

Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>
  • Loading branch information
@Ailrun @mergify
Ailrun and mergify[bot] committed Dec 13, 2021
1 parent 0b6b5ec commit 0c3f1c4
Show file tree
Hide file tree
Showing 4 changed files with 37 additions and 36 deletions.
50 changes: 25 additions & 25 deletions plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -210,22 +210,24 @@ completion _ide _ complParams = do
result <$> VFS.getCompletionPrefix position cnts
where
result (Just pfix)
| "{-# language" `T.isPrefixOf` T.toLower (VFS.fullLine pfix)
| "{-# language" `T.isPrefixOf` line
= J.List $ map buildCompletion
(Fuzzy.simpleFilter (VFS.prefixText pfix) allPragmas)
| "{-# options_ghc" `T.isPrefixOf` T.toLower (VFS.fullLine pfix)
| "{-# options_ghc" `T.isPrefixOf` line
= 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 "}"))
| "{-#" `T.isPrefixOf` line
= J.List $ map (\(a, b, c) -> mkPragmaCompl (a <> suffix) b c) validPragmas
| otherwise
= J.List []
where
line = T.toLower $ VFS.fullLine pfix
suffix
| "#-}" `T.isSuffixOf` line = " "
| "-}" `T.isSuffixOf` line = " #"
| "}" `T.isSuffixOf` line = " #-"
| otherwise = " #-}"
result Nothing = J.List []
isPragmaPrefix line = "{-#" `T.isPrefixOf` line
buildCompletion p =
J.CompletionItem
{ _label = p,
Expand All @@ -247,24 +249,22 @@ 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 #-}")
validPragmas :: [(T.Text, T.Text, T.Text)]
validPragmas =
[ ("LANGUAGE ${1:extension}" , "LANGUAGE", "{-# LANGUAGE #-}")
, ("OPTIONS_GHC -${1:option}" , "OPTIONS_GHC", "{-# OPTIONS_GHC #-}")
, ("INLINE ${1:function}" , "INLINE", "{-# INLINE #-}")
, ("NOINLINE ${1:function}" , "NOINLINE", "{-# NOINLINE #-}")
, ("INLINABLE ${1:function}" , "INLINABLE", "{-# INLINABLE #-}")
, ("WARNING ${1:message}" , "WARNING", "{-# WARNING #-}")
, ("DEPRECATED ${1:message}" , "DEPRECATED", "{-# DEPRECATED #-}")
, ("ANN ${1:annotation}" , "ANN", "{-# ANN #-}")
, ("RULES" , "RULES", "{-# RULES #-}")
, ("SPECIALIZE ${1:function}" , "SPECIALIZE", "{-# SPECIALIZE #-}")
, ("SPECIALIZE INLINE ${1:function}" , "SPECIALIZE INLINE", "{-# SPECIALIZE INLINE #-}")
]
where suffix = case mSuffix of
(Just s) -> s
Nothing -> ""


mkPragmaCompl :: T.Text -> T.Text -> T.Text -> J.CompletionItem
Expand Down
15 changes: 8 additions & 7 deletions plugins/hls-pragmas-plugin/test/Main.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -27,14 +27,13 @@ tests =
codeActionTests :: TestTree
codeActionTests =
testGroup "code actions"
[
codeActionTest "Block comment then line comment doesn't split line" "BlockCommentThenLineComment" [("Add \"TupleSections\"", "Contains TupleSections code action")]
[ codeActionTest "Block comment then line comment doesn't split line" "BlockCommentThenLineComment" [("Add \"TupleSections\"", "Contains TupleSections code action")]
, codeActionTest "Block comment then single-line block comment doesn't split line" "BlockCommentThenSingleLineBlockComment" [("Add \"TupleSections\"", "Contains TupleSections code action")]
, codeActionTest "Block comment then multi-line block comment doesn't split line" "BlockCommentThenMultiLineBlockComment" [("Add \"TupleSections\"", "Contains TupleSections code action")]
, codeActionTest "Block comment then line haddock splits line" "BlockCommentThenLineHaddock" [("Add \"TupleSections\"", "Contains TupleSections code action")]
, codeActionTest "Block comment then single-line block haddock splits line" "BlockCommentThenSingleLineBlockHaddock" [("Add \"TupleSections\"", "Contains TupleSections code action")]
, codeActionTest "Block comment then multi-line block haddock splits line" "BlockCommentThenMultiLineBlockHaddock" [("Add \"TupleSections\"", "Contains TupleSections code action")]
, codeActionTest "Pragma then line comment doesn't split line" "PragmaThenLineComment" [("Add \"TupleSections\"", "Contains TupleSections code action")]
, codeActionTest "Block comment then single-line block haddock splits line" "BlockCommentThenSingleLineBlockHaddock" [("Add \"TupleSections\"", "Contains TupleSections code action")]
, codeActionTest "Block comment then multi-line block haddock splits line" "BlockCommentThenMultiLineBlockHaddock" [("Add \"TupleSections\"", "Contains TupleSections code action")]
, codeActionTest "Pragma then line comment doesn't split line" "PragmaThenLineComment" [("Add \"TupleSections\"", "Contains TupleSections code action")]
, codeActionTest "Pragma then single-line block comment doesn't split line" "PragmaThenSingleLineBlockComment" [("Add \"TupleSections\"", "Contains TupleSections code action")]
, codeActionTest "Pragma then multi-line block comment splits line" "PragmaThenMultiLineBlockComment" [("Add \"TupleSections\"", "Contains TupleSections code action")]
, codeActionTest "Pragma then line haddock splits line" "PragmaThenLineHaddock" [("Add \"TupleSections\"", "Contains TupleSections code action")]
Expand Down Expand Up @@ -99,8 +98,10 @@ codeActionTests' =

completionTests :: TestTree
completionTests =
testGroup "completions" [
completionTest "completes pragmas" "Completion.hs" "" "LANGUAGE" (Just Snippet) (Just "LANGUAGE ${1:extension} #-}") (Just "{-# LANGUAGE #-}") [0, 4, 0, 34, 0, 4]
testGroup "completions"
[ completionTest "completes pragmas" "Completion.hs" "" "LANGUAGE" (Just Snippet) (Just "LANGUAGE ${1:extension} #-}") (Just "{-# LANGUAGE #-}") [0, 4, 0, 34, 0, 4]
, completionTest "completes pragmas with existing closing pragma bracket" "Completion.hs" "" "LANGUAGE" (Just Snippet) (Just "LANGUAGE ${1:extension} ") (Just "{-# LANGUAGE #-}") [0, 4, 0, 31, 0, 4]
, completionTest "completes pragmas with existing closing comment bracket" "Completion.hs" "" "LANGUAGE" (Just Snippet) (Just "LANGUAGE ${1:extension} #") (Just "{-# LANGUAGE #-}") [0, 4, 0, 32, 0, 4]
, completionTest "completes pragmas with existing closing bracket" "Completion.hs" "" "LANGUAGE" (Just Snippet) (Just "LANGUAGE ${1:extension} #-") (Just "{-# LANGUAGE #-}") [0, 4, 0, 33, 0, 4]
, completionTest "completes options pragma" "Completion.hs" "OPTIONS" "OPTIONS_GHC" (Just Snippet) (Just "OPTIONS_GHC -${1:option} #-}") (Just "{-# OPTIONS_GHC #-}") [0, 4, 0, 34, 0, 4]
, completionTest "completes ghc options pragma values" "Completion.hs" "{-# OPTIONS_GHC -Wno-red #-}\n" "Wno-redundant-constraints" Nothing Nothing Nothing [0, 0, 0, 0, 0, 24]
Expand Down
4 changes: 2 additions & 2 deletions plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenMultiLineBlockHaddock.expected.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@ haddock
-}

module BlockCommentThenMultiLineBlockHaddock where
import GHC.SourceGen (multiIf)
import Diagrams (block)
import Data.List (intercalate)
import System.IO (hFlush)

a = (1,)
4 changes: 2 additions & 2 deletions plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenMultiLineBlockHaddock.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@ haddock
-}

module BlockCommentThenMultiLineBlockHaddock where
import GHC.SourceGen (multiIf)
import Diagrams (block)
import Data.List (intercalate)
import System.IO (hFlush)

a = (1,)

0 comments on commit 0c3f1c4

Please sign in to comment.