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

diff --combined haskell-lsp-test.cabal
index 51f5fb94ff2762da84d2164ac6c758da878fc02b,810a1131bfd24a7e527bf1c7e6659b374c0c38db..eef87c601a08b41cd0cff95414727d39ff648a40
--- 1/haskell-lsp-test.cabal
--- 2/haskell-lsp-test.cabal
+++ b/haskell-lsp-test.cabal
@@@ -20,7 -20,7 +20,7 @@@ librar
    default-language:    Haskell2010
    build-depends:       base >= 4.7 && < 5
                       , haskell-lsp-types
-                      , haskell-lsp
+                      , haskell-lsp >= 0.3
                       , aeson
                       , bytestring
                       , conduit
@@@ -35,7 -35,6 +35,7 @@@
                       , text
                       , transformers
                       , unordered-containers
 +                     , yi-rope
    if os(windows)
      build-depends:     Win32
    else
@@@ -57,9 -56,11 +57,11 @@@ test-suite test
    build-depends:       base >= 4.7 && < 5
                       , hspec
                       , lens
+                      , data-default
                       , directory
                       , haskell-lsp-test
                       , haskell-lsp
+                      , haskell-lsp-types
                       , conduit
                       , conduit-parse
                       , aeson

diff --combined src/Language/Haskell/LSP/Test.hs
index b2d731e675cd897de03008106bbcb316bf5253bc,7f13a59e111a4e93e63d60198b165a43388bd1db..48869b4b4d640c81aa3d39adf87cb6356caee44a
--- 1/src/Language/Haskell/LSP/Test.hs
--- 2/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@@ -16,6 -16,7 +16,7 @@@ module Language.Haskell.LSP.Tes
    -- * Sessions
      runSession
    , runSessionWithHandles
+   , runSessionWithCapabilities
    , Session
    -- * Sending
    , sendRequest
@@@ -57,12 -58,12 +58,12 @@@
    , getInitializeResponse
    , openDoc
    , getDocItem
 +  , documentContents
    , getDocUri
    ) where
  
  import Control.Applicative
  import Control.Applicative.Combinators
 -import Control.Monad
  import Control.Monad.IO.Class
  import Control.Concurrent
  import Control.Lens hiding ((.=), List)
@@@ -71,10 -72,13 +72,11 @@@ import qualified Data.Text.IO as 
  import Data.Aeson
  import qualified Data.ByteString.Lazy.Char8 as B
  import Data.Default
 -import Data.Foldable
 -import qualified Data.HashMap.Strict as HashMap
 -import Data.List
 +import qualified Data.Map as Map
 +import Data.Maybe
  import Language.Haskell.LSP.Types
  import qualified  Language.Haskell.LSP.Types as LSP (error, id)
 -import Language.Haskell.LSP.Messages
+ import Language.Haskell.LSP.TH.ClientCapabilities
  import Language.Haskell.LSP.VFS
  import Language.Haskell.LSP.Test.Compat
  import Language.Haskell.LSP.Test.Decoding
@@@ -84,14 -88,21 +86,22 @@@ import Language.Haskell.LSP.Test.Serve
  import System.IO
  import System.Directory
  import System.FilePath
 +import qualified Yi.Rope as Rope
  
  -- | Starts a new session.
  runSession :: String -- ^ The command to run the server.
             -> FilePath -- ^ The filepath to the root directory for the session.
             -> Session a -- ^ The session to run.
             -> IO a
- runSession serverExe rootDir session = do
+ runSession = runSessionWithCapabilities def
+ 
+ -- | Starts a new sesion with a client with the specified capabilities.
+ runSessionWithCapabilities :: ClientCapabilities -- ^ The capabilities the client should have.
+                            -> String -- ^ The command to run the server.
+                            -> FilePath -- ^ The filepath to the root directory for the session.
+                            -> Session a -- ^ The session to run.
+                            -> IO a
+ runSessionWithCapabilities caps serverExe rootDir session = do
    pid <- getProcessID
    absRootDir <- canonicalizePath rootDir
  
@@@ -99,7 -110,7 +109,7 @@@
                                            (Just $ T.pack absRootDir)
                                            (Just $ filePathToUri absRootDir)
                                            Nothing
-                                           def
+                                           caps
                                            (Just TraceOff)
  
    withServer serverExe $ \serverIn serverOut _ -> runSessionWithHandles serverIn serverOut listenServer rootDir $ do
