From be0150d080f5686d5f650251067e754f732720c7 Mon Sep 17 00:00:00 2001 From: Fendor Date: Sun, 10 Jul 2022 18:10:56 +0200 Subject: [PATCH 01/25] Extract cabal plugin in its own package --- cabal.project | 1 + haskell-language-server.cabal | 12 ++++ plugins/hls-cabal-plugin/CHANGELOG.md | 5 ++ plugins/hls-cabal-plugin/LICENSE | 20 +++++++ .../hls-cabal-plugin/hls-cabal-plugin.cabal | 46 +++++++++++++++ .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 59 +++++++++++++++++++ plugins/hls-cabal-plugin/test/Main.hs | 22 +++++++ .../test/testdata/simple.cabal | 24 ++++++++ src/HlsPlugins.hs | 7 ++- stack-lts19.yaml | 1 + stack.yaml | 1 + 11 files changed, 197 insertions(+), 1 deletion(-) create mode 100644 plugins/hls-cabal-plugin/CHANGELOG.md create mode 100644 plugins/hls-cabal-plugin/LICENSE create mode 100644 plugins/hls-cabal-plugin/hls-cabal-plugin.cabal create mode 100644 plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs create mode 100644 plugins/hls-cabal-plugin/test/Main.hs create mode 100644 plugins/hls-cabal-plugin/test/testdata/simple.cabal diff --git a/cabal.project b/cabal.project index 4dee7fc198..6536f26465 100644 --- a/cabal.project +++ b/cabal.project @@ -8,6 +8,7 @@ packages: ./ghcide/test ./hls-plugin-api ./hls-test-utils + ./plugins/hls-cabal-plugin ./plugins/hls-cabal-fmt-plugin ./plugins/hls-tactics-plugin ./plugins/hls-brittany-plugin diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index cc69eed3a1..6926f53318 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -63,6 +63,12 @@ flag ignore-plugins-ghc-bounds default: False manual: True + +flag cabal + description: Enable cabal plugin + default: True + manual: True + flag class description: Enable class plugin default: True @@ -215,6 +221,11 @@ common cabalfmt build-depends: hls-cabal-fmt-plugin ^>= 0.1.0.0 cpp-options: -Dhls_cabalfmt +common cabal + if flag(cabal) + build-depends: hls-cabal-plugin ^>= 0.1 + cpp-options: -Dhls_cabal + common class if flag(class) build-depends: hls-class-plugin ^>= 1.1 @@ -358,6 +369,7 @@ library , warnings , pedantic -- plugins + , cabal , callHierarchy , cabalfmt , changeTypeSignature diff --git a/plugins/hls-cabal-plugin/CHANGELOG.md b/plugins/hls-cabal-plugin/CHANGELOG.md new file mode 100644 index 0000000000..cfebb241bb --- /dev/null +++ b/plugins/hls-cabal-plugin/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for hls-cabal-plugin + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/plugins/hls-cabal-plugin/LICENSE b/plugins/hls-cabal-plugin/LICENSE new file mode 100644 index 0000000000..6d34465ea5 --- /dev/null +++ b/plugins/hls-cabal-plugin/LICENSE @@ -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. diff --git a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal new file mode 100644 index 0000000000..10437ae0d8 --- /dev/null +++ b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal @@ -0,0 +1,46 @@ +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: + , aeson + , base >=4.12 && <5 + , czipwith + , extra + , filepath + , ghc-exactprint + , ghcide >=1.6 && <1.9 + , hls-plugin-api >=1.5 && <1.6 + , lens + , lsp-types + , text + , transformers + + -- see https://github.com/lspitzner/brittany/issues/364 + -- TODO: remove these when GH issue #2005 is resolved + 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 + , filepath + , hls-cabal-plugin + , hls-test-utils ^>=1.4 + , lsp + , lsp-types + , text diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs new file mode 100644 index 0000000000..ca20507e13 --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} + +module Ide.Plugin.Cabal where + +import Control.Monad.IO.Class +import Data.Aeson +import qualified Data.Text as T +import Development.IDE as D +import GHC.Generics +import Ide.PluginUtils +import Ide.Types +import Language.LSP.Types + + +newtype Log = LogText T.Text deriving Show + +instance Pretty Log where + pretty = \case + LogText log -> pretty log + +descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState +descriptor recorder plId = (defaultCabalPluginDescriptor plId) + { pluginHandlers = mkPluginHandler STextDocumentCodeLens (codeLens recorder) + } + +-- --------------------------------------------------------------------- + +codeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState TextDocumentCodeLens +codeLens recorder _ideState plId CodeLensParams{_textDocument=TextDocumentIdentifier uri} = liftIO $ do + log Debug $ LogText "ExampleCabal.codeLens entered (ideLogger)" + case uriToFilePath' uri of + Just (toNormalizedFilePath -> _filePath) -> do + let + title = "Add TODO Item via Code Lens" + range = Range (Position 3 0) (Position 4 0) + let cmdParams = AddTodoParams uri "do abc" + cmd = mkLspCommand plId "codelens.todo" title (Just [toJSON cmdParams]) + pure $ Right $ List [ CodeLens range (Just cmd) Nothing ] + Nothing -> pure $ Right $ List [] + where + log = logWith recorder +-- --------------------------------------------------------------------- + +data AddTodoParams = AddTodoParams + { file :: Uri -- ^ Uri of the file to add the pragma to + , todoText :: T.Text + } + deriving (Show, Eq, Generic, ToJSON, FromJSON) diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs new file mode 100644 index 0000000000..a78602a4a2 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main + ( main + ) where + +import qualified Data.Text as T +import qualified Language.LSP.Types.Lens as L +import Ide.Plugin.Cabal +import System.FilePath +import Test.Hls +import Test.Hls.Util (onlyWorkForGhcVersions) + +main :: IO () +main = defaultTestRunner tests + +pragmasPlugin :: PluginDescriptor IdeState +pragmasPlugin = descriptor mempty "cabal" + +tests :: TestTree +tests = + testGroup "cabal" + [] \ No newline at end of file diff --git a/plugins/hls-cabal-plugin/test/testdata/simple.cabal b/plugins/hls-cabal-plugin/test/testdata/simple.cabal new file mode 100644 index 0000000000..1adb3b2795 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/simple.cabal @@ -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 diff --git a/src/HlsPlugins.hs b/src/HlsPlugins.hs index b471fa65cb..6fe2e4ef24 100644 --- a/src/HlsPlugins.hs +++ b/src/HlsPlugins.hs @@ -21,7 +21,9 @@ import qualified Ide.Plugin.QualifyImportedNames as QualifyImportedNames #if hls_callHierarchy import qualified Ide.Plugin.CallHierarchy as CallHierarchy #endif - +#if hls_cabal +import qualified Ide.Plugin.Cabal as Cabal +#endif #if hls_class import qualified Ide.Plugin.Class as Class #endif @@ -146,6 +148,9 @@ idePlugins recorder = pluginDescToIdePlugins allPlugins pluginRecorder :: forall log. (Pretty log) => PluginId -> Recorder (WithPriority log) pluginRecorder pluginId = cmapWithPrio (Log pluginId) recorder allPlugins = +#if hls_cabal + let pId = "cabal" in Cabal.descriptor (pluginRecorder pId) pId : +#endif #if hls_pragmas Pragmas.descriptor "pragmas" : #endif diff --git a/stack-lts19.yaml b/stack-lts19.yaml index 4e33bd28f8..74d90c3361 100644 --- a/stack-lts19.yaml +++ b/stack-lts19.yaml @@ -9,6 +9,7 @@ packages: - ./hls-plugin-api - ./hls-test-utils # - ./shake-bench + - ./plugins/hls-cabal-plugin - ./plugins/hls-cabal-fmt-plugin - ./plugins/hls-call-hierarchy-plugin - ./plugins/hls-class-plugin diff --git a/stack.yaml b/stack.yaml index ca2f39b5cf..b92448278e 100644 --- a/stack.yaml +++ b/stack.yaml @@ -9,6 +9,7 @@ packages: - ./hls-plugin-api - ./hls-test-utils - ./shake-bench +- ./plugins/hls-cabal-plugin - ./plugins/hls-cabal-fmt-plugin - ./plugins/hls-call-hierarchy-plugin - ./plugins/hls-class-plugin From c7b1a97d1c612854f18f6fc9bc3546de8c8c39fc Mon Sep 17 00:00:00 2001 From: "Rune K. Svendsen" Date: Sat, 11 Jun 2022 16:25:02 +0200 Subject: [PATCH 02/25] hls-cabal-plugin: Add plugin Add golden parse test for test/testdata/simple.cabal Add module Ide.Plugin.Cabal.Diag Also: add -Wall Add parseCabalFileContents Use VFS for cabal file contents Diagnostics * Parse and display Errors * Parse and display Warnings Code Actions * Code Action for License Field --- .../hls-cabal-plugin/hls-cabal-plugin.cabal | 38 ++++- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 148 ++++++++++++++---- .../src/Ide/Plugin/Cabal/Diagnostics.hs | 73 +++++++++ .../src/Ide/Plugin/Cabal/LicenseSuggest.hs | 73 +++++++++ .../src/Ide/Plugin/Cabal/Parse.hs | 46 ++++++ plugins/hls-cabal-plugin/test/Main.hs | 17 +- .../test/testdata/simple.cabal.golden.txt | 1 + 7 files changed, 355 insertions(+), 41 deletions(-) create mode 100644 plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs create mode 100644 plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs create mode 100644 plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Parse.hs create mode 100644 plugins/hls-cabal-plugin/test/testdata/simple.cabal.golden.txt diff --git a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal index 10437ae0d8..1faab67b3e 100644 --- a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal +++ b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal @@ -1,37 +1,60 @@ cabal-version: 3.0 name: hls-cabal-plugin version: 0.1.0.0 -synopsis: +synopsis: Cabal integration plugin with Haskell Language Server +description: + Please see the README on GitHub at + homepage: license: MIT license-file: LICENSE author: Fendor maintainer: fendor@posteo.de category: Development -extra-source-files: CHANGELOG.md +extra-source-files: + CHANGELOG.md + test/testdata/simple.cabal + test/testdata/simple.cabal.golden.txt + +common warnings + ghc-options: -Wall library - exposed-modules: Ide.Plugin.Cabal + import: warnings + exposed-modules: + Ide.Plugin.Cabal + Ide.Plugin.Cabal.Diagnostics + Ide.Plugin.Cabal.LicenseSuggest + Ide.Plugin.Cabal.Parse + build-depends: , aeson - , base >=4.12 && <5 + , base >=4.12 && <5 + , bytestring + , Cabal , czipwith + , deepseq + , directory , extra , filepath , ghc-exactprint , ghcide >=1.6 && <1.9 + , hashable , hls-plugin-api >=1.5 && <1.6 , lens + , lsp , lsp-types + , regex-tdfa + , stm , text , transformers + , unordered-containers - -- see https://github.com/lspitzner/brittany/issues/364 - -- TODO: remove these when GH issue #2005 is resolved hs-source-dirs: src default-language: Haskell2010 -test-suite hls-cabal-plugin-test +test-suite tests + import: warnings default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: test @@ -43,4 +66,5 @@ test-suite hls-cabal-plugin-test , hls-test-utils ^>=1.4 , lsp , lsp-types + , tasty-hunit , text diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index ca20507e13..deab26f62d 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -1,59 +1,141 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ViewPatterns #-} module Ide.Plugin.Cabal where +import Control.Concurrent.STM +import Control.DeepSeq (NFData) +import Control.Monad.Extra import Control.Monad.IO.Class -import Data.Aeson -import qualified Data.Text as T -import Development.IDE as D +import qualified Data.ByteString as BS +import Data.Hashable +import qualified Data.List.NonEmpty as NE +import Data.Maybe (catMaybes) +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 GHC.Generics -import Ide.PluginUtils +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 - -newtype Log = LogText T.Text deriving Show +data Log + = LogModificationTime NormalizedFilePath (Maybe FileVersion) + | LogDiagnostics NormalizedFilePath [FileDiagnostic] + | LogShake Shake.Log + deriving Show instance Pretty Log where pretty = \case - LogText log -> pretty log + LogShake log' -> pretty log' + LogModificationTime nfp modTime -> + "Modified:" <+> pretty (fromNormalizedFilePath nfp) <+> pretty (show modTime) + LogDiagnostics nfp diags -> + "Diagnostics for " <+> pretty (fromNormalizedFilePath nfp) <> ":" <+> pretty (show diags) descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState descriptor recorder plId = (defaultCabalPluginDescriptor plId) - { pluginHandlers = mkPluginHandler STextDocumentCodeLens (codeLens recorder) + { pluginRules = cabalRules recorder + , pluginHandlers = mkPluginHandler STextDocumentCodeAction licenseSuggestCodeAction + , pluginNotificationHandlers = mconcat + [ mkPluginNotificationHandler LSP.STextDocumentDidOpen $ + \ide vfs _ (DidOpenTextDocumentParams TextDocumentItem{_uri,_version}) -> liftIO $ do + whenUriFile _uri $ \file -> do + logDebug (ideLogger ide) $ "Opened text document: " <> getUri _uri + join $ atomically $ Shake.recordDirtyKeys (shakeExtras ide) GetModificationTime [file] + restartShakeSession (shakeExtras ide) (VFSModified vfs) (fromNormalizedFilePath file ++ " (opened)") [] + join $ Shake.shakeEnqueue (shakeExtras ide) $ Shake.mkDelayedAction "cabal parse modified" Info $ void $ use ParseCabal file + + , mkPluginNotificationHandler LSP.STextDocumentDidChange $ + \ide vfs _ (DidChangeTextDocumentParams VersionedTextDocumentIdentifier{_uri} _) -> liftIO $ do + whenUriFile _uri $ \file -> do + logDebug (ideLogger ide) $ "Modified text document: " <> getUri _uri + logDebug (ideLogger ide) $ "VFS State: " <> T.pack (show vfs) + join $ atomically $ Shake.recordDirtyKeys (shakeExtras ide) GetModificationTime [file] + restartShakeSession (shakeExtras ide) (VFSModified vfs) (fromNormalizedFilePath file ++ " (modified)") [] + join $ Shake.shakeEnqueue (shakeExtras ide) $ Shake.mkDelayedAction "cabal parse modified" Info $ void $ use ParseCabal file + + , mkPluginNotificationHandler LSP.STextDocumentDidSave $ + \ide vfs _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do + whenUriFile _uri $ \file -> do + logDebug (ideLogger ide) $ "Saved text document: " <> getUri _uri + join $ atomically $ Shake.recordDirtyKeys (shakeExtras ide) GetModificationTime [file] + restartShakeSession (shakeExtras ide) (VFSModified vfs) (fromNormalizedFilePath file ++ " (saved)") [] + join $ Shake.shakeEnqueue (shakeExtras ide) $ Shake.mkDelayedAction "cabal parse modified" Info $ void $ use ParseCabal file + + , mkPluginNotificationHandler LSP.STextDocumentDidClose $ + \ide vfs _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do + whenUriFile _uri $ \file -> do + let msg = "Closed text document: " <> getUri _uri + logDebug (ideLogger ide) msg + join $ atomically $ Shake.recordDirtyKeys (shakeExtras ide) GetModificationTime [file] + restartShakeSession (shakeExtras ide) (VFSModified vfs) (fromNormalizedFilePath file ++ " (closed)") [] + join $ Shake.shakeEnqueue (shakeExtras ide) $ Shake.mkDelayedAction "cabal parse modified" Info $ void $ use ParseCabal file + ] } + where + whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO () + whenUriFile uri act = whenJust (LSP.uriToFilePath uri) $ act . toNormalizedFilePath' + +-- ---------------------------------------------------------------- +-- Plugin Rules +-- ---------------------------------------------------------------- --- --------------------------------------------------------------------- - -codeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState TextDocumentCodeLens -codeLens recorder _ideState plId CodeLensParams{_textDocument=TextDocumentIdentifier uri} = liftIO $ do - log Debug $ LogText "ExampleCabal.codeLens entered (ideLogger)" - case uriToFilePath' uri of - Just (toNormalizedFilePath -> _filePath) -> do - let - title = "Add TODO Item via Code Lens" - range = Range (Position 3 0) (Position 4 0) - let cmdParams = AddTodoParams uri "do abc" - cmd = mkLspCommand plId "codelens.todo" title (Just [toJSON cmdParams]) - pure $ Right $ List [ CodeLens range (Just cmd) Nothing ] - Nothing -> pure $ Right $ List [] +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 + define (cmapWithPrio LogShake recorder) $ \ParseCabal file -> do + t <- use GetModificationTime file + log' Debug $ LogModificationTime file t + mVirtualFile <- Shake.getVirtualFile file + contents <- case mVirtualFile of + Just vfile -> pure $ Encoding.encodeUtf8 $ VFS.virtualFileText vfile + 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 + log' Debug $ LogDiagnostics file allDiags + pure (allDiags, Nothing) + Right _ -> do + log' Debug $ LogDiagnostics file warningDiags + pure (warningDiags, Just ()) where - log = logWith recorder --- --------------------------------------------------------------------- + log' = logWith recorder -data AddTodoParams = AddTodoParams - { file :: Uri -- ^ Uri of the file to add the pragma to - , todoText :: T.Text - } - deriving (Show, Eq, Generic, ToJSON, FromJSON) +-- ---------------------------------------------------------------- +-- Code Actions +-- ---------------------------------------------------------------- + +licenseSuggestCodeAction + :: IdeState + -> PluginId + -> CodeActionParams + -> LspM Config (Either ResponseError (ResponseResult 'TextDocumentCodeAction)) +licenseSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List diags}) = + pure $ Right $ List $ catMaybes $ map (fmap InR . LicenseSuggest.licenseErrorAction uri) diags diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs new file mode 100644 index 0000000000..b06fc28a05 --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE TupleSections #-} +module Ide.Plugin.Cabal.Diagnostics +( errorDiagnostic +, warningDiagnostic + -- * 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 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 (T.pack "parsing") 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 (T.pack "parsing") 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 (Lib.Position line column) = + Range + (Position (fromIntegral line') (fromIntegral col')) + (Position (fromIntegral $ line' + 1) 0) + 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 + } diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs new file mode 100644 index 0000000000..c7480de681 --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs @@ -0,0 +1,73 @@ +{-# 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 + +-- | 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' + -> Maybe CodeAction +licenseErrorAction uri diag = + mkCodeAction <$> licenseErrorSuggestion 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 + +-- | 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 + :: Diagnostic + -- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic' + -> Maybe (T.Text, T.Text) + -- ^ (Original (incorrect) license identifier, suggested replacement) +licenseErrorSuggestion diag = + mSuggestion (_message diag) >>= \case + [original, suggestion] -> Just (original, suggestion) + _ -> Nothing + where + regex :: T.Text + regex = "Unknown SPDX license identifier: '(.*)' Do you mean (.*)\\?" + mSuggestion msg = getMatch <$> (msg :: T.Text) =~~ regex + getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> [T.Text] + getMatch (_, _, _, results) = results diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Parse.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Parse.hs new file mode 100644 index 0000000000..d1e62cd73e --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Parse.hs @@ -0,0 +1,46 @@ +module Ide.Plugin.Cabal.Parse +( parseCabalFile +, parseCabalFileContents + -- * Re-exports +, FilePath +, NonEmpty(..) +, PWarning(..) +, Version +, PError(..) +, Position(..) +, GenericPackageDescription(..) +) where + +import Control.Monad (unless) +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) +import qualified System.Directory as Dir +import qualified System.Exit as Exit + + +parseCabalFile + :: FilePath + -> IO ([PWarning], Either (Maybe Version, NonEmpty PError) GenericPackageDescription) +parseCabalFile = + readAndParseFile' + where + readAndParseFile' fpath = do + exists <- Dir.doesFileExist fpath + unless exists $ + Exit.die $ + "Error Parsing: file \"" ++ fpath ++ "\" doesn't exist. Cannot continue." + bs <- BS.readFile fpath + parseCabalFileContents bs + +parseCabalFileContents + :: BS.ByteString + -> IO ([PWarning], Either (Maybe Version, NonEmpty PError) GenericPackageDescription) +parseCabalFileContents bs = + pure $ runParseResult (parseGenericPackageDescription bs) diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index a78602a4a2..75e7925d2d 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -3,12 +3,14 @@ module Main ( main ) where +import qualified Ide.Plugin.Cabal.Parse as Lib import qualified Data.Text as T import qualified Language.LSP.Types.Lens as L import Ide.Plugin.Cabal import System.FilePath import Test.Hls import Test.Hls.Util (onlyWorkForGhcVersions) +import Test.Tasty.HUnit (assertFailure, testCase, (@?=)) main :: IO () main = defaultTestRunner tests @@ -19,4 +21,17 @@ pragmasPlugin = descriptor mempty "cabal" tests :: TestTree tests = testGroup "cabal" - [] \ No newline at end of file + [ testCase "parsing works" $ do + parseRes <- Lib.parseCabalFile "test/testdata/simple.cabal" + goldenShowStr <- readFile "test/testdata/simple.cabal.golden.txt" + show parseRes @?= goldenShowStr + ] + +-- Orphans +instance Eq Lib.PWarning where + Lib.PWarning pWarnType1 pos1 str1 == Lib.PWarning pWarnType2 pos2 str2 = + pWarnType1 == pWarnType2 && pos1 == pos2 && str1 == str2 + +instance Eq Lib.PError where + Lib.PError pos1 str1 == Lib.PError pos2 str2 = + pos1 == pos2 && str1 == str2 diff --git a/plugins/hls-cabal-plugin/test/testdata/simple.cabal.golden.txt b/plugins/hls-cabal-plugin/test/testdata/simple.cabal.golden.txt new file mode 100644 index 0000000000..667393f689 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/simple.cabal.golden.txt @@ -0,0 +1 @@ +([],Right (GenericPackageDescription {packageDescription = PackageDescription {specVersion = CabalSpecV3_0, package = PackageIdentifier {pkgName = PackageName "hls-cabal-plugin", pkgVersion = mkVersion [0,1,0,0]}, licenseRaw = Left (License (ELicense (ELicenseId MIT) Nothing)), licenseFiles = [SymbolicPath "LICENSE"], copyright = "", maintainer = "fendor@posteo.de", author = "Fendor", stability = "", testedWith = [], homepage = "", pkgUrl = "", bugReports = "", sourceRepos = [], synopsis = "", description = "", category = "Development", customFieldsPD = [], buildTypeRaw = Nothing, setupBuildInfo = Nothing, library = Nothing, subLibraries = [], executables = [], foreignLibs = [], testSuites = [], benchmarks = [], dataFiles = [], dataDir = ".", extraSrcFiles = ["CHANGELOG.md"], extraTmpFiles = [], extraDocFiles = []}, gpdScannedVersion = Nothing, genPackageFlags = [], condLibrary = Just (CondNode {condTreeData = Library {libName = LMainLibName, exposedModules = [ModuleName "IDE.Plugin.Cabal"], reexportedModules = [], signatures = [], libExposed = True, libVisibility = LibraryVisibilityPublic, libBuildInfo = BuildInfo {buildable = True, buildTools = [], buildToolDepends = [], cppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], frameworks = [], extraFrameworkDirs = [], asmSources = [], cmmSources = [], cSources = [], cxxSources = [], jsSources = [], hsSourceDirs = [SymbolicPath "src"], otherModules = [], virtualModules = [], autogenModules = [], defaultLanguage = Just Haskell2010, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraGHCiLibs = [], extraBundledLibs = [], extraLibFlavours = [], extraDynLibFlavours = [], extraLibDirs = [], includeDirs = [], includes = [], autogenIncludes = [], installIncludes = [], options = PerCompilerFlavor [] [], profOptions = PerCompilerFlavor [] [], sharedOptions = PerCompilerFlavor [] [], staticOptions = PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [Dependency (PackageName "base") (MajorBoundVersion (mkVersion [4,14,3,0])) (fromNonEmpty (LMainLibName :| []))], mixins = []}}, condTreeConstraints = [Dependency (PackageName "base") (MajorBoundVersion (mkVersion [4,14,3,0])) (fromNonEmpty (LMainLibName :| []))], condTreeComponents = []}), condSubLibraries = [], condForeignLibs = [], condExecutables = [], condTestSuites = [(UnqualComponentName "hls-cabal-plugin-test",CondNode {condTreeData = TestSuite {testName = UnqualComponentName "", testInterface = TestSuiteExeV10 (mkVersion [1,0]) "Main.hs", testBuildInfo = BuildInfo {buildable = True, buildTools = [], buildToolDepends = [], cppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], frameworks = [], extraFrameworkDirs = [], asmSources = [], cmmSources = [], cSources = [], cxxSources = [], jsSources = [], hsSourceDirs = [SymbolicPath "test"], otherModules = [], virtualModules = [], autogenModules = [], defaultLanguage = Just Haskell2010, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraGHCiLibs = [], extraBundledLibs = [], extraLibFlavours = [], extraDynLibFlavours = [], extraLibDirs = [], includeDirs = [], includes = [], autogenIncludes = [], installIncludes = [], options = PerCompilerFlavor [] [], profOptions = PerCompilerFlavor [] [], sharedOptions = PerCompilerFlavor [] [], staticOptions = PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [Dependency (PackageName "base") (MajorBoundVersion (mkVersion [4,14,3,0])) (fromNonEmpty (LMainLibName :| []))], mixins = []}}, condTreeConstraints = [Dependency (PackageName "base") (MajorBoundVersion (mkVersion [4,14,3,0])) (fromNonEmpty (LMainLibName :| []))], condTreeComponents = []})], condBenchmarks = []})) \ No newline at end of file From 34dbd3300af17c77a2d3b3bca0f1ea1dbc547f45 Mon Sep 17 00:00:00 2001 From: Fendor Date: Thu, 23 Jun 2022 17:37:38 +0200 Subject: [PATCH 03/25] Add CI workflow --- .github/workflows/hackage.yml | 1 + .github/workflows/test.yml | 4 ++++ 2 files changed, 5 insertions(+) diff --git a/.github/workflows/hackage.yml b/.github/workflows/hackage.yml index f909ef6fb9..34e6b8b62b 100644 --- a/.github/workflows/hackage.yml +++ b/.github/workflows/hackage.yml @@ -28,6 +28,7 @@ jobs: matrix: package: ["hie-compat", "hls-graph", "shake-bench", "hls-plugin-api", "ghcide", "hls-test-utils", + "hls-cabal-plugin", "hls-brittany-plugin", "hls-floskell-plugin", "hls-fourmolu-plugin", "hls-ormolu-plugin", "hls-stylish-haskell-plugin", "hls-class-plugin", "hls-eval-plugin", "hls-explicit-imports-plugin", diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 3a79cf13d1..fb9022e113 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -259,6 +259,10 @@ jobs: name: Test hls-cabal-fmt-plugin test suite run: cabal test hls-cabal-fmt-plugin --flag=isolateTests --test-options="$TEST_OPTS" || cabal test hls-cabal-fmt-plugin --flag=isolateTests --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-cabal-fmt-plugin --flag=isolateTests --test-options="$TEST_OPTS" + - if: matrix.test + name: Test hls-cabal-plugin test suite + run: cabal test hls-cabal-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-cabal-plugin --test-options="$TEST_OPTS" + test_post_job: if: always() runs-on: ubuntu-latest From 62a6fadba5372559064f2d0b5c2269ade53fc68c Mon Sep 17 00:00:00 2001 From: Fendor Date: Sun, 26 Jun 2022 17:46:26 +0200 Subject: [PATCH 04/25] Add test-suite for hls-cabal-plugin --- hls-test-utils/src/Test/Hls.hs | 28 +++- .../hls-cabal-plugin/hls-cabal-plugin.cabal | 3 +- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 24 ++- plugins/hls-cabal-plugin/test/Main.hs | 155 +++++++++++++++--- .../test/testdata/invalid.cabal | 8 + .../test/testdata/licenseCodeAction.cabal | 8 + .../test/testdata/simple-cabal/A.hs | 4 + .../test/testdata/simple-cabal/cabal.project | 1 + .../test/testdata/simple-cabal/hie.yaml | 2 + .../testdata/simple-cabal/simple-cabal.cabal | 10 ++ .../test/testdata/simple.cabal.golden.txt | 2 +- 11 files changed, 211 insertions(+), 34 deletions(-) create mode 100644 plugins/hls-cabal-plugin/test/testdata/invalid.cabal create mode 100644 plugins/hls-cabal-plugin/test/testdata/licenseCodeAction.cabal create mode 100644 plugins/hls-cabal-plugin/test/testdata/simple-cabal/A.hs create mode 100644 plugins/hls-cabal-plugin/test/testdata/simple-cabal/cabal.project create mode 100644 plugins/hls-cabal-plugin/test/testdata/simple-cabal/hie.yaml create mode 100644 plugins/hls-cabal-plugin/test/testdata/simple-cabal/simple-cabal.cabal diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs index 7f61f66ae6..a9d3a595f3 100644 --- a/hls-test-utils/src/Test/Hls.hs +++ b/hls-test-utils/src/Test/Hls.hs @@ -16,6 +16,7 @@ module Test.Hls defaultTestRunner, goldenGitDiff, goldenWithHaskellDoc, + goldenWithCabalDoc, goldenWithHaskellDocFormatter, goldenWithCabalDocFormatter, def, @@ -124,12 +125,35 @@ goldenWithHaskellDoc -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree -goldenWithHaskellDoc plugin title testDataDir path desc ext act = +goldenWithHaskellDoc = goldenWithDoc "haskell" + +goldenWithCabalDoc + :: PluginDescriptor IdeState + -> TestName + -> FilePath + -> FilePath + -> FilePath + -> FilePath + -> (TextDocumentIdentifier -> Session ()) + -> TestTree +goldenWithCabalDoc = goldenWithDoc "cabal" + +goldenWithDoc + :: T.Text + -> PluginDescriptor IdeState + -> TestName + -> FilePath + -> FilePath + -> FilePath + -> FilePath + -> (TextDocumentIdentifier -> Session ()) + -> TestTree +goldenWithDoc fileType plugin title testDataDir path desc ext act = goldenGitDiff title (testDataDir path <.> desc <.> ext) $ runSessionWithServer plugin testDataDir $ TL.encodeUtf8 . TL.fromStrict <$> do - doc <- openDoc (path <.> ext) "haskell" + doc <- openDoc (path <.> ext) fileType void waitForBuildQueue act doc documentContents doc diff --git a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal index 1faab67b3e..0f0be31255 100644 --- a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal +++ b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal @@ -14,7 +14,6 @@ category: Development extra-source-files: CHANGELOG.md test/testdata/simple.cabal - test/testdata/simple.cabal.golden.txt common warnings ghc-options: -Wall @@ -64,7 +63,9 @@ test-suite tests , filepath , hls-cabal-plugin , hls-test-utils ^>=1.4 + , lens , lsp + , ghcide , lsp-types , tasty-hunit , text diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index deab26f62d..bf8a20f674 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -38,6 +38,10 @@ data Log = LogModificationTime NormalizedFilePath (Maybe FileVersion) | LogDiagnostics NormalizedFilePath [FileDiagnostic] | LogShake Shake.Log + | LogDocOpened Uri + | LogDocModified Uri + | LogDocSaved Uri + | LogDocClosed Uri deriving Show instance Pretty Log where @@ -47,6 +51,14 @@ instance Pretty Log where "Modified:" <+> pretty (fromNormalizedFilePath nfp) <+> pretty (show modTime) LogDiagnostics nfp diags -> "Diagnostics for " <+> pretty (fromNormalizedFilePath nfp) <> ":" <+> pretty (show diags) + 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) descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState descriptor recorder plId = (defaultCabalPluginDescriptor plId) @@ -56,7 +68,7 @@ descriptor recorder plId = (defaultCabalPluginDescriptor plId) [ mkPluginNotificationHandler LSP.STextDocumentDidOpen $ \ide vfs _ (DidOpenTextDocumentParams TextDocumentItem{_uri,_version}) -> liftIO $ do whenUriFile _uri $ \file -> do - logDebug (ideLogger ide) $ "Opened text document: " <> getUri _uri + log' Debug $ LogDocOpened _uri join $ atomically $ Shake.recordDirtyKeys (shakeExtras ide) GetModificationTime [file] restartShakeSession (shakeExtras ide) (VFSModified vfs) (fromNormalizedFilePath file ++ " (opened)") [] join $ Shake.shakeEnqueue (shakeExtras ide) $ Shake.mkDelayedAction "cabal parse modified" Info $ void $ use ParseCabal file @@ -64,8 +76,7 @@ descriptor recorder plId = (defaultCabalPluginDescriptor plId) , mkPluginNotificationHandler LSP.STextDocumentDidChange $ \ide vfs _ (DidChangeTextDocumentParams VersionedTextDocumentIdentifier{_uri} _) -> liftIO $ do whenUriFile _uri $ \file -> do - logDebug (ideLogger ide) $ "Modified text document: " <> getUri _uri - logDebug (ideLogger ide) $ "VFS State: " <> T.pack (show vfs) + log' Debug $ LogDocModified _uri join $ atomically $ Shake.recordDirtyKeys (shakeExtras ide) GetModificationTime [file] restartShakeSession (shakeExtras ide) (VFSModified vfs) (fromNormalizedFilePath file ++ " (modified)") [] join $ Shake.shakeEnqueue (shakeExtras ide) $ Shake.mkDelayedAction "cabal parse modified" Info $ void $ use ParseCabal file @@ -73,7 +84,7 @@ descriptor recorder plId = (defaultCabalPluginDescriptor plId) , mkPluginNotificationHandler LSP.STextDocumentDidSave $ \ide vfs _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do whenUriFile _uri $ \file -> do - logDebug (ideLogger ide) $ "Saved text document: " <> getUri _uri + log' Debug $ LogDocSaved _uri join $ atomically $ Shake.recordDirtyKeys (shakeExtras ide) GetModificationTime [file] restartShakeSession (shakeExtras ide) (VFSModified vfs) (fromNormalizedFilePath file ++ " (saved)") [] join $ Shake.shakeEnqueue (shakeExtras ide) $ Shake.mkDelayedAction "cabal parse modified" Info $ void $ use ParseCabal file @@ -81,14 +92,15 @@ descriptor recorder plId = (defaultCabalPluginDescriptor plId) , mkPluginNotificationHandler LSP.STextDocumentDidClose $ \ide vfs _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do whenUriFile _uri $ \file -> do - let msg = "Closed text document: " <> getUri _uri - logDebug (ideLogger ide) msg + log' Debug $ LogDocClosed _uri join $ atomically $ Shake.recordDirtyKeys (shakeExtras ide) GetModificationTime [file] restartShakeSession (shakeExtras ide) (VFSModified vfs) (fromNormalizedFilePath file ++ " (closed)") [] join $ Shake.shakeEnqueue (shakeExtras ide) $ Shake.mkDelayedAction "cabal parse modified" Info $ void $ use ParseCabal file ] } where + log' = logWith recorder + whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO () whenUriFile uri act = whenJust (LSP.uriToFilePath uri) $ act . toNormalizedFilePath' diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 75e7925d2d..5be5e980d2 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -1,37 +1,144 @@ {-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE NamedFieldPuns #-} module Main ( main ) where -import qualified Ide.Plugin.Cabal.Parse as Lib -import qualified Data.Text as T -import qualified Language.LSP.Types.Lens as L +import Control.Lens ((^.)) +import Data.Either (isRight) +import Data.Function +import qualified Data.Text as Text +import Development.IDE.Types.Logger import Ide.Plugin.Cabal +import qualified Ide.Plugin.Cabal.Parse as Lib +import qualified Language.LSP.Types.Lens as J import System.FilePath import Test.Hls -import Test.Hls.Util (onlyWorkForGhcVersions) -import Test.Tasty.HUnit (assertFailure, testCase, (@?=)) + +cabalPlugin :: Recorder (WithPriority Log) -> PluginDescriptor IdeState +cabalPlugin recorder = descriptor recorder "cabal" main :: IO () -main = defaultTestRunner tests - -pragmasPlugin :: PluginDescriptor IdeState -pragmasPlugin = descriptor mempty "cabal" - -tests :: TestTree -tests = - testGroup "cabal" - [ testCase "parsing works" $ do - parseRes <- Lib.parseCabalFile "test/testdata/simple.cabal" - goldenShowStr <- readFile "test/testdata/simple.cabal.golden.txt" - show parseRes @?= goldenShowStr +main = do + recorder <- initialiseRecorder False + defaultTestRunner $ + testGroup "Cabal Plugin Tests" + [ unitTests + , pluginTests recorder + ] + +-- | @initialiseRecorder silent@ +-- +-- If @'silent' == True@, then don't log anything, otherwise +-- the recorder is the standard recorder of HLS. Useful for debugging. +initialiseRecorder :: Bool -> IO (Recorder (WithPriority Log)) +initialiseRecorder True = pure mempty +initialiseRecorder False = do + docWithPriorityRecorder <- makeDefaultStderrRecorder Nothing Debug + + let docWithFilteredPriorityRecorder = + docWithPriorityRecorder + & cfilter (\WithPriority{ priority } -> priority >= Debug) + pure $ docWithFilteredPriorityRecorder + & cmapWithPrio pretty + +-- ------------------------------------------------------------------------ +-- Unit Tests +-- ------------------------------------------------------------------------ + +unitTests :: TestTree +unitTests = + testGroup "Unit Tests" + [ testCase "Simple Parsing works" $ do + (warnings, pm) <- Lib.parseCabalFile $ testDataDir "simple.cabal" + liftIO $ do + null warnings @? "Found unexpected warnings" + isRight pm @? "Failed to parse GenericPackageDescription" ] --- Orphans -instance Eq Lib.PWarning where - Lib.PWarning pWarnType1 pos1 str1 == Lib.PWarning pWarnType2 pos2 str2 = - pWarnType1 == pWarnType2 && pos1 == pos2 && str1 == str2 +-- ------------------------------------------------------------------------ +-- Integration Tests +-- ------------------------------------------------------------------------ + +pluginTests :: Recorder (WithPriority Log) -> TestTree +pluginTests recorder = testGroup "Plugin Tests" + [ testGroup "Diagnostics" + [ runCabalTestCaseSession "Publishes Diagnostics on Error" recorder "" $ do + doc <- openDoc "invalid.cabal" "cabal" + diags <- waitForDiagnosticsFromSource doc "parsing" + 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" recorder "" $ 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" recorder "simple-cabal" $ do + hsDoc <- openDoc "A.hs" "haskell" + expectNoMoreDiagnostics 1 hsDoc "typechecking" + cabalDoc <- openDoc "simple-cabal.cabal" "cabal" + expectNoMoreDiagnostics 1 cabalDoc "parsing" + , runCabalTestCaseSession "Diagnostics in .hs files from invalid .cabal file" recorder "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" recorder "" $ do + doc <- openDoc "licenseCodeAction.cabal" "cabal" + diags <- waitForDiagnosticsFromSource doc "parsing" + 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 + [InR codeAction] <- 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" + ] + ] + ] + +-- ------------------------------------------------------------------------ +-- Runner utils +-- ------------------------------------------------------------------------ + +runCabalTestCaseSession :: TestName -> Recorder (WithPriority Log) -> FilePath -> Session () -> TestTree +runCabalTestCaseSession title recorder subdir act = testCase title $ runCabalSession recorder subdir act + +runCabalSession :: Recorder (WithPriority Log) -> FilePath -> Session a -> IO a +runCabalSession recorder subdir = + failIfSessionTimeout . runSessionWithServer (cabalPlugin recorder) (testDataDir subdir) -instance Eq Lib.PError where - Lib.PError pos1 str1 == Lib.PError pos2 str2 = - pos1 == pos2 && str1 == str2 +testDataDir :: FilePath +testDataDir = "test" "testdata" diff --git a/plugins/hls-cabal-plugin/test/testdata/invalid.cabal b/plugins/hls-cabal-plugin/test/testdata/invalid.cabal new file mode 100644 index 0000000000..26f9b8f2d6 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/invalid.cabal @@ -0,0 +1,8 @@ +cabal-version: 3.0 +name: invalid +version: 0.1.0.0 +license: BSD3 + +library + build-depends: base + default-language: Haskell2010 diff --git a/plugins/hls-cabal-plugin/test/testdata/licenseCodeAction.cabal b/plugins/hls-cabal-plugin/test/testdata/licenseCodeAction.cabal new file mode 100644 index 0000000000..d1bbf8b5c2 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/licenseCodeAction.cabal @@ -0,0 +1,8 @@ +cabal-version: 3.0 +name: licenseCodeAction +version: 0.1.0.0 +license: BSD3 + +library + build-depends: base + default-language: Haskell2010 diff --git a/plugins/hls-cabal-plugin/test/testdata/simple-cabal/A.hs b/plugins/hls-cabal-plugin/test/testdata/simple-cabal/A.hs new file mode 100644 index 0000000000..c72a91d81a --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/simple-cabal/A.hs @@ -0,0 +1,4 @@ +module A where + +-- definitions don't matter here. +foo = 1 diff --git a/plugins/hls-cabal-plugin/test/testdata/simple-cabal/cabal.project b/plugins/hls-cabal-plugin/test/testdata/simple-cabal/cabal.project new file mode 100644 index 0000000000..e6fdbadb43 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/simple-cabal/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/plugins/hls-cabal-plugin/test/testdata/simple-cabal/hie.yaml b/plugins/hls-cabal-plugin/test/testdata/simple-cabal/hie.yaml new file mode 100644 index 0000000000..04cd24395e --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/simple-cabal/hie.yaml @@ -0,0 +1,2 @@ +cradle: + cabal: diff --git a/plugins/hls-cabal-plugin/test/testdata/simple-cabal/simple-cabal.cabal b/plugins/hls-cabal-plugin/test/testdata/simple-cabal/simple-cabal.cabal new file mode 100644 index 0000000000..48ac100d3d --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/simple-cabal/simple-cabal.cabal @@ -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 diff --git a/plugins/hls-cabal-plugin/test/testdata/simple.cabal.golden.txt b/plugins/hls-cabal-plugin/test/testdata/simple.cabal.golden.txt index 667393f689..2117da8886 100644 --- a/plugins/hls-cabal-plugin/test/testdata/simple.cabal.golden.txt +++ b/plugins/hls-cabal-plugin/test/testdata/simple.cabal.golden.txt @@ -1 +1 @@ -([],Right (GenericPackageDescription {packageDescription = PackageDescription {specVersion = CabalSpecV3_0, package = PackageIdentifier {pkgName = PackageName "hls-cabal-plugin", pkgVersion = mkVersion [0,1,0,0]}, licenseRaw = Left (License (ELicense (ELicenseId MIT) Nothing)), licenseFiles = [SymbolicPath "LICENSE"], copyright = "", maintainer = "fendor@posteo.de", author = "Fendor", stability = "", testedWith = [], homepage = "", pkgUrl = "", bugReports = "", sourceRepos = [], synopsis = "", description = "", category = "Development", customFieldsPD = [], buildTypeRaw = Nothing, setupBuildInfo = Nothing, library = Nothing, subLibraries = [], executables = [], foreignLibs = [], testSuites = [], benchmarks = [], dataFiles = [], dataDir = ".", extraSrcFiles = ["CHANGELOG.md"], extraTmpFiles = [], extraDocFiles = []}, gpdScannedVersion = Nothing, genPackageFlags = [], condLibrary = Just (CondNode {condTreeData = Library {libName = LMainLibName, exposedModules = [ModuleName "IDE.Plugin.Cabal"], reexportedModules = [], signatures = [], libExposed = True, libVisibility = LibraryVisibilityPublic, libBuildInfo = BuildInfo {buildable = True, buildTools = [], buildToolDepends = [], cppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], frameworks = [], extraFrameworkDirs = [], asmSources = [], cmmSources = [], cSources = [], cxxSources = [], jsSources = [], hsSourceDirs = [SymbolicPath "src"], otherModules = [], virtualModules = [], autogenModules = [], defaultLanguage = Just Haskell2010, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraGHCiLibs = [], extraBundledLibs = [], extraLibFlavours = [], extraDynLibFlavours = [], extraLibDirs = [], includeDirs = [], includes = [], autogenIncludes = [], installIncludes = [], options = PerCompilerFlavor [] [], profOptions = PerCompilerFlavor [] [], sharedOptions = PerCompilerFlavor [] [], staticOptions = PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [Dependency (PackageName "base") (MajorBoundVersion (mkVersion [4,14,3,0])) (fromNonEmpty (LMainLibName :| []))], mixins = []}}, condTreeConstraints = [Dependency (PackageName "base") (MajorBoundVersion (mkVersion [4,14,3,0])) (fromNonEmpty (LMainLibName :| []))], condTreeComponents = []}), condSubLibraries = [], condForeignLibs = [], condExecutables = [], condTestSuites = [(UnqualComponentName "hls-cabal-plugin-test",CondNode {condTreeData = TestSuite {testName = UnqualComponentName "", testInterface = TestSuiteExeV10 (mkVersion [1,0]) "Main.hs", testBuildInfo = BuildInfo {buildable = True, buildTools = [], buildToolDepends = [], cppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], frameworks = [], extraFrameworkDirs = [], asmSources = [], cmmSources = [], cSources = [], cxxSources = [], jsSources = [], hsSourceDirs = [SymbolicPath "test"], otherModules = [], virtualModules = [], autogenModules = [], defaultLanguage = Just Haskell2010, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraGHCiLibs = [], extraBundledLibs = [], extraLibFlavours = [], extraDynLibFlavours = [], extraLibDirs = [], includeDirs = [], includes = [], autogenIncludes = [], installIncludes = [], options = PerCompilerFlavor [] [], profOptions = PerCompilerFlavor [] [], sharedOptions = PerCompilerFlavor [] [], staticOptions = PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [Dependency (PackageName "base") (MajorBoundVersion (mkVersion [4,14,3,0])) (fromNonEmpty (LMainLibName :| []))], mixins = []}}, condTreeConstraints = [Dependency (PackageName "base") (MajorBoundVersion (mkVersion [4,14,3,0])) (fromNonEmpty (LMainLibName :| []))], condTreeComponents = []})], condBenchmarks = []})) \ No newline at end of file +([],Right (GenericPackageDescription {packageDescription = PackageDescription {specVersionRaw = Left (mkVersion [3,0]), package = PackageIdentifier {pkgName = PackageName "hls-cabal-plugin", pkgVersion = mkVersion [0,1,0,0]}, licenseRaw = Left (License (ELicense (ELicenseId MIT) Nothing)), licenseFiles = ["LICENSE"], copyright = "", maintainer = "fendor@posteo.de", author = "Fendor", stability = "", testedWith = [], homepage = "", pkgUrl = "", bugReports = "", sourceRepos = [], synopsis = "", description = "", category = "Development", customFieldsPD = [], buildTypeRaw = Nothing, setupBuildInfo = Nothing, library = Nothing, subLibraries = [], executables = [], foreignLibs = [], testSuites = [], benchmarks = [], dataFiles = [], dataDir = ".", extraSrcFiles = ["CHANGELOG.md"], extraTmpFiles = [], extraDocFiles = []}, genPackageFlags = [], condLibrary = Just (CondNode {condTreeData = Library {libName = LMainLibName, exposedModules = [ModuleName ["IDE","Plugin","Cabal"]], reexportedModules = [], signatures = [], libExposed = True, libVisibility = LibraryVisibilityPublic, libBuildInfo = BuildInfo {buildable = True, buildTools = [], buildToolDepends = [], cppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], ldOptions = [], pkgconfigDepends = [], frameworks = [], extraFrameworkDirs = [], asmSources = [], cmmSources = [], cSources = [], cxxSources = [], jsSources = [], hsSourceDirs = ["src"], otherModules = [], virtualModules = [], autogenModules = [], defaultLanguage = Just Haskell2010, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraGHCiLibs = [], extraBundledLibs = [], extraLibFlavours = [], extraDynLibFlavours = [], extraLibDirs = [], includeDirs = [], includes = [], autogenIncludes = [], installIncludes = [], options = PerCompilerFlavor [] [], profOptions = PerCompilerFlavor [] [], sharedOptions = PerCompilerFlavor [] [], staticOptions = PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [Dependency (PackageName "base") (MajorBoundVersion (mkVersion [4,14,3,0])) (fromList [LMainLibName])], mixins = []}}, condTreeConstraints = [Dependency (PackageName "base") (MajorBoundVersion (mkVersion [4,14,3,0])) (fromList [LMainLibName])], condTreeComponents = []}), condSubLibraries = [], condForeignLibs = [], condExecutables = [], condTestSuites = [(UnqualComponentName "hls-cabal-plugin-test",CondNode {condTreeData = TestSuite {testName = UnqualComponentName "", testInterface = TestSuiteExeV10 (mkVersion [1,0]) "Main.hs", testBuildInfo = BuildInfo {buildable = True, buildTools = [], buildToolDepends = [], cppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], ldOptions = [], pkgconfigDepends = [], frameworks = [], extraFrameworkDirs = [], asmSources = [], cmmSources = [], cSources = [], cxxSources = [], jsSources = [], hsSourceDirs = ["test"], otherModules = [], virtualModules = [], autogenModules = [], defaultLanguage = Just Haskell2010, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraGHCiLibs = [], extraBundledLibs = [], extraLibFlavours = [], extraDynLibFlavours = [], extraLibDirs = [], includeDirs = [], includes = [], autogenIncludes = [], installIncludes = [], options = PerCompilerFlavor [] [], profOptions = PerCompilerFlavor [] [], sharedOptions = PerCompilerFlavor [] [], staticOptions = PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [Dependency (PackageName "base") (MajorBoundVersion (mkVersion [4,14,3,0])) (fromList [LMainLibName])], mixins = []}}, condTreeConstraints = [Dependency (PackageName "base") (MajorBoundVersion (mkVersion [4,14,3,0])) (fromList [LMainLibName])], condTreeComponents = []})], condBenchmarks = []})) From 309260a658ca475632f87c7c4069c8e10ac9b3cb Mon Sep 17 00:00:00 2001 From: Fendor Date: Sun, 10 Jul 2022 19:08:54 +0200 Subject: [PATCH 05/25] Fix various cabal issues --- .../hls-cabal-plugin/hls-cabal-plugin.cabal | 29 ++++++++----------- 1 file changed, 12 insertions(+), 17 deletions(-) diff --git a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal index 0f0be31255..73f7a4bb13 100644 --- a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal +++ b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal @@ -13,6 +13,8 @@ maintainer: fendor@posteo.de category: Development extra-source-files: CHANGELOG.md + test/testdata/invalid.cabal + test/testdata/licenseCodeAction.cabal test/testdata/simple.cabal common warnings @@ -27,27 +29,21 @@ library Ide.Plugin.Cabal.Parse build-depends: - , aeson - , base >=4.12 && <5 + , base >=4.12 && <5 , bytestring - , Cabal - , czipwith + , Cabal ^>=3.2 || ^>=3.4 || ^>=3.6 , deepseq , directory - , extra - , filepath - , ghc-exactprint - , ghcide >=1.6 && <1.9 + , extra >=1.7.4 + , ghcide ^>= 1.8 , hashable - , hls-plugin-api >=1.5 && <1.6 - , lens - , lsp - , lsp-types - , regex-tdfa + , hls-plugin-api ^>=1.5 + , lsp ^>=1.6.0.0 + , lsp-types ^>=1.6.0.0 + , regex-tdfa ^>=1.3.1 , stm , text - , transformers - , unordered-containers + , unordered-containers >=0.2.10.0 hs-source-dirs: src default-language: Haskell2010 @@ -61,11 +57,10 @@ test-suite tests build-depends: , base , filepath + , ghcide , hls-cabal-plugin , hls-test-utils ^>=1.4 , lens - , lsp - , ghcide , lsp-types , tasty-hunit , text From 28052ee00baab7c97487611f53785e45eed63fe1 Mon Sep 17 00:00:00 2001 From: Fendor Date: Sun, 10 Jul 2022 18:09:34 +0200 Subject: [PATCH 06/25] Update Codeowners file for hls-cabal-plugin --- CODEOWNERS | 1 + 1 file changed, 1 insertion(+) diff --git a/CODEOWNERS b/CODEOWNERS index 268f136ff9..25253d226e 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -9,6 +9,7 @@ # Plugins /plugins/hls-alternate-number-format-plugin @drsooch /plugins/hls-brittany-plugin @fendor +/plugins/hls-cabal-plugin @fendor @runeksvendsen /plugins/hls-cabal-fmt-plugin @VeryMilkyJoe @fendor /plugins/hls-call-hierarchy-plugin @July541 /plugins/hls-class-plugin @Ailrun From f92793059ca93415840924e2789f6a12f34f2eee Mon Sep 17 00:00:00 2001 From: fendor Date: Tue, 26 Jul 2022 15:32:32 +0200 Subject: [PATCH 07/25] Document Bytestring is UTF-8 encoded Co-authored-by: Julian Ospald --- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Parse.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Parse.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Parse.hs index d1e62cd73e..8dff89f17b 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Parse.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Parse.hs @@ -40,7 +40,7 @@ parseCabalFile = parseCabalFileContents bs parseCabalFileContents - :: BS.ByteString + :: BS.ByteString -- ^ UTF-8 encoded bytestring -> IO ([PWarning], Either (Maybe Version, NonEmpty PError) GenericPackageDescription) parseCabalFileContents bs = pure $ runParseResult (parseGenericPackageDescription bs) From f7e5d64ef2b31265af1c53b71b288ccb0845cbb6 Mon Sep 17 00:00:00 2001 From: Fendor Date: Sun, 14 Aug 2022 14:52:20 +0200 Subject: [PATCH 08/25] Remove code duplication --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 43 ++++++++++--------- 1 file changed, 22 insertions(+), 21 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index bf8a20f674..2e189e3a36 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -17,7 +17,7 @@ import Control.Monad.IO.Class import qualified Data.ByteString as BS import Data.Hashable import qualified Data.List.NonEmpty as NE -import Data.Maybe (catMaybes) +import Data.Maybe (mapMaybe) import qualified Data.Text.Encoding as Encoding import Data.Typeable import Development.IDE as D @@ -50,7 +50,7 @@ instance Pretty Log where LogModificationTime nfp modTime -> "Modified:" <+> pretty (fromNormalizedFilePath nfp) <+> pretty (show modTime) LogDiagnostics nfp diags -> - "Diagnostics for " <+> pretty (fromNormalizedFilePath nfp) <> ":" <+> pretty (show diags) + "Diagnostics for" <+> pretty (fromNormalizedFilePath nfp) <> ":" <+> pretty (show diags) LogDocOpened uri -> "Opened text document:" <+> pretty (getUri uri) LogDocModified uri -> @@ -68,34 +68,26 @@ descriptor recorder plId = (defaultCabalPluginDescriptor plId) [ mkPluginNotificationHandler LSP.STextDocumentDidOpen $ \ide vfs _ (DidOpenTextDocumentParams TextDocumentItem{_uri,_version}) -> liftIO $ do whenUriFile _uri $ \file -> do - log' Debug $ LogDocOpened _uri - join $ atomically $ Shake.recordDirtyKeys (shakeExtras ide) GetModificationTime [file] - restartShakeSession (shakeExtras ide) (VFSModified vfs) (fromNormalizedFilePath file ++ " (opened)") [] - join $ Shake.shakeEnqueue (shakeExtras ide) $ Shake.mkDelayedAction "cabal parse modified" Info $ void $ use ParseCabal file + log' Debug $ LogDocOpened _uri + restartCabalShakeSession ide vfs file "(opened)" , mkPluginNotificationHandler LSP.STextDocumentDidChange $ \ide vfs _ (DidChangeTextDocumentParams VersionedTextDocumentIdentifier{_uri} _) -> liftIO $ do whenUriFile _uri $ \file -> do log' Debug $ LogDocModified _uri - join $ atomically $ Shake.recordDirtyKeys (shakeExtras ide) GetModificationTime [file] - restartShakeSession (shakeExtras ide) (VFSModified vfs) (fromNormalizedFilePath file ++ " (modified)") [] - join $ Shake.shakeEnqueue (shakeExtras ide) $ Shake.mkDelayedAction "cabal parse modified" Info $ void $ use ParseCabal file + restartCabalShakeSession ide vfs file "(changed)" , mkPluginNotificationHandler LSP.STextDocumentDidSave $ \ide vfs _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do - whenUriFile _uri $ \file -> do - log' Debug $ LogDocSaved _uri - join $ atomically $ Shake.recordDirtyKeys (shakeExtras ide) GetModificationTime [file] - restartShakeSession (shakeExtras ide) (VFSModified vfs) (fromNormalizedFilePath file ++ " (saved)") [] - join $ Shake.shakeEnqueue (shakeExtras ide) $ Shake.mkDelayedAction "cabal parse modified" Info $ void $ use ParseCabal file + whenUriFile _uri $ \file -> do + log' Debug $ LogDocSaved _uri + restartCabalShakeSession ide vfs file "(saved)" , mkPluginNotificationHandler LSP.STextDocumentDidClose $ - \ide vfs _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do - whenUriFile _uri $ \file -> do - log' Debug $ LogDocClosed _uri - join $ atomically $ Shake.recordDirtyKeys (shakeExtras ide) GetModificationTime [file] - restartShakeSession (shakeExtras ide) (VFSModified vfs) (fromNormalizedFilePath file ++ " (closed)") [] - join $ Shake.shakeEnqueue (shakeExtras ide) $ Shake.mkDelayedAction "cabal parse modified" Info $ void $ use ParseCabal file + \ide vfs _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do + whenUriFile _uri $ \file -> do + log' Debug $ LogDocClosed _uri + restartCabalShakeSession ide vfs file "(closed)" ] } where @@ -104,6 +96,15 @@ descriptor recorder plId = (defaultCabalPluginDescriptor plId) 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. +restartCabalShakeSession :: IdeState -> VFS.VFS -> NormalizedFilePath -> String -> IO () +restartCabalShakeSession ide vfs file actionMsg = do + join $ atomically $ Shake.recordDirtyKeys (shakeExtras ide) GetModificationTime [file] + restartShakeSession (shakeExtras ide) (VFSModified vfs) (fromNormalizedFilePath file ++ " " ++ actionMsg) [] + join $ Shake.shakeEnqueue (shakeExtras ide) $ Shake.mkDelayedAction "cabal parse modified" Info $ void $ use ParseCabal file + -- ---------------------------------------------------------------- -- Plugin Rules -- ---------------------------------------------------------------- @@ -150,4 +151,4 @@ licenseSuggestCodeAction -> CodeActionParams -> LspM Config (Either ResponseError (ResponseResult 'TextDocumentCodeAction)) licenseSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List diags}) = - pure $ Right $ List $ catMaybes $ map (fmap InR . LicenseSuggest.licenseErrorAction uri) diags + pure $ Right $ List $ mapMaybe (fmap InR . LicenseSuggest.licenseErrorAction uri) diags From 36382802381d34983a92ae370ac45fd77362730d Mon Sep 17 00:00:00 2001 From: Fendor Date: Mon, 10 Oct 2022 19:07:09 +0200 Subject: [PATCH 09/25] Add cabal files of interest and kick function Configure a "kick" function for cabal files that is run when the shake queue needs to be restarted. Copy pastes from ghcide and 'files of interest'. Maybe more abstraction needed. --- .../hls-cabal-plugin/hls-cabal-plugin.cabal | 1 + .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 93 ++++++++++++++++++- 2 files changed, 91 insertions(+), 3 deletions(-) diff --git a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal index 73f7a4bb13..bd694e6977 100644 --- a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal +++ b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal @@ -38,6 +38,7 @@ library , ghcide ^>= 1.8 , hashable , hls-plugin-api ^>=1.5 + , hls-graph ^>=1.8 , lsp ^>=1.6.0.0 , lsp-types ^>=1.6.0.0 , regex-tdfa ^>=1.3.1 diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 2e189e3a36..359b814ea0 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -6,23 +6,29 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} -module Ide.Plugin.Cabal where +module Ide.Plugin.Cabal (descriptor, Log(..)) where import Control.Concurrent.STM -import Control.DeepSeq (NFData) +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 Data.Maybe (mapMaybe) +import qualified Data.Text as T 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 @@ -69,24 +75,28 @@ descriptor recorder plId = (defaultCabalPluginDescriptor plId) \ide vfs _ (DidOpenTextDocumentParams TextDocumentItem{_uri,_version}) -> liftIO $ do whenUriFile _uri $ \file -> do log' Debug $ LogDocOpened _uri + addFileOfInterest ide file Modified{firstOpen=True} restartCabalShakeSession ide vfs file "(opened)" , mkPluginNotificationHandler LSP.STextDocumentDidChange $ \ide vfs _ (DidChangeTextDocumentParams VersionedTextDocumentIdentifier{_uri} _) -> liftIO $ do whenUriFile _uri $ \file -> do log' Debug $ LogDocModified _uri + addFileOfInterest ide file Modified{firstOpen=False} restartCabalShakeSession ide vfs file "(changed)" , mkPluginNotificationHandler LSP.STextDocumentDidSave $ \ide vfs _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do whenUriFile _uri $ \file -> do log' Debug $ LogDocSaved _uri + addFileOfInterest ide file OnDisk restartCabalShakeSession ide vfs file "(saved)" , mkPluginNotificationHandler LSP.STextDocumentDidClose $ \ide vfs _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do whenUriFile _uri $ \file -> do log' Debug $ LogDocClosed _uri + deleteFileOfInterest ide file restartCabalShakeSession ide vfs file "(closed)" ] } @@ -103,7 +113,71 @@ restartCabalShakeSession :: IdeState -> VFS.VFS -> NormalizedFilePath -> String restartCabalShakeSession ide vfs file actionMsg = do join $ atomically $ Shake.recordDirtyKeys (shakeExtras ide) GetModificationTime [file] restartShakeSession (shakeExtras ide) (VFSModified vfs) (fromNormalizedFilePath file ++ " " ++ actionMsg) [] - join $ Shake.shakeEnqueue (shakeExtras ide) $ Shake.mkDelayedAction "cabal parse modified" Info $ void $ use ParseCabal file + +-- ---------------------------------------------------------------- +-- Cabal file of Interset rules and global variable +-- ---------------------------------------------------------------- + +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. +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 + +getFilesOfInterest :: IdeState -> IO( HashMap NormalizedFilePath FileOfInterestStatus) +getFilesOfInterest state = do + OfInterestCabalVar var <- Shake.getIdeGlobalState state + readVar var + +addFileOfInterest :: IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO () +addFileOfInterest 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] + logDebug (ideLogger state) $ + "Set files of interest to: " <> T.pack (show files) + +deleteFileOfInterest :: IdeState -> NormalizedFilePath -> IO () +deleteFileOfInterest state f = do + OfInterestCabalVar var <- Shake.getIdeGlobalState state + files <- modifyVar' var $ HashMap.delete f + join $ atomically $ Shake.recordDirtyKeys (shakeExtras state) IsFileOfInterest [f] + logDebug (ideLogger state) $ "Set files of interest to: " <> T.pack (show files) -- ---------------------------------------------------------------- -- Plugin Rules @@ -118,6 +192,7 @@ type instance RuleResult ParseCabal = () cabalRules :: Recorder (WithPriority Log) -> Rules () cabalRules recorder = do + ofInterestRules recorder define (cmapWithPrio LogShake recorder) $ \ParseCabal file -> do t <- use GetModificationTime file log' Debug $ LogModificationTime file t @@ -138,9 +213,21 @@ cabalRules recorder = do Right _ -> do log' Debug $ LogDiagnostics file warningDiags 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 +-- | TODO: add documentation +kick :: Action () +kick = do + files <- HashMap.keys <$> getCabalFilesOfInterestUntracked + void $ uses ParseCabal files + -- ---------------------------------------------------------------- -- Code Actions -- ---------------------------------------------------------------- From fb941e3949015513af0271025b4f93f9fb8706bb Mon Sep 17 00:00:00 2001 From: Fendor Date: Sun, 30 Oct 2022 15:15:50 +0100 Subject: [PATCH 10/25] Add more documentation --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 142 ++++++++++-------- 1 file changed, 76 insertions(+), 66 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 359b814ea0..2d4404db4b 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -114,71 +114,6 @@ restartCabalShakeSession ide vfs file actionMsg = do join $ atomically $ Shake.recordDirtyKeys (shakeExtras ide) GetModificationTime [file] restartShakeSession (shakeExtras ide) (VFSModified vfs) (fromNormalizedFilePath file ++ " " ++ actionMsg) [] --- ---------------------------------------------------------------- --- Cabal file of Interset rules and global variable --- ---------------------------------------------------------------- - -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. -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 - -getFilesOfInterest :: IdeState -> IO( HashMap NormalizedFilePath FileOfInterestStatus) -getFilesOfInterest state = do - OfInterestCabalVar var <- Shake.getIdeGlobalState state - readVar var - -addFileOfInterest :: IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO () -addFileOfInterest 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] - logDebug (ideLogger state) $ - "Set files of interest to: " <> T.pack (show files) - -deleteFileOfInterest :: IdeState -> NormalizedFilePath -> IO () -deleteFileOfInterest state f = do - OfInterestCabalVar var <- Shake.getIdeGlobalState state - files <- modifyVar' var $ HashMap.delete f - join $ atomically $ Shake.recordDirtyKeys (shakeExtras state) IsFileOfInterest [f] - logDebug (ideLogger state) $ "Set files of interest to: " <> T.pack (show files) - -- ---------------------------------------------------------------- -- Plugin Rules -- ---------------------------------------------------------------- @@ -192,7 +127,9 @@ 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 t <- use GetModificationTime file log' Debug $ LogModificationTime file t @@ -222,7 +159,12 @@ cabalRules recorder = do where log' = logWith recorder --- | TODO: add documentation +-- | This is the kick function for the cabal plugin. +-- We run this action, whenever we need to restart the shake session, 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 @@ -239,3 +181,71 @@ licenseSuggestCodeAction -> 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 + +-- ---------------------------------------------------------------- +-- 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 :: IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO () +addFileOfInterest 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] + logDebug (ideLogger state) $ + "Set files of interest to: " <> T.pack (show files) + +deleteFileOfInterest :: IdeState -> NormalizedFilePath -> IO () +deleteFileOfInterest state f = do + OfInterestCabalVar var <- Shake.getIdeGlobalState state + files <- modifyVar' var $ HashMap.delete f + join $ atomically $ Shake.recordDirtyKeys (shakeExtras state) IsFileOfInterest [f] + logDebug (ideLogger state) $ "Set files of interest to: " <> T.pack (show files) From 46f6657541887e143e6180d4c3a225ab5884b3f5 Mon Sep 17 00:00:00 2001 From: Fendor Date: Sun, 13 Nov 2022 17:44:14 +0100 Subject: [PATCH 11/25] Mark flaky test-case as flaky with issue ref --- plugins/hls-cabal-plugin/test/Main.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 5be5e980d2..e90e30a951 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -88,7 +88,8 @@ pluginTests recorder = testGroup "Plugin Tests" expectNoMoreDiagnostics 1 hsDoc "typechecking" cabalDoc <- openDoc "simple-cabal.cabal" "cabal" expectNoMoreDiagnostics 1 cabalDoc "parsing" - , runCabalTestCaseSession "Diagnostics in .hs files from invalid .cabal file" recorder "simple-cabal" $ do + , ignoreTestBecause "Testcase is flaky for certain GHC versions (e.g. 9.2.4). See #3333 for details." $ do + runCabalTestCaseSession "Diagnostics in .hs files from invalid .cabal file" recorder "simple-cabal" $ do hsDoc <- openDoc "A.hs" "haskell" expectNoMoreDiagnostics 1 hsDoc "typechecking" cabalDoc <- openDoc "simple-cabal.cabal" "cabal" From 033caa9005ce3bf11061538f03b2d32588daf615 Mon Sep 17 00:00:00 2001 From: Fendor Date: Sun, 13 Nov 2022 18:11:46 +0100 Subject: [PATCH 12/25] Make fendor the only CODEOWNER for hls-cabal-plugin --- CODEOWNERS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CODEOWNERS b/CODEOWNERS index 25253d226e..dbe8495fbc 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -9,7 +9,7 @@ # Plugins /plugins/hls-alternate-number-format-plugin @drsooch /plugins/hls-brittany-plugin @fendor -/plugins/hls-cabal-plugin @fendor @runeksvendsen +/plugins/hls-cabal-plugin @fendor /plugins/hls-cabal-fmt-plugin @VeryMilkyJoe @fendor /plugins/hls-call-hierarchy-plugin @July541 /plugins/hls-class-plugin @Ailrun From 7a0f066645c1ed64e848330549c2d5cda370c720 Mon Sep 17 00:00:00 2001 From: Fendor Date: Sun, 13 Nov 2022 20:03:19 +0100 Subject: [PATCH 13/25] Add missing extra-source-files for hls-cabal-plugin --- plugins/hls-cabal-plugin/hls-cabal-plugin.cabal | 8 +++++--- .../test/testdata/simple.cabal.golden.txt | 1 - 2 files changed, 5 insertions(+), 4 deletions(-) delete mode 100644 plugins/hls-cabal-plugin/test/testdata/simple.cabal.golden.txt diff --git a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal index bd694e6977..3ede8183a8 100644 --- a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal +++ b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal @@ -13,9 +13,11 @@ maintainer: fendor@posteo.de category: Development extra-source-files: CHANGELOG.md - test/testdata/invalid.cabal - test/testdata/licenseCodeAction.cabal - test/testdata/simple.cabal + 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 diff --git a/plugins/hls-cabal-plugin/test/testdata/simple.cabal.golden.txt b/plugins/hls-cabal-plugin/test/testdata/simple.cabal.golden.txt deleted file mode 100644 index 2117da8886..0000000000 --- a/plugins/hls-cabal-plugin/test/testdata/simple.cabal.golden.txt +++ /dev/null @@ -1 +0,0 @@ -([],Right (GenericPackageDescription {packageDescription = PackageDescription {specVersionRaw = Left (mkVersion [3,0]), package = PackageIdentifier {pkgName = PackageName "hls-cabal-plugin", pkgVersion = mkVersion [0,1,0,0]}, licenseRaw = Left (License (ELicense (ELicenseId MIT) Nothing)), licenseFiles = ["LICENSE"], copyright = "", maintainer = "fendor@posteo.de", author = "Fendor", stability = "", testedWith = [], homepage = "", pkgUrl = "", bugReports = "", sourceRepos = [], synopsis = "", description = "", category = "Development", customFieldsPD = [], buildTypeRaw = Nothing, setupBuildInfo = Nothing, library = Nothing, subLibraries = [], executables = [], foreignLibs = [], testSuites = [], benchmarks = [], dataFiles = [], dataDir = ".", extraSrcFiles = ["CHANGELOG.md"], extraTmpFiles = [], extraDocFiles = []}, genPackageFlags = [], condLibrary = Just (CondNode {condTreeData = Library {libName = LMainLibName, exposedModules = [ModuleName ["IDE","Plugin","Cabal"]], reexportedModules = [], signatures = [], libExposed = True, libVisibility = LibraryVisibilityPublic, libBuildInfo = BuildInfo {buildable = True, buildTools = [], buildToolDepends = [], cppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], ldOptions = [], pkgconfigDepends = [], frameworks = [], extraFrameworkDirs = [], asmSources = [], cmmSources = [], cSources = [], cxxSources = [], jsSources = [], hsSourceDirs = ["src"], otherModules = [], virtualModules = [], autogenModules = [], defaultLanguage = Just Haskell2010, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraGHCiLibs = [], extraBundledLibs = [], extraLibFlavours = [], extraDynLibFlavours = [], extraLibDirs = [], includeDirs = [], includes = [], autogenIncludes = [], installIncludes = [], options = PerCompilerFlavor [] [], profOptions = PerCompilerFlavor [] [], sharedOptions = PerCompilerFlavor [] [], staticOptions = PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [Dependency (PackageName "base") (MajorBoundVersion (mkVersion [4,14,3,0])) (fromList [LMainLibName])], mixins = []}}, condTreeConstraints = [Dependency (PackageName "base") (MajorBoundVersion (mkVersion [4,14,3,0])) (fromList [LMainLibName])], condTreeComponents = []}), condSubLibraries = [], condForeignLibs = [], condExecutables = [], condTestSuites = [(UnqualComponentName "hls-cabal-plugin-test",CondNode {condTreeData = TestSuite {testName = UnqualComponentName "", testInterface = TestSuiteExeV10 (mkVersion [1,0]) "Main.hs", testBuildInfo = BuildInfo {buildable = True, buildTools = [], buildToolDepends = [], cppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], ldOptions = [], pkgconfigDepends = [], frameworks = [], extraFrameworkDirs = [], asmSources = [], cmmSources = [], cSources = [], cxxSources = [], jsSources = [], hsSourceDirs = ["test"], otherModules = [], virtualModules = [], autogenModules = [], defaultLanguage = Just Haskell2010, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraGHCiLibs = [], extraBundledLibs = [], extraLibFlavours = [], extraDynLibFlavours = [], extraLibDirs = [], includeDirs = [], includes = [], autogenIncludes = [], installIncludes = [], options = PerCompilerFlavor [] [], profOptions = PerCompilerFlavor [] [], sharedOptions = PerCompilerFlavor [] [], staticOptions = PerCompilerFlavor [] [], customFieldsBI = [], targetBuildDepends = [Dependency (PackageName "base") (MajorBoundVersion (mkVersion [4,14,3,0])) (fromList [LMainLibName])], mixins = []}}, condTreeConstraints = [Dependency (PackageName "base") (MajorBoundVersion (mkVersion [4,14,3,0])) (fromList [LMainLibName])], condTreeComponents = []})], condBenchmarks = []})) From fcd223d18aada9956c844b0fca0723eb1200012b Mon Sep 17 00:00:00 2001 From: Fendor Date: Sun, 13 Nov 2022 20:03:36 +0100 Subject: [PATCH 14/25] Add proper CHANGELOG entry for the first version of hls-cabal-plugin --- plugins/hls-cabal-plugin/CHANGELOG.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/plugins/hls-cabal-plugin/CHANGELOG.md b/plugins/hls-cabal-plugin/CHANGELOG.md index cfebb241bb..809439f0a8 100644 --- a/plugins/hls-cabal-plugin/CHANGELOG.md +++ b/plugins/hls-cabal-plugin/CHANGELOG.md @@ -2,4 +2,5 @@ ## 0.1.0.0 -- YYYY-mm-dd -* First version. Released on an unsuspecting world. +* Provide Diagnostics on parse errors and warnings for .cabal files +* Provide CodeAction for the common SPDX License mistake "BSD3" instead of "BSD-3-Clause" From 1932674284a6f4eb050959890116461c421766ca Mon Sep 17 00:00:00 2001 From: Fendor Date: Sat, 19 Nov 2022 14:45:44 +0100 Subject: [PATCH 15/25] Add support for Cabal 3.8 --- plugins/hls-cabal-plugin/hls-cabal-plugin.cabal | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal index 3ede8183a8..805e539b88 100644 --- a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal +++ b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal @@ -33,7 +33,18 @@ library build-depends: , base >=4.12 && <5 , bytestring - , Cabal ^>=3.2 || ^>=3.4 || ^>=3.6 + -- 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 From 525e2da0bdb8f8df4186634a88159e36a974023e Mon Sep 17 00:00:00 2001 From: Fendor Date: Sat, 19 Nov 2022 14:46:09 +0100 Subject: [PATCH 16/25] Set diagnostics source to cabal --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs | 5 +++-- plugins/hls-cabal-plugin/test/Main.hs | 6 +++--- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs index b06fc28a05..44d89ecf1e 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE OverloadedStrings #-} module Ide.Plugin.Cabal.Diagnostics ( errorDiagnostic , warningDiagnostic @@ -23,14 +24,14 @@ import Language.LSP.Types (Diagnostic (..), -- | Produce a diagnostic from a Cabal parser error errorDiagnostic :: NormalizedFilePath -> Lib.PError -> FileDiagnostic errorDiagnostic fp err@(Lib.PError pos _) = - mkDiag fp (T.pack "parsing") DsError (toBeginningOfNextLine pos) msg + 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 (T.pack "parsing") DsWarning (toBeginningOfNextLine pos) msg + mkDiag fp "cabal" DsWarning (toBeginningOfNextLine pos) msg where msg = T.pack $ showPWarning (fromNormalizedFilePath fp) warning diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index e90e30a951..28bde9a2a2 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -21,7 +21,7 @@ cabalPlugin recorder = descriptor recorder "cabal" main :: IO () main = do - recorder <- initialiseRecorder False + recorder <- initialiseRecorder True defaultTestRunner $ testGroup "Cabal Plugin Tests" [ unitTests @@ -66,7 +66,7 @@ pluginTests recorder = testGroup "Plugin Tests" [ testGroup "Diagnostics" [ runCabalTestCaseSession "Publishes Diagnostics on Error" recorder "" $ do doc <- openDoc "invalid.cabal" "cabal" - diags <- waitForDiagnosticsFromSource doc "parsing" + diags <- waitForDiagnosticsFromSource doc "cabal" unknownLicenseDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'BSD3'"] liftIO $ do length diags @?= 1 @@ -108,7 +108,7 @@ pluginTests recorder = testGroup "Plugin Tests" , testGroup "Code Actions" [ runCabalTestCaseSession "BSD-3" recorder "" $ do doc <- openDoc "licenseCodeAction.cabal" "cabal" - diags <- waitForDiagnosticsFromSource doc "parsing" + diags <- waitForDiagnosticsFromSource doc "cabal" reduceDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'BSD3'"] liftIO $ do length diags @?= 1 From 76137d4fa1882e5967d75203057cc394b98f182c Mon Sep 17 00:00:00 2001 From: Fendor Date: Sat, 19 Nov 2022 14:58:19 +0100 Subject: [PATCH 17/25] Remove unused function --- .../src/Ide/Plugin/Cabal/Parse.hs | 27 +++---------------- plugins/hls-cabal-plugin/test/Main.hs | 3 ++- 2 files changed, 6 insertions(+), 24 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Parse.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Parse.hs index 8dff89f17b..28700c5104 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Parse.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Parse.hs @@ -1,6 +1,5 @@ module Ide.Plugin.Cabal.Parse -( parseCabalFile -, parseCabalFileContents +( parseCabalFileContents -- * Re-exports , FilePath , NonEmpty(..) @@ -11,7 +10,6 @@ module Ide.Plugin.Cabal.Parse , GenericPackageDescription(..) ) where -import Control.Monad (unless) import qualified Data.ByteString as BS import Data.List.NonEmpty (NonEmpty (..)) import Distribution.Fields (PError (..), @@ -21,26 +19,9 @@ import Distribution.PackageDescription.Parsec (parseGenericPacka import Distribution.Parsec.Position (Position (..)) import Distribution.Types.GenericPackageDescription (GenericPackageDescription (..)) import Distribution.Types.Version (Version) -import qualified System.Directory as Dir -import qualified System.Exit as Exit - - -parseCabalFile - :: FilePath - -> IO ([PWarning], Either (Maybe Version, NonEmpty PError) GenericPackageDescription) -parseCabalFile = - readAndParseFile' - where - readAndParseFile' fpath = do - exists <- Dir.doesFileExist fpath - unless exists $ - Exit.die $ - "Error Parsing: file \"" ++ fpath ++ "\" doesn't exist. Cannot continue." - bs <- BS.readFile fpath - parseCabalFileContents bs parseCabalFileContents - :: BS.ByteString -- ^ UTF-8 encoded bytestring - -> IO ([PWarning], Either (Maybe Version, NonEmpty PError) GenericPackageDescription) + :: BS.ByteString -- ^ UTF-8 encoded bytestring + -> IO ([PWarning], Either (Maybe Version, NonEmpty PError) GenericPackageDescription) parseCabalFileContents bs = - pure $ runParseResult (parseGenericPackageDescription bs) + pure $ runParseResult (parseGenericPackageDescription bs) diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 28bde9a2a2..c557d317da 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -15,6 +15,7 @@ import qualified Ide.Plugin.Cabal.Parse as Lib import qualified Language.LSP.Types.Lens as J import System.FilePath import Test.Hls +import qualified Data.ByteString as BS cabalPlugin :: Recorder (WithPriority Log) -> PluginDescriptor IdeState cabalPlugin recorder = descriptor recorder "cabal" @@ -51,7 +52,7 @@ unitTests :: TestTree unitTests = testGroup "Unit Tests" [ testCase "Simple Parsing works" $ do - (warnings, pm) <- Lib.parseCabalFile $ testDataDir "simple.cabal" + (warnings, pm) <- Lib.parseCabalFileContents =<< BS.readFile (testDataDir "simple.cabal") liftIO $ do null warnings @? "Found unexpected warnings" isRight pm @? "Failed to parse GenericPackageDescription" From 66c6089cca3e3278728dd60c9146a4ff78af005d Mon Sep 17 00:00:00 2001 From: Fendor Date: Sat, 19 Nov 2022 14:58:34 +0100 Subject: [PATCH 18/25] Add unit tests for code action utilities --- .../hls-cabal-plugin/hls-cabal-plugin.cabal | 1 + .../src/Ide/Plugin/Cabal/Diagnostics.hs | 2 +- .../src/Ide/Plugin/Cabal/LicenseSuggest.hs | 10 +++--- plugins/hls-cabal-plugin/test/Main.hs | 34 +++++++++++++++---- 4 files changed, 35 insertions(+), 12 deletions(-) diff --git a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal index 805e539b88..67170c10ab 100644 --- a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal +++ b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal @@ -70,6 +70,7 @@ test-suite tests main-is: Main.hs build-depends: , base + , bytestring , filepath , ghcide , hls-cabal-plugin diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs index 44d89ecf1e..51cb166f4c 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs @@ -1,6 +1,6 @@ {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} -{-# LANGUAGE OverloadedStrings #-} module Ide.Plugin.Cabal.Diagnostics ( errorDiagnostic , warningDiagnostic 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 c7480de681..2381286c95 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs @@ -33,7 +33,7 @@ licenseErrorAction -- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic' -> Maybe CodeAction licenseErrorAction uri diag = - mkCodeAction <$> licenseErrorSuggestion diag + mkCodeAction <$> licenseErrorSuggestion (_message diag) where mkCodeAction (original, suggestion) = let @@ -52,17 +52,17 @@ 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 a diagnostic returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic', +-- | Given an error message 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 - :: Diagnostic + :: T.Text -- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic' -> Maybe (T.Text, T.Text) -- ^ (Original (incorrect) license identifier, suggested replacement) -licenseErrorSuggestion diag = - mSuggestion (_message diag) >>= \case +licenseErrorSuggestion message = + mSuggestion message >>= \case [original, suggestion] -> Just (original, suggestion) _ -> Nothing where diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index c557d317da..b2db2f4315 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -5,17 +5,19 @@ module Main ( main ) where -import Control.Lens ((^.)) -import Data.Either (isRight) +import Control.Lens ((^.)) +import qualified Data.ByteString as BS +import Data.Either (isRight) import Data.Function -import qualified Data.Text as Text +import qualified Data.Text as Text import Development.IDE.Types.Logger import Ide.Plugin.Cabal -import qualified Ide.Plugin.Cabal.Parse as Lib -import qualified Language.LSP.Types.Lens as J +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 -import qualified Data.ByteString as BS + cabalPlugin :: Recorder (WithPriority Log) -> PluginDescriptor IdeState cabalPlugin recorder = descriptor recorder "cabal" @@ -51,6 +53,12 @@ initialiseRecorder False = do 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 @@ -58,6 +66,20 @@ unitTests = 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?" @?= Nothing, + + testCase "BSD-3-Clause" $ do + licenseErrorSuggestion "Unknown SPDX license identifier: 'BSD3' Do you mean BSD-3-Clause?" @?= Just ("BSD3", "BSD-3-Clause"), + + testCase "MIT" $ do + -- contains no suggestion + licenseErrorSuggestion "Unknown SPDX license identifier: 'MIT3'" @?= Nothing + ] + -- ------------------------------------------------------------------------ -- Integration Tests -- ------------------------------------------------------------------------ From 65780af1a8f51c4a6f1d931c3e1c2eae69ad9373 Mon Sep 17 00:00:00 2001 From: Fendor Date: Sat, 19 Nov 2022 15:06:25 +0100 Subject: [PATCH 19/25] Remove overly specific logging of diagnostics from hls-cabal-plugin --- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 5 ----- 1 file changed, 5 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 2d4404db4b..0ed3fcb785 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -42,7 +42,6 @@ import qualified Language.LSP.VFS as VFS data Log = LogModificationTime NormalizedFilePath (Maybe FileVersion) - | LogDiagnostics NormalizedFilePath [FileDiagnostic] | LogShake Shake.Log | LogDocOpened Uri | LogDocModified Uri @@ -55,8 +54,6 @@ instance Pretty Log where LogShake log' -> pretty log' LogModificationTime nfp modTime -> "Modified:" <+> pretty (fromNormalizedFilePath nfp) <+> pretty (show modTime) - LogDiagnostics nfp diags -> - "Diagnostics for" <+> pretty (fromNormalizedFilePath nfp) <> ":" <+> pretty (show diags) LogDocOpened uri -> "Opened text document:" <+> pretty (getUri uri) LogDocModified uri -> @@ -145,10 +142,8 @@ cabalRules recorder = do Left (_cabalVersion, pErrorNE) -> do let errorDiags = NE.toList $ NE.map (Diagnostics.errorDiagnostic file) pErrorNE allDiags = errorDiags <> warningDiags - log' Debug $ LogDiagnostics file allDiags pure (allDiags, Nothing) Right _ -> do - log' Debug $ LogDiagnostics file warningDiags pure (warningDiags, Just ()) action $ do From f33531cb8e0289eee9ae1da94fa7b83ac30afd98 Mon Sep 17 00:00:00 2001 From: Fendor Date: Sat, 19 Nov 2022 15:17:51 +0100 Subject: [PATCH 20/25] Improve logging for Cabal FOIs --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 48 +++++++++++-------- 1 file changed, 27 insertions(+), 21 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 0ed3fcb785..62a97b0121 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -22,7 +22,6 @@ 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 as T import qualified Data.Text.Encoding as Encoding import Data.Typeable import Development.IDE as D @@ -47,6 +46,7 @@ data Log | LogDocModified Uri | LogDocSaved Uri | LogDocClosed Uri + | LogFOI (HashMap NormalizedFilePath FileOfInterestStatus) deriving Show instance Pretty Log where @@ -62,6 +62,9 @@ instance Pretty Log where "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) @@ -72,29 +75,29 @@ descriptor recorder plId = (defaultCabalPluginDescriptor plId) \ide vfs _ (DidOpenTextDocumentParams TextDocumentItem{_uri,_version}) -> liftIO $ do whenUriFile _uri $ \file -> do log' Debug $ LogDocOpened _uri - addFileOfInterest ide file Modified{firstOpen=True} - restartCabalShakeSession ide vfs file "(opened)" + 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 ide file Modified{firstOpen=False} - restartCabalShakeSession ide vfs file "(changed)" + 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 ide file OnDisk - restartCabalShakeSession ide vfs file "(saved)" + 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 ide file - restartCabalShakeSession ide vfs file "(closed)" + deleteFileOfInterest recorder ide file + restartCabalShakeSession (shakeExtras ide) vfs file "(closed)" ] } where @@ -106,10 +109,10 @@ descriptor recorder plId = (defaultCabalPluginDescriptor plId) -- | 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. -restartCabalShakeSession :: IdeState -> VFS.VFS -> NormalizedFilePath -> String -> IO () -restartCabalShakeSession ide vfs file actionMsg = do - join $ atomically $ Shake.recordDirtyKeys (shakeExtras ide) GetModificationTime [file] - restartShakeSession (shakeExtras ide) (VFSModified vfs) (fromNormalizedFilePath file ++ " " ++ actionMsg) [] +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 @@ -222,25 +225,28 @@ ofInterestRules recorder = do summarize (IsCabalFOI (Modified False)) = BS.singleton 2 summarize (IsCabalFOI (Modified True)) = BS.singleton 3 -getCabalFilesOfInterestUntracked :: Action (HashMap NormalizedFilePath FileOfInterestStatus) +getCabalFilesOfInterestUntracked :: Action (HashMap NormalizedFilePath FileOfInterestStatus) getCabalFilesOfInterestUntracked = do OfInterestCabalVar var <- Shake.getIdeGlobalAction liftIO $ readVar var -addFileOfInterest :: IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO () -addFileOfInterest state f v = do +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] - logDebug (ideLogger state) $ - "Set files of interest to: " <> T.pack (show files) + log' Debug $ LogFOI files + where + log' = logWith recorder -deleteFileOfInterest :: IdeState -> NormalizedFilePath -> IO () -deleteFileOfInterest state f = do +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] - logDebug (ideLogger state) $ "Set files of interest to: " <> T.pack (show files) + log' Debug $ LogFOI files + where + log' = logWith recorder From c27b063ceeeb8a929a4342c2ef459a1976fb9022 Mon Sep 17 00:00:00 2001 From: Fendor Date: Sat, 19 Nov 2022 15:35:05 +0100 Subject: [PATCH 21/25] Add Range manipulation functions --- hls-plugin-api/src/Ide/PluginUtils.hs | 29 +++++++++++++++++++++++---- 1 file changed, 25 insertions(+), 4 deletions(-) diff --git a/hls-plugin-api/src/Ide/PluginUtils.hs b/hls-plugin-api/src/Ide/PluginUtils.hs index 3203cbcf8a..3b1fbb7ac2 100644 --- a/hls-plugin-api/src/Ide/PluginUtils.hs +++ b/hls-plugin-api/src/Ide/PluginUtils.hs @@ -2,9 +2,12 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} module Ide.PluginUtils - ( WithDeletions(..), - getProcessID, + ( -- * LSP Range manipulation functions normalize, + extendNextLine, + extendLineStart, + WithDeletions(..), + getProcessID, makeDiffTextEdit, makeDiffTextEditAdditive, diffText, @@ -67,9 +70,27 @@ import qualified Text.Megaparsec.Char.Lexer as P -- --------------------------------------------------------------------- -- | Extend to the line below and above to replace newline character. +-- +-- >>> normalize (Range (Position 5 5) (Position 5 10)) +-- Range (Position 5 0) (Position 6 0) normalize :: Range -> Range -normalize (Range (Position sl _) (Position el _)) = - Range (Position sl 0) (Position (el + 1) 0) +normalize = extendLineStart . extendNextLine + +-- | Extend 'Range' to the start of the next line. +-- +-- >>> extendNextLine (Range (Position 5 5) (Position 5 10)) +-- Range (Position 5 5) (Position 6 0) +extendNextLine :: Range -> Range +extendNextLine (Range s (Position el _)) = + Range s (Position (el + 1) 0) + +-- | Extend 'Range' to the start of the current line. +-- +-- >>> extendLineStart (Range (Position 5 5) (Position 5 10)) +-- Range (Position 5 0) (Position 5 10) +extendLineStart :: Range -> Range +extendLineStart (Range (Position sl _) e) = + Range (Position sl 0) e -- --------------------------------------------------------------------- From edd227fd896f913b06c5fb30ba590d8c66bf74d4 Mon Sep 17 00:00:00 2001 From: Fendor Date: Sat, 19 Nov 2022 15:37:16 +0100 Subject: [PATCH 22/25] Use Range manipulation functions from hls-plugin-api --- .../src/Ide/Plugin/Cabal/Diagnostics.hs | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs index 51cb166f4c..2b077cfaf1 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs @@ -4,6 +4,7 @@ module Ide.Plugin.Cabal.Diagnostics ( errorDiagnostic , warningDiagnostic +, positionFromCabalPosition -- * Re-exports , FileDiagnostic , Diagnostic(..) @@ -15,6 +16,7 @@ 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, @@ -40,10 +42,19 @@ warningDiagnostic fp warning@(Lib.PWarning _ pos _) = -- We define the range to be _from_ this position -- _to_ the first column of the next line. toBeginningOfNextLine :: Lib.Position -> Range -toBeginningOfNextLine (Lib.Position line column) = - Range - (Position (fromIntegral line') (fromIntegral col')) - (Position (fromIntegral $ line' + 1) 0) +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 From 3938b8f62eb6e1fe647e6cd82a2189c4a789d83e Mon Sep 17 00:00:00 2001 From: Fendor Date: Sat, 19 Nov 2022 15:55:03 +0100 Subject: [PATCH 23/25] Add more documentation for crucial shake restart function --- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 62a97b0121..611ca9f793 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -109,6 +109,11 @@ descriptor recorder plId = (defaultCabalPluginDescriptor plId) -- | 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] @@ -131,6 +136,8 @@ cabalRules recorder = do 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 <- use GetModificationTime file log' Debug $ LogModificationTime file t mVirtualFile <- Shake.getVirtualFile file @@ -158,7 +165,7 @@ cabalRules recorder = do log' = logWith recorder -- | This is the kick function for the cabal plugin. --- We run this action, whenever we need to restart the shake session, which triggers +-- 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 From 99c70818b36c4041f87254d1b7bfeb9f65af61b7 Mon Sep 17 00:00:00 2001 From: Fendor Date: Sat, 19 Nov 2022 16:10:20 +0100 Subject: [PATCH 24/25] Add hls-cabal-plugin features to features.md --- docs/features.md | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/docs/features.md b/docs/features.md index 5b025a82aa..c032848abb 100644 --- a/docs/features.md +++ b/docs/features.md @@ -44,6 +44,12 @@ Provided by: `hls-stan-plugin` Provides Stan hints as diagnostics. +### Cabal parse errors and warnings + +Provided by: `hls-cabal-plugin` + +Provides errors and warnings from Cabal as diagnostics + ## Hovers Provided by: `ghcide` @@ -308,6 +314,14 @@ Expand record wildcards, explicitly listing all record fields as field puns. ![Explicit Wildcard Demo](../plugins/hls-explicit-record-fields-plugin/wildcard.gif) +### Unknown SPDX License suggestion + +Provided by: `hls-cabal-plugin` + +Code action kind: `quickfix` + +Correct common misspelling of SPDX Licenses such as `BSD-3-Clause`. + ## Code lenses ### Add type signature From 701915c75ba2547ae22891b3a024a8c0311e74c6 Mon Sep 17 00:00:00 2001 From: Fendor Date: Sat, 19 Nov 2022 17:19:21 +0100 Subject: [PATCH 25/25] Re-use existing GetFileContents rule --- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 611ca9f793..72a16c8ea6 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -40,7 +40,7 @@ import qualified Language.LSP.Types as LSP import qualified Language.LSP.VFS as VFS data Log - = LogModificationTime NormalizedFilePath (Maybe FileVersion) + = LogModificationTime NormalizedFilePath FileVersion | LogShake Shake.Log | LogDocOpened Uri | LogDocModified Uri @@ -138,11 +138,10 @@ cabalRules recorder = do 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 <- use GetModificationTime file + (t, mCabalSource) <- use_ GetFileContents file log' Debug $ LogModificationTime file t - mVirtualFile <- Shake.getVirtualFile file - contents <- case mVirtualFile of - Just vfile -> pure $ Encoding.encodeUtf8 $ VFS.virtualFileText vfile + contents <- case mCabalSource of + Just sources -> pure $ Encoding.encodeUtf8 sources Nothing -> do liftIO $ BS.readFile $ fromNormalizedFilePath file