Merge branch 'ghc-7.6' into ghc-7.6-merge-2

Conflicts:
	haddock.cabal
	src/Haddock/Interface/AttachInstances.hs
	src/Haddock/Interface/Create.hs
	src/Haddock/Interface/LexParseRn.hs
	src/Haddock/InterfaceFile.hs
	src/Haddock/Types.hs

Only GHC HEAD can compile this. GHC 7.6.x cannot compile this.

Some test fail.

17 files changed, 360 insertions, 148 deletions

diff --git a/src/.ghci b/src/.ghci
deleted file mode 100644
index f00e6d55..00000000
--- a/src/.ghci
+++ /dev/null
@@ -1 +0,0 @@
-:set -i../dist/build/autogen -i../dist/build/haddock/haddock-tmp/ -packageghc -optP-include -optP../dist/build/autogen/cabal_macros.h -XCPP -XDeriveDataTypeable -XScopedTypeVariables -XMagicHash
diff --git a/src/Documentation/Haddock.hs b/src/Documentation/Haddock.hs
index 60bb3147..36115a2a 100644
--- a/src/Documentation/Haddock.hs
+++ b/src/Documentation/Haddock.hs
@@ -35,7 +35,13 @@ module Documentation.Haddock (
   -- * Documentation comments
   Doc(..),
   Example(..),
+  Hyperlink(..),
   DocMarkup(..),
+  Documentation(..),
+  ArgMap,
+  AliasMap,
+  WarningMap,
+  DocMap,
   HaddockModInfo(..),
   markup,
 
@@ -48,8 +54,10 @@ module Documentation.Haddock (
 
   -- * Flags and options
   Flag(..),
-  DocOption(..)
+  DocOption(..),
 
+  -- * Program entry point
+  haddock,
 ) where
 
 
@@ -58,7 +66,7 @@ import Haddock.Interface
 import Haddock.Types
 import Haddock.Options
 import Haddock.Utils
-import Main
+import Haddock
 
 
 -- | Create 'Interface' structures from a given list of Haddock command-line
@@ -70,6 +78,5 @@ createInterfaces
   -> [String]       -- ^ File or module names
   -> IO [Interface] -- ^ Resulting list of interfaces
 createInterfaces flags modules = do
-  (_, ifaces, _) <- readPackagesAndProcessModules flags modules
+  (_, ifaces, _) <- withGhc' flags (readPackagesAndProcessModules flags modules)
   return ifaces
-
diff --git a/src/Main.hs b/src/Haddock.hs
index dc5a49d2..3b31c756 100644
--- a/src/Main.hs
+++ b/src/Haddock.hs
@@ -1,8 +1,8 @@
 {-# OPTIONS_GHC -Wwarn #-}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP, ScopedTypeVariables #-}
 -----------------------------------------------------------------------------
 -- |
--- Module      :  Main
+-- Module      :  Haddock
 -- Copyright   :  (c) Simon Marlow 2003-2006,
 --                    David Waern  2006-2010
 -- License     :  BSD-like
@@ -15,7 +15,7 @@
 --
 -- Program entry point and top-level code.
 -----------------------------------------------------------------------------
-module Main (main, readPackagesAndProcessModules) where
+module Haddock (haddock, readPackagesAndProcessModules, withGhc') where
 
 
 import Haddock.Backends.Xhtml
@@ -32,14 +32,14 @@ import Haddock.Options
 import Haddock.Utils
 import Haddock.GhcUtils hiding (pretty)
 
-import Control.Monad
+import Control.Monad hiding (forM_)
+import Data.Foldable (forM_)
 import Control.Exception
 import Data.Maybe
 import Data.IORef
 import qualified Data.Map as Map
 import System.IO
 import System.Exit
-import System.Environment
 
 #if defined(mingw32_HOST_OS)
 import Foreign
@@ -61,9 +61,6 @@ import StaticFlags (saveStaticFlagGlobals, restoreStaticFlagGlobals)
 import Panic (handleGhcException)
 import Module
 
-import Control.Monad.Fix (MonadFix)
-
-
 --------------------------------------------------------------------------------
 -- * Exception handling
 --------------------------------------------------------------------------------
@@ -123,27 +120,23 @@ handleGhcExceptions =
 -------------------------------------------------------------------------------
 
 
-main :: IO ()
-main = handleTopExceptions $ do
+-- | Run Haddock with given list of arguments.
+--
+-- Haddock's own main function is defined in terms of this:
+--
+-- > main = getArgs >>= haddock
+haddock :: [String] -> IO ()
+haddock args = handleTopExceptions $ do
 
   -- Parse command-line flags and handle some of them initially.
   -- TODO: unify all of this (and some of what's in the 'render' function),
   -- into one function that returns a record with a field for each option,
   -- or which exits with an error or help message.
-  args <- getArgs
   (flags, files) <- parseHaddockOpts args
   shortcutFlags flags
   qual <- case qualification flags of {Left msg -> throwE msg; Right q -> return q}
 
-  libDir <- fmap snd (getGhcDirs flags)
-
-  -- Catches all GHC source errors, then prints and re-throws them.
-  let handleSrcErrors action' = flip handleSourceError action' $ \err -> do
-        printException err
-        liftIO exitFailure
-
-  -- Initialize GHC.
-  withGhc libDir (ghcFlags flags) $ \_ -> handleSrcErrors $ do
+  withGhc' flags $ do
 
     dflags <- getDynFlags
 
@@ -151,9 +144,11 @@ main = handleTopExceptions $ do
       (packages, ifaces, homeLinks) <- readPackagesAndProcessModules flags files
 
       -- Dump an "interface file" (.haddock file), if requested.
-      case optDumpInterfaceFile flags of
-        Just f -> liftIO $ dumpInterfaceFile f (map toInstalledIface ifaces) homeLinks
-        Nothing -> return ()
+      forM_ (optDumpInterfaceFile flags) $ \path -> liftIO $ do
+        writeInterfaceFile path InterfaceFile {
+            ifInstalledIfaces = map toInstalledIface ifaces
+          , ifLinkEnv         = homeLinks
+          }
 
       -- Render the interfaces.
       liftIO $ renderStep dflags flags qual packages ifaces
@@ -169,6 +164,18 @@ main = handleTopExceptions $ do
       liftIO $ renderStep dflags flags qual packages []
 
 
+withGhc' :: [Flag] -> Ghc a -> IO a
+withGhc' flags action = do
+  libDir <- fmap snd (getGhcDirs flags)
+
+  -- Catches all GHC source errors, then prints and re-throws them.
+  let handleSrcErrors action' = flip handleSourceError action' $ \err -> do
+        printException err
+        liftIO exitFailure
+
+  withGhc libDir (ghcFlags flags) (\_ -> handleSrcErrors action)
+
+
 readPackagesAndProcessModules :: [Flag] -> [String]
                               -> Ghc ([(DocPaths, InterfaceFile)], [Interface], LinkEnv)
 readPackagesAndProcessModules flags files = do
@@ -260,13 +267,12 @@ render dflags flags qual ifaces installedIfaces srcMap = do
 -------------------------------------------------------------------------------
 
 
-readInterfaceFiles :: (MonadFix m, MonadIO m) =>
-                      NameCacheAccessor m
-                   -> [(DocPaths, FilePath)] ->
-                      m [(DocPaths, InterfaceFile)]
+readInterfaceFiles :: MonadIO m
+                   => NameCacheAccessor m
+                   -> [(DocPaths, FilePath)]
+                   -> m [(DocPaths, InterfaceFile)]
 readInterfaceFiles name_cache_accessor pairs = do
-  mbPackages <- mapM tryReadIface pairs
-  return (catMaybes mbPackages)
+  catMaybes `liftM` mapM tryReadIface pairs
   where
     -- try to read an interface, warn if we can't
     tryReadIface (paths, file) = do
@@ -280,15 +286,6 @@ readInterfaceFiles name_cache_accessor pairs = do
         Right f -> return $ Just (paths, f)
 
 
-dumpInterfaceFile :: FilePath -> [InstalledInterface] -> LinkEnv -> IO ()
-dumpInterfaceFile path ifaces homeLinks = writeInterfaceFile path ifaceFile
-  where
-    ifaceFile = InterfaceFile {
-        ifInstalledIfaces = ifaces,
-        ifLinkEnv         = homeLinks
-      }
-
-
 -------------------------------------------------------------------------------
 -- * Creating a GHC session
 -------------------------------------------------------------------------------
diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index 4417dc52..64905a37 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -253,8 +253,9 @@ markupTag dflags = Markup {
   markupOrderedList          = box (TagL 'o'),
   markupDefList              = box (TagL 'u') . map (\(a,b) -> TagInline "i" a : Str " " : b),
   markupCodeBlock            = box TagPre,
-  markupURL                  = box (TagInline "a") . str,
+  markupHyperlink            = \(Hyperlink url mLabel) -> (box (TagInline "a") . str) (fromMaybe url mLabel),
   markupAName                = const $ str "",
+  markupProperty             = box TagPre . str,
   markupExample              = box TagPre . str . unlines . map exampleToString
   }
 
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index 6df9062e..5d0fabe9 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -1002,8 +1002,9 @@ parLatexMarkup ppId = Markup {
   markupOrderedList          = \p v -> enumeratedList (map ($v) p) $$ text "",
   markupDefList              = \l v -> descriptionList (map (\(a,b) -> (a v, b v)) l),
   markupCodeBlock            = \p _ -> quote (verb (p Verb)) $$ text "",
-  markupURL                  = \u _ -> text "\\url" <> braces (text u),
+  markupHyperlink            = \l _ -> markupLink l,
   markupAName                = \_ _ -> empty,
+  markupProperty             = \p _ -> quote $ verb $ text p,
   markupExample              = \e _ -> quote $ verb $ text $ unlines $ map exampleToString e
   }
   where
@@ -1011,6 +1012,10 @@ parLatexMarkup ppId = Markup {
     fixString Verb  s = s
     fixString Mono  s = latexMonoFilter s
 
+    markupLink (Hyperlink url mLabel) = case mLabel of
+      Just label -> text "\\href" <> braces (text url) <> braces (text label)
+      Nothing    -> text "\\url"  <> braces (text url)
+
     markupId ppId_ id v =
       case v of
         Verb  -> theid
diff --git a/src/Haddock/Backends/Xhtml/DocMarkup.hs b/src/Haddock/Backends/Xhtml/DocMarkup.hs
index 052116ee..aa4ba377 100644
--- a/src/Haddock/Backends/Xhtml/DocMarkup.hs
+++ b/src/Haddock/Backends/Xhtml/DocMarkup.hs
@@ -25,6 +25,7 @@ import Haddock.Types
 import Haddock.Utils
 
 import Text.XHtml hiding ( name, title, p, quote )
+import Data.Maybe (fromMaybe)
 
 import GHC
 
@@ -46,9 +47,10 @@ parHtmlMarkup qual ppId = Markup {
   markupOrderedList          = ordList,
   markupDefList              = defList,
   markupCodeBlock            = pre,
-  markupURL                  = \url -> anchor ! [href url] << url,
+  markupHyperlink            = \(Hyperlink url mLabel) -> anchor ! [href url] << fromMaybe url mLabel,
   markupAName                = \aname -> namedAnchor aname << "",
   markupPic                  = \path -> image ! [src path],
+  markupProperty             = pre . toHtml,
   markupExample              = examplesToHtml
   }
   where
diff --git a/src/Haddock/Interface.hs b/src/Haddock/Interface.hs
index e1e65d18..ea1f42e5 100644
--- a/src/Haddock/Interface.hs
+++ b/src/Haddock/Interface.hs
@@ -43,6 +43,7 @@ import Haddock.Utils
 import Control.Monad
 import Data.List
 import qualified Data.Map as Map
+import qualified Data.Set as Set
 import Distribution.Verbosity
 import System.Directory
 import System.FilePath
@@ -72,8 +73,12 @@ processModules verbosity modules flags extIfaces = do
                                    , iface <- ifInstalledIfaces ext ]
   interfaces <- createIfaces0 verbosity modules flags instIfaceMap
 
+  let exportedNames =
+        Set.unions $ map (Set.fromList . ifaceExports) $
+        filter (\i -> not $ OptHide `elem` ifaceOptions i) interfaces
+      mods = Set.fromList $ map ifaceMod interfaces
   out verbosity verbose "Attaching instances..."
-  interfaces' <- attachInstances interfaces instIfaceMap
+  interfaces' <- attachInstances (exportedNames, mods) interfaces instIfaceMap
 
   out verbosity verbose "Building cross-linking environment..."
   -- Combine the link envs of the external packages into one
diff --git a/src/Haddock/Interface/AttachInstances.hs b/src/Haddock/Interface/AttachInstances.hs
index 427ef84d..04c4e5e1 100644
--- a/src/Haddock/Interface/AttachInstances.hs
+++ b/src/Haddock/Interface/AttachInstances.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE CPP, MagicHash #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Haddock.Interface.AttachInstances
@@ -20,37 +20,42 @@ import Haddock.Convert
 import Control.Arrow
 import Data.List
 import qualified Data.Map as Map
+import qualified Data.Set as Set
 
-import GHC
-import Name
-import InstEnv
 import Class
+import FastString
+import GHC
 import GhcMonad (withSession)
-import TysPrim( funTyCon )
+import Id
+import InstEnv
 import MonadUtils (liftIO)
+import Name
+import PrelNames
 import TcRnDriver (tcRnGetInfo)
+import TyCon
 import TypeRep
+import TysPrim( funTyCon )
 import Var hiding (varName)
-import TyCon
-import PrelNames
-import FastString
 #define FSLIT(x) (mkFastString# (x#))
 
+type ExportedNames = Set.Set Name
+type Modules = Set.Set Module
+type ExportInfo = (ExportedNames, Modules)
 
-attachInstances :: [Interface] -> InstIfaceMap -> Ghc [Interface]
-attachInstances ifaces instIfaceMap = mapM attach ifaces
+attachInstances :: ExportInfo -> [Interface] -> InstIfaceMap -> Ghc [Interface]
+attachInstances expInfo ifaces instIfaceMap = mapM attach ifaces
   where
     -- TODO: take an IfaceMap as input
     ifaceMap = Map.fromList [ (ifaceMod i, i) | i <- ifaces ]
 
     attach iface = do
-      newItems <- mapM (attachToExportItem iface ifaceMap instIfaceMap)
+      newItems <- mapM (attachToExportItem expInfo iface ifaceMap instIfaceMap)
                        (ifaceExportItems iface)
       return $ iface { ifaceExportItems = newItems }
 
 
-attachToExportItem :: Interface -> IfaceMap -> InstIfaceMap -> ExportItem Name -> Ghc (ExportItem Name)
-attachToExportItem iface ifaceMap instIfaceMap export =
+attachToExportItem :: ExportInfo -> Interface -> IfaceMap -> InstIfaceMap -> ExportItem Name -> Ghc (ExportItem Name)
+attachToExportItem expInfo iface ifaceMap instIfaceMap export =
   case export of
     ExportDecl { expItemDecl = L _ (TyClD d) } -> do
       mb_info <- getAllInfo (tcdName d)
@@ -61,6 +66,11 @@ attachToExportItem iface ifaceMap instIfaceMap export =
                   Just (_, _, instances) ->
                     let insts = map (first synifyInstHead) $ sortImage (first instHead)
                                 [ (instanceSig i, getName i) | i <- instances ]
+{- FIXME
+                    let insts = map (first synifyInstHead) $ sortImage (first instHead) $
+                                filter (\((_,_,cls,tys),_) -> not $ isInstanceHidden expInfo cls tys)
+                                [ (instanceHead' i, getName i) | i <- instances ]
+-}
                     in [ (inst, lookupInstDoc name iface ifaceMap instIfaceMap)
                        | (inst, name) <- insts ]
                   Nothing -> []
@@ -89,6 +99,22 @@ lookupInstDoc name iface ifaceMap instIfaceMap =
     modName = nameModule name
 
 
+-- | Like GHC's 'instanceHead' but drops "silent" arguments.
+{- FIXME
+instanceHead' :: ClsInst -> ([TyVar], ThetaType, Class, [Type])
+instanceHead' ispec = (tvs, dropSilentArgs dfun theta, cls, tys)
+  where
+    dfun = is_dfun ispec
+    (tvs, theta, cls, tys) = instanceHead ispec
+-}
+
+
+-- | Drop "silent" arguments. See GHC Note [Silent superclass
+-- arguments].
+dropSilentArgs :: DFunId -> ThetaType -> ThetaType
+dropSilentArgs dfun theta = drop (dfunNSilent dfun) theta
+
+
 -- | Like GHC's getInfo but doesn't cut things out depending on the
 -- interative context, which we don't set sufficiently anyway.
 getAllInfo :: GhcMonad m => Name -> m (Maybe (TyThing,Fixity,[ClsInst]))
@@ -143,3 +169,42 @@ funTyConName = mkWiredInName gHC_PRIM
                         funTyConKey
                         (ATyCon funTyCon)       -- Relevant TyCon
                         BuiltInSyntax
+
+--------------------------------------------------------------------------------
+-- Filtering hidden instances
+--------------------------------------------------------------------------------
+
+-- | A class or data type is hidden iff
+--
+-- * it is defined in one of the modules that are being processed
+--
+-- * and it is not exported by any non-hidden module
+isNameHidden :: ExportInfo -> Name -> Bool
+isNameHidden (names, modules) name =
+  nameModule name `Set.member` modules &&
+  not (name `Set.member` names)
+
+-- | We say that an instance is «hidden» iff its class or any (part)
+-- of its type(s) is hidden.
+isInstanceHidden :: ExportInfo -> Class -> [Type] -> Bool
+isInstanceHidden expInfo cls tys =
+    instClassHidden || instTypeHidden
+  where
+    instClassHidden :: Bool
+    instClassHidden = isNameHidden expInfo $ getName cls
+
+    instTypeHidden :: Bool
+    instTypeHidden = any typeHidden tys
+
+    nameHidden :: Name -> Bool
+    nameHidden = isNameHidden expInfo
+
+    typeHidden :: Type -> Bool
+    typeHidden t =
+      case t of
+        TyVarTy {} -> False
+        AppTy t1 t2 -> typeHidden t1 || typeHidden t2
+        TyConApp tcon args -> nameHidden (getName tcon) || any typeHidden args
+        FunTy t1 t2 -> typeHidden t1 || typeHidden t2
+        ForAllTy _ ty -> typeHidden ty
+        LitTy _ -> False
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index 8f429d9c..40016a0b 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE TupleSections, BangPatterns #-}
+{-# OPTIONS_GHC -Wwarn #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Haddock.Interface.Create
@@ -40,7 +41,7 @@ import Name
 import Bag
 import RdrName
 import TcRnTypes
-import FastString (unpackFS)
+import FastString (unpackFS, concatFS)
 
 
 -- | Use a 'TypecheckedModule' to produce an 'Interface'.
@@ -89,8 +90,11 @@ createInterface tm flags modMap instIfaceMap = do
 
   liftErrMsg $ warnAboutFilteredDecls dflags mdl decls
 
-  let warningMap = mkWarningMap warnings gre exportedNames
-  exportItems <- mkExportItems modMap mdl warningMap gre exportedNames decls maps exports
+  warningMap <- liftErrMsg $ mkWarningMap dflags warnings gre exportedNames
+
+  let allWarnings = M.unions (warningMap : map ifaceWarningMap (M.elems modMap))
+
+  exportItems <- mkExportItems modMap mdl allWarnings gre exportedNames decls maps exports
                    instances instIfaceMap dflags
 
   let !visibleNames = mkVisibleNames exportItems opts
@@ -111,26 +115,29 @@ createInterface tm flags modMap instIfaceMap = do
   let !aliases =
         mkAliasMap dflags $ tm_renamed_source tm
 
+  modWarn <- liftErrMsg $ moduleWarning dflags gre warnings
+
   return $! Interface {
-    ifaceMod             = mdl,
-    ifaceOrigFilename    = msHsFilePath ms,
-    ifaceInfo            = info,
-    ifaceDoc             = Documentation mbDoc (moduleWarning warnings),
-    ifaceRnDoc           = Documentation Nothing Nothing,
-    ifaceOptions         = opts,
-    ifaceDocMap          = docMap,
-    ifaceArgMap          = argMap,
-    ifaceRnDocMap        = M.empty,
-    ifaceRnArgMap        = M.empty,
-    ifaceExportItems     = prunedExportItems,
-    ifaceRnExportItems   = [],
-    ifaceExports         = exportedNames,
-    ifaceVisibleExports  = visibleNames,
-    ifaceDeclMap         = declMap,
-    ifaceSubMap          = subMap,
-    ifaceModuleAliases   = aliases,
-    ifaceInstances       = instances,
-    ifaceHaddockCoverage = coverage
+    ifaceMod             = mdl
+  , ifaceOrigFilename    = msHsFilePath ms
+  , ifaceInfo            = info
+  , ifaceDoc             = Documentation mbDoc modWarn
+  , ifaceRnDoc           = Documentation Nothing Nothing
+  , ifaceOptions         = opts
+  , ifaceDocMap          = docMap
+  , ifaceArgMap          = argMap
+  , ifaceRnDocMap        = M.empty
+  , ifaceRnArgMap        = M.empty
+  , ifaceExportItems     = prunedExportItems
+  , ifaceRnExportItems   = []
+  , ifaceExports         = exportedNames
+  , ifaceVisibleExports  = visibleNames
+  , ifaceDeclMap         = declMap
+  , ifaceSubMap          = subMap
+  , ifaceModuleAliases   = aliases
+  , ifaceInstances       = instances
+  , ifaceHaddockCoverage = coverage
+  , ifaceWarningMap      = warningMap
   }
 
 mkAliasMap :: DynFlags -> Maybe RenamedSource -> M.Map Module ModuleName
@@ -166,31 +173,35 @@ lookupModuleDyn dflags Nothing mdlName =
 -- Warnings
 -------------------------------------------------------------------------------
 
-type WarningMap = DocMap Name
-
-mkWarningMap :: Warnings -> GlobalRdrEnv -> [Name] -> WarningMap
-mkWarningMap NoWarnings  _ _ = M.empty
-mkWarningMap (WarnAll _) _ _ = M.empty
-mkWarningMap (WarnSome ws) gre exps = M.fromList
-      [ (n, warnToDoc w) | (occ, w) <- ws, elt <- lookupGlobalRdrEnv gre occ
-      , let n = gre_name elt, n `elem` exps ]
+mkWarningMap :: DynFlags -> Warnings -> GlobalRdrEnv -> [Name] -> ErrMsgM WarningMap
+mkWarningMap dflags warnings gre exps = case warnings of
+  NoWarnings  -> return M.empty
+  WarnAll _   -> return M.empty
+  WarnSome ws -> do
+    let ws' = [ (n, w) | (occ, w) <- ws, elt <- lookupGlobalRdrEnv gre occ
+              , let n = gre_name elt, n `elem` exps ]
+    M.fromList <$> mapM parse ws'
+  where
+    parse (n, w) = (,) n <$> parseWarning dflags gre w
 
 
-moduleWarning :: Warnings -> Maybe (Doc id)
-moduleWarning ws =
+moduleWarning :: DynFlags -> GlobalRdrEnv -> Warnings -> ErrMsgM (Maybe (Doc Name))
+moduleWarning dflags gre ws =
   case ws of
-    NoWarnings -> Nothing
-    WarnSome _ -> Nothing
-    WarnAll w  -> Just $! warnToDoc w
-
-
-warnToDoc :: WarningTxt -> Doc id
-warnToDoc w = case w of
-  (DeprecatedTxt msg) -> format "Deprecated: " msg
-  (WarningTxt    msg) -> format "Warning: "    msg
+    NoWarnings -> return Nothing
+    WarnSome _ -> return Nothing
+    WarnAll w  -> Just <$> parseWarning dflags gre w
+
+parseWarning :: DynFlags -> GlobalRdrEnv -> WarningTxt -> ErrMsgM (Doc Name)
+parseWarning dflags gre w = do
+  r <- case w of
+    (DeprecatedTxt msg) -> format "Deprecated: " (concatFS msg)
+    (WarningTxt    msg) -> format "Warning: "    (concatFS msg)
+  r `deepseq` return r
   where
-    format x xs = let !str = force $ concat (x : map unpackFS xs)
-                  in DocWarning $ DocParagraph $ DocString str
+    format x xs = DocWarning . DocParagraph . DocAppend (DocString x)
+      .   fromMaybe (DocString . unpackFS $ xs)
+      <$> processDocString dflags gre (HsDocString xs)
 
 
 -------------------------------------------------------------------------------
@@ -703,6 +714,7 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap) decls =
         f (L l (SigD (GenericSig names t))) xs = foldr (\n acc -> L l (SigD (GenericSig [n] t)) : acc) xs names
         f x xs = x : xs
 
+    mkExportItem :: LHsDecl Name -> ErrMsgGhc (Maybe (ExportItem Name))
     mkExportItem (L _ (DocD (DocGroup lev docStr))) = do
       mbDoc <- liftErrMsg $ processDocString dflags gre docStr
       return $ fmap (ExportGroup lev "") mbDoc
@@ -777,7 +789,7 @@ extractRecSel nm mdl t tvs (L _ con : rest) =
   data_ty = foldl (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar t)) (map toTypeNoLoc tvs)
 
 
--- | Keep exprt items with docs.
+-- | Keep export items with docs.
 pruneExportItems :: [ExportItem Name] -> [ExportItem Name]
 pruneExportItems = filter hasDoc
   where
diff --git a/src/Haddock/Interface/LexParseRn.hs b/src/Haddock/Interface/LexParseRn.hs
index 8070b137..ced12d8d 100644
--- a/src/Haddock/Interface/LexParseRn.hs
+++ b/src/Haddock/Interface/LexParseRn.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -Wwarn #-}
 {-# LANGUAGE BangPatterns #-}
   -----------------------------------------------------------------------------
 -- |
@@ -117,9 +118,10 @@ rename dflags gre = rn
       DocCodeBlock doc -> DocCodeBlock (rn doc)
       DocIdentifierUnchecked x -> DocIdentifierUnchecked x
       DocModule str -> DocModule str
-      DocURL str -> DocURL str
+      DocHyperlink l -> DocHyperlink l
       DocPic str -> DocPic str
       DocAName str -> DocAName str
+      DocProperty p -> DocProperty p
       DocExamples e -> DocExamples e
       DocEmpty -> DocEmpty
       DocString str -> DocString str
diff --git a/src/Haddock/Interface/ParseModuleHeader.hs b/src/Haddock/Interface/ParseModuleHeader.hs
index 411b6661..18f4c768 100644
--- a/src/Haddock/Interface/ParseModuleHeader.hs
+++ b/src/Haddock/Interface/ParseModuleHeader.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -Wwarn #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Haddock.Interface.ParseModuleHeader
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index b384886c..a2499726 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -82,42 +82,41 @@ renameInterface dflags renamingEnv warnings iface =
 --------------------------------------------------------------------------------
 
 
-newtype GenRnM n a =
-  RnM { unRn :: (n -> (Bool, DocName))  -- name lookup function
-             -> (a,[n])
+newtype RnM a =
+  RnM { unRn :: (Name -> (Bool, DocName))  -- name lookup function
+             -> (a,[Name])
       }
 
-type RnM a = GenRnM Name a
-
-instance Monad (GenRnM n) where
+instance Monad RnM where
   (>>=) = thenRn
   return = returnRn
 
-instance Functor (GenRnM n) where
+instance Functor RnM where
   fmap f x = do a <- x; return (f a)
 
-instance Applicative (GenRnM n) where
+instance Applicative RnM where
   pure = return
   (<*>) = ap
 
-returnRn :: a -> GenRnM n a
+returnRn :: a -> RnM a
 returnRn a   = RnM (const (a,[]))
-thenRn :: GenRnM n a -> (a -> GenRnM n b) -> GenRnM n b
+thenRn :: RnM a -> (a -> RnM b) -> RnM b
 m `thenRn` k = RnM (\lkp -> case unRn m lkp of
   (a,out1) -> case unRn (k a) lkp of
     (b,out2) -> (b,out1++out2))
 
 getLookupRn :: RnM (Name -> (Bool, DocName))
 getLookupRn = RnM (\lkp -> (lkp,[]))
+
 outRn :: Name -> RnM ()
 outRn name = RnM (const ((),[name]))
 
-lookupRn :: (DocName -> a) -> Name -> RnM a
-lookupRn and_then name = do
+lookupRn :: Name -> RnM DocName
+lookupRn name = do
   lkp <- getLookupRn
   case lkp name of
-    (False,maps_to) -> do outRn name; return (and_then maps_to)
-    (True, maps_to) -> return (and_then maps_to)
+    (False,maps_to) -> do outRn name; return maps_to
+    (True, maps_to) -> return maps_to
 
 
 runRnFM :: LinkEnv -> RnM a -> (a,[Name])
@@ -134,7 +133,7 @@ runRnFM env rn = unRn rn lkp
 
 
 rename :: Name -> RnM DocName
-rename = lookupRn id
+rename = lookupRn
 
 
 renameL :: Located Name -> RnM (Located DocName)
@@ -199,9 +198,10 @@ renameDoc d = case d of
   DocCodeBlock doc -> do
     doc' <- renameDoc doc
     return (DocCodeBlock doc')
-  DocURL str -> return (DocURL str)
+  DocHyperlink l -> return (DocHyperlink l)
   DocPic str -> return (DocPic str)
   DocAName str -> return (DocAName str)
+  DocProperty p -> return (DocProperty p)
   DocExamples e -> return (DocExamples e)
 
 
@@ -270,8 +270,16 @@ renameType t = case t of
 
   HsTyLit x -> return (HsTyLit x)
 
-  _ -> error "renameType"
+  HsWrapTy a b            -> HsWrapTy a <$> renameType b
+  HsRecTy a               -> HsRecTy <$> mapM renameConDeclFieldField a
+  HsCoreTy a              -> pure (HsCoreTy a)
+  HsExplicitListTy  a b   -> HsExplicitListTy  a <$> mapM renameLType b
+  HsExplicitTupleTy a b   -> HsExplicitTupleTy a <$> mapM renameLType b
+  HsQuasiQuoteTy a        -> HsQuasiQuoteTy <$> renameHsQuasiQuote a
+  HsSpliceTy _ _ _        -> error "renameType: HsSpliceTy"
 
+renameHsQuasiQuote :: HsQuasiQuote Name -> RnM (HsQuasiQuote DocName)
+renameHsQuasiQuote (HsQuasiQuote a b c) = HsQuasiQuote <$> rename a <*> pure b <*> pure c
 
 renameLTyVarBndrs :: LHsTyVarBndrs Name -> RnM (LHsTyVarBndrs DocName)
 renameLTyVarBndrs (HsQTvs { hsq_kvs = _, hsq_tvs = tvs })
@@ -402,22 +410,25 @@ renameCon decl@(ConDecl { con_name = lname, con_qvars = ltyvars
       return (decl { con_name = lname', con_qvars = ltyvars', con_cxt = lcontext'
                    , con_details = details', con_res = restype', con_doc = mbldoc' })
   where
-    renameDetails (RecCon fields) = return . RecCon =<< mapM renameField fields
+    renameDetails (RecCon fields) = return . RecCon =<< mapM renameConDeclFieldField fields
     renameDetails (PrefixCon ps) = return . PrefixCon =<< mapM renameLType ps
     renameDetails (InfixCon a b) = do
       a' <- renameLType a
       b' <- renameLType b
       return (InfixCon a' b')
 
-    renameField (ConDeclField name t doc) = do
-      name' <- renameL name
-      t'   <- renameLType t
-      doc' <- mapM renameLDocHsSyn doc
-      return (ConDeclField name' t' doc')
-
     renameResType (ResTyH98) = return ResTyH98
     renameResType (ResTyGADT t) = return . ResTyGADT =<< renameLType t
 
+
+renameConDeclFieldField :: ConDeclField Name -> RnM (ConDeclField DocName)
+renameConDeclFieldField (ConDeclField name t doc) = do
+  name' <- renameL name
+  t'   <- renameLType t
+  doc' <- mapM renameLDocHsSyn doc
+  return (ConDeclField name' t' doc')
+
+
 renameSig :: Sig Name -> RnM (Sig DocName)
 renameSig sig = case sig of
   TypeSig lnames ltype -> do
@@ -498,8 +509,8 @@ renameExportItem item = case item of
       return (inst', idoc')
     return (ExportDecl decl' doc' subs' instances')
   ExportNoDecl x subs -> do
-    x'    <- lookupRn id x
-    subs' <- mapM (lookupRn id) subs
+    x'    <- lookupRn x
+    subs' <- mapM lookupRn subs
     return (ExportNoDecl x' subs')
   ExportDoc doc -> do
     doc' <- renameDoc doc
diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs
index a07b1b03..ec7272e7 100644
--- a/src/Haddock/InterfaceFile.hs
+++ b/src/Haddock/InterfaceFile.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 -----------------------------------------------------------------------------
 -- |
@@ -61,9 +61,18 @@ binaryInterfaceMagic :: Word32
 binaryInterfaceMagic = 0xD0Cface
 
 
--- Since datatypes in the GHC API might change between major versions, and
--- because we store GHC datatypes in our interface files, we need to make sure
--- we version our interface files accordingly.
+-- IMPORTANT: Since datatypes in the GHC API might change between major
+-- versions, and because we store GHC datatypes in our interface files, we need
+-- to make sure we version our interface files accordingly.
+--
+-- If you change the interface file format or adapt Haddock to work with a new
+-- major version of GHC (so that the format changes indirectly) *you* need to
+-- follow these steps:
+--
+-- (1) increase `binaryInterfaceVersion`
+--
+-- (2) set `binaryInterfaceVersionCompatibility` to [binaryInterfaceVersion]
+--
 binaryInterfaceVersion :: Word16
 #if __GLASGOW_HASKELL__ == 702
 binaryInterfaceVersion = 20
@@ -76,9 +85,12 @@ binaryInterfaceVersion = 20
 #elif __GLASGOW_HASKELL__ == 706
 binaryInterfaceVersion = 20
 #elif __GLASGOW_HASKELL__ == 707
-binaryInterfaceVersion = 20
+binaryInterfaceVersion = 22
+
+binaryInterfaceVersionCompatibility :: [Word16]
+binaryInterfaceVersionCompatibility = [21, 22]
 #else
-#error Unknown GHC version
+#error Unsupported GHC version
 #endif
 
 
@@ -189,7 +201,7 @@ readInterfaceFile (get_name_cache, set_name_cache) filename = do
   case () of
     _ | magic /= binaryInterfaceMagic -> return . Left $
       "Magic number mismatch: couldn't load interface file: " ++ filename
-      | version /= binaryInterfaceVersion -> return . Left $
+      | version `notElem` binaryInterfaceVersionCompatibility -> return . Left $
       "Interface file is of wrong version: " ++ filename
       | otherwise -> with_name_cache $ \update_nc -> do
 
@@ -417,6 +429,15 @@ instance Binary Example where
         result <- get bh
         return (Example expression result)
 
+instance Binary Hyperlink where
+    put_ bh (Hyperlink url label) = do
+        put_ bh url
+        put_ bh label
+    get bh = do
+        url <- get bh
+        label <- get bh
+        return (Hyperlink url label)
+
 
 {-* Generated by DrIFT : Look, but Don't Touch. *-}
 instance (Binary id) => Binary (Doc id) where
@@ -456,7 +477,7 @@ instance (Binary id) => Binary (Doc id) where
     put_ bh (DocCodeBlock al) = do
             putByte bh 11
             put_ bh al
-    put_ bh (DocURL am) = do
+    put_ bh (DocHyperlink am) = do
             putByte bh 12
             put_ bh am
     put_ bh (DocPic x) = do
@@ -474,6 +495,9 @@ instance (Binary id) => Binary (Doc id) where
     put_ bh (DocWarning ag) = do
             putByte bh 17
             put_ bh ag
+    put_ bh (DocProperty x) = do
+            putByte bh 18
+            put_ bh x
     get bh = do
             h <- getByte bh
             case h of
@@ -515,7 +539,7 @@ instance (Binary id) => Binary (Doc id) where
                     return (DocCodeBlock al)
               12 -> do
                     am <- get bh
-                    return (DocURL am)
+                    return (DocHyperlink am)
               13 -> do
                     x <- get bh
                     return (DocPic x)
@@ -531,6 +555,9 @@ instance (Binary id) => Binary (Doc id) where
               17 -> do
                     ag <- get bh
                     return (DocWarning ag)
+              18 -> do
+                    x <- get bh
+                    return (DocProperty x)
               _ -> fail "invalid binary data found"
 
 
diff --git a/src/Haddock/Lex.x b/src/Haddock/Lex.x
index b9ebe688..0d8dd954 100644
--- a/src/Haddock/Lex.x
+++ b/src/Haddock/Lex.x
@@ -50,6 +50,7 @@ $ident    = [$alphanum \'\_\.\!\#\$\%\&\*\+\/\<\=\>\?\@\\\\\^\|\-\~\:]
 <0,para> {
  $ws* \n		;
  $ws* \>		{ begin birdtrack }
+ $ws* prop \> .* \n	{ strtoken TokProperty `andBegin` property}
  $ws* \>\>\>            { strtoken TokExamplePrompt `andBegin` exampleexpr }
  $ws* [\*\-]		{ token TokBullet `andBegin` string }
  $ws* \[		{ token TokDefStart `andBegin` def }
@@ -74,6 +75,8 @@ $ident    = [$alphanum \'\_\.\!\#\$\%\&\*\+\/\<\=\>\?\@\\\\\^\|\-\~\:]
 
 <birdtrack> .*	\n?	{ strtokenNL TokBirdTrack `andBegin` line }
 
+<property> ()           { token TokPara `andBegin` para }
+
 <example> {
   $ws*	\n		{ token TokPara `andBegin` para }
   $ws* \>\>\>	        { strtoken TokExamplePrompt `andBegin` exampleexpr }
@@ -129,6 +132,7 @@ data Token
   | TokEmphasis String
   | TokAName String
   | TokBirdTrack String
+  | TokProperty String
   | TokExamplePrompt String
   | TokExampleExpression String
   | TokExampleResult String
diff --git a/src/Haddock/Parse.y b/src/Haddock/Parse.y
index e36e8416..f40ff521 100644
--- a/src/Haddock/Parse.y
+++ b/src/Haddock/Parse.y
@@ -7,10 +7,10 @@
 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
 -- for details
 
-module Haddock.Parse where
+module Haddock.Parse (parseString, parseParas) where
 
 import Haddock.Lex
-import Haddock.Types (Doc(..), Example(Example))
+import Haddock.Types (Doc(..), Example(Example), Hyperlink(..))
 import Haddock.Doc
 import HsSyn
 import RdrName
@@ -35,6 +35,7 @@ import Data.List  (stripPrefix)
 	'-'	{ (TokBullet,_) }
 	'(n)'	{ (TokNumber,_) }
 	'>..'	{ (TokBirdTrack $$,_) }
+	PROP	{ (TokProperty $$,_) }
 	PROMPT	{ (TokExamplePrompt $$,_) }
 	RESULT	{ (TokExampleResult $$,_) }
 	EXP	{ (TokExampleExpression $$,_) }
@@ -73,12 +74,16 @@ defpara :: { (Doc RdrName, Doc RdrName) }
 para    :: { Doc RdrName }
 	: seq			{ docParagraph $1 }
 	| codepara		{ DocCodeBlock $1 }
+	| property		{ $1 }
 	| examples		{ DocExamples $1 }
 
 codepara :: { Doc RdrName }
 	: '>..' codepara	{ docAppend (DocString $1) $2 }
 	| '>..'			{ DocString $1 }
 
+property :: { Doc RdrName }
+	: PROP			{ makeProperty $1 }
+
 examples :: { [Example] }
 	: example examples	{ $1 : $2 }
 	| example		{ [$1] }
@@ -107,7 +112,7 @@ seq1	:: { Doc RdrName }
 elem1	:: { Doc RdrName }
 	: STRING		{ DocString $1 }
 	| '/../'                { DocEmphasis (DocString $1) }
-	| URL			{ DocURL $1 }
+	| URL			{ DocHyperlink (makeHyperlink $1) }
 	| PIC                   { DocPic $1 }
 	| ANAME			{ DocAName $1 }
 	| IDENT			{ DocIdentifier $1 }
@@ -121,6 +126,22 @@ strings  :: { String }
 happyError :: [LToken] -> Maybe a
 happyError toks = Nothing
 
+-- | Create a `Hyperlink` from given string.
+--
+-- A hyperlink consists of a URL and an optional label.  The label is separated
+-- from the url by one or more whitespace characters.
+makeHyperlink :: String -> Hyperlink
+makeHyperlink input = case break isSpace $ strip input of
+  (url, "")    -> Hyperlink url Nothing
+  (url, label) -> Hyperlink url (Just . dropWhile isSpace $ label)
+
+makeProperty :: String -> Doc RdrName
+makeProperty s = case strip s of
+  'p':'r':'o':'p':'>':xs ->
+	DocProperty (dropWhile isSpace xs)
+  xs ->
+	error $ "makeProperty: invalid input " ++ show xs
+
 -- | Create an 'Example', stripping superfluous characters as appropriate
 makeExample :: String -> String -> [String] -> Example
 makeExample prompt expression result =
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index 8ea5b930..181ea026 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -1,5 +1,5 @@
-{-# OPTIONS_HADDOCK hide #-}
 {-# LANGUAGE DeriveDataTypeable, DeriveFunctor #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Haddock.Types
@@ -22,6 +22,7 @@ module Haddock.Types (
 
 import Control.Exception
 import Control.Arrow
+import Control.DeepSeq
 import Data.Typeable
 import Data.Map (Map)
 import Data.Maybe
@@ -113,8 +114,13 @@ data Interface = Interface
     -- | The number of haddockable and haddocked items in the module, as a
     -- tuple. Haddockable items are the exports and the module itself.
   , ifaceHaddockCoverage :: !(Int, Int)
+
+    -- | Warnings for things defined in this module.
+  , ifaceWarningMap :: !WarningMap
   }
 
+type WarningMap = DocMap Name
+
 
 -- | A subset of the fields of 'Interface' that we store in the interface
 -- files.
@@ -303,9 +309,10 @@ data Doc id
   | DocOrderedList [Doc id]
   | DocDefList [(Doc id, Doc id)]
   | DocCodeBlock (Doc id)
-  | DocURL String
+  | DocHyperlink Hyperlink
   | DocPic String
   | DocAName String
+  | DocProperty String
   | DocExamples [Example]
   deriving (Functor)
 
@@ -315,12 +322,54 @@ instance Monoid (Doc id) where
   mappend = DocAppend
 
 
+instance NFData a => NFData (Doc a) where
+  rnf doc = case doc of
+    DocEmpty                  -> ()
+    DocAppend a b             -> a `deepseq` b `deepseq` ()
+    DocString a               -> a `deepseq` ()
+    DocParagraph a            -> a `deepseq` ()
+    DocIdentifier a           -> a `deepseq` ()
+    DocIdentifierUnchecked a  -> a `deepseq` ()
+    DocModule a               -> a `deepseq` ()
+    DocWarning a              -> a `deepseq` ()
+    DocEmphasis a             -> a `deepseq` ()
+    DocMonospaced a           -> a `deepseq` ()
+    DocUnorderedList a        -> a `deepseq` ()
+    DocOrderedList a          -> a `deepseq` ()
+    DocDefList a              -> a `deepseq` ()
+    DocCodeBlock a            -> a `deepseq` ()
+    DocHyperlink a            -> a `deepseq` ()
+    DocPic a                  -> a `deepseq` ()
+    DocAName a                -> a `deepseq` ()
+    DocProperty a             -> a `deepseq` ()
+    DocExamples a             -> a `deepseq` ()
+
+
+instance NFData Name
+instance NFData OccName
+instance NFData ModuleName
+
+
+data Hyperlink = Hyperlink
+  { hyperlinkUrl   :: String
+  , hyperlinkLabel :: Maybe String
+  } deriving (Eq, Show)
+
+
+instance NFData Hyperlink where
+  rnf (Hyperlink a b) = a `deepseq` b `deepseq` ()
+
+
 data Example = Example
   { exampleExpression :: String
   , exampleResult     :: [String]
   } deriving (Eq, Show)
 
 
+instance NFData Example where
+  rnf (Example a b) = a `deepseq` b `deepseq` ()
+
+
 exampleToString :: Example -> String
 exampleToString (Example expression result) =
     ">>> " ++ expression ++ "\n" ++  unlines result
@@ -341,9 +390,10 @@ data DocMarkup id a = Markup
   , markupOrderedList          :: [a] -> a
   , markupDefList              :: [(a,a)] -> a
   , markupCodeBlock            :: a -> a
-  , markupURL                  :: String -> a
+  , markupHyperlink            :: Hyperlink -> a
   , markupAName                :: String -> a
   , markupPic                  :: String -> a
+  , markupProperty             :: String -> a
   , markupExample              :: [Example] -> a
   }
 
diff --git a/src/Haddock/Utils.hs b/src/Haddock/Utils.hs
index 20f45c95..e0b86350 100644
--- a/src/Haddock/Utils.hs
+++ b/src/Haddock/Utils.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Haddock.Utils
@@ -426,9 +427,10 @@ markup m (DocUnorderedList ds)       = markupUnorderedList m (map (markup m) ds)
 markup m (DocOrderedList ds)         = markupOrderedList m (map (markup m) ds)
 markup m (DocDefList ds)             = markupDefList m (map (markupPair m) ds)
 markup m (DocCodeBlock d)            = markupCodeBlock m (markup m d)
-markup m (DocURL url)                = markupURL m url
+markup m (DocHyperlink l)            = markupHyperlink m l
 markup m (DocAName ref)              = markupAName m ref
 markup m (DocPic img)                = markupPic m img
+markup m (DocProperty p)             = markupProperty m p
 markup m (DocExamples e)             = markupExample m e
 
 
@@ -453,9 +455,10 @@ idMarkup = Markup {
   markupOrderedList          = DocOrderedList,
   markupDefList              = DocDefList,
   markupCodeBlock            = DocCodeBlock,
-  markupURL                  = DocURL,
+  markupHyperlink            = DocHyperlink,
   markupAName                = DocAName,
   markupPic                  = DocPic,
+  markupProperty             = DocProperty,
   markupExample              = DocExamples
   }