From bece589927102eb7cc66db5200ec11b568d35748 Mon Sep 17 00:00:00 2001
From: Luke Lau <luke_lau@icloud.com>
Date: Wed, 11 Jul 2018 13:53:20 +0100
Subject: [PATCH 01/16] Remove leftover loggin

---
 src/Language/Haskell/LSP/Test.hs | 2 --
 1 file changed, 2 deletions(-)

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index 592589c..3ba8690 100644
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -153,8 +153,6 @@ runSessionWithConfig config serverExe rootDir session = do
 documentContents :: TextDocumentIdentifier -> Session T.Text
 documentContents doc = do
   vfs <- vfs <$> get
-  liftIO $ print vfs
-  liftIO $ print doc
   let file = vfs Map.! (doc ^. uri)
   return $ Rope.toText $ Language.Haskell.LSP.VFS._text file
 
-- 
2.30.2


From b0865d289f761343190dbe6c9969539f17e2d72a Mon Sep 17 00:00:00 2001
From: Luke Lau <luke_lau@icloud.com>
Date: Thu, 12 Jul 2018 13:53:23 +0100
Subject: [PATCH 02/16] Add getReferences

---
 src/Language/Haskell/LSP/Test.hs |  8 ++++++++
 test/Test.hs                     | 15 ++++++++++++++-
 2 files changed, 22 insertions(+), 1 deletion(-)

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index 3ba8690..bc1faa1 100644
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -60,6 +60,8 @@ module Language.Haskell.LSP.Test
   , executeCodeAction
   -- ** Completions
   , getCompletions
+  -- ** References
+  , getReferences
   -- ** Edits
   , applyEdit
   ) where
@@ -414,3 +416,9 @@ getCompletions doc pos = do
   case res of
     Completions (List items) -> return items
     CompletionList (CompletionListType _ (List items)) -> return items
+
+getReferences :: TextDocumentIdentifier -> Position -> Bool -> Session [Location]
+getReferences doc pos inclDecl =
+  let ctx = ReferenceContext inclDecl
+      params = ReferenceParams doc pos ctx
+  in fromMaybe [] . (^. result) <$> sendRequest TextDocumentReferences params 
diff --git a/test/Test.hs b/test/Test.hs
index 1a09b29..005018c 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -18,7 +18,7 @@ import           Language.Haskell.LSP.Messages
 import           Language.Haskell.LSP.Test
 import           Language.Haskell.LSP.Test.Replay
 import           Language.Haskell.LSP.Types.Capabilities
-import           Language.Haskell.LSP.Types hiding (capabilities, message)
+import           Language.Haskell.LSP.Types as LSP hiding (capabilities, message)
 import           System.Timeout
 
 {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}
@@ -226,6 +226,19 @@ main = hspec $ do
         item ^. kind `shouldBe` Just CiFunction
         item ^. detail `shouldBe` Just "Items -> IO ()\nMain"
 
+  describe "getReferences" $
+    it "works" $ runSession "hie --lsp" "test/data/renamePass" $ do
+      doc <- openDoc "Desktop/simple.hs" "haskell"
+      let pos = Position 40 3 -- interactWithUser
+          uri = doc ^. LSP.uri
+      refs <- getReferences doc pos True
+      liftIO $ refs `shouldContain` map (Location uri) [
+          mkRange 41 0 41 16
+        , mkRange 75 6 75 22
+        , mkRange 71 6 71 22
+        ]
+    where mkRange sl sc el ec = Range (Position sl sc) (Position el ec)
+
 
 didChangeCaps :: ClientCapabilities
 didChangeCaps = def { _workspace = Just workspaceCaps }
-- 
2.30.2


From f940434fbd873e90124a46bd1386c59e8cee49f7 Mon Sep 17 00:00:00 2001
From: Luke Lau <luke_lau@icloud.com>
Date: Thu, 12 Jul 2018 14:07:25 +0100
Subject: [PATCH 03/16] Add waitForDiagnosticsSource

---
 src/Language/Haskell/LSP/Test.hs | 12 ++++++++++++
 test/Test.hs                     | 10 +++++++++-
 test/data/error/Error.hs         |  2 ++
 3 files changed, 23 insertions(+), 1 deletion(-)
 create mode 100644 test/data/error/Error.hs

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index bc1faa1..3def440 100644
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -52,6 +52,7 @@ module Language.Haskell.LSP.Test
   , getDocumentSymbols
   -- ** Diagnostics
   , waitForDiagnostics
+  , waitForDiagnosticsSource
   , noDiagnostics
   -- ** Commands
   , executeCommand
@@ -308,6 +309,17 @@ waitForDiagnostics = do
   let (List diags) = diagsNot ^. params . LSP.diagnostics
   return diags
 
+waitForDiagnosticsSource :: String -> Session [Diagnostic]
+waitForDiagnosticsSource src = do
+  diags <- waitForDiagnostics
+  let res = filter matches diags
+  if null res
+    then waitForDiagnosticsSource src
+    else return res
+  where
+    matches :: Diagnostic -> Bool
+    matches d = d ^. source == Just (T.pack src)
+
 -- | Expects a 'PublishDiagnosticsNotification' and throws an
 -- 'UnexpectedDiagnosticsException' if there are any diagnostics
 -- returned.
diff --git a/test/Test.hs b/test/Test.hs
index 005018c..eedc887 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -237,8 +237,16 @@ main = hspec $ do
         , mkRange 75 6 75 22
         , mkRange 71 6 71 22
         ]
-    where mkRange sl sc el ec = Range (Position sl sc) (Position el ec)
 
+  describe "waitForDiagnosticsSource" $
+    it "works" $ runSession "hie --lsp" "test/data/error" $ do
+      openDoc "Error.hs" "haskell"
+      [diag] <- waitForDiagnosticsSource "ghcmod"
+      liftIO $ do
+        diag ^. severity `shouldBe` Just DsError
+        diag ^. source `shouldBe` Just "ghcmod"
+
+mkRange sl sc el ec = Range (Position sl sc) (Position el ec)
 
 didChangeCaps :: ClientCapabilities
 didChangeCaps = def { _workspace = Just workspaceCaps }
diff --git a/test/data/error/Error.hs b/test/data/error/Error.hs
new file mode 100644
index 0000000..79c1dd9
--- /dev/null
+++ b/test/data/error/Error.hs
@@ -0,0 +1,2 @@
+main :: IO Int
+main = return "hello"
-- 
2.30.2


From b39cc258cdffae26e2a783470995df73e4099070 Mon Sep 17 00:00:00 2001
From: Luke Lau <luke_lau@icloud.com>
Date: Thu, 12 Jul 2018 15:30:10 +0100
Subject: [PATCH 04/16] Add rename

---
 src/Language/Haskell/LSP/Test.hs | 30 +++++++++++++++++++++++++-----
 test/Test.hs                     |  8 +++++++-
 test/data/{error => }/Error.hs   |  0
 test/data/Rename.hs              |  2 ++
 4 files changed, 34 insertions(+), 6 deletions(-)
 rename test/data/{error => }/Error.hs (100%)
 create mode 100644 test/data/Rename.hs

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index 3def440..c5090f9 100644
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -63,6 +63,8 @@ module Language.Haskell.LSP.Test
   , getCompletions
   -- ** References
   , getReferences
+  -- ** Renaming
+  , rename
   -- ** Edits
   , applyEdit
   ) where
@@ -422,15 +424,33 @@ getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
 getCompletions doc pos = do
   rsp <- sendRequest TextDocumentCompletion (TextDocumentPositionParams doc pos)
 
-  let exc = throw $ UnexpectedResponseError (rsp ^. LSP.id)
-                                            (fromJust $ rsp ^. LSP.error)
-      res = fromMaybe exc (rsp ^. result)
-  case res of
+  case getResponseResult rsp of
     Completions (List items) -> return items
     CompletionList (CompletionListType _ (List items)) -> return items
 
-getReferences :: TextDocumentIdentifier -> Position -> Bool -> Session [Location]
+-- | Returns the references for the position in the document.
+getReferences :: TextDocumentIdentifier -- ^ The document to lookup in.
+              -> Position -- ^ The position to lookup. 
+              -> Bool -- ^ Whether to include declarations as references.
+              -> Session [Location] -- ^ The locations of the references.
 getReferences doc pos inclDecl =
   let ctx = ReferenceContext inclDecl
       params = ReferenceParams doc pos ctx
   in fromMaybe [] . (^. result) <$> sendRequest TextDocumentReferences params 
+
+-- ^ Renames the term at the specified position.
+rename :: TextDocumentIdentifier -> Position -> String -> Session ()
+rename doc pos newName = do
+  let params = RenameParams doc pos (T.pack newName)
+  rsp <- sendRequest TextDocumentRename params :: Session RenameResponse
+  let wEdit = getResponseResult rsp
+      req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
+  updateState (ReqApplyWorkspaceEdit req)
+
+-- | Checks the response for errors and throws an exception if needed.
+-- Returns the result if successful.
+getResponseResult :: ResponseMessage a -> a 
+getResponseResult rsp = fromMaybe exc (rsp ^. result)
+  where exc = throw $ UnexpectedResponseError (rsp ^. LSP.id)
+                                              (fromJust $ rsp ^. LSP.error)
+
diff --git a/test/Test.hs b/test/Test.hs
index eedc887..6353e09 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -239,13 +239,19 @@ main = hspec $ do
         ]
 
   describe "waitForDiagnosticsSource" $
-    it "works" $ runSession "hie --lsp" "test/data/error" $ do
+    it "works" $ runSession "hie --lsp" "test/data" $ do
       openDoc "Error.hs" "haskell"
       [diag] <- waitForDiagnosticsSource "ghcmod"
       liftIO $ do
         diag ^. severity `shouldBe` Just DsError
         diag ^. source `shouldBe` Just "ghcmod"
 
+  describe "rename" $
+    it "works" $ runSession "hie --lsp" "test/data" $ do
+      doc <- openDoc "Rename.hs" "haskell"
+      rename doc (Position 1 0) "bar"
+      documentContents doc >>= liftIO . shouldBe "main = bar\nbar = return 42\n"
+
 mkRange sl sc el ec = Range (Position sl sc) (Position el ec)
 
 didChangeCaps :: ClientCapabilities
diff --git a/test/data/error/Error.hs b/test/data/Error.hs
similarity index 100%
rename from test/data/error/Error.hs
rename to test/data/Error.hs
diff --git a/test/data/Rename.hs b/test/data/Rename.hs
new file mode 100644
index 0000000..13e4d96
--- /dev/null
+++ b/test/data/Rename.hs
@@ -0,0 +1,2 @@
+main = foo
+foo = return 42
-- 
2.30.2


From 9b78d100e96d3ea4c059edbc45d3d084dddcab0a Mon Sep 17 00:00:00 2001
From: Luke Lau <luke_lau@icloud.com>
Date: Sat, 14 Jul 2018 12:12:52 +0100
Subject: [PATCH 05/16] Add getDefinitions

---
 src/Language/Haskell/LSP/Test.hs | 16 ++++++++++++++--
 test/Test.hs                     |  7 +++++++
 2 files changed, 21 insertions(+), 2 deletions(-)

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index c5090f9..d4c6311 100644
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -9,7 +9,9 @@
 -- Maintainer  : luke_lau@icloud.com
 -- Stability   : experimental
 --
--- A framework for testing <https://github.com/Microsoft/language-server-protocol Language Server Protocol servers> at the JSON level.
+-- A framework for testing
+-- <https://github.com/Microsoft/language-server-protocol Language Server Protocol servers>
+-- functionally.
 
 module Language.Haskell.LSP.Test
   (
@@ -63,6 +65,8 @@ module Language.Haskell.LSP.Test
   , getCompletions
   -- ** References
   , getReferences
+  -- ** Definitions
+  , getDefinitions
   -- ** Renaming
   , rename
   -- ** Edits
@@ -436,7 +440,15 @@ getReferences :: TextDocumentIdentifier -- ^ The document to lookup in.
 getReferences doc pos inclDecl =
   let ctx = ReferenceContext inclDecl
       params = ReferenceParams doc pos ctx
-  in fromMaybe [] . (^. result) <$> sendRequest TextDocumentReferences params 
+  in getResponseResult <$> sendRequest TextDocumentReferences params 
+
+-- | Returns the definition(s) for the term at the specified position.
+getDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
+               -> Position -- ^ The position the term is at.
+               -> Session [Location] -- ^ The location(s) of the definitions
+getDefinitions doc pos =
+  let params = TextDocumentPositionParams doc pos
+  in getResponseResult <$> sendRequest TextDocumentDefinition params
 
 -- ^ Renames the term at the specified position.
 rename :: TextDocumentIdentifier -> Position -> String -> Session ()
diff --git a/test/Test.hs b/test/Test.hs
index 6353e09..0bd7965 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -238,6 +238,13 @@ main = hspec $ do
         , mkRange 71 6 71 22
         ]
 
+  describe "getDefinitions" $
+    it "works" $ runSession "hie --lsp" "test/data/renamePass" $ do
+      doc <- openDoc "Desktop/simple.hs" "haskell"
+      let pos = Position 49 25 -- addItem
+      defs <- getDefinitions doc pos
+      liftIO $ defs `shouldBe` [Location (doc ^. uri) (mkRange 28 0 28 7)]
+
   describe "waitForDiagnosticsSource" $
     it "works" $ runSession "hie --lsp" "test/data" $ do
       openDoc "Error.hs" "haskell"
-- 
2.30.2


From 0d03bbc4a85a2d625fa663a47bcd079883bf7900 Mon Sep 17 00:00:00 2001
From: Luke Lau <luke_lau@icloud.com>
Date: Tue, 17 Jul 2018 00:20:21 +0100
Subject: [PATCH 06/16] Add getHover

---
 src/Language/Haskell/LSP/Test.hs | 8 ++++++++
 test/Test.hs                     | 9 +++++++++
 2 files changed, 17 insertions(+)

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index d4c6311..403c0e1 100644
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -69,6 +69,8 @@ module Language.Haskell.LSP.Test
   , getDefinitions
   -- ** Renaming
   , rename
+  -- ** Hover
+  , getHover
   -- ** Edits
   , applyEdit
   ) where
@@ -459,6 +461,12 @@ rename doc pos newName = do
       req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
   updateState (ReqApplyWorkspaceEdit req)
 
+-- ^ Returns the hover information at the specified position.
+getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover)
+getHover doc pos = do
+  let params = TextDocumentPositionParams doc pos
+  getResponseResult <$> sendRequest TextDocumentHover params
+
 -- | Checks the response for errors and throws an exception if needed.
 -- Returns the result if successful.
 getResponseResult :: ResponseMessage a -> a 
diff --git a/test/Test.hs b/test/Test.hs
index 0bd7965..e342440 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -7,6 +7,7 @@ import           Test.Hspec
 import           Data.Aeson
 import           Data.Default
 import qualified Data.HashMap.Strict as HM
+import           Data.Maybe
 import qualified Data.Text as T
 import           Control.Applicative.Combinators
 import           Control.Concurrent
@@ -259,6 +260,14 @@ main = hspec $ do
       rename doc (Position 1 0) "bar"
       documentContents doc >>= liftIO . shouldBe "main = bar\nbar = return 42\n"
 
+  describe "getHover" $
+    it "works" $ runSession "hie --lsp" "test/data/renamePass" $ do
+      doc <- openDoc "Desktop/simple.hs" "haskell"
+      -- hover returns nothing until module is loaded
+      skipManyTill loggingNotification $ count 2 noDiagnostics
+      hover <- getHover doc (Position 45 9) -- putStrLn
+      liftIO $ hover `shouldSatisfy` isJust
+
 mkRange sl sc el ec = Range (Position sl sc) (Position el ec)
 
 didChangeCaps :: ClientCapabilities
-- 
2.30.2


From 52fa38c9702407f58aeea09c6bded442d672d7fd Mon Sep 17 00:00:00 2001
From: Luke Lau <luke_lau@icloud.com>
Date: Tue, 17 Jul 2018 13:35:54 +0100
Subject: [PATCH 07/16] Add getHighlights

---
 src/Language/Haskell/LSP/Test.hs | 11 +++++++++--
 test/Test.hs                     |  6 ++++++
 2 files changed, 15 insertions(+), 2 deletions(-)

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index 403c0e1..e47109e 100644
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -71,6 +71,8 @@ module Language.Haskell.LSP.Test
   , rename
   -- ** Hover
   , getHover
+  -- ** Highlights
+  , getHighlights
   -- ** Edits
   , applyEdit
   ) where
@@ -463,9 +465,14 @@ rename doc pos newName = do
 
 -- ^ Returns the hover information at the specified position.
 getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover)
-getHover doc pos = do
+getHover doc pos =
   let params = TextDocumentPositionParams doc pos
-  getResponseResult <$> sendRequest TextDocumentHover params
+  in getResponseResult <$> sendRequest TextDocumentHover params
+
+getHighlights :: TextDocumentIdentifier -> Position -> Session [DocumentHighlight]
+getHighlights doc pos =
+  let params = TextDocumentPositionParams doc pos
+  in getResponseResult <$> sendRequest TextDocumentDocumentHighlight params
 
 -- | Checks the response for errors and throws an exception if needed.
 -- Returns the result if successful.
diff --git a/test/Test.hs b/test/Test.hs
index e342440..a17be20 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -267,6 +267,12 @@ main = hspec $ do
       skipManyTill loggingNotification $ count 2 noDiagnostics
       hover <- getHover doc (Position 45 9) -- putStrLn
       liftIO $ hover `shouldSatisfy` isJust
+  describe "getHighlights" $
+    it "works" $ runSession "hie --lsp" "test/data/renamePass" $ do
+      doc <- openDoc "Desktop/simple.hs" "haskell"
+      skipManyTill loggingNotification $ count 2 noDiagnostics
+      highlights <- getHighlights doc (Position 27 4) -- addItem
+      liftIO $ length highlights `shouldBe` 4
 
 mkRange sl sc el ec = Range (Position sl sc) (Position el ec)
 
-- 
2.30.2


From 35ce787a5458ffdce71923e40464448d6ea71801 Mon Sep 17 00:00:00 2001
From: Luke Lau <luke_lau@icloud.com>
Date: Tue, 17 Jul 2018 14:30:02 +0100
Subject: [PATCH 08/16] Add formatDoc and formatRange

---
 src/Language/Haskell/LSP/Test.hs         | 26 +++++++++++++++++++++++-
 src/Language/Haskell/LSP/Test/Session.hs |  1 -
 test/Test.hs                             | 15 ++++++++++++++
 test/data/Format.hs                      |  4 ++++
 4 files changed, 44 insertions(+), 2 deletions(-)
 create mode 100644 test/data/Format.hs

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index e47109e..b648078 100644
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -73,6 +73,9 @@ module Language.Haskell.LSP.Test
   , getHover
   -- ** Highlights
   , getHighlights
+  -- ** Formatting
+  , formatDoc
+  , formatRange
   -- ** Edits
   , applyEdit
   ) where
@@ -463,12 +466,13 @@ rename doc pos newName = do
       req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
   updateState (ReqApplyWorkspaceEdit req)
 
--- ^ Returns the hover information at the specified position.
+-- | Returns the hover information at the specified position.
 getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover)
 getHover doc pos =
   let params = TextDocumentPositionParams doc pos
   in getResponseResult <$> sendRequest TextDocumentHover params
 
+-- | Returns the highlighted occurences of the term at the specified position
 getHighlights :: TextDocumentIdentifier -> Position -> Session [DocumentHighlight]
 getHighlights doc pos =
   let params = TextDocumentPositionParams doc pos
@@ -481,3 +485,23 @@ getResponseResult rsp = fromMaybe exc (rsp ^. result)
   where exc = throw $ UnexpectedResponseError (rsp ^. LSP.id)
                                               (fromJust $ rsp ^. LSP.error)
 
+-- | Applies formatting to the specified document.
+formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session ()
+formatDoc doc opts = do
+  let params = DocumentFormattingParams doc opts
+  edits <- getResponseResult <$> sendRequest TextDocumentFormatting params
+  applyTextEdits doc edits
+
+-- | Applies formatting to the specified range in a document.
+formatRange :: TextDocumentIdentifier -> FormattingOptions -> Range -> Session ()
+formatRange doc opts range = do
+  let params = DocumentRangeFormattingParams doc range opts
+  edits <- getResponseResult <$> sendRequest TextDocumentRangeFormatting params
+  applyTextEdits doc edits
+
+applyTextEdits :: TextDocumentIdentifier -> List TextEdit -> Session ()
+applyTextEdits doc edits =
+  let wEdit = WorkspaceEdit (Just (HashMap.singleton (doc ^. uri) edits)) Nothing
+      req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
+  in updateState (ReqApplyWorkspaceEdit req)
+
diff --git a/src/Language/Haskell/LSP/Test/Session.hs b/src/Language/Haskell/LSP/Test/Session.hs
index 1dee298..218defb 100644
--- a/src/Language/Haskell/LSP/Test/Session.hs
+++ b/src/Language/Haskell/LSP/Test/Session.hs
@@ -208,7 +208,6 @@ updateState (NotPublishDiagnostics n) = do
 
 updateState (ReqApplyWorkspaceEdit r) = do
 
-
   allChangeParams <- case r ^. params . edit . documentChanges of
     Just (List cs) -> do
       mapM_ (checkIfNeedsOpened . (^. textDocument . uri)) cs
diff --git a/test/Test.hs b/test/Test.hs
index a17be20..56bd01d 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -267,6 +267,7 @@ main = hspec $ do
       skipManyTill loggingNotification $ count 2 noDiagnostics
       hover <- getHover doc (Position 45 9) -- putStrLn
       liftIO $ hover `shouldSatisfy` isJust
+
   describe "getHighlights" $
     it "works" $ runSession "hie --lsp" "test/data/renamePass" $ do
       doc <- openDoc "Desktop/simple.hs" "haskell"
@@ -274,6 +275,20 @@ main = hspec $ do
       highlights <- getHighlights doc (Position 27 4) -- addItem
       liftIO $ length highlights `shouldBe` 4
 
+  describe "formatDoc" $
+    it "works" $ runSession "hie --lsp" "test/data" $ do
+      doc <- openDoc "Format.hs" "haskell"
+      oldContents <- documentContents doc
+      formatDoc doc (FormattingOptions 4 True)
+      documentContents doc >>= liftIO . (`shouldNotBe` oldContents)
+
+  describe "formatRange" $
+    it "works" $ runSession "hie --lsp" "test/data" $ do
+      doc <- openDoc "Format.hs" "haskell"
+      oldContents <- documentContents doc
+      formatRange doc (FormattingOptions 4 True) (Range (Position 1 10) (Position 2 10))
+      documentContents doc >>= liftIO . (`shouldNotBe` oldContents)
+
 mkRange sl sc el ec = Range (Position sl sc) (Position el ec)
 
 didChangeCaps :: ClientCapabilities
diff --git a/test/data/Format.hs b/test/data/Format.hs
new file mode 100644
index 0000000..46eba52
--- /dev/null
+++ b/test/data/Format.hs
@@ -0,0 +1,4 @@
+module Format where
+foo 3  = 2
+foo  x = x
+bar _   = 2
-- 
2.30.2


From 776b8e1a475e2150797d432f0c13ccf685b1cd4b Mon Sep 17 00:00:00 2001
From: Luke Lau <luke_lau@icloud.com>
Date: Mon, 23 Jul 2018 22:52:55 +0100
Subject: [PATCH 09/16] Add closeDoc

---
 src/Language/Haskell/LSP/Test.hs | 12 ++++++++++++
 test/Test.hs                     | 10 ++++++++++
 2 files changed, 22 insertions(+)

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index b648078..60f13b1 100644
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -46,6 +46,7 @@ module Language.Haskell.LSP.Test
   , initializeResponse
   -- ** Documents
   , openDoc
+  , closeDoc
   , documentContents
   , getDocumentEdit
   , getDocUri
@@ -308,6 +309,17 @@ openDoc file languageId = do
     contents <- liftIO $ T.readFile fp
     return $ TextDocumentItem (filePathToUri fp) (T.pack languageId) 0 contents
 
+-- | Closes a text document and sends a notification to the client.
+closeDoc :: TextDocumentIdentifier -> Session ()
+closeDoc docId = do
+  let params = DidCloseTextDocumentParams (TextDocumentIdentifier (docId ^. uri))
+  sendNotification TextDocumentDidClose params
+
+  oldVfs <- vfs <$> get
+  let notif = NotificationMessage "" TextDocumentDidClose params
+  newVfs <- liftIO $ closeVFS oldVfs notif
+  modify $ \s -> s { vfs = newVfs }
+
 -- | Gets the Uri for the file corrected to the session directory.
 getDocUri :: FilePath -> Session Uri
 getDocUri file = do
diff --git a/test/Test.hs b/test/Test.hs
index 56bd01d..a4a4173 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -289,6 +289,16 @@ main = hspec $ do
       formatRange doc (FormattingOptions 4 True) (Range (Position 1 10) (Position 2 10))
       documentContents doc >>= liftIO . (`shouldNotBe` oldContents)
 
+  describe "closeDoc" $
+    it "works" $
+      let sesh =
+            runSession "hie --lsp" "test/data" $ do
+              doc <- openDoc "Format.hs" "haskell"
+              closeDoc doc
+              -- need to evaluate to throw
+              documentContents doc >>= liftIO . print
+      in sesh `shouldThrow` anyException
+
 mkRange sl sc el ec = Range (Position sl sc) (Position el ec)
 
 didChangeCaps :: ClientCapabilities
-- 
2.30.2


From e0926c045ccd5444f3112cb231cc3590c600d48d Mon Sep 17 00:00:00 2001
From: Luke Lau <luke_lau@icloud.com>
Date: Thu, 26 Jul 2018 21:58:47 +0100
Subject: [PATCH 10/16] Make ClientCapabilities a mandatory parameter

Closes #13
---
 .gitignore                                    |  2 +
 example/Main.hs                               |  2 +-
 haskell-lsp-test.cabal                        |  3 +-
 src/Language/Haskell/LSP/Test.hs              | 15 +++--
 src/Language/Haskell/LSP/Test/Capabilities.hs | 51 +++++++++++++++
 src/Language/Haskell/LSP/Test/Replay.hs       |  1 +
 src/Language/Haskell/LSP/Test/Session.hs      | 16 +++--
 test/Test.hs                                  | 65 +++++++++----------
 test/data/renamePass/session.log              |  2 +-
 9 files changed, 109 insertions(+), 48 deletions(-)
 create mode 100644 src/Language/Haskell/LSP/Test/Capabilities.hs

diff --git a/.gitignore b/.gitignore
index 93b38a2..f78eac2 100644
--- a/.gitignore
+++ b/.gitignore
@@ -6,3 +6,5 @@ cabal.project.local*
 **/.DS_Store
 *.swp
 
+# used for rerunning failed hspec tests
+.hspec-failures
diff --git a/example/Main.hs b/example/Main.hs
index c992b8e..a6bafe9 100644
--- a/example/Main.hs
+++ b/example/Main.hs
@@ -3,7 +3,7 @@ import Control.Monad.IO.Class
 import Language.Haskell.LSP.Test
 import Language.Haskell.LSP.Types
 
-main = runSession "hie --lsp" "test/recordings/renamePass" $ do
+main = runSession "hie --lsp" fullCaps "test/recordings/renamePass" $ do
   docItem <- openDoc "Desktop/simple.hs" "haskell"
   
   -- Use your favourite favourite combinators.
diff --git a/haskell-lsp-test.cabal b/haskell-lsp-test.cabal
index 860c29b..d3e9b20 100644
--- a/haskell-lsp-test.cabal
+++ b/haskell-lsp-test.cabal
@@ -46,7 +46,8 @@ library
     build-depends:     Win32
   else
     build-depends:     unix
-  other-modules:       Language.Haskell.LSP.Test.Compat
+  other-modules:       Language.Haskell.LSP.Test.Capabilities
+                       Language.Haskell.LSP.Test.Compat
                        Language.Haskell.LSP.Test.Decoding
                        Language.Haskell.LSP.Test.Exceptions
                        Language.Haskell.LSP.Test.Files
diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index 60f13b1..aeae56b 100644
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -24,6 +24,8 @@ module Language.Haskell.LSP.Test
   , SessionException(..)
   , anySessionException
   , withTimeout
+  -- * Capabilities
+  , fullCaps
   -- * Sending
   , sendRequest
   , sendRequest_
@@ -99,6 +101,7 @@ import qualified Language.Haskell.LSP.Types as LSP
 import qualified Language.Haskell.LSP.Types.Capabilities as LSP
 import Language.Haskell.LSP.Messages
 import Language.Haskell.LSP.VFS
+import Language.Haskell.LSP.Test.Capabilities
 import Language.Haskell.LSP.Test.Compat
 import Language.Haskell.LSP.Test.Decoding
 import Language.Haskell.LSP.Test.Exceptions
@@ -112,18 +115,20 @@ import qualified Yi.Rope as Rope
 
 -- | Starts a new session.
 runSession :: String -- ^ The command to run the server.
+           -> LSP.ClientCapabilities -- ^ The capabilities that the client should declare.
            -> FilePath -- ^ The filepath to the root directory for the session.
            -> Session a -- ^ The session to run.
            -> IO a
 runSession = runSessionWithConfig def
 
 -- | Starts a new sesion with a client with the specified capabilities.
-runSessionWithConfig :: SessionConfig -- ^ The capabilities the client should have.
+runSessionWithConfig :: SessionConfig -- ^ Configuration options for the session.
                      -> String -- ^ The command to run the server.
+                     -> LSP.ClientCapabilities -- ^ The capabilities that the client should declare.
                      -> FilePath -- ^ The filepath to the root directory for the session.
                      -> Session a -- ^ The session to run.
                      -> IO a
-runSessionWithConfig config serverExe rootDir session = do
+runSessionWithConfig config serverExe caps rootDir session = do
   pid <- getCurrentProcessID
   absRootDir <- canonicalizePath rootDir
 
@@ -131,10 +136,10 @@ runSessionWithConfig config serverExe rootDir session = do
                                           (Just $ T.pack absRootDir)
                                           (Just $ filePathToUri absRootDir)
                                           Nothing
-                                          (capabilities config)
+                                          caps
                                           (Just TraceOff)
   withServer serverExe (logStdErr config) $ \serverIn serverOut _ ->
-    runSessionWithHandles serverIn serverOut listenServer config rootDir $ do
+    runSessionWithHandles serverIn serverOut listenServer config caps rootDir $ do
 
       -- Wrap the session around initialize and shutdown calls
       initRspMsg <- sendRequest Initialize initializeParams :: Session InitializeResponse
@@ -420,7 +425,7 @@ applyEdit doc edit = do
 
   verDoc <- getVersionedDoc doc
 
-  caps <- asks (capabilities . config)
+  caps <- asks sessionCapabilities
 
   let supportsDocChanges = fromMaybe False $ do
         let LSP.ClientCapabilities mWorkspace _ _ = caps
diff --git a/src/Language/Haskell/LSP/Test/Capabilities.hs b/src/Language/Haskell/LSP/Test/Capabilities.hs
new file mode 100644
index 0000000..f1237e3
--- /dev/null
+++ b/src/Language/Haskell/LSP/Test/Capabilities.hs
@@ -0,0 +1,51 @@
+module Language.Haskell.LSP.Test.Capabilities where
+import Language.Haskell.LSP.Types
+import Language.Haskell.LSP.Types.Capabilities
+
+-- | Capabilities for full conformance to the LSP specification.
+-- The whole shebang.
+fullCaps :: ClientCapabilities
+fullCaps = ClientCapabilities (Just w) (Just td) Nothing
+  where
+    w = WorkspaceClientCapabilities
+          (Just True)
+          (Just (WorkspaceEditClientCapabilities (Just True)))
+          (Just (DidChangeConfigurationClientCapabilities (Just True)))
+          (Just (DidChangeWatchedFilesClientCapabilities (Just True)))
+          (Just (SymbolClientCapabilities (Just True)))
+          (Just (ExecuteClientCapabilities (Just True)))
+    td = TextDocumentClientCapabilities
+          (Just sync)
+          (Just (CompletionClientCapabilities 
+                  (Just True)
+                  (Just (CompletionItemClientCapabilities (Just True)))))
+          (Just (HoverClientCapabilities (Just True)))
+          (Just (SignatureHelpClientCapabilities (Just True)))
+          (Just (ReferencesClientCapabilities (Just True)))
+          (Just (DocumentHighlightClientCapabilities (Just True)))
+          (Just (DocumentSymbolClientCapabilities (Just True)))
+          (Just (FormattingClientCapabilities (Just True)))
+          (Just (RangeFormattingClientCapabilities (Just True)))
+          (Just (OnTypeFormattingClientCapabilities (Just True)))
+          (Just (DefinitionClientCapabilities (Just True)))
+          (Just codeAction)
+          (Just (CodeLensClientCapabilities (Just True)))
+          (Just (DocumentLinkClientCapabilities (Just True)))
+          (Just (RenameClientCapabilities (Just True)))
+    sync = SynchronizationTextDocumentClientCapabilities
+            (Just True)
+            (Just True)
+            (Just True)
+            (Just True)
+    codeAction = CodeActionClientCapabilities
+                  (Just True)
+                  (Just (CodeActionLiteralSupport kinds))
+    kinds = CodeActionKindValueSet
+              (List [ CodeActionQuickFix
+                    , CodeActionRefactor
+                    , CodeActionRefactorExtract
+                    , CodeActionRefactorInline
+                    , CodeActionRefactorRewrite
+                    , CodeActionSource
+                    , CodeActionSourceOrganizeImports
+                    ])
diff --git a/src/Language/Haskell/LSP/Test/Replay.hs b/src/Language/Haskell/LSP/Test/Replay.hs
index 979b789..23e6137 100644
--- a/src/Language/Haskell/LSP/Test/Replay.hs
+++ b/src/Language/Haskell/LSP/Test/Replay.hs
@@ -61,6 +61,7 @@ replaySession serverExe sessionDir = do
                             serverOut
                             (listenServer serverMsgs requestMap reqSema rspSema passSema mainThread)
                             def
+                            fullCaps
                             sessionDir
                             (sendMessages clientMsgs reqSema rspSema)
     takeMVar passSema
diff --git a/src/Language/Haskell/LSP/Test/Session.hs b/src/Language/Haskell/LSP/Test/Session.hs
index 218defb..c923478 100644
--- a/src/Language/Haskell/LSP/Test/Session.hs
+++ b/src/Language/Haskell/LSP/Test/Session.hs
@@ -72,13 +72,13 @@ type Session = ParserStateReader FromServerMessage SessionState SessionContext I
 -- | Stuff you can configure for a 'Session'.
 data SessionConfig = SessionConfig
   {
-    capabilities :: ClientCapabilities -- ^ Specific capabilities the client should advertise. Default is yes to everything.
-  , messageTimeout :: Int -- ^ Maximum time to wait for a message in seconds. Defaults to 60.
-  , logStdErr :: Bool -- ^ When True redirects the servers stderr output to haskell-lsp-test's stdout. Defaults to False
+    messageTimeout :: Int -- ^ Maximum time to wait for a message in seconds. Defaults to 60.
+  , logStdErr :: Bool -- ^ When True redirects the servers stderr output to haskell-lsp-test's stdout. Defaults to False.
+  , logMessages :: Bool -- ^ When True traces the communication between client and server to stdout. Defaults to True.
   }
 
 instance Default SessionConfig where
-  def = SessionConfig def 60 False
+  def = SessionConfig 60 False True
 
 data SessionMessage = ServerMessage FromServerMessage
                     | TimeoutMessage Int
@@ -92,6 +92,7 @@ data SessionContext = SessionContext
   , requestMap :: MVar RequestMap
   , initRsp :: MVar InitializeResponse
   , config :: SessionConfig
+  , sessionCapabilities :: ClientCapabilities
   }
 
 class Monad m => HasReader r m where
@@ -170,10 +171,11 @@ runSessionWithHandles :: Handle -- ^ Server in
                       -> Handle -- ^ Server out
                       -> (Handle -> SessionContext -> IO ()) -- ^ Server listener
                       -> SessionConfig
-                      -> FilePath
+                      -> ClientCapabilities
+                      -> FilePath -- ^ Root directory
                       -> Session a
                       -> IO a
-runSessionWithHandles serverIn serverOut serverHandler config rootDir session = do
+runSessionWithHandles serverIn serverOut serverHandler config caps rootDir session = do
   absRootDir <- canonicalizePath rootDir
 
   hSetBuffering serverIn  NoBuffering
@@ -183,7 +185,7 @@ runSessionWithHandles serverIn serverOut serverHandler config rootDir session =
   messageChan <- newChan
   initRsp <- newEmptyMVar
 
-  let context = SessionContext serverIn absRootDir messageChan reqMap initRsp config
+  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
diff --git a/test/Test.hs b/test/Test.hs
index a4a4173..08c21be 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -29,22 +29,21 @@ main = hspec $ do
   describe "Session" $ do
     it "fails a test" $
       -- TODO: Catch the exception in haskell-lsp-test and provide nicer output
-      let session = runSession "hie --lsp" "test/data/renamePass" $ do
+      let session = runSession "hie --lsp" fullCaps "test/data/renamePass" $ do
                       openDoc "Desktop/simple.hs" "haskell"
                       skipMany loggingNotification
                       anyRequest
         in session `shouldThrow` anyException
-    it "initializeResponse" $ runSession "hie --lsp" "test/data/renamePass" $ do
+    it "initializeResponse" $ runSession "hie --lsp" fullCaps "test/data/renamePass" $ do
       rsp <- initializeResponse
       liftIO $ rsp ^. result `shouldNotBe` Nothing
 
     it "runSessionWithConfig" $
-      runSessionWithConfig (def { capabilities = didChangeCaps })
-        "hie --lsp" "test/data/renamePass" $ return ()
+      runSession "hie --lsp" didChangeCaps "test/data/renamePass" $ return ()
 
     describe "withTimeout" $ do
       it "times out" $
-        let sesh = runSession "hie --lsp" "test/data/renamePass" $ do
+        let sesh = runSession "hie --lsp" fullCaps "test/data/renamePass" $ do
                     openDoc "Desktop/simple.hs" "haskell"
                     -- won't receive a request - will timeout
                     -- incoming logging requests shouldn't increase the
@@ -55,12 +54,12 @@ main = hspec $ do
           in timeout 6000000 sesh `shouldThrow` anySessionException
           
       it "doesn't time out" $
-        let sesh = runSession "hie --lsp" "test/data/renamePass" $ do
+        let sesh = runSession "hie --lsp" fullCaps "test/data/renamePass" $ do
                     openDoc "Desktop/simple.hs" "haskell"
                     withTimeout 5 $ skipManyTill anyMessage publishDiagnosticsNotification
           in void $ timeout 6000000 sesh
 
-      it "further timeout messages are ignored" $ runSession "hie --lsp" "test/data/renamePass" $ do
+      it "further timeout messages are ignored" $ runSession "hie --lsp" fullCaps "test/data/renamePass" $ do
         doc <- openDoc "Desktop/simple.hs" "haskell"
         withTimeout 3 $ getDocumentSymbols doc
         liftIO $ threadDelay 5000000
@@ -70,7 +69,7 @@ main = hspec $ do
 
       it "overrides global message timeout" $
         let sesh =
-              runSessionWithConfig (def { messageTimeout = 5 }) "hie --lsp" "test/data/renamePass" $ do
+              runSessionWithConfig (def { messageTimeout = 5 }) "hie --lsp" fullCaps "test/data/renamePass" $ do
                 doc <- openDoc "Desktop/simple.hs" "haskell"
                 -- shouldn't time out in here since we are overriding it
                 withTimeout 10 $ liftIO $ threadDelay 7000000
@@ -80,7 +79,7 @@ main = hspec $ do
 
       it "unoverrides global message timeout" $
         let sesh =
-              runSessionWithConfig (def { messageTimeout = 5 }) "hie --lsp" "test/data/renamePass" $ do
+              runSessionWithConfig (def { messageTimeout = 5 }) "hie --lsp" fullCaps "test/data/renamePass" $ do
                 doc <- openDoc "Desktop/simple.hs" "haskell"
                 -- shouldn't time out in here since we are overriding it
                 withTimeout 10 $ liftIO $ threadDelay 7000000
@@ -92,13 +91,13 @@ main = hspec $ do
 
     describe "SessionException" $ do
       it "throw on time out" $
-        let sesh = runSessionWithConfig (def {messageTimeout = 10}) "hie --lsp" "test/data/renamePass" $ do
+        let sesh = runSessionWithConfig (def {messageTimeout = 10}) "hie --lsp" fullCaps "test/data/renamePass" $ do
                 skipMany loggingNotification
                 _ <- message :: Session ApplyWorkspaceEditRequest
                 return ()
         in sesh `shouldThrow` anySessionException
 
-      it "don't throw when no time out" $ runSessionWithConfig (def {messageTimeout = 5}) "hie --lsp" "test/data/renamePass" $ do
+      it "don't throw when no time out" $ runSessionWithConfig (def {messageTimeout = 5}) "hie --lsp" fullCaps "test/data/renamePass" $ do
         loggingNotification
         liftIO $ threadDelay 10
         _ <- openDoc "Desktop/simple.hs" "haskell"
@@ -108,7 +107,7 @@ main = hspec $ do
         it "throws when there's an unexpected message" $
           let selector (UnexpectedMessage "Publish diagnostics notification" (NotLogMessage _)) = True
               selector _ = False
-            in runSession "hie --lsp" "test/data/renamePass" publishDiagnosticsNotification `shouldThrow` selector
+            in runSession "hie --lsp" fullCaps "test/data/renamePass" publishDiagnosticsNotification `shouldThrow` selector
         it "provides the correct types that were expected and received" $
           let selector (UnexpectedMessage "ResponseMessage WorkspaceEdit" (RspDocumentSymbols _)) = True
               selector _ = False
@@ -117,7 +116,7 @@ main = hspec $ do
                 sendRequest' TextDocumentDocumentSymbol (DocumentSymbolParams doc)
                 skipMany anyNotification
                 message :: Session RenameResponse -- the wrong type
-            in runSession "hie --lsp" "test/data/renamePass" sesh
+            in runSession "hie --lsp" fullCaps "test/data/renamePass" sesh
               `shouldThrow` selector
 
   describe "replaySession" $ do
@@ -130,7 +129,7 @@ main = hspec $ do
 
   describe "manual javascript session" $
     it "passes a test" $
-      runSession "javascript-typescript-stdio" "test/data/javascriptPass" $ do
+      runSession "javascript-typescript-stdio" fullCaps "test/data/javascriptPass" $ do
         doc <- openDoc "test.js" "javascript"
 
         noDiagnostics
@@ -143,7 +142,7 @@ main = hspec $ do
 
   describe "text document VFS" $
     it "sends back didChange notifications" $
-      runSession "hie --lsp" "test/data/refactor" $ do
+      runSession "hie --lsp" def "test/data/refactor" $ do
         doc <- openDoc "Main.hs" "haskell"
 
         let args = toJSON $ AOP (doc ^. uri)
@@ -166,7 +165,7 @@ main = hspec $ do
 
   describe "getDocumentEdit" $
     it "automatically consumes applyedit requests" $
-      runSession "hie --lsp" "test/data/refactor" $ do
+      runSession "hie --lsp" fullCaps "test/data/refactor" $ do
         doc <- openDoc "Main.hs" "haskell"
 
         let args = toJSON $ AOP (doc ^. uri)
@@ -179,17 +178,17 @@ main = hspec $ do
         noDiagnostics
 
   describe "getAllCodeActions" $
-    it "works" $ runSession "hie --lsp" "test/data/refactor" $ do
+    it "works" $ runSession "hie --lsp" fullCaps "test/data/refactor" $ do
       doc <- openDoc "Main.hs" "haskell"
       _ <- waitForDiagnostics
       actions <- getAllCodeActions doc
       liftIO $ do
-        let [CommandOrCodeActionCommand action] = actions
+        let [CommandOrCodeActionCodeAction action] = actions
         action ^. title `shouldBe` "Apply hint:Redundant bracket"
-        action ^. command `shouldSatisfy` T.isSuffixOf ":applyrefact:applyOne"
+        action ^. command . _Just . command `shouldSatisfy` T.isSuffixOf ":applyrefact:applyOne"
 
   describe "getDocumentSymbols" $
-    it "works" $ runSession "hie --lsp" "test/data/renamePass" $ do
+    it "works" $ runSession "hie --lsp" fullCaps "test/data/renamePass" $ do
       doc <- openDoc "Desktop/simple.hs" "haskell"
 
       skipMany loggingNotification
@@ -205,13 +204,13 @@ main = hspec $ do
         mainSymbol ^. containerName `shouldBe` Nothing
 
   describe "applyEdit" $ do
-    it "increments the version" $ runSessionWithConfig (def { capabilities = docChangesCaps }) "hie --lsp" "test/data/renamePass" $ do
+    it "increments the version" $ runSession "hie --lsp" docChangesCaps "test/data/renamePass" $ do
       doc <- openDoc "Desktop/simple.hs" "haskell"
       VersionedTextDocumentIdentifier _ (Just oldVersion) <- getVersionedDoc doc
       let edit = TextEdit (Range (Position 1 1) (Position 1 3)) "foo" 
       VersionedTextDocumentIdentifier _ (Just newVersion) <- applyEdit doc edit
       liftIO $ newVersion `shouldBe` oldVersion + 1
-    it "changes the document contents" $ runSession "hie --lsp" "test/data/renamePass" $ do
+    it "changes the document contents" $ runSession "hie --lsp" fullCaps "test/data/renamePass" $ do
       doc <- openDoc "Desktop/simple.hs" "haskell"
       let edit = TextEdit (Range (Position 0 0) (Position 0 2)) "foo" 
       applyEdit doc edit
@@ -219,16 +218,16 @@ main = hspec $ do
       liftIO $ contents `shouldSatisfy` T.isPrefixOf "foodule"
 
   describe "getCompletions" $
-    it "works" $ runSession "hie --lsp" "test/data/renamePass" $ do
+    it "works" $ runSession "hie --lsp" def "test/data/renamePass" $ do
       doc <- openDoc "Desktop/simple.hs" "haskell"
-      [item] <- getCompletions doc (Position 5 5)
+      item:_ <- getCompletions doc (Position 5 5)
       liftIO $ do
         item ^. label `shouldBe` "interactWithUser"
         item ^. kind `shouldBe` Just CiFunction
         item ^. detail `shouldBe` Just "Items -> IO ()\nMain"
 
   describe "getReferences" $
-    it "works" $ runSession "hie --lsp" "test/data/renamePass" $ do
+    it "works" $ runSession "hie --lsp" fullCaps "test/data/renamePass" $ do
       doc <- openDoc "Desktop/simple.hs" "haskell"
       let pos = Position 40 3 -- interactWithUser
           uri = doc ^. LSP.uri
@@ -240,14 +239,14 @@ main = hspec $ do
         ]
 
   describe "getDefinitions" $
-    it "works" $ runSession "hie --lsp" "test/data/renamePass" $ do
+    it "works" $ runSession "hie --lsp" fullCaps "test/data/renamePass" $ do
       doc <- openDoc "Desktop/simple.hs" "haskell"
       let pos = Position 49 25 -- addItem
       defs <- getDefinitions doc pos
       liftIO $ defs `shouldBe` [Location (doc ^. uri) (mkRange 28 0 28 7)]
 
   describe "waitForDiagnosticsSource" $
-    it "works" $ runSession "hie --lsp" "test/data" $ do
+    it "works" $ runSession "hie --lsp" fullCaps "test/data" $ do
       openDoc "Error.hs" "haskell"
       [diag] <- waitForDiagnosticsSource "ghcmod"
       liftIO $ do
@@ -255,13 +254,13 @@ main = hspec $ do
         diag ^. source `shouldBe` Just "ghcmod"
 
   describe "rename" $
-    it "works" $ runSession "hie --lsp" "test/data" $ do
+    it "works" $ runSession "hie --lsp" fullCaps "test/data" $ do
       doc <- openDoc "Rename.hs" "haskell"
       rename doc (Position 1 0) "bar"
       documentContents doc >>= liftIO . shouldBe "main = bar\nbar = return 42\n"
 
   describe "getHover" $
-    it "works" $ runSession "hie --lsp" "test/data/renamePass" $ do
+    it "works" $ runSession "hie --lsp" fullCaps "test/data/renamePass" $ do
       doc <- openDoc "Desktop/simple.hs" "haskell"
       -- hover returns nothing until module is loaded
       skipManyTill loggingNotification $ count 2 noDiagnostics
@@ -269,21 +268,21 @@ main = hspec $ do
       liftIO $ hover `shouldSatisfy` isJust
 
   describe "getHighlights" $
-    it "works" $ runSession "hie --lsp" "test/data/renamePass" $ do
+    it "works" $ runSession "hie --lsp" fullCaps "test/data/renamePass" $ do
       doc <- openDoc "Desktop/simple.hs" "haskell"
       skipManyTill loggingNotification $ count 2 noDiagnostics
       highlights <- getHighlights doc (Position 27 4) -- addItem
       liftIO $ length highlights `shouldBe` 4
 
   describe "formatDoc" $
-    it "works" $ runSession "hie --lsp" "test/data" $ do
+    it "works" $ runSession "hie --lsp" fullCaps "test/data" $ do
       doc <- openDoc "Format.hs" "haskell"
       oldContents <- documentContents doc
       formatDoc doc (FormattingOptions 4 True)
       documentContents doc >>= liftIO . (`shouldNotBe` oldContents)
 
   describe "formatRange" $
-    it "works" $ runSession "hie --lsp" "test/data" $ do
+    it "works" $ runSession "hie --lsp" fullCaps "test/data" $ do
       doc <- openDoc "Format.hs" "haskell"
       oldContents <- documentContents doc
       formatRange doc (FormattingOptions 4 True) (Range (Position 1 10) (Position 2 10))
@@ -292,7 +291,7 @@ main = hspec $ do
   describe "closeDoc" $
     it "works" $
       let sesh =
-            runSession "hie --lsp" "test/data" $ do
+            runSession "hie --lsp" fullCaps "test/data" $ do
               doc <- openDoc "Format.hs" "haskell"
               closeDoc doc
               -- need to evaluate to throw
diff --git a/test/data/renamePass/session.log b/test/data/renamePass/session.log
index 4cf5766..1648ff7 100644
--- a/test/data/renamePass/session.log
+++ b/test/data/renamePass/session.log
@@ -1,5 +1,5 @@
 {"tag":"FromClient","contents":["2018-06-03T04:08:38.856591Z",{"tag":"ReqInitialize","contents":{"jsonrpc":"2.0","params":{"rootUri":"file:///Users/luke","processId":7558,"rootPath":"/Users/luke","capabilities":{"textDocument":{"completion":{"completionItem":{"snippetSupport":false}}}},"trace":"off"},"method":"initialize","id":9}}]}
-{"tag":"FromServer","contents":["2018-06-03T04:08:38.873087Z",{"tag":"RspInitialize","contents":{"result":{"capabilities":{"textDocumentSync":{"openClose":true,"change":2,"willSave":false,"willSaveWaitUntil":false,"save":{"includeText":false}},"documentRangeFormattingProvider":true,"documentHighlightProvider":true,"executeCommandProvider":{"commands":["1234:applyrefact:applyOne","1234:hare:demote","16026:hie:applyWorkspaceEdit","16026:hsimport:import","16026:package:add"]},"renameProvider":true,"definitionProvider":true,"hoverProvider":true,"codeActionProvider":true,"completionProvider":{"triggerCharacters":["."],"resolveProvider":true},"documentSymbolProvider":true,"documentFormattingProvider":true,"referencesProvider":true}},"jsonrpc":"2.0","id":9}}]}
+{"tag":"FromServer","contents":["2018-06-03T04:08:38.873087Z",{"tag":"RspInitialize","contents":{"result":{"capabilities":{"textDocumentSync":{"openClose":true,"change":2,"willSave":false,"willSaveWaitUntil":false,"save":{"includeText":false}},"documentRangeFormattingProvider":true,"documentHighlightProvider":true,"executeCommandProvider":{"commands":["7796:applyrefact:applyOne","7796:applyrefact:applyAll","7796:applyrefact:lint","7796:base:version","7796:base:plugins","7796:base:commands","7796:base:commandDetail","7796:brittany:format","7796:build:prepare","7796:build:isConfigured","7796:build:configure","7796:build:listTargets","7796:build:listFlags","7796:build:buildDirectory","7796:build:buildTarget","7796:eg2:sayHello","7796:eg2:sayHelloTo ","7796:ghcmod:check","7796:ghcmod:lint","7796:ghcmod:info","7796:ghcmod:type","7796:ghcmod:casesplit","7796:hare:demote","7796:hare:dupdef","7796:hare:iftocase","7796:hare:liftonelevel","7796:hare:lifttotoplevel","7796:hare:rename","7796:hare:deletedef","7796:hare:genapplicative","7796:hoogle:info","7796:hoogle:lookup","7796:hsimport:import","7796:package:add"]},"renameProvider":true,"definitionProvider":true,"hoverProvider":true,"codeActionProvider":true,"completionProvider":{"triggerCharacters":["."],"resolveProvider":true},"documentSymbolProvider":true,"documentFormattingProvider":true,"referencesProvider":true}},"jsonrpc":"2.0","id":9}}]}
 {"tag":"FromClient","contents":["2018-06-03T04:08:39.325465Z",{"tag":"NotInitialized","contents":{"jsonrpc":"2.0","params":{},"method":"initialized"}}]}
 {"tag":"FromClient","contents":["2018-06-03T04:08:39.325807Z",{"tag":"NotDidChangeConfiguration","contents":{"jsonrpc":"2.0","params":{"settings":{}},"method":"workspace/didChangeConfiguration"}}]}
 {"tag":"FromClient","contents":["2018-06-03T04:08:39.326177Z",{"tag":"NotDidOpenTextDocument","contents":{"jsonrpc":"2.0","params":{"textDocument":{"languageId":"haskell","text":"module Main where\n\nmain :: IO ()\nmain = do\n  let initialList = []\n  interactWithUser initialList\n\ntype Item = String\ntype Items = [Item]\n\ndata Command = Quit\n             | DisplayItems\n             | AddItem String\n             | RemoveItem Int\n             | Help\n\ntype Error = String\n\nparseCommand :: String -> Either Error Command\nparseCommand line = case words line of\n  [\"quit\"] -> Right Quit\n  [\"items\"] -> Right DisplayItems\n  \"add\" : item -> Right $ AddItem $ unwords item\n  \"remove\" : i -> Right $ RemoveItem $ read $ unwords i\n  [\"help\"] -> Right Help\n  _ -> Left \"Unknown command\"\n\naddItem :: Item -> Items -> Items\naddItem = (:)\n\ndisplayItems :: Items -> String\ndisplayItems = unlines . map (\"- \" ++)\n\nremoveItem :: Int -> Items -> Either Error Items\nremoveItem i items\n  | i < 0 || i >= length items = Left \"Out of range\"\n  | otherwise = Right result\n  where (front, back) = splitAt (i + 1) items\n        result = init front ++ back\n\ninteractWithUser :: Items -> IO ()\ninteractWithUser items = do\n  line <- getLine\n  case parseCommand line of\n    Right DisplayItems -> do\n      putStrLn $ displayItems items\n      interactWithUser items\n\n    Right (AddItem item) -> do\n      let newItems = addItem item items\n      putStrLn \"Added\"\n      interactWithUser newItems\n\n    Right (RemoveItem i) ->\n      case removeItem i items of\n        Right newItems -> do\n          putStrLn $ \"Removed \" ++ items !! i\n          interactWithUser newItems\n        Left err -> do\n          putStrLn err\n          interactWithUser items\n\n\n    Right Quit -> return ()\n\n    Right Help -> do\n      putStrLn \"Commands:\"\n      putStrLn \"help\"\n      putStrLn \"items\"\n      putStrLn \"add\"\n      putStrLn \"quit\"\n      interactWithUser items\n\n    Left err -> do\n      putStrLn $ \"Error: \" ++ err\n      interactWithUser items\n","uri":"file:///Users/luke/Desktop/simple.hs","version":0}},"method":"textDocument/didOpen"}}]}
-- 
2.30.2


From 7ee14165e9d2ebcc171716d41e3e207444c418b3 Mon Sep 17 00:00:00 2001
From: Luke Lau <luke_lau@icloud.com>
Date: Thu, 26 Jul 2018 22:13:42 +0100
Subject: [PATCH 11/16] Pretty print message trace

Make colours a bit less eye-bleeding
Also implement logMessages config
---
 haskell-lsp-test.cabal                   |  1 +
 src/Language/Haskell/LSP/Test/Parsing.hs | 11 ++++++++---
 src/Language/Haskell/LSP/Test/Session.hs |  9 ++++++---
 3 files changed, 15 insertions(+), 6 deletions(-)

diff --git a/haskell-lsp-test.cabal b/haskell-lsp-test.cabal
index d3e9b20..d3ef940 100644
--- a/haskell-lsp-test.cabal
+++ b/haskell-lsp-test.cabal
@@ -26,6 +26,7 @@ library
   build-depends:       base >= 4.7 && < 5
                      , haskell-lsp >= 0.4
                      , aeson
+                     , aeson-pretty
                      , ansi-terminal
                      , bytestring
                      , conduit
diff --git a/src/Language/Haskell/LSP/Test/Parsing.hs b/src/Language/Haskell/LSP/Test/Parsing.hs
index 36349da..2936b31 100644
--- a/src/Language/Haskell/LSP/Test/Parsing.hs
+++ b/src/Language/Haskell/LSP/Test/Parsing.hs
@@ -10,6 +10,7 @@ import Control.Lens
 import Control.Monad.IO.Class
 import Control.Monad
 import Data.Aeson
+import Data.Aeson.Encode.Pretty
 import qualified Data.ByteString.Lazy.Char8 as B
 import Data.Conduit.Parser
 import Data.Maybe
@@ -42,9 +43,10 @@ satisfy pred = do
 
   if pred x
     then do
-      liftIO $ do
-        setSGR [SetColor Foreground Vivid Magenta]
-        putStrLn $ "<-- " ++ B.unpack (encodeMsg x)
+      shouldLog <- asks $ logMessages . config
+      liftIO $ when shouldLog $ do
+        setSGR [SetColor Foreground Dull Magenta]
+        putStrLn $ "<-- " ++ B.unpack (encodeMsgPretty x)
         setSGR [Reset]
       return x
     else empty
@@ -86,6 +88,9 @@ castMsg = fromMaybe (error "Failed casting a message") . decode . encodeMsg
 encodeMsg :: FromServerMessage -> B.ByteString
 encodeMsg = encode . genericToJSON (defaultOptions { sumEncoding = UntaggedValue })
 
+encodeMsgPretty :: FromServerMessage -> B.ByteString
+encodeMsgPretty = encodePretty . genericToJSON (defaultOptions { sumEncoding = UntaggedValue })
+
 -- | Matches if the message is a log message notification or a show message notification/request.
 loggingNotification :: Session FromServerMessage
 loggingNotification = named "Logging notification" $ satisfy shouldSkip
diff --git a/src/Language/Haskell/LSP/Test/Session.hs b/src/Language/Haskell/LSP/Test/Session.hs
index c923478..a58496d 100644
--- a/src/Language/Haskell/LSP/Test/Session.hs
+++ b/src/Language/Haskell/LSP/Test/Session.hs
@@ -35,6 +35,7 @@ import Control.Monad.Trans.State (StateT, runStateT)
 import qualified Control.Monad.Trans.State as State (get, put)
 import qualified Data.ByteString.Lazy.Char8 as B
 import Data.Aeson
+import Data.Aeson.Encode.Pretty
 import Data.Conduit as Conduit
 import Data.Conduit.Parser as Parser
 import Data.Default
@@ -276,10 +277,12 @@ updateState _ = return ()
 sendMessage :: (MonadIO m, HasReader SessionContext m, ToJSON a) => a -> m ()
 sendMessage msg = do
   h <- serverIn <$> ask
-  let encoded = encode msg
-  liftIO $ do
+  let encoded = encodePretty msg
 
-    setSGR [SetColor Foreground Vivid Cyan]
+  shouldLog <- asks $ logMessages . config
+  liftIO $ when shouldLog $ do
+  
+    setSGR [SetColor Foreground Dull Cyan]
     putStrLn $ "--> " ++ B.unpack encoded
     setSGR [Reset]
 
-- 
2.30.2


From 8c1b9ade4ee800cb7f6410c1e7d0f43f30138c9f Mon Sep 17 00:00:00 2001
From: Luke Lau <luke_lau@icloud.com>
Date: Thu, 26 Jul 2018 22:27:40 +0100
Subject: [PATCH 12/16] Update hie on travis

---
 .travis.yml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/.travis.yml b/.travis.yml
index 8c7812c..88efe99 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -20,9 +20,9 @@ before_install:
   - npm update
 
 install:
-  - git clone https://github.com/Bubba/haskell-ide-engine.git --recursive
+  - git clone https://github.com/haskell/haskell-ide-engine.git --recursive
   - cd haskell-ide-engine
-  - git checkout import-code-actions
+  - git submodule sync
   - git submodule update
   - stack --no-terminal --skip-ghc-check install -j2
   - stack exec hoogle generate
-- 
2.30.2


From 8a112a4c1522d031ad64af7b1e6310023f90997a Mon Sep 17 00:00:00 2001
From: Luke Lau <luke_lau@icloud.com>
Date: Fri, 27 Jul 2018 21:35:09 +0100
Subject: [PATCH 13/16] Try out cabal on travis

---
 .travis.yml | 22 +++++++++++++---------
 1 file changed, 13 insertions(+), 9 deletions(-)

diff --git a/.travis.yml b/.travis.yml
index 88efe99..4a4730e 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -1,11 +1,15 @@
-language: javascript
+language: haskell
+
+ghc:
+  - "8.2.2"
+  - "8.4.2"
 
 sudo: false
 
 # Caching so the next build will be fast too.
-cache:
-  directories:
-  - $HOME/.stack
+# cache:
+#   directories:
+#   - $HOME/.stack
 
 addons:
   apt:
@@ -14,9 +18,9 @@ addons:
 
 before_install:
   # Download and unpack the stack executable
-  - mkdir -p ~/.local/bin
-  - export PATH=$HOME/.local/bin:$PATH
-  - travis_retry curl -L https://get.haskellstack.org/stable/linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
+  # - mkdir -p ~/.local/bin
+  # - export PATH=$HOME/.local/bin:$PATH
+  # - travis_retry curl -L https://get.haskellstack.org/stable/linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
   - npm update
 
 install:
@@ -29,5 +33,5 @@ install:
   - cd ..
   - npm i -g javascript-typescript-langserver
 
-script:
-  - stack --no-terminal --skip-ghc-check test
+# script:
+#   - stack --no-terminal --skip-ghc-check test
-- 
2.30.2


From 7ec9adc898c5b84762fee84f2f8d02891213b974 Mon Sep 17 00:00:00 2001
From: Luke Lau <luke_lau@icloud.com>
Date: Fri, 27 Jul 2018 21:39:18 +0100
Subject: [PATCH 14/16] Keep stack for installing hie

---
 .travis.yml | 16 ++++++++++------
 1 file changed, 10 insertions(+), 6 deletions(-)

diff --git a/.travis.yml b/.travis.yml
index 4a4730e..2786a93 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -7,9 +7,9 @@ ghc:
 sudo: false
 
 # Caching so the next build will be fast too.
-# cache:
-#   directories:
-#   - $HOME/.stack
+cache:
+  directories:
+  - $HOME/.stack
 
 addons:
   apt:
@@ -18,9 +18,9 @@ addons:
 
 before_install:
   # Download and unpack the stack executable
-  # - mkdir -p ~/.local/bin
-  # - export PATH=$HOME/.local/bin:$PATH
-  # - travis_retry curl -L https://get.haskellstack.org/stable/linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
+  - mkdir -p ~/.local/bin
+  - export PATH=$HOME/.local/bin:$PATH
+  - travis_retry curl -L https://get.haskellstack.org/stable/linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
   - npm update
 
 install:
@@ -28,6 +28,10 @@ install:
   - cd haskell-ide-engine
   - git submodule sync
   - git submodule update
+  # - cabal new-update
+  # - cabal new-configure
+  # - cabal new-build
+  # - export PATH=dist-newstyle/build/*/ghc-*/haskell-ide-engine-*/x/hie/build:$PATH
   - stack --no-terminal --skip-ghc-check install -j2
   - stack exec hoogle generate
   - cd ..
-- 
2.30.2


From 3ad786f9a0727c85c9b0eb9094874704f1757cd1 Mon Sep 17 00:00:00 2001
From: Luke Lau <luke_lau@icloud.com>
Date: Sat, 28 Jul 2018 15:01:27 +0100
Subject: [PATCH 15/16] Move hie installation to before_install

---
 .travis.yml | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/.travis.yml b/.travis.yml
index 2786a93..b33a9ff 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -21,9 +21,7 @@ before_install:
   - mkdir -p ~/.local/bin
   - export PATH=$HOME/.local/bin:$PATH
   - travis_retry curl -L https://get.haskellstack.org/stable/linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
-  - npm update
     
-install:
   - git clone https://github.com/haskell/haskell-ide-engine.git --recursive
   - cd haskell-ide-engine
   - git submodule sync
@@ -35,6 +33,7 @@ install:
   - stack --no-terminal --skip-ghc-check install -j2
   - stack exec hoogle generate
   - cd ..
+  - npm update
   - npm i -g javascript-typescript-langserver
 
 # script:
-- 
2.30.2


From 949a1f9fd6a5fd53c2b27161855ba587c1be8e02 Mon Sep 17 00:00:00 2001
From: Luke Lau <luke_lau@icloud.com>
Date: Sat, 28 Jul 2018 15:22:17 +0100
Subject: [PATCH 16/16] Bump stack resolver

---
 stack.yaml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/stack.yaml b/stack.yaml
index 934b356..a81dc68 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -1,4 +1,4 @@
-resolver: lts-12.0
+resolver: lts-12.2
 packages:
   - .
 
-- 
2.30.2