Hyperlinker: Links for TyOps, class methods and associated types

2 files changed, 44 insertions, 11 deletions

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 02c4ca0b..3c96db98 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -93,9 +93,12 @@ variables =
 types :: GHC.RenamedSource -> LTokenDetails
 types = everythingInRenamedSource ty
   where
+    ty :: forall a. Data a => a -> [(GHC.SrcSpan, TokenDetails)]
     ty term = case cast term of
         (Just ((GHC.L sspan (GHC.HsTyVar _ name)) :: GHC.LHsType GHC.GhcRn)) ->
             pure (sspan, RtkType (GHC.unLoc name))
+        (Just ((GHC.L sspan (GHC.HsOpTy l name r)) :: GHC.LHsType GHC.GhcRn)) ->
+            (sspan, RtkType (GHC.unLoc name)):(ty l ++ ty r)
         _ -> empty
 
 -- | Obtain details map for identifier bindings.
@@ -141,6 +144,7 @@ decls :: GHC.RenamedSource -> LTokenDetails
 decls (group, _, _, _) = concatMap ($ group)
     [ concat . map typ . concat . map GHC.group_tyclds . GHC.hs_tyclds
     , everythingInRenamedSource fun . GHC.hs_valds
+    , everythingInRenamedSource fix . GHC.hs_fixds
     , everythingInRenamedSource (con `Syb.combine` ins)
     ]
   where
@@ -148,7 +152,10 @@ decls (group, _, _, _) = concatMap ($ group)
         GHC.DataDecl { tcdLName = name } -> pure . decl $ name
         GHC.SynDecl name _ _ _ _ -> pure . decl $ name
         GHC.FamDecl fam -> pure . decl $ GHC.fdLName fam
-        GHC.ClassDecl{..} -> [decl tcdLName] ++ concatMap sig tcdSigs
+        GHC.ClassDecl{..} ->
+          [decl tcdLName]
+            ++ concatMap sig tcdSigs
+            ++ concatMap tyfam tcdATs
     fun term = case cast term of
         (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.GhcRn))
             | GHC.isExternalName name -> pure (sspan, RtkDecl name)
@@ -171,8 +178,14 @@ decls (group, _, _, _) = concatMap ($ group)
         Just (field :: GHC.ConDeclField GHC.GhcRn)
           -> map (decl . fmap GHC.selectorFieldOcc) $ GHC.cd_fld_names field
         Nothing -> empty
+    fix term = case cast term of
+        Just ((GHC.FixitySig names _) :: GHC.FixitySig GHC.GhcRn)
+          -> map decl names
+        Nothing -> empty
+    tyfam (GHC.L _ (GHC.FamilyDecl{..})) = [decl fdLName]
     sig (GHC.L _ (GHC.TypeSig names _)) = map decl names
     sig (GHC.L _ (GHC.PatSynSig names _)) = map decl names
+    sig (GHC.L _ (GHC.ClassOpSig _ names _)) = map decl names
     sig _ = []
     decl (GHC.L sspan name) = (sspan, RtkDecl name)
     tyref (GHC.L sspan name) = (sspan, RtkType name)
diff --git a/hypsrc-test/ref/src/Classes.html b/hypsrc-test/ref/src/Classes.html
index abff8877..d2604e82 100644
--- a/hypsrc-test/ref/src/Classes.html
+++ b/hypsrc-test/ref/src/Classes.html
@@ -60,8 +60,12 @@
       ></a
       ><span
       >    </span
-      ><span class="hs-identifier"
-      >bar</span
+      ><a name="bar"
+      ><a href="Classes.html#bar"
+	><span class="hs-identifier"
+	  >bar</span
+	  ></a
+	></a
       ><span
       > </span
       ><span class="hs-glyph"
@@ -87,8 +91,12 @@
       ></a
       ><span
       >    </span
-      ><span class="hs-identifier"
-      >baz</span
+      ><a name="baz"
+      ><a href="Classes.html#baz"
+	><span class="hs-identifier"
+	  >baz</span
+	  ></a
+	></a
       ><span
       > </span
       ><span class="hs-glyph"
@@ -361,8 +369,12 @@
       ></a
       ><span
       >    </span
-      ><span class="hs-identifier"
-      >quux</span
+      ><a name="quux"
+      ><a href="Classes.html#quux"
+	><span class="hs-identifier"
+	  >quux</span
+	  ></a
+	></a
       ><span
       > </span
       ><span class="hs-glyph"
@@ -470,8 +482,12 @@
       ></a
       ><span
       >    </span
-      ><span class="hs-identifier"
-      >norf</span
+      ><a name="norf"
+      ><a href="Classes.html#norf"
+	><span class="hs-identifier"
+	  >norf</span
+	  ></a
+	></a
       ><span
       > </span
       ><span class="hs-glyph"
@@ -703,8 +719,12 @@
       ></a
       ><span
       >    </span
-      ><span class="hs-identifier"
-      >plugh</span
+      ><a name="plugh"
+      ><a href="Classes.html#plugh"
+	><span class="hs-identifier"
+	  >plugh</span
+	  ></a
+	></a
       ><span
       > </span
       ><span class="hs-glyph"