Migrate some plugins to the new test plugin recorder structure

Author: fendor

plugins/hls-alternate-number-format-plugin/test/Main.hs

@@ -19,8 +19,8 @@ import           Text.Regex.TDFA                  ((=~))
 main :: IO ()
 main = defaultTestRunner test
 
-alternateNumberFormatPlugin :: PluginDescriptor IdeState
-alternateNumberFormatPlugin = AlternateNumberFormat.descriptor mempty  "alternateNumberFormat"
+alternateNumberFormatPlugin :: Recorder (WithPriority AlternateNumberFormat.Log) -> PluginDescriptor IdeState
+alternateNumberFormatPlugin recorder = AlternateNumberFormat.descriptor recorder  "alternateNumberFormat"
 
 -- NOTE: For whatever reason, this plugin does not play nice with creating Code Actions on time.
 -- As a result tests will mostly pass if `import Prelude` is added at the top. We (mostly fendor) surmise this has something
@@ -54,7 +54,7 @@ test = testGroup "alternateNumberFormat" [
 
 codeActionProperties :: TestName -> [(Int, Int)] -> ([CodeAction] -> Session ()) -> TestTree
 codeActionProperties fp locs assertions = testCase fp $ do
-    runSessionWithServer alternateNumberFormatPlugin testDataDir $ do
+    runSessionWithServerAndRecorder alternateNumberFormatPlugin testDataDir $ do
         openDoc (fp <.> ".hs") "haskell" >>= codeActionsFromLocs >>= findAlternateNumberActions >>= assertions
     where
         -- similar to codeActionTest
@@ -75,7 +75,7 @@ testDataDir :: FilePath
 testDataDir = "test" </> "testdata"
 
 goldenAlternateFormat :: FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree
-goldenAlternateFormat fp = goldenWithHaskellDoc alternateNumberFormatPlugin (fp <> " (golden)") testDataDir fp "expected" "hs"
+goldenAlternateFormat fp = goldenWithHaskellDoc (alternateNumberFormatPlugin mempty) (fp <> " (golden)") testDataDir fp "expected" "hs"
 
 codeActionTest :: (Maybe Text -> Bool) -> FilePath -> Int -> Int -> TestTree
 codeActionTest filter' fp line col = goldenAlternateFormat fp $ \doc -> do

plugins/hls-cabal-fmt-plugin/test/Main.hs

@@ -30,8 +30,8 @@ main = do
   foundCabalFmt <- isCabalFmtFound
   defaultTestRunner (tests foundCabalFmt)
 
-cabalFmtPlugin :: PluginDescriptor IdeState
-cabalFmtPlugin = CabalFmt.descriptor mempty "cabal-fmt"
+cabalFmtPlugin :: Recorder (WithPriority CabalFmt.Log) -> PluginDescriptor IdeState
+cabalFmtPlugin recorder = CabalFmt.descriptor recorder "cabal-fmt"
 
 tests :: CabalFmtFound -> TestTree
 tests found = testGroup "cabal-fmt"
@@ -52,7 +52,7 @@ cabalFmtGolden NotFound title _ _ _ =
   testCase title $
     assertFailure $  "Couldn't find cabal-fmt on PATH or this is not an isolated run. "
                   <> "Use cabal flag 'isolateTests' to make it isolated or install cabal-fmt locally."
-cabalFmtGolden Found title path desc act = goldenWithCabalDocFormatter cabalFmtPlugin "cabal-fmt" conf title testDataDir path desc "cabal" act
+cabalFmtGolden Found title path desc act = goldenWithCabalDocFormatter (cabalFmtPlugin mempty) "cabal-fmt" conf title testDataDir path desc "cabal" act
   where
     conf = def
 

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

@@ -25,8 +25,8 @@ import           Test.Hls
 
 main :: IO ()
 main = do
-    recorder <- makeDefaultStderrRecorder Nothing Debug
-    defaultTestRunner . tests $ contramap (fmap pretty) recorder
+    recorder <- pluginTestRecorder
+    defaultTestRunner . tests $ recorder
 
 classPlugin :: Recorder (WithPriority Class.Log) -> PluginDescriptor IdeState
 classPlugin recorder = Class.descriptor recorder "class"

plugins/hls-code-range-plugin/test/Main.hs

@@ -23,7 +23,7 @@ plugin recorder = descriptor recorder "codeRange"
 
 main :: IO ()
 main = do
-    recorder <- contramap (fmap pretty) <$> makeDefaultStderrRecorder Nothing Debug
+    recorder <- pluginTestRecorder
     defaultTestRunner $
         testGroup "Code Range" [
             testGroup "Integration Tests" [

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

@@ -29,34 +29,34 @@ import           Test.Hls
 main :: IO ()
 main = defaultTestRunner tests
 
-evalPlugin :: PluginDescriptor IdeState
-evalPlugin = Eval.descriptor mempty "eval"
+evalPlugin :: Recorder (WithPriority Eval.Log) -> PluginDescriptor IdeState
+evalPlugin recorder = Eval.descriptor recorder "eval"
 
 tests :: TestTree
 tests =
   testGroup "eval"
   [ testCase "Produces Evaluate code lenses" $
-      runSessionWithServer evalPlugin testDataDir $ do
+      runSessionWithServerAndRecorder evalPlugin testDataDir $ do
         doc <- openDoc "T1.hs" "haskell"
         lenses <- getCodeLenses doc
         liftIO $ map (preview $ command . _Just . title) lenses @?= [Just "Evaluate..."]
   , testCase "Produces Refresh code lenses" $
-      runSessionWithServer evalPlugin testDataDir $ do
+      runSessionWithServerAndRecorder evalPlugin testDataDir $ do
         doc <- openDoc "T2.hs" "haskell"
         lenses <- getCodeLenses doc
         liftIO $ map (preview $ command . _Just . title) lenses @?= [Just "Refresh..."]
   , testCase "Code lenses have ranges" $
-      runSessionWithServer evalPlugin testDataDir $ do
+      runSessionWithServerAndRecorder evalPlugin testDataDir $ do
         doc <- openDoc "T1.hs" "haskell"
         lenses <- getCodeLenses doc
         liftIO $ map (view range) lenses @?= [Range (Position 4 0) (Position 5 0)]
   , testCase "Multi-line expressions have a multi-line range" $ do
-      runSessionWithServer evalPlugin testDataDir $ do
+      runSessionWithServerAndRecorder evalPlugin testDataDir $ do
         doc <- openDoc "T3.hs" "haskell"
         lenses <- getCodeLenses doc
         liftIO $ map (view range) lenses @?= [Range (Position 3 0) (Position 5 0)]
   , testCase "Executed expressions range covers only the expression" $ do
-      runSessionWithServer evalPlugin testDataDir $ do
+      runSessionWithServerAndRecorder evalPlugin testDataDir $ do
         doc <- openDoc "T2.hs" "haskell"
         lenses <- getCodeLenses doc
         liftIO $ map (view range) lenses @?= [Range (Position 4 0) (Position 5 0)]
@@ -194,7 +194,7 @@ tests =
         not ("Baz Foo" `isInfixOf` output)          @? "Output includes instance Baz Foo"
     ]
   , testCase "Interfaces are reused after Eval" $ do
-      runSessionWithServer evalPlugin testDataDir $ do
+      runSessionWithServerAndRecorder evalPlugin testDataDir $ do
         doc <- openDoc "TLocalImport.hs" "haskell"
         waitForTypecheck doc
         lenses <- getCodeLenses doc
@@ -213,13 +213,13 @@ tests =
 
 goldenWithEval :: TestName -> FilePath -> FilePath -> TestTree
 goldenWithEval title path ext =
-  goldenWithHaskellDoc evalPlugin title testDataDir path "expected" ext executeLensesBackwards
+  goldenWithHaskellDocAndRecorder evalPlugin title testDataDir path "expected" ext executeLensesBackwards
 
 -- | Similar function as 'goldenWithEval' with an alternate reference file
 -- naming. Useful when reference file may change because of GHC version.
 goldenWithEval' :: TestName -> FilePath -> FilePath -> FilePath -> TestTree
 goldenWithEval' title path ext expected =
-  goldenWithHaskellDoc evalPlugin title testDataDir path expected ext executeLensesBackwards
+  goldenWithHaskellDocAndRecorder evalPlugin title testDataDir path expected ext executeLensesBackwards
 
 -- | Execute lenses backwards, to avoid affecting their position in the source file
 executeLensesBackwards :: TextDocumentIdentifier -> Session ()
@@ -246,7 +246,7 @@ executeCmd cmd = do
   pure ()
 
 evalLenses :: FilePath -> IO [CodeLens]
-evalLenses path = runSessionWithServer evalPlugin testDataDir $ do
+evalLenses path = runSessionWithServerAndRecorder evalPlugin testDataDir $ do
   doc <- openDoc path "haskell"
   executeLensesBackwards doc
   getCodeLenses doc
@@ -280,12 +280,12 @@ exceptionConfig exCfg = changeConfig ["exception" .= exCfg]
 
 goldenWithEvalConfig' :: TestName -> FilePath -> FilePath -> FilePath -> Config -> TestTree
 goldenWithEvalConfig' title path ext expected cfg =
-    goldenWithHaskellDoc evalPlugin title testDataDir path expected ext $ \doc -> do
+    goldenWithHaskellDocAndRecorder evalPlugin title testDataDir path expected ext $ \doc -> do
       sendConfigurationChanged (toJSON cfg)
       executeLensesBackwards doc
 
 evalInFile :: HasCallStack => FilePath -> T.Text -> T.Text -> IO ()
-evalInFile fp e expected = runSessionWithServer evalPlugin testDataDir $ do
+evalInFile fp e expected = runSessionWithServerAndRecorder evalPlugin testDataDir $ do
   doc <- openDoc fp "haskell"
   origin <- documentContents doc
   let withEval = origin <> e