Skip to content

Commit e61d328

Browse files
dyniecfendor
dyniec
authored and
fendor
committed
Suggest licenses in cabal files
1 parent 5dbbd85 commit e61d328

File tree

5 files changed

+73
-27
lines changed

5 files changed

+73
-27
lines changed

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

Lines changed: 2 additions & 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
@@ -58,6 +59,7 @@ library
5859
, stm
5960
, text
6061
, unordered-containers >=0.2.10.0
62+
, fuzzy >=0.1
6163

6264
hs-source-dirs: src
6365
default-language: Haskell2010

‎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: 26 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -12,16 +12,20 @@ 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 Distribution.SPDX.LicenseId (licenseId)
27+
import Text.Fuzzy (simpleFilter)
28+
2529
-- | Given a diagnostic returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic',
2630
-- if it represents an "Unknown SPDX license identifier"-error along
2731
-- with a suggestion, then return a 'CodeAction' for replacing the
@@ -31,7 +35,7 @@ licenseErrorAction
3135
-- ^ File for which the diagnostic was generated
3236
-> Diagnostic
3337
-- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
34-
-> Maybe CodeAction
38+
-> [CodeAction]
3539
licenseErrorAction uri diag =
3640
mkCodeAction <$> licenseErrorSuggestion (_message diag)
3741
where
@@ -52,22 +56,25 @@ licenseErrorAction uri diag =
5256
edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing Nothing
5357
in CodeAction title (Just CodeActionQuickFix) (Just $ List []) Nothing Nothing (Just edit) Nothing Nothing
5458

55-
-- | Given an error message returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic',
59+
-- | License name of every license supported by cabal
60+
licenseNames :: [T.Text]
61+
licenseNames = map (T.pack . licenseId) [minBound .. maxBound]
62+
63+
-- | Given a diagnostic returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic',
5664
-- if it represents an "Unknown SPDX license identifier"-error along
5765
-- with a suggestion then return the suggestion (after the "Do you mean"-text)
5866
-- along with the incorrect identifier.
59-
licenseErrorSuggestion
60-
:: T.Text
67+
licenseErrorSuggestion ::
68+
T.Text
6169
-- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
62-
-> Maybe (T.Text, T.Text)
70+
-> [(T.Text, T.Text)]
6371
-- ^ (Original (incorrect) license identifier, suggested replacement)
64-
licenseErrorSuggestion message =
65-
mSuggestion message >>= \case
66-
[original, suggestion] -> Just (original, suggestion)
67-
_ -> Nothing
72+
licenseErrorSuggestion msg = take 10 $
73+
(getMatch <$> msg =~~ regex) >>= \case
74+
[original] -> simpleFilter original licenseNames >>= \x -> [(original,x)]
75+
_ -> []
6876
where
6977
regex :: T.Text
70-
regex = "Unknown SPDX license identifier: '(.*)' Do you mean (.*)\\?"
71-
mSuggestion msg = getMatch <$> (msg :: T.Text) =~~ regex
78+
regex = "Unknown SPDX license identifier: '(.*)'"
7279
getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> [T.Text]
7380
getMatch (_, _, _, results) = results

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

Lines changed: 36 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,13 @@
1-
{-# LANGUAGE OverloadedStrings #-}
1+
{-# LANGUAGE OverloadedStrings #-}
22
{-# OPTIONS_GHC -Wno-orphans #-}
3-
{-# LANGUAGE NamedFieldPuns #-}
3+
{-# LANGUAGE DisambiguateRecordFields #-}
4+
{-# LANGUAGE NamedFieldPuns #-}
45
module Main
56
( main
67
) where
78

89
import Control.Lens ((^.))
10+
import Control.Monad (guard)
911
import qualified Data.ByteString as BS
1012
import Data.Either (isRight)
1113
import Data.Function
@@ -70,14 +72,14 @@ codeActionUnitTests :: TestTree
7072
codeActionUnitTests = testGroup "Code Action Tests"
7173
[ testCase "Unknown format" $ do
7274
-- the message has the wrong format
73-
licenseErrorSuggestion "Unknown license identifier: 'BSD3' Do you mean BSD-3-Clause?" @?= Nothing,
75+
licenseErrorSuggestion "Unknown license identifier: 'BSD3' Do you mean BSD-3-Clause?" @?= [],
7476

7577
testCase "BSD-3-Clause" $ do
76-
licenseErrorSuggestion "Unknown SPDX license identifier: 'BSD3' Do you mean BSD-3-Clause?" @?= Just ("BSD3", "BSD-3-Clause"),
78+
licenseErrorSuggestion "Unknown SPDX license identifier: 'BSD3' Do you mean BSD-3-Clause?" @?= [("BSD3", "BSD-3-Clause")],
7779

7880
testCase "MIT" $ do
7981
-- contains no suggestion
80-
licenseErrorSuggestion "Unknown SPDX license identifier: 'MIT3'" @?= Nothing
82+
licenseErrorSuggestion "Unknown SPDX license identifier: 'MIT3'" @?= [("MIT3", "MIT")]
8183
]
8284

8385
-- ------------------------------------------------------------------------
@@ -137,7 +139,7 @@ pluginTests recorder = testGroup "Plugin Tests"
137139
length diags @?= 1
138140
reduceDiag ^. J.range @?= Range (Position 3 24) (Position 4 0)
139141
reduceDiag ^. J.severity @?= Just DsError
140-
[InR codeAction] <- getCodeActions doc (Range (Position 3 24) (Position 4 0))
142+
[codeAction] <- getLicenseAction "BSD-3-Clause"<$> getCodeActions doc (Range (Position 3 24) (Position 4 0))
141143
executeCodeAction codeAction
142144
contents <- documentContents doc
143145
liftIO $ contents @?= Text.unlines
@@ -150,8 +152,36 @@ pluginTests recorder = testGroup "Plugin Tests"
150152
, " build-depends: base"
151153
, " default-language: Haskell2010"
152154
]
155+
, runCabalTestCaseSession "Apache-2.0" recorder "" $ do
156+
doc <- openDoc "licenseCodeAction2.cabal" "cabal"
157+
diags <- waitForDiagnosticsFromSource doc "parsing"
158+
-- test if it supports typos in license name, here 'apahe'
159+
reduceDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'apahe'"]
160+
liftIO $ do
161+
length diags @?= 1
162+
reduceDiag ^. J.range @?= Range (Position 3 25) (Position 4 0)
163+
reduceDiag ^. J.severity @?= Just DsError
164+
[codeAction] <- getLicenseAction "Apache-2.0"<$> getCodeActions doc (Range (Position 3 24) (Position 4 0))
165+
executeCodeAction codeAction
166+
contents <- documentContents doc
167+
liftIO $ contents @?= Text.unlines
168+
[ "cabal-version: 3.0"
169+
, "name: licenseCodeAction2"
170+
, "version: 0.1.0.0"
171+
, "license: Apache-2.0"
172+
, ""
173+
, "library"
174+
, " build-depends: base"
175+
, " default-language: Haskell2010"
176+
]
153177
]
154178
]
179+
where
180+
getLicenseAction :: Text.Text -> [(|?) Command CodeAction] -> [CodeAction]
181+
getLicenseAction license codeActions = do
182+
InR action@CodeAction{_title} <- codeActions
183+
guard (_title=="Replace with "<>license)
184+
pure action
155185

156186
-- ------------------------------------------------------------------------
157187
-- 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)