aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlec Theriault <alec.theriault@gmail.com>2018-02-05 10:15:39 -0800
committeralexbiehl <alex.biehl@gmail.com>2018-02-05 22:01:04 +0100
commit1e335fc0828f6f1927c6d2a125919c59f04c0bc0 (patch)
tree4ca9d96b7e26088d8dfb614f1b7ff7f6a8744806
parent55bd7476bb28dc39fc7dea959fb75f81035d3600 (diff)
Hyperlink pattern synonyms and 'module' imports (#744)
Links to pattern synonyms are now generated, as well as links from modules in import lists. Fixes #731.
-rw-r--r--haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs14
1 files changed, 10 insertions, 4 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 361bc15d..841dff76 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -111,6 +111,8 @@ binds = everythingInRenamedSource
fun term = case cast term of
(Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.GhcRn)) ->
pure (sspan, RtkBind name)
+ (Just (GHC.PatSynBind (GHC.PSB (GHC.L sspan name) _ _ _ _))) ->
+ pure (sspan, RtkBind name)
_ -> empty
pat term = case cast term of
(Just ((GHC.L sspan (GHC.VarPat name)) :: GHC.LPat GHC.GhcRn)) ->
@@ -147,6 +149,8 @@ decls (group, _, _, _) = concatMap ($ group)
fun term = case cast term of
(Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.GhcRn))
| GHC.isExternalName name -> pure (sspan, RtkDecl name)
+ (Just (GHC.PatSynBind (GHC.PSB (GHC.L sspan name) _ _ _ _)))
+ | GHC.isExternalName name -> pure (sspan, RtkDecl name)
_ -> empty
con term = case cast term of
(Just (cdcl :: GHC.ConDecl GHC.GhcRn)) ->
@@ -165,6 +169,7 @@ decls (group, _, _, _) = concatMap ($ group)
-> map (decl . fmap GHC.selectorFieldOcc) $ GHC.cd_fld_names field
Nothing -> empty
sig (GHC.L _ (GHC.TypeSig names _)) = map decl names
+ sig (GHC.L _ (GHC.PatSynSig names _)) = map decl names
sig _ = []
decl (GHC.L sspan name) = (sspan, RtkDecl name)
tyref (GHC.L sspan name) = (sspan, RtkType name)
@@ -183,10 +188,11 @@ imports src@(_, imps, _, _) =
(Just (GHC.IEThingAll t)) -> pure $ typ $ GHC.ieLWrappedName t
(Just (GHC.IEThingWith t _ vs _fls)) ->
[typ $ GHC.ieLWrappedName t] ++ map (var . GHC.ieLWrappedName) vs
+ (Just (GHC.IEModuleContents m)) -> pure $ modu m
_ -> empty
typ (GHC.L sspan name) = (sspan, RtkType name)
var (GHC.L sspan name) = (sspan, RtkVar name)
- imp idecl | not . GHC.ideclImplicit $ idecl =
- let (GHC.L sspan name) = GHC.ideclName idecl
- in Just (sspan, RtkModule name)
- imp _ = Nothing
+ modu (GHC.L sspan name) = (sspan, RtkModule name)
+ imp idecl
+ | not . GHC.ideclImplicit $ idecl = Just (modu (GHC.ideclName idecl))
+ | otherwise = Nothing