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/hls-cabal-plugin.cabal b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal index 67170c10ab..f202b633c3 100644 --- a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal +++ b/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 diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 72a16c8ea6..913cb37ed6 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/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 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 2381286c95..6165cfd135 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs @@ -12,16 +12,21 @@ 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 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 +36,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 +57,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) diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index b2db2f4315..9fb01274b6 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/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 diff --git a/plugins/hls-cabal-plugin/test/testdata/licenseCodeAction2.cabal b/plugins/hls-cabal-plugin/test/testdata/licenseCodeAction2.cabal new file mode 100644 index 0000000000..6f8a886ba1 --- /dev/null +++ b/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