diff options
| author | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-07-02 13:31:05 +0200 |
|---|---|---|
| committer | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-07-02 13:31:05 +0200 |
| commit | 28e93ceec440d0d1ed053bbf3c20e4bdcd6d5f4e (patch) | |
| tree | 2490debca28600f3eb51f14b7ecead0862fcdd87 | |
| parent | 5c01af0e605c2bd16382cbd0de7102f1fbc2f361 (diff) | |
Improve support for hyperlinking type families.
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 8 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs | 1 |
2 files changed, 8 insertions, 1 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs index b592326d..4b60ca37 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs @@ -129,7 +129,7 @@ binds = decls :: GHC.RenamedSource -> DetailsMap decls (group, _, _, _) = concatMap ($ group) [ concat . map typ . concat . map GHC.group_tyclds . GHC.hs_tyclds - , everything (<|>) (fun `combine` con) + , everything (<|>) (fun `combine` con `combine` ins) ] where typ (GHC.L _ t) = case t of @@ -144,10 +144,16 @@ decls (group, _, _, _) = concatMap ($ group) (Just cdcl) -> map decl (GHC.con_names cdcl) ++ everything (<|>) fld cdcl Nothing -> empty + ins term = case cast term of + (Just (GHC.DataFamInstD inst)) -> pure . tyref $ GHC.dfid_tycon inst + (Just (GHC.TyFamInstD (GHC.TyFamInstDecl (GHC.L _ eqn) _))) -> + pure . tyref $ GHC.tfe_tycon eqn + _ -> empty 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) + tyref (GHC.L sspan name) = (sspan, RtkType name) -- | Obtain details map for import declarations. -- diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs index 019075a1..37cc5377 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs @@ -197,6 +197,7 @@ keywords = , "type" , "where" , "forall" + , "family" , "mdo" ] |