rebase fixes

Author: wz1000

ghcide/exe/Main.hs

@@ -112,8 +112,8 @@ main = do
                       , optOTMemoryProfiling = IdeOTMemoryProfiling argsOTMemoryProfiling
                       , optTesting = IdeTesting argsTesting
                       , optShakeOptions = (optShakeOptions defOptions){shakeThreads = argsThreads}
-                      , optCheckParents = checkParents config
-                      , optCheckProject = checkProject config
+                      , optCheckParents = pure $ checkParents config
+                      , optCheckProject = pure $ checkProject config
                       }
                 }
 

ghcide/ghcide.cabal

@@ -167,7 +167,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

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

ghcide/src/Development/IDE/LSP/Protocol.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

ghcide/src/Development/IDE/Main.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))

plugins/hls-eval-plugin/test/Eval.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