diff --git a/unison-cli/src/Unison/LSP.hs b/unison-cli/src/Unison/LSP.hs index 80b168a55e..867a08ed1e 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 :: 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 @@ -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) @@ -172,9 +180,15 @@ lspRequestHandlers = & 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) - & SMM.insert Msg.SMethod_TextDocumentRangeFormatting (mkHandler formatRangeRequest) + & 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 971e289ec5..647d707d20 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 @@ -117,7 +118,8 @@ data Command -- | Options shared by sufficiently many subcommands. data GlobalOptions = GlobalOptions { codebasePathOption :: Maybe CodebasePathOption, - exitOption :: ShouldExit + exitOption :: ShouldExit, + lspFormattingConfig :: LspFormattingConfig } deriving (Show, Eq) @@ -259,12 +261,10 @@ globalOptionsParser = do -- ApplicativeDo codebasePathOption <- codebasePathParser <|> codebaseCreateParser exitOption <- exitParser + lspFormattingConfig <- lspFormattingParser pure - GlobalOptions - { codebasePathOption = codebasePathOption, - exitOption = exitOption - } + GlobalOptions {codebasePathOption, exitOption, lspFormattingConfig} codebasePathParser :: Parser (Maybe CodebasePathOption) codebasePathParser = do @@ -291,6 +291,11 @@ exitParser = flag DoNotExit Exit (long "exit" <> help exitHelp) where exitHelp = "Exit repl after the command." +lspFormattingParser :: Parser LspFormattingConfig +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") 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