[commit: haddock] master: Improve support for hyperlinking type families. (28e93ce)

[git at git.haskell.org]

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

On branch  : master
Link       : http://git.haskell.org/haddock.git/commitdiff/28e93ceec440d0d1ed053bbf3c20e4bdcd6d5f4e

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

commit 28e93ceec440d0d1ed053bbf3c20e4bdcd6d5f4e
Author: Łukasz Hanuszczak <lukasz.hanuszczak at gmail.com>
Date:   Thu Jul 2 13:31:05 2015 +0200

    Improve support for hyperlinking type families.


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

28e93ceec440d0d1ed053bbf3c20e4bdcd6d5f4e
 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs    | 8 +++++++-
 haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs | 1 +
 2 files changed, 8 insertions(+), 1 deletion(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index b592326..4b60ca3 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 019075a..37cc537 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"
     ]