diff options
Diffstat (limited to 'compiler/GHC/Parser/PostProcess/Haddock.hs')
| -rw-r--r-- | compiler/GHC/Parser/PostProcess/Haddock.hs | 30 |
1 files changed, 19 insertions, 11 deletions
diff --git a/compiler/GHC/Parser/PostProcess/Haddock.hs b/compiler/GHC/Parser/PostProcess/Haddock.hs index 0837cac70e..21f74a878e 100644 --- a/compiler/GHC/Parser/PostProcess/Haddock.hs +++ b/compiler/GHC/Parser/PostProcess/Haddock.hs @@ -519,15 +519,14 @@ instance HasHaddock (HsDecl GhcPs) where , DataFamInstDecl { dfid_eqn } <- dfid_inst = do dfid_eqn' <- case dfid_eqn of - HsIB _ (FamEqn { feqn_tycon, feqn_bndrs, feqn_pats, feqn_fixity, feqn_rhs }) + FamEqn { feqn_tycon, feqn_bndrs, feqn_pats, feqn_fixity, feqn_rhs } -> do registerHdkA feqn_tycon feqn_rhs' <- addHaddock feqn_rhs - pure $ - HsIB noExtField (FamEqn { + pure $ FamEqn { feqn_ext = noExtField, feqn_tycon, feqn_bndrs, feqn_pats, feqn_fixity, - feqn_rhs = feqn_rhs' }) + feqn_rhs = feqn_rhs' } pure $ InstD noExtField (DataFamInstD { dfid_ext = noExtField, dfid_inst = DataFamInstDecl { dfid_eqn = dfid_eqn' } }) @@ -690,7 +689,7 @@ instance HasHaddock (Located (ConDecl GhcPs)) where addHaddock (L l_con_decl con_decl) = extendHdkA l_con_decl $ case con_decl of - ConDeclGADT { con_g_ext, con_names, con_forall, con_qvars, con_mb_cxt, con_g_args, con_res_ty } -> do + ConDeclGADT { con_g_ext, con_names, con_bndrs, con_mb_cxt, con_g_args, con_res_ty } -> do -- discardHasInnerDocs is ok because we don't need this info for GADTs. con_doc' <- discardHasInnerDocs $ getConDoc (getLoc (head con_names)) con_g_args' <- @@ -702,7 +701,7 @@ instance HasHaddock (Located (ConDecl GhcPs)) where pure $ RecConGADT (L l_rec flds') con_res_ty' <- addHaddock con_res_ty pure $ L l_con_decl $ - ConDeclGADT { con_g_ext, con_names, con_forall, con_qvars, con_mb_cxt, + ConDeclGADT { con_g_ext, con_names, con_bndrs, con_mb_cxt, con_doc = con_doc', con_g_args = con_g_args', con_res_ty = con_res_ty' } @@ -931,8 +930,15 @@ instance HasHaddock a => HasHaddock (HsScaled GhcPs a) where instance HasHaddock a => HasHaddock (HsWildCardBndrs GhcPs a) where addHaddock (HsWC _ t) = HsWC noExtField <$> addHaddock t -instance HasHaddock a => HasHaddock (HsImplicitBndrs GhcPs a) where - addHaddock (HsIB _ t) = HsIB noExtField <$> addHaddock t +instance HasHaddock (Located (HsSigType GhcPs)) where + addHaddock (L l (HsSig{sig_bndrs = outer_bndrs, sig_body = body})) = + extendHdkA l $ do + case outer_bndrs of + HsOuterImplicit{} -> pure () + HsOuterExplicit{hso_bndrs = bndrs} -> + registerLocHdkA (getLHsTyVarBndrsLoc bndrs) + body' <- addHaddock body + pure $ L l $ HsSig noExtField outer_bndrs body' -- Process a type, adding documentation comments to function arguments -- and the result. Many formatting styles are supported. @@ -1465,10 +1471,12 @@ mkLHsDocTy t (Just doc) = L (getLoc t) (HsDocTy noExtField t doc) getForAllTeleLoc :: HsForAllTelescope GhcPs -> SrcSpan getForAllTeleLoc tele = - foldr combineSrcSpans noSrcSpan $ case tele of - HsForAllVis{ hsf_vis_bndrs } -> map getLoc hsf_vis_bndrs - HsForAllInvis { hsf_invis_bndrs } -> map getLoc hsf_invis_bndrs + HsForAllVis{ hsf_vis_bndrs } -> getLHsTyVarBndrsLoc hsf_vis_bndrs + HsForAllInvis { hsf_invis_bndrs } -> getLHsTyVarBndrsLoc hsf_invis_bndrs + +getLHsTyVarBndrsLoc :: [LHsTyVarBndr flag GhcPs] -> SrcSpan +getLHsTyVarBndrsLoc bndrs = foldr combineSrcSpans noSrcSpan $ map getLoc bndrs -- | The inverse of 'partitionBindsAndSigs' that merges partitioned items back -- into a flat list. Elements are put back into the order in which they |