From b31513dbacb48102b4c5d2fd6de1982161d81fae Mon Sep 17 00:00:00 2001
From: Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com>
Date: Mon, 8 Jun 2015 15:16:06 +0200
Subject: Fix weird hyperlinking of parenthesized operators.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs    | 7 ++++++-
 haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs | 1 +
 2 files changed, 7 insertions(+), 1 deletion(-)

(limited to 'haddock-api/src/Haddock/Backends')

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
-- 
cgit v1.2.3