Skip to content

Commit 5a9da41

Browse files
dyniecdyniec
committed
Suggest licenses in cabal files
1 parent 65ab7b1 commit 5a9da41

File tree

5 files changed

+61
-16
lines changed

5 files changed

+61
-16
lines changed

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

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,8 @@ library
3131
build-depends:
3232
, base >=4.12 && <5
3333
, bytestring
34-
, Cabal ^>=3.2 || ^>=3.4 || ^>=3.6
34+
, Cabal ^>=3.6
35+
, Cabal-syntax ^>= 3.6
3536
, deepseq
3637
, directory
3738
, extra >=1.7.4
@@ -44,6 +45,7 @@ library
4445
, stm
4546
, text ^>=1.2.4.0
4647
, unordered-containers >=0.2.10.0
48+
, fuzzy >=0.1
4749

4850
hs-source-dirs: src
4951
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
@@ -17,7 +17,6 @@ import Control.Monad.IO.Class
1717
import qualified Data.ByteString as BS
1818
import Data.Hashable
1919
import qualified Data.List.NonEmpty as NE
20-
import Data.Maybe (mapMaybe)
2120
import qualified Data.Text.Encoding as Encoding
2221
import Data.Typeable
2322
import Development.IDE as D
@@ -151,4 +150,4 @@ licenseSuggestCodeAction
151150
-> CodeActionParams
152151
-> LspM Config (Either ResponseError (ResponseResult 'TextDocumentCodeAction))
153152
licenseSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List diags}) =
154-
pure $ Right $ List $ mapMaybe (fmap InR . LicenseSuggest.licenseErrorAction uri) diags
153+
pure $ Right $ List $ diags>>=(fmap InR . LicenseSuggest.licenseErrorAction uri)

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

Lines changed: 18 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,9 @@ import Language.LSP.Types (CodeAction (CodeAction),
2222
WorkspaceEdit (WorkspaceEdit))
2323
import Text.Regex.TDFA
2424

25+
import Distribution.SPDX.LicenseId (licenseId)
26+
import Text.Fuzzy (simpleFilter)
27+
2528
-- | Given a diagnostic returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic',
2629
-- if it represents an "Unknown SPDX license identifier"-error along
2730
-- with a suggestion, then return a 'CodeAction' for replacing the
@@ -31,7 +34,7 @@ licenseErrorAction
3134
-- ^ File for which the diagnostic was generated
3235
-> Diagnostic
3336
-- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
34-
-> Maybe CodeAction
37+
-> [CodeAction]
3538
licenseErrorAction uri diag =
3639
mkCodeAction <$> licenseErrorSuggestion diag
3740
where
@@ -52,22 +55,25 @@ licenseErrorAction uri diag =
5255
edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing Nothing
5356
in CodeAction title (Just CodeActionQuickFix) (Just $ List []) Nothing Nothing (Just edit) Nothing Nothing
5457

58+
-- | License name of every license supported by cabal
59+
licenseNames :: [T.Text]
60+
licenseNames = map (T.pack . licenseId) [minBound .. maxBound]
61+
5562
-- | Given a diagnostic returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic',
5663
-- if it represents an "Unknown SPDX license identifier"-error along
5764
-- with a suggestion then return the suggestion (after the "Do you mean"-text)
5865
-- along with the incorrect identifier.
59-
licenseErrorSuggestion
60-
:: Diagnostic
61-
-- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
62-
-> Maybe (T.Text, T.Text)
63-
-- ^ (Original (incorrect) license identifier, suggested replacement)
64-
licenseErrorSuggestion diag =
65-
mSuggestion (_message diag) >>= \case
66-
[original, suggestion] -> Just (original, suggestion)
67-
_ -> Nothing
66+
licenseErrorSuggestion ::
67+
-- | Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
68+
Diagnostic
69+
-- | (Original (incorrect) license identifier, suggested replacement)
70+
-> [(T.Text, T.Text)]
71+
licenseErrorSuggestion diag = take 10 $
72+
(getMatch <$> _message diag =~~ regex) >>= \case
73+
[original] -> simpleFilter original licenseNames >>= \x -> [(original,x)]
74+
_ -> []
6875
where
6976
regex :: T.Text
70-
regex = "Unknown SPDX license identifier: '(.*)' Do you mean (.*)\\?"
71-
mSuggestion msg = getMatch <$> (msg :: T.Text) =~~ regex
77+
regex = "Unknown SPDX license identifier: '(.*)'"
7278
getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> [T.Text]
7379
getMatch (_, _, _, results) = results

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

Lines changed: 31 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
{-# LANGUAGE OverloadedStrings #-}
22
{-# OPTIONS_GHC -Wno-orphans #-}
33
{-# LANGUAGE NamedFieldPuns #-}
4+
{-# LANGUAGE DisambiguateRecordFields #-}
45
module Main
56
( main
67
) where
@@ -15,6 +16,7 @@ import qualified Ide.Plugin.Cabal.Parse as Lib
1516
import qualified Language.LSP.Types.Lens as J
1617
import System.FilePath
1718
import Test.Hls
19+
import Control.Monad ( guard )
1820

1921
cabalPlugin :: Recorder (WithPriority Log) -> PluginDescriptor IdeState
2022
cabalPlugin recorder = descriptor recorder "cabal"
@@ -113,7 +115,7 @@ pluginTests recorder = testGroup "Plugin Tests"
113115
length diags @?= 1
114116
reduceDiag ^. J.range @?= Range (Position 3 24) (Position 4 0)
115117
reduceDiag ^. J.severity @?= Just DsError
116-
[InR codeAction] <- getCodeActions doc (Range (Position 3 24) (Position 4 0))
118+
[codeAction] <- getLicenseAction "BSD-3-Clause"<$> getCodeActions doc (Range (Position 3 24) (Position 4 0))
117119
executeCodeAction codeAction
118120
contents <- documentContents doc
119121
liftIO $ contents @?= Text.unlines
@@ -126,8 +128,36 @@ pluginTests recorder = testGroup "Plugin Tests"
126128
, " build-depends: base"
127129
, " default-language: Haskell2010"
128130
]
131+
, runCabalTestCaseSession "Apache-2.0" recorder "" $ do
132+
doc <- openDoc "licenseCodeAction2.cabal" "cabal"
133+
diags <- waitForDiagnosticsFromSource doc "parsing"
134+
-- test if it supports typos in license name, here 'apahe'
135+
reduceDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'apahe'"]
136+
liftIO $ do
137+
length diags @?= 1
138+
reduceDiag ^. J.range @?= Range (Position 3 25) (Position 4 0)
139+
reduceDiag ^. J.severity @?= Just DsError
140+
[codeAction] <- getLicenseAction "Apache-2.0"<$> getCodeActions doc (Range (Position 3 24) (Position 4 0))
141+
executeCodeAction codeAction
142+
contents <- documentContents doc
143+
liftIO $ contents @?= Text.unlines
144+
[ "cabal-version: 3.0"
145+
, "name: licenseCodeAction2"
146+
, "version: 0.1.0.0"
147+
, "license: Apache-2.0"
148+
, ""
149+
, "library"
150+
, " build-depends: base"
151+
, " default-language: Haskell2010"
152+
]
129153
]
130154
]
155+
where
156+
getLicenseAction :: Text.Text -> [(|?) Command CodeAction] -> [CodeAction]
157+
getLicenseAction license codeActions = do
158+
InR action@CodeAction{_title} <- codeActions
159+
guard (_title=="Replace with "<>license)
160+
pure action
131161

132162
-- ------------------------------------------------------------------------
133163
-- 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)