diff options
| 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 |
| commit | 5a86381db3d73b4b68fdaae5c150a84e91e80c09 (patch) | |
| tree | f0a3ed0daa2df60ed854ebc1b0035faae07b3997 | |
| parent | 6cf5e45135ad48f140a76054b38e13eb83491d2a (diff) | |
Make hyperlinker generate correct anchors for data constructors.
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 13 |
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. -- |