haddock 2.4.1 → 2.4.2

raw patch · 23 files changed

+504/−249 lines, 23 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGES +38/−0
• doc/haddock.xml +1/−1
• haddock.cabal +11/−7
• haddock.spec +1/−1
• src/Distribution/Haddock.hs +4/−1
• src/Haddock/Backends/HH.hs +1/−0
• src/Haddock/Backends/HH2.hs +1/−0
• src/Haddock/Backends/Hoogle.hs +35/−9
• src/Haddock/Backends/Html.hs +40/−20
• src/Haddock/DocName.hs +9/−0
• src/Haddock/GHC.hs +7/−6
• src/Haddock/GHC/Typecheck.hs +4/−10
• src/Haddock/GHC/Utils.hs +65/−0
• src/Haddock/Interface.hs +85/−49
• src/Haddock/Interface/AttachInstances.hs +6/−0
• src/Haddock/Interface/Create.hs +123/−90
• src/Haddock/Interface/Rename.hs +5/−5
• src/Haddock/InterfaceFile.hs +22/−9
• src/Haddock/ModuleTree.hs +7/−8
• src/Haddock/Options.hs +2/−2
• src/Haddock/Types.hs +11/−9
• src/Haddock/Version.hs +1/−0
• src/Main.hs +25/−22

