diff options
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs | 34 | ||||
| -rw-r--r-- | hypsrc-test/ref/src/Types.html | 56 |
2 files changed, 60 insertions, 30 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs index e01d7114..12f37ced 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs @@ -13,6 +13,7 @@ import Haddock.Backends.Hyperlinker.Utils import qualified Data.ByteString as BS import GHC.Iface.Ext.Types +import GHC.Iface.Ext.Utils ( isEvidenceContext , emptyNodeInfo ) import GHC.Unit.Module ( ModuleName, moduleNameString ) import GHC.Types.Name ( getOccString, isInternalName, Name, nameModule, nameUnique ) import GHC.Types.SrcLoc @@ -105,6 +106,7 @@ renderWithAst srcs Node{..} toks = anchored $ case toks of _ -> go nodeChildren toks where + nodeInfo = maybe emptyNodeInfo id (Map.lookup SourceInfo $ getSourcedNodeInfo sourcedNodeInfo) go _ [] = mempty go [] xs = foldMap renderToken xs go (cur:rest) xs = @@ -139,8 +141,9 @@ richToken srcs details Token{..} contexts = concatMap (Set.elems . identInfo) . Map.elems . nodeIdentifiers $ details - -- pick an arbitary identifier to hyperlink with - identDet = Map.lookupMin . nodeIdentifiers $ details + -- pick an arbitary non-evidence identifier to hyperlink with + identDet = Map.lookupMin $ Map.filter notEvidence $ nodeIdentifiers $ details + notEvidence = not . any isEvidenceContext . identInfo -- If we have name information, we can make links linked = case identDet of @@ -163,7 +166,8 @@ annotate ni content = | otherwise = mempty annotation = typ ++ identTyps typ = unlines (nodeType ni) - typedIdents = [ (n,t) | (n, identType -> Just t) <- Map.toList $ nodeIdentifiers ni ] + typedIdents = [ (n,t) | (n, c@(identType -> Just t)) <- Map.toList $ nodeIdentifiers ni + , not (any isEvidenceContext $ identInfo c) ] identTyps | length typedIdents > 1 || null (nodeType ni) = concatMap (\(n,t) -> printName n ++ " :: " ++ t ++ "\n") typedIdents @@ -176,17 +180,19 @@ richTokenStyle :: Bool -- ^ are we lacking a type annotation? -> ContextInfo -- ^ in what context did this token show up? -> [StyleClass] -richTokenStyle True Use = ["hs-type"] -richTokenStyle False Use = ["hs-var"] -richTokenStyle _ RecField{} = ["hs-var"] -richTokenStyle _ PatternBind{} = ["hs-var"] -richTokenStyle _ MatchBind{} = ["hs-var"] -richTokenStyle _ TyVarBind{} = ["hs-type"] -richTokenStyle _ ValBind{} = ["hs-var"] -richTokenStyle _ TyDecl = ["hs-type"] -richTokenStyle _ ClassTyDecl{} = ["hs-type"] -richTokenStyle _ Decl{} = ["hs-var"] -richTokenStyle _ IEThing{} = [] -- could be either a value or type +richTokenStyle True Use = ["hs-type"] +richTokenStyle False Use = ["hs-var"] +richTokenStyle _ RecField{} = ["hs-var"] +richTokenStyle _ PatternBind{} = ["hs-var"] +richTokenStyle _ MatchBind{} = ["hs-var"] +richTokenStyle _ TyVarBind{} = ["hs-type"] +richTokenStyle _ ValBind{} = ["hs-var"] +richTokenStyle _ TyDecl = ["hs-type"] +richTokenStyle _ ClassTyDecl{} = ["hs-type"] +richTokenStyle _ Decl{} = ["hs-var"] +richTokenStyle _ IEThing{} = [] -- could be either a value or type +richTokenStyle _ EvidenceVarBind{} = [] +richTokenStyle _ EvidenceVarUse{} = [] tokenStyle :: TokenType -> [StyleClass] tokenStyle TkIdentifier = ["hs-identifier"] diff --git a/hypsrc-test/ref/src/Types.html b/hypsrc-test/ref/src/Types.html index e08382dd..835fafb0 100644 --- a/hypsrc-test/ref/src/Types.html +++ b/hypsrc-test/ref/src/Types.html @@ -699,8 +699,11 @@ ><span > </span ><span class="annot" - ><a href="Types.html#Bar" - ><span class="hs-identifier hs-type" + ><span class="annottext" + >Quux +</span + ><a href="Types.html#Bar" + ><span class="hs-identifier hs-var" >Bar</span ></a ></span @@ -761,8 +764,11 @@ ><span > </span ><span class="annot" - ><a href="Types.html#Baz" - ><span class="hs-identifier hs-type" + ><span class="annottext" + >Quux +</span + ><a href="Types.html#Baz" + ><span class="hs-identifier hs-var" >Baz</span ></a ></span @@ -864,8 +870,11 @@ ><span > </span ><span class="annot" - ><a href="Types.html#Bar" - ><span class="hs-identifier hs-type" + ><span class="annottext" + >Quux +</span + ><a href="Types.html#Bar" + ><span class="hs-identifier hs-var" >Bar</span ></a ></span @@ -926,8 +935,11 @@ ><span > </span ><span class="annot" - ><a href="Types.html#Baz" - ><span class="hs-identifier hs-type" + ><span class="annottext" + >Quux +</span + ><a href="Types.html#Baz" + ><span class="hs-identifier hs-var" >Baz</span ></a ></span @@ -1060,8 +1072,11 @@ ><span > </span ><span class="annot" - ><a href="Types.html#Bar" - ><span class="hs-identifier hs-type" + ><span class="annottext" + >Quux +</span + ><a href="Types.html#Bar" + ><span class="hs-identifier hs-var" >Bar</span ></a ></span @@ -1112,8 +1127,11 @@ ><span > </span ><span class="annot" - ><a href="Types.html#Baz" - ><span class="hs-identifier hs-type" + ><span class="annottext" + >Quux +</span + ><a href="Types.html#Baz" + ><span class="hs-identifier hs-var" >Baz</span ></a ></span @@ -1207,8 +1225,11 @@ ><span class="hs-special" >(</span ><span class="annot" - ><a href="Types.html#Bar" - ><span class="hs-identifier hs-type" + ><span class="annottext" + >Quux +</span + ><a href="Types.html#Bar" + ><span class="hs-identifier hs-var" >Bar</span ></a ></span @@ -1259,8 +1280,11 @@ ><span class="hs-special" >(</span ><span class="annot" - ><a href="Types.html#Baz" - ><span class="hs-identifier hs-type" + ><span class="annottext" + >Quux +</span + ><a href="Types.html#Baz" + ><span class="hs-identifier hs-var" >Baz</span ></a ></span |