Add suggestions about licenses in cabal file

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

@@ -12,16 +12,20 @@ module Ide.Plugin.Cabal.LicenseSuggest
 )
 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           Distribution.SPDX.LicenseId (licenseId)
+import           Text.Fuzzy                  (simpleFilter)
+
 -- | 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 +35,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 +56,25 @@ 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',
+-- | 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',
 --   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
+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 = take 10 $
+   (getMatch <$> msg =~~ regex) >>= \case
+          [original] -> simpleFilter original licenseNames >>= \x -> [(original,x)]
+          _ -> []
   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

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

@@ -1,11 +1,13 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings        #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
-{-# LANGUAGE NamedFieldPuns    #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns           #-}
 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 +72,14 @@ 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"),
+      licenseErrorSuggestion "Unknown SPDX license identifier: 'BSD3' Do you mean BSD-3-Clause?" @?= [("BSD3", "BSD-3-Clause")],
 
     testCase "MIT" $ do
       -- contains no suggestion
-      licenseErrorSuggestion "Unknown SPDX license identifier: 'MIT3'" @?= Nothing
+      licenseErrorSuggestion "Unknown SPDX license identifier: 'MIT3'" @?= [("MIT3", "MIT")]
   ]
 
 -- ------------------------------------------------------------------------
@@ -137,7 +139,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 +152,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 "parsing"
+        -- 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