Skip to content

Commit 6196e0d

Browse files
author
VeryMilkyJoe
committed
Add default-extension completions in .cabal files
Suggest all known language extensions for the `default-extensions` field in .cabal files. Also add a new variation, `mkParameterisedTestCaseM`, of `mkParameterisedTestCase` which takes an Assertion instead checking for equality of the given values.
1 parent 1078d4b commit 6196e0d

File tree

3 files changed

+67
-43
lines changed

3 files changed

+67
-43
lines changed

hls-test-utils/src/Test/Hls.hs

Lines changed: 12 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,7 @@ module Test.Hls
3636
runSessionWithTestConfig,
3737
-- * Running parameterised tests for a set of test configurations
3838
parameterisedCursorTest,
39+
parameterisedCursorTestM,
3940
-- * Helpful re-exports
4041
PluginDescriptor,
4142
IdeState,
@@ -383,8 +384,15 @@ goldenWithDocInTmpDir languageKind config plugin title tree path desc ext act =
383384
-- The quasi quoter '__i' is very helpful to define such tests, as it additionally
384385
-- allows to interpolate haskell values and functions. We reexport this quasi quoter
385386
-- for easier usage.
386-
parameterisedCursorTest :: (Show a, Eq a) => String -> T.Text -> [a] -> (T.Text -> PosPrefixInfo -> IO a) -> TestTree
387-
parameterisedCursorTest title content expectations act
387+
parameterisedCursorTest :: forall a . (Show a, Eq a) => String -> T.Text -> [a] -> (T.Text -> PosPrefixInfo -> IO a) -> TestTree
388+
parameterisedCursorTest title content expectations act = parameterisedCursorTestM title content assertions act
389+
where
390+
assertions = map testCaseAssertion expectations
391+
testCaseAssertion :: a -> PosPrefixInfo -> a -> Assertion
392+
testCaseAssertion expected info actual = assertEqual (mkParameterisedLabel info) actual expected
393+
394+
parameterisedCursorTestM :: String -> T.Text -> [(PosPrefixInfo -> a -> Assertion)] -> (T.Text -> PosPrefixInfo -> IO a) -> TestTree
395+
parameterisedCursorTestM title content expectations act
388396
| lenPrefs /= lenExpected = error $ "parameterisedCursorTest: Expected " <> show lenExpected <> " cursors but found: " <> show lenPrefs
389397
| otherwise = testGroup title $
390398
map singleTest testCaseSpec
@@ -395,9 +403,9 @@ parameterisedCursorTest title content expectations act
395403

396404
testCaseSpec = zip [1 ::Int ..] (zip expectations prefInfos)
397405

398-
singleTest (n, (expected, info)) = testCase (title <> " " <> show n) $ do
406+
singleTest (n, (assert, info)) = testCase (title <> " " <> show n) $ do
399407
actual <- act cleanText info
400-
assertEqual (mkParameterisedLabel info) expected actual
408+
assert info actual
401409

402410
-- ------------------------------------------------------------
403411
-- Helper function for initialising plugins under test

plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Data.hs

Lines changed: 17 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,8 @@ import Ide.Plugin.Cabal.Completion.Completer.Simple
1515
import Ide.Plugin.Cabal.Completion.Completer.Types (Completer)
1616
import Ide.Plugin.Cabal.Completion.Types
1717
import Ide.Plugin.Cabal.LicenseSuggest (licenseNames)
18-
18+
import Language.Haskell.Extension
19+
import Distribution.Pretty (prettyShow)
1920
-- | Ad-hoc data type for modelling the available top-level stanzas.
2021
-- Not intended right now for anything else but to avoid string
2122
-- comparisons in 'stanzaKeywordMap' and 'libExecTestBenchCommons'.
@@ -177,8 +178,8 @@ libExecTestBenchCommons st =
177178
[ ("import:", importCompleter),
178179
("build-depends:", noopCompleter),
179180
("hs-source-dirs:", directoryCompleter),
180-
("default-extensions:", noopCompleter),
181-
("other-extensions:", noopCompleter),
181+
("default-extensions:", constantCompleter $ map (T.pack . prettyShow) allExtensions),
182+
("other-extensions:", constantCompleter $ map (T.pack . prettyShow) allExtensions),
182183
("default-language:", constantCompleter ["GHC2021", "Haskell2010", "Haskell98"]),
183184
("other-languages:", noopCompleter),
184185
("build-tool-depends:", noopCompleter),
@@ -235,6 +236,19 @@ libExecTestBenchCommons st =
235236
-- but not have erased the "common" stanza.
236237
noopCompleter
237238

239+
-- | Returns all possible language extensions including disabled ones.
240+
allExtensions :: [Extension]
241+
allExtensions =
242+
concatMap
243+
( \e ->
244+
-- These pragmas cannot be negated as they are not reversible
245+
-- by prepending "No".
246+
if e `notElem` [Unsafe, Trustworthy, Safe]
247+
then [EnableExtension e, DisableExtension e]
248+
else [EnableExtension e]
249+
)
250+
knownExtensions
251+
238252
-- | Contains a map of the most commonly used licenses, weighted by their popularity.
239253
--
240254
-- The data was extracted by Kleidukos from the alternative hackage frontend flora.pm.

plugins/hls-cabal-plugin/test/Completer.hs

Lines changed: 38 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,8 @@ import System.FilePath
3131
import Test.Hls
3232
import qualified Text.Fuzzy.Parallel as Fuzzy
3333
import Utils
34+
import Test.Hls.FileSystem (text, file, mkVirtualFileTree)
35+
import Development.IDE.Plugin.Completions.Types (cursorPos)
3436

3537
completerTests :: TestTree
3638
completerTests =
@@ -73,7 +75,20 @@ basicCompleterTests =
7375
let complTexts = getTextEditTexts compls
7476
liftIO $ assertBool "suggests f2" $ "f2.hs" `elem` complTexts
7577
liftIO $ assertBool "does not suggest" $ "Content.hs" `notElem` complTexts
76-
]
78+
, parameterisedCursorTestM "extensions completion" libraryStanzaData
79+
[ \_ actual -> assertBool "suggests FieldSelectors" $ "FieldSelectors" `elem` actual
80+
, \_ actual -> assertBool "suggests OverloadedStrings" $ "OverloadedStrings" `elem` actual
81+
, \_ actual -> assertBool "suggests something" $ not . null $ actual
82+
, \_ actual -> assertBool "suggests NoLambdaCase" $ "NoLambdaCase" `elem` actual
83+
, \_ actual -> assertBool "suggests RecordWildCards" $ "RecordWildCards" `elem` actual
84+
]
85+
$ \fileContent posPrefInfo -> do
86+
let vFileTree = mkVirtualFileTree "" $ [file "cabalFile.cabal" $ text fileContent]
87+
runCabalSessionVft vFileTree $ do
88+
doc <- openDoc "cabalFile.cabal" "cabal"
89+
compls <- getCompletions doc (cursorPos posPrefInfo)
90+
let complTexts = getTextEditTexts compls
91+
pure complTexts]
7792
where
7893
getTextEditTexts :: [CompletionItem] -> [T.Text]
7994
getTextEditTexts compls = mapMaybe (^? L.textEdit . _Just . _L . L.newText) compls
@@ -401,40 +416,27 @@ extract item = case item ^. L.textEdit of
401416
Just (InL v) -> v ^. L.newText
402417
_ -> error ""
403418

404-
importTestData :: T.Text
405-
importTestData = [__i|
406-
cabal-version: 3.0
407-
name: hls-cabal-plugin
408-
version: 0.1.0.0
409-
synopsis:
410-
homepage:
411-
license: MIT
412-
license-file: LICENSE
413-
author: Fendor
414-
maintainer: fendor@posteo.de
415-
category: Development
416-
extra-source-files: CHANGELOG.md
417-
418-
common defaults
419-
default-language: GHC2021
420-
-- Should have been in GHC2021, an oversight
421-
default-extensions: ExplicitNamespaces
422-
423-
common test-defaults
424-
ghc-options: -threaded -rtsopts -with-rtsopts=-N
425-
426-
library
427-
import:
428-
^
429-
exposed-modules: IDE.Plugin.Cabal
430-
build-depends: base ^>=4.14.3.0
431-
hs-source-dirs: src
432-
default-language: Haskell2010
433-
434-
common notForLib
435-
default-language: GHC2021
419+
-- ------------------------------------------------------------------------
420+
-- Test Data
421+
-- ------------------------------------------------------------------------
436422

437-
test-suite tests
438-
import:
439-
^
423+
libraryStanzaData :: T.Text
424+
libraryStanzaData = [__i|
425+
cabal-version: 3.0
426+
name: simple-cabal
427+
common mylib
428+
default-extensions: Field
429+
^
430+
library
431+
default-extensions: Ov
432+
^
433+
test-suite mysuite
434+
default-extensions:
435+
^
436+
executable myexe
437+
default-extensions: NoLam
438+
^
439+
benchmark mybench
440+
other-extensions: RecordW
441+
^
440442
|]

0 commit comments

Comments
 (0)