diff options
| author | Zubin Duggal <zubin@cmi.ac.in> | 2020-04-03 19:45:36 +0530 | 
|---|---|---|
| committer | Matthew Pickering <matthewtpickering@gmail.com> | 2020-05-24 17:55:48 +0100 | 
| commit | 8134a3be2c01ab5f1b88fed86c4ad7cc2f417f0a (patch) | |
| tree | f4a7b5e427b4cf44c558938c95d7803ff7abc0e1 /haddock-api/src/Haddock | |
| parent | 8f340aef12df5f5df02d49ab5c6c5d7cccfa398b (diff) | |
update for hiefile-typeclass-info
Diffstat (limited to 'haddock-api/src/Haddock')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs | 34 | 
1 files changed, 20 insertions, 14 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"]  | 
