git.iko.soy/ghcide
on master help sign in
Only report progress when client supports it (#2517)

* Only report progress when client supports it This fixes an issue that some people encountered when running hie-core in Emacs with a version of haskell-lsp that does not understand progress events. * Fix tests * More test fixes

commit0f0e6740c1d5f5dc3367267b52d97e088fb6c11f authorMoritz Kiefer <moritz.kiefer@purelyfunctional.org> dateTue 13 Aug 2019, 20:00 (7 years ago) parent10c59a0
6 files changed+25−9
compare with master
unifiedsplit
exe/Main.hs+3−2 src/Development/IDE/Core/Service.hs+1 src/Development/IDE/Core/Shake.hs+4−3 src/Development/IDE/LSP/LanguageServer.hs+3−2 src/Development/IDE/Types/Options.hs+12−1 test/exe/Main.hs+2−1
exe/Main.hs+3−2
@@ -64,10 +64,11 @@ main = do
6464 if argLSP then do
6565 t <- offsetTime
6666 hPutStrLn stderr "Starting LSP server..."
67− runLanguageServer def def $ \event vfs -> do
67+ runLanguageServer def def $ \event vfs caps -> do
6868 t <- t
6969 hPutStrLn stderr $ "Started LSP server in " ++ showDuration t
70− let options = defaultIdeOptions $ liftIO $ newSession' =<< findCradle (dir <> "/")
70+ let options = (defaultIdeOptions $ liftIO $ newSession' =<< findCradle (dir <> "/"))
71+ { optReportProgress = clientSupportsProgress caps }
7172 initialise (mainRule >> action kick) event logger options vfs
7273 else do
7374 putStrLn "[1/6] Finding hie-bios cradle"
src/Development/IDE/Core/Service.hs+1
@@ -51,6 +51,7 @@ initialise mainRule toDiags logger options vfs =
5151 toDiags
5252 logger
5353 (optShakeProfiling options)
54+ (optReportProgress options)
5455 (shakeOptions { shakeThreads = optThreads options
5556 , shakeFiles = "/dev/null"
5657 }) $ do
src/Development/IDE/Core/Shake.hs+4−3
@@ -62,6 +62,7 @@ import Language.Haskell.LSP.Diagnostics
6262import qualified Data.SortedList as SL
6363import Development.IDE.Types.Diagnostics
6464import Development.IDE.Types.Location
65+import Development.IDE.Types.Options
6566import Control.Concurrent.Extra
6667import Control.Exception
6768import Control.DeepSeq
@@ -211,7 +212,6 @@ type IdeRule k v =
211212 , NFData v
212213 )
213214
214−
215215-- | A Shake database plus persistent store. Can be thought of as storing
216216-- mappings from @(FilePath, k)@ to @RuleResult k@.
217217data IdeState = IdeState
@@ -278,10 +278,11 @@ seqValue v b = case v of
278278shakeOpen :: (LSP.FromServerMessage -> IO ()) -- ^ diagnostic handler
279279 -> Logger
280280 -> Maybe FilePath
281+ -> IdeReportProgress
281282 -> ShakeOptions
282283 -> Rules ()
283284 -> IO IdeState
284−shakeOpen eventer logger shakeProfileDir opts rules = do
285+shakeOpen eventer logger shakeProfileDir (IdeReportProgress reportProgress) opts rules = do
285286 shakeExtras <- do
286287 globals <- newVar HMap.empty
287288 state <- newVar HMap.empty
@@ -294,7 +295,7 @@ shakeOpen eventer logger shakeProfileDir opts rules = do
294295 shakeOpenDatabase
295296 opts
296297 { shakeExtra = addShakeExtra shakeExtras $ shakeExtra opts
297− , shakeProgress = lspShakeProgress eventer
298+ , shakeProgress = if reportProgress then lspShakeProgress eventer else const (pure ())
298299 }
299300 rules
300301 shakeAbort <- newVar $ return ()
src/Development/IDE/LSP/LanguageServer.hs+3−2
@@ -10,6 +10,7 @@ module Development.IDE.LSP.LanguageServer
1010 ) where
1111
1212import Language.Haskell.LSP.Types
13+import Language.Haskell.LSP.Types.Capabilities
1314import Development.IDE.LSP.Server
1415import qualified Language.Haskell.LSP.Control as LSP
1516import qualified Language.Haskell.LSP.Core as LSP
@@ -40,7 +41,7 @@ import Language.Haskell.LSP.Messages
4041runLanguageServer
4142 :: LSP.Options
4243 -> PartialHandlers
43− -> ((FromServerMessage -> IO ()) -> VFSHandle -> IO IdeState)
44+ -> ((FromServerMessage -> IO ()) -> VFSHandle -> ClientCapabilities -> IO IdeState)
4445 -> IO ()
4546runLanguageServer options userHandlers getIdeState = do
4647 -- Move stdout to another file descriptor and duplicate stderr
@@ -119,7 +120,7 @@ runLanguageServer options userHandlers getIdeState = do
119120 where
120121 handleInit :: IO () -> (LspId -> IO ()) -> (LspId -> IO ()) -> Chan Message -> LSP.LspFuncs () -> IO (Maybe err)
121122 handleInit exitClientMsg clearReqId waitForCancel clientMsgChan lspFuncs@LSP.LspFuncs{..} = do
122− ide <- getIdeState sendFunc (makeLSPVFSHandle lspFuncs)
123+ ide <- getIdeState sendFunc (makeLSPVFSHandle lspFuncs) clientCapabilities
123124 _ <- flip forkFinally (const exitClientMsg) $ forever $ do
124125 msg <- readChan clientMsgChan
125126 case msg of
src/Development/IDE/Types/Options.hs+12−1
@@ -6,14 +6,17 @@
66-- | Options
77module Development.IDE.Types.Options
88 ( IdeOptions(..)
9+ , IdeReportProgress(..)
10+ , clientSupportsProgress
911 , IdePkgLocationOptions(..)
1012 , defaultIdeOptions
1113 ) where
1214
15+import Data.Maybe
1316import Development.Shake
1417import GHC hiding (parseModule, typecheckModule)
1518import GhcPlugins as GHC hiding (fst3, (<>))
16−
19+import qualified Language.Haskell.LSP.Types.Capabilities as LSP
1720
1821data IdeOptions = IdeOptions
1922 { optPreprocessor :: GHC.ParsedSource -> ([(GHC.SrcSpan, String)], GHC.ParsedSource)
@@ -25,10 +28,17 @@ data IdeOptions = IdeOptions
2528
2629 , optThreads :: Int
2730 , optShakeProfiling :: Maybe FilePath
31+ , optReportProgress :: IdeReportProgress
2832 , optLanguageSyntax :: String -- ^ the ```language to use
2933 , optNewColonConvention :: Bool -- ^ whether to use new colon convention
3034 }
3135
36+newtype IdeReportProgress = IdeReportProgress Bool
37+
38+clientSupportsProgress :: LSP.ClientCapabilities -> IdeReportProgress
39+clientSupportsProgress caps = IdeReportProgress $ fromMaybe False $
40+ LSP._progress =<< LSP._window (caps :: LSP.ClientCapabilities)
41+
3242defaultIdeOptions :: Action HscEnv -> IdeOptions
3343defaultIdeOptions session = IdeOptions
3444 {optPreprocessor = (,) []
@@ -37,6 +47,7 @@ defaultIdeOptions session = IdeOptions
3747 ,optPkgLocationOpts = defaultIdePkgLocationOptions
3848 ,optThreads = 0
3949 ,optShakeProfiling = Nothing
50+ ,optReportProgress = IdeReportProgress False
4051 ,optLanguageSyntax = "haskell"
4152 ,optNewColonConvention = False
4253 }
test/exe/Main.hs+2−1
@@ -11,6 +11,7 @@ import Development.IDE.Test
1111import Development.IDE.Test.Runfiles
1212import Language.Haskell.LSP.Test
1313import Language.Haskell.LSP.Types
14+import Language.Haskell.LSP.Types.Capabilities
1415import System.Environment.Blank (setEnv)
1516import System.IO.Extra
1617import Test.Tasty
@@ -64,7 +65,7 @@ run s = withTempDir $ \dir -> do
6465 -- HIE calls getXgdDirectory which assumes that HOME is set.
6566 -- Only sets HOME if it wasn't already set.
6667 setEnv "HOME" "/homeless-shelter" False
67− runSessionWithConfig conf cmd fullCaps dir s
68+ runSessionWithConfig conf cmd fullCaps { _window = Just $ WindowClientCapabilities $ Just True } dir s
6869 where
6970 conf = defaultConfig
7071 -- If you uncomment this you can see all messages