Skip to content

Commit 2448d98

Browse files
ChrisPennerChrisPenner
committed
Clean up duplicate combinators
1 parent d6b738b commit 2448d98

File tree

1 file changed

+8
-149
lines changed

1 file changed

+8
-149
lines changed

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

Lines changed: 8 additions & 149 deletions
Original file line numberDiff line numberDiff line change
@@ -202,76 +202,7 @@ instance Functor SourceNode where
202202
-- | Find the node in a term which contains the specified position, but none of its
203203
-- children contain that position.
204204
findSmallestEnclosingNode :: Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
205-
findSmallestEnclosingNode pos term
206-
| ABT.Term _ absAnn (ABT.Abs _ body) <- term =
207-
-- Abs nodes annotate the location of the var being bound, not the body of the binding, so we either match on
208-
-- the binding, or skip over them to the body.
209-
if absAnn `Ann.contains` pos
210-
then Just (TermNode term)
211-
else findSmallestEnclosingNode pos body
212-
| annIsFilePosition ann && not (ann `Ann.contains` pos) = Nothing
213-
| Just r <- cleanImplicitUnit term = findSmallestEnclosingNode pos r
214-
| otherwise = do
215-
-- For leaf nodes we require that they be an in-file position, not Intrinsic or
216-
-- external.
217-
-- In some rare cases it's possible for an External/Intrinsic node to have children that
218-
-- ARE in the file, so we need to make sure we still crawl their children.
219-
let guardInFile = guard (annIsFilePosition ann)
220-
let bestChild = case ABT.out term of
221-
ABT.Tm f -> case f of
222-
Term.Int {} -> guardInFile *> Just (TermNode term)
223-
Term.Nat {} -> guardInFile *> Just (TermNode term)
224-
Term.Float {} -> guardInFile *> Just (TermNode term)
225-
Term.Boolean {} -> guardInFile *> Just (TermNode term)
226-
Term.Text {} -> guardInFile *> Just (TermNode term)
227-
Term.Char {} -> guardInFile *> Just (TermNode term)
228-
Term.Blank {} -> guardInFile *> Just (TermNode term)
229-
Term.Ref {} -> guardInFile *> Just (TermNode term)
230-
Term.Constructor {} -> guardInFile *> Just (TermNode term)
231-
Term.Request {} -> guardInFile *> Just (TermNode term)
232-
Term.Handle a b -> findSmallestEnclosingNode pos a <|> findSmallestEnclosingNode pos b
233-
Term.App a b ->
234-
-- We crawl the body of the App first because the annotations for certain
235-
-- lambda syntaxes get a bit squirrelly.
236-
-- Specifically Tuple constructor apps will have an annotation which spans the
237-
-- whole tuple, e.g. the annotation of the tuple constructor for `(1, 2)` will
238-
-- cover ALL of `(1, 2)`, so we check the body of the tuple app first to see
239-
-- if the cursor is on 1 or 2 before falling back on the annotation of the
240-
-- 'function' of the app.
241-
findSmallestEnclosingNode pos b <|> findSmallestEnclosingNode pos a
242-
Term.Ann a typ -> findSmallestEnclosingNode pos a <|> (TypeNode <$> findSmallestEnclosingType pos typ)
243-
Term.List xs -> altSum (findSmallestEnclosingNode pos <$> xs)
244-
Term.If cond a b -> findSmallestEnclosingNode pos cond <|> findSmallestEnclosingNode pos a <|> findSmallestEnclosingNode pos b
245-
Term.And l r -> findSmallestEnclosingNode pos l <|> findSmallestEnclosingNode pos r
246-
Term.Or l r -> findSmallestEnclosingNode pos l <|> findSmallestEnclosingNode pos r
247-
Term.Lam a -> findSmallestEnclosingNode pos a
248-
Term.LetRec _isTop xs y ->
249-
altSum (findSmallestEnclosingNode pos <$> xs)
250-
<|> findSmallestEnclosingNode pos y
251-
Term.Let _isTop a b ->
252-
findSmallestEnclosingNode pos a
253-
<|> findSmallestEnclosingNode pos b
254-
Term.Match a cases ->
255-
findSmallestEnclosingNode pos a
256-
<|> altSum (cases <&> \(MatchCase pat grd body) -> ((PatternNode <$> findSmallestEnclosingPattern pos pat) <|> (grd >>= findSmallestEnclosingNode pos) <|> findSmallestEnclosingNode pos body))
257-
Term.TermLink {} -> guardInFile *> Just (TermNode term)
258-
Term.TypeLink {} -> guardInFile *> Just (TermNode term)
259-
ABT.Var _v -> guardInFile *> Just (TermNode term)
260-
ABT.Cycle r -> findSmallestEnclosingNode pos r
261-
ABT.Abs _v r -> findSmallestEnclosingNode pos r
262-
let fallback = if annIsFilePosition ann then Just (TermNode term) else Nothing
263-
bestChild <|> fallback
264-
where
265-
-- tuples always end in an implicit unit, but it's annotated with the span of the whole
266-
-- tuple, which is problematic, so we need to detect and remove implicit tuples.
267-
-- We can detect them because we know that the last element of a tuple is always its
268-
-- implicit unit.
269-
cleanImplicitUnit :: Term Symbol Ann -> Maybe (Term Symbol Ann)
270-
cleanImplicitUnit = \case
271-
ABT.Tm' (Term.App (ABT.Tm' (Term.App (ABT.Tm' (Term.Constructor (ConstructorReference ref 0))) x)) trm)
272-
| ref == Builtins.pairRef && Term.amap (const ()) trm == Builtins.unitTerm () -> Just x
273-
_ -> Nothing
274-
ann = getTermSpanAnn term
205+
findSmallestEnclosingNode pos term = findSmallestEnclosingNodeMatching pos pure term
275206

276207
-- | Find the node in a term which contains the specified position, but none of its
277208
-- children contain that position
@@ -359,42 +290,7 @@ getTermSpanAnn tm = case ABT.out tm of
359290
_ -> ABT.annotation tm
360291

361292
findSmallestEnclosingPattern :: Pos -> Pattern.Pattern Ann -> Maybe (Pattern.Pattern Ann)
362-
findSmallestEnclosingPattern pos pat
363-
| Just validTargets <- cleanImplicitUnit pat = findSmallestEnclosingPattern pos validTargets
364-
| annIsFilePosition (ann pat) && not (ann pat `Ann.contains` pos) = Nothing
365-
| otherwise = do
366-
-- For leaf nodes we require that they be an in-file position, not Intrinsic or
367-
-- external.
368-
-- In some rare cases it's possible for an External/Intrinsic node to have children that
369-
-- ARE in the file, so we need to make sure we still crawl their children.
370-
let guardInFile = guard (annIsFilePosition (ann pat))
371-
let bestChild = case pat of
372-
Pattern.Unbound {} -> guardInFile *> Just pat
373-
Pattern.Var {} -> guardInFile *> Just pat
374-
Pattern.Boolean {} -> guardInFile *> Just pat
375-
Pattern.Int {} -> guardInFile *> Just pat
376-
Pattern.Nat {} -> guardInFile *> Just pat
377-
Pattern.Float {} -> guardInFile *> Just pat
378-
Pattern.Text {} -> guardInFile *> Just pat
379-
Pattern.Char {} -> guardInFile *> Just pat
380-
Pattern.Constructor _loc _conRef pats -> altSum (findSmallestEnclosingPattern pos <$> pats)
381-
Pattern.As _loc p -> findSmallestEnclosingPattern pos p
382-
Pattern.EffectPure _loc p -> findSmallestEnclosingPattern pos p
383-
Pattern.EffectBind _loc _conRef pats p -> altSum (findSmallestEnclosingPattern pos <$> pats) <|> findSmallestEnclosingPattern pos p
384-
Pattern.SequenceLiteral _loc pats -> altSum (findSmallestEnclosingPattern pos <$> pats)
385-
Pattern.SequenceOp _loc p1 _op p2 -> findSmallestEnclosingPattern pos p1 <|> findSmallestEnclosingPattern pos p2
386-
let fallback = if annIsFilePosition (ann pat) then Just pat else Nothing
387-
bestChild <|> fallback
388-
where
389-
-- tuple patterns always end in an implicit unit, but it's annotated with the span of the whole
390-
-- tuple, which is problematic, so we need to detect and remove implicit tuples.
391-
-- We can detect them because we know that the last element of a tuple is always its
392-
-- implicit unit.
393-
cleanImplicitUnit :: Pattern.Pattern Ann -> Maybe (Pattern.Pattern Ann)
394-
cleanImplicitUnit = \case
395-
(Pattern.Constructor _loc (ConstructorReference conRef 0) [pat1, Pattern.Constructor _ (ConstructorReference mayUnitRef 0) _])
396-
| conRef == Builtins.pairRef && mayUnitRef == Builtins.unitRef -> Just pat1
397-
_ -> Nothing
293+
findSmallestEnclosingPattern pos pat = findSmallestEnclosingPatternMatching pos pure pat
398294

399295
findSmallestEnclosingPatternMatching ::
400296
forall m a.
@@ -445,36 +341,7 @@ findSmallestEnclosingPatternMatching pos pred pat
445341
-- This is helpful for finding the specific type reference of a given argument within a type arrow
446342
-- that a position references.
447343
findSmallestEnclosingType :: Pos -> Type Symbol Ann -> Maybe (Type Symbol Ann)
448-
findSmallestEnclosingType pos typ
449-
| -- Abs nodes annotate the location of the var being bound, not the body of the binding, so we just skip over them.
450-
ABT.Abs'' _ body <- typ =
451-
findSmallestEnclosingType pos body
452-
| annIsFilePosition (ABT.annotation typ) && not (ABT.annotation typ `Ann.contains` pos) = Nothing
453-
| otherwise = do
454-
-- For leaf nodes we require that they be an in-file position, not Intrinsic or
455-
-- external.
456-
-- In some rare cases it's possible for an External/Intrinsic node to have children that
457-
-- ARE in the file, so we need to make sure we still crawl their children.
458-
let guardInFile = guard (annIsFilePosition (ABT.annotation typ))
459-
let bestChild = case ABT.out typ of
460-
ABT.Tm f -> case f of
461-
Type.Ref {} -> guardInFile *> Just typ
462-
Type.Arrow a b -> findSmallestEnclosingType pos a <|> findSmallestEnclosingType pos b
463-
Type.Effect effs rhs ->
464-
-- There's currently a bug in the annotations for effects which cause them to
465-
-- span larger than they should. As a workaround for now we just make sure to
466-
-- search the RHS before the effects.
467-
findSmallestEnclosingType pos rhs <|> findSmallestEnclosingType pos effs
468-
Type.App a b -> findSmallestEnclosingType pos a <|> findSmallestEnclosingType pos b
469-
Type.Forall r -> findSmallestEnclosingType pos r
470-
Type.Ann a _kind -> findSmallestEnclosingType pos a
471-
Type.Effects es -> altSum (findSmallestEnclosingType pos <$> es)
472-
Type.IntroOuter a -> findSmallestEnclosingType pos a
473-
ABT.Var _v -> guardInFile *> Just typ
474-
ABT.Cycle r -> findSmallestEnclosingType pos r
475-
ABT.Abs _v r -> findSmallestEnclosingType pos r
476-
let fallback = if annIsFilePosition (ABT.annotation typ) then Just typ else Nothing
477-
bestChild <|> fallback
344+
findSmallestEnclosingType pos typ = findSmallestEnclosingTypeMatching pos pure typ
478345

479346
-- | Find the node in a type which contains the specified position, but none of its
480347
-- children contain that position.
@@ -527,20 +394,12 @@ refInDecl p (DD.asDataDecl -> dd) =
527394
-- | Returns the ABT node at the provided position.
528395
-- Does not return Decl nodes.
529396
nodeAtPosition :: Uri -> Position -> MaybeT Lsp (SourceNode Ann)
530-
nodeAtPosition uri (lspToUPos -> pos) = do
531-
(FileSummary {termsBySymbol, testWatchSummary, exprWatchSummary}) <- getFileSummary uri
397+
nodeAtPosition uri pos = nodeAtPositionMatching uri pos pure
532398

533-
let (trms, typs) = termsBySymbol & foldMap \(_ann, _ref, trm, mayTyp) -> ([trm], toList mayTyp)
534-
( altMap (hoistMaybe . findSmallestEnclosingNode pos . removeInferredTypeAnnotations) trms
535-
<|> altMap (hoistMaybe . findSmallestEnclosingNode pos . removeInferredTypeAnnotations) (testWatchSummary ^.. folded . _4)
536-
<|> altMap (hoistMaybe . findSmallestEnclosingNode pos . removeInferredTypeAnnotations) (exprWatchSummary ^.. folded . _4)
537-
<|> altMap (fmap TypeNode . hoistMaybe . findSmallestEnclosingType pos) typs
538-
)
539-
where
540-
hoistMaybe :: Maybe a -> MaybeT Lsp a
541-
hoistMaybe = MaybeT . pure
542-
543-
-- | Returns the ABT node at the provided position, matching a predicate.
399+
-- | Search the ABT for nodes which intersect at a given position, running the
400+
-- provided selector on them and aligning results to prefer smaller containing nodes first.
401+
-- The caller may use either 'pure' or 'empty' in the selector to select or ignore a given option.
402+
--
544403
-- Does not return Decl nodes.
545404
nodeAtPositionMatching :: Uri -> Position -> (SourceNode Ann -> MaybeT Lsp a) -> MaybeT Lsp a
546405
nodeAtPositionMatching uri (lspToUPos -> pos) pred = do

0 commit comments

Comments
 (0)