hls-cabal-plugin (empty) → 0.1.0.0
raw patch · 16 files changed
+811/−0 lines, 16 filesdep +Cabaldep +basedep +bytestring
Dependencies added: Cabal, base, bytestring, deepseq, directory, extra, filepath, ghcide, hashable, hls-cabal-plugin, hls-graph, hls-plugin-api, hls-test-utils, lens, lsp, lsp-types, regex-tdfa, stm, tasty-hunit, text, unordered-containers
Files
- CHANGELOG.md +6/−0
- LICENSE +20/−0
- hls-cabal-plugin.cabal +81/−0
- src/Ide/Plugin/Cabal.hs +257/−0
- src/Ide/Plugin/Cabal/Diagnostics.hs +85/−0
- src/Ide/Plugin/Cabal/LicenseSuggest.hs +88/−0
- src/Ide/Plugin/Cabal/Parse.hs +27/−0
- test/Main.hs +182/−0
- test/testdata/invalid.cabal +8/−0
- test/testdata/licenseCodeAction.cabal +8/−0
- test/testdata/licenseCodeAction2.cabal +8/−0
- test/testdata/simple-cabal/A.hs +4/−0
- test/testdata/simple-cabal/cabal.project +1/−0
- test/testdata/simple-cabal/hie.yaml +2/−0
- test/testdata/simple-cabal/simple-cabal.cabal +10/−0
- test/testdata/simple.cabal +24/−0
+ CHANGELOG.md view
@@ -0,0 +1,6 @@+# Revision history for hls-cabal-plugin++## 0.1.0.0 -- YYYY-mm-dd++* Provide Diagnostics on parse errors and warnings for .cabal files+* Provide CodeAction for the common SPDX License mistake "BSD3" instead of "BSD-3-Clause"
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2022 Fendor++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ hls-cabal-plugin.cabal view
@@ -0,0 +1,81 @@+cabal-version: 3.0+name: hls-cabal-plugin+version: 0.1.0.0+synopsis: Cabal integration plugin with Haskell Language Server+description:+ Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>++homepage:+license: MIT+license-file: LICENSE+author: Fendor+maintainer: fendor@posteo.de+category: Development+extra-source-files:+ CHANGELOG.md+ test/testdata/*.cabal+ test/testdata/simple-cabal/A.hs+ test/testdata/simple-cabal/cabal.project+ test/testdata/simple-cabal/hie.yaml+ test/testdata/simple-cabal/simple-cabal.cabal++common warnings+ ghc-options: -Wall++library+ import: warnings+ exposed-modules:+ Ide.Plugin.Cabal+ Ide.Plugin.Cabal.Diagnostics+ Ide.Plugin.Cabal.LicenseSuggest+ Ide.Plugin.Cabal.Parse++ build-depends:+ , base >=4.12 && <5+ , bytestring+ -- Ideally, we only want to support a single Cabal version, supporting+ -- older versions is completely pointless since Cabal is backwards compatible,+ -- the latest Cabal version can parse all versions of the Cabal file format.+ --+ -- However, stack is making this difficult, if we change the version of Cabal,+ -- we essentially need to make sure all other packages in the snapshot have their+ -- Cabal dependency version relaxed.+ -- Most packages have a Hackage revision, but stack won't pick these up (for sensible reasons)+ -- automatically, forcing us to manually update the packages revision id.+ -- 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+ , deepseq+ , directory+ , extra >=1.7.4+ , ghcide ^>= 1.9+ , hashable+ , hls-plugin-api ^>=1.6+ , hls-graph ^>=1.9+ , lsp ^>=1.6.0.0+ , lsp-types ^>=1.6.0.0+ , regex-tdfa ^>=1.3.1+ , stm+ , text+ , unordered-containers >=0.2.10.0++ hs-source-dirs: src+ default-language: Haskell2010++test-suite tests+ import: warnings+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ build-depends:+ , base+ , bytestring+ , filepath+ , ghcide+ , hls-cabal-plugin+ , hls-test-utils ^>=1.5+ , lens+ , lsp-types+ , tasty-hunit+ , text
+ src/Ide/Plugin/Cabal.hs view
@@ -0,0 +1,257 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}++module Ide.Plugin.Cabal (descriptor, Log(..)) where++import Control.Concurrent.STM+import Control.Concurrent.Strict+import Control.DeepSeq+import Control.Monad.Extra+import Control.Monad.IO.Class+import qualified Data.ByteString as BS+import Data.Hashable+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HashMap+import qualified Data.List.NonEmpty as NE+import qualified Data.Text.Encoding as Encoding+import Data.Typeable+import Development.IDE as D+import Development.IDE.Core.Shake (restartShakeSession)+import qualified Development.IDE.Core.Shake as Shake+import Development.IDE.Graph (alwaysRerun)+import GHC.Generics+import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics+import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest+import qualified Ide.Plugin.Cabal.Parse as Parse+import Ide.Plugin.Config (Config)+import Ide.Types+import Language.LSP.Server (LspM)+import Language.LSP.Types+import qualified Language.LSP.Types as LSP+import qualified Language.LSP.VFS as VFS++data Log+ = LogModificationTime NormalizedFilePath FileVersion+ | LogShake Shake.Log+ | LogDocOpened Uri+ | LogDocModified Uri+ | LogDocSaved Uri+ | LogDocClosed Uri+ | LogFOI (HashMap NormalizedFilePath FileOfInterestStatus)+ deriving Show++instance Pretty Log where+ pretty = \case+ LogShake log' -> pretty log'+ LogModificationTime nfp modTime ->+ "Modified:" <+> pretty (fromNormalizedFilePath nfp) <+> pretty (show modTime)+ LogDocOpened uri ->+ "Opened text document:" <+> pretty (getUri uri)+ LogDocModified uri ->+ "Modified text document:" <+> pretty (getUri uri)+ LogDocSaved uri ->+ "Saved text document:" <+> pretty (getUri uri)+ LogDocClosed uri ->+ "Closed text document:" <+> pretty (getUri uri)+ LogFOI files ->+ "Set files of interest to:" <+> viaShow files+++descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState+descriptor recorder plId = (defaultCabalPluginDescriptor plId)+ { pluginRules = cabalRules recorder+ , pluginHandlers = mkPluginHandler STextDocumentCodeAction licenseSuggestCodeAction+ , pluginNotificationHandlers = mconcat+ [ mkPluginNotificationHandler LSP.STextDocumentDidOpen $+ \ide vfs _ (DidOpenTextDocumentParams TextDocumentItem{_uri,_version}) -> liftIO $ do+ whenUriFile _uri $ \file -> do+ log' Debug $ LogDocOpened _uri+ addFileOfInterest recorder ide file Modified{firstOpen=True}+ restartCabalShakeSession (shakeExtras ide) vfs file "(opened)"++ , mkPluginNotificationHandler LSP.STextDocumentDidChange $+ \ide vfs _ (DidChangeTextDocumentParams VersionedTextDocumentIdentifier{_uri} _) -> liftIO $ do+ whenUriFile _uri $ \file -> do+ log' Debug $ LogDocModified _uri+ addFileOfInterest recorder ide file Modified{firstOpen=False}+ restartCabalShakeSession (shakeExtras ide) vfs file "(changed)"++ , mkPluginNotificationHandler LSP.STextDocumentDidSave $+ \ide vfs _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do+ whenUriFile _uri $ \file -> do+ log' Debug $ LogDocSaved _uri+ addFileOfInterest recorder ide file OnDisk+ restartCabalShakeSession (shakeExtras ide) vfs file "(saved)"++ , mkPluginNotificationHandler LSP.STextDocumentDidClose $+ \ide vfs _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do+ whenUriFile _uri $ \file -> do+ log' Debug $ LogDocClosed _uri+ deleteFileOfInterest recorder ide file+ restartCabalShakeSession (shakeExtras ide) vfs file "(closed)"+ ]+ }+ where+ log' = logWith recorder++ whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO ()+ whenUriFile uri act = whenJust (LSP.uriToFilePath uri) $ act . toNormalizedFilePath'++-- | Helper function to restart the shake session, specifically for modifying .cabal files.+-- No special logic, just group up a bunch of functions you need for the base+-- Notification Handlers.+--+-- To make sure diagnostics are up to date, we need to tell shake that the file was touched and+-- needs to be re-parsed. That's what we do when we record the dirty key that our parsing+-- rule depends on.+-- Then we restart the shake session, so that changes to our virtual files are actually picked up.+restartCabalShakeSession :: ShakeExtras -> VFS.VFS -> NormalizedFilePath -> String -> IO ()+restartCabalShakeSession shakeExtras vfs file actionMsg = do+ join $ atomically $ Shake.recordDirtyKeys shakeExtras GetModificationTime [file]+ restartShakeSession shakeExtras (VFSModified vfs) (fromNormalizedFilePath file ++ " " ++ actionMsg) []++-- ----------------------------------------------------------------+-- Plugin Rules+-- ----------------------------------------------------------------++data ParseCabal = ParseCabal+ deriving (Eq, Show, Typeable, Generic)+instance Hashable ParseCabal+instance NFData ParseCabal++type instance RuleResult ParseCabal = ()++cabalRules :: Recorder (WithPriority Log) -> Rules ()+cabalRules recorder = do+ -- Make sure we initialise the cabal files-of-interest.+ ofInterestRules recorder+ -- Rule to produce diagnostics for cabal files.+ define (cmapWithPrio LogShake recorder) $ \ParseCabal file -> do+ -- whenever this key is marked as dirty (e.g., when a user writes stuff to it),+ -- we rerun this rule because this rule *depends* on GetModificationTime.+ (t, mCabalSource) <- use_ GetFileContents file+ log' Debug $ LogModificationTime file t+ contents <- case mCabalSource of+ Just sources -> pure $ Encoding.encodeUtf8 sources+ Nothing -> do+ liftIO $ BS.readFile $ fromNormalizedFilePath file++ (pWarnings, pm) <- liftIO $ Parse.parseCabalFileContents contents+ let warningDiags = fmap (Diagnostics.warningDiagnostic file) pWarnings+ case pm of+ Left (_cabalVersion, pErrorNE) -> do+ let errorDiags = NE.toList $ NE.map (Diagnostics.errorDiagnostic file) pErrorNE+ allDiags = errorDiags <> warningDiags+ pure (allDiags, Nothing)+ Right _ -> do+ pure (warningDiags, Just ())++ action $ do+ -- Run the cabal kick. This code always runs when 'shakeRestart' is run.+ -- Must be careful to not impede the performance too much. Crucial to+ -- a snappy IDE experience.+ kick+ where+ log' = logWith recorder++-- | This is the kick function for the cabal plugin.+-- We run this action, whenever we shake session us run/restarted, which triggers+-- actions to produce diagnostics for cabal files.+--+-- It is paramount that this kick-function can be run quickly, since it is a blocking+-- function invocation.+kick :: Action ()+kick = do+ files <- HashMap.keys <$> getCabalFilesOfInterestUntracked+ void $ uses ParseCabal files++-- ----------------------------------------------------------------+-- Code Actions+-- ----------------------------------------------------------------++licenseSuggestCodeAction+ :: IdeState+ -> PluginId+ -> CodeActionParams+ -> LspM Config (Either ResponseError (ResponseResult 'TextDocumentCodeAction))+licenseSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List diags}) =+ pure $ Right $ List $ diags >>= (fmap InR . (LicenseSuggest.licenseErrorAction uri))++-- ----------------------------------------------------------------+-- Cabal file of Interest rules and global variable+-- ----------------------------------------------------------------++-- | Cabal files that are currently open in the lsp-client.+-- Specific actions happen when these files are saved, closed or modified,+-- such as generating diagnostics, re-parsing, etc...+--+-- We need to store the open files to parse them again if we restart the shake session.+-- Restarting of the shake session happens whenever these files are modified.+newtype OfInterestCabalVar = OfInterestCabalVar (Var (HashMap NormalizedFilePath FileOfInterestStatus))++instance Shake.IsIdeGlobal OfInterestCabalVar++data IsCabalFileOfInterest = IsCabalFileOfInterest+ deriving (Eq, Show, Typeable, Generic)+instance Hashable IsCabalFileOfInterest+instance NFData IsCabalFileOfInterest++type instance RuleResult IsCabalFileOfInterest = CabalFileOfInterestResult++data CabalFileOfInterestResult = NotCabalFOI | IsCabalFOI FileOfInterestStatus+ deriving (Eq, Show, Typeable, Generic)+instance Hashable CabalFileOfInterestResult+instance NFData CabalFileOfInterestResult++-- | The rule that initialises the files of interest state.+--+-- Needs to be run on start-up.+ofInterestRules :: Recorder (WithPriority Log) -> Rules ()+ofInterestRules recorder = do+ Shake.addIdeGlobal . OfInterestCabalVar =<< liftIO (newVar HashMap.empty)+ Shake.defineEarlyCutoff (cmapWithPrio LogShake recorder) $ RuleNoDiagnostics $ \IsCabalFileOfInterest f -> do+ alwaysRerun+ filesOfInterest <- getCabalFilesOfInterestUntracked+ let foi = maybe NotCabalFOI IsCabalFOI $ f `HashMap.lookup` filesOfInterest+ fp = summarize foi+ res = (Just fp, Just foi)+ return res+ where+ summarize NotCabalFOI = BS.singleton 0+ summarize (IsCabalFOI OnDisk) = BS.singleton 1+ summarize (IsCabalFOI (Modified False)) = BS.singleton 2+ summarize (IsCabalFOI (Modified True)) = BS.singleton 3++getCabalFilesOfInterestUntracked :: Action (HashMap NormalizedFilePath FileOfInterestStatus)+getCabalFilesOfInterestUntracked = do+ OfInterestCabalVar var <- Shake.getIdeGlobalAction+ liftIO $ readVar var++addFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO ()+addFileOfInterest recorder state f v = do+ OfInterestCabalVar var <- Shake.getIdeGlobalState state+ (prev, files) <- modifyVar var $ \dict -> do+ let (prev, new) = HashMap.alterF (, Just v) f dict+ pure (new, (prev, new))+ when (prev /= Just v) $ do+ join $ atomically $ Shake.recordDirtyKeys (shakeExtras state) IsFileOfInterest [f]+ log' Debug $ LogFOI files+ where+ log' = logWith recorder++deleteFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> IO ()+deleteFileOfInterest recorder state f = do+ OfInterestCabalVar var <- Shake.getIdeGlobalState state+ files <- modifyVar' var $ HashMap.delete f+ join $ atomically $ Shake.recordDirtyKeys (shakeExtras state) IsFileOfInterest [f]+ log' Debug $ LogFOI files+ where+ log' = logWith recorder
+ src/Ide/Plugin/Cabal/Diagnostics.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+module Ide.Plugin.Cabal.Diagnostics+( errorDiagnostic+, warningDiagnostic+, positionFromCabalPosition+ -- * Re-exports+, FileDiagnostic+, Diagnostic(..)+)+where++import qualified Data.Text as T+import Development.IDE (FileDiagnostic,+ ShowDiagnostic (ShowDiag))+import Distribution.Fields (showPError, showPWarning)+import qualified Ide.Plugin.Cabal.Parse as Lib+import Ide.PluginUtils (extendNextLine)+import Language.LSP.Types (Diagnostic (..),+ DiagnosticSeverity (..),+ DiagnosticSource, NormalizedFilePath,+ Position (Position), Range (Range),+ fromNormalizedFilePath)++-- | Produce a diagnostic from a Cabal parser error+errorDiagnostic :: NormalizedFilePath -> Lib.PError -> FileDiagnostic+errorDiagnostic fp err@(Lib.PError pos _) =+ mkDiag fp "cabal" DsError (toBeginningOfNextLine pos) msg+ where+ msg = T.pack $ showPError (fromNormalizedFilePath fp) err++-- | Produce a diagnostic from a Cabal parser warning+warningDiagnostic :: NormalizedFilePath -> Lib.PWarning -> FileDiagnostic+warningDiagnostic fp warning@(Lib.PWarning _ pos _) =+ mkDiag fp "cabal" DsWarning (toBeginningOfNextLine pos) msg+ where+ msg = T.pack $ showPWarning (fromNormalizedFilePath fp) warning++-- | The Cabal parser does not output a _range_ for a warning/error,+-- only a single source code 'Lib.Position'.+-- We define the range to be _from_ this position+-- _to_ the first column of the next line.+toBeginningOfNextLine :: Lib.Position -> Range+toBeginningOfNextLine cabalPos = extendNextLine $ Range pos pos+ where+ pos = positionFromCabalPosition cabalPos++-- | Convert a 'Lib.Position' from Cabal to a 'Range' that LSP understands.+--+-- Prefer this function over hand-rolled unpacking/packing, since LSP is zero-based,+-- while Cabal is one-based.+--+-- >>> positionFromCabalPosition $ Lib.Position 1 1+-- Position 0 0+positionFromCabalPosition :: Lib.Position -> Position+positionFromCabalPosition (Lib.Position line column) = Position (fromIntegral line') (fromIntegral col')+ where+ -- LSP is zero-based, Cabal is one-based+ line' = line-1+ col' = column-1++-- | Create a 'FileDiagnostic'+mkDiag+ :: NormalizedFilePath+ -- ^ Cabal file path+ -> DiagnosticSource+ -- ^ Where does the diagnostic come from?+ -> DiagnosticSeverity+ -- ^ Severity+ -> Range+ -- ^ Which source code range should the editor highlight?+ -> T.Text+ -- ^ The message displayed by the editor+ -> FileDiagnostic+mkDiag file diagSource sev loc msg = (file, ShowDiag,)+ Diagnostic+ { _range = loc+ , _severity = Just sev+ , _source = Just diagSource+ , _message = msg+ , _code = Nothing+ , _tags = Nothing+ , _relatedInformation = Nothing+ }
+ src/Ide/Plugin/Cabal/LicenseSuggest.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ExplicitNamespaces #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+module Ide.Plugin.Cabal.LicenseSuggest+( licenseErrorSuggestion+, licenseErrorAction+ -- * Re-exports+, T.Text+, Diagnostic(..)+)+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 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+-- the incorrect license identifier with the suggestion.+licenseErrorAction+ :: Uri+ -- ^ File for which the diagnostic was generated+ -> Diagnostic+ -- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'+ -> [CodeAction]+licenseErrorAction uri diag =+ mkCodeAction <$> licenseErrorSuggestion (_message diag)+ where+ mkCodeAction (original, suggestion) =+ let+ -- The Cabal parser does not output the _range_ of the incorrect license identifier,+ -- only a single source code position. Consequently, in 'Ide.Plugin.Cabal.Diag.errorDiagnostic'+ -- we define the range to be from the returned position the first column of the next line.+ -- Since the "replace" code action replaces this range, we need to modify the range to+ -- start at the first character of the invalid license identifier. We achieve this by+ -- subtracting the length of the identifier from the beginning of the range.+ adjustRange (Range (Position line col) rangeTo) =+ Range (Position line (col - fromIntegral (T.length original))) rangeTo+ title = "Replace with " <> suggestion+ -- We must also add a newline character to the replacement since the range returned by+ -- 'Ide.Plugin.Cabal.Diag.errorDiagnostic' ends at the beginning of the following line.+ tedit = [TextEdit (adjustRange $ _range diag) (suggestion <> "\n")]+ edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing Nothing+ in CodeAction title (Just CodeActionQuickFix) (Just $ List []) Nothing Nothing (Just edit) Nothing Nothing++-- | 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'+ -> [(T.Text, T.Text)]+ -- ^ (Original (incorrect) license identifier, suggested replacement)+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: '(.*)'"+ 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)
+ src/Ide/Plugin/Cabal/Parse.hs view
@@ -0,0 +1,27 @@+module Ide.Plugin.Cabal.Parse+( parseCabalFileContents+ -- * Re-exports+, FilePath+, NonEmpty(..)+, PWarning(..)+, Version+, PError(..)+, Position(..)+, GenericPackageDescription(..)+) where++import qualified Data.ByteString as BS+import Data.List.NonEmpty (NonEmpty (..))+import Distribution.Fields (PError (..),+ PWarning (..))+import Distribution.Fields.ParseResult (runParseResult)+import Distribution.PackageDescription.Parsec (parseGenericPackageDescription)+import Distribution.Parsec.Position (Position (..))+import Distribution.Types.GenericPackageDescription (GenericPackageDescription (..))+import Distribution.Types.Version (Version)++parseCabalFileContents+ :: BS.ByteString -- ^ UTF-8 encoded bytestring+ -> IO ([PWarning], Either (Maybe Version, NonEmpty PError) GenericPackageDescription)+parseCabalFileContents bs =+ pure $ runParseResult (parseGenericPackageDescription bs)
+ test/Main.hs view
@@ -0,0 +1,182 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-orphans #-}+{-# 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 qualified Data.Text as Text+import Ide.Plugin.Cabal+import Ide.Plugin.Cabal.LicenseSuggest (licenseErrorSuggestion)+import qualified Ide.Plugin.Cabal.Parse as Lib+import qualified Language.LSP.Types.Lens as J+import System.FilePath+import Test.Hls++cabalPlugin :: PluginTestDescriptor Log+cabalPlugin = mkPluginTestDescriptor descriptor "cabal"++main :: IO ()+main = do+ defaultTestRunner $+ testGroup "Cabal Plugin Tests"+ [ unitTests+ , pluginTests+ ]++-- ------------------------------------------------------------------------+-- Unit Tests+-- ------------------------------------------------------------------------++unitTests :: TestTree+unitTests =+ testGroup "Unit Tests"+ [ cabalParserUnitTests,+ codeActionUnitTests+ ]++cabalParserUnitTests :: TestTree+cabalParserUnitTests = testGroup "Parsing Cabal"+ [ testCase "Simple Parsing works" $ do+ (warnings, pm) <- Lib.parseCabalFileContents =<< BS.readFile (testDataDir </> "simple.cabal")+ liftIO $ do+ null warnings @? "Found unexpected warnings"+ isRight pm @? "Failed to parse GenericPackageDescription"+ ]++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?" @?= [],++ testCase "BSD-3-Clause" $ do+ 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+ -- contains no suggestion+ take 2 (licenseErrorSuggestion "Unknown SPDX license identifier: 'MiT'")+ @?= [("MiT","MIT"),("MiT","MIT-0")]+ ]++-- ------------------------------------------------------------------------+-- Integration Tests+-- ------------------------------------------------------------------------++pluginTests :: TestTree+pluginTests = testGroup "Plugin Tests"+ [ testGroup "Diagnostics"+ [ runCabalTestCaseSession "Publishes Diagnostics on Error" "" $ do+ doc <- openDoc "invalid.cabal" "cabal"+ diags <- waitForDiagnosticsFromSource doc "cabal"+ unknownLicenseDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'BSD3'"]+ liftIO $ do+ length diags @?= 1+ unknownLicenseDiag ^. J.range @?= Range (Position 3 24) (Position 4 0)+ unknownLicenseDiag ^. J.severity @?= Just DsError+ , runCabalTestCaseSession "Clears diagnostics" "" $ do+ doc <- openDoc "invalid.cabal" "cabal"+ diags <- waitForDiagnosticsFrom doc+ unknownLicenseDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'BSD3'"]+ liftIO $ do+ length diags @?= 1+ unknownLicenseDiag ^. J.range @?= Range (Position 3 24) (Position 4 0)+ unknownLicenseDiag ^. J.severity @?= Just DsError+ _ <- applyEdit doc $ TextEdit (Range (Position 3 20) (Position 4 0)) "BSD-3-Clause\n"+ newDiags <- waitForDiagnosticsFrom doc+ liftIO $ newDiags @?= []+ , runCabalTestCaseSession "No Diagnostics in .hs files from valid .cabal file" "simple-cabal" $ do+ hsDoc <- openDoc "A.hs" "haskell"+ expectNoMoreDiagnostics 1 hsDoc "typechecking"+ cabalDoc <- openDoc "simple-cabal.cabal" "cabal"+ expectNoMoreDiagnostics 1 cabalDoc "parsing"+ , ignoreTestBecause "Testcase is flaky for certain GHC versions (e.g. 9.2.5). See #3333 for details." $ do+ runCabalTestCaseSession "Diagnostics in .hs files from invalid .cabal file" "simple-cabal" $ do+ hsDoc <- openDoc "A.hs" "haskell"+ expectNoMoreDiagnostics 1 hsDoc "typechecking"+ cabalDoc <- openDoc "simple-cabal.cabal" "cabal"+ expectNoMoreDiagnostics 1 cabalDoc "parsing"+ let theRange = Range (Position 3 20) (Position 3 23)+ -- Invalid license+ changeDoc cabalDoc [TextDocumentContentChangeEvent (Just theRange) Nothing "MIT3"]+ cabalDiags <- waitForDiagnosticsFrom cabalDoc+ unknownLicenseDiag <- liftIO $ inspectDiagnostic cabalDiags ["Unknown SPDX license identifier: 'MIT3'"]+ expectNoMoreDiagnostics 1 hsDoc "typechecking"+ liftIO $ do+ length cabalDiags @?= 1+ unknownLicenseDiag ^. J.range @?= Range (Position 3 24) (Position 4 0)+ unknownLicenseDiag ^. J.severity @?= Just DsError+ ]+ , testGroup "Code Actions"+ [ runCabalTestCaseSession "BSD-3" "" $ do+ doc <- openDoc "licenseCodeAction.cabal" "cabal"+ diags <- waitForDiagnosticsFromSource doc "cabal"+ reduceDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'BSD3'"]+ liftIO $ do+ 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))+ executeCodeAction codeAction+ contents <- documentContents doc+ liftIO $ contents @?= Text.unlines+ [ "cabal-version: 3.0"+ , "name: licenseCodeAction"+ , "version: 0.1.0.0"+ , "license: BSD-3-Clause"+ , ""+ , "library"+ , " build-depends: base"+ , " default-language: Haskell2010"+ ]+ , runCabalTestCaseSession "Apache-2.0" "" $ 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+-- ------------------------------------------------------------------------++runCabalTestCaseSession :: TestName -> FilePath -> Session () -> TestTree+runCabalTestCaseSession title subdir = testCase title . runCabalSession subdir++runCabalSession :: FilePath -> Session a -> IO a+runCabalSession subdir =+ failIfSessionTimeout . runSessionWithServer cabalPlugin (testDataDir </> subdir)++testDataDir :: FilePath+testDataDir = "test" </> "testdata"
+ test/testdata/invalid.cabal view
@@ -0,0 +1,8 @@+cabal-version: 3.0+name: invalid+version: 0.1.0.0+license: BSD3++library+ build-depends: base+ default-language: Haskell2010
+ test/testdata/licenseCodeAction.cabal view
@@ -0,0 +1,8 @@+cabal-version: 3.0+name: licenseCodeAction+version: 0.1.0.0+license: BSD3++library+ build-depends: base+ default-language: Haskell2010
+ test/testdata/licenseCodeAction2.cabal view
@@ -0,0 +1,8 @@+cabal-version: 3.0+name: licenseCodeAction2+version: 0.1.0.0+license: APAHE++library+ build-depends: base+ default-language: Haskell2010
+ test/testdata/simple-cabal/A.hs view
@@ -0,0 +1,4 @@+module A where++-- definitions don't matter here.+foo = 1
+ test/testdata/simple-cabal/cabal.project view
@@ -0,0 +1,1 @@+packages: .
+ test/testdata/simple-cabal/hie.yaml view
@@ -0,0 +1,2 @@+cradle:+ cabal:
+ test/testdata/simple-cabal/simple-cabal.cabal view
@@ -0,0 +1,10 @@+cabal-version: 3.0+name: simple-cabal+version: 0.1.0.0+license: MIT++library+ build-depends: base+ hs-source-dirs: .+ exposed-modules: A+ default-language: Haskell2010
+ test/testdata/simple.cabal view
@@ -0,0 +1,24 @@+cabal-version: 3.0+name: hls-cabal-plugin+version: 0.1.0.0+synopsis:+homepage:+license: MIT+license-file: LICENSE+author: Fendor+maintainer: fendor@posteo.de+category: Development+extra-source-files: CHANGELOG.md++library+ exposed-modules: IDE.Plugin.Cabal+ build-depends: base ^>=4.14.3.0+ hs-source-dirs: src+ default-language: Haskell2010++test-suite hls-cabal-plugin-test+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ build-depends: base ^>=4.14.3.0