Fix testsuite for license suggestions

Author: fendor

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

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)

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
 
 -- ------------------------------------------------------------------------

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