Skip to content

Commit

Permalink
Stop typechecking after a parse error in some file (avoid invalid cache)
Browse files Browse the repository at this point in the history
  • Loading branch information
fizruk committed Dec 16, 2023
1 parent 01762ed commit 68ab0b4
Show file tree
Hide file tree
Showing 2 changed files with 18 additions and 7 deletions.
2 changes: 1 addition & 1 deletion rzk/src/Language/Rzk/VSCode/Handlers.hs
Original file line number Diff line number Diff line change
Expand Up @@ -61,7 +61,7 @@ collectErrors :: [(FilePath, Either String Module)] -> ([(FilePath, String)], [(
collectErrors [] = ([], [])
collectErrors ((path, result) : paths) =
case result of
Left err -> ((path, err) : errors, modules)
Left err -> ((path, err) : errors, [])
Right module_ -> (errors, (path, module_) : modules)
where
(errors, modules) = collectErrors paths
Expand Down
23 changes: 17 additions & 6 deletions rzk/src/Language/Rzk/VSCode/Lsp.hs
Original file line number Diff line number Diff line change
Expand Up @@ -39,26 +39,37 @@ import Rzk.TypeCheck (defaultTypeCheck,
maxDiagnosticCount :: Int
maxDiagnosticCount = 100

data IsChanged
= HasChanged
| NotChanged

-- | Detects if the given path has changes in its declaration compared to what's in the cache
hasNotChanged :: RzkTypecheckCache -> FilePath -> LSP Bool
hasNotChanged cache path = toBool $ do
isChanged :: RzkTypecheckCache -> FilePath -> LSP IsChanged
isChanged cache path = toIsChanged $ do
cachedDecls <- maybeToEitherLSP $ lookup path cache
module' <- toExceptTLifted $ parseModuleFile path
e <- toExceptTLifted $ try @SomeException $ evaluate $
defaultTypeCheck (typecheckModulesWithLocationIncremental (filter ((/= path) . fst) cache) [(path, module')])
defaultTypeCheck (typecheckModulesWithLocationIncremental (takeWhile ((/= path) . fst) cache) [(path, module')])
(checkedModules, _errors) <- toExceptT $ return e
decls' <- maybeToEitherLSP $ lookup path checkedModules
return (decls' == cachedDecls)
return $ if decls' == cachedDecls
then NotChanged
else HasChanged
where
toExceptT = modifyError (const ()) . ExceptT
toExceptTLifted = toExceptT . liftIO
maybeToEitherLSP = \case
Nothing -> throwError ()
Just x -> return x
toBool m = runExceptT m >>= \case
Left _ -> return False
toIsChanged m = runExceptT m >>= \case
Left _ -> return HasChanged -- in case of error consider the file has changed
Right x -> return x

hasNotChanged :: RzkTypecheckCache -> FilePath -> LSP Bool
hasNotChanged cache path = isChanged cache path >>= \case
HasChanged -> return False
NotChanged -> return True

-- | Monadic 'dropWhile'
dropWhileM :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
dropWhileM _ [] = return []
Expand Down

0 comments on commit 68ab0b4

Please sign in to comment.