@@ -1,3 +1,41 @@+Changed in version 2.4.2:++  * Support GHC 6.10.2++  * Haddock no longer crashes on Template Haskell modules (#68)+    (only with GHC 6.10.2 or above)++  * Fix problem with Template Haskell-generated declarations disappearing (#59)++  * Generate two anchors for each link for compatibility between IE and Opera+    (#45)++  * Improved error messages++  * Show re-exports from external packages again (GHC ticket #2746)++  * Store hidden modules in .haddock files again (needed by the haddock+    library)++  * Avoid processing boot modules++  * Pragmas may exist between document comments and declarations++  * Do not indicate that a constructor argument is unboxed++  * Fix problem with with non-working links to ghc-prim++  * Allow referring to a specific section within a module in a module link+    (#65)++  * Fixes to the Hoogle backend+  +  * Improvements to the haddock library++  * Many other fixes (including #67, #69, #58, #57)++-----------------------------------------------------------------------------+ Changed in version 2.4.1:    * Depend on base 4.* when GHC >= 6.9, otherwise 3.*

@@ -16,7 +16,7 @@       <holder>Simon Marlow</holder>     </copyright>     <abstract>-      <para>This document describes Haddock version 2.4.1, a Haskell+      <para>This document describes Haddock version 2.4.2, a Haskell       documentation tool.</para>     </abstract>   </bookinfo>

@@ -1,6 +1,6 @@ name:                 haddock-version:              2.4.1-cabal-version:        >= 1.2+version:              2.4.2+cabal-version:        >= 1.2.3 license:              BSD3 build-type:           Simple license-file:         LICENSE@@ -81,7 +81,7 @@    if impl(ghc >= 6.9)     build-depends: Cabal >= 1.5-    build-depends: base >= 4.0.0.0 && < 5.0.0.0+    build-depends: base >= 4.0.0.0 && < 4.2.0.0   else     build-depends: base < 4.0.0.0 @@ -118,26 +118,30 @@     Haddock.GHC       -- Cabal doesn't define __GHC_PATCHLEVEL__+  if impl(ghc == 6.10.1)+    cpp-options: -D__GHC_PATCHLEVEL__=1   if impl(ghc == 6.8.3)     cpp-options: -D__GHC_PATCHLEVEL__=3-  if impl(ghc == 6.8.2)+  if impl(ghc == 6.8.2) || impl(ghc >= 6.10.1.20090223)     cpp-options: -D__GHC_PATCHLEVEL__=2 -- library   hs-source-dirs:       src   extensions:           CPP, PatternGuards, DeriveDataTypeable,                         ScopedTypeVariables, MagicHash   exposed-modules:      Distribution.Haddock   other-modules:+    Haddock.DocName     Haddock.Types     Haddock.InterfaceFile     Haddock.Exception     Haddock.Utils+    Haddock.GHC.Utils      -- Cabal doesn't define __GHC_PATCHLEVEL__+  if impl(ghc == 6.10.1)+    cpp-options: -D__GHC_PATCHLEVEL__=1   if impl(ghc == 6.8.3)     cpp-options: -D__GHC_PATCHLEVEL__=3-  if impl(ghc == 6.8.2)+  if impl(ghc == 6.8.2) || impl(ghc >= 6.10.1.20090223)     cpp-options: -D__GHC_PATCHLEVEL__=2

@@ -17,7 +17,7 @@ # version label of your release tarball.  %define name    haddock-%define version 2.4.1+%define version 2.4.2 %define release 1  Name:           %{name}

@@ -7,10 +7,13 @@  module Distribution.Haddock (   readInterfaceFile,+  nameCacheFromGhc,+  freshNameCache,+  NameCacheAccessor,   InterfaceFile(..),   LinkEnv,   InstalledInterface(..),-  DocName(..)+  module Haddock.DocName ) where  

@@ -6,6 +6,7 @@  module Haddock.Backends.HH (ppHHContents, ppHHIndex, ppHHProject) where +ppHHContents, ppHHIndex, ppHHProject :: a ppHHContents = error "not yet" ppHHIndex = error "not yet" ppHHProject = error "not yet"

@@ -8,6 +8,7 @@ module Haddock.Backends.HH2 (ppHH2Contents, ppHH2Index, ppHH2Files, ppHH2Collection) where  +ppHH2Contents, ppHH2Index, ppHH2Files, ppHH2Collection :: a ppHH2Contents = error "not yet" ppHH2Index = error "not yet" ppHH2Files = error "not yet"

@@ -54,7 +54,33 @@ --------------------------------------------------------------------- -- Utility functions +dropHsDocTy :: HsType a -> HsType a+dropHsDocTy = f+    where+        g (L src x) = L src (f x)+        f (HsForAllTy a b c d) = HsForAllTy a b c (g d)+        f (HsBangTy a b) = HsBangTy a (g b)+        f (HsAppTy a b) = HsAppTy (g a) (g b)+        f (HsFunTy a b) = HsFunTy (g a) (g b)+        f (HsListTy a) = HsListTy (g a)+        f (HsPArrTy a) = HsPArrTy (g a)+        f (HsTupleTy a b) = HsTupleTy a (map g b)+        f (HsOpTy a b c) = HsOpTy (g a) b (g c)+        f (HsParTy a) = HsParTy (g a)+        f (HsKindSig a b) = HsKindSig (g a) b+        f (HsDocTy a b) = f $ unL a+        f x = x +outHsType :: OutputableBndr a => HsType a -> String+outHsType = out . dropHsDocTy+++makeExplicit (HsForAllTy _ a b c) = HsForAllTy Explicit a b c+makeExplicit x = x++makeExplicitL (L src x) = L src (makeExplicit x)++ dropComment (' ':'-':'-':' ':_) = [] dropComment (x:xs) = x : dropComment xs dropComment [] = []@@ -68,10 +94,6 @@         f [] = []  -typeSig :: String -> [String] -> String-typeSig name flds = operator name ++ " :: " ++ concat (intersperse " -> " flds)-- operator :: String -> String operator (x:xs) | not (isAlphaNum x) && x `notElem` "_' ([{" = "(" ++ x:xs ++ ")" operator x = x@@ -94,7 +116,7 @@   ppSig :: Sig Name -> [String]-ppSig (TypeSig name sig) = [operator (out name) ++ " :: " ++ out typ]+ppSig (TypeSig name sig) = [operator (out name) ++ " :: " ++ outHsType typ]     where         typ = case unL sig of                    HsForAllTy Explicit a b c -> HsForAllTy Implicit a b c@@ -142,18 +164,22 @@ ppCtor :: TyClDecl Name -> ConDecl Name -> [String] ppCtor dat con = ldoc (con_doc con) ++ f (con_details con)     where-        f (PrefixCon args) = [typeSig name $ map out args ++ [resType]]+        f (PrefixCon args) = [typeSig name $ args ++ [resType]]         f (InfixCon a1 a2) = f $ PrefixCon [a1,a2]         f (RecCon recs) = f (PrefixCon $ map cd_fld_type recs) ++ concat                           [ldoc (cd_fld_doc r) ++-                           [out (unL $ cd_fld_name r) `typeSig` [resType, out $ cd_fld_type r]]+                           [out (unL $ cd_fld_name r) `typeSig` [resType, cd_fld_type r]]                           | r <- recs] +        funs = foldr1 (\x y -> reL $ HsFunTy (makeExplicitL x) (makeExplicitL y))+        apps = foldl1 (\x y -> reL $ HsAppTy x y)++        typeSig name flds = operator name ++ " :: " ++ outHsType (makeExplicit $ unL $ funs flds)         name = out $ unL $ con_name con          resType = case con_res con of-            ResTyH98 -> unwords $ operator (out (tcdLName dat)) : map out (tcdTyVars dat)-            ResTyGADT x -> out $ unL x+            ResTyH98 -> apps $ map (reL . HsTyVar) $ unL (tcdLName dat) : [x | UserTyVar x <- map unL $ tcdTyVars dat]+            ResTyGADT x -> x   ---------------------------------------------------------------------

@@ -27,7 +27,7 @@ import qualified Haddock.Utils.Html as Html  import Control.Exception     ( bracket )-import Control.Monad         ( when, unless )+import Control.Monad         ( when, unless, join ) import Data.Char             ( isUpper, toUpper ) import Data.List             ( sortBy, groupBy ) import Data.Maybe@@ -609,7 +609,7 @@     exports = numberSectionHeadings (ifaceRnExportItems iface)      has_doc (ExportDecl _ doc _ _) = isJust doc-    has_doc (ExportNoDecl _ _ _) = False+    has_doc (ExportNoDecl _ _) = False     has_doc (ExportModule _) = False     has_doc _ = True @@ -733,9 +733,9 @@   = ppDocGroup lev (namedAnchor id0 << docToHtml doc) processExport summary links docMap (ExportDecl decl doc subdocs insts)   = ppDecl summary links decl doc insts docMap subdocs-processExport summmary _ _ (ExportNoDecl _ y [])+processExport summmary _ _ (ExportNoDecl y [])   = declBox (ppDocName y)-processExport summmary _ _ (ExportNoDecl _ y subs)+processExport summmary _ _ (ExportNoDecl y subs)   = declBox (ppDocName y <+> parenList (map ppDocName subs)) processExport _ _ _ (ExportDoc doc)   = docBox (docToHtml doc)@@ -763,7 +763,7 @@  -- TODO: use DeclInfo DocName or something ppDecl :: Bool -> LinksInfo -> LHsDecl DocName -> -          Maybe (HsDoc DocName) -> [InstHead DocName] -> DocMap -> [(DocName, HsDoc DocName)] -> HtmlTable+          Maybe (HsDoc DocName) -> [InstHead DocName] -> DocMap -> [(DocName, Maybe (HsDoc DocName))] -> HtmlTable ppDecl summ links (L loc decl) mbDoc instances docMap subdocs = case decl of   TyClD d@(TyFamily {})          -> ppTyFam summ False links loc mbDoc d   TyClD d@(TyData {})@@ -1070,7 +1070,7 @@ 	fundep (vars1,vars2) = hsep (map ppDocName vars1) <+> toHtml "->" <+> 			       hsep (map ppDocName vars2) -ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocName -> SrcSpan -> [(DocName, HsDoc DocName)] -> HtmlTable+ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocName -> SrcSpan -> [(DocName, Maybe (HsDoc DocName))] -> HtmlTable ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ ats _) loc subdocs =    if null sigs && null ats     then (if summary then declBox else topDeclBox links loc nm) hdr@@ -1081,11 +1081,11 @@ 					aboves 					( 						[ ppAssocType summary links doc at | at <- ats-                                                , let doc = lookup (tcdName $ unL at) subdocs ]  +++                                                , let doc = join $ lookup (tcdName $ unL at) subdocs ]  ++  						[ ppFunSig summary links loc doc n typ 						| L _ (TypeSig (L _ n) (L _ typ)) <- sigs-						, let doc = lookup n subdocs ] +						, let doc = join $ lookup n subdocs ]  					) 				)   where@@ -1095,7 +1095,7 @@   ppClassDecl :: Bool -> LinksInfo -> [InstHead DocName] -> SrcSpan ->-               Maybe (HsDoc DocName) -> DocMap -> [(DocName, HsDoc DocName)] -> TyClDecl DocName -> +               Maybe (HsDoc DocName) -> DocMap -> [(DocName, Maybe (HsDoc DocName))] -> TyClDecl DocName ->                 HtmlTable ppClassDecl summary links instances loc mbDoc docMap subdocs 	decl@(ClassDecl lctxt lname ltyvars lfds lsigs _ ats _)@@ -1124,10 +1124,10 @@     methodTable =       abovesSep s8 [ ppFunSig summary links loc doc n typ                    | L _ (TypeSig (L _ n) (L _ typ)) <- lsigs-                   , let doc = lookup n subdocs ]+                   , let doc = join $ lookup n subdocs ]      atTable = abovesSep s8 $ [ ppAssocType summary links doc at | at <- ats-                             , let doc = lookup (tcdName $ unL at) subdocs ]+                             , let doc = join $ lookup (tcdName $ unL at) subdocs ]      instId = collapseId (docNameOrig nm)     instancesBit@@ -1415,7 +1415,8 @@ -}  ppBang HsStrict = toHtml "!"-ppBang HsUnbox  = toHtml "!!"+ppBang HsUnbox  = toHtml "!" -- unboxed args is an implementation detail,+                             -- so we just show the strictness annotation  tupleParens Boxed   = parenList tupleParens Unboxed = ubxParenList @@ -1585,14 +1586,14 @@ -- ----------------------------------------------------------------------------- -- * Doc Markup -parHtmlMarkup :: (a -> Html) -> DocMarkup a Html-parHtmlMarkup ppId = Markup {+parHtmlMarkup :: (a -> Html) -> (a -> Bool) -> DocMarkup a Html+parHtmlMarkup ppId isTyCon = Markup {   markupParagraph     = paragraph,   markupEmpty	      = toHtml "",   markupString        = toHtml,   markupAppend        = (+++),-  markupIdentifier    = tt . ppId . head,-  markupModule        = \m -> ppModule (mkModuleNoPackage m) "",+  markupIdentifier    = tt . ppId . choose,+  markupModule        = \m -> let (mod,ref) = break (=='#') m in ppModule (mkModuleNoPackage mod) ref,   markupEmphasis      = emphasize . toHtml,   markupMonospaced    = tt . toHtml,   markupUnorderedList = ulist . concatHtml . map (li <<),@@ -1603,12 +1604,23 @@   markupURL	      = \url -> anchor ! [href url] << toHtml url,   markupAName	      = \aname -> namedAnchor aname << toHtml ""   }+  where+    -- If an id can refer to multiple things, we give precedence to type+    -- constructors.  This should ideally be done during renaming from RdrName+    -- to Name, but since we will move this process from GHC into Haddock in+    -- the future, we fix it here in the meantime.+    -- TODO: mention this rule in the documentation.+    choose [x] = x+    choose (x:y:_)+      | isTyCon x = x+      | otherwise = y + markupDef (a,b) = dterm << a +++ ddef << b -htmlMarkup = parHtmlMarkup ppDocName-htmlOrigMarkup = parHtmlMarkup ppName-htmlRdrMarkup = parHtmlMarkup ppRdrName+htmlMarkup = parHtmlMarkup ppDocName (isTyConName . getName)+htmlOrigMarkup = parHtmlMarkup ppName isTyConName+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).@@ -1806,8 +1818,16 @@ s8  = tda [ theclass "s8" ]  << noHtml s15 = tda [ theclass "s15" ] << noHtml ++-- | Generate a named anchor+--+-- This actually generates two anchor tags, one with the name unescaped, and one+-- with the name URI-escaped. This is needed because Opera 9.52 (and later+-- versions) needs the name to be unescaped, while IE 7 needs it to be escaped.+-- namedAnchor :: String -> Html -> Html-namedAnchor n = anchor ! [name (escapeStr n)]+namedAnchor n = (anchor ! [name n]) . (anchor ! [name (escapeStr n)])+  -- -- A section of HTML which is collapsible via a +/- button.

