[commit: haddock] master: Make hyperlinker generate correct anchors for data constructors. (5a86381)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/haddock

On branch  : master
Link       : http://git.haskell.org/haddock.git/commitdiff/5a86381db3d73b4b68fdaae5c150a84e91e80c09

>---------------------------------------------------------------

commit 5a86381db3d73b4b68fdaae5c150a84e91e80c09
Author: Łukasz Hanuszczak <lukasz.hanuszczak at gmail.com>
Date:   Mon Jun 29 16:10:03 2015 +0200

    Make hyperlinker generate correct anchors for data constructors.


>---------------------------------------------------------------

5a86381db3d73b4b68fdaae5c150a84e91e80c09
 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 13 +++++++++----
 1 file changed, 9 insertions(+), 4 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 275f10e..c32bb72 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -107,17 +107,22 @@ binds =
 -- | Obtain details map for top-level declarations.
 decls :: GHC.RenamedSource -> DetailsMap
 decls (group, _, _, _) = concatMap ($ group)
-    [ map typ . concat . map GHC.group_tyclds . GHC.hs_tyclds
+    [ concat . map typ . concat . map GHC.group_tyclds . GHC.hs_tyclds
     , everything (<|>) fun
     ]
   where
-    typ (GHC.L _ t) =
-        let (GHC.L sspan name) = GHC.tcdLName t
-        in (sspan, RtkDecl name)
+    typ (GHC.L _ t) = case t of
+        GHC.DataDecl (GHC.L sspan name) _ defn _ ->
+            [(sspan, RtkDecl name)] ++ concatMap con (GHC.dd_cons defn)
+        _ ->
+            let (GHC.L sspan name) = GHC.tcdLName t
+            in pure (sspan, RtkDecl name)
     fun term = case cast term of
         (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ _ :: GHC.HsBind GHC.Name))
             | GHC.isExternalName name -> pure (sspan, RtkDecl name)
         _ -> empty
+    con (GHC.L _ t) = flip map (GHC.con_names t) $
+        \(GHC.L sspan name) -> (sspan, RtkDecl name)
 
 -- | Obtain details map for import declarations.
 --