X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FParsing.hs;h=8c05590304533b59e95dc1400875f9a20ad8cb87;hb=a4180c432755f683d07605f4413135d6cfadc065;hp=2e829f372284373fa6d5673f9509e140c250387e;hpb=12ac9c23d054e92a82146320e2b061c11a87e3f1;p=lsp-test.git

diff --git a/src/Language/Haskell/LSP/Test/Parsing.hs b/src/Language/Haskell/LSP/Test/Parsing.hs
index 2e829f3..8c05590 100644
--- a/src/Language/Haskell/LSP/Test/Parsing.hs
+++ b/src/Language/Haskell/LSP/Test/Parsing.hs
@@ -8,7 +8,6 @@ import Control.Applicative
 import Control.Concurrent.Chan
 import Control.Concurrent.MVar
 import Control.Monad.Trans.Class
-import Control.Monad.IO.Class
 import Control.Monad.Trans.Reader
 import Control.Monad.Trans.State
 import Data.Aeson
@@ -17,7 +16,8 @@ import Data.Conduit hiding (await)
 import Data.Conduit.Parser
 import Data.Maybe
 import Language.Haskell.LSP.Messages
-import Language.Haskell.LSP.Types 
+import Language.Haskell.LSP.Types hiding (error)
+import Language.Haskell.LSP.Test.Compat
 import Language.Haskell.LSP.Test.Decoding
 import Language.Haskell.LSP.Test.Messages
 import System.IO
@@ -27,7 +27,8 @@ data SessionContext = SessionContext
     serverIn :: Handle,
     rootDir :: FilePath,
     messageChan :: Chan FromServerMessage,
-    requestMap :: MVar RequestMap
+    requestMap :: MVar RequestMap,
+    initRsp :: MVar InitializeResponse
   }
 
 newtype SessionState = SessionState
@@ -58,7 +59,7 @@ notification :: forall m a. (Monad m, FromJSON a) => ConduitParser FromServerMes
 notification = do
   let parser = decode . encodeMsg :: FromServerMessage -> Maybe (NotificationMessage ServerMethod a)
   x <- satisfy (isJust . parser)
-  return $ fromJust $ decode $ encodeMsg x
+  return $ decodeMsg $ encodeMsg x
 
 -- | Matches if the message is a request.
 anyRequest :: Monad m => ConduitParser FromServerMessage m FromServerMessage
@@ -68,7 +69,7 @@ request :: forall m a b. (Monad m, FromJSON a, FromJSON b) => ConduitParser From
 request = do
   let parser = decode . encodeMsg :: FromServerMessage -> Maybe (RequestMessage ServerMethod a b)
   x <- satisfy (isJust . parser)
-  return $ fromJust $ decode $ encodeMsg x
+  return $ decodeMsg $ encodeMsg x
 
 -- | Matches if the message is a response.
 anyResponse :: Monad m => ConduitParser FromServerMessage m FromServerMessage
@@ -78,13 +79,17 @@ response :: forall m a. (Monad m, FromJSON a) => ConduitParser FromServerMessage
 response = do
   let parser = decode . encodeMsg :: FromServerMessage -> Maybe (ResponseMessage a)
   x <- satisfy (isJust . parser)
-  return $ fromJust $ decode $ encodeMsg x
+  return $ decodeMsg $ encodeMsg x
 
 -- | A version of encode that encodes FromServerMessages as if they
 -- weren't wrapped.
 encodeMsg :: FromServerMessage -> B.ByteString
 encodeMsg = encode . genericToJSON (defaultOptions { sumEncoding = UntaggedValue })
 
+decodeMsg :: FromJSON a => B.ByteString -> a
+decodeMsg x = fromMaybe (error $ "Unexpected message type\nGot:\n " ++ show x)
+                  (decode x)
+
 -- | Matches if the message is a log message notification or a show message notification/request.
 loggingNotification :: Monad m => ConduitParser FromServerMessage m FromServerMessage
 loggingNotification = satisfy shouldSkip
@@ -108,12 +113,6 @@ satisfy pred = do
     then return x
     else empty
 
-chanSource :: MonadIO m => Chan o -> ConduitT i o m b
-chanSource c = do
-  x <- liftIO $ readChan c
-  yield x
-  chanSource c
-
 runSession' :: Chan FromServerMessage -> SessionContext -> SessionState -> Session a -> IO (a, SessionState)
 runSession' chan context state session = runReaderT (runStateT conduit state) context
   where conduit = runConduit $ chanSource chan .| runConduitParser session