diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 32ec6b972d..f2bb8b4232 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -458,12 +458,9 @@ test-suite func-test Rename Symbol TypeDefinition - Tactic Splice HaddockComments Ide.Plugin.Splice.Types - Ide.Plugin.Tactic.FeatureSet - Ide.Plugin.Tactic.TestTypes Ide.Plugin.Eval.Types default-extensions: OverloadedStrings diff --git a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal index c5e2d72f96..bfbf039f9b 100644 --- a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal +++ b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal @@ -78,26 +78,64 @@ library default-language: Haskell2010 default-extensions: DataKinds, TypeOperators + +executable test-server + default-language: Haskell2010 + build-depends: + , base + , data-default + , ghcide + , hls-tactics-plugin + , hls-plugin-api + , shake + main-is: Server.hs + hs-source-dirs: test + ghc-options: + "-with-rtsopts=-I0 -A128M" + -threaded -Wall -Wno-name-shadowing -Wredundant-constraints + test-suite tests type: exitcode-stdio-1.0 main-is: Main.hs other-modules: AutoTupleSpec + GoldenSpec UnificationSpec hs-source-dirs: test ghc-options: -Wall -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: QuickCheck + , aeson , base + , bytestring , checkers + , containers + , data-default + , deepseq + , directory + , filepath + , ghc + , ghcide >= 0.7.5.0 + , hie-bios + , hls-plugin-api + , hls-tactics-plugin , hspec + , hspec-expectations + , lens + , lsp-test + , lsp-types + , megaparsec , mtl - , hls-tactics-plugin - , hls-plugin-api - , hie-bios - , ghc - , containers - build-tool-depends: hspec-discover:hspec-discover + , tasty + , tasty-ant-xml >=1.1.6 + , tasty-expected-failure + , tasty-golden + , tasty-hunit + , tasty-rerun + , text + build-tool-depends: + hspec-discover:hspec-discover + , hls-tactics-plugin:test-server -any default-language: Haskell2010 diff --git a/plugins/hls-tactics-plugin/test/AutoTupleSpec.hs b/plugins/hls-tactics-plugin/test/AutoTupleSpec.hs index d1e9a6ce5f..328a1650a3 100644 --- a/plugins/hls-tactics-plugin/test/AutoTupleSpec.hs +++ b/plugins/hls-tactics-plugin/test/AutoTupleSpec.hs @@ -2,23 +2,17 @@ module AutoTupleSpec where -import Data.Either (isRight) -import qualified Data.Map as M -import Ide.Plugin.Tactic.Debug -import Ide.Plugin.Tactic.Judgements (mkFirstJudgement) -import Ide.Plugin.Tactic.Machinery -import Ide.Plugin.Tactic.Tactics (auto') -import Ide.Plugin.Tactic.Types -import OccName (mkVarOcc) -import Test.Hspec -import Test.QuickCheck -import Type (mkTyVarTy) -import TysPrim (alphaTyVars) -import TysWiredIn (mkBoxedTupleTy) - - -instance Show Type where - show = unsafeRender +import Data.Either (isRight) +import Ide.Plugin.Tactic.Judgements (mkFirstJudgement) +import Ide.Plugin.Tactic.Machinery +import Ide.Plugin.Tactic.Tactics (auto') +import Ide.Plugin.Tactic.Types +import OccName (mkVarOcc) +import Test.Hspec +import Test.QuickCheck +import Type (mkTyVarTy) +import TysPrim (alphaTyVars) +import TysWiredIn (mkBoxedTupleTy) spec :: Spec diff --git a/test/functional/Tactic.hs b/plugins/hls-tactics-plugin/test/GoldenSpec.hs similarity index 53% rename from test/functional/Tactic.hs rename to plugins/hls-tactics-plugin/test/GoldenSpec.hs index 7282772042..94c64a4abc 100644 --- a/test/functional/Tactic.hs +++ b/plugins/hls-tactics-plugin/test/GoldenSpec.hs @@ -1,135 +1,135 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ViewPatterns #-} -module Tactic - ( tests - ) -where +module GoldenSpec where import Control.Applicative.Combinators ( skipManyTill ) -import Control.Lens hiding ((<.>)) +import Control.Lens hiding ((<.>), failing) import Control.Monad (unless) import Control.Monad.IO.Class import Data.Aeson import Data.Default (Default(def)) -import Data.Either (isLeft) import Data.Foldable import qualified Data.Map as M import Data.Maybe import Data.Text (Text) -import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Ide.Plugin.Config as Plugin import Ide.Plugin.Tactic.FeatureSet (FeatureSet, allFeatures) import Ide.Plugin.Tactic.TestTypes import Language.LSP.Test import Language.LSP.Types -import Language.LSP.Types.Lens hiding (id, capabilities, message, executeCommand, applyEdit, rename) +import Language.LSP.Types.Lens hiding (id, capabilities, message, executeCommand, applyEdit, rename, line, title, name, actions) import System.Directory (doesFileExist) import System.FilePath -import Test.Hls.Util -import Test.Tasty -import Test.Tasty.ExpectedFailure (ignoreTestBecause) -import Test.Tasty.HUnit +import Test.Hspec ------------------------------------------------------------------------------- --- | Get a range at the given line and column corresponding to having nothing --- selected. --- --- NB: These coordinates are in "file space", ie, 1-indexed. -pointRange :: Int -> Int -> Range -pointRange - (subtract 1 -> line) - (subtract 1 -> col) = - Range (Position line col) (Position line $ col + 1) - - ------------------------------------------------------------------------------- --- | Get the title of a code action. -codeActionTitle :: (Command |? CodeAction) -> Maybe Text -codeActionTitle InL{} = Nothing -codeActionTitle (InR(CodeAction title _ _ _ _ _ _)) = Just title - - -tests :: TestTree -tests = testGroup - "tactic" - [ mkTest +spec :: Spec +spec = do + describe "code action availability" $ do + mkTest "Produces intros code action" "T1.hs" 2 14 [ (id, Intros, "") ] - , mkTest + mkTest "Produces destruct and homomorphism code actions" "T2.hs" 2 21 [ (id, Destruct, "eab") , (id, Homomorphism, "eab") ] - , mkTest + mkTest "Won't suggest homomorphism on the wrong type" "T2.hs" 8 8 [ (not, Homomorphism, "global") ] - , mkTest + mkTest "Won't suggest intros on the wrong type" "T2.hs" 8 8 [ (not, Intros, "") ] - , mkTest + mkTest "Produces (homomorphic) lambdacase code actions" "T3.hs" 4 24 [ (id, HomomorphismLambdaCase, "") , (id, DestructLambdaCase, "") ] - , mkTest + mkTest "Produces lambdacase code actions" "T3.hs" 7 13 [ (id, DestructLambdaCase, "") ] - , mkTest + mkTest "Doesn't suggest lambdacase without -XLambdaCase" "T2.hs" 11 25 [ (not, DestructLambdaCase, "") ] - , goldenTest "GoldenIntros.hs" 2 8 Intros "" - , goldenTest "GoldenEitherAuto.hs" 2 11 Auto "" - , goldenTest "GoldenJoinCont.hs" 4 12 Auto "" - , goldenTest "GoldenIdentityFunctor.hs" 3 11 Auto "" - , goldenTest "GoldenIdTypeFam.hs" 7 11 Auto "" - , goldenTest "GoldenEitherHomomorphic.hs" 2 15 Auto "" - , goldenTest "GoldenNote.hs" 2 8 Auto "" - , goldenTest "GoldenPureList.hs" 2 12 Auto "" - , goldenTest "GoldenListFmap.hs" 2 12 Auto "" - , goldenTest "GoldenFromMaybe.hs" 2 13 Auto "" - , goldenTest "GoldenFoldr.hs" 2 10 Auto "" - , goldenTest "GoldenSwap.hs" 2 8 Auto "" - , goldenTest "GoldenFmapTree.hs" 4 11 Auto "" - , goldenTest "GoldenGADTDestruct.hs" 7 17 Destruct "gadt" - , goldenTest "GoldenGADTDestructCoercion.hs" 8 17 Destruct "gadt" - , goldenTest "GoldenGADTAuto.hs" 7 13 Auto "" - , goldenTest "GoldenSwapMany.hs" 2 12 Auto "" - , goldenTest "GoldenBigTuple.hs" 4 12 Auto "" - , goldenTest "GoldenShow.hs" 2 10 Auto "" - , goldenTest "GoldenShowCompose.hs" 2 15 Auto "" - , goldenTest "GoldenShowMapChar.hs" 2 8 Auto "" - , goldenTest "GoldenSuperclass.hs" 7 8 Auto "" - , ignoreTestBecause "It is unreliable in circleci builds" - $ goldenTest "GoldenApplicativeThen.hs" 2 11 Auto "" - , goldenTest "GoldenSafeHead.hs" 2 12 Auto "" - , expectFail "GoldenFish.hs" 5 18 Auto "" - , goldenTest "GoldenArbitrary.hs" 25 13 Auto "" - , goldenTest "FmapBoth.hs" 2 12 Auto "" - , goldenTest "RecordCon.hs" 7 8 Auto "" - , goldenTest "FmapJoin.hs" 2 14 Auto "" - , goldenTest "Fgmap.hs" 2 9 Auto "" - , goldenTest "FmapJoinInLet.hs" 4 19 Auto "" - , goldenTest "SplitPattern.hs" 7 25 Destruct "a" - ] + + describe "golden tests" $ do + let goldenTest = mkGoldenTest allFeatures + autoTest = mkGoldenTest allFeatures Auto "" + + goldenTest Intros "" "GoldenIntros.hs" 2 8 + autoTest "GoldenEitherAuto.hs" 2 11 + autoTest "GoldenJoinCont.hs" 4 12 + autoTest "GoldenIdentityFunctor.hs" 3 11 + autoTest "GoldenIdTypeFam.hs" 7 11 + autoTest "GoldenEitherHomomorphic.hs" 2 15 + autoTest "GoldenNote.hs" 2 8 + autoTest "GoldenPureList.hs" 2 12 + autoTest "GoldenListFmap.hs" 2 12 + autoTest "GoldenFromMaybe.hs" 2 13 + autoTest "GoldenFoldr.hs" 2 10 + autoTest "GoldenSwap.hs" 2 8 + autoTest "GoldenFmapTree.hs" 4 11 + goldenTest Destruct "gadt" + "GoldenGADTDestruct.hs" 7 17 + goldenTest Destruct "gadt" + "GoldenGADTDestructCoercion.hs" 8 17 + autoTest "GoldenGADTAuto.hs" 7 13 + autoTest "GoldenSwapMany.hs" 2 12 + autoTest "GoldenBigTuple.hs" 4 12 + autoTest "GoldenShow.hs" 2 10 + autoTest "GoldenShowCompose.hs" 2 15 + autoTest "GoldenShowMapChar.hs" 2 8 + autoTest "GoldenSuperclass.hs" 7 8 + failing "flaky in CI" $ + autoTest "GoldenApplicativeThen.hs" 2 11 + autoTest "GoldenSafeHead.hs" 2 12 + failing "not enough auto gas" $ + autoTest "GoldenFish.hs" 5 18 + autoTest "GoldenArbitrary.hs" 25 13 + autoTest "FmapBoth.hs" 2 12 + autoTest "RecordCon.hs" 7 8 + autoTest "FmapJoin.hs" 2 14 + autoTest "Fgmap.hs" 2 9 + autoTest "FmapJoinInLet.hs" 4 19 + goldenTest Destruct "a" + "SplitPattern.hs" 7 25 + + +------------------------------------------------------------------------------ +-- | Get a range at the given line and column corresponding to having nothing +-- selected. +-- +-- NB: These coordinates are in "file space", ie, 1-indexed. +pointRange :: Int -> Int -> Range +pointRange + (subtract 1 -> line) + (subtract 1 -> col) = + Range (Position line col) (Position line $ col + 1) + + +------------------------------------------------------------------------------ +-- | Get the title of a code action. +codeActionTitle :: (Command |? CodeAction) -> Maybe Text +codeActionTitle InL{} = Nothing +codeActionTitle (InR(CodeAction title _ _ _ _ _ _)) = Just title ------------------------------------------------------------------------------ @@ -144,10 +144,9 @@ mkTest , TacticCommand -- An expected command ... , Text -- ... for this variable ) -- ^ A collection of (un)expected code actions. - -> TestTree -mkTest name fp line col ts = - testCase name $ do - runSession hlsCommand fullCaps tacticPath $ do + -> SpecWith (Arg Bool) +mkTest name fp line col ts = it name $ do + runSession testCommand fullCaps tacticPath $ do doc <- openDoc fp "haskell" _ <- waitForDiagnostics actions <- getCodeActions doc $ pointRange line col @@ -155,8 +154,7 @@ mkTest name fp line col ts = for_ ts $ \(f, tc, var) -> do let title = tacticTitle tc var liftIO $ - f (title `elem` titles) - @? ("Expected a code action with title " <> T.unpack title) + (title `elem` titles) `shouldSatisfy` f setFeatureSet :: FeatureSet -> Session () @@ -175,13 +173,18 @@ setFeatureSet features = do DidChangeConfigurationParams $ toJSON config -goldenTest :: FilePath -> Int -> Int -> TacticCommand -> Text -> TestTree -goldenTest = goldenTest' allFeatures -goldenTest' :: FeatureSet -> FilePath -> Int -> Int -> TacticCommand -> Text -> TestTree -goldenTest' features input line col tc occ = - testCase (input <> " (golden)") $ do - runSession hlsCommand fullCaps tacticPath $ do +mkGoldenTest + :: FeatureSet + -> TacticCommand + -> Text + -> FilePath + -> Int + -> Int + -> SpecWith () +mkGoldenTest features tc occ input line col = + it (input <> " (golden)") $ do + runSession testCommand fullCaps tacticPath $ do setFeatureSet features doc <- openDoc input "haskell" _ <- waitForDiagnostics @@ -196,29 +199,26 @@ goldenTest' features input line col tc occ = liftIO $ (doesFileExist expected_name >>=) $ flip unless $ do T.writeFile expected_name edited expected <- liftIO $ T.readFile expected_name - liftIO $ edited @?= expected + liftIO $ edited `shouldBe` expected -expectFail :: FilePath -> Int -> Int -> TacticCommand -> Text -> TestTree -expectFail input line col tc occ = - testCase (input <> " (golden)") $ do - runSession hlsCommand fullCaps tacticPath $ do - doc <- openDoc input "haskell" - _ <- waitForDiagnostics - actions <- getCodeActions doc $ pointRange line col - Just (InR CodeAction {_command = Just c}) - <- pure $ find ((== Just (tacticTitle tc occ)) . codeActionTitle) actions - resp <- executeCommandWithResp c - liftIO $ unless (isLeft $ _result resp) $ - assertFailure "didn't fail, but expected one" +------------------------------------------------------------------------------ +-- | Don't run a test. +failing :: Applicative m => String -> b -> m () +failing _ _ = pure () tacticPath :: FilePath -tacticPath = "test/testdata/tactic" +tacticPath = "test/golden" -executeCommandWithResp :: Command -> Session (ResponseMessage WorkspaceExecuteCommand) +testCommand :: String +testCommand = "test-server" + + +executeCommandWithResp :: Command -> Session (ResponseMessage 'WorkspaceExecuteCommand) executeCommandWithResp cmd = do let args = decode $ encode $ fromJust $ cmd ^. arguments execParams = ExecuteCommandParams Nothing (cmd ^. command) args request SWorkspaceExecuteCommand execParams + diff --git a/plugins/hls-tactics-plugin/test/Server.hs b/plugins/hls-tactics-plugin/test/Server.hs new file mode 100644 index 0000000000..521ab6b1fe --- /dev/null +++ b/plugins/hls-tactics-plugin/test/Server.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} + +module Main(main) where + +import Data.Default +import Development.IDE.Main +import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide +import Ide.Plugin.Tactic as T +import Ide.PluginUtils + +main :: IO () +main = defaultMain def + { argsHlsPlugins = pluginDescToIdePlugins $ + [ T.descriptor "tactic" + ] <> + Ghcide.descriptors + } + diff --git a/test/testdata/tactic/Fgmap.hs b/plugins/hls-tactics-plugin/test/golden/Fgmap.hs similarity index 100% rename from test/testdata/tactic/Fgmap.hs rename to plugins/hls-tactics-plugin/test/golden/Fgmap.hs diff --git a/test/testdata/tactic/Fgmap.hs.expected b/plugins/hls-tactics-plugin/test/golden/Fgmap.hs.expected similarity index 100% rename from test/testdata/tactic/Fgmap.hs.expected rename to plugins/hls-tactics-plugin/test/golden/Fgmap.hs.expected diff --git a/test/testdata/tactic/FmapBoth.hs b/plugins/hls-tactics-plugin/test/golden/FmapBoth.hs similarity index 100% rename from test/testdata/tactic/FmapBoth.hs rename to plugins/hls-tactics-plugin/test/golden/FmapBoth.hs diff --git a/test/testdata/tactic/FmapBoth.hs.expected b/plugins/hls-tactics-plugin/test/golden/FmapBoth.hs.expected similarity index 100% rename from test/testdata/tactic/FmapBoth.hs.expected rename to plugins/hls-tactics-plugin/test/golden/FmapBoth.hs.expected diff --git a/test/testdata/tactic/FmapJoin.hs b/plugins/hls-tactics-plugin/test/golden/FmapJoin.hs similarity index 100% rename from test/testdata/tactic/FmapJoin.hs rename to plugins/hls-tactics-plugin/test/golden/FmapJoin.hs diff --git a/test/testdata/tactic/FmapJoin.hs.expected b/plugins/hls-tactics-plugin/test/golden/FmapJoin.hs.expected similarity index 100% rename from test/testdata/tactic/FmapJoin.hs.expected rename to plugins/hls-tactics-plugin/test/golden/FmapJoin.hs.expected diff --git a/test/testdata/tactic/FmapJoinInLet.hs b/plugins/hls-tactics-plugin/test/golden/FmapJoinInLet.hs similarity index 100% rename from test/testdata/tactic/FmapJoinInLet.hs rename to plugins/hls-tactics-plugin/test/golden/FmapJoinInLet.hs diff --git a/test/testdata/tactic/FmapJoinInLet.hs.expected b/plugins/hls-tactics-plugin/test/golden/FmapJoinInLet.hs.expected similarity index 100% rename from test/testdata/tactic/FmapJoinInLet.hs.expected rename to plugins/hls-tactics-plugin/test/golden/FmapJoinInLet.hs.expected diff --git a/test/testdata/tactic/GoldenApplicativeThen.hs b/plugins/hls-tactics-plugin/test/golden/GoldenApplicativeThen.hs similarity index 100% rename from test/testdata/tactic/GoldenApplicativeThen.hs rename to plugins/hls-tactics-plugin/test/golden/GoldenApplicativeThen.hs diff --git a/test/testdata/tactic/GoldenArbitrary.hs b/plugins/hls-tactics-plugin/test/golden/GoldenArbitrary.hs similarity index 100% rename from test/testdata/tactic/GoldenArbitrary.hs rename to plugins/hls-tactics-plugin/test/golden/GoldenArbitrary.hs diff --git a/test/testdata/tactic/GoldenArbitrary.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenArbitrary.hs.expected similarity index 100% rename from test/testdata/tactic/GoldenArbitrary.hs.expected rename to plugins/hls-tactics-plugin/test/golden/GoldenArbitrary.hs.expected diff --git a/test/testdata/tactic/GoldenBigTuple.hs b/plugins/hls-tactics-plugin/test/golden/GoldenBigTuple.hs similarity index 100% rename from test/testdata/tactic/GoldenBigTuple.hs rename to plugins/hls-tactics-plugin/test/golden/GoldenBigTuple.hs diff --git a/test/testdata/tactic/GoldenBigTuple.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenBigTuple.hs.expected similarity index 100% rename from test/testdata/tactic/GoldenBigTuple.hs.expected rename to plugins/hls-tactics-plugin/test/golden/GoldenBigTuple.hs.expected diff --git a/test/testdata/tactic/GoldenEitherAuto.hs b/plugins/hls-tactics-plugin/test/golden/GoldenEitherAuto.hs similarity index 100% rename from test/testdata/tactic/GoldenEitherAuto.hs rename to plugins/hls-tactics-plugin/test/golden/GoldenEitherAuto.hs diff --git a/test/testdata/tactic/GoldenEitherAuto.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenEitherAuto.hs.expected similarity index 100% rename from test/testdata/tactic/GoldenEitherAuto.hs.expected rename to plugins/hls-tactics-plugin/test/golden/GoldenEitherAuto.hs.expected diff --git a/test/testdata/tactic/GoldenEitherHomomorphic.hs b/plugins/hls-tactics-plugin/test/golden/GoldenEitherHomomorphic.hs similarity index 100% rename from test/testdata/tactic/GoldenEitherHomomorphic.hs rename to plugins/hls-tactics-plugin/test/golden/GoldenEitherHomomorphic.hs diff --git a/test/testdata/tactic/GoldenEitherHomomorphic.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenEitherHomomorphic.hs.expected similarity index 100% rename from test/testdata/tactic/GoldenEitherHomomorphic.hs.expected rename to plugins/hls-tactics-plugin/test/golden/GoldenEitherHomomorphic.hs.expected diff --git a/test/testdata/tactic/GoldenFish.hs b/plugins/hls-tactics-plugin/test/golden/GoldenFish.hs similarity index 100% rename from test/testdata/tactic/GoldenFish.hs rename to plugins/hls-tactics-plugin/test/golden/GoldenFish.hs diff --git a/test/testdata/tactic/GoldenFmapTree.hs b/plugins/hls-tactics-plugin/test/golden/GoldenFmapTree.hs similarity index 100% rename from test/testdata/tactic/GoldenFmapTree.hs rename to plugins/hls-tactics-plugin/test/golden/GoldenFmapTree.hs diff --git a/test/testdata/tactic/GoldenFmapTree.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenFmapTree.hs.expected similarity index 100% rename from test/testdata/tactic/GoldenFmapTree.hs.expected rename to plugins/hls-tactics-plugin/test/golden/GoldenFmapTree.hs.expected diff --git a/test/testdata/tactic/GoldenFoldr.hs b/plugins/hls-tactics-plugin/test/golden/GoldenFoldr.hs similarity index 100% rename from test/testdata/tactic/GoldenFoldr.hs rename to plugins/hls-tactics-plugin/test/golden/GoldenFoldr.hs diff --git a/test/testdata/tactic/GoldenFoldr.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenFoldr.hs.expected similarity index 100% rename from test/testdata/tactic/GoldenFoldr.hs.expected rename to plugins/hls-tactics-plugin/test/golden/GoldenFoldr.hs.expected diff --git a/test/testdata/tactic/GoldenFromMaybe.hs b/plugins/hls-tactics-plugin/test/golden/GoldenFromMaybe.hs similarity index 100% rename from test/testdata/tactic/GoldenFromMaybe.hs rename to plugins/hls-tactics-plugin/test/golden/GoldenFromMaybe.hs diff --git a/test/testdata/tactic/GoldenFromMaybe.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenFromMaybe.hs.expected similarity index 100% rename from test/testdata/tactic/GoldenFromMaybe.hs.expected rename to plugins/hls-tactics-plugin/test/golden/GoldenFromMaybe.hs.expected diff --git a/test/testdata/tactic/GoldenGADTAuto.hs b/plugins/hls-tactics-plugin/test/golden/GoldenGADTAuto.hs similarity index 100% rename from test/testdata/tactic/GoldenGADTAuto.hs rename to plugins/hls-tactics-plugin/test/golden/GoldenGADTAuto.hs diff --git a/test/testdata/tactic/GoldenGADTAuto.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenGADTAuto.hs.expected similarity index 100% rename from test/testdata/tactic/GoldenGADTAuto.hs.expected rename to plugins/hls-tactics-plugin/test/golden/GoldenGADTAuto.hs.expected diff --git a/test/testdata/tactic/GoldenGADTDestruct.hs b/plugins/hls-tactics-plugin/test/golden/GoldenGADTDestruct.hs similarity index 100% rename from test/testdata/tactic/GoldenGADTDestruct.hs rename to plugins/hls-tactics-plugin/test/golden/GoldenGADTDestruct.hs diff --git a/test/testdata/tactic/GoldenGADTDestruct.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenGADTDestruct.hs.expected similarity index 100% rename from test/testdata/tactic/GoldenGADTDestruct.hs.expected rename to plugins/hls-tactics-plugin/test/golden/GoldenGADTDestruct.hs.expected diff --git a/test/testdata/tactic/GoldenGADTDestructCoercion.hs b/plugins/hls-tactics-plugin/test/golden/GoldenGADTDestructCoercion.hs similarity index 100% rename from test/testdata/tactic/GoldenGADTDestructCoercion.hs rename to plugins/hls-tactics-plugin/test/golden/GoldenGADTDestructCoercion.hs diff --git a/test/testdata/tactic/GoldenGADTDestructCoercion.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenGADTDestructCoercion.hs.expected similarity index 100% rename from test/testdata/tactic/GoldenGADTDestructCoercion.hs.expected rename to plugins/hls-tactics-plugin/test/golden/GoldenGADTDestructCoercion.hs.expected diff --git a/test/testdata/tactic/GoldenIdTypeFam.hs b/plugins/hls-tactics-plugin/test/golden/GoldenIdTypeFam.hs similarity index 100% rename from test/testdata/tactic/GoldenIdTypeFam.hs rename to plugins/hls-tactics-plugin/test/golden/GoldenIdTypeFam.hs diff --git a/test/testdata/tactic/GoldenIdTypeFam.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenIdTypeFam.hs.expected similarity index 100% rename from test/testdata/tactic/GoldenIdTypeFam.hs.expected rename to plugins/hls-tactics-plugin/test/golden/GoldenIdTypeFam.hs.expected diff --git a/test/testdata/tactic/GoldenIdentityFunctor.hs b/plugins/hls-tactics-plugin/test/golden/GoldenIdentityFunctor.hs similarity index 100% rename from test/testdata/tactic/GoldenIdentityFunctor.hs rename to plugins/hls-tactics-plugin/test/golden/GoldenIdentityFunctor.hs diff --git a/test/testdata/tactic/GoldenIdentityFunctor.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenIdentityFunctor.hs.expected similarity index 100% rename from test/testdata/tactic/GoldenIdentityFunctor.hs.expected rename to plugins/hls-tactics-plugin/test/golden/GoldenIdentityFunctor.hs.expected diff --git a/test/testdata/tactic/GoldenIntros.hs b/plugins/hls-tactics-plugin/test/golden/GoldenIntros.hs similarity index 100% rename from test/testdata/tactic/GoldenIntros.hs rename to plugins/hls-tactics-plugin/test/golden/GoldenIntros.hs diff --git a/test/testdata/tactic/GoldenIntros.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenIntros.hs.expected similarity index 100% rename from test/testdata/tactic/GoldenIntros.hs.expected rename to plugins/hls-tactics-plugin/test/golden/GoldenIntros.hs.expected diff --git a/test/testdata/tactic/GoldenJoinCont.hs b/plugins/hls-tactics-plugin/test/golden/GoldenJoinCont.hs similarity index 100% rename from test/testdata/tactic/GoldenJoinCont.hs rename to plugins/hls-tactics-plugin/test/golden/GoldenJoinCont.hs diff --git a/test/testdata/tactic/GoldenJoinCont.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenJoinCont.hs.expected similarity index 100% rename from test/testdata/tactic/GoldenJoinCont.hs.expected rename to plugins/hls-tactics-plugin/test/golden/GoldenJoinCont.hs.expected diff --git a/test/testdata/tactic/GoldenListFmap.hs b/plugins/hls-tactics-plugin/test/golden/GoldenListFmap.hs similarity index 100% rename from test/testdata/tactic/GoldenListFmap.hs rename to plugins/hls-tactics-plugin/test/golden/GoldenListFmap.hs diff --git a/test/testdata/tactic/GoldenListFmap.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenListFmap.hs.expected similarity index 100% rename from test/testdata/tactic/GoldenListFmap.hs.expected rename to plugins/hls-tactics-plugin/test/golden/GoldenListFmap.hs.expected diff --git a/test/testdata/tactic/GoldenNote.hs b/plugins/hls-tactics-plugin/test/golden/GoldenNote.hs similarity index 100% rename from test/testdata/tactic/GoldenNote.hs rename to plugins/hls-tactics-plugin/test/golden/GoldenNote.hs diff --git a/test/testdata/tactic/GoldenNote.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenNote.hs.expected similarity index 100% rename from test/testdata/tactic/GoldenNote.hs.expected rename to plugins/hls-tactics-plugin/test/golden/GoldenNote.hs.expected diff --git a/test/testdata/tactic/GoldenPureList.hs b/plugins/hls-tactics-plugin/test/golden/GoldenPureList.hs similarity index 100% rename from test/testdata/tactic/GoldenPureList.hs rename to plugins/hls-tactics-plugin/test/golden/GoldenPureList.hs diff --git a/test/testdata/tactic/GoldenPureList.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenPureList.hs.expected similarity index 100% rename from test/testdata/tactic/GoldenPureList.hs.expected rename to plugins/hls-tactics-plugin/test/golden/GoldenPureList.hs.expected diff --git a/test/testdata/tactic/GoldenSafeHead.hs b/plugins/hls-tactics-plugin/test/golden/GoldenSafeHead.hs similarity index 100% rename from test/testdata/tactic/GoldenSafeHead.hs rename to plugins/hls-tactics-plugin/test/golden/GoldenSafeHead.hs diff --git a/test/testdata/tactic/GoldenSafeHead.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenSafeHead.hs.expected similarity index 100% rename from test/testdata/tactic/GoldenSafeHead.hs.expected rename to plugins/hls-tactics-plugin/test/golden/GoldenSafeHead.hs.expected diff --git a/test/testdata/tactic/GoldenShow.hs b/plugins/hls-tactics-plugin/test/golden/GoldenShow.hs similarity index 100% rename from test/testdata/tactic/GoldenShow.hs rename to plugins/hls-tactics-plugin/test/golden/GoldenShow.hs diff --git a/test/testdata/tactic/GoldenShow.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenShow.hs.expected similarity index 100% rename from test/testdata/tactic/GoldenShow.hs.expected rename to plugins/hls-tactics-plugin/test/golden/GoldenShow.hs.expected diff --git a/test/testdata/tactic/GoldenShowCompose.hs b/plugins/hls-tactics-plugin/test/golden/GoldenShowCompose.hs similarity index 100% rename from test/testdata/tactic/GoldenShowCompose.hs rename to plugins/hls-tactics-plugin/test/golden/GoldenShowCompose.hs diff --git a/test/testdata/tactic/GoldenShowCompose.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenShowCompose.hs.expected similarity index 100% rename from test/testdata/tactic/GoldenShowCompose.hs.expected rename to plugins/hls-tactics-plugin/test/golden/GoldenShowCompose.hs.expected diff --git a/test/testdata/tactic/GoldenShowMapChar.hs b/plugins/hls-tactics-plugin/test/golden/GoldenShowMapChar.hs similarity index 100% rename from test/testdata/tactic/GoldenShowMapChar.hs rename to plugins/hls-tactics-plugin/test/golden/GoldenShowMapChar.hs diff --git a/test/testdata/tactic/GoldenShowMapChar.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenShowMapChar.hs.expected similarity index 100% rename from test/testdata/tactic/GoldenShowMapChar.hs.expected rename to plugins/hls-tactics-plugin/test/golden/GoldenShowMapChar.hs.expected diff --git a/test/testdata/tactic/GoldenSuperclass.hs b/plugins/hls-tactics-plugin/test/golden/GoldenSuperclass.hs similarity index 100% rename from test/testdata/tactic/GoldenSuperclass.hs rename to plugins/hls-tactics-plugin/test/golden/GoldenSuperclass.hs diff --git a/test/testdata/tactic/GoldenSuperclass.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenSuperclass.hs.expected similarity index 100% rename from test/testdata/tactic/GoldenSuperclass.hs.expected rename to plugins/hls-tactics-plugin/test/golden/GoldenSuperclass.hs.expected diff --git a/test/testdata/tactic/GoldenSwap.hs b/plugins/hls-tactics-plugin/test/golden/GoldenSwap.hs similarity index 100% rename from test/testdata/tactic/GoldenSwap.hs rename to plugins/hls-tactics-plugin/test/golden/GoldenSwap.hs diff --git a/test/testdata/tactic/GoldenSwap.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenSwap.hs.expected similarity index 100% rename from test/testdata/tactic/GoldenSwap.hs.expected rename to plugins/hls-tactics-plugin/test/golden/GoldenSwap.hs.expected diff --git a/test/testdata/tactic/GoldenSwapMany.hs b/plugins/hls-tactics-plugin/test/golden/GoldenSwapMany.hs similarity index 100% rename from test/testdata/tactic/GoldenSwapMany.hs rename to plugins/hls-tactics-plugin/test/golden/GoldenSwapMany.hs diff --git a/test/testdata/tactic/GoldenSwapMany.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenSwapMany.hs.expected similarity index 100% rename from test/testdata/tactic/GoldenSwapMany.hs.expected rename to plugins/hls-tactics-plugin/test/golden/GoldenSwapMany.hs.expected diff --git a/test/testdata/tactic/RecordCon.hs b/plugins/hls-tactics-plugin/test/golden/RecordCon.hs similarity index 100% rename from test/testdata/tactic/RecordCon.hs rename to plugins/hls-tactics-plugin/test/golden/RecordCon.hs diff --git a/test/testdata/tactic/RecordCon.hs.expected b/plugins/hls-tactics-plugin/test/golden/RecordCon.hs.expected similarity index 100% rename from test/testdata/tactic/RecordCon.hs.expected rename to plugins/hls-tactics-plugin/test/golden/RecordCon.hs.expected diff --git a/test/testdata/tactic/SplitPattern.hs b/plugins/hls-tactics-plugin/test/golden/SplitPattern.hs similarity index 100% rename from test/testdata/tactic/SplitPattern.hs rename to plugins/hls-tactics-plugin/test/golden/SplitPattern.hs diff --git a/test/testdata/tactic/SplitPattern.hs.expected b/plugins/hls-tactics-plugin/test/golden/SplitPattern.hs.expected similarity index 100% rename from test/testdata/tactic/SplitPattern.hs.expected rename to plugins/hls-tactics-plugin/test/golden/SplitPattern.hs.expected diff --git a/test/testdata/tactic/T1.hs b/plugins/hls-tactics-plugin/test/golden/T1.hs similarity index 100% rename from test/testdata/tactic/T1.hs rename to plugins/hls-tactics-plugin/test/golden/T1.hs diff --git a/test/testdata/tactic/T2.hs b/plugins/hls-tactics-plugin/test/golden/T2.hs similarity index 100% rename from test/testdata/tactic/T2.hs rename to plugins/hls-tactics-plugin/test/golden/T2.hs diff --git a/test/testdata/tactic/T3.hs b/plugins/hls-tactics-plugin/test/golden/T3.hs similarity index 100% rename from test/testdata/tactic/T3.hs rename to plugins/hls-tactics-plugin/test/golden/T3.hs diff --git a/test/testdata/tactic/hie.yaml b/plugins/hls-tactics-plugin/test/golden/hie.yaml similarity index 100% rename from test/testdata/tactic/hie.yaml rename to plugins/hls-tactics-plugin/test/golden/hie.yaml diff --git a/test/testdata/tactic/test.cabal b/plugins/hls-tactics-plugin/test/golden/test.cabal similarity index 100% rename from test/testdata/tactic/test.cabal rename to plugins/hls-tactics-plugin/test/golden/test.cabal diff --git a/test/functional/Main.hs b/test/functional/Main.hs index 75adbad8fe..7b3846ba67 100644 --- a/test/functional/Main.hs +++ b/test/functional/Main.hs @@ -21,7 +21,6 @@ import Reference import Rename import Symbol import Splice -import Tactic import Test.Tasty import Test.Tasty.Ingredients.Rerun import Test.Tasty.Runners ( @@ -58,7 +57,6 @@ main = , Reference.tests , Rename.tests , Symbol.tests - , Tactic.tests , TypeDefinition.tests , Splice.tests , HaddockComments.tests