From e61d32871112b41fa9fd124ffaa8435ab5e7a82b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Dybiec?= Date: Fri, 7 Oct 2022 16:01:31 +0200 Subject: [PATCH 1/3] Suggest licenses in cabal files --- .../hls-cabal-plugin/hls-cabal-plugin.cabal | 2 + .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 3 +- .../src/Ide/Plugin/Cabal/LicenseSuggest.hs | 45 +++++++++++-------- plugins/hls-cabal-plugin/test/Main.hs | 42 ++++++++++++++--- .../test/testdata/licenseCodeAction2.cabal | 8 ++++ 5 files changed, 73 insertions(+), 27 deletions(-) create mode 100644 plugins/hls-cabal-plugin/test/testdata/licenseCodeAction2.cabal diff --git a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal index 67170c10ab..6267cdb129 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 @@ -58,6 +59,7 @@ library , stm , text , unordered-containers >=0.2.10.0 + , fuzzy >=0.1 hs-source-dirs: src default-language: Haskell2010 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..781836948f 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,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 diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index b2db2f4315..4a0d37a92a 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/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 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..cc3f457c87 --- /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 From 0cde028ac85426b84eeaf95ed401f32b24808f94 Mon Sep 17 00:00:00 2001 From: Fendor Date: Thu, 24 Nov 2022 14:48:57 +0100 Subject: [PATCH 2/3] 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 From 29f9e450a360d0b106cab0a6d2c88b1e58268f87 Mon Sep 17 00:00:00 2001 From: fendor Date: Thu, 24 Nov 2022 21:17:04 +0100 Subject: [PATCH 3/3] Apply suggestions from code review --- plugins/hls-cabal-plugin/hls-cabal-plugin.cabal | 1 - plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs | 1 - 2 files changed, 2 deletions(-) diff --git a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal index 6267cdb129..f202b633c3 100644 --- a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal +++ b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal @@ -59,7 +59,6 @@ library , stm , text , unordered-containers >=0.2.10.0 - , fuzzy >=0.1 hs-source-dirs: src default-language: Haskell2010 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 899733197c..6165cfd135 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs @@ -6,7 +6,6 @@ module Ide.Plugin.Cabal.LicenseSuggest ( licenseErrorSuggestion , licenseErrorAction -, licenseNames -- * Re-exports , T.Text , Diagnostic(..)