From cf40ddd1ed1bd23137487b8358fc1c7bc0608318 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Mon, 13 Dec 2021 09:16:42 -0800 Subject: [PATCH] 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 8e6319d806..54950b0bfd 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs @@ -31,7 +31,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) @@ -64,6 +64,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 @@ -595,6 +596,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 98dfea147b..803ad21204 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 = _ +