post-merge fixes

haskell · Oct 26, 2021 · f8d11d3 · f8d11d3
1 parent bd194e7
commit f8d11d3
Show file tree

Hide file tree

Showing 2 changed files with 12 additions and 13 deletions.
diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs
@@ -50,11 +50,10 @@ import           Development.IDE.Test                     (Cursor,
                                                            expectNoMoreDiagnostics,
                                                            flushMessages,
                                                            standardizeQuotes,
-                                                           getInterfaceFilesDir
+                                                           getInterfaceFilesDir,
                                                            waitForAction,
                                                            getStoredKeys,
-                                                           waitForTypecheck,
-                                                           getFilesOfInterest, waitForGC)
+                                                           waitForTypecheck, waitForGC)
 import           Development.IDE.Test.Runfiles
 import qualified Development.IDE.Types.Diagnostics        as Diagnostics
 import           Development.IDE.Types.Location
@@ -5254,7 +5253,7 @@ ifaceErrorTest = testCase "iface-error-test-1" $ runWithExtraFiles "recomp" $ \d
 
 
     -- Check that we wrote the interfaces for B when we saved
-    Right hidir <- getInterfaceFilesDir bdoc
+    hidir <- getInterfaceFilesDir bdoc
     hi_exists <- liftIO $ doesFileExist $ hidir </> "B.hi"
     liftIO $ assertBool ("Couldn't find B.hi in " ++ hidir) hi_exists
 

diff --git a/ghcide/test/src/Development/IDE/Test.hs b/ghcide/test/src/Development/IDE/Test.hs
@@ -182,25 +182,25 @@ canonicalizeUri uri = filePathToUri <$> canonicalizePath (fromJust (uriToFilePat
 diagnostic :: Session (NotificationMessage TextDocumentPublishDiagnostics)
 diagnostic = LspTest.message STextDocumentPublishDiagnostics
 
-callTestPlugin :: (A.FromJSON b) => TestRequest -> Session (Either ResponseError b)
+callTestPlugin :: (A.FromJSON b) => TestRequest -> Session b
 callTestPlugin cmd = do
     let cm = SCustomMethod "test"
     waitId <- sendRequest cm (A.toJSON cmd)
     ResponseMessage{_result} <- skipManyTill anyMessage $ responseForId cm waitId
-    return $ do
-      e <- _result
-      case A.fromJSON e of
-        A.Error e   -> Left $ ResponseError InternalError (T.pack e) Nothing
-        A.Success a -> pure a
+    return $ case _result of
+         Left (ResponseError t err _) -> error $ show t <> ": " <> T.unpack err
+         Right json -> case A.fromJSON json of
+             A.Success a -> a
+             A.Error e   -> error e
 
-waitForAction :: String -> TextDocumentIdentifier -> Session (Either ResponseError WaitForIdeRuleResult)
+waitForAction :: String -> TextDocumentIdentifier -> Session WaitForIdeRuleResult
 waitForAction key TextDocumentIdentifier{_uri} =
     callTestPlugin (WaitForIdeRule key _uri)
 
-getLastBuildKeys :: Session (Either ResponseError [T.Text])
+getLastBuildKeys :: Session [T.Text]
 getLastBuildKeys = callTestPlugin GetLastBuildKeys
 
-getInterfaceFilesDir :: TextDocumentIdentifier -> Session (Either ResponseError FilePath)
+getInterfaceFilesDir :: TextDocumentIdentifier -> Session FilePath
 getInterfaceFilesDir TextDocumentIdentifier{_uri} = callTestPlugin (GetInterfaceFilesDir _uri)
 
 garbageCollectDirtyKeys :: CheckParents -> Int -> Session [String]