[LSP] add basic formatting (#844)
This commit is contained in:
parent
1e3c2a1c84
commit
21f9e951cc
|
@ -1,3 +1,6 @@
|
||||||
# Changelog for dhall-lsp-server
|
# Changelog for dhall-lsp-server
|
||||||
|
|
||||||
## Unreleased changes
|
## unreleased
|
||||||
|
- whole document formatting
|
||||||
|
## 0.0.1.0
|
||||||
|
- diagnostic output
|
||||||
|
|
|
@ -70,7 +70,7 @@ parserInfoOptions =
|
||||||
|
|
||||||
runCommand :: Options -> IO ()
|
runCommand :: Options -> IO ()
|
||||||
runCommand Options{..} = case command of
|
runCommand Options{..} = case command of
|
||||||
CmdVersion -> putStrLn "0.0.1.0" -- TODO: read from build
|
CmdVersion -> putStrLn "0.0.1.1" -- TODO: read from build
|
||||||
Default ->
|
Default ->
|
||||||
run logFile (pure ()) >>= \case
|
run logFile (pure ()) >>= \case
|
||||||
0 -> exitSuccess
|
0 -> exitSuccess
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
cabal-version: 1.12
|
cabal-version: 1.12
|
||||||
name: dhall-lsp-server
|
name: dhall-lsp-server
|
||||||
version: 0.1.0.0
|
version: 0.1.0.1
|
||||||
description: Please see the README on GitHub at <https://github.com/githubuser/dhall-lsp-server#readme>
|
description: Please see the README on GitHub at <https://github.com/githubuser/dhall-lsp-server#readme>
|
||||||
homepage: https://github.com/dhall-lang/dhall-haskell/dhall-lsp-server#readme
|
homepage: https://github.com/dhall-lang/dhall-haskell/dhall-lsp-server#readme
|
||||||
bug-reports: https://github.com/dhall-lang/dhall-haskell/issues
|
bug-reports: https://github.com/dhall-lang/dhall-haskell/issues
|
||||||
|
@ -22,9 +22,11 @@ library
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
Backend.Dhall.DhallErrors
|
Backend.Dhall.DhallErrors
|
||||||
Backend.Dhall.Diagnostics
|
Backend.Dhall.Diagnostics
|
||||||
|
Backend.Dhall.Formatting
|
||||||
LSP.Common
|
LSP.Common
|
||||||
LSP.Dispatcher
|
LSP.Dispatcher
|
||||||
LSP.Handlers.Diagnostics
|
LSP.Handlers.Diagnostics
|
||||||
|
LSP.Handlers.DocumentFormatting
|
||||||
LSP.Server
|
LSP.Server
|
||||||
Prelude
|
Prelude
|
||||||
other-modules:
|
other-modules:
|
||||||
|
|
20
dhall-lsp-server/src/Backend/Dhall/Formatting.hs
Normal file
20
dhall-lsp-server/src/Backend/Dhall/Formatting.hs
Normal file
|
@ -0,0 +1,20 @@
|
||||||
|
module Backend.Dhall.Formatting(formatDocument) where
|
||||||
|
|
||||||
|
import Dhall.Pretty (CharacterSet(..), layoutOpts)
|
||||||
|
import Dhall.Parser(exprAndHeaderFromText, ParseError(..))
|
||||||
|
|
||||||
|
import qualified Data.Text
|
||||||
|
import qualified Data.Text.Prettyprint.Doc as Pretty
|
||||||
|
import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty.Text
|
||||||
|
import qualified Dhall.Pretty
|
||||||
|
|
||||||
|
formatDocument :: Text -> Either ParseError Text
|
||||||
|
formatDocument text = do
|
||||||
|
(header, expr) <- exprAndHeaderFromText "" text
|
||||||
|
let doc = Pretty.pretty header
|
||||||
|
<> Pretty.unAnnotate (Dhall.Pretty.prettyCharacterSet Unicode expr)
|
||||||
|
<> "\n"
|
||||||
|
formattedText =
|
||||||
|
Pretty.Text.renderStrict (Pretty.layoutSmart layoutOpts doc)
|
||||||
|
pure formattedText
|
||||||
|
|
|
@ -13,6 +13,7 @@ import qualified Language.Haskell.LSP.Types.Lens as J
|
||||||
|
|
||||||
import LSP.Common
|
import LSP.Common
|
||||||
import LSP.Handlers.Diagnostics
|
import LSP.Handlers.Diagnostics
|
||||||
|
import LSP.Handlers.DocumentFormatting
|
||||||
|
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
|
|
||||||
|
@ -25,12 +26,12 @@ dispatcher lf inp = do
|
||||||
inval <- liftIO $ atomically $ readTChan inp
|
inval <- liftIO $ atomically $ readTChan inp
|
||||||
case inval of
|
case inval of
|
||||||
|
|
||||||
(RspFromClient rm) ->
|
(RspFromClient rm) ->
|
||||||
liftIO $ LSP.Utility.logs $ "reactor:got RspFromClient:" ++ show rm
|
liftIO $ LSP.Utility.logs $ "reactor:got RspFromClient:" ++ show rm
|
||||||
|
|
||||||
-- -------------------------------
|
-- -------------------------------
|
||||||
|
|
||||||
(NotInitialized _notification) -> do
|
(NotInitialized _notification) -> do
|
||||||
liftIO $ LSP.Utility.logm "****** reactor: processing Initialized Notification"
|
liftIO $ LSP.Utility.logm "****** reactor: processing Initialized Notification"
|
||||||
|
|
||||||
let
|
let
|
||||||
|
@ -51,7 +52,7 @@ dispatcher lf inp = do
|
||||||
|
|
||||||
-- -------------------------------
|
-- -------------------------------
|
||||||
|
|
||||||
(NotDidOpenTextDocument notification) -> do
|
(NotDidOpenTextDocument notification) -> do
|
||||||
liftIO $ LSP.Utility.logm "****** reactor: processing NotDidOpenTextDocument"
|
liftIO $ LSP.Utility.logm "****** reactor: processing NotDidOpenTextDocument"
|
||||||
let
|
let
|
||||||
doc = notification ^. J.params
|
doc = notification ^. J.params
|
||||||
|
@ -66,7 +67,7 @@ dispatcher lf inp = do
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(NotDidSaveTextDocument notification) -> do
|
(NotDidSaveTextDocument notification) -> do
|
||||||
liftIO $ LSP.Utility.logm "****** reactor: processing NotDidSaveTextDocument"
|
liftIO $ LSP.Utility.logm "****** reactor: processing NotDidSaveTextDocument"
|
||||||
let
|
let
|
||||||
doc = notification ^. J.params
|
doc = notification ^. J.params
|
||||||
|
@ -78,7 +79,7 @@ dispatcher lf inp = do
|
||||||
sendDiagnostics doc Nothing
|
sendDiagnostics doc Nothing
|
||||||
|
|
||||||
|
|
||||||
(NotDidCloseTextDocument req) -> do
|
(NotDidCloseTextDocument req) -> do
|
||||||
liftIO $ LSP.Utility.logm "****** reactor: processing NotDidCloseTextDocument"
|
liftIO $ LSP.Utility.logm "****** reactor: processing NotDidCloseTextDocument"
|
||||||
let
|
let
|
||||||
doc = req ^. J.params
|
doc = req ^. J.params
|
||||||
|
@ -87,7 +88,36 @@ dispatcher lf inp = do
|
||||||
fileName = J.uriToFilePath doc
|
fileName = J.uriToFilePath doc
|
||||||
liftIO $ LSP.Utility.logs $ "********* fileName=" ++ show fileName
|
liftIO $ LSP.Utility.logs $ "********* fileName=" ++ show fileName
|
||||||
sendEmptyDiagnostics doc Nothing
|
sendEmptyDiagnostics doc Nothing
|
||||||
om -> do
|
|
||||||
liftIO $ LSP.Utility.logs $ "\nIGNORING!!!\n HandlerRequest:" ++ show om
|
|
||||||
|
|
||||||
-- ---------------------------------------------------------------------
|
|
||||||
|
(ReqDocumentFormatting req) -> do
|
||||||
|
liftIO $ LSP.Utility.logm "****** reactor: processing ReqDocumentFormatting"
|
||||||
|
let
|
||||||
|
uri = req ^. J.params
|
||||||
|
. J.textDocument
|
||||||
|
. J.uri
|
||||||
|
range = req ^. J.params
|
||||||
|
. J.options
|
||||||
|
tabSize = range ^. J.tabSize
|
||||||
|
insertSpaces = range ^. J.insertSpaces
|
||||||
|
|
||||||
|
formattedDocument <- formatDocument uri tabSize insertSpaces
|
||||||
|
publish req RspDocumentFormatting formattedDocument
|
||||||
|
|
||||||
|
unknown ->
|
||||||
|
liftIO $ LSP.Utility.logs $ "\nIGNORING!!!\n HandlerRequest:" ++ show unknown
|
||||||
|
|
||||||
|
|
||||||
|
-- ---------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
|
publish :: J.RequestMessage J.ClientMethod req resp
|
||||||
|
-> (J.ResponseMessage resp -> FromServerMessage)
|
||||||
|
-> resp
|
||||||
|
-> ReaderT (LSP.Core.LspFuncs ()) IO ()
|
||||||
|
publish req unwrap response =
|
||||||
|
do
|
||||||
|
lf <- ask
|
||||||
|
let
|
||||||
|
rspMessage = LSP.Core.makeResponseMessage req response
|
||||||
|
liftIO $ LSP.Core.sendFunc lf (unwrap rspMessage)
|
||||||
|
|
35
dhall-lsp-server/src/LSP/Handlers/DocumentFormatting.hs
Normal file
35
dhall-lsp-server/src/LSP/Handlers/DocumentFormatting.hs
Normal file
|
@ -0,0 +1,35 @@
|
||||||
|
module LSP.Handlers.DocumentFormatting(formatDocument) where
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
import qualified Backend.Dhall.Formatting as Formatting
|
||||||
|
|
||||||
|
import qualified Language.Haskell.LSP.Core as LSP.Core
|
||||||
|
|
||||||
|
import qualified Data.Aeson as J
|
||||||
|
import qualified Language.Haskell.LSP.Types as J
|
||||||
|
import qualified Language.Haskell.LSP.Types.Lens as J
|
||||||
|
import qualified Language.Haskell.LSP.Utility as LSP.Utility
|
||||||
|
import Language.Haskell.LSP.Messages
|
||||||
|
|
||||||
|
import qualified Data.Text
|
||||||
|
import qualified Data.Text.IO
|
||||||
|
import qualified Data.SortedList
|
||||||
|
|
||||||
|
-- TODO: implement tabSize and spaces/tabs options
|
||||||
|
-- * Note: any formatting errors would be swallowed. I think this is fine in this case, but generally we'd like to send user a notification
|
||||||
|
-- (e.g. the error occurred in the formatter itself, and user requests format constantly and nothing happens)
|
||||||
|
formatDocument :: J.Uri -> Int -> Bool -> ReaderT (LSP.Core.LspFuncs ()) IO (J.List J.TextEdit)
|
||||||
|
formatDocument fileUri tabSize insertSpaces = do
|
||||||
|
let
|
||||||
|
filePath = maybe (error "can't convert uri to file path") id $ J.uriToFilePath fileUri -- !FIXME: handle non-file uris
|
||||||
|
txt <- lift $ Data.Text.IO.readFile filePath
|
||||||
|
case Formatting.formatDocument txt of
|
||||||
|
(Right formatted) -> let
|
||||||
|
numLines = Data.Text.length txt
|
||||||
|
range = J.Range (J.Position 0 0) (J.Position numLines 0)
|
||||||
|
in pure $ J.List [J.TextEdit range formatted]
|
||||||
|
(Left err) -> do
|
||||||
|
lift $ LSP.Utility.logs $ "Error while formatting the document " <> show err
|
||||||
|
pure (J.List [])
|
||||||
|
|
|
@ -91,6 +91,7 @@ lspHandlers rin
|
||||||
, LSP.Core.responseHandler = Just $ responseHandlerCb rin
|
, LSP.Core.responseHandler = Just $ responseHandlerCb rin
|
||||||
-- , Core.codeActionHandler = Just $ passHandler rin ReqCodeAction
|
-- , Core.codeActionHandler = Just $ passHandler rin ReqCodeAction
|
||||||
, LSP.Core.executeCommandHandler = Just $ passHandler rin ReqExecuteCommand
|
, LSP.Core.executeCommandHandler = Just $ passHandler rin ReqExecuteCommand
|
||||||
|
, LSP.Core.documentFormattingHandler = Just $ passHandler rin ReqDocumentFormatting
|
||||||
}
|
}
|
||||||
|
|
||||||
-- ---------------------------------------------------------------------
|
-- ---------------------------------------------------------------------
|
||||||
|
|
Loading…
Reference in New Issue
Block a user