diff options
author | alexbiehl <alex.biehl@gmail.com> | 2017-10-08 19:38:21 +0200 |
---|---|---|
committer | alexbiehl <alex.biehl@gmail.com> | 2017-10-08 19:38:21 +0200 |
commit | 671b62d104751fd0ab8daf6b9cda1b971abf331f (patch) | |
tree | 43e1605c5e49ce0cf6d060fffb838f23e0e136aa /haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | |
parent | 406030f2782590799e44470da7ca80e85f3cf026 (diff) | |
parent | e498b7871bfbee8b38858b546390246ddddb9509 (diff) |
Merge remote-tracking branch 'origin/ghc-head' into HEAD
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs')
-rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 30 |
1 files changed, 16 insertions, 14 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs index 9d273417..57ff72ff 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs @@ -84,13 +84,13 @@ variables = everythingInRenamedSource (var `Syb.combine` rec) where var term = case cast term of - (Just (GHC.L sspan (GHC.HsVar name))) -> + (Just ((GHC.L sspan (GHC.HsVar name)) :: GHC.LHsExpr GHC.GhcRn)) -> pure (sspan, RtkVar (GHC.unLoc name)) (Just (GHC.L _ (GHC.RecordCon (GHC.L sspan name) _ _ _))) -> pure (sspan, RtkVar name) _ -> empty rec term = case cast term of - Just (GHC.HsRecField (GHC.L sspan name) (_ :: GHC.LHsExpr GHC.Name) _) -> + Just (GHC.HsRecField (GHC.L sspan name) (_ :: GHC.LHsExpr GHC.GhcRn) _) -> pure (sspan, RtkVar name) _ -> empty @@ -99,7 +99,7 @@ types :: GHC.RenamedSource -> LTokenDetails types = everythingInRenamedSource ty where ty term = case cast term of - (Just (GHC.L sspan (GHC.HsTyVar _ name))) -> + (Just ((GHC.L sspan (GHC.HsTyVar _ name)) :: GHC.LHsType GHC.GhcRn)) -> pure (sspan, RtkType (GHC.unLoc name)) _ -> empty @@ -114,11 +114,11 @@ binds = everythingInRenamedSource (fun `Syb.combine` pat `Syb.combine` tvar) where fun term = case cast term of - (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.Name)) -> + (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.GhcRn)) -> pure (sspan, RtkBind name) _ -> empty pat term = case cast term of - (Just (GHC.L sspan (GHC.VarPat name))) -> + (Just ((GHC.L sspan (GHC.VarPat name)) :: GHC.LPat GHC.GhcRn)) -> pure (sspan, RtkBind (GHC.unLoc name)) (Just (GHC.L _ (GHC.ConPatIn (GHC.L sspan name) recs))) -> [(sspan, RtkVar name)] ++ everythingInRenamedSource rec recs @@ -126,11 +126,11 @@ binds = everythingInRenamedSource pure (sspan, RtkBind name) _ -> empty rec term = case cast term of - (Just (GHC.HsRecField (GHC.L sspan name) (_ :: GHC.LPat GHC.Name) _)) -> + (Just (GHC.HsRecField (GHC.L sspan name) (_ :: GHC.LPat GHC.GhcRn) _)) -> pure (sspan, RtkVar name) _ -> empty tvar term = case cast term of - (Just (GHC.L sspan (GHC.UserTyVar name))) -> + (Just ((GHC.L sspan (GHC.UserTyVar name)) :: GHC.LHsTyVarBndr GHC.GhcRn)) -> pure (sspan, RtkBind (GHC.unLoc name)) (Just (GHC.L _ (GHC.KindedTyVar (GHC.L sspan name) _))) -> pure (sspan, RtkBind name) @@ -150,21 +150,23 @@ decls (group, _, _, _) = concatMap ($ group) GHC.FamDecl fam -> pure . decl $ GHC.fdLName fam GHC.ClassDecl{..} -> [decl tcdLName] ++ concatMap sig tcdSigs fun term = case cast term of - (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.Name)) + (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.GhcRn)) | GHC.isExternalName name -> pure (sspan, RtkDecl name) _ -> empty con term = case cast term of - (Just cdcl) -> + (Just (cdcl :: GHC.ConDecl GHC.GhcRn)) -> map decl (GHC.getConNames cdcl) ++ everythingInRenamedSource 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 + (Just ((GHC.DataFamInstD (GHC.DataFamInstDecl eqn)) + :: GHC.InstDecl GHC.GhcRn)) + -> pure . tyref $ GHC.feqn_tycon $ GHC.hsib_body eqn + (Just (GHC.TyFamInstD (GHC.TyFamInstDecl eqn))) -> + pure . tyref $ GHC.feqn_tycon $ GHC.hsib_body eqn _ -> empty fld term = case cast term of - Just (field :: GHC.ConDeclField GHC.Name) + Just (field :: GHC.ConDeclField GHC.GhcRn) -> map (decl . fmap GHC.selectorFieldOcc) $ GHC.cd_fld_names field Nothing -> empty sig (GHC.L _ (GHC.TypeSig names _)) = map decl names @@ -181,7 +183,7 @@ imports src@(_, imps, _, _) = everythingInRenamedSource ie src ++ mapMaybe (imp . GHC.unLoc) imps where ie term = case cast term of - (Just (GHC.IEVar v)) -> pure $ var $ GHC.ieLWrappedName v + (Just ((GHC.IEVar v) :: GHC.IE GHC.GhcRn)) -> pure $ var $ GHC.ieLWrappedName v (Just (GHC.IEThingAbs t)) -> pure $ typ $ GHC.ieLWrappedName t (Just (GHC.IEThingAll t)) -> pure $ typ $ GHC.ieLWrappedName t (Just (GHC.IEThingWith t _ vs _fls)) -> |