diff options
| -rw-r--r-- | src/HaddockUtil.hs | 33 | ||||
| -rw-r--r-- | src/Main.hs | 2 |
2 files changed, 18 insertions, 17 deletions
diff --git a/src/HaddockUtil.hs b/src/HaddockUtil.hs index 7cdca748..b80e8a1b 100644 --- a/src/HaddockUtil.hs +++ b/src/HaddockUtil.hs @@ -81,21 +81,24 @@ restrictTo names (L loc decl) = L loc $ case decl of _ -> decl restrictCons :: [Name] -> [LConDecl Name] -> [LConDecl Name] -restrictCons names decls = [ L p (fromJust (keep d)) | L p d <- decls, isJust (keep d) ] - where keep d | unLoc (con_name d) `elem` names = - case con_details d of - PrefixCon _ -> Just d - RecCon fields - | all field_avail fields -> Just d - | otherwise -> Just (d { con_details = PrefixCon (field_types fields) }) - -- if we have *all* the field names available, then - -- keep the record declaration. Otherwise degrade to - -- a constructor declaration. This isn't quite right, but - -- it's the best we can do. - where - field_avail (HsRecField n _ _) = (unLoc n) `elem` names - field_types flds = [ ty | HsRecField n ty _ <- flds] - keep d | otherwise = Nothing +restrictCons names decls = [ L p d | L p (Just d) <- map (fmap keep) decls ] + where + keep d | unLoc (con_name d) `elem` names = + case con_details d of + PrefixCon _ -> Just d + RecCon fields + | all field_avail fields -> Just d + | otherwise -> Just (d { con_details = PrefixCon (field_types fields) }) + -- if we have *all* the field names available, then + -- keep the record declaration. Otherwise degrade to + -- a constructor declaration. This isn't quite right, but + -- it's the best we can do. + InfixCon _ _ -> Just d + where + field_avail (HsRecField n _ _) = (unLoc n) `elem` names + field_types flds = [ ty | HsRecField n ty _ <- flds] + + keep d | otherwise = Nothing restrictDecls :: [Name] -> [LSig Name] -> [LSig Name] restrictDecls names decls = filter keep decls diff --git a/src/Main.hs b/src/Main.hs index 8f61f8d9..59e4b751 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -869,9 +869,7 @@ mkExportItems mod_map this_mod exported_names exportedDeclMap localDeclMap sub_m Nothing -> return [] Just found -> return [ ExportDoc found ] - -- NOTE: I'm unsure about this. Currently only "External" names are considered. declWith :: Name -> ErrMsgM [ ExportItem Name ] - declWith t | not (isExternalName t) = return [] declWith t | (Just decl, maybeDoc) <- findDecl t = return [ ExportDecl t (restrictTo subs (extractDecl t mdl decl)) maybeDoc [] ] |