diff --git a/haskell-ide-engine.cabal b/haskell-ide-engine.cabal index 7cfb385fd..994244d4a 100644 --- a/haskell-ide-engine.cabal +++ b/haskell-ide-engine.cabal @@ -70,8 +70,8 @@ library , gitrev >= 1.1 , haddock-api , haddock-library - , haskell-lsp == 0.14.* - , haskell-lsp-types == 0.14.* + , haskell-lsp == 0.15.* + , haskell-lsp-types == 0.15.* , haskell-src-exts , hie-plugin-api , hlint (>= 2.0.11 && < 2.1.18) || >= 2.1.22 @@ -192,7 +192,7 @@ test-suite unit-test , filepath , free , haskell-ide-engine - , haskell-lsp-types + , haskell-lsp-types >= 0.15.0.0 , hie-test-utils , hie-plugin-api , hoogle > 5.0.11 @@ -278,10 +278,10 @@ test-suite func-test , data-default , directory , filepath - , lsp-test >= 0.5.2 + , lsp-test >= 0.6.0.0 , haskell-ide-engine - , haskell-lsp-types == 0.14.* - , haskell-lsp == 0.14.* + , haskell-lsp-types == 0.15.* + , haskell-lsp == 0.15.* , hie-test-utils , hie-plugin-api , hspec diff --git a/hie-plugin-api/Haskell/Ide/Engine/Config.hs b/hie-plugin-api/Haskell/Ide/Engine/Config.hs index 9f625023c..36d76bb9e 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/Config.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/Config.hs @@ -8,14 +8,23 @@ import Language.Haskell.LSP.Types -- --------------------------------------------------------------------- --- | Callback from haskell-lsp core to convert the generic message to the --- specific one for hie +-- | Given a DidChangeConfigurationNotification message, this function returns the parsed +-- Config object if possible. getConfigFromNotification :: DidChangeConfigurationNotification -> Either T.Text Config getConfigFromNotification (NotificationMessage _ _ (DidChangeConfigurationParams p)) = case fromJSON p of Success c -> Right c Error err -> Left $ T.pack err +-- | Given an InitializeRequest message, this function returns the parsed +-- Config object if possible. Otherwise, it returns the default configuration +getInitialConfig :: InitializeRequest -> Either T.Text Config +getInitialConfig (RequestMessage _ _ _ InitializeParams{_initializationOptions = Nothing }) = Right def +getInitialConfig (RequestMessage _ _ _ InitializeParams{_initializationOptions = Just opts}) = + case fromJSON opts of + Success c -> Right c + Error err -> Left $ T.pack err + -- --------------------------------------------------------------------- data Config = diff --git a/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs b/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs index bfac52030..3f6813266 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs @@ -11,7 +11,7 @@ module Haskell.Ide.Engine.Ghc ( setTypecheckedModule - , Diagnostics + , Diagnostics(..) , AdditionalErrs , cabalModuleGraphs , makeRevRedirMapFunc @@ -21,9 +21,11 @@ import Bag import Control.Monad.IO.Class import Data.IORef import qualified Data.Map.Strict as Map -import Data.Monoid ((<>)) +import Data.Semigroup ((<>), Semigroup) import qualified Data.Set as Set import qualified Data.Text as T +import qualified Data.Aeson +import Data.Coerce import ErrUtils import qualified GhcModCore as GM ( withDynFlags @@ -45,10 +47,24 @@ import GHC import IOEnv as G import HscTypes import Outputable (renderWithStyle) +import Language.Haskell.LSP.Types ( NormalizedUri(..), toNormalizedUri ) -- --------------------------------------------------------------------- -type Diagnostics = Map.Map Uri (Set.Set Diagnostic) +newtype Diagnostics = Diagnostics (Map.Map NormalizedUri (Set.Set Diagnostic)) + deriving (Show, Eq) + +instance Semigroup Diagnostics where + Diagnostics d1 <> Diagnostics d2 = Diagnostics (d1 <> d2) + +instance Monoid Diagnostics where + mappend = (<>) + mempty = Diagnostics mempty + +instance Data.Aeson.ToJSON Diagnostics where + toJSON (Diagnostics d) = Data.Aeson.toJSON + (Map.mapKeys coerce d :: Map.Map T.Text (Set.Set Diagnostic)) + type AdditionalErrs = [T.Text] -- --------------------------------------------------------------------- @@ -68,10 +84,9 @@ logDiag rfm eref dref df _reason sev spn style msg = do let msgTxt = T.pack $ renderWithStyle df msg style case eloc of Right (Location uri range) -> do - let update = Map.insertWith Set.union uri l - where l = Set.singleton diag + let update = Map.insertWith Set.union (toNormalizedUri uri) (Set.singleton diag) diag = Diagnostic range (Just $ lspSev sev) Nothing (Just "ghcmod") msgTxt Nothing - modifyIORef' dref update + modifyIORef' dref (\(Diagnostics d) -> Diagnostics $ update d) Left _ -> do modifyIORef' eref (msgTxt:) return () @@ -109,9 +124,11 @@ srcErrToDiag df rfm se = do (m,es) <- processMsgs xs case res of Right (uri, diag) -> - return (Map.insertWith Set.union uri (Set.singleton diag) m, es) + return (Map.insertWith Set.union (toNormalizedUri uri) (Set.singleton diag) m, es) Left e -> return (m, e:es) - processMsgs errMsgs + + (diags, errs) <- processMsgs errMsgs + return (Diagnostics diags, errs) -- --------------------------------------------------------------------- @@ -121,11 +138,14 @@ myWrapper :: GM.IOish m -> GM.GmlT m (Diagnostics, AdditionalErrs) myWrapper rfm action = do env <- getSession - diagRef <- liftIO $ newIORef Map.empty + diagRef <- liftIO $ newIORef mempty errRef <- liftIO $ newIORef [] let setLogger df = df { log_action = logDiag rfm errRef diagRef } setDeferTypedHoles = setGeneralFlag' Opt_DeferTypedHoles - ghcErrRes msg = (Map.empty, [T.pack msg]) + + ghcErrRes :: String -> (Diagnostics, AdditionalErrs) + ghcErrRes msg = (mempty, [T.pack msg]) + handlers = errorHandlers ghcErrRes (srcErrToDiag (hsc_dflags env) rfm ) action' = do GM.withDynFlags (setLogger . setDeferTypedHoles) action @@ -167,7 +187,7 @@ setTypecheckedModule uri = debugm $ "setTypecheckedModule: file mapping state is: " ++ show fileMap rfm <- GM.mkRevRedirMapFunc let - ghcErrRes msg = ((Map.empty, [T.pack msg]),Nothing,Nothing) + ghcErrRes msg = ((Diagnostics Map.empty, [T.pack msg]),Nothing,Nothing) progTitle = "Typechecking " <> T.pack (takeFileName fp) debugm "setTypecheckedModule: before ghc-mod" -- TODO:AZ: loading this one module may/should trigger loads of any @@ -175,12 +195,12 @@ setTypecheckedModule uri = -- sure that their diagnostics are reported, and their module -- cache entries are updated. -- TODO: Are there any hooks we can use to report back on the progress? - ((diags', errs), mtm, mpm) <- withIndefiniteProgress progTitle NotCancellable $ GM.gcatches + ((Diagnostics diags', errs), mtm, mpm) <- withIndefiniteProgress progTitle NotCancellable $ GM.gcatches (GM.getModulesGhc' (myWrapper rfm) fp) (errorHandlers ghcErrRes (return . ghcErrRes . show)) debugm "setTypecheckedModule: after ghc-mod" - canonUri <- canonicalizeUri uri + canonUri <- toNormalizedUri <$> canonicalizeUri uri let diags = Map.insertWith Set.union canonUri Set.empty diags' diags2 <- case (mpm,mtm) of (Just pm, Nothing) -> do @@ -212,7 +232,7 @@ setTypecheckedModule uri = let d = Diagnostic range sev Nothing (Just "ghcmod") msgTxt Nothing return $ Map.insertWith Set.union canonUri (Set.singleton d) diags - return $ IdeResultOk (diags2,errs) + return $ IdeResultOk (Diagnostics diags2,errs) -- --------------------------------------------------------------------- diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs index 06bf7b7eb..aca5c45b9 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs @@ -155,6 +155,7 @@ import Language.Haskell.LSP.Types ( Command(..) , WorkspaceEdit(..) , filePathToUri , uriToFilePath + , toNormalizedUri ) import Language.Haskell.LSP.VFS ( VirtualFile(..) ) @@ -410,7 +411,7 @@ getVirtualFile :: (MonadIde m, MonadIO m) => Uri -> m (Maybe VirtualFile) getVirtualFile uri = do mlf <- ideEnvLspFuncs <$> getIdeEnv case mlf of - Just lf -> liftIO $ Core.getVirtualFileFunc lf uri + Just lf -> liftIO $ Core.getVirtualFileFunc lf (toNormalizedUri uri) Nothing -> return Nothing getConfig :: (MonadIde m, MonadIO m) => m Config diff --git a/hie-plugin-api/hie-plugin-api.cabal b/hie-plugin-api/hie-plugin-api.cabal index e09f4a525..201ac6f3e 100644 --- a/hie-plugin-api/hie-plugin-api.cabal +++ b/hie-plugin-api/hie-plugin-api.cabal @@ -45,7 +45,7 @@ library , ghc , ghc-mod-core >= 5.9.0.0 , ghc-project-types >= 5.9.0.0 - , haskell-lsp == 0.14.* + , haskell-lsp == 0.15.* , hslogger , monad-control , mtl diff --git a/src/Haskell/Ide/Engine/LSP/CodeActions.hs b/src/Haskell/Ide/Engine/LSP/CodeActions.hs index f74efebf9..7eff8ede7 100644 --- a/src/Haskell/Ide/Engine/LSP/CodeActions.hs +++ b/src/Haskell/Ide/Engine/LSP/CodeActions.hs @@ -32,7 +32,7 @@ handleCodeActionReq :: TrackingNumber -> J.CodeActionRequest -> R () handleCodeActionReq tn req = do vfsFunc <- asksLspFuncs Core.getVirtualFileFunc - docVersion <- fmap _version <$> liftIO (vfsFunc docUri) + docVersion <- fmap _version <$> liftIO (vfsFunc (J.toNormalizedUri docUri)) let docId = J.VersionedTextDocumentIdentifier docUri docVersion let getProvider p = pluginCodeActionProvider p <*> return (pluginId p) diff --git a/src/Haskell/Ide/Engine/Transport/LspStdio.hs b/src/Haskell/Ide/Engine/Transport/LspStdio.hs index a993c7a3c..59272dc42 100644 --- a/src/Haskell/Ide/Engine/Transport/LspStdio.hs +++ b/src/Haskell/Ide/Engine/Transport/LspStdio.hs @@ -93,7 +93,7 @@ data DiagnosticsRequest = DiagnosticsRequest , trackingNumber :: TrackingNumber -- ^ The tracking identifier for this request - , file :: J.Uri + , file :: Uri -- ^ The file that was change and needs to be checked , documentVersion :: J.TextDocumentVersion @@ -118,7 +118,7 @@ run scheduler _origDir plugins captureFp = flip E.catches handlers $ do rin <- atomically newTChan :: IO (TChan ReactorInput) commandIds <- allLspCmdIds plugins - let dp lf = do + let onStartup lf = do diagIn <- atomically newTChan let react = runReactor lf scheduler diagnosticProviders hps sps fps plugins reactorFunc = react $ reactor rin diagIn @@ -175,8 +175,11 @@ run scheduler _origDir plugins captureFp = flip E.catches handlers $ do fps :: Map.Map PluginId FormattingProvider fps = Map.mapMaybe pluginFormattingProvider $ ipMap plugins + initCallbacks :: Core.InitializeCallbacks Config + initCallbacks = Core.InitializeCallbacks getInitialConfig getConfigFromNotification onStartup + flip E.finally finalProc $ do - CTRL.run (getConfigFromNotification, dp) (hieHandlers rin) (hieOptions commandIds) captureFp + CTRL.run initCallbacks (hieHandlers rin) (hieOptions commandIds) captureFp where handlers = [E.Handler ioExcept, E.Handler someExcept] finalProc = L.removeAllHandlers @@ -199,7 +202,7 @@ configVal field = field <$> getClientConfig getPrefixAtPos :: (MonadIO m, MonadReader REnv m) => Uri -> Position -> m (Maybe Hie.PosPrefixInfo) getPrefixAtPos uri pos = do - mvf <- liftIO =<< asksLspFuncs Core.getVirtualFileFunc <*> pure uri + mvf <- liftIO =<< asksLspFuncs Core.getVirtualFileFunc <*> pure (J.toNormalizedUri uri) case mvf of Just vf -> VFS.getCompletionPrefix pos vf Nothing -> return Nothing @@ -214,7 +217,7 @@ mapFileFromVfs tn vtdi = do let uri = vtdi ^. J.uri ver = fromMaybe 0 (vtdi ^. J.version) vfsFunc <- asksLspFuncs Core.getVirtualFileFunc - mvf <- liftIO $ vfsFunc uri + mvf <- liftIO $ vfsFunc (J.toNormalizedUri uri) case (mvf, uriToFilePath uri) of (Just (VFS.VirtualFile _ yitext _), Just fp) -> do let text' = Rope.toString yitext @@ -308,7 +311,7 @@ updatePositionMap uri changes = pluginGetFile "updatePositionMap: " uri $ \file -- --------------------------------------------------------------------- publishDiagnostics :: (MonadIO m, MonadReader REnv m) - => Int -> J.Uri -> J.TextDocumentVersion -> DiagnosticsBySource -> m () + => Int -> J.NormalizedUri -> J.TextDocumentVersion -> DiagnosticsBySource -> m () publishDiagnostics maxToSend uri' mv diags = do lf <- asks lspFuncs liftIO $ Core.publishDiagnosticsFunc lf maxToSend uri' mv diags @@ -797,7 +800,7 @@ reactor inp diagIn = do withDocumentContents :: J.LspId -> J.Uri -> (T.Text -> R ()) -> R () withDocumentContents reqId uri f = do vfsFunc <- asksLspFuncs Core.getVirtualFileFunc - mvf <- liftIO $ vfsFunc uri + mvf <- liftIO $ vfsFunc (J.toNormalizedUri uri) lf <- asks lspFuncs case mvf of Nothing -> liftIO $ @@ -838,7 +841,7 @@ queueDiagnosticsRequest :: TChan DiagnosticsRequest -- ^ The channel to publish the diagnostics requests to -> DiagnosticTrigger -> TrackingNumber - -> J.Uri + -> Uri -> J.TextDocumentVersion -> R () queueDiagnosticsRequest diagIn dt tn uri mVer = @@ -869,11 +872,11 @@ requestDiagnostics DiagnosticsRequest{trigger, file, trackingNumber, documentVer maxToSend = maxNumberOfProblems clientConfig sendOne (fileUri,ds') = do debugm $ "LspStdio.sendone:(fileUri,ds')=" ++ show(fileUri,ds') - publishDiagnosticsIO maxToSend fileUri Nothing (Map.fromList [(Just pid,SL.toSortedList ds')]) + publishDiagnosticsIO maxToSend (J.toNormalizedUri fileUri) Nothing (Map.fromList [(Just pid,SL.toSortedList ds')]) sendEmpty = do debugm "LspStdio.sendempty" - publishDiagnosticsIO maxToSend file Nothing (Map.fromList [(Just pid,SL.toSortedList [])]) + publishDiagnosticsIO maxToSend (J.toNormalizedUri file) Nothing (Map.fromList [(Just pid,SL.toSortedList [])]) -- fv = case documentVersion of -- Nothing -> Nothing @@ -901,7 +904,7 @@ requestDiagnostics DiagnosticsRequest{trigger, file, trackingNumber, documentVer when enabled $ makeRequest reql -- | get hlint and GHC diagnostics and loads the typechecked module into the cache -requestDiagnosticsNormal :: TrackingNumber -> J.Uri -> J.TextDocumentVersion -> R () +requestDiagnosticsNormal :: TrackingNumber -> Uri -> J.TextDocumentVersion -> R () requestDiagnosticsNormal tn file mVer = do clientConfig <- getClientConfig let @@ -909,18 +912,20 @@ requestDiagnosticsNormal tn file mVer = do -- | If there is a GHC error, flush the hlint diagnostics -- TODO: Just flush the parse error diagnostics - sendOneGhc :: J.DiagnosticSource -> (Uri, [Diagnostic]) -> R () + sendOneGhc :: J.DiagnosticSource -> (J.NormalizedUri, [Diagnostic]) -> R () sendOneGhc pid (fileUri,ds) = do if any (hasSeverity J.DsError) ds then publishDiagnostics maxToSend fileUri Nothing (Map.fromList [(Just "hlint",SL.toSortedList []),(Just pid,SL.toSortedList ds)]) else sendOne pid (fileUri,ds) + sendOne pid (fileUri,ds) = do publishDiagnostics maxToSend fileUri Nothing (Map.fromList [(Just pid,SL.toSortedList ds)]) + hasSeverity :: J.DiagnosticSeverity -> J.Diagnostic -> Bool hasSeverity sev (J.Diagnostic _ (Just s) _ _ _ _) = s == sev hasSeverity _ _ = False - sendEmpty = publishDiagnostics maxToSend file Nothing (Map.fromList [(Just "ghcmod",SL.toSortedList [])]) + sendEmpty = publishDiagnostics maxToSend (J.toNormalizedUri file) Nothing (Map.fromList [(Just "ghcmod",SL.toSortedList [])]) maxToSend = maxNumberOfProblems clientConfig let sendHlint = hlintOn clientConfig @@ -929,13 +934,13 @@ requestDiagnosticsNormal tn file mVer = do let reql = GReq tn (Just file) (Just (file,ver)) Nothing callbackl $ ApplyRefact.lintCmd' file callbackl (PublishDiagnosticsParams fp (List ds)) - = sendOne "hlint" (fp, ds) + = sendOne "hlint" (J.toNormalizedUri fp, ds) makeRequest reql -- get GHC diagnostics and loads the typechecked module into the cache let reqg = GReq tn (Just file) (Just (file,ver)) Nothing callbackg $ HIE.setTypecheckedModule file - callbackg (pd, errs) = do + callbackg (HIE.Diagnostics pd, errs) = do forM_ errs $ \e -> do reactorSend $ NotShowMessage $ fmServerShowMessageNotification J.MtError diff --git a/stack-8.2.2.yaml b/stack-8.2.2.yaml index 65b0415e0..8dffe2c8c 100644 --- a/stack-8.2.2.yaml +++ b/stack-8.2.2.yaml @@ -20,14 +20,14 @@ extra-deps: - ghc-exactprint-0.5.8.2 - haddock-api-2.18.1 - haddock-library-1.4.4 -- haskell-lsp-0.14.0.0 -- haskell-lsp-types-0.14.0.1 +- haskell-lsp-0.15.0.0 +- haskell-lsp-types-0.15.0.0 - haskell-src-exts-1.21.0 - haskell-src-exts-util-0.2.5 - hlint-2.1.17 # last hlint supporting GHC 8.2 - hoogle-5.0.17.9 - hsimport-0.8.8 -- lsp-test-0.5.4.0 +- lsp-test-0.6.0.0 - monad-dijkstra-0.1.1.2 - pretty-show-1.8.2 - rope-utf16-splay-0.3.1.0 diff --git a/stack-8.4.2.yaml b/stack-8.4.2.yaml index ec92a9c33..d13e63942 100644 --- a/stack-8.4.2.yaml +++ b/stack-8.4.2.yaml @@ -19,14 +19,14 @@ extra-deps: - ghc-lib-parser-8.8.0.20190424 - haddock-api-2.20.0 - haddock-library-1.6.0 -- haskell-lsp-0.14.0.0 -- haskell-lsp-types-0.14.0.1 +- haskell-lsp-0.15.0.0 +- haskell-lsp-types-0.15.0.0 - haskell-src-exts-1.21.0 - haskell-src-exts-util-0.2.5 - hlint-2.1.24 - hoogle-5.0.17.9 - hsimport-0.10.0 -- lsp-test-0.5.4.0 +- lsp-test-0.6.0.0 - monad-dijkstra-0.1.1.2 - pretty-show-1.8.2 - rope-utf16-splay-0.3.1.0 diff --git a/stack-8.4.3.yaml b/stack-8.4.3.yaml index f8d756903..7c78982de 100644 --- a/stack-8.4.3.yaml +++ b/stack-8.4.3.yaml @@ -19,14 +19,14 @@ extra-deps: - ghc-lib-parser-8.8.0.20190424 - haddock-api-2.20.0 - haddock-library-1.6.0 -- haskell-lsp-0.14.0.0 -- haskell-lsp-types-0.14.0.1 +- haskell-lsp-0.15.0.0 +- haskell-lsp-types-0.15.0.0 - haskell-src-exts-1.21.0 - haskell-src-exts-util-0.2.5 - hlint-2.1.24 - hoogle-5.0.17.9 - hsimport-0.10.0 -- lsp-test-0.5.4.0 +- lsp-test-0.6.0.0 - monad-dijkstra-0.1.1.2 - pretty-show-1.8.2 - rope-utf16-splay-0.3.1.0 diff --git a/stack-8.4.4.yaml b/stack-8.4.4.yaml index 30200043a..09edacf36 100644 --- a/stack-8.4.4.yaml +++ b/stack-8.4.4.yaml @@ -18,14 +18,14 @@ extra-deps: - ghc-lib-parser-8.8.0.20190424 - haddock-api-2.20.0 - haddock-library-1.6.0 -- haskell-lsp-0.14.0.0 -- haskell-lsp-types-0.14.0.1 +- haskell-lsp-0.15.0.0 +- haskell-lsp-types-0.15.0.0 - haskell-src-exts-1.21.0 - haskell-src-exts-util-0.2.5 - hlint-2.1.24 - hoogle-5.0.17.9 - hsimport-0.10.0 -- lsp-test-0.5.4.0 +- lsp-test-0.6.0.0 - monad-dijkstra-0.1.1.2 - optparse-simple-0.1.0 - pretty-show-1.9.5 diff --git a/stack-8.6.1.yaml b/stack-8.6.1.yaml index 1479408ec..510ed9c4e 100644 --- a/stack-8.6.1.yaml +++ b/stack-8.6.1.yaml @@ -21,14 +21,14 @@ extra-deps: - floskell-0.10.0 - ghc-lib-parser-8.8.0.20190424 - haddock-api-2.21.0 -- haskell-lsp-0.14.0.0 -- haskell-lsp-types-0.14.0.1 +- haskell-lsp-0.15.0.0 +- haskell-lsp-types-0.15.0.0 - haskell-src-exts-1.21.0 - haskell-src-exts-util-0.2.5 - hlint-2.1.24 - hoogle-5.0.17.9 - hsimport-0.10.0 -- lsp-test-0.5.4.0 +- lsp-test-0.6.0.0 - monad-dijkstra-0.1.1.2 - monad-memo-0.4.1 - monoid-subclasses-0.4.6.1 diff --git a/stack-8.6.2.yaml b/stack-8.6.2.yaml index 2fc6e881f..2a4983b51 100644 --- a/stack-8.6.2.yaml +++ b/stack-8.6.2.yaml @@ -17,14 +17,14 @@ extra-deps: - floskell-0.10.0 - ghc-lib-parser-8.8.0.20190424 - haddock-api-2.21.0 -- haskell-lsp-0.14.0.0 -- haskell-lsp-types-0.14.0.1 +- haskell-lsp-0.15.0.0 +- haskell-lsp-types-0.15.0.0 - haskell-src-exts-1.21.0 - haskell-src-exts-util-0.2.5 - hlint-2.1.24 - hoogle-5.0.17.9 - hsimport-0.10.0 -- lsp-test-0.5.4.0 +- lsp-test-0.6.0.0 - monad-dijkstra-0.1.1.2 - monad-memo-0.4.1 - multistate-0.8.0.1 diff --git a/stack-8.6.3.yaml b/stack-8.6.3.yaml index 14059e83b..792bb8870 100644 --- a/stack-8.6.3.yaml +++ b/stack-8.6.3.yaml @@ -17,14 +17,14 @@ extra-deps: - floskell-0.10.0 - ghc-lib-parser-8.8.0.20190424 - haddock-api-2.21.0 -- haskell-lsp-0.14.0.0 -- haskell-lsp-types-0.14.0.1 +- haskell-lsp-0.15.0.0 +- haskell-lsp-types-0.15.0.0 - haskell-src-exts-1.21.0 - haskell-src-exts-util-0.2.5 - hlint-2.1.24 - hoogle-5.0.17.9 - hsimport-0.10.0 -- lsp-test-0.5.4.0 +- lsp-test-0.6.0.0 - monad-dijkstra-0.1.1.2 - monad-memo-0.4.1 - multistate-0.8.0.1 diff --git a/stack-8.6.4.yaml b/stack-8.6.4.yaml index 5df504e5c..521e175f1 100644 --- a/stack-8.6.4.yaml +++ b/stack-8.6.4.yaml @@ -17,13 +17,13 @@ extra-deps: - floskell-0.10.0 - ghc-lib-parser-8.8.0.20190424 - haddock-api-2.22.0 -- haskell-lsp-0.14.0.0 -- haskell-lsp-types-0.14.0.1 +- haskell-lsp-0.15.0.0 +- haskell-lsp-types-0.15.0.0 - haskell-src-exts-1.21.0 - hlint-2.1.24 - hoogle-5.0.17.9 - hsimport-0.10.0 -- lsp-test-0.5.4.0 +- lsp-test-0.6.0.0 - monad-dijkstra-0.1.1.2@rev:1 - monad-memo-0.4.1 - multistate-0.8.0.1 diff --git a/stack-8.6.5.yaml b/stack-8.6.5.yaml index e24840307..7afeba6f5 100644 --- a/stack-8.6.5.yaml +++ b/stack-8.6.5.yaml @@ -1,4 +1,4 @@ -resolver: lts-13.23 # First GHC 8.6.5 +resolver: lts-13.27 packages: - . - hie-plugin-api @@ -17,13 +17,13 @@ extra-deps: - floskell-0.10.0 - ghc-lib-parser-8.8.0.20190424 - haddock-api-2.22.0 -- haskell-lsp-0.14.0.0 -- haskell-lsp-types-0.14.0.1 +- haskell-lsp-0.15.0.0 +- haskell-lsp-types-0.15.0.0 - haskell-src-exts-1.21.0 - hlint-2.1.24 - hsimport-0.10.0 - hoogle-5.0.17.9 -- lsp-test-0.5.4.0 +- lsp-test-0.6.0.0 - monad-dijkstra-0.1.1.2@rev:1 - monad-memo-0.4.1 - multistate-0.8.0.1 diff --git a/stack.yaml b/stack.yaml index 82b19111e..7250d5a31 100644 --- a/stack.yaml +++ b/stack.yaml @@ -21,11 +21,11 @@ extra-deps: - ghc-exactprint-0.5.8.2 - ghc-lib-parser-8.8.0.20190424 - haddock-api-2.22.0 -- haskell-lsp-0.14.0.0 -- haskell-lsp-types-0.14.0.1 +- haskell-lsp-0.15.0.0 +- haskell-lsp-types-0.15.0.0 - hlint-2.1.24 - hsimport-0.10.0 -- lsp-test-0.5.4.0 +- lsp-test-0.6.0.0 - monad-dijkstra-0.1.1.2@rev:1 - monad-memo-0.4.1 - multistate-0.8.0.1 diff --git a/test/dispatcher/Main.hs b/test/dispatcher/Main.hs index 4d8113363..dacd786f4 100644 --- a/test/dispatcher/Main.hs +++ b/test/dispatcher/Main.hs @@ -173,7 +173,7 @@ funcSpec = describe "functional dispatch" $ do -- followed by the diagnostics ... ("req2",Right res2) <- atomically $ readTChan logChan - show res2 `shouldBe` "((Map Uri (Set Diagnostic)),[Text])" + show res2 `shouldBe` "(Diagnostics,[Text])" -- No more pending results rr3 <- atomically $ tryReadTChan logChan @@ -280,7 +280,7 @@ funcSpec = describe "functional dispatch" $ do unpackRes hr7 `shouldBe` ("req7", Just ([] :: [Location])) ("req8", Right diags) <- atomically $ readTChan logChan - show diags `shouldBe` "((Map Uri (Set Diagnostic)),[Text])" + show diags `shouldBe` "(Diagnostics,[Text])" killThread dispatcher diff --git a/test/unit/GhcModPluginSpec.hs b/test/unit/GhcModPluginSpec.hs index 6a87d0e25..fcaa75ecd 100644 --- a/test/unit/GhcModPluginSpec.hs +++ b/test/unit/GhcModPluginSpec.hs @@ -15,7 +15,7 @@ import Haskell.Ide.Engine.MonadTypes import Haskell.Ide.Engine.Plugin.GhcMod import Haskell.Ide.Engine.PluginUtils import Haskell.Ide.Engine.Support.HieExtras -import Language.Haskell.LSP.Types (TextEdit (..)) +import Language.Haskell.LSP.Types (TextEdit (..), toNormalizedUri) import System.Directory import TestUtils @@ -51,7 +51,7 @@ ghcmodSpec = ss -> fail $ "got:" ++ show ss let res = IdeResultOk $ - (Map.singleton arg (S.singleton diag), env) + (Diagnostics (Map.singleton (toNormalizedUri arg) (S.singleton diag)), env) diag = Diagnostic (Range (toPos (4,7)) (toPos (4,8))) (Just DsError)