Merge pull request #4691 from unisonweb/lsp/auto-fmt-flag

Disable lsp-formatting by default, opt in via --lsp-format flag
unisonweb · Feb 13, 2024 · 9d1c75a · 9d1c75a
2 parents 36fdcd8 + 712a9ad
commit 9d1c75a
Show file tree

Hide file tree

Showing 3 changed files with 40 additions and 21 deletions.
diff --git 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,21 +108,22 @@ spawnLsp codebase runtime latestRootHash latestPath =
         Nothing -> when (not onWindows) runServer
 
 serverDefinition ::
+  LspFormattingConfig ->
   MVar VFS ->
   Codebase IO Symbol Ann ->
   Runtime Symbol ->
   Ki.Scope ->
   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
@@ -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
@@ -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