Show log message early on

Author: fendor

src/Haskell/Ide/Engine/Server.hs

@@ -157,7 +157,9 @@ run scheduler _origDir plugins captureFp = flip E.catches handlers $ do
 
         -- Check for mismatching GHC versions
         -- Ignore hie.yaml parse errors. They get reported in ModuleCache.hs
-        let parseErrorHandler (_ :: Yaml.ParseException) = return Nothing
+        let parseErrorHandler (_ :: Yaml.ParseException) = do
+              logm "Caught a yaml parse exception"
+              return Nothing
             dummyCradleFile = fromMaybe currentDir lspRootDir </> "File.hs"
         logm $ "Dummy Cradle File: " ++ dummyCradleFile
         mcradle <- liftIO $ E.catch (Just <$> findLocalCradle dummyCradleFile) parseErrorHandler
@@ -411,13 +413,12 @@ reactor inp diagIn = do
           currentDir <- liftIO getCurrentDirectory
 
           -- Check for mismatching GHC versions
-          -- Ignore hie.yaml parse errors. They get reported in ModuleCache.hs
-          let parseErrorHandler (_ :: Yaml.ParseException) = return Nothing
-              dummyCradleFile = (fromMaybe currentDir lspRootDir) </> "File.hs"
-          cradleRes <- liftIO $ E.catch (Just <$> findLocalCradle dummyCradleFile) parseErrorHandler
+          let dummyCradleFile = (fromMaybe currentDir lspRootDir) </> "File.hs"
+          logm $ "Dummy Cradle file result: " ++ dummyCradleFile
+          cradleRes <- liftIO $ E.try (findLocalCradle dummyCradleFile)
 
           case cradleRes of
-            Just cradle -> do
+            Right cradle -> do
               projGhcVersion <- liftIO $ getProjectGhcVersion cradle
               when (projGhcVersion /= hieGhcVersion) $ do
                 let msg = T.pack $ "Mismatching GHC versions: " ++ cradleDisplay cradle ++
@@ -434,7 +435,9 @@ reactor inp diagIn = do
                   reactorSend $ NotShowMessage $ fmServerShowMessageNotification J.MtWarning cabalMsg
                   reactorSend $ NotLogMessage $ fmServerLogMessageNotification J.MtWarning cabalMsg
 
-            Nothing -> return ()
+            Left (_ :: Yaml.ParseException) -> do
+              logm "Failed to parse it"
+              reactorSend $ NotShowMessage $ fmServerShowMessageNotification J.MtError "Couldn't parse hie.yaml"
 
           renv <- ask
           let hreq = GReq tn "init-hoogle" Nothing Nothing Nothing callback Nothing $ IdeResultOk <$> Hoogle.initializeHoogleDb

test/dispatcher/Main.hs

@@ -71,6 +71,8 @@ startServer :: IO (Scheduler IO, TChan LogVal, ThreadId)
 startServer = do
   scheduler <- newScheduler plugins testOptions
   logChan  <- newTChanIO
+  -- This is correct because we set the working directory to
+  -- "test/testdata" in the function set-up.
   cwd <- getCurrentDirectory
   crdl <- Bios.findLocalCradle (cwd </> "File.hs")
   dispatcher <- forkIO $ do
@@ -130,6 +132,7 @@ instance ToJSON   Cached where
 
 funcSpec :: Spec
 funcSpec = describe "functional dispatch" $ do
+    -- required to not kill the 'findLocalCradle' logic in 'startServer'.
     runIO $ setCurrentDirectory "test/testdata"
     (scheduler, logChan, dispatcher) <- runIO startServer
 

test/functional/HieBiosSpec.hs

@@ -9,6 +9,7 @@ import Language.Haskell.LSP.Messages
 import System.FilePath ((</>))
 import Test.Hspec
 import TestUtils
+import           Debug.Trace                    ( trace )
 
 spec :: Spec
 -- Create an empty hie.yaml to trigger the parse error
@@ -20,15 +21,14 @@ spec = beforeAll_ (writeFile (hieBiosErrorPath </> "hie.yaml") "") $ do
       _ <- openDoc "Main.hs" "haskell"
       _ <- count 2 waitForDiagnostics
       return ()
-  
+
     it "reports errors in hie.yaml" $ runSession hieCommand fullCaps hieBiosErrorPath $ do
       _ <- openDoc "Foo.hs" "haskell"
       _ <- skipManyTill loggingNotification (satisfy isMessage)
       return ()
-  
+
   where hieBiosErrorPath = "test/testdata/hieBiosError"
-  
+
         isMessage (NotShowMessage (NotificationMessage _ _ (ShowMessageParams MtError s))) =
           "Couldn't parse hie.yaml" `T.isInfixOf` s
-        isMessage _ = False
-        
+        isMessage m = trace ("Message: " ++ show m) $ False