Log various events for debugging purposes

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,25 +67,31 @@ 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
 
           cachedModules <- getCachedTypecheckedModules
           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]

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