@@ -19,10 +19,19 @@   deriving Eq  +-- TODO: remove docNameOrig in favour of the NamedThing instance++instance NamedThing DocName where+  getName (Documented name _) = name+  getName (Undocumented name) = name+++-- | The 'OccName' belonging to this name docNameOcc :: DocName -> OccName docNameOcc = nameOccName . docNameOrig  +-- | The original definition site of this name docNameOrig :: DocName -> Name docNameOrig (Documented name _) = name docNameOrig (Undocumented name) = name

@@ -47,17 +47,18 @@ #endif     let dynflags' = dopt_set dynflags Opt_Haddock     let dynflags'' = dynflags' {-        hscTarget = HscAsm,+        hscTarget = HscNothing,         ghcMode   = CompManager,         ghcLink   = NoLink       }     dynflags''' <- parseGhcFlags dynflags'' restFlags flags-#if __GLASGOW_HASKELL__ >= 609 -    setSessionDynFlags dynflags'''-    ghcActs dynflags'''+    defaultCleanupHandler dynflags''' $ do+#if __GLASGOW_HASKELL__ >= 609+        setSessionDynFlags dynflags'''+        ghcActs dynflags''' #else-    setSessionDynFlags session dynflags'''-    return (session, dynflags''')+        setSessionDynFlags session dynflags'''+        return (session, dynflags''') #endif  

