diff options
Diffstat (limited to 'src/HaddockTypes.hs')
| -rw-r--r-- | src/HaddockTypes.hs | 77 |
1 files changed, 0 insertions, 77 deletions
diff --git a/src/HaddockTypes.hs b/src/HaddockTypes.hs index e29d5dae..c157a753 100644 --- a/src/HaddockTypes.hs +++ b/src/HaddockTypes.hs @@ -12,16 +12,11 @@ module HaddockTypes ( DocString, GenDoc(..), Doc, ParsedDoc, DocMarkup(..), markup, mapIdent, docAppend, docParagraph, - - -- * Misc utilities - nameOfQName, collectNames, declBinders, declMainBinder, splitTyConApp, - restrictTo, ) where import FiniteMap import HsSyn -import List (intersect) import Char (isSpace) -- --------------------------------------------------------------------------- @@ -77,78 +72,6 @@ data ExportItem type ModuleMap = FiniteMap Module Interface -- ----------------------------------------------------------------------------- --- Some Utilities - -nameOfQName (Qual _ n) = n -nameOfQName (UnQual n) = n - -collectNames :: [HsDecl] -> [HsName] -collectNames ds = concat (map declBinders ds) - -declMainBinder :: HsDecl -> Maybe HsName -declMainBinder d = - case d of - HsTypeDecl _ n _ _ -> Just n - HsDataDecl _ _ n _ cons _ -> Just n - HsNewTypeDecl _ _ n _ _ _ -> Just n - HsClassDecl _ qt decls -> Just (exQtNm qt) - HsTypeSig _ [n] _ -> Just n - HsTypeSig _ ns _ -> error "declMainBinder" - HsForeignImport _ _ _ _ n _ -> Just n - _ -> Nothing - -declBinders :: HsDecl -> [HsName] -declBinders d = - case d of - HsTypeDecl _ n _ _ -> [n] - HsDataDecl _ _ n _ cons _ -> n : concat (map conDeclBinders cons) - HsNewTypeDecl _ _ n _ _ _ -> [n] - HsClassDecl _ qt decls -> exQtNm qt : collectNames decls - HsTypeSig _ ns _ -> ns - HsForeignImport _ _ _ _ n _ -> [n] - _ -> [] - -conDeclBinders (HsConDecl _ n _ _) = [n] -conDeclBinders (HsRecDecl _ n fields _) = n : concat (map fieldDeclBinders fields) - -fieldDeclBinders (HsFieldDecl ns _ _) = ns - -exQtNm (HsForAllType _ _ t) = nameOfQName (fst (splitTyConApp t)) -exQtNm t = nameOfQName (fst (splitTyConApp t)) - -splitTyConApp :: HsType -> (HsQName,[HsType]) -splitTyConApp t = split t [] - where - split :: HsType -> [HsType] -> (HsQName,[HsType]) - split (HsTyApp t u) ts = split t (u:ts) - split (HsTyCon t) ts = (t,ts) - split _ _ = error "splitTyConApp" - --- --------------------------------------------------------------------------- --- Making abstract declarations - -restrictTo :: [HsName] -> HsDecl -> HsDecl -restrictTo names decl = case decl of - HsDataDecl loc ctxt n xs cons drv -> - HsDataDecl loc ctxt n xs (restrictCons names cons) drv - HsNewTypeDecl loc ctxt n xs con drv -> - HsDataDecl loc ctxt n xs (restrictCons names [con]) drv - HsClassDecl loc qt decls -> - HsClassDecl loc qt (restrictDecls names decls) - _ -> decl - -restrictCons :: [HsName] -> [HsConDecl] -> [HsConDecl] -restrictCons names decls = filter keep decls - where keep (HsConDecl _ n _ _) = n `elem` names - keep (HsRecDecl _ n _ _) = n `elem` names - -- ToDo: records not right - -restrictDecls :: [HsName] -> [HsDecl] -> [HsDecl] -restrictDecls names decls = filter keep decls - where keep d = not (null (declBinders d `intersect` names)) - -- ToDo: not really correct - --- ----------------------------------------------------------------------------- -- Doc strings and formatting data GenDoc id |