From 17f9d40900037c477cc64933012fc6e9ddec3640 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 13 Feb 2024 09:34:01 -0800 Subject: [PATCH 1/3] Add lspFormat cli option --- unison-cli/unison/ArgParse.hs | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/unison-cli/unison/ArgParse.hs b/unison-cli/unison/ArgParse.hs index 971e289ec5..49a2a963b7 100644 --- a/unison-cli/unison/ArgParse.hs +++ b/unison-cli/unison/ArgParse.hs @@ -96,6 +96,9 @@ data ShouldExit = Exit | DoNotExit data IsHeadless = Headless | WithCLI deriving (Show, Eq) +data LspFormatting = LspFormatEnabled | LspFormatDisabled + deriving (Show, Eq) + -- | Represents commands the cli can run. -- -- Note that this is not one-to-one with command-parsers since some are simple variants. @@ -117,7 +120,8 @@ data Command -- | Options shared by sufficiently many subcommands. data GlobalOptions = GlobalOptions { codebasePathOption :: Maybe CodebasePathOption, - exitOption :: ShouldExit + exitOption :: ShouldExit, + lspFormatting :: LspFormatting } deriving (Show, Eq) @@ -259,12 +263,10 @@ globalOptionsParser = do -- ApplicativeDo codebasePathOption <- codebasePathParser <|> codebaseCreateParser exitOption <- exitParser + lspFormatting <- lspFormattingParser pure - GlobalOptions - { codebasePathOption = codebasePathOption, - exitOption = exitOption - } + GlobalOptions {codebasePathOption, exitOption, lspFormatting} codebasePathParser :: Parser (Maybe CodebasePathOption) codebasePathParser = do @@ -291,6 +293,11 @@ exitParser = flag DoNotExit Exit (long "exit" <> help exitHelp) where exitHelp = "Exit repl after the command." +lspFormattingParser :: Parser LspFormatting +lspFormattingParser = flag LspFormatDisabled LspFormatEnabled (long "lsp-format" <> help lspFormatHelp) + where + lspFormatHelp = "[Experimental] Enable formatting of source files via LSP." + versionOptionParser :: String -> String -> Parser (a -> a) versionOptionParser progName version = infoOption (progName <> " version: " <> version) (short 'v' <> long "version" <> help "Show version") From 3c9f71cb7368a2647f207caf0ce71fa345010d7d Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 13 Feb 2024 09:40:41 -0800 Subject: [PATCH 2/3] Disable auto-formatting based on cli flag --- unison-cli/src/Unison/LSP.hs | 34 ++++++++++++++++++++++------------ unison-cli/unison/ArgParse.hs | 8 +++----- 2 files changed, 25 insertions(+), 17 deletions(-) diff --git a/unison-cli/src/Unison/LSP.hs b/unison-cli/src/Unison/LSP.hs index 80b168a55e..5db6663a8c 100644 --- a/unison-cli/src/Unison/LSP.hs +++ b/unison-cli/src/Unison/LSP.hs @@ -3,7 +3,11 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeOperators #-} -module Unison.LSP where +module Unison.LSP + ( spawnLsp, + LspFormattingConfig (..), + ) +where import Colog.Core (LogAction (LogAction)) import Colog.Core qualified as Colog @@ -50,12 +54,15 @@ import Unison.Symbol import UnliftIO import UnliftIO.Foreign (Errno (..), eADDRINUSE) +data LspFormattingConfig = LspFormatEnabled | LspFormatDisabled + deriving (Show, Eq) + getLspPort :: IO String getLspPort = fromMaybe "5757" <$> lookupEnv "UNISON_LSP_PORT" -- | Spawn an LSP server on the configured port. -spawnLsp :: Codebase IO Symbol Ann -> Runtime Symbol -> STM CausalHash -> STM (Path.Absolute) -> IO () -spawnLsp codebase runtime latestRootHash latestPath = +spawnLsp :: Codebase IO Symbol Ann -> Runtime Symbol -> STM CausalHash -> STM (Path.Absolute) -> LspFormattingConfig -> IO () +spawnLsp codebase runtime latestRootHash latestPath lspFormattingConfig = ifEnabled . TCP.withSocketsDo $ do lspPort <- getLspPort UnliftIO.handleIO (handleFailure lspPort) $ do @@ -75,7 +82,7 @@ spawnLsp codebase runtime latestRootHash latestPath = -- different un-saved state for the same file. initVFS $ \vfs -> do vfsVar <- newMVar vfs - void $ runServerWith lspServerLogger lspClientLogger clientInput clientOutput (serverDefinition vfsVar codebase runtime scope latestRootHash latestPath) + void $ runServerWith lspServerLogger lspClientLogger clientInput clientOutput (serverDefinition lspFormattingConfig vfsVar codebase runtime scope latestRootHash latestPath) where handleFailure :: String -> IOException -> IO () handleFailure lspPort ioerr = @@ -101,6 +108,7 @@ spawnLsp codebase runtime latestRootHash latestPath = Nothing -> when (not onWindows) runServer serverDefinition :: + LspFormattingConfig -> MVar VFS -> Codebase IO Symbol Ann -> Runtime Symbol -> @@ -108,14 +116,14 @@ serverDefinition :: STM CausalHash -> STM (Path.Absolute) -> ServerDefinition Config -serverDefinition vfsVar codebase runtime scope latestRootHash latestPath = +serverDefinition lspFormattingConfig vfsVar codebase runtime scope latestRootHash latestPath = ServerDefinition { defaultConfig = defaultLSPConfig, configSection = "unison", parseConfig = Config.parseConfig, onConfigChange = Config.updateConfig, doInitialize = lspDoInitialize vfsVar codebase runtime scope latestRootHash latestPath, - staticHandlers = lspStaticHandlers, + staticHandlers = lspStaticHandlers lspFormattingConfig, interpretHandler = lspInterpretHandler, options = lspOptions } @@ -154,16 +162,16 @@ lspDoInitialize vfsVar codebase runtime scope latestRootHash latestPath lspConte pure $ Right $ env -- | LSP request handlers that don't register/unregister dynamically -lspStaticHandlers :: ClientCapabilities -> Handlers Lsp -lspStaticHandlers _capabilities = +lspStaticHandlers :: LspFormattingConfig -> ClientCapabilities -> Handlers Lsp +lspStaticHandlers lspFormattingConfig _capabilities = Handlers - { reqHandlers = lspRequestHandlers, + { reqHandlers = lspRequestHandlers lspFormattingConfig, notHandlers = lspNotificationHandlers } -- | LSP request handlers -lspRequestHandlers :: SMethodMap (ClientMessageHandler Lsp 'Msg.Request) -lspRequestHandlers = +lspRequestHandlers :: LspFormattingConfig -> SMethodMap (ClientMessageHandler Lsp 'Msg.Request) +lspRequestHandlers lspFormattingConfig = mempty & SMM.insert Msg.SMethod_TextDocumentHover (mkHandler hoverHandler) & SMM.insert Msg.SMethod_TextDocumentCodeAction (mkHandler codeActionHandler) @@ -173,7 +181,9 @@ lspRequestHandlers = & SMM.insert Msg.SMethod_TextDocumentCompletion (mkHandler completionHandler) & SMM.insert Msg.SMethod_CompletionItemResolve (mkHandler completionItemResolveHandler) & SMM.insert Msg.SMethod_TextDocumentFormatting (mkHandler formatDocRequest) - & SMM.insert Msg.SMethod_TextDocumentRangeFormatting (mkHandler formatRangeRequest) + & case lspFormattingConfig of + LspFormatEnabled -> SMM.insert Msg.SMethod_TextDocumentRangeFormatting (mkHandler formatRangeRequest) + LspFormatDisabled -> id where defaultTimeout = 10_000 -- 10s mkHandler :: diff --git a/unison-cli/unison/ArgParse.hs b/unison-cli/unison/ArgParse.hs index 49a2a963b7..548f2f77e0 100644 --- a/unison-cli/unison/ArgParse.hs +++ b/unison-cli/unison/ArgParse.hs @@ -59,6 +59,7 @@ import Text.Read (readMaybe) import Unison.Codebase.Path qualified as Path import Unison.Codebase.Path.Parse qualified as Path import Unison.CommandLine.Types (ShouldWatchFiles (..)) +import Unison.LSP (LspFormattingConfig (..)) import Unison.PrettyTerminal qualified as PT import Unison.Server.CodebaseServer (CodebaseServerOpts (..)) import Unison.Server.CodebaseServer qualified as Server @@ -96,9 +97,6 @@ data ShouldExit = Exit | DoNotExit data IsHeadless = Headless | WithCLI deriving (Show, Eq) -data LspFormatting = LspFormatEnabled | LspFormatDisabled - deriving (Show, Eq) - -- | Represents commands the cli can run. -- -- Note that this is not one-to-one with command-parsers since some are simple variants. @@ -121,7 +119,7 @@ data Command data GlobalOptions = GlobalOptions { codebasePathOption :: Maybe CodebasePathOption, exitOption :: ShouldExit, - lspFormatting :: LspFormatting + lspFormatting :: LspFormattingConfig } deriving (Show, Eq) @@ -293,7 +291,7 @@ exitParser = flag DoNotExit Exit (long "exit" <> help exitHelp) where exitHelp = "Exit repl after the command." -lspFormattingParser :: Parser LspFormatting +lspFormattingParser :: Parser LspFormattingConfig lspFormattingParser = flag LspFormatDisabled LspFormatEnabled (long "lsp-format" <> help lspFormatHelp) where lspFormatHelp = "[Experimental] Enable formatting of source files via LSP." From 712a9ad895e0726a8fc1dc0f74c16db16897446c Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 13 Feb 2024 09:44:11 -0800 Subject: [PATCH 3/3] Wire up auto-format flag --- unison-cli/src/Unison/LSP.hs | 16 ++++++++++------ unison-cli/unison/ArgParse.hs | 6 +++--- unison-cli/unison/Main.hs | 6 +++--- 3 files changed, 16 insertions(+), 12 deletions(-) diff --git a/unison-cli/src/Unison/LSP.hs b/unison-cli/src/Unison/LSP.hs index 5db6663a8c..867a08ed1e 100644 --- a/unison-cli/src/Unison/LSP.hs +++ b/unison-cli/src/Unison/LSP.hs @@ -61,8 +61,8 @@ getLspPort :: IO String getLspPort = fromMaybe "5757" <$> lookupEnv "UNISON_LSP_PORT" -- | Spawn an LSP server on the configured port. -spawnLsp :: Codebase IO Symbol Ann -> Runtime Symbol -> STM CausalHash -> STM (Path.Absolute) -> LspFormattingConfig -> IO () -spawnLsp codebase runtime latestRootHash latestPath lspFormattingConfig = +spawnLsp :: LspFormattingConfig -> Codebase IO Symbol Ann -> Runtime Symbol -> STM CausalHash -> STM (Path.Absolute) -> IO () +spawnLsp lspFormattingConfig codebase runtime latestRootHash latestPath = ifEnabled . TCP.withSocketsDo $ do lspPort <- getLspPort UnliftIO.handleIO (handleFailure lspPort) $ do @@ -180,11 +180,15 @@ lspRequestHandlers lspFormattingConfig = & SMM.insert Msg.SMethod_TextDocumentFoldingRange (mkHandler foldingRangeRequest) & SMM.insert Msg.SMethod_TextDocumentCompletion (mkHandler completionHandler) & SMM.insert Msg.SMethod_CompletionItemResolve (mkHandler completionItemResolveHandler) - & SMM.insert Msg.SMethod_TextDocumentFormatting (mkHandler formatDocRequest) - & case lspFormattingConfig of - LspFormatEnabled -> SMM.insert Msg.SMethod_TextDocumentRangeFormatting (mkHandler formatRangeRequest) - LspFormatDisabled -> id + & addFormattingHandlers where + addFormattingHandlers handlers = + case lspFormattingConfig of + LspFormatEnabled -> + handlers + & SMM.insert Msg.SMethod_TextDocumentFormatting (mkHandler formatDocRequest) + & SMM.insert Msg.SMethod_TextDocumentRangeFormatting (mkHandler formatRangeRequest) + LspFormatDisabled -> handlers defaultTimeout = 10_000 -- 10s mkHandler :: forall m. diff --git a/unison-cli/unison/ArgParse.hs b/unison-cli/unison/ArgParse.hs index 548f2f77e0..647d707d20 100644 --- a/unison-cli/unison/ArgParse.hs +++ b/unison-cli/unison/ArgParse.hs @@ -119,7 +119,7 @@ data Command data GlobalOptions = GlobalOptions { codebasePathOption :: Maybe CodebasePathOption, exitOption :: ShouldExit, - lspFormatting :: LspFormattingConfig + lspFormattingConfig :: LspFormattingConfig } deriving (Show, Eq) @@ -261,10 +261,10 @@ globalOptionsParser = do -- ApplicativeDo codebasePathOption <- codebasePathParser <|> codebaseCreateParser exitOption <- exitParser - lspFormatting <- lspFormattingParser + lspFormattingConfig <- lspFormattingParser pure - GlobalOptions {codebasePathOption, exitOption, lspFormatting} + GlobalOptions {codebasePathOption, exitOption, lspFormattingConfig} codebasePathParser :: Parser (Maybe CodebasePathOption) codebasePathParser = do diff --git a/unison-cli/unison/Main.hs b/unison-cli/unison/Main.hs index 42664ec3f8..087b9c4c4c 100644 --- a/unison-cli/unison/Main.hs +++ b/unison-cli/unison/Main.hs @@ -15,7 +15,7 @@ where import ArgParse ( CodebasePathOption (..), Command (Init, Launch, PrintVersion, Run, Transcript), - GlobalOptions (GlobalOptions, codebasePathOption, exitOption), + GlobalOptions (..), IsHeadless (Headless, WithCLI), RunSource (..), ShouldExit (DoNotExit, Exit), @@ -120,7 +120,7 @@ main = do progName <- getProgName -- hSetBuffering stdout NoBuffering -- cool (renderUsageInfo, globalOptions, command) <- parseCLIArgs progName (Text.unpack Version.gitDescribeWithDate) - let GlobalOptions {codebasePathOption = mCodePathOption, exitOption = exitOption} = globalOptions + let GlobalOptions {codebasePathOption = mCodePathOption, exitOption, lspFormattingConfig} = globalOptions withConfig mCodePathOption \config -> do currentDir <- getCurrentDirectory case command of @@ -293,7 +293,7 @@ main = do -- prevent UCM from shutting down properly. Hopefully we can re-enable LSP on -- Windows when we move to GHC 9.* -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/1224 - void . Ki.fork scope $ LSP.spawnLsp theCodebase runtime (readTVar rootCausalHashVar) (readTVar pathVar) + void . Ki.fork scope $ LSP.spawnLsp lspFormattingConfig theCodebase runtime (readTVar rootCausalHashVar) (readTVar pathVar) Server.startServer (Backend.BackendEnv {Backend.useNamesIndex = False}) codebaseServerOpts sbRuntime theCodebase $ \baseUrl -> do case exitOption of DoNotExit -> do