@@ -10,16 +10,10 @@ ) where  -import Haddock.Exception import Haddock.Types-import Haddock.GHC.Utils  import Data.Maybe-import Control.Monad import GHC-import HscTypes ( msHsFilePath )-import Digraph-import BasicTypes import SrcLoc  import Data.List@@ -36,13 +30,13 @@  -- | Dig out what we want from the typechecker output mkGhcModule :: CheckedMod -> DynFlags -> GhcModule -mkGhcModule (mod, file, checkedMod) dynflags = GhcModule {-  ghcModule         = mod,+mkGhcModule (mdl, file, checkedMod) dynflags = GhcModule {+  ghcModule         = mdl,   ghcFilename       = file,   ghcMbDocOpts      = mbOpts,   ghcHaddockModInfo = info,   ghcMbDoc          = mbDoc,-  ghcGroup          = group,+  ghcGroup          = group_,   ghcMbExports      = mbExports,   ghcExportedNames  = modInfoExports modInfo,   ghcDefinedNames   = map getName $ modInfoTyThings modInfo,@@ -55,5 +49,5 @@ #else     mbOpts = haddockOptions dynflags #endif-    (group, _, mbExports, mbDoc, info) = renamed+    (group_, _, mbExports, mbDoc, info) = renamed     (parsed, renamed, _, modInfo) = checkedMod

@@ -5,6 +5,7 @@ --  +{-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_HADDOCK hide #-} @@ -15,6 +16,7 @@ import Data.Char import Data.Version import qualified Data.Map as Map+import Control.Arrow  import HsSyn import SrcLoc@@ -113,3 +115,66 @@  trace_ppr :: Outputable a => a -> b -> b trace_ppr x y = trace (pretty x) y+++-------------------------------------------------------------------------------+-- NamedThing instances+-------------------------------------------------------------------------------+++instance NamedThing (TyClDecl Name) where+  getName = tcdName+++instance NamedThing (ConDecl Name) where+  getName = unL . con_name+++-------------------------------------------------------------------------------+-- Subordinates+-------------------------------------------------------------------------------+++class Parent a where+  children :: a -> [Name]+++instance Parent (ConDecl Name) where+  children con =+    case con_details con of+      RecCon fields -> map (unL . cd_fld_name) fields+      _             -> []+++instance Parent (TyClDecl Name) where+  children d+    | isDataDecl  d = map (unL . con_name . unL) . tcdCons $ d+    | isClassDecl d =+        map (tcdName . unL) (tcdATs d) +++        [ unL n | L _ (TypeSig n _) <- tcdSigs d ]+    | otherwise = []+++-- | A parent and its children+family :: (NamedThing a, Parent a) => a -> (Name, [Name])+family = getName &&& children+++-- | A mapping from the parent (main-binder) to its children and from each+-- child to its grand-children, recursively.+families :: TyClDecl Name -> [(Name, [Name])]+families d+  | isDataDecl  d = family d : map (family . unL) (tcdCons d)+  | isClassDecl d = family d : concatMap (families . unL) (tcdATs d)+  | otherwise     = []+++-- | A mapping from child to parent+parentMap :: TyClDecl Name -> [(Name, Name)]+parentMap d = [ (c, p) | (p, cs) <- families d, c <- cs ]+++-- | The parents of a subordinate in a declaration+parents :: Name -> HsDecl Name -> [Name]+parents n (TyClD d) = [ p | (c, p) <- parentMap d, c == n ]+parents _ _ = []

@@ -24,6 +24,7 @@ import Haddock.GHC.Typecheck import Haddock.Exception import Haddock.Utils+import Haddock.InterfaceFile  import qualified Data.Map as Map import Data.Map (Map)@@ -37,24 +38,34 @@ import Digraph import BasicTypes import SrcLoc+import HscTypes   -- | Turn a topologically sorted list of module names/filenames into interfaces. Also -- return the home link environment created in the process. #if __GLASGOW_HASKELL__ >= 609-createInterfaces :: [String] -> LinkEnv -> [Flag] -> Ghc ([Interface], LinkEnv)-createInterfaces modules externalLinks flags = do+createInterfaces :: [String] -> [Flag] -> [InterfaceFile]+                 -> Ghc ([Interface], LinkEnv)+createInterfaces modules flags extIfaces = do   -- part 1, create interfaces-  interfaces <- createInterfaces' modules flags+  let instIfaceMap =  Map.fromList [ (instMod iface, iface) | ext <- extIfaces+                                   , iface <- ifInstalledIfaces ext ]+  interfaces <- createInterfaces' modules flags instIfaceMap #else-createInterfaces :: Session -> [String] -> LinkEnv -> [Flag] -> IO ([Interface], LinkEnv)-createInterfaces session modules externalLinks flags = do+createInterfaces :: Session -> [String] -> [Flag]+                 -> [InterfaceFile] -> IO ([Interface], LinkEnv)+createInterfaces session modules flags extIfaces = do   -- part 1, create interfaces-  interfaces <- createInterfaces' session modules flags+  let instIfaceMap =  Map.fromList [ (instMod iface, iface) | ext <- extIfaces+                                   , iface <- ifInstalledIfaces ext ]+  interfaces <- createInterfaces' session modules flags instIfaceMap #endif   -- part 2, build link environment-  let homeLinks = buildHomeLinks interfaces-      links     = homeLinks `Map.union` externalLinks+      -- combine the link envs of the external packages into one+  let extLinks  = Map.unions (map ifLinkEnv extIfaces)+      homeLinks = buildHomeLinks interfaces -- build the environment for the home+                                            -- package+      links     = homeLinks `Map.union` extLinks       allNames  = Map.keys links    -- part 3, attach instances@@ -70,28 +81,51 @@   #if __GLASGOW_HASKELL__ >= 609-createInterfaces' :: [String] -> [Flag] -> Ghc [Interface]-createInterfaces' modules flags = do+createInterfaces' :: [String] -> [Flag] -> InstIfaceMap -> Ghc [Interface]+createInterfaces' modules flags instIfaceMap = do   targets <- mapM (\f -> guessTarget f Nothing) modules   setTargets targets   modgraph <- depanal [] False-  let orderedMods = flattenSCCs $ topSortModuleGraph False modgraph Nothing++#if (__GLASGOW_HASKELL__ == 610 && __GHC_PATCHLEVEL__ >= 2) || __GLASGOW_HASKELL__ >= 611+  -- If template haskell is used by the package, we can not use+  -- HscNothing as target since we might need to run code generated from+  -- one or more of the modules during typechecking.+#if __GLASGOW_HASKELL__ < 611+  let needsTemplateHaskell = any (dopt Opt_TemplateHaskell . ms_hspp_opts)+#endif+  modgraph' <- if needsTemplateHaskell modgraph+       then do+         dflags <- getSessionDynFlags+         setSessionDynFlags dflags { hscTarget = HscC } +         -- we need to set HscC on all the ModSummaries as well+         let addHscC m = m { ms_hspp_opts = (ms_hspp_opts m) { hscTarget = HscC } }  +         return (map addHscC modgraph)+       else return modgraph+#else+  let modgraph' = modgraph+#endif++  let orderedMods = flattenSCCs $ topSortModuleGraph False modgraph' Nothing   (ifaces, _) <- foldM (\(ifaces, modMap) modsum -> do-    interface <- processModule modsum flags modMap+    x <- processModule modsum flags modMap instIfaceMap #else-createInterfaces' :: Session -> [String] -> [Flag] -> IO [Interface]-createInterfaces' session modules flags = do+createInterfaces' :: Session -> [String] -> [Flag] -> InstIfaceMap -> IO [Interface]+createInterfaces' session modules flags instIfaceMap = do   targets <- mapM (\f -> guessTarget f Nothing) modules   setTargets session targets   mbGraph <- depanal session [] False   modgraph <- case mbGraph of     Just graph -> return graph-    Nothing -> throwE "Failed to create dependecy graph"+    Nothing -> throwE "Failed to create dependency graph"   let orderedMods = flattenSCCs $ topSortModuleGraph False modgraph Nothing   (ifaces, _) <- foldM (\(ifaces, modMap) modsum -> do-    interface <- processModule session modsum flags modMap+    x <- processModule session modsum flags modMap instIfaceMap #endif-    return $ (interface : ifaces , Map.insert (ifaceMod interface) interface modMap)+    case x of+      Just interface ->+        return $ (interface : ifaces , Map.insert (ifaceMod interface) interface modMap)+      Nothing -> return (ifaces, modMap)     ) ([], Map.empty) orderedMods   return (reverse ifaces) @@ -128,41 +162,43 @@ -}  #if __GLASGOW_HASKELL__ >= 609-processModule :: ModSummary -> [Flag] -> ModuleMap -> Ghc Interface-processModule modsum flags modMap = --  let handleSrcErrors action = flip handleSourceError action $ \err -> do -        printExceptionAndWarnings err-        throwE ("Failed to check module: " ++ moduleString (ms_mod modsum))--  in handleSrcErrors $ do-       let filename = msHsFilePath modsum-       let dynflags = ms_hspp_opts modsum-       tc_mod <- loadModule =<< typecheckModule =<< parseModule modsum-       let Just renamed_src = renamedSource tc_mod-       let ghcMod = mkGhcModule (ms_mod modsum,-                             filename,-                             (parsedSource tc_mod,-                              renamed_src,-                              typecheckedSource tc_mod,-                              moduleInfo tc_mod))-                             dynflags-       let (interface, msg) = runWriter $ createInterface ghcMod flags modMap-       liftIO $ mapM_ putStrLn msg-       liftIO $ evaluate interface-       return interface+processModule :: ModSummary -> [Flag] -> ModuleMap -> InstIfaceMap -> Ghc (Maybe Interface)+processModule modsum flags modMap instIfaceMap = do+  tc_mod <- loadModule =<< typecheckModule =<< parseModule modsum+  if not $ isBootSummary modsum+    then do+      let filename = msHsFilePath modsum+      let dynflags = ms_hspp_opts modsum+      let Just renamed_src = renamedSource tc_mod+      let ghcMod = mkGhcModule (ms_mod modsum,+                            filename,+                            (parsedSource tc_mod,+                             renamed_src,+                             typecheckedSource tc_mod,+                             moduleInfo tc_mod))+                            dynflags+      let (interface, msg) = runWriter $ createInterface ghcMod flags modMap instIfaceMap+      liftIO $ mapM_ putStrLn msg+      liftIO $ evaluate interface+      return (Just interface)+    else+      return Nothing #else-processModule :: Session -> ModSummary -> [Flag] -> ModuleMap -> IO Interface-processModule session modsum flags modMap = do+processModule :: Session -> ModSummary -> [Flag] -> ModuleMap -> InstIfaceMap -> IO (Maybe Interface)+processModule session modsum flags modMap instIfaceMap = do   let filename = msHsFilePath modsum   mbMod <- checkAndLoadModule session modsum False-  ghcMod <- case mbMod of-    Just (CheckedModule a (Just b) (Just c) (Just d) _)-      -> return $ mkGhcModule (ms_mod modsum, filename, (a,b,c,d)) (ms_hspp_opts modsum)-    _ -> throwE ("Failed to check module: " ++ (moduleString $ ms_mod modsum))-  let (interface, msg) = runWriter $ createInterface ghcMod flags modMap-  mapM_ putStrLn msg-  return interface+  if not $ isBootSummary modsum+    then do+      ghcMod <- case mbMod of+        Just (CheckedModule a (Just b) (Just c) (Just d) _)+          -> return $ mkGhcModule (ms_mod modsum, filename, (a,b,c,d)) (ms_hspp_opts modsum)+        _ -> throwE ("Failed to check module: " ++ (moduleString $ ms_mod modsum))+      let (interface, msg) = runWriter $ createInterface ghcMod flags modMap instIfaceMap+      mapM_ putStrLn msg+      return (Just interface)+    else+      return Nothing #endif  -- | Build a mapping which for each original name, points to the "best"

@@ -23,7 +23,13 @@ import SrcLoc import InstEnv import Class++#if __GLASGOW_HASKELL__ >= 610 && __GHC_PATCHLEVEL__ >= 2+import TypeRep hiding (funTyConName)+#else import TypeRep+#endif+ import Var hiding (varName) import TyCon import PrelNames

@@ -40,8 +40,9 @@ -- | Process the data in the GhcModule to produce an interface. -- To do this, we need access to already processed modules in the topological -- sort. That's what's in the module map.-createInterface :: GhcModule -> [Flag] -> ModuleMap -> ErrMsgM Interface-createInterface ghcMod flags modMap = do+createInterface :: GhcModule -> [Flag] -> ModuleMap -> InstIfaceMap+                -> ErrMsgM Interface+createInterface ghcMod flags modMap instIfaceMap = do    let mod = ghcModule ghcMod @@ -62,13 +63,11 @@    warnAboutFilteredDecls mod decls0 -  visibleNames <- mkVisibleNames mod modMap localNames -                                 (ghcNamesInScope ghcMod) -                                 exports opts declMap -   exportItems <- mkExportItems modMap mod (ghcExportedNames ghcMod) decls declMap-                               opts exports ignoreExps instances+                               opts exports ignoreExps instances instIfaceMap +  let visibleNames = mkVisibleNames exportItems opts+     -- prune the export list to just those declarations that have   -- documentation, if the 'prune' option is on.   let @@ -90,6 +89,7 @@     ifaceExports         = exportedNames,     ifaceVisibleExports  = visibleNames,      ifaceDeclMap         = declMap,+    ifaceSubMap          = mkSubMap declMap exportedNames,     ifaceInstances       = ghcInstances ghcMod   } @@ -125,7 +125,15 @@ -- Declarations -------------------------------------------------------------------------------- +-- | Make a sub map from a declaration map. Make sure we only include exported+-- names.+mkSubMap :: Map Name DeclInfo -> [Name] -> Map Name [Name]+mkSubMap declMap exports =+  Map.filterWithKey (\k _ -> k `elem` exports) (Map.map filterSubs declMap)+  where+    filterSubs (_, _, subs) = [ sub  | (sub, _) <- subs, sub `elem` exports ] + -- Make a map from names to 'DeclInfo's. Exclude declarations that don't -- have names (instances and stand-alone documentation comments). Include -- subordinate names, but map them to their parent declarations. @@ -190,18 +198,19 @@ filterOutInstances = filter (\(L _ d, _, _) -> not (isInstD d))  --- | Take all declarations in an 'HsGroup' and convert them into a list of--- 'Decl's+-- | Take all declarations except pragmas, infix decls, rules and value+-- bindings from an 'HsGroup'. declsFromGroup :: HsGroup Name -> [Decl]--- TODO: actually take all declarations declsFromGroup group = -  decls hs_tyclds TyClD group ++-  decls hs_fords  ForD  group ++-  decls hs_docs   DocD  group ++-  decls hs_instds InstD group ++-  decls (sigs . hs_valds) SigD group+  decls hs_tyclds  TyClD    group +++  decls hs_derivds DerivD   group +++  decls hs_defds   DefD     group +++  decls hs_fords   ForD     group +++  decls hs_docs    DocD     group +++  decls hs_instds  InstD    group +++  decls (typesigs . hs_valds) SigD group   where-    sigs (ValBindsOut _ x) = x+    typesigs (ValBindsOut _ sigs) = filter isVanillaLSig sigs   -- | Take a field of declarations from a data structure and create HsDecls@@ -231,9 +240,8 @@   when (not $ null instances) $      tell $ nub $ [-      "Warning: " ++ modStr ++ ": Rendering of associated types for instances has "-      ++ "not yet been implemented. Associated types will not be shown for the "-      ++ "following instances:\n" ++ (concat $ intersperse ", " instances) ]+      "Warning: " ++ modStr ++ ": We do not support associated types in instances yet. "+      ++ "These instances are affected:\n" ++ (concat $ intersperse ", " instances) ]   --------------------------------------------------------------------------------@@ -274,11 +282,10 @@ --------------------------------------------------------------------------------  --- | Collect the docs and attach them to the right declaration+-- | Collect the docs and attach them to the right declaration. collectDocs :: [Decl] -> [(Decl, (Maybe Doc))] collectDocs decls = collect Nothing DocEmpty decls - collect :: Maybe Decl -> Doc -> [Decl] -> [(Decl, (Maybe Doc))] collect d doc_so_far [] =    case d of@@ -296,9 +303,7 @@      _ -> case d of       Nothing -> collect (Just e) doc_so_far es-      Just d0-        | sameDecl d0 e -> collect d doc_so_far es  -        | otherwise -> finishedDoc d0 doc_so_far (collect (Just e) DocEmpty es)+      Just d0 -> finishedDoc d0 doc_so_far (collect (Just e) DocEmpty es)   finishedDoc :: Decl -> Doc -> [(Decl, (Maybe Doc))] -> [(Decl, (Maybe Doc))]@@ -310,9 +315,6 @@ finishedDoc _ _ rest = rest  -sameDecl d1 d2 = getLoc d1 == getLoc d2-- {- attachATs :: [IE Name] -> ([IE Name], [Name]) attachATs exports = @@ -324,6 +326,9 @@ -- | Build the list of items that will become the documentation, from the -- export list.  At this point, the list of ExportItems is in terms of -- original names.+--+-- We create the export items even if the module is hidden, since they+-- might be useful when creating the export items for other modules. mkExportItems   :: ModuleMap   -> Module			-- this module@@ -334,10 +339,11 @@   -> Maybe [IE Name]   -> Bool				-- --ignore-all-exports flag   -> [Instance]+  -> InstIfaceMap   -> ErrMsgM [ExportItem Name]  mkExportItems modMap this_mod exported_names decls declMap-              opts maybe_exps ignore_all_exports instances+              opts maybe_exps ignore_all_exports instances instIfaceMap   | isNothing maybe_exps || ignore_all_exports || OptIgnoreExports `elem` opts     = everything_local_exported   | Just specs <- maybe_exps = liftM concat $ mapM lookupExport specs@@ -347,7 +353,6 @@     everything_local_exported =  -- everything exported       return (fullContentsOfThisModule this_mod decls)    -    packageId = modulePackageId this_mod      lookupExport (IEVar x) = declWith x     lookupExport (IEThingAbs t) = declWith t@@ -359,7 +364,7 @@      lookupExport (IEThingAll t)        = declWith t     lookupExport (IEThingWith t cs)    = declWith t-    lookupExport (IEModuleContents m)  = fullContentsOf (mkModule packageId m)+    lookupExport (IEModuleContents m)  = fullContentsOf m     lookupExport (IEGroup lev doc)     = return [ ExportGroup lev "" doc ]     lookupExport (IEDoc doc)           = return [ ExportDoc doc ]      lookupExport (IEDocNamed str) = do@@ -369,25 +374,57 @@         Just found -> return [ ExportDoc found ]      declWith :: Name -> ErrMsgM [ ExportItem Name ]-    declWith t-      -- temp hack: we filter out separately declared ATs, since we haven't decided how-      -- to handle them yet. We should really give an warning message also, and filter the-      -- name out in mkVisibleNames...-      | Just x@(decl,_,_) <- findDecl t,-        t `notElem` declATs (unL decl) = return [ mkExportDecl t x ]-      | otherwise = return []+    declWith t =+      case findDecl t of+        Just x@(decl,_,_) ->+          let declName =+                case getMainDeclBinder (unL decl) of+                  Just declName -> declName+                  Nothing -> error "declWith: should not happen"+          in case () of+            _+              -- temp hack: we filter out separately exported ATs, since we haven't decided how+              -- to handle them yet. We should really give an warning message also, and filter the+              -- name out in mkVisibleNames...+              | t `elem` declATs (unL decl)        -> return [] +              -- We should not show a subordinate by itself if any of its+              -- parents is also exported. See note [1].+              | t /= declName,+                Just p <- find isExported (parents t $ unL decl) ->+                do tell [ +                     "Warning: " ++ moduleString this_mod ++ ": " +++                     pretty (nameOccName t) ++ " is exported separately but " +++                     "will be documented under " ++ pretty (nameOccName p) +++                     ". Consider exporting it together with its parent(s)" +++                     " for code clarity." ]+                   return [] +              -- normal case+              | otherwise                          -> return [ mkExportDecl t x ]+        Nothing ->+          -- If we can't find the declaration, it must belong to another package.+          -- We return just the name of the declaration and try to get the subs+          -- from the installed interface of that package.+          case Map.lookup (nameModule t) instIfaceMap of+            Nothing -> return [ ExportNoDecl t [] ]+            Just iface ->+              let subs = case Map.lookup t (instSubMap iface) of+                           Nothing -> []+                           Just x -> x+              in return [ ExportNoDecl t subs ]+     mkExportDecl :: Name -> DeclInfo -> ExportItem Name     mkExportDecl n (decl, doc, subs) = decl'       where-        decl' = ExportDecl (restrictTo subs' (extractDecl n mdl decl)) doc subdocs []+        decl' = ExportDecl (restrictTo sub_names (extractDecl n mdl decl)) doc subs' []         mdl = nameModule n-        subs' = filter (`elem` exported_names) $ map fst subs-        subdocs = [ (n, doc) | (n, Just doc) <- subs ]+        subs' = filter ((`elem` exported_names) . fst) subs+        sub_names = map fst subs' +    isExported n = n `elem` exported_names -    fullContentsOf m  +    fullContentsOf modname 	| m == this_mod = return (fullContentsOfThisModule this_mod decls) 	| otherwise =  	   case Map.lookup m modMap of@@ -395,8 +432,20 @@ 		| OptHide `elem` ifaceOptions iface 			-> return (ifaceExportItems iface) 		| otherwise -> return [ ExportModule m ]-	     Nothing -> return [] -- already emitted a warning in visibleNames+               +	     Nothing -> -- we have to try to find it in the installed interfaces+                        -- (external packages)+               case Map.lookup modname (Map.mapKeys moduleName instIfaceMap) of+                 Just iface -> return [ ExportModule (instMod iface) ]+                 Nothing -> do+                   tell ["Warning: " ++ pretty this_mod ++ ": Could not find " +++                         "documentation for exported module: " ++ pretty modname]+                   return []+      where+        m = mkModule packageId modname+        packageId = modulePackageId this_mod +         findDecl :: Name -> Maybe DeclInfo     findDecl n        | m == this_mod = Map.lookup n declMap@@ -407,13 +456,29 @@         m = nameModule n  +-- Note [1]:+------------+-- It is unnecessary to document a subordinate by itself at the top level if+-- any of its parents is also documented. Furthermore, if the subordinate is a+-- record field or a class method, documenting it under its parent+-- indicates its special status.+--+-- A user might expect that it should show up separately, so we issue a+-- warning. It's a fine opportunity to also tell the user she might want to+-- export the subordinate through the parent export item for clarity.+--+-- The code removes top-level subordinates also when the parent is exported+-- through a 'module' export. I think that is fine.+--+-- (For more information, see Trac #69)++ fullContentsOfThisModule :: Module -> [DeclInfo] -> [ExportItem Name] fullContentsOfThisModule module_ decls = catMaybes (map mkExportItem decls)   where     mkExportItem (L _ (DocD (DocGroup lev doc)), _, _) = Just $ ExportGroup lev "" doc     mkExportItem (L _ (DocD (DocCommentNamed _ doc)), _, _)   = Just $ ExportDoc doc-    mkExportItem (decl, doc, subs) = Just $ ExportDecl decl doc subdocs []-      where subdocs = [ (n, doc) | (n, Just doc) <- subs ]+    mkExportItem (decl, doc, subs) = Just $ ExportDecl decl doc subs []  --    mkExportItem _ = Nothing -- TODO: see if this is really needed @@ -486,53 +551,21 @@ 	hasDoc _ = True  --- | Gather a list of original names exported from this module-mkVisibleNames :: Module -             -> ModuleMap-             -> [Name] -             -> [Name]-             -> Maybe [IE Name]-             -> [DocOption]-             -> Map Name DeclInfo-             -> ErrMsgM [Name]--mkVisibleNames mdl modMap localNames scope maybeExps opts declMap -  -- if no export list, just return all local names -  | Nothing <- maybeExps         = return (filter hasDecl localNames)-  | OptIgnoreExports `elem` opts = return localNames-  | Just expspecs <- maybeExps = do-      visibleNames <- mapM extract expspecs-      return $ filter isNotPackageName (concat visibleNames)- where-  hasDecl name = isJust (Map.lookup name declMap)-  isNotPackageName name = nameMod == mdl || isJust (Map.lookup nameMod modMap)-    where nameMod = nameModule name--  extract e = -   case e of-    IEVar x -> return [x]-    IEThingAbs t -> return [t]-    IEThingAll t -> return (t : all_subs)-	 where-	      all_subs | nameModule t == mdl = subsOfName t declMap-		       | otherwise = allSubsOfName modMap t--    IEThingWith t cs -> return (t : cs)-	-    IEModuleContents m-	| mkModule (modulePackageId mdl) m == mdl -> return localNames -	| otherwise -> let m' = mkModule (modulePackageId mdl) m in-	  case Map.lookup m' modMap of-	    Just mod-		| OptHide `elem` ifaceOptions mod ->-		    return (filter (`elem` scope) (ifaceExports mod))-		| otherwise -> return []-	    Nothing-		-> tell (exportModuleMissingErr mdl m') >> return []-  -    _ -> return []-+mkVisibleNames :: [ExportItem Name] -> [DocOption] -> [Name]+mkVisibleNames exports opts+  | OptHide `elem` opts = []+  | otherwise = concatMap exportName exports+  where+    exportName e@ExportDecl {} =+      case getMainDeclBinder $ unL $ expItemDecl e of+        Just n -> n : subs+        Nothing -> subs+      where subs = map fst (expItemSubDocs e) +    exportName e@ExportNoDecl {} = [] -- we don't count these as visible, since+                                      -- we don't want links to go to them.+    exportName _ = [] +       exportModuleMissingErr this mdl    = ["Warning: in export list of " ++ show (moduleString this) 	 ++ ": module not found: " ++ show (moduleString mdl)]

@@ -68,7 +68,7 @@     -- report things that we couldn't link to. Only do this for non-hidden     -- modules.     unless (OptHide `elem` ifaceOptions mod || null strings || not warnings) $-      tell ["Warning: " ++ show (ppr (ifaceMod mod) defaultUserStyle) +++      tell ["Warning: " ++ moduleString (ifaceMod mod) ++             ": could not find link destinations for:\n"++             "   " ++ concat (map (' ':) strings) ] @@ -405,10 +405,10 @@     subs' <- mapM renameSub subs     instances' <- mapM renameInstHead instances     return (ExportDecl decl' doc' subs' instances')-  ExportNoDecl x y subs -> do-    y'    <- lookupRn id y+  ExportNoDecl x subs -> do+    x'    <- lookupRn id x     subs' <- mapM (lookupRn id) subs-    return (ExportNoDecl x y' subs')+    return (ExportNoDecl x' subs')   ExportDoc doc -> do     doc' <- renameDoc doc     return (ExportDoc doc')@@ -416,5 +416,5 @@  renameSub (n,doc) = do   n' <- rename n-  doc' <- renameDoc doc+  doc' <- mapM renameDoc doc   return (n', doc')

@@ -37,9 +37,10 @@ import HscTypes import FastMutInt import HsDoc+#if __GLASGOW_HASKELL__ >= 609  import FastString import Unique-+#endif  data InterfaceFile = InterfaceFile {   ifLinkEnv         :: LinkEnv,@@ -55,18 +56,24 @@ -- and because we store GHC datatypes in our interface files, -- we need to make sure we version our interface files accordingly. ----- Instead of adding one, we add three to all version numbers+-- Instead of adding one, we add five to all version numbers -- when one of our own (stored) datatypes is changed.  binaryInterfaceVersion :: Word16 #if __GLASGOW_HASKELL__ == 608 && __GHC_PATCHLEVEL__ == 2-binaryInterfaceVersion = 2+binaryInterfaceVersion = 9 #endif          #if __GLASGOW_HASKELL__ == 608 && __GHC_PATCHLEVEL__ == 3-binaryInterfaceVersion = 3+binaryInterfaceVersion = 10 #endif           -#if __GLASGOW_HASKELL__ >= 609-binaryInterfaceVersion = 4+#if __GLASGOW_HASKELL__ == 610 && __GHC_PATCHLEVEL__ == 1+binaryInterfaceVersion = 11 #endif+#if __GLASGOW_HASKELL__ == 610 && __GHC_PATCHLEVEL__ == 2+binaryInterfaceVersion = 12+#endif+#if __GLASGOW_HASKELL__ == 611+binaryInterfaceVersion = 13+#endif   initBinMemSize :: Int@@ -110,7 +117,7 @@   bh <- return $ setUserData bh0 ud   put_ bh iface -  -- write the symtab pointer at the fornt of the file+  -- write the symtab pointer at the front of the file   symtab_p <- tellBin bh   putAt bh symtab_p_p symtab_p   seekBin bh symtab_p		@@ -352,12 +359,14 @@   instance Binary InstalledInterface where-  put_ bh (InstalledInterface modu info docMap exps visExps) = do+  put_ bh (InstalledInterface modu info docMap exps visExps opts subMap) = do     put_ bh modu     put_ bh info     put_ bh (Map.toList docMap)     put_ bh exps     put_ bh visExps+    put_ bh opts+    put_ bh (Map.toList subMap)    get bh = do     modu    <- get bh@@ -365,7 +374,11 @@     docMap  <- get bh     exps    <- get bh     visExps <- get bh-    return (InstalledInterface modu info (Map.fromList docMap) exps visExps)+    opts    <- get bh+    subMap  <- get bh+    +    return (InstalledInterface modu info (Map.fromList docMap)+            exps visExps opts (Map.fromList subMap))   instance Binary DocOption where

@@ -6,7 +6,6 @@  module Haddock.ModuleTree ( ModuleTree(..), mkModuleTree ) where -import Haddock.DocName import GHC           ( HsDoc, Name ) import Module        ( Module, moduleNameString, moduleName, modulePackageId ) #if __GLASGOW_HASKELL__ >= 609@@ -19,14 +18,14 @@  mkModuleTree :: Bool -> [(Module, Maybe (HsDoc Name))] -> [ModuleTree] mkModuleTree showPkgs mods = -  foldr fn [] [ (splitModule mod, modPkg mod, short) | (mod, short) <- mods ]+  foldr fn [] [ (splitModule mdl, modPkg mdl, short) | (mdl, short) <- mods ]   where-    modPkg mod | showPkgs = Just (packageIdString (modulePackageId mod))-               | otherwise = Nothing-    fn (mod,pkg,short) trees = addToTrees mod pkg short trees+    modPkg mod_ | showPkgs = Just (packageIdString (modulePackageId mod_))+                | otherwise = Nothing+    fn (mod_,pkg,short) trees = addToTrees mod_ pkg short trees  addToTrees :: [String] -> Maybe String -> Maybe (HsDoc Name) -> [ModuleTree] -> [ModuleTree]-addToTrees [] pkg short ts = ts+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)   | s1 >  s2  = t : addToTrees (s1:ss) pkg short ts@@ -37,12 +36,12 @@   this_short = if null ss then short else node_short  mkSubTree :: [String] -> Maybe String -> Maybe (HsDoc Name) -> [ModuleTree]-mkSubTree []     pkg short = []+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)]  splitModule :: Module -> [String]-splitModule mod = split (moduleNameString (moduleName mod))+splitModule mdl = split (moduleNameString (moduleName mdl))   where split mod0 = case break (== '.') mod0 of      			(s1, '.':s2) -> s1 : split s2      			(s1, _)      -> [s1]

@@ -29,8 +29,8 @@   parseHaddockOpts :: [String] -> IO ([Flag], [String])-parseHaddockOpts words =-  case getOpt Permute (options True) words of+parseHaddockOpts params =+  case getOpt Permute (options True) params  of     (flags, args, []) -> return (flags, args)     (_, _, errors)    -> do        usage <- getUsage

@@ -47,8 +47,8 @@       -- | Maybe a doc comment       expItemMbDoc :: Maybe (HsDoc name), -      -- | Documentation for subordinate declarations-      expItemSubDocs :: [(name, HsDoc name)],+      -- | Subordinate names, possibly with documentation+      expItemSubDocs :: [(name, Maybe (HsDoc name))],        -- | Instances relevant to this declaration       expItemInstances :: [InstHead name]@@ -56,11 +56,7 @@ 	  }	-- ^ An exported declaration  		       | ExportNoDecl {-	  -- | The original name-      expItemName :: Name,--      -- | Where to link to-      expItemLinkTarget :: name,+      expItemName :: name,        -- | Subordinate names       expItemSubs :: [name]@@ -89,6 +85,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 LinkEnv       = Map Name Module @@ -136,6 +133,7 @@    ifaceDeclMap         :: Map Name DeclInfo,   ifaceRnDocMap        :: Map Name (HsDoc DocName),+  ifaceSubMap          :: Map Name [Name],    ifaceExportItems     :: ![ExportItem Name],   ifaceRnExportItems   :: [ExportItem DocName],@@ -167,7 +165,9 @@   instInfo           :: HaddockModInfo Name,   instDocMap         :: Map Name (HsDoc DocName),   instExports        :: [Name],-  instVisibleExports :: [Name]+  instVisibleExports :: [Name],+  instOptions        :: [DocOption],+  instSubMap         :: Map Name [Name] }  @@ -178,7 +178,9 @@   instInfo           = ifaceInfo           interface,   instDocMap         = ifaceRnDocMap       interface,   instExports        = ifaceExports        interface,-  instVisibleExports = ifaceVisibleExports interface+  instVisibleExports = ifaceVisibleExports interface,+  instOptions        = ifaceOptions        interface,+  instSubMap         = ifaceSubMap         interface }  

