Make HLS refactor use the existing ignore test infrastructure

Author: fendor

hls-test-utils/src/Test/Hls/Util.hs

@@ -28,15 +28,20 @@ module Test.Hls.Util
     , inspectCodeAction
     , inspectCommand
     , inspectDiagnostic
+    -- * Mark tests as broken for various reasons.
     , knownBrokenOnWindows
     , knownBrokenForGhcVersions
+    , knownIssueInEnv
     , knownBrokenInEnv
     , onlyWorkForGhcVersions
+    -- * Setup test-suite state
     , setupBuildToolFiles
+    -- * Diagnostics helpers
     , SymbolLocation
     , waitForDiagnosticsFrom
     , waitForDiagnosticsFromSource
     , waitForDiagnosticsFromSourceWithTimeout
+    -- * Working directory modifications
     , withCurrentDirectoryInTmp
     , withCurrentDirectoryInTmp'
     , withCanonicalTempDir
@@ -115,7 +120,19 @@ files =
    -- , "./test/testdata/wErrorTest/"
   ]
 
-data EnvSpec = HostOS OS | GhcVer GhcVersion
+-- | Why is the test broken?
+--
+-- Are they broken for the given spec or are we just ignoring the test
+-- because the test doesn't make sense in the Environment.
+data IssueSolution
+  = Broken
+  -- ^ Mark a test as known broken, expecting the test to be fixed eventually.
+  | Ignore
+  -- ^ Mark a test as ignored, because the test doesn't make sense in the
+  -- associated environment.
+  deriving (Show)
+
+data EnvSpec = HostOS OS | GhcVer GhcVersion | Specific OS GhcVersion
     deriving (Show, Eq)
 
 matchesCurrentEnv :: EnvSpec -> Bool
@@ -131,11 +148,18 @@ hostOS
     | isMac = MacOS
     | otherwise = Linux
 
+-- | Mark the given TestTree as having a known issue if /any/ of environmental
+-- spec matches the current environment.
+knownIssueInEnv :: IssueSolution -> [EnvSpec] -> String -> TestTree -> TestTree
+knownIssueInEnv issueSolution envSpecs reason
+    | any matchesCurrentEnv envSpecs = case issueSolution of
+        Broken -> expectFailBecause reason
+        Ignore -> ignoreTestBecause reason
+    | otherwise = id
+
 -- | Mark as broken if /any/ of environmental spec mathces the current environment.
 knownBrokenInEnv :: [EnvSpec] -> String -> TestTree -> TestTree
-knownBrokenInEnv envSpecs reason
-    | any matchesCurrentEnv envSpecs = expectFailBecause reason
-    | otherwise = id
+knownBrokenInEnv = knownIssueInEnv Broken
 
 knownBrokenOnWindows :: String -> TestTree -> TestTree
 knownBrokenOnWindows = knownBrokenInEnv [HostOS Windows]

plugins/hls-refactor-plugin/test/Main.hs

@@ -3719,42 +3719,7 @@ withTempDir f = System.IO.Extra.withTempDir $ \dir -> do
   f dir'
 
 ignoreForGHC92 :: String -> TestTree -> TestTree
-ignoreForGHC92 = ignoreFor (BrokenForGHC [GHC92])
-
-data BrokenTarget =
-    BrokenSpecific OS [GhcVersion]
-    -- ^Broken for `BrokenOS` with `GhcVersion`
-    | BrokenForOS OS
-    -- ^Broken for `BrokenOS`
-    | BrokenForGHC [GhcVersion]
-    -- ^Broken for `GhcVersion`
-    deriving (Show)
-
--- | Ignore test for specific os and ghc with reason.
-ignoreFor :: BrokenTarget -> String -> TestTree -> TestTree
-ignoreFor = knownIssueFor Ignore
-
--- | Deal with `IssueSolution` for specific OS and GHC.
-knownIssueFor :: IssueSolution -> BrokenTarget -> String -> TestTree -> TestTree
-knownIssueFor solution = go . \case
-    BrokenSpecific bos vers -> isTargetOS bos && isTargetGhc vers
-    BrokenForOS bos         -> isTargetOS bos
-    BrokenForGHC vers       -> isTargetGhc vers
-    where
-        isTargetOS = \case
-            Windows -> isWindows
-            MacOS   -> isMac
-            Linux   -> not isWindows && not isMac
-
-        isTargetGhc = elem ghcVersion
-
-        go True = case solution of
-            Broken -> expectFailBecause
-            Ignore -> ignoreTestBecause
-        go False = \_ -> id
-
-
-data IssueSolution = Broken | Ignore deriving (Show)
+ignoreForGHC92 = knownIssueInEnv Ignore [GhcVer GHC92]
 
 -- | Assert that a value is not 'Nothing', and extract the value.
 assertJust :: MonadIO m => String -> Maybe a -> m a