diff options
| author | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-06-08 15:16:06 +0200 |
|---|---|---|
| committer | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-06-30 22:37:48 +0200 |
| commit | b31513dbacb48102b4c5d2fd6de1982161d81fae (patch) | |
| tree | 930866b10b934ceff08dd8c5091b61c0d63add87 | |
| parent | fab61bb80c2d8059e91aece7677cf349cd34a8db (diff) | |
Fix weird hyperlinking of parenthesized operators.
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 7 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs | 1 |
2 files changed, 7 insertions, 1 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs index 05d6a52e..2749096e 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs @@ -33,7 +33,7 @@ enrich :: GHC.RenamedSource -> [Token] -> [RichToken] enrich src = map $ \token -> RichToken { rtkToken = token - , rtkDetails = lookupBySpan (tkSpan token) detailsMap + , rtkDetails = enrichToken token detailsMap } where detailsMap = concat @@ -45,6 +45,11 @@ enrich src = type DetailsMap = [(GHC.SrcSpan, TokenDetails)] +enrichToken :: Token -> DetailsMap -> Maybe TokenDetails +enrichToken (Token typ _ spn) dm + | typ `elem` [TkIdentifier, TkOperator] = lookupBySpan spn dm +enrichToken _ _ = Nothing + lookupBySpan :: Span -> DetailsMap -> Maybe TokenDetails lookupBySpan tspan = listToMaybe . map snd . filter (matches tspan . fst) diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs index 0e1ad5b2..70a69279 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs @@ -37,6 +37,7 @@ data TokenType | TkCpp | TkPragma | TkUnknown + deriving (Eq) parse :: String -> [Token] parse = tokenize . tag . chunk |