@@ -15,4 +15,5 @@ projectName = "Haddock" projectUrl  = "http://www.haskell.org/haddock/" +projectVersion :: String projectVersion = showVersion version

@@ -160,26 +160,29 @@ #endif  #if __GLASGOW_HASKELL__ >= 609+      -- We have one global error handler for all GHC source errors.  Other kinds+      -- of exceptions will be propagated to the top-level error handler. +      let handleSrcErrors action = flip handleSourceError action $ \err -> do+            printExceptionAndWarnings err+            liftIO exitFailure+       -- initialize GHC-      startGhc libDir (ghcFlags flags) $ \dynflags -> do+      startGhc libDir (ghcFlags flags) $ \dynflags -> handleSrcErrors $ do          -- get packages supplied with --read-interface         packages <- readInterfaceFiles nameCacheFromGhc (ifacePairs flags) -        -- combine the link envs of the external packages into one-        let extLinks = Map.unions (map (ifLinkEnv . fst) packages)          -- create the interfaces -- this is the core part of Haddock-        (interfaces, homeLinks) <- createInterfaces fileArgs extLinks flags+        (interfaces, homeLinks) <- createInterfaces fileArgs flags+                                                    (map fst packages) -        let visibleIfaces = [ i | i <- interfaces, OptHide `notElem` ifaceOptions i ]-          liftIO $ do           -- render the interfaces-          renderStep packages visibleIfaces+          renderStep packages interfaces             -- last but not least, dump the interface file-          dumpInterfaceFile (map toInstalledIface visibleIfaces) homeLinks flags+          dumpInterfaceFile (map toInstalledIface interfaces) homeLinks flags #else       -- initialize GHC       (session, dynflags) <- startGhc libDir (ghcFlags flags)@@ -187,19 +190,15 @@       -- get packages supplied with --read-interface       packages <- readInterfaceFiles (nameCacheFromGhc session) (ifacePairs flags) -      -- combine the link envs of the external packages into one-      let extLinks = Map.unions (map (ifLinkEnv . fst) packages)-       -- create the interfaces -- this is the core part of Haddock-      (interfaces, homeLinks) <- createInterfaces session fileArgs extLinks flags--      let visibleIfaces = [ i | i <- interfaces, OptHide `notElem` ifaceOptions i ]+      (interfaces, homeLinks) <- createInterfaces session fileArgs flags+                                                  (map fst packages)        -- render the interfaces-      renderStep packages visibleIfaces+      renderStep packages interfaces         -- last but not least, dump the interface file-      dumpInterfaceFile (map toInstalledIface visibleIfaces) homeLinks flags+      dumpInterfaceFile (map toInstalledIface interfaces) homeLinks flags #endif     else do       -- get packages supplied with --read-interface@@ -216,7 +215,7 @@  -- | Render the interfaces with whatever backend is specified in the flags  render :: [Flag] -> [Interface] -> [InstalledInterface] -> IO ()-render flags visibleIfaces installedIfaces = do+render flags ifaces installedIfaces = do   let     title = case [str | Flag_Heading str <- flags] of 		[] -> ""@@ -271,11 +270,13 @@   prologue <- getPrologue flags    let +    visibleIfaces    = [ i | i <- ifaces, OptHide `notElem` ifaceOptions i ]+     -- *all* visible interfaces including external package modules-    allVisibleIfaces = map toInstalledIface visibleIfaces-                       ++ installedIfaces-    -    packageMod       = ifaceMod (head visibleIfaces)+    allIfaces        = map toInstalledIface ifaces ++ installedIfaces+    allVisibleIfaces = [ i | i <- allIfaces, OptHide `notElem` instOptions i ]++    packageMod       = ifaceMod (head ifaces)     packageStr       = Just (modulePackageString packageMod)     (pkgName,pkgVer) = modulePackageInfo packageMod @@ -303,7 +304,9 @@     copyHtmlBits odir libdir css_file    when (Flag_Hoogle `elem` flags) $ do-    ppHoogle pkgName pkgVer title prologue visibleIfaces odir+    let pkgName2 = if pkgName == "main" && title /= [] then title else pkgName+    ppHoogle pkgName2 pkgVer title prologue visibleIfaces odir+  ------------------------------------------------------------------------------- -- Reading and dumping interface files