Add window/progress reporting for typechecking

.gitmodules

@@ -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

hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs

@@ -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

hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs

@@ -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

src/Haskell/Ide/Engine/LSP/CodeActions.hs

@@ -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

src/Haskell/Ide/Engine/Plugin/GhcMod.hs

@@ -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

src/Haskell/Ide/Engine/Transport/LspStdio.hs

@@ -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

stack.yaml

@@ -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