Skip to content

Commit 0c3f1c4

Browse files
Ailrunmergify[bot]
Ailrun
and
mergify[bot]
authored
Fix some pragma completion cases (#2474)
* 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>
1 parent 0b6b5ec commit 0c3f1c4

File tree

4 files changed

+37
-36
lines changed

4 files changed

+37
-36
lines changed

‎plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs

Lines changed: 25 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -210,22 +210,24 @@ completion _ide _ complParams = do
210210
result <$> VFS.getCompletionPrefix position cnts
211211
where
212212
result (Just pfix)
213-
| "{-# language" `T.isPrefixOf` T.toLower (VFS.fullLine pfix)
213+
| "{-# language" `T.isPrefixOf` line
214214
= J.List $ map buildCompletion
215215
(Fuzzy.simpleFilter (VFS.prefixText pfix) allPragmas)
216-
| "{-# options_ghc" `T.isPrefixOf` T.toLower (VFS.fullLine pfix)
216+
| "{-# options_ghc" `T.isPrefixOf` line
217217
= J.List $ map mkExtCompl
218218
(Fuzzy.simpleFilter (VFS.prefixText pfix) flags)
219-
-- if there already is a closing bracket - complete without one
220-
| isPragmaPrefix (VFS.fullLine pfix) && "}" `T.isSuffixOf` VFS.fullLine pfix
221-
= J.List $ map (\(a, b, c) -> mkPragmaCompl a b c) (validPragmas Nothing)
222-
-- if there is no closing bracket - complete with one
223-
| isPragmaPrefix (VFS.fullLine pfix)
224-
= J.List $ map (\(a, b, c) -> mkPragmaCompl a b c) (validPragmas (Just "}"))
219+
| "{-#" `T.isPrefixOf` line
220+
= J.List $ map (\(a, b, c) -> mkPragmaCompl (a <> suffix) b c) validPragmas
225221
| otherwise
226222
= J.List []
223+
where
224+
line = T.toLower $ VFS.fullLine pfix
225+
suffix
226+
| "#-}" `T.isSuffixOf` line = " "
227+
| "-}" `T.isSuffixOf` line = " #"
228+
| "}" `T.isSuffixOf` line = " #-"
229+
| otherwise = " #-}"
227230
result Nothing = J.List []
228-
isPragmaPrefix line = "{-#" `T.isPrefixOf` line
229231
buildCompletion p =
230232
J.CompletionItem
231233
{ _label = p,
@@ -247,24 +249,22 @@ completion _ide _ complParams = do
247249
_xdata = Nothing
248250
}
249251
_ -> return $ J.List []
252+
250253
-----------------------------------------------------------------------
251-
validPragmas :: Maybe T.Text -> [(T.Text, T.Text, T.Text)]
252-
validPragmas mSuffix =
253-
[ ("LANGUAGE ${1:extension} #-" <> suffix , "LANGUAGE", "{-# LANGUAGE #-}")
254-
, ("OPTIONS_GHC -${1:option} #-" <> suffix , "OPTIONS_GHC", "{-# OPTIONS_GHC #-}")
255-
, ("INLINE ${1:function} #-" <> suffix , "INLINE", "{-# INLINE #-}")
256-
, ("NOINLINE ${1:function} #-" <> suffix , "NOINLINE", "{-# NOINLINE #-}")
257-
, ("INLINABLE ${1:function} #-"<> suffix , "INLINABLE", "{-# INLINABLE #-}")
258-
, ("WARNING ${1:message} #-" <> suffix , "WARNING", "{-# WARNING #-}")
259-
, ("DEPRECATED ${1:message} #-" <> suffix , "DEPRECATED", "{-# DEPRECATED #-}")
260-
, ("ANN ${1:annotation} #-" <> suffix , "ANN", "{-# ANN #-}")
261-
, ("RULES #-" <> suffix , "RULES", "{-# RULES #-}")
262-
, ("SPECIALIZE ${1:function} #-" <> suffix , "SPECIALIZE", "{-# SPECIALIZE #-}")
263-
, ("SPECIALIZE INLINE ${1:function} #-"<> suffix , "SPECIALIZE INLINE", "{-# SPECIALIZE INLINE #-}")
254+
validPragmas :: [(T.Text, T.Text, T.Text)]
255+
validPragmas =
256+
[ ("LANGUAGE ${1:extension}" , "LANGUAGE", "{-# LANGUAGE #-}")
257+
, ("OPTIONS_GHC -${1:option}" , "OPTIONS_GHC", "{-# OPTIONS_GHC #-}")
258+
, ("INLINE ${1:function}" , "INLINE", "{-# INLINE #-}")
259+
, ("NOINLINE ${1:function}" , "NOINLINE", "{-# NOINLINE #-}")
260+
, ("INLINABLE ${1:function}" , "INLINABLE", "{-# INLINABLE #-}")
261+
, ("WARNING ${1:message}" , "WARNING", "{-# WARNING #-}")
262+
, ("DEPRECATED ${1:message}" , "DEPRECATED", "{-# DEPRECATED #-}")
263+
, ("ANN ${1:annotation}" , "ANN", "{-# ANN #-}")
264+
, ("RULES" , "RULES", "{-# RULES #-}")
265+
, ("SPECIALIZE ${1:function}" , "SPECIALIZE", "{-# SPECIALIZE #-}")
266+
, ("SPECIALIZE INLINE ${1:function}" , "SPECIALIZE INLINE", "{-# SPECIALIZE INLINE #-}")
264267
]
265-
where suffix = case mSuffix of
266-
(Just s) -> s
267-
Nothing -> ""
268268

269269

270270
mkPragmaCompl :: T.Text -> T.Text -> T.Text -> J.CompletionItem

‎plugins/hls-pragmas-plugin/test/Main.hs

Lines changed: 8 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -27,14 +27,13 @@ tests =
2727
codeActionTests :: TestTree
2828
codeActionTests =
2929
testGroup "code actions"
30-
[
31-
codeActionTest "Block comment then line comment doesn't split line" "BlockCommentThenLineComment" [("Add \"TupleSections\"", "Contains TupleSections code action")]
30+
[ codeActionTest "Block comment then line comment doesn't split line" "BlockCommentThenLineComment" [("Add \"TupleSections\"", "Contains TupleSections code action")]
3231
, codeActionTest "Block comment then single-line block comment doesn't split line" "BlockCommentThenSingleLineBlockComment" [("Add \"TupleSections\"", "Contains TupleSections code action")]
3332
, codeActionTest "Block comment then multi-line block comment doesn't split line" "BlockCommentThenMultiLineBlockComment" [("Add \"TupleSections\"", "Contains TupleSections code action")]
3433
, codeActionTest "Block comment then line haddock splits line" "BlockCommentThenLineHaddock" [("Add \"TupleSections\"", "Contains TupleSections code action")]
35-
, codeActionTest "Block comment then single-line block haddock splits line" "BlockCommentThenSingleLineBlockHaddock" [("Add \"TupleSections\"", "Contains TupleSections code action")]
36-
, codeActionTest "Block comment then multi-line block haddock splits line" "BlockCommentThenMultiLineBlockHaddock" [("Add \"TupleSections\"", "Contains TupleSections code action")]
37-
, codeActionTest "Pragma then line comment doesn't split line" "PragmaThenLineComment" [("Add \"TupleSections\"", "Contains TupleSections code action")]
34+
, codeActionTest "Block comment then single-line block haddock splits line" "BlockCommentThenSingleLineBlockHaddock" [("Add \"TupleSections\"", "Contains TupleSections code action")]
35+
, codeActionTest "Block comment then multi-line block haddock splits line" "BlockCommentThenMultiLineBlockHaddock" [("Add \"TupleSections\"", "Contains TupleSections code action")]
36+
, codeActionTest "Pragma then line comment doesn't split line" "PragmaThenLineComment" [("Add \"TupleSections\"", "Contains TupleSections code action")]
3837
, codeActionTest "Pragma then single-line block comment doesn't split line" "PragmaThenSingleLineBlockComment" [("Add \"TupleSections\"", "Contains TupleSections code action")]
3938
, codeActionTest "Pragma then multi-line block comment splits line" "PragmaThenMultiLineBlockComment" [("Add \"TupleSections\"", "Contains TupleSections code action")]
4039
, codeActionTest "Pragma then line haddock splits line" "PragmaThenLineHaddock" [("Add \"TupleSections\"", "Contains TupleSections code action")]
@@ -99,8 +98,10 @@ codeActionTests' =
9998

10099
completionTests :: TestTree
101100
completionTests =
102-
testGroup "completions" [
103-
completionTest "completes pragmas" "Completion.hs" "" "LANGUAGE" (Just Snippet) (Just "LANGUAGE ${1:extension} #-}") (Just "{-# LANGUAGE #-}") [0, 4, 0, 34, 0, 4]
101+
testGroup "completions"
102+
[ completionTest "completes pragmas" "Completion.hs" "" "LANGUAGE" (Just Snippet) (Just "LANGUAGE ${1:extension} #-}") (Just "{-# LANGUAGE #-}") [0, 4, 0, 34, 0, 4]
103+
, 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]
104+
, 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]
104105
, completionTest "completes pragmas with existing closing bracket" "Completion.hs" "" "LANGUAGE" (Just Snippet) (Just "LANGUAGE ${1:extension} #-") (Just "{-# LANGUAGE #-}") [0, 4, 0, 33, 0, 4]
105106
, 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]
106107
, 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]

‎plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenMultiLineBlockHaddock.expected.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@ haddock
77
-}
88

99
module BlockCommentThenMultiLineBlockHaddock where
10-
import GHC.SourceGen (multiIf)
11-
import Diagrams (block)
10+
import Data.List (intercalate)
11+
import System.IO (hFlush)
1212

1313
a = (1,)

‎plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenMultiLineBlockHaddock.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ haddock
55
-}
66

77
module BlockCommentThenMultiLineBlockHaddock where
8-
import GHC.SourceGen (multiIf)
9-
import Diagrams (block)
8+
import Data.List (intercalate)
9+
import System.IO (hFlush)
1010

1111
a = (1,)

0 commit comments

Comments
 (0)