Show user info messages in LSP, invalidate modules transitively on change
This commit is contained in:
29
src/LSP.newt
29
src/LSP.newt
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user