From da71cd782f99e4879d3b7c10f24e1f1b20bdab39 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Fri, 12 Feb 2021 16:23:07 +0530 Subject: [PATCH] rebase fixes --- ghcide/ghcide.cabal | 1 - ghcide/src/Development/IDE/Core/Shake.hs | 11 +++-- ghcide/src/Development/IDE/LSP/Protocol.hs | 23 --------- ghcide/src/Development/IDE/Main.hs | 56 ++++++---------------- plugins/hls-eval-plugin/test/Eval.hs | 1 - src/Ide/Main.hs | 5 +- 6 files changed, 23 insertions(+), 74 deletions(-) delete mode 100644 ghcide/src/Development/IDE/LSP/Protocol.hs diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index c5c5e299589..67fa49fa6f3 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -166,7 +166,6 @@ library Development.IDE.LSP.HoverDefinition Development.IDE.LSP.LanguageServer Development.IDE.LSP.Outline - Development.IDE.LSP.Protocol Development.IDE.LSP.Server Development.IDE.Spans.Common Development.IDE.Spans.Documentation diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 31d357bc6ac..a3985e3600d 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -1036,7 +1036,7 @@ updateFileDiagnostics :: MonadIO m -> ShakeExtras -> [(ShowDiagnostic,Diagnostic)] -- ^ current results -> m () -updateFileDiagnostics fp k ShakeExtras{diagnostics, hiddenDiagnostics, publishedDiagnostics, state, debouncer, lspEnv} current = liftIO $ do +updateFileDiagnostics fp k ShakeExtras{logger, diagnostics, hiddenDiagnostics, publishedDiagnostics, state, debouncer, lspEnv} current = liftIO $ do modTime <- (currentValue . fst =<<) <$> getValues state GetModificationTime fp let (currentShown, currentHidden) = partition ((== ShowDiag) . fst) current uri = filePathToUri' fp @@ -1057,9 +1057,12 @@ updateFileDiagnostics fp k ShakeExtras{diagnostics, hiddenDiagnostics, published registerEvent debouncer delay uri $ do mask_ $ modifyVar_ publishedDiagnostics $ \published -> do let lastPublish = HMap.lookupDefault [] uri published - when (lastPublish /= newDiags) $ mRunLspT lspEnv $ - LSP.sendNotification LSP.STextDocumentPublishDiagnostics $ - LSP.PublishDiagnosticsParams (fromNormalizedUri uri) ver (List newDiags) + when (lastPublish /= newDiags) $ case lspEnv of + Nothing -> -- Print an LSP event. + logInfo logger $ showDiagnosticsColored $ map (fp,ShowDiag,) newDiags + Just env -> LSP.runLspT env $ + LSP.sendNotification LSP.STextDocumentPublishDiagnostics $ + LSP.PublishDiagnosticsParams (fromNormalizedUri uri) ver (List newDiags) pure $! HMap.insert uri newDiags published newtype Priority = Priority Double diff --git a/ghcide/src/Development/IDE/LSP/Protocol.hs b/ghcide/src/Development/IDE/LSP/Protocol.hs deleted file mode 100644 index 1a0779862b7..00000000000 --- a/ghcide/src/Development/IDE/LSP/Protocol.hs +++ /dev/null @@ -1,23 +0,0 @@ --- Copyright (c) 2019 The DAML Authors. All rights reserved. --- SPDX-License-Identifier: Apache-2.0 -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE GADTs #-} - -module Development.IDE.LSP.Protocol - ( pattern EventFileDiagnostics - ) where - -import Development.IDE.Types.Diagnostics -import Development.IDE.Types.Location -import Language.LSP.Types - ----------------------------------------------------------------------------------------------------- --- Pretty printing ----------------------------------------------------------------------------------------------------- - --- | Pattern synonym to make it a bit more convenient to match on diagnostics --- in things like damlc test. -pattern EventFileDiagnostics :: FilePath -> [Diagnostic] -> FromServerMessage -pattern EventFileDiagnostics fp diags <- FromServerMess STextDocumentPublishDiagnostics - (NotificationMessage _ STextDocumentPublishDiagnostics - (PublishDiagnosticsParams (uriToFilePath' -> Just fp) _ver (List diags))) diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index 804a121341b..af145816464 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -4,7 +4,6 @@ import Control.Exception.Safe ( Exception (displayException), catchAny, ) -import Control.Lens ((^.)) import Control.Monad.Extra (concatMapM, unless, when) import qualified Data.Aeson as J import Data.Default (Default (def)) @@ -47,18 +46,13 @@ import Development.IDE.Core.Shake ( ) import Development.IDE.Core.Tracing (measureMemory) import Development.IDE.LSP.LanguageServer (runLanguageServer) -import Development.IDE.LSP.Protocol import Development.IDE.Plugin ( - Plugin (pluginHandler, pluginRules), + Plugin (pluginHandlers, pluginRules), ) import Development.IDE.Plugin.HLS (asGhcIdePlugin) import Development.IDE.Session (SessionLoadingOptions, defaultLoadingOptions, loadSessionWithOptions, setInitialDynFlags) -import Development.IDE.Types.Diagnostics ( - ShowDiagnostic (ShowDiag), - showDiagnosticsColored, - ) import Development.IDE.Types.Location (toNormalizedFilePath') -import Development.IDE.Types.Logger (Logger, logInfo) +import Development.IDE.Types.Logger (Logger) import Development.IDE.Types.Options ( IdeGhcSession, IdeOptions (optCheckParents, optCheckProject, optReportProgress), @@ -71,14 +65,7 @@ import HIE.Bios.Cradle (findCradle) import Ide.Plugin.Config (CheckParents (NeverCheck), Config) import Ide.PluginUtils (allLspCmdIds', getProcessID, pluginDescToIdePlugins) import Ide.Types (IdePlugins) -import qualified Language.Haskell.LSP.Core as LSP -import Language.Haskell.LSP.Messages (FromServerMessage) -import Language.Haskell.LSP.Types ( - DidChangeConfigurationNotification, - InitializeRequest, - LspId (IdInt), - ) -import Language.Haskell.LSP.Types.Lens (initializationOptions, params) +import qualified Language.LSP.Server as LSP import qualified System.Directory.Extra as IO import System.Exit (ExitCode (ExitFailure), exitWith) import System.FilePath (takeExtension, takeFileName) @@ -99,8 +86,7 @@ data Arguments = Arguments , argsSessionLoadingOptions :: SessionLoadingOptions , argsIdeOptions :: Maybe Config -> Action IdeGhcSession -> IdeOptions , argsLspOptions :: LSP.Options - , argsGetInitialConfig :: InitializeRequest -> Either T.Text Config - , argsOnConfigChange :: DidChangeConfigurationNotification -> Either T.Text Config + , argsOnConfigChange :: IdeState -> J.Value -> IO (Either T.Text Config) } defArguments :: HieDb -> IndexQueue -> Arguments @@ -117,12 +103,9 @@ defArguments hiedb hiechan = , argsSessionLoadingOptions = defaultLoadingOptions , argsIdeOptions = const defaultIdeOptions , argsLspOptions = def {LSP.completionTriggerCharacters = Just "."} - , argsOnConfigChange = const $ Left "Updating Not supported" - , argsGetInitialConfig = \x -> case x ^. params . initializationOptions of - Nothing -> Right def - Just v -> case J.fromJSON v of - J.Error err -> Left $ T.pack err - J.Success a -> Right a + , argsOnConfigChange = \_ide v -> pure $ case J.fromJSON v of + J.Error err -> Left $ T.pack err + J.Success a -> Right a } defaultMain :: Arguments -> IO () @@ -140,7 +123,7 @@ defaultMain Arguments{..} = do t <- offsetTime hPutStrLn stderr "Starting LSP server..." hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!" - runLanguageServer options (pluginHandler plugins) argsGetInitialConfig argsOnConfigChange $ \getLspId event vfs caps wProg wIndefProg getConfig rootPath -> do + runLanguageServer options argsOnConfigChange (pluginHandlers plugins) $ \env vfs rootPath -> do t <- t hPutStrLn stderr $ "Started LSP server in " ++ showDuration t @@ -153,19 +136,16 @@ defaultMain Arguments{..} = do `catchAny` (\e -> (hPutStrLn stderr $ "setInitialDynFlags: " ++ displayException e) >> pure Nothing) sessionLoader <- loadSessionWithOptions argsSessionLoadingOptions $ fromMaybe dir rootPath - config <- getConfig + config <- LSP.runLspT env LSP.getConfig let options = (argsIdeOptions config sessionLoader) { optReportProgress = clientSupportsProgress caps } rules = argsRules >> pluginRules plugins + caps = LSP.resClientCapabilities env debouncer <- newAsyncDebouncer initialise - caps rules - getLspId - event - wProg - wIndefProg + (Just env) argsLogger debouncer options @@ -195,13 +175,12 @@ defaultMain Arguments{..} = do putStrLn "\nStep 3/4: Initializing the IDE" vfs <- makeVFSHandle debouncer <- newAsyncDebouncer - let dummyWithProg _ _ f = f (const (pure ())) sessionLoader <- loadSessionWithOptions argsSessionLoadingOptions dir let options = (argsIdeOptions Nothing sessionLoader) - { optCheckParents = NeverCheck - , optCheckProject = False + { optCheckParents = pure NeverCheck + , optCheckProject = pure False } - ide <- initialise def mainRule (pure $ IdInt 0) (showEvent argsLogger) dummyWithProg (const (const id)) argsLogger debouncer options vfs argsHiedb argsHieChan + ide <- initialise mainRule Nothing argsLogger debouncer options vfs argsHiedb argsHieChan putStrLn "\nStep 4/4: Type checking the files" setFilesOfInterest ide $ HashMap.fromList $ map ((,OnDisk) . toNormalizedFilePath') files @@ -246,10 +225,3 @@ expandFiles = concatMapM $ \x -> do when (null files) $ fail $ "Couldn't find any .hs/.lhs files inside directory: " ++ x return files - --- | Print an LSP event. -showEvent :: Logger -> FromServerMessage -> IO () -showEvent _ (EventFileDiagnostics _ []) = return () -showEvent argsLogger (EventFileDiagnostics (toNormalizedFilePath' -> file) diags) = - logInfo argsLogger $ showDiagnosticsColored $ map (file,ShowDiag,) diags -showEvent argsLogger e = logInfo argsLogger $ T.pack $ show e diff --git a/plugins/hls-eval-plugin/test/Eval.hs b/plugins/hls-eval-plugin/test/Eval.hs index a6bd45e0cb9..8222208b67a 100644 --- a/plugins/hls-eval-plugin/test/Eval.hs +++ b/plugins/hls-eval-plugin/test/Eval.hs @@ -37,7 +37,6 @@ import Test.Tasty.HUnit ( (@?=), ) import Data.List.Extra (nubOrdOn) -import Development.IDE (List(List)) import Ide.Plugin.Eval.Types (EvalParams(..)) import Data.Aeson (fromJSON) import Data.Aeson.Types (Result(Success)) diff --git a/src/Ide/Main.hs b/src/Ide/Main.hs index 12a3824bb71..d357fa38e56 100644 --- a/src/Ide/Main.hs +++ b/src/Ide/Main.hs @@ -18,7 +18,7 @@ import qualified Data.Text as T import Development.IDE.Core.Rules import Development.IDE.Session (setInitialDynFlags, getHieDbLoc, runWithDb) import Development.IDE.Types.Logger as G -import qualified Language.Haskell.LSP.Core as LSP +import qualified Language.LSP.Server as LSP import Ide.Arguments import Ide.Logger import Ide.Version @@ -31,7 +31,7 @@ import HieDb.Run import qualified Development.IDE.Main as Main import qualified Development.IDE.Types.Options as Ghcide import Development.Shake (ShakeOptions(shakeThreads)) -import Ide.Plugin.Config (getInitialConfig, getConfigFromNotification) +import Ide.Plugin.Config (getConfigFromNotification) defaultMain :: Arguments -> IdePlugins IdeState -> IO () defaultMain args idePlugins = do @@ -100,7 +100,6 @@ runLspMode lspArgs@LspArguments{..} idePlugins = do { Main.argFiles = if argLSP then Nothing else Just [] , Main.argsHlsPlugins = idePlugins , Main.argsLogger = hlsLogger - , Main.argsGetInitialConfig = getInitialConfig , Main.argsOnConfigChange = getConfigFromNotification , Main.argsIdeOptions = \_config sessionLoader -> let defOptions = Ghcide.defaultIdeOptions sessionLoader