ghcide-tests: Show errors where they are caused

instead of deep inside some generic helper function

Author: anka-213

ghcide/test/exe/Main.hs

@@ -5129,7 +5129,7 @@ testSessionWithExtraFiles prefix name = testCase name . runWithExtraFiles prefix
 testSession' :: String -> (FilePath -> Session ()) -> TestTree
 testSession' name = testCase name . run'
 
-testSessionWait :: String -> Session () -> TestTree
+testSessionWait :: HasCallStack => String -> Session () -> TestTree
 testSessionWait name = testSession name .
       -- Check that any diagnostics produced were already consumed by the test case.
       --

ghcide/test/src/Development/IDE/Test.hs

@@ -47,7 +47,7 @@ type Cursor = (Int, Int)
 cursorPosition :: Cursor -> Position
 cursorPosition (line,  col) = Position line col
 
-requireDiagnostic :: List Diagnostic -> (DiagnosticSeverity, Cursor, T.Text, Maybe DiagnosticTag) -> Assertion
+requireDiagnostic :: HasCallStack => List Diagnostic -> (DiagnosticSeverity, Cursor, T.Text, Maybe DiagnosticTag) -> Assertion
 requireDiagnostic actuals expected@(severity, cursor, expectedMsg, expectedTag) = do
     unless (any match actuals) $
         assertFailure $
@@ -69,7 +69,7 @@ requireDiagnostic actuals expected@(severity, cursor, expectedMsg, expectedTag)
 
 -- |wait for @timeout@ seconds and report an assertion failure
 -- if any diagnostic messages arrive in that period
-expectNoMoreDiagnostics :: Seconds -> Session ()
+expectNoMoreDiagnostics :: HasCallStack => Seconds -> Session ()
 expectNoMoreDiagnostics timeout =
   expectMessages STextDocumentPublishDiagnostics timeout $ \diagsNot -> do
     let fileUri = diagsNot ^. params . uri
@@ -109,23 +109,23 @@ flushMessages = do
 --
 --   Rather than trying to assert the absence of diagnostics, introduce an
 --   expected diagnostic (e.g. a redundant import) and assert the singleton diagnostic.
-expectDiagnostics :: [(FilePath, [(DiagnosticSeverity, Cursor, T.Text)])] -> Session ()
+expectDiagnostics :: HasCallStack => [(FilePath, [(DiagnosticSeverity, Cursor, T.Text)])] -> Session ()
 expectDiagnostics
   = expectDiagnosticsWithTags
   . map (second (map (\(ds, c, t) -> (ds, c, t, Nothing))))
 
 unwrapDiagnostic :: NotificationMessage TextDocumentPublishDiagnostics  -> (Uri, List Diagnostic)
 unwrapDiagnostic diagsNot = (diagsNot^.params.uri, diagsNot^.params.diagnostics)
 
-expectDiagnosticsWithTags :: [(String, [(DiagnosticSeverity, Cursor, T.Text, Maybe DiagnosticTag)])] -> Session ()
+expectDiagnosticsWithTags :: HasCallStack => [(String, [(DiagnosticSeverity, Cursor, T.Text, Maybe DiagnosticTag)])] -> Session ()
 expectDiagnosticsWithTags expected = do
     let f = getDocUri >=> liftIO . canonicalizeUri >=> pure . toNormalizedUri
         next = unwrapDiagnostic <$> skipManyTill anyMessage diagnostic
     expected' <- Map.fromListWith (<>) <$> traverseOf (traverse . _1) f expected
     expectDiagnosticsWithTags' next expected'
 
 expectDiagnosticsWithTags' ::
-  MonadIO m =>
+  (HasCallStack, MonadIO m) =>
   m (Uri, List Diagnostic) ->
   Map.Map NormalizedUri [(DiagnosticSeverity, Cursor, T.Text, Maybe DiagnosticTag)] ->
   m ()
@@ -165,12 +165,12 @@ expectDiagnosticsWithTags' next expected = go expected
                     <> show actual
             go $ Map.delete canonUri m
 
-expectCurrentDiagnostics :: TextDocumentIdentifier -> [(DiagnosticSeverity, Cursor, T.Text)] -> Session ()
+expectCurrentDiagnostics :: HasCallStack => TextDocumentIdentifier -> [(DiagnosticSeverity, Cursor, T.Text)] -> Session ()
 expectCurrentDiagnostics doc expected = do
     diags <- getCurrentDiagnostics doc
     checkDiagnosticsForDoc doc expected diags
 
-checkDiagnosticsForDoc :: TextDocumentIdentifier -> [(DiagnosticSeverity, Cursor, T.Text)] -> [Diagnostic] -> Session ()
+checkDiagnosticsForDoc :: HasCallStack => TextDocumentIdentifier -> [(DiagnosticSeverity, Cursor, T.Text)] -> [Diagnostic] -> Session ()
 checkDiagnosticsForDoc TextDocumentIdentifier {_uri} expected obtained = do
     let expected' = Map.fromList [(nuri, map (\(ds, c, t) -> (ds, c, t, Nothing)) expected)]
         nuri = toNormalizedUri _uri