import action for out of scope names, start introducing error types
This commit is contained in:
@@ -63,6 +63,7 @@ data CodeAction
|
|||||||
= CaseSplitAction (List FileEdit)
|
= CaseSplitAction (List FileEdit)
|
||||||
| AddMissingAction (List FileEdit)
|
| AddMissingAction (List FileEdit)
|
||||||
| Intro String FileEdit
|
| Intro String FileEdit
|
||||||
|
| ImportAction String FileEdit
|
||||||
|
|
||||||
|
|
||||||
applyDCon : QName × Int × Tm → List String
|
applyDCon : QName × Int × Tm → List String
|
||||||
@@ -210,7 +211,6 @@ introActions (Just $ Unsolved fc qn ctx vty User constraints) =
|
|||||||
putStrLn $ showError "" err
|
putStrLn $ showError "" err
|
||||||
pure Nil
|
pure Nil
|
||||||
where
|
where
|
||||||
|
|
||||||
introDCon : QName × Int × Tm → List String
|
introDCon : QName × Int × Tm → List String
|
||||||
introDCon (QN _ nm, _, tm) = go (Lin :< nm) tm
|
introDCon (QN _ nm, _, tm) = go (Lin :< nm) tm
|
||||||
where
|
where
|
||||||
@@ -226,6 +226,26 @@ introActions (Just $ Unsolved fc qn ctx vty User constraints) =
|
|||||||
|
|
||||||
introActions _ = pure Nil
|
introActions _ = pure Nil
|
||||||
|
|
||||||
|
errorActions : Int → Int → Error → M (List CodeAction)
|
||||||
|
errorActions row col err = do
|
||||||
|
let (ENotFound fc nm) = err | _ => pure Nil
|
||||||
|
let (True) = posInFC row col fc | _ => pure Nil
|
||||||
|
top <- getTop
|
||||||
|
let mods = map (\e => e.name.qns) $ lookupAll nm top
|
||||||
|
case mods of
|
||||||
|
Nil => pure Nil
|
||||||
|
_ => do
|
||||||
|
top <- getTop
|
||||||
|
let row = getInsertRow 0 1 $ split top.currentMod.modSource "\n"
|
||||||
|
let fc = MkFC fc.file (MkBounds row 0 row 0)
|
||||||
|
pure $ map (\nm => ImportAction nm (MkEdit fc "import \{nm}\n")) mods
|
||||||
|
where
|
||||||
|
getInsertRow : Int → Int → List String → Int
|
||||||
|
getInsertRow row cur Nil = row
|
||||||
|
getInsertRow row cur (l :: ls) =
|
||||||
|
let row = ite (isPrefixOf "module" l || isPrefixOf "import" l) cur row
|
||||||
|
in getInsertRow row (cur + 1) ls
|
||||||
|
|
||||||
getActions : FileSource → String → Int → Int → M (List CodeAction)
|
getActions : FileSource → String → Int → Int → M (List CodeAction)
|
||||||
getActions repo modns row col = do
|
getActions repo modns row col = do
|
||||||
Just mod <- switchModule repo modns | _ => pure Nil
|
Just mod <- switchModule repo modns | _ => pure Nil
|
||||||
@@ -236,7 +256,8 @@ getActions repo modns row col = do
|
|||||||
let hole = getHole mod row col
|
let hole = getHole mod row col
|
||||||
putStrLn "Hole \{debugStr hole}"
|
putStrLn "Hole \{debugStr hole}"
|
||||||
intros <- introActions $ getHole mod row col
|
intros <- introActions $ getHole mod row col
|
||||||
pure $ actions ++ intros
|
eactions <- join <$> traverse (errorActions row col) mod.modErrors
|
||||||
|
pure $ actions ++ intros ++ eactions
|
||||||
where
|
where
|
||||||
getAction : EditorInfo → M (Maybe CodeAction)
|
getAction : EditorInfo → M (Maybe CodeAction)
|
||||||
getAction (CaseSplit fc ctx nm scty) = getCaseSplit row col fc ctx nm scty
|
getAction (CaseSplit fc ctx nm scty) = getCaseSplit row col fc ctx nm scty
|
||||||
|
|||||||
13
src/LSP.newt
13
src/LSP.newt
@@ -13,8 +13,6 @@ import Data.SortedMap
|
|||||||
import Data.IORef
|
import Data.IORef
|
||||||
import Node
|
import Node
|
||||||
import Commands
|
import Commands
|
||||||
import Data.List1
|
|
||||||
import Lib.Prettier
|
|
||||||
import Lib.ProcessDecl
|
import Lib.ProcessDecl
|
||||||
|
|
||||||
pfunc js_castArray : Array JSObject → JSObject := `x => x`
|
pfunc js_castArray : Array JSObject → JSObject := `x => x`
|
||||||
@@ -148,6 +146,11 @@ codeActionInfo uri line col = unsafePerformIO $ do
|
|||||||
$ ("title", JsonStr "Intro \{name}")
|
$ ("title", JsonStr "Intro \{name}")
|
||||||
:: ("edit", (single "changes" $ single uri $ JsonArray $ editToJson edit :: Nil))
|
:: ("edit", (single "changes" $ single uri $ JsonArray $ editToJson edit :: Nil))
|
||||||
:: Nil
|
:: Nil
|
||||||
|
actionToJson (ImportAction name edit) =
|
||||||
|
JsonObj
|
||||||
|
$ ("title", JsonStr "Import \{name}")
|
||||||
|
:: ("edit", (single "changes" $ single uri $ JsonArray $ editToJson edit :: Nil))
|
||||||
|
:: Nil
|
||||||
actionToJson (AddMissingAction edits) =
|
actionToJson (AddMissingAction edits) =
|
||||||
JsonObj
|
JsonObj
|
||||||
$ ("title", JsonStr "Add missing cases")
|
$ ("title", JsonStr "Add missing cases")
|
||||||
@@ -155,11 +158,11 @@ codeActionInfo uri line col = unsafePerformIO $ do
|
|||||||
:: Nil
|
:: Nil
|
||||||
|
|
||||||
errorToDiag : Error -> Json
|
errorToDiag : Error -> Json
|
||||||
errorToDiag (E fc msg) =
|
errorToDiag err =
|
||||||
JsonObj
|
JsonObj
|
||||||
$ ("severity", JsonInt 1)
|
$ ("severity", JsonInt 1)
|
||||||
:: ("range", fcToRange fc)
|
:: ("range", fcToRange (getFC err))
|
||||||
:: ("message", JsonStr msg)
|
:: ("message", JsonStr (errorMsg err))
|
||||||
:: ("source", JsonStr "newt") -- what is this key for?
|
:: ("source", JsonStr "newt") -- what is this key for?
|
||||||
:: Nil
|
:: Nil
|
||||||
-- These shouldn't escape
|
-- These shouldn't escape
|
||||||
|
|||||||
@@ -142,11 +142,10 @@ emptyFC' : String → FC
|
|||||||
emptyFC' fn = MkFC fn (MkBounds 0 0 0 0)
|
emptyFC' fn = MkFC fn (MkBounds 0 0 0 0)
|
||||||
|
|
||||||
-- Using a String instead of List String for the module shaved about 16% of compile time...
|
-- Using a String instead of List String for the module shaved about 16% of compile time...
|
||||||
data QName : U where
|
record QName where
|
||||||
QN : String -> String -> QName
|
constructor QN
|
||||||
|
qns : String
|
||||||
.baseName : QName → String
|
baseName : String
|
||||||
(QN _ name).baseName = name
|
|
||||||
|
|
||||||
instance Eq QName where
|
instance Eq QName where
|
||||||
-- `if` gets us short circuit behavior, idris has a lazy `&&`
|
-- `if` gets us short circuit behavior, idris has a lazy `&&`
|
||||||
@@ -159,34 +158,39 @@ instance Show QName where
|
|||||||
instance Ord QName where
|
instance Ord QName where
|
||||||
compare (QN ns nm) (QN ns' nm') = if ns == ns' then compare nm nm' else compare ns ns'
|
compare (QN ns nm) (QN ns' nm') = if ns == ns' then compare nm nm' else compare ns ns'
|
||||||
|
|
||||||
|
-- I'll want to get Context / Val in some of these
|
||||||
|
-- and a pretty printer in the monad
|
||||||
data Error
|
data Error
|
||||||
= E FC String
|
= E FC String
|
||||||
|
| ENotFound FC String
|
||||||
| Postpone FC QName String
|
| Postpone FC QName String
|
||||||
|
|
||||||
instance Show FC where
|
instance Show FC where
|
||||||
show (MkFC file (MkBounds l c el ec)) = "\{file}:\{show $ l + 1}:\{show $ c + 1}--\{show $ el + 1}:\{show $ ec + 1}"
|
show (MkFC file (MkBounds l c el ec)) = "\{file}:\{show $ l + 1}:\{show $ c + 1}--\{show $ el + 1}:\{show $ ec + 1}"
|
||||||
|
|
||||||
showError : String -> Error -> String
|
instance HasFC Error where
|
||||||
showError src (E fc msg) = "ERROR at \{show fc}: \{msg}\n" ++ go 0 (lines src)
|
getFC (E x str) = x
|
||||||
|
getFC (ENotFound x _) = x
|
||||||
|
getFC (Postpone x k str) = x
|
||||||
|
|
||||||
|
errorMsg : Error -> String
|
||||||
|
errorMsg (E x str) = str
|
||||||
|
errorMsg (ENotFound x nm) = "\{nm} not in scope"
|
||||||
|
errorMsg (Postpone x k str) = str
|
||||||
|
|
||||||
|
showError : (src : String) -> Error -> String
|
||||||
|
showError src err =
|
||||||
|
let fc = getFC err
|
||||||
|
in "ERROR at \{show $ getFC err}: \{errorMsg err}\n" ++ go fc 0 (lines src)
|
||||||
where
|
where
|
||||||
go : Int -> List String -> String
|
go : FC → Int → List String → String
|
||||||
go l Nil = ""
|
go fc l Nil = ""
|
||||||
go l (x :: xs) =
|
go fc l (x :: xs) =
|
||||||
if l == fcLine fc then
|
if l == fcLine fc then
|
||||||
let width = fc.bnds.endCol - fc.bnds.startCol in
|
let width = fc.bnds.endCol - fc.bnds.startCol in
|
||||||
" \{x}\n \{replicate (cast $ fcCol fc) ' '}\{replicate (cast width) '^'}\n"
|
" \{x}\n \{replicate (cast $ fcCol fc) ' '}\{replicate (cast width) '^'}\n"
|
||||||
else if fcLine fc - 3 < l then " " ++ x ++ "\n" ++ go (l + 1) xs
|
else if fcLine fc - 3 < l then " " ++ x ++ "\n" ++ go fc (l + 1) xs
|
||||||
else go (l + 1) xs
|
else go fc (l + 1) xs
|
||||||
showError src (Postpone fc ix msg) = "ERROR at \{show fc}: Postpone \{show ix} \{msg}\n" ++ go 0 (lines src)
|
|
||||||
where
|
|
||||||
go : Int -> List String -> String
|
|
||||||
go l Nil = ""
|
|
||||||
go l (x :: xs) =
|
|
||||||
if l == fcLine fc then
|
|
||||||
" \{x}\n \{replicate (cast $ fcCol fc) ' '}^\n"
|
|
||||||
else if fcLine fc - 3 < l then " " ++ x ++ "\n" ++ go (l + 1) xs
|
|
||||||
else go (l + 1) xs
|
|
||||||
|
|
||||||
|
|
||||||
data Fixity = InfixL | InfixR | Infix
|
data Fixity = InfixL | InfixR | Infix
|
||||||
|
|
||||||
|
|||||||
@@ -1535,9 +1535,6 @@ infer ctx tm@(RUpdateRec fc _ _) = error fc "I can't infer record updates"
|
|||||||
|
|
||||||
infer ctx (RVar fc nm) = go 0 ctx.types
|
infer ctx (RVar fc nm) = go 0 ctx.types
|
||||||
where
|
where
|
||||||
entryNS : TopEntry → String
|
|
||||||
entryNS (MkEntry fc (QN ns _) _ _ _) = ns
|
|
||||||
|
|
||||||
go : Int -> List (String × Val) -> M (Tm × Val)
|
go : Int -> List (String × Val) -> M (Tm × Val)
|
||||||
go i Nil = do
|
go i Nil = do
|
||||||
top <- getTop
|
top <- getTop
|
||||||
@@ -1546,13 +1543,8 @@ infer ctx (RVar fc nm) = go 0 ctx.types
|
|||||||
debug $ \ _ => "lookup \{show name} as \{show def}"
|
debug $ \ _ => "lookup \{show name} as \{show def}"
|
||||||
vty <- eval Nil ty
|
vty <- eval Nil ty
|
||||||
pure (Ref fc name, vty)
|
pure (Ref fc name, vty)
|
||||||
Nothing => do
|
-- Can we soften this without introducing a meta?
|
||||||
let mods = map entryNS $ lookupAll nm top
|
Nothing => throwError $ ENotFound fc nm
|
||||||
let extra = case mods of
|
|
||||||
Nil => ""
|
|
||||||
-- For the benefit of the editor, but only sees transitive modules
|
|
||||||
_ => ", try importing: \{joinBy ", " mods}"
|
|
||||||
error fc "\{show nm} not in scope\{extra}"
|
|
||||||
go i ((x, ty) :: xs) = if x == nm then pure (Bnd fc i, ty)
|
go i ((x, ty) :: xs) = if x == nm then pure (Bnd fc i, ty)
|
||||||
else go (i + 1) xs
|
else go (i + 1) xs
|
||||||
|
|
||||||
|
|||||||
@@ -570,13 +570,6 @@ debugM x = logM 2 x
|
|||||||
instance Show Context where
|
instance Show Context where
|
||||||
show ctx = "Context \{show $ map fst $ ctx.types}"
|
show ctx = "Context \{show $ map fst $ ctx.types}"
|
||||||
|
|
||||||
errorMsg : Error -> String
|
|
||||||
errorMsg (E x str) = str
|
|
||||||
errorMsg (Postpone x k str) = str
|
|
||||||
|
|
||||||
instance HasFC Error where
|
|
||||||
getFC (E x str) = x
|
|
||||||
getFC (Postpone x k str) = x
|
|
||||||
|
|
||||||
error : ∀ a. FC -> String -> M a
|
error : ∀ a. FC -> String -> M a
|
||||||
error fc msg = throwError $ E fc msg
|
error fc msg = throwError $ E fc msg
|
||||||
|
|||||||
Reference in New Issue
Block a user