diff options
Diffstat (limited to 'src/Haddock/Backends/HaddockDB.hs')
| -rw-r--r-- | src/Haddock/Backends/HaddockDB.hs | 170 |
1 files changed, 0 insertions, 170 deletions
diff --git a/src/Haddock/Backends/HaddockDB.hs b/src/Haddock/Backends/HaddockDB.hs deleted file mode 100644 index 1c248bfb..00000000 --- a/src/Haddock/Backends/HaddockDB.hs +++ /dev/null @@ -1,170 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Haddock.Backends.HaddockDB --- Copyright : (c) Simon Marlow 2003 --- License : BSD-like --- --- Maintainer : haddock@projects.haskell.org --- Stability : experimental --- Portability : portable ------------------------------------------------------------------------------ -module Haddock.Backends.HaddockDB (ppDocBook) where - -{- -import HaddockTypes -import HaddockUtil -import HsSyn2 - -import Text.PrettyPrint --} - ------------------------------------------------------------------------------ --- Printing the results in DocBook format - -ppDocBook :: a -ppDocBook = error "not working" -{- -ppDocBook :: FilePath -> [(Module, Interface)] -> String -ppDocBook odir mods = render (ppIfaces mods) - -ppIfaces mods - = text "<!DOCTYPE BOOK PUBLIC \"-//OASIS//DTD DocBook V3.1//EN\" [" - $$ text "]>" - $$ text "<book>" - $$ text "<bookinfo>" - $$ text "<author><othername>HaskellDoc version 0.0</othername></author>" - $$ text "</bookinfo>" - $$ text "<article>" - $$ vcat (map do_mod mods) - $$ text "</article></book>" - where - do_mod (Module mod, iface) - = text "<sect1 id=\"sec-" <> text mod <> text "\">" - $$ text "<title><literal>" - <> text mod - <> text "</literal></title>" - $$ text "<indexterm><primary><literal>" - <> text mod - <> text "</literal></primary></indexterm>" - $$ text "<variablelist>" - $$ vcat (map (do_export mod) (eltsFM (iface_decls iface))) - $$ text "</variablelist>" - $$ text "</sect1>" - - do_export mod decl | (nm:_) <- declBinders decl - = text "<varlistentry id=" <> ppLinkId mod nm <> char '>' - $$ text "<term><literal>" - <> do_decl decl - <> text "</literal></term>" - $$ text "<listitem>" - $$ text "<para>" - $$ text "</para>" - $$ text "</listitem>" - $$ text "</varlistentry>" - do_export _ _ = empty - - do_decl (HsTypeSig _ [nm] ty _) - = ppHsName nm <> text " :: " <> ppHsType ty - do_decl (HsTypeDecl _ nm args ty _) - = hsep ([text "type", ppHsName nm ] - ++ map ppHsName args - ++ [equals, ppHsType ty]) - do_decl (HsNewTypeDecl loc ctx nm args con drv _) - = hsep ([text "data", ppHsName nm] -- data, not newtype - ++ map ppHsName args - ) <+> equals <+> ppHsConstr con -- ToDo: derivings - do_decl (HsDataDecl loc ctx nm args cons drv _) - = hsep ([text "data", {-ToDo: context-}ppHsName nm] - ++ map ppHsName args) - <+> vcat (zipWith (<+>) (equals : repeat (char '|')) - (map ppHsConstr cons)) - do_decl (HsClassDecl loc ty fds decl _) - = hsep [text "class", ppHsType ty] - do_decl decl - = empty - -ppHsConstr :: HsConDecl -> Doc -ppHsConstr (HsRecDecl pos name tvs ctxt fieldList maybe_doc) = - ppHsName name - <> (braces . hsep . punctuate comma . map ppField $ fieldList) -ppHsConstr (HsConDecl pos name tvs ctxt typeList maybe_doc) = - hsep (ppHsName name : map ppHsBangType typeList) - -ppField (HsFieldDecl ns ty doc) - = hsep (punctuate comma (map ppHsName ns) ++ - [text "::", ppHsBangType ty]) - -ppHsBangType :: HsBangType -> Doc -ppHsBangType (HsBangedTy ty) = char '!' <> ppHsType ty -ppHsBangType (HsUnBangedTy ty) = ppHsType ty - -ppHsContext :: HsContext -> Doc -ppHsContext [] = empty -ppHsContext context = parenList (map (\ (a,b) -> ppHsQName a <+> - hsep (map ppHsAType b)) context) - -ppHsType :: HsType -> Doc -ppHsType (HsForAllType Nothing context htype) = - hsep [ ppHsContext context, text "=>", ppHsType htype] -ppHsType (HsForAllType (Just tvs) [] htype) = - hsep (text "forall" : map ppHsName tvs ++ text "." : [ppHsType htype]) -ppHsType (HsForAllType (Just tvs) context htype) = - hsep (text "forall" : map ppHsName tvs ++ text "." : - ppHsContext context : text "=>" : [ppHsType htype]) -ppHsType (HsTyFun a b) = fsep [ppHsBType a, text "->", ppHsType b] -ppHsType (HsTyIP n t) = fsep [(char '?' <> ppHsName n), text "::", ppHsType t] -ppHsType t = ppHsBType t - -ppHsBType (HsTyApp (HsTyCon (Qual (Module "Prelude") (HsTyClsName (HsSpecial "[]")))) b ) - = brackets $ ppHsType b -ppHsBType (HsTyApp a b) = fsep [ppHsBType a, ppHsAType b] -ppHsBType t = ppHsAType t - -ppHsAType :: HsType -> Doc -ppHsAType (HsTyTuple True l) = parenList . map ppHsType $ l -ppHsAType (HsTyTuple False l) = ubxParenList . map ppHsType $ l --- special case -ppHsAType (HsTyApp (HsTyCon (Qual (Module "Prelude") (HsTyClsName (HsSpecial "[]")))) b ) - = brackets $ ppHsType b -ppHsAType (HsTyVar name) = ppHsName name -ppHsAType (HsTyCon name) = ppHsQName name -ppHsAType t = parens $ ppHsType t - -ppHsQName :: HsQName -> Doc -ppHsQName (UnQual str) = ppHsName str -ppHsQName n@(Qual (Module mod) str) - | n == unit_con_name = ppHsName str - | isSpecial str = ppHsName str - | otherwise - = text "<link linkend=" <> ppLinkId mod str <> char '>' - <> ppHsName str - <> text "</link>" - -isSpecial (HsTyClsName id) | HsSpecial _ <- id = True -isSpecial (HsVarName id) | HsSpecial _ <- id = True -isSpecial _ = False - -ppHsName :: HsName -> Doc -ppHsName (HsTyClsName id) = ppHsIdentifier id -ppHsName (HsVarName id) = ppHsIdentifier id - -ppHsIdentifier :: HsIdentifier -> Doc -ppHsIdentifier (HsIdent str) = text str -ppHsIdentifier (HsSymbol str) = text str -ppHsIdentifier (HsSpecial str) = text str - -ppLinkId :: String -> HsName -> Doc -ppLinkId mod str - = hcat [char '\"', text mod, char '.', ppHsName str, char '\"'] - --- ----------------------------------------------------------------------------- --- * Misc - -parenList :: [Doc] -> Doc -parenList = parens . fsep . punctuate comma - -ubxParenList :: [Doc] -> Doc -ubxParenList = ubxparens . fsep . punctuate comma - -ubxparens p = text "(#" <> p <> text "#)" --} |