module CombHsHDoc(parseHs, combineHsHDoc) where import HDocDefs import HsSyn import HsParseMonad import qualified HsParser import Scanner import Maybe import List data CommentLookup = CommentLookup { positional :: [Loc], perName :: [(HsQName, [HDoc])] } locLt :: Loc -> Loc -> Bool locLt l1 l2 = srcLocLT (locSrcLoc l1) (locSrcLoc l2) sortLocs [] = [] sortLocs (x:xs) = sortLocs [y | y <- xs, y `locLt` x] ++ x : sortLocs [y | y <- xs, x `locLt` y] findHDoc :: HsQName -> CommentLookup -> SrcLoc -> [HDoc] findHDoc name clu loc = case (lookup name (perName clu),findHDocPositional (positional clu)) of (Nothing, hdocs) -> hdocs (Just hd1, hd2) -> hd1 ++ hd2 where findHDocPositional [] = [] findHDocPositional (HDocLoc _ hdl : DeclLoc l : ls) | l == loc = hdl | otherwise = findHDocPositional ls findHDocPositional (_ : ls) = findHDocPositional ls findModuleHDoc :: CommentLookup -> [HDoc] findModuleHDoc clu = fmh (positional clu) where fmh :: [Loc] -> [HDoc] fmh [] = [] fmh (HDocLoc _ hdocs : ModuleLoc _ : _) = hdocs fmh (_:xs) = fmh xs findConsHDoc :: HsQName -> CommentLookup -> SrcLoc -> Maybe HDoc findConsHDoc name clu loc = find (positional clu) where find [] = Nothing find (ConsLoc l : ls) | l == loc = nextHDoc ls | otherwise = find ls find (_ : ls) = find ls nextHDoc [] = Nothing nextHDoc (ConsLoc _ : ls) = nextHDoc ls nextHDoc (HDocConsLoc _ hdl : _) = listToMaybe [hd | hd@(HDoc _ ConstructorTags) <- hdl] nextHDoc _ = Nothing makeCommentLookup :: HsModule -> [CommentAssoc] -> CommentLookup makeCommentLookup hsMod assocs = CommentLookup { positional = sortLocs (extractLocs hsMod ++ hdocLocs), perName = hdocNames } where hdocLocs = [loc | Positional loc <- assocs] hdocNames = [(name, hdocs) | PerName name hdocs <- assocs] -- run HsParser on the given input parseHs :: String -> Either String HsModule parseHs input = case HsParser.parseModule input of ParseOk e -> Right e ParseFailed (SrcLoc l c) err -> Left (show l ++ ":" ++ show c ++ ": " ++ err) -- extract the locations of "interesting" declarations/bindings extractLocs :: HsModule -> [Loc] extractLocs (HsModule loc _ _ _ decls) = ModuleLoc loc : extractDeclLocs decls where extractDeclLocs [] = [] extractDeclLocs (HsTypeDecl l _ _ _ : ds) = DeclLoc l : extractDeclLocs ds extractDeclLocs (HsDataDecl l _ _ _ conses _ : ds) = DeclLoc l : (map conDeclLoc conses) ++ extractDeclLocs ds extractDeclLocs (HsNewTypeDecl l _ _ _ cons _ : ds) = DeclLoc l : conDeclLoc cons : extractDeclLocs ds extractDeclLocs (HsInfixDecl l _ _ _ : ds) = DeclLoc l : extractDeclLocs ds extractDeclLocs (HsClassDecl l _ _ ml : ds) = DeclLoc l : extractDeclLocs (ml ++ ds) extractDeclLocs (HsInstDecl l _ ml : ds) = DeclLoc l : extractDeclLocs (ml ++ ds) extractDeclLocs (HsDefaultDecl l _ : ds) = DeclLoc l : extractDeclLocs ds extractDeclLocs (HsTypeSig l _ _ : ds) = DeclLoc l : extractDeclLocs ds extractDeclLocs (HsFunBind l _ : ds) = DeclLoc l : extractDeclLocs ds extractDeclLocs (HsPatBind l _ _ _ : ds) = DeclLoc l : extractDeclLocs ds conDeclLoc :: HsConDecl -> Loc conDeclLoc (HsConDecl l _ _ _ _) = ConsLoc l conDeclLoc (HsRecDecl l _ _) = ConsLoc l -- combine HsParser's output with the HDoc comments combineHsHDoc :: HDocSettings -> HDocInput -> HsMod -> [CommentAssoc] -> ModuleDoc combineHsHDoc hdSet hdInp hsm hdAssocs = moddoc where m @(HsModule _ (Module modname) exp imp decls) = hsmHsModule hsm lookupInfo = makeCommentLookup m hdAssocs (gTags, mTags) = tagsForModule lookupInfo moddoc = ModuleDoc { moduleName = modname, descriptionM = gtDescription gTags, authorM = mtAuthor mTags, versionM = mtVersion mTags, seeTagsM = makeSeeTags gTags moddoc, exports = explist, imports = implist, functions = combFunctions decls hdSet moddoc lookupInfo, datatypes = combDatatypes decls hdSet moddoc lookupInfo, classes = combClasses decls hdSet moddoc lookupInfo, instances = combInstances decls hdSet moddoc lookupInfo, typesynonyms = combTypesyns decls hdSet moddoc lookupInfo, appearsM = moddoc `elem` (visibleModules hdInp), hiddenM = moddoc `elem` (hiddenModules hdInp) } explist = combExports moddoc exp implist = combImports hdSet hdInp moddoc imp combExports :: ModuleDoc -> Maybe [HsExportSpec] -> [Export] combExports md expspecs = nub $ concat $ map hideE $ addVisibleInstances md $ case expspecs of Nothing -> allExports md Just el -> concat (map mk el) where mk :: HsExportSpec -> [Export] mk (HsEVar n) = [ExportFunction f | f <- functions md, localNameMatch f n] ++ [ExportFunction f | Import qual _ qn exps <- imports md, ExportFunction f <- exps, doNamesMatch qual qn n f] mk (HsEAbs n) = case lookupExport md n of Just (ExportClass c _) -> [ExportClass c []] Just (ExportData d _) -> [ExportData d []] -- Just (ExportType t _) -> [ExportType t Nothing] Just (ExportFunction f) -> [ExportFunction f] x -> maybeToList x mk (HsEThingAll n) = maybeToList $ lookupExport md n mk (HsEThingWith n hsfnames) = case lookupExport md n of Just (ExportClass c fs) -> [ExportClass c [f | f <- fs, any (localNameMatch f) (map UnQual hsfnames)]] Just (ExportData d cs) -> [ExportData d [cons | cons@(ConstructorDoc cname desc) <- cs, constructorName cname `elem` map hsNameToString hsfnames]] x -> maybeToList x mk (HsEModuleContents (Module n)) | n == moduleName md = localExports md | otherwise = [es | Import _ impmd qname exps <- imports md, moduleName impmd == n || qname == n, es <- exps] hide :: (CanAppear a, HasHDocName a) => a -> a hide obj | themodule obj /= md = setAppearance obj False | otherwise = obj hideE :: Export -> [Export] hideE (ExportClass c fs) = [ExportClass (hide c) (map hide fs)] ++ [ExportFunction (hide f) | f <- fs] hideE (ExportData d cs) = [ExportData (hide d) cs] hideE (ExportType t Nothing) = [ExportType (hide t) Nothing] hideE (ExportType t (Just _)) = let t' = hide t in [ExportType t' (Just $ constructorT t')] hideE (ExportFunction f) = [ExportFunction (hide f)] hideE (ExportInstance i) = [ExportInstance (hide i)] -- Local functions are considered visible (i.e. they get exported); -- imported instances are exported iff the corresponding class is -- "available" in the current module. addVisibleInstances :: ModuleDoc -> [Export] -> [Export] addVisibleInstances md exps = concat [ExportInstance i : [ExportFunction f | f <- instanceFunctions i] | i <- instances md] ++ reexportedInsts ++ exps where reexportedInsts = nub [i | Import _ _ _ es <- imports md, i@(ExportInstance inst) <- es, classDefAvailable (definingClass inst)] classDefAvailable Nothing = False classDefAvailable (Just clss) = isJust $ relookupClass md clss {- isExp (Context t1 t2) = isExp t1 && isExp t2 isExp (Simple (_,tyid)) = isExpTyid tyid isExp (Fun t1 t2) = isExp t1 && isExp t2 isExp (List t) = isExp t isExp (Tuple ts) = all isExp ts isExp (Con (_,tyid) ts) = isExpTyid tyid && all isExp ts isExpTyid TyUnknown = False isExpTyid TyVar = True isExpTyid (TyClass c) = or [c == c' | ExportClass c' _ <- exps] isExpTyid (TyData d) = or [d == d' | ExportData d' _ <- exps] isExpTyid (TyType t) = or [t == t' | ExportType t' _ <- exps] -} combImports :: HDocSettings -> HDocInput -> ModuleDoc -> [HsImportDecl] -> [Import] combImports hdSet hdInp md imps = visi ++ nonVisi where -- make sure that modules which appear in the output are placed -- in the import list first (that makes lookups prefer exports from -- modules appearing in the output!) (visi, nonVisi) = partition (\(Import _ m _ _) -> appearsInOutput m) [i | Just i <- map mk prelImps] prelImps | moduleName md /= "Prelude" && noExplicitImpPrel = importPrelude : imps | otherwise = imps importPrelude = HsImportDecl (SrcLoc 0 0) (Module "Prelude") False Nothing Nothing noExplicitImpPrel = all (/="Prelude") [m | HsImportDecl _ (Module m) _ _ _ <- imps] mk :: HsImportDecl -> Maybe Import mk (HsImportDecl _ (Module m) qual mbq list) = if (null moddoc) then Nothing else Just $ Import qual (head moddoc) qname expl where qname = case mbq of Nothing -> m Just (Module mq) -> mq expl = case list of Nothing -> map reexportIt $ exports (head moddoc) Just (False, impspecs) -> combImpSpecs impspecs Just (True, impspecs) -> (map reexportIt $ exports (head moddoc)) \\ combImpSpecs impspecs moddoc = [md | md <- allModules hdInp, moduleName md == m] reexportIt :: Export -> Export reexportIt (ExportData d cs) = let d' = reex d in ExportData d' (constructors d' \\ (constructors d' \\ cs)) reexportIt (ExportFunction f) = ExportFunction (reex f) reexportIt (ExportClass c fs) = ExportClass (reex c) (map reex fs) reexportIt (ExportInstance i) = ExportInstance (reex i) reexportIt (ExportType t Nothing) = ExportType (reex t) Nothing reexportIt (ExportType t (Just _)) = let t' = reex t in ExportType t' (Just $ constructorT t') combImpSpecs :: [HsImportSpec] -> [Export] combImpSpecs impspecs = [e | Just e <- map mki impspecs] ++ [ExportInstance (reex i) | ExportInstance i <- exports (head moddoc)] mki :: HsImportSpec -> Maybe Export mki (HsIVar n) = case lookupExportFunction (head moddoc) (UnQual n) of Just (ExportFunction f) -> Just (ExportFunction (reex f)) _ -> Nothing mki (HsIAbs n) = case lookupExport (head moddoc) (UnQual n) of Just (ExportData d _) -> Just (ExportData (reex d) []) -- Just (ExportType t _) -> Just (ExportType (reex t) Nothing) Just (ExportType t Nothing) -> Just (ExportType (reex t) Nothing) Just (ExportType t (Just _)) -> let t' = reex t in Just (ExportType t' (Just $ constructorT t')) Just (ExportClass c _) -> Just (ExportClass (reex c) []) x -> x mki (HsIThingAll n) = case lookupExport (head moddoc) (UnQual n) of Just (ExportClass c fs) -> Just (ExportClass (reex c) (map reex fs)) Just (ExportData d cs) -> let d' = reex d in Just (ExportData d' (constructors d' \\ (constructors d' \\ cs))) Just (ExportType t Nothing) -> Just (ExportType (reex t) Nothing) Just (ExportType t (Just _)) -> let t' = reex t in Just (ExportType t' (Just $ constructorT t')) Just (ExportFunction f) -> error ("cannot export function " ++ thename f ++ " from module " ++ moduleName (themodule f) ++ " with \"(..)\"") x -> x mki (HsIThingWith n hsfnames) = case lookupExport md (UnQual n) of Just (ExportFunction f) -> error ("cannot export function " ++ thename f ++ " from module " ++ moduleName (themodule f) ++ " with \"(" ++ concat (intersperse "," (map hsNameToString hsfnames)) ++ ")\"") Just (ExportClass c fs) -> let c' = reex c in Just (ExportClass c' [reex f | f <- fs, any (localNameMatch f) (map UnQual hsfnames)]) Just (ExportData d cs) -> let d' = reex d names = [constructorName c | ConstructorDoc c _ <- constructors d] in Just (ExportData d' [c' | c'@(ConstructorDoc cn _) <- constructors d', constructorName cn `elem` names]) Just (ExportType t Nothing) -> Just (ExportType (reex t) Nothing) Just (ExportType t (Just _)) -> let t' = reex t in Just (ExportType t' (Just $ constructorT t')) x -> x -- re-export a object, i.e. make it appear as being defined in -- the current module, when its source module is invisible -- but not hidden, *and* we are in "--exports" mode; -- otherwise the object is not make "local". reex :: (HasHDocName a, Reexportable a, CanAppear a) => a -> a reex obj | hdsExportsOnly hdSet == True && appearsInOutput (themodule obj) == False && hiddenM (themodule obj) == False = (reexport obj) md | otherwise = obj combFunctions :: [HsDecl] -> HDocSettings -> ModuleDoc -> CommentLookup -> [FunctionDoc] combFunctions decls hdSet moddoc lookupInfo = concat $ map (mk NoClass) decls where mk :: FunClass -> HsDecl -> [FunctionDoc] mk fc (HsTypeSig l hsnames qualty) = [let (gTags,fTags) = tagsForFunction (UnQual hsn) lookupInfo l (par',ret') = addTypes (expF moddoc) (ftParam fTags) (ftReturn fTags) sig expF md = f where fc' = relookupFunClass md fc f = FunctionDoc { nameF = mkHDocName md (UnQual hsn) l moddoc, descriptionF = gtDescription gTags, seeTagsF = makeSeeTags gTags md, signature = Just (joinContext (relookupType md sig) fc'), paramlist = par', retdescr = ret', funclass = fc', origSig = Just sig, appearsF=appears hdSet md (ExportFunction f), reexportF = expF } in expF moddoc | hsn <- hsnames ] where sig = hsQType2type moddoc qualty mk _ (HsClassDecl l qualty fundeps ds) = case cl of Nothing -> [] Just cd -> concat $ map (mk (Class cd)) ds where cl = lookupClass moddoc (ctypeName $ hsQType2type moddoc qualty) mk _ (HsInstDecl l qualty ds) = case inst of Nothing -> [] Just id -> snd $ foldl (mkI id) ([],[]) ds where inst = lookupInstance moddoc (hsQType2type moddoc qualty) mk _ _ = [] mkI :: InstanceDoc -> ([String], [FunctionDoc]) -> HsDecl -> ([String], [FunctionDoc]) mkI id (names, fs) (HsFunBind l (HsMatch _ n' _ _ _ : _)) = mkI' id (names,fs) l (UnQual n') mkI id (names, fs) (HsPatBind l (HsPVar n') _ _) = mkI' id (names,fs) l (UnQual n') mkI _ _ decl = ([],[]) mkI' id (names, fs) l n | unqualHsQName n `notElem` names = let (gTags,fTags) = tagsForFunction n lookupInfo l par = ftParam fTags ret = ftReturn fTags expF md = f where fc = relookupFunClass md (Instance id) sig = signatureFromClass n fc (par', ret') = case sig of Just s -> addTypes f par ret s Nothing -> (par, ret) f = FunctionDoc { nameF = mkHDocName md n l moddoc, descriptionF = gtDescription gTags, seeTagsF = makeSeeTags gTags md, signature = sig, paramlist = par', retdescr = ret', funclass = fc, origSig = Nothing, appearsF = appears hdSet md (ExportFunction f), reexportF = expF } in (unqualHsQName n : names, expF moddoc:fs) | otherwise = (names, fs) combDatatypes :: [HsDecl] -> HDocSettings -> ModuleDoc -> CommentLookup -> [DataDoc] combDatatypes decls hdSet mod lookupInfo = [dd | Just dd <- map mkDD decls] where mkDD (HsDataDecl l context hsn ns hscons derivedInsts) = Just $ mk mod l context (UnQual hsn) ns hscons derivedInsts False mkDD (HsNewTypeDecl l context hsn ns hscon derivedInsts) = Just $ mk mod l context (UnQual hsn) ns [hscon] derivedInsts True mkDD _ = Nothing mk :: ModuleDoc -> SrcLoc -> [(HsQName, [HsType])] -> HsQName -> [HsName] -> [HsConDecl] -> [HsQName] -> Bool -> DataDoc mk mod l context hsn ns hscons derivedInsts isNT = expD mod where expD md = dd where dd = DataDoc { nameD = mkHDocName md hsn l mod, descriptionD = gtDescription gTags, seeTagsD = makeSeeTags gTags md, typedefD = relookupType md cty, derivedInstances = map unqualHsQName derivedInsts, constructors = condescs, isNewType = isNT, appearsD = appears hdSet md (ExportData dd []), reexportD = expD } (gTags, dTags) = tagsForData hsn lookupInfo l consdes' = dtCons dTags condescs = if null consdes' then map mkConsDesc hscons else map addConsArgTypes consdes' cty = if null context then ty else Context cont ty ty = case ns of [] -> Simple (unqual hsn, TyData dd) _ -> Con (unqual hsn, TyData dd) [Simple (UnQual n, TyUnknown) | n <- ns] cont = hsContext2type md context addConsArgTypes :: ConstructorDoc -> ConstructorDoc addConsArgTypes c@(ConstructorDoc (Labelled _ _) _) = c addConsArgTypes c@(ConstructorDoc (Constructor name fas ctx tys ty) desc) = case findHsConTypesByName name of Nothing -> c -- Nothing should be an error; -- check whether `x' and `ty' are the same type? Just x -> let newTys = zipWith addType tys x newTs = map extractType newTys newCon = Constructor name fas ctx newTys newTs in ConstructorDoc newCon desc consDescr :: HsQName -> SrcLoc -> HDocText consDescr name loc = case findConsHDoc name lookupInfo loc of Nothing -> [] Just (HDoc gen sp) -> gtDescription gen findHsConTypesByName :: String -> Maybe [Type] findHsConTypesByName name = listToMaybe [map unBangTy tys | HsConDecl _ _ _ n tys <- hscons, hsNameToString n == name] mkConsDesc :: HsConDecl -> ConstructorDoc mkConsDesc (HsConDecl loc fas ctx n bangtys) = ConstructorDoc (Constructor (hsNameToString n) (map hsNameToString fas) context tys ts) (consDescr (UnQual n) loc) where context = case ctx of [] -> Nothing cs -> Just (hsContext2type md ctx) (tys, ts) = mkCon bangtys mkConsDesc (HsRecDecl loc n recs) = ConstructorDoc (Labelled (hsNameToString n) [mkRec (UnQual vn) bty | (ns, bty) <- recs, vn <- ns]) (consDescr (UnQual n) loc) mkCon :: [HsBangType] -> ([Typed], [Type]) mkCon [] = ([], []) mkCon bs = unzip [mk (unBangTy b) | b <- bs] where mk t = (Typed (SimpleT "_") t, t) mkRec :: HsQName -> HsBangType -> Typed mkRec vn bt = Typed (SimpleT (unqualHsQName vn)) (unBangTy bt) unBangTy (HsBangedTy t) = hsType2type md t unBangTy (HsUnBangedTy t) = hsType2type md t combTypesyns :: [HsDecl] -> HDocSettings -> ModuleDoc -> CommentLookup -> [TypeDoc] combTypesyns decls hdSet moddoc lookupInfo = [mk l (UnQual hsn) ns hst | HsTypeDecl l hsn ns hst <- decls] where mk :: SrcLoc -> HsQName -> [HsName] -> HsType -> TypeDoc mk l hsn ns hst = expT moddoc where gTags = tagsForType hsn lookupInfo l expT md = td where td = TypeDoc { nameT = mkHDocName md hsn l moddoc, typedefT = relookupType md $ Con (unqual hsn, TyType td) [Simple (UnQual n, TyUnknown) | n <- ns], constructorT = relookupType md consTy, descriptionT = gtDescription gTags, seeTagsT = makeSeeTags gTags md, appearsT = appears hdSet md (ExportType td Nothing), reexportT = expT } consTy = hsType2type moddoc hst combClasses :: [HsDecl] -> HDocSettings -> ModuleDoc -> CommentLookup -> [ClassDoc] combClasses decls hdSet moddoc lookupInfo = [cd | Just cd <- map mk decls] where mk :: HsDecl -> Maybe ClassDoc mk (HsClassDecl l qualty fundeps _) = Just (expC moddoc) where expC md = cd where ty = relookupType md origTy cd = ClassDoc { nameC = mkHDocName md (ctypeName ty) l moddoc, descriptionC = gtDescription gTags, seeTagsC = makeSeeTags gTags md, typedefC = ty, functionalDeps = map mkFunDep fundeps, memberFunctions = [reexport f md | f <- members moddoc (Class cd)], appearsC = appears hdSet md (ExportClass cd []), reexportC = expC } gTags = tagsForClassInst (ctypeName origTy) lookupInfo l origTy = hsQType2type moddoc qualty mk _ = Nothing mkFunDep :: HsFunDep -> FunDep mkFunDep (ns1, ns2) = (map hsNameToString ns1, map hsNameToString ns2) combInstances :: [HsDecl] -> HDocSettings -> ModuleDoc -> CommentLookup -> [InstanceDoc] combInstances decls hdSet moddoc lookupInfo = [id | Just id <- map mk decls] where mk :: HsDecl -> Maybe InstanceDoc mk (HsInstDecl l qualty _) = Just (expI moddoc) where ty = hsQType2type moddoc qualty expI md = id where ty' = relookupType md ty id = InstanceDoc { nameI = mkHDocName md (ctypeName ty') l moddoc, descriptionI = gtDescription gTags, seeTagsI = makeSeeTags gTags md, typedefI = ty', instanceFunctions = members md (Instance id), appearsI = appears hdSet md (ExportInstance id), definingClass = lookupClass md (ctypeName ty'), reexportI = expI } gTags = tagsForClassInst (UnQual (HsIdent "")) lookupInfo l mk _ = Nothing -- convert a `HsQualType' to a HDoc `Type' hsQType2type :: ModuleDoc -> HsQualType -> Type hsQType2type md (HsUnQualType t) = hsType2type md t hsQType2type md (HsQualType fas context t) | null fas = ctt | otherwise = Forall (map hsNameToString fas) ctt where ctt = Context cont (hsType2type md t) cont = hsContext2type md context -- convert a context hsContext2type :: ModuleDoc -> [(HsQName, [HsType])] -> Type hsContext2type md context | length context == 1 = conv (head context) | otherwise = Tuple (map conv context) where conv (a,bs) = Con (lookupTypeId md a) (map (hsType2type md) bs) -- convert a HsType hsType2type :: ModuleDoc -> HsType -> Type hsType2type md hsType = checkTycons $ hst2ty hsType where hst2ty (HsTyVar n) = Simple (UnQual n, TyUnknown) hst2ty (HsTyCon n@(Qual (Module "Prelude") name)) | isSymbolicConstructor (hsNameToString name) = Simple (UnQual name, TyUnknown) | otherwise = Simple (lookupTypeId md n) where isSymbolicConstructor "->" = True isSymbolicConstructor "[]" = True isSymbolicConstructor ('(':ns) = dropWhile (==',') ns == ")" isSymbolicConstructor _ = False hst2ty (HsTyCon n) = Simple (lookupTypeId md n) hst2ty (HsTyTuple ts) = Tuple (map hst2ty ts) hst2ty (HsTyFun t1 t2) = Fun (hst2ty t1) (hst2ty t2) hst2ty (HsTyApp t1 t2) -- | t1 == HsTyCon (Qual (Module "Prelude") "[]") = List (hst2ty t2) | otherwise = case (hst2ty t1, hst2ty t2) of (Con x xs, y) -> Con x (xs ++ [y]) (Simple x, y) -> Con x [y] _ -> error ("HsTyApp conversion failed for:\n " ++ show hsType ++ "\n please report this as a bug") hst2ty (HsTyForall fas t) = Forall (map hsNameToString fas) (hst2ty t) makeSeeTags :: GeneralTags -> ModuleDoc -> [HDR] makeSeeTags gTags moddoc = [x | Just x <- map (findHdr moddoc) (gtSee gTags)] tagsForModule lookupInfo = head ([(gt, mt) | HDoc gt (ModuleTags mt) <- findModuleHDoc lookupInfo] ++ [(emptyGenTags, emptyModuleTags)]) tagsForFunction hsn lookupInfo l = head ([(gt, ft) | HDoc gt (FunctionTags ft) <- findHDoc hsn lookupInfo l] ++ [(emptyGenTags, emptyFunctionTags)]) tagsForData hsn lookupInfo l = head ([(gt, dt) | HDoc gt (DataTags dt) <- findHDoc hsn lookupInfo l] ++ [(emptyGenTags, emptyDataTags)]) tagsForType hsn lookupInfo l = head ([gt | HDoc gt TypeTags <- findHDoc hsn lookupInfo l] ++ [emptyGenTags]) tagsForClassInst hsn lookupInfo l = head ([gt | HDoc gt ClassInstTags <- findHDoc hsn lookupInfo l] ++ [emptyGenTags])