diff options
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 15 | ||||
| -rw-r--r-- | hypsrc-test/ref/src/Classes.html | 40 |
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" |