Disable auto-formatting based on cli flag

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 ::

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."