From b16107e07e429633409a00d3c30de1db7d19d9b8 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Mon, 13 Dec 2021 09:16:42 -0800 Subject: [PATCH 1/5] Add subsequent tactic test --- .../src/Wingman/LanguageServer.hs | 10 +++- .../hls-tactics-plugin/test/ProviderSpec.hs | 6 ++ plugins/hls-tactics-plugin/test/Utils.hs | 60 +++++++++++-------- .../test/golden/SubsequentTactics.expected.hs | 5 ++ .../test/golden/SubsequentTactics.hs | 5 ++ 5 files changed, 60 insertions(+), 26 deletions(-) create mode 100644 plugins/hls-tactics-plugin/test/golden/SubsequentTactics.expected.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/SubsequentTactics.hs diff --git a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs index b73d69430c..e4a5166d11 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs @@ -30,7 +30,7 @@ import Development.IDE.Core.PositionMapping (idDelta) import Development.IDE.Core.RuleTypes import Development.IDE.Core.Rules (usePropertyAction) import Development.IDE.Core.Service (runAction) -import Development.IDE.Core.Shake (IdeState (..), uses, define, use, addPersistentRule) +import Development.IDE.Core.Shake (IdeState (..), uses, define, use, addPersistentRule, getShakeExtras, recordDirtyKeys) import qualified Development.IDE.Core.Shake as IDE import Development.IDE.Core.UseStale import Development.IDE.GHC.Compat hiding (empty) @@ -63,6 +63,7 @@ import Wingman.Judgements.Theta import Wingman.Range import Wingman.StaticPlugin (pattern WingmanMetaprogram, pattern MetaprogramSyntax) import Wingman.Types +import Control.Concurrent.STM.Stats (atomically) tacticDesc :: T.Text -> T.Text @@ -594,6 +595,13 @@ wingmanRules plId = do action $ do files <- getFilesOfInterestUntracked + extras <- getShakeExtras + void + $ liftIO + $ join + $ atomically + $ recordDirtyKeys extras WriteDiagnostics + $ Map.keys files void $ uses WriteDiagnostics $ Map.keys files diff --git a/plugins/hls-tactics-plugin/test/ProviderSpec.hs b/plugins/hls-tactics-plugin/test/ProviderSpec.hs index 7d6d0fcfe6..4eea30f5b3 100644 --- a/plugins/hls-tactics-plugin/test/ProviderSpec.hs +++ b/plugins/hls-tactics-plugin/test/ProviderSpec.hs @@ -20,3 +20,9 @@ spec = do "T2" 8 8 [ (not, Intros, "") ] + + goldenTestMany "SubsequentTactics" + [ InvokeTactic Intros "" 4 5 + , InvokeTactic Destruct "du" 4 8 + , InvokeTactic Auto "" 4 15 + ] diff --git a/plugins/hls-tactics-plugin/test/Utils.hs b/plugins/hls-tactics-plugin/test/Utils.hs index fa516193da..82ab426b4f 100644 --- a/plugins/hls-tactics-plugin/test/Utils.hs +++ b/plugins/hls-tactics-plugin/test/Utils.hs @@ -4,6 +4,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE RecordWildCards #-} module Utils where @@ -96,39 +97,45 @@ mkTest name fp line col ts = it name $ do liftIO $ (title `elem` titles) `shouldSatisfy` f +data InvokeTactic = InvokeTactic + { it_command :: TacticCommand + , it_argument :: Text + , it_line :: Int + , it_col :: Int + } + +invokeTactic :: TextDocumentIdentifier -> InvokeTactic -> Session () +invokeTactic doc InvokeTactic{..} = do + -- wait for the entire build to finish, so that Tactics code actions that + -- use stale data will get uptodate stuff + void waitForDiagnostics + void $ waitForTypecheck doc + actions <- getCodeActions doc $ pointRange it_line it_col + case find ((== Just (tacticTitle it_command it_argument)) . codeActionTitle) actions of + Just (InR CodeAction {_command = Just c}) -> do + executeCommand c + void $ skipManyTill anyMessage $ message SWorkspaceApplyEdit + _ -> error $ show actions mkGoldenTest :: (Text -> Text -> Assertion) - -> TacticCommand - -> Text - -> Int - -> Int + -> [InvokeTactic] -> FilePath -> SpecWith () -mkGoldenTest eq tc occ line col input = +mkGoldenTest eq invocations input = it (input <> " (golden)") $ do resetGlobalHoleRef runSessionForTactics $ do doc <- openDoc (input <.> "hs") "haskell" - -- wait for diagnostics to start coming - void waitForDiagnostics - -- wait for the entire build to finish, so that Tactics code actions that - -- use stale data will get uptodate stuff - void $ waitForTypecheck doc - actions <- getCodeActions doc $ pointRange line col - case find ((== Just (tacticTitle tc occ)) . codeActionTitle) actions of - Just (InR CodeAction {_command = Just c}) -> do - executeCommand c - _resp <- skipManyTill anyMessage (message SWorkspaceApplyEdit) - edited <- documentContents doc - let expected_name = input <.> "expected" <.> "hs" - -- Write golden tests if they don't already exist - liftIO $ (doesFileExist expected_name >>=) $ flip unless $ do - T.writeFile expected_name edited - expected <- liftIO $ T.readFile expected_name - liftIO $ edited `eq` expected - _ -> error $ show actions + traverse_ (invokeTactic doc) invocations + edited <- documentContents doc + let expected_name = input <.> "expected" <.> "hs" + -- Write golden tests if they don't already exist + liftIO $ (doesFileExist expected_name >>=) $ flip unless $ do + T.writeFile expected_name edited + expected <- liftIO $ T.readFile expected_name + liftIO $ edited `eq` expected mkCodeLensTest :: FilePath @@ -197,10 +204,13 @@ mkShowMessageTest tc occ line col input ufm = goldenTest :: TacticCommand -> Text -> Int -> Int -> FilePath -> SpecWith () -goldenTest = mkGoldenTest shouldBe +goldenTest tc occ line col = mkGoldenTest shouldBe [InvokeTactic tc occ line col] + +goldenTestMany :: FilePath -> [InvokeTactic] -> SpecWith () +goldenTestMany = flip $ mkGoldenTest shouldBe goldenTestNoWhitespace :: TacticCommand -> Text -> Int -> Int -> FilePath -> SpecWith () -goldenTestNoWhitespace = mkGoldenTest shouldBeIgnoringSpaces +goldenTestNoWhitespace tc occ line col = mkGoldenTest shouldBeIgnoringSpaces [InvokeTactic tc occ line col] shouldBeIgnoringSpaces :: Text -> Text -> Assertion diff --git a/plugins/hls-tactics-plugin/test/golden/SubsequentTactics.expected.hs b/plugins/hls-tactics-plugin/test/golden/SubsequentTactics.expected.hs new file mode 100644 index 0000000000..e638fa311c --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/SubsequentTactics.expected.hs @@ -0,0 +1,5 @@ +data Dummy a = Dummy a + +f :: Dummy Int -> Int +f (Dummy n) = n + diff --git a/plugins/hls-tactics-plugin/test/golden/SubsequentTactics.hs b/plugins/hls-tactics-plugin/test/golden/SubsequentTactics.hs new file mode 100644 index 0000000000..7487adf038 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/SubsequentTactics.hs @@ -0,0 +1,5 @@ +data Dummy a = Dummy a + +f :: Dummy Int -> Int +f = _ + From 14f1675e5d2e26f2da5e888d11db745ca1a75ea1 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Tue, 14 Dec 2021 19:39:59 +0000 Subject: [PATCH 2/5] Delete extraneous hie.yaml and cabal descriptor in Tactics test suite --- plugins/hls-tactics-plugin/test/golden/hie.yaml | 1 - .../hls-tactics-plugin/test/golden/test.cabal | 17 ----------------- 2 files changed, 18 deletions(-) delete mode 100644 plugins/hls-tactics-plugin/test/golden/hie.yaml delete mode 100644 plugins/hls-tactics-plugin/test/golden/test.cabal diff --git a/plugins/hls-tactics-plugin/test/golden/hie.yaml b/plugins/hls-tactics-plugin/test/golden/hie.yaml deleted file mode 100644 index 7aa4f9e0ad..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/hie.yaml +++ /dev/null @@ -1 +0,0 @@ -cradle: {direct: {arguments: ["T1", "T2", "T3"]}} diff --git a/plugins/hls-tactics-plugin/test/golden/test.cabal b/plugins/hls-tactics-plugin/test/golden/test.cabal deleted file mode 100644 index 845edafa26..0000000000 --- a/plugins/hls-tactics-plugin/test/golden/test.cabal +++ /dev/null @@ -1,17 +0,0 @@ -name: test -version: 0.1.0.0 --- synopsis: --- description: -license: BSD3 -author: Author name here -maintainer: example@example.com -copyright: 2017 Author name here -category: Web -build-type: Simple -cabal-version: >=1.10 - -library - exposed-modules: T1, T2 - build-depends: base >= 4.7 && < 5 - default-language: Haskell2010 - ghc-options: -Wall -fwarn-unused-imports From a9177815ca9385314022acdd0c390c83529f8dc4 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 19 Dec 2021 11:37:07 +0000 Subject: [PATCH 3/5] Fix Show instance --- ghcide/src/Development/IDE/Core/RuleTypes.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index 5b14d9b4e8..07129d5251 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -414,7 +414,7 @@ newtype GhcSessionDeps = GhcSessionDeps_ -- Required for interactive evaluation, but leads to more cache invalidations fullModSummary :: Bool } - deriving newtype (Eq, Show, Typeable, Hashable, NFData) + deriving (Eq, Show, Typeable, Hashable, NFData) pattern GhcSessionDeps :: GhcSessionDeps pattern GhcSessionDeps = GhcSessionDeps_ False From b62da2930613b28e9d7cfaf1953988ab3bae83db Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 19 Dec 2021 11:37:25 +0000 Subject: [PATCH 4/5] remove unnecessary recordDirtyKeys call --- .../hls-tactics-plugin/src/Wingman/LanguageServer.hs | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) diff --git a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs index e4a5166d11..b73d69430c 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs @@ -30,7 +30,7 @@ import Development.IDE.Core.PositionMapping (idDelta) import Development.IDE.Core.RuleTypes import Development.IDE.Core.Rules (usePropertyAction) import Development.IDE.Core.Service (runAction) -import Development.IDE.Core.Shake (IdeState (..), uses, define, use, addPersistentRule, getShakeExtras, recordDirtyKeys) +import Development.IDE.Core.Shake (IdeState (..), uses, define, use, addPersistentRule) import qualified Development.IDE.Core.Shake as IDE import Development.IDE.Core.UseStale import Development.IDE.GHC.Compat hiding (empty) @@ -63,7 +63,6 @@ import Wingman.Judgements.Theta import Wingman.Range import Wingman.StaticPlugin (pattern WingmanMetaprogram, pattern MetaprogramSyntax) import Wingman.Types -import Control.Concurrent.STM.Stats (atomically) tacticDesc :: T.Text -> T.Text @@ -595,13 +594,6 @@ wingmanRules plId = do action $ do files <- getFilesOfInterestUntracked - extras <- getShakeExtras - void - $ liftIO - $ join - $ atomically - $ recordDirtyKeys extras WriteDiagnostics - $ Map.keys files void $ uses WriteDiagnostics $ Map.keys files From 943a32aab109f5d7e7824a7af31b517e76aba759 Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Sun, 2 Jan 2022 14:06:26 +0000 Subject: [PATCH 5/5] Remove patterns from cabal file for removed files --- plugins/hls-tactics-plugin/hls-tactics-plugin.cabal | 2 -- 1 file changed, 2 deletions(-) diff --git a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal index d4a00bb96f..e0740187fc 100644 --- a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal +++ b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal @@ -15,9 +15,7 @@ license-file: LICENSE build-type: Simple extra-source-files: README.md - test/golden/*.cabal test/golden/*.hs - test/golden/*.yaml flag pedantic description: Enable -Werror