From 21f9e951cc3b7e99eb3f31f08e580540c323f507 Mon Sep 17 00:00:00 2001 From: PanAeon Date: Fri, 8 Mar 2019 14:24:54 +0000 Subject: [PATCH] [LSP] add basic formatting (#844) --- dhall-lsp-server/ChangeLog.md | 5 +- dhall-lsp-server/app/Main.hs | 2 +- dhall-lsp-server/dhall-lsp-server.cabal | 4 +- .../src/Backend/Dhall/Formatting.hs | 20 ++++++++ dhall-lsp-server/src/LSP/Dispatcher.hs | 46 +++++++++++++++---- .../src/LSP/Handlers/DocumentFormatting.hs | 35 ++++++++++++++ dhall-lsp-server/src/LSP/Server.hs | 1 + 7 files changed, 102 insertions(+), 11 deletions(-) create mode 100644 dhall-lsp-server/src/Backend/Dhall/Formatting.hs create mode 100644 dhall-lsp-server/src/LSP/Handlers/DocumentFormatting.hs diff --git a/dhall-lsp-server/ChangeLog.md b/dhall-lsp-server/ChangeLog.md index 336a343..32dea00 100644 --- a/dhall-lsp-server/ChangeLog.md +++ b/dhall-lsp-server/ChangeLog.md @@ -1,3 +1,6 @@ # Changelog for dhall-lsp-server -## Unreleased changes +## unreleased + - whole document formatting +## 0.0.1.0 + - diagnostic output diff --git a/dhall-lsp-server/app/Main.hs b/dhall-lsp-server/app/Main.hs index 5366dee..80a8c73 100644 --- a/dhall-lsp-server/app/Main.hs +++ b/dhall-lsp-server/app/Main.hs @@ -70,7 +70,7 @@ parserInfoOptions = runCommand :: Options -> IO () 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 -> run logFile (pure ()) >>= \case 0 -> exitSuccess diff --git a/dhall-lsp-server/dhall-lsp-server.cabal b/dhall-lsp-server/dhall-lsp-server.cabal index 5bc632a..50116f6 100644 --- a/dhall-lsp-server/dhall-lsp-server.cabal +++ b/dhall-lsp-server/dhall-lsp-server.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 name: dhall-lsp-server -version: 0.1.0.0 +version: 0.1.0.1 description: Please see the README on GitHub at homepage: https://github.com/dhall-lang/dhall-haskell/dhall-lsp-server#readme bug-reports: https://github.com/dhall-lang/dhall-haskell/issues @@ -22,9 +22,11 @@ library exposed-modules: Backend.Dhall.DhallErrors Backend.Dhall.Diagnostics + Backend.Dhall.Formatting LSP.Common LSP.Dispatcher LSP.Handlers.Diagnostics + LSP.Handlers.DocumentFormatting LSP.Server Prelude other-modules: diff --git a/dhall-lsp-server/src/Backend/Dhall/Formatting.hs b/dhall-lsp-server/src/Backend/Dhall/Formatting.hs new file mode 100644 index 0000000..d19e22c --- /dev/null +++ b/dhall-lsp-server/src/Backend/Dhall/Formatting.hs @@ -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 + diff --git a/dhall-lsp-server/src/LSP/Dispatcher.hs b/dhall-lsp-server/src/LSP/Dispatcher.hs index 710a7a6..a5bcfe4 100644 --- a/dhall-lsp-server/src/LSP/Dispatcher.hs +++ b/dhall-lsp-server/src/LSP/Dispatcher.hs @@ -13,6 +13,7 @@ import qualified Language.Haskell.LSP.Types.Lens as J import LSP.Common import LSP.Handlers.Diagnostics +import LSP.Handlers.DocumentFormatting import Control.Lens @@ -25,12 +26,12 @@ dispatcher lf inp = do inval <- liftIO $ atomically $ readTChan inp case inval of - (RspFromClient rm) -> + (RspFromClient rm) -> liftIO $ LSP.Utility.logs $ "reactor:got RspFromClient:" ++ show rm -- ------------------------------- - (NotInitialized _notification) -> do + (NotInitialized _notification) -> do liftIO $ LSP.Utility.logm "****** reactor: processing Initialized Notification" let @@ -51,7 +52,7 @@ dispatcher lf inp = do -- ------------------------------- - (NotDidOpenTextDocument notification) -> do + (NotDidOpenTextDocument notification) -> do liftIO $ LSP.Utility.logm "****** reactor: processing NotDidOpenTextDocument" let 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" let doc = notification ^. J.params @@ -78,7 +79,7 @@ dispatcher lf inp = do sendDiagnostics doc Nothing - (NotDidCloseTextDocument req) -> do + (NotDidCloseTextDocument req) -> do liftIO $ LSP.Utility.logm "****** reactor: processing NotDidCloseTextDocument" let doc = req ^. J.params @@ -87,7 +88,36 @@ dispatcher lf inp = do fileName = J.uriToFilePath doc liftIO $ LSP.Utility.logs $ "********* fileName=" ++ show fileName sendEmptyDiagnostics doc Nothing - om -> do - liftIO $ LSP.Utility.logs $ "\nIGNORING!!!\n HandlerRequest:" ++ show om --- --------------------------------------------------------------------- \ No newline at end of file + + (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) diff --git a/dhall-lsp-server/src/LSP/Handlers/DocumentFormatting.hs b/dhall-lsp-server/src/LSP/Handlers/DocumentFormatting.hs new file mode 100644 index 0000000..c07356e --- /dev/null +++ b/dhall-lsp-server/src/LSP/Handlers/DocumentFormatting.hs @@ -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 []) + diff --git a/dhall-lsp-server/src/LSP/Server.hs b/dhall-lsp-server/src/LSP/Server.hs index 7684aee..9c58575 100644 --- a/dhall-lsp-server/src/LSP/Server.hs +++ b/dhall-lsp-server/src/LSP/Server.hs @@ -91,6 +91,7 @@ lspHandlers rin , LSP.Core.responseHandler = Just $ responseHandlerCb rin -- , Core.codeActionHandler = Just $ passHandler rin ReqCodeAction , LSP.Core.executeCommandHandler = Just $ passHandler rin ReqExecuteCommand + , LSP.Core.documentFormattingHandler = Just $ passHandler rin ReqDocumentFormatting } -- ---------------------------------------------------------------------