From: Luke Lau <luke_lau@icloud.com>
Date: Tue, 17 Jul 2018 13:30:02 +0000 (+0100)
Subject: Add formatDoc and formatRange
X-Git-Url: http://git.lukelau.me/?p=opengl.git;a=commitdiff_plain;h=35ce787a5458ffdce71923e40464448d6ea71801

Add formatDoc and formatRange
---

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