Merge pull request #74 from fwcd/initialize-handling

Move initialization into `doInitialize` and report progress

app/Main.hs

@@ -10,6 +10,7 @@ import qualified Language.LSP.Server as S
 import qualified Language.LSP.Protocol.Types as J
 import qualified Curry.LanguageServer.Config as CFG
 import Curry.LanguageServer.Handlers
+import Curry.LanguageServer.Handlers.Initialize (initializeHandler)
 import Curry.LanguageServer.Handlers.Workspace.Command (commands)
 import Curry.LanguageServer.Monad (runLSM, newLSStateVar)
 import System.Exit (ExitCode(ExitFailure), exitSuccess, exitWith)
@@ -32,7 +33,7 @@ runLanguageServer = do
         -- TODO: Handle configuration changes (ideally from here, not in the didChangeConfiguration handler)
         -- See https://hackage.haskell.org/package/lsp-2.7.0.0/docs/Language-LSP-Server.html#t:ServerDefinition
         , S.onConfigChange = const $ pure ()
-        , S.doInitialize = const . pure . Right
+        , S.doInitialize = \env req -> runLSM (initializeHandler req) state env >> return (Right env)
         , S.staticHandlers = handlers
         , S.interpretHandler = \env -> S.Iso (\lsm -> runLSM lsm state env) liftIO
         , S.options = S.defaultOptions

curry-language-server.cabal

@@ -35,7 +35,7 @@ library
       Curry.LanguageServer.Handlers
       Curry.LanguageServer.Handlers.Cancel
       Curry.LanguageServer.Handlers.Diagnostics
-      Curry.LanguageServer.Handlers.Initialized
+      Curry.LanguageServer.Handlers.Initialize
       Curry.LanguageServer.Handlers.TextDocument.CodeAction
       Curry.LanguageServer.Handlers.TextDocument.CodeLens
       Curry.LanguageServer.Handlers.TextDocument.Completion

src/Curry/LanguageServer/Handlers.hs

@@ -1,6 +1,7 @@
 module Curry.LanguageServer.Handlers (handlers) where
 
 import Curry.LanguageServer.Handlers.Cancel (cancelHandler)
+import Curry.LanguageServer.Handlers.Initialize (initializedHandler)
 import Curry.LanguageServer.Handlers.TextDocument.CodeAction (codeActionHandler)
 import Curry.LanguageServer.Handlers.TextDocument.CodeLens (codeLensHandler)
 import Curry.LanguageServer.Handlers.TextDocument.Completion (completionHandler)
@@ -9,7 +10,6 @@ import Curry.LanguageServer.Handlers.TextDocument.DocumentSymbol (documentSymbol
 import Curry.LanguageServer.Handlers.TextDocument.Notifications (didOpenHandler, didChangeHandler, didSaveHandler, didCloseHandler)
 import Curry.LanguageServer.Handlers.TextDocument.Hover (hoverHandler)
 import Curry.LanguageServer.Handlers.TextDocument.SignatureHelp (signatureHelpHandler)
-import Curry.LanguageServer.Handlers.Initialized (initializedHandler)
 import Curry.LanguageServer.Handlers.Workspace.Command (executeCommandHandler)
 import Curry.LanguageServer.Handlers.Workspace.Notifications (didChangeConfigurationHandler)
 import Curry.LanguageServer.Handlers.Workspace.Symbol (workspaceSymbolHandler)

src/Curry/LanguageServer/Handlers/Initialized.hs → src/Curry/LanguageServer/Handlers/Initialize.hs

@@ -1,33 +1,39 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Curry.LanguageServer.Handlers.Initialized (initializedHandler) where
+{-# LANGUAGE DataKinds, OverloadedStrings #-}
+module Curry.LanguageServer.Handlers.Initialize (initializeHandler, initializedHandler) where
 
+import Control.Lens ((^.))
 import Curry.LanguageServer.FileLoader (fileLoader)
 import Curry.LanguageServer.Handlers.Diagnostics (emitDiagnostics)
 import Curry.LanguageServer.Utils.Logging (infoM)
 import qualified Curry.LanguageServer.Index.Store as I
 import Curry.LanguageServer.Monad (LSM)
 import Data.Maybe (maybeToList, fromMaybe)
 import qualified Data.Text as T
-import qualified Language.LSP.Server as S
+import qualified Language.LSP.Protocol.Lens as J
 import qualified Language.LSP.Protocol.Types as J
 import qualified Language.LSP.Protocol.Message as J
+import qualified Language.LSP.Server as S
+
+initializeHandler :: J.TMessage J.Method_Initialize -> LSM ()
+initializeHandler req = do
+    let token = req ^. J.params . J.workDoneToken
+    S.withIndefiniteProgress "Initializing Curry..." token S.NotCancellable $ \updater -> do
+        infoM "Building index store..."
+        workspaceFolders <- fromMaybe [] <$> S.getWorkspaceFolders
+        let folderToPath (J.WorkspaceFolder uri _) = J.uriToFilePath uri
+            folders = maybeToList . folderToPath =<< workspaceFolders
+        mapM_ addDirToIndexStore folders
+        count <- I.getModuleCount
+        infoM $ "Indexed " <> T.pack (show count) <> " files"
 
 initializedHandler :: S.Handlers LSM
 initializedHandler = S.notificationHandler J.SMethod_Initialized $ \_nt -> do
-    infoM "Building index store..."
-    workspaceFolders <- fromMaybe [] <$> S.getWorkspaceFolders
-    let folders = maybeToList . folderToPath =<< workspaceFolders
-    mapM_ addDirToIndexStore folders
-    count <- I.getModuleCount
-    infoM $ "Indexed " <> T.pack (show count) <> " files"
-    where folderToPath (J.WorkspaceFolder uri _) = J.uriToFilePath uri
+    entries <- I.getModuleList
+    mapM_ (uncurry emitDiagnostics) entries
 
 -- | Indexes a workspace folder recursively.
 addDirToIndexStore :: FilePath -> LSM ()
 addDirToIndexStore dirPath = do
     fl <- fileLoader
     cfg <- S.getConfig
     I.addWorkspaceDir cfg fl dirPath
-    entries <- I.getModuleList
-    mapM_ (uncurry emitDiagnostics) entries
-