packages feed

haddock-api 2.16.0 → 2.16.1

raw patch · 19 files changed

+195/−115 lines, 19 filesdep ~ghcdep ~haddock-library

Dependency ranges changed: ghc, haddock-library

Files

haddock-api.cabal view
@@ -1,5 +1,5 @@ name:                 haddock-api-version:              2.16.0+version:              2.16.1 synopsis:             A documentation-generation tool for Haskell libraries description:          Haddock is a documentation-generation tool for Haskell                       libraries@@ -45,10 +45,10 @@     , array     , xhtml >= 3000.2 && < 3000.3     , Cabal >= 1.10-    , ghc >= 7.10 && < 7.10.2+    , ghc >= 7.10 && < 7.12      , ghc-paths-    , haddock-library == 1.2.0.*+    , haddock-library == 1.2.*    hs-source-dirs:       src
resources/html/Ocean.std-theme/ocean.css view
@@ -416,6 +416,14 @@   margin-top: 0.8em; } +.clearfix:after {+  clear: both;+  content: " ";+  display: block;+  height: 0;+  visibility: hidden;+}+ .subs dl {   margin: 0; }@@ -453,6 +461,11 @@ .inst, .inst li {   list-style: none;   margin-left: 1em;+}++/* Workaround for bug in Firefox (issue #384) */+.inst-left {+  float: left; }  .top p.src {
src/Haddock.hs view
@@ -39,6 +39,7 @@ import Haddock.Utils  import Control.Monad hiding (forM_)+import Control.Applicative import Data.Foldable (forM_) import Data.List (isPrefixOf) import Control.Exception@@ -250,9 +251,9 @@     allVisibleIfaces = [ i | i <- allIfaces, OptHide `notElem` instOptions i ]      pkgMod           = ifaceMod (head ifaces)-    pkgKey            = modulePackageKey pkgMod+    pkgKey           = modulePackageKey pkgMod     pkgStr           = Just (packageKeyString pkgKey)-    (pkgName,pkgVer) = modulePackageInfo dflags flags pkgMod+    pkgNameVer       = modulePackageInfo dflags flags pkgMod      (srcBase, srcModule, srcEntity, srcLEntity) = sourceUrls flags     srcMap' = maybe srcMap (\path -> Map.insert pkgKey path srcMap) srcEntity@@ -288,12 +289,20 @@   -- TODO: we throw away Meta for both Hoogle and LaTeX right now,   -- might want to fix that if/when these two get some work on them   when (Flag_Hoogle `elem` flags) $ do-    let pkgNameStr | unpackFS pkgNameFS == "main" && title /= []-                               = title-                   | otherwise = unpackFS pkgNameFS-          where PackageName pkgNameFS = pkgName-    ppHoogle dflags pkgNameStr pkgVer title (fmap _doc prologue) visibleIfaces-      odir+    case pkgNameVer of+      Nothing -> putStrLn . unlines $+          [ "haddock: Unable to find a package providing module "+            ++ moduleNameString (moduleName pkgMod) ++ ", skipping Hoogle."+          , ""+          , "         Perhaps try specifying the desired package explicitly"+            ++ " using the --package-name"+          , "         and --package-version arguments."+          ]+      Just (PackageName pkgNameFS, pkgVer) ->+          let pkgNameStr | unpackFS pkgNameFS == "main" && title /= [] = title+                         | otherwise = unpackFS pkgNameFS+          in ppHoogle dflags pkgNameStr pkgVer title (fmap _doc prologue)+               visibleIfaces odir    when (Flag_LaTeX `elem` flags) $ do     ppLaTeX title pkgStr visibleIfaces odir (fmap _doc prologue) opt_latex_style@@ -312,12 +321,12 @@                             -- contain the package name or version                             -- provided by the user which we                             -- prioritise-                  -> Module -> (PackageName, Data.Version.Version)+                  -> Module -> Maybe (PackageName, Data.Version.Version) modulePackageInfo dflags flags modu =-  (fromMaybe (packageName pkg) (optPackageName flags),-   fromMaybe (packageVersion pkg) (optPackageVersion flags))+    cmdline <|> pkgDb   where-    pkg = getPackageDetails dflags (modulePackageKey modu)+    cmdline = (,) <$> optPackageName flags <*> optPackageVersion flags+    pkgDb = (\pkg -> (packageName pkg, packageVersion pkg)) <$> lookupPackage dflags (modulePackageKey modu)   -------------------------------------------------------------------------------
src/Haddock/Backends/Hoogle.hs view
@@ -15,7 +15,8 @@     ppHoogle   ) where -+import BasicTypes (OverlapFlag(..), OverlapMode(..))+import InstEnv (ClsInst(..)) import Haddock.GhcUtils import Haddock.Types hiding (Version) import Haddock.Utils hiding (out)@@ -95,18 +96,22 @@ dropComment [] = []  -out :: Outputable a => DynFlags -> a -> String-out dflags = f . unwords . map (dropWhile isSpace) . lines . showSDocUnqual dflags . ppr+outWith :: Outputable a => (SDoc -> String) -> a -> [Char]+outWith p = f . unwords . map (dropWhile isSpace) . lines . p . ppr     where         f xs | " <document comment>" `isPrefixOf` xs = f $ drop 19 xs         f (x:xs) = x : f xs         f [] = [] +out :: Outputable a => DynFlags -> a -> String+out dflags = outWith $ showSDocUnqual dflags  operator :: String -> String operator (x:xs) | not (isAlphaNum x) && x `notElem` "_' ([{" = '(' : x:xs ++ ")" operator x = x +commaSeparate :: Outputable a => DynFlags -> [a] -> String+commaSeparate dflags = showSDocUnqual dflags . interpp'SP  --------------------------------------------------------------------- -- How to print each export@@ -119,30 +124,38 @@     where         f (TyClD d@DataDecl{})  = ppData dflags d subdocs         f (TyClD d@SynDecl{})   = ppSynonym dflags d-        f (TyClD d@ClassDecl{}) = ppClass dflags d+        f (TyClD d@ClassDecl{}) = ppClass dflags d subdocs         f (ForD (ForeignImport name typ _ _)) = ppSig dflags $ TypeSig [name] typ []         f (ForD (ForeignExport name typ _ _)) = ppSig dflags $ TypeSig [name] typ []         f (SigD sig) = ppSig dflags sig         f _ = [] ppExport _ _ = [] --ppSig :: DynFlags -> Sig Name -> [String]-ppSig dflags (TypeSig names sig _)-    = [operator prettyNames ++ " :: " ++ outHsType dflags typ]+ppSigWithDoc :: DynFlags -> Sig Name -> [(Name, DocForDecl Name)] -> [String]+ppSigWithDoc dflags (TypeSig names sig _) subdocs+    = concatMap mkDocSig names     where-        prettyNames = intercalate ", " $ map (out dflags) names+        mkDocSig n = concatMap (ppDocumentation dflags) (getDoc n)+                     ++ [mkSig n]+        mkSig n = operator (out dflags n) ++ " :: " ++ outHsType dflags typ++        getDoc :: Located Name -> [Documentation Name]+        getDoc n = maybe [] (return . fst) (lookup (unL n) subdocs)+         typ = case unL sig of                    HsForAllTy Explicit a b c d  -> HsForAllTy Implicit a b c d                    HsForAllTy Qualified a b c d -> HsForAllTy Implicit a b c d                    x -> x-ppSig _ _ = []+ppSigWithDoc _ _ _ = [] +ppSig :: DynFlags -> Sig Name -> [String]+ppSig dflags x  = ppSigWithDoc dflags x [] + -- note: does not yet output documentation for class methods-ppClass :: DynFlags -> TyClDecl Name -> [String]-ppClass dflags x = out dflags x{tcdSigs=[]} :-            concatMap (ppSig dflags . addContext . unL) (tcdSigs x)+ppClass :: DynFlags -> TyClDecl Name -> [(Name, DocForDecl Name)] -> [String]+ppClass dflags x subdocs = out dflags x{tcdSigs=[]} :+            concatMap (flip (ppSigWithDoc dflags) subdocs . addContext . unL) (tcdSigs x)     where         addContext (TypeSig name (L l sig) nwcs) = TypeSig name (L l $ f sig) nwcs         addContext (MinimalSig src sig) = MinimalSig src sig@@ -156,8 +169,16 @@   ppInstance :: DynFlags -> ClsInst -> [String]-ppInstance dflags x = [dropComment $ out dflags x]-+ppInstance dflags x =+  [dropComment $ outWith (showSDocForUser dflags alwaysQualify) cls]+  where+    -- As per #168, we don't want safety information about the class+    -- in Hoogle output. The easiest way to achieve this is to set the+    -- safety information to a state where the Outputable instance+    -- produces no output which means no overlap and unsafe (or [safe]+    -- is generated).+    cls = x { is_flag = OverlapFlag { overlapMode = NoOverlap mempty+                                    , isSafeOverlap = False } }  ppSynonym :: DynFlags -> TyClDecl Name -> [String] ppSynonym dflags x = [out dflags x]@@ -198,7 +219,10 @@         apps = foldl1 (\x y -> reL $ HsAppTy x y)          typeSig nm flds = operator nm ++ " :: " ++ outHsType dflags (makeExplicit $ unL $ funs flds)-        name = out dflags $ map unL $ con_names con++        -- We print the constructors as comma-separated list. See GHC+        -- docs for con_names on why it is a list to begin with.+        name = commaSeparate dflags . map unL $ con_names con          resType = case con_res con of             ResTyH98 -> apps $ map (reL . HsTyVar) $
src/Haddock/Backends/LaTeX.hs view
@@ -544,14 +544,14 @@     (is, rest') = spanWith isUndocdInstance rest  isUndocdInstance :: DocInstance a -> Maybe (InstHead a)-isUndocdInstance (L _ i,Nothing) = Just i+isUndocdInstance (i,Nothing,_) = Just i isUndocdInstance _ = Nothing  -- | Print a possibly commented instance. The instance header is printed inside -- an 'argBox'. The comment is printed to the right of the box in normal comment -- style. ppDocInstance :: Bool -> DocInstance DocName -> LaTeX-ppDocInstance unicode (L _ instHead, doc) =+ppDocInstance unicode (instHead, doc, _) =   declWithDoc (ppInstDecl unicode instHead) (fmap docToLaTeX $ fmap _doc doc)
src/Haddock/Backends/Xhtml.hs view
@@ -36,7 +36,6 @@  import Control.Monad         ( when, unless ) import Data.Char             ( toUpper )-import Data.Functor          ( (<$>) ) import Data.List             ( sortBy, groupBy, intercalate, isPrefixOf ) import Data.Maybe import System.FilePath hiding ( (</>) )@@ -289,7 +288,7 @@   mkNode :: Qualification -> [String] -> String -> ModuleTree -> Html-mkNode qual ss p (Node s leaf pkg short ts) =+mkNode qual ss p (Node s leaf pkg srcPkg short ts) =   htmlModule <+> shortDescr +++ htmlPkg +++ subtree   where     modAttrs = case (ts, leaf) of@@ -313,7 +312,7 @@     mdl = intercalate "." (reverse (s:ss))      shortDescr = maybe noHtml (origDocToHtml qual) short-    htmlPkg = maybe noHtml (thespan ! [theclass "package"] <<) pkg+    htmlPkg = maybe noHtml (thespan ! [theclass "package"] <<) srcPkg      subtree = mkNodeList qual (s:ss) p ts ! collapseSection p True ""
src/Haddock/Backends/Xhtml/Decl.hs view
@@ -27,7 +27,6 @@ import Haddock.Types import Haddock.Doc (combineDocumentation) -import           Control.Applicative import           Data.List             ( intersperse, sort ) import qualified Data.Map as Map import           Data.Maybe@@ -498,12 +497,12 @@  ppInstances :: LinksInfo -> [DocInstance DocName] -> DocName -> Unicode -> Qualification -> Html ppInstances links instances baseName unicode qual-  = subInstances qual instName links True baseName (map instDecl instances)+  = subInstances qual instName links True (map instDecl instances)   -- force Splice = True to use line URLs   where     instName = getOccString $ getName baseName-    instDecl :: DocInstance DocName -> (SubDecl,SrcSpan)-    instDecl (L l inst, maybeDoc) = ((instHead inst, maybeDoc, []),l)+    instDecl :: DocInstance DocName -> (SubDecl,Located DocName)+    instDecl (inst, maybeDoc,l) = ((instHead inst, maybeDoc, []),l)     instHead (n, ks, ts, ClassInst cs) = ppContextNoLocs cs unicode qual         <+> ppAppNameTypes n ks ts unicode qual     instHead (n, ks, ts, TypeInst rhs) = keyword "type"
src/Haddock/Backends/Xhtml/DocMarkup.hs view
@@ -19,8 +19,6 @@   docElement, docSection, docSection_, ) where -import Control.Applicative ((<$>))- import Data.List import Haddock.Backends.Xhtml.Names import Haddock.Backends.Xhtml.Utils@@ -64,7 +62,10 @@                                   then anchor ! [href url]                                        << fromMaybe url mLabel                                   else toHtml $ fromMaybe url mLabel,-  markupAName                = \aname -> namedAnchor aname << "",+  markupAName                = \aname+                               -> if insertAnchors+                                  then namedAnchor aname << ""+                                  else noHtml,   markupPic                  = \(Picture uri t) -> image ! ([src uri] ++ fromMaybe [] (return . title <$> t)),   markupProperty             = pre . toHtml,   markupExample              = examplesToHtml,
src/Haddock/Backends/Xhtml/Layout.hs view
@@ -44,7 +44,6 @@ import Haddock.Backends.Xhtml.Utils import Haddock.Types import Haddock.Utils (makeAnchorId)- import qualified Data.Map as Map import Text.XHtml hiding ( name, title, p, quote ) @@ -148,20 +147,22 @@        docElement td << fmap (docToHtml Nothing qual) mdoc)       : map (cell . (td <<)) subs + -- | Sub table with source information (optional).-subTableSrc :: Qualification -> LinksInfo -> Bool -> DocName -> [(SubDecl,SrcSpan)] -> Maybe Html-subTableSrc _ _  _ _ [] = Nothing-subTableSrc qual lnks splice dn decls = Just $ table << aboves (concatMap subRow decls)+subTableSrc :: Qualification -> LinksInfo -> Bool -> [(SubDecl,Located DocName)] -> Maybe Html+subTableSrc _ _  _ [] = Nothing+subTableSrc qual lnks splice decls = Just $ table << aboves (concatMap subRow decls)   where-    subRow ((decl, mdoc, subs),loc) =-      (td ! [theclass "src"] << decl-      <+> linkHtml loc+    subRow ((decl, mdoc, subs),L loc dn) =+      (td ! [theclass "src clearfix"] <<+        (thespan ! [theclass "inst-left"] << decl)+        <+> linkHtml loc dn       <->       docElement td << fmap (docToHtml Nothing qual) mdoc       )       : map (cell . (td <<)) subs-    linkHtml loc@(RealSrcSpan _) = links lnks loc splice dn-    linkHtml _ = noHtml+    linkHtml loc@(RealSrcSpan _) dn = links lnks loc splice dn+    linkHtml _ _ = noHtml  subBlock :: [Html] -> Maybe Html subBlock [] = Nothing@@ -191,12 +192,12 @@ -- | Generate sub table for instance declarations, with source subInstances :: Qualification              -> String -- ^ Class name, used for anchor generation-             -> LinksInfo -> Bool -> DocName-             -> [(SubDecl,SrcSpan)] -> Html-subInstances qual nm lnks splice dn = maybe noHtml wrap . instTable+             -> LinksInfo -> Bool+             -> [(SubDecl,Located DocName)] -> Html+subInstances qual nm lnks splice = maybe noHtml wrap . instTable   where     wrap = (subSection <<) . (subCaption +++)-    instTable = fmap (thediv ! collapseSection id_ True [] <<) . subTableSrc qual lnks splice dn+    instTable = fmap (thediv ! collapseSection id_ True [] <<) . subTableSrc qual lnks splice     subSection = thediv ! [theclass "subs instances"]     subCaption = paragraph ! collapseControl id_ True "caption" << "Instances"     id_ = makeAnchorId $ "i:" ++ nm
src/Haddock/Backends/Xhtml/Themes.hs view
@@ -18,7 +18,6 @@  import Haddock.Options -import Control.Applicative import Control.Monad (liftM) import Data.Char (toLower) import Data.Either (lefts, rights)@@ -206,4 +205,3 @@  concatEither :: [Either a [b]] -> Either a [b] concatEither = liftEither concat . sequenceEither-
src/Haddock/GhcUtils.hs view
@@ -16,7 +16,6 @@ module Haddock.GhcUtils where  -import Control.Applicative  ( (<$>) ) import Control.Arrow import Data.Function
src/Haddock/Interface/AttachInstances.hs view
@@ -38,6 +38,7 @@ import Name import Outputable (text, sep, (<+>)) import PrelNames+import SrcLoc import TcRnDriver (tcRnGetInfo) import TcType (tcSplitSigmaTy) import TyCon@@ -68,11 +69,11 @@                    -> Ghc (ExportItem Name) attachToExportItem expInfo iface ifaceMap instIfaceMap export =   case attachFixities export of-    e@ExportDecl { expItemDecl = L _ (TyClD d) } -> do+    e@ExportDecl { expItemDecl = L eSpan (TyClD d) } -> do       mb_info <- getAllInfo (tcdName d)       insts <- case mb_info of         Just (_, _, cls_instances, fam_instances) ->-          let fam_insts = [ (L (getSrcSpan n) $ synifyFamInst i opaque, doc)+          let fam_insts = [ (synifyFamInst i opaque, doc,spanNameE n (synifyFamInst i opaque) (L eSpan (tcdName d)) )                           | i <- sortBy (comparing instFam) fam_instances                           , let n = getName i                           , let doc = instLookup instDocMap n iface ifaceMap instIfaceMap@@ -80,14 +81,14 @@                           , not $ any (isTypeHidden expInfo) (fi_tys i)                           , let opaque = isTypeHidden expInfo (fi_rhs i)                           ]-              cls_insts = [ (L (getSrcSpan n) $ synifyInstHead i, instLookup instDocMap n iface ifaceMap instIfaceMap)+              cls_insts = [ (synifyInstHead i, instLookup instDocMap n iface ifaceMap instIfaceMap, spanName n (synifyInstHead i) (L eSpan (tcdName d)))                           | let is = [ (instanceHead' i, getName i) | i <- cls_instances ]                           , (i@(_,_,cls,tys), n) <- sortBy (comparing $ first instHead) is                           , not $ isInstanceHidden expInfo cls tys                           ]               -- fam_insts but with failing type fams filtered out-              cleanFamInsts = [ (L l fi, n) | (L l (Right fi), n) <- fam_insts ]-              famInstErrs = [ errm | (L _ (Left errm), _) <- fam_insts ]+              cleanFamInsts = [ (fi, n, L l r) | (Right fi, n, L l (Right r)) <- fam_insts ]+              famInstErrs = [ errm | (Left errm, _, _) <- fam_insts ]           in do             dfs <- getDynFlags             let mkBug = (text "haddock-bug:" <+>) . text@@ -106,6 +107,18 @@       ] }      attachFixities e = e+    -- spanName: attach the location to the name that is the same file as the instance location+    spanName s (clsn,_,_,_) (L instL instn) =+        let s1 = getSrcSpan s+            sn = if srcSpanFileName_maybe s1 == srcSpanFileName_maybe instL+                    then instn+                    else clsn+        in L (getSrcSpan s) sn+    -- spanName on Either+    spanNameE s (Left e) _ =  L (getSrcSpan s) (Left e)+    spanNameE s (Right ok) linst =+      let L l r = spanName s ok linst+      in L l (Right r)   instLookup :: (InstalledInterface -> Map.Map Name a) -> Name
src/Haddock/Interface/Create.hs view
@@ -517,7 +517,7 @@       case findDecl t of         ([L l (ValD _)], (doc, _)) -> do           -- Top-level binding without type signature-          export <- hiValExportItem dflags t doc (l `elem` splices) $ M.lookup t fixMap+          export <- hiValExportItem dflags t l doc (l `elem` splices) $ M.lookup t fixMap           return [export]         (ds, docs_) | decl : _ <- filter (not . isValD . unLoc) ds ->           let declNames = getMainDeclBinder (unL decl)@@ -620,13 +620,19 @@                    O.text "-- Please report this on Haddock issue tracker!"       bugWarn = O.showSDoc dflags . warnLine -hiValExportItem :: DynFlags -> Name -> DocForDecl Name -> Bool -> Maybe Fixity -> ErrMsgGhc (ExportItem Name)-hiValExportItem dflags name doc splice fixity = do+-- | This function is called for top-level bindings without type signatures.+-- It gets the type signature from GHC and that means it's not going to+-- have a meaningful 'SrcSpan'. So we pass down 'SrcSpan' for the+-- declaration and use it instead - 'nLoc' here.+hiValExportItem :: DynFlags -> Name -> SrcSpan -> DocForDecl Name -> Bool+                -> Maybe Fixity -> ErrMsgGhc (ExportItem Name)+hiValExportItem dflags name nLoc doc splice fixity = do   mayDecl <- hiDecl dflags name   case mayDecl of     Nothing -> return (ExportNoDecl name [])-    Just decl -> return (ExportDecl decl doc [] [] fixities splice)+    Just decl -> return (ExportDecl (fixSpan decl) doc [] [] fixities splice)   where+    fixSpan (L l t) = L (SrcLoc.combineSrcSpans l nLoc) t     fixities = case fixity of       Just f  -> [(name, f)]       Nothing -> []@@ -737,7 +743,7 @@       | name:_ <- collectHsBindBinders d, Just [L _ (ValD _)] <- M.lookup name declMap =           -- Top-level binding without type signature.           let (doc, _) = lookupDocs name warnings docMap argMap subMap in-          fmap Just (hiValExportItem dflags name doc (l `elem` splices) $ M.lookup name fixMap)+          fmap Just (hiValExportItem dflags name l doc (l `elem` splices) $ M.lookup name fixMap)       | otherwise = return Nothing     mkExportItem decl@(L l (InstD d))       | Just name <- M.lookup (getInstLoc d) instMap =
src/Haddock/Interface/LexParseRn.hs view
@@ -18,7 +18,6 @@   , processModuleHeader   ) where -import Control.Applicative import Data.IntSet (toList) import Data.List import Documentation.Haddock.Doc (metaDocConcat)@@ -31,6 +30,7 @@ import Name import Outputable (showPpr) import RdrName+import RnEnv (dataTcOccs)  processDocStrings :: DynFlags -> GlobalRdrEnv -> [HsDocString]                   -> Maybe (MDoc Name)@@ -74,7 +74,13 @@   where     failure = (emptyHaddockModInfo, Nothing) -+-- | Takes a 'GlobalRdrEnv' which (hopefully) contains all the+-- definitions and a parsed comment and we attempt to make sense of+-- where the identifiers in the comment point to. We're in effect+-- trying to convert 'RdrName's to 'Name's, with some guesswork and+-- fallbacks in case we can't locate the identifiers.+--+-- See the comments in the source for implementation commentary. rename :: DynFlags -> GlobalRdrEnv -> Doc RdrName -> Doc Name rename dflags gre = rn   where@@ -82,19 +88,36 @@       DocAppend a b -> DocAppend (rn a) (rn b)       DocParagraph doc -> DocParagraph (rn doc)       DocIdentifier x -> do-        let choices = dataTcOccs' x+        -- Generate the choices for the possible kind of thing this+        -- is.+        let choices = dataTcOccs x+        -- Try to look up all the names in the GlobalRdrEnv that match+        -- the names.         let names = concatMap (\c -> map gre_name (lookupGRE_RdrName c gre)) choices+         case names of+          -- We found no names in the env so we start guessing.           [] ->             case choices of               [] -> DocMonospaced (DocString (showPpr dflags x))-              [a] -> outOfScope dflags a-              a:b:_ | isRdrTc a -> outOfScope dflags a-                    | otherwise -> outOfScope dflags b+              -- There was nothing in the environment so we need to+              -- pick some default from what's available to us. We+              -- diverge here from the old way where we would default+              -- to type constructors as we're much more likely to+              -- actually want anchors to regular definitions than+              -- type constructor names (such as in #253). So now we+              -- only get type constructor links if they are actually+              -- in scope.+              a:_ -> outOfScope dflags a++          -- There is only one name in the environment that matches so+          -- use it.           [a] -> DocIdentifier a-          a:b:_ | isTyConName a -> DocIdentifier a | otherwise -> DocIdentifier b-              -- If an id can refer to multiple things, we give precedence to type-              -- constructors.+          -- But when there are multiple names available, default to+          -- type constructors: somewhat awfully GHC returns the+          -- values in the list positionally.+          a:b:_ | isTyConName a -> DocIdentifier a+                | otherwise -> DocIdentifier b        DocWarning doc -> DocWarning (rn doc)       DocEmphasis doc -> DocEmphasis (rn doc)@@ -115,21 +138,14 @@       DocString str -> DocString str       DocHeader (Header l t) -> DocHeader $ Header l (rn t) -dataTcOccs' :: RdrName -> [RdrName]--- If the input is a data constructor, return both it and a type--- constructor.  This is useful when we aren't sure which we are--- looking at.------ We use this definition instead of the GHC's to provide proper linking to--- functions accross modules. See ticket #253 on Haddock Trac.-dataTcOccs' rdr_name-  | isDataOcc occ             = [rdr_name, rdr_name_tc]-  | otherwise                 = [rdr_name]-  where-    occ = rdrNameOcc rdr_name-    rdr_name_tc = setRdrNameSpace rdr_name tcName--+-- | Wrap an identifier that's out of scope (i.e. wasn't found in+-- 'GlobalReaderEnv' during 'rename') in an appropriate doc. Currently+-- we simply monospace the identifier in most cases except when the+-- identifier is qualified: if the identifier is qualified then we can+-- still try to guess and generate anchors accross modules but the+-- users shouldn't rely on this doing the right thing. See tickets+-- #253 and #375 on the confusion this causes depending on which+-- default we pick in 'rename'. outOfScope :: DynFlags -> RdrName -> Doc a outOfScope dflags x =   case x of
src/Haddock/Interface/ParseModuleHeader.hs view
@@ -11,7 +11,6 @@ ----------------------------------------------------------------------------- module Haddock.Interface.ParseModuleHeader (parseModuleHeader) where -import Control.Applicative ((<$>)) import Control.Monad (mplus) import Data.Char import DynFlags
src/Haddock/Interface/Rename.hs view
@@ -498,10 +498,11 @@     decl' <- renameLDecl decl     doc'  <- renameDocForDecl doc     subs' <- mapM renameSub subs-    instances' <- forM instances $ \(L l inst, idoc) -> do+    instances' <- forM instances $ \(inst, idoc, L l n) -> do       inst' <- renameInstHead inst+      n' <- rename n       idoc' <- mapM renameDoc idoc-      return (L l inst', idoc')+      return (inst', idoc',L l n')     fixities' <- forM fixities $ \(name, fixity) -> do       name' <- lookupRn name       return (name', fixity)
src/Haddock/InterfaceFile.hs view
@@ -25,7 +25,6 @@  import Control.Monad import Data.Array-import Data.Functor ((<$>)) import Data.IORef import Data.List import qualified Data.Map as Map
src/Haddock/ModuleTree.hs view
@@ -15,41 +15,44 @@ import Haddock.Types ( MDoc )  import GHC           ( Name )-import Module        ( Module, moduleNameString, moduleName, modulePackageKey )+import Module        ( Module, moduleNameString, moduleName, modulePackageKey, packageKeyString ) import DynFlags      ( DynFlags ) import Packages      ( lookupPackage ) import PackageConfig ( sourcePackageIdString )  -data ModuleTree = Node String Bool (Maybe String) (Maybe (MDoc Name)) [ModuleTree]+data ModuleTree = Node String Bool (Maybe String) (Maybe String) (Maybe (MDoc Name)) [ModuleTree]   mkModuleTree :: DynFlags -> Bool -> [(Module, Maybe (MDoc Name))] -> [ModuleTree] mkModuleTree dflags showPkgs mods =-  foldr fn [] [ (splitModule mdl, modPkg mdl, short) | (mdl, short) <- mods ]+  foldr fn [] [ (splitModule mdl, modPkg mdl, modSrcPkg mdl, short) | (mdl, short) <- mods ]   where-    modPkg mod_ | showPkgs = fmap sourcePackageIdString-                                  (lookupPackage dflags (modulePackageKey mod_))+    modPkg mod_ | showPkgs = Just (packageKeyString (modulePackageKey mod_))                 | otherwise = Nothing-    fn (mod_,pkg,short) = addToTrees mod_ pkg short+    modSrcPkg mod_ | showPkgs = fmap sourcePackageIdString+                                     (lookupPackage dflags (modulePackageKey mod_))+                   | otherwise = Nothing+    fn (mod_,pkg,srcPkg,short) = addToTrees mod_ pkg srcPkg short  -addToTrees :: [String] -> Maybe String -> Maybe (MDoc 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)-  | s1 >  s2  = t : addToTrees (s1:ss) pkg short ts-  | s1 == s2  = Node s2 (leaf || null ss) this_pkg this_short (addToTrees ss pkg short subs) : ts-  | otherwise = mkSubTree (s1:ss) pkg short ++ t : ts+addToTrees :: [String] -> Maybe String -> Maybe String -> Maybe (MDoc Name) -> [ModuleTree] -> [ModuleTree]+addToTrees [] _ _ _ ts = ts+addToTrees ss pkg srcPkg short [] = mkSubTree ss pkg srcPkg short+addToTrees (s1:ss) pkg srcPkg short (t@(Node s2 leaf node_pkg node_srcPkg node_short subs) : ts)+  | s1 >  s2  = t : addToTrees (s1:ss) pkg srcPkg short ts+  | s1 == s2  = Node s2 (leaf || null ss) this_pkg this_srcPkg this_short (addToTrees ss pkg srcPkg short subs) : ts+  | otherwise = mkSubTree (s1:ss) pkg srcPkg short ++ t : ts  where   this_pkg = if null ss then pkg else node_pkg+  this_srcPkg = if null ss then srcPkg else node_srcPkg   this_short = if null ss then short else node_short  -mkSubTree :: [String] -> Maybe String -> Maybe (MDoc 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)]+mkSubTree :: [String] -> Maybe String -> Maybe String -> Maybe (MDoc Name) -> [ModuleTree]+mkSubTree []     _   _      _     = []+mkSubTree [s]    pkg srcPkg short = [Node s True pkg srcPkg short []]+mkSubTree (s:ss) pkg srcPkg short = [Node s (null ss) Nothing Nothing Nothing (mkSubTree ss pkg srcPkg short)]   splitModule :: Module -> [String]
src/Haddock/Types.hs view
@@ -300,7 +300,7 @@   ppr (DataInst  a) = text "DataInst"  <+> ppr a  -- | An instance head that may have documentation and a source location.-type DocInstance name = (Located (InstHead name), Maybe (MDoc name))+type DocInstance name = (InstHead name, Maybe (MDoc name), Located name)  -- | The head of an instance. Consists of a class name, a list of kind -- parameters, a list of type parameters and an instance type