From 2f50ba726d39081b98a5e53939ae52b6b20febfb Mon Sep 17 00:00:00 2001
From: kokobd <contact@zelinf.net>
Date: Mon, 1 Aug 2022 14:33:46 +0800
Subject: [PATCH 01/18] upgrade lsp to 1.5

---
 cabal.project                                 |  2 +-
 exe/Wrapper.hs                                |  2 +-
 ghcide/ghcide.cabal                           |  7 +++---
 ghcide/src/Development/IDE/Core/FileStore.hs  |  4 ++--
 ghcide/src/Development/IDE/Core/Rules.hs      | 10 ++++----
 ghcide/src/Development/IDE/Core/Shake.hs      |  4 ++--
 .../src/Development/IDE/LSP/LanguageServer.hs | 18 +++++++++------
 ghcide/src/Development/IDE/Main.hs            |  2 +-
 .../src/Development/IDE/Plugin/CodeAction.hs  |  7 +++---
 ghcide/src/Development/IDE/Types/Logger.hs    | 23 ++++++++++++++-----
 ghcide/test/exe/Main.hs                       | 14 +++++------
 hls-plugin-api/hls-plugin-api.cabal           |  2 +-
 hls-test-utils/hls-test-utils.cabal           |  4 ++--
 .../src/Ide/Plugin/Rename.hs                  |  4 ----
 stack-lts16.yaml                              |  6 ++---
 stack-lts19.yaml                              |  3 +++
 stack.yaml                                    | 10 ++++----
 17 files changed, 69 insertions(+), 53 deletions(-)

diff --git a/cabal.project b/cabal.project
index bb14019d99..85c88e0105 100644
--- a/cabal.project
+++ b/cabal.project
@@ -44,7 +44,7 @@ package *
 
 write-ghc-environment-files: never
 
-index-state: 2022-06-12T00:00:00Z
+index-state: 2022-07-31T21:47:51Z
 
 constraints:
   hyphenation +embed,
diff --git a/exe/Wrapper.hs b/exe/Wrapper.hs
index 83f10cedb2..0122cf319f 100644
--- a/exe/Wrapper.hs
+++ b/exe/Wrapper.hs
@@ -301,7 +301,7 @@ launchErrorLSP errorMsg = do
         let interpretHandler (env,  _st) = LSP.Iso (LSP.runLspT env . unErrorLSPM) liftIO
         pure (doInitialize, asyncHandlers, interpretHandler)
 
-  runLanguageServer
+  runLanguageServer (cmapWithPrio pretty recorder)
     (Main.argsLspOptions defaultArguments)
     inH
     outH
diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal
index e91c296f36..5d4ead50b6 100644
--- a/ghcide/ghcide.cabal
+++ b/ghcide/ghcide.cabal
@@ -46,6 +46,7 @@ library
         binary,
         bytestring,
         case-insensitive,
+        co-log-core,
         containers,
         data-default,
         deepseq,
@@ -69,8 +70,8 @@ library
         lens,
         list-t,
         hiedb == 0.4.1.*,
-        lsp-types ^>= 1.4.0.1,
-        lsp ^>= 1.4.0.0 ,
+        lsp-types ^>= 1.5.0.0,
+        lsp ^>= 1.5.0.0 ,
         monoid-subclasses,
         mtl,
         network-uri,
@@ -81,7 +82,7 @@ library
         random,
         regex-tdfa >= 1.3.1.0,
         retrie,
-        rope-utf16-splay,
+        text-rope,
         safe,
         safe-exceptions,
         hls-graph ^>= 1.7,
diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs
index 697df7c3fd..93a9c0a90f 100644
--- a/ghcide/src/Development/IDE/Core/FileStore.hs
+++ b/ghcide/src/Development/IDE/Core/FileStore.hs
@@ -28,8 +28,8 @@ import           Control.Exception
 import           Control.Monad.Extra
 import           Control.Monad.IO.Class
 import qualified Data.ByteString                              as BS
-import qualified Data.Rope.UTF16                              as Rope
 import qualified Data.Text                                    as T
+import qualified Data.Text.Utf16.Rope                         as Rope
 import           Data.Time
 import           Data.Time.Clock.POSIX
 import           Development.IDE.Core.FileUtils
@@ -188,7 +188,7 @@ getFileContentsImpl file = do
     time <- use_ GetModificationTime file
     res <- do
         mbVirtual <- getVirtualFile file
-        pure $ Rope.toText . _text <$> mbVirtual
+        pure $ Rope.toText . _file_text <$> mbVirtual
     pure ([], Just (time, res))
 
 -- | Returns the modification time and the contents.
diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs
index 786a4ae156..e3f1c4aaa3 100644
--- a/ghcide/src/Development/IDE/Core/Rules.hs
+++ b/ghcide/src/Development/IDE/Core/Rules.hs
@@ -92,7 +92,7 @@ import qualified Data.IntMap.Strict                           as IntMap
 import           Data.List
 import qualified Data.Map                                     as M
 import           Data.Maybe
-import qualified Data.Rope.UTF16                              as Rope
+import qualified Data.Text.Utf16.Rope                         as Rope
 import qualified Data.Set                                     as Set
 import qualified Data.Text                                    as T
 import qualified Data.Text.Encoding                           as T
@@ -574,10 +574,10 @@ persistentHieFileRule :: Recorder (WithPriority Log) -> Rules ()
 persistentHieFileRule recorder = addPersistentRule GetHieAst $ \file -> runMaybeT $ do
   res <- readHieFileForSrcFromDisk recorder file
   vfsRef <- asks vfsVar
-  vfsData <- liftIO $ vfsMap <$> readTVarIO vfsRef
+  vfsData <- liftIO $ _vfsMap <$> readTVarIO vfsRef
   (currentSource, ver) <- liftIO $ case M.lookup (filePathToUri' file) vfsData of
     Nothing -> (,Nothing) . T.decodeUtf8 <$> BS.readFile (fromNormalizedFilePath file)
-    Just vf -> pure (Rope.toText $ _text vf, Just $ _lsp_version vf)
+    Just vf -> pure (Rope.toText $ _file_text vf, Just $ _lsp_version vf)
   let refmap = Compat.generateReferencesMap . Compat.getAsts . Compat.hie_asts $ res
       del = deltaFromDiff (T.decodeUtf8 $ Compat.hie_hs_src res) currentSource
   pure (HAR (Compat.hie_module res) (Compat.hie_asts res) refmap mempty (HieFromDisk res),del,ver)
@@ -1108,8 +1108,8 @@ getLinkableType f = use_ NeedsCompilation f
 
 -- needsCompilationRule :: Rules ()
 needsCompilationRule :: NormalizedFilePath  -> Action (IdeResultNoDiagnosticsEarlyCutoff (Maybe LinkableType))
-needsCompilationRule file 
-  | "boot" `isSuffixOf` (fromNormalizedFilePath file) = 
+needsCompilationRule file
+  | "boot" `isSuffixOf` (fromNormalizedFilePath file) =
     pure (Just $ encodeLinkableType Nothing, Just Nothing)
 needsCompilationRule file = do
   graph <- useNoFile GetModuleGraph
diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs
index cd37c1b26f..8ac8de2f0a 100644
--- a/ghcide/src/Development/IDE/Core/Shake.hs
+++ b/ghcide/src/Development/IDE/Core/Shake.hs
@@ -164,7 +164,7 @@ import qualified Language.LSP.Server                    as LSP
 import           Language.LSP.Types
 import qualified Language.LSP.Types                     as LSP
 import           Language.LSP.Types.Capabilities
-import           Language.LSP.VFS
+import           Language.LSP.VFS                       hiding (start)
 import qualified "list-t" ListT
 import           OpenTelemetry.Eventlog
 import qualified StmContainers.Map                      as STM
@@ -323,7 +323,7 @@ class Typeable a => IsIdeGlobal a where
 -- | Read a virtual file from the current snapshot
 getVirtualFile :: NormalizedFilePath -> Action (Maybe VirtualFile)
 getVirtualFile nf = do
-  vfs <- fmap vfsMap . liftIO . readTVarIO . vfsVar =<< getShakeExtras
+  vfs <- fmap _vfsMap . liftIO . readTVarIO . vfsVar =<< getShakeExtras
   pure $! Map.lookup (filePathToUri' nf) vfs -- Don't leak a reference to the entire map
 
 -- Take a snapshot of the current LSP VFS
diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
index 798ea40a68..e5d94e0d41 100644
--- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs
+++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
@@ -34,17 +34,16 @@ import           UnliftIO.Concurrent
 import           UnliftIO.Directory
 import           UnliftIO.Exception
 
+import           Control.Monad.IO.Unlift               (MonadUnliftIO)
 import           Development.IDE.Core.IdeConfiguration
-import           Development.IDE.Core.Shake            hiding (Log)
+import           Development.IDE.Core.Shake            hiding (Log, Priority)
 import           Development.IDE.Core.Tracing
-import           Development.IDE.Types.Logger
-
-import           Control.Monad.IO.Unlift               (MonadUnliftIO)
-import           Data.Kind                             (Type)
 import qualified Development.IDE.Session               as Session
+import           Development.IDE.Types.Logger
 import qualified Development.IDE.Types.Logger          as Logger
 import           Development.IDE.Types.Shake           (WithHieDb)
 import           Language.LSP.Server                   (LanguageContextEnv,
+                                                        LspServerLog,
                                                         type (<~>))
 import           System.IO.Unsafe                      (unsafeInterleaveIO)
 
@@ -55,6 +54,7 @@ data Log
   | LogReactorThreadStopped
   | LogCancelledRequest !SomeLspId
   | LogSession Session.Log
+  | LogLspServer LspServerLog
   deriving Show
 
 instance Pretty Log where
@@ -74,13 +74,15 @@ instance Pretty Log where
     LogCancelledRequest requestId ->
       "Cancelled request" <+> viaShow requestId
     LogSession log -> pretty log
+    LogLspServer log -> pretty log
 
 -- used to smuggle RankNType WithHieDb through dbMVar
 newtype WithHieDbShield = WithHieDbShield WithHieDb
 
 runLanguageServer
     :: forall config a m. (Show config)
-    => LSP.Options
+    => Recorder (WithPriority Log)
+    -> LSP.Options
     -> Handle -- input
     -> Handle -- output
     -> config
@@ -90,7 +92,7 @@ runLanguageServer
                LSP.Handlers (m config),
                (LanguageContextEnv config, a) -> m config <~> IO))
     -> IO ()
-runLanguageServer options inH outH defaultConfig onConfigurationChange setup = do
+runLanguageServer recorder options inH outH defaultConfig onConfigurationChange setup = do
     -- This MVar becomes full when the server thread exits or we receive exit message from client.
     -- LSP server will be canceled when it's full.
     clientMsgVar <- newEmptyMVar
@@ -108,6 +110,8 @@ runLanguageServer options inH outH defaultConfig onConfigurationChange setup = d
 
     void $ untilMVar clientMsgVar $
           void $ LSP.runServerWithHandles
+            (toCologActionWithPrio (cmapWithPrio LogLspServer recorder))
+            (toCologActionWithPrio (cmapWithPrio LogLspServer recorder))
             inH
             outH
             serverDefinition
diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs
index 585a2badb7..7ce2ac47d5 100644
--- a/ghcide/src/Development/IDE/Main.hs
+++ b/ghcide/src/Development/IDE/Main.hs
@@ -385,7 +385,7 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re
 
             let setup = setupLSP (cmapWithPrio LogLanguageServer recorder) argsGetHieDbLoc (pluginHandlers plugins) getIdeState
 
-            runLanguageServer options inH outH argsDefaultHlsConfig argsOnConfigChange setup
+            runLanguageServer (cmapWithPrio LogLanguageServer recorder) options inH outH argsDefaultHlsConfig argsOnConfigChange setup
             dumpSTMStats
         Check argFiles -> do
           dir <- maybe IO.getCurrentDirectory return argsProjectRoot
diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs
index a3eb4f4774..35f89ac108 100644
--- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs
+++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs
@@ -36,9 +36,9 @@ import qualified Data.List.NonEmpty                                as NE
 import qualified Data.Map.Strict                                   as M
 import           Data.Maybe
 import           Data.Ord                                          (comparing)
-import qualified Data.Rope.UTF16                                   as Rope
 import qualified Data.Set                                          as S
 import qualified Data.Text                                         as T
+import qualified Data.Text.Utf16.Rope                              as Rope
 import           Data.Tuple.Extra                                  (fst3)
 import           Development.IDE.Core.Rules
 import           Development.IDE.Core.RuleTypes
@@ -75,7 +75,8 @@ import           Language.LSP.Types                                (CodeAction (
                                                                     WorkspaceEdit (WorkspaceEdit, _changeAnnotations, _changes, _documentChanges),
                                                                     type (|?) (InR),
                                                                     uriToFilePath)
-import           Language.LSP.VFS
+import           Language.LSP.VFS                                  (VirtualFile,
+                                                                    _file_text)
 import           Text.Regex.TDFA                                   (mrAfter,
                                                                     (=~), (=~~))
 #if MIN_VERSION_ghc(9,2,0)
@@ -109,7 +110,7 @@ codeAction
 codeAction state _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List xs}) = do
   contents <- LSP.getVirtualFile $ toNormalizedUri uri
   liftIO $ do
-    let text = Rope.toText . (_text :: VirtualFile -> Rope.Rope) <$> contents
+    let text = Rope.toText . (_file_text :: VirtualFile -> Rope.Rope) <$> contents
         mbFile = toNormalizedFilePath' <$> uriToFilePath uri
     diag <- atomically $ fmap (\(_, _, d) -> d) . filter (\(p, _, _) -> mbFile == Just p) <$> getDiagnostics state
     (join -> parsedModule) <- runAction "GhcideCodeActions.getParsedModule" state $ getParsedModule `traverse` mbFile
diff --git a/ghcide/src/Development/IDE/Types/Logger.hs b/ghcide/src/Development/IDE/Types/Logger.hs
index 6673707204..8a1633a32b 100644
--- a/ghcide/src/Development/IDE/Types/Logger.hs
+++ b/ghcide/src/Development/IDE/Types/Logger.hs
@@ -27,6 +27,7 @@ module Development.IDE.Types.Logger
   , lspClientLogRecorder
   , module PrettyPrinterModule
   , renderStrict
+  , toCologActionWithPrio
   ) where
 
 import           Control.Concurrent                    (myThreadId)
@@ -59,7 +60,6 @@ import           Language.LSP.Server
 import qualified Language.LSP.Server                   as LSP
 import           Language.LSP.Types                    (LogMessageParams (..),
                                                         MessageType (..),
-                                                        ResponseError,
                                                         SMethod (SWindowLogMessage, SWindowShowMessage),
                                                         ShowMessageParams (..))
 #if MIN_VERSION_prettyprinter(1,7,0)
@@ -69,11 +69,10 @@ import           Prettyprinter.Render.Text             (renderStrict)
 import           Data.Text.Prettyprint.Doc             as PrettyPrinterModule
 import           Data.Text.Prettyprint.Doc.Render.Text (renderStrict)
 #endif
-import           Control.Lens                          ((^.))
-import           Ide.Types                             (CommandId (CommandId),
-                                                        PluginId (PluginId))
-import           Language.LSP.Types.Lens               (HasCode (code),
-                                                        HasMessage (message))
+import           Colog.Core                            (LogAction (..),
+                                                        Severity,
+                                                        WithSeverity (..))
+import qualified Colog.Core                            as Colog
 import           System.IO                             (Handle,
                                                         IOMode (AppendMode),
                                                         hClose, hFlush,
@@ -381,3 +380,15 @@ priorityToLsp =
     Info    -> MtInfo
     Warning -> MtWarning
     Error   -> MtError
+
+toCologActionWithPrio :: (MonadIO m, HasCallStack) => Recorder (WithPriority msg) -> LogAction m (WithSeverity msg)
+toCologActionWithPrio (Recorder _logger) = LogAction $ \WithSeverity{..} -> do
+    let priority = severityToPriority getSeverity
+    _logger $ WithPriority priority callStack getMsg
+    undefined
+  where
+    severityToPriority :: Severity -> Priority
+    severityToPriority Colog.Debug   = Debug
+    severityToPriority Colog.Info    = Info
+    severityToPriority Colog.Warning = Warning
+    severityToPriority Colog.Error   = Error
diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs
index 24669ad7a5..e60a39996c 100644
--- a/ghcide/test/exe/Main.hs
+++ b/ghcide/test/exe/Main.hs
@@ -28,8 +28,8 @@ import           Data.Default
 import           Data.Foldable
 import           Data.List.Extra
 import           Data.Maybe
-import           Data.Rope.UTF16                          (Rope)
-import qualified Data.Rope.UTF16                          as Rope
+import           Data.Text.Utf16.Rope                          (Rope)
+import qualified Data.Text.Utf16.Rope                          as Rope
 import qualified Data.Set                                 as Set
 import qualified Data.Text                                as T
 import           Development.IDE.Core.PositionMapping     (PositionResult (..),
@@ -4357,12 +4357,12 @@ findDefinitionAndHoverTests = let
 
   typeDefinitionTests = [ tst (getTypeDefinitions, checkDefs) aaaL14 sourceFilePath (pure tcData) "Saturated data con"
                         , tst (getTypeDefinitions, checkDefs) aL20 sourceFilePath (pure [ExpectNoDefinitions]) "Polymorphic variable"]
-  
-  recordDotSyntaxTests 
+
+  recordDotSyntaxTests
     | ghcVersion >= GHC92 =
-        [ tst (getHover, checkHover) (Position 19 24) (T.unpack "RecordDotSyntax.hs") (pure [ExpectHoverText ["x :: MyRecord"]]) "hover over parent" 
-        , tst (getHover, checkHover) (Position 19 25) (T.unpack "RecordDotSyntax.hs") (pure [ExpectHoverText ["_ :: MyChild"]]) "hover over dot shows child" 
-        , tst (getHover, checkHover) (Position 19 26) (T.unpack "RecordDotSyntax.hs") (pure [ExpectHoverText ["_ :: MyChild"]]) "hover over child" 
+        [ tst (getHover, checkHover) (Position 19 24) (T.unpack "RecordDotSyntax.hs") (pure [ExpectHoverText ["x :: MyRecord"]]) "hover over parent"
+        , tst (getHover, checkHover) (Position 19 25) (T.unpack "RecordDotSyntax.hs") (pure [ExpectHoverText ["_ :: MyChild"]]) "hover over dot shows child"
+        , tst (getHover, checkHover) (Position 19 26) (T.unpack "RecordDotSyntax.hs") (pure [ExpectHoverText ["_ :: MyChild"]]) "hover over child"
         ]
     | otherwise = []
 
diff --git a/hls-plugin-api/hls-plugin-api.cabal b/hls-plugin-api/hls-plugin-api.cabal
index 0d79ec3bac..67e57b578b 100644
--- a/hls-plugin-api/hls-plugin-api.cabal
+++ b/hls-plugin-api/hls-plugin-api.cabal
@@ -49,7 +49,7 @@ library
     , hls-graph             ^>= 1.7
     , lens
     , lens-aeson
-    , lsp                   >=1.4.0.0 && < 1.6
+    , lsp                   ^>=1.5.0.0
     , opentelemetry         >=0.4
     , optparse-applicative
     , process
diff --git a/hls-test-utils/hls-test-utils.cabal b/hls-test-utils/hls-test-utils.cabal
index 4a90797316..3335f5d8d3 100644
--- a/hls-test-utils/hls-test-utils.cabal
+++ b/hls-test-utils/hls-test-utils.cabal
@@ -45,9 +45,9 @@ library
     , hls-graph
     , hls-plugin-api          ^>=1.3 || ^>=1.4
     , lens
-    , lsp                     ^>=1.4
+    , lsp                     ^>=1.5.0.0
     , lsp-test                ^>=0.14
-    , lsp-types               ^>=1.4.0.1
+    , lsp-types               ^>=1.5.0.0
     , tasty
     , tasty-expected-failure
     , tasty-golden
diff --git a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs
index 6d7dbea5d5..b83423254a 100644
--- a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs
+++ b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs
@@ -48,10 +48,6 @@ import           Ide.Types
 import           Language.LSP.Server
 import           Language.LSP.Types
 
-instance Hashable Location
-instance Hashable Range
-instance Hashable Position
-instance Hashable UInt
 instance Hashable (Mod a) where hash n = hash (unMod n)
 
 descriptor :: PluginId -> PluginDescriptor IdeState
diff --git a/stack-lts16.yaml b/stack-lts16.yaml
index 826f8730e4..591d910fbe 100644
--- a/stack-lts16.yaml
+++ b/stack-lts16.yaml
@@ -84,9 +84,9 @@ extra-deps:
   - constraints-extras-0.3.0.2@sha256:013b8d0392582c6ca068e226718a4fe8be8e22321cc0634f6115505bf377ad26,1853
   - some-1.0.1@sha256:26e5bab7276f48b25ea8660d3fd1166c0f20fd497dac879a40f408e23211f93e,2055
   - unliftio-core-0.2.0.1@sha256:9b3e44ea9aacacbfc35b3b54015af450091916ac3618a41868ebf6546977659a,1082
-  - lsp-1.4.0.0
-  - lsp-types-1.4.0.1
-  - lsp-test-0.14.0.2
+  - lsp-1.5.0.0
+  - lsp-types-1.5.0.0
+  - lsp-test-0.14.0.3
   - stm-containers-1.1.0.4
   - stm-hamt-1.2.0.6@sha256:fba86ccb4b45c5706c19b0e1315ba63dcac3b5d71de945ec001ba921fae80061,3972
   - primitive-extras-0.10.1
diff --git a/stack-lts19.yaml b/stack-lts19.yaml
index 48f834ddcb..8e72b48829 100644
--- a/stack-lts19.yaml
+++ b/stack-lts19.yaml
@@ -52,6 +52,9 @@ extra-deps:
 - refinery-0.4.0.0@sha256:fe3a43add8ff1db5cfffee7e7694c86128b1dfe62c541f26e25a8eadf9585610,1663
 - retrie-1.1.0.0
 - stylish-haskell-0.14.2.0@sha256:fffe1c13ad4c2678cf28a7470cac5d3bf20c71c36f09969e3e5f186787cceb7c,4321
+- lsp-1.5.0.0
+- lsp-types-1.5.0.0
+- lsp-test-0.14.0.3
 
 configure-options:
   ghcide:
diff --git a/stack.yaml b/stack.yaml
index 438328b03a..105cbb680c 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -1,4 +1,4 @@
-resolver: nightly-2022-06-10
+resolver: nightly-2022-07-31
 
 packages:
 - .
@@ -40,13 +40,13 @@ extra-deps:
 - hlint-3.4
 - implicit-hie-0.1.2.7@sha256:82bbbb1a8c05f99c8af3c16ac53e80c8648d8bf047b25ed5ce45a135bd736907,3122
 - implicit-hie-cradle-0.5.0.0@sha256:4276f60f3a59bc22df03fd918f73bca9f777de9568f85e3a8be8bd7566234a59,2368
-- lsp-1.4.0.0@sha256:d992cb88d6212f113baf372404c141a6bea14c436baa64ea6e4f01b6188c575b,5088
-- lsp-test-0.14.0.2@sha256:d62d2af45508f04c5fcad23e469c45b37ca19760cee15b025a0eb499cbd28050,4663
-- lsp-types-1.4.0.1@sha256:b902952df7becc1827947ee3ff1cd8c746aa8f9f80db330db20e2fdf1b6089e8,4504
+- lsp-1.5.0.0
+- lsp-test-0.14.0.3
+- lsp-types-1.5.0.0
 - monad-dijkstra-0.1.1.3@sha256:d2fc098d7c122555e726830a12ae0423ac187f89de9228f32e56e2f6fc2238e1,1900
 - retrie-1.2.0.1
-- rope-utf16-splay-0.3.2.0
 - sqlite-simple-0.4.18.0@sha256:3ceea56375c0a3590c814e411a4eb86943f8d31b93b110ca159c90689b6b39e5,3002
+- co-log-core-0.3.1.0
 
 # currently needed for ghcide>extra, etc.
 allow-newer: true

From ba518a2ed510f92f6621ec759f1c63c4bd425a2f Mon Sep 17 00:00:00 2001
From: kokobd <contact@zelinf.net>
Date: Mon, 1 Aug 2022 15:04:50 +0800
Subject: [PATCH 02/18] fix stack.yaml

---
 stack-lts16.yaml | 2 ++
 stack-lts19.yaml | 1 +
 2 files changed, 3 insertions(+)

diff --git a/stack-lts16.yaml b/stack-lts16.yaml
index 591d910fbe..0359ce5621 100644
--- a/stack-lts16.yaml
+++ b/stack-lts16.yaml
@@ -99,6 +99,8 @@ extra-deps:
   - trial-0.0.0.0@sha256:834d3be439dc9b52a759a45a4d3944e5e55c3d50fd5874003147cc1f6231d4aa,4301
   - trial-optparse-applicative-0.0.0.0@sha256:ba05edfc327a281766df5e0f44d91229e6a98afaf59abe1894b293453f076192,2449
   - trial-tomland-0.0.0.0@sha256:743a9baaa36891ed3a44618fdfd5bc4ed9afc39cf9b9fa23ea1b96f3787f5ec0,2526
+  - text-rope-0.2
+  - co-log-core-0.3.1.0
 
 configure-options:
   ghcide:
diff --git a/stack-lts19.yaml b/stack-lts19.yaml
index 8e72b48829..9a274f4d17 100644
--- a/stack-lts19.yaml
+++ b/stack-lts19.yaml
@@ -55,6 +55,7 @@ extra-deps:
 - lsp-1.5.0.0
 - lsp-types-1.5.0.0
 - lsp-test-0.14.0.3
+- co-log-core-0.3.1.0
 
 configure-options:
   ghcide:

From 278d02981fca1e59475a61acadc9b32f7443cc3d Mon Sep 17 00:00:00 2001
From: kokobd <contact@zelinf.net>
Date: Wed, 3 Aug 2022 00:02:05 +0800
Subject: [PATCH 03/18] try fix tests

---
 ghcide/ghcide.cabal                        |  1 +
 ghcide/src/Development/IDE/Types/Logger.hs |  1 -
 ghcide/test/exe/Main.hs                    | 59 ++++++++++++----------
 hls-test-utils/src/Test/Hls/Util.hs        |  8 +--
 4 files changed, 36 insertions(+), 33 deletions(-)

diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal
index 5d4ead50b6..66b5666f1a 100644
--- a/ghcide/ghcide.cabal
+++ b/ghcide/ghcide.cabal
@@ -437,6 +437,7 @@ test-suite ghcide-tests
         tasty-quickcheck,
         tasty-rerun,
         text,
+        text-rope,
         unordered-containers,
         vector,
     if (impl(ghc >= 8.6) && impl(ghc < 9.2))
diff --git a/ghcide/src/Development/IDE/Types/Logger.hs b/ghcide/src/Development/IDE/Types/Logger.hs
index 8a1633a32b..f5e68d7032 100644
--- a/ghcide/src/Development/IDE/Types/Logger.hs
+++ b/ghcide/src/Development/IDE/Types/Logger.hs
@@ -385,7 +385,6 @@ toCologActionWithPrio :: (MonadIO m, HasCallStack) => Recorder (WithPriority msg
 toCologActionWithPrio (Recorder _logger) = LogAction $ \WithSeverity{..} -> do
     let priority = severityToPriority getSeverity
     _logger $ WithPriority priority callStack getMsg
-    undefined
   where
     severityToPriority :: Severity -> Priority
     severityToPriority Colog.Debug   = Debug
diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs
index e60a39996c..8563f4297d 100644
--- a/ghcide/test/exe/Main.hs
+++ b/ghcide/test/exe/Main.hs
@@ -28,10 +28,10 @@ import           Data.Default
 import           Data.Foldable
 import           Data.List.Extra
 import           Data.Maybe
-import           Data.Text.Utf16.Rope                          (Rope)
-import qualified Data.Text.Utf16.Rope                          as Rope
 import qualified Data.Set                                 as Set
 import qualified Data.Text                                as T
+import           Data.Text.Utf16.Rope                     (Rope)
+import qualified Data.Text.Utf16.Rope                     as Rope
 import           Development.IDE.Core.PositionMapping     (PositionResult (..),
                                                            fromCurrent,
                                                            positionResultToMaybe,
@@ -78,7 +78,7 @@ import qualified Language.LSP.Types.Lens                  as Lens (label)
 import qualified Language.LSP.Types.Lens                  as Lsp (diagnostics,
                                                                   message,
                                                                   params)
-import           Language.LSP.VFS                         (applyChange)
+import           Language.LSP.VFS                         (VfsLog, applyChange)
 import           Network.URI
 import           System.Directory
 import           System.Environment.Blank                 (getEnv, setEnv,
@@ -116,7 +116,8 @@ import           Development.IDE.Types.Logger             (Logger (Logger),
                                                            WithPriority (WithPriority, priority),
                                                            cfilter,
                                                            cmapWithPrio,
-                                                           makeDefaultStderrRecorder)
+                                                           makeDefaultStderrRecorder,
+                                                           toCologActionWithPrio)
 import qualified FuzzySearch
 import           GHC.Stack                                (emptyCallStack)
 import qualified HieDbRetry
@@ -128,6 +129,8 @@ import           Language.LSP.Types.Lens                  (didChangeWatchedFiles
 import qualified Language.LSP.Types.Lens                  as L
 import qualified Progress
 import           System.Time.Extra
+import           Test.QuickCheck.Monadic                  (forAllM, monadicIO)
+import qualified Test.QuickCheck.Monadic as MonadicQuickCheck
 import           Test.Tasty
 import           Test.Tasty.ExpectedFailure
 import           Test.Tasty.HUnit
@@ -139,11 +142,13 @@ import           Text.Regex.TDFA                          ((=~))
 data Log
   = LogGhcIde Ghcide.Log
   | LogIDEMain IDE.Log
+  | LogVfs VfsLog
 
 instance Pretty Log where
   pretty = \case
     LogGhcIde log  -> pretty log
     LogIDEMain log -> pretty log
+    LogVfs log     -> pretty log
 
 -- | Wait for the next progress begin step
 waitForProgressBegin :: Session ()
@@ -210,7 +215,7 @@ main = do
     , safeTests
     , unitTests recorder logger
     , haddockTests
-    , positionMappingTests
+    , positionMappingTests recorder
     , watchedFilesTests
     , cradleTests
     , dependentFileTest
@@ -250,7 +255,7 @@ initializeResponseTests = withResource acquire release tests where
     , chk "   find references"          _referencesProvider (Just $ InL True)
     , chk "   doc highlight"     _documentHighlightProvider (Just $ InL True)
     , chk "   doc symbol"           _documentSymbolProvider (Just $ InL True)
-    , chk "   workspace symbol"    _workspaceSymbolProvider (Just True)
+    , chk "   workspace symbol"    _workspaceSymbolProvider (Just $ InL True)
     , chk "   code action"             _codeActionProvider  (Just $ InL True)
     , chk "   code lens"                 _codeLensProvider  (Just $ CodeLensOptions (Just False) (Just False))
     , chk "NO doc formatting"   _documentFormattingProvider (Just $ InL False)
@@ -6869,10 +6874,8 @@ testIde recorder arguments session = do
     flip finally (setCurrentDirectory cwd) $ withAsync server $ \_ ->
         runSessionWithHandles hInWrite hOutRead config lspTestCaps projDir session
 
-
-
-positionMappingTests :: TestTree
-positionMappingTests =
+positionMappingTests :: Recorder (WithPriority Log) -> TestTree
+positionMappingTests recorder =
     testGroup "position mapping"
         [ testGroup "toCurrent"
               [ testCase "before" $
@@ -6986,18 +6989,20 @@ positionMappingTests =
                     \(range, replacement, oldPos, newPos) ->
                     fromCurrent range replacement newPos === PositionExact oldPos
               , testProperty "toCurrent r t <=< fromCurrent r t" $ do
-                let gen = do
+                let gen :: Gen (Rope, Range, T.Text)
+                    gen = do
                         rope <- genRope
                         range <- genRange rope
                         PrintableText replacement <- arbitrary
-                        let newRope = applyChange rope (TextDocumentContentChangeEvent (Just range) Nothing replacement)
-                        newPos <- genPosition newRope
-                        pure (range, replacement, newPos)
-                forAll
-                    (suchThatMap gen
-                        (\(range, replacement, newPos) -> positionResultToMaybe $ (range, replacement, newPos,) <$> fromCurrent range replacement newPos)) $
-                    \(range, replacement, newPos, oldPos) ->
-                    toCurrent range replacement oldPos === PositionExact newPos
+                        pure (rope, range, replacement)
+                monadicIO $ forAllM gen
+                    $ \(rope, range, replacement) -> do
+                        newRope <- liftIO $ applyChange (toCologActionWithPrio $ cmapWithPrio LogVfs recorder) rope (TextDocumentContentChangeEvent (Just range) Nothing replacement)
+                        newPos <- MonadicQuickCheck.pick $ genPosition newRope
+                        case positionResultToMaybe $ (range, replacement, newPos,) <$> fromCurrent range replacement newPos of
+                            Nothing -> MonadicQuickCheck.pre False
+                            Just (range, replacement, newPos, oldPos) ->
+                                MonadicQuickCheck.assert $ toCurrent range replacement oldPos == PositionExact newPos
               ]
         ]
 
@@ -7013,19 +7018,19 @@ genRope = Rope.fromText . getPrintableText <$> arbitrary
 
 genPosition :: Rope -> Gen Position
 genPosition r = do
-    let rows = Rope.rows r
+    let rows :: Int = fromIntegral $ Rope.lengthInLines r
     row <- choose (0, max 0 $ rows - 1) `suchThat` inBounds @UInt
-    let columns = Rope.columns (nthLine row r)
+    let columns = T.length (nthLine (fromIntegral row) r)
     column <- choose (0, max 0 $ columns - 1) `suchThat` inBounds @UInt
     pure $ Position (fromIntegral row) (fromIntegral column)
 
 genRange :: Rope -> Gen Range
 genRange r = do
-    let rows = Rope.rows r
+    let rows :: Int = fromIntegral $ Rope.lengthInLines r
     startPos@(Position startLine startColumn) <- genPosition r
     let maxLineDiff = max 0 $ rows - 1 - fromIntegral startLine
     endLine <- choose (fromIntegral startLine, fromIntegral startLine + maxLineDiff) `suchThat` inBounds @UInt
-    let columns = Rope.columns (nthLine (fromIntegral endLine) r)
+    let columns = T.length (nthLine (fromIntegral endLine) r)
     endColumn <-
         if fromIntegral startLine == endLine
             then choose (fromIntegral startColumn, columns)
@@ -7037,12 +7042,10 @@ inBounds :: forall b a . (Integral a, Integral b, Bounded b) => a -> Bool
 inBounds a = let i = toInteger a in i <= toInteger (maxBound @b) && i >= toInteger (minBound @b)
 
 -- | Get the ith line of a rope, starting from 0. Trailing newline not included.
-nthLine :: Int -> Rope -> Rope
+nthLine :: Int -> Rope -> T.Text
 nthLine i r
-    | i < 0 = error $ "Negative line number: " <> show i
-    | i == 0 && Rope.rows r == 0 = r
-    | i >= Rope.rows r = error $ "Row number out of bounds: " <> show i <> "/" <> show (Rope.rows r)
-    | otherwise = Rope.takeWhile (/= '\n') $ fst $ Rope.splitAtLine 1 $ snd $ Rope.splitAtLine (i - 1) r
+    | Rope.null r = ""
+    | otherwise = Rope.lines r !! i
 
 getWatchedFilesSubscriptionsUntil :: forall m. SServerMethod m -> Session [DidChangeWatchedFilesRegistrationOptions]
 getWatchedFilesSubscriptionsUntil m = do
diff --git a/hls-test-utils/src/Test/Hls/Util.hs b/hls-test-utils/src/Test/Hls/Util.hs
index 519e15caf7..2496782712 100644
--- a/hls-test-utils/src/Test/Hls/Util.hs
+++ b/hls-test-utils/src/Test/Hls/Util.hs
@@ -3,7 +3,6 @@
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE GADTs                 #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE NamedFieldPuns        #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE TypeOperators         #-}
 module Test.Hls.Util
@@ -46,7 +45,7 @@ where
 
 import           Control.Applicative.Combinators (skipManyTill, (<|>))
 import           Control.Exception               (catch, throwIO)
-import           Control.Lens                    ((^.))
+import           Control.Lens                    ((&), (?~), (^.))
 import           Control.Monad
 import           Control.Monad.IO.Class
 import qualified Data.Aeson                      as A
@@ -59,6 +58,7 @@ import           Development.IDE                 (GhcVersion (..), ghcVersion)
 import qualified Language.LSP.Test               as Test
 import           Language.LSP.Types              hiding (Reason (..))
 import qualified Language.LSP.Types.Capabilities as C
+import           Language.LSP.Types.Lens         (textDocument)
 import qualified Language.LSP.Types.Lens         as L
 import           System.Directory
 import           System.Environment
@@ -74,13 +74,13 @@ import           Test.Tasty.HUnit                (Assertion, assertFailure,
                                                   (@?=))
 
 noLiteralCaps :: C.ClientCapabilities
-noLiteralCaps = def { C._textDocument = Just textDocumentCaps }
+noLiteralCaps = def & textDocument ?~ textDocumentCaps
   where
     textDocumentCaps = def { C._codeAction = Just codeActionCaps }
     codeActionCaps = CodeActionClientCapabilities (Just True) Nothing Nothing Nothing Nothing Nothing Nothing
 
 codeActionSupportCaps :: C.ClientCapabilities
-codeActionSupportCaps = def { C._textDocument = Just textDocumentCaps }
+codeActionSupportCaps = def & textDocument ?~ textDocumentCaps
   where
     textDocumentCaps = def { C._codeAction = Just codeActionCaps }
     codeActionCaps = CodeActionClientCapabilities (Just True) (Just literalSupport) (Just True) Nothing Nothing Nothing Nothing

From c763e79599d1a32f19cbc563959ab2bd03674b48 Mon Sep 17 00:00:00 2001
From: kokobd <contact@zelinf.net>
Date: Wed, 3 Aug 2022 17:38:08 +0800
Subject: [PATCH 04/18] disable verbose logging in ghcide

---
 ghcide/test/exe/Main.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs
index 8563f4297d..3b5356b723 100644
--- a/ghcide/test/exe/Main.hs
+++ b/ghcide/test/exe/Main.hs
@@ -6651,7 +6651,10 @@ runInDir'' lspCaps dir startExeIn startSessionIn extraOptions s = do
 
   shakeProfiling <- getEnv "SHAKE_PROFILING"
   let cmd = unwords $
-       [ghcideExe, "--lsp", "--test", "--verify-core-file", "--verbose", "-j2", "--cwd", startDir
+       -- With lsp-1.5, verbose logging is causing a lot of deeply nested JSON in ghcide-tests,
+       -- and finally results in OOM on a machine with 64GB RAM.
+       -- I can't find the root cause now.
+       [ghcideExe, "--lsp", "--test", "--verify-core-file", "-j2", "--cwd", startDir
        ] ++ ["--shake-profiling=" <> dir | Just dir <- [shakeProfiling]
        ] ++ extraOptions
   -- HIE calls getXgdDirectory which assumes that HOME is set.

From ba9a7613b8b51daec5e434f5c9713f2cf49fe2a2 Mon Sep 17 00:00:00 2001
From: kokobd <contact@zelinf.net>
Date: Wed, 3 Aug 2022 21:32:28 +0800
Subject: [PATCH 05/18] fix more tests in ghcide

---
 ghcide/ghcide.cabal                      | 1 -
 ghcide/src/Development/IDE/Core/Shake.hs | 3 ++-
 ghcide/test/exe/Main.hs                  | 3 ++-
 3 files changed, 4 insertions(+), 3 deletions(-)

diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal
index 66b5666f1a..dfa6ae2ff0 100644
--- a/ghcide/ghcide.cabal
+++ b/ghcide/ghcide.cabal
@@ -422,7 +422,6 @@ test-suite ghcide-tests
         QuickCheck,
         quickcheck-instances,
         random,
-        rope-utf16-splay,
         regex-tdfa ^>= 1.3.1,
         safe,
         safe-exceptions,
diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs
index 8ac8de2f0a..3b83186140 100644
--- a/ghcide/src/Development/IDE/Core/Shake.hs
+++ b/ghcide/src/Development/IDE/Core/Shake.hs
@@ -706,7 +706,8 @@ shakeRestart recorder IdeState{..} vfs reason acts =
               backlog <- readTVarIO $ dirtyKeys shakeExtras
               queue <- atomicallyNamed "actionQueue - peek" $ peekInProgress $ actionQueue shakeExtras
 
-              log Debug $ LogBuildSessionRestart reason queue backlog stopTime res
+              -- this log is required by tests
+              log Info $ LogBuildSessionRestart reason queue backlog stopTime res
         )
         -- It is crucial to be masked here, otherwise we can get killed
         -- between spawning the new thread and updating shakeSession.
diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs
index 3b5356b723..d54e8468c2 100644
--- a/ghcide/test/exe/Main.hs
+++ b/ghcide/test/exe/Main.hs
@@ -6379,7 +6379,8 @@ clientSettingsTest = testGroup "client settings handling"
             void $ skipManyTill anyMessage $ message SClientRegisterCapability
             void $ createDoc "A.hs" "haskell" "module A where"
             waitForProgressDone
-            sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON ("" :: String)))
+            sendNotification SWorkspaceDidChangeConfiguration
+                (DidChangeConfigurationParams (toJSON (mempty :: A.Object)))
             skipManyTill anyMessage restartingBuildSession
 
     ]

From d8600d11e76625698a43afc94e27580e40ca80b6 Mon Sep 17 00:00:00 2001
From: kokobd <contact@zelinf.net>
Date: Thu, 4 Aug 2022 00:15:29 +0800
Subject: [PATCH 06/18] fix floskell test

---
 plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs b/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs
index 70fe309b66..e59e0e9e92 100644
--- a/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs
+++ b/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs
@@ -33,7 +33,7 @@ provider _ideState typ contents fp _ = liftIO $ do
     config <- findConfigOrDefault file
     let (range, selectedContents) = case typ of
           FormatText    -> (fullRange contents, contents)
-          FormatRange r -> (r, extractRange r contents)
+          FormatRange r -> (normalize r, extractRange r contents)
         result = reformat config (Just file) . TL.encodeUtf8 $ TL.fromStrict selectedContents
     case result of
       Left  err -> pure $ Left $ responseError $ T.pack $ "floskellCmd: " ++ err

From 1fd6658c770b3b254a7927ccf403c55512637dd6 Mon Sep 17 00:00:00 2001
From: kokobd <contact@zelinf.net>
Date: Thu, 4 Aug 2022 11:48:42 +0800
Subject: [PATCH 07/18] disable debug log in func-test

---
 test/utils/Test/Hls/Command.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/test/utils/Test/Hls/Command.hs b/test/utils/Test/Hls/Command.hs
index 90b1f62b7d..f042dcf991 100644
--- a/test/utils/Test/Hls/Command.hs
+++ b/test/utils/Test/Hls/Command.hs
@@ -23,7 +23,7 @@ hlsCommand :: String
 {-# NOINLINE hlsCommand #-}
 hlsCommand = unsafePerformIO $ do
   testExe <- fromMaybe "haskell-language-server" <$> lookupEnv "HLS_TEST_EXE"
-  pure $ testExe ++ " --lsp -d -j4"
+  pure $ testExe ++ " --lsp -j4"
 
 hlsCommandVomit :: String
 hlsCommandVomit = hlsCommand ++ " --vomit"

From 62815a12edcafb17e58bd598f4577cec3879b839 Mon Sep 17 00:00:00 2001
From: kokobd <contact@zelinf.net>
Date: Thu, 4 Aug 2022 12:34:23 +0800
Subject: [PATCH 08/18] disable debug log in lsp itself

---
 ghcide/src/Development/IDE/Core/Shake.hs         |  2 +-
 ghcide/src/Development/IDE/LSP/LanguageServer.hs | 11 +++++++++--
 ghcide/test/exe/Main.hs                          |  5 +----
 3 files changed, 11 insertions(+), 7 deletions(-)

diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs
index 3b83186140..d341838e0a 100644
--- a/ghcide/src/Development/IDE/Core/Shake.hs
+++ b/ghcide/src/Development/IDE/Core/Shake.hs
@@ -707,7 +707,7 @@ shakeRestart recorder IdeState{..} vfs reason acts =
               queue <- atomicallyNamed "actionQueue - peek" $ peekInProgress $ actionQueue shakeExtras
 
               -- this log is required by tests
-              log Info $ LogBuildSessionRestart reason queue backlog stopTime res
+              log Debug $ LogBuildSessionRestart reason queue backlog stopTime res
         )
         -- It is crucial to be masked here, otherwise we can get killed
         -- between spawning the new thread and updating shakeSession.
diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
index e5d94e0d41..e7065bb32f 100644
--- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs
+++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
@@ -34,6 +34,8 @@ import           UnliftIO.Concurrent
 import           UnliftIO.Directory
 import           UnliftIO.Exception
 
+import qualified Colog.Core                            as Colog
+import           Control.Monad.IO.Class
 import           Control.Monad.IO.Unlift               (MonadUnliftIO)
 import           Development.IDE.Core.IdeConfiguration
 import           Development.IDE.Core.Shake            hiding (Log, Priority)
@@ -108,10 +110,15 @@ runLanguageServer recorder options inH outH defaultConfig onConfigurationChange
             , LSP.options = modifyOptions options
             }
 
+    let lspCologAction :: MonadIO m2 => Colog.LogAction m2 (Colog.WithSeverity LspServerLog)
+        lspCologAction = toCologActionWithPrio $ cfilter
+            (\msg -> priority msg >= Info)
+            (cmapWithPrio LogLspServer recorder)
+
     void $ untilMVar clientMsgVar $
           void $ LSP.runServerWithHandles
-            (toCologActionWithPrio (cmapWithPrio LogLspServer recorder))
-            (toCologActionWithPrio (cmapWithPrio LogLspServer recorder))
+            lspCologAction
+            lspCologAction
             inH
             outH
             serverDefinition
diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs
index d54e8468c2..79e81776f2 100644
--- a/ghcide/test/exe/Main.hs
+++ b/ghcide/test/exe/Main.hs
@@ -6652,10 +6652,7 @@ runInDir'' lspCaps dir startExeIn startSessionIn extraOptions s = do
 
   shakeProfiling <- getEnv "SHAKE_PROFILING"
   let cmd = unwords $
-       -- With lsp-1.5, verbose logging is causing a lot of deeply nested JSON in ghcide-tests,
-       -- and finally results in OOM on a machine with 64GB RAM.
-       -- I can't find the root cause now.
-       [ghcideExe, "--lsp", "--test", "--verify-core-file", "-j2", "--cwd", startDir
+       [ghcideExe, "--lsp", "--test", "--verify-core-file", "--verbose", "-j2", "--cwd", startDir
        ] ++ ["--shake-profiling=" <> dir | Just dir <- [shakeProfiling]
        ] ++ extraOptions
   -- HIE calls getXgdDirectory which assumes that HOME is set.

From bb7c09ec0e91f93009c7902f92eaec1a59530d0d Mon Sep 17 00:00:00 2001
From: kokobd <contact@zelinf.net>
Date: Thu, 4 Aug 2022 12:34:27 +0800
Subject: [PATCH 09/18] Revert "disable debug log in func-test"

This reverts commit 1fd6658c770b3b254a7927ccf403c55512637dd6.
---
 test/utils/Test/Hls/Command.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/test/utils/Test/Hls/Command.hs b/test/utils/Test/Hls/Command.hs
index f042dcf991..90b1f62b7d 100644
--- a/test/utils/Test/Hls/Command.hs
+++ b/test/utils/Test/Hls/Command.hs
@@ -23,7 +23,7 @@ hlsCommand :: String
 {-# NOINLINE hlsCommand #-}
 hlsCommand = unsafePerformIO $ do
   testExe <- fromMaybe "haskell-language-server" <$> lookupEnv "HLS_TEST_EXE"
-  pure $ testExe ++ " --lsp -j4"
+  pure $ testExe ++ " --lsp -d -j4"
 
 hlsCommandVomit :: String
 hlsCommandVomit = hlsCommand ++ " --vomit"

From 56a00c9ca669947fe164e8094b0387d7aafc0dc3 Mon Sep 17 00:00:00 2001
From: kokobd <contact@zelinf.net>
Date: Thu, 4 Aug 2022 13:34:33 +0800
Subject: [PATCH 10/18] remove unused import

---
 ghcide/src/Development/IDE/LSP/LanguageServer.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
index e7065bb32f..98478e9937 100644
--- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs
+++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
@@ -35,7 +35,6 @@ import           UnliftIO.Directory
 import           UnliftIO.Exception
 
 import qualified Colog.Core                            as Colog
-import           Control.Monad.IO.Class
 import           Control.Monad.IO.Unlift               (MonadUnliftIO)
 import           Development.IDE.Core.IdeConfiguration
 import           Development.IDE.Core.Shake            hiding (Log, Priority)

From 15a23203cedbc71397a5b04bb89cb3e90d670824 Mon Sep 17 00:00:00 2001
From: kokobd <contact@zelinf.net>
Date: Mon, 8 Aug 2022 12:35:34 +0800
Subject: [PATCH 11/18] fix hls test utils

---
 ghcide/src/Development/IDE/Plugin/Test.hs |   1 -
 hls-test-utils/src/Test/Hls.hs            | 101 +++++++++++-----------
 hls-test-utils/src/Test/Hls/Util.hs       |  41 +++------
 3 files changed, 63 insertions(+), 80 deletions(-)

diff --git a/ghcide/src/Development/IDE/Plugin/Test.hs b/ghcide/src/Development/IDE/Plugin/Test.hs
index 9932e1dc3a..c6163ab105 100644
--- a/ghcide/src/Development/IDE/Plugin/Test.hs
+++ b/ghcide/src/Development/IDE/Plugin/Test.hs
@@ -27,7 +27,6 @@ import           Data.Text                            (Text, pack)
 import           Development.IDE.Core.OfInterest      (getFilesOfInterest)
 import           Development.IDE.Core.Rules
 import           Development.IDE.Core.RuleTypes
-import           Development.IDE.Core.Service
 import           Development.IDE.Core.Shake
 import           Development.IDE.GHC.Compat
 import           Development.IDE.Graph                (Action)
diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs
index c0af35b29a..768c67d384 100644
--- a/hls-test-utils/src/Test/Hls.hs
+++ b/hls-test-utils/src/Test/Hls.hs
@@ -189,57 +189,56 @@ runSessionWithServer' ::
   Session a ->
   IO a
 runSessionWithServer' plugins conf sconf caps root s = withLock lock $ keepCurrentDirectory $ do
-  (inR, inW) <- createPipe
-  (outR, outW) <- createPipe
-
-  docWithPriorityRecorder <- makeDefaultStderrRecorder Nothing Debug
-
-  logStdErr <- fromMaybe "0" <$> lookupEnv "LSP_TEST_LOG_STDERR"
-
-  let
-    docWithFilteredPriorityRecorder@Recorder{ logger_ } =
-      if logStdErr == "0" then mempty
-      else cfilter (\WithPriority{ priority } -> priority >= Debug) docWithPriorityRecorder
-
-    -- exists until old logging style is phased out
-    logger = Logger $ \p m -> logger_ (WithPriority p emptyCallStack (pretty m))
-
-    recorder = cmapWithPrio pretty docWithFilteredPriorityRecorder
-
-    arguments@Arguments{ argsHlsPlugins, argsIdeOptions, argsLogger } = defaultArguments (cmapWithPrio LogIDEMain recorder) logger
-
-    hlsPlugins =
-      plugins
-      ++ [Test.blockCommandDescriptor "block-command", Test.plugin]
-      ++ idePluginsToPluginDesc argsHlsPlugins
-    ideOptions = \config ghcSession ->
-      let defIdeOptions = argsIdeOptions config ghcSession
-      in defIdeOptions
-           { optTesting = IdeTesting True
-           , optCheckProject = pure False
-           }
-
-  server <-
-    async $
-      Ghcide.defaultMain
-        (cmapWithPrio LogIDEMain recorder)
-        arguments
-          { argsHandleIn = pure inR
-          , argsHandleOut = pure outW
-          , argsDefaultHlsConfig = conf
-          , argsLogger = argsLogger
-          , argsIdeOptions = ideOptions
-          , argsHlsPlugins = pluginDescToIdePlugins hlsPlugins }
-
-  x <- runSessionWithHandles inW outR sconf caps root s
-  hClose inW
-  timeout 3 (wait server) >>= \case
-    Just () -> pure ()
-    Nothing -> do
-      putStrLn "Server does not exit in 3s, canceling the async task..."
-      (t, _) <- duration $ cancel server
-      putStrLn $ "Finishing canceling (took " <> showDuration t <> "s)"
-  pure x
+    (inR, inW) <- createPipe
+    (outR, outW) <- createPipe
+
+    docWithPriorityRecorder <- makeDefaultStderrRecorder Nothing Debug
+
+    logStdErr <- fromMaybe "0" <$> lookupEnv "LSP_TEST_LOG_STDERR"
+
+    let
+        docWithFilteredPriorityRecorder@Recorder{ logger_ } =
+            if logStdErr == "0" then mempty
+            else cfilter (\WithPriority{ priority } -> priority >= Debug) docWithPriorityRecorder
+
+        -- exists until old logging style is phased out
+        logger = Logger $ \p m -> logger_ (WithPriority p emptyCallStack (pretty m))
+
+        recorder = cmapWithPrio pretty docWithFilteredPriorityRecorder
+
+        arguments@Arguments{ argsHlsPlugins, argsIdeOptions, argsLogger } = defaultArguments (cmapWithPrio LogIDEMain recorder) logger
+
+        hlsPlugins =
+            plugins
+            ++ [Test.blockCommandDescriptor "block-command", Test.plugin]
+            ++ idePluginsToPluginDesc argsHlsPlugins
+        ideOptions config ghcSession =
+            let defIdeOptions = argsIdeOptions config ghcSession
+            in defIdeOptions
+                    { optTesting = IdeTesting True
+                    , optCheckProject = pure False
+                    }
+
+    server <- async $
+        Ghcide.defaultMain (cmapWithPrio LogIDEMain recorder)
+            arguments
+                { argsHandleIn = pure inR
+                , argsHandleOut = pure outW
+                , argsDefaultHlsConfig = conf
+                , argsLogger = argsLogger
+                , argsIdeOptions = ideOptions
+                , argsHlsPlugins = pluginDescToIdePlugins hlsPlugins
+                }
+
+    x <- runSessionWithHandles inW outR sconf caps root s
+    hClose inW
+    timeout 3 (wait server) >>= \case
+        Just () -> pure ()
+        Nothing -> do
+            putStrLn "Server does not exit in 3s, canceling the async task..."
+            (t, _) <- duration $ cancel server
+            putStrLn $ "Finishing canceling (took " <> showDuration t <> "s)"
+    pure x
 
 -- | Wait for the next progress end step
 waitForProgressDone :: Session ()
diff --git a/hls-test-utils/src/Test/Hls/Util.hs b/hls-test-utils/src/Test/Hls/Util.hs
index 2496782712..93ceac93d3 100644
--- a/hls-test-utils/src/Test/Hls/Util.hs
+++ b/hls-test-utils/src/Test/Hls/Util.hs
@@ -55,6 +55,7 @@ import           Data.List.Extra                 (find)
 import qualified Data.Set                        as Set
 import qualified Data.Text                       as T
 import           Development.IDE                 (GhcVersion (..), ghcVersion)
+import           Development.IDE.Plugin.Test     (TestRequest (GetFilesOfInterest))
 import qualified Language.LSP.Test               as Test
 import           Language.LSP.Types              hiding (Reason (..))
 import qualified Language.LSP.Types.Capabilities as C
@@ -297,16 +298,7 @@ waitForDiagnosticsFrom doc = do
        else return diags
 
 waitForDiagnosticsFromSource :: TextDocumentIdentifier -> String -> Test.Session [Diagnostic]
-waitForDiagnosticsFromSource doc src = do
-    diagsNot <- skipManyTill Test.anyMessage (Test.message STextDocumentPublishDiagnostics)
-    let (List diags) = diagsNot ^. L.params . L.diagnostics
-    let res = filter matches diags
-    if doc ^. L.uri /= diagsNot ^. L.params . L.uri || null res
-       then waitForDiagnosticsFromSource doc src
-       else return res
-  where
-    matches :: Diagnostic -> Bool
-    matches d = d ^. L.source == Just (T.pack src)
+waitForDiagnosticsFromSource = waitForDiagnosticsFromSourceWithTimeout 5
 
 -- | wait for @timeout@ seconds and report an assertion failure
 -- if any diagnostic messages arrive in that period
@@ -322,38 +314,31 @@ expectNoMoreDiagnostics timeout doc src = do
 -- If timeout is 0 it will wait until the session timeout
 waitForDiagnosticsFromSourceWithTimeout :: Seconds -> TextDocumentIdentifier -> String -> Test.Session [Diagnostic]
 waitForDiagnosticsFromSourceWithTimeout timeout document source = do
-    when (timeout > 0) $ do
+    when (timeout > 0) $
         -- Give any further diagnostic messages time to arrive.
         liftIO $ sleep timeout
         -- Send a dummy message to provoke a response from the server.
         -- This guarantees that we have at least one message to
         -- process, so message won't block or timeout.
-        void $ Test.sendNotification (SCustomMethod "non-existent-method") A.Null
-    handleMessages
+    testId <- Test.sendRequest (SCustomMethod "test") (A.toJSON GetFilesOfInterest)
+    handleMessages testId
   where
     matches :: Diagnostic -> Bool
     matches d = d ^. L.source == Just (T.pack source)
 
-    handleMessages = handleDiagnostic <|> handleCustomMethodResponse <|> ignoreOthers
-    handleDiagnostic = do
+    handleMessages testId = handleDiagnostic testId <|> handleCustomMethodResponse testId <|> ignoreOthers testId
+    handleDiagnostic testId = do
         diagsNot <- Test.message STextDocumentPublishDiagnostics
         let fileUri = diagsNot ^. L.params . L.uri
             (List diags) = diagsNot ^. L.params . L.diagnostics
             res = filter matches diags
         if fileUri == document ^. L.uri && not (null res)
-            then return diags else handleMessages
-    handleCustomMethodResponse =
-        -- the CustomClientMethod triggers a RspCustomServer
-        -- handle that and then exit
-        void (Test.satisfyMaybe responseForNonExistentMethod) >> return []
-
-    responseForNonExistentMethod :: FromServerMessage -> Maybe FromServerMessage
-    responseForNonExistentMethod notif
-        | FromServerMess SWindowLogMessage logMsg <- notif,
-          "non-existent-method" `T.isInfixOf` (logMsg ^. L.params . L.message)  = Just notif
-        | otherwise = Nothing
-
-    ignoreOthers = void Test.anyMessage >> handleMessages
+            then return diags else handleMessages testId
+    handleCustomMethodResponse testId = do
+        _ <- Test.responseForId (SCustomMethod "test") testId
+        pure []
+
+    ignoreOthers testId = void Test.anyMessage >> handleMessages testId
 
 failIfSessionTimeout :: IO a -> IO a
 failIfSessionTimeout action = action `catch` errorHandler

From 51d13f2c5efd1291dedef1fb5f455622d3e81315 Mon Sep 17 00:00:00 2001
From: kokobd <contact@zelinf.net>
Date: Tue, 9 Aug 2022 19:29:26 +0800
Subject: [PATCH 12/18] upgrade lsp in nix

---
 flake.lock | 18 +++++++++---------
 flake.nix  |  6 +++---
 2 files changed, 12 insertions(+), 12 deletions(-)

diff --git a/flake.lock b/flake.lock
index 3823849eba..e01237f392 100644
--- a/flake.lock
+++ b/flake.lock
@@ -197,37 +197,37 @@
     "lsp": {
       "flake": false,
       "locked": {
-        "narHash": "sha256-OcyNHNRh9j5nbJ8SjaNAWIEKuixAJlA7+vTimFY0c2c=",
+        "narHash": "sha256-+rkFYvSAI1hyFxPkgWZReyM2P6irVDpGVUGK8mcfEJE=",
         "type": "tarball",
-        "url": "https://hackage.haskell.org/package/lsp-1.4.0.0/lsp-1.4.0.0.tar.gz"
+        "url": "https://hackage.haskell.org/package/lsp-1.5.0.0/lsp-1.5.0.0.tar.gz"
       },
       "original": {
         "type": "tarball",
-        "url": "https://hackage.haskell.org/package/lsp-1.4.0.0/lsp-1.4.0.0.tar.gz"
+        "url": "https://hackage.haskell.org/package/lsp-1.5.0.0/lsp-1.5.0.0.tar.gz"
       }
     },
     "lsp-test": {
       "flake": false,
       "locked": {
-        "narHash": "sha256-IOmbQH6tKdu9kAyirvLx6xFS2N+/tbs6vZn0mNGm3No=",
+        "narHash": "sha256-TXRy/VT94Cn0BPtiL65c7UqahyJZgUtBQQgESZacrdY=",
         "type": "tarball",
-        "url": "https://hackage.haskell.org/package/lsp-test-0.14.0.2/lsp-test-0.14.0.2.tar.gz"
+        "url": "https://hackage.haskell.org/package/lsp-test-0.14.0.3/lsp-test-0.14.0.3.tar.gz"
       },
       "original": {
         "type": "tarball",
-        "url": "https://hackage.haskell.org/package/lsp-test-0.14.0.2/lsp-test-0.14.0.2.tar.gz"
+        "url": "https://hackage.haskell.org/package/lsp-test-0.14.0.3/lsp-test-0.14.0.3.tar.gz"
       }
     },
     "lsp-types": {
       "flake": false,
       "locked": {
-        "narHash": "sha256-HGg4upgirM6/px+vflY5S0Y79gAIDpl32Ad9mbbzTdU=",
+        "narHash": "sha256-q4XTvIvsLvISjgedpRktJbWsWHSRIQbOx2Z/2u+3s50=",
         "type": "tarball",
-        "url": "https://hackage.haskell.org/package/lsp-types-1.4.0.1/lsp-types-1.4.0.1.tar.gz"
+        "url": "https://hackage.haskell.org/package/lsp-types-1.5.0.0/lsp-types-1.5.0.0.tar.gz"
       },
       "original": {
         "type": "tarball",
-        "url": "https://hackage.haskell.org/package/lsp-types-1.4.0.1/lsp-types-1.4.0.1.tar.gz"
+        "url": "https://hackage.haskell.org/package/lsp-types-1.5.0.0/lsp-types-1.5.0.0.tar.gz"
       }
     },
     "myst-parser": {
diff --git a/flake.nix b/flake.nix
index df92770614..738bcde4da 100644
--- a/flake.nix
+++ b/flake.nix
@@ -21,15 +21,15 @@
 
     # List of hackage dependencies
     lsp = {
-      url = "https://hackage.haskell.org/package/lsp-1.4.0.0/lsp-1.4.0.0.tar.gz";
+      url = "https://hackage.haskell.org/package/lsp-1.5.0.0/lsp-1.5.0.0.tar.gz";
       flake = false;
     };
     lsp-types = {
-      url = "https://hackage.haskell.org/package/lsp-types-1.4.0.1/lsp-types-1.4.0.1.tar.gz";
+      url = "https://hackage.haskell.org/package/lsp-types-1.5.0.0/lsp-types-1.5.0.0.tar.gz";
       flake = false;
     };
     lsp-test = {
-      url = "https://hackage.haskell.org/package/lsp-test-0.14.0.2/lsp-test-0.14.0.2.tar.gz";
+      url = "https://hackage.haskell.org/package/lsp-test-0.14.0.3/lsp-test-0.14.0.3.tar.gz";
       flake = false;
     };
     ghc-exactprint-150 = {

From 2ecd76d0bafc25df12ac818f1c72b0f56a79c9df Mon Sep 17 00:00:00 2001
From: kokobd <contact@zelinf.net>
Date: Tue, 9 Aug 2022 19:29:35 +0800
Subject: [PATCH 13/18] fix func-tests

---
 test/functional/Diagnostic.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/test/functional/Diagnostic.hs b/test/functional/Diagnostic.hs
index bf2aab31cd..c1a961ab36 100644
--- a/test/functional/Diagnostic.hs
+++ b/test/functional/Diagnostic.hs
@@ -23,7 +23,7 @@ basicTests = testGroup "Diagnostics work" [
             diags <- waitForDiagnosticsFromSource doc "example2"
             reduceDiag <- liftIO $ inspectDiagnostic diags ["example2 diagnostic, hello world"]
             liftIO $ do
-                length diags @?= 1
+                length diags @?= 2
                 reduceDiag ^. LSP.range @?= Range (Position 0 0) (Position 1 0)
                 reduceDiag ^. LSP.severity @?= Just DsError
     ]

From ef84255dcc7d76770248f96f66c75a341d514415 Mon Sep 17 00:00:00 2001
From: kokobd <contact@zelinf.net>
Date: Tue, 9 Aug 2022 19:43:51 +0800
Subject: [PATCH 14/18] Revert "fix func-tests"

This reverts commit 2ecd76d0bafc25df12ac818f1c72b0f56a79c9df.
---
 test/functional/Diagnostic.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/test/functional/Diagnostic.hs b/test/functional/Diagnostic.hs
index c1a961ab36..bf2aab31cd 100644
--- a/test/functional/Diagnostic.hs
+++ b/test/functional/Diagnostic.hs
@@ -23,7 +23,7 @@ basicTests = testGroup "Diagnostics work" [
             diags <- waitForDiagnosticsFromSource doc "example2"
             reduceDiag <- liftIO $ inspectDiagnostic diags ["example2 diagnostic, hello world"]
             liftIO $ do
-                length diags @?= 2
+                length diags @?= 1
                 reduceDiag ^. LSP.range @?= Range (Position 0 0) (Position 1 0)
                 reduceDiag ^. LSP.severity @?= Just DsError
     ]

From c89ccfd7da0b64061d7987c245552d6f42bbafba Mon Sep 17 00:00:00 2001
From: kokobd <contact@zelinf.net>
Date: Tue, 9 Aug 2022 19:47:24 +0800
Subject: [PATCH 15/18] fix waitForDiagnosticsFromSourceWithTimeout

---
 hls-test-utils/src/Test/Hls/Util.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/hls-test-utils/src/Test/Hls/Util.hs b/hls-test-utils/src/Test/Hls/Util.hs
index 93ceac93d3..e906156192 100644
--- a/hls-test-utils/src/Test/Hls/Util.hs
+++ b/hls-test-utils/src/Test/Hls/Util.hs
@@ -333,7 +333,7 @@ waitForDiagnosticsFromSourceWithTimeout timeout document source = do
             (List diags) = diagsNot ^. L.params . L.diagnostics
             res = filter matches diags
         if fileUri == document ^. L.uri && not (null res)
-            then return diags else handleMessages testId
+            then return res else handleMessages testId
     handleCustomMethodResponse testId = do
         _ <- Test.responseForId (SCustomMethod "test") testId
         pure []

From bf25f0113df3cbba409f95c6cfc990d63d0d7e13 Mon Sep 17 00:00:00 2001
From: kokobd <contact@zelinf.net>
Date: Wed, 10 Aug 2022 17:02:31 +0800
Subject: [PATCH 16/18] use Null as dummy message in
 waitForDiagnosticsFromSourceWithTimeout

---
 hls-test-utils/src/Test/Hls/Util.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/hls-test-utils/src/Test/Hls/Util.hs b/hls-test-utils/src/Test/Hls/Util.hs
index e906156192..322a2bf867 100644
--- a/hls-test-utils/src/Test/Hls/Util.hs
+++ b/hls-test-utils/src/Test/Hls/Util.hs
@@ -55,7 +55,6 @@ import           Data.List.Extra                 (find)
 import qualified Data.Set                        as Set
 import qualified Data.Text                       as T
 import           Development.IDE                 (GhcVersion (..), ghcVersion)
-import           Development.IDE.Plugin.Test     (TestRequest (GetFilesOfInterest))
 import qualified Language.LSP.Test               as Test
 import           Language.LSP.Types              hiding (Reason (..))
 import qualified Language.LSP.Types.Capabilities as C
@@ -320,7 +319,7 @@ waitForDiagnosticsFromSourceWithTimeout timeout document source = do
         -- Send a dummy message to provoke a response from the server.
         -- This guarantees that we have at least one message to
         -- process, so message won't block or timeout.
-    testId <- Test.sendRequest (SCustomMethod "test") (A.toJSON GetFilesOfInterest)
+    testId <- Test.sendRequest (SCustomMethod "test") A.Null
     handleMessages testId
   where
     matches :: Diagnostic -> Bool

From 7f9755797105e78f445b2e99b91af9f97b0fe994 Mon Sep 17 00:00:00 2001
From: kokobd <contact@zelinf.net>
Date: Fri, 12 Aug 2022 08:02:52 +0800
Subject: [PATCH 17/18] simplify a test case

---
 ghcide/test/exe/Main.hs | 24 ++++++++++++------------
 1 file changed, 12 insertions(+), 12 deletions(-)

diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs
index 79e81776f2..c4a4b082a7 100644
--- a/ghcide/test/exe/Main.hs
+++ b/ghcide/test/exe/Main.hs
@@ -98,6 +98,7 @@ import           Control.Concurrent.Async
 import           Control.Lens                             (to, (.~), (^.))
 import           Control.Monad.Extra                      (whenJust)
 import           Data.Function                            ((&))
+import           Data.Functor.Identity                    (runIdentity)
 import           Data.IORef
 import           Data.IORef.Extra                         (atomicModifyIORef_)
 import           Data.String                              (IsString (fromString))
@@ -129,8 +130,8 @@ import           Language.LSP.Types.Lens                  (didChangeWatchedFiles
 import qualified Language.LSP.Types.Lens                  as L
 import qualified Progress
 import           System.Time.Extra
+import qualified Test.QuickCheck.Monadic                  as MonadicQuickCheck
 import           Test.QuickCheck.Monadic                  (forAllM, monadicIO)
-import qualified Test.QuickCheck.Monadic as MonadicQuickCheck
 import           Test.Tasty
 import           Test.Tasty.ExpectedFailure
 import           Test.Tasty.HUnit
@@ -6990,20 +6991,19 @@ positionMappingTests recorder =
                     \(range, replacement, oldPos, newPos) ->
                     fromCurrent range replacement newPos === PositionExact oldPos
               , testProperty "toCurrent r t <=< fromCurrent r t" $ do
-                let gen :: Gen (Rope, Range, T.Text)
-                    gen = do
+                let gen = do
                         rope <- genRope
                         range <- genRange rope
                         PrintableText replacement <- arbitrary
-                        pure (rope, range, replacement)
-                monadicIO $ forAllM gen
-                    $ \(rope, range, replacement) -> do
-                        newRope <- liftIO $ applyChange (toCologActionWithPrio $ cmapWithPrio LogVfs recorder) rope (TextDocumentContentChangeEvent (Just range) Nothing replacement)
-                        newPos <- MonadicQuickCheck.pick $ genPosition newRope
-                        case positionResultToMaybe $ (range, replacement, newPos,) <$> fromCurrent range replacement newPos of
-                            Nothing -> MonadicQuickCheck.pre False
-                            Just (range, replacement, newPos, oldPos) ->
-                                MonadicQuickCheck.assert $ toCurrent range replacement oldPos == PositionExact newPos
+                        let newRope = runIdentity $ applyChange mempty rope
+                                (TextDocumentContentChangeEvent (Just range) Nothing replacement)
+                        newPos <- genPosition newRope
+                        pure (range, replacement, newPos)
+                forAll
+                    (suchThatMap gen
+                        (\(range, replacement, newPos) -> positionResultToMaybe $ (range, replacement, newPos,) <$> fromCurrent range replacement newPos)) $
+                    \(range, replacement, newPos, oldPos) ->
+                    toCurrent range replacement oldPos === PositionExact newPos
               ]
         ]
 

From f565fb2e04683e66e16e650a5f95807cd1106794 Mon Sep 17 00:00:00 2001
From: kokobd <contact@zelinf.net>
Date: Fri, 12 Aug 2022 08:08:03 +0800
Subject: [PATCH 18/18] add comment about lsp bad logs

---
 ghcide/src/Development/IDE/LSP/LanguageServer.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
index 98478e9937..4d717dd999 100644
--- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs
+++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
@@ -111,6 +111,7 @@ runLanguageServer recorder options inH outH defaultConfig onConfigurationChange
 
     let lspCologAction :: MonadIO m2 => Colog.LogAction m2 (Colog.WithSeverity LspServerLog)
         lspCologAction = toCologActionWithPrio $ cfilter
+            -- filter out bad logs in lsp, see: https://github.com/haskell/lsp/issues/447
             (\msg -> priority msg >= Info)
             (cmapWithPrio LogLspServer recorder)