Add suggestions about licenses in cabal file

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/hls-cabal-plugin.cabal

@@ -45,6 +45,7 @@ library
     -- This is a lot of work for almost zero benefit, so we just allow more versions here
     -- and we eventually completely drop support for building HLS with stack.
     , Cabal                 ^>=3.2 || ^>=3.4 || ^>=3.6 || ^>= 3.8
+    , Cabal-syntax          ^>= 3.6
     , deepseq
     , directory
     , extra                 >=1.7.4
@@ -58,6 +59,7 @@ library
     , stm
     , text
     , unordered-containers  >=0.2.10.0
+    , fuzzy                 >=0.1
 
   hs-source-dirs:   src
   default-language: Haskell2010

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

@@ -21,7 +21,6 @@ import           Data.Hashable
 import           Data.HashMap.Strict             (HashMap)
 import qualified Data.HashMap.Strict             as HashMap
 import qualified Data.List.NonEmpty              as NE
-import           Data.Maybe                      (mapMaybe)
 import qualified Data.Text.Encoding              as Encoding
 import           Data.Typeable
 import           Development.IDE                 as D
@@ -184,7 +183,7 @@ licenseSuggestCodeAction
   -> CodeActionParams
   -> LspM Config (Either ResponseError (ResponseResult 'TextDocumentCodeAction))
 licenseSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List diags}) =
-  pure $ Right $ List $ mapMaybe (fmap InR . LicenseSuggest.licenseErrorAction uri) diags
+  pure $ Right $ List $ diags >>= (fmap InR . (LicenseSuggest.licenseErrorAction uri))
 
 -- ----------------------------------------------------------------
 -- Cabal file of Interest rules and global variable

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

@@ -6,22 +6,28 @@
 module Ide.Plugin.Cabal.LicenseSuggest
 ( licenseErrorSuggestion
 , licenseErrorAction
+, licenseNames
   -- * Re-exports
 , T.Text
 , Diagnostic(..)
 )
 where
 
-import qualified Data.HashMap.Strict as Map
-import qualified Data.Text           as T
-import           Language.LSP.Types  (CodeAction (CodeAction),
-                                      CodeActionKind (CodeActionQuickFix),
-                                      Diagnostic (..), List (List),
-                                      Position (Position), Range (Range),
-                                      TextEdit (TextEdit), Uri,
-                                      WorkspaceEdit (WorkspaceEdit))
+import qualified Data.HashMap.Strict         as Map
+import qualified Data.Text                   as T
+import           Language.LSP.Types          (CodeAction (CodeAction),
+                                              CodeActionKind (CodeActionQuickFix),
+                                              Diagnostic (..), List (List),
+                                              Position (Position),
+                                              Range (Range),
+                                              TextEdit (TextEdit), Uri,
+                                              WorkspaceEdit (WorkspaceEdit))
 import           Text.Regex.TDFA
 
+import qualified Data.List                   as List
+import           Distribution.SPDX.LicenseId (licenseId)
+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
 --   with a suggestion, then return a 'CodeAction' for replacing the
@@ -31,7 +37,7 @@ licenseErrorAction
   -- ^ File for which the diagnostic was generated
   -> Diagnostic
   -- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
-  -> Maybe CodeAction
+  -> [CodeAction]
 licenseErrorAction uri diag =
   mkCodeAction <$> licenseErrorSuggestion (_message diag)
   where
@@ -52,22 +58,32 @@ licenseErrorAction uri diag =
         edit  = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing Nothing
       in CodeAction title (Just CodeActionQuickFix) (Just $ List []) Nothing Nothing (Just edit) Nothing Nothing
 
--- | Given an error message 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.
-licenseErrorSuggestion
-  :: T.Text
+-- | License name of every license supported by cabal
+licenseNames :: [T.Text]
+licenseNames = map (T.pack . licenseId) [minBound .. maxBound]
+
+-- | Given a diagnostic returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic',
+--   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'
-  -> Maybe (T.Text, T.Text)
+  -> [(T.Text, T.Text)]
   -- ^ (Original (incorrect) license identifier, suggested replacement)
-licenseErrorSuggestion message =
-  mSuggestion message >>= \case
-    [original, suggestion] -> Just (original, suggestion)
-    _                      -> Nothing
+licenseErrorSuggestion msg =
+   (getMatch <$> msg =~~ regex) >>= \case
+          [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: '(.*)' Do you mean (.*)\\?"
-    mSuggestion msg = getMatch <$> (msg :: T.Text) =~~ regex
+    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

@@ -1,11 +1,14 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings        #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
-{-# LANGUAGE NamedFieldPuns    #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns           #-}
+{-# LANGUAGE TypeOperators            #-}
 module Main
   ( main
   ) where
 
 import           Control.Lens                    ((^.))
+import           Control.Monad                   (guard)
 import qualified Data.ByteString                 as BS
 import           Data.Either                     (isRight)
 import           Data.Function
@@ -70,14 +73,16 @@ codeActionUnitTests :: TestTree
 codeActionUnitTests = testGroup "Code Action Tests"
   [ testCase "Unknown format" $ do
       -- the message has the wrong format
-      licenseErrorSuggestion "Unknown license identifier: 'BSD3' Do you mean BSD-3-Clause?" @?= Nothing,
+      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?" @?= Just ("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'" @?= Nothing
+      take 2 (licenseErrorSuggestion "Unknown SPDX license identifier: 'MiT'")
+        @?= [("MiT","MIT"),("MiT","MIT-0")]
   ]
 
 -- ------------------------------------------------------------------------
@@ -137,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
-        [InR codeAction] <- 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
@@ -150,8 +155,36 @@ pluginTests recorder = testGroup "Plugin Tests"
           , "    build-depends:    base"
           , "    default-language: Haskell2010"
           ]
+    , runCabalTestCaseSession "Apache-2.0" recorder "" $ do
+        doc <- openDoc "licenseCodeAction2.cabal" "cabal"
+        diags <- waitForDiagnosticsFromSource doc "cabal"
+        -- test if it supports typos in license name, here '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))
+        executeCodeAction codeAction
+        contents <- documentContents doc
+        liftIO $ contents @?= Text.unlines
+          [ "cabal-version:      3.0"
+          , "name:               licenseCodeAction2"
+          , "version:            0.1.0.0"
+          , "license:            Apache-2.0"
+          , ""
+          , "library"
+          , "    build-depends:    base"
+          , "    default-language: Haskell2010"
+          ]
     ]
   ]
+  where
+    getLicenseAction :: Text.Text -> [Command |? CodeAction] -> [CodeAction]
+    getLicenseAction license codeActions = do
+                  InR action@CodeAction{_title} <- codeActions
+                  guard (_title=="Replace with " <> license)
+                  pure action
 
 -- ------------------------------------------------------------------------
 -- Runner utils

plugins/hls-cabal-plugin/test/testdata/licenseCodeAction2.cabal

@@ -0,0 +1,8 @@
+cabal-version:      3.0
+name:               licenseCodeAction2
+version:            0.1.0.0
+license:            APAHE
+
+library
+    build-depends:    base
+    default-language: Haskell2010