diff options
Diffstat (limited to 'compiler/GHC/HsToCore/Docs.hs')
| -rw-r--r-- | compiler/GHC/HsToCore/Docs.hs | 36 |
1 files changed, 20 insertions, 16 deletions
diff --git a/compiler/GHC/HsToCore/Docs.hs b/compiler/GHC/HsToCore/Docs.hs index f162dadaf5..f142817730 100644 --- a/compiler/GHC/HsToCore/Docs.hs +++ b/compiler/GHC/HsToCore/Docs.hs @@ -249,9 +249,12 @@ mkMaps env instances decls = -> ( [(Name, [HsDoc GhcRn])] , [(Name, IntMap (HsDoc GhcRn))] ) - mappings (L (SrcSpanAnn _ (RealSrcSpan l _)) decl, doc) = + mappings (L (EpAnnS anc _ _ ) decl, doc) = (dm, am) where + l = case anc of + EpaSpan (RealSrcSpan s _) -> Just s + _ -> Nothing args = declTypeDocs decl subs :: [(Name, [HsDoc GhcRn], IntMap (HsDoc GhcRn))] @@ -263,14 +266,14 @@ mkMaps env instances decls = ns = names l decl dm = [(n, d) | (n, d) <- zip ns (repeat doc) ++ zip subNs subDocs, not $ all (isEmptyDocString . hsDocString) d] am = [(n, args) | n <- ns] ++ zip subNs subArgs - mappings (L (SrcSpanAnn _ (UnhelpfulSpan _)) _, _) = ([], []) instanceMap :: Map RealSrcSpan Name instanceMap = M.fromList [(l, n) | n <- instances, RealSrcSpan l _ <- [getSrcSpan n] ] - names :: RealSrcSpan -> HsDecl GhcRn -> [Name] + names :: Maybe RealSrcSpan -> HsDecl GhcRn -> [Name] names _ (InstD _ d) = maybeToList $ lookupSrcSpan (getInstLoc d) instanceMap - names l (DerivD {}) = maybeToList (M.lookup l instanceMap) -- See Note [1]. + names (Just l) (DerivD {}) = maybeToList (M.lookup l instanceMap) -- See Note [1]. + names Nothing (DerivD {}) = [] names _ decl = getMainDeclBinder env decl {- @@ -327,12 +330,12 @@ getInstLoc = \case -- type instance Foo Int = Bool -- ^^^ DataFamInstD _ (DataFamInstDecl - { dfid_eqn = FamEqn { feqn_tycon = L l _ }}) -> locA l + { dfid_eqn = FamEqn { feqn_tycon = L l _ }}) -> locN l -- Since CoAxioms' Names refer to the whole line for type family instances -- in particular, we need to dig a bit deeper to pull out the entire -- equation. This does not happen for data family instances, for some reason. TyFamInstD _ (TyFamInstDecl - { tfid_eqn = FamEqn { feqn_tycon = L l _ }}) -> locA l + { tfid_eqn = FamEqn { feqn_tycon = L l _ }}) -> locN l -- | Get all subordinate declarations inside a declaration, and their docs. -- A subordinate declaration is something like the associate type or data @@ -347,10 +350,10 @@ subordinates env instMap decl = case decl of DataFamInstDecl { dfid_eqn = FamEqn { feqn_tycon = L l _ , feqn_rhs = defn }} <- unLoc <$> cid_datafam_insts d - [ (n, [], IM.empty) | Just n <- [lookupSrcSpan (locA l) instMap] ] ++ dataSubs defn + [ (n, [], IM.empty) | Just n <- [lookupSrcSpan (locN l) instMap] ] ++ dataSubs defn ty_fams = do TyFamInstDecl { tfid_eqn = FamEqn { feqn_tycon = L l _ } } <- unLoc <$> cid_tyfam_insts d - [ (n, [], IM.empty) | Just n <- [lookupSrcSpan (locA l) instMap] ] + [ (n, [], IM.empty) | Just n <- [lookupSrcSpan (locN l) instMap] ] in data_fams ++ ty_fams InstD _ (DataFamInstD _ (DataFamInstDecl d)) @@ -503,18 +506,19 @@ ungroup group_ = -- | Collect docs and attach them to the right declarations. -- -- A declaration may have multiple doc strings attached to it. -collectDocs :: forall p. UnXRec p => [LHsDecl p] -> [(LHsDecl p, [HsDoc p])] +-- collectDocs :: forall p. UnXRec p => [LHsDecl p] -> [(LHsDecl p, [HsDoc p])] +collectDocs :: [LHsDecl GhcRn] -> [(LHsDecl GhcRn, [HsDoc GhcRn])] -- ^ This is an example. collectDocs = go [] Nothing where go docs mprev decls = case (decls, mprev) of - ((unXRec @p -> DocD _ (DocCommentNext s)) : ds, Nothing) -> go (unLoc s:docs) Nothing ds - ((unXRec @p -> DocD _ (DocCommentNext s)) : ds, Just prev) -> finished prev docs $ go [unLoc s] Nothing ds - ((unXRec @p -> DocD _ (DocCommentPrev s)) : ds, mprev) -> go (unLoc s:docs) mprev ds - (d : ds, Nothing) -> go docs (Just d) ds - (d : ds, Just prev) -> finished prev docs $ go [] (Just d) ds - ([] , Nothing) -> [] - ([] , Just prev) -> finished prev docs [] + ((L _ (DocD _ (DocCommentNext s))) : ds, Nothing) -> go (unLoc s:docs) Nothing ds + ((L _ (DocD _ (DocCommentNext s))) : ds, Just prev) -> finished prev docs $ go [unLoc s] Nothing ds + ((L _ (DocD _ (DocCommentPrev s))) : ds, mprev) -> go (unLoc s:docs) mprev ds + (d : ds, Nothing) -> go docs (Just d) ds + (d : ds, Just prev) -> finished prev docs $ go [] (Just d) ds + ([] , Nothing) -> [] + ([] , Just prev) -> finished prev docs [] finished decl docs rest = (decl, reverse docs) : rest |