Merge branch 'master' of https://github.com/Bubba/haskell-lsp-test

diff --combined example/Main.hs
index 0c8ae9ff821618ee85f198decd3170e199e391ed,1697ca53d90cd51b2144b2d438efbc00ab568c70..fc453db39cdb032a98cb0c468e697167816458cf
--- 1/example/Main.hs
--- 2/example/Main.hs
+++ b/example/Main.hs
@@@ -4,15 -4,15 +4,15 @@@ import Data.Prox
  
  import Control.Monad.IO.Class
  
 -main = runSession "test/recordings/renamePass" $ do
 +main = runSession "hie" "test/recordings/renamePass" $ do
  
    docItem <- getDocItem "Desktop/simple.hs" "haskell"
    docId <- TextDocumentIdentifier <$> getDocUri "Desktop/simple.hs"
  
    sendNotification TextDocumentDidOpen (DidOpenTextDocumentParams docItem)
    
-   sendRequest (Proxy :: Proxy DocumentSymbolRequest) TextDocumentDocumentSymbol (DocumentSymbolParams docId)
+   sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams docId)
  
    skipMany loggingNotification
  
-   response >>= liftIO . print
+   anyResponse >>= liftIO . print

diff --combined src/Language/Haskell/LSP/Test.hs
index 087143fa8960537db6d71dab2c3bc70e82e83221,fb928a4b9ccd0bfbec75cd4bae66af408e885242..79b7b1e7147934150d4cf632b9c142940e2191e0
--- 1/src/Language/Haskell/LSP/Test.hs
--- 2/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@@ -24,8 -24,11 +24,11 @@@ module Language.Haskell.LSP.Tes
    , sendNotification'
    , sendResponse
    -- * Receving
+   , anyRequest
    , request
+   , anyResponse
    , response
+   , anyNotification
    , notification
    , loggingNotification
    , publishDiagnosticsNotification
@@@ -61,17 -64,15 +64,15 @@@ import Control.Applicative.Combinator
  import Control.Monad
  import Control.Monad.IO.Class
  import Control.Concurrent
- import Control.Lens
+ import Control.Lens hiding ((.=))
  import qualified Data.Text as T
  import qualified Data.Text.IO as T
  import Data.Aeson
  import qualified Data.ByteString.Lazy.Char8 as B
  import Data.Default
- import Data.Proxy
  import System.Process
  import Language.Haskell.LSP.Types
- import qualified  Language.Haskell.LSP.Types as LSP (error)
- import Language.Haskell.LSP.Messages
+ import qualified  Language.Haskell.LSP.Types as LSP (error, id)
  import Language.Haskell.LSP.Test.Compat
  import System.IO
  import System.Directory
@@@ -80,11 -81,10 +81,11 @@@ import Language.Haskell.LSP.Test.Decodi
  import Language.Haskell.LSP.Test.Parsing
  
  -- | Starts a new session.
 -runSession :: FilePath -- ^ The filepath to the root directory for the session.
 +runSession :: FilePath -- ^ The filepath to the server executable.
 +           -> FilePath -- ^ The filepath to the root directory for the session.
             -> Session a -- ^ The session to run.
             -> IO ()
 -runSession rootDir session = do
 +runSession serverExe rootDir session = do
    pid <- getProcessID
    absRootDir <- canonicalizePath rootDir
  
@@@ -95,11 -95,11 +96,11 @@@
                                            def
                                            (Just TraceOff)
  
 -  runSessionWithHandler listenServer rootDir $ do
 +  runSessionWithHandler listenServer serverExe rootDir $ do
  
      -- Wrap the session around initialize and shutdown calls
-     sendRequest (Proxy :: Proxy InitializeRequest) Initialize initializeParams
-     RspInitialize initRsp <- response
+     sendRequest Initialize initializeParams
+     initRsp <- response :: Session InitializeResponse
      liftIO $ maybe (return ()) (putStrLn . ("Error while initializing: " ++) . show ) (initRsp ^. LSP.error)
  
      sendNotification Initialized InitializedParams
@@@ -112,15 -112,14 +113,15 @@@
  -- | An internal version of 'runSession' that allows for a custom handler to listen to the server.
  -- It also does not automatically send initialize and exit messages.
  runSessionWithHandler :: (Handle -> Session ())
 +                      -> FilePath
                        -> FilePath
                        -> Session a
                        -> IO a
 -runSessionWithHandler serverHandler rootDir session = do
 +runSessionWithHandler serverHandler serverExe rootDir session = do
    absRootDir <- canonicalizePath rootDir
  
    (Just serverIn, Just serverOut, Nothing, serverProc) <- createProcess
 -    (proc "hie" ["--lsp", "-d", "-l", "/tmp/hie-test.log"])
 +    (proc serverExe ["--lsp", "-d", "-l", "/tmp/hie-test.log"])
      { std_in = CreatePipe, std_out = CreatePipe }
  
    hSetBuffering serverIn  NoBuffering
@@@ -133,10 -132,11 +134,11 @@@
    let context = SessionContext serverIn absRootDir messageChan reqMap
        initState = SessionState (IdInt 9)
  
-   forkIO $ void $ runSession' meaninglessChan context initState (serverHandler serverOut)
+   threadId <- forkIO $ void $ runSession' meaninglessChan context initState (serverHandler serverOut)
    (result, _) <- runSession' messageChan context initState session
  
    terminateProcess serverProc
+   killThread threadId
  
    return result
  
@@@ -161,29 -161,45 +163,45 @@@ listenServer serverOut = d
  --             (DocumentSymbolParams docId)
  -- @
  sendRequest
-   :: forall params resp. (ToJSON params, ToJSON resp, FromJSON resp)
-   => Proxy (RequestMessage ClientMethod params resp) -- ^ A proxy to provide more type information about the request.
-   -> ClientMethod -- ^ The request method.
+   :: (ToJSON params)
+   => --Proxy (RequestMessage ClientMethod params resp) -- ^ A proxy to provide more type information about the request.
+   ClientMethod -- ^ The request method.
    -> params -- ^ The request parameters.
    -> Session LspId -- ^ The id of the request that was sent.
- sendRequest _ method params = do
+ sendRequest method params = do
    id <- curReqId <$> get
    modify $ \c -> c { curReqId = nextId id }
  
-   let req = RequestMessage "2.0" id method params :: RequestMessage ClientMethod params resp
+   let req = RequestMessage' "2.0" id method params
  
-   sendRequest' req
+   -- Update the request map
+   reqMap <- requestMap <$> ask
+   liftIO $ modifyMVar_ reqMap $
+     \r -> return $ updateRequestMap r id method
+ 
+   sendMessage req
  
    return id
  
    where nextId (IdInt i) = IdInt (i + 1)
          nextId (IdString s) = IdString $ T.pack $ show $ read (T.unpack s) + 1
  
+ -- | A custom type for request message that doesn't
+ -- need a response type, allows us to infer the request
+ -- message type without using proxies.
+ data RequestMessage' a = RequestMessage' T.Text LspId ClientMethod a
+ 
+ instance ToJSON a => ToJSON (RequestMessage' a) where
+   toJSON (RequestMessage' rpc id method params) =
+     object ["jsonrpc" .= rpc, "id" .= id, "method" .= method, "params" .= params]
+ 
+ 
  sendRequest' :: (ToJSON a, ToJSON b) => RequestMessage ClientMethod a b -> Session ()
  sendRequest' req = do
    -- Update the request map
    reqMap <- requestMap <$> ask
-   liftIO $ modifyMVar_ reqMap (return . flip updateRequestMap req)
+   liftIO $ modifyMVar_ reqMap $
+     \r -> return $ updateRequestMap r (req ^. LSP.id) (req ^. method)
  
    sendMessage req
  

diff --combined src/Language/Haskell/LSP/Test/Replay.hs
index 4802c9ad152afb7b57d8a2a7d906d81b99a459a8,2d5e4e612284ab6c3329a5aa7c36c548f45a1ef2..dfa364b44c3600b4682eca2f94699f2fea16fad3
--- 1/src/Language/Haskell/LSP/Test/Replay.hs
--- 2/src/Language/Haskell/LSP/Test/Replay.hs
+++ b/src/Language/Haskell/LSP/Test/Replay.hs
@@@ -29,10 -29,9 +29,10 @@@ import           Language.Haskell.LSP.T
  -- makes sure it matches up with an expected response.
  -- The session directory should have a captured session file in it
  -- named "session.log".
 -replaySession :: FilePath -- ^ The recorded session directory.
 +replaySession :: FilePath -- ^ The filepath to the server executable.
 +              -> FilePath -- ^ The recorded session directory.
                -> IO Bool
 -replaySession sessionDir = do
 +replaySession serverExe sessionDir = do
  
    entries <- B.lines <$> B.readFile (sessionDir </> "session.log")
  
@@@ -51,10 -50,14 +51,15 @@@
    rspSema <- newEmptyMVar
    passVar <- newEmptyMVar :: IO (MVar Bool)
  
-   forkIO $ runSessionWithHandler (listenServer serverMsgs requestMap reqSema rspSema passVar) serverExe sessionDir $
-     sendMessages clientMsgs reqSema rspSema
+   threadId <- forkIO $
+     runSessionWithHandler (listenServer serverMsgs requestMap reqSema rspSema passVar)
++                          serverExe
+                           sessionDir
+                           (sendMessages clientMsgs reqSema rspSema)
  
-   takeMVar passVar
+   result <- takeMVar passVar
+   killThread threadId
+   return result
  
    where
      isClientMsg (FromClient _ _) = True

diff --combined test/Test.hs
index c7e67131d914875b1fb41f98cb8928b8dba1f7e5,ca135c7a379c3790f80e640262610b8887bde55b..426dd6bd704f3df283e2f19e7ac08609697211d9
--- 1/test/Test.hs
--- 2/test/Test.hs
+++ b/test/Test.hs
@@@ -2,32 -2,28 +2,28 @@@
  {-# LANGUAGE OverloadedStrings #-}
  import           Test.Hspec
  import           Data.Maybe
- import           Data.Proxy
  import           Control.Monad.IO.Class
  import           Control.Lens hiding (List)
  import           Language.Haskell.LSP.Test
  import           Language.Haskell.LSP.Test.Replay
  import           Language.Haskell.LSP.Types
- import           Language.Haskell.LSP.Messages
  import           ParsingTests
  
  main = hspec $ do
-   describe "manual session validation" $ do
+   describe "manual session" $ do
      it "passes a test" $
 -      runSession "test/recordings/renamePass" $ do
 +      runSession "hie" "test/recordings/renamePass" $ do
          doc <- openDoc "Desktop/simple.hs" "haskell"
  
          skipMany loggingNotification
  
-         NotPublishDiagnostics diagsNot <- notification
+         diagsNot <- notification :: Session PublishDiagnosticsNotification
  
          liftIO $ diagsNot ^. params . diagnostics `shouldBe` List []
          
-         sendRequest (Proxy :: Proxy DocumentSymbolRequest)
-                     TextDocumentDocumentSymbol
-                     (DocumentSymbolParams doc)
+         sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc)
  
-         RspDocumentSymbols rspSymbols <- response
+         rspSymbols <- response :: Session DocumentSymbolsResponse
          
          liftIO $ do
            let (List symbols) = fromJust (rspSymbols ^. result)
@@@ -39,16 -35,16 +35,16 @@@
      
      it "fails a test" $
        -- TODO: Catch the exception in haskell-lsp-test and provide nicer output
 -      let session = runSession "test/recordings/renamePass" $ do
 +      let session = runSession "hie" "test/recordings/renamePass" $ do
                        openDoc "Desktop/simple.hs" "haskell"
                        skipMany loggingNotification
-                     request
+                       anyRequest
          in session `shouldThrow` anyException
    
    describe "replay session" $ do
      it "passes a test" $
 -      replaySession "test/recordings/renamePass" `shouldReturn` True
 +      replaySession "hie" "test/recordings/renamePass" `shouldReturn` True
      it "fails a test" $
 -      replaySession "test/recordings/renameFail" `shouldReturn` False
 +      replaySession "hie" "test/recordings/renameFail" `shouldReturn` False
    
    parsingSpec