diff --git a/rzk/src/Language/Rzk/VSCode/Handlers.hs b/rzk/src/Language/Rzk/VSCode/Handlers.hs index 55c61809c..45b55d098 100644 --- a/rzk/src/Language/Rzk/VSCode/Handlers.hs +++ b/rzk/src/Language/Rzk/VSCode/Handlers.hs @@ -8,10 +8,10 @@ module Language.Rzk.VSCode.Handlers where import Control.Exception (SomeException, evaluate, try) import Control.Lens -import Control.Monad.Cont (MonadIO (liftIO), forM_) +import Control.Monad.Cont (MonadIO (liftIO), forM_, when) import Data.Default.Class import Data.List (sort, (\\)) -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, isNothing) import qualified Data.Text as T import qualified Data.Yaml as Yaml import Language.LSP.Diagnostics (partitionBySource) @@ -32,6 +32,7 @@ import Language.Rzk.Free.Syntax (RzkPosition (RzkPosition), import Language.Rzk.Syntax (Module, VarIdent' (VarIdent), parseModuleFile, printTree) import Language.Rzk.VSCode.Env +import Language.Rzk.VSCode.Logging import Language.Rzk.VSCode.State (ProjectConfig (include)) import Rzk.TypeCheck @@ -66,18 +67,21 @@ filePathToNormalizedUri = toNormalizedUri . filePathToUri typecheckFromConfigFile :: LSP () typecheckFromConfigFile = do + logInfo "Looking for rzk.yaml" root <- getRootPath case root of Nothing -> do + logWarning "Workspace has no root path, cannot find rzk.yaml" sendNotification SMethod_WindowShowMessage (ShowMessageParams MessageType_Warning "Cannot find the workspace root") Just rootPath -> do let rzkYamlPath = rootPath "rzk.yaml" eitherConfig <- liftIO $ Yaml.decodeFileEither @ProjectConfig rzkYamlPath case eitherConfig of Left err -> do - sendNotification SMethod_WindowShowMessage (ShowMessageParams MessageType_Warning (T.pack $ "Invalid or missing rzk.yaml: " ++ Yaml.prettyPrintParseException err)) + logError ("Invalid or missing rzk.yaml: " ++ Yaml.prettyPrintParseException err) Right config -> do + logDebug "Starting typechecking" rawPaths <- liftIO $ globDir (map compile (include config)) rootPath let paths = concatMap sort rawPaths @@ -85,6 +89,9 @@ typecheckFromConfigFile = do let cachedPaths = map fst cachedModules modifiedFiles = paths \\ cachedPaths + logDebug ("Found " ++ show (length cachedPaths) ++ " files in the cache") + logDebug (show (length modifiedFiles) ++ " files have been modified") + (parseErrors, parsedModules) <- liftIO $ collectErrors <$> parseFiles modifiedFiles tcResults <- liftIO $ try $ evaluate $ defaultTypeCheck (typecheckModulesWithLocationIncremental cachedModules parsedModules) @@ -94,11 +101,14 @@ typecheckFromConfigFile = do Right (Left err) -> return ([err], []) -- sort of impossible Right (Right (checkedModules, errors)) -> do -- cache well-typed modules + logInfo (show (length checkedModules) ++ " modules successfully typechecked") + logInfo (show (length errors) ++ " errors found") cacheTypecheckedModules checkedModules return (errors, checkedModules) -- Reset all published diags -- TODO: remove this after properly grouping by path below, after which there can be an empty list of errors + -- TODO: handle clearing diagnostics for files that got removed from the project (rzk.yaml) forM_ paths $ \path -> do publishDiagnostics 0 (filePathToNormalizedUri path) Nothing (partitionBySource []) @@ -161,9 +171,12 @@ instance Default CompletionItemLabelDetails provideCompletions :: Handler LSP 'Method_TextDocumentCompletion provideCompletions req res = do + logInfo "Providing text completions" root <- getRootPath + when (isNothing root) $ logDebug "Not in a workspace. Cannot find root path for relative paths" let rootDir = fromMaybe "/" root cachedModules <- getCachedTypecheckedModules + logDebug ("Found " ++ show (length cachedModules) ++ " modules in the cache") let currentFile = fromMaybe "" $ uriToFilePath $ req ^. params . textDocument . uri -- Take all the modules up to and including the currently open one let modules = takeWhileInc ((/= currentFile) . fst) cachedModules @@ -174,6 +187,7 @@ provideCompletions req res = do | otherwise = [x] let items = concatMap (declsToItems rootDir) modules + logDebug ("Sending " ++ show (length items) ++ " completion items") res $ Right $ InL items where declsToItems :: FilePath -> (FilePath, [Decl']) -> [CompletionItem] diff --git a/rzk/src/Language/Rzk/VSCode/Lsp.hs b/rzk/src/Language/Rzk/VSCode/Lsp.hs index 806df9dad..31553309b 100644 --- a/rzk/src/Language/Rzk/VSCode/Lsp.hs +++ b/rzk/src/Language/Rzk/VSCode/Lsp.hs @@ -19,6 +19,7 @@ import Language.LSP.VFS (virtualFileText) import Language.Rzk.Syntax (parseModuleSafe) import Language.Rzk.VSCode.Env import Language.Rzk.VSCode.Handlers +import Language.Rzk.VSCode.Logging import Language.Rzk.VSCode.Tokenize (tokenizeModule) -- | The maximum number of diagnostic messages to send to the client @@ -38,7 +39,9 @@ handlers = , notificationHandler SMethod_WorkspaceDidChangeWatchedFiles $ \msg -> do let modifiedPaths = msg ^.. params . changes . traverse . uri . to uriToFilePath . _Just if any ("rzk.yaml" `isSuffixOf`) modifiedPaths - then resetCacheForAllFiles + then do + logDebug "rzk.yaml modified. Clearing module cache" + resetCacheForAllFiles else resetCacheForFiles modifiedPaths typecheckFromConfigFile , notificationHandler SMethod_TextDocumentDidSave $ \_msg -> do @@ -62,9 +65,9 @@ handlers = Just sourceCode -> fmap (fmap tokenizeModule) $ liftIO $ parseModuleSafe (T.unpack sourceCode) case possibleTokens of - Left _err -> do + Left err -> do -- Exception occurred when parsing the module - return () + logWarning ("Failed to tokenize file: " ++ err) Right tokens -> do let encoded = encodeTokens defaultSemanticTokensLegend $ relativizeTokens tokens case encoded of