Skip to content

Commit 320492c

Browse files
ChrisPennerChrisPenner
committed
Generalize node searching
1 parent 83e2a10 commit 320492c

File tree

2 files changed

+187
-12
lines changed

2 files changed

+187
-12
lines changed

‎unison-cli/src/Unison/LSP/Hover.hs

Lines changed: 10 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -125,19 +125,17 @@ hoverInfo uri pos =
125125
hoverInfoForLocalVar :: MaybeT Lsp Text
126126
hoverInfoForLocalVar = do
127127
Debug.debugM Debug.Temp "pos" pos
128-
let varFromNode = do
129-
node <- LSPQ.nodeAtPosition uri pos
130-
Debug.debugM Debug.Temp "node" node
131-
case node of
132-
-- Var mentions
133-
LSPQ.TermNode (Term.Var' v) -> pure $ v
134-
-- Var bindings
135-
LSPQ.TermNode (ABT.Abs'' v _body) -> pure $ v
136-
LSPQ.TermNode {} -> empty
137-
LSPQ.TypeNode {} -> empty
138-
LSPQ.PatternNode _pat -> empty
128+
localVar <- LSPQ.nodeAtPositionMatching uri pos \node -> do
129+
Debug.debugM Debug.Temp "node" node
130+
case node of
131+
LSPQ.TypeNode {} -> empty
132+
LSPQ.PatternNode {} -> empty
133+
LSPQ.TermNode trm -> case trm of
134+
(Term.Var' v) -> pure v
135+
(ABT.Abs'' v _body) -> pure v
136+
_ -> empty
137+
Debug.debugM Debug.Temp "localVar" localVar
139138
-- let varFromText = VFS.identifierAtPosition uri pos
140-
localVar <- varFromNode -- <|> varFromText
141139
FileAnalysis {localBindingTypes} <- FileAnalysis.getFileAnalysis uri
142140
Debug.debugM Debug.Temp "localBindingTypes" localBindingTypes
143141
Debug.debugM Debug.Temp "localVar" localVar

‎unison-cli/src/Unison/LSP/Queries.hs

Lines changed: 177 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,10 +7,15 @@ module Unison.LSP.Queries
77
getTypeDeclaration,
88
refAtPosition,
99
nodeAtPosition,
10+
nodeAtPositionMatching,
1011
refInTerm,
1112
refInType,
1213
findSmallestEnclosingNode,
1314
findSmallestEnclosingType,
15+
findSmallestEnclosingTypeMatching,
16+
findSmallestEnclosingNodeMatching,
17+
findSmallestEnclosingPattern,
18+
findSmallestEnclosingPatternMatching,
1419
refInDecl,
1520
SourceNode (..),
1621
)
@@ -268,6 +273,85 @@ findSmallestEnclosingNode pos term
268273
_ -> Nothing
269274
ann = getTermSpanAnn term
270275

276+
-- | Find the node in a term which contains the specified position, but none of its
277+
-- children contain that position
278+
findSmallestEnclosingNodeMatching :: forall m a. (MonadPlus m) => Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
279+
findSmallestEnclosingNodeMatching pos pred term
280+
| ABT.Term _ absAnn (ABT.Abs _ body) <- term =
281+
-- Abs nodes annotate the location of the var being bound, not the body of the binding, so we either match on
282+
-- the binding, or skip over them to the body.
283+
if absAnn `Ann.contains` pos
284+
then termPred term <|> findSmallestEnclosingNodeMatching pos pred body
285+
else findSmallestEnclosingNodeMatching pos pred body
286+
| annIsFilePosition ann && not (ann `Ann.contains` pos) = empty
287+
| Just r <- cleanImplicitUnit term = findSmallestEnclosingNodeMatching pos pred r
288+
| otherwise = do
289+
-- For leaf nodes we require that they be an in-file position, not Intrinsic or
290+
-- external.
291+
-- In some rare cases it's possible for an External/Intrinsic node to have children that
292+
-- ARE in the file, so we need to make sure we still crawl their children.
293+
let guardInFile = guard (annIsFilePosition ann)
294+
let bestChild = case ABT.out term of
295+
ABT.Tm f -> case f of
296+
Term.Int {} -> guardInFile *> termPred term
297+
Term.Nat {} -> guardInFile *> termPred term
298+
Term.Float {} -> guardInFile *> termPred term
299+
Term.Boolean {} -> guardInFile *> termPred term
300+
Term.Text {} -> guardInFile *> termPred term
301+
Term.Char {} -> guardInFile *> termPred term
302+
Term.Blank {} -> guardInFile *> termPred term
303+
Term.Ref {} -> guardInFile *> termPred term
304+
Term.Constructor {} -> guardInFile *> termPred term
305+
Term.Request {} -> guardInFile *> termPred term
306+
Term.Handle a b -> findSmallestEnclosingNodeMatching pos pred a <|> findSmallestEnclosingNodeMatching pos pred b
307+
Term.App a b ->
308+
-- We crawl the body of the App first because the annotations for certain
309+
-- lambda syntaxes get a bit squirrelly.
310+
-- Specifically Tuple constructor apps will have an annotation which spans the
311+
-- whole tuple, e.g. the annotation of the tuple constructor for `(1, 2)` will
312+
-- cover ALL of `(1, 2)`, so we check the body of the tuple app first to see
313+
-- if the cursor is on 1 or 2 before falling back on the annotation of the
314+
-- 'function' of the app.
315+
findSmallestEnclosingNodeMatching pos pred b <|> findSmallestEnclosingNodeMatching pos pred a
316+
Term.Ann a typ -> findSmallestEnclosingNodeMatching pos pred a <|> (findSmallestEnclosingTypeMatching pos typePred typ)
317+
Term.List xs -> altSum (findSmallestEnclosingNodeMatching pos pred <$> xs)
318+
Term.If cond a b -> findSmallestEnclosingNodeMatching pos pred cond <|> findSmallestEnclosingNodeMatching pos pred a <|> findSmallestEnclosingNodeMatching pos pred b
319+
Term.And l r -> findSmallestEnclosingNodeMatching pos pred l <|> findSmallestEnclosingNodeMatching pos pred r
320+
Term.Or l r -> findSmallestEnclosingNodeMatching pos pred l <|> findSmallestEnclosingNodeMatching pos pred r
321+
Term.Lam a -> findSmallestEnclosingNodeMatching pos pred a
322+
Term.LetRec _isTop xs y ->
323+
altSum (findSmallestEnclosingNodeMatching pos pred <$> xs)
324+
<|> findSmallestEnclosingNodeMatching pos pred y
325+
Term.Let _isTop a b ->
326+
findSmallestEnclosingNodeMatching pos pred a
327+
<|> findSmallestEnclosingNodeMatching pos pred b
328+
Term.Match a cases ->
329+
findSmallestEnclosingNodeMatching pos pred a
330+
<|> altSum (cases <&> \(MatchCase pat grd body) -> ((findSmallestEnclosingPatternMatching pos patPred pat) <|> (altMaybe grd >>= findSmallestEnclosingNodeMatching pos pred) <|> findSmallestEnclosingNodeMatching pos pred body))
331+
Term.TermLink {} -> guardInFile *> termPred term
332+
Term.TypeLink {} -> guardInFile *> termPred term
333+
ABT.Var _v -> guardInFile *> termPred term
334+
ABT.Cycle r -> findSmallestEnclosingNodeMatching pos pred r
335+
ABT.Abs _v r -> findSmallestEnclosingNodeMatching pos pred r
336+
let fallback = if annIsFilePosition ann then termPred term else empty
337+
bestChild <|> fallback
338+
where
339+
altMaybe :: Maybe x -> m x
340+
altMaybe = maybe empty pure
341+
-- tuples always end in an implicit unit, but it's annotated with the span of the whole
342+
-- tuple, which is problematic, so we need to detect and remove implicit tuples.
343+
-- We can detect them because we know that the last element of a tuple is always its
344+
-- implicit unit.
345+
cleanImplicitUnit :: Term Symbol Ann -> Maybe (Term Symbol Ann)
346+
cleanImplicitUnit = \case
347+
ABT.Tm' (Term.App (ABT.Tm' (Term.App (ABT.Tm' (Term.Constructor (ConstructorReference ref 0))) x)) trm)
348+
| ref == Builtins.pairRef && Term.amap (const ()) trm == Builtins.unitTerm () -> Just x
349+
_ -> Nothing
350+
ann = getTermSpanAnn term
351+
termPred = pred . TermNode
352+
typePred = pred . TypeNode
353+
patPred = pred . PatternNode
354+
271355
-- | Most nodes have the property that their annotation spans all their children, but there are some exceptions.
272356
getTermSpanAnn :: Term Symbol Ann -> Ann
273357
getTermSpanAnn tm = case ABT.out tm of
@@ -312,6 +396,50 @@ findSmallestEnclosingPattern pos pat
312396
| conRef == Builtins.pairRef && mayUnitRef == Builtins.unitRef -> Just pat1
313397
_ -> Nothing
314398

399+
findSmallestEnclosingPatternMatching ::
400+
forall m a.
401+
(Alternative m) =>
402+
Pos ->
403+
(Pattern.Pattern Ann -> m a) ->
404+
Pattern.Pattern Ann ->
405+
m a
406+
findSmallestEnclosingPatternMatching pos pred pat
407+
| Just validTargets <- cleanImplicitUnit pat = findSmallestEnclosingPatternMatching pos pred validTargets
408+
| annIsFilePosition (ann pat) && not (ann pat `Ann.contains` pos) = empty
409+
| otherwise = do
410+
-- For leaf nodes we require that they be an in-file position, not Intrinsic or
411+
-- external.
412+
-- In some rare cases it's possible for an External/Intrinsic node to have children that
413+
-- ARE in the file, so we need to make sure we still crawl their children.
414+
let guardInFile = guard (annIsFilePosition (ann pat))
415+
let bestChild = case pat of
416+
Pattern.Unbound {} -> guardInFile *> pred pat
417+
Pattern.Var {} -> guardInFile *> pred pat
418+
Pattern.Boolean {} -> guardInFile *> pred pat
419+
Pattern.Int {} -> guardInFile *> pred pat
420+
Pattern.Nat {} -> guardInFile *> pred pat
421+
Pattern.Float {} -> guardInFile *> pred pat
422+
Pattern.Text {} -> guardInFile *> pred pat
423+
Pattern.Char {} -> guardInFile *> pred pat
424+
Pattern.Constructor _loc _conRef pats -> altSum (findSmallestEnclosingPatternMatching pos pred <$> pats)
425+
Pattern.As _loc p -> findSmallestEnclosingPatternMatching pos pred p
426+
Pattern.EffectPure _loc p -> findSmallestEnclosingPatternMatching pos pred p
427+
Pattern.EffectBind _loc _conRef pats p -> altSum (findSmallestEnclosingPatternMatching pos pred <$> pats) <|> findSmallestEnclosingPatternMatching pos pred p
428+
Pattern.SequenceLiteral _loc pats -> altSum (findSmallestEnclosingPatternMatching pos pred <$> pats)
429+
Pattern.SequenceOp _loc p1 _op p2 -> findSmallestEnclosingPatternMatching pos pred p1 <|> findSmallestEnclosingPatternMatching pos pred p2
430+
let fallback = if annIsFilePosition (ann pat) then pred pat else empty
431+
bestChild <|> fallback
432+
where
433+
-- tuple patterns always end in an implicit unit, but it's annotated with the span of the whole
434+
-- tuple, which is problematic, so we need to detect and remove implicit tuples.
435+
-- We can detect them because we know that the last element of a tuple is always its
436+
-- implicit unit.
437+
cleanImplicitUnit :: Pattern.Pattern Ann -> Maybe (Pattern.Pattern Ann)
438+
cleanImplicitUnit = \case
439+
(Pattern.Constructor _loc (ConstructorReference conRef 0) [pat1, Pattern.Constructor _ (ConstructorReference mayUnitRef 0) _])
440+
| conRef == Builtins.pairRef && mayUnitRef == Builtins.unitRef -> Just pat1
441+
_ -> Nothing
442+
315443
-- | Find the node in a type which contains the specified position, but none of its
316444
-- children contain that position.
317445
-- This is helpful for finding the specific type reference of a given argument within a type arrow
@@ -348,6 +476,42 @@ findSmallestEnclosingType pos typ
348476
let fallback = if annIsFilePosition (ABT.annotation typ) then Just typ else Nothing
349477
bestChild <|> fallback
350478

479+
-- | Find the node in a type which contains the specified position, but none of its
480+
-- children contain that position.
481+
-- This is helpful for finding the specific type reference of a given argument within a type arrow
482+
-- that a position references.
483+
findSmallestEnclosingTypeMatching :: (Alternative m) => Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
484+
findSmallestEnclosingTypeMatching pos pred typ
485+
| -- Abs nodes annotate the location of the var being bound, not the body of the binding, so we just skip over them.
486+
ABT.Abs'' _ body <- typ =
487+
findSmallestEnclosingTypeMatching pos pred body
488+
| annIsFilePosition (ABT.annotation typ) && not (ABT.annotation typ `Ann.contains` pos) = empty
489+
| otherwise = do
490+
-- For leaf nodes we require that they be an in-file position, not Intrinsic or
491+
-- external.
492+
-- In some rare cases it's possible for an External/Intrinsic node to have children that
493+
-- ARE in the file, so we need to make sure we still crawl their children.
494+
let guardInFile = guard (annIsFilePosition (ABT.annotation typ))
495+
let bestChild = case ABT.out typ of
496+
ABT.Tm f -> case f of
497+
Type.Ref {} -> guardInFile *> pred typ
498+
Type.Arrow a b -> findSmallestEnclosingTypeMatching pos pred a <|> findSmallestEnclosingTypeMatching pos pred b
499+
Type.Effect effs rhs ->
500+
-- There's currently a bug in the annotations for effects which cause them to
501+
-- span larger than they should. As a workaround for now we just make sure to
502+
-- search the RHS before the effects.
503+
findSmallestEnclosingTypeMatching pos pred rhs <|> findSmallestEnclosingTypeMatching pos pred effs
504+
Type.App a b -> findSmallestEnclosingTypeMatching pos pred a <|> findSmallestEnclosingTypeMatching pos pred b
505+
Type.Forall r -> findSmallestEnclosingTypeMatching pos pred r
506+
Type.Ann a _kind -> findSmallestEnclosingTypeMatching pos pred a
507+
Type.Effects es -> altSum (findSmallestEnclosingTypeMatching pos pred <$> es)
508+
Type.IntroOuter a -> findSmallestEnclosingTypeMatching pos pred a
509+
ABT.Var _v -> guardInFile *> pred typ
510+
ABT.Cycle r -> findSmallestEnclosingTypeMatching pos pred r
511+
ABT.Abs _v r -> findSmallestEnclosingTypeMatching pos pred r
512+
let fallback = if annIsFilePosition (ABT.annotation typ) then pred typ else empty
513+
bestChild <|> fallback
514+
351515
-- | Returns the type reference the given position applies to within a Decl, if any.
352516
--
353517
-- I.e. if the cursor is over a type reference within a constructor signature or ability
@@ -376,6 +540,19 @@ nodeAtPosition uri (lspToUPos -> pos) = do
376540
hoistMaybe :: Maybe a -> MaybeT Lsp a
377541
hoistMaybe = MaybeT . pure
378542

543+
-- | Returns the ABT node at the provided position, matching a predicate.
544+
-- Does not return Decl nodes.
545+
nodeAtPositionMatching :: Uri -> Position -> (SourceNode Ann -> MaybeT Lsp a) -> MaybeT Lsp a
546+
nodeAtPositionMatching uri (lspToUPos -> pos) pred = do
547+
(FileSummary {termsBySymbol, testWatchSummary, exprWatchSummary}) <- getFileSummary uri
548+
549+
let (trms, typs) = termsBySymbol & foldMap \(_ann, _ref, trm, mayTyp) -> ([trm], toList mayTyp)
550+
( altMap (findSmallestEnclosingNodeMatching pos pred . removeInferredTypeAnnotations) trms
551+
<|> altMap (findSmallestEnclosingNodeMatching pos pred . removeInferredTypeAnnotations) (testWatchSummary ^.. folded . _4)
552+
<|> altMap (findSmallestEnclosingNodeMatching pos pred . removeInferredTypeAnnotations) (exprWatchSummary ^.. folded . _4)
553+
<|> altMap (findSmallestEnclosingTypeMatching pos (pred . TypeNode)) typs
554+
)
555+
379556
annIsFilePosition :: Ann -> Bool
380557
annIsFilePosition = \case
381558
Ann.Intrinsic -> False

0 commit comments

Comments
 (0)