Add golden test for fixing field typos

Author: crtschin

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

@@ -28,6 +28,7 @@ import           Ide.Plugin.Cabal.Completion.Types              (CabalPrefixInfo
 import qualified Language.LSP.Protocol.Lens                     as L
 import           System.FilePath
 import           Test.Hls
+import qualified Text.Fuzzy.Parallel                            as Fuzzy
 import           Utils
 
 completerTests :: TestTree
@@ -270,7 +271,7 @@ filePathExposedModulesTests =
     callFilePathsForExposedModules :: [FilePath] -> IO [T.Text]
     callFilePathsForExposedModules srcDirs = do
       let prefInfo = simpleCabalPrefixInfoFromFp "" exposedTestDir
-      filePathsForExposedModules mempty srcDirs prefInfo
+      filePathsForExposedModules mempty srcDirs prefInfo $ Fuzzy.Matcher $ Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults
 
 exposedModuleCompleterTests :: TestTree
 exposedModuleCompleterTests =
@@ -366,11 +367,19 @@ simpleCompleterData sName dir pref = do
         cabalContents <- ByteString.readFile $ testDataDir </> "exposed.cabal"
         pure $ parseGenericPackageDescriptionMaybe cabalContents,
       getCabalCommonSections = undefined,
-      stanzaName = sName
+      stanzaName = sName,
+      matcher = Fuzzy.Matcher $ Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults
     }
 
 mkCompleterData :: CabalPrefixInfo -> CompleterData
-mkCompleterData prefInfo = CompleterData {getLatestGPD = undefined, getCabalCommonSections = undefined, cabalPrefixInfo = prefInfo, stanzaName = Nothing}
+mkCompleterData prefInfo =
+  CompleterData
+    { getLatestGPD = undefined,
+      getCabalCommonSections = undefined,
+      cabalPrefixInfo = prefInfo,
+      stanzaName = Nothing,
+      matcher = Fuzzy.Matcher $ Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults
+    }
 
 exposedTestDir :: FilePath
 exposedTestDir = addTrailingPathSeparator $ testDataDir </> "src-modules"

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

@@ -14,10 +14,9 @@ import           Completer                       (completerTests)
 import           Context                         (contextTests)
 import           Control.Lens                    ((^.))
 import           Control.Lens.Fold               ((^?))
-import           Control.Monad                   (guard)
+import           Control.Monad                   (forM_, guard)
 import qualified Data.ByteString                 as BS
 import           Data.Either                     (isRight)
-import           Data.List.Extra                 (nubOrdOn)
 import qualified Data.Maybe                      as Maybe
 import           Data.Text                       (Text)
 import qualified Data.Text                       as T
@@ -26,6 +25,7 @@ import           Definition                      (gotoDefinitionTests)
 import           Development.IDE.Test
 import           Ide.Plugin.Cabal.LicenseSuggest (licenseErrorSuggestion)
 import qualified Ide.Plugin.Cabal.Parse          as Lib
+import           Language.LSP.Protocol.Lens      (HasRange (..))
 import qualified Language.LSP.Protocol.Lens      as L
 import qualified Language.LSP.Protocol.Message   as L
 import           Outline                         (outlineTests)
@@ -191,32 +191,29 @@ codeActionTests = testGroup "Code Actions"
                     , "    build-depends:    base"
                     , "    default-language: Haskell2010"
                     ]
-    , runCabalGoldenSession "Code Actions - Can fix field names" "code-actions" "FieldSuggestions" $ \doc -> do
-        _ <- waitForDiagnosticsFrom doc
-        cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions doc
-        -- Filter out the code actions we want to invoke.
-        -- We only want to invoke Code Actions with certain titles, and
-        -- we want to invoke them only once, not once for each cursor request.
-        -- 'getAllCodeActions' iterates over each cursor position and requests code actions.
-        let selectedCas = nubOrdOn (^. L.title) $ filter
-                (\ca -> (ca ^. L.title) `elem`
-                    [ "Replace with license"
-                    , "Replace with build-type"
-                    , "Replace with extra-doc-files"
-                    , "Replace with ghc-options"
-                    , "Replace with location"
-                    , "Replace with default-language"
-                    , "Replace with import"
-                    , "Replace with build-depends"
-                    , "Replace with main-is"
-                    , "Replace with hs-source-dirs"
-                    ]) cas
-        mapM_ executeCodeAction selectedCas
-        pure ()
+    , runCabalGoldenSession
+        "Code Actions - Can complete field names"
+        "code-actions"
+        "FieldSuggestions"
+        executeFirstActionPerDiagnostic
+    , runCabalGoldenSession
+        "Code Actions - Can fix field typos"
+        "code-actions"
+        "FieldSuggestionsTypos"
+        executeFirstActionPerDiagnostic
     , cabalAddDependencyTests
     , cabalAddModuleTests
     ]
   where
+    executeFirstActionPerDiagnostic doc = do
+      _ <- waitForDiagnosticsFrom doc
+      diagnotics <- getCurrentDiagnostics doc
+      -- Execute the first code action at each diagnostic point
+      forM_ diagnotics $ \diagnostic -> do
+        codeActions <- getCodeActions doc (diagnostic ^. range)
+        case codeActions of
+          []     -> pure ()
+          ca : _ -> mapM_ executeCodeAction (ca ^? _R)
     getLicenseAction :: T.Text -> [Command |? CodeAction] -> [CodeAction]
     getLicenseAction license codeActions = do
         InR action@CodeAction{_title} <- codeActions

plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestionsTypos.cabal

@@ -0,0 +1,36 @@
+cabal-version: 3.0
+name: FieldSuggestions
+version: 0.1.0
+liqns:            BSD-3-Clause
+
+quil-type: Simple
+
+qqxtra-doc-fils:
+    ChangeLog
+
+-- Default warnings in HLS
+common warnings
+  ghq-option: -Wall
+               -Wredundant-constraints
+               -Wunused-packages
+               -Wno-name-shadowing
+               -Wno-unticked-promoted-constructors
+
+source-repository head
+  type:     git
+  locqt: fake
+
+library
+    qqjfault-lang: Haskell2010
+    -- Import isn't supported right now.
+    iqqor: warnings
+    bqqld-dep: base
+
+executable my-exe
+    mbn-is: Main.hs
+
+test-suite Test
+    type: exitcode-stdio-1.0
+    main-is: Test.hs
+    hqqqsource-drs:
+

plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestionsTypos.golden.cabal

@@ -0,0 +1,36 @@
+cabal-version: 3.0
+name: FieldSuggestions
+version: 0.1.0
+license:            BSD-3-Clause
+
+build-type: Simple
+
+extra-doc-files:
+    ChangeLog
+
+-- Default warnings in HLS
+common warnings
+  ghc-options: -Wall
+               -Wredundant-constraints
+               -Wunused-packages
+               -Wno-name-shadowing
+               -Wno-unticked-promoted-constructors
+
+source-repository head
+  type:     git
+  location: fake
+
+library
+    default-language: Haskell2010
+    -- Import isn't supported right now.
+    import: warnings
+    build-depends: base
+
+executable my-exe
+    main-is: Main.hs
+
+test-suite Test
+    type: exitcode-stdio-1.0
+    main-is: Test.hs
+    hs-source-dirs:
+