diff options
| -rw-r--r-- | haddock.cabal | 2 | ||||
| -rw-r--r-- | src/Haddock/Backends/Hoogle.hs | 8 | ||||
| -rw-r--r-- | src/Haddock/Backends/Html.hs | 28 | ||||
| -rw-r--r-- | src/Haddock/Doc.hs (renamed from src/Haddock/HsDoc.hs) | 8 | ||||
| -rw-r--r-- | src/Haddock/Interface/AttachInstances.hs | 2 | ||||
| -rw-r--r-- | src/Haddock/Interface/LexParseRn.hs | 14 | ||||
| -rw-r--r-- | src/Haddock/Interface/Parse.y | 26 | ||||
| -rw-r--r-- | src/Haddock/Interface/ParseModuleHeader.hs | 4 | ||||
| -rw-r--r-- | src/Haddock/Interface/Rename.hs | 6 | ||||
| -rw-r--r-- | src/Haddock/Interface/Rn.hs | 8 | ||||
| -rw-r--r-- | src/Haddock/InterfaceFile.hs | 2 | ||||
| -rw-r--r-- | src/Haddock/ModuleTree.hs | 10 | ||||
| -rw-r--r-- | src/Haddock/Types.hs | 49 | ||||
| -rw-r--r-- | src/Haddock/Utils.hs | 12 | ||||
| -rw-r--r-- | src/Main.hs | 2 | 
15 files changed, 90 insertions, 91 deletions
diff --git a/haddock.cabal b/haddock.cabal index 286a3517..59b68c9e 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -116,7 +116,7 @@ executable haddock      Haddock.Backends.Hoogle      Haddock.ModuleTree      Haddock.Types -    Haddock.HsDoc +    Haddock.Doc      Haddock.Version      Haddock.InterfaceFile              Haddock.Options diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs index 3412033d..9958faeb 100644 --- a/src/Haddock/Backends/Hoogle.hs +++ b/src/Haddock/Backends/Hoogle.hs @@ -35,7 +35,7 @@ prefix = ["-- Hoogle documentation, generated by Haddock"           ,""] -ppHoogle :: String -> String -> String -> Maybe (HsDoc RdrName) -> [Interface] -> FilePath -> IO () +ppHoogle :: String -> String -> String -> Maybe (Doc RdrName) -> [Interface] -> FilePath -> IO ()  ppHoogle package version synopsis prologue ifaces odir = do      let filename = package ++ ".txt"          contents = prefix ++ @@ -168,7 +168,7 @@ ppData x subdocs = showData x{tcdCons=[],tcdDerivs=Nothing} :                  f w = if w == nam then operator nam else w  -- | for constructors, and named-fields... -lookupCon :: [(Name, DocForDecl Name)] -> Located Name -> Maybe (HsDoc Name) +lookupCon :: [(Name, DocForDecl Name)] -> Located Name -> Maybe (Doc Name)  lookupCon subdocs (L _ name) = case lookup name subdocs of    Just (d, _) -> d    _ -> Nothing @@ -198,11 +198,11 @@ ppCtor dat subdocs con = doc (lookupCon subdocs (con_name con))  ---------------------------------------------------------------------  -- DOCUMENTATION -doc :: Outputable o => Maybe (HsDoc o) -> [String] +doc :: Outputable o => Maybe (Doc o) -> [String]  doc = docWith "" -docWith :: Outputable o => String -> Maybe (HsDoc o) -> [String] +docWith :: Outputable o => String -> Maybe (Doc o) -> [String]  docWith [] Nothing = []  docWith header d = ("":) $ zipWith (++) ("-- | " : repeat "--   ") $      [header | header /= ""] ++ ["" | header /= "" && isJust d] ++ diff --git a/src/Haddock/Backends/Html.hs b/src/Haddock/Backends/Html.hs index c29f2483..37c9cca0 100644 --- a/src/Haddock/Backends/Html.hs +++ b/src/Haddock/Backends/Html.hs @@ -63,7 +63,7 @@ ppHtml	:: String  	-> Maybe String				-- package  	-> [Interface]  	-> FilePath			-- destination directory -	-> Maybe (HsDoc GHC.RdrName)    -- prologue text, maybe +	-> Maybe (Doc GHC.RdrName)    -- prologue text, maybe  	-> Maybe String		        -- the Html Help format (--html-help)  	-> SourceURLs			-- the source URL (--source)  	-> WikiURLs			-- the wiki URL (--wiki) @@ -306,7 +306,7 @@ ppHtmlContents     -> Maybe String     -> SourceURLs     -> WikiURLs -   -> [InstalledInterface] -> Bool -> Maybe (HsDoc GHC.RdrName) +   -> [InstalledInterface] -> Bool -> Maybe (Doc GHC.RdrName)     -> IO ()  ppHtmlContents odir doctitle    maybe_package maybe_html_help_format maybe_index_url @@ -341,7 +341,7 @@ ppHtmlContents odir doctitle      Just "devhelp" -> return ()      Just format    -> fail ("The "++format++" format is not implemented") -ppPrologue :: String -> Maybe (HsDoc GHC.RdrName) -> HtmlTable +ppPrologue :: String -> Maybe (Doc GHC.RdrName) -> HtmlTable  ppPrologue _ Nothing = Html.emptyTable  ppPrologue title (Just doc) =     (tda [theclass "section1"] << toHtml title) </> @@ -800,7 +800,7 @@ ppDocGroup lev doc    | lev == 3  = tda [ theclass "section3" ] << doc    | otherwise = tda [ theclass "section4" ] << doc -declWithDoc :: Bool -> LinksInfo -> SrcSpan -> DocName -> Maybe (HsDoc DocName) -> Html -> HtmlTable +declWithDoc :: Bool -> LinksInfo -> SrcSpan -> DocName -> Maybe (Doc DocName) -> Html -> HtmlTable  declWithDoc True  _     _   _  _          html_decl = declBox html_decl  declWithDoc False links loc nm Nothing    html_decl = topDeclBox links loc nm html_decl  declWithDoc False links loc nm (Just doc) html_decl =  @@ -928,7 +928,7 @@ ppTyFamHeader summary associated decl unicode =      Nothing -> empty -ppTyFam :: Bool -> Bool -> LinksInfo -> SrcSpan -> Maybe (HsDoc DocName) -> +ppTyFam :: Bool -> Bool -> LinksInfo -> SrcSpan -> Maybe (Doc DocName) ->                TyClDecl DocName -> Bool -> HtmlTable  ppTyFam summary associated links loc mbDoc decl unicode @@ -985,7 +985,7 @@ ppDataInst = undefined  -------------------------------------------------------------------------------- -ppTyInst :: Bool -> Bool -> LinksInfo -> SrcSpan -> Maybe (HsDoc DocName) -> +ppTyInst :: Bool -> Bool -> LinksInfo -> SrcSpan -> Maybe (Doc DocName) ->              TyClDecl DocName -> Bool -> HtmlTable  ppTyInst summary associated links loc mbDoc decl unicode @@ -1151,7 +1151,7 @@ ppShortClassDecl _ _ _ _ _ _ = error "declaration type not supported by ppShortC  ppClassDecl :: Bool -> LinksInfo -> [DocInstance DocName] -> SrcSpan -            -> Maybe (HsDoc DocName) -> [(DocName, DocForDecl DocName)] +            -> Maybe (Doc DocName) -> [(DocName, DocForDecl DocName)]              -> TyClDecl DocName -> Bool -> HtmlTable  ppClassDecl summary links instances loc mbDoc subdocs  	decl@(ClassDecl lctxt lname ltyvars lfds lsigs _ ats _) unicode @@ -1258,7 +1258,7 @@ ppShortDataDecl summary links loc dataDecl unicode  ppDataDecl :: Bool -> LinksInfo -> [DocInstance DocName] ->                [(DocName, DocForDecl DocName)] -> -              SrcSpan -> Maybe (HsDoc DocName) -> TyClDecl DocName -> Bool -> HtmlTable +              SrcSpan -> Maybe (Doc DocName) -> TyClDecl DocName -> Bool -> HtmlTable  ppDataDecl summary links instances subdocs loc mbDoc dataDecl unicode    | summary = declWithDoc summary links loc docname mbDoc  @@ -1738,13 +1738,13 @@ htmlRdrMarkup = parHtmlMarkup ppRdrName isRdrTc  -- If the doc is a single paragraph, don't surround it with <P> (this causes  -- ugly extra whitespace with some browsers). -docToHtml :: HsDoc DocName -> Html +docToHtml :: Doc DocName -> Html  docToHtml doc = markup htmlMarkup (unParagraph (markup htmlCleanup doc)) -origDocToHtml :: HsDoc Name -> Html +origDocToHtml :: Doc Name -> Html  origDocToHtml doc = markup htmlOrigMarkup (unParagraph (markup htmlCleanup doc)) -rdrDocToHtml :: HsDoc RdrName -> Html +rdrDocToHtml :: Doc RdrName -> Html  rdrDocToHtml doc = markup htmlRdrMarkup (unParagraph (markup htmlCleanup doc))  -- If there is a single paragraph, then surrounding it with <P>..</P> @@ -1752,13 +1752,13 @@ rdrDocToHtml doc = markup htmlRdrMarkup (unParagraph (markup htmlCleanup doc))  -- we have multiple paragraphs, then we want the extra whitespace to  -- separate them.  So we catch the single paragraph case and transform it  -- here. -unParagraph :: HsDoc a -> HsDoc a +unParagraph :: Doc a -> Doc a  unParagraph (DocParagraph d) = d  --NO: This eliminates line breaks in the code block:  (SDM, 6/5/2003)  --unParagraph (DocCodeBlock d) = (DocMonospaced d)  unParagraph doc              = doc -htmlCleanup :: DocMarkup a (HsDoc a) +htmlCleanup :: DocMarkup a (Doc a)  htmlCleanup = idMarkup {     markupUnorderedList = DocUnorderedList . map unParagraph,    markupOrderedList   = DocOrderedList   . map unParagraph @@ -1894,7 +1894,7 @@ ndocBox html = tda [theclass "ndoc"] << html  rdocBox :: Html -> HtmlTable  rdocBox html = tda [theclass "rdoc"] << html -maybeRDocBox :: Maybe (HsDoc DocName) -> HtmlTable +maybeRDocBox :: Maybe (Doc DocName) -> HtmlTable  maybeRDocBox Nothing = rdocBox (noHtml)  maybeRDocBox (Just doc) = rdocBox (docToHtml doc) diff --git a/src/Haddock/HsDoc.hs b/src/Haddock/Doc.hs index bb355a26..adafc8fd 100644 --- a/src/Haddock/HsDoc.hs +++ b/src/Haddock/Doc.hs @@ -1,4 +1,4 @@ -module Haddock.HsDoc ( +module Haddock.Doc (    docAppend,    docParagraph    ) where @@ -9,7 +9,7 @@ import Data.Char (isSpace)  -- used to make parsing easier; we group the list items later -docAppend :: HsDoc id -> HsDoc id -> HsDoc id +docAppend :: Doc id -> Doc id -> Doc id  docAppend (DocUnorderedList ds1) (DocUnorderedList ds2)    = DocUnorderedList (ds1++ds2)  docAppend (DocUnorderedList ds1) (DocAppend (DocUnorderedList ds2) d) @@ -29,7 +29,7 @@ docAppend d1 d2  -- again to make parsing easier - we spot a paragraph whose only item  -- is a DocMonospaced and make it into a DocCodeBlock -docParagraph :: HsDoc id -> HsDoc id +docParagraph :: Doc id -> Doc id  docParagraph (DocMonospaced p)    = DocCodeBlock (docCodeBlock p)  docParagraph (DocAppend (DocString s1) (DocMonospaced p)) @@ -56,7 +56,7 @@ docParagraph p  -- gives an extra vertical space after the code block.  The single space  -- on the final line seems to trigger the extra vertical space.  -- -docCodeBlock :: HsDoc id -> HsDoc id +docCodeBlock :: Doc id -> Doc id  docCodeBlock (DocString s)    = DocString (reverse $ dropWhile (`elem` " \t") $ reverse s)  docCodeBlock (DocAppend l r) diff --git a/src/Haddock/Interface/AttachInstances.hs b/src/Haddock/Interface/AttachInstances.hs index b6d988dc..abc5f053 100644 --- a/src/Haddock/Interface/AttachInstances.hs +++ b/src/Haddock/Interface/AttachInstances.hs @@ -56,7 +56,7 @@ attachInstances ifaces instIfaceMap = mapM attach ifaces          attachExport export = return export -lookupInstDoc :: Name -> Interface -> InstIfaceMap -> Maybe (HsDoc Name) +lookupInstDoc :: Name -> Interface -> InstIfaceMap -> Maybe (Doc Name)  -- TODO: capture this pattern in a function (when we have streamlined the  -- handling of instances)  lookupInstDoc name iface ifaceMap = diff --git a/src/Haddock/Interface/LexParseRn.hs b/src/Haddock/Interface/LexParseRn.hs index dc7744c7..fc44cedf 100644 --- a/src/Haddock/Interface/LexParseRn.hs +++ b/src/Haddock/Interface/LexParseRn.hs @@ -23,7 +23,7 @@ import Haddock.Interface.Lex  import Haddock.Interface.Parse  import Haddock.Interface.Rn  import Haddock.Interface.ParseModuleHeader -import Haddock.HsDoc +import Haddock.Doc  import Data.Maybe  import FastString  import GHC @@ -31,7 +31,7 @@ import RdrName  data HaddockCommentType = NormalHaddockComment | DocSectionComment -lexParseRnHaddockCommentList :: HaddockCommentType -> GlobalRdrEnv -> [HsDocString] -> ErrMsgM (Maybe (HsDoc Name)) +lexParseRnHaddockCommentList :: HaddockCommentType -> GlobalRdrEnv -> [HsDocString] -> ErrMsgM (Maybe (Doc Name))  lexParseRnHaddockCommentList hty gre docStrs = do    docMbs <- mapM (lexParseRnHaddockComment hty gre) docStrs    let docs = catMaybes docMbs @@ -41,7 +41,7 @@ lexParseRnHaddockCommentList hty gre docStrs = do      _ -> return (Just doc)  lexParseRnHaddockComment :: HaddockCommentType -> -    GlobalRdrEnv -> HsDocString -> ErrMsgM (Maybe (HsDoc Name)) +    GlobalRdrEnv -> HsDocString -> ErrMsgM (Maybe (Doc Name))  lexParseRnHaddockComment hty gre (HsDocString fs) = do     let str = unpackFS fs     let toks = tokenise str @@ -52,14 +52,14 @@ lexParseRnHaddockComment hty gre (HsDocString fs) = do       Nothing -> do         tell ["doc comment parse failed: "++str]         return Nothing -     Just doc -> return (Just (rnHsDoc gre doc)) +     Just doc -> return (Just (rnDoc gre doc)) -lexParseRnMbHaddockComment :: HaddockCommentType -> GlobalRdrEnv -> Maybe HsDocString -> ErrMsgM (Maybe (HsDoc Name)) +lexParseRnMbHaddockComment :: HaddockCommentType -> GlobalRdrEnv -> Maybe HsDocString -> ErrMsgM (Maybe (Doc Name))  lexParseRnMbHaddockComment _ _ Nothing = return Nothing  lexParseRnMbHaddockComment hty gre (Just d) = lexParseRnHaddockComment hty gre d  -- yes, you always get a HaddockModInfo though it might be empty -lexParseRnHaddockModHeader :: GlobalRdrEnv -> GhcDocHdr -> ErrMsgM (HaddockModInfo Name, Maybe (HsDoc Name)) +lexParseRnHaddockModHeader :: GlobalRdrEnv -> GhcDocHdr -> ErrMsgM (HaddockModInfo Name, Maybe (Doc Name))  lexParseRnHaddockModHeader gre mbStr = do    let failure = (emptyHaddockModInfo, Nothing)    case mbStr of @@ -71,4 +71,4 @@ lexParseRnHaddockModHeader gre mbStr = do            tell ["haddock module header parse failed: " ++ mess]            return failure          Right (info, doc) -> -          return (rnHaddockModInfo gre info, Just (rnHsDoc gre doc)) +          return (rnHaddockModInfo gre info, Just (rnDoc gre doc)) diff --git a/src/Haddock/Interface/Parse.y b/src/Haddock/Interface/Parse.y index f420c8e4..a5175ddc 100644 --- a/src/Haddock/Interface/Parse.y +++ b/src/Haddock/Interface/Parse.y @@ -12,8 +12,8 @@ module Haddock.Interface.Parse (  ) where  import Haddock.Interface.Lex -import Haddock.Types (HsDoc(..)) -import Haddock.HsDoc +import Haddock.Types (Doc(..)) +import Haddock.Doc  import HsSyn  import RdrName  } @@ -45,49 +45,49 @@ import RdrName  %% -doc	:: { HsDoc RdrName } +doc	:: { Doc RdrName }  	: apara PARA doc	{ docAppend $1 $3 }  	| PARA doc 		{ $2 }  	| apara			{ $1 }  	| {- empty -}		{ DocEmpty } -apara	:: { HsDoc RdrName } +apara	:: { Doc RdrName }  	: ulpara		{ DocUnorderedList [$1] }  	| olpara		{ DocOrderedList [$1] }          | defpara               { DocDefList [$1] }  	| para			{ $1 } -ulpara  :: { HsDoc RdrName } +ulpara  :: { Doc RdrName }  	: '-' para		{ $2 } -olpara  :: { HsDoc RdrName }  +olpara  :: { Doc RdrName }   	: '(n)' para		{ $2 } -defpara :: { (HsDoc RdrName, HsDoc RdrName) } +defpara :: { (Doc RdrName, Doc RdrName) }  	: '[' seq ']' seq	{ ($2, $4) } -para    :: { HsDoc RdrName } +para    :: { Doc RdrName }  	: seq			{ docParagraph $1 }  	| codepara		{ DocCodeBlock $1 } -codepara :: { HsDoc RdrName } +codepara :: { Doc RdrName }  	: '>..' codepara	{ docAppend (DocString $1) $2 }  	| '>..'			{ DocString $1 } -seq	:: { HsDoc RdrName } +seq	:: { Doc RdrName }  	: elem seq		{ docAppend $1 $2 }  	| elem			{ $1 } -elem	:: { HsDoc RdrName } +elem	:: { Doc RdrName }  	: elem1			{ $1 }  	| '@' seq1 '@'		{ DocMonospaced $2 } -seq1	:: { HsDoc RdrName } +seq1	:: { Doc RdrName }  	: PARA seq1             { docAppend (DocString "\n") $2 }  	| elem1 seq1            { docAppend $1 $2 }  	| elem1			{ $1 } -elem1	:: { HsDoc RdrName } +elem1	:: { Doc RdrName }  	: STRING		{ DocString $1 }  	| '/../'                { DocEmphasis (DocString $1) }  	| URL			{ DocURL $1 } diff --git a/src/Haddock/Interface/ParseModuleHeader.hs b/src/Haddock/Interface/ParseModuleHeader.hs index eb563656..e74a0aef 100644 --- a/src/Haddock/Interface/ParseModuleHeader.hs +++ b/src/Haddock/Interface/ParseModuleHeader.hs @@ -26,7 +26,7 @@ import Data.Char  -- NB.  The headers must be given in the order Module, Description,  -- Copyright, License, Maintainer, Stability, Portability, except that  -- any or all may be omitted. -parseModuleHeader :: String -> Either String (HaddockModInfo RdrName, HsDoc RdrName) +parseModuleHeader :: String -> Either String (HaddockModInfo RdrName, Doc RdrName)  parseModuleHeader str0 =     let        getKey :: String -> String -> (Maybe String,String) @@ -43,7 +43,7 @@ parseModuleHeader str0 =        (stabilityOpt,str7) = getKey "Stability" str6        (portabilityOpt,str8) = getKey "Portability" str7 -      description1 :: Either String (Maybe (HsDoc RdrName)) +      description1 :: Either String (Maybe (Doc RdrName))        description1 = case descriptionOpt of           Nothing -> Right Nothing           Just description -> case parseHaddockString . tokenise $ description of diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs index 0d678537..80dc7d14 100644 --- a/src/Haddock/Interface/Rename.hs +++ b/src/Haddock/Interface/Rename.hs @@ -146,14 +146,14 @@ renameExportItems :: [ExportItem Name] -> RnM [ExportItem DocName]  renameExportItems = mapM renameExportItem -renameDocForDecl :: (Maybe (HsDoc Name), FnArgsDoc Name) -> RnM (Maybe (HsDoc DocName), FnArgsDoc DocName) +renameDocForDecl :: (Maybe (Doc Name), FnArgsDoc Name) -> RnM (Maybe (Doc DocName), FnArgsDoc DocName)  renameDocForDecl (mbDoc, fnArgsDoc) = do    mbDoc' <- renameMaybeDoc mbDoc    fnArgsDoc' <- renameFnArgsDoc fnArgsDoc    return (mbDoc', fnArgsDoc') -renameMaybeDoc :: Maybe (HsDoc Name) -> RnM (Maybe (HsDoc DocName)) +renameMaybeDoc :: Maybe (Doc Name) -> RnM (Maybe (Doc DocName))  renameMaybeDoc = mapM renameDoc @@ -161,7 +161,7 @@ renameLDocHsSyn :: LHsDocString -> RnM LHsDocString  renameLDocHsSyn = return -renameDoc :: HsDoc Name -> RnM (HsDoc DocName) +renameDoc :: Doc Name -> RnM (Doc DocName)  renameDoc d = case d of    DocEmpty -> return DocEmpty    DocAppend a b -> do diff --git a/src/Haddock/Interface/Rn.hs b/src/Haddock/Interface/Rn.hs index c45b5042..5127e49b 100644 --- a/src/Haddock/Interface/Rn.hs +++ b/src/Haddock/Interface/Rn.hs @@ -1,5 +1,5 @@ -module Haddock.Interface.Rn ( rnHsDoc, rnHaddockModInfo ) where +module Haddock.Interface.Rn ( rnDoc, rnHaddockModInfo ) where  import Haddock.Types @@ -11,7 +11,7 @@ import Outputable  ( ppr, defaultUserStyle )  rnHaddockModInfo :: GlobalRdrEnv -> HaddockModInfo RdrName -> HaddockModInfo Name  rnHaddockModInfo gre (HaddockModInfo desc port stab maint) = -  HaddockModInfo (fmap (rnHsDoc gre) desc) port stab maint +  HaddockModInfo (fmap (rnDoc gre) desc) port stab maint  ids2string :: [RdrName] -> String  ids2string []    = [] @@ -20,8 +20,8 @@ ids2string (x:_) = show $ ppr x defaultUserStyle  data Id x = Id {unId::x}  instance Monad Id where (Id v)>>=f = f v; return = Id -rnHsDoc :: GlobalRdrEnv -> HsDoc RdrName -> HsDoc Name -rnHsDoc gre = unId . do_rn +rnDoc :: GlobalRdrEnv -> Doc RdrName -> Doc Name +rnDoc gre = unId . do_rn    where   do_rn doc_to_rn = case doc_to_rn of  diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs index cfcc8fbd..eed44714 100644 --- a/src/Haddock/InterfaceFile.hs +++ b/src/Haddock/InterfaceFile.hs @@ -372,7 +372,7 @@ instance Binary DocOption where  {-* Generated by DrIFT : Look, but Don't Touch. *-} -instance (Binary id) => Binary (HsDoc id) where +instance (Binary id) => Binary (Doc id) where      put_ bh DocEmpty = do              putByte bh 0      put_ bh (DocAppend aa ab) = do diff --git a/src/Haddock/ModuleTree.hs b/src/Haddock/ModuleTree.hs index d82c53a6..855c00dd 100644 --- a/src/Haddock/ModuleTree.hs +++ b/src/Haddock/ModuleTree.hs @@ -12,15 +12,15 @@  module Haddock.ModuleTree ( ModuleTree(..), mkModuleTree ) where -import Haddock.Types ( HsDoc ) +import Haddock.Types ( Doc )  import GHC           ( Name )  import Module        ( Module, moduleNameString, moduleName, modulePackageId,                         packageIdString ) -data ModuleTree = Node String Bool (Maybe String) (Maybe (HsDoc Name)) [ModuleTree] +data ModuleTree = Node String Bool (Maybe String) (Maybe (Doc Name)) [ModuleTree] -mkModuleTree :: Bool -> [(Module, Maybe (HsDoc Name))] -> [ModuleTree] +mkModuleTree :: Bool -> [(Module, Maybe (Doc Name))] -> [ModuleTree]  mkModuleTree showPkgs mods =     foldr fn [] [ (splitModule mdl, modPkg mdl, short) | (mdl, short) <- mods ]    where @@ -28,7 +28,7 @@ mkModuleTree showPkgs mods =                  | otherwise = Nothing      fn (mod_,pkg,short) = addToTrees mod_ pkg short -addToTrees :: [String] -> Maybe String -> Maybe (HsDoc Name) -> [ModuleTree] -> [ModuleTree] +addToTrees :: [String] -> Maybe String -> Maybe (Doc Name) -> [ModuleTree] -> [ModuleTree]  addToTrees [] _ _ ts = ts  addToTrees ss pkg short [] = mkSubTree ss pkg short  addToTrees (s1:ss) pkg short (t@(Node s2 leaf node_pkg node_short subs) : ts) @@ -39,7 +39,7 @@ addToTrees (s1:ss) pkg short (t@(Node s2 leaf node_pkg node_short subs) : ts)    this_pkg = if null ss then pkg else node_pkg    this_short = if null ss then short else node_short -mkSubTree :: [String] -> Maybe String -> Maybe (HsDoc Name) -> [ModuleTree] +mkSubTree :: [String] -> Maybe String -> Maybe (Doc Name) -> [ModuleTree]  mkSubTree []     _   _     = []  mkSubTree [s]    pkg short = [Node s True pkg short []]  mkSubTree (s:ss) pkg short = [Node s (null ss) Nothing Nothing (mkSubTree ss pkg short)] diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs index 86e4cea2..b4853379 100644 --- a/src/Haddock/Types.hs +++ b/src/Haddock/Types.hs @@ -35,15 +35,14 @@ import Test.QuickCheck  -- convenient short-hands  type Decl = LHsDecl Name -type Doc  = HsDoc Name -type DocInstance name = (InstHead name, Maybe (HsDoc name)) +type DocInstance name = (InstHead name, Maybe (Doc name))  -- | Arguments and result are indexed by Int, zero-based from the left,  -- because that's the easiest to use when recursing over types. -type FnArgsDoc name = Map Int (HsDoc name) -type DocForDecl name = (Maybe (HsDoc name), FnArgsDoc name) +type FnArgsDoc name = Map Int (Doc name) +type DocForDecl name = (Maybe (Doc name), FnArgsDoc name)  noDocForDecl :: DocForDecl name  noDocForDecl = (Nothing, Map.empty) @@ -117,11 +116,11 @@ data ExportItem name        expItemSectionId :: String,        -- | Section heading text -      expItemSectionText :: HsDoc name +      expItemSectionText :: Doc name      } -- ^ A section heading -  | ExportDoc (HsDoc name) -- ^ Some documentation +  | ExportDoc (Doc name) -- ^ Some documentation    | ExportModule Module    -- ^ A cross-reference to another module @@ -133,7 +132,7 @@ type InstHead name = ([HsPred name], name, [HsType name])  type ModuleMap     = Map Module Interface  type InstIfaceMap  = Map Module InstalledInterface -type DocMap        = Map Name (HsDoc DocName) +type DocMap        = Map Name (Doc DocName)  type LinkEnv       = Map Name Module @@ -172,10 +171,10 @@ data Interface = Interface {    ifaceInfo            :: !(HaddockModInfo Name),    -- | The documentation header for this module -  ifaceDoc             :: !(Maybe (HsDoc Name)), +  ifaceDoc             :: !(Maybe (Doc Name)),    -- | The renamed documentation header for this module -  ifaceRnDoc           :: Maybe (HsDoc DocName), +  ifaceRnDoc           :: Maybe (Doc DocName),    -- | The Haddock options for this module (prune, ignore-exports, etc)    ifaceOptions         :: ![DocOption], @@ -215,7 +214,7 @@ data Interface = Interface {    ifaceInstances       :: ![Instance],    -- | Docs for instances defined in this module -  ifaceInstanceDocMap  :: Map Name (HsDoc Name) +  ifaceInstanceDocMap  :: Map Name (Doc Name)  } @@ -266,26 +265,26 @@ toInstalledIface interface = InstalledInterface {    instSubMap         = ifaceSubMap         interface  } -unrenameHsDoc :: HsDoc DocName -> HsDoc Name -unrenameHsDoc = fmap getName +unrenameDoc :: Doc DocName -> Doc Name +unrenameDoc = fmap getName  unrenameDocForDecl :: DocForDecl DocName -> DocForDecl Name  unrenameDocForDecl (mbDoc, fnArgsDoc) = -    (fmap unrenameHsDoc mbDoc, fmap unrenameHsDoc fnArgsDoc) +    (fmap unrenameDoc mbDoc, fmap unrenameDoc fnArgsDoc) -data HsDoc id +data Doc id    = DocEmpty -  | DocAppend (HsDoc id) (HsDoc id) +  | DocAppend (Doc id) (Doc id)    | DocString String -  | DocParagraph (HsDoc id) +  | DocParagraph (Doc id)    | DocIdentifier [id]    | DocModule String -  | DocEmphasis (HsDoc id) -  | DocMonospaced (HsDoc id) -  | DocUnorderedList [HsDoc id] -  | DocOrderedList [HsDoc id] -  | DocDefList [(HsDoc id, HsDoc id)] -  | DocCodeBlock (HsDoc id) +  | DocEmphasis (Doc id) +  | DocMonospaced (Doc id) +  | DocUnorderedList [Doc id] +  | DocOrderedList [Doc id] +  | DocDefList [(Doc id, Doc id)] +  | DocCodeBlock (Doc id)    | DocURL String    | DocPic String    | DocAName String @@ -294,7 +293,7 @@ data HsDoc id  #ifdef TEST  -- TODO: use derive -instance Arbitrary a => Arbitrary (HsDoc a) where +instance Arbitrary a => Arbitrary (Doc a) where    arbitrary =      oneof [ return DocEmpty            , do { a <- arbitrary; b <- arbitrary; return (DocAppend a b) } @@ -314,7 +313,7 @@ instance Arbitrary a => Arbitrary (HsDoc a) where  #endif -type LHsDoc id = Located (HsDoc id) +type LDoc id = Located (Doc id)  data DocMarkup id a = Markup { @@ -337,7 +336,7 @@ data DocMarkup id a = Markup {  data HaddockModInfo name = HaddockModInfo { -        hmi_description :: Maybe (HsDoc name), +        hmi_description :: Maybe (Doc name),          hmi_portability :: Maybe String,          hmi_stability   :: Maybe String,          hmi_maintainer  :: Maybe String diff --git a/src/Haddock/Utils.hs b/src/Haddock/Utils.hs index 6a30cb07..da144355 100644 --- a/src/Haddock/Utils.hs +++ b/src/Haddock/Utils.hs @@ -33,7 +33,7 @@ module Haddock.Utils (    -- * HTML cross reference mapping    html_xrefs_ref, -  -- * HsDoc markup  +  -- * Doc markup     markup,     idMarkup, @@ -102,11 +102,11 @@ out progVerbosity msgVerbosity msg  -- | extract a module's short description. -toDescription :: Interface -> Maybe (HsDoc Name) +toDescription :: Interface -> Maybe (Doc Name)  toDescription = hmi_description . ifaceInfo  -- | extract a module's short description. -toInstalledDescription :: InstalledInterface -> Maybe (HsDoc Name) +toInstalledDescription :: InstalledInterface -> Maybe (Doc Name)  toInstalledDescription = hmi_description . instInfo @@ -311,7 +311,7 @@ replace a b = map (\x -> if x == a then b else x)  -----------------------------------------------------------------------------  -- put here temporarily -markup :: DocMarkup id a -> HsDoc id -> a +markup :: DocMarkup id a -> Doc id -> a  markup m DocEmpty              = markupEmpty m  markup m (DocAppend d1 d2)     = markupAppend m (markup m d1) (markup m d2)  markup m (DocString s)         = markupString m s @@ -328,11 +328,11 @@ markup m (DocURL url)          = markupURL m url  markup m (DocAName ref)        = markupAName m ref  markup m (DocPic img)          = markupPic m img -markupPair :: DocMarkup id a -> (HsDoc id, HsDoc id) -> (a, a) +markupPair :: DocMarkup id a -> (Doc id, Doc id) -> (a, a)  markupPair m (a,b) = (markup m a, markup m b)  -- | The identity markup -idMarkup :: DocMarkup a (HsDoc a) +idMarkup :: DocMarkup a (Doc a)  idMarkup = Markup {    markupEmpty         = DocEmpty,    markupString        = DocString, diff --git a/src/Main.hs b/src/Main.hs index 6b47b64e..f09dcd29 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -394,7 +394,7 @@ updateHTMLXRefs packages = writeIORef html_xrefs_ref (Map.fromList mapping)                , iface <- ifInstalledIfaces ifaces ] -getPrologue :: [Flag] -> IO (Maybe (HsDoc RdrName)) +getPrologue :: [Flag] -> IO (Maybe (Doc RdrName))  getPrologue flags =    case [filename | Flag_Prologue filename <- flags ] of      [] -> return Nothing  | 
