Emit error assertion when session timeout

Author: jneira

test/functional/FunctionalCodeAction.hs

@@ -142,7 +142,9 @@ hlintTests = testGroup "hlint suggestions" [
         expectNoMoreDiagnostics 3 doc "hlint"
     ]
     where
-        runHlintSession subdir = runSession hlsCommand fullCaps $ "test/testdata/hlint" </> subdir
+        runHlintSession :: FilePath -> Session a -> IO a
+        runHlintSession subdir  =
+            failIfSessionTimeout . runSession hlsCommand fullCaps ("test/testdata/hlint" </> subdir)
 
         noHlintDiagnostics :: [Diagnostic] -> Assertion
         noHlintDiagnostics diags =

test/utils/Test/Hls/Util.hs

@@ -1,11 +1,12 @@
-{-# LANGUAGE CPP, OverloadedStrings, NamedFieldPuns #-}
+{-# LANGUAGE CPP, OverloadedStrings, NamedFieldPuns, MultiParamTypeClasses #-}
 module Test.Hls.Util
   (
       codeActionSupportCaps
     , dummyLspFuncs
     , expectCodeAction
     , expectDiagnostic
     , expectNoMoreDiagnostics
+    , failIfSessionTimeout
     , flushStackEnvironment
     , fromAction
     , fromCommand
@@ -31,6 +32,7 @@ module Test.Hls.Util
   )
 where
 
+import           Control.Exception (throwIO, catch)
 import           Control.Monad
 import           Control.Monad.IO.Class
 import           Control.Applicative.Combinators (skipManyTill, (<|>))
@@ -415,3 +417,9 @@ waitForDiagnosticsFromSourceWithTimeout timeout document source = do
         | otherwise = Nothing
 
     ignoreOthers = void Test.anyMessage >> handleMessages
+
+failIfSessionTimeout :: IO a -> IO a
+failIfSessionTimeout action = action `catch` errorHandler
+    where errorHandler :: Test.SessionException -> IO a
+          errorHandler e@(Test.Timeout _) = assertFailure $ show e
+          errorHandler e = throwIO e