diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs index 1e05e0fa20..a7acad46c4 100644 --- a/hls-test-utils/src/Test/Hls.hs +++ b/hls-test-utils/src/Test/Hls.hs @@ -36,6 +36,7 @@ module Test.Hls runSessionWithTestConfig, -- * Running parameterised tests for a set of test configurations parameterisedCursorTest, + parameterisedCursorTestM, -- * Helpful re-exports PluginDescriptor, IdeState, @@ -383,8 +384,15 @@ goldenWithDocInTmpDir languageKind config plugin title tree path desc ext act = -- The quasi quoter '__i' is very helpful to define such tests, as it additionally -- allows to interpolate haskell values and functions. We reexport this quasi quoter -- for easier usage. -parameterisedCursorTest :: (Show a, Eq a) => String -> T.Text -> [a] -> (T.Text -> PosPrefixInfo -> IO a) -> TestTree -parameterisedCursorTest title content expectations act +parameterisedCursorTest :: forall a . (Show a, Eq a) => String -> T.Text -> [a] -> (T.Text -> PosPrefixInfo -> IO a) -> TestTree +parameterisedCursorTest title content expectations act = parameterisedCursorTestM title content assertions act + where + assertions = map testCaseAssertion expectations + testCaseAssertion :: a -> PosPrefixInfo -> a -> Assertion + testCaseAssertion expected info actual = assertEqual (mkParameterisedLabel info) expected actual + +parameterisedCursorTestM :: String -> T.Text -> [(PosPrefixInfo -> a -> Assertion)] -> (T.Text -> PosPrefixInfo -> IO a) -> TestTree +parameterisedCursorTestM title content expectations act | lenPrefs /= lenExpected = error $ "parameterisedCursorTest: Expected " <> show lenExpected <> " cursors but found: " <> show lenPrefs | otherwise = testGroup title $ map singleTest testCaseSpec @@ -395,9 +403,9 @@ parameterisedCursorTest title content expectations act testCaseSpec = zip [1 ::Int ..] (zip expectations prefInfos) - singleTest (n, (expected, info)) = testCase (title <> " " <> show n) $ do + singleTest (n, (assert, info)) = testCase (title <> " " <> show n) $ do actual <- act cleanText info - assertEqual (mkParameterisedLabel info) expected actual + assert info actual -- ------------------------------------------------------------ -- Helper function for initialising plugins under test diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Data.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Data.hs index 03e517eae2..6942980ef2 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Data.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Data.hs @@ -8,6 +8,7 @@ import qualified Data.Text as T import Development.IDE.GHC.Compat.Core (flagsForCompletion) import Distribution.CabalSpecVersion (CabalSpecVersion (CabalSpecV2_2), showCabalSpecVersion) +import Distribution.Pretty (prettyShow) import Ide.Plugin.Cabal.Completion.Completer.FilePath import Ide.Plugin.Cabal.Completion.Completer.Module import Ide.Plugin.Cabal.Completion.Completer.Paths @@ -15,7 +16,7 @@ import Ide.Plugin.Cabal.Completion.Completer.Simple import Ide.Plugin.Cabal.Completion.Completer.Types (Completer) import Ide.Plugin.Cabal.Completion.Types import Ide.Plugin.Cabal.LicenseSuggest (licenseNames) - +import Language.Haskell.Extension -- | Ad-hoc data type for modelling the available top-level stanzas. -- Not intended right now for anything else but to avoid string -- comparisons in 'stanzaKeywordMap' and 'libExecTestBenchCommons'. @@ -177,8 +178,8 @@ libExecTestBenchCommons st = [ ("import:", importCompleter), ("build-depends:", noopCompleter), ("hs-source-dirs:", directoryCompleter), - ("default-extensions:", noopCompleter), - ("other-extensions:", noopCompleter), + ("default-extensions:", constantCompleter $ map (T.pack . prettyShow) allExtensions), + ("other-extensions:", constantCompleter $ map (T.pack . prettyShow) allExtensions), ("default-language:", constantCompleter ["GHC2021", "Haskell2010", "Haskell98"]), ("other-languages:", noopCompleter), ("build-tool-depends:", noopCompleter), @@ -235,6 +236,19 @@ libExecTestBenchCommons st = -- but not have erased the "common" stanza. noopCompleter +-- | Returns all possible language extensions including disabled ones. +allExtensions :: [Extension] +allExtensions = + concatMap + ( \e -> + -- These pragmas cannot be negated as they are not reversible + -- by prepending "No". + if e `notElem` [Unsafe, Trustworthy, Safe] + then [EnableExtension e, DisableExtension e] + else [EnableExtension e] + ) + knownExtensions + -- | Contains a map of the most commonly used licenses, weighted by their popularity. -- -- The data was extracted by Kleidukos from the alternative hackage frontend flora.pm. diff --git a/plugins/hls-cabal-plugin/test/Completer.hs b/plugins/hls-cabal-plugin/test/Completer.hs index f810127f53..951884e252 100644 --- a/plugins/hls-cabal-plugin/test/Completer.hs +++ b/plugins/hls-cabal-plugin/test/Completer.hs @@ -12,6 +12,7 @@ import qualified Data.ByteString as ByteString import qualified Data.ByteString.Char8 as BS8 import Data.Maybe (mapMaybe) import qualified Data.Text as T +import Development.IDE.Plugin.Completions.Types (cursorPos) import qualified Development.IDE.Plugin.Completions.Types as Ghcide import qualified Distribution.Fields as Syntax import Distribution.PackageDescription (GenericPackageDescription) @@ -29,6 +30,9 @@ import Ide.Plugin.Cabal.Completion.Types (CabalPrefixInfo import qualified Language.LSP.Protocol.Lens as L import System.FilePath import Test.Hls +import Test.Hls.FileSystem (file, + mkVirtualFileTree, + text) import qualified Text.Fuzzy.Parallel as Fuzzy import Utils @@ -73,7 +77,20 @@ basicCompleterTests = let complTexts = getTextEditTexts compls liftIO $ assertBool "suggests f2" $ "f2.hs" `elem` complTexts liftIO $ assertBool "does not suggest" $ "Content.hs" `notElem` complTexts - ] + , parameterisedCursorTestM "extensions completion" libraryStanzaData + [ \_ actual -> assertBool "suggests FieldSelectors" $ "FieldSelectors" `elem` actual + , \_ actual -> assertBool "suggests OverloadedStrings" $ "OverloadedStrings" `elem` actual + , \_ actual -> assertBool "suggests something" $ not . null $ actual + , \_ actual -> assertBool "suggests NoLambdaCase" $ "NoLambdaCase" `elem` actual + , \_ actual -> assertBool "suggests RecordWildCards" $ "RecordWildCards" `elem` actual + ] + $ \fileContent posPrefInfo -> do + let vFileTree = mkVirtualFileTree "" $ [file "cabalFile.cabal" $ text fileContent] + runCabalSessionVft vFileTree $ do + doc <- openDoc "cabalFile.cabal" "cabal" + compls <- getCompletions doc (cursorPos posPrefInfo) + let complTexts = getTextEditTexts compls + pure complTexts] where getTextEditTexts :: [CompletionItem] -> [T.Text] getTextEditTexts compls = mapMaybe (^? L.textEdit . _Just . _L . L.newText) compls @@ -401,40 +418,27 @@ extract item = case item ^. L.textEdit of Just (InL v) -> v ^. L.newText _ -> error "" -importTestData :: T.Text -importTestData = [__i| - cabal-version: 3.0 - name: hls-cabal-plugin - version: 0.1.0.0 - synopsis: - homepage: - license: MIT - license-file: LICENSE - author: Fendor - maintainer: fendor@posteo.de - category: Development - extra-source-files: CHANGELOG.md - - common defaults - default-language: GHC2021 - -- Should have been in GHC2021, an oversight - default-extensions: ExplicitNamespaces - - common test-defaults - ghc-options: -threaded -rtsopts -with-rtsopts=-N - - library - import: - ^ - exposed-modules: IDE.Plugin.Cabal - build-depends: base ^>=4.14.3.0 - hs-source-dirs: src - default-language: Haskell2010 - - common notForLib - default-language: GHC2021 +-- ------------------------------------------------------------------------ +-- Test Data +-- ------------------------------------------------------------------------ - test-suite tests - import: - ^ +libraryStanzaData :: T.Text +libraryStanzaData = [__i| + cabal-version: 3.0 + name: simple-cabal + common mylib + default-extensions: Field + ^ + library + default-extensions: Ov + ^ + test-suite mysuite + default-extensions: + ^ + executable myexe + default-extensions: NoLam + ^ + benchmark mybench + other-extensions: RecordW + ^ |]