mirror of
https://github.com/haskell/haskell-ide-engine.git
synced 2024-09-11 11:05:30 +03:00
Add window/progress reporting for typechecking
This commit is contained in:
parent
4889cc538a
commit
b1cb9ac752
4
.gitmodules
vendored
4
.gitmodules
vendored
@ -36,3 +36,7 @@
|
||||
path = submodules/floskell
|
||||
url = https://github.com/ennocramer/floskell
|
||||
# url = https://github.com/alanz/floskell
|
||||
|
||||
[submodule "submodules/haskell-lsp"]
|
||||
path = submodules/haskell-lsp
|
||||
url = https://github.com/alanz/haskell-lsp
|
||||
|
@ -260,7 +260,7 @@ fileInfo tfileName =
|
||||
|
||||
clientSupportsDocumentChanges :: IdeM Bool
|
||||
clientSupportsDocumentChanges = do
|
||||
ClientCapabilities mwCaps _ _ <- getClientCapabilities
|
||||
ClientCapabilities mwCaps _ _ _ <- getClientCapabilities
|
||||
let supports = do
|
||||
wCaps <- mwCaps
|
||||
WorkspaceEditClientCapabilities mDc <- _workspaceEdit wCaps
|
||||
|
@ -344,14 +344,15 @@ data IdeEnv = IdeEnv
|
||||
}
|
||||
|
||||
-- | The class of monads that support common IDE functions, namely IdeM/IdeGhcM/IdeDeferM
|
||||
class Monad m => MonadIde m where
|
||||
class MonadIO m => MonadIde m where
|
||||
getRootPath :: m (Maybe FilePath)
|
||||
getVirtualFile :: Uri -> m (Maybe VirtualFile)
|
||||
getConfig :: m Config
|
||||
getClientCapabilities :: m ClientCapabilities
|
||||
getPlugins :: m IdePlugins
|
||||
withIndefiniteProgress :: T.Text -> m a -> m a
|
||||
|
||||
instance MonadIde IdeM where
|
||||
instance MonadIO m => MonadIde (ReaderT IdeEnv m) where
|
||||
getRootPath = do
|
||||
mlf <- asks ideEnvLspFuncs
|
||||
case mlf of
|
||||
@ -378,12 +379,19 @@ instance MonadIde IdeM where
|
||||
|
||||
getPlugins = asks idePlugins
|
||||
|
||||
withIndefiniteProgress t f = do
|
||||
lf <- asks ideEnvLspFuncs
|
||||
withIndefiniteProgress' lf t f
|
||||
|
||||
instance MonadIde IdeGhcM where
|
||||
getRootPath = lift $ lift getRootPath
|
||||
getVirtualFile = lift . lift . getVirtualFile
|
||||
getConfig = lift $ lift getConfig
|
||||
getClientCapabilities = lift $ lift getClientCapabilities
|
||||
getPlugins = lift $ lift getPlugins
|
||||
withIndefiniteProgress t f = do
|
||||
lf <- lift $ lift $ asks ideEnvLspFuncs
|
||||
withIndefiniteProgress' lf t f
|
||||
|
||||
instance MonadIde IdeDeferM where
|
||||
getRootPath = lift getRootPath
|
||||
@ -391,6 +399,16 @@ instance MonadIde IdeDeferM where
|
||||
getConfig = lift getConfig
|
||||
getClientCapabilities = lift getClientCapabilities
|
||||
getPlugins = lift getPlugins
|
||||
withIndefiniteProgress t f = do
|
||||
lf <- lift $ asks ideEnvLspFuncs
|
||||
withIndefiniteProgress' lf t f
|
||||
|
||||
withIndefiniteProgress' :: MonadIO m => Maybe (Core.LspFuncs Config) -> T.Text -> m a -> m a
|
||||
withIndefiniteProgress' lspFuncs t f =
|
||||
let mWp = Core.withIndefiniteProgress <$> lspFuncs
|
||||
in case mWp of
|
||||
Nothing -> f
|
||||
Just wp -> wp t f
|
||||
|
||||
data IdeState = IdeState
|
||||
{ moduleCache :: GhcModuleCache
|
||||
|
@ -62,7 +62,7 @@ handleCodeActionReq tn req = do
|
||||
wrapCodeAction :: J.CodeAction -> R (Maybe J.CAResult)
|
||||
wrapCodeAction action = do
|
||||
|
||||
(C.ClientCapabilities _ textDocCaps _) <- asksLspFuncs Core.clientCapabilities
|
||||
(C.ClientCapabilities _ textDocCaps _ _) <- asksLspFuncs Core.clientCapabilities
|
||||
let literalSupport = textDocCaps >>= C._codeAction >>= C._codeActionLiteralSupport
|
||||
|
||||
case literalSupport of
|
||||
|
@ -20,6 +20,7 @@ import Data.Maybe
|
||||
import Data.Monoid ((<>))
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Text as T
|
||||
import System.FilePath
|
||||
import ErrUtils
|
||||
import Name
|
||||
import GHC.Generics
|
||||
@ -186,10 +187,12 @@ setTypecheckedModule uri =
|
||||
rfm <- GM.mkRevRedirMapFunc
|
||||
let
|
||||
ghcErrRes msg = ((Map.empty, [T.pack msg]),Nothing,Nothing)
|
||||
progTitle = "Typechecking " <> T.pack (takeFileName fp)
|
||||
debugm "setTypecheckedModule: before ghc-mod"
|
||||
((diags', errs), mtm, mpm) <- GM.gcatches
|
||||
(GM.getModulesGhc' (myWrapper rfm) fp)
|
||||
(errorHandlers ghcErrRes (return . ghcErrRes . show))
|
||||
-- TODO: Are there any hooks we can use to report back on the progress?
|
||||
((diags', errs), mtm, mpm) <- withIndefiniteProgress progTitle $ GM.gcatches
|
||||
(GM.getModulesGhc' (myWrapper rfm) fp)
|
||||
(errorHandlers ghcErrRes (return . ghcErrRes . show))
|
||||
debugm "setTypecheckedModule: after ghc-mod"
|
||||
|
||||
canonUri <- canonicalizeUri uri
|
||||
|
@ -757,7 +757,7 @@ reactor inp diagIn = do
|
||||
ReqDocumentSymbols req -> do
|
||||
liftIO $ U.logs $ "reactor:got Document symbol request:" ++ show req
|
||||
sps <- asks symbolProviders
|
||||
C.ClientCapabilities _ tdc _ <- asksLspFuncs Core.clientCapabilities
|
||||
C.ClientCapabilities _ tdc _ _ <- asksLspFuncs Core.clientCapabilities
|
||||
let uri = req ^. J.params . J.textDocument . J.uri
|
||||
supportsHierarchy = fromMaybe False $ tdc >>= C._documentSymbol >>= C._hierarchicalDocumentSymbolSupport
|
||||
convertSymbols :: [J.DocumentSymbol] -> J.DSResult
|
||||
|
@ -10,6 +10,8 @@ extra-deps:
|
||||
- ./submodules/floskell
|
||||
- ./submodules/ghc-mod
|
||||
- ./submodules/ghc-mod/core
|
||||
- ./submodules/haskell-lsp
|
||||
- ./submodules/haskell-lsp/haskell-lsp-types
|
||||
|
||||
- ansi-terminal-0.8.2
|
||||
- butcher-1.3.2.1
|
||||
@ -18,8 +20,8 @@ extra-deps:
|
||||
- deque-0.2.7
|
||||
- ghc-exactprint-0.5.8.2
|
||||
- haddock-api-2.22.0
|
||||
- haskell-lsp-0.9.0.0
|
||||
- haskell-lsp-types-0.9.0.0
|
||||
# - haskell-lsp-0.9.0.0
|
||||
# - haskell-lsp-types-0.9.0.0
|
||||
- haskell-src-exts-util-0.2.5
|
||||
- hlint-2.1.16
|
||||
- hsimport-0.8.8
|
||||
|
Loading…
Reference in New Issue
Block a user