aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorŁukasz Hanuszczak <lukasz.hanuszczak@gmail.com>2015-06-29 16:10:03 +0200
committerŁukasz Hanuszczak <lukasz.hanuszczak@gmail.com>2015-06-30 22:37:49 +0200
commit5a86381db3d73b4b68fdaae5c150a84e91e80c09 (patch)
treef0a3ed0daa2df60ed854ebc1b0035faae07b3997
parent6cf5e45135ad48f140a76054b38e13eb83491d2a (diff)
Make hyperlinker generate correct anchors for data constructors.
-rw-r--r--haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs13
1 files 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 275f10e9..c32bb722 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.
--