Skip to content

Commit

Permalink
Improve documentation for Evidence tree rendering
Browse files Browse the repository at this point in the history
Also, add extensive note about skipping 'EvLetBinding' evidence nodes.
  • Loading branch information
fendor committed Oct 23, 2024
1 parent eed6ba4 commit cfd73c7
Showing 1 changed file with 48 additions and 9 deletions.
57 changes: 48 additions & 9 deletions ghcide/src/Development/IDE/Spans/AtPoint.hs
Original file line number Diff line number Diff line change
Expand Up @@ -269,12 +269,26 @@ atPoint IdeOptions{} (HAR _ (hf :: HieASTs a) rf _ (kind :: HieKind hietype)) (D
prettyName :: (Either ModuleName Name, IdentifierDetails hietype) -> IO T.Text
prettyName (Right n, dets)
-- We want to print evidence variable using a readable tree structure.
| any isEvidenceUse (identInfo dets) = pure $ maybe "" (printOutputable . renderEvidenceTree) (getEvidenceTree rf n) <> "\n"
| otherwise = pure $ T.unlines $
wrapHaskell (printOutputable n <> maybe "" (" :: " <>) ((prettyType <$> identType dets) <|> maybeKind))
: maybeToList (pretty (definedAt n) (prettyPackageName n))
++ catMaybes [ T.unlines . spanDocToMarkdown <$> lookupNameEnv dm n
]
-- Evidence variables contain information why a particular instance or
-- type equality was chosen, paired with location information.
| any isEvidenceUse (identInfo dets) =
let
-- The evidence tree may not be present for some reason, e.g., the 'Name' is not
-- present in the tree.
-- Thus, we need to handle it here, but in practice, this should never be 'Nothing'.
evidenceTree = maybe "" (printOutputable . renderEvidenceTree) (getEvidenceTree rf n)
in
pure $ evidenceTree <> "\n"
-- Identifier details that are not evidence variables are used to display type information and
-- documentation of that name.
| otherwise =
let
typeSig = wrapHaskell (printOutputable n <> maybe "" (" :: " <>) ((prettyType <$> identType dets) <|> maybeKind))
definitionLoc = maybeToList (pretty (definedAt n) (prettyPackageName n))
docs = maybeToList (T.unlines . spanDocToMarkdown <$> lookupNameEnv dm n)
in
pure $ T.unlines $
[typeSig] ++ definitionLoc ++ docs
where maybeKind = fmap printOutputable $ safeTyThingType =<< lookupNameEnv km n
pretty Nothing Nothing = Nothing
pretty (Just define) Nothing = Just $ define <> "\n"
Expand Down Expand Up @@ -337,6 +351,31 @@ atPoint IdeOptions{} (HAR _ (hf :: HieASTs a) rf _ (kind :: HieKind hietype)) (D
renderEvidenceTree :: Tree (EvidenceInfo a) -> SDoc
-- However, if the root constraint is simply a<n indirection (via let) to a single other constraint,
-- we can still skip rendering it
-- The evidence ghc generates is made up of a few primitives, like @WpLet@ (let bindings),
-- @WpEvLam@ (lambda abstractions) and so on.
-- The let binding refers to these lets.
--
-- For example, evidence for @Show ([Int], Bool)@ might look like:
--
-- @
-- $dShow,[]IntBool = $fShow,[]IntBool
-- -- indirection, we don't gain anything by printing this
-- $fShow,[]IntBool = $dShow, $fShow[]Int $fShowBool
-- -- This is the root "let" we render as a tree
-- $fShow[]Int = $dShow[] $fShowInt
-- -- second level let, collapse it into its parent $fShow,[]IntBool
-- $fShowInt = base:Data.Int.$dShowInt
-- -- indirection, remove it
-- $fShowBool = base:Data.Bool.$dShowBool
-- -- indirection, remove it
--
-- in $dShow,[]IntBool
-- @
--
-- On doing this we end up with the tree @Show ([Int], Bool) -> (Show (,), Show [], Show Int, Show Bool)@
--
-- It is also quite helpful to look at the @.hie@ file directly to see how the
-- evidence information is presented on disk. @hiedb dump <mod.hie>@
renderEvidenceTree (T.Node (EvidenceInfo{evidenceDetails=Just (EvLetBind _,_,_)}) [x])
= renderEvidenceTree x
renderEvidenceTree (T.Node (EvidenceInfo{evidenceDetails=Just (EvLetBind _,_,_), ..}) xs)
Expand All @@ -351,15 +390,15 @@ atPoint IdeOptions{} (HAR _ (hf :: HieASTs a) rf _ (kind :: HieKind hietype)) (D
= vcat (map renderEvidenceTree' xs)
renderEvidenceTree' (T.Node (EvidenceInfo{..}) _)
= hang (text "- `" O.<> expandType evidenceType O.<> "`") 2 $
vcat $
printDets evidenceSpan evidenceDetails : map (text . T.unpack) (maybeToList $ definedAt evidenceVar)
vcat $
printDets evidenceSpan evidenceDetails : map (text . T.unpack) (maybeToList $ definedAt evidenceVar)

printDets :: RealSrcSpan -> Maybe (EvVarSource, Scope, Maybe Span) -> SDoc
printDets _ Nothing = text "using an external instance"
printDets ospn (Just (src,_,mspn)) = pprSrc
$$ text "at" <+> text (T.unpack $ srcSpanToMdLink location)
where
location = realSrcSpanToLocation $ traceShowId spn
location = realSrcSpanToLocation spn
-- Use the bind span if we have one, else use the occurrence span
spn = fromMaybe ospn mspn
pprSrc = case src of
Expand Down

0 comments on commit cfd73c7

Please sign in to comment.