diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/HaddockTypes.hs | 38 | ||||
| -rw-r--r-- | src/HaddockUtil.hs | 42 | ||||
| -rw-r--r-- | src/Main.hs | 199 |
3 files changed, 189 insertions, 90 deletions
diff --git a/src/HaddockTypes.hs b/src/HaddockTypes.hs index e81bf11d..02d8c673 100644 --- a/src/HaddockTypes.hs +++ b/src/HaddockTypes.hs @@ -6,8 +6,8 @@ module HaddockTypes ( -- * Module interfaces - NameEnv, Interface(..), ExportItem(..), ModuleMap, - + NameEnv, Interface(..), ExportItem(..), ExportItem2(..), ModuleMap, ModuleMap2, + HaddockModule(..), -- * Misc types DocOption(..), InstHead, ) where @@ -87,9 +87,9 @@ data DocOption data ExportItem = ExportDecl - GHC.Name -- the original name - GHC.HsDecl -- a declaration (with doc annotations) - [InstHead] -- instances relevant to this declaration + HsQName -- the original name + HsDecl -- a declaration (with doc annotations) + [InstHead] -- instances relevant to this declaration | ExportNoDecl -- an exported entity for which we have no documentation -- (perhaps becuase it resides in another package) @@ -108,6 +108,29 @@ data ExportItem | ExportModule -- a cross-reference to another module Module +data ExportItem2 + = ExportDecl2 + GHC.Name -- the original name + (GHC.HsDecl GHC.Name) -- a declaration (with doc annotations) + [InstHead] -- instances relevant to this declaration + + | ExportNoDecl2 -- an exported entity for which we have no documentation + -- (perhaps becuase it resides in another package) + GHC.Name -- the original name + GHC.Name -- where to link to + [GHC.Name] -- subordinate names + + | ExportGroup2 -- a section heading + Int -- section level (1, 2, 3, ... ) + String -- section "id" (for hyperlinks) + (GHC.HsDoc GHC.Name) -- section heading text + + | ExportDoc2 -- some documentation + (GHC.HsDoc GHC.Name) + + | ExportModule2 -- a cross-reference to another module + GHC.Module + type InstHead = (HsContext,HsAsst) type ModuleMap = Map Module Interface @@ -115,6 +138,7 @@ type ModuleMap2 = Map GHC.Module HaddockModule data HaddockModule = HM { hmod_options :: [DocOption], - hmod_decls :: Map Name GHC.HsDecl, - hmod_orig_exports :: [ExportItem] + hmod_decls :: Map GHC.Name (GHC.HsDecl GHC.Name), + hmod_orig_exports :: [ExportItem2], + hmod_subs :: Map GHC.Name [GHC.Name] } diff --git a/src/HaddockUtil.hs b/src/HaddockUtil.hs index d4c495a3..1d4eb29b 100644 --- a/src/HaddockUtil.hs +++ b/src/HaddockUtil.hs @@ -33,11 +33,14 @@ import HsSyn2 import Map ( Map ) import qualified Map hiding ( Map ) +import qualified GHC as GHC +import SrcLoc + import Control.Monad ( liftM, MonadPlus(..) ) import Data.Char ( isAlpha, isSpace, toUpper, ord ) import Data.IORef ( IORef, newIORef, readIORef ) import Data.List ( intersect, isSuffixOf, intersperse ) -import Data.Maybe ( maybeToList, fromMaybe ) +import Data.Maybe ( maybeToList, fromMaybe, isJust, fromJust ) import Network.URI import System.Environment ( getProgName ) import System.Exit ( exitWith, ExitCode(..) ) @@ -144,38 +147,37 @@ addConDocs (x:xs) doc = addConDoc x doc : xs restrictTo :: [GHC.Name] -> (GHC.HsDecl GHC.Name) -> (GHC.HsDecl GHC.Name) restrictTo names decl = case decl of - TyClD d | isDataDecl d && tcdND d == DataType -> - TyClD (d { tcdCons = restrictCons names (tcdCons d) } - TyClD d | isDataDecl d && tcdND d == NewType -> - case restrictCons names (tcdCons d) of - [] -> TyClD (d { tcdND = DataType, tcdCons = [] }) - [con] -> TyClD (d { tcdCons = con }) - TyClD d | isClassDecl d -> - TyClD (d { tcdSigs = restrictDecls names (tcdSigs d) }) + GHC.TyClD d | GHC.isDataDecl d && GHC.tcdND d == GHC.DataType -> + GHC.TyClD (d { GHC.tcdCons = restrictCons names (GHC.tcdCons d) }) + GHC.TyClD d | GHC.isDataDecl d && GHC.tcdND d == GHC.NewType -> + case restrictCons names (GHC.tcdCons d) of + [] -> GHC.TyClD (d { GHC.tcdND = GHC.DataType, GHC.tcdCons = [] }) + [con] -> GHC.TyClD (d { GHC.tcdCons = [con] }) + GHC.TyClD d | GHC.isClassDecl d -> + GHC.TyClD (d { GHC.tcdSigs = restrictDecls names (GHC.tcdSigs d) }) _ -> decl restrictCons :: [GHC.Name] -> [GHC.LConDecl GHC.Name] -> [GHC.LConDecl GHC.Name] -restrictCons names decls = [ d | Just d <- map keep decls ] - where keep d | con_name (unLoc d) `elem` names = - case con_details d of - PrefixCon _ -> Just d - RecCon fields +restrictCons names decls = [ L p (fromJust (keep d)) | L p d <- decls, isJust (keep d) ] + where keep d | unLoc (GHC.con_name d) `elem` names = + case GHC.con_details d of + GHC.PrefixCon _ -> Just d + GHC.RecCon fields | all field_avail fields -> Just d - | otherwise = Just (d { con_details = PrefixCon field_types }) + | otherwise -> Just (d { GHC.con_details = GHC.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 = [ ty | HsRecField n ty _ <- fields] + field_avail (GHC.HsRecField n _ _) = (unLoc n) `elem` names + field_types flds = [ ty | GHC.HsRecField n ty _ <- flds] keep d | otherwise = Nothing restrictDecls :: [GHC.Name] -> [GHC.LSig GHC.Name] -> [GHC.LSig GHC.Name] restrictDecls names decls = filter keep decls - where keep d = sigName d `elem` names - - -- ToDo: not really correct + where keep d = fromJust (GHC.sigName d) `elem` names + -- has to have a name, since it's a class method type signature {- restrictTo :: [HsName] -> HsDecl -> HsDecl diff --git a/src/Main.hs b/src/Main.hs index dfc5ee99..0fcd66fc 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -53,6 +53,8 @@ import Control.Concurrent import qualified GHC as GHC import Outputable import SrcLoc +import qualified Digraph as Digraph +import Name ----------------------------------------------------------------------------- -- Top-level stuff @@ -282,26 +284,57 @@ run flags files = do (ghcFlags'', rest) <- GHC.parseDynamicFlags ghcFlags' haddockGhcFlags when (not (null rest)) (die $ "The following flags are not GHC flags: " ++ pprList rest ++ "\n") - GHC.defaultErrorHandler ghcFlags'' $ do + sorted_checked_modules <- GHC.defaultErrorHandler ghcFlags'' $ do GHC.setSessionDynFlags session ghcFlags'' targets <- mapM (\s -> GHC.guessTarget s Nothing) files GHC.setTargets session targets - -- find out the module names of the targets, and topologically sort those modules maybe_module_graph <- GHC.depanal session [] True module_graph <- case maybe_module_graph of Just module_graph -> return module_graph Nothing -> die "Failed to load modules" - let sorted_modules = flattenSCC (topSortModuleGraph False module_graph Nothing) + let sorted_modules = concatMap Digraph.flattenSCC (GHC.topSortModuleGraph False module_graph Nothing) let modules = [ GHC.ms_mod modsum | modsum <- sorted_modules, GHC.ms_hspp_file modsum `elem` files ] mb_checked_modules <- mapM (GHC.checkModule session) modules let checked_modules = catMaybes mb_checked_modules + if length checked_modules /= length mb_checked_modules + then die "Failed to load all modules" + else return (zip modules checked_modules) + + let module_map = Map.empty + + let loop ((mod, checkedMod):modules) module_map = do + exported_names <- get_exported_names + binding_group <- get_binding_group + let exported_decls_map = mk_exported_decls_map exported_names binding_group + mkExportItems module_map mod exported_names exported_decls_map + where + get_binding_group = case GHC.renamedSource checkedMod of + Just (group, _, _) -> group + Nothing -> die "Failed to get renamed source" + get_module_info = case GHC.checkedModuleInfo checkedMod of + Just mi -> return mi + Nothing -> die "Failed to get checkedModuleInfo" + get_exported_names = do + module_info <- get_module_info + return (GHC.modInfoExports module_info) + + + + --let Just (group, imports, exports) = GHC.renamedSource (head sorted_checked_modules) + --printSDoc (ppr group) defaultUserStyle + let exports = GHC.modInfoExports $ fromJust $ GHC.checkedModuleInfo $ snd $ (head sorted_checked_modules) + printSDoc (ppr exports) defaultUserStyle + + + + {- let parsed_source = unLoc $ GHC.parsedSource (head checked_modules) - printSDoc (ppr parsed_source) defaultUserStyle + printSDoc (ppr parsed_source) defaultUserStyle -} - return () + return () -- case successFlag of -- GHC.Succeeded -> bye "Succeeded" -- GHC.Failed -> bye "Could not load all targets" @@ -380,8 +413,37 @@ run flags files = do pprList [x] = show x pprList (x:xs) = show x ++ ", " ++ pprList xs ---moduleFromFilename filename = - +mk_exported_decls_map :: [GHC.Name] -> GHC.HsGroup GHC.Name -> Map GHC.Name (GHC.HsDecl GHC.Name) +mk_exported_decls_map exported_names group = Map.fromList + [ (name, decl) | name <- exported_names, + let Just decl = getDeclFromGroup name group ] + +getDeclFromGroup :: GHC.HsGroup GHC.Name -> GHC.Name -> Maybe (GHC.HsDecl GHC.Name) +getDeclFromGroup group name = case catMaybes [getDeclFromVals (GHC.hs_valds group), + getDeclFromTyCls (GHC.hs_tyclds group), + getDeclFromFors (GHC.hs_fords group)] of + [Just decl] -> Just decl + _ -> Nothing + where + getDeclFromVals (GHC.ValBindsOut _ lsigs) = case matching of + [lsig] -> Just (GHC.SigD (unLoc lsig)) + _ -> Nothing + where + matching = [ lsig | lsig <- lsigs, GHC.sigName lsig == name ] + getDeclFromVals _ = error "getDeclFromVals: illegal input" + + getDeclFromTyCls ltycls = case matching of + [ltycl] -> Just (GHC.TyClD (unLoc ltycl)) + _ -> Nothing + where + matching = [ ltycl | ltycl <- ltycls, unLoc (GHC.tcdLName (unLoc ltycl)) == name ] + + getDeclFromFors lfors = case matching of + [for] -> Just (GHC.ForD for) + _ -> Nothing + where + matching = [ for | L _ for@(GHC.ForeignExport n _ _ _) <- lfors, (unLoc n) == name ] + parseIfaceOption :: String -> (FilePath,FilePath) parseIfaceOption s = case break (==',') s of @@ -792,14 +854,14 @@ unknownConstraint = UnQual (HsTyClsName (HsIdent "???")) mkExportItems :: ModuleMap2 -> GHC.Module -- this module - -> GHC.NameSet -- exported names (orig) + -> [GHC.Name] -- exported names (orig) -> Map GHC.Name (GHC.HsDecl GHC.Name) -- maps local names to declarations -> Map GHC.Name [GHC.Name] -- sub-map for this module -> [GHC.HsDecl GHC.Name] -- decls in the current module -> [DocOption] - -> Maybe [GHC.IE Name] + -> Maybe [GHC.IE GHC.Name] -> Bool -- --ignore-all-exports flag - -> ErrMsgM [ExportItem] + -> ErrMsgM [ExportItem2] mkExportItems mod_map this_mod exported_names decl_map sub_map decls opts maybe_exps ignore_all_exports @@ -817,35 +879,30 @@ mkExportItems mod_map this_mod exported_names decl_map sub_map decls lookupExport (GHC.IEThingAll t) = declWith t lookupExport (GHC.IEThingWith t cs) = declWith t lookupExport (GHC.IEModuleContents m) = fullContentsOf m - lookupExport (GHC.IEGroup lev doc) = return [ ExportGroup lev "" doc ] - lookupExport (GHC.IEDoc doc) = return [ ExportDoc doc ] + lookupExport (GHC.IEGroup lev doc) = return [ ExportGroup2 lev "" doc ] + lookupExport (GHC.IEDoc doc) = return [ ExportDoc2 doc ] lookupExport (GHC.IEDocNamed str) = do r <- findNamedDoc str decls case r of Nothing -> return [] - Just found -> return [ ExportDoc found ] + Just found -> return [ ExportDoc2 found ] -- NOTE: I'm unsure about this. Currently only "External" names are considered. - declWith :: GHC.Name -> ErrMsgM [ ExportItem ] + declWith :: GHC.Name -> ErrMsgM [ ExportItem2 ] declWith t | not (isExternalName t) = return [] declWith t | Just decl <- findDecl t - = return [ ExportDecl t (restrictTo subs (extractDecl x mdl decl)) [] ] + = return [ ExportDecl2 t (restrictTo subs (extractDecl t mdl decl)) [] ] | otherwise - = return [ ExportNoDecl t t (map (Qual mdl) subs) ] + = return [ ExportNoDecl2 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 -- the doc for this entity. where - Just mdl = nameModule t - x = nameOccName - subs = map nameOfQName subs_qnames - subs_qnames = filter (`elem` exported_names) all_subs_qnames - - all_subs_qnames = map (Qual mdl) all_subs - - all_subs | mdl == this_mod = Map.findWithDefault [] x sub_map + mdl = nameModule t + subs = filter (`elem` exported_names) all_subs + all_subs | mdl == this_mod = Map.findWithDefault [] t sub_map | otherwise = all_subs_of_qname mod_map t fullContentsOf m @@ -855,12 +912,12 @@ mkExportItems mod_map this_mod exported_names decl_map sub_map decls Just hmod | OptHide `elem` hmod_options hmod -> return (hmod_orig_exports hmod) - | otherwise -> return [ ExportModule m ] + | otherwise -> return [ ExportModule2 m ] Nothing -> return [] -- already emitted a warning in exportedNames findDecl :: GHC.Name -> Maybe (GHC.HsDecl GHC.Name) findDecl n | not (isExternalName n) = Nothing - findDecl n = + findDecl n | m == this_mod = Map.lookup n decl_map | otherwise = case Map.lookup m mod_map of @@ -869,14 +926,14 @@ mkExportItems mod_map this_mod exported_names decl_map sub_map decls where m = nameModule n -fullContentsOfThisModule :: GHC.Module -> [GHC.HsDecl GHC.Name] -> [ExportItem] +fullContentsOfThisModule :: GHC.Module -> [GHC.HsDecl GHC.Name] -> [ExportItem2] fullContentsOfThisModule mdl decls = map mkExportItem (filter keepDecl decls) - where mkExportItem (DocD (DocGroup lev doc)) = ExportGroup lev "" doc - mkExportItem decl = ExportDecl x decl [] -- NOTE: will this work? is x qualified correctly? - where Just x = GHC.getDeclMainBinder decl + where mkExportItem (GHC.DocD (GHC.DocGroup lev doc)) = ExportGroup2 lev "" doc + mkExportItem decl = ExportDecl2 x decl [] -- NOTE: will this work? is x qualified correctly? + where Just x = GHC.getMainDeclBinder decl -keepDecl :: GHC.HsDecl -> Bool +keepDecl :: GHC.HsDecl GHC.Name -> Bool keepDecl (GHC.SigD _) = True keepDecl (GHC.TyClD _) = True keepDecl (GHC.DocD _) = True @@ -891,8 +948,8 @@ keepDecl _ = False mkExportItems :: ModuleMap - -> Module -- this module - -> [HsQName] -- exported names (orig) + -> GHC.Module -- this module + -> [GHC.Name] -- exported names (orig) -> Map HsName HsDecl -- maps local names to declarations -> Map HsName [HsName] -- sub-map for this module -> [HsDecl] -- decls in the current module @@ -992,58 +1049,61 @@ keepDecl _ = False -- it might be an individual record selector or a class method. In these -- cases we have to extract the required declaration (and somehow cobble -- together a type signature for it...) --- We put noSrcLoc everywhere in the cobbled together type signatures since +-- We put noSrcSpan everywhere in the cobbled together type signatures since -- they aren't actually located in the soure code. extractDecl :: GHC.Name -> GHC.Module -> GHC.HsDecl GHC.Name -> GHC.HsDecl GHC.Name extractDecl name mdl decl - | Just n <- getDeclMainBinder decl, n == name = decl + | Just n <- GHC.getMainDeclBinder decl, n == name = decl | otherwise = case decl of GHC.TyClD d | GHC.isClassDecl d -> let matching_sigs = [ sig | sig <- GHC.tcdSigs d, GHC.sigName sig == Just name ] in case matching_sigs of [s0] -> let (n, tyvar_names) = name_and_tyvars d - in SigD (extractClassDecl n mdl tyvar_names s0) + in GHC.SigD (extractClassDecl n mdl tyvar_names s0) _ -> error "internal: extractDecl" GHC.TyClD d | GHC.isDataDecl d -> let (n, tyvar_names) = name_and_tyvars d - in SigD (extractRecSel name mdl n tyvar_names (GHC.tcdCons d)) + in GHC.SigD (extractRecSel name mdl n tyvar_names (GHC.tcdCons d)) _ -> error "internal: extractDecl" where - name_and_tyvars d = (GHC.unLoc (GHC.tcdLName d), hsLTyVarLocNames (GHC.tcdTyVars d)) + name_and_tyvars d = (unLoc (GHC.tcdLName d), GHC.hsLTyVarLocNames (GHC.tcdTyVars d)) -toTypeNoLoc :: Located GHC.Name -> LHsType GHC.Name +toTypeNoLoc :: Located GHC.Name -> GHC.LHsType GHC.Name toTypeNoLoc lname = mkNoLoc (GHC.HsTyVar (unLoc lname)) mkNoLoc :: a -> Located a -mkNoLoc a = Located noSrcLoc a +mkNoLoc a = L noSrcSpan a + +rmLoc :: Located a -> Located a +rmLoc a = mkNoLoc (unLoc a) -- originally expected unqualified 1:st name, now it doesn't -extractClassDecl :: GHC.Name -> GHC.Module -> [GHC.Located GHC.Name] -> GHC.LSig GHC.Name -> GHC.Sig GHC.Name -extractClassDecl c mdl tvs0 (GHC.Located p (GHC.TypeSig lname ltype)) = case ltype of - GHC.Located _ (GHC.HsForAllTy exp tvs (GHC.Located p'' preds) ty) -> - GHC.TypeSig lname (mkNoLoc (GHC.HsForAllTy exp tvs lctxt ty)) - _ -> GHC.TypeSig lname (mkNoLoc (GHC.HsForAllTy exp [] lctxt ltype)) - where - lctxt = mkNoLoc ctxt - ctxt = [mkNoLoc (GHC.HsClassP c (map toTypeNoLoc tvs0))] ++ preds +extractClassDecl :: GHC.Name -> GHC.Module -> [Located GHC.Name] -> GHC.LSig GHC.Name -> GHC.Sig GHC.Name +extractClassDecl c mdl tvs0 (L _ (GHC.TypeSig lname ltype)) = case ltype of + L _ (GHC.HsForAllTy exp tvs (L _ preds) ty) -> + GHC.TypeSig (rmLoc lname) (mkNoLoc (GHC.HsForAllTy exp tvs (lctxt preds) ty)) + _ -> GHC.TypeSig (rmLoc lname) (mkNoLoc (GHC.mkImplicitHsForAllTy (lctxt []) ltype)) + where + lctxt preds = mkNoLoc (ctxt preds) + ctxt preds = [mkNoLoc (GHC.HsClassP c (map toTypeNoLoc tvs0))] ++ preds extractClassDecl _ _ _ d = error $ "Main.extractClassDecl: unexpected decl" -extractRecSel :: GHC.Located GHC.Name -> GHC.Module -> GHC.Name -> [GHC.Located GHC.Name] -> [GHC.LConDecl GHC.Name] - -> GHC.Sig Ghc.Name +extractRecSel :: GHC.Name -> GHC.Module -> GHC.Name -> [Located GHC.Name] -> [GHC.LConDecl GHC.Name] + -> GHC.Sig GHC.Name extractRecSel _ _ _ _ [] = error "extractRecSel: selector not found" -- originally expected unqualified 3:rd name, now it doesn't -extractRecSel nm mdl t tvs (Located _ con : rest) = +extractRecSel nm mdl t tvs (L _ con : rest) = case GHC.con_details con of GHC.RecCon fields | (GHC.HsRecField n ty _ : _) <- matching_fields fields -> - GHC.TypeSig nm (mkNoLoc (GHC.HsFunTy data_ty (GHC.getBangType ty))) + GHC.TypeSig (mkNoLoc nm) (mkNoLoc (GHC.HsFunTy data_ty (GHC.getBangType ty))) _ -> extractRecSel nm mdl t tvs rest where - matching_fields flds = [ f | HsRecField n _ _ <- flds, n == nm ] - data_ty = mkNoLoc (foldl HsAppTy (mkNoLoc (HsTyVar t)) (map toTypeNoLoc tvs)) + matching_fields flds = [ f | f@(GHC.HsRecField n _ _) <- flds, (unLoc n) == nm ] + data_ty = foldl (\x y -> mkNoLoc (GHC.HsAppTy x y)) (mkNoLoc (GHC.HsTyVar t)) (map toTypeNoLoc tvs) -- 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 @@ -1115,7 +1175,7 @@ mkSubNames decls = -- ----------------------------------------------------------------------------- -- Gather a list of original names exported from this module - +{- exportedNames :: Module -> ModuleMap -> [HsName] -> Map HsQName HsQName -> Map HsName [HsName] @@ -1190,11 +1250,11 @@ exportedNames mdl mod_map local_names orig_env sub_map maybe_exps opts case Map.lookup m mod_map of Nothing -> False Just iface -> isJust (Map.lookup n (iface_decls iface)) - +-} exportModuleMissingErr this mdl = ["Warning: in export list of " ++ show this ++ ": module not found: " ++ show 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). @@ -1205,13 +1265,26 @@ all_subs_of_qname mod_map (Qual mdl nm) = Nothing -> [] all_subs_of_qname _ n@(UnQual _) = error $ "Main.all_subs_of_qname: unexpected unqual'd name:" ++ show n +-} + + +-- 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). +all_subs_of_qname :: ModuleMap2 -> GHC.Name -> [GHC.Name] +all_subs_of_qname mod_map name + | isExternalName name = + case Map.lookup (nameModule name) mod_map of + Just hmod -> Map.findWithDefault [] name (hmod_subs hmod) + Nothing -> [] + | otherwise = error $ "Main.all_subs_of_qname: unexpected unqual'd name" -- ---------------------------------------------------------------------------- -- Building name environments -- The orig env maps names in the current source file to -- fully-qualified "original" names. - +{- buildOrigEnv :: Module -> Bool -> ModuleMap -> [HsImportDecl] -> ErrMsgM (Map HsQName HsQName) buildOrigEnv this_mdl verbose mod_map imp_decls @@ -1241,8 +1314,8 @@ buildOrigEnv this_mdl verbose mod_map imp_decls qual_module | Just m <- maybe_as = m | otherwise = mdl - - +-} +{- processImportDecl :: ModuleMap -> HsImportDecl -> [(HsName,HsQName)] processImportDecl mod_map (HsImportDecl _ mdl is_qualified maybe_as imp_specs) = case Map.lookup mdl mod_map of @@ -1280,7 +1353,7 @@ processImportDecl mod_map (HsImportDecl _ mdl is_qualified maybe_as imp_specs) case Map.lookup nm env of Just qnm -> filter (`Map.member` env) (all_subs_of_qname mod_map qnm) _ -> [] - +-} -- ----------------------------------------------------------------------------- -- | Build a mapping which for each original name, points to the "best" @@ -1390,12 +1463,12 @@ collectInDecl decl -- ----------------------------------------------------------------------------- -- Named documentation -findNamedDoc :: String -> [HsDecl] -> ErrMsgM (Maybe Doc) +findNamedDoc :: String -> [GHC.HsDecl GHC.Name] -> ErrMsgM (Maybe (GHC.HsDoc GHC.Name)) findNamedDoc name decls = search decls where search [] = do tell ["Cannot find documentation for: $" ++ name] return Nothing - search ((DocD (DocCommentNamed name' doc)):rest) + search ((GHC.DocD (GHC.DocCommentNamed name' doc)):rest) | name == name' = return (Just doc) | otherwise = search rest search (_other_decl : rest) = search rest |