From 0cde028ac85426b84eeaf95ed401f32b24808f94 Mon Sep 17 00:00:00 2001 From: Fendor Date: Thu, 24 Nov 2022 14:48:57 +0100 Subject: [PATCH] Fix testsuite for license suggestions --- ghcide/src/Text/Fuzzy/Parallel.hs | 4 ++-- .../src/Ide/Plugin/Cabal/LicenseSuggest.hs | 21 +++++++++++++------ plugins/hls-cabal-plugin/test/Main.hs | 21 +++++++++++-------- .../test/testdata/licenseCodeAction2.cabal | 2 +- 4 files changed, 30 insertions(+), 18 deletions(-) diff --git a/ghcide/src/Text/Fuzzy/Parallel.hs b/ghcide/src/Text/Fuzzy/Parallel.hs index 6d822e7538..0137861468 100644 --- a/ghcide/src/Text/Fuzzy/Parallel.hs +++ b/ghcide/src/Text/Fuzzy/Parallel.hs @@ -91,8 +91,8 @@ filter chunkSize maxRes pattern ts extract = partialSortByAscScore maxRes perfec -- match against the pattern. Runs with default settings where -- nothing is added around the matches, as case insensitive. -- --- >>> simpleFilter "vm" ["vim", "emacs", "virtual machine"] --- ["vim","virtual machine"] +-- >>> simpleFilter 1000 10 "vm" ["vim", "emacs", "virtual machine"] +-- [Scored {score = 4, original = "vim"},Scored {score = 4, original = "virtual machine"}] {-# INLINABLE simpleFilter #-} simpleFilter :: Int -- ^ Chunk size. 1000 works well. -> Int -- ^ Max. number of results wanted diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs index 781836948f..899733197c 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs @@ -6,6 +6,7 @@ module Ide.Plugin.Cabal.LicenseSuggest ( licenseErrorSuggestion , licenseErrorAction +, licenseNames -- * Re-exports , T.Text , Diagnostic(..) @@ -23,8 +24,9 @@ import Language.LSP.Types (CodeAction (CodeAction), WorkspaceEdit (WorkspaceEdit)) import Text.Regex.TDFA +import qualified Data.List as List import Distribution.SPDX.LicenseId (licenseId) -import Text.Fuzzy (simpleFilter) +import qualified Text.Fuzzy.Parallel as Fuzzy -- | Given a diagnostic returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic', -- if it represents an "Unknown SPDX license identifier"-error along @@ -61,20 +63,27 @@ licenseNames :: [T.Text] licenseNames = map (T.pack . licenseId) [minBound .. maxBound] -- | Given a diagnostic returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic', --- if it represents an "Unknown SPDX license identifier"-error along --- with a suggestion then return the suggestion (after the "Do you mean"-text) --- along with the incorrect identifier. +-- provide possible corrections for SPDX license identifiers +-- based on the list specified in Cabal. +-- Results are sorted by best fit, and prefer solutions that have smaller +-- length distance to the original word. +-- +-- >>> take 2 $ licenseErrorSuggestion (T.pack "Unknown SPDX license identifier: 'BSD3'") +-- [("BSD3","BSD-3-Clause"),("BSD3","BSD-3-Clause-LBNL")] licenseErrorSuggestion :: T.Text -- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic' -> [(T.Text, T.Text)] -- ^ (Original (incorrect) license identifier, suggested replacement) -licenseErrorSuggestion msg = take 10 $ +licenseErrorSuggestion msg = (getMatch <$> msg =~~ regex) >>= \case - [original] -> simpleFilter original licenseNames >>= \x -> [(original,x)] + [original] -> + let matches = map Fuzzy.original $ Fuzzy.simpleFilter 1000 10 original licenseNames + in [(original,candidate) | candidate <- List.sortBy (lengthDistance original) matches] _ -> [] where regex :: T.Text regex = "Unknown SPDX license identifier: '(.*)'" getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> [T.Text] getMatch (_, _, _, results) = results + lengthDistance original x1 x2 = abs (T.length original - T.length x1) `compare` abs (T.length original - T.length x2) diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 4a0d37a92a..9fb01274b6 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -2,6 +2,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} {-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE TypeOperators #-} module Main ( main ) where @@ -75,11 +76,13 @@ codeActionUnitTests = testGroup "Code Action Tests" licenseErrorSuggestion "Unknown license identifier: 'BSD3' Do you mean BSD-3-Clause?" @?= [], testCase "BSD-3-Clause" $ do - licenseErrorSuggestion "Unknown SPDX license identifier: 'BSD3' Do you mean BSD-3-Clause?" @?= [("BSD3", "BSD-3-Clause")], + take 2 (licenseErrorSuggestion "Unknown SPDX license identifier: 'BSD3' Do you mean BSD-3-Clause?") + @?= [("BSD3","BSD-3-Clause"),("BSD3","BSD-3-Clause-LBNL")], - testCase "MIT" $ do + testCase "MiT" $ do -- contains no suggestion - licenseErrorSuggestion "Unknown SPDX license identifier: 'MIT3'" @?= [("MIT3", "MIT")] + take 2 (licenseErrorSuggestion "Unknown SPDX license identifier: 'MiT'") + @?= [("MiT","MIT"),("MiT","MIT-0")] ] -- ------------------------------------------------------------------------ @@ -139,7 +142,7 @@ pluginTests recorder = testGroup "Plugin Tests" length diags @?= 1 reduceDiag ^. J.range @?= Range (Position 3 24) (Position 4 0) reduceDiag ^. J.severity @?= Just DsError - [codeAction] <- getLicenseAction "BSD-3-Clause"<$> getCodeActions doc (Range (Position 3 24) (Position 4 0)) + [codeAction] <- getLicenseAction "BSD-3-Clause" <$> getCodeActions doc (Range (Position 3 24) (Position 4 0)) executeCodeAction codeAction contents <- documentContents doc liftIO $ contents @?= Text.unlines @@ -154,14 +157,14 @@ pluginTests recorder = testGroup "Plugin Tests" ] , runCabalTestCaseSession "Apache-2.0" recorder "" $ do doc <- openDoc "licenseCodeAction2.cabal" "cabal" - diags <- waitForDiagnosticsFromSource doc "parsing" + diags <- waitForDiagnosticsFromSource doc "cabal" -- test if it supports typos in license name, here 'apahe' - reduceDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'apahe'"] + reduceDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'APAHE'"] liftIO $ do length diags @?= 1 reduceDiag ^. J.range @?= Range (Position 3 25) (Position 4 0) reduceDiag ^. J.severity @?= Just DsError - [codeAction] <- getLicenseAction "Apache-2.0"<$> getCodeActions doc (Range (Position 3 24) (Position 4 0)) + [codeAction] <- getLicenseAction "Apache-2.0" <$> getCodeActions doc (Range (Position 3 24) (Position 4 0)) executeCodeAction codeAction contents <- documentContents doc liftIO $ contents @?= Text.unlines @@ -177,10 +180,10 @@ pluginTests recorder = testGroup "Plugin Tests" ] ] where - getLicenseAction :: Text.Text -> [(|?) Command CodeAction] -> [CodeAction] + getLicenseAction :: Text.Text -> [Command |? CodeAction] -> [CodeAction] getLicenseAction license codeActions = do InR action@CodeAction{_title} <- codeActions - guard (_title=="Replace with "<>license) + guard (_title=="Replace with " <> license) pure action -- ------------------------------------------------------------------------ diff --git a/plugins/hls-cabal-plugin/test/testdata/licenseCodeAction2.cabal b/plugins/hls-cabal-plugin/test/testdata/licenseCodeAction2.cabal index cc3f457c87..6f8a886ba1 100644 --- a/plugins/hls-cabal-plugin/test/testdata/licenseCodeAction2.cabal +++ b/plugins/hls-cabal-plugin/test/testdata/licenseCodeAction2.cabal @@ -1,7 +1,7 @@ cabal-version: 3.0 name: licenseCodeAction2 version: 0.1.0.0 -license: apahe +license: APAHE library build-depends: base