Add formatDoc and formatRange

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index e47109e03da0f1e83c84466423ad2fd2cd2262aa..b648078b8c1fe14ece70330755867b25a6bb63c8 100644 (file)
--- 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 1dee298a933b0f93ff203f152dcbff7c4fafe8cb..218defb7cb28fea135b25c1803131e856d2c8046 100644 (file)
--- 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 a17be20f7f151f725e85c32b3031bb301692b81a..56bd01dd0a1a5ec4d2ae65418706acf19620f0e0 100644 (file)
--- 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 (file)
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