X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FhsSyn%2FHsSyn.lhs;h=507eab60db13cd4c806d6c1d609b3ceccfe9c12d;hb=81dd3afef58136efab3dc2691f3c7a7ee844ad91;hp=2169b1a3b6a7cee09b8c899f782a6294c239a528;hpb=108361d05dfb0aa37871c2c6a4ddec45a1b68010;p=ghc-hetmet.git diff --git a/compiler/hsSyn/HsSyn.lhs b/compiler/hsSyn/HsSyn.lhs index 2169b1a..507eab6 100644 --- a/compiler/hsSyn/HsSyn.lhs +++ b/compiler/hsSyn/HsSyn.lhs @@ -1,4 +1,5 @@ % +% (c) The University of Glasgow 2006 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % \section{Haskell abstract syntax definition} @@ -17,12 +18,14 @@ module HsSyn ( module HsPat, module HsTypes, module HsUtils, + module HsDoc, Fixity, - HsModule(..), HsExtCore(..) - ) where + HsModule(..), HsExtCore(..), -#include "HsVersions.h" + HaddockModInfo(..), + emptyHaddockModInfo, +) where -- friends: import HsDecls @@ -34,12 +37,14 @@ import HsPat import HsTypes import BasicTypes ( Fixity, DeprecTxt ) import HsUtils +import HsDoc -- others: import IfaceSyn ( IfaceBinding ) import Outputable import SrcLoc ( Located(..) ) import Module ( Module, ModuleName ) +import FastString \end{code} All we actually declare here is the top-level structure for a module. @@ -57,6 +62,23 @@ data HsModule name -- often empty, downstream. [LHsDecl name] -- Type, class, value, and interface signature decls (Maybe DeprecTxt) -- reason/explanation for deprecation of this module + (HaddockModInfo name) -- Haddock module info + (Maybe (HsDoc name)) -- Haddock module description + +data HaddockModInfo name = HaddockModInfo { + hmi_description :: Maybe (HsDoc name), + hmi_portability :: Maybe String, + hmi_stability :: Maybe String, + hmi_maintainer :: Maybe String +} + +emptyHaddockModInfo :: HaddockModInfo a +emptyHaddockModInfo = HaddockModInfo { + hmi_description = Nothing, + hmi_portability = Nothing, + hmi_stability = Nothing, + hmi_maintainer = Nothing +} data HsExtCore name -- Read from Foo.hcr = HsExtCore @@ -66,32 +88,42 @@ data HsExtCore name -- Read from Foo.hcr [IfaceBinding] -- And the bindings \end{code} + \begin{code} +instance Outputable Char where + ppr c = text [c] + instance (OutputableBndr name) => Outputable (HsModule name) where - ppr (HsModule Nothing _ imports decls _) - = pp_nonnull imports $$ pp_nonnull decls + ppr (HsModule Nothing _ imports decls _ _ mbDoc) + = pp_mb mbDoc $$ pp_nonnull imports $$ pp_nonnull decls - ppr (HsModule (Just name) exports imports decls deprec) + ppr (HsModule (Just name) exports imports decls deprec _ mbDoc) = vcat [ + pp_mb mbDoc, case exports of - Nothing -> pp_header (ptext SLIT("where")) + Nothing -> pp_header (ptext (sLit "where")) Just es -> vcat [ pp_header lparen, nest 8 (fsep (punctuate comma (map ppr es))), - nest 4 (ptext SLIT(") where")) + nest 4 (ptext (sLit ") where")) ], pp_nonnull imports, pp_nonnull decls - ] + ] where pp_header rest = case deprec of Nothing -> pp_modname <+> rest Just d -> vcat [ pp_modname, ppr d, rest ] - pp_modname = ptext SLIT("module") <+> ppr name + pp_modname = ptext (sLit "module") <+> ppr name + +pp_mb :: Outputable t => Maybe t -> SDoc +pp_mb (Just x) = ppr x +pp_mb Nothing = empty +pp_nonnull :: Outputable t => [t] -> SDoc pp_nonnull [] = empty pp_nonnull xs = vcat (map ppr xs) \end{code}