@@@ -132,16 -143,38 +142,16 @@@ listenServer serverOut = d
    reqMap <- liftIO $ readMVar $ requestMap context
  
    let msg = decodeFromServerMsg reqMap msgBytes
 -  processTextChanges msg
    liftIO $ writeChan (messageChan context) msg
  
    listenServer serverOut
  
 -processTextChanges :: FromServerMessage -> Session ()
 -processTextChanges (ReqApplyWorkspaceEdit r) = do
 -  List changeParams <- case r ^. params . edit . documentChanges of
 -    Just cs -> mapM applyTextDocumentEdit cs
 -    Nothing -> case r ^. params . edit . changes of
 -      Just cs -> mapM (uncurry applyTextEdit) (List (HashMap.toList cs))
 -      Nothing -> return (List [])
 -
 -  let groupedParams = groupBy (\a b -> (a ^. textDocument == b ^. textDocument)) changeParams
 -      mergedParams = map mergeParams groupedParams
 -
 -  forM_ mergedParams (sendNotification TextDocumentDidChange)
 -
 -  where applyTextDocumentEdit (TextDocumentEdit docId (List edits)) = do
 -          oldVFS <- vfs <$> get
 -          let changeEvents = map (\e -> TextDocumentContentChangeEvent (Just (e ^. range)) Nothing (e ^. newText)) edits
 -              params = DidChangeTextDocumentParams docId (List changeEvents)
 -          newVFS <- liftIO $ changeVFS oldVFS (fmClientDidChangeTextDocumentNotification params)
 -          modify (\s -> s { vfs = newVFS })
 -          return params
 -
 -        applyTextEdit uri edits = applyTextDocumentEdit (TextDocumentEdit (VersionedTextDocumentIdentifier uri 0) edits)
 -
 -        mergeParams :: [DidChangeTextDocumentParams] -> DidChangeTextDocumentParams
 -        mergeParams params = let events = concat (toList (map (toList . (^. contentChanges)) params))
 -                             in DidChangeTextDocumentParams (head params ^. textDocument) (List events)
 -processTextChanges _ = return ()
 +-- | The current text contents of a document.
 +documentContents :: TextDocumentIdentifier -> Session T.Text
 +documentContents doc = do
 +  vfs <- vfs <$> get
 +  let file = vfs Map.! (doc ^. uri)
 +  return $ Rope.toText $ Language.Haskell.LSP.VFS._text file
  
  -- | Sends a request to the server.
  --
@@@ -198,18 -231,9 +208,18 @@@ sendNotification :: ToJSON 
                   => ClientMethod -- ^ The notification method.
                   -> a -- ^ The notification parameters.
                   -> Session ()
 -sendNotification method params =
 -  let notif = NotificationMessage "2.0" method params
 -    in sendNotification' notif
 +
 +-- | Open a virtual file if we send a did open text document notification
 +sendNotification TextDocumentDidOpen params = do
 +  let params' = fromJust $ decode $ encode params
 +      n :: DidOpenTextDocumentNotification
 +      n = NotificationMessage "2.0" TextDocumentDidOpen params'
 +  oldVFS <- vfs <$> get
 +  newVFS <- liftIO $ openVFS oldVFS n
 +  modify (\s -> s { vfs = newVFS })
 +  sendNotification' n
 +
 +sendNotification method params = sendNotification' (NotificationMessage "2.0" method params)
  
  sendNotification' :: (ToJSON a, ToJSON b) => NotificationMessage a b -> Session ()
  sendNotification' = sendMessage
@@@ -251,4 -275,3 +261,4 @@@ getDocUri file = d
    context <- ask
    let fp = rootDir context </> file
    return $ filePathToUri fp
 +

diff --combined test/Test.hs
index d615cb904fea91caac358fc30e07fd7f1f89dbc0,0bffa5e1a7c3f7a23d40205887b9216441bf5454..d83d03d5082b2cc138b2ea9bcfb86b984954cdfd
--- 1/test/Test.hs
--- 2/test/Test.hs
+++ b/test/Test.hs
@@@ -4,6 -4,7 +4,7 @@@
  {-# LANGUAGE DeriveAnyClass #-}
  import           Test.Hspec
  import           Data.Aeson
+ import           Data.Default
  import qualified Data.HashMap.Strict as HM
  import           Data.Maybe
  import           Control.Monad.IO.Class
@@@ -11,6 -12,7 +12,7 @@@ import           Control.Lens hiding (L
  import           GHC.Generics
  import           Language.Haskell.LSP.Test
  import           Language.Haskell.LSP.Test.Replay
+ import           Language.Haskell.LSP.TH.ClientCapabilities
  import           Language.Haskell.LSP.Types
  import           ParsingTests
  
@@@ -45,6 -47,12 +47,12 @@@ main = hspec $ d
        rsp <- getInitializeResponse
        liftIO $ rsp ^. result `shouldNotBe` Nothing
  
+     it "can register specific capabilities" $ do
+       let caps = def { _workspace = Just workspaceCaps }
+           workspaceCaps = def { _didChangeConfiguration = Just configCaps }
+           configCaps = DidChangeConfigurationClientCapabilities (Just True)
+       runSessionWithCapabilities caps "hie --lsp" "test/data/renamePass" $ return ()
+ 
    describe "replay session" $ do
      it "passes a test" $
        replaySession "hie --lsp" "test/data/renamePass" `shouldReturn` True
@@@ -88,9 -96,6 +96,9 @@@
  
          checkNoDiagnostics
  
 +        contents <- documentContents doc
 +        liftIO $ contents `shouldBe` "main :: IO Int\nmain = return 42"
 +
    parsingSpec
  
  data ApplyOneParams = AOP