From 400421055b56493f28a91abfae4cdcc7e18bfa8f Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Fri, 28 Jun 2024 09:23:20 +0300 Subject: [PATCH 01/65] cabal-add code action traces --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 23 ++++++++++++++++++- src/HlsPlugins.hs | 2 ++ 2 files changed, 24 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 317f48bb3a..e78129aa1d 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -4,7 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} -module Ide.Plugin.Cabal (descriptor, Log (..)) where +module Ide.Plugin.Cabal (descriptor, haskellFilesDescriptor, Log (..)) where import Control.Concurrent.Strict import Control.DeepSeq @@ -53,6 +53,8 @@ import qualified Language.LSP.Protocol.Message as LSP import Language.LSP.Protocol.Types import qualified Language.LSP.VFS as VFS +import Debug.Trace + data Log = LogModificationTime NormalizedFilePath FileVersion | LogShake Shake.Log @@ -87,6 +89,18 @@ instance Pretty Log where <+> pretty position LogCompletions logs -> pretty logs + +haskellFilesDescriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState +haskellFilesDescriptor recorder plId = + (defaultPluginDescriptor plId "Provides the cabal-add code action in haskell files") + { pluginHandlers = + mconcat + [ mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ cabalAddCodeAction recorder + ] + , pluginRules = pure () -- TODO: change to haskell files only (?) + , pluginNotificationHandlers = mempty + } + descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState descriptor recorder plId = (defaultCabalPluginDescriptor plId "Provides a variety of IDE features in cabal files") @@ -94,6 +108,7 @@ descriptor recorder plId = , pluginHandlers = mconcat [ mkPluginHandler LSP.SMethod_TextDocumentCodeAction licenseSuggestCodeAction + -- , mkPluginHandler LSP.SMethod_TextDocumentCodeAction cabalAddCodeAction , mkPluginHandler LSP.SMethod_TextDocumentCompletion $ completion recorder , mkPluginHandler LSP.SMethod_TextDocumentDocumentSymbol moduleOutline , mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ fieldSuggestCodeAction recorder @@ -309,6 +324,12 @@ gotoDefinition ideState _ msgParam = do isSectionArgName name (Syntax.Section _ sectionArgName _) = name == CabalFields.onelineSectionArgs sectionArgName isSectionArgName _ _ = False +cabalAddCodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction +cabalAddCodeAction recorder state plId (CodeActionParams _ _ docId _ context) = do + let diags = context ^. JL.diagnostics + traceShowM ("cabalAddCodeAction diags ", diags) + pure $ InL [] + -- ---------------------------------------------------------------- -- Cabal file of Interest rules and global variable -- ---------------------------------------------------------------- diff --git a/src/HlsPlugins.hs b/src/HlsPlugins.hs index f08ae187cd..231d8898d6 100644 --- a/src/HlsPlugins.hs +++ b/src/HlsPlugins.hs @@ -152,6 +152,8 @@ idePlugins recorder = pluginDescToIdePlugins allPlugins allPlugins = #if hls_cabal let pId = "cabal" in Cabal.descriptor (pluginRecorder pId) pId : + -- let caId = "add-module" in Cabal.haskellFilesDescriptor (pluginRecorder caId) caId : + let caId = "cabal-add" in Cabal.haskellFilesDescriptor (pluginRecorder caId) caId : #endif #if hls_pragmas Pragmas.suggestPragmaDescriptor "pragmas-suggest" : From 76af0abb8dc425d655a6f326ec53400db01bafa6 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Sat, 29 Jun 2024 20:32:17 +0300 Subject: [PATCH 02/65] showing specific code action --- haskell-language-server.cabal | 1 + .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 15 +++--- .../src/Ide/Plugin/Cabal/CabalAdd.hs | 47 +++++++++++++++++++ .../testdata/cabal-add/MissingDependencies.hs | 0 .../hidden-package/hidden-package.cabal | 13 +++++ .../cabal-add/hidden-package/src/MyLib.hs | 6 +++ src/HlsPlugins.hs | 1 - 7 files changed, 76 insertions(+), 7 deletions(-) create mode 100644 plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs create mode 100644 plugins/hls-cabal-plugin/test/testdata/cabal-add/MissingDependencies.hs create mode 100644 plugins/hls-cabal-plugin/test/testdata/cabal-add/hidden-package/hidden-package.cabal create mode 100644 plugins/hls-cabal-plugin/test/testdata/cabal-add/hidden-package/src/MyLib.hs diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index c79d714fc3..4fc0ca192f 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -244,6 +244,7 @@ library hls-cabal-plugin Ide.Plugin.Cabal.Completion.Types Ide.Plugin.Cabal.FieldSuggest Ide.Plugin.Cabal.LicenseSuggest + Ide.Plugin.Cabal.CabalAdd Ide.Plugin.Cabal.Orphans Ide.Plugin.Cabal.Outline Ide.Plugin.Cabal.Parse diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index e78129aa1d..19966a5bb3 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -53,7 +53,9 @@ import qualified Language.LSP.Protocol.Message as LSP import Language.LSP.Protocol.Types import qualified Language.LSP.VFS as VFS -import Debug.Trace +import qualified Data.Text () +import Debug.Trace +import qualified Ide.Plugin.Cabal.CabalAdd as CabalAdd data Log = LogModificationTime NormalizedFilePath FileVersion @@ -108,7 +110,6 @@ descriptor recorder plId = , pluginHandlers = mconcat [ mkPluginHandler LSP.SMethod_TextDocumentCodeAction licenseSuggestCodeAction - -- , mkPluginHandler LSP.SMethod_TextDocumentCodeAction cabalAddCodeAction , mkPluginHandler LSP.SMethod_TextDocumentCompletion $ completion recorder , mkPluginHandler LSP.SMethod_TextDocumentDocumentSymbol moduleOutline , mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ fieldSuggestCodeAction recorder @@ -325,10 +326,12 @@ gotoDefinition ideState _ msgParam = do isSectionArgName _ _ = False cabalAddCodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction -cabalAddCodeAction recorder state plId (CodeActionParams _ _ docId _ context) = do - let diags = context ^. JL.diagnostics - traceShowM ("cabalAddCodeAction diags ", diags) - pure $ InL [] +cabalAddCodeAction recorder state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do + maxCompls <- fmap maxCompletions . liftIO $ runAction "cabal-plugin.cabalAdd" state getClientConfigAction + -- traceShowM ("cabalAddCodeAction maxCompls", maxCompls, "diags", diags) + let suggest d = CabalAdd.missingDependenciesSuggestion maxCompls (Diagnostics._message d) + -- traceShowM ("CabalAdd.missingDependenciesAction", map suggest diags) + pure $ InL $ diags >>= (fmap InR . CabalAdd.missingDependenciesAction maxCompls uri) -- ---------------------------------------------------------------- -- Cabal file of Interest rules and global variable diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs new file mode 100644 index 0000000000..a9189081b4 --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE OverloadedStrings #-} +module Ide.Plugin.Cabal.CabalAdd +( missingDependenciesAction + , missingDependenciesSuggestion + , hiddenPackageAction +) +where + +import qualified Data.Text as T +import Language.LSP.Protocol.Types (CodeAction (CodeAction), + CodeActionKind (CodeActionKind_QuickFix), + Diagnostic (..), Uri) +import Text.Regex.TDFA + + +missingDependenciesAction + :: Int + -> Uri + -> Diagnostic + -> [CodeAction] +missingDependenciesAction maxCompletions uri diag = + mkCodeAction <$> missingDependenciesSuggestion maxCompletions (_message diag) + where + mkCodeAction suggestedDep = + let + title = "Add dependency " <> suggestedDep + in CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing (Nothing) Nothing Nothing + +missingDependenciesSuggestion + :: Int + -> T.Text + -> [T.Text] + +missingDependenciesSuggestion maxCompletions msg = take maxCompletions $ getMatch (msg =~ regex) + where + regex :: T.Text + regex = "Could not load module \8216.*\8217.\nIt is a member of the hidden package \8216(.*)\8217" + getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> [T.Text] + getMatch (_, _, _, results) = results + +hiddenPackageAction + :: Int -- ^ Maximum number of suggestions to return + -> Uri -- ^ File for which the diagnostic was generated + -> Diagnostic + -> [CodeAction] +hiddenPackageAction = undefined diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add/MissingDependencies.hs b/plugins/hls-cabal-plugin/test/testdata/cabal-add/MissingDependencies.hs new file mode 100644 index 0000000000..e69de29bb2 diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add/hidden-package/hidden-package.cabal b/plugins/hls-cabal-plugin/test/testdata/cabal-add/hidden-package/hidden-package.cabal new file mode 100644 index 0000000000..e618c810eb --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-add/hidden-package/hidden-package.cabal @@ -0,0 +1,13 @@ +cabal-version: 3.0 +name: hidden-package +version: 0.1.0.0 +license: MIT +build-type: Simple + +library + exposed-modules: MyLib + -- other-modules: + -- other-extensions: + build-depends: base + hs-source-dirs: src + default-language: Haskell2010 diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add/hidden-package/src/MyLib.hs b/plugins/hls-cabal-plugin/test/testdata/cabal-add/hidden-package/src/MyLib.hs new file mode 100644 index 0000000000..bbb506d001 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-add/hidden-package/src/MyLib.hs @@ -0,0 +1,6 @@ +module MyLib (someFunc) where + +import Data.List.Split + +someFunc :: IO () +someFunc = putStrLn "someFunc" diff --git a/src/HlsPlugins.hs b/src/HlsPlugins.hs index 231d8898d6..60f8481d44 100644 --- a/src/HlsPlugins.hs +++ b/src/HlsPlugins.hs @@ -152,7 +152,6 @@ idePlugins recorder = pluginDescToIdePlugins allPlugins allPlugins = #if hls_cabal let pId = "cabal" in Cabal.descriptor (pluginRecorder pId) pId : - -- let caId = "add-module" in Cabal.haskellFilesDescriptor (pluginRecorder caId) caId : let caId = "cabal-add" in Cabal.haskellFilesDescriptor (pluginRecorder caId) caId : #endif #if hls_pragmas From b2e45a02078a3c72cc20f280da56e96cc29b6298 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Mon, 1 Jul 2024 18:45:21 +0300 Subject: [PATCH 03/65] hidden package progress --- .../src/Ide/Plugin/Cabal/CabalAdd.hs | 22 +++++++++---------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index a9189081b4..6f75008ee4 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -14,24 +14,16 @@ import Language.LSP.Protocol.Types (CodeAction (CodeAction), import Text.Regex.TDFA -missingDependenciesAction - :: Int - -> Uri - -> Diagnostic - -> [CodeAction] +missingDependenciesAction :: Int -> Uri -> Diagnostic -> [CodeAction] missingDependenciesAction maxCompletions uri diag = mkCodeAction <$> missingDependenciesSuggestion maxCompletions (_message diag) where mkCodeAction suggestedDep = let title = "Add dependency " <> suggestedDep - in CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing (Nothing) Nothing Nothing - -missingDependenciesSuggestion - :: Int - -> T.Text - -> [T.Text] + in CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing Nothing (Nothing) Nothing +missingDependenciesSuggestion :: Int -> T.Text -> [T.Text] missingDependenciesSuggestion maxCompletions msg = take maxCompletions $ getMatch (msg =~ regex) where regex :: T.Text @@ -45,3 +37,11 @@ hiddenPackageAction -> Diagnostic -> [CodeAction] hiddenPackageAction = undefined + +hiddenPackageSuggestion :: Int -> T.Text -> [T.Text] +hiddenPackageSuggestion maxCompletions msg = take maxCompletions $ getMatch (msg =~ regex) + where + regex :: T.Text + regex = "It is a member of the package '.*'\nwhich is unusable due to missing dependencies:[\n ]*([:word:-.]*)" + getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> [T.Text] + getMatch (_, _, _, results) = results \ No newline at end of file From a940b585ae3613173bafa87ee2f0d6a2e09efb3f Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Tue, 2 Jul 2024 06:50:29 +0300 Subject: [PATCH 04/65] + hidden-package test case --- .../test/cabal-add-testdata/cabal.project | 1 + .../hidden-package/hidden-package.cabal | 14 ++++++++++++++ .../cabal-add-testdata/hidden-package/src/Main.hs | 5 +++++ .../test/cabal-add-testdata/hie.yaml | 3 +++ .../test/testdata/cabal-add/MissingDependencies.hs | 0 .../cabal-add/hidden-package/hidden-package.cabal | 13 ------------- .../testdata/cabal-add/hidden-package/src/MyLib.hs | 6 ------ 7 files changed, 23 insertions(+), 19 deletions(-) create mode 100644 plugins/hls-cabal-plugin/test/cabal-add-testdata/cabal.project create mode 100644 plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal create mode 100644 plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/src/Main.hs create mode 100644 plugins/hls-cabal-plugin/test/cabal-add-testdata/hie.yaml delete mode 100644 plugins/hls-cabal-plugin/test/testdata/cabal-add/MissingDependencies.hs delete mode 100644 plugins/hls-cabal-plugin/test/testdata/cabal-add/hidden-package/hidden-package.cabal delete mode 100644 plugins/hls-cabal-plugin/test/testdata/cabal-add/hidden-package/src/MyLib.hs diff --git a/plugins/hls-cabal-plugin/test/cabal-add-testdata/cabal.project b/plugins/hls-cabal-plugin/test/cabal-add-testdata/cabal.project new file mode 100644 index 0000000000..280b81b2f4 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/cabal-add-testdata/cabal.project @@ -0,0 +1 @@ +packages: ./hidden-package \ No newline at end of file diff --git a/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal b/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal new file mode 100644 index 0000000000..673a20d7ea --- /dev/null +++ b/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal @@ -0,0 +1,14 @@ +cabal-version: 2.2 + +name: hidden-package +version: 0.1.0.0 +author: Fendor +maintainer: power.walross@gmail.com +build-type: Simple + +executable hidden-package + main-is: Main.hs + hs-source-dirs: src + ghc-options: -Wall + build-depends: base + default-language: Haskell2010 diff --git a/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/src/Main.hs b/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/src/Main.hs new file mode 100644 index 0000000000..0bf3e99dae --- /dev/null +++ b/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/src/Main.hs @@ -0,0 +1,5 @@ +module Main where + +import Data.List.Split + +main = putStrLn "Hello, Haskell!" \ No newline at end of file diff --git a/plugins/hls-cabal-plugin/test/cabal-add-testdata/hie.yaml b/plugins/hls-cabal-plugin/test/cabal-add-testdata/hie.yaml new file mode 100644 index 0000000000..ddd86720b9 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/cabal-add-testdata/hie.yaml @@ -0,0 +1,3 @@ +cradle: + cabal: + component: "exe:hidden-package" \ No newline at end of file diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add/MissingDependencies.hs b/plugins/hls-cabal-plugin/test/testdata/cabal-add/MissingDependencies.hs deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add/hidden-package/hidden-package.cabal b/plugins/hls-cabal-plugin/test/testdata/cabal-add/hidden-package/hidden-package.cabal deleted file mode 100644 index e618c810eb..0000000000 --- a/plugins/hls-cabal-plugin/test/testdata/cabal-add/hidden-package/hidden-package.cabal +++ /dev/null @@ -1,13 +0,0 @@ -cabal-version: 3.0 -name: hidden-package -version: 0.1.0.0 -license: MIT -build-type: Simple - -library - exposed-modules: MyLib - -- other-modules: - -- other-extensions: - build-depends: base - hs-source-dirs: src - default-language: Haskell2010 diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add/hidden-package/src/MyLib.hs b/plugins/hls-cabal-plugin/test/testdata/cabal-add/hidden-package/src/MyLib.hs deleted file mode 100644 index bbb506d001..0000000000 --- a/plugins/hls-cabal-plugin/test/testdata/cabal-add/hidden-package/src/MyLib.hs +++ /dev/null @@ -1,6 +0,0 @@ -module MyLib (someFunc) where - -import Data.List.Split - -someFunc :: IO () -someFunc = putStrLn "someFunc" From ccbd228566e4d4572636667e85afb58697e538df Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Thu, 4 Jul 2024 05:55:19 +0300 Subject: [PATCH 05/65] test cases update --- .../test/cabal-add-testdata/cabal.project | 2 +- .../hidden-package/hidden-package.cabal | 2 -- .../missing-dependencies/missing-dependencies.cabal | 13 +++++++++++++ .../missing-dependencies/src/Main.hs | 4 ++++ .../missing-dependencies/src/Test.hs | 3 +++ 5 files changed, 21 insertions(+), 3 deletions(-) create mode 100644 plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/missing-dependencies.cabal create mode 100644 plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/src/Main.hs create mode 100644 plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/src/Test.hs diff --git a/plugins/hls-cabal-plugin/test/cabal-add-testdata/cabal.project b/plugins/hls-cabal-plugin/test/cabal-add-testdata/cabal.project index 280b81b2f4..125ed7aaf3 100644 --- a/plugins/hls-cabal-plugin/test/cabal-add-testdata/cabal.project +++ b/plugins/hls-cabal-plugin/test/cabal-add-testdata/cabal.project @@ -1 +1 @@ -packages: ./hidden-package \ No newline at end of file +packages: hidden-package missing-dependencies \ No newline at end of file diff --git a/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal b/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal index 673a20d7ea..6a5863fb44 100644 --- a/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal +++ b/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal @@ -2,8 +2,6 @@ cabal-version: 2.2 name: hidden-package version: 0.1.0.0 -author: Fendor -maintainer: power.walross@gmail.com build-type: Simple executable hidden-package diff --git a/plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/missing-dependencies.cabal b/plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/missing-dependencies.cabal new file mode 100644 index 0000000000..91bfc584ca --- /dev/null +++ b/plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/missing-dependencies.cabal @@ -0,0 +1,13 @@ +cabal-version: 2.2 + +name: missing-dependencies +version: 0.1.0.0 +build-type: Simple + +executable missing-dependencies + main-is: Main.hs + hs-source-dirs: src + ghc-options: -Wall + build-depends: + , split >=0.2.5 + default-language: Haskell2010 diff --git a/plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/src/Main.hs b/plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/src/Main.hs new file mode 100644 index 0000000000..8048024acb --- /dev/null +++ b/plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/src/Main.hs @@ -0,0 +1,4 @@ +module Main where + +import Data.List.Split +main = putStrLn "Hello, Haskell!" \ No newline at end of file diff --git a/plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/src/Test.hs b/plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/src/Test.hs new file mode 100644 index 0000000000..68ab0a84d7 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/src/Test.hs @@ -0,0 +1,3 @@ +module Test where + +import Data.List.Split \ No newline at end of file From 02665148dfc38069749ca599dd9c2115b9a4a24b Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Thu, 4 Jul 2024 06:51:59 +0300 Subject: [PATCH 06/65] embedded cabal-add --- cabal-add | 1 + cabal.project | 1 + haskell-language-server.cabal | 2 ++ plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs | 1 + 4 files changed, 5 insertions(+) create mode 160000 cabal-add diff --git a/cabal-add b/cabal-add new file mode 160000 index 0000000000..6e48220530 --- /dev/null +++ b/cabal-add @@ -0,0 +1 @@ +Subproject commit 6e482205307cb6fd3713338c6467506eabfb8761 diff --git a/cabal.project b/cabal.project index dc7887ee7a..07a94da56d 100644 --- a/cabal.project +++ b/cabal.project @@ -6,6 +6,7 @@ packages: ./ghcide ./hls-plugin-api ./hls-test-utils + ./cabal-add index-state: 2024-06-29T00:00:00Z diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 4fc0ca192f..7208ef4e91 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -271,6 +271,8 @@ library hls-cabal-plugin , transformers , unordered-containers >=0.2.10.0 , containers + , cabal-add + hs-source-dirs: plugins/hls-cabal-plugin/src test-suite hls-cabal-plugin-tests diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 6f75008ee4..d149e6ee83 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -12,6 +12,7 @@ import Language.LSP.Protocol.Types (CodeAction (CodeAction), CodeActionKind (CodeActionKind_QuickFix), Diagnostic (..), Uri) import Text.Regex.TDFA +import Distribution.Client.Add missingDependenciesAction :: Int -> Uri -> Diagnostic -> [CodeAction] From 5cf86c817a49aae7e1877e3a463b46c7db614b29 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Fri, 5 Jul 2024 07:47:23 +0300 Subject: [PATCH 07/65] cabal-add CodeAction, PATH cabal-add install --- haskell-language-server.cabal | 1 + .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 5 ++- .../src/Ide/Plugin/Cabal/CabalAdd.hs | 33 +++++++++++++++---- src/HlsPlugins.hs | 2 +- 4 files changed, 30 insertions(+), 11 deletions(-) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 7208ef4e91..2272897688 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -272,6 +272,7 @@ library hls-cabal-plugin , unordered-containers >=0.2.10.0 , containers , cabal-add + , process hs-source-dirs: plugins/hls-cabal-plugin/src diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 19966a5bb3..b24eb6d6b0 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -99,6 +99,7 @@ haskellFilesDescriptor recorder plId = mconcat [ mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ cabalAddCodeAction recorder ] + , pluginCommands = [PluginCommand CabalAdd.cabalAddNameCommand "add a dependency to a cabal file" CabalAdd.command] , pluginRules = pure () -- TODO: change to haskell files only (?) , pluginNotificationHandlers = mempty } @@ -328,10 +329,8 @@ gotoDefinition ideState _ msgParam = do cabalAddCodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction cabalAddCodeAction recorder state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do maxCompls <- fmap maxCompletions . liftIO $ runAction "cabal-plugin.cabalAdd" state getClientConfigAction - -- traceShowM ("cabalAddCodeAction maxCompls", maxCompls, "diags", diags) let suggest d = CabalAdd.missingDependenciesSuggestion maxCompls (Diagnostics._message d) - -- traceShowM ("CabalAdd.missingDependenciesAction", map suggest diags) - pure $ InL $ diags >>= (fmap InR . CabalAdd.missingDependenciesAction maxCompls uri) + pure $ InL $ diags >>= (fmap InR . CabalAdd.missingDependenciesAction plId maxCompls uri) -- ---------------------------------------------------------------- -- Cabal file of Interest rules and global variable diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index d149e6ee83..a19f6df00a 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -1,28 +1,39 @@ {-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE OverloadedStrings #-} module Ide.Plugin.Cabal.CabalAdd ( missingDependenciesAction , missingDependenciesSuggestion , hiddenPackageAction + , cabalAddNameCommand + , command ) where +import Control.Monad (void) +import Control.Monad.IO.Class (liftIO) +import Data.String (IsString) import qualified Data.Text as T +import Development.IDE (IdeState) +import Ide.PluginUtils (mkLspCommand) +import Ide.Types (CommandFunction, + CommandId (CommandId), PluginId) import Language.LSP.Protocol.Types (CodeAction (CodeAction), CodeActionKind (CodeActionKind_QuickFix), - Diagnostic (..), Uri) + Command (..), Diagnostic (..), + Null (Null), Uri, type (|?) (InR)) +import System.Process (readProcess) import Text.Regex.TDFA -import Distribution.Client.Add - -missingDependenciesAction :: Int -> Uri -> Diagnostic -> [CodeAction] -missingDependenciesAction maxCompletions uri diag = +missingDependenciesAction :: PluginId -> Int -> Uri -> Diagnostic -> [CodeAction] +missingDependenciesAction plId maxCompletions uri diag = mkCodeAction <$> missingDependenciesSuggestion maxCompletions (_message diag) where mkCodeAction suggestedDep = let title = "Add dependency " <> suggestedDep - in CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing Nothing (Nothing) Nothing + command = mkLspCommand plId (CommandId cabalAddNameCommand) "Execute Code Action" (Nothing) + in CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing Nothing (Just command) Nothing missingDependenciesSuggestion :: Int -> T.Text -> [T.Text] missingDependenciesSuggestion maxCompletions msg = take maxCompletions $ getMatch (msg =~ regex) @@ -45,4 +56,12 @@ hiddenPackageSuggestion maxCompletions msg = take maxCompletions $ getMatch (msg regex :: T.Text regex = "It is a member of the package '.*'\nwhich is unusable due to missing dependencies:[\n ]*([:word:-.]*)" getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> [T.Text] - getMatch (_, _, _, results) = results \ No newline at end of file + getMatch (_, _, _, results) = results + +cabalAddNameCommand :: IsString p => p +cabalAddNameCommand = "cabalAdd" + +command :: CommandFunction IdeState Uri +command state _ uri = do + void $ liftIO $ readProcess "cabal-add" [] [] + pure $ InR Null diff --git a/src/HlsPlugins.hs b/src/HlsPlugins.hs index 60f8481d44..cbfcae52c5 100644 --- a/src/HlsPlugins.hs +++ b/src/HlsPlugins.hs @@ -152,7 +152,7 @@ idePlugins recorder = pluginDescToIdePlugins allPlugins allPlugins = #if hls_cabal let pId = "cabal" in Cabal.descriptor (pluginRecorder pId) pId : - let caId = "cabal-add" in Cabal.haskellFilesDescriptor (pluginRecorder caId) caId : + let caId = "cabaladd" in Cabal.haskellFilesDescriptor (pluginRecorder caId) caId : #endif #if hls_pragmas Pragmas.suggestPragmaDescriptor "pragmas-suggest" : From fc2db8f8c5aa03a04c56f1198514bf5258c81116 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Tue, 9 Jul 2024 20:52:57 +0300 Subject: [PATCH 08/65] + cabal file path in CodeAction --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 8 ++- .../src/Ide/Plugin/Cabal/CabalAdd.hs | 50 ++++++++++++++----- 2 files changed, 43 insertions(+), 15 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index b24eb6d6b0..3cfb493601 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -329,8 +329,12 @@ gotoDefinition ideState _ msgParam = do cabalAddCodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction cabalAddCodeAction recorder state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do maxCompls <- fmap maxCompletions . liftIO $ runAction "cabal-plugin.cabalAdd" state getClientConfigAction - let suggest d = CabalAdd.missingDependenciesSuggestion maxCompls (Diagnostics._message d) - pure $ InL $ diags >>= (fmap InR . CabalAdd.missingDependenciesAction plId maxCompls uri) + let mbUriPath = uriToFilePath uri + case mbUriPath of + Nothing -> pure $ InL [] + Just uriPath -> do + cabalFiles <- liftIO $ CabalAdd.findResponsibleCabalFile uriPath + pure $ InL $ diags >>= (\diag -> fmap InR (CabalAdd.missingDependenciesAction plId maxCompls uri diag cabalFiles)) -- ---------------------------------------------------------------- -- Cabal file of Interest rules and global variable diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index a19f6df00a..8159a8fc22 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -2,7 +2,8 @@ {-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE OverloadedStrings #-} module Ide.Plugin.Cabal.CabalAdd -( missingDependenciesAction +( findResponsibleCabalFile + , missingDependenciesAction , missingDependenciesSuggestion , hiddenPackageAction , cabalAddNameCommand @@ -19,33 +20,55 @@ import Ide.PluginUtils (mkLspCommand) import Ide.Types (CommandFunction, CommandId (CommandId), PluginId) import Language.LSP.Protocol.Types (CodeAction (CodeAction), + CodeActionDisabled (CodeActionDisabled), CodeActionKind (CodeActionKind_QuickFix), - Command (..), Diagnostic (..), - Null (Null), Uri, type (|?) (InR)) + Diagnostic (..), Null (Null), + Uri (..), type (|?) (InR)) +import System.Directory (listDirectory) +import System.FilePath (dropFileName, splitPath, + takeExtension, ()) import System.Process (readProcess) import Text.Regex.TDFA -missingDependenciesAction :: PluginId -> Int -> Uri -> Diagnostic -> [CodeAction] -missingDependenciesAction plId maxCompletions uri diag = - mkCodeAction <$> missingDependenciesSuggestion maxCompletions (_message diag) +findResponsibleCabalFile :: FilePath -> IO [FilePath] +findResponsibleCabalFile uriPath = do + contents <- mapM listDirectory allDirPaths + let filesWithPaths = concat $ zipWith (\path content -> map (path ) content) allDirPaths contents + let cabalFiles = filter (\c -> takeExtension c == ".cabal") filesWithPaths + pure $ reverse cabalFiles -- sorted from closest to the uriPath + where dirPath = dropFileName uriPath + allDirPaths = scanl1 () (splitPath dirPath) + + +-- | Gives a code action that calls the command, +-- if a suggestion for a missing dependency is found. +-- Disabled action if no cabal files given. +missingDependenciesAction :: PluginId -> Int -> Uri -> Diagnostic -> [FilePath] -> [CodeAction] +missingDependenciesAction plId maxCompletions uri diag cabalFiles = + case cabalFiles of + [] -> [CodeAction "No .cabal file found" (Just CodeActionKind_QuickFix) (Just []) Nothing + (Just (CodeActionDisabled "No .cabal file found")) Nothing Nothing Nothing] + (cabalFile:_) -> mkCodeAction cabalFile <$> missingDependenciesSuggestion maxCompletions (_message diag) where - mkCodeAction suggestedDep = + mkCodeAction cabalFile suggestedDep = let - title = "Add dependency " <> suggestedDep - command = mkLspCommand plId (CommandId cabalAddNameCommand) "Execute Code Action" (Nothing) + title = "Add dependency " <> suggestedDep <> " at " <> (T.pack $ show cabalFile) + command = mkLspCommand plId (CommandId cabalAddNameCommand) "Execute Code Action" (Nothing) -- TODO: add cabal-add CL arguments in CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing Nothing (Just command) Nothing +-- | Gives a mentioned number of hidden packages given +-- a specific error message missingDependenciesSuggestion :: Int -> T.Text -> [T.Text] missingDependenciesSuggestion maxCompletions msg = take maxCompletions $ getMatch (msg =~ regex) where - regex :: T.Text + regex :: T.Text -- TODO: Support multiple packages suggestion regex = "Could not load module \8216.*\8217.\nIt is a member of the hidden package \8216(.*)\8217" getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> [T.Text] getMatch (_, _, _, results) = results hiddenPackageAction - :: Int -- ^ Maximum number of suggestions to return - -> Uri -- ^ File for which the diagnostic was generated + :: Int + -> Uri -> Diagnostic -> [CodeAction] hiddenPackageAction = undefined @@ -61,7 +84,8 @@ hiddenPackageSuggestion maxCompletions msg = take maxCompletions $ getMatch (msg cabalAddNameCommand :: IsString p => p cabalAddNameCommand = "cabalAdd" +-- | Registering a cabal-add as a HLS command command :: CommandFunction IdeState Uri command state _ uri = do void $ liftIO $ readProcess "cabal-add" [] [] - pure $ InR Null + pure $ InR Null -- TODO: return cabal-add output (?) From 922cfe5c6d07283fd9e912f94c5a2f04da41dece Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Wed, 10 Jul 2024 10:12:18 +0300 Subject: [PATCH 09/65] WIP command arguments --- haskell-language-server.cabal | 1 + .../src/Ide/Plugin/Cabal/CabalAdd.hs | 13 ++++++++++--- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 2272897688..0df5f4342e 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -273,6 +273,7 @@ library hls-cabal-plugin , containers , cabal-add , process + , aeson hs-source-dirs: plugins/hls-cabal-plugin/src diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 8159a8fc22..7d9affe295 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -26,9 +26,11 @@ import Language.LSP.Protocol.Types (CodeAction (CodeAction), Uri (..), type (|?) (InR)) import System.Directory (listDirectory) import System.FilePath (dropFileName, splitPath, - takeExtension, ()) + takeExtension, (), takeFileName) import System.Process (readProcess) import Text.Regex.TDFA +import Data.Aeson.Types (toJSON) +import Debug.Trace findResponsibleCabalFile :: FilePath -> IO [FilePath] findResponsibleCabalFile uriPath = do @@ -52,8 +54,12 @@ missingDependenciesAction plId maxCompletions uri diag cabalFiles = where mkCodeAction cabalFile suggestedDep = let - title = "Add dependency " <> suggestedDep <> " at " <> (T.pack $ show cabalFile) - command = mkLspCommand plId (CommandId cabalAddNameCommand) "Execute Code Action" (Nothing) -- TODO: add cabal-add CL arguments + cabalName = T.pack $ takeFileName cabalFile + title = "Add dependency " <> suggestedDep <> " at " <> cabalName <> " " <> (T.pack $ show args) + -- args = Just [toJSON suggestedDep, toJSON ("--project-file " <> cabalFile)] + args = Just [toJSON suggestedDep] + + command = mkLspCommand plId (CommandId cabalAddNameCommand) "Execute Code Action" args -- TODO: add cabal-add CL arguments in CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing Nothing (Just command) Nothing -- | Gives a mentioned number of hidden packages given @@ -87,5 +93,6 @@ cabalAddNameCommand = "cabalAdd" -- | Registering a cabal-add as a HLS command command :: CommandFunction IdeState Uri command state _ uri = do + traceShowM ("uri ", uri) void $ liftIO $ readProcess "cabal-add" [] [] pure $ InR Null -- TODO: return cabal-add output (?) From e20da0de55cd11a69afa92bb2c9f1f3f10c29c11 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Wed, 10 Jul 2024 10:26:10 +0300 Subject: [PATCH 10/65] WIP hardcoded cabal-add --- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 7d9affe295..da8473197d 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -94,5 +94,5 @@ cabalAddNameCommand = "cabalAdd" command :: CommandFunction IdeState Uri command state _ uri = do traceShowM ("uri ", uri) - void $ liftIO $ readProcess "cabal-add" [] [] + void $ liftIO $ readProcess "/home/george-manjaro/.cabal/bin/cabal-add" [] [] pure $ InR Null -- TODO: return cabal-add output (?) From a032bc0ec5fc1a2d8edefc00654c2c7ee2a2a040 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Thu, 11 Jul 2024 17:42:56 +0300 Subject: [PATCH 11/65] + cabal-add --- cabal-add | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal-add b/cabal-add index 6e48220530..8c004e2a43 160000 --- a/cabal-add +++ b/cabal-add @@ -1 +1 @@ -Subproject commit 6e482205307cb6fd3713338c6467506eabfb8761 +Subproject commit 8c004e2a4329232f9824425f5472b2d6d7958bbd From 9c64de875b259fa52e988bcbac34626ecb9c7f81 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Thu, 11 Jul 2024 18:17:57 +0300 Subject: [PATCH 12/65] catched parameters in a command --- .../src/Ide/Plugin/Cabal/CabalAdd.hs | 28 +++++++++++++------ 1 file changed, 19 insertions(+), 9 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index da8473197d..acb9690d00 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -1,6 +1,9 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DeriveAnyClass #-} + module Ide.Plugin.Cabal.CabalAdd ( findResponsibleCabalFile , missingDependenciesAction @@ -29,8 +32,9 @@ import System.FilePath (dropFileName, splitPath, takeExtension, (), takeFileName) import System.Process (readProcess) import Text.Regex.TDFA -import Data.Aeson.Types (toJSON) +import Data.Aeson.Types (toJSON, FromJSON, ToJSON) import Debug.Trace +import Distribution.Compat.Prelude (Generic) findResponsibleCabalFile :: FilePath -> IO [FilePath] findResponsibleCabalFile uriPath = do @@ -55,11 +59,9 @@ missingDependenciesAction plId maxCompletions uri diag cabalFiles = mkCodeAction cabalFile suggestedDep = let cabalName = T.pack $ takeFileName cabalFile - title = "Add dependency " <> suggestedDep <> " at " <> cabalName <> " " <> (T.pack $ show args) - -- args = Just [toJSON suggestedDep, toJSON ("--project-file " <> cabalFile)] - args = Just [toJSON suggestedDep] - - command = mkLspCommand plId (CommandId cabalAddNameCommand) "Execute Code Action" args -- TODO: add cabal-add CL arguments + params = CabalAddCommandParams {cabalPath = cabalFile, dependency = suggestedDep} + title = "Add dependency " <> suggestedDep <> " at " <> cabalName <> " " <> (T.pack $ show params) + command = mkLspCommand plId (CommandId cabalAddNameCommand) "Execute Code Action" (Just [toJSON params]) -- TODO: add cabal-add CL arguments in CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing Nothing (Just command) Nothing -- | Gives a mentioned number of hidden packages given @@ -90,9 +92,17 @@ hiddenPackageSuggestion maxCompletions msg = take maxCompletions $ getMatch (msg cabalAddNameCommand :: IsString p => p cabalAddNameCommand = "cabalAdd" +data CabalAddCommandParams = + CabalAddCommandParams { cabalPath :: FilePath + , dependency :: T.Text + } + deriving (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + -- | Registering a cabal-add as a HLS command -command :: CommandFunction IdeState Uri -command state _ uri = do - traceShowM ("uri ", uri) +command :: CommandFunction IdeState CabalAddCommandParams +command _ _ (CabalAddCommandParams {cabalPath = path, dependency = dep}) = do + traceShowM ("cabalPath ", path) + traceShowM ("dependency ", dep) void $ liftIO $ readProcess "/home/george-manjaro/.cabal/bin/cabal-add" [] [] pure $ InR Null -- TODO: return cabal-add output (?) From f633e70164a3aa9c32deeeb1fbc23b7ea29c3d1a Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Fri, 12 Jul 2024 16:58:21 +0300 Subject: [PATCH 13/65] working prototype --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 2 +- .../src/Ide/Plugin/Cabal/CabalAdd.hs | 67 ++++++++++++++++--- 2 files changed, 59 insertions(+), 10 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 3cfb493601..72284f8fd9 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -99,7 +99,7 @@ haskellFilesDescriptor recorder plId = mconcat [ mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ cabalAddCodeAction recorder ] - , pluginCommands = [PluginCommand CabalAdd.cabalAddNameCommand "add a dependency to a cabal file" CabalAdd.command] + , pluginCommands = [PluginCommand CabalAdd.cabalAddCommand "add a dependency to a cabal file" CabalAdd.command] , pluginRules = pure () -- TODO: change to haskell files only (?) , pluginNotificationHandlers = mempty } diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index acb9690d00..8b3e3928f9 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -3,13 +3,15 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE PartialTypeSignatures #-} module Ide.Plugin.Cabal.CabalAdd ( findResponsibleCabalFile , missingDependenciesAction , missingDependenciesSuggestion , hiddenPackageAction - , cabalAddNameCommand + , cabalAddCommand , command ) where @@ -27,7 +29,9 @@ import Language.LSP.Protocol.Types (CodeAction (CodeAction), CodeActionKind (CodeActionKind_QuickFix), Diagnostic (..), Null (Null), Uri (..), type (|?) (InR)) -import System.Directory (listDirectory) +import System.Directory (listDirectory, doesFileExist) +import Distribution.PackageDescription.Quirks (patchQuirks) + import System.FilePath (dropFileName, splitPath, takeExtension, (), takeFileName) import System.Process (readProcess) @@ -35,6 +39,17 @@ import Text.Regex.TDFA import Data.Aeson.Types (toJSON, FromJSON, ToJSON) import Debug.Trace import Distribution.Compat.Prelude (Generic) +import Data.List.NonEmpty (NonEmpty (..), fromList) +import Distribution.Client.Add as Add +import Data.ByteString (ByteString) +import Data.ByteString.Char8 qualified as B +import Data.Maybe (fromJust) +import Distribution.PackageDescription ( + ComponentName, + GenericPackageDescription, + packageDescription, + specVersion, + ) findResponsibleCabalFile :: FilePath -> IO [FilePath] findResponsibleCabalFile uriPath = do @@ -61,7 +76,7 @@ missingDependenciesAction plId maxCompletions uri diag cabalFiles = cabalName = T.pack $ takeFileName cabalFile params = CabalAddCommandParams {cabalPath = cabalFile, dependency = suggestedDep} title = "Add dependency " <> suggestedDep <> " at " <> cabalName <> " " <> (T.pack $ show params) - command = mkLspCommand plId (CommandId cabalAddNameCommand) "Execute Code Action" (Just [toJSON params]) -- TODO: add cabal-add CL arguments + command = mkLspCommand plId (CommandId cabalAddCommand) "Execute Code Action" (Just [toJSON params]) -- TODO: add cabal-add CL arguments in CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing Nothing (Just command) Nothing -- | Gives a mentioned number of hidden packages given @@ -70,7 +85,7 @@ missingDependenciesSuggestion :: Int -> T.Text -> [T.Text] missingDependenciesSuggestion maxCompletions msg = take maxCompletions $ getMatch (msg =~ regex) where regex :: T.Text -- TODO: Support multiple packages suggestion - regex = "Could not load module \8216.*\8217.\nIt is a member of the hidden package \8216(.*)\8217" + regex = "Could not load module \8216.*\8217.\nIt is a member of the hidden package \8216([a-z]+)[-]?[0-9\\.]*\8217" getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> [T.Text] getMatch (_, _, _, results) = results @@ -89,8 +104,8 @@ hiddenPackageSuggestion maxCompletions msg = take maxCompletions $ getMatch (msg getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> [T.Text] getMatch (_, _, _, results) = results -cabalAddNameCommand :: IsString p => p -cabalAddNameCommand = "cabalAdd" +cabalAddCommand :: IsString p => p +cabalAddCommand = "cabalAdd" data CabalAddCommandParams = CabalAddCommandParams { cabalPath :: FilePath @@ -99,10 +114,44 @@ data CabalAddCommandParams = deriving (Generic, Show) deriving anyclass (FromJSON, ToJSON) --- | Registering a cabal-add as a HLS command command :: CommandFunction IdeState CabalAddCommandParams command _ _ (CabalAddCommandParams {cabalPath = path, dependency = dep}) = do traceShowM ("cabalPath ", path) traceShowM ("dependency ", dep) - void $ liftIO $ readProcess "/home/george-manjaro/.cabal/bin/cabal-add" [] [] - pure $ InR Null -- TODO: return cabal-add output (?) + void $ liftIO $ addDependency path (fromList [T.unpack dep]) + pure $ InR Null + +data RawConfig = RawConfig + { rcnfCabalFile :: !FilePath + , rcnfComponent :: !(Maybe String) + , rcnfDependencies :: !(NonEmpty String) + } + deriving (Show) + +readCabalFile :: FilePath -> IO (Maybe ByteString) +readCabalFile fileName = do + cabalFileExists <- doesFileExist fileName + if cabalFileExists + then Just . snd . patchQuirks <$> B.readFile fileName + else pure Nothing + +addDependency :: FilePath -> NonEmpty String -> IO () +addDependency cabalFilePath dependency = do + let rcnfComponent = Nothing -- Just "component?" + + cnfOrigContents <- fromJust <$> readCabalFile cabalFilePath + let inputs :: Either _ _ = do + (fields, packDescr) <- parseCabalFile cabalFilePath cnfOrigContents + -- ^ cabal path ^ cabal raw contents + let specVer = specVersion $ packageDescription packDescr + cmp <- resolveComponent cabalFilePath (fields, packDescr) rcnfComponent + deps <- traverse (validateDependency specVer) dependency + pure (fields, packDescr, cmp, deps) + + (cnfFields, origPackDescr, cnfComponent, cnfDependencies) <- case inputs of + Left err -> error err + Right pair -> pure pair + + case executeConfig (validateChanges origPackDescr) (Config {..}) of + Nothing -> error $ "Cannot extend build-depends in " ++ cabalFilePath + Just r -> B.writeFile cabalFilePath r \ No newline at end of file From fd719e63de86c2366ff2979ebfda4db6a8f7f428 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Fri, 12 Jul 2024 18:07:04 +0300 Subject: [PATCH 14/65] adds package's version if detected --- .../src/Ide/Plugin/Cabal/CabalAdd.hs | 154 ++++++++---------- .../hidden-package/hidden-package.cabal | 2 +- 2 files changed, 73 insertions(+), 83 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 8b3e3928f9..67bd462942 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -1,10 +1,10 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE ExplicitNamespaces #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE RecordWildCards #-} module Ide.Plugin.Cabal.CabalAdd ( findResponsibleCabalFile @@ -16,40 +16,39 @@ module Ide.Plugin.Cabal.CabalAdd ) where -import Control.Monad (void) -import Control.Monad.IO.Class (liftIO) -import Data.String (IsString) -import qualified Data.Text as T -import Development.IDE (IdeState) -import Ide.PluginUtils (mkLspCommand) -import Ide.Types (CommandFunction, - CommandId (CommandId), PluginId) -import Language.LSP.Protocol.Types (CodeAction (CodeAction), - CodeActionDisabled (CodeActionDisabled), - CodeActionKind (CodeActionKind_QuickFix), - Diagnostic (..), Null (Null), - Uri (..), type (|?) (InR)) -import System.Directory (listDirectory, doesFileExist) -import Distribution.PackageDescription.Quirks (patchQuirks) - -import System.FilePath (dropFileName, splitPath, - takeExtension, (), takeFileName) -import System.Process (readProcess) +import Control.Monad (void) +import Control.Monad.IO.Class (liftIO) +import Data.String (IsString) +import qualified Data.Text as T +import Development.IDE (IdeState) +import Distribution.PackageDescription.Quirks (patchQuirks) +import Ide.PluginUtils (mkLspCommand) +import Ide.Types (CommandFunction, + CommandId (CommandId), + PluginId) +import Language.LSP.Protocol.Types (CodeAction (CodeAction), + CodeActionDisabled (CodeActionDisabled), + CodeActionKind (CodeActionKind_QuickFix), + Diagnostic (..), + Null (Null), Uri (..), + type (|?) (InR)) +import System.Directory (doesFileExist, + listDirectory) + +import Data.Aeson.Types (FromJSON, ToJSON, + toJSON) +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as B +import Data.List.NonEmpty (NonEmpty (..), + fromList) +import Distribution.Client.Add as Add +import Distribution.Compat.Prelude (Generic) +import Distribution.PackageDescription (packageDescription, + specVersion) +import System.FilePath (dropFileName, + splitPath, + takeExtension, ()) import Text.Regex.TDFA -import Data.Aeson.Types (toJSON, FromJSON, ToJSON) -import Debug.Trace -import Distribution.Compat.Prelude (Generic) -import Data.List.NonEmpty (NonEmpty (..), fromList) -import Distribution.Client.Add as Add -import Data.ByteString (ByteString) -import Data.ByteString.Char8 qualified as B -import Data.Maybe (fromJust) -import Distribution.PackageDescription ( - ComponentName, - GenericPackageDescription, - packageDescription, - specVersion, - ) findResponsibleCabalFile :: FilePath -> IO [FilePath] findResponsibleCabalFile uriPath = do @@ -65,82 +64,73 @@ findResponsibleCabalFile uriPath = do -- if a suggestion for a missing dependency is found. -- Disabled action if no cabal files given. missingDependenciesAction :: PluginId -> Int -> Uri -> Diagnostic -> [FilePath] -> [CodeAction] -missingDependenciesAction plId maxCompletions uri diag cabalFiles = +missingDependenciesAction plId maxCompletions _ diag cabalFiles = case cabalFiles of [] -> [CodeAction "No .cabal file found" (Just CodeActionKind_QuickFix) (Just []) Nothing (Just (CodeActionDisabled "No .cabal file found")) Nothing Nothing Nothing] (cabalFile:_) -> mkCodeAction cabalFile <$> missingDependenciesSuggestion maxCompletions (_message diag) where - mkCodeAction cabalFile suggestedDep = + mkCodeAction cabalFile (suggestedDep, suggestedVersion) = let - cabalName = T.pack $ takeFileName cabalFile - params = CabalAddCommandParams {cabalPath = cabalFile, dependency = suggestedDep} - title = "Add dependency " <> suggestedDep <> " at " <> cabalName <> " " <> (T.pack $ show params) - command = mkLspCommand plId (CommandId cabalAddCommand) "Execute Code Action" (Just [toJSON params]) -- TODO: add cabal-add CL arguments + versionTitle = if T.null suggestedVersion then T.empty else "version " <> suggestedVersion + title = "Add dependency " <> suggestedDep <> " " <> versionTitle + + version = if T.null suggestedVersion then Nothing else Just suggestedVersion + params = CabalAddCommandParams {cabalPath = cabalFile, dependency = suggestedDep, version=version} + command = mkLspCommand plId (CommandId cabalAddCommand) "Execute Code Action" (Just [toJSON params]) in CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing Nothing (Just command) Nothing -- | Gives a mentioned number of hidden packages given -- a specific error message -missingDependenciesSuggestion :: Int -> T.Text -> [T.Text] +missingDependenciesSuggestion :: Int -> T.Text -> [(T.Text, T.Text)] missingDependenciesSuggestion maxCompletions msg = take maxCompletions $ getMatch (msg =~ regex) where regex :: T.Text -- TODO: Support multiple packages suggestion - regex = "Could not load module \8216.*\8217.\nIt is a member of the hidden package \8216([a-z]+)[-]?[0-9\\.]*\8217" - getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> [T.Text] - getMatch (_, _, _, results) = results - -hiddenPackageAction - :: Int - -> Uri - -> Diagnostic - -> [CodeAction] + regex = "Could not load module \8216.*\8217.\nIt is a member of the hidden package \8216([a-z]+)[-]?([0-9\\.]*)\8217" + getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> [(T.Text, T.Text)] + getMatch (_, _, _, []) = [] + getMatch (_, _, _, [dependency]) = [(dependency, T.empty)] + getMatch (_, _, _, [dependency, version]) = [(dependency, version)] + getMatch (_, _, _, _) = error "Impossible pattern matching case" + + +hiddenPackageAction :: Int -> Uri -> Diagnostic -> [CodeAction] hiddenPackageAction = undefined hiddenPackageSuggestion :: Int -> T.Text -> [T.Text] -hiddenPackageSuggestion maxCompletions msg = take maxCompletions $ getMatch (msg =~ regex) - where - regex :: T.Text - regex = "It is a member of the package '.*'\nwhich is unusable due to missing dependencies:[\n ]*([:word:-.]*)" - getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> [T.Text] - getMatch (_, _, _, results) = results +hiddenPackageSuggestion maxCompletions msg = undefined cabalAddCommand :: IsString p => p cabalAddCommand = "cabalAdd" data CabalAddCommandParams = - CabalAddCommandParams { cabalPath :: FilePath + CabalAddCommandParams { cabalPath :: FilePath , dependency :: T.Text + , version :: Maybe T.Text } deriving (Generic, Show) deriving anyclass (FromJSON, ToJSON) command :: CommandFunction IdeState CabalAddCommandParams -command _ _ (CabalAddCommandParams {cabalPath = path, dependency = dep}) = do - traceShowM ("cabalPath ", path) - traceShowM ("dependency ", dep) - void $ liftIO $ addDependency path (fromList [T.unpack dep]) +command _ _ (CabalAddCommandParams {cabalPath = path, dependency = dep, version = mbVer}) = do + let specifiedDep = case mbVer of + Nothing -> dep + Just ver -> dep <> " ^>=" <> ver + void $ liftIO $ addDependency path (fromList [T.unpack specifiedDep]) pure $ InR Null -data RawConfig = RawConfig - { rcnfCabalFile :: !FilePath - , rcnfComponent :: !(Maybe String) - , rcnfDependencies :: !(NonEmpty String) - } - deriving (Show) - -readCabalFile :: FilePath -> IO (Maybe ByteString) +readCabalFile :: FilePath -> IO ByteString readCabalFile fileName = do cabalFileExists <- doesFileExist fileName if cabalFileExists - then Just . snd . patchQuirks <$> B.readFile fileName - else pure Nothing + then snd . patchQuirks <$> B.readFile fileName + else error ("Failed to read cabal file at " <> fileName) addDependency :: FilePath -> NonEmpty String -> IO () addDependency cabalFilePath dependency = do - let rcnfComponent = Nothing -- Just "component?" - - cnfOrigContents <- fromJust <$> readCabalFile cabalFilePath - let inputs :: Either _ _ = do + let rcnfComponent = Nothing + cnfOrigContents <- readCabalFile cabalFilePath + let inputs = do (fields, packDescr) <- parseCabalFile cabalFilePath cnfOrigContents -- ^ cabal path ^ cabal raw contents let specVer = specVersion $ packageDescription packDescr @@ -149,9 +139,9 @@ addDependency cabalFilePath dependency = do pure (fields, packDescr, cmp, deps) (cnfFields, origPackDescr, cnfComponent, cnfDependencies) <- case inputs of - Left err -> error err + Left err -> error err Right pair -> pure pair case executeConfig (validateChanges origPackDescr) (Config {..}) of Nothing -> error $ "Cannot extend build-depends in " ++ cabalFilePath - Just r -> B.writeFile cabalFilePath r \ No newline at end of file + Just r -> B.writeFile cabalFilePath r diff --git a/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal b/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal index 6a5863fb44..8c7e975217 100644 --- a/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal +++ b/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal @@ -8,5 +8,5 @@ executable hidden-package main-is: Main.hs hs-source-dirs: src ghc-options: -Wall - build-depends: base + build-depends: split ^>=0.2.5, base default-language: Haskell2010 From 2087b067c25a7c5ab4c1e1c9e7c52a8e601bdb30 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Fri, 12 Jul 2024 18:21:47 +0300 Subject: [PATCH 15/65] + docs --- .../src/Ide/Plugin/Cabal/CabalAdd.hs | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 67bd462942..184a1ac0a2 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -50,6 +50,10 @@ import System.FilePath (dropFileName, takeExtension, ()) import Text.Regex.TDFA + +-- | Given a path to a haskell file, finds all cabal files paths +-- sorted from the closest to the farthest. +-- Gives all found paths all the way to the root directory. findResponsibleCabalFile :: FilePath -> IO [FilePath] findResponsibleCabalFile uriPath = do contents <- mapM listDirectory allDirPaths @@ -119,6 +123,9 @@ command _ _ (CabalAddCommandParams {cabalPath = path, dependency = dep, version void $ liftIO $ addDependency path (fromList [T.unpack specifiedDep]) pure $ InR Null +-- | Gives cabal file's contents or throws error. +-- Inspired by @readCabalFile@ in cabal-add, +-- Distribution.Client.Main readCabalFile :: FilePath -> IO ByteString readCabalFile fileName = do cabalFileExists <- doesFileExist fileName @@ -126,6 +133,12 @@ readCabalFile fileName = do then snd . patchQuirks <$> B.readFile fileName else error ("Failed to read cabal file at " <> fileName) +-- | Constructs prerequisets for the @executeConfig@ +-- and runs it, given path to the cabal file and +-- a dependency message. +-- +-- Inspired by @main@ in cabal-add, +-- Distribution.Client.Main addDependency :: FilePath -> NonEmpty String -> IO () addDependency cabalFilePath dependency = do let rcnfComponent = Nothing From 980e4ede2279046792694bf949ff3d5d98586ff9 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Mon, 15 Jul 2024 12:43:52 +0300 Subject: [PATCH 16/65] + source-repository-package cabal-add --- cabal-add | 1 - cabal.project | 6 +++++- .../cabal-add-testdata/hidden-package/hidden-package.cabal | 2 +- 3 files changed, 6 insertions(+), 3 deletions(-) delete mode 160000 cabal-add diff --git a/cabal-add b/cabal-add deleted file mode 160000 index 8c004e2a43..0000000000 --- a/cabal-add +++ /dev/null @@ -1 +0,0 @@ -Subproject commit 8c004e2a4329232f9824425f5472b2d6d7958bbd diff --git a/cabal.project b/cabal.project index 07a94da56d..60fb14c812 100644 --- a/cabal.project +++ b/cabal.project @@ -6,7 +6,11 @@ packages: ./ghcide ./hls-plugin-api ./hls-test-utils - ./cabal-add + +source-repository-package + type: git + location: https://github.com/Bodigrim/cabal-add.git + tag: master index-state: 2024-06-29T00:00:00Z diff --git a/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal b/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal index 8c7e975217..6a5863fb44 100644 --- a/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal +++ b/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal @@ -8,5 +8,5 @@ executable hidden-package main-is: Main.hs hs-source-dirs: src ghc-options: -Wall - build-depends: split ^>=0.2.5, base + build-depends: base default-language: Haskell2010 From 01e33c8ce6775310ccb8b35dcfb4f0ac9ea2062f Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Mon, 15 Jul 2024 19:07:15 +0300 Subject: [PATCH 17/65] parsing comma --- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs | 5 +++-- .../missing-dependencies/missing-dependencies.cabal | 3 +-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 184a1ac0a2..dd393b642c 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -49,6 +49,7 @@ import System.FilePath (dropFileName, splitPath, takeExtension, ()) import Text.Regex.TDFA +import System.IO.Unsafe (unsafeInterleaveIO) -- | Given a path to a haskell file, finds all cabal files paths @@ -56,7 +57,7 @@ import Text.Regex.TDFA -- Gives all found paths all the way to the root directory. findResponsibleCabalFile :: FilePath -> IO [FilePath] findResponsibleCabalFile uriPath = do - contents <- mapM listDirectory allDirPaths + contents <- mapM (unsafeInterleaveIO . listDirectory) allDirPaths let filesWithPaths = concat $ zipWith (\path content -> map (path ) content) allDirPaths contents let cabalFiles = filter (\c -> takeExtension c == ".cabal") filesWithPaths pure $ reverse cabalFiles -- sorted from closest to the uriPath @@ -90,7 +91,7 @@ missingDependenciesSuggestion :: Int -> T.Text -> [(T.Text, T.Text)] missingDependenciesSuggestion maxCompletions msg = take maxCompletions $ getMatch (msg =~ regex) where regex :: T.Text -- TODO: Support multiple packages suggestion - regex = "Could not load module \8216.*\8217.\nIt is a member of the hidden package \8216([a-z]+)[-]?([0-9\\.]*)\8217" + regex = "Could not load module \8216.*\8217.\nIt is a member of the hidden package [\8216\\']([a-z]+)[-]?([0-9\\.]*)[\8217\\']" getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> [(T.Text, T.Text)] getMatch (_, _, _, []) = [] getMatch (_, _, _, [dependency]) = [(dependency, T.empty)] diff --git a/plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/missing-dependencies.cabal b/plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/missing-dependencies.cabal index 91bfc584ca..1309adbef3 100644 --- a/plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/missing-dependencies.cabal +++ b/plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/missing-dependencies.cabal @@ -8,6 +8,5 @@ executable missing-dependencies main-is: Main.hs hs-source-dirs: src ghc-options: -Wall - build-depends: - , split >=0.2.5 + build-depends: base default-language: Haskell2010 From c8cde85cfa2b9793c9025b3c4a074c5d6934ba65 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Wed, 17 Jul 2024 14:26:56 +0300 Subject: [PATCH 18/65] + build targets --- haskell-language-server.cabal | 1 + .../src/Ide/Plugin/Cabal/CabalAdd.hs | 36 +++++++++++++------ .../hidden-package/hidden-package.cabal | 2 +- 3 files changed, 28 insertions(+), 11 deletions(-) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 0df5f4342e..1ebdedfff9 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -274,6 +274,7 @@ library hls-cabal-plugin , cabal-add , process , aeson + , Cabal hs-source-dirs: plugins/hls-cabal-plugin/src diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index dd393b642c..6b8ba55097 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -16,7 +16,7 @@ module Ide.Plugin.Cabal.CabalAdd ) where -import Control.Monad (void) +import Control.Monad (void, filterM) import Control.Monad.IO.Class (liftIO) import Data.String (IsString) import qualified Data.Text as T @@ -44,13 +44,18 @@ import Data.List.NonEmpty (NonEmpty (..), import Distribution.Client.Add as Add import Distribution.Compat.Prelude (Generic) import Distribution.PackageDescription (packageDescription, - specVersion) + specVersion, GenericPackageDescription (GenericPackageDescription), showComponentName, componentNameRaw) import System.FilePath (dropFileName, splitPath, - takeExtension, ()) + takeExtension, (), takeFileName, dropExtension) import Text.Regex.TDFA -import System.IO.Unsafe (unsafeInterleaveIO) - +import System.IO.Unsafe (unsafeInterleaveIO) +import System.Directory (doesFileExist) +import Distribution.Simple.BuildTarget (readBuildTargets, buildTargetComponentName) +import Distribution.Verbosity (normal) +import Debug.Trace +import Distribution.PackageDescription.Configuration (flattenPackageDescription) +import Distribution.Types.ComponentName (componentNameStanza) -- | Given a path to a haskell file, finds all cabal files paths -- sorted from the closest to the farthest. @@ -58,8 +63,9 @@ import System.IO.Unsafe (unsafeInterleaveIO) findResponsibleCabalFile :: FilePath -> IO [FilePath] findResponsibleCabalFile uriPath = do contents <- mapM (unsafeInterleaveIO . listDirectory) allDirPaths - let filesWithPaths = concat $ zipWith (\path content -> map (path ) content) allDirPaths contents - let cabalFiles = filter (\c -> takeExtension c == ".cabal") filesWithPaths + let objectWithPaths = concat $ zipWith (\path content -> map (path ) content) allDirPaths contents + let objectCabalExtension = filter (\c -> takeExtension c == ".cabal") objectWithPaths + cabalFiles <- filterM (\c -> doesFileExist c) objectCabalExtension pure $ reverse cabalFiles -- sorted from closest to the uriPath where dirPath = dropFileName uriPath allDirPaths = scanl1 () (splitPath dirPath) @@ -142,11 +148,21 @@ readCabalFile fileName = do -- Distribution.Client.Main addDependency :: FilePath -> NonEmpty String -> IO () addDependency cabalFilePath dependency = do - let rcnfComponent = Nothing + cnfOrigContents <- readCabalFile cabalFilePath + + (fields, packDescr) <- case parseCabalFile cabalFilePath cnfOrigContents of + Left err -> error err + Right pair -> pure pair + + let cabalName = dropExtension $ takeFileName cabalFilePath + buildTargets <- readBuildTargets normal (flattenPackageDescription packDescr) [cabalName] + let inputs = do - (fields, packDescr) <- parseCabalFile cabalFilePath cnfOrigContents - -- ^ cabal path ^ cabal raw contents + let rcnfComponent = case buildTargets of + [] -> Nothing + (target:_) -> Just $ componentNameRaw $ buildTargetComponentName target + let specVer = specVersion $ packageDescription packDescr cmp <- resolveComponent cabalFilePath (fields, packDescr) rcnfComponent deps <- traverse (validateDependency specVer) dependency diff --git a/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal b/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal index 6a5863fb44..c03f0834a1 100644 --- a/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal +++ b/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal @@ -1,4 +1,4 @@ -cabal-version: 2.2 +cabal-version: 3.4 name: hidden-package version: 0.1.0.0 From 707316ba384d1eb340ea36899b14f9a18238a26d Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Wed, 17 Jul 2024 19:20:15 +0300 Subject: [PATCH 19/65] WIP resolve multiple targets --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 4 +- .../src/Ide/Plugin/Cabal/CabalAdd.hs | 83 +++++++++++-------- .../hidden-package/hidden-package.cabal | 5 ++ 3 files changed, 55 insertions(+), 37 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 72284f8fd9..3ab479b8eb 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -3,6 +3,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE PartialTypeSignatures #-} module Ide.Plugin.Cabal (descriptor, haskellFilesDescriptor, Log (..)) where @@ -334,7 +335,8 @@ cabalAddCodeAction recorder state plId (CodeActionParams _ _ (TextDocumentIdenti Nothing -> pure $ InL [] Just uriPath -> do cabalFiles <- liftIO $ CabalAdd.findResponsibleCabalFile uriPath - pure $ InL $ diags >>= (\diag -> fmap InR (CabalAdd.missingDependenciesAction plId maxCompls uri diag cabalFiles)) + actions <- liftIO $ mapM (\diag -> CabalAdd.hiddenPackageAction plId maxCompls uri diag cabalFiles) diags + pure $ InL $ fmap InR (concat actions) -- ---------------------------------------------------------------- -- Cabal file of Interest rules and global variable diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 6b8ba55097..b41ff2e7b2 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -8,8 +8,8 @@ module Ide.Plugin.Cabal.CabalAdd ( findResponsibleCabalFile - , missingDependenciesAction - , missingDependenciesSuggestion + , hiddenPackageAction + , hiddenPackageSuggestion , hiddenPackageAction , cabalAddCommand , command @@ -31,7 +31,7 @@ import Language.LSP.Protocol.Types (CodeAction (CodeAction) CodeActionKind (CodeActionKind_QuickFix), Diagnostic (..), Null (Null), Uri (..), - type (|?) (InR)) + type (|?) (InR), uriToFilePath) import System.Directory (doesFileExist, listDirectory) @@ -47,15 +47,16 @@ import Distribution.PackageDescription (packageDescription, specVersion, GenericPackageDescription (GenericPackageDescription), showComponentName, componentNameRaw) import System.FilePath (dropFileName, splitPath, - takeExtension, (), takeFileName, dropExtension) + takeExtension, (), takeFileName, dropExtension, makeRelative) import Text.Regex.TDFA import System.IO.Unsafe (unsafeInterleaveIO) import System.Directory (doesFileExist) -import Distribution.Simple.BuildTarget (readBuildTargets, buildTargetComponentName) -import Distribution.Verbosity (normal) +import Distribution.Simple.BuildTarget (readBuildTargets, buildTargetComponentName, BuildTarget) +import Distribution.Verbosity (normal, silent, verboseNoStderr) import Debug.Trace import Distribution.PackageDescription.Configuration (flattenPackageDescription) -import Distribution.Types.ComponentName (componentNameStanza) +import Distribution.Types.ComponentName (componentNameStanza, ComponentName) +import Data.Maybe (fromJust) -- | Given a path to a haskell file, finds all cabal files paths -- sorted from the closest to the farthest. @@ -74,27 +75,38 @@ findResponsibleCabalFile uriPath = do -- | Gives a code action that calls the command, -- if a suggestion for a missing dependency is found. -- Disabled action if no cabal files given. -missingDependenciesAction :: PluginId -> Int -> Uri -> Diagnostic -> [FilePath] -> [CodeAction] -missingDependenciesAction plId maxCompletions _ diag cabalFiles = +hiddenPackageAction :: PluginId -> Int -> Uri -> Diagnostic -> [FilePath] -> IO [CodeAction] +hiddenPackageAction plId maxCompletions uri diag cabalFiles = case cabalFiles of - [] -> [CodeAction "No .cabal file found" (Just CodeActionKind_QuickFix) (Just []) Nothing + [] -> pure [CodeAction "No .cabal file found" (Just CodeActionKind_QuickFix) (Just []) Nothing (Just (CodeActionDisabled "No .cabal file found")) Nothing Nothing Nothing] - (cabalFile:_) -> mkCodeAction cabalFile <$> missingDependenciesSuggestion maxCompletions (_message diag) + (cabalFile:_) -> do + buildTargets <- liftIO $ getBuildTargets cabalFile (fromJust $ uriToFilePath uri) + + case buildTargets of + [] -> pure $ mkCodeAction cabalFile Nothing <$> hiddenPackageSuggestion maxCompletions (_message diag) + targets -> pure $ concat [mkCodeAction cabalFile (Just $ buildTargetToStringRepr target) <$> + hiddenPackageSuggestion maxCompletions (_message diag) | target <- targets] where - mkCodeAction cabalFile (suggestedDep, suggestedVersion) = + buildTargetToStringRepr target = componentNameStanza $ buildTargetComponentName target + mkCodeAction cabalFile target (suggestedDep, suggestedVersion) = let - versionTitle = if T.null suggestedVersion then T.empty else "version " <> suggestedVersion - title = "Add dependency " <> suggestedDep <> " " <> versionTitle + versionTitle = if T.null suggestedVersion then T.empty else " version " <> suggestedVersion + targetTitle = case target of + Nothing -> T.empty + Just t -> " target " <> T.pack t + title = "Add dependency " <> suggestedDep <> versionTitle <> targetTitle version = if T.null suggestedVersion then Nothing else Just suggestedVersion - params = CabalAddCommandParams {cabalPath = cabalFile, dependency = suggestedDep, version=version} + + params = CabalAddCommandParams {cabalPath = cabalFile, buildTarget = target, dependency = suggestedDep, version=version} command = mkLspCommand plId (CommandId cabalAddCommand) "Execute Code Action" (Just [toJSON params]) in CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing Nothing (Just command) Nothing -- | Gives a mentioned number of hidden packages given -- a specific error message -missingDependenciesSuggestion :: Int -> T.Text -> [(T.Text, T.Text)] -missingDependenciesSuggestion maxCompletions msg = take maxCompletions $ getMatch (msg =~ regex) +hiddenPackageSuggestion :: Int -> T.Text -> [(T.Text, T.Text)] +hiddenPackageSuggestion maxCompletions msg = take maxCompletions $ getMatch (msg =~ regex) where regex :: T.Text -- TODO: Support multiple packages suggestion regex = "Could not load module \8216.*\8217.\nIt is a member of the hidden package [\8216\\']([a-z]+)[-]?([0-9\\.]*)[\8217\\']" @@ -105,17 +117,12 @@ missingDependenciesSuggestion maxCompletions msg = take maxCompletions $ getMatc getMatch (_, _, _, _) = error "Impossible pattern matching case" -hiddenPackageAction :: Int -> Uri -> Diagnostic -> [CodeAction] -hiddenPackageAction = undefined - -hiddenPackageSuggestion :: Int -> T.Text -> [T.Text] -hiddenPackageSuggestion maxCompletions msg = undefined - cabalAddCommand :: IsString p => p cabalAddCommand = "cabalAdd" data CabalAddCommandParams = CabalAddCommandParams { cabalPath :: FilePath + , buildTarget :: Maybe String , dependency :: T.Text , version :: Maybe T.Text } @@ -123,11 +130,11 @@ data CabalAddCommandParams = deriving anyclass (FromJSON, ToJSON) command :: CommandFunction IdeState CabalAddCommandParams -command _ _ (CabalAddCommandParams {cabalPath = path, dependency = dep, version = mbVer}) = do +command _ _ (CabalAddCommandParams {cabalPath = path, buildTarget = target, dependency = dep, version = mbVer}) = do let specifiedDep = case mbVer of Nothing -> dep Just ver -> dep <> " ^>=" <> ver - void $ liftIO $ addDependency path (fromList [T.unpack specifiedDep]) + void $ liftIO $ addDependency path target (fromList [T.unpack specifiedDep]) pure $ InR Null -- | Gives cabal file's contents or throws error. @@ -140,14 +147,24 @@ readCabalFile fileName = do then snd . patchQuirks <$> B.readFile fileName else error ("Failed to read cabal file at " <> fileName) +getBuildTargets :: FilePath -> FilePath -> IO [BuildTarget] +getBuildTargets cabalFilePath haskellFilePath = do + cabalContents <- readCabalFile cabalFilePath + (_, packDescr) <- case parseCabalFile cabalFilePath cabalContents of + Left err -> error err + Right pair -> pure pair + + let haskellFileRelativePath = makeRelative (dropFileName cabalFilePath) haskellFilePath + readBuildTargets (verboseNoStderr silent) (flattenPackageDescription packDescr) [haskellFileRelativePath] + + -- | Constructs prerequisets for the @executeConfig@ --- and runs it, given path to the cabal file and --- a dependency message. +-- and runs it, given path to the cabal file and a dependency message. -- -- Inspired by @main@ in cabal-add, -- Distribution.Client.Main -addDependency :: FilePath -> NonEmpty String -> IO () -addDependency cabalFilePath dependency = do +addDependency :: FilePath -> Maybe String -> NonEmpty String -> IO () +addDependency cabalFilePath buildTarget dependency = do cnfOrigContents <- readCabalFile cabalFilePath @@ -155,14 +172,8 @@ addDependency cabalFilePath dependency = do Left err -> error err Right pair -> pure pair - let cabalName = dropExtension $ takeFileName cabalFilePath - buildTargets <- readBuildTargets normal (flattenPackageDescription packDescr) [cabalName] - let inputs = do - let rcnfComponent = case buildTargets of - [] -> Nothing - (target:_) -> Just $ componentNameRaw $ buildTargetComponentName target - + let rcnfComponent = buildTarget let specVer = specVersion $ packageDescription packDescr cmp <- resolveComponent cabalFilePath (fields, packDescr) rcnfComponent deps <- traverse (validateDependency specVer) dependency diff --git a/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal b/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal index c03f0834a1..947a62987b 100644 --- a/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal +++ b/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal @@ -10,3 +10,8 @@ executable hidden-package ghc-options: -Wall build-depends: base default-language: Haskell2010 + + +library + build-depends: base >= 4 && < 5 + ghc-options: -Wall \ No newline at end of file From 5f1694b8d802a32cc1ab7993d49c6a8f16c34787 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Thu, 18 Jul 2024 15:51:29 +0300 Subject: [PATCH 20/65] resolve target, no multiple --- haskell-language-server.cabal | 1 + .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 2 - .../src/Ide/Plugin/Cabal/CabalAdd.hs | 98 ++++++++++--------- .../hidden-package/hidden-package.cabal | 2 +- 4 files changed, 54 insertions(+), 49 deletions(-) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 1ebdedfff9..34e58621a3 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -275,6 +275,7 @@ library hls-cabal-plugin , process , aeson , Cabal + , pretty hs-source-dirs: plugins/hls-cabal-plugin/src diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 3ab479b8eb..3c8a57fd23 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -3,7 +3,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE PartialTypeSignatures #-} module Ide.Plugin.Cabal (descriptor, haskellFilesDescriptor, Log (..)) where @@ -55,7 +54,6 @@ import Language.LSP.Protocol.Types import qualified Language.LSP.VFS as VFS import qualified Data.Text () -import Debug.Trace import qualified Ide.Plugin.Cabal.CabalAdd as CabalAdd data Log diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index b41ff2e7b2..4ea7d391e7 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -16,47 +16,53 @@ module Ide.Plugin.Cabal.CabalAdd ) where -import Control.Monad (void, filterM) -import Control.Monad.IO.Class (liftIO) -import Data.String (IsString) -import qualified Data.Text as T -import Development.IDE (IdeState) -import Distribution.PackageDescription.Quirks (patchQuirks) -import Ide.PluginUtils (mkLspCommand) -import Ide.Types (CommandFunction, - CommandId (CommandId), - PluginId) -import Language.LSP.Protocol.Types (CodeAction (CodeAction), - CodeActionDisabled (CodeActionDisabled), - CodeActionKind (CodeActionKind_QuickFix), - Diagnostic (..), - Null (Null), Uri (..), - type (|?) (InR), uriToFilePath) -import System.Directory (doesFileExist, - listDirectory) - -import Data.Aeson.Types (FromJSON, ToJSON, - toJSON) -import Data.ByteString (ByteString) -import qualified Data.ByteString.Char8 as B -import Data.List.NonEmpty (NonEmpty (..), - fromList) -import Distribution.Client.Add as Add -import Distribution.Compat.Prelude (Generic) -import Distribution.PackageDescription (packageDescription, - specVersion, GenericPackageDescription (GenericPackageDescription), showComponentName, componentNameRaw) -import System.FilePath (dropFileName, - splitPath, - takeExtension, (), takeFileName, dropExtension, makeRelative) +import Control.Monad (filterM, void) +import Control.Monad.IO.Class (liftIO) +import Data.String (IsString) +import qualified Data.Text as T +import Development.IDE (IdeState) +import Distribution.PackageDescription.Quirks (patchQuirks) +import Ide.PluginUtils (mkLspCommand) +import Ide.Types (CommandFunction, + CommandId (CommandId), + PluginId) +import Language.LSP.Protocol.Types (CodeAction (CodeAction), + CodeActionDisabled (CodeActionDisabled), + CodeActionKind (CodeActionKind_QuickFix), + Diagnostic (..), + Null (Null), + Uri (..), + type (|?) (InR), + uriToFilePath) +import System.Directory (doesFileExist, + listDirectory) + +import Data.Aeson.Types (FromJSON, + ToJSON, toJSON) +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as B +import Data.List.NonEmpty (NonEmpty (..), + fromList) +import Data.Maybe (fromJust) +import Distribution.Client.Add as Add +import Distribution.Compat.Prelude (Generic) +import Distribution.PackageDescription (packageDescription, + specVersion) +import Distribution.PackageDescription.Configuration (flattenPackageDescription) +import Distribution.Pretty (pretty) +import Distribution.Simple.BuildTarget (BuildTarget, + buildTargetComponentName, + readBuildTargets) +import Distribution.Verbosity (silent, + verboseNoStderr) +import System.FilePath (dropFileName, + makeRelative, + splitPath, + takeExtension, + ()) +import System.IO.Unsafe (unsafeInterleaveIO) +import Text.PrettyPrint (render) import Text.Regex.TDFA -import System.IO.Unsafe (unsafeInterleaveIO) -import System.Directory (doesFileExist) -import Distribution.Simple.BuildTarget (readBuildTargets, buildTargetComponentName, BuildTarget) -import Distribution.Verbosity (normal, silent, verboseNoStderr) -import Debug.Trace -import Distribution.PackageDescription.Configuration (flattenPackageDescription) -import Distribution.Types.ComponentName (componentNameStanza, ComponentName) -import Data.Maybe (fromJust) -- | Given a path to a haskell file, finds all cabal files paths -- sorted from the closest to the farthest. @@ -75,6 +81,7 @@ findResponsibleCabalFile uriPath = do -- | Gives a code action that calls the command, -- if a suggestion for a missing dependency is found. -- Disabled action if no cabal files given. +-- Conducts IO action on a cabal file to find build targets. hiddenPackageAction :: PluginId -> Int -> Uri -> Diagnostic -> [FilePath] -> IO [CodeAction] hiddenPackageAction plId maxCompletions uri diag cabalFiles = case cabalFiles of @@ -82,19 +89,18 @@ hiddenPackageAction plId maxCompletions uri diag cabalFiles = (Just (CodeActionDisabled "No .cabal file found")) Nothing Nothing Nothing] (cabalFile:_) -> do buildTargets <- liftIO $ getBuildTargets cabalFile (fromJust $ uriToFilePath uri) - case buildTargets of [] -> pure $ mkCodeAction cabalFile Nothing <$> hiddenPackageSuggestion maxCompletions (_message diag) targets -> pure $ concat [mkCodeAction cabalFile (Just $ buildTargetToStringRepr target) <$> hiddenPackageSuggestion maxCompletions (_message diag) | target <- targets] where - buildTargetToStringRepr target = componentNameStanza $ buildTargetComponentName target + buildTargetToStringRepr target = render $ pretty $ buildTargetComponentName target mkCodeAction cabalFile target (suggestedDep, suggestedVersion) = let versionTitle = if T.null suggestedVersion then T.empty else " version " <> suggestedVersion targetTitle = case target of Nothing -> T.empty - Just t -> " target " <> T.pack t + Just t -> " target " <> T.pack t title = "Add dependency " <> suggestedDep <> versionTitle <> targetTitle version = if T.null suggestedVersion then Nothing else Just suggestedVersion @@ -121,10 +127,10 @@ cabalAddCommand :: IsString p => p cabalAddCommand = "cabalAdd" data CabalAddCommandParams = - CabalAddCommandParams { cabalPath :: FilePath + CabalAddCommandParams { cabalPath :: FilePath , buildTarget :: Maybe String - , dependency :: T.Text - , version :: Maybe T.Text + , dependency :: T.Text + , version :: Maybe T.Text } deriving (Generic, Show) deriving anyclass (FromJSON, ToJSON) diff --git a/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal b/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal index 947a62987b..4fd505c962 100644 --- a/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal +++ b/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal @@ -12,6 +12,6 @@ executable hidden-package default-language: Haskell2010 -library +library hidden-package build-depends: base >= 4 && < 5 ghc-options: -Wall \ No newline at end of file From 419a48a6f6b68cc7918d249e7e781f8daac144b3 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Thu, 18 Jul 2024 21:57:46 +0300 Subject: [PATCH 21/65] rule usage, refactoring --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 25 ++++++++--- .../src/Ide/Plugin/Cabal/CabalAdd.hs | 43 ++++++++----------- .../hidden-package/hidden-package.cabal | 2 +- 3 files changed, 37 insertions(+), 33 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 3c8a57fd23..a4375f7b7c 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -55,6 +55,8 @@ import qualified Language.LSP.VFS as VFS import qualified Data.Text () import qualified Ide.Plugin.Cabal.CabalAdd as CabalAdd +import Debug.Trace +import Distribution.PackageDescription.Configuration (flattenPackageDescription) data Log = LogModificationTime NormalizedFilePath FileVersion @@ -328,13 +330,24 @@ gotoDefinition ideState _ msgParam = do cabalAddCodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction cabalAddCodeAction recorder state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do maxCompls <- fmap maxCompletions . liftIO $ runAction "cabal-plugin.cabalAdd" state getClientConfigAction - let mbUriPath = uriToFilePath uri - case mbUriPath of + + let mbHaskellFilePath = uriToFilePath uri + case mbHaskellFilePath of Nothing -> pure $ InL [] - Just uriPath -> do - cabalFiles <- liftIO $ CabalAdd.findResponsibleCabalFile uriPath - actions <- liftIO $ mapM (\diag -> CabalAdd.hiddenPackageAction plId maxCompls uri diag cabalFiles) diags - pure $ InL $ fmap InR (concat actions) + Just haskellFilePath -> do + cabalFiles <- liftIO $ CabalAdd.findResponsibleCabalFile haskellFilePath + case cabalFiles of + [] -> pure $ InL $ fmap InR [noCabalFileAction] + (cabalFilePath:_) -> do + mGPD <- liftIO $ runIdeAction "cabal-plugin.modulesCompleter.gpd" (shakeExtras state) $ useWithStaleFast ParseCabalFile $ toNormalizedFilePath (head cabalFiles) + case mGPD of + Nothing -> pure $ InL [] + Just (gpd, _) -> do + actions <- liftIO $ mapM (\diag -> CabalAdd.hiddenPackageAction plId maxCompls diag haskellFilePath cabalFilePath gpd) diags + pure $ InL $ fmap InR (concat actions) + where + noCabalFileAction = CodeAction "No .cabal file found" (Just CodeActionKind_QuickFix) (Just []) Nothing + (Just (CodeActionDisabled "No .cabal file found")) Nothing Nothing Nothing -- ---------------------------------------------------------------- -- Cabal file of Interest rules and global variable diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 4ea7d391e7..79d2273bd3 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -20,7 +20,7 @@ import Control.Monad (filterM, void) import Control.Monad.IO.Class (liftIO) import Data.String (IsString) import qualified Data.Text as T -import Development.IDE (IdeState) +import Development.IDE (IdeState, runIdeAction) import Distribution.PackageDescription.Quirks (patchQuirks) import Ide.PluginUtils (mkLspCommand) import Ide.Types (CommandFunction, @@ -47,7 +47,7 @@ import Data.Maybe (fromJust) import Distribution.Client.Add as Add import Distribution.Compat.Prelude (Generic) import Distribution.PackageDescription (packageDescription, - specVersion) + specVersion, GenericPackageDescription) import Distribution.PackageDescription.Configuration (flattenPackageDescription) import Distribution.Pretty (pretty) import Distribution.Simple.BuildTarget (BuildTarget, @@ -68,13 +68,13 @@ import Text.Regex.TDFA -- sorted from the closest to the farthest. -- Gives all found paths all the way to the root directory. findResponsibleCabalFile :: FilePath -> IO [FilePath] -findResponsibleCabalFile uriPath = do +findResponsibleCabalFile haskellFilePath = do contents <- mapM (unsafeInterleaveIO . listDirectory) allDirPaths let objectWithPaths = concat $ zipWith (\path content -> map (path ) content) allDirPaths contents let objectCabalExtension = filter (\c -> takeExtension c == ".cabal") objectWithPaths cabalFiles <- filterM (\c -> doesFileExist c) objectCabalExtension - pure $ reverse cabalFiles -- sorted from closest to the uriPath - where dirPath = dropFileName uriPath + pure $ reverse cabalFiles -- sorted from closest to the haskellFilePath + where dirPath = dropFileName haskellFilePath allDirPaths = scanl1 () (splitPath dirPath) @@ -82,20 +82,16 @@ findResponsibleCabalFile uriPath = do -- if a suggestion for a missing dependency is found. -- Disabled action if no cabal files given. -- Conducts IO action on a cabal file to find build targets. -hiddenPackageAction :: PluginId -> Int -> Uri -> Diagnostic -> [FilePath] -> IO [CodeAction] -hiddenPackageAction plId maxCompletions uri diag cabalFiles = - case cabalFiles of - [] -> pure [CodeAction "No .cabal file found" (Just CodeActionKind_QuickFix) (Just []) Nothing - (Just (CodeActionDisabled "No .cabal file found")) Nothing Nothing Nothing] - (cabalFile:_) -> do - buildTargets <- liftIO $ getBuildTargets cabalFile (fromJust $ uriToFilePath uri) - case buildTargets of - [] -> pure $ mkCodeAction cabalFile Nothing <$> hiddenPackageSuggestion maxCompletions (_message diag) - targets -> pure $ concat [mkCodeAction cabalFile (Just $ buildTargetToStringRepr target) <$> - hiddenPackageSuggestion maxCompletions (_message diag) | target <- targets] +hiddenPackageAction :: PluginId -> Int -> Diagnostic -> FilePath -> FilePath -> GenericPackageDescription -> IO [CodeAction] +hiddenPackageAction plId maxCompletions diag haskellFilePath cabalFilePath gpd = do + buildTargets <- liftIO $ getBuildTargets gpd cabalFilePath haskellFilePath + case buildTargets of + [] -> pure $ mkCodeAction cabalFilePath Nothing <$> hiddenPackageSuggestion maxCompletions (_message diag) + targets -> pure $ concat [mkCodeAction cabalFilePath (Just $ buildTargetToStringRepr target) <$> + hiddenPackageSuggestion maxCompletions (_message diag) | target <- targets] where buildTargetToStringRepr target = render $ pretty $ buildTargetComponentName target - mkCodeAction cabalFile target (suggestedDep, suggestedVersion) = + mkCodeAction cabalFilePath target (suggestedDep, suggestedVersion) = let versionTitle = if T.null suggestedVersion then T.empty else " version " <> suggestedVersion targetTitle = case target of @@ -105,7 +101,7 @@ hiddenPackageAction plId maxCompletions uri diag cabalFiles = version = if T.null suggestedVersion then Nothing else Just suggestedVersion - params = CabalAddCommandParams {cabalPath = cabalFile, buildTarget = target, dependency = suggestedDep, version=version} + params = CabalAddCommandParams {cabalPath = cabalFilePath, buildTarget = target, dependency = suggestedDep, version=version} command = mkLspCommand plId (CommandId cabalAddCommand) "Execute Code Action" (Just [toJSON params]) in CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing Nothing (Just command) Nothing @@ -153,15 +149,10 @@ readCabalFile fileName = do then snd . patchQuirks <$> B.readFile fileName else error ("Failed to read cabal file at " <> fileName) -getBuildTargets :: FilePath -> FilePath -> IO [BuildTarget] -getBuildTargets cabalFilePath haskellFilePath = do - cabalContents <- readCabalFile cabalFilePath - (_, packDescr) <- case parseCabalFile cabalFilePath cabalContents of - Left err -> error err - Right pair -> pure pair - +getBuildTargets :: GenericPackageDescription -> FilePath -> FilePath -> IO [BuildTarget] +getBuildTargets gpd cabalFilePath haskellFilePath = do let haskellFileRelativePath = makeRelative (dropFileName cabalFilePath) haskellFilePath - readBuildTargets (verboseNoStderr silent) (flattenPackageDescription packDescr) [haskellFileRelativePath] + readBuildTargets (verboseNoStderr silent) (flattenPackageDescription gpd) [haskellFileRelativePath] -- | Constructs prerequisets for the @executeConfig@ diff --git a/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal b/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal index 4fd505c962..947a62987b 100644 --- a/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal +++ b/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal @@ -12,6 +12,6 @@ executable hidden-package default-language: Haskell2010 -library hidden-package +library build-depends: base >= 4 && < 5 ghc-options: -Wall \ No newline at end of file From 397715151e1257c9ec5e55e83aad435488395df4 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Mon, 22 Jul 2024 15:13:10 +0300 Subject: [PATCH 22/65] better findResponsibleCabalFile --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 10 +++--- .../src/Ide/Plugin/Cabal/CabalAdd.hs | 36 ++++++++++--------- 2 files changed, 24 insertions(+), 22 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index a4375f7b7c..a842ec6700 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -335,11 +335,11 @@ cabalAddCodeAction recorder state plId (CodeActionParams _ _ (TextDocumentIdenti case mbHaskellFilePath of Nothing -> pure $ InL [] Just haskellFilePath -> do - cabalFiles <- liftIO $ CabalAdd.findResponsibleCabalFile haskellFilePath - case cabalFiles of - [] -> pure $ InL $ fmap InR [noCabalFileAction] - (cabalFilePath:_) -> do - mGPD <- liftIO $ runIdeAction "cabal-plugin.modulesCompleter.gpd" (shakeExtras state) $ useWithStaleFast ParseCabalFile $ toNormalizedFilePath (head cabalFiles) + mbCabalFile <- liftIO $ CabalAdd.findResponsibleCabalFile haskellFilePath + case mbCabalFile of + Nothing -> pure $ InL $ fmap InR [noCabalFileAction] + Just cabalFilePath -> do + mGPD <- liftIO $ runIdeAction "cabal-plugin.modulesCompleter.gpd" (shakeExtras state) $ useWithStaleFast ParseCabalFile $ toNormalizedFilePath cabalFilePath case mGPD of Nothing -> pure $ InL [] Just (gpd, _) -> do diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 79d2273bd3..9a9a021281 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -27,13 +27,10 @@ import Ide.Types (CommandFunction, CommandId (CommandId), PluginId) import Language.LSP.Protocol.Types (CodeAction (CodeAction), - CodeActionDisabled (CodeActionDisabled), CodeActionKind (CodeActionKind_QuickFix), Diagnostic (..), Null (Null), - Uri (..), - type (|?) (InR), - uriToFilePath) + type (|?) (InR)) import System.Directory (doesFileExist, listDirectory) @@ -43,7 +40,6 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B import Data.List.NonEmpty (NonEmpty (..), fromList) -import Data.Maybe (fromJust) import Distribution.Client.Add as Add import Distribution.Compat.Prelude (Generic) import Distribution.PackageDescription (packageDescription, @@ -60,22 +56,28 @@ import System.FilePath (dropFileName, splitPath, takeExtension, ()) -import System.IO.Unsafe (unsafeInterleaveIO) import Text.PrettyPrint (render) import Text.Regex.TDFA +import Distribution.Simple.Utils (safeHead) --- | Given a path to a haskell file, finds all cabal files paths --- sorted from the closest to the farthest. --- Gives all found paths all the way to the root directory. -findResponsibleCabalFile :: FilePath -> IO [FilePath] + +-- | Given a path to a haskell file, returns the closest cabal file. +-- If cabal file wasn't found, dives Nothing. +findResponsibleCabalFile :: FilePath -> IO (Maybe FilePath) findResponsibleCabalFile haskellFilePath = do - contents <- mapM (unsafeInterleaveIO . listDirectory) allDirPaths - let objectWithPaths = concat $ zipWith (\path content -> map (path ) content) allDirPaths contents - let objectCabalExtension = filter (\c -> takeExtension c == ".cabal") objectWithPaths - cabalFiles <- filterM (\c -> doesFileExist c) objectCabalExtension - pure $ reverse cabalFiles -- sorted from closest to the haskellFilePath - where dirPath = dropFileName haskellFilePath - allDirPaths = scanl1 () (splitPath dirPath) + let dirPath = dropFileName haskellFilePath + allDirPaths = reverse $ scanl1 () (splitPath dirPath) -- sorted from most to least specific + go allDirPaths + where + go [] = pure Nothing + go (path:ps) = do + objects <- listDirectory path + let objectsWithPaths = map (\obj -> path <> obj) objects + objectsCabalExtension = filter (\c -> takeExtension c == ".cabal") objectsWithPaths + cabalFiles <- filterM (\c -> doesFileExist c) objectsCabalExtension + case safeHead cabalFiles of + Nothing -> go ps + Just cabalFile -> pure $ Just cabalFile -- | Gives a code action that calls the command, From 1ad43562183cff64014d36bc7e7ea746732a50b5 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Mon, 22 Jul 2024 21:23:59 +0300 Subject: [PATCH 23/65] runAction data lookup --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 5 +- .../src/Ide/Plugin/Cabal/CabalAdd.hs | 48 ++++++++++++++----- 2 files changed, 37 insertions(+), 16 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index a842ec6700..329f70d55a 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -56,7 +56,6 @@ import qualified Language.LSP.VFS as VFS import qualified Data.Text () import qualified Ide.Plugin.Cabal.CabalAdd as CabalAdd import Debug.Trace -import Distribution.PackageDescription.Configuration (flattenPackageDescription) data Log = LogModificationTime NormalizedFilePath FileVersion @@ -329,7 +328,7 @@ gotoDefinition ideState _ msgParam = do cabalAddCodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction cabalAddCodeAction recorder state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do - maxCompls <- fmap maxCompletions . liftIO $ runAction "cabal-plugin.cabalAdd" state getClientConfigAction + maxCompls <- fmap maxCompletions . liftIO $ runAction "cabal.cabal-add" state getClientConfigAction let mbHaskellFilePath = uriToFilePath uri case mbHaskellFilePath of @@ -339,7 +338,7 @@ cabalAddCodeAction recorder state plId (CodeActionParams _ _ (TextDocumentIdenti case mbCabalFile of Nothing -> pure $ InL $ fmap InR [noCabalFileAction] Just cabalFilePath -> do - mGPD <- liftIO $ runIdeAction "cabal-plugin.modulesCompleter.gpd" (shakeExtras state) $ useWithStaleFast ParseCabalFile $ toNormalizedFilePath cabalFilePath + mGPD <- liftIO $ runAction "cabal.cabal-add" state $ useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath case mGPD of Nothing -> pure $ InL [] Just (gpd, _) -> do diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 9a9a021281..581069a1c8 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -20,7 +20,7 @@ import Control.Monad (filterM, void) import Control.Monad.IO.Class (liftIO) import Data.String (IsString) import qualified Data.Text as T -import Development.IDE (IdeState, runIdeAction) +import Development.IDE (IdeState (shakeExtras), runIdeAction, useWithStale) import Distribution.PackageDescription.Quirks (patchQuirks) import Ide.PluginUtils (mkLspCommand) import Ide.Types (CommandFunction, @@ -30,7 +30,7 @@ import Language.LSP.Protocol.Types (CodeAction (Code CodeActionKind (CodeActionKind_QuickFix), Diagnostic (..), Null (Null), - type (|?) (InR)) + type (|?) (InR), toNormalizedFilePath) import System.Directory (doesFileExist, listDirectory) @@ -43,7 +43,7 @@ import Data.List.NonEmpty (NonEmpty (..), import Distribution.Client.Add as Add import Distribution.Compat.Prelude (Generic) import Distribution.PackageDescription (packageDescription, - specVersion, GenericPackageDescription) + specVersion, GenericPackageDescription (GenericPackageDescription)) import Distribution.PackageDescription.Configuration (flattenPackageDescription) import Distribution.Pretty (pretty) import Distribution.Simple.BuildTarget (BuildTarget, @@ -59,7 +59,14 @@ import System.FilePath (dropFileName, import Text.PrettyPrint (render) import Text.Regex.TDFA import Distribution.Simple.Utils (safeHead) +import Development.IDE.Core.Rules (runAction) +import Ide.Plugin.Cabal.Completion.Types (ParseCabalFields (..), + ParseCabalFile (..)) +import Development.IDE.Core.RuleTypes (GetFileContents(..)) +import Data.Text.Encoding (encodeUtf8) +import Ide.Plugin.Cabal.Orphans () +import Distribution.Fields.Field (fieldAnn) -- | Given a path to a haskell file, returns the closest cabal file. -- If cabal file wasn't found, dives Nothing. @@ -134,11 +141,11 @@ data CabalAddCommandParams = deriving anyclass (FromJSON, ToJSON) command :: CommandFunction IdeState CabalAddCommandParams -command _ _ (CabalAddCommandParams {cabalPath = path, buildTarget = target, dependency = dep, version = mbVer}) = do +command state _ (CabalAddCommandParams {cabalPath = path, buildTarget = target, dependency = dep, version = mbVer}) = do let specifiedDep = case mbVer of Nothing -> dep Just ver -> dep <> " ^>=" <> ver - void $ liftIO $ addDependency path target (fromList [T.unpack specifiedDep]) + void $ liftIO $ addDependency state path target (fromList [T.unpack specifiedDep]) pure $ InR Null -- | Gives cabal file's contents or throws error. @@ -162,14 +169,29 @@ getBuildTargets gpd cabalFilePath haskellFilePath = do -- -- Inspired by @main@ in cabal-add, -- Distribution.Client.Main -addDependency :: FilePath -> Maybe String -> NonEmpty String -> IO () -addDependency cabalFilePath buildTarget dependency = do - - cnfOrigContents <- readCabalFile cabalFilePath - - (fields, packDescr) <- case parseCabalFile cabalFilePath cnfOrigContents of - Left err -> error err - Right pair -> pure pair +addDependency :: IdeState -> FilePath -> Maybe String -> NonEmpty String -> IO () +addDependency state cabalFilePath buildTarget dependency = do + (mbCnfOrigContents, mbFields, mbPackDescr) <- liftIO $ runAction "cabal.cabal-add" state $ do + contents <- useWithStale GetFileContents $ toNormalizedFilePath cabalFilePath + inFields <- useWithStale ParseCabalFields $ toNormalizedFilePath cabalFilePath + inPackDescr <- useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath + let mbCnfOrigContents = case snd . fst <$> contents of + Just (Just txt) -> Just $ encodeUtf8 txt + _ -> Nothing + let mbFields = fst <$> inFields + let mbPackDescr :: Maybe GenericPackageDescription = fst <$> inPackDescr + pure (mbCnfOrigContents, mbFields, mbPackDescr) + + (cnfOrigContents, fields, packDescr) <- liftIO $ do + cnfOrigContents <- case mbCnfOrigContents of + (Just cnfOrigContents) -> pure cnfOrigContents + Nothing -> readCabalFile cabalFilePath + let (fields, packDescr) = case (mbFields, mbPackDescr) of + (Just fields, Just packDescr) -> (fields, packDescr) + (_, _) -> case parseCabalFile cabalFilePath cnfOrigContents of + Left err -> error err + Right (_ ,gpd) -> pure gpd + pure (cnfOrigContents, fields, packDescr) let inputs = do let rcnfComponent = buildTarget From 68b9a640566f0d0ede955fdbab711544c4e6c3a7 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Sat, 27 Jul 2024 21:51:27 +0300 Subject: [PATCH 24/65] bugfix --- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 581069a1c8..bf5914edbd 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -120,7 +120,7 @@ hiddenPackageSuggestion :: Int -> T.Text -> [(T.Text, T.Text)] hiddenPackageSuggestion maxCompletions msg = take maxCompletions $ getMatch (msg =~ regex) where regex :: T.Text -- TODO: Support multiple packages suggestion - regex = "Could not load module \8216.*\8217.\nIt is a member of the hidden package [\8216\\']([a-z]+)[-]?([0-9\\.]*)[\8217\\']" + regex = "Could not load module \8216.*\8217.\nIt is a member of the hidden package [\8216']([a-z-]+)[-]?([0-9\\.]*)[\8217']" getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> [(T.Text, T.Text)] getMatch (_, _, _, []) = [] getMatch (_, _, _, [dependency]) = [(dependency, T.empty)] From f729147ffc55871d2548b36a291e12ab70279c45 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Mon, 29 Jul 2024 23:58:46 +0300 Subject: [PATCH 25/65] WIP tests --- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 1 - plugins/hls-cabal-plugin/test/Main.hs | 12 ++++++++++++ .../test/cabal-add-testdata/cabal.project | 1 - .../missing-dependencies/missing-dependencies.cabal | 12 ------------ .../missing-dependencies/src/Main.hs | 4 ---- .../missing-dependencies/src/Test.hs | 3 --- .../test/testdata/cabal-add-testdata/cabal.project | 1 + .../hidden-package/hidden-package.cabal | 0 .../cabal-add-testdata/hidden-package/src/Main.hs | 0 .../test/{ => testdata}/cabal-add-testdata/hie.yaml | 0 10 files changed, 13 insertions(+), 21 deletions(-) delete mode 100644 plugins/hls-cabal-plugin/test/cabal-add-testdata/cabal.project delete mode 100644 plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/missing-dependencies.cabal delete mode 100644 plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/src/Main.hs delete mode 100644 plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/src/Test.hs create mode 100644 plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal.project rename plugins/hls-cabal-plugin/test/{ => testdata}/cabal-add-testdata/hidden-package/hidden-package.cabal (100%) rename plugins/hls-cabal-plugin/test/{ => testdata}/cabal-add-testdata/hidden-package/src/Main.hs (100%) rename plugins/hls-cabal-plugin/test/{ => testdata}/cabal-add-testdata/hie.yaml (100%) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 329f70d55a..23606c1466 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -329,7 +329,6 @@ gotoDefinition ideState _ msgParam = do cabalAddCodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction cabalAddCodeAction recorder state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do maxCompls <- fmap maxCompletions . liftIO $ runAction "cabal.cabal-add" state getClientConfigAction - let mbHaskellFilePath = uriToFilePath uri case mbHaskellFilePath of Nothing -> pure $ InL [] diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 2009352bbd..4a6fbb5c8d 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -17,6 +17,7 @@ import Data.List.Extra (nubOrdOn) import qualified Data.Maybe as Maybe import qualified Data.Text as T import qualified Data.Text as Text +import qualified Data.Text.Internal.Search as Text import Ide.Plugin.Cabal.LicenseSuggest (licenseErrorSuggestion) import qualified Ide.Plugin.Cabal.Parse as Lib import qualified Language.LSP.Protocol.Lens as L @@ -222,6 +223,17 @@ codeActionTests = testGroup "Code Actions" ]) cas mapM_ executeCodeAction selectedCas pure () + , runCabalTestCaseSession "Code Actions - Can add hidden package" ("cabal-add-testdata" "hidden-package") $ do + doc <- openDoc ("src" "Main.hs") "haskell" + _ <- waitForDiagnosticsFromSource doc "haskell" + cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions doc + let selectedCas = nubOrdOn (^. L.title) $ filter + (\ca -> (ca ^. L.title) == "Add dependency") cas + mapM_ executeCodeAction selectedCas + + doc <- openDoc "hidden-package.cabal" "cabal" + contents <- documentContents doc + liftIO $ assertEqual "Split isn't found in the cabal file" (Text.indices "split" contents) [] ] where getLicenseAction :: T.Text -> [Command |? CodeAction] -> [CodeAction] diff --git a/plugins/hls-cabal-plugin/test/cabal-add-testdata/cabal.project b/plugins/hls-cabal-plugin/test/cabal-add-testdata/cabal.project deleted file mode 100644 index 125ed7aaf3..0000000000 --- a/plugins/hls-cabal-plugin/test/cabal-add-testdata/cabal.project +++ /dev/null @@ -1 +0,0 @@ -packages: hidden-package missing-dependencies \ No newline at end of file diff --git a/plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/missing-dependencies.cabal b/plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/missing-dependencies.cabal deleted file mode 100644 index 1309adbef3..0000000000 --- a/plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/missing-dependencies.cabal +++ /dev/null @@ -1,12 +0,0 @@ -cabal-version: 2.2 - -name: missing-dependencies -version: 0.1.0.0 -build-type: Simple - -executable missing-dependencies - main-is: Main.hs - hs-source-dirs: src - ghc-options: -Wall - build-depends: base - default-language: Haskell2010 diff --git a/plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/src/Main.hs b/plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/src/Main.hs deleted file mode 100644 index 8048024acb..0000000000 --- a/plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/src/Main.hs +++ /dev/null @@ -1,4 +0,0 @@ -module Main where - -import Data.List.Split -main = putStrLn "Hello, Haskell!" \ No newline at end of file diff --git a/plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/src/Test.hs b/plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/src/Test.hs deleted file mode 100644 index 68ab0a84d7..0000000000 --- a/plugins/hls-cabal-plugin/test/cabal-add-testdata/missing-dependencies/src/Test.hs +++ /dev/null @@ -1,3 +0,0 @@ -module Test where - -import Data.List.Split \ No newline at end of file diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal.project b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal.project new file mode 100644 index 0000000000..acae42d876 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal.project @@ -0,0 +1 @@ +packages: hidden-package \ No newline at end of file diff --git a/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package/hidden-package.cabal similarity index 100% rename from plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/hidden-package.cabal rename to plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package/hidden-package.cabal diff --git a/plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/src/Main.hs b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package/src/Main.hs similarity index 100% rename from plugins/hls-cabal-plugin/test/cabal-add-testdata/hidden-package/src/Main.hs rename to plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package/src/Main.hs diff --git a/plugins/hls-cabal-plugin/test/cabal-add-testdata/hie.yaml b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hie.yaml similarity index 100% rename from plugins/hls-cabal-plugin/test/cabal-add-testdata/hie.yaml rename to plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hie.yaml From d06fa2ef33e998e809afe0478aa8181c2d4f5cee Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Tue, 30 Jul 2024 22:18:52 +0300 Subject: [PATCH 26/65] WIP tests, ghcIdePlugin issue(?) --- haskell-language-server.cabal | 1 + plugins/hls-cabal-plugin/test/Main.hs | 16 +++++++++++++++- plugins/hls-cabal-plugin/test/Utils.hs | 12 ++++++++++++ 3 files changed, 28 insertions(+), 1 deletion(-) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 34e58621a3..fc0a53741b 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -303,6 +303,7 @@ test-suite hls-cabal-plugin-tests , lens , lsp-types , text + , hls-plugin-api ----------------------------- -- class plugin diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 4a6fbb5c8d..8188475ac5 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -27,6 +27,8 @@ import System.FilePath import Test.Hls import Utils +import Debug.Trace + main :: IO () main = do defaultTestRunner $ @@ -223,13 +225,25 @@ codeActionTests = testGroup "Code Actions" ]) cas mapM_ executeCodeAction selectedCas pure () - , runCabalTestCaseSession "Code Actions - Can add hidden package" ("cabal-add-testdata" "hidden-package") $ do + , runHaskellTestCaseSession "test that haskell files are read" ("cabal-add-testdata" "hidden-package") $ do doc <- openDoc ("src" "Main.hs") "haskell" + _ <- waitForDiagnosticsFromSource doc "haskell" cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions doc let selectedCas = nubOrdOn (^. L.title) $ filter (\ca -> (ca ^. L.title) == "Add dependency") cas mapM_ executeCodeAction selectedCas + liftIO $ assertEqual "Split isn't found in the cabal file" (show selectedCas) [] + , runCabalTestCaseSession "Code Actions - Can add hidden package" ("cabal-add-testdata" "hidden-package") $ do + _ <- liftIO $ runHaskellSession ("cabal-add-testdata" "hidden-package") $ do + doc <- openDoc ("src" "Main.hs") "haskell" + + _ <- waitForDiagnosticsFromSource doc "haskell" + cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions doc + let selectedCas = nubOrdOn (^. L.title) $ filter + (\ca -> (ca ^. L.title) == "Add dependency") cas + mapM_ executeCodeAction selectedCas + pure () doc <- openDoc "hidden-package.cabal" "cabal" contents <- documentContents doc diff --git a/plugins/hls-cabal-plugin/test/Utils.hs b/plugins/hls-cabal-plugin/test/Utils.hs index bcafa01fac..359c0fac2d 100644 --- a/plugins/hls-cabal-plugin/test/Utils.hs +++ b/plugins/hls-cabal-plugin/test/Utils.hs @@ -13,10 +13,15 @@ import qualified Ide.Plugin.Cabal import Ide.Plugin.Cabal.Completion.Types import System.FilePath import Test.Hls +import Ide.Types (defaultPluginDescriptor) + cabalPlugin :: PluginTestDescriptor Ide.Plugin.Cabal.Log cabalPlugin = mkPluginTestDescriptor descriptor "cabal" +ghcIdePlugin :: PluginTestDescriptor () +ghcIdePlugin = mkPluginTestDescriptor (\_ pid -> defaultPluginDescriptor pid "ghcIdeTestPlugin") "core" + simpleCabalPrefixInfoFromPos :: Position -> T.Text -> CabalPrefixInfo simpleCabalPrefixInfoFromPos pos prefix = CabalPrefixInfo @@ -45,10 +50,17 @@ filePathComplTestDir = addTrailingPathSeparator $ testDataDir "filepath-comp runCabalTestCaseSession :: TestName -> FilePath -> Session () -> TestTree runCabalTestCaseSession title subdir = testCase title . runCabalSession subdir +runHaskellTestCaseSession :: TestName -> FilePath -> Session () -> TestTree +runHaskellTestCaseSession title subdir = testCase title . runHaskellSession subdir + runCabalSession :: FilePath -> Session a -> IO a runCabalSession subdir = failIfSessionTimeout . runSessionWithServer def cabalPlugin (testDataDir subdir) +runHaskellSession :: FilePath -> Session a -> IO a +runHaskellSession subdir = + failIfSessionTimeout . runSessionWithServer def ghcIdePlugin (testDataDir subdir) + runCabalGoldenSession :: TestName -> FilePath -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree runCabalGoldenSession title subdir fp act = goldenWithCabalDoc def cabalPlugin title testDataDir (subdir fp) "golden" "cabal" act From fca76cba303454f63cb91befb25abdbd7ff502e0 Mon Sep 17 00:00:00 2001 From: Fendor Date: Wed, 31 Jul 2024 13:50:23 +0200 Subject: [PATCH 27/65] WIP: make tests fail for good reason --- plugins/hls-cabal-plugin/test/Main.hs | 25 +++++++++---------- plugins/hls-cabal-plugin/test/Utils.hs | 15 ++++++----- .../hidden-package/hidden-package.cabal | 4 +-- 3 files changed, 21 insertions(+), 23 deletions(-) diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 8188475ac5..953265c3a0 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -226,24 +226,23 @@ codeActionTests = testGroup "Code Actions" mapM_ executeCodeAction selectedCas pure () , runHaskellTestCaseSession "test that haskell files are read" ("cabal-add-testdata" "hidden-package") $ do - doc <- openDoc ("src" "Main.hs") "haskell" + hsDoc <- openDoc ("src" "Main.hs") "haskell" - _ <- waitForDiagnosticsFromSource doc "haskell" - cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions doc + diags <- waitForDiagnosticsFrom hsDoc + traceShowM ("Diags", diags) + cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions hsDoc + traceShowM ("Code ACtions", cas) let selectedCas = nubOrdOn (^. L.title) $ filter (\ca -> (ca ^. L.title) == "Add dependency") cas mapM_ executeCodeAction selectedCas liftIO $ assertEqual "Split isn't found in the cabal file" (show selectedCas) [] - , runCabalTestCaseSession "Code Actions - Can add hidden package" ("cabal-add-testdata" "hidden-package") $ do - _ <- liftIO $ runHaskellSession ("cabal-add-testdata" "hidden-package") $ do - doc <- openDoc ("src" "Main.hs") "haskell" - - _ <- waitForDiagnosticsFromSource doc "haskell" - cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions doc - let selectedCas = nubOrdOn (^. L.title) $ filter - (\ca -> (ca ^. L.title) == "Add dependency") cas - mapM_ executeCodeAction selectedCas - pure () + , runHaskellTestCaseSession "Code Actions - Can add hidden package" ("cabal-add-testdata" "hidden-package") $ do + hsdoc <- openDoc ("src" "Main.hs") "haskell" + _ <- waitForDiagnosticsFrom hsdoc + cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions hsdoc + let selectedCas = nubOrdOn (^. L.title) $ filter + (\ca -> (ca ^. L.title) == "Add dependency") cas + mapM_ executeCodeAction selectedCas doc <- openDoc "hidden-package.cabal" "cabal" contents <- documentContents doc diff --git a/plugins/hls-cabal-plugin/test/Utils.hs b/plugins/hls-cabal-plugin/test/Utils.hs index 359c0fac2d..37f6d37d58 100644 --- a/plugins/hls-cabal-plugin/test/Utils.hs +++ b/plugins/hls-cabal-plugin/test/Utils.hs @@ -8,19 +8,18 @@ import Control.Monad (guard) import Data.List (sort) import Data.Proxy (Proxy (Proxy)) import qualified Data.Text as T -import Ide.Plugin.Cabal (descriptor) +import Ide.Plugin.Cabal (descriptor, haskellFilesDescriptor) import qualified Ide.Plugin.Cabal import Ide.Plugin.Cabal.Completion.Types import System.FilePath import Test.Hls -import Ide.Types (defaultPluginDescriptor) cabalPlugin :: PluginTestDescriptor Ide.Plugin.Cabal.Log cabalPlugin = mkPluginTestDescriptor descriptor "cabal" -ghcIdePlugin :: PluginTestDescriptor () -ghcIdePlugin = mkPluginTestDescriptor (\_ pid -> defaultPluginDescriptor pid "ghcIdeTestPlugin") "core" +cabalHaskellPlugin :: PluginTestDescriptor Ide.Plugin.Cabal.Log +cabalHaskellPlugin = mkPluginTestDescriptor haskellFilesDescriptor "cabal-haskell" simpleCabalPrefixInfoFromPos :: Position -> T.Text -> CabalPrefixInfo simpleCabalPrefixInfoFromPos pos prefix = @@ -51,15 +50,15 @@ runCabalTestCaseSession :: TestName -> FilePath -> Session () -> TestTree runCabalTestCaseSession title subdir = testCase title . runCabalSession subdir runHaskellTestCaseSession :: TestName -> FilePath -> Session () -> TestTree -runHaskellTestCaseSession title subdir = testCase title . runHaskellSession subdir +runHaskellTestCaseSession title subdir = testCase title . runHaskellAndCabalSession subdir runCabalSession :: FilePath -> Session a -> IO a runCabalSession subdir = failIfSessionTimeout . runSessionWithServer def cabalPlugin (testDataDir subdir) -runHaskellSession :: FilePath -> Session a -> IO a -runHaskellSession subdir = - failIfSessionTimeout . runSessionWithServer def ghcIdePlugin (testDataDir subdir) +runHaskellAndCabalSession :: FilePath -> Session a -> IO a +runHaskellAndCabalSession subdir = + failIfSessionTimeout . runSessionWithServer def (cabalPlugin <> cabalHaskellPlugin) (testDataDir subdir) runCabalGoldenSession :: TestName -> FilePath -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree runCabalGoldenSession title subdir fp act = goldenWithCabalDoc def cabalPlugin title testDataDir (subdir fp) "golden" "cabal" act diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package/hidden-package.cabal b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package/hidden-package.cabal index 947a62987b..89d4a29fd4 100644 --- a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package/hidden-package.cabal +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package/hidden-package.cabal @@ -1,4 +1,4 @@ -cabal-version: 3.4 +cabal-version: 2.4 name: hidden-package version: 0.1.0.0 @@ -14,4 +14,4 @@ executable hidden-package library build-depends: base >= 4 && < 5 - ghc-options: -Wall \ No newline at end of file + ghc-options: -Wall From 260d333bccbbafec973bc544aae54bbb6a07e8cc Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Wed, 31 Jul 2024 18:03:10 +0300 Subject: [PATCH 28/65] WIP tests, succesfull CodeAction call --- .../src/Ide/Plugin/Cabal/CabalAdd.hs | 5 +++-- plugins/hls-cabal-plugin/test/Main.hs | 16 ++-------------- 2 files changed, 5 insertions(+), 16 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index bf5914edbd..7101ab1470 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -120,11 +120,12 @@ hiddenPackageSuggestion :: Int -> T.Text -> [(T.Text, T.Text)] hiddenPackageSuggestion maxCompletions msg = take maxCompletions $ getMatch (msg =~ regex) where regex :: T.Text -- TODO: Support multiple packages suggestion - regex = "Could not load module \8216.*\8217.\nIt is a member of the hidden package [\8216']([a-z-]+)[-]?([0-9\\.]*)[\8217']" + regex = "It is a member of the hidden package [\8216']([a-z-]+)(-([0-9\\.]*))?[\8217']" getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> [(T.Text, T.Text)] getMatch (_, _, _, []) = [] getMatch (_, _, _, [dependency]) = [(dependency, T.empty)] - getMatch (_, _, _, [dependency, version]) = [(dependency, version)] + getMatch (_, _, _, [dependency, dashedVersion]) = [(dependency, T.empty)] -- failed to get version + getMatch (_, _, _, [dependency, dashedVersion, cleanVersion]) = [(dependency, cleanVersion)] getMatch (_, _, _, _) = error "Impossible pattern matching case" diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 953265c3a0..050162c01e 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -225,28 +225,16 @@ codeActionTests = testGroup "Code Actions" ]) cas mapM_ executeCodeAction selectedCas pure () - , runHaskellTestCaseSession "test that haskell files are read" ("cabal-add-testdata" "hidden-package") $ do - hsDoc <- openDoc ("src" "Main.hs") "haskell" - - diags <- waitForDiagnosticsFrom hsDoc - traceShowM ("Diags", diags) - cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions hsDoc - traceShowM ("Code ACtions", cas) - let selectedCas = nubOrdOn (^. L.title) $ filter - (\ca -> (ca ^. L.title) == "Add dependency") cas - mapM_ executeCodeAction selectedCas - liftIO $ assertEqual "Split isn't found in the cabal file" (show selectedCas) [] , runHaskellTestCaseSession "Code Actions - Can add hidden package" ("cabal-add-testdata" "hidden-package") $ do hsdoc <- openDoc ("src" "Main.hs") "haskell" _ <- waitForDiagnosticsFrom hsdoc cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions hsdoc - let selectedCas = nubOrdOn (^. L.title) $ filter - (\ca -> (ca ^. L.title) == "Add dependency") cas + let selectedCas = filter (\ca -> "Add dependency" `T.isPrefixOf` (ca ^. L.title)) cas mapM_ executeCodeAction selectedCas doc <- openDoc "hidden-package.cabal" "cabal" contents <- documentContents doc - liftIO $ assertEqual "Split isn't found in the cabal file" (Text.indices "split" contents) [] + liftIO $ assertEqual "Split isn't found in the cabal file" (Text.indices "split" contents) [256] ] where getLicenseAction :: T.Text -> [Command |? CodeAction] -> [CodeAction] From 7258ea06f652ca2ba9dfe5bc69c94509e324cad0 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Thu, 1 Aug 2024 15:34:49 +0300 Subject: [PATCH 29/65] WIP from writeFile to edit --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 5 ++- .../src/Ide/Plugin/Cabal/CabalAdd.hs | 39 +++++++++++++------ plugins/hls-cabal-plugin/test/Main.hs | 6 ++- 3 files changed, 34 insertions(+), 16 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 23606c1466..b4897872f1 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -327,7 +327,7 @@ gotoDefinition ideState _ msgParam = do isSectionArgName _ _ = False cabalAddCodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction -cabalAddCodeAction recorder state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do +cabalAddCodeAction recorder state plId (CodeActionParams _ _ docId@(TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do maxCompls <- fmap maxCompletions . liftIO $ runAction "cabal.cabal-add" state getClientConfigAction let mbHaskellFilePath = uriToFilePath uri case mbHaskellFilePath of @@ -337,11 +337,12 @@ cabalAddCodeAction recorder state plId (CodeActionParams _ _ (TextDocumentIdenti case mbCabalFile of Nothing -> pure $ InL $ fmap InR [noCabalFileAction] Just cabalFilePath -> do + verTxtDocId <- lift $ pluginGetVersionedTextDoc $ TextDocumentIdentifier (filePathToUri cabalFilePath) mGPD <- liftIO $ runAction "cabal.cabal-add" state $ useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath case mGPD of Nothing -> pure $ InL [] Just (gpd, _) -> do - actions <- liftIO $ mapM (\diag -> CabalAdd.hiddenPackageAction plId maxCompls diag haskellFilePath cabalFilePath gpd) diags + actions <- liftIO $ mapM (\diag -> CabalAdd.hiddenPackageAction plId verTxtDocId maxCompls diag haskellFilePath cabalFilePath gpd) diags pure $ InL $ fmap InR (concat actions) where noCabalFileAction = CodeAction "No .cabal file found" (Just CodeActionKind_QuickFix) (Just []) Nothing diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 7101ab1470..a7bffaae02 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -10,7 +10,6 @@ module Ide.Plugin.Cabal.CabalAdd ( findResponsibleCabalFile , hiddenPackageAction , hiddenPackageSuggestion - , hiddenPackageAction , cabalAddCommand , command ) @@ -20,17 +19,18 @@ import Control.Monad (filterM, void) import Control.Monad.IO.Class (liftIO) import Data.String (IsString) import qualified Data.Text as T +import qualified Data.Text.Encoding as T import Development.IDE (IdeState (shakeExtras), runIdeAction, useWithStale) import Distribution.PackageDescription.Quirks (patchQuirks) -import Ide.PluginUtils (mkLspCommand) +import Ide.PluginUtils ( mkLspCommand, WithDeletions(SkipDeletions), diffText ) import Ide.Types (CommandFunction, CommandId (CommandId), - PluginId) + PluginId, pluginGetClientCapabilities, pluginSendRequest) import Language.LSP.Protocol.Types (CodeAction (CodeAction), CodeActionKind (CodeActionKind_QuickFix), Diagnostic (..), Null (Null), - type (|?) (InR), toNormalizedFilePath) + type (|?) (InR), toNormalizedFilePath, TextDocumentIdentifier, VersionedTextDocumentIdentifier, ClientCapabilities, WorkspaceFoldersServerCapabilities, WorkspaceEdit, ApplyWorkspaceEditParams (ApplyWorkspaceEditParams)) import System.Directory (doesFileExist, listDirectory) @@ -67,6 +67,9 @@ import Development.IDE.Core.RuleTypes (GetFileContents(..)) import Data.Text.Encoding (encodeUtf8) import Ide.Plugin.Cabal.Orphans () import Distribution.Fields.Field (fieldAnn) +import Control.Monad.Trans.Class (lift) +import Language.LSP.Protocol.Message (SMethod (SMethod_WorkspaceApplyEdit)) +import Debug.Trace -- | Given a path to a haskell file, returns the closest cabal file. -- If cabal file wasn't found, dives Nothing. @@ -91,8 +94,8 @@ findResponsibleCabalFile haskellFilePath = do -- if a suggestion for a missing dependency is found. -- Disabled action if no cabal files given. -- Conducts IO action on a cabal file to find build targets. -hiddenPackageAction :: PluginId -> Int -> Diagnostic -> FilePath -> FilePath -> GenericPackageDescription -> IO [CodeAction] -hiddenPackageAction plId maxCompletions diag haskellFilePath cabalFilePath gpd = do +hiddenPackageAction :: PluginId -> VersionedTextDocumentIdentifier -> Int -> Diagnostic -> FilePath -> FilePath -> GenericPackageDescription -> IO [CodeAction] +hiddenPackageAction plId verTxtDocId maxCompletions diag haskellFilePath cabalFilePath gpd = do buildTargets <- liftIO $ getBuildTargets gpd cabalFilePath haskellFilePath case buildTargets of [] -> pure $ mkCodeAction cabalFilePath Nothing <$> hiddenPackageSuggestion maxCompletions (_message diag) @@ -110,7 +113,11 @@ hiddenPackageAction plId maxCompletions diag haskellFilePath cabalFilePath gpd = version = if T.null suggestedVersion then Nothing else Just suggestedVersion - params = CabalAddCommandParams {cabalPath = cabalFilePath, buildTarget = target, dependency = suggestedDep, version=version} + params = CabalAddCommandParams {cabalPath = cabalFilePath + , verTxtDocId = verTxtDocId + , buildTarget = target + , dependency = suggestedDep + , version=version} command = mkLspCommand plId (CommandId cabalAddCommand) "Execute Code Action" (Just [toJSON params]) in CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing Nothing (Just command) Nothing @@ -134,6 +141,7 @@ cabalAddCommand = "cabalAdd" data CabalAddCommandParams = CabalAddCommandParams { cabalPath :: FilePath + , verTxtDocId :: VersionedTextDocumentIdentifier , buildTarget :: Maybe String , dependency :: T.Text , version :: Maybe T.Text @@ -142,13 +150,17 @@ data CabalAddCommandParams = deriving anyclass (FromJSON, ToJSON) command :: CommandFunction IdeState CabalAddCommandParams -command state _ (CabalAddCommandParams {cabalPath = path, buildTarget = target, dependency = dep, version = mbVer}) = do +command state _ (CabalAddCommandParams {cabalPath = path, verTxtDocId = verTxtDocId, buildTarget = target, dependency = dep, version = mbVer}) = do let specifiedDep = case mbVer of Nothing -> dep Just ver -> dep <> " ^>=" <> ver - void $ liftIO $ addDependency state path target (fromList [T.unpack specifiedDep]) + caps <- lift pluginGetClientCapabilities + let env = (state, caps, verTxtDocId) + edit <- liftIO $ getDependencyEdit env path target (fromList [T.unpack specifiedDep]) + void $ lift $ pluginSendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (\_ -> pure ()) pure $ InR Null + -- | Gives cabal file's contents or throws error. -- Inspired by @readCabalFile@ in cabal-add, -- Distribution.Client.Main @@ -170,8 +182,9 @@ getBuildTargets gpd cabalFilePath haskellFilePath = do -- -- Inspired by @main@ in cabal-add, -- Distribution.Client.Main -addDependency :: IdeState -> FilePath -> Maybe String -> NonEmpty String -> IO () -addDependency state cabalFilePath buildTarget dependency = do +getDependencyEdit :: (IdeState, ClientCapabilities, VersionedTextDocumentIdentifier) -> FilePath -> Maybe String -> NonEmpty String -> IO(WorkspaceEdit) +getDependencyEdit env cabalFilePath buildTarget dependency = do + let (state, caps, verTxtDocId) = env (mbCnfOrigContents, mbFields, mbPackDescr) <- liftIO $ runAction "cabal.cabal-add" state $ do contents <- useWithStale GetFileContents $ toNormalizedFilePath cabalFilePath inFields <- useWithStale ParseCabalFields $ toNormalizedFilePath cabalFilePath @@ -207,4 +220,6 @@ addDependency state cabalFilePath buildTarget dependency = do case executeConfig (validateChanges origPackDescr) (Config {..}) of Nothing -> error $ "Cannot extend build-depends in " ++ cabalFilePath - Just r -> B.writeFile cabalFilePath r + Just newContents -> do + let edit = diffText caps (verTxtDocId, T.decodeUtf8 cnfOrigContents) (T.decodeUtf8 newContents) SkipDeletions + pure edit diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 050162c01e..f81070f4d5 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -230,10 +230,12 @@ codeActionTests = testGroup "Code Actions" _ <- waitForDiagnosticsFrom hsdoc cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions hsdoc let selectedCas = filter (\ca -> "Add dependency" `T.isPrefixOf` (ca ^. L.title)) cas + traceShowM("selectedCas", selectedCas) mapM_ executeCodeAction selectedCas - doc <- openDoc "hidden-package.cabal" "cabal" - contents <- documentContents doc + cabDoc <- openDoc "hidden-package.cabal" "cabal" + contents <- documentContents cabDoc + traceShowM("contents", contents) liftIO $ assertEqual "Split isn't found in the cabal file" (Text.indices "split" contents) [256] ] where From 497b1fcbb790c49b96187f3202352d22b69ee2a4 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Sun, 4 Aug 2024 00:10:23 +0300 Subject: [PATCH 30/65] WIP logging prototype --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 12 ++++- .../src/Ide/Plugin/Cabal/CabalAdd.hs | 46 +++++++++++++++---- plugins/hls-cabal-plugin/test/Main.hs | 4 +- 3 files changed, 50 insertions(+), 12 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index b4897872f1..51b2559557 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -67,6 +67,7 @@ data Log | LogFOI (HashMap NormalizedFilePath FileOfInterestStatus) | LogCompletionContext Types.Context Position | LogCompletions Types.Log + | LogCabalAdd CabalAdd.Log deriving (Show) instance Pretty Log where @@ -90,6 +91,7 @@ instance Pretty Log where <+> "for cursor position:" <+> pretty position LogCompletions logs -> pretty logs + LogCabalAdd logs -> pretty logs haskellFilesDescriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState @@ -99,10 +101,13 @@ haskellFilesDescriptor recorder plId = mconcat [ mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ cabalAddCodeAction recorder ] - , pluginCommands = [PluginCommand CabalAdd.cabalAddCommand "add a dependency to a cabal file" CabalAdd.command] + , pluginCommands = [PluginCommand CabalAdd.cabalAddCommand "add a dependency to a cabal file" (CabalAdd.command cabalAddRecorder)] , pluginRules = pure () -- TODO: change to haskell files only (?) , pluginNotificationHandlers = mempty } + where + cabalAddRecorder = cmapWithPrio LogCabalAdd recorder + descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState descriptor recorder plId = @@ -342,11 +347,14 @@ cabalAddCodeAction recorder state plId (CodeActionParams _ _ docId@(TextDocument case mGPD of Nothing -> pure $ InL [] Just (gpd, _) -> do - actions <- liftIO $ mapM (\diag -> CabalAdd.hiddenPackageAction plId verTxtDocId maxCompls diag haskellFilePath cabalFilePath gpd) diags + actions <- liftIO $ mapM (\diag -> CabalAdd.hiddenPackageAction cabalAddRecorder plId verTxtDocId + maxCompls diag haskellFilePath cabalFilePath gpd) diags pure $ InL $ fmap InR (concat actions) where noCabalFileAction = CodeAction "No .cabal file found" (Just CodeActionKind_QuickFix) (Just []) Nothing (Just (CodeActionDisabled "No .cabal file found")) Nothing Nothing Nothing + cabalAddRecorder = cmapWithPrio LogCabalAdd recorder + -- ---------------------------------------------------------------- -- Cabal file of Interest rules and global variable diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index a7bffaae02..905d2bfc7f 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -5,6 +5,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE LambdaCase #-} module Ide.Plugin.Cabal.CabalAdd ( findResponsibleCabalFile @@ -12,6 +13,7 @@ module Ide.Plugin.Cabal.CabalAdd , hiddenPackageSuggestion , cabalAddCommand , command + , Log ) where @@ -70,6 +72,23 @@ import Distribution.Fields.Field (fieldAnn) import Control.Monad.Trans.Class (lift) import Language.LSP.Protocol.Message (SMethod (SMethod_WorkspaceApplyEdit)) import Debug.Trace +import qualified Ide.Logger as Logger + +data Log + = LogFoundResponsibleCabalFile FilePath + | LogCalledCabalAddCodeAction + | LogCalledCabalAddCommand CabalAddCommandParams + | LogCreatedEdit WorkspaceEdit + | LogExecutedCommand + deriving (Show) + +instance Logger.Pretty Log where + pretty = \case + LogFoundResponsibleCabalFile fp -> "Located the responsible cabal file at " Logger.<+> Logger.pretty fp + LogCalledCabalAddCodeAction -> "The CabalAdd CodeAction is called" + LogCalledCabalAddCommand params -> "Called CabalAdd command with:\n" Logger.<+> Logger.pretty params + LogCreatedEdit edit -> "Created inplace edit:\n" Logger.<+> Logger.pretty edit + LogExecutedCommand -> "Executed CabalAdd command" -- | Given a path to a haskell file, returns the closest cabal file. -- If cabal file wasn't found, dives Nothing. @@ -94,9 +113,10 @@ findResponsibleCabalFile haskellFilePath = do -- if a suggestion for a missing dependency is found. -- Disabled action if no cabal files given. -- Conducts IO action on a cabal file to find build targets. -hiddenPackageAction :: PluginId -> VersionedTextDocumentIdentifier -> Int -> Diagnostic -> FilePath -> FilePath -> GenericPackageDescription -> IO [CodeAction] -hiddenPackageAction plId verTxtDocId maxCompletions diag haskellFilePath cabalFilePath gpd = do +hiddenPackageAction :: Logger.Recorder (Logger.WithPriority Log) -> PluginId -> VersionedTextDocumentIdentifier -> Int -> Diagnostic -> FilePath -> FilePath -> GenericPackageDescription -> IO [CodeAction] +hiddenPackageAction recorder plId verTxtDocId maxCompletions diag haskellFilePath cabalFilePath gpd = do buildTargets <- liftIO $ getBuildTargets gpd cabalFilePath haskellFilePath + Logger.logWith recorder Logger.Info LogCalledCabalAddCodeAction case buildTargets of [] -> pure $ mkCodeAction cabalFilePath Nothing <$> hiddenPackageSuggestion maxCompletions (_message diag) targets -> pure $ concat [mkCodeAction cabalFilePath (Just $ buildTargetToStringRepr target) <$> @@ -110,7 +130,6 @@ hiddenPackageAction plId verTxtDocId maxCompletions diag haskellFilePath cabalFi Nothing -> T.empty Just t -> " target " <> T.pack t title = "Add dependency " <> suggestedDep <> versionTitle <> targetTitle - version = if T.null suggestedVersion then Nothing else Just suggestedVersion params = CabalAddCommandParams {cabalPath = cabalFilePath @@ -149,15 +168,25 @@ data CabalAddCommandParams = deriving (Generic, Show) deriving anyclass (FromJSON, ToJSON) -command :: CommandFunction IdeState CabalAddCommandParams -command state _ (CabalAddCommandParams {cabalPath = path, verTxtDocId = verTxtDocId, buildTarget = target, dependency = dep, version = mbVer}) = do +instance Logger.Pretty CabalAddCommandParams where + pretty CabalAddCommandParams{..} = + "CabalAdd parameters:\n" Logger.<+> + "| cabal path: " Logger.<+> Logger.pretty cabalPath Logger.<+> "\n" Logger.<+> + "| target: " Logger.<+> Logger.pretty buildTarget Logger.<+> "\n" Logger.<+> + "| dependendency: " Logger.<+> Logger.pretty dependency Logger.<+> "\n" Logger.<+> + "| version: " Logger.<+> Logger.pretty version Logger.<+> "\n" + +command :: Logger.Recorder (Logger.WithPriority Log) -> CommandFunction IdeState CabalAddCommandParams +command recorder state _ params@(CabalAddCommandParams {cabalPath = path, verTxtDocId = verTxtDocId, buildTarget = target, dependency = dep, version = mbVer}) = do + Logger.logWith recorder Logger.Info $ LogCalledCabalAddCommand params let specifiedDep = case mbVer of Nothing -> dep Just ver -> dep <> " ^>=" <> ver caps <- lift pluginGetClientCapabilities let env = (state, caps, verTxtDocId) - edit <- liftIO $ getDependencyEdit env path target (fromList [T.unpack specifiedDep]) + edit <- liftIO $ getDependencyEdit recorder env path target (fromList [T.unpack specifiedDep]) void $ lift $ pluginSendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (\_ -> pure ()) + Logger.logWith recorder Logger.Info $ LogExecutedCommand pure $ InR Null @@ -182,8 +211,8 @@ getBuildTargets gpd cabalFilePath haskellFilePath = do -- -- Inspired by @main@ in cabal-add, -- Distribution.Client.Main -getDependencyEdit :: (IdeState, ClientCapabilities, VersionedTextDocumentIdentifier) -> FilePath -> Maybe String -> NonEmpty String -> IO(WorkspaceEdit) -getDependencyEdit env cabalFilePath buildTarget dependency = do +getDependencyEdit :: Logger.Recorder (Logger.WithPriority Log) -> (IdeState, ClientCapabilities, VersionedTextDocumentIdentifier) -> FilePath -> Maybe String -> NonEmpty String -> IO WorkspaceEdit +getDependencyEdit recorder env cabalFilePath buildTarget dependency = do let (state, caps, verTxtDocId) = env (mbCnfOrigContents, mbFields, mbPackDescr) <- liftIO $ runAction "cabal.cabal-add" state $ do contents <- useWithStale GetFileContents $ toNormalizedFilePath cabalFilePath @@ -222,4 +251,5 @@ getDependencyEdit env cabalFilePath buildTarget dependency = do Nothing -> error $ "Cannot extend build-depends in " ++ cabalFilePath Just newContents -> do let edit = diffText caps (verTxtDocId, T.decodeUtf8 cnfOrigContents) (T.decodeUtf8 newContents) SkipDeletions + Logger.logWith recorder Logger.Info $ LogCreatedEdit edit pure edit diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index f81070f4d5..e623b70112 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -230,12 +230,12 @@ codeActionTests = testGroup "Code Actions" _ <- waitForDiagnosticsFrom hsdoc cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions hsdoc let selectedCas = filter (\ca -> "Add dependency" `T.isPrefixOf` (ca ^. L.title)) cas - traceShowM("selectedCas", selectedCas) + -- traceShowM("selectedCas", selectedCas) mapM_ executeCodeAction selectedCas cabDoc <- openDoc "hidden-package.cabal" "cabal" contents <- documentContents cabDoc - traceShowM("contents", contents) + -- traceShowM("contents", contents) liftIO $ assertEqual "Split isn't found in the cabal file" (Text.indices "split" contents) [256] ] where From cf8d35630a16b3e09daa42d90d33475975965e57 Mon Sep 17 00:00:00 2001 From: Fendor Date: Sun, 4 Aug 2024 11:51:18 +0200 Subject: [PATCH 31/65] Use PluginError instead of error --- .../src/Ide/Plugin/Cabal/CabalAdd.hs | 33 ++++++++++--------- 1 file changed, 18 insertions(+), 15 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 905d2bfc7f..65ab45a6db 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -18,7 +18,7 @@ module Ide.Plugin.Cabal.CabalAdd where import Control.Monad (filterM, void) -import Control.Monad.IO.Class (liftIO) +import Control.Monad.IO.Class (liftIO, MonadIO) import Data.String (IsString) import qualified Data.Text as T import qualified Data.Text.Encoding as T @@ -27,7 +27,7 @@ import Distribution.PackageDescription.Quirks (patchQuirks) import Ide.PluginUtils ( mkLspCommand, WithDeletions(SkipDeletions), diffText ) import Ide.Types (CommandFunction, CommandId (CommandId), - PluginId, pluginGetClientCapabilities, pluginSendRequest) + PluginId, pluginGetClientCapabilities, pluginSendRequest, HandlerM) import Language.LSP.Protocol.Types (CodeAction (CodeAction), CodeActionKind (CodeActionKind_QuickFix), Diagnostic (..), @@ -73,6 +73,8 @@ import Control.Monad.Trans.Class (lift) import Language.LSP.Protocol.Message (SMethod (SMethod_WorkspaceApplyEdit)) import Debug.Trace import qualified Ide.Logger as Logger +import Control.Monad.Trans.Except +import Ide.Plugin.Error data Log = LogFoundResponsibleCabalFile FilePath @@ -184,7 +186,7 @@ command recorder state _ params@(CabalAddCommandParams {cabalPath = path, verTxt Just ver -> dep <> " ^>=" <> ver caps <- lift pluginGetClientCapabilities let env = (state, caps, verTxtDocId) - edit <- liftIO $ getDependencyEdit recorder env path target (fromList [T.unpack specifiedDep]) + edit <- getDependencyEdit recorder env path target (fromList [T.unpack specifiedDep]) void $ lift $ pluginSendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (\_ -> pure ()) Logger.logWith recorder Logger.Info $ LogExecutedCommand pure $ InR Null @@ -193,12 +195,12 @@ command recorder state _ params@(CabalAddCommandParams {cabalPath = path, verTxt -- | Gives cabal file's contents or throws error. -- Inspired by @readCabalFile@ in cabal-add, -- Distribution.Client.Main -readCabalFile :: FilePath -> IO ByteString +readCabalFile :: MonadIO m => FilePath -> ExceptT PluginError m ByteString readCabalFile fileName = do - cabalFileExists <- doesFileExist fileName + cabalFileExists <- liftIO $ doesFileExist fileName if cabalFileExists - then snd . patchQuirks <$> B.readFile fileName - else error ("Failed to read cabal file at " <> fileName) + then snd . patchQuirks <$> liftIO (B.readFile fileName) + else throwE $ PluginInternalError $ T.pack ("Failed to read cabal file at " <> fileName) getBuildTargets :: GenericPackageDescription -> FilePath -> FilePath -> IO [BuildTarget] getBuildTargets gpd cabalFilePath haskellFilePath = do @@ -211,7 +213,8 @@ getBuildTargets gpd cabalFilePath haskellFilePath = do -- -- Inspired by @main@ in cabal-add, -- Distribution.Client.Main -getDependencyEdit :: Logger.Recorder (Logger.WithPriority Log) -> (IdeState, ClientCapabilities, VersionedTextDocumentIdentifier) -> FilePath -> Maybe String -> NonEmpty String -> IO WorkspaceEdit +getDependencyEdit :: MonadIO m => Logger.Recorder (Logger.WithPriority Log) -> (IdeState, ClientCapabilities, VersionedTextDocumentIdentifier) -> + FilePath -> Maybe String -> NonEmpty String -> ExceptT PluginError m WorkspaceEdit getDependencyEdit recorder env cabalFilePath buildTarget dependency = do let (state, caps, verTxtDocId) = env (mbCnfOrigContents, mbFields, mbPackDescr) <- liftIO $ runAction "cabal.cabal-add" state $ do @@ -225,15 +228,15 @@ getDependencyEdit recorder env cabalFilePath buildTarget dependency = do let mbPackDescr :: Maybe GenericPackageDescription = fst <$> inPackDescr pure (mbCnfOrigContents, mbFields, mbPackDescr) - (cnfOrigContents, fields, packDescr) <- liftIO $ do + (cnfOrigContents, fields, packDescr) <- do cnfOrigContents <- case mbCnfOrigContents of (Just cnfOrigContents) -> pure cnfOrigContents Nothing -> readCabalFile cabalFilePath - let (fields, packDescr) = case (mbFields, mbPackDescr) of - (Just fields, Just packDescr) -> (fields, packDescr) + (fields, packDescr) <- case (mbFields, mbPackDescr) of + (Just fields, Just packDescr) -> pure (fields, packDescr) (_, _) -> case parseCabalFile cabalFilePath cnfOrigContents of - Left err -> error err - Right (_ ,gpd) -> pure gpd + Left err -> throwE $ PluginInternalError $ T.pack $ err + Right (f ,gpd) -> pure (f, gpd) pure (cnfOrigContents, fields, packDescr) let inputs = do @@ -244,11 +247,11 @@ getDependencyEdit recorder env cabalFilePath buildTarget dependency = do pure (fields, packDescr, cmp, deps) (cnfFields, origPackDescr, cnfComponent, cnfDependencies) <- case inputs of - Left err -> error err + Left err -> throwE $ PluginInternalError $ T.pack $ err Right pair -> pure pair case executeConfig (validateChanges origPackDescr) (Config {..}) of - Nothing -> error $ "Cannot extend build-depends in " ++ cabalFilePath + Nothing -> throwE $ PluginInternalError $ T.pack $ "Cannot extend build-depends in " ++ cabalFilePath Just newContents -> do let edit = diffText caps (verTxtDocId, T.decodeUtf8 cnfOrigContents) (T.decodeUtf8 newContents) SkipDeletions Logger.logWith recorder Logger.Info $ LogCreatedEdit edit From 45399c6193133febb1d69d5ef7bd27ba6f8da9c7 Mon Sep 17 00:00:00 2001 From: Fendor Date: Sun, 4 Aug 2024 11:51:35 +0200 Subject: [PATCH 32/65] Wait for TextEdit messages in CabalAdd test --- plugins/hls-cabal-plugin/test/Main.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index e623b70112..051d920dd4 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -227,13 +227,13 @@ codeActionTests = testGroup "Code Actions" pure () , runHaskellTestCaseSession "Code Actions - Can add hidden package" ("cabal-add-testdata" "hidden-package") $ do hsdoc <- openDoc ("src" "Main.hs") "haskell" + cabDoc <- openDoc "hidden-package.cabal" "cabal" _ <- waitForDiagnosticsFrom hsdoc cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions hsdoc let selectedCas = filter (\ca -> "Add dependency" `T.isPrefixOf` (ca ^. L.title)) cas -- traceShowM("selectedCas", selectedCas) mapM_ executeCodeAction selectedCas - - cabDoc <- openDoc "hidden-package.cabal" "cabal" + _ <- skipManyTill anyMessage $ getDocumentEdit cabDoc contents <- documentContents cabDoc -- traceShowM("contents", contents) liftIO $ assertEqual "Split isn't found in the cabal file" (Text.indices "split" contents) [256] From a1c70dba4632b9ea2ed78a5048056f3694c2d912 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Sun, 4 Aug 2024 00:28:35 +0300 Subject: [PATCH 33/65] WIP formatting --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 1 - .../src/Ide/Plugin/Cabal/CabalAdd.hs | 37 ++++++++++++------- 2 files changed, 23 insertions(+), 15 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 51b2559557..52c16526e7 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -55,7 +55,6 @@ import qualified Language.LSP.VFS as VFS import qualified Data.Text () import qualified Ide.Plugin.Cabal.CabalAdd as CabalAdd -import Debug.Trace data Log = LogModificationTime NormalizedFilePath FileVersion diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 65ab45a6db..675019f6ad 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -2,10 +2,10 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE LambdaCase #-} module Ide.Plugin.Cabal.CabalAdd ( findResponsibleCabalFile @@ -22,9 +22,13 @@ import Control.Monad.IO.Class (liftIO, MonadIO) import Data.String (IsString) import qualified Data.Text as T import qualified Data.Text.Encoding as T -import Development.IDE (IdeState (shakeExtras), runIdeAction, useWithStale) +import Development.IDE (IdeState (shakeExtras), + runIdeAction, + useWithStale) import Distribution.PackageDescription.Quirks (patchQuirks) -import Ide.PluginUtils ( mkLspCommand, WithDeletions(SkipDeletions), diffText ) +import Ide.PluginUtils (WithDeletions (SkipDeletions), + diffText, + mkLspCommand) import Ide.Types (CommandFunction, CommandId (CommandId), PluginId, pluginGetClientCapabilities, pluginSendRequest, HandlerM) @@ -32,7 +36,12 @@ import Language.LSP.Protocol.Types (CodeAction (Code CodeActionKind (CodeActionKind_QuickFix), Diagnostic (..), Null (Null), - type (|?) (InR), toNormalizedFilePath, TextDocumentIdentifier, VersionedTextDocumentIdentifier, ClientCapabilities, WorkspaceFoldersServerCapabilities, WorkspaceEdit, ApplyWorkspaceEditParams (ApplyWorkspaceEditParams)) + TextDocumentIdentifier, + VersionedTextDocumentIdentifier, + WorkspaceEdit, + WorkspaceFoldersServerCapabilities, + toNormalizedFilePath, + type (|?) (InR), ClientCapabilities, ApplyWorkspaceEditParams (ApplyWorkspaceEditParams)) import System.Directory (doesFileExist, listDirectory) @@ -42,17 +51,22 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B import Data.List.NonEmpty (NonEmpty (..), fromList) +import Development.IDE.Core.Rules (runAction) import Distribution.Client.Add as Add import Distribution.Compat.Prelude (Generic) -import Distribution.PackageDescription (packageDescription, - specVersion, GenericPackageDescription (GenericPackageDescription)) +import Distribution.PackageDescription (GenericPackageDescription (GenericPackageDescription), + packageDescription, + specVersion) import Distribution.PackageDescription.Configuration (flattenPackageDescription) import Distribution.Pretty (pretty) import Distribution.Simple.BuildTarget (BuildTarget, buildTargetComponentName, readBuildTargets) +import Distribution.Simple.Utils (safeHead) import Distribution.Verbosity (silent, verboseNoStderr) +import Ide.Plugin.Cabal.Completion.Types (ParseCabalFields (..), + ParseCabalFile (..)) import System.FilePath (dropFileName, makeRelative, splitPath, @@ -60,11 +74,6 @@ import System.FilePath (dropFileName, ()) import Text.PrettyPrint (render) import Text.Regex.TDFA -import Distribution.Simple.Utils (safeHead) -import Development.IDE.Core.Rules (runAction) -import Ide.Plugin.Cabal.Completion.Types (ParseCabalFields (..), - ParseCabalFile (..)) - import Development.IDE.Core.RuleTypes (GetFileContents(..)) import Data.Text.Encoding (encodeUtf8) import Ide.Plugin.Cabal.Orphans () @@ -107,7 +116,7 @@ findResponsibleCabalFile haskellFilePath = do objectsCabalExtension = filter (\c -> takeExtension c == ".cabal") objectsWithPaths cabalFiles <- filterM (\c -> doesFileExist c) objectsCabalExtension case safeHead cabalFiles of - Nothing -> go ps + Nothing -> go ps Just cabalFile -> pure $ Just cabalFile @@ -188,7 +197,7 @@ command recorder state _ params@(CabalAddCommandParams {cabalPath = path, verTxt let env = (state, caps, verTxtDocId) edit <- getDependencyEdit recorder env path target (fromList [T.unpack specifiedDep]) void $ lift $ pluginSendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (\_ -> pure ()) - Logger.logWith recorder Logger.Info $ LogExecutedCommand + Logger.logWith recorder Logger.Info LogExecutedCommand pure $ InR Null @@ -223,7 +232,7 @@ getDependencyEdit recorder env cabalFilePath buildTarget dependency = do inPackDescr <- useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath let mbCnfOrigContents = case snd . fst <$> contents of Just (Just txt) -> Just $ encodeUtf8 txt - _ -> Nothing + _ -> Nothing let mbFields = fst <$> inFields let mbPackDescr :: Maybe GenericPackageDescription = fst <$> inPackDescr pure (mbCnfOrigContents, mbFields, mbPackDescr) From 4abb95ef8ca37635ecd707bbaaf4488a104173d8 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Sun, 4 Aug 2024 16:55:36 +0300 Subject: [PATCH 34/65] WIP formatting --- .../src/Ide/Plugin/Cabal/CabalAdd.hs | 120 +++++++++--------- plugins/hls-cabal-plugin/test/Main.hs | 4 +- 2 files changed, 61 insertions(+), 63 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 675019f6ad..3aad02b089 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -18,12 +18,11 @@ module Ide.Plugin.Cabal.CabalAdd where import Control.Monad (filterM, void) -import Control.Monad.IO.Class (liftIO, MonadIO) +import Control.Monad.IO.Class (MonadIO, liftIO) import Data.String (IsString) import qualified Data.Text as T import qualified Data.Text.Encoding as T -import Development.IDE (IdeState (shakeExtras), - runIdeAction, +import Development.IDE (IdeState, useWithStale) import Distribution.PackageDescription.Quirks (patchQuirks) import Ide.PluginUtils (WithDeletions (SkipDeletions), @@ -31,30 +30,37 @@ import Ide.PluginUtils (WithDeletions (S mkLspCommand) import Ide.Types (CommandFunction, CommandId (CommandId), - PluginId, pluginGetClientCapabilities, pluginSendRequest, HandlerM) -import Language.LSP.Protocol.Types (CodeAction (CodeAction), + HandlerM, + PluginId, + pluginGetClientCapabilities, + pluginSendRequest) +import Language.LSP.Protocol.Types (ApplyWorkspaceEditParams (ApplyWorkspaceEditParams), + ClientCapabilities, + CodeAction (CodeAction), CodeActionKind (CodeActionKind_QuickFix), Diagnostic (..), Null (Null), - TextDocumentIdentifier, VersionedTextDocumentIdentifier, WorkspaceEdit, - WorkspaceFoldersServerCapabilities, toNormalizedFilePath, - type (|?) (InR), ClientCapabilities, ApplyWorkspaceEditParams (ApplyWorkspaceEditParams)) + type (|?) (InR)) import System.Directory (doesFileExist, listDirectory) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Except import Data.Aeson.Types (FromJSON, ToJSON, toJSON) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B import Data.List.NonEmpty (NonEmpty (..), fromList) +import Data.Text.Encoding (encodeUtf8) import Development.IDE.Core.Rules (runAction) +import Development.IDE.Core.RuleTypes (GetFileContents (..)) import Distribution.Client.Add as Add import Distribution.Compat.Prelude (Generic) -import Distribution.PackageDescription (GenericPackageDescription (GenericPackageDescription), +import Distribution.PackageDescription (GenericPackageDescription, packageDescription, specVersion) import Distribution.PackageDescription.Configuration (flattenPackageDescription) @@ -65,8 +71,12 @@ import Distribution.Simple.BuildTarget (BuildTarget, import Distribution.Simple.Utils (safeHead) import Distribution.Verbosity (silent, verboseNoStderr) +import qualified Ide.Logger as Logger import Ide.Plugin.Cabal.Completion.Types (ParseCabalFields (..), ParseCabalFile (..)) +import Ide.Plugin.Cabal.Orphans () +import Ide.Plugin.Error +import Language.LSP.Protocol.Message (SMethod (SMethod_WorkspaceApplyEdit)) import System.FilePath (dropFileName, makeRelative, splitPath, @@ -74,16 +84,6 @@ import System.FilePath (dropFileName, ()) import Text.PrettyPrint (render) import Text.Regex.TDFA -import Development.IDE.Core.RuleTypes (GetFileContents(..)) -import Data.Text.Encoding (encodeUtf8) -import Ide.Plugin.Cabal.Orphans () -import Distribution.Fields.Field (fieldAnn) -import Control.Monad.Trans.Class (lift) -import Language.LSP.Protocol.Message (SMethod (SMethod_WorkspaceApplyEdit)) -import Debug.Trace -import qualified Ide.Logger as Logger -import Control.Monad.Trans.Except -import Ide.Plugin.Error data Log = LogFoundResponsibleCabalFile FilePath @@ -101,24 +101,6 @@ instance Logger.Pretty Log where LogCreatedEdit edit -> "Created inplace edit:\n" Logger.<+> Logger.pretty edit LogExecutedCommand -> "Executed CabalAdd command" --- | Given a path to a haskell file, returns the closest cabal file. --- If cabal file wasn't found, dives Nothing. -findResponsibleCabalFile :: FilePath -> IO (Maybe FilePath) -findResponsibleCabalFile haskellFilePath = do - let dirPath = dropFileName haskellFilePath - allDirPaths = reverse $ scanl1 () (splitPath dirPath) -- sorted from most to least specific - go allDirPaths - where - go [] = pure Nothing - go (path:ps) = do - objects <- listDirectory path - let objectsWithPaths = map (\obj -> path <> obj) objects - objectsCabalExtension = filter (\c -> takeExtension c == ".cabal") objectsWithPaths - cabalFiles <- filterM (\c -> doesFileExist c) objectsCabalExtension - case safeHead cabalFiles of - Nothing -> go ps - Just cabalFile -> pure $ Just cabalFile - -- | Gives a code action that calls the command, -- if a suggestion for a missing dependency is found. @@ -134,6 +116,13 @@ hiddenPackageAction recorder plId verTxtDocId maxCompletions diag haskellFilePat hiddenPackageSuggestion maxCompletions (_message diag) | target <- targets] where buildTargetToStringRepr target = render $ pretty $ buildTargetComponentName target + + getBuildTargets :: GenericPackageDescription -> FilePath -> FilePath -> IO [BuildTarget] + getBuildTargets gpd cabalFilePath haskellFilePath = do + let haskellFileRelativePath = makeRelative (dropFileName cabalFilePath) haskellFilePath + readBuildTargets (verboseNoStderr silent) (flattenPackageDescription gpd) [haskellFileRelativePath] + + mkCodeAction :: FilePath -> Maybe String -> (T.Text, T.Text) -> CodeAction mkCodeAction cabalFilePath target (suggestedDep, suggestedVersion) = let versionTitle = if T.null suggestedVersion then T.empty else " version " <> suggestedVersion @@ -200,26 +189,9 @@ command recorder state _ params@(CabalAddCommandParams {cabalPath = path, verTxt Logger.logWith recorder Logger.Info LogExecutedCommand pure $ InR Null - --- | Gives cabal file's contents or throws error. --- Inspired by @readCabalFile@ in cabal-add, --- Distribution.Client.Main -readCabalFile :: MonadIO m => FilePath -> ExceptT PluginError m ByteString -readCabalFile fileName = do - cabalFileExists <- liftIO $ doesFileExist fileName - if cabalFileExists - then snd . patchQuirks <$> liftIO (B.readFile fileName) - else throwE $ PluginInternalError $ T.pack ("Failed to read cabal file at " <> fileName) - -getBuildTargets :: GenericPackageDescription -> FilePath -> FilePath -> IO [BuildTarget] -getBuildTargets gpd cabalFilePath haskellFilePath = do - let haskellFileRelativePath = makeRelative (dropFileName cabalFilePath) haskellFilePath - readBuildTargets (verboseNoStderr silent) (flattenPackageDescription gpd) [haskellFileRelativePath] - - -- | Constructs prerequisets for the @executeConfig@ -- and runs it, given path to the cabal file and a dependency message. --- +-- Given the new contents of the cabal file constructs and returns the @edit@. -- Inspired by @main@ in cabal-add, -- Distribution.Client.Main getDependencyEdit :: MonadIO m => Logger.Recorder (Logger.WithPriority Log) -> (IdeState, ClientCapabilities, VersionedTextDocumentIdentifier) -> @@ -227,9 +199,9 @@ getDependencyEdit :: MonadIO m => Logger.Recorder (Logger.WithPriority Log) -> ( getDependencyEdit recorder env cabalFilePath buildTarget dependency = do let (state, caps, verTxtDocId) = env (mbCnfOrigContents, mbFields, mbPackDescr) <- liftIO $ runAction "cabal.cabal-add" state $ do - contents <- useWithStale GetFileContents $ toNormalizedFilePath cabalFilePath - inFields <- useWithStale ParseCabalFields $ toNormalizedFilePath cabalFilePath - inPackDescr <- useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath + contents <- Development.IDE.useWithStale GetFileContents $ toNormalizedFilePath cabalFilePath + inFields <- Development.IDE.useWithStale ParseCabalFields $ toNormalizedFilePath cabalFilePath + inPackDescr <- Development.IDE.useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath let mbCnfOrigContents = case snd . fst <$> contents of Just (Just txt) -> Just $ encodeUtf8 txt _ -> Nothing @@ -240,7 +212,7 @@ getDependencyEdit recorder env cabalFilePath buildTarget dependency = do (cnfOrigContents, fields, packDescr) <- do cnfOrigContents <- case mbCnfOrigContents of (Just cnfOrigContents) -> pure cnfOrigContents - Nothing -> readCabalFile cabalFilePath + Nothing -> readCabalFile cabalFilePath (fields, packDescr) <- case (mbFields, mbPackDescr) of (Just fields, Just packDescr) -> pure (fields, packDescr) (_, _) -> case parseCabalFile cabalFilePath cnfOrigContents of @@ -256,7 +228,7 @@ getDependencyEdit recorder env cabalFilePath buildTarget dependency = do pure (fields, packDescr, cmp, deps) (cnfFields, origPackDescr, cnfComponent, cnfDependencies) <- case inputs of - Left err -> throwE $ PluginInternalError $ T.pack $ err + Left err -> throwE $ PluginInternalError $ T.pack err Right pair -> pure pair case executeConfig (validateChanges origPackDescr) (Config {..}) of @@ -265,3 +237,31 @@ getDependencyEdit recorder env cabalFilePath buildTarget dependency = do let edit = diffText caps (verTxtDocId, T.decodeUtf8 cnfOrigContents) (T.decodeUtf8 newContents) SkipDeletions Logger.logWith recorder Logger.Info $ LogCreatedEdit edit pure edit + +-- | Given a path to a haskell file, returns the closest cabal file. +-- If cabal file wasn't found, dives Nothing. +findResponsibleCabalFile :: FilePath -> IO (Maybe FilePath) +findResponsibleCabalFile haskellFilePath = do + let dirPath = dropFileName haskellFilePath + allDirPaths = reverse $ scanl1 () (splitPath dirPath) -- sorted from most to least specific + go allDirPaths + where + go [] = pure Nothing + go (path:ps) = do + objects <- listDirectory path + let objectsWithPaths = map (\obj -> path <> obj) objects + objectsCabalExtension = filter (\c -> takeExtension c == ".cabal") objectsWithPaths + cabalFiles <- filterM (\c -> doesFileExist c) objectsCabalExtension + case safeHead cabalFiles of + Nothing -> go ps + Just cabalFile -> pure $ Just cabalFile + +-- | Gives cabal file's contents or throws error. +-- Inspired by @readCabalFile@ in cabal-add, +-- Distribution.Client.Main +readCabalFile :: MonadIO m => FilePath -> ExceptT PluginError m ByteString +readCabalFile fileName = do + cabalFileExists <- liftIO $ doesFileExist fileName + if cabalFileExists + then snd . patchQuirks <$> liftIO (B.readFile fileName) + else throwE $ PluginInternalError $ T.pack ("Failed to read cabal file at " <> fileName) diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 051d920dd4..ef8fe5cf93 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -231,11 +231,9 @@ codeActionTests = testGroup "Code Actions" _ <- waitForDiagnosticsFrom hsdoc cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions hsdoc let selectedCas = filter (\ca -> "Add dependency" `T.isPrefixOf` (ca ^. L.title)) cas - -- traceShowM("selectedCas", selectedCas) mapM_ executeCodeAction selectedCas - _ <- skipManyTill anyMessage $ getDocumentEdit cabDoc + _ <- skipManyTill anyMessage $ getDocumentEdit cabDoc -- Needed to wait for the changes in cabal file contents <- documentContents cabDoc - -- traceShowM("contents", contents) liftIO $ assertEqual "Split isn't found in the cabal file" (Text.indices "split" contents) [256] ] where From 6924af65496975d748738b4755778c034aec09fe Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Sun, 4 Aug 2024 17:25:19 +0300 Subject: [PATCH 35/65] dashed deps test --- plugins/hls-cabal-plugin/test/Main.hs | 16 +++++++++++++--- .../hidden-package-dashed.cabal | 12 ++++++++++++ .../hidden-package-dashed/src/Main.hs | 5 +++++ 3 files changed, 30 insertions(+), 3 deletions(-) create mode 100644 plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-dashed/hidden-package-dashed.cabal create mode 100644 plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-dashed/src/Main.hs diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index ef8fe5cf93..6238dfe4a3 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -27,8 +27,6 @@ import System.FilePath import Test.Hls import Utils -import Debug.Trace - main :: IO () main = do defaultTestRunner $ @@ -232,9 +230,21 @@ codeActionTests = testGroup "Code Actions" cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions hsdoc let selectedCas = filter (\ca -> "Add dependency" `T.isPrefixOf` (ca ^. L.title)) cas mapM_ executeCodeAction selectedCas - _ <- skipManyTill anyMessage $ getDocumentEdit cabDoc -- Needed to wait for the changes in cabal file + _ <- skipManyTill anyMessage $ getDocumentEdit cabDoc -- Wait for the changes in cabal file contents <- documentContents cabDoc liftIO $ assertEqual "Split isn't found in the cabal file" (Text.indices "split" contents) [256] + , runHaskellTestCaseSession "Code Actions - Can add dashed hidden package" ("cabal-add-testdata" "hidden-package-dashed") $ do + hsdoc <- openDoc ("src" "Main.hs") "haskell" + cabDoc <- openDoc "hidden-package-dashed.cabal" "cabal" + _ <- waitForDiagnosticsFrom hsdoc + cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions hsdoc + let selectedCas = filter (\ca -> "Add dependency" `T.isPrefixOf` (ca ^. L.title)) cas + mapM_ executeCodeAction selectedCas + _ <- skipManyTill anyMessage $ getDocumentEdit cabDoc -- Wait for the changes in cabal file + contents <- documentContents cabDoc + liftIO $ assertEqual "hls-plugin-api isn't found in the cabal file" (Text.indices "hls-plugin-api" contents) [263] + + ] where getLicenseAction :: T.Text -> [Command |? CodeAction] -> [CodeAction] diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-dashed/hidden-package-dashed.cabal b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-dashed/hidden-package-dashed.cabal new file mode 100644 index 0000000000..6b45eb7393 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-dashed/hidden-package-dashed.cabal @@ -0,0 +1,12 @@ +cabal-version: 2.4 + +name: hidden-package +version: 0.1.0.0 +build-type: Simple + +executable hidden-package-dashed + main-is: Main.hs + hs-source-dirs: src + ghc-options: -Wall + build-depends: base + default-language: Haskell2010 diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-dashed/src/Main.hs b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-dashed/src/Main.hs new file mode 100644 index 0000000000..d0e1128af7 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-dashed/src/Main.hs @@ -0,0 +1,5 @@ +module Main where + +import Ide.Types + +main = putStrLn "Hello, Haskell!" \ No newline at end of file From 24ac7bbf290f07a864d0786ee89c775ed864c809 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Mon, 5 Aug 2024 23:14:50 +0300 Subject: [PATCH 36/65] more tests --- plugins/hls-cabal-plugin/test/Main.hs | 43 ++++++++++--------- .../testdata/cabal-add-testdata/cabal.project | 6 ++- .../hidden-package-bench/bench/Main.hs | 6 +++ .../hidden-package-bench.cabal | 17 ++++++++ .../hidden-package-lib.cabal | 17 ++++++++ .../hidden-package-lib/src/MyLib.hs | 6 +++ .../hidden-package-tests.cabal | 18 ++++++++ .../hidden-package-tests/test/Main.hs | 6 +++ 8 files changed, 97 insertions(+), 22 deletions(-) create mode 100644 plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-bench/bench/Main.hs create mode 100644 plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-bench/hidden-package-bench.cabal create mode 100644 plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-lib/hidden-package-lib.cabal create mode 100644 plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-lib/src/MyLib.hs create mode 100644 plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-tests/hidden-package-tests.cabal create mode 100644 plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-tests/test/Main.hs diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 6238dfe4a3..834625bee2 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -223,27 +223,16 @@ codeActionTests = testGroup "Code Actions" ]) cas mapM_ executeCodeAction selectedCas pure () - , runHaskellTestCaseSession "Code Actions - Can add hidden package" ("cabal-add-testdata" "hidden-package") $ do - hsdoc <- openDoc ("src" "Main.hs") "haskell" - cabDoc <- openDoc "hidden-package.cabal" "cabal" - _ <- waitForDiagnosticsFrom hsdoc - cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions hsdoc - let selectedCas = filter (\ca -> "Add dependency" `T.isPrefixOf` (ca ^. L.title)) cas - mapM_ executeCodeAction selectedCas - _ <- skipManyTill anyMessage $ getDocumentEdit cabDoc -- Wait for the changes in cabal file - contents <- documentContents cabDoc - liftIO $ assertEqual "Split isn't found in the cabal file" (Text.indices "split" contents) [256] - , runHaskellTestCaseSession "Code Actions - Can add dashed hidden package" ("cabal-add-testdata" "hidden-package-dashed") $ do - hsdoc <- openDoc ("src" "Main.hs") "haskell" - cabDoc <- openDoc "hidden-package-dashed.cabal" "cabal" - _ <- waitForDiagnosticsFrom hsdoc - cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions hsdoc - let selectedCas = filter (\ca -> "Add dependency" `T.isPrefixOf` (ca ^. L.title)) cas - mapM_ executeCodeAction selectedCas - _ <- skipManyTill anyMessage $ getDocumentEdit cabDoc -- Wait for the changes in cabal file - contents <- documentContents cabDoc - liftIO $ assertEqual "hls-plugin-api isn't found in the cabal file" (Text.indices "hls-plugin-api" contents) [263] - + , runHaskellTestCaseSession "Code Actions - Can add hidden package" ("cabal-add-testdata" "hidden-package") + (generateHiddenPackageTestSession "hidden-package.cabal" ("src" "Main.hs") "split" [256]) + , runHaskellTestCaseSession "Code Actions - Can add dashed hidden package" ("cabal-add-testdata" "hidden-package-dashed") + (generateHiddenPackageTestSession "hidden-package-dashed.cabal" ("src" "Main.hs") "hls-plugin-api" [263]) + , runHaskellTestCaseSession "Code Actions - Can add hidden package to a library" ("cabal-add-testdata" "hidden-package-lib") + (generateHiddenPackageTestSession "hidden-package-lib.cabal" ("src" "MyLib.hs") "split" [256]) + , runHaskellTestCaseSession "Code Actions - Can add hidden package to a test" ("cabal-add-testdata" "hidden-package-tests") + (generateHiddenPackageTestSession "hidden-package-tests.cabal" ("test" "Main.hs") "split" [256]) + , runHaskellTestCaseSession "Code Actions - Can add hidden package to a bench" ("cabal-add-testdata" "hidden-package-bench") + (generateHiddenPackageTestSession "hidden-package-bench.cabal" ("bench" "Main.hs") "split" [256]) ] where @@ -253,6 +242,18 @@ codeActionTests = testGroup "Code Actions" guard (_title == "Replace with " <> license) pure action + generateHiddenPackageTestSession :: FilePath -> FilePath -> T.Text -> [Int] -> Session () + generateHiddenPackageTestSession cabalFile haskellFile dependency indicesRes = do + hsdoc <- openDoc haskellFile "haskell" + cabDoc <- openDoc cabalFile "cabal" + _ <- waitForDiagnosticsFrom hsdoc + cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions hsdoc + let selectedCas = filter (\ca -> "Add dependency" `T.isPrefixOf` (ca ^. L.title)) cas + mapM_ executeCodeAction selectedCas + _ <- skipManyTill anyMessage $ getDocumentEdit cabDoc -- Wait for the changes in cabal file + contents <- documentContents cabDoc + liftIO $ assertEqual (T.unpack dependency <> " isn't found in the cabal file") (Text.indices dependency contents) indicesRes + -- ---------------------------------------------------------------------------- -- Goto Definition Tests -- ---------------------------------------------------------------------------- diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal.project b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal.project index acae42d876..f36da21488 100644 --- a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal.project +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal.project @@ -1 +1,5 @@ -packages: hidden-package \ No newline at end of file +packages: hidden-package + hidden-package-dashed + hidden-package-lib + hidden-package-tests + hidden-package-bench diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-bench/bench/Main.hs b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-bench/bench/Main.hs new file mode 100644 index 0000000000..e5c42398f2 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-bench/bench/Main.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Data.List.Split + +main :: IO () +main = putStrLn "Test suite not yet implemented." diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-bench/hidden-package-bench.cabal b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-bench/hidden-package-bench.cabal new file mode 100644 index 0000000000..bc87454962 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-bench/hidden-package-bench.cabal @@ -0,0 +1,17 @@ +cabal-version: 2.4 +name: hidden-package-bench +version: 0.1.0.0 +license: NONE +author: George Gerasev +maintainer: george30032002@gmail.com +build-type: Simple + +common warnings + ghc-options: -Wall + +benchmark benchmark + type: exitcode-stdio-1.0 + ghc-options: -threaded + main-is: Main.hs + hs-source-dirs: bench + build-depends: base diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-lib/hidden-package-lib.cabal b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-lib/hidden-package-lib.cabal new file mode 100644 index 0000000000..e783054d35 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-lib/hidden-package-lib.cabal @@ -0,0 +1,17 @@ +cabal-version: 2.4 +name: hidden-package-lib +version: 0.1.0.0 +license: NONE +author: George Gerasev +maintainer: george30032002@gmail.com +build-type: Simple + +common warnings + ghc-options: -Wall + +library + import: warnings + exposed-modules: MyLib + build-depends: base + hs-source-dirs: src + default-language: Haskell2010 diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-lib/src/MyLib.hs b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-lib/src/MyLib.hs new file mode 100644 index 0000000000..bbb506d001 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-lib/src/MyLib.hs @@ -0,0 +1,6 @@ +module MyLib (someFunc) where + +import Data.List.Split + +someFunc :: IO () +someFunc = putStrLn "someFunc" diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-tests/hidden-package-tests.cabal b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-tests/hidden-package-tests.cabal new file mode 100644 index 0000000000..f9b6fe7097 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-tests/hidden-package-tests.cabal @@ -0,0 +1,18 @@ +cabal-version: 2.4 +name: hidden-package-tests +version: 0.1.0.0 +license: NONE +author: George Gerasev +maintainer: george30032002@gmail.com +build-type: Simple + +common warnings + ghc-options: -Wall + +test-suite hidden-package-tests-test + import: warnings + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + build-depends: base diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-tests/test/Main.hs b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-tests/test/Main.hs new file mode 100644 index 0000000000..e5c42398f2 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-tests/test/Main.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Data.List.Split + +main :: IO () +main = putStrLn "Test suite not yet implemented." From 069e796b4687a752d79b6dd66da68f588b261e44 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Tue, 6 Aug 2024 18:03:38 +0300 Subject: [PATCH 37/65] renamed tests --- plugins/hls-cabal-plugin/test/Main.hs | 32 +++++++++++++------ .../bench/Main.hs | 0 .../cabal-add-bench.cabal} | 2 +- .../cabal-add-dashed.cabal} | 4 +-- .../src/Main.hs | 2 +- .../cabal-add-exe.cabal} | 6 ++-- .../src/Main.hs | 0 .../cabal-add-lib.cabal} | 2 +- .../src/MyLib.hs | 0 .../cabal-add-tests.cabal} | 4 +-- .../test/Main.hs | 0 .../testdata/cabal-add-testdata/cabal.project | 10 +++--- .../test/testdata/cabal-add-testdata/hie.yaml | 3 +- 13 files changed, 37 insertions(+), 28 deletions(-) rename plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/{hidden-package-bench => cabal-add-bench}/bench/Main.hs (100%) rename plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/{hidden-package-bench/hidden-package-bench.cabal => cabal-add-bench/cabal-add-bench.cabal} (90%) rename plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/{hidden-package-dashed/hidden-package-dashed.cabal => cabal-add-dashed/cabal-add-dashed.cabal} (77%) rename plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/{hidden-package-dashed => cabal-add-dashed}/src/Main.hs (74%) rename plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/{hidden-package/hidden-package.cabal => cabal-add-exe/cabal-add-exe.cabal} (82%) rename plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/{hidden-package => cabal-add-exe}/src/Main.hs (100%) rename plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/{hidden-package-lib/hidden-package-lib.cabal => cabal-add-lib/cabal-add-lib.cabal} (90%) rename plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/{hidden-package-lib => cabal-add-lib}/src/MyLib.hs (100%) rename plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/{hidden-package-tests/hidden-package-tests.cabal => cabal-add-tests/cabal-add-tests.cabal} (84%) rename plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/{hidden-package-tests => cabal-add-tests}/test/Main.hs (100%) diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 834625bee2..f92d31eac9 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -223,16 +223,28 @@ codeActionTests = testGroup "Code Actions" ]) cas mapM_ executeCodeAction selectedCas pure () - , runHaskellTestCaseSession "Code Actions - Can add hidden package" ("cabal-add-testdata" "hidden-package") - (generateHiddenPackageTestSession "hidden-package.cabal" ("src" "Main.hs") "split" [256]) - , runHaskellTestCaseSession "Code Actions - Can add dashed hidden package" ("cabal-add-testdata" "hidden-package-dashed") - (generateHiddenPackageTestSession "hidden-package-dashed.cabal" ("src" "Main.hs") "hls-plugin-api" [263]) - , runHaskellTestCaseSession "Code Actions - Can add hidden package to a library" ("cabal-add-testdata" "hidden-package-lib") - (generateHiddenPackageTestSession "hidden-package-lib.cabal" ("src" "MyLib.hs") "split" [256]) - , runHaskellTestCaseSession "Code Actions - Can add hidden package to a test" ("cabal-add-testdata" "hidden-package-tests") - (generateHiddenPackageTestSession "hidden-package-tests.cabal" ("test" "Main.hs") "split" [256]) - , runHaskellTestCaseSession "Code Actions - Can add hidden package to a bench" ("cabal-add-testdata" "hidden-package-bench") - (generateHiddenPackageTestSession "hidden-package-bench.cabal" ("bench" "Main.hs") "split" [256]) + -- , runHaskellTestCaseSession "Code Actions - Can add hidden package" ("cabal-add-testdata" "cabal-add-exe") $ do + -- hsdoc <- openDoc ("src" "Main.hs") "haskell" + -- cabDoc <- openDoc "cabal-add-exe.cabal" "cabal" + -- _ <- waitForDiagnosticsFrom hsdoc + -- cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions hsdoc + -- let selectedCas = filter (\ca -> "Add dependency" `T.isPrefixOf` (ca ^. L.title)) cas + -- -- traceShowM("selectedCas", selectedCas) + -- mapM_ executeCodeAction selectedCas + -- _ <- skipManyTill anyMessage $ getDocumentEdit cabDoc + -- contents <- documentContents cabDoc + -- -- traceShowM("contents", contents) + -- liftIO $ assertEqual "Split isn't found in the cabal file" (Text.indices "split" contents) [256] + , runHaskellTestCaseSession "Code Actions - Can add hidden package" ("cabal-add-testdata" "cabal-add-exe") + (generateHiddenPackageTestSession "cabal-add-exe.cabal" ("src" "Main.hs") "split" [253]) + , runHaskellTestCaseSession "Code Actions - Can add dashed hidden package" ("cabal-add-testdata" "cabal-add-dashed") + (generateHiddenPackageTestSession "cabal-add-dashed.cabal" ("src" "Main.hs") "ghc-boot-th" [260]) + , runHaskellTestCaseSession "Code Actions - Can add hidden package to a library" ("cabal-add-testdata" "cabal-add-lib") + (generateHiddenPackageTestSession "cabal-add-lib.cabal" ("src" "MyLib.hs") "split" [348]) + , runHaskellTestCaseSession "Code Actions - Can add hidden package to a test" ("cabal-add-testdata" "cabal-add-tests") + (generateHiddenPackageTestSession "cabal-add-tests.cabal" ("test" "Main.hs") "split" [478]) + , runHaskellTestCaseSession "Code Actions - Can add hidden package to a benchmark" ("cabal-add-testdata" "cabal-add-bench") + (generateHiddenPackageTestSession "cabal-add-bench.cabal" ("bench" "Main.hs") "split" [403]) ] where diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-bench/bench/Main.hs b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-bench/bench/Main.hs similarity index 100% rename from plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-bench/bench/Main.hs rename to plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-bench/bench/Main.hs diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-bench/hidden-package-bench.cabal b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-bench/cabal-add-bench.cabal similarity index 90% rename from plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-bench/hidden-package-bench.cabal rename to plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-bench/cabal-add-bench.cabal index bc87454962..b58a6d3302 100644 --- a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-bench/hidden-package-bench.cabal +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-bench/cabal-add-bench.cabal @@ -1,5 +1,5 @@ cabal-version: 2.4 -name: hidden-package-bench +name: cabal-add-bench version: 0.1.0.0 license: NONE author: George Gerasev diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-dashed/hidden-package-dashed.cabal b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-dashed/cabal-add-dashed.cabal similarity index 77% rename from plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-dashed/hidden-package-dashed.cabal rename to plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-dashed/cabal-add-dashed.cabal index 6b45eb7393..ba9d951e48 100644 --- a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-dashed/hidden-package-dashed.cabal +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-dashed/cabal-add-dashed.cabal @@ -1,10 +1,10 @@ cabal-version: 2.4 -name: hidden-package +name: cabal-add-dashed version: 0.1.0.0 build-type: Simple -executable hidden-package-dashed +executable cabal-add-dashed main-is: Main.hs hs-source-dirs: src ghc-options: -Wall diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-dashed/src/Main.hs b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-dashed/src/Main.hs similarity index 74% rename from plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-dashed/src/Main.hs rename to plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-dashed/src/Main.hs index d0e1128af7..8bfdf21bed 100644 --- a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-dashed/src/Main.hs +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-dashed/src/Main.hs @@ -1,5 +1,5 @@ module Main where -import Ide.Types +import GHC.Lexeme main = putStrLn "Hello, Haskell!" \ No newline at end of file diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package/hidden-package.cabal b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-exe/cabal-add-exe.cabal similarity index 82% rename from plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package/hidden-package.cabal rename to plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-exe/cabal-add-exe.cabal index 89d4a29fd4..a3499bbf97 100644 --- a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package/hidden-package.cabal +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-exe/cabal-add-exe.cabal @@ -1,17 +1,15 @@ cabal-version: 2.4 - -name: hidden-package +name: cabal-add-exe version: 0.1.0.0 build-type: Simple -executable hidden-package +executable cabal-add-exe main-is: Main.hs hs-source-dirs: src ghc-options: -Wall build-depends: base default-language: Haskell2010 - library build-depends: base >= 4 && < 5 ghc-options: -Wall diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package/src/Main.hs b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-exe/src/Main.hs similarity index 100% rename from plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package/src/Main.hs rename to plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-exe/src/Main.hs diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-lib/hidden-package-lib.cabal b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-lib/cabal-add-lib.cabal similarity index 90% rename from plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-lib/hidden-package-lib.cabal rename to plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-lib/cabal-add-lib.cabal index e783054d35..b00b45bb6b 100644 --- a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-lib/hidden-package-lib.cabal +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-lib/cabal-add-lib.cabal @@ -1,5 +1,5 @@ cabal-version: 2.4 -name: hidden-package-lib +name: cabal-add-lib version: 0.1.0.0 license: NONE author: George Gerasev diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-lib/src/MyLib.hs b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-lib/src/MyLib.hs similarity index 100% rename from plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-lib/src/MyLib.hs rename to plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-lib/src/MyLib.hs diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-tests/hidden-package-tests.cabal b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-tests/cabal-add-tests.cabal similarity index 84% rename from plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-tests/hidden-package-tests.cabal rename to plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-tests/cabal-add-tests.cabal index f9b6fe7097..d217f8c4d5 100644 --- a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-tests/hidden-package-tests.cabal +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-tests/cabal-add-tests.cabal @@ -1,5 +1,5 @@ cabal-version: 2.4 -name: hidden-package-tests +name: cabal-add-tests version: 0.1.0.0 license: NONE author: George Gerasev @@ -9,7 +9,7 @@ build-type: Simple common warnings ghc-options: -Wall -test-suite hidden-package-tests-test +test-suite cabal-add-tests-test import: warnings default-language: Haskell2010 type: exitcode-stdio-1.0 diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-tests/test/Main.hs b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-tests/test/Main.hs similarity index 100% rename from plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hidden-package-tests/test/Main.hs rename to plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-tests/test/Main.hs diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal.project b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal.project index f36da21488..bd26d41cc0 100644 --- a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal.project +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal.project @@ -1,5 +1,5 @@ -packages: hidden-package - hidden-package-dashed - hidden-package-lib - hidden-package-tests - hidden-package-bench +packages: cabal-add-exe + cabal-add-dashed + cabal-add-lib + cabal-add-tests + cabal-add-bench diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hie.yaml b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hie.yaml index ddd86720b9..f0c7014d7f 100644 --- a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hie.yaml +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/hie.yaml @@ -1,3 +1,2 @@ cradle: - cabal: - component: "exe:hidden-package" \ No newline at end of file + cabal: \ No newline at end of file From c05ee6d56f532ee2d6937f31b15c887952b4db0e Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Tue, 6 Aug 2024 18:11:41 +0300 Subject: [PATCH 38/65] formatting and cleanup --- .../src/Ide/Plugin/Cabal/CabalAdd.hs | 55 +++++++++---------- plugins/hls-cabal-plugin/test/Main.hs | 12 ---- plugins/hls-cabal-plugin/test/Utils.hs | 3 +- 3 files changed, 28 insertions(+), 42 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 3aad02b089..e3779b1d54 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -10,7 +10,6 @@ module Ide.Plugin.Cabal.CabalAdd ( findResponsibleCabalFile , hiddenPackageAction - , hiddenPackageSuggestion , cabalAddCommand , command , Log @@ -19,34 +18,6 @@ where import Control.Monad (filterM, void) import Control.Monad.IO.Class (MonadIO, liftIO) -import Data.String (IsString) -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import Development.IDE (IdeState, - useWithStale) -import Distribution.PackageDescription.Quirks (patchQuirks) -import Ide.PluginUtils (WithDeletions (SkipDeletions), - diffText, - mkLspCommand) -import Ide.Types (CommandFunction, - CommandId (CommandId), - HandlerM, - PluginId, - pluginGetClientCapabilities, - pluginSendRequest) -import Language.LSP.Protocol.Types (ApplyWorkspaceEditParams (ApplyWorkspaceEditParams), - ClientCapabilities, - CodeAction (CodeAction), - CodeActionKind (CodeActionKind_QuickFix), - Diagnostic (..), - Null (Null), - VersionedTextDocumentIdentifier, - WorkspaceEdit, - toNormalizedFilePath, - type (|?) (InR)) -import System.Directory (doesFileExist, - listDirectory) - import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except import Data.Aeson.Types (FromJSON, @@ -55,7 +26,12 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B import Data.List.NonEmpty (NonEmpty (..), fromList) +import Data.String (IsString) +import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) +import qualified Data.Text.Encoding as T +import Development.IDE (IdeState, + useWithStale) import Development.IDE.Core.Rules (runAction) import Development.IDE.Core.RuleTypes (GetFileContents (..)) import Distribution.Client.Add as Add @@ -64,6 +40,7 @@ import Distribution.PackageDescription (GenericPackageDe packageDescription, specVersion) import Distribution.PackageDescription.Configuration (flattenPackageDescription) +import Distribution.PackageDescription.Quirks (patchQuirks) import Distribution.Pretty (pretty) import Distribution.Simple.BuildTarget (BuildTarget, buildTargetComponentName, @@ -76,7 +53,27 @@ import Ide.Plugin.Cabal.Completion.Types (ParseCabalFields ParseCabalFile (..)) import Ide.Plugin.Cabal.Orphans () import Ide.Plugin.Error +import Ide.PluginUtils (WithDeletions (SkipDeletions), + diffText, + mkLspCommand) +import Ide.Types (CommandFunction, + CommandId (CommandId), + PluginId, + pluginGetClientCapabilities, + pluginSendRequest) import Language.LSP.Protocol.Message (SMethod (SMethod_WorkspaceApplyEdit)) +import Language.LSP.Protocol.Types (ApplyWorkspaceEditParams (ApplyWorkspaceEditParams), + ClientCapabilities, + CodeAction (CodeAction), + CodeActionKind (CodeActionKind_QuickFix), + Diagnostic (..), + Null (Null), + VersionedTextDocumentIdentifier, + WorkspaceEdit, + toNormalizedFilePath, + type (|?) (InR)) +import System.Directory (doesFileExist, + listDirectory) import System.FilePath (dropFileName, makeRelative, splitPath, diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index f92d31eac9..ebe3c514c6 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -223,18 +223,6 @@ codeActionTests = testGroup "Code Actions" ]) cas mapM_ executeCodeAction selectedCas pure () - -- , runHaskellTestCaseSession "Code Actions - Can add hidden package" ("cabal-add-testdata" "cabal-add-exe") $ do - -- hsdoc <- openDoc ("src" "Main.hs") "haskell" - -- cabDoc <- openDoc "cabal-add-exe.cabal" "cabal" - -- _ <- waitForDiagnosticsFrom hsdoc - -- cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions hsdoc - -- let selectedCas = filter (\ca -> "Add dependency" `T.isPrefixOf` (ca ^. L.title)) cas - -- -- traceShowM("selectedCas", selectedCas) - -- mapM_ executeCodeAction selectedCas - -- _ <- skipManyTill anyMessage $ getDocumentEdit cabDoc - -- contents <- documentContents cabDoc - -- -- traceShowM("contents", contents) - -- liftIO $ assertEqual "Split isn't found in the cabal file" (Text.indices "split" contents) [256] , runHaskellTestCaseSession "Code Actions - Can add hidden package" ("cabal-add-testdata" "cabal-add-exe") (generateHiddenPackageTestSession "cabal-add-exe.cabal" ("src" "Main.hs") "split" [253]) , runHaskellTestCaseSession "Code Actions - Can add dashed hidden package" ("cabal-add-testdata" "cabal-add-dashed") diff --git a/plugins/hls-cabal-plugin/test/Utils.hs b/plugins/hls-cabal-plugin/test/Utils.hs index 37f6d37d58..b7a9795787 100644 --- a/plugins/hls-cabal-plugin/test/Utils.hs +++ b/plugins/hls-cabal-plugin/test/Utils.hs @@ -8,7 +8,8 @@ import Control.Monad (guard) import Data.List (sort) import Data.Proxy (Proxy (Proxy)) import qualified Data.Text as T -import Ide.Plugin.Cabal (descriptor, haskellFilesDescriptor) +import Ide.Plugin.Cabal (descriptor, + haskellFilesDescriptor) import qualified Ide.Plugin.Cabal import Ide.Plugin.Cabal.Completion.Types import System.FilePath From 1959d7451f7da87a29bc5b5e00a1f9bfbdd4353c Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Wed, 7 Aug 2024 18:10:14 +0300 Subject: [PATCH 39/65] schema update --- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs | 2 +- test/testdata/schema/ghc94/default-config.golden.json | 3 +++ .../schema/ghc94/vscode-extension-schema.golden.json | 6 ++++++ test/testdata/schema/ghc96/default-config.golden.json | 3 +++ .../schema/ghc96/vscode-extension-schema.golden.json | 6 ++++++ test/testdata/schema/ghc98/default-config.golden.json | 3 +++ .../schema/ghc98/vscode-extension-schema.golden.json | 6 ++++++ 7 files changed, 28 insertions(+), 1 deletion(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index e3779b1d54..1c23ad5a93 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -236,7 +236,7 @@ getDependencyEdit recorder env cabalFilePath buildTarget dependency = do pure edit -- | Given a path to a haskell file, returns the closest cabal file. --- If cabal file wasn't found, dives Nothing. +-- If cabal file wasn't found, gives Nothing. findResponsibleCabalFile :: FilePath -> IO (Maybe FilePath) findResponsibleCabalFile haskellFilePath = do let dirPath = dropFileName haskellFilePath diff --git a/test/testdata/schema/ghc94/default-config.golden.json b/test/testdata/schema/ghc94/default-config.golden.json index 5f881ff00e..6ac4a44c1f 100644 --- a/test/testdata/schema/ghc94/default-config.golden.json +++ b/test/testdata/schema/ghc94/default-config.golden.json @@ -24,6 +24,9 @@ "path": "cabal-gild" } }, + "cabaladd": { + "globalOn": true + }, "callHierarchy": { "globalOn": true }, diff --git a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json index 5da4a27dd6..ca88649fd7 100644 --- a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json @@ -41,6 +41,12 @@ "scope": "resource", "type": "boolean" }, + "haskell.plugin.cabaladd.globalOn": { + "default": true, + "description": "Enables cabaladd plugin", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.callHierarchy.globalOn": { "default": true, "description": "Enables callHierarchy plugin", diff --git a/test/testdata/schema/ghc96/default-config.golden.json b/test/testdata/schema/ghc96/default-config.golden.json index 5f881ff00e..6ac4a44c1f 100644 --- a/test/testdata/schema/ghc96/default-config.golden.json +++ b/test/testdata/schema/ghc96/default-config.golden.json @@ -24,6 +24,9 @@ "path": "cabal-gild" } }, + "cabaladd": { + "globalOn": true + }, "callHierarchy": { "globalOn": true }, diff --git a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json index 5da4a27dd6..ca88649fd7 100644 --- a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json @@ -41,6 +41,12 @@ "scope": "resource", "type": "boolean" }, + "haskell.plugin.cabaladd.globalOn": { + "default": true, + "description": "Enables cabaladd plugin", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.callHierarchy.globalOn": { "default": true, "description": "Enables callHierarchy plugin", diff --git a/test/testdata/schema/ghc98/default-config.golden.json b/test/testdata/schema/ghc98/default-config.golden.json index 5f881ff00e..6ac4a44c1f 100644 --- a/test/testdata/schema/ghc98/default-config.golden.json +++ b/test/testdata/schema/ghc98/default-config.golden.json @@ -24,6 +24,9 @@ "path": "cabal-gild" } }, + "cabaladd": { + "globalOn": true + }, "callHierarchy": { "globalOn": true }, diff --git a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json index 5da4a27dd6..ca88649fd7 100644 --- a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json @@ -41,6 +41,12 @@ "scope": "resource", "type": "boolean" }, + "haskell.plugin.cabaladd.globalOn": { + "default": true, + "description": "Enables cabaladd plugin", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.callHierarchy.globalOn": { "default": true, "description": "Enables callHierarchy plugin", From 3f5d4f73bc6fa74f4aa5fe0f4b740329e8b5a02c Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Wed, 7 Aug 2024 18:11:46 +0300 Subject: [PATCH 40/65] test assertion order fix --- plugins/hls-cabal-plugin/test/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index ebe3c514c6..f46ab3b85a 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -252,7 +252,7 @@ codeActionTests = testGroup "Code Actions" mapM_ executeCodeAction selectedCas _ <- skipManyTill anyMessage $ getDocumentEdit cabDoc -- Wait for the changes in cabal file contents <- documentContents cabDoc - liftIO $ assertEqual (T.unpack dependency <> " isn't found in the cabal file") (Text.indices dependency contents) indicesRes + liftIO $ assertEqual (T.unpack dependency <> " isn't found in the cabal file") indicesRes (Text.indices dependency contents) -- ---------------------------------------------------------------------------- -- Goto Definition Tests From 5157063ce3cd2d675015f3f197f4a63f4281fe56 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Wed, 7 Aug 2024 20:04:56 +0300 Subject: [PATCH 41/65] test dashed change --- plugins/hls-cabal-plugin/test/Main.hs | 2 +- .../testdata/cabal-add-testdata/cabal-add-dashed/src/Main.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index f46ab3b85a..a13ab6f885 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -226,7 +226,7 @@ codeActionTests = testGroup "Code Actions" , runHaskellTestCaseSession "Code Actions - Can add hidden package" ("cabal-add-testdata" "cabal-add-exe") (generateHiddenPackageTestSession "cabal-add-exe.cabal" ("src" "Main.hs") "split" [253]) , runHaskellTestCaseSession "Code Actions - Can add dashed hidden package" ("cabal-add-testdata" "cabal-add-dashed") - (generateHiddenPackageTestSession "cabal-add-dashed.cabal" ("src" "Main.hs") "ghc-boot-th" [260]) + (generateHiddenPackageTestSession "cabal-add-dashed.cabal" ("src" "Main.hs") "ghc-boot" [260]) , runHaskellTestCaseSession "Code Actions - Can add hidden package to a library" ("cabal-add-testdata" "cabal-add-lib") (generateHiddenPackageTestSession "cabal-add-lib.cabal" ("src" "MyLib.hs") "split" [348]) , runHaskellTestCaseSession "Code Actions - Can add hidden package to a test" ("cabal-add-testdata" "cabal-add-tests") diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-dashed/src/Main.hs b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-dashed/src/Main.hs index 8bfdf21bed..976f77859f 100644 --- a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-dashed/src/Main.hs +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-dashed/src/Main.hs @@ -1,5 +1,5 @@ module Main where -import GHC.Lexeme +import GHC.BaseDir main = putStrLn "Hello, Haskell!" \ No newline at end of file From 0b335fdba53779973c2c3538b63e56333fcf9b5f Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Thu, 8 Aug 2024 23:52:50 +0300 Subject: [PATCH 42/65] regex tests --- .../src/Ide/Plugin/Cabal/CabalAdd.hs | 10 +-- plugins/hls-cabal-plugin/test/Main.hs | 85 ++++++++++++++++++- .../cabal-add-dashed/cabal-add-dashed.cabal | 12 --- .../cabal-add-dashed/src/Main.hs | 5 -- .../testdata/cabal-add-testdata/cabal.project | 1 - 5 files changed, 87 insertions(+), 26 deletions(-) delete mode 100644 plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-dashed/cabal-add-dashed.cabal delete mode 100644 plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-dashed/src/Main.hs diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 1c23ad5a93..ac7be7093c 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -10,6 +10,7 @@ module Ide.Plugin.Cabal.CabalAdd ( findResponsibleCabalFile , hiddenPackageAction + , hiddenPackageSuggestion , cabalAddCommand , command , Log @@ -143,15 +144,14 @@ hiddenPackageSuggestion :: Int -> T.Text -> [(T.Text, T.Text)] hiddenPackageSuggestion maxCompletions msg = take maxCompletions $ getMatch (msg =~ regex) where regex :: T.Text -- TODO: Support multiple packages suggestion - regex = "It is a member of the hidden package [\8216']([a-z-]+)(-([0-9\\.]*))?[\8217']" + regex = "It is a member of the hidden package [\8216']([a-zA-Z0-9-]*[a-zA-Z0-9])(-([0-9\\.]*))?[\8217']" + -- Have to do this matching because `Regex.TDFA` doesn't(?) support + -- not-capturing groups like (?:message) getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> [(T.Text, T.Text)] getMatch (_, _, _, []) = [] - getMatch (_, _, _, [dependency]) = [(dependency, T.empty)] - getMatch (_, _, _, [dependency, dashedVersion]) = [(dependency, T.empty)] -- failed to get version - getMatch (_, _, _, [dependency, dashedVersion, cleanVersion]) = [(dependency, cleanVersion)] + getMatch (_, _, _, [dependency, _, cleanVersion]) = [(dependency, cleanVersion)] getMatch (_, _, _, _) = error "Impossible pattern matching case" - cabalAddCommand :: IsString p => p cabalAddCommand = "cabalAdd" diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index a13ab6f885..72fb708388 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -26,6 +26,8 @@ import Outline (outlineTests) import System.FilePath import Test.Hls import Utils +import Ide.Plugin.Cabal.CabalAdd (hiddenPackageSuggestion) +import Distribution.Utils.Generic (safeHead) main :: IO () main = do @@ -225,15 +227,84 @@ codeActionTests = testGroup "Code Actions" pure () , runHaskellTestCaseSession "Code Actions - Can add hidden package" ("cabal-add-testdata" "cabal-add-exe") (generateHiddenPackageTestSession "cabal-add-exe.cabal" ("src" "Main.hs") "split" [253]) - , runHaskellTestCaseSession "Code Actions - Can add dashed hidden package" ("cabal-add-testdata" "cabal-add-dashed") - (generateHiddenPackageTestSession "cabal-add-dashed.cabal" ("src" "Main.hs") "ghc-boot" [260]) , runHaskellTestCaseSession "Code Actions - Can add hidden package to a library" ("cabal-add-testdata" "cabal-add-lib") (generateHiddenPackageTestSession "cabal-add-lib.cabal" ("src" "MyLib.hs") "split" [348]) , runHaskellTestCaseSession "Code Actions - Can add hidden package to a test" ("cabal-add-testdata" "cabal-add-tests") (generateHiddenPackageTestSession "cabal-add-tests.cabal" ("test" "Main.hs") "split" [478]) , runHaskellTestCaseSession "Code Actions - Can add hidden package to a benchmark" ("cabal-add-testdata" "cabal-add-bench") (generateHiddenPackageTestSession "cabal-add-bench.cabal" ("bench" "Main.hs") "split" [403]) - + , testHiddenPackageSuggestions "Check CabalAdd's parser, no version" + [ "It is a member of the hidden package 'base'" + , "It is a member of the hidden package 'Blammo-wai'" + , "It is a member of the hidden package 'BlastHTTP'" + , "It is a member of the hidden package 'CC-delcont-ref-tf'" + , "It is a member of the hidden package '3d-graphics-examples'" + , "It is a member of the hidden package 'AAI'" + , "It is a member of the hidden package 'AWin32Console'" + ] + [ ("base", T.empty) + , ("Blammo-wai", T.empty) + , ("BlastHTTP", T.empty) + , ("CC-delcont-ref-tf", T.empty) + , ("3d-graphics-examples", T.empty) + , ("AAI", T.empty) + , ("AWin32Console", T.empty) + ] + , testHiddenPackageSuggestions "Check CabalAdd's parser, with version" + [ "It is a member of the hidden package 'base-0.1.0.0'" + , "It is a member of the hidden package 'Blammo-wai-0.11.0'" + , "It is a member of the hidden package 'BlastHTTP-2.6.4.3'" + , "It is a member of the hidden package 'CC-delcont-ref-tf-0.0.0.2'" + , "It is a member of the hidden package '3d-graphics-examples-1.1.6'" + , "It is a member of the hidden package 'AAI-0.1'" + , "It is a member of the hidden package 'AWin32Console-1.19.1'" + ] + [ ("base","0.1.0.0") + , ("Blammo-wai", "0.11.0") + , ("BlastHTTP", "2.6.4.3") + , ("CC-delcont-ref-tf", "0.0.0.2") + , ("3d-graphics-examples", "1.1.6") + , ("AAI", "0.1") + , ("AWin32Console", "1.19.1") + ] + , testHiddenPackageSuggestions "Check CabalAdd's parser, no version, unicode comma" + [ "It is a member of the hidden package \8216base\8217" + , "It is a member of the hidden package \8216Blammo-wai\8217" + , "It is a member of the hidden package \8216BlastHTTP\8217" + , "It is a member of the hidden package \8216CC-delcont-ref-tf\8217" + , "It is a member of the hidden package \8216AAI\8217" + , "It is a member of the hidden package \8216AWin32Console\8217" + ] + [ ("base", T.empty) + , ("Blammo-wai", T.empty) + , ("BlastHTTP", T.empty) + , ("CC-delcont-ref-tf", T.empty) + , ("AAI", T.empty) + , ("AWin32Console", T.empty) + ] + , testHiddenPackageSuggestions "Check CabalAdd's parser, with version, unicode comma" + [ "It is a member of the hidden package \8216base-0.1.0.0\8217" + , "It is a member of the hidden package \8216Blammo-wai-0.11.0\8217" + , "It is a member of the hidden package \8216BlastHTTP-2.6.4.3\8217" + , "It is a member of the hidden package \8216CC-delcont-ref-tf-0.0.0.2\8217" + , "It is a member of the hidden package \8216AAI-0.1\8217" + , "It is a member of the hidden package \8216AWin32Console-1.19.1\8217" + ] + [ ("base","0.1.0.0") + , ("Blammo-wai", "0.11.0") + , ("BlastHTTP", "2.6.4.3") + , ("CC-delcont-ref-tf", "0.0.0.2") + , ("AAI", "0.1") + , ("AWin32Console", "1.19.1") + ] + , expectFailBecause "TODO fix regex for these cases" $ + testHiddenPackageSuggestions "Check CabalAdd's parser, with version, unicode comma" + [ "It is a member of the hidden package \82163d-graphics-examples\8217" + , "It is a member of the hidden package \82163d-graphics-examples-1.1.6\8217" + ] + [ ("3d-graphics-examples", T.empty) + , ("3d-graphics-examples", "1.1.6") + ] ] where getLicenseAction :: T.Text -> [Command |? CodeAction] -> [CodeAction] @@ -254,6 +325,14 @@ codeActionTests = testGroup "Code Actions" contents <- documentContents cabDoc liftIO $ assertEqual (T.unpack dependency <> " isn't found in the cabal file") indicesRes (Text.indices dependency contents) + testHiddenPackageSuggestions :: String -> [T.Text] -> [(T.Text, T.Text)] -> TestTree + testHiddenPackageSuggestions testTitle messages suggestions = + let suggestions' = map (safeHead . hiddenPackageSuggestion 1) messages + assertions = zipWith (@?=) suggestions' (map Just suggestions) + testNames = map (\(f, s) -> "Check if " ++ T.unpack f ++ "-" ++ T.unpack s ++ " was parsed correctly") suggestions + test = testGroup testTitle $ zipWith testCase testNames assertions + in test + -- ---------------------------------------------------------------------------- -- Goto Definition Tests -- ---------------------------------------------------------------------------- diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-dashed/cabal-add-dashed.cabal b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-dashed/cabal-add-dashed.cabal deleted file mode 100644 index ba9d951e48..0000000000 --- a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-dashed/cabal-add-dashed.cabal +++ /dev/null @@ -1,12 +0,0 @@ -cabal-version: 2.4 - -name: cabal-add-dashed -version: 0.1.0.0 -build-type: Simple - -executable cabal-add-dashed - main-is: Main.hs - hs-source-dirs: src - ghc-options: -Wall - build-depends: base - default-language: Haskell2010 diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-dashed/src/Main.hs b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-dashed/src/Main.hs deleted file mode 100644 index 976f77859f..0000000000 --- a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal-add-dashed/src/Main.hs +++ /dev/null @@ -1,5 +0,0 @@ -module Main where - -import GHC.BaseDir - -main = putStrLn "Hello, Haskell!" \ No newline at end of file diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal.project b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal.project index bd26d41cc0..dfa2feed39 100644 --- a/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal.project +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-add-testdata/cabal.project @@ -1,5 +1,4 @@ packages: cabal-add-exe - cabal-add-dashed cabal-add-lib cabal-add-tests cabal-add-bench From 7704af3ab825c7af822c7760a9021d6864660f58 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Thu, 8 Aug 2024 23:54:17 +0300 Subject: [PATCH 43/65] formatting --- plugins/hls-cabal-plugin/test/Main.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 72fb708388..92a1d9be07 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -18,6 +18,8 @@ import qualified Data.Maybe as Maybe import qualified Data.Text as T import qualified Data.Text as Text import qualified Data.Text.Internal.Search as Text +import Distribution.Utils.Generic (safeHead) +import Ide.Plugin.Cabal.CabalAdd (hiddenPackageSuggestion) import Ide.Plugin.Cabal.LicenseSuggest (licenseErrorSuggestion) import qualified Ide.Plugin.Cabal.Parse as Lib import qualified Language.LSP.Protocol.Lens as L @@ -26,8 +28,6 @@ import Outline (outlineTests) import System.FilePath import Test.Hls import Utils -import Ide.Plugin.Cabal.CabalAdd (hiddenPackageSuggestion) -import Distribution.Utils.Generic (safeHead) main :: IO () main = do From a661b3bce3dcd535eadbfbe534977d60f7c4effe Mon Sep 17 00:00:00 2001 From: Georgii Gerasev <54953043+VenInf@users.noreply.github.com> Date: Wed, 14 Aug 2024 16:28:56 +0300 Subject: [PATCH 44/65] Update plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs Co-authored-by: VeryMilkyJoe --- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index ac7be7093c..53cea65c86 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -186,7 +186,7 @@ command recorder state _ params@(CabalAddCommandParams {cabalPath = path, verTxt Logger.logWith recorder Logger.Info LogExecutedCommand pure $ InR Null --- | Constructs prerequisets for the @executeConfig@ +-- | Constructs prerequisites for the @executeConfig@ -- and runs it, given path to the cabal file and a dependency message. -- Given the new contents of the cabal file constructs and returns the @edit@. -- Inspired by @main@ in cabal-add, From 11a7496c7e74d381011596f0265fe57e1d890815 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Wed, 14 Aug 2024 21:05:26 +0300 Subject: [PATCH 45/65] tests, formatting, other --- haskell-language-server.cabal | 1 + .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 12 +- .../src/Ide/Plugin/Cabal/CabalAdd.hs | 60 +++++---- plugins/hls-cabal-plugin/test/CabalAdd.hs | 123 ++++++++++++++++++ plugins/hls-cabal-plugin/test/Main.hs | 89 +------------ 5 files changed, 170 insertions(+), 115 deletions(-) create mode 100644 plugins/hls-cabal-plugin/test/CabalAdd.hs diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index fc0a53741b..e89f22ad8a 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -291,6 +291,7 @@ test-suite hls-cabal-plugin-tests Context Utils Outline + CabalAdd build-depends: , base , bytestring diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 52c16526e7..2bf8063109 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -331,7 +331,7 @@ gotoDefinition ideState _ msgParam = do isSectionArgName _ _ = False cabalAddCodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction -cabalAddCodeAction recorder state plId (CodeActionParams _ _ docId@(TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do +cabalAddCodeAction recorder state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do maxCompls <- fmap maxCompletions . liftIO $ runAction "cabal.cabal-add" state getClientConfigAction let mbHaskellFilePath = uriToFilePath uri case mbHaskellFilePath of @@ -342,12 +342,14 @@ cabalAddCodeAction recorder state plId (CodeActionParams _ _ docId@(TextDocument Nothing -> pure $ InL $ fmap InR [noCabalFileAction] Just cabalFilePath -> do verTxtDocId <- lift $ pluginGetVersionedTextDoc $ TextDocumentIdentifier (filePathToUri cabalFilePath) - mGPD <- liftIO $ runAction "cabal.cabal-add" state $ useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath - case mGPD of + mbGPD <- liftIO $ runAction "cabal.cabal-add" state $ useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath + case mbGPD of Nothing -> pure $ InL [] Just (gpd, _) -> do - actions <- liftIO $ mapM (\diag -> CabalAdd.hiddenPackageAction cabalAddRecorder plId verTxtDocId - maxCompls diag haskellFilePath cabalFilePath gpd) diags + actions <- liftIO $ mapM (\diag -> + CabalAdd.addDependencySuggestCodeAction cabalAddRecorder plId + verTxtDocId maxCompls diag + haskellFilePath cabalFilePath gpd) diags pure $ InL $ fmap InR (concat actions) where noCabalFileAction = CodeAction "No .cabal file found" (Just CodeActionKind_QuickFix) (Just []) Nothing diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 53cea65c86..f3129f98ae 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -9,7 +9,7 @@ module Ide.Plugin.Cabal.CabalAdd ( findResponsibleCabalFile - , hiddenPackageAction + , addDependencySuggestCodeAction , hiddenPackageSuggestion , cabalAddCommand , command @@ -99,13 +99,42 @@ instance Logger.Pretty Log where LogCreatedEdit edit -> "Created inplace edit:\n" Logger.<+> Logger.pretty edit LogExecutedCommand -> "Executed CabalAdd command" +cabalAddCommand :: IsString p => p +cabalAddCommand = "cabalAdd" + +data CabalAddCommandParams = + CabalAddCommandParams { cabalPath :: FilePath + , verTxtDocId :: VersionedTextDocumentIdentifier + , buildTarget :: Maybe String + , dependency :: T.Text + , version :: Maybe T.Text + } + deriving (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +instance Logger.Pretty CabalAddCommandParams where + pretty CabalAddCommandParams{..} = + "CabalAdd parameters:\n" Logger.<+> + "| cabal path: " Logger.<+> Logger.pretty cabalPath Logger.<+> "\n" Logger.<+> + "| target: " Logger.<+> Logger.pretty buildTarget Logger.<+> "\n" Logger.<+> + "| dependendency: " Logger.<+> Logger.pretty dependency Logger.<+> "\n" Logger.<+> + "| version: " Logger.<+> Logger.pretty version Logger.<+> "\n" -- | Gives a code action that calls the command, -- if a suggestion for a missing dependency is found. -- Disabled action if no cabal files given. -- Conducts IO action on a cabal file to find build targets. -hiddenPackageAction :: Logger.Recorder (Logger.WithPriority Log) -> PluginId -> VersionedTextDocumentIdentifier -> Int -> Diagnostic -> FilePath -> FilePath -> GenericPackageDescription -> IO [CodeAction] -hiddenPackageAction recorder plId verTxtDocId maxCompletions diag haskellFilePath cabalFilePath gpd = do +addDependencySuggestCodeAction + :: Logger.Recorder (Logger.WithPriority Log) + -> PluginId + -> VersionedTextDocumentIdentifier -- ^ Cabal's versioned text identifier + -> Int -- ^ Maximum number of suggestions to return + -> Diagnostic -- ^ Diagnostic from a code action + -> FilePath -- ^ Path to the haskell file + -> FilePath -- ^ Path to the cabal file + -> GenericPackageDescription + -> IO [CodeAction] +addDependencySuggestCodeAction recorder plId verTxtDocId maxCompletions diag haskellFilePath cabalFilePath gpd = do buildTargets <- liftIO $ getBuildTargets gpd cabalFilePath haskellFilePath Logger.logWith recorder Logger.Info LogCalledCabalAddCodeAction case buildTargets of @@ -138,8 +167,8 @@ hiddenPackageAction recorder plId verTxtDocId maxCompletions diag haskellFilePat command = mkLspCommand plId (CommandId cabalAddCommand) "Execute Code Action" (Just [toJSON params]) in CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing Nothing (Just command) Nothing --- | Gives a mentioned number of hidden packages given --- a specific error message +-- | Gives a mentioned number of @(dependency, version)@ pairs +-- found in the "hidden package" message hiddenPackageSuggestion :: Int -> T.Text -> [(T.Text, T.Text)] hiddenPackageSuggestion maxCompletions msg = take maxCompletions $ getMatch (msg =~ regex) where @@ -152,27 +181,6 @@ hiddenPackageSuggestion maxCompletions msg = take maxCompletions $ getMatch (msg getMatch (_, _, _, [dependency, _, cleanVersion]) = [(dependency, cleanVersion)] getMatch (_, _, _, _) = error "Impossible pattern matching case" -cabalAddCommand :: IsString p => p -cabalAddCommand = "cabalAdd" - -data CabalAddCommandParams = - CabalAddCommandParams { cabalPath :: FilePath - , verTxtDocId :: VersionedTextDocumentIdentifier - , buildTarget :: Maybe String - , dependency :: T.Text - , version :: Maybe T.Text - } - deriving (Generic, Show) - deriving anyclass (FromJSON, ToJSON) - -instance Logger.Pretty CabalAddCommandParams where - pretty CabalAddCommandParams{..} = - "CabalAdd parameters:\n" Logger.<+> - "| cabal path: " Logger.<+> Logger.pretty cabalPath Logger.<+> "\n" Logger.<+> - "| target: " Logger.<+> Logger.pretty buildTarget Logger.<+> "\n" Logger.<+> - "| dependendency: " Logger.<+> Logger.pretty dependency Logger.<+> "\n" Logger.<+> - "| version: " Logger.<+> Logger.pretty version Logger.<+> "\n" - command :: Logger.Recorder (Logger.WithPriority Log) -> CommandFunction IdeState CabalAddCommandParams command recorder state _ params@(CabalAddCommandParams {cabalPath = path, verTxtDocId = verTxtDocId, buildTarget = target, dependency = dep, version = mbVer}) = do Logger.logWith recorder Logger.Info $ LogCalledCabalAddCommand params diff --git a/plugins/hls-cabal-plugin/test/CabalAdd.hs b/plugins/hls-cabal-plugin/test/CabalAdd.hs new file mode 100644 index 0000000000..009aaa9723 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/CabalAdd.hs @@ -0,0 +1,123 @@ +{-# LANGUAGE OverloadedStrings #-} + +module CabalAdd ( + cabalAddTests, +) where + +import Test.Hls +import Control.Lens ((^.)) +import Control.Lens.Fold ((^?)) +import qualified Data.Text as T +import qualified Data.Text.Internal.Search as T +import qualified Language.LSP.Protocol.Lens as L +import qualified Data.Maybe as Maybe +import Distribution.Utils.Generic (safeHead) +import System.FilePath +import Ide.Plugin.Cabal.CabalAdd (hiddenPackageSuggestion) +import Utils + + +cabalAddTests :: TestTree +cabalAddTests = + testGroup + "CabalAdd Tests" + [ runHaskellTestCaseSession "Code Actions - Can add hidden package" ("cabal-add-testdata" "cabal-add-exe") + (generateAddDependencyTestSession "cabal-add-exe.cabal" ("src" "Main.hs") "split" [253]) + , runHaskellTestCaseSession "Code Actions - Can add hidden package to a library" ("cabal-add-testdata" "cabal-add-lib") + (generateAddDependencyTestSession "cabal-add-lib.cabal" ("src" "MyLib.hs") "split" [348]) + , runHaskellTestCaseSession "Code Actions - Can add hidden package to a test" ("cabal-add-testdata" "cabal-add-tests") + (generateAddDependencyTestSession "cabal-add-tests.cabal" ("test" "Main.hs") "split" [478]) + , runHaskellTestCaseSession "Code Actions - Can add hidden package to a benchmark" ("cabal-add-testdata" "cabal-add-bench") + (generateAddDependencyTestSession "cabal-add-bench.cabal" ("bench" "Main.hs") "split" [403]) + , testHiddenPackageSuggestions "Check CabalAdd's parser, no version" + [ "It is a member of the hidden package 'base'" + , "It is a member of the hidden package 'Blammo-wai'" + , "It is a member of the hidden package 'BlastHTTP'" + , "It is a member of the hidden package 'CC-delcont-ref-tf'" + , "It is a member of the hidden package '3d-graphics-examples'" + , "It is a member of the hidden package 'AAI'" + , "It is a member of the hidden package 'AWin32Console'" + ] + [ ("base", T.empty) + , ("Blammo-wai", T.empty) + , ("BlastHTTP", T.empty) + , ("CC-delcont-ref-tf", T.empty) + , ("3d-graphics-examples", T.empty) + , ("AAI", T.empty) + , ("AWin32Console", T.empty) + ] + , testHiddenPackageSuggestions "Check CabalAdd's parser, with version" + [ "It is a member of the hidden package 'base-0.1.0.0'" + , "It is a member of the hidden package 'Blammo-wai-0.11.0'" + , "It is a member of the hidden package 'BlastHTTP-2.6.4.3'" + , "It is a member of the hidden package 'CC-delcont-ref-tf-0.0.0.2'" + , "It is a member of the hidden package '3d-graphics-examples-1.1.6'" + , "It is a member of the hidden package 'AAI-0.1'" + , "It is a member of the hidden package 'AWin32Console-1.19.1'" + ] + [ ("base","0.1.0.0") + , ("Blammo-wai", "0.11.0") + , ("BlastHTTP", "2.6.4.3") + , ("CC-delcont-ref-tf", "0.0.0.2") + , ("3d-graphics-examples", "1.1.6") + , ("AAI", "0.1") + , ("AWin32Console", "1.19.1") + ] + , testHiddenPackageSuggestions "Check CabalAdd's parser, no version, unicode comma" + [ "It is a member of the hidden package \8216base\8217" + , "It is a member of the hidden package \8216Blammo-wai\8217" + , "It is a member of the hidden package \8216BlastHTTP\8217" + , "It is a member of the hidden package \8216CC-delcont-ref-tf\8217" + , "It is a member of the hidden package \8216AAI\8217" + , "It is a member of the hidden package \8216AWin32Console\8217" + ] + [ ("base", T.empty) + , ("Blammo-wai", T.empty) + , ("BlastHTTP", T.empty) + , ("CC-delcont-ref-tf", T.empty) + , ("AAI", T.empty) + , ("AWin32Console", T.empty) + ] + , testHiddenPackageSuggestions "Check CabalAdd's parser, with version, unicode comma" + [ "It is a member of the hidden package \8216base-0.1.0.0\8217" + , "It is a member of the hidden package \8216Blammo-wai-0.11.0\8217" + , "It is a member of the hidden package \8216BlastHTTP-2.6.4.3\8217" + , "It is a member of the hidden package \8216CC-delcont-ref-tf-0.0.0.2\8217" + , "It is a member of the hidden package \8216AAI-0.1\8217" + , "It is a member of the hidden package \8216AWin32Console-1.19.1\8217" + ] + [ ("base","0.1.0.0") + , ("Blammo-wai", "0.11.0") + , ("BlastHTTP", "2.6.4.3") + , ("CC-delcont-ref-tf", "0.0.0.2") + , ("AAI", "0.1") + , ("AWin32Console", "1.19.1") + ] + , expectFailBecause "TODO fix regex for these cases" $ + testHiddenPackageSuggestions "Check CabalAdd's parser, with version, unicode comma" + [ "It is a member of the hidden package \82163d-graphics-examples\8217" + , "It is a member of the hidden package \82163d-graphics-examples-1.1.6\8217" + ] + [ ("3d-graphics-examples", T.empty) + , ("3d-graphics-examples", "1.1.6") + ] + ] + where + generateAddDependencyTestSession :: FilePath -> FilePath -> T.Text -> [Int] -> Session () + generateAddDependencyTestSession cabalFile haskellFile dependency indicesRes = do + hsdoc <- openDoc haskellFile "haskell" + cabDoc <- openDoc cabalFile "cabal" + _ <- waitForDiagnosticsFrom hsdoc + cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions hsdoc + let selectedCas = filter (\ca -> "Add dependency" `T.isPrefixOf` (ca ^. L.title)) cas + mapM_ executeCodeAction selectedCas + _ <- skipManyTill anyMessage $ getDocumentEdit cabDoc -- Wait for the changes in cabal file + contents <- documentContents cabDoc + liftIO $ assertEqual (T.unpack dependency <> " isn't found in the cabal file") indicesRes (T.indices dependency contents) + testHiddenPackageSuggestions :: String -> [T.Text] -> [(T.Text, T.Text)] -> TestTree + testHiddenPackageSuggestions testTitle messages suggestions = + let suggestions' = map (safeHead . hiddenPackageSuggestion 1) messages + assertions = zipWith (@?=) suggestions' (map Just suggestions) + testNames = map (\(f, s) -> "Check if " ++ T.unpack f ++ (if s == "" then "" else "-") ++ T.unpack s ++ " was parsed correctly") suggestions + test = testGroup testTitle $ zipWith testCase testNames assertions + in test diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 92a1d9be07..b509232068 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -16,8 +16,6 @@ import Data.Either (isRight) import Data.List.Extra (nubOrdOn) import qualified Data.Maybe as Maybe import qualified Data.Text as T -import qualified Data.Text as Text -import qualified Data.Text.Internal.Search as Text import Distribution.Utils.Generic (safeHead) import Ide.Plugin.Cabal.CabalAdd (hiddenPackageSuggestion) import Ide.Plugin.Cabal.LicenseSuggest (licenseErrorSuggestion) @@ -25,6 +23,7 @@ import qualified Ide.Plugin.Cabal.Parse as Lib import qualified Language.LSP.Protocol.Lens as L import qualified Language.LSP.Protocol.Types as LSP import Outline (outlineTests) +import CabalAdd (cabalAddTests) import System.FilePath import Test.Hls import Utils @@ -169,7 +168,7 @@ codeActionTests = testGroup "Code Actions" contents <- documentContents doc liftIO $ contents - @?= Text.unlines + @?= T.unlines [ "cabal-version: 3.0" , "name: licenseCodeAction" , "version: 0.1.0.0" @@ -193,7 +192,7 @@ codeActionTests = testGroup "Code Actions" contents <- documentContents doc liftIO $ contents - @?= Text.unlines + @?= T.unlines [ "cabal-version: 3.0" , "name: licenseCodeAction2" , "version: 0.1.0.0" @@ -225,86 +224,7 @@ codeActionTests = testGroup "Code Actions" ]) cas mapM_ executeCodeAction selectedCas pure () - , runHaskellTestCaseSession "Code Actions - Can add hidden package" ("cabal-add-testdata" "cabal-add-exe") - (generateHiddenPackageTestSession "cabal-add-exe.cabal" ("src" "Main.hs") "split" [253]) - , runHaskellTestCaseSession "Code Actions - Can add hidden package to a library" ("cabal-add-testdata" "cabal-add-lib") - (generateHiddenPackageTestSession "cabal-add-lib.cabal" ("src" "MyLib.hs") "split" [348]) - , runHaskellTestCaseSession "Code Actions - Can add hidden package to a test" ("cabal-add-testdata" "cabal-add-tests") - (generateHiddenPackageTestSession "cabal-add-tests.cabal" ("test" "Main.hs") "split" [478]) - , runHaskellTestCaseSession "Code Actions - Can add hidden package to a benchmark" ("cabal-add-testdata" "cabal-add-bench") - (generateHiddenPackageTestSession "cabal-add-bench.cabal" ("bench" "Main.hs") "split" [403]) - , testHiddenPackageSuggestions "Check CabalAdd's parser, no version" - [ "It is a member of the hidden package 'base'" - , "It is a member of the hidden package 'Blammo-wai'" - , "It is a member of the hidden package 'BlastHTTP'" - , "It is a member of the hidden package 'CC-delcont-ref-tf'" - , "It is a member of the hidden package '3d-graphics-examples'" - , "It is a member of the hidden package 'AAI'" - , "It is a member of the hidden package 'AWin32Console'" - ] - [ ("base", T.empty) - , ("Blammo-wai", T.empty) - , ("BlastHTTP", T.empty) - , ("CC-delcont-ref-tf", T.empty) - , ("3d-graphics-examples", T.empty) - , ("AAI", T.empty) - , ("AWin32Console", T.empty) - ] - , testHiddenPackageSuggestions "Check CabalAdd's parser, with version" - [ "It is a member of the hidden package 'base-0.1.0.0'" - , "It is a member of the hidden package 'Blammo-wai-0.11.0'" - , "It is a member of the hidden package 'BlastHTTP-2.6.4.3'" - , "It is a member of the hidden package 'CC-delcont-ref-tf-0.0.0.2'" - , "It is a member of the hidden package '3d-graphics-examples-1.1.6'" - , "It is a member of the hidden package 'AAI-0.1'" - , "It is a member of the hidden package 'AWin32Console-1.19.1'" - ] - [ ("base","0.1.0.0") - , ("Blammo-wai", "0.11.0") - , ("BlastHTTP", "2.6.4.3") - , ("CC-delcont-ref-tf", "0.0.0.2") - , ("3d-graphics-examples", "1.1.6") - , ("AAI", "0.1") - , ("AWin32Console", "1.19.1") - ] - , testHiddenPackageSuggestions "Check CabalAdd's parser, no version, unicode comma" - [ "It is a member of the hidden package \8216base\8217" - , "It is a member of the hidden package \8216Blammo-wai\8217" - , "It is a member of the hidden package \8216BlastHTTP\8217" - , "It is a member of the hidden package \8216CC-delcont-ref-tf\8217" - , "It is a member of the hidden package \8216AAI\8217" - , "It is a member of the hidden package \8216AWin32Console\8217" - ] - [ ("base", T.empty) - , ("Blammo-wai", T.empty) - , ("BlastHTTP", T.empty) - , ("CC-delcont-ref-tf", T.empty) - , ("AAI", T.empty) - , ("AWin32Console", T.empty) - ] - , testHiddenPackageSuggestions "Check CabalAdd's parser, with version, unicode comma" - [ "It is a member of the hidden package \8216base-0.1.0.0\8217" - , "It is a member of the hidden package \8216Blammo-wai-0.11.0\8217" - , "It is a member of the hidden package \8216BlastHTTP-2.6.4.3\8217" - , "It is a member of the hidden package \8216CC-delcont-ref-tf-0.0.0.2\8217" - , "It is a member of the hidden package \8216AAI-0.1\8217" - , "It is a member of the hidden package \8216AWin32Console-1.19.1\8217" - ] - [ ("base","0.1.0.0") - , ("Blammo-wai", "0.11.0") - , ("BlastHTTP", "2.6.4.3") - , ("CC-delcont-ref-tf", "0.0.0.2") - , ("AAI", "0.1") - , ("AWin32Console", "1.19.1") - ] - , expectFailBecause "TODO fix regex for these cases" $ - testHiddenPackageSuggestions "Check CabalAdd's parser, with version, unicode comma" - [ "It is a member of the hidden package \82163d-graphics-examples\8217" - , "It is a member of the hidden package \82163d-graphics-examples-1.1.6\8217" - ] - [ ("3d-graphics-examples", T.empty) - , ("3d-graphics-examples", "1.1.6") - ] + , cabalAddTests ] where getLicenseAction :: T.Text -> [Command |? CodeAction] -> [CodeAction] @@ -313,6 +233,7 @@ codeActionTests = testGroup "Code Actions" guard (_title == "Replace with " <> license) pure action + generateHiddenPackageTestSession :: FilePath -> FilePath -> T.Text -> [Int] -> Session () generateHiddenPackageTestSession cabalFile haskellFile dependency indicesRes = do hsdoc <- openDoc haskellFile "haskell" From 37522fa871385cd9381f65d2ff864388094ac19c Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Wed, 14 Aug 2024 21:10:35 +0300 Subject: [PATCH 46/65] formatting --- plugins/hls-cabal-plugin/test/CabalAdd.hs | 18 +++++++++--------- plugins/hls-cabal-plugin/test/Main.hs | 4 +--- 2 files changed, 10 insertions(+), 12 deletions(-) diff --git a/plugins/hls-cabal-plugin/test/CabalAdd.hs b/plugins/hls-cabal-plugin/test/CabalAdd.hs index 009aaa9723..2d2e399136 100644 --- a/plugins/hls-cabal-plugin/test/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/test/CabalAdd.hs @@ -4,16 +4,16 @@ module CabalAdd ( cabalAddTests, ) where -import Test.Hls -import Control.Lens ((^.)) -import Control.Lens.Fold ((^?)) -import qualified Data.Text as T -import qualified Data.Text.Internal.Search as T -import qualified Language.LSP.Protocol.Lens as L -import qualified Data.Maybe as Maybe -import Distribution.Utils.Generic (safeHead) +import Control.Lens ((^.)) +import Control.Lens.Fold ((^?)) +import qualified Data.Maybe as Maybe +import qualified Data.Text as T +import qualified Data.Text.Internal.Search as T +import Distribution.Utils.Generic (safeHead) +import Ide.Plugin.Cabal.CabalAdd (hiddenPackageSuggestion) +import qualified Language.LSP.Protocol.Lens as L import System.FilePath -import Ide.Plugin.Cabal.CabalAdd (hiddenPackageSuggestion) +import Test.Hls import Utils diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index b509232068..9e59b89813 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -6,6 +6,7 @@ module Main ( main, ) where +import CabalAdd (cabalAddTests) import Completer (completerTests) import Context (contextTests) import Control.Lens ((^.)) @@ -16,14 +17,11 @@ import Data.Either (isRight) import Data.List.Extra (nubOrdOn) import qualified Data.Maybe as Maybe import qualified Data.Text as T -import Distribution.Utils.Generic (safeHead) -import Ide.Plugin.Cabal.CabalAdd (hiddenPackageSuggestion) import Ide.Plugin.Cabal.LicenseSuggest (licenseErrorSuggestion) import qualified Ide.Plugin.Cabal.Parse as Lib import qualified Language.LSP.Protocol.Lens as L import qualified Language.LSP.Protocol.Types as LSP import Outline (outlineTests) -import CabalAdd (cabalAddTests) import System.FilePath import Test.Hls import Utils From 1ae361396f5c63aba4a8cc3f2947b217815ea658 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Thu, 15 Aug 2024 00:24:54 +0300 Subject: [PATCH 47/65] descriptor --- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 9 +++++---- plugins/hls-cabal-plugin/test/Utils.hs | 4 ++-- src/HlsPlugins.hs | 2 +- 3 files changed, 8 insertions(+), 7 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 2bf8063109..45d4e834e4 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -4,7 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} -module Ide.Plugin.Cabal (descriptor, haskellFilesDescriptor, Log (..)) where +module Ide.Plugin.Cabal (descriptor, haskellInteractionDescriptor, Log (..)) where import Control.Concurrent.Strict import Control.DeepSeq @@ -92,9 +92,10 @@ instance Pretty Log where LogCompletions logs -> pretty logs LogCabalAdd logs -> pretty logs - -haskellFilesDescriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState -haskellFilesDescriptor recorder plId = +-- | Some actions with cabal files originate from haskell files. +-- This descriptor is needed to handle these cases. +haskellInteractionDescriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState +haskellInteractionDescriptor recorder plId = (defaultPluginDescriptor plId "Provides the cabal-add code action in haskell files") { pluginHandlers = mconcat diff --git a/plugins/hls-cabal-plugin/test/Utils.hs b/plugins/hls-cabal-plugin/test/Utils.hs index b7a9795787..2733f94fd0 100644 --- a/plugins/hls-cabal-plugin/test/Utils.hs +++ b/plugins/hls-cabal-plugin/test/Utils.hs @@ -9,7 +9,7 @@ import Data.List (sort) import Data.Proxy (Proxy (Proxy)) import qualified Data.Text as T import Ide.Plugin.Cabal (descriptor, - haskellFilesDescriptor) + haskellInteractionDescriptor) import qualified Ide.Plugin.Cabal import Ide.Plugin.Cabal.Completion.Types import System.FilePath @@ -20,7 +20,7 @@ cabalPlugin :: PluginTestDescriptor Ide.Plugin.Cabal.Log cabalPlugin = mkPluginTestDescriptor descriptor "cabal" cabalHaskellPlugin :: PluginTestDescriptor Ide.Plugin.Cabal.Log -cabalHaskellPlugin = mkPluginTestDescriptor haskellFilesDescriptor "cabal-haskell" +cabalHaskellPlugin = mkPluginTestDescriptor haskellInteractionDescriptor "cabal-haskell" simpleCabalPrefixInfoFromPos :: Position -> T.Text -> CabalPrefixInfo simpleCabalPrefixInfoFromPos pos prefix = diff --git a/src/HlsPlugins.hs b/src/HlsPlugins.hs index cbfcae52c5..c78bb6af1b 100644 --- a/src/HlsPlugins.hs +++ b/src/HlsPlugins.hs @@ -152,7 +152,7 @@ idePlugins recorder = pluginDescToIdePlugins allPlugins allPlugins = #if hls_cabal let pId = "cabal" in Cabal.descriptor (pluginRecorder pId) pId : - let caId = "cabaladd" in Cabal.haskellFilesDescriptor (pluginRecorder caId) caId : + let caId = "cabaladd" in Cabal.haskellInteractionDescriptor (pluginRecorder caId) caId : #endif #if hls_pragmas Pragmas.suggestPragmaDescriptor "pragmas-suggest" : From f1ef7c99bb38dfdef957ec4f2c6e5494a53b33ac Mon Sep 17 00:00:00 2001 From: Georgii Gerasev <54953043+VenInf@users.noreply.github.com> Date: Fri, 16 Aug 2024 17:21:10 +0300 Subject: [PATCH 48/65] Apply suggestions from code review small review changes Co-authored-by: fendor --- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 10 +++++----- 1 file changed, 5 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 45d4e834e4..fd9bf09dd1 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -93,7 +93,8 @@ instance Pretty Log where LogCabalAdd logs -> pretty logs -- | Some actions with cabal files originate from haskell files. --- This descriptor is needed to handle these cases. +-- This descriptor allows to hook into the diagnostics of haskell source files, and +-- allows us to provide code actions and commands that interact with `.cabal` files. haskellInteractionDescriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState haskellInteractionDescriptor recorder plId = (defaultPluginDescriptor plId "Provides the cabal-add code action in haskell files") @@ -102,7 +103,7 @@ haskellInteractionDescriptor recorder plId = [ mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ cabalAddCodeAction recorder ] , pluginCommands = [PluginCommand CabalAdd.cabalAddCommand "add a dependency to a cabal file" (CabalAdd.command cabalAddRecorder)] - , pluginRules = pure () -- TODO: change to haskell files only (?) + , pluginRules = pure () , pluginNotificationHandlers = mempty } where @@ -334,13 +335,12 @@ gotoDefinition ideState _ msgParam = do cabalAddCodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction cabalAddCodeAction recorder state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do maxCompls <- fmap maxCompletions . liftIO $ runAction "cabal.cabal-add" state getClientConfigAction - let mbHaskellFilePath = uriToFilePath uri - case mbHaskellFilePath of + case uriToFilePath uri of Nothing -> pure $ InL [] Just haskellFilePath -> do mbCabalFile <- liftIO $ CabalAdd.findResponsibleCabalFile haskellFilePath case mbCabalFile of - Nothing -> pure $ InL $ fmap InR [noCabalFileAction] + Nothing -> pure $ InL [InR noCabalFileAction] Just cabalFilePath -> do verTxtDocId <- lift $ pluginGetVersionedTextDoc $ TextDocumentIdentifier (filePathToUri cabalFilePath) mbGPD <- liftIO $ runAction "cabal.cabal-add" state $ useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath From 911ccbe71ba077ccda317f25f4d76ea7e2ca1d4f Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Fri, 16 Aug 2024 18:08:49 +0300 Subject: [PATCH 49/65] diagnostic optimisation --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 37 ++++++++-------- .../src/Ide/Plugin/Cabal/CabalAdd.hs | 17 ++++---- plugins/hls-cabal-plugin/test/CabalAdd.hs | 42 ++++++++++++++----- 3 files changed, 60 insertions(+), 36 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index fd9bf09dd1..7ff40d1eb2 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -335,23 +335,26 @@ gotoDefinition ideState _ msgParam = do cabalAddCodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction cabalAddCodeAction recorder state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do maxCompls <- fmap maxCompletions . liftIO $ runAction "cabal.cabal-add" state getClientConfigAction - case uriToFilePath uri of - Nothing -> pure $ InL [] - Just haskellFilePath -> do - mbCabalFile <- liftIO $ CabalAdd.findResponsibleCabalFile haskellFilePath - case mbCabalFile of - Nothing -> pure $ InL [InR noCabalFileAction] - Just cabalFilePath -> do - verTxtDocId <- lift $ pluginGetVersionedTextDoc $ TextDocumentIdentifier (filePathToUri cabalFilePath) - mbGPD <- liftIO $ runAction "cabal.cabal-add" state $ useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath - case mbGPD of - Nothing -> pure $ InL [] - Just (gpd, _) -> do - actions <- liftIO $ mapM (\diag -> - CabalAdd.addDependencySuggestCodeAction cabalAddRecorder plId - verTxtDocId maxCompls diag - haskellFilePath cabalFilePath gpd) diags - pure $ InL $ fmap InR (concat actions) + let suggestions = concatMap (\diag -> CabalAdd.hiddenPackageSuggestion maxCompls diag) diags + case suggestions of + [] -> pure $ InL [] + _ -> + case uriToFilePath uri of + Nothing -> pure $ InL [] + Just haskellFilePath -> do + mbCabalFile <- liftIO $ CabalAdd.findResponsibleCabalFile haskellFilePath + case mbCabalFile of + Nothing -> pure $ InL [InR noCabalFileAction] + Just cabalFilePath -> do + verTxtDocId <- lift $ pluginGetVersionedTextDoc $ TextDocumentIdentifier (filePathToUri cabalFilePath) + mbGPD <- liftIO $ runAction "cabal.cabal-add" state $ useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath + case mbGPD of + Nothing -> pure $ InL [] + Just (gpd, _) -> do + actions <- liftIO $ CabalAdd.addDependencySuggestCodeAction cabalAddRecorder plId + verTxtDocId suggestions + haskellFilePath cabalFilePath gpd + pure $ InL $ fmap InR actions where noCabalFileAction = CodeAction "No .cabal file found" (Just CodeActionKind_QuickFix) (Just []) Nothing (Just (CodeActionDisabled "No .cabal file found")) Nothing Nothing Nothing diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index f3129f98ae..8d8b69b478 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -128,19 +128,18 @@ addDependencySuggestCodeAction :: Logger.Recorder (Logger.WithPriority Log) -> PluginId -> VersionedTextDocumentIdentifier -- ^ Cabal's versioned text identifier - -> Int -- ^ Maximum number of suggestions to return - -> Diagnostic -- ^ Diagnostic from a code action + -> [(T.Text, T.Text)] -- ^ A dependency-version suggestion pairs -> FilePath -- ^ Path to the haskell file -> FilePath -- ^ Path to the cabal file -> GenericPackageDescription -> IO [CodeAction] -addDependencySuggestCodeAction recorder plId verTxtDocId maxCompletions diag haskellFilePath cabalFilePath gpd = do +addDependencySuggestCodeAction recorder plId verTxtDocId suggestions haskellFilePath cabalFilePath gpd = do buildTargets <- liftIO $ getBuildTargets gpd cabalFilePath haskellFilePath Logger.logWith recorder Logger.Info LogCalledCabalAddCodeAction case buildTargets of - [] -> pure $ mkCodeAction cabalFilePath Nothing <$> hiddenPackageSuggestion maxCompletions (_message diag) + [] -> pure $ mkCodeAction cabalFilePath Nothing <$> suggestions targets -> pure $ concat [mkCodeAction cabalFilePath (Just $ buildTargetToStringRepr target) <$> - hiddenPackageSuggestion maxCompletions (_message diag) | target <- targets] + suggestions | target <- targets] where buildTargetToStringRepr target = render $ pretty $ buildTargetComponentName target @@ -168,10 +167,12 @@ addDependencySuggestCodeAction recorder plId verTxtDocId maxCompletions diag has in CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing Nothing (Just command) Nothing -- | Gives a mentioned number of @(dependency, version)@ pairs --- found in the "hidden package" message -hiddenPackageSuggestion :: Int -> T.Text -> [(T.Text, T.Text)] -hiddenPackageSuggestion maxCompletions msg = take maxCompletions $ getMatch (msg =~ regex) +-- found in the "hidden package" diagnostic message +hiddenPackageSuggestion :: Int -> Diagnostic -> [(T.Text, T.Text)] +hiddenPackageSuggestion maxCompletions diag = take maxCompletions $ getMatch (msg =~ regex) where + msg :: T.Text + msg = _message diag regex :: T.Text -- TODO: Support multiple packages suggestion regex = "It is a member of the hidden package [\8216']([a-zA-Z0-9-]*[a-zA-Z0-9])(-([0-9\\.]*))?[\8217']" -- Have to do this matching because `Regex.TDFA` doesn't(?) support diff --git a/plugins/hls-cabal-plugin/test/CabalAdd.hs b/plugins/hls-cabal-plugin/test/CabalAdd.hs index 2d2e399136..92e732cbf6 100644 --- a/plugins/hls-cabal-plugin/test/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/test/CabalAdd.hs @@ -4,19 +4,26 @@ module CabalAdd ( cabalAddTests, ) where -import Control.Lens ((^.)) -import Control.Lens.Fold ((^?)) -import qualified Data.Maybe as Maybe -import qualified Data.Text as T -import qualified Data.Text.Internal.Search as T -import Distribution.Utils.Generic (safeHead) -import Ide.Plugin.Cabal.CabalAdd (hiddenPackageSuggestion) -import qualified Language.LSP.Protocol.Lens as L +import Control.Lens ((^.)) +import Control.Lens.Fold ((^?)) +import qualified Data.Maybe as Maybe +import qualified Data.Text as T +import qualified Data.Text.Internal.Search as T +import Distribution.Utils.Generic (safeHead) +import Ide.Plugin.Cabal.CabalAdd (hiddenPackageSuggestion) +import qualified Language.LSP.Protocol.Lens as L +import Language.LSP.Protocol.Types (Diagnostic (..), mkRange) import System.FilePath -import Test.Hls +import Test.Hls (Session, TestTree, _R, anyMessage, + assertEqual, documentContents, + executeCodeAction, + expectFailBecause, + getAllCodeActions, + getDocumentEdit, liftIO, openDoc, + skipManyTill, testCase, testGroup, + waitForDiagnosticsFrom, (@?=)) import Utils - cabalAddTests :: TestTree cabalAddTests = testGroup @@ -116,8 +123,21 @@ cabalAddTests = liftIO $ assertEqual (T.unpack dependency <> " isn't found in the cabal file") indicesRes (T.indices dependency contents) testHiddenPackageSuggestions :: String -> [T.Text] -> [(T.Text, T.Text)] -> TestTree testHiddenPackageSuggestions testTitle messages suggestions = - let suggestions' = map (safeHead . hiddenPackageSuggestion 1) messages + let diags = map (\msg -> messageToDiagnostic msg ) messages + suggestions' = map (safeHead . hiddenPackageSuggestion 1) diags assertions = zipWith (@?=) suggestions' (map Just suggestions) testNames = map (\(f, s) -> "Check if " ++ T.unpack f ++ (if s == "" then "" else "-") ++ T.unpack s ++ " was parsed correctly") suggestions test = testGroup testTitle $ zipWith testCase testNames assertions in test + messageToDiagnostic :: T.Text -> Diagnostic + messageToDiagnostic msg = Diagnostic { + _range = mkRange 0 0 0 0 + , _severity = Nothing + , _code = Nothing + , _source = Nothing + , _message = msg + , _relatedInformation = Nothing + , _tags = Nothing + , _codeDescription = Nothing + , _data_ = Nothing + } From d9bf2b2003e27eb6d07e96db9735a435a6c4fd98 Mon Sep 17 00:00:00 2001 From: Georgii Gerasev <54953043+VenInf@users.noreply.github.com> Date: Fri, 16 Aug 2024 18:11:59 +0300 Subject: [PATCH 50/65] Update plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs Co-authored-by: fendor --- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 8d8b69b478..6e6f37de7c 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -163,7 +163,7 @@ addDependencySuggestCodeAction recorder plId verTxtDocId suggestions haskellFile , buildTarget = target , dependency = suggestedDep , version=version} - command = mkLspCommand plId (CommandId cabalAddCommand) "Execute Code Action" (Just [toJSON params]) + command = mkLspCommand plId (CommandId cabalAddCommand) "Add missing dependency" (Just [toJSON params]) in CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing Nothing (Just command) Nothing -- | Gives a mentioned number of @(dependency, version)@ pairs From 831b110f2ac5dbc9d7f57d2d50b11fbf8aa66582 Mon Sep 17 00:00:00 2001 From: Georgii Gerasev <54953043+VenInf@users.noreply.github.com> Date: Fri, 16 Aug 2024 18:57:43 +0300 Subject: [PATCH 51/65] Apply suggestions from code review Co-authored-by: fendor --- .../src/Ide/Plugin/Cabal/CabalAdd.hs | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 6e6f37de7c..3c777d5792 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -114,11 +114,12 @@ data CabalAddCommandParams = instance Logger.Pretty CabalAddCommandParams where pretty CabalAddCommandParams{..} = - "CabalAdd parameters:\n" Logger.<+> - "| cabal path: " Logger.<+> Logger.pretty cabalPath Logger.<+> "\n" Logger.<+> - "| target: " Logger.<+> Logger.pretty buildTarget Logger.<+> "\n" Logger.<+> - "| dependendency: " Logger.<+> Logger.pretty dependency Logger.<+> "\n" Logger.<+> - "| version: " Logger.<+> Logger.pretty version Logger.<+> "\n" + "CabalAdd parameters:" <+> vcat + [ "cabal path:" <+> pretty cabalPath + , "target:" <+> pretty buildTarget + , "dependendency:" <+> pretty dependency + , "version:" <+> pretty version + ] -- | Gives a code action that calls the command, -- if a suggestion for a missing dependency is found. @@ -204,10 +205,10 @@ getDependencyEdit :: MonadIO m => Logger.Recorder (Logger.WithPriority Log) -> ( FilePath -> Maybe String -> NonEmpty String -> ExceptT PluginError m WorkspaceEdit getDependencyEdit recorder env cabalFilePath buildTarget dependency = do let (state, caps, verTxtDocId) = env - (mbCnfOrigContents, mbFields, mbPackDescr) <- liftIO $ runAction "cabal.cabal-add" state $ do - contents <- Development.IDE.useWithStale GetFileContents $ toNormalizedFilePath cabalFilePath - inFields <- Development.IDE.useWithStale ParseCabalFields $ toNormalizedFilePath cabalFilePath - inPackDescr <- Development.IDE.useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath + runActionE "cabal.cabal-add" state $ do + contents <- useWithStaleE GetFileContents $ toNormalizedFilePath cabalFilePath + inFields <- useWithStaleE ParseCabalFields $ toNormalizedFilePath cabalFilePath + inPackDescr <- useWithStaleE ParseCabalFile $ toNormalizedFilePath cabalFilePath let mbCnfOrigContents = case snd . fst <$> contents of Just (Just txt) -> Just $ encodeUtf8 txt _ -> Nothing From 9cb82b8f3300e65717a8e78fd1d9ee6466dff89f Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Fri, 16 Aug 2024 18:58:49 +0300 Subject: [PATCH 52/65] HlsPlugins rename id --- src/HlsPlugins.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/HlsPlugins.hs b/src/HlsPlugins.hs index c78bb6af1b..87a1af7392 100644 --- a/src/HlsPlugins.hs +++ b/src/HlsPlugins.hs @@ -152,7 +152,7 @@ idePlugins recorder = pluginDescToIdePlugins allPlugins allPlugins = #if hls_cabal let pId = "cabal" in Cabal.descriptor (pluginRecorder pId) pId : - let caId = "cabaladd" in Cabal.haskellInteractionDescriptor (pluginRecorder caId) caId : + let caId = "cabalHaskellIntegration" in Cabal.haskellInteractionDescriptor (pluginRecorder caId) caId : #endif #if hls_pragmas Pragmas.suggestPragmaDescriptor "pragmas-suggest" : From 7b36ae227fbb5e13be585a9afa93bc6122bca70e Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Fri, 16 Aug 2024 19:46:38 +0300 Subject: [PATCH 53/65] docs, revert changes --- .../src/Ide/Plugin/Cabal/CabalAdd.hs | 43 +++++++++++++------ 1 file changed, 30 insertions(+), 13 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 3c777d5792..162f9fcc5c 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -114,17 +114,25 @@ data CabalAddCommandParams = instance Logger.Pretty CabalAddCommandParams where pretty CabalAddCommandParams{..} = - "CabalAdd parameters:" <+> vcat - [ "cabal path:" <+> pretty cabalPath - , "target:" <+> pretty buildTarget - , "dependendency:" <+> pretty dependency - , "version:" <+> pretty version + "CabalAdd parameters:" Logger.<+> Logger.vcat + [ "cabal path:" Logger.<+> Logger.pretty cabalPath + , "target:" Logger.<+> Logger.pretty buildTarget + , "dependendency:" Logger.<+> Logger.pretty dependency + , "version:" Logger.<+> Logger.pretty version ] --- | Gives a code action that calls the command, --- if a suggestion for a missing dependency is found. --- Disabled action if no cabal files given. --- Conducts IO action on a cabal file to find build targets. +-- | Creates a code action that calls the `cabalAddCommand`, +-- using dependency-version suggestion pairs as input. +-- +-- Returns disabled action if no cabal files given. +-- +-- Takes haskell file and cabal file paths to create a relative path +-- to the haskell file, which is used to get a `BuildTarget`. +-- In current implementation the dependency is being added to the main found +-- build target, but if there will be a way to get all build targets from a file +-- it will be possible to support addition to a build target of choice. +-- +-- The cabal file path is also used to make the text `edit` down the line. addDependencySuggestCodeAction :: Logger.Recorder (Logger.WithPriority Log) -> PluginId @@ -142,8 +150,17 @@ addDependencySuggestCodeAction recorder plId verTxtDocId suggestions haskellFile targets -> pure $ concat [mkCodeAction cabalFilePath (Just $ buildTargetToStringRepr target) <$> suggestions | target <- targets] where + -- | Note the use of `pretty` funciton. + -- It converts the `BuildTarget` to an acceptable string representation. + -- It will be used in as the input for `cabal-add`'s `executeConfig`. buildTargetToStringRepr target = render $ pretty $ buildTargetComponentName target + -- | Gives the build targets that are used in the `CabalAdd`. + -- Note the unorthodox usage of `readBuildTargets`: + -- If the relative path to the haskell file is provided, + -- the `readBuildTargets` will return a main build target. + -- This behaviour is acceptable for now, but changing to a way of getting + -- all build targets in a file is advised. getBuildTargets :: GenericPackageDescription -> FilePath -> FilePath -> IO [BuildTarget] getBuildTargets gpd cabalFilePath haskellFilePath = do let haskellFileRelativePath = makeRelative (dropFileName cabalFilePath) haskellFilePath @@ -205,10 +222,10 @@ getDependencyEdit :: MonadIO m => Logger.Recorder (Logger.WithPriority Log) -> ( FilePath -> Maybe String -> NonEmpty String -> ExceptT PluginError m WorkspaceEdit getDependencyEdit recorder env cabalFilePath buildTarget dependency = do let (state, caps, verTxtDocId) = env - runActionE "cabal.cabal-add" state $ do - contents <- useWithStaleE GetFileContents $ toNormalizedFilePath cabalFilePath - inFields <- useWithStaleE ParseCabalFields $ toNormalizedFilePath cabalFilePath - inPackDescr <- useWithStaleE ParseCabalFile $ toNormalizedFilePath cabalFilePath + (mbCnfOrigContents, mbFields, mbPackDescr) <- liftIO $ runAction "cabal.cabal-add" state $ do + contents <- Development.IDE.useWithStale GetFileContents $ toNormalizedFilePath cabalFilePath + inFields <- Development.IDE.useWithStale ParseCabalFields $ toNormalizedFilePath cabalFilePath + inPackDescr <- Development.IDE.useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath let mbCnfOrigContents = case snd . fst <$> contents of Just (Just txt) -> Just $ encodeUtf8 txt _ -> Nothing From cca5bfcc44531b7b12022184fcae93e591303a53 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Fri, 16 Aug 2024 19:54:39 +0300 Subject: [PATCH 54/65] logs, docs --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 162f9fcc5c..277e9eb8a6 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -202,7 +202,7 @@ hiddenPackageSuggestion maxCompletions diag = take maxCompletions $ getMatch (ms command :: Logger.Recorder (Logger.WithPriority Log) -> CommandFunction IdeState CabalAddCommandParams command recorder state _ params@(CabalAddCommandParams {cabalPath = path, verTxtDocId = verTxtDocId, buildTarget = target, dependency = dep, version = mbVer}) = do - Logger.logWith recorder Logger.Info $ LogCalledCabalAddCommand params + Logger.logWith recorder Logger.Debug $ LogCalledCabalAddCommand params let specifiedDep = case mbVer of Nothing -> dep Just ver -> dep <> " ^>=" <> ver @@ -210,7 +210,7 @@ command recorder state _ params@(CabalAddCommandParams {cabalPath = path, verTxt let env = (state, caps, verTxtDocId) edit <- getDependencyEdit recorder env path target (fromList [T.unpack specifiedDep]) void $ lift $ pluginSendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (\_ -> pure ()) - Logger.logWith recorder Logger.Info LogExecutedCommand + Logger.logWith recorder Logger.Debug LogExecutedCommand pure $ InR Null -- | Constructs prerequisites for the @executeConfig@ @@ -259,7 +259,7 @@ getDependencyEdit recorder env cabalFilePath buildTarget dependency = do Nothing -> throwE $ PluginInternalError $ T.pack $ "Cannot extend build-depends in " ++ cabalFilePath Just newContents -> do let edit = diffText caps (verTxtDocId, T.decodeUtf8 cnfOrigContents) (T.decodeUtf8 newContents) SkipDeletions - Logger.logWith recorder Logger.Info $ LogCreatedEdit edit + Logger.logWith recorder Logger.Debug $ LogCreatedEdit edit pure edit -- | Given a path to a haskell file, returns the closest cabal file. @@ -283,6 +283,9 @@ findResponsibleCabalFile haskellFilePath = do -- | Gives cabal file's contents or throws error. -- Inspired by @readCabalFile@ in cabal-add, -- Distribution.Client.Main +-- +-- This is a fallback option! +-- Use only if the `GetFileContents` fails. readCabalFile :: MonadIO m => FilePath -> ExceptT PluginError m ByteString readCabalFile fileName = do cabalFileExists <- liftIO $ doesFileExist fileName From 5fb79431cd36bf9fffc94d147d41f05900c56f66 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Fri, 16 Aug 2024 20:03:35 +0300 Subject: [PATCH 55/65] more docs --- .../src/Ide/Plugin/Cabal/CabalAdd.hs | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 277e9eb8a6..f99bef3d3c 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -126,13 +126,13 @@ instance Logger.Pretty CabalAddCommandParams where -- -- Returns disabled action if no cabal files given. -- --- Takes haskell file and cabal file paths to create a relative path +-- Takes haskell file (source of diagnostics) and +-- cabal file (the file that will be edited) paths to create a relative path -- to the haskell file, which is used to get a `BuildTarget`. +-- -- In current implementation the dependency is being added to the main found -- build target, but if there will be a way to get all build targets from a file -- it will be possible to support addition to a build target of choice. --- --- The cabal file path is also used to make the text `edit` down the line. addDependencySuggestCodeAction :: Logger.Recorder (Logger.WithPriority Log) -> PluginId @@ -223,16 +223,18 @@ getDependencyEdit :: MonadIO m => Logger.Recorder (Logger.WithPriority Log) -> ( getDependencyEdit recorder env cabalFilePath buildTarget dependency = do let (state, caps, verTxtDocId) = env (mbCnfOrigContents, mbFields, mbPackDescr) <- liftIO $ runAction "cabal.cabal-add" state $ do - contents <- Development.IDE.useWithStale GetFileContents $ toNormalizedFilePath cabalFilePath - inFields <- Development.IDE.useWithStale ParseCabalFields $ toNormalizedFilePath cabalFilePath - inPackDescr <- Development.IDE.useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath + contents <- useWithStale GetFileContents $ toNormalizedFilePath cabalFilePath + inFields <- useWithStale ParseCabalFields $ toNormalizedFilePath cabalFilePath + inPackDescr <- useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath let mbCnfOrigContents = case snd . fst <$> contents of Just (Just txt) -> Just $ encodeUtf8 txt _ -> Nothing let mbFields = fst <$> inFields - let mbPackDescr :: Maybe GenericPackageDescription = fst <$> inPackDescr + let mbPackDescr = fst <$> inPackDescr pure (mbCnfOrigContents, mbFields, mbPackDescr) + -- Check if required info was received, + -- otherwise fall back on other options. (cnfOrigContents, fields, packDescr) <- do cnfOrigContents <- case mbCnfOrigContents of (Just cnfOrigContents) -> pure cnfOrigContents @@ -240,7 +242,7 @@ getDependencyEdit recorder env cabalFilePath buildTarget dependency = do (fields, packDescr) <- case (mbFields, mbPackDescr) of (Just fields, Just packDescr) -> pure (fields, packDescr) (_, _) -> case parseCabalFile cabalFilePath cnfOrigContents of - Left err -> throwE $ PluginInternalError $ T.pack $ err + Left err -> throwE $ PluginInternalError $ T.pack err Right (f ,gpd) -> pure (f, gpd) pure (cnfOrigContents, fields, packDescr) From a3ea3b0a11dbe78b3a54e2fc749e492adc0de30f Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Fri, 16 Aug 2024 20:04:24 +0300 Subject: [PATCH 56/65] docs --- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index f99bef3d3c..ba222f45d7 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -126,8 +126,7 @@ instance Logger.Pretty CabalAddCommandParams where -- -- Returns disabled action if no cabal files given. -- --- Takes haskell file (source of diagnostics) and --- cabal file (the file that will be edited) paths to create a relative path +-- Takes haskell file and cabal file paths to create a relative path -- to the haskell file, which is used to get a `BuildTarget`. -- -- In current implementation the dependency is being added to the main found @@ -138,8 +137,8 @@ addDependencySuggestCodeAction -> PluginId -> VersionedTextDocumentIdentifier -- ^ Cabal's versioned text identifier -> [(T.Text, T.Text)] -- ^ A dependency-version suggestion pairs - -> FilePath -- ^ Path to the haskell file - -> FilePath -- ^ Path to the cabal file + -> FilePath -- ^ Path to the haskell file (source of diagnostics) + -> FilePath -- ^ Path to the cabal file (that will be edited) -> GenericPackageDescription -> IO [CodeAction] addDependencySuggestCodeAction recorder plId verTxtDocId suggestions haskellFilePath cabalFilePath gpd = do From 78913d3416add3c4ff081dea523a45b406678775 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Fri, 16 Aug 2024 20:16:16 +0300 Subject: [PATCH 57/65] imports --- .../src/Ide/Plugin/Cabal/CabalAdd.hs | 40 +++++++++---------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index ba222f45d7..305b619dcb 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -42,14 +42,14 @@ import Distribution.PackageDescription (GenericPackageDe specVersion) import Distribution.PackageDescription.Configuration (flattenPackageDescription) import Distribution.PackageDescription.Quirks (patchQuirks) -import Distribution.Pretty (pretty) +import qualified Distribution.Pretty as Pretty import Distribution.Simple.BuildTarget (BuildTarget, buildTargetComponentName, readBuildTargets) import Distribution.Simple.Utils (safeHead) import Distribution.Verbosity (silent, verboseNoStderr) -import qualified Ide.Logger as Logger +import Ide.Logger import Ide.Plugin.Cabal.Completion.Types (ParseCabalFields (..), ParseCabalFile (..)) import Ide.Plugin.Cabal.Orphans () @@ -91,12 +91,12 @@ data Log | LogExecutedCommand deriving (Show) -instance Logger.Pretty Log where +instance Pretty Log where pretty = \case - LogFoundResponsibleCabalFile fp -> "Located the responsible cabal file at " Logger.<+> Logger.pretty fp + LogFoundResponsibleCabalFile fp -> "Located the responsible cabal file at " <+> pretty fp LogCalledCabalAddCodeAction -> "The CabalAdd CodeAction is called" - LogCalledCabalAddCommand params -> "Called CabalAdd command with:\n" Logger.<+> Logger.pretty params - LogCreatedEdit edit -> "Created inplace edit:\n" Logger.<+> Logger.pretty edit + LogCalledCabalAddCommand params -> "Called CabalAdd command with:\n" <+> pretty params + LogCreatedEdit edit -> "Created inplace edit:\n" <+> pretty edit LogExecutedCommand -> "Executed CabalAdd command" cabalAddCommand :: IsString p => p @@ -112,13 +112,13 @@ data CabalAddCommandParams = deriving (Generic, Show) deriving anyclass (FromJSON, ToJSON) -instance Logger.Pretty CabalAddCommandParams where +instance Pretty CabalAddCommandParams where pretty CabalAddCommandParams{..} = - "CabalAdd parameters:" Logger.<+> Logger.vcat - [ "cabal path:" Logger.<+> Logger.pretty cabalPath - , "target:" Logger.<+> Logger.pretty buildTarget - , "dependendency:" Logger.<+> Logger.pretty dependency - , "version:" Logger.<+> Logger.pretty version + "CabalAdd parameters:" <+> vcat + [ "cabal path:" <+> pretty cabalPath + , "target:" <+> pretty buildTarget + , "dependendency:" <+> pretty dependency + , "version:" <+> pretty version ] -- | Creates a code action that calls the `cabalAddCommand`, @@ -133,7 +133,7 @@ instance Logger.Pretty CabalAddCommandParams where -- build target, but if there will be a way to get all build targets from a file -- it will be possible to support addition to a build target of choice. addDependencySuggestCodeAction - :: Logger.Recorder (Logger.WithPriority Log) + :: Recorder (WithPriority Log) -> PluginId -> VersionedTextDocumentIdentifier -- ^ Cabal's versioned text identifier -> [(T.Text, T.Text)] -- ^ A dependency-version suggestion pairs @@ -143,7 +143,7 @@ addDependencySuggestCodeAction -> IO [CodeAction] addDependencySuggestCodeAction recorder plId verTxtDocId suggestions haskellFilePath cabalFilePath gpd = do buildTargets <- liftIO $ getBuildTargets gpd cabalFilePath haskellFilePath - Logger.logWith recorder Logger.Info LogCalledCabalAddCodeAction + logWith recorder Info LogCalledCabalAddCodeAction case buildTargets of [] -> pure $ mkCodeAction cabalFilePath Nothing <$> suggestions targets -> pure $ concat [mkCodeAction cabalFilePath (Just $ buildTargetToStringRepr target) <$> @@ -152,7 +152,7 @@ addDependencySuggestCodeAction recorder plId verTxtDocId suggestions haskellFile -- | Note the use of `pretty` funciton. -- It converts the `BuildTarget` to an acceptable string representation. -- It will be used in as the input for `cabal-add`'s `executeConfig`. - buildTargetToStringRepr target = render $ pretty $ buildTargetComponentName target + buildTargetToStringRepr target = render $ Pretty.pretty $ buildTargetComponentName target -- | Gives the build targets that are used in the `CabalAdd`. -- Note the unorthodox usage of `readBuildTargets`: @@ -199,9 +199,9 @@ hiddenPackageSuggestion maxCompletions diag = take maxCompletions $ getMatch (ms getMatch (_, _, _, [dependency, _, cleanVersion]) = [(dependency, cleanVersion)] getMatch (_, _, _, _) = error "Impossible pattern matching case" -command :: Logger.Recorder (Logger.WithPriority Log) -> CommandFunction IdeState CabalAddCommandParams +command :: Recorder (WithPriority Log) -> CommandFunction IdeState CabalAddCommandParams command recorder state _ params@(CabalAddCommandParams {cabalPath = path, verTxtDocId = verTxtDocId, buildTarget = target, dependency = dep, version = mbVer}) = do - Logger.logWith recorder Logger.Debug $ LogCalledCabalAddCommand params + logWith recorder Debug $ LogCalledCabalAddCommand params let specifiedDep = case mbVer of Nothing -> dep Just ver -> dep <> " ^>=" <> ver @@ -209,7 +209,7 @@ command recorder state _ params@(CabalAddCommandParams {cabalPath = path, verTxt let env = (state, caps, verTxtDocId) edit <- getDependencyEdit recorder env path target (fromList [T.unpack specifiedDep]) void $ lift $ pluginSendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (\_ -> pure ()) - Logger.logWith recorder Logger.Debug LogExecutedCommand + logWith recorder Debug LogExecutedCommand pure $ InR Null -- | Constructs prerequisites for the @executeConfig@ @@ -217,7 +217,7 @@ command recorder state _ params@(CabalAddCommandParams {cabalPath = path, verTxt -- Given the new contents of the cabal file constructs and returns the @edit@. -- Inspired by @main@ in cabal-add, -- Distribution.Client.Main -getDependencyEdit :: MonadIO m => Logger.Recorder (Logger.WithPriority Log) -> (IdeState, ClientCapabilities, VersionedTextDocumentIdentifier) -> +getDependencyEdit :: MonadIO m => Recorder (WithPriority Log) -> (IdeState, ClientCapabilities, VersionedTextDocumentIdentifier) -> FilePath -> Maybe String -> NonEmpty String -> ExceptT PluginError m WorkspaceEdit getDependencyEdit recorder env cabalFilePath buildTarget dependency = do let (state, caps, verTxtDocId) = env @@ -260,7 +260,7 @@ getDependencyEdit recorder env cabalFilePath buildTarget dependency = do Nothing -> throwE $ PluginInternalError $ T.pack $ "Cannot extend build-depends in " ++ cabalFilePath Just newContents -> do let edit = diffText caps (verTxtDocId, T.decodeUtf8 cnfOrigContents) (T.decodeUtf8 newContents) SkipDeletions - Logger.logWith recorder Logger.Debug $ LogCreatedEdit edit + logWith recorder Debug $ LogCreatedEdit edit pure edit -- | Given a path to a haskell file, returns the closest cabal file. From f2129d41c87ee18e8a18c85a263bb4ee29d8678e Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Fri, 16 Aug 2024 20:27:31 +0300 Subject: [PATCH 58/65] docs --- .../src/Ide/Plugin/Cabal/CabalAdd.hs | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 305b619dcb..2b81fe1f47 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -184,7 +184,22 @@ addDependencySuggestCodeAction recorder plId verTxtDocId suggestions haskellFile in CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing Nothing (Just command) Nothing -- | Gives a mentioned number of @(dependency, version)@ pairs --- found in the "hidden package" diagnostic message +-- found in the "hidden package" diagnostic message. +-- +-- For example, if a ghc error looks like this: +-- +-- > "Could not load module ‘Data.List.Split’ +-- > It is a member of the hidden package ‘split-0.2.5’. +-- > Perhaps you need to add ‘split’ to the build-depends in your .cabal file." +-- +-- It extracts mentioned package names and version numbers. +-- In this example, it will be @[("split", "0.2.5")]@ +-- +-- Also supports messages without a version. +-- +-- > "Perhaps you need to add ‘split’ to the build-depends in your .cabal file." +-- +-- Will turn into @[("split", "")]@ hiddenPackageSuggestion :: Int -> Diagnostic -> [(T.Text, T.Text)] hiddenPackageSuggestion maxCompletions diag = take maxCompletions $ getMatch (msg =~ regex) where From 0b26f5df57b86bb837c9d4277111d346b1f74dcc Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Fri, 16 Aug 2024 21:53:49 +0300 Subject: [PATCH 59/65] schema --- test/testdata/schema/ghc94/default-config.golden.json | 2 +- .../testdata/schema/ghc94/vscode-extension-schema.golden.json | 4 ++-- test/testdata/schema/ghc96/default-config.golden.json | 2 +- .../testdata/schema/ghc96/vscode-extension-schema.golden.json | 4 ++-- test/testdata/schema/ghc98/default-config.golden.json | 2 +- .../testdata/schema/ghc98/vscode-extension-schema.golden.json | 4 ++-- 6 files changed, 9 insertions(+), 9 deletions(-) diff --git a/test/testdata/schema/ghc94/default-config.golden.json b/test/testdata/schema/ghc94/default-config.golden.json index 6ac4a44c1f..6deedfb1cf 100644 --- a/test/testdata/schema/ghc94/default-config.golden.json +++ b/test/testdata/schema/ghc94/default-config.golden.json @@ -24,7 +24,7 @@ "path": "cabal-gild" } }, - "cabaladd": { + "cabalHaskellIntegration": { "globalOn": true }, "callHierarchy": { diff --git a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json index ca88649fd7..e8572b47e1 100644 --- a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json @@ -41,9 +41,9 @@ "scope": "resource", "type": "boolean" }, - "haskell.plugin.cabaladd.globalOn": { + "haskell.plugin.cabalHaskellIntegration.globalOn": { "default": true, - "description": "Enables cabaladd plugin", + "description": "Enables cabalHaskellIntegration plugin", "scope": "resource", "type": "boolean" }, diff --git a/test/testdata/schema/ghc96/default-config.golden.json b/test/testdata/schema/ghc96/default-config.golden.json index 6ac4a44c1f..6deedfb1cf 100644 --- a/test/testdata/schema/ghc96/default-config.golden.json +++ b/test/testdata/schema/ghc96/default-config.golden.json @@ -24,7 +24,7 @@ "path": "cabal-gild" } }, - "cabaladd": { + "cabalHaskellIntegration": { "globalOn": true }, "callHierarchy": { diff --git a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json index ca88649fd7..e8572b47e1 100644 --- a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json @@ -41,9 +41,9 @@ "scope": "resource", "type": "boolean" }, - "haskell.plugin.cabaladd.globalOn": { + "haskell.plugin.cabalHaskellIntegration.globalOn": { "default": true, - "description": "Enables cabaladd plugin", + "description": "Enables cabalHaskellIntegration plugin", "scope": "resource", "type": "boolean" }, diff --git a/test/testdata/schema/ghc98/default-config.golden.json b/test/testdata/schema/ghc98/default-config.golden.json index 6ac4a44c1f..6deedfb1cf 100644 --- a/test/testdata/schema/ghc98/default-config.golden.json +++ b/test/testdata/schema/ghc98/default-config.golden.json @@ -24,7 +24,7 @@ "path": "cabal-gild" } }, - "cabaladd": { + "cabalHaskellIntegration": { "globalOn": true }, "callHierarchy": { diff --git a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json index ca88649fd7..e8572b47e1 100644 --- a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json @@ -41,9 +41,9 @@ "scope": "resource", "type": "boolean" }, - "haskell.plugin.cabaladd.globalOn": { + "haskell.plugin.cabalHaskellIntegration.globalOn": { "default": true, - "description": "Enables cabaladd plugin", + "description": "Enables cabalHaskellIntegration plugin", "scope": "resource", "type": "boolean" }, From e4e363bdd91248cf3f5baa960a5023370557d929 Mon Sep 17 00:00:00 2001 From: Georgii Gerasev <54953043+VenInf@users.noreply.github.com> Date: Sun, 18 Aug 2024 21:50:02 +0300 Subject: [PATCH 60/65] Apply suggestions from code review Co-authored-by: fendor --- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 2b81fe1f47..2a27976534 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -149,7 +149,7 @@ addDependencySuggestCodeAction recorder plId verTxtDocId suggestions haskellFile targets -> pure $ concat [mkCodeAction cabalFilePath (Just $ buildTargetToStringRepr target) <$> suggestions | target <- targets] where - -- | Note the use of `pretty` funciton. + -- | Note the use of `pretty` function. -- It converts the `BuildTarget` to an acceptable string representation. -- It will be used in as the input for `cabal-add`'s `executeConfig`. buildTargetToStringRepr target = render $ Pretty.pretty $ buildTargetComponentName target @@ -274,9 +274,9 @@ getDependencyEdit recorder env cabalFilePath buildTarget dependency = do case executeConfig (validateChanges origPackDescr) (Config {..}) of Nothing -> throwE $ PluginInternalError $ T.pack $ "Cannot extend build-depends in " ++ cabalFilePath Just newContents -> do - let edit = diffText caps (verTxtDocId, T.decodeUtf8 cnfOrigContents) (T.decodeUtf8 newContents) SkipDeletions - logWith recorder Debug $ LogCreatedEdit edit - pure edit + let edit = diffText caps (verTxtDocId, T.decodeUtf8 cnfOrigContents) (T.decodeUtf8 newContents) SkipDeletions + logWith recorder Debug $ LogCreatedEdit edit + pure edit -- | Given a path to a haskell file, returns the closest cabal file. -- If cabal file wasn't found, gives Nothing. From 76f064c519d0c58c4aae405943fc166972160d03 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Sun, 18 Aug 2024 21:56:38 +0300 Subject: [PATCH 61/65] - logs and empty suggestion --- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 4 +--- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs | 3 --- 2 files changed, 1 insertion(+), 6 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 7ff40d1eb2..cc51b4067c 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -344,7 +344,7 @@ cabalAddCodeAction recorder state plId (CodeActionParams _ _ (TextDocumentIdenti Just haskellFilePath -> do mbCabalFile <- liftIO $ CabalAdd.findResponsibleCabalFile haskellFilePath case mbCabalFile of - Nothing -> pure $ InL [InR noCabalFileAction] + Nothing -> pure $ InL [] Just cabalFilePath -> do verTxtDocId <- lift $ pluginGetVersionedTextDoc $ TextDocumentIdentifier (filePathToUri cabalFilePath) mbGPD <- liftIO $ runAction "cabal.cabal-add" state $ useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath @@ -356,8 +356,6 @@ cabalAddCodeAction recorder state plId (CodeActionParams _ _ (TextDocumentIdenti haskellFilePath cabalFilePath gpd pure $ InL $ fmap InR actions where - noCabalFileAction = CodeAction "No .cabal file found" (Just CodeActionKind_QuickFix) (Just []) Nothing - (Just (CodeActionDisabled "No .cabal file found")) Nothing Nothing Nothing cabalAddRecorder = cmapWithPrio LogCabalAdd recorder diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 2a27976534..f06e84c4b8 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -85,7 +85,6 @@ import Text.Regex.TDFA data Log = LogFoundResponsibleCabalFile FilePath - | LogCalledCabalAddCodeAction | LogCalledCabalAddCommand CabalAddCommandParams | LogCreatedEdit WorkspaceEdit | LogExecutedCommand @@ -94,7 +93,6 @@ data Log instance Pretty Log where pretty = \case LogFoundResponsibleCabalFile fp -> "Located the responsible cabal file at " <+> pretty fp - LogCalledCabalAddCodeAction -> "The CabalAdd CodeAction is called" LogCalledCabalAddCommand params -> "Called CabalAdd command with:\n" <+> pretty params LogCreatedEdit edit -> "Created inplace edit:\n" <+> pretty edit LogExecutedCommand -> "Executed CabalAdd command" @@ -143,7 +141,6 @@ addDependencySuggestCodeAction -> IO [CodeAction] addDependencySuggestCodeAction recorder plId verTxtDocId suggestions haskellFilePath cabalFilePath gpd = do buildTargets <- liftIO $ getBuildTargets gpd cabalFilePath haskellFilePath - logWith recorder Info LogCalledCabalAddCodeAction case buildTargets of [] -> pure $ mkCodeAction cabalFilePath Nothing <$> suggestions targets -> pure $ concat [mkCodeAction cabalFilePath (Just $ buildTargetToStringRepr target) <$> From 310226f721b67b625ec6a9985c06456d0f0f1fb5 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Sun, 18 Aug 2024 21:59:02 +0300 Subject: [PATCH 62/65] - empty recorder --- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index f06e84c4b8..08204ced4d 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -131,15 +131,14 @@ instance Pretty CabalAddCommandParams where -- build target, but if there will be a way to get all build targets from a file -- it will be possible to support addition to a build target of choice. addDependencySuggestCodeAction - :: Recorder (WithPriority Log) - -> PluginId + :: PluginId -> VersionedTextDocumentIdentifier -- ^ Cabal's versioned text identifier -> [(T.Text, T.Text)] -- ^ A dependency-version suggestion pairs -> FilePath -- ^ Path to the haskell file (source of diagnostics) -> FilePath -- ^ Path to the cabal file (that will be edited) -> GenericPackageDescription -> IO [CodeAction] -addDependencySuggestCodeAction recorder plId verTxtDocId suggestions haskellFilePath cabalFilePath gpd = do +addDependencySuggestCodeAction plId verTxtDocId suggestions haskellFilePath cabalFilePath gpd = do buildTargets <- liftIO $ getBuildTargets gpd cabalFilePath haskellFilePath case buildTargets of [] -> pure $ mkCodeAction cabalFilePath Nothing <$> suggestions From ae6a0604d6110fc4723237ef9392028e3bb3920b Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Sun, 18 Aug 2024 22:23:34 +0300 Subject: [PATCH 63/65] docs --- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 2 +- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs | 6 ++++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index cc51b4067c..b668e3eb39 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -335,7 +335,7 @@ gotoDefinition ideState _ msgParam = do cabalAddCodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction cabalAddCodeAction recorder state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do maxCompls <- fmap maxCompletions . liftIO $ runAction "cabal.cabal-add" state getClientConfigAction - let suggestions = concatMap (\diag -> CabalAdd.hiddenPackageSuggestion maxCompls diag) diags + let suggestions = take maxCompls $ concatMap CabalAdd.hiddenPackageSuggestion diags case suggestions of [] -> pure $ InL [] _ -> diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 08204ced4d..e60d06db78 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -141,7 +141,9 @@ addDependencySuggestCodeAction addDependencySuggestCodeAction plId verTxtDocId suggestions haskellFilePath cabalFilePath gpd = do buildTargets <- liftIO $ getBuildTargets gpd cabalFilePath haskellFilePath case buildTargets of + -- If there are no build targets found, run `cabal-add` command with default behaviour [] -> pure $ mkCodeAction cabalFilePath Nothing <$> suggestions + -- Otherwise provide actions for all found targets targets -> pure $ concat [mkCodeAction cabalFilePath (Just $ buildTargetToStringRepr target) <$> suggestions | target <- targets] where @@ -196,8 +198,8 @@ addDependencySuggestCodeAction plId verTxtDocId suggestions haskellFilePath caba -- > "Perhaps you need to add ‘split’ to the build-depends in your .cabal file." -- -- Will turn into @[("split", "")]@ -hiddenPackageSuggestion :: Int -> Diagnostic -> [(T.Text, T.Text)] -hiddenPackageSuggestion maxCompletions diag = take maxCompletions $ getMatch (msg =~ regex) +hiddenPackageSuggestion :: Diagnostic -> [(T.Text, T.Text)] +hiddenPackageSuggestion diag = getMatch (msg =~ regex) where msg :: T.Text msg = _message diag From 385d83b295b3e09de4e60ec7fb523b85bd866d85 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Sun, 18 Aug 2024 23:00:21 +0300 Subject: [PATCH 64/65] resolve merging issues --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 15 +++++++------ plugins/hls-cabal-plugin/test/CabalAdd.hs | 2 +- plugins/hls-cabal-plugin/test/Main.hs | 21 ------------------- 3 files changed, 8 insertions(+), 30 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index b668e3eb39..03e8fbfdff 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -100,7 +100,7 @@ haskellInteractionDescriptor recorder plId = (defaultPluginDescriptor plId "Provides the cabal-add code action in haskell files") { pluginHandlers = mconcat - [ mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ cabalAddCodeAction recorder + [ mkPluginHandler LSP.SMethod_TextDocumentCodeAction cabalAddCodeAction ] , pluginCommands = [PluginCommand CabalAdd.cabalAddCommand "add a dependency to a cabal file" (CabalAdd.command cabalAddRecorder)] , pluginRules = pure () @@ -332,8 +332,8 @@ gotoDefinition ideState _ msgParam = do isSectionArgName name (Syntax.Section _ sectionArgName _) = name == CabalFields.onelineSectionArgs sectionArgName isSectionArgName _ _ = False -cabalAddCodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction -cabalAddCodeAction recorder state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do +cabalAddCodeAction :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction +cabalAddCodeAction state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do maxCompls <- fmap maxCompletions . liftIO $ runAction "cabal.cabal-add" state getClientConfigAction let suggestions = take maxCompls $ concatMap CabalAdd.hiddenPackageSuggestion diags case suggestions of @@ -351,12 +351,11 @@ cabalAddCodeAction recorder state plId (CodeActionParams _ _ (TextDocumentIdenti case mbGPD of Nothing -> pure $ InL [] Just (gpd, _) -> do - actions <- liftIO $ CabalAdd.addDependencySuggestCodeAction cabalAddRecorder plId - verTxtDocId suggestions - haskellFilePath cabalFilePath gpd + actions <- liftIO $ CabalAdd.addDependencySuggestCodeAction plId verTxtDocId + suggestions + haskellFilePath cabalFilePath + gpd pure $ InL $ fmap InR actions - where - cabalAddRecorder = cmapWithPrio LogCabalAdd recorder -- ---------------------------------------------------------------- diff --git a/plugins/hls-cabal-plugin/test/CabalAdd.hs b/plugins/hls-cabal-plugin/test/CabalAdd.hs index 92e732cbf6..f6bc7dbde0 100644 --- a/plugins/hls-cabal-plugin/test/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/test/CabalAdd.hs @@ -124,7 +124,7 @@ cabalAddTests = testHiddenPackageSuggestions :: String -> [T.Text] -> [(T.Text, T.Text)] -> TestTree testHiddenPackageSuggestions testTitle messages suggestions = let diags = map (\msg -> messageToDiagnostic msg ) messages - suggestions' = map (safeHead . hiddenPackageSuggestion 1) diags + suggestions' = map (safeHead . hiddenPackageSuggestion) diags assertions = zipWith (@?=) suggestions' (map Just suggestions) testNames = map (\(f, s) -> "Check if " ++ T.unpack f ++ (if s == "" then "" else "-") ++ T.unpack s ++ " was parsed correctly") suggestions test = testGroup testTitle $ zipWith testCase testNames assertions diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 9e59b89813..00e39583f4 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -231,27 +231,6 @@ codeActionTests = testGroup "Code Actions" guard (_title == "Replace with " <> license) pure action - - generateHiddenPackageTestSession :: FilePath -> FilePath -> T.Text -> [Int] -> Session () - generateHiddenPackageTestSession cabalFile haskellFile dependency indicesRes = do - hsdoc <- openDoc haskellFile "haskell" - cabDoc <- openDoc cabalFile "cabal" - _ <- waitForDiagnosticsFrom hsdoc - cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions hsdoc - let selectedCas = filter (\ca -> "Add dependency" `T.isPrefixOf` (ca ^. L.title)) cas - mapM_ executeCodeAction selectedCas - _ <- skipManyTill anyMessage $ getDocumentEdit cabDoc -- Wait for the changes in cabal file - contents <- documentContents cabDoc - liftIO $ assertEqual (T.unpack dependency <> " isn't found in the cabal file") indicesRes (Text.indices dependency contents) - - testHiddenPackageSuggestions :: String -> [T.Text] -> [(T.Text, T.Text)] -> TestTree - testHiddenPackageSuggestions testTitle messages suggestions = - let suggestions' = map (safeHead . hiddenPackageSuggestion 1) messages - assertions = zipWith (@?=) suggestions' (map Just suggestions) - testNames = map (\(f, s) -> "Check if " ++ T.unpack f ++ "-" ++ T.unpack s ++ " was parsed correctly") suggestions - test = testGroup testTitle $ zipWith testCase testNames assertions - in test - -- ---------------------------------------------------------------------------- -- Goto Definition Tests -- ---------------------------------------------------------------------------- From e8c605199ba609099552f5e3739d920e3d8ec929 Mon Sep 17 00:00:00 2001 From: Fendor Date: Tue, 20 Aug 2024 16:45:16 +0200 Subject: [PATCH 65/65] Add cabal-add extra-dep for stack files --- cabal.project | 4 +++- stack-lts22.yaml | 8 ++++++++ stack.yaml | 7 +++++++ 3 files changed, 18 insertions(+), 1 deletion(-) diff --git a/cabal.project b/cabal.project index 60fb14c812..1df213bed8 100644 --- a/cabal.project +++ b/cabal.project @@ -7,10 +7,12 @@ packages: ./hls-plugin-api ./hls-test-utils +-- Only keep this until https://github.com/Bodigrim/cabal-add/issues/7 +-- is resolved source-repository-package type: git location: https://github.com/Bodigrim/cabal-add.git - tag: master + tag: 8c004e2a4329232f9824425f5472b2d6d7958bbd index-state: 2024-06-29T00:00:00Z diff --git a/stack-lts22.yaml b/stack-lts22.yaml index 80007a898c..9aca1671f4 100644 --- a/stack-lts22.yaml +++ b/stack-lts22.yaml @@ -37,6 +37,12 @@ extra-deps: - trial-optparse-applicative-0.0.0.0 - trial-tomland-0.0.0.0 - validation-selective-0.2.0.0 + # Only keep this until https://github.com/Bodigrim/cabal-add/issues/7 + # is resolved + - git: https://github.com/Bodigrim/cabal-add.git + commit: 8c004e2a4329232f9824425f5472b2d6d7958bbd + - cabal-install-parsers-0.6.1.1 + configure-options: ghcide: @@ -51,6 +57,8 @@ flags: ghc-lib: true retrie: BuildExecutable: false + cabal-add: + cabal-syntax: true nix: packages: [icu libcxx zlib] diff --git a/stack.yaml b/stack.yaml index 8df73f646b..2b09ffc163 100644 --- a/stack.yaml +++ b/stack.yaml @@ -38,6 +38,11 @@ extra-deps: - trial-0.0.0.0 - trial-optparse-applicative-0.0.0.0 - trial-tomland-0.0.0.0 + # Only keep this until https://github.com/Bodigrim/cabal-add/issues/7 + # is resolved + - git: https://github.com/Bodigrim/cabal-add.git + commit: 8c004e2a4329232f9824425f5472b2d6d7958bbd + - cabal-install-parsers-0.6.1.1 configure-options: ghcide: @@ -52,6 +57,8 @@ flags: ghc-lib: true retrie: BuildExecutable: false + cabal-add: + cabal-syntax: true nix: packages: [icu libcxx zlib]