Properly terminate server handler thread on exceptions

diff --git a/src/Language/Haskell/LSP/Test/Decoding.hs b/src/Language/Haskell/LSP/Test/Decoding.hs
index 059ab344dafad445003e0f066583cd779d5d79a1..b3929abbf4da57d983015597b929707213cd97c4 100644 (file)
--- a/src/Language/Haskell/LSP/Test/Decoding.hs
+++ b/src/Language/Haskell/LSP/Test/Decoding.hs
@@ -3,12 +3,15 @@ module Language.Haskell.LSP.Test.Decoding where
 
 import           Prelude                 hiding ( id )
 import           Data.Aeson
+import           Control.Exception
 import           Control.Lens
 import qualified Data.ByteString.Lazy.Char8    as B
 import           Data.Maybe
 import           System.IO
+import           System.IO.Error
 import           Language.Haskell.LSP.Types
-import           Language.Haskell.LSP.Types.Lens hiding (error)
+import           Language.Haskell.LSP.Types.Lens
+                                         hiding ( error )
 import           Language.Haskell.LSP.Messages
 import qualified Data.HashMap.Strict           as HM
 
@@ -42,9 +45,12 @@ addHeader content = B.concat
 
 getHeaders :: Handle -> IO [(String, String)]
 getHeaders h = do
-  l <- hGetLine h
+  l <- catch (hGetLine h) eofHandler 
   let (name, val) = span (/= ':') l
   if null val then return [] else ((name, drop 2 val) :) <$> getHeaders h
+  where eofHandler e
+          | isEOFError e = error "Language Server unexpectedly terminated"
+          | otherwise = throw e
 
 type RequestMap = HM.HashMap LspId ClientMethod
 

diff --git a/src/Language/Haskell/LSP/Test/Session.hs b/src/Language/Haskell/LSP/Test/Session.hs
index 9af3a6774150b559500ee544ce63a298b944d387..a153cba988890e08b5fe6f54e40d3a8cdfcbb377 100644 (file)
--- a/src/Language/Haskell/LSP/Test/Session.hs
+++ b/src/Language/Haskell/LSP/Test/Session.hs
@@ -203,11 +203,9 @@ runSessionWithHandles serverIn serverOut serverHandler config caps rootDir sessi
 
   let context = SessionContext serverIn absRootDir messageChan reqMap initRsp config caps
       initState = SessionState (IdInt 0) mempty mempty 0 False Nothing
-
-  threadId <- forkIO $ void $ serverHandler serverOut context
-  (result, _) <- runSession context initState session
-
-  killThread threadId
+      launchServerHandler = forkIO $ void $ serverHandler serverOut context
+  (result, _) <- bracket launchServerHandler killThread $
+    const $ runSession context initState session
 
   return result
 

diff --git a/stack.yaml b/stack.yaml
index 2c97f95d41adcd18f7e966e5321d538ae745a3c0..0c1d999cf218b8d3e0d8e3b4eb4b91eff1c3fbb9 100644 (file)
--- a/stack.yaml
+++ b/stack.yaml
@@ -1,4 +1,4 @@
-resolver: lts-12.17
+resolver: nightly-2018-12-01
 packages:
   - .
 

diff --git a/test/Test.hs b/test/Test.hs
index 9319a779ee22cc4f2cac5d9e7563a16c878e3ae7..e4aae5517c90362c1d50e87bf12df4105ef4bc8a 100644 (file)
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -30,7 +30,7 @@ import           System.Timeout
 main = hspec $ do
   describe "Session" $ do
     it "fails a test" $
-      -- TODO: Catch the exception in haskell-lsp-test and provide nicer output
+      -- TODO: Catch the exception in lsp-test and provide nicer output
       let session = runSession "hie" fullCaps "test/data/renamePass" $ do
                       openDoc "Desktop/simple.hs" "haskell"
                       skipMany loggingNotification