From 3fb955471974728f78506fe5d526cdaa08afa556 Mon Sep 17 00:00:00 2001 From: davve Date: Fri, 22 Sep 2006 20:35:40 +0000 Subject: Take away trailin "2" on all previously clashing type names --- src/HaddockHtml.hs | 50 ++++++++++++++++++++++++------------------------- src/HaddockRename.hs | 24 ++++++++++++------------ src/HaddockTypes.hs | 53 ++++++++++++++++++++++------------------------------ src/Main.hs | 40 +++++++++++++++++++-------------------- 4 files changed, 79 insertions(+), 88 deletions(-) (limited to 'src') diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs index c36cec47..0dd7a189 100644 --- a/src/HaddockHtml.hs +++ b/src/HaddockHtml.hs @@ -551,9 +551,9 @@ hmodToHtml maybe_source_url maybe_wiki_url hmod exports = numberSectionHeadings (hmod_rn_export_items hmod) - has_doc (ExportDecl2 _ _ doc _) = isJust doc - has_doc (ExportNoDecl2 _ _ _) = False - has_doc (ExportModule2 _) = False + has_doc (ExportDecl _ _ doc _) = isJust doc + has_doc (ExportNoDecl _ _ _) = False + has_doc (ExportModule _) = False has_doc _ = True no_doc_at_all = not (any has_doc exports) @@ -582,13 +582,13 @@ hmodToHtml maybe_source_url maybe_wiki_url hmod maybe_doc_hdr = case exports of [] -> Html.emptyTable - ExportGroup2 _ _ _ : _ -> Html.emptyTable + ExportGroup _ _ _ : _ -> Html.emptyTable _ -> tda [ theclass "section1" ] << toHtml "Documentation" bdy = map (processExport False linksInfo docMap) exports linksInfo = (maybe_source_url, maybe_wiki_url, hmod) -ppModuleContents :: [ExportItem2 DocName] -> HtmlTable +ppModuleContents :: [ExportItem DocName] -> HtmlTable ppModuleContents exports | length sections == 0 = Html.emptyTable | otherwise = tda [theclass "section4"] << bold << toHtml "Contents" @@ -596,9 +596,9 @@ ppModuleContents exports where (sections, _leftovers{-should be []-}) = process 0 exports - process :: Int -> [ExportItem2 DocName] -> ([Html],[ExportItem2 DocName]) + process :: Int -> [ExportItem DocName] -> ([Html],[ExportItem DocName]) process _ [] = ([], []) - process n items@(ExportGroup2 lev id0 doc : rest) + process n items@(ExportGroup lev id0 doc : rest) | lev <= n = ( [], items ) | otherwise = ( html:secs, rest2 ) where @@ -613,32 +613,32 @@ ppModuleContents exports -- we need to assign a unique id to each section heading so we can hyperlink -- them from the contents: -numberSectionHeadings :: [ExportItem2 DocName] -> [ExportItem2 DocName] +numberSectionHeadings :: [ExportItem DocName] -> [ExportItem DocName] numberSectionHeadings exports = go 1 exports - where go :: Int -> [ExportItem2 DocName] -> [ExportItem2 DocName] + where go :: Int -> [ExportItem DocName] -> [ExportItem DocName] go _ [] = [] - go n (ExportGroup2 lev _ doc : es) - = ExportGroup2 lev (show n) doc : go (n+1) es + go n (ExportGroup lev _ doc : es) + = ExportGroup lev (show n) doc : go (n+1) es go n (other:es) = other : go n es -processExport :: Bool -> LinksInfo -> DocMap -> (ExportItem2 DocName) -> HtmlTable -processExport _ _ _ (ExportGroup2 lev id0 doc) +processExport :: Bool -> LinksInfo -> DocMap -> (ExportItem DocName) -> HtmlTable +processExport _ _ _ (ExportGroup lev id0 doc) = ppDocGroup lev (namedAnchor id0 << docToHtml doc) -processExport summary links docMap (ExportDecl2 x decl doc insts) +processExport summary links docMap (ExportDecl x decl doc insts) = doDecl summary links x decl doc insts docMap -processExport summmary _ _ (ExportNoDecl2 _ y []) +processExport summmary _ _ (ExportNoDecl _ y []) = declBox (ppDocName y) -processExport summmary _ _ (ExportNoDecl2 _ y subs) +processExport summmary _ _ (ExportNoDecl _ y subs) = declBox (ppDocName y <+> parenList (map ppDocName subs)) -processExport _ _ _ (ExportDoc2 doc) +processExport _ _ _ (ExportDoc doc) = docBox (docToHtml doc) -processExport _ _ _ (ExportModule2 mod) +processExport _ _ _ (ExportModule mod) = declBox (toHtml "module" <+> ppModule mod "") -forSummary :: (ExportItem2 DocName) -> Bool -forSummary (ExportGroup2 _ _ _) = False -forSummary (ExportDoc2 _) = False +forSummary :: (ExportItem DocName) -> Bool +forSummary (ExportGroup _ _ _) = False +forSummary (ExportDoc _) = False forSummary _ = True ppDocGroup :: Int -> Html -> HtmlTable @@ -655,7 +655,7 @@ declWithDoc False links loc nm (Just doc) html_decl = topDeclBox links loc nm html_decl docBox (docToHtml doc) doDecl :: Bool -> LinksInfo -> Name -> LHsDecl DocName -> - Maybe (HsDoc DocName) -> [InstHead2 DocName] -> DocMap -> HtmlTable + Maybe (HsDoc DocName) -> [InstHead DocName] -> DocMap -> HtmlTable doDecl summary links x (L loc d) mbDoc instances docMap = doDecl d where doDecl (TyClD d) = doTyClD d @@ -798,7 +798,7 @@ ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ _) loc docM hdr = ppClassHdr summary lctxt nm tvs fds NoLink nm = unLoc lname -ppClassDecl :: Ord key => Bool -> LinksInfo -> [InstHead2 DocName] -> key -> SrcSpan -> +ppClassDecl :: Ord key => Bool -> LinksInfo -> [InstHead DocName] -> key -> SrcSpan -> Maybe (HsDoc DocName) -> DocMap -> TyClDecl DocName -> HtmlTable ppClassDecl summary links instances orig_c loc mbDoc docMap @@ -844,7 +844,7 @@ ppClassDecl summary links instances orig_c loc mbDoc docMap aboves (map (declBox . ppInstHead) instances) )) -ppInstHead :: InstHead2 DocName -> Html +ppInstHead :: InstHead DocName -> Html ppInstHead ([], n, ts) = ppAsst n ts ppInstHead (ctxt, n, ts) = ppContextNoLocs ctxt <+> ppAsst n ts @@ -896,7 +896,7 @@ ppShortDataDecl summary links loc mbDoc dataDecl resTy = (con_res . unLoc . head) cons -- The rest of the cases: -ppDataDecl :: Ord key => Bool -> LinksInfo -> [InstHead2 DocName] -> key -> +ppDataDecl :: Ord key => Bool -> LinksInfo -> [InstHead DocName] -> key -> SrcSpan -> Maybe (HsDoc DocName) -> TyClDecl DocName -> HtmlTable ppDataDecl summary links instances x loc mbDoc dataDecl diff --git a/src/HaddockRename.hs b/src/HaddockRename.hs index 65af08e8..a5e2daa5 100644 --- a/src/HaddockRename.hs +++ b/src/HaddockRename.hs @@ -76,7 +76,7 @@ keepL (L loc n) = L loc (NoLink n) rename = lookupRn id renameL (L loc name) = return . L loc =<< rename name -renameExportItems :: [ExportItem2 Name] -> RnM [ExportItem2 DocName] +renameExportItems :: [ExportItem Name] -> RnM [ExportItem DocName] renameExportItems items = mapM renameExportItem items renameMaybeDoc :: Maybe (HsDoc Name) -> RnM (Maybe (HsDoc DocName)) @@ -199,7 +199,7 @@ renameLContext (L loc context) = do context' <- mapM renameLPred context return (L loc context') -renameInstHead :: InstHead2 Name -> RnM (InstHead2 DocName) +renameInstHead :: InstHead Name -> RnM (InstHead DocName) renameInstHead (preds, className, types) = do preds' <- mapM renamePred preds className' <- rename className @@ -301,21 +301,21 @@ renameForD (ForeignExport lname ltype x) = do ltype' <- renameLType ltype return (ForeignExport (keepL lname) ltype' x) -renameExportItem :: ExportItem2 Name -> RnM (ExportItem2 DocName) +renameExportItem :: ExportItem Name -> RnM (ExportItem DocName) renameExportItem item = case item of - ExportModule2 mod -> return (ExportModule2 mod) - ExportGroup2 lev id doc -> do + ExportModule mod -> return (ExportModule mod) + ExportGroup lev id doc -> do doc' <- renameDoc doc - return (ExportGroup2 lev id doc') - ExportDecl2 x decl doc instances -> do + return (ExportGroup lev id doc') + ExportDecl x decl doc instances -> do decl' <- renameLDecl decl doc' <- mapM renameDoc doc instances' <- mapM renameInstHead instances - return (ExportDecl2 x decl' doc' instances') - ExportNoDecl2 x y subs -> do + return (ExportDecl x decl' doc' instances') + ExportNoDecl x y subs -> do y' <- lookupRn id y subs' <- mapM (lookupRn id) subs - return (ExportNoDecl2 x y' subs') - ExportDoc2 doc -> do + return (ExportNoDecl x y' subs') + ExportDoc doc -> do doc' <- renameDoc doc - return (ExportDoc2 doc') + return (ExportDoc doc') diff --git a/src/HaddockTypes.hs b/src/HaddockTypes.hs index d8295b39..52cea181 100644 --- a/src/HaddockTypes.hs +++ b/src/HaddockTypes.hs @@ -7,12 +7,12 @@ -- module HaddockTypes ( - ExportItem2(..), - ModuleMap2, + ExportItem(..), + ModuleMap, DocMap, HaddockModule(..), DocOption(..), - InstHead2, + InstHead, DocName(..), DocMarkup(..) ) where @@ -30,34 +30,35 @@ data DocOption -- exported by this module. deriving (Eq, Show) -data ExportItem2 name - = ExportDecl2 +data ExportItem name + = ExportDecl Name -- ^ The original name (LHsDecl name) -- ^ A declaration (Maybe (HsDoc name)) -- ^ Maybe a doc comment - [InstHead2 name] -- ^ Instances relevant to this declaration + [InstHead name] -- ^ Instances relevant to this declaration - | ExportNoDecl2 -- ^ An exported entity for which we have no + | ExportNoDecl -- ^ An exported entity for which we have no -- documentation (perhaps because it resides in -- another package) Name -- ^ The original name name -- ^ Where to link to [name] -- ^ Subordinate names - | ExportGroup2 -- ^ A section heading + | ExportGroup -- ^ A section heading Int -- ^ section level (1, 2, 3, ... ) String -- ^ Section "id" (for hyperlinks) (HsDoc name) -- ^ Section heading text - | ExportDoc2 -- ^ Some documentation + | ExportDoc -- ^ Some documentation (HsDoc name) - | ExportModule2 -- ^ A cross-reference to another module + | ExportModule -- ^ A cross-reference to another module Module -type InstHead2 name = ([HsPred name], name, [HsType name]) -type ModuleMap2 = Map Module HaddockModule -type DocMap = Map Name (HsDoc DocName) +type InstHead name = ([HsPred name], name, [HsType name]) +type ModuleMap = Map Module HaddockModule +type DocMap = Map Name (HsDoc DocName) + data DocName = Link Name | NoLink Name instance Outputable DocName where @@ -67,42 +68,34 @@ instance Outputable DocName where data HaddockModule = HM { -- | A value to identify the module - hmod_mod :: Module, -- | The original filename for this module - hmod_orig_filename :: FilePath, -- | Textual information about the module - hmod_info :: HaddockModInfo Name, -- | The documentation header for this module - hmod_doc :: Maybe (HsDoc Name), -- | The renamed documentation header for this module - hmod_rn_doc :: Maybe (HsDoc DocName), -- | The Haddock options for this module (prune, ignore-exports, etc) - hmod_options :: [DocOption], hmod_exported_decl_map :: Map Name (LHsDecl Name), hmod_doc_map :: Map Name (HsDoc Name), hmod_rn_doc_map :: Map Name (HsDoc DocName), - hmod_export_items :: [ExportItem2 Name], - hmod_rn_export_items :: [ExportItem2 DocName], + hmod_export_items :: [ExportItem Name], + hmod_rn_export_items :: [ExportItem DocName], -- | All the names that are defined in this module - hmod_locals :: [Name], -- | All the names that are exported by this module - hmod_exports :: [Name], -- | All the visible names exported by this module @@ -112,13 +105,11 @@ data HaddockModule = HM { -- that it can't be from another package. -- Basically, a visible name is a name that will show up in the documentation -- for this module. - hmod_visible_exports :: [Name], hmod_sub_map :: Map Name [Name], -- | The instances exported by this module - hmod_instances :: [Instance] } @@ -139,12 +130,12 @@ data DocMarkup id a = Markup { markupAName :: String -> a } -instance (Outputable a, OutputableBndr a) => Outputable (ExportItem2 a) where - ppr (ExportDecl2 n decl doc instns) = text "ExportDecl" <+> ppr n <+> ppr decl <+> ppr doc <+> ppr instns - ppr (ExportNoDecl2 n1 n2 ns) = text "ExportNoDecl (org name, link name, sub names)" <+> ppr n1 <+> ppr n2 <+> ppr ns - ppr (ExportGroup2 lev id doc) = text "ExportGroup (lev, id, doc)" <+> ppr lev <+> ppr doc - ppr (ExportDoc2 doc) = text "ExportDoc" <+> ppr doc - ppr (ExportModule2 mod) = text "ExportModule" <+> ppr mod +instance (Outputable a, OutputableBndr a) => Outputable (ExportItem a) where + ppr (ExportDecl n decl doc instns) = text "ExportDecl" <+> ppr n <+> ppr decl <+> ppr doc <+> ppr instns + ppr (ExportNoDecl n1 n2 ns) = text "ExportNoDecl (org name, link name, sub names)" <+> ppr n1 <+> ppr n2 <+> ppr ns + ppr (ExportGroup lev id doc) = text "ExportGroup (lev, id, doc)" <+> ppr lev <+> ppr doc + ppr (ExportDoc doc) = text "ExportDoc" <+> ppr doc + ppr (ExportModule mod) = text "ExportModule" <+> ppr mod instance OutputableBndr DocName where pprBndr _ d = ppr d diff --git a/src/Main.hs b/src/Main.hs index 35998635..5c686873 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -456,7 +456,7 @@ type FullyCheckedMod = (ParsedSource, printEntity (DocEntity doc) = show doc printEntity (DeclEntity name) = show $ ppr name defaultUserStyle -pass1 :: [CheckedMod] -> [Flag] -> ErrMsgM ModuleMap2 +pass1 :: [CheckedMod] -> [Flag] -> ErrMsgM ModuleMap pass1 modules flags = worker modules (Map.empty) flags where worker [] moduleMap _ = return moduleMap @@ -748,7 +748,7 @@ renameModule renamingEnv mod = -- original names. mkExportItems - :: ModuleMap2 + :: ModuleMap -> Module -- this module -> [Name] -- exported names (orig) -> Map Name (LHsDecl Name) -- maps exported names to declarations @@ -760,7 +760,7 @@ mkExportItems -> Bool -- --ignore-all-exports flag -> Map Name (HsDoc Name) -> PackageId - -> ErrMsgM [ExportItem2 Name] + -> ErrMsgM [ExportItem Name] mkExportItems mod_map this_mod exported_names exportedDeclMap localDeclMap sub_map entities opts maybe_exps ignore_all_exports docMap packageId @@ -778,22 +778,22 @@ mkExportItems mod_map this_mod exported_names exportedDeclMap localDeclMap sub_m lookupExport (IEThingAll t) = declWith t lookupExport (IEThingWith t cs) = declWith t lookupExport (IEModuleContents m) = fullContentsOf (mkModule packageId m) - lookupExport (IEGroup lev doc) = return [ ExportGroup2 lev "" doc ] - lookupExport (IEDoc doc) = return [ ExportDoc2 doc ] + lookupExport (IEGroup lev doc) = return [ ExportGroup lev "" doc ] + lookupExport (IEDoc doc) = return [ ExportDoc doc ] lookupExport (IEDocNamed str) = do r <- findNamedDoc str entities case r of Nothing -> return [] - Just found -> return [ ExportDoc2 found ] + Just found -> return [ ExportDoc found ] -- NOTE: I'm unsure about this. Currently only "External" names are considered. - declWith :: Name -> ErrMsgM [ ExportItem2 Name ] + declWith :: Name -> ErrMsgM [ ExportItem Name ] declWith t | not (isExternalName t) = return [] declWith t | (Just decl, maybeDoc) <- findDecl t - = return [ ExportDecl2 t (restrictTo subs (extractDecl t mdl decl)) maybeDoc [] ] + = return [ ExportDecl t (restrictTo subs (extractDecl t mdl decl)) maybeDoc [] ] | otherwise - = return [ ExportNoDecl2 t t subs ] + = return [ ExportNoDecl t t subs ] -- can't find the decl (it might be from another package), but let's -- list the entity anyway. Later on, the renamer will change the -- orig name into the import name, so we get a proper link to @@ -811,7 +811,7 @@ mkExportItems mod_map this_mod exported_names exportedDeclMap localDeclMap sub_m Just hmod | OptHide `elem` hmod_options hmod -> return (hmod_export_items hmod) - | otherwise -> return [ ExportModule2 m ] + | otherwise -> return [ ExportModule m ] Nothing -> return [] -- already emitted a warning in exportedNames findDecl :: Name -> (Maybe (LHsDecl Name), Maybe (HsDoc Name)) @@ -827,13 +827,13 @@ mkExportItems mod_map this_mod exported_names exportedDeclMap localDeclMap sub_m m = nameModule n fullContentsOfThisModule :: Module -> [DocEntity Name] -> Map Name (LHsDecl Name) -> - Map Name (HsDoc Name) -> [ExportItem2 Name] + Map Name (HsDoc Name) -> [ExportItem Name] fullContentsOfThisModule module_ entities declMap docMap = catMaybes (map mkExportItem entities) where - mkExportItem (DocEntity (DocGroup lev doc)) = Just (ExportGroup2 lev "" doc) + mkExportItem (DocEntity (DocGroup lev doc)) = Just (ExportGroup lev "" doc) mkExportItem (DeclEntity name) = fmap mkExport (Map.lookup name declMap) - where mkExport decl = ExportDecl2 name decl (Map.lookup name docMap) [] + where mkExport decl = ExportDecl name decl (Map.lookup name docMap) [] -- Sometimes the declaration we want to export is not the "main" declaration: -- it might be an individual record selector or a class method. In these @@ -895,16 +895,16 @@ extractRecSel nm mdl t tvs (L _ con : rest) = -- ----------------------------------------------------------------------------- -- Pruning -pruneExportItems :: [ExportItem2 Name] -> [ExportItem2 Name] +pruneExportItems :: [ExportItem Name] -> [ExportItem Name] pruneExportItems items = filter hasDoc items - where hasDoc (ExportDecl2 _ _ d _) = isJust d + where hasDoc (ExportDecl _ _ d _) = isJust d hasDoc _ = True -- ----------------------------------------------------------------------------- -- Gather a list of original names exported from this module visibleNames :: Module - -> ModuleMap2 + -> ModuleMap -> [Name] -> [Name] -> Map Name [Name] @@ -957,7 +957,7 @@ exportModuleMissingErr this mdl -- for a given entity, find all the names it "owns" (ie. all the -- constructors and field names of a tycon, or all the methods of a -- class). -allSubsOfName :: ModuleMap2 -> Name -> [Name] +allSubsOfName :: ModuleMap -> Name -> [Name] allSubsOfName mod_map name | isExternalName name = case Map.lookup (nameModule name) mod_map of @@ -1043,8 +1043,8 @@ attachInstances modules = map attach modules where newItems = map attachExport (hmod_export_items mod) - attachExport (ExportDecl2 n decl doc _) = - ExportDecl2 n decl doc (case Map.lookup n instMap of + attachExport (ExportDecl n decl doc _) = + ExportDecl n decl doc (case Map.lookup n instMap of Nothing -> [] Just instheads -> instheads) attachExport otherExport = otherExport @@ -1097,7 +1097,7 @@ funTyConName = mkWiredInName gHC_PRIM BuiltInSyntax -toHsInstHead :: ([TyVar], [PredType], Class, [Type]) -> InstHead2 Name +toHsInstHead :: ([TyVar], [PredType], Class, [Type]) -> InstHead Name toHsInstHead (_, preds, cls, ts) = (map toHsPred preds, className cls, map toHsType ts) -------------------------------------------------------------------------------- -- cgit v1.2.3