Show user info messages in LSP, invalidate modules transitively on change

This commit is contained in:
2026-02-16 09:22:49 -08:00
parent adff28ea0f
commit d86c257426
2 changed files with 50 additions and 3 deletions

View File

@@ -3,6 +3,7 @@ module LSP
import Prelude import Prelude
-- TODO pull this into its own file -- TODO pull this into its own file
import Lib.Common import Lib.Common
import Lib.Eval
import Lib.Types import Lib.Types
import Lib.TopContext import Lib.TopContext
import Lib.Tokenizer import Lib.Tokenizer
@@ -14,6 +15,8 @@ import Data.IORef
import Node import Node
import Commands import Commands
import Data.List1 import Data.List1
import Lib.Prettier
import Lib.ProcessDecl
pfunc js_castArray : Array JSObject JSObject := `x => x` pfunc js_castArray : Array JSObject JSObject := `x => x`
pfunc js_castInt : Int JSObject := `x => x` pfunc js_castInt : Int JSObject := `x => x`
@@ -115,6 +118,28 @@ errorToDiag (E fc msg) =
errorToDiag (Postpone fc qn msg) = errorToDiag $ E fc "Postpone \{show qn} \{msg}" errorToDiag (Postpone fc qn msg) = errorToDiag $ E fc "Postpone \{show qn} \{msg}"
getInfos : M (List Json)
getInfos = do
top <- getTop
go Nil $ listValues $ top.metaCtx.metas
where
go : List Json → List MetaEntry → M (List Json)
go acc Nil = pure acc
go acc (Unsolved fc k ctx ty User cons :: rest) = do
ty' <- quote ctx.lvl ty
let names = map fst ctx.types
let dispType = render 90 $ pprint names ty'
dispEnv <- dumpEnv ctx
let msg = "\{dispEnv}\n--------\n\{dispType}"
let diag = JsonObj
$ ("severity", JsonInt 3)
:: ("range", fcToRange fc)
:: ("message", JsonStr msg)
:: ("source", JsonStr "newt") -- what is this key for?
:: Nil
go (diag :: acc) rest
go acc (_ :: es) = go acc es
checkFile : String JSObject checkFile : String JSObject
checkFile fn = unsafePerformIO $ do checkFile fn = unsafePerformIO $ do
let (base,modName) = decomposeName fn let (base,modName) = decomposeName fn
@@ -131,7 +156,9 @@ checkFile fn = unsafePerformIO $ do
pure MkUnit pure MkUnit
-- pull out errors and infos -- pull out errors and infos
top <- getTop top <- getTop
pure $ map (errorToDiag) top.errors let errors = map (errorToDiag) top.errors
infos <- getInfos
pure $ infos ++ errors
).runM st.topContext ).runM st.topContext
| Left err => do | Left err => do
putStrLn $ showError "" err putStrLn $ showError "" err

View File

@@ -138,6 +138,26 @@ processModule importFC repo stk modns = do
(Left err) <- tryError $ processDecl ns decl | _ => pure MkUnit (Left err) <- tryError $ processDecl ns decl | _ => pure MkUnit
addError err addError err
-- NOW TODO clear dependents too. -- invalidate Module and anyone who depends on it
invalidateModule : String -> M Unit invalidateModule : String -> M Unit
invalidateModule modname = modifyTop [modules $= deleteMap modname] invalidateModule modname = do
top <- getTop
let modules = join $ map getDeps $ toList top.modules
let revMap = map swap modules
let deps = foldl accumulate emptyMap revMap
go deps $ modname :: Nil
where
accumulate : SortedMap String (List String) String × String SortedMap String (List String)
accumulate deps (k,v) = let prev = fromMaybe Nil $ lookupMap' k deps
in updateMap k (v :: prev) deps
getDeps : String × ModContext List (String × String)
getDeps (nm, mod) = map (nm , ) mod.modDeps
go : SortedMap String (List String) List String M Unit
go deps Nil = pure MkUnit
go deps (name :: names) = do
modifyTop [modules $= deleteMap name]
let ds = fromMaybe Nil $ lookupMap' name deps
putStrLn "Chase \{name} → \{show ds}"
go deps $ ds ++ names