diff options
| author | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-06-29 17:33:59 +0200 |
|---|---|---|
| committer | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-06-30 22:37:49 +0200 |
| commit | 46b1520fcc8ef56825bd42ecf1c1fa8ec899ee58 (patch) | |
| tree | 4731176c7554fa9693d491149348904c95d60559 | |
| parent | 5a86381db3d73b4b68fdaae5c150a84e91e80c09 (diff) | |
Make hyperlinker generate anchors for record field declarations.
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 16 |
1 files changed, 9 insertions, 7 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs index c32bb722..5efcd2ed 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs @@ -112,17 +112,19 @@ decls (group, _, _, _) = concatMap ($ group) ] where 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) + GHC.DataDecl name _ defn _ -> + [decl name] ++ concatMap con (GHC.dd_cons defn) + _ -> pure . decl $ GHC.tcdLName t 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) + con (GHC.L _ t) = + map decl (GHC.con_names t) ++ everything (<|>) fld t + fld term = case cast term of + Just field -> map decl $ GHC.cd_fld_names field + Nothing -> empty + decl (GHC.L sspan name) = (sspan, RtkDecl name) -- | Obtain details map for import declarations. -- |