Skip to content

Commit

Permalink
Fix TyDef narrowToPosition (#2170)
Browse files Browse the repository at this point in the history
`STyDef` is not actually an atom and we need to recurse further.

| Recursing | TyDef |
|--------|--------|
| <img width="340" alt="false" src="https://github.com/user-attachments/assets/e42b5773-0c38-46bd-bb85-c0233bdbc290"> | <img width="340" alt="tydef" src="https://github.com/user-attachments/assets/84d88edd-50eb-40e2-bfb1-207167ad62e5"> | 


Closes #2169.
  • Loading branch information
xsebek authored Oct 12, 2024
1 parent 636be31 commit 188ff6b
Showing 1 changed file with 5 additions and 1 deletion.
6 changes: 5 additions & 1 deletion src/swarm-lang/Swarm/Language/LSP/Hover.hs
Original file line number Diff line number Diff line change
Expand Up @@ -113,6 +113,7 @@ narrowToPosition s0@(Syntax' _ t _ ty) pos = fromMaybe s0 $ case t of
SApp s1 s2 -> d s1 <|> d s2
SLet _ _ lv _ _ s1@(Syntax' _ _ _ lty) s2 -> d (locVarToSyntax' lv lty) <|> d s1 <|> d s2
SBind mlv _ _ _ s1@(Syntax' _ _ _ lty) s2 -> (mlv >>= d . flip locVarToSyntax' (getInnerType lty)) <|> d s1 <|> d s2
STydef typ typBody _ti s1 -> d s1 <|> Just (locVarToSyntax' typ $ fromPoly typBody)
SPair s1 s2 -> d s1 <|> d s2
SDelay s -> d s
SRcd m -> asum . map d . catMaybes . M.elems $ m
Expand All @@ -129,7 +130,6 @@ narrowToPosition s0@(Syntax' _ t _ ty) pos = fromMaybe s0 $ case t of
TVar {} -> Nothing
TRequire {} -> Nothing
TRequireDevice {} -> Nothing
STydef {} -> Nothing
-- these should not show up in surface language
TRef {} -> Nothing
TRobot {} -> Nothing
Expand All @@ -151,6 +151,8 @@ treeToMarkdown d (Node t children) =
T.unlines $ renderDoc d t : map (treeToMarkdown $ d + 1) children

class Show t => ExplainableType t where
fromPoly :: Polytype -> t

-- | Pretty print the type.
prettyType :: t -> Text

Expand All @@ -166,11 +168,13 @@ class Show t => ExplainableType t where
eq :: t -> Polytype -> Bool

instance ExplainableType () where
fromPoly = const ()
prettyType = const "?"
getInnerType = id
eq _ _ = False

instance ExplainableType Polytype where
fromPoly = id
prettyType = prettyTextLine
getInnerType = fmap $ \case
(l :->: _r) -> l
Expand Down

0 comments on commit 188ff6b

Please sign in to comment.