dhall-lsp-server: Fix hovering in presence of nested lets (#1537)
* Fix hacked-together parsers Back when we changed the linter to preserve let comments we made whitespace parsing explicit (previously combinators swallowed any trailing whitespace), but we forgot to update the hacked-together parsers used by the LSP server. As a result, various convenience features broke, but that's easy enough to fix. * Fix 'annotate lets' and 'type on hover' features Both features only work as intended if as much of the Dhall code as possible is wrapped in Note annotations, since we use that to figure out where the user was pointing. Since the removal of explicit multi-lets in the syntax the parser no longer wraps immediately nested lets (i.e. multilets) in Notes, which means we need to split them manually (like we used to). * Fix hovering test Now the behaviour expected by the test matches what we would want in reality.
This commit is contained in:
parent
6c68f8206d
commit
619788f795
|
@ -24,7 +24,6 @@ import Control.Applicative (optional, (<|>))
|
|||
import qualified Text.Megaparsec as Megaparsec
|
||||
import Text.Megaparsec (SourcePos(..))
|
||||
|
||||
|
||||
-- | Parse the outermost binding in a Src descriptor of a let-block and return
|
||||
-- the rest. Ex. on input `let a = 0 let b = a in b` parses `let a = 0 ` and
|
||||
-- returns the Src descriptor containing `let b = a in b`.
|
||||
|
@ -33,13 +32,20 @@ getLetInner (Src left _ text) = Megaparsec.parseMaybe (unParser parseLetInnerOff
|
|||
where parseLetInnerOffset = do
|
||||
setSourcePos left
|
||||
_let
|
||||
nonemptyWhitespace
|
||||
_ <- label
|
||||
whitespace
|
||||
_ <- optional (do
|
||||
_ <- _colon
|
||||
expr)
|
||||
nonemptyWhitespace
|
||||
_ <- expr
|
||||
whitespace)
|
||||
_equal
|
||||
whitespace
|
||||
_ <- expr
|
||||
whitespace
|
||||
_ <- optional _in
|
||||
whitespace
|
||||
begin <- getSourcePos
|
||||
tokens <- Megaparsec.takeRest
|
||||
end <- getSourcePos
|
||||
|
@ -53,11 +59,15 @@ getLetAnnot (Src left _ text) = Megaparsec.parseMaybe (unParser parseLetAnnot) t
|
|||
where parseLetAnnot = do
|
||||
setSourcePos left
|
||||
_let
|
||||
nonemptyWhitespace
|
||||
_ <- label
|
||||
whitespace
|
||||
begin <- getSourcePos
|
||||
(tokens, _) <- Megaparsec.match $ optional (do
|
||||
_ <- _colon
|
||||
expr)
|
||||
nonemptyWhitespace
|
||||
_ <- expr
|
||||
whitespace)
|
||||
end <- getSourcePos
|
||||
_ <- Megaparsec.takeRest
|
||||
return (Src begin end tokens)
|
||||
|
@ -73,7 +83,7 @@ getLetIdentifier src@(Src left _ text) =
|
|||
where parseLetIdentifier = do
|
||||
setSourcePos left
|
||||
_let
|
||||
whitespace
|
||||
nonemptyWhitespace
|
||||
begin <- getSourcePos
|
||||
(tokens, _) <- Megaparsec.match label
|
||||
end <- getSourcePos
|
||||
|
|
|
@ -10,7 +10,7 @@ import Control.Applicative ((<|>))
|
|||
import Data.Bifunctor (first)
|
||||
import Data.Void (absurd, Void)
|
||||
|
||||
import Dhall.LSP.Backend.Parsing (getLetAnnot, getLetIdentifier,
|
||||
import Dhall.LSP.Backend.Parsing (getLetInner, getLetAnnot, getLetIdentifier,
|
||||
getLamIdentifier, getForallIdentifier)
|
||||
import Dhall.LSP.Backend.Diagnostics (Position, Range(..), rangeFromDhall)
|
||||
import Dhall.LSP.Backend.Dhall (WellTyped, fromWellTyped)
|
||||
|
@ -20,7 +20,10 @@ import Dhall.LSP.Backend.Dhall (WellTyped, fromWellTyped)
|
|||
-- that subexpression if possible.
|
||||
typeAt :: Position -> WellTyped -> Either String (Maybe Src, Expr Src Void)
|
||||
typeAt pos expr = do
|
||||
let expr' = fromWellTyped expr
|
||||
expr' <- case splitMultiLetSrc (fromWellTyped expr) of
|
||||
Just e -> return e
|
||||
Nothing -> Left "The impossible happened: failed to split let\
|
||||
\ blocks when preprocessing for typeAt'."
|
||||
(mSrc, typ) <- first show $ typeAt' pos empty expr'
|
||||
case mSrc of
|
||||
Just src -> return (Just src, normalize typ)
|
||||
|
@ -42,7 +45,6 @@ typeAt' pos _ctx (Note src (Pi _ _A _)) | Just src' <- getForallIdentifier src
|
|||
, pos `inside` src' =
|
||||
return (Just src', _A)
|
||||
|
||||
-- the input only contains singleton lets
|
||||
typeAt' pos ctx (Let (Binding { variable = x, value = a }) e@(Note src _)) | pos `inside` src = do
|
||||
_ <- typeWithA absurd ctx a
|
||||
let a' = shift 1 (V x 0) (normalize a)
|
||||
|
@ -72,12 +74,16 @@ typeAt' pos ctx expr = do
|
|||
|
||||
-- | Find the smallest Note-wrapped expression at the given position.
|
||||
exprAt :: Position -> Expr Src a -> Maybe (Expr Src a)
|
||||
exprAt pos e@(Note _ expr) = exprAt pos expr <|> Just e
|
||||
exprAt pos expr =
|
||||
exprAt pos e = do e' <- splitMultiLetSrc e
|
||||
exprAt' pos e'
|
||||
|
||||
exprAt' :: Position -> Expr Src a -> Maybe (Expr Src a)
|
||||
exprAt' pos e@(Note _ expr) = exprAt pos expr <|> Just e
|
||||
exprAt' pos expr =
|
||||
let subExprs = toListOf subExpressions expr
|
||||
in case [ (src, e) | (Note src e) <- subExprs, pos `inside` src ] of
|
||||
[] -> Nothing
|
||||
((src,e) : _) -> exprAt pos e <|> Just (Note src e)
|
||||
((src,e) : _) -> exprAt' pos e <|> Just (Note src e)
|
||||
|
||||
|
||||
-- | Find the smallest Src annotation containing the given position.
|
||||
|
@ -92,7 +98,12 @@ srcAt pos expr = do Note src _ <- exprAt pos expr
|
|||
-- textual error message.
|
||||
annotateLet :: Position -> WellTyped -> Either String (Src, Expr Src Void)
|
||||
annotateLet pos expr = do
|
||||
annotateLet' pos empty (fromWellTyped expr)
|
||||
expr' <- case splitMultiLetSrc (fromWellTyped expr) of
|
||||
Just e -> return e
|
||||
Nothing -> Left "The impossible happened: failed to split let\
|
||||
\ blocks when preprocessing for annotateLet'."
|
||||
annotateLet' pos empty expr'
|
||||
|
||||
|
||||
annotateLet' :: Position -> Context (Expr Src Void) -> Expr Src Void
|
||||
-> Either String (Src, Expr Src Void)
|
||||
|
@ -133,6 +144,13 @@ annotateLet' pos ctx expr = do
|
|||
(e:[]) -> annotateLet' pos ctx e
|
||||
_ -> Left "You weren't pointing at a let binder!"
|
||||
|
||||
-- Make sure all lets in a multilet are annotated with their source information
|
||||
splitMultiLetSrc :: Expr Src a -> Maybe (Expr Src a)
|
||||
splitMultiLetSrc (Note src (Let b (Let b' e))) = do
|
||||
src' <- getLetInner src
|
||||
splitMultiLetSrc (Note src (Let b (Note src' (Let b' e))))
|
||||
splitMultiLetSrc expr = subExpressions splitMultiLetSrc expr
|
||||
|
||||
-- Check if range lies completely inside a given subexpression.
|
||||
-- This version takes trailing whitespace into account
|
||||
-- (c.f. `sanitiseRange` from Backend.Diangostics).
|
||||
|
|
|
@ -37,7 +37,7 @@ hoveringSpec dir =
|
|||
case (extractContents typeHover, extractContents funcHover) of
|
||||
(HoverContents typeContent, HoverContents functionContent) -> do
|
||||
getValue typeContent `shouldBe` "Type"
|
||||
getValue functionContent `shouldBe` "{ home : Text, name : Text }"
|
||||
getValue functionContent `shouldBe` "\8704(_isAdmin : Bool) \8594 { home : Text, name : Text }"
|
||||
_ -> error "test failed"
|
||||
pure ()
|
||||
|
||||
|
|
Loading…
Reference in New Issue