Skip to content

Commit d7690c5

Browse files
dyniecmichaelpjfendor
authored
Add suggestions about licenses in cabal file (#3261)
* Suggest licenses in cabal files * Fix testsuite for license suggestions * Apply suggestions from code review Co-authored-by: Michael Peyton Jones <me@michaelpj.com> Co-authored-by: Fendor <power.walross@gmail.com> Co-authored-by: fendor <fendor@users.noreply.github.com>
1 parent ac83ca4 commit d7690c5

File tree

6 files changed

+89
-33
lines changed

6 files changed

+89
-33
lines changed

‎ghcide/src/Text/Fuzzy/Parallel.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -91,8 +91,8 @@ filter chunkSize maxRes pattern ts extract = partialSortByAscScore maxRes perfec
9191
-- match against the pattern. Runs with default settings where
9292
-- nothing is added around the matches, as case insensitive.
9393
--
94-
-- >>> simpleFilter "vm" ["vim", "emacs", "virtual machine"]
95-
-- ["vim","virtual machine"]
94+
-- >>> simpleFilter 1000 10 "vm" ["vim", "emacs", "virtual machine"]
95+
-- [Scored {score = 4, original = "vim"},Scored {score = 4, original = "virtual machine"}]
9696
{-# INLINABLE simpleFilter #-}
9797
simpleFilter :: Int -- ^ Chunk size. 1000 works well.
9898
-> Int -- ^ Max. number of results wanted

‎plugins/hls-cabal-plugin/hls-cabal-plugin.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -45,6 +45,7 @@ library
4545
-- This is a lot of work for almost zero benefit, so we just allow more versions here
4646
-- and we eventually completely drop support for building HLS with stack.
4747
, Cabal ^>=3.2 || ^>=3.4 || ^>=3.6 || ^>= 3.8
48+
, Cabal-syntax ^>= 3.6
4849
, deepseq
4950
, directory
5051
, extra >=1.7.4

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

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,6 @@ import Data.Hashable
2121
import Data.HashMap.Strict (HashMap)
2222
import qualified Data.HashMap.Strict as HashMap
2323
import qualified Data.List.NonEmpty as NE
24-
import Data.Maybe (mapMaybe)
2524
import qualified Data.Text.Encoding as Encoding
2625
import Data.Typeable
2726
import Development.IDE as D
@@ -184,7 +183,7 @@ licenseSuggestCodeAction
184183
-> CodeActionParams
185184
-> LspM Config (Either ResponseError (ResponseResult 'TextDocumentCodeAction))
186185
licenseSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List diags}) =
187-
pure $ Right $ List $ mapMaybe (fmap InR . LicenseSuggest.licenseErrorAction uri) diags
186+
pure $ Right $ List $ diags >>= (fmap InR . (LicenseSuggest.licenseErrorAction uri))
188187

189188
-- ----------------------------------------------------------------
190189
-- Cabal file of Interest rules and global variable

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

Lines changed: 37 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -12,16 +12,21 @@ module Ide.Plugin.Cabal.LicenseSuggest
1212
)
1313
where
1414

15-
import qualified Data.HashMap.Strict as Map
16-
import qualified Data.Text as T
17-
import Language.LSP.Types (CodeAction (CodeAction),
18-
CodeActionKind (CodeActionQuickFix),
19-
Diagnostic (..), List (List),
20-
Position (Position), Range (Range),
21-
TextEdit (TextEdit), Uri,
22-
WorkspaceEdit (WorkspaceEdit))
15+
import qualified Data.HashMap.Strict as Map
16+
import qualified Data.Text as T
17+
import Language.LSP.Types (CodeAction (CodeAction),
18+
CodeActionKind (CodeActionQuickFix),
19+
Diagnostic (..), List (List),
20+
Position (Position),
21+
Range (Range),
22+
TextEdit (TextEdit), Uri,
23+
WorkspaceEdit (WorkspaceEdit))
2324
import Text.Regex.TDFA
2425

26+
import qualified Data.List as List
27+
import Distribution.SPDX.LicenseId (licenseId)
28+
import qualified Text.Fuzzy.Parallel as Fuzzy
29+
2530
-- | Given a diagnostic returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic',
2631
-- if it represents an "Unknown SPDX license identifier"-error along
2732
-- with a suggestion, then return a 'CodeAction' for replacing the
@@ -31,7 +36,7 @@ licenseErrorAction
3136
-- ^ File for which the diagnostic was generated
3237
-> Diagnostic
3338
-- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
34-
-> Maybe CodeAction
39+
-> [CodeAction]
3540
licenseErrorAction uri diag =
3641
mkCodeAction <$> licenseErrorSuggestion (_message diag)
3742
where
@@ -52,22 +57,32 @@ licenseErrorAction uri diag =
5257
edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing Nothing
5358
in CodeAction title (Just CodeActionQuickFix) (Just $ List []) Nothing Nothing (Just edit) Nothing Nothing
5459

55-
-- | Given an error message returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic',
56-
-- if it represents an "Unknown SPDX license identifier"-error along
57-
-- with a suggestion then return the suggestion (after the "Do you mean"-text)
58-
-- along with the incorrect identifier.
59-
licenseErrorSuggestion
60-
:: T.Text
60+
-- | License name of every license supported by cabal
61+
licenseNames :: [T.Text]
62+
licenseNames = map (T.pack . licenseId) [minBound .. maxBound]
63+
64+
-- | Given a diagnostic returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic',
65+
-- provide possible corrections for SPDX license identifiers
66+
-- based on the list specified in Cabal.
67+
-- Results are sorted by best fit, and prefer solutions that have smaller
68+
-- length distance to the original word.
69+
--
70+
-- >>> take 2 $ licenseErrorSuggestion (T.pack "Unknown SPDX license identifier: 'BSD3'")
71+
-- [("BSD3","BSD-3-Clause"),("BSD3","BSD-3-Clause-LBNL")]
72+
licenseErrorSuggestion ::
73+
T.Text
6174
-- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
62-
-> Maybe (T.Text, T.Text)
75+
-> [(T.Text, T.Text)]
6376
-- ^ (Original (incorrect) license identifier, suggested replacement)
64-
licenseErrorSuggestion message =
65-
mSuggestion message >>= \case
66-
[original, suggestion] -> Just (original, suggestion)
67-
_ -> Nothing
77+
licenseErrorSuggestion msg =
78+
(getMatch <$> msg =~~ regex) >>= \case
79+
[original] ->
80+
let matches = map Fuzzy.original $ Fuzzy.simpleFilter 1000 10 original licenseNames
81+
in [(original,candidate) | candidate <- List.sortBy (lengthDistance original) matches]
82+
_ -> []
6883
where
6984
regex :: T.Text
70-
regex = "Unknown SPDX license identifier: '(.*)' Do you mean (.*)\\?"
71-
mSuggestion msg = getMatch <$> (msg :: T.Text) =~~ regex
85+
regex = "Unknown SPDX license identifier: '(.*)'"
7286
getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> [T.Text]
7387
getMatch (_, _, _, results) = results
88+
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

Lines changed: 40 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,14 @@
1-
{-# LANGUAGE OverloadedStrings #-}
1+
{-# LANGUAGE OverloadedStrings #-}
22
{-# OPTIONS_GHC -Wno-orphans #-}
3-
{-# LANGUAGE NamedFieldPuns #-}
3+
{-# LANGUAGE DisambiguateRecordFields #-}
4+
{-# LANGUAGE NamedFieldPuns #-}
5+
{-# LANGUAGE TypeOperators #-}
46
module Main
57
( main
68
) where
79

810
import Control.Lens ((^.))
11+
import Control.Monad (guard)
912
import qualified Data.ByteString as BS
1013
import Data.Either (isRight)
1114
import Data.Function
@@ -70,14 +73,16 @@ codeActionUnitTests :: TestTree
7073
codeActionUnitTests = testGroup "Code Action Tests"
7174
[ testCase "Unknown format" $ do
7275
-- the message has the wrong format
73-
licenseErrorSuggestion "Unknown license identifier: 'BSD3' Do you mean BSD-3-Clause?" @?= Nothing,
76+
licenseErrorSuggestion "Unknown license identifier: 'BSD3' Do you mean BSD-3-Clause?" @?= [],
7477

7578
testCase "BSD-3-Clause" $ do
76-
licenseErrorSuggestion "Unknown SPDX license identifier: 'BSD3' Do you mean BSD-3-Clause?" @?= Just ("BSD3", "BSD-3-Clause"),
79+
take 2 (licenseErrorSuggestion "Unknown SPDX license identifier: 'BSD3' Do you mean BSD-3-Clause?")
80+
@?= [("BSD3","BSD-3-Clause"),("BSD3","BSD-3-Clause-LBNL")],
7781

78-
testCase "MIT" $ do
82+
testCase "MiT" $ do
7983
-- contains no suggestion
80-
licenseErrorSuggestion "Unknown SPDX license identifier: 'MIT3'" @?= Nothing
84+
take 2 (licenseErrorSuggestion "Unknown SPDX license identifier: 'MiT'")
85+
@?= [("MiT","MIT"),("MiT","MIT-0")]
8186
]
8287

8388
-- ------------------------------------------------------------------------
@@ -137,7 +142,7 @@ pluginTests recorder = testGroup "Plugin Tests"
137142
length diags @?= 1
138143
reduceDiag ^. J.range @?= Range (Position 3 24) (Position 4 0)
139144
reduceDiag ^. J.severity @?= Just DsError
140-
[InR codeAction] <- getCodeActions doc (Range (Position 3 24) (Position 4 0))
145+
[codeAction] <- getLicenseAction "BSD-3-Clause" <$> getCodeActions doc (Range (Position 3 24) (Position 4 0))
141146
executeCodeAction codeAction
142147
contents <- documentContents doc
143148
liftIO $ contents @?= Text.unlines
@@ -150,8 +155,36 @@ pluginTests recorder = testGroup "Plugin Tests"
150155
, " build-depends: base"
151156
, " default-language: Haskell2010"
152157
]
158+
, runCabalTestCaseSession "Apache-2.0" recorder "" $ do
159+
doc <- openDoc "licenseCodeAction2.cabal" "cabal"
160+
diags <- waitForDiagnosticsFromSource doc "cabal"
161+
-- test if it supports typos in license name, here 'apahe'
162+
reduceDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'APAHE'"]
163+
liftIO $ do
164+
length diags @?= 1
165+
reduceDiag ^. J.range @?= Range (Position 3 25) (Position 4 0)
166+
reduceDiag ^. J.severity @?= Just DsError
167+
[codeAction] <- getLicenseAction "Apache-2.0" <$> getCodeActions doc (Range (Position 3 24) (Position 4 0))
168+
executeCodeAction codeAction
169+
contents <- documentContents doc
170+
liftIO $ contents @?= Text.unlines
171+
[ "cabal-version: 3.0"
172+
, "name: licenseCodeAction2"
173+
, "version: 0.1.0.0"
174+
, "license: Apache-2.0"
175+
, ""
176+
, "library"
177+
, " build-depends: base"
178+
, " default-language: Haskell2010"
179+
]
153180
]
154181
]
182+
where
183+
getLicenseAction :: Text.Text -> [Command |? CodeAction] -> [CodeAction]
184+
getLicenseAction license codeActions = do
185+
InR action@CodeAction{_title} <- codeActions
186+
guard (_title=="Replace with " <> license)
187+
pure action
155188

156189
-- ------------------------------------------------------------------------
157190
-- Runner utils

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

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
cabal-version: 3.0
2+
name: licenseCodeAction2
3+
version: 0.1.0.0
4+
license: APAHE
5+
6+
library
7+
build-depends: base
8+
default-language: Haskell2010

0 commit comments

Comments
 (0)