Logging

rzk/package.yaml

@@ -21,7 +21,7 @@ description: Please see the README on GitHub at <https://github.com/rzk-lang/rzk
 flags:
   lsp:
     description: >-
-      Build with LSP support.
+      Build with LSP support (only available with GHC, not GHCJS).
     manual: true
     default: true
 
@@ -31,20 +31,14 @@ build-tools:
 
 dependencies:
   array: ">= 0.5.3.0"
-  aeson: ">= 1.4.2.0"
   base: ">= 4.7 && < 5"
   bifunctors: ">= 5.5.3"
   bytestring: ">= 0.10.8.2"
+  Glob: ">= 0.9.3"
   mtl: ">= 2.2.2"
+  optparse-generic: ">= 1.3.0"
   template-haskell: ">= 2.14.0.0"
   text: ">= 1.2.3.1"
-  optparse-generic: ">= 1.3.0"
-  Glob: ">= 0.9.3"
-  lens: ">= 4.17"
-  filepath: ">= 1.4.2.1"
-  stm: ">= 2.5.0.0"
-  yaml: ">= 0.11.0.0"
-  data-default-class: ">= 0.1.2.0"
 
 ghc-options:
   - -Wall
@@ -72,9 +66,18 @@ library:
         - Language.Rzk.VSCode.Lsp
         - Language.Rzk.VSCode.State
         - Language.Rzk.VSCode.Tokenize
+        - Language.Rzk.VSCode.Logging
       dependencies:
+        aeson: ">= 1.4.2.0"
+        co-log-core: ">= 0.3.2.0"
+        data-default-class: ">= 0.1.2.0"
+        filepath: ">= 1.4.2.1"
+        lens: ">= 4.17"
         lsp: ">= 2.1.0.0"
         lsp-types: ">= 2.0.1.0"
+        stm: ">= 2.5.0.0"
+        yaml: ">= 0.11.0.0"
+      cpp-options: -DLSP
 
 executables:
   rzk:
@@ -87,7 +90,7 @@ executables:
     dependencies:
       - rzk
     when:
-      - condition: flag(lsp) && !impl(ghcjs)
+      - condition: "!impl(ghcjs)"
         dependencies:
           with-utf8: ">= 1.0.2.4"
 

rzk/rzk.cabal

@@ -26,7 +26,7 @@ source-repository head
   location: https://github.com/rzk-lang/rzk
 
 flag lsp
-  description: Build with LSP support.
+  description: Build with LSP support (only available with GHC, not GHCJS).
   manual: True
   default: True
 
@@ -54,20 +54,14 @@ library
     , happy >=1.19.9
   build-depends:
       Glob >=0.9.3
-    , aeson >=1.4.2.0
     , array >=0.5.3.0
     , base >=4.7 && <5
     , bifunctors >=5.5.3
     , bytestring >=0.10.8.2
-    , data-default-class >=0.1.2.0
-    , filepath >=1.4.2.1
-    , lens >=4.17
     , mtl >=2.2.2
     , optparse-generic >=1.3.0
-    , stm >=2.5.0.0
     , template-haskell >=2.14.0.0
     , text >=1.2.3.1
-    , yaml >=0.11.0.0
   default-language: Haskell2010
   if flag(lsp) && !impl(ghcjs)
     exposed-modules:
@@ -76,9 +70,18 @@ library
         Language.Rzk.VSCode.Lsp
         Language.Rzk.VSCode.State
         Language.Rzk.VSCode.Tokenize
+        Language.Rzk.VSCode.Logging
+    cpp-options: -DLSP
     build-depends:
-        lsp >=2.1.0.0
+        aeson >=1.4.2.0
+      , co-log-core >=0.3.2.0
+      , data-default-class >=0.1.2.0
+      , filepath >=1.4.2.1
+      , lens >=4.17
+      , lsp >=2.1.0.0
       , lsp-types >=2.0.1.0
+      , stm >=2.5.0.0
+      , yaml >=0.11.0.0
 
 executable rzk
   main-is: Main.hs
@@ -92,23 +95,17 @@ executable rzk
     , happy >=1.19.9
   build-depends:
       Glob >=0.9.3
-    , aeson >=1.4.2.0
     , array >=0.5.3.0
     , base >=4.7 && <5
     , bifunctors >=5.5.3
     , bytestring >=0.10.8.2
-    , data-default-class >=0.1.2.0
-    , filepath >=1.4.2.1
-    , lens >=4.17
     , mtl >=2.2.2
     , optparse-generic >=1.3.0
     , rzk
-    , stm >=2.5.0.0
     , template-haskell >=2.14.0.0
     , text >=1.2.3.1
-    , yaml >=0.11.0.0
   default-language: Haskell2010
-  if flag(lsp) && !impl(ghcjs)
+  if !impl(ghcjs)
     build-depends:
         with-utf8 >=1.0.2.4
 
@@ -124,21 +121,15 @@ test-suite doctests
   build-depends:
       Glob
     , QuickCheck
-    , aeson >=1.4.2.0
     , array >=0.5.3.0
     , base
     , bifunctors >=5.5.3
     , bytestring >=0.10.8.2
-    , data-default-class >=0.1.2.0
     , doctest
-    , filepath >=1.4.2.1
-    , lens >=4.17
     , mtl >=2.2.2
     , optparse-generic >=1.3.0
-    , stm >=2.5.0.0
     , template-haskell
     , text >=1.2.3.1
-    , yaml >=0.11.0.0
   default-language: Haskell2010
 
 test-suite rzk-test
@@ -154,19 +145,13 @@ test-suite rzk-test
     , happy >=1.19.9
   build-depends:
       Glob >=0.9.3
-    , aeson >=1.4.2.0
     , array >=0.5.3.0
     , base >=4.7 && <5
     , bifunctors >=5.5.3
     , bytestring >=0.10.8.2
-    , data-default-class >=0.1.2.0
-    , filepath >=1.4.2.1
-    , lens >=4.17
     , mtl >=2.2.2
     , optparse-generic >=1.3.0
     , rzk
-    , stm >=2.5.0.0
     , template-haskell >=2.14.0.0
     , text >=1.2.3.1
-    , yaml >=0.11.0.0
   default-language: Haskell2010

rzk/rzk.nix

@@ -1,7 +1,6 @@
-{ mkDerivation, aeson, alex, array, base, bifunctors, bytestring
-, data-default-class, doctest, filepath, Glob, happy, hpack, lens
-, lib, mtl, optparse-generic, QuickCheck, stm, template-haskell
-, text, yaml
+{ mkDerivation, alex, array, base, bifunctors, bytestring, doctest
+, Glob, happy, hpack, lib, mtl, optparse-generic, QuickCheck
+, template-haskell, text
 }:
 mkDerivation {
   pname = "rzk";
@@ -10,19 +9,18 @@ mkDerivation {
   isLibrary = true;
   isExecutable = true;
   libraryHaskellDepends = [
-    aeson array base bifunctors bytestring data-default-class filepath
-    Glob lens mtl optparse-generic stm template-haskell text yaml
+    array base bifunctors bytestring Glob mtl optparse-generic
+    template-haskell text
   ];
   libraryToolDepends = [ alex happy hpack ];
   executableHaskellDepends = [
-    aeson array base bifunctors bytestring data-default-class filepath
-    Glob lens mtl optparse-generic stm template-haskell text yaml
+    array base bifunctors bytestring Glob mtl optparse-generic
+    template-haskell text
   ];
   executableToolDepends = [ alex happy ];
   testHaskellDepends = [
-    aeson array base bifunctors bytestring data-default-class doctest
-    filepath Glob lens mtl optparse-generic QuickCheck stm
-    template-haskell text yaml
+    array base bifunctors bytestring doctest Glob mtl optparse-generic
+    QuickCheck template-haskell text
   ];
   testToolDepends = [ alex happy ];
   prePatch = "hpack";

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/Logging.hs

@@ -0,0 +1,20 @@
+module Language.Rzk.VSCode.Logging where
+
+import           Colog.Core           (Severity (..), WithSeverity (..), (<&))
+import qualified Data.Text            as T
+import           Language.LSP.Logging (defaultClientLogger)
+import           Language.LSP.Server  (MonadLsp)
+
+
+logDebug :: MonadLsp c m => String -> m ()
+logDebug msg = defaultClientLogger <& T.pack msg `WithSeverity` Debug
+
+logInfo :: MonadLsp c m => String -> m ()
+logInfo msg = defaultClientLogger <& T.pack msg `WithSeverity` Info
+
+logWarning :: MonadLsp c m => String -> m ()
+logWarning msg = defaultClientLogger <& T.pack msg `WithSeverity` Warning
+
+-- | Error logs will also be shown to the user via `window/showMessage`
+logError :: MonadLsp c m => String -> m ()
+logError msg = defaultClientLogger <& T.pack msg `WithSeverity` Error

rzk/src/Language/Rzk/VSCode/Lsp.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE TypeApplications      #-}
 
 module Language.Rzk.VSCode.Lsp where
 
@@ -20,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
@@ -39,12 +39,10 @@ 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
-        -- TODO: see what files changed and typecheck them again
-        --  Need to handle 3 events: added, changed, and deleted
-
-        -- Currently, this is only sent for changes in `rzk.yaml`, so it makes sense to typecheck again (unconditionally)
         typecheckFromConfigFile
     , notificationHandler SMethod_TextDocumentDidSave $ \_msg -> do
         -- TODO: check if the file is included in the config's `include` list.
@@ -67,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

rzk/src/Rzk/Main.hs

@@ -9,9 +9,11 @@ module Rzk.Main where
 import           Control.Monad           (forM, void)
 import           Data.List               (sort)
 import           Data.Version            (showVersion)
-#ifndef __GHCJS__
+
+#ifdef LSP
 import           Language.Rzk.VSCode.Lsp (runLsp)
 #endif
+
 import           Options.Generic
 import           System.Exit             (exitFailure)
 import           System.FilePath.Glob    (glob)
@@ -41,10 +43,10 @@ main = getRecord "rzk: an experimental proof assistant for synthetic ∞-categor
       Right _decls -> putStrLn "Everything is ok!"
 
   Lsp ->
-#ifndef __GHCJS__
+#ifdef LSP
     void runLsp
 #else
-    error "rzk lsp is not supported with a GHCJS build"
+    error "rzk lsp is not supported with this build"
 #endif
 
   Version -> putStrLn (showVersion version)