Merge pull request #1 from haskell/ghc-head

Ghc head

17 files changed, 1452 insertions, 400 deletions

diff --git a/haddock-api/src/Haddock/Backends/HaddockDB.hs b/haddock-api/src/Haddock/Backends/HaddockDB.hs
index 1c248bfb..0bdc9057 100644
--- a/haddock-api/src/Haddock/Backends/HaddockDB.hs
+++ b/haddock-api/src/Haddock/Backends/HaddockDB.hs
@@ -40,7 +40,7 @@ ppIfaces mods
   where
      do_mod (Module mod, iface)
         =  text "<sect1 id=\"sec-" <> text mod <> text "\">"
-        $$ text "<title><literal>" 
+        $$ text "<title><literal>"
 	   <> text mod
 	   <> text "</literal></title>"
 	$$ text "<indexterm><primary><literal>"
@@ -50,10 +50,10 @@ ppIfaces mods
 	$$ vcat (map (do_export mod) (eltsFM (iface_decls iface)))
 	$$ text "</variablelist>"
 	$$ text "</sect1>"
- 
+
      do_export mod decl | (nm:_) <- declBinders decl
 	=  text "<varlistentry id=" <> ppLinkId mod nm <> char '>'
-	$$ text "<term><literal>" 
+	$$ text "<term><literal>"
 		<> do_decl decl
 		<> text "</literal></term>"
 	$$ text "<listitem>"
@@ -63,11 +63,11 @@ ppIfaces mods
 	$$ text "</varlistentry>"
      do_export _ _ = empty
 
-     do_decl (HsTypeSig _ [nm] ty _) 
+     do_decl (HsTypeSig _ [nm] ty _)
 	=  ppHsName nm <> text " :: " <> ppHsType ty
      do_decl (HsTypeDecl _ nm args ty _)
 	=  hsep ([text "type", ppHsName nm ]
-		 ++ map ppHsName args 
+		 ++ map ppHsName args
 		 ++ [equals, ppHsType ty])
      do_decl (HsNewTypeDecl loc ctx nm args con drv _)
 	= hsep ([text "data", ppHsName nm] -- data, not newtype
@@ -87,7 +87,7 @@ ppHsConstr :: HsConDecl -> Doc
 ppHsConstr (HsRecDecl pos name tvs ctxt fieldList maybe_doc) =
 	 ppHsName name
 	 <> (braces . hsep . punctuate comma . map ppField $ fieldList)
-ppHsConstr (HsConDecl pos name tvs ctxt typeList maybe_doc) = 
+ppHsConstr (HsConDecl pos name tvs ctxt typeList maybe_doc) =
 	 hsep (ppHsName name : map ppHsBangType typeList)
 
 ppField (HsFieldDecl ns ty doc)
@@ -100,7 +100,7 @@ ppHsBangType (HsUnBangedTy ty) = ppHsType ty
 
 ppHsContext :: HsContext -> Doc
 ppHsContext []      = empty
-ppHsContext context = parenList (map (\ (a,b) -> ppHsQName a <+> 
+ppHsContext context = parenList (map (\ (a,b) -> ppHsQName a <+>
 					 hsep (map ppHsAType b)) context)
 
 ppHsType :: HsType -> Doc
@@ -109,7 +109,7 @@ ppHsType (HsForAllType Nothing context htype) =
 ppHsType (HsForAllType (Just tvs) [] htype) =
      hsep (text "forall" : map ppHsName tvs ++ text "." : [ppHsType htype])
 ppHsType (HsForAllType (Just tvs) context htype) =
-     hsep (text "forall" : map ppHsName tvs ++ text "." : 
+     hsep (text "forall" : map ppHsName tvs ++ text "." :
 	   ppHsContext context : text "=>" : [ppHsType htype])
 ppHsType (HsTyFun a b) = fsep [ppHsBType a, text "-&gt;", ppHsType b]
 ppHsType (HsTyIP n t)  = fsep [(char '?' <> ppHsName n), text "::", ppHsType t]
@@ -135,7 +135,7 @@ ppHsQName (UnQual str)			= ppHsName str
 ppHsQName n@(Qual (Module mod) str)
 	 | n == unit_con_name		= ppHsName str
 	 | isSpecial str 		= ppHsName str
-	 | otherwise 
+	 | otherwise
 		=  text "<link linkend=" <> ppLinkId mod str <> char '>'
 		<> ppHsName str
 		<> text "</link>"
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index fe656a4b..a9bc9a8b 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -15,12 +15,15 @@ module Haddock.Backends.Hoogle (
     ppHoogle
   ) where
 
-
+import BasicTypes (OverlapFlag(..), OverlapMode(..))
+import InstEnv (ClsInst(..))
 import Haddock.GhcUtils
 import Haddock.Types hiding (Version)
 import Haddock.Utils hiding (out)
+
 import GHC
 import Outputable
+import NameSet
 
 import Data.Char
 import Data.List
@@ -64,7 +67,8 @@ dropHsDocTy :: HsType a -> HsType a
 dropHsDocTy = f
     where
         g (L src x) = L src (f x)
-        f (HsForAllTy a b c d e) = HsForAllTy a b c d (g e)
+        f (HsForAllTy a e) = HsForAllTy a (g e)
+        f (HsQualTy a e) = HsQualTy a (g e)
         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)
@@ -81,32 +85,28 @@ outHsType :: OutputableBndr a => DynFlags -> HsType a -> String
 outHsType dflags = out dflags . dropHsDocTy
 
 
-makeExplicit :: HsType a -> HsType a
-makeExplicit (HsForAllTy _ a b c d) = HsForAllTy Explicit a b c d
-makeExplicit x = x
-
-makeExplicitL :: LHsType a -> LHsType a
-makeExplicitL (L src x) = L src (makeExplicit x)
-
-
 dropComment :: String -> String
 dropComment (' ':'-':'-':' ':_) = []
 dropComment (x:xs) = x : dropComment xs
 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
@@ -115,49 +115,84 @@ ppExport :: DynFlags -> ExportItem Name -> [String]
 ppExport dflags ExportDecl { expItemDecl    = L _ decl
                            , expItemMbDoc   = (dc, _)
                            , expItemSubDocs = subdocs
+                           , expItemFixities = fixities
                            } = ppDocumentation dflags dc ++ f decl
     where
         f (TyClD d@DataDecl{})  = ppData dflags d subdocs
         f (TyClD d@SynDecl{})   = ppSynonym dflags d
-        f (TyClD d@ClassDecl{}) = ppClass dflags d
-        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 (TyClD d@ClassDecl{}) = ppClass dflags d subdocs
+        f (ForD (ForeignImport name typ _ _)) = [pp_sig dflags [name] (hsSigType typ)]
+        f (ForD (ForeignExport name typ _ _)) = [pp_sig dflags [name] (hsSigType typ)]
+        f (SigD sig) = ppSig dflags sig ++ ppFixities
         f _ = []
+
+        ppFixities = concatMap (ppFixity dflags) fixities
 ppExport _ _ = []
 
+ppSigWithDoc :: DynFlags -> Sig Name -> [(Name, DocForDecl Name)] -> [String]
+ppSigWithDoc dflags (TypeSig names sig) subdocs
+    = concatMap mkDocSig names
+    where
+        mkDocSig n = concatMap (ppDocumentation dflags) (getDoc n)
+                     ++ [pp_sig dflags names (hsSigWcType sig)]
+
+        getDoc :: Located Name -> [Documentation Name]
+        getDoc n = maybe [] (return . fst) (lookup (unL n) subdocs)
+
+ppSigWithDoc _ _ _ = []
 
 ppSig :: DynFlags -> Sig Name -> [String]
-ppSig dflags (TypeSig names sig _)
-    = [operator prettyNames ++ " :: " ++ outHsType dflags typ]
-    where
-        prettyNames = intercalate ", " $ map (out dflags) names
-        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 _ _ = []
+ppSig dflags x  = ppSigWithDoc dflags x []
 
+pp_sig :: DynFlags -> [Located Name] -> LHsType Name -> String
+pp_sig dflags names (L _ typ)  =
+    operator prettyNames ++ " :: " ++ outHsType dflags typ
+    where
+      prettyNames = intercalate ", " $ map (out dflags) names
 
 -- 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 decl subdocs = (out dflags decl{tcdSigs=[]} ++ ppTyFams) :  ppMethods
     where
-        addContext (TypeSig name (L l sig) nwcs) = TypeSig name (L l $ f sig) nwcs
-        addContext (MinimalSig src sig) = MinimalSig src sig
-        addContext _ = error "expected TypeSig"
 
-        f (HsForAllTy a b c con d) = HsForAllTy a b c (reL (context : unLoc con)) d
-        f t = HsForAllTy Implicit Nothing emptyHsQTvs (reL [context]) (reL t)
+        ppMethods = concat . map (ppSig' . unLoc . add_ctxt) $ tcdSigs decl
+        ppSig' = flip (ppSigWithDoc dflags) subdocs
 
-        context = nlHsTyConApp (tcdName x)
-            (map (reL . HsTyVar . hsTyVarName . unL) (hsQTvBndrs (tyClDeclTyVars x)))
+        add_ctxt = addClassContext (tcdName decl) (tyClDeclTyVars decl)
 
+        ppTyFams
+            | null $ tcdATs decl = ""
+            | otherwise = (" " ++) . showSDocUnqual dflags . whereWrapper $ concat
+                [ map ppr (tcdATs decl)
+                , map (ppr . tyFamEqnToSyn . unLoc) (tcdATDefs decl)
+                ]
+
+        whereWrapper elems = vcat'
+            [ text "where" <+> lbrace
+            , nest 4 . vcat . map (<> semi) $ elems
+            , rbrace
+            ]
+
+        tyFamEqnToSyn :: TyFamDefltEqn Name -> TyClDecl Name
+        tyFamEqnToSyn tfe = SynDecl
+            { tcdLName = tfe_tycon tfe
+            , tcdTyVars = tfe_pats tfe
+            , tcdRhs = tfe_rhs tfe
+            , tcdFVs = emptyNameSet
+            }
 
-ppInstance :: DynFlags -> ClsInst -> [String]
-ppInstance dflags x = [dropComment $ out dflags x]
 
+ppInstance :: DynFlags -> ClsInst -> [String]
+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]
@@ -184,26 +219,40 @@ lookupCon dflags subdocs (L _ name) = case lookup name subdocs of
   _ -> []
 
 ppCtor :: DynFlags -> TyClDecl Name -> [(Name, DocForDecl Name)] -> ConDecl Name -> [String]
-ppCtor dflags dat subdocs con
-   = concatMap (lookupCon dflags subdocs) (con_names con) ++ f (con_details con)
+ppCtor dflags dat subdocs con@ConDeclH98 {}
+  -- AZ:TODO get rid of the concatMap
+   = concatMap (lookupCon dflags subdocs) [con_name con] ++ f (getConDetails con)
     where
         f (PrefixCon args) = [typeSig name $ args ++ [resType]]
         f (InfixCon a1 a2) = f $ PrefixCon [a1,a2]
         f (RecCon (L _ recs)) = f (PrefixCon $ map cd_fld_type (map unLoc recs)) ++ concat
-                          [(concatMap (lookupCon dflags subdocs) (cd_fld_names r)) ++
-                           [out dflags (map unL $ cd_fld_names r) `typeSig` [resType, cd_fld_type r]]
+                          [(concatMap (lookupCon dflags subdocs . noLoc . selectorFieldOcc . unLoc) (cd_fld_names r)) ++
+                           [out dflags (map (selectorFieldOcc . unLoc) $ cd_fld_names r) `typeSig` [resType, cd_fld_type r]]
                           | r <- map unLoc recs]
 
-        funs = foldr1 (\x y -> reL $ HsFunTy (makeExplicitL x) (makeExplicitL y))
+        funs = foldr1 (\x y -> reL $ HsFunTy x y)
         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
+        typeSig nm flds = operator nm ++ " :: " ++ outHsType dflags (unL $ funs flds)
+
+        -- 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 $ getConNames con
+
+        resType = apps $ map (reL . HsTyVar . reL) $
+                        (tcdName dat) : [hsTyVarName v | L _ v@(UserTyVar _) <- hsQTvExplicit $ tyClDeclTyVars dat]
+
+ppCtor dflags _dat subdocs con@ConDeclGADT {}
+   = concatMap (lookupCon dflags subdocs) (getConNames con) ++ f
+    where
+        f = [typeSig name (hsib_body $ con_type con)]
+
+        typeSig nm ty = operator nm ++ " :: " ++ outHsType dflags (unL ty)
+        name = out dflags $ map unL $ getConNames con
 
-        resType = case con_res con of
-            ResTyH98 -> apps $ map (reL . HsTyVar) $
-                        (tcdName dat) : [hsTyVarName v | L _ v@(UserTyVar _) <- hsQTvBndrs $ tyClDeclTyVars dat]
-            ResTyGADT _ x -> x
+
+ppFixity :: DynFlags -> (Name, Fixity) -> [String]
+ppFixity dflags (name, fixity) = [out dflags (FixitySig [noLoc name] fixity)]
 
 
 ---------------------------------------------------------------------
@@ -334,3 +383,8 @@ escape = concatMap f
         f '>' = "&gt;"
         f '&' = "&amp;"
         f x = [x]
+
+
+-- | Just like 'vcat' but uses '($+$)' instead of '($$)'.
+vcat' :: [SDoc] -> SDoc
+vcat' = foldr ($+$) empty
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
new file mode 100644
index 00000000..248a8a54
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
@@ -0,0 +1,64 @@
+module Haddock.Backends.Hyperlinker
+    ( ppHyperlinkedSource
+    , module Haddock.Backends.Hyperlinker.Types
+    , module Haddock.Backends.Hyperlinker.Utils
+    ) where
+
+
+import Haddock.Types
+import Haddock.Backends.Hyperlinker.Renderer
+import Haddock.Backends.Hyperlinker.Types
+import Haddock.Backends.Hyperlinker.Utils
+
+import Text.XHtml hiding ((</>))
+
+import Data.Maybe
+import System.Directory
+import System.FilePath
+
+
+-- | Generate hyperlinked source for given interfaces.
+--
+-- Note that list of interfaces should also contain interfaces normally hidden
+-- when generating documentation. Otherwise this could lead to dead links in
+-- produced source.
+ppHyperlinkedSource :: FilePath -- ^ Output directory
+                    -> FilePath -- ^ Resource directory
+                    -> Maybe FilePath -- ^ Custom CSS file path
+                    -> Bool -- ^ Flag indicating whether to pretty-print HTML
+                    -> SrcMap -- ^ Paths to sources
+                    -> [Interface] -- ^ Interfaces for which we create source
+                    -> IO ()
+ppHyperlinkedSource outdir libdir mstyle pretty srcs ifaces = do
+    createDirectoryIfMissing True srcdir
+    let cssFile = fromMaybe (defaultCssFile libdir) mstyle
+    copyFile cssFile $ srcdir </> srcCssFile
+    copyFile (libdir </> "html" </> highlightScript) $
+        srcdir </> highlightScript
+    mapM_ (ppHyperlinkedModuleSource srcdir pretty srcs) ifaces
+  where
+    srcdir = outdir </> hypSrcDir
+
+-- | Generate hyperlinked source for particular interface.
+ppHyperlinkedModuleSource :: FilePath -> Bool -> SrcMap -> Interface
+                          -> IO ()
+ppHyperlinkedModuleSource srcdir pretty srcs iface =
+    case ifaceTokenizedSrc iface of
+        Just tokens -> writeFile path . html . render' $ tokens
+        Nothing -> return ()
+  where
+    render' = render (Just srcCssFile) (Just highlightScript) srcs
+    html = if pretty then renderHtml else showHtml
+    path = srcdir </> hypSrcModuleFile (ifaceMod iface)
+
+-- | Name of CSS file in output directory.
+srcCssFile :: FilePath
+srcCssFile = "style.css"
+
+-- | Name of highlight script in output and resource directory.
+highlightScript :: FilePath
+highlightScript = "highlight.js"
+
+-- | Path to default CSS file.
+defaultCssFile :: FilePath -> FilePath
+defaultCssFile libdir = libdir </> "html" </> "solarized.css"
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
new file mode 100644
index 00000000..e8baae88
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -0,0 +1,185 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeFamilies #-}
+
+
+module Haddock.Backends.Hyperlinker.Ast (enrich) where
+
+
+import Haddock.Syb
+import Haddock.Backends.Hyperlinker.Types
+
+import qualified GHC
+
+import Control.Applicative
+import Data.Data
+import Data.Maybe
+
+
+-- | Add more detailed information to token stream using GHC API.
+enrich :: GHC.RenamedSource -> [Token] -> [RichToken]
+enrich src =
+    map $ \token -> RichToken
+        { rtkToken = token
+        , rtkDetails = enrichToken token detailsMap
+        }
+  where
+    detailsMap = concatMap ($ src)
+        [ variables
+        , types
+        , decls
+        , binds
+        , imports
+        ]
+
+-- | A map containing association between source locations and "details" of
+-- this location.
+--
+-- For the time being, it is just a list of pairs. However, looking up things
+-- in such structure has linear complexity. We cannot use any hashmap-like
+-- stuff because source locations are not ordered. In the future, this should
+-- be replaced with interval tree data structure.
+type DetailsMap = [(GHC.SrcSpan, TokenDetails)]
+
+lookupBySpan :: Span -> DetailsMap -> Maybe TokenDetails
+lookupBySpan tspan = listToMaybe . map snd . filter (matches tspan . fst)
+
+enrichToken :: Token -> DetailsMap -> Maybe TokenDetails
+enrichToken (Token typ _ spn) dm
+    | typ `elem` [TkIdentifier, TkOperator] = lookupBySpan spn dm
+enrichToken _ _ = Nothing
+
+-- | Obtain details map for variables ("normally" used identifiers).
+variables :: GHC.RenamedSource -> DetailsMap
+variables =
+    everything (<|>) (var `combine` rec)
+  where
+    var term = case cast term of
+        (Just (GHC.L sspan (GHC.HsVar name))) ->
+            pure (sspan, RtkVar (GHC.unLoc name))
+        (Just (GHC.L _ (GHC.RecordCon (GHC.L sspan name) _ _ _))) ->
+            pure (sspan, RtkVar name)
+        _ -> empty
+    rec term = case cast term of
+        Just (GHC.HsRecField (GHC.L sspan name) (_ :: GHC.LHsExpr GHC.Name) _) ->
+            pure (sspan, RtkVar name)
+        _ -> empty
+
+-- | Obtain details map for types.
+types :: GHC.RenamedSource -> DetailsMap
+types =
+    everything (<|>) ty
+  where
+    ty term = case cast term of
+        (Just (GHC.L sspan (GHC.HsTyVar name))) ->
+            pure (sspan, RtkType (GHC.unLoc name))
+        _ -> empty
+
+-- | Obtain details map for identifier bindings.
+--
+-- That includes both identifiers bound by pattern matching or declared using
+-- ordinary assignment (in top-level declarations, let-expressions and where
+-- clauses).
+binds :: GHC.RenamedSource -> DetailsMap
+binds =
+    everything (<|>) (fun `combine` pat `combine` tvar)
+  where
+    fun term = case cast term of
+        (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.Name)) ->
+            pure (sspan, RtkBind name)
+        _ -> empty
+    pat term = case cast term of
+        (Just (GHC.L sspan (GHC.VarPat name))) ->
+            pure (sspan, RtkBind (GHC.unLoc name))
+        (Just (GHC.L _ (GHC.ConPatIn (GHC.L sspan name) recs))) ->
+            [(sspan, RtkVar name)] ++ everything (<|>) rec recs
+        (Just (GHC.L _ (GHC.AsPat (GHC.L sspan name) _))) ->
+            pure (sspan, RtkBind name)
+        _ -> empty
+    rec term = case cast term of
+        (Just (GHC.HsRecField (GHC.L sspan name) (_ :: GHC.LPat GHC.Name) _)) ->
+            pure (sspan, RtkVar name)
+        _ -> empty
+    tvar term = case cast term of
+        (Just (GHC.L sspan (GHC.UserTyVar name))) ->
+            pure (sspan, RtkBind (GHC.unLoc name))
+        (Just (GHC.L _ (GHC.KindedTyVar (GHC.L sspan name) _))) ->
+            pure (sspan, RtkBind name)
+        _ -> empty
+
+-- | Obtain details map for top-level declarations.
+decls :: GHC.RenamedSource -> DetailsMap
+decls (group, _, _, _) = concatMap ($ group)
+    [ concat . map typ . concat . map GHC.group_tyclds . GHC.hs_tyclds
+    , everything (<|>) fun . GHC.hs_valds
+    , everything (<|>) (con `combine` ins)
+    ]
+  where
+    typ (GHC.L _ t) = case t of
+        GHC.DataDecl name _ _ _ -> pure . decl $ name
+        GHC.SynDecl name _ _ _ -> pure . decl $ name
+        GHC.FamDecl fam -> pure . decl $ GHC.fdLName fam
+        GHC.ClassDecl{..} -> [decl tcdLName] ++ concatMap sig tcdSigs
+    fun term = case cast term of
+        (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.Name))
+            | GHC.isExternalName name -> pure (sspan, RtkDecl name)
+        _ -> empty
+    con term = case cast term of
+        (Just cdcl) ->
+            map decl (GHC.getConNames cdcl) ++ everything (<|>) fld cdcl
+        Nothing -> empty
+    ins term = case cast term of
+        (Just (GHC.DataFamInstD inst)) -> pure . tyref $ GHC.dfid_tycon inst
+        (Just (GHC.TyFamInstD (GHC.TyFamInstDecl (GHC.L _ eqn) _))) ->
+            pure . tyref $ GHC.tfe_tycon eqn
+        _ -> empty
+    fld term = case cast term of
+        Just (field :: GHC.ConDeclField GHC.Name)
+          -> map (decl . fmap GHC.selectorFieldOcc) $ GHC.cd_fld_names field
+        Nothing -> empty
+    sig (GHC.L _ (GHC.TypeSig names _)) = map decl names
+    sig _ = []
+    decl (GHC.L sspan name) = (sspan, RtkDecl name)
+    tyref (GHC.L sspan name) = (sspan, RtkType name)
+
+-- | Obtain details map for import declarations.
+--
+-- This map also includes type and variable details for items in export and
+-- import lists.
+imports :: GHC.RenamedSource -> DetailsMap
+imports src@(_, imps, _, _) =
+    everything (<|>) ie src ++ mapMaybe (imp . GHC.unLoc) imps
+  where
+    ie term = case cast term of
+        (Just (GHC.IEVar v)) -> pure $ var v
+        (Just (GHC.IEThingAbs t)) -> pure $ typ t
+        (Just (GHC.IEThingAll t)) -> pure $ typ t
+        (Just (GHC.IEThingWith t _ vs _fls)) ->
+          [typ t] ++ map var vs
+        _ -> empty
+    typ (GHC.L sspan name) = (sspan, RtkType name)
+    var (GHC.L sspan name) = (sspan, RtkVar name)
+    imp idecl | not . GHC.ideclImplicit $ idecl =
+        let (GHC.L sspan name) = GHC.ideclName idecl
+        in Just (sspan, RtkModule name)
+    imp _ = Nothing
+
+-- | Check whether token stream span matches GHC source span.
+--
+-- Currently, it is implemented as checking whether "our" span is contained
+-- in GHC span. The reason for that is because GHC span are generally wider
+-- and may spread across couple tokens. For example, @(>>=)@ consists of three
+-- tokens: @(@, @>>=@, @)@, but GHC source span associated with @>>=@ variable
+-- contains @(@ and @)@. Similarly, qualified identifiers like @Foo.Bar.quux@
+-- are tokenized as @Foo@, @.@, @Bar@, @.@, @quux@ but GHC source span
+-- associated with @quux@ contains all five elements.
+matches :: Span -> GHC.SrcSpan -> Bool
+matches tspan (GHC.RealSrcSpan aspan)
+    | saspan <= stspan && etspan <= easpan = True
+  where
+    stspan = (posRow . spStart $ tspan, posCol . spStart $ tspan)
+    etspan = (posRow . spEnd $ tspan, posCol . spEnd $ tspan)
+    saspan = (GHC.srcSpanStartLine aspan, GHC.srcSpanStartCol aspan)
+    easpan = (GHC.srcSpanEndLine aspan, GHC.srcSpanEndCol aspan)
+matches _ _ = False
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
new file mode 100644
index 00000000..e206413e
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -0,0 +1,204 @@
+module Haddock.Backends.Hyperlinker.Parser (parse) where
+
+
+import Data.Char
+import Data.List
+import Data.Maybe
+
+import Haddock.Backends.Hyperlinker.Types
+
+
+-- | Turn source code string into a stream of more descriptive tokens.
+--
+-- Result should retain original file layout (including comments, whitespace,
+-- etc.), i.e. the following "law" should hold:
+--
+-- @concat . map 'tkValue' . 'parse' = id@
+parse :: String -> [Token]
+parse = tokenize . tag . chunk
+
+-- | Split raw source string to more meaningful chunks.
+--
+-- This is the initial stage of tokenization process. Each chunk is either
+-- a comment (including comment delimiters), a whitespace string, preprocessor
+-- macro (and all its content until the end of a line) or valid Haskell lexeme.
+chunk :: String -> [String]
+chunk [] = []
+chunk str@(c:_)
+    | isSpace c =
+        let (space, mcpp, rest) = spanSpaceOrCpp str
+        in [space] ++ maybeToList mcpp ++ chunk rest
+chunk str
+    | "--" `isPrefixOf` str = chunk' $ spanToNewline str
+    | "{-" `isPrefixOf` str = chunk' $ chunkComment 0 str
+    | otherwise = case lex str of
+        (tok:_) -> chunk' tok
+        [] -> [str]
+  where
+    chunk' (c, rest) = c:(chunk rest)
+
+-- | Split input to "first line" string and the rest of it.
+--
+-- Ideally, this should be done simply with @'break' (== '\n')@. However,
+-- Haskell also allows line-unbreaking (or whatever it is called) so things
+-- are not as simple and this function deals with that.
+spanToNewline :: String -> (String, String)
+spanToNewline [] = ([], [])
+spanToNewline ('\\':'\n':str) =
+    let (str', rest) = spanToNewline str
+    in ('\\':'\n':str', rest)
+spanToNewline str@('\n':_) = ("", str)
+spanToNewline (c:str) =
+    let (str', rest) = spanToNewline str
+    in (c:str', rest)
+
+-- | Split input to whitespace string, (optional) preprocessor directive and
+-- the rest of it.
+--
+-- Again, using something like @'span' 'isSpace'@ would be nice to chunk input
+-- to whitespace. The problem is with /#/ symbol - if it is placed at the very
+-- beginning of a line, it should be recognized as preprocessor macro. In any
+-- other case, it is ordinary Haskell symbol and can be used to declare
+-- operators. Hence, while dealing with whitespace we also check whether there
+-- happens to be /#/ symbol just after a newline character - if that is the
+-- case, we begin treating the whole line as preprocessor macro.
+spanSpaceOrCpp :: String -> (String, Maybe String, String)
+spanSpaceOrCpp ('\n':'#':str) =
+    let (str', rest) = spanToNewline str
+    in ("\n", Just $ '#':str', rest)
+spanSpaceOrCpp (c:str')
+    | isSpace c =
+        let (space, mcpp, rest) = spanSpaceOrCpp str'
+        in (c:space, mcpp, rest)
+spanSpaceOrCpp str = ("", Nothing, str)
+
+-- | Split input to comment content (including delimiters) and the rest.
+--
+-- Again, some more logic than simple 'span' is required because of Haskell
+-- comment nesting policy.
+chunkComment :: Int -> String -> (String, String)
+chunkComment _ [] = ("", "")
+chunkComment depth ('{':'-':str) =
+    let (c, rest) = chunkComment (depth + 1) str
+    in ("{-" ++ c, rest)
+chunkComment depth ('-':'}':str)
+    | depth == 1 = ("-}", str)
+    | otherwise =
+        let (c, rest) = chunkComment (depth - 1) str
+        in ("-}" ++ c, rest)
+chunkComment depth (e:str) =
+    let (c, rest) = chunkComment depth str
+    in (e:c, rest)
+
+-- | Assign source location for each chunk in given stream.
+tag :: [String] -> [(Span, String)]
+tag =
+    reverse . snd . foldl aux (Position 1 1, [])
+  where
+    aux (pos, cs) str =
+        let pos' = foldl move pos str
+        in (pos', (Span pos pos', str):cs)
+    move pos '\n' = pos { posRow = posRow pos + 1, posCol = 1 }
+    move pos _ = pos { posCol = posCol pos + 1 }
+
+-- | Turn unrecognised chunk stream to more descriptive token stream.
+tokenize :: [(Span, String)] -> [Token]
+tokenize =
+    map aux
+  where
+    aux (sp, str) = Token
+        { tkType = classify str
+        , tkValue = str
+        , tkSpan = sp
+        }
+
+-- | Classify given string as appropriate Haskell token.
+--
+-- This method is based on Haskell 98 Report lexical structure description:
+-- https://www.haskell.org/onlinereport/lexemes.html
+--
+-- However, this is probably far from being perfect and most probably does not
+-- handle correctly all corner cases.
+classify :: String -> TokenType
+classify str
+    | "--" `isPrefixOf` str = TkComment
+    | "{-#" `isPrefixOf` str = TkPragma
+    | "{-" `isPrefixOf` str = TkComment
+classify str@(c:_)
+    | isSpace c = TkSpace
+    | isDigit c = TkNumber
+    | c `elem` special = TkSpecial
+    | str `elem` glyphs = TkGlyph
+    | all (`elem` symbols) str = TkOperator
+    | c == '#' = TkCpp
+    | c == '"' = TkString
+    | c == '\'' = TkChar
+classify str
+    | str `elem` keywords = TkKeyword
+    | isIdentifier str = TkIdentifier
+    | otherwise = TkUnknown
+
+keywords :: [String]
+keywords =
+    [ "as"
+    , "case"
+    , "class"
+    , "data"
+    , "default"
+    , "deriving"
+    , "do"
+    , "else"
+    , "hiding"
+    , "if"
+    , "import"
+    , "in"
+    , "infix"
+    , "infixl"
+    , "infixr"
+    , "instance"
+    , "let"
+    , "module"
+    , "newtype"
+    , "of"
+    , "qualified"
+    , "then"
+    , "type"
+    , "where"
+    , "forall"
+    , "family"
+    , "mdo"
+    ]
+
+glyphs :: [String]
+glyphs =
+    [ ".."
+    , ":"
+    , "::"
+    , "="
+    , "\\"
+    , "|"
+    , "<-"
+    , "->"
+    , "@"
+    , "~"
+    , "~#"
+    , "=>"
+    , "-"
+    , "!"
+    ]
+
+special :: [Char]
+special = "()[]{},;`"
+
+-- TODO: Add support for any Unicode symbol or punctuation.
+-- source: http://stackoverflow.com/questions/10548170/what-characters-are-permitted-for-haskell-operators
+symbols :: [Char]
+symbols = "!#$%&*+./<=>?@\\^|-~:"
+
+isIdentifier :: String -> Bool
+isIdentifier (s:str)
+    | (isLower' s || isUpper s) && all isAlphaNum' str = True
+  where
+    isLower' c = isLower c || c == '_'
+    isAlphaNum' c = isAlphaNum c || c == '_' || c == '\''
+isIdentifier _ = False
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
new file mode 100644
index 00000000..15793f0c
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -0,0 +1,189 @@
+{-# LANGUAGE RecordWildCards #-}
+
+
+module Haddock.Backends.Hyperlinker.Renderer (render) where
+
+
+import Haddock.Backends.Hyperlinker.Types
+import Haddock.Backends.Hyperlinker.Utils
+
+import qualified GHC
+import qualified Name as GHC
+import qualified Unique as GHC
+
+import System.FilePath.Posix ((</>))
+
+import Data.List
+import Data.Maybe
+import Data.Monoid
+import qualified Data.Map as Map
+
+import Text.XHtml (Html, HtmlAttr, (!))
+import qualified Text.XHtml as Html
+
+
+type StyleClass = String
+
+
+render :: Maybe FilePath -> Maybe FilePath -> SrcMap -> [RichToken]
+       -> Html
+render mcss mjs srcs tokens = header mcss mjs <> body srcs tokens
+
+
+data TokenGroup
+    = GrpNormal Token
+    | GrpRich TokenDetails [Token]
+
+
+-- | Group consecutive tokens pointing to the same element.
+--
+-- We want to render qualified identifiers as one entity. For example,
+-- @Bar.Baz.foo@ consists of 5 tokens (@Bar@, @.@, @Baz@, @.@, @foo@) but for
+-- better user experience when highlighting and clicking links, these tokens
+-- should be regarded as one identifier. Therefore, before rendering we must
+-- group consecutive elements pointing to the same 'GHC.Name' (note that even
+-- dot token has it if it is part of qualified name).
+groupTokens :: [RichToken] -> [TokenGroup]
+groupTokens [] = []
+groupTokens ((RichToken tok Nothing):rest) = (GrpNormal tok):(groupTokens rest)
+groupTokens ((RichToken tok (Just det)):rest) =
+    let (grp, rest') = span same rest
+    in (GrpRich det (tok:(map rtkToken grp))):(groupTokens rest')
+  where
+    same (RichToken _ (Just det')) = det == det'
+    same _ = False
+
+
+body :: SrcMap -> [RichToken] -> Html
+body srcs tokens =
+    Html.body . Html.pre $ hypsrc
+  where
+    hypsrc = mconcat . map (tokenGroup srcs) . groupTokens $ tokens
+
+
+header :: Maybe FilePath -> Maybe FilePath -> Html
+header mcss mjs
+    | isNothing mcss && isNothing mjs = Html.noHtml
+header mcss mjs =
+    Html.header $ css mcss <> js mjs
+  where
+    css Nothing = Html.noHtml
+    css (Just cssFile) = Html.thelink Html.noHtml !
+        [ Html.rel "stylesheet"
+        , Html.thetype "text/css"
+        , Html.href cssFile
+        ]
+    js Nothing = Html.noHtml
+    js (Just scriptFile) = Html.script Html.noHtml !
+        [ Html.thetype "text/javascript"
+        , Html.src scriptFile
+        ]
+
+
+tokenGroup :: SrcMap -> TokenGroup -> Html
+tokenGroup _ (GrpNormal tok@(Token { .. }))
+    | tkType == TkSpace = renderSpace (posRow . spStart $ tkSpan) tkValue
+    | otherwise = tokenSpan tok ! attrs
+  where
+    attrs = [ multiclass . tokenStyle $ tkType ]
+tokenGroup srcs (GrpRich det tokens) =
+    externalAnchor det . internalAnchor det . hyperlink srcs det $ content
+  where
+    content = mconcat . map (richToken det) $ tokens
+
+
+richToken :: TokenDetails -> Token -> Html
+richToken det tok =
+    tokenSpan tok ! [ multiclass style ]
+  where
+    style = (tokenStyle . tkType) tok ++ richTokenStyle det
+
+
+tokenSpan :: Token -> Html
+tokenSpan = Html.thespan . Html.toHtml . tkValue
+
+
+richTokenStyle :: TokenDetails -> [StyleClass]
+richTokenStyle (RtkVar _) = ["hs-var"]
+richTokenStyle (RtkType _) = ["hs-type"]
+richTokenStyle _ = []
+
+tokenStyle :: TokenType -> [StyleClass]
+tokenStyle TkIdentifier = ["hs-identifier"]
+tokenStyle TkKeyword = ["hs-keyword"]
+tokenStyle TkString = ["hs-string"]
+tokenStyle TkChar = ["hs-char"]
+tokenStyle TkNumber = ["hs-number"]
+tokenStyle TkOperator = ["hs-operator"]
+tokenStyle TkGlyph = ["hs-glyph"]
+tokenStyle TkSpecial = ["hs-special"]
+tokenStyle TkSpace = []
+tokenStyle TkComment = ["hs-comment"]
+tokenStyle TkCpp = ["hs-cpp"]
+tokenStyle TkPragma = ["hs-pragma"]
+tokenStyle TkUnknown = []
+
+multiclass :: [StyleClass] -> HtmlAttr
+multiclass = Html.theclass . intercalate " "
+
+externalAnchor :: TokenDetails -> Html -> Html
+externalAnchor (RtkDecl name) content =
+    Html.anchor content ! [ Html.name $ externalAnchorIdent name ]
+externalAnchor _ content = content
+
+internalAnchor :: TokenDetails -> Html -> Html
+internalAnchor (RtkBind name) content =
+    Html.anchor content ! [ Html.name $ internalAnchorIdent name ]
+internalAnchor _ content = content
+
+externalAnchorIdent :: GHC.Name -> String
+externalAnchorIdent = hypSrcNameUrl
+
+internalAnchorIdent :: GHC.Name -> String
+internalAnchorIdent = ("local-" ++) . show . GHC.getKey . GHC.nameUnique
+
+hyperlink :: SrcMap -> TokenDetails -> Html -> Html
+hyperlink srcs details = case rtkName details of
+    Left name ->
+        if GHC.isInternalName name
+        then internalHyperlink name
+        else externalNameHyperlink srcs name
+    Right name -> externalModHyperlink srcs name
+
+internalHyperlink :: GHC.Name -> Html -> Html
+internalHyperlink name content =
+    Html.anchor content ! [ Html.href $ "#" ++ internalAnchorIdent name ]
+
+externalNameHyperlink :: SrcMap -> GHC.Name -> Html -> Html
+externalNameHyperlink (srcs, _) name content = case Map.lookup mdl srcs of
+    Just SrcLocal -> Html.anchor content !
+        [ Html.href $ hypSrcModuleNameUrl mdl name ]
+    Just (SrcExternal path) -> Html.anchor content !
+        [ Html.href $ path </> hypSrcModuleNameUrl mdl name ]
+    Nothing -> content
+  where
+    mdl = GHC.nameModule name
+
+externalModHyperlink :: SrcMap -> GHC.ModuleName -> Html -> Html
+externalModHyperlink (_, srcs) name content = case Map.lookup name srcs of
+    Just SrcLocal -> Html.anchor content !
+        [ Html.href $ hypSrcModuleUrl' name ]
+    Just (SrcExternal path) -> Html.anchor content !
+        [ Html.href $ path </> hypSrcModuleUrl' name ]
+    Nothing -> content
+
+
+renderSpace :: Int -> String -> Html
+renderSpace _ [] = Html.noHtml
+renderSpace line ('\n':rest) = mconcat
+    [ Html.thespan . Html.toHtml $ "\n"
+    , lineAnchor (line + 1)
+    , renderSpace (line + 1) rest
+    ]
+renderSpace line space =
+    let (hspace, rest) = span (/= '\n') space
+    in (Html.thespan . Html.toHtml) hspace <> renderSpace line rest
+
+
+lineAnchor :: Int -> Html
+lineAnchor line = Html.anchor Html.noHtml ! [ Html.name $ hypSrcLineUrl line ]
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs
new file mode 100644
index 00000000..5f4dbc8c
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs
@@ -0,0 +1,85 @@
+module Haddock.Backends.Hyperlinker.Types where
+
+
+import qualified GHC
+
+import Data.Map (Map)
+import qualified Data.Map as Map
+
+
+data Token = Token
+    { tkType :: TokenType
+    , tkValue :: String
+    , tkSpan :: Span
+    }
+
+data Position = Position
+    { posRow :: !Int
+    , posCol :: !Int
+    }
+
+data Span = Span
+    { spStart :: Position
+    , spEnd :: Position
+    }
+
+data TokenType
+    = TkIdentifier
+    | TkKeyword
+    | TkString
+    | TkChar
+    | TkNumber
+    | TkOperator
+    | TkGlyph
+    | TkSpecial
+    | TkSpace
+    | TkComment
+    | TkCpp
+    | TkPragma
+    | TkUnknown
+    deriving (Show, Eq)
+
+
+data RichToken = RichToken
+    { rtkToken :: Token
+    , rtkDetails :: Maybe TokenDetails
+    }
+
+data TokenDetails
+    = RtkVar GHC.Name
+    | RtkType GHC.Name
+    | RtkBind GHC.Name
+    | RtkDecl GHC.Name
+    | RtkModule GHC.ModuleName
+    deriving (Eq)
+
+
+rtkName :: TokenDetails -> Either GHC.Name GHC.ModuleName
+rtkName (RtkVar name) = Left name
+rtkName (RtkType name) = Left name
+rtkName (RtkBind name) = Left name
+rtkName (RtkDecl name) = Left name
+rtkName (RtkModule name) = Right name
+
+
+-- | Path for making cross-package hyperlinks in generated sources.
+--
+-- Used in 'SrcMap' to determine whether module originates in current package
+-- or in an external package.
+data SrcPath
+    = SrcExternal FilePath
+    | SrcLocal
+
+-- | Mapping from modules to cross-package source paths.
+--
+-- This mapping is actually a pair of maps instead of just one map. The reason
+-- for this is because when hyperlinking modules in import lists we have no
+-- 'GHC.Module' available. On the other hand, we can't just use map with
+-- 'GHC.ModuleName' as indices because certain modules may have common name
+-- but originate in different packages. Hence, we use both /rich/ and /poor/
+-- versions, where the /poor/ is just projection of /rich/ one cached in pair
+-- for better performance.
+type SrcMap = (Map GHC.Module SrcPath, Map GHC.ModuleName SrcPath)
+
+mkSrcMap :: Map GHC.Module SrcPath -> SrcMap
+mkSrcMap srcs = (srcs, Map.mapKeys GHC.moduleName srcs)
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
new file mode 100644
index 00000000..9de4a03d
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
@@ -0,0 +1,68 @@
+module Haddock.Backends.Hyperlinker.Utils
+    ( hypSrcDir, hypSrcModuleFile, hypSrcModuleFile'
+    , hypSrcModuleUrl, hypSrcModuleUrl'
+    , hypSrcNameUrl
+    , hypSrcLineUrl
+    , hypSrcModuleNameUrl, hypSrcModuleLineUrl
+    , hypSrcModuleUrlFormat
+    , hypSrcModuleNameUrlFormat, hypSrcModuleLineUrlFormat
+    ) where
+
+
+import Haddock.Backends.Xhtml.Utils
+
+import GHC
+import FastString
+import System.FilePath.Posix ((</>))
+
+
+hypSrcDir :: FilePath
+hypSrcDir = "src"
+
+hypSrcModuleFile :: Module -> FilePath
+hypSrcModuleFile = hypSrcModuleFile' . moduleName
+
+hypSrcModuleFile' :: ModuleName -> FilePath
+hypSrcModuleFile' mdl = spliceURL'
+    Nothing (Just mdl) Nothing Nothing moduleFormat
+
+hypSrcModuleUrl :: Module -> String
+hypSrcModuleUrl = hypSrcModuleFile
+
+hypSrcModuleUrl' :: ModuleName -> String
+hypSrcModuleUrl' = hypSrcModuleFile'
+
+hypSrcNameUrl :: Name -> String
+hypSrcNameUrl name = spliceURL
+    Nothing Nothing (Just name) Nothing nameFormat
+
+hypSrcLineUrl :: Int -> String
+hypSrcLineUrl line = spliceURL
+    Nothing Nothing Nothing (Just spn) lineFormat
+  where
+    loc = mkSrcLoc nilFS line 1
+    spn = mkSrcSpan loc loc
+
+hypSrcModuleNameUrl :: Module -> Name -> String
+hypSrcModuleNameUrl mdl name = hypSrcModuleUrl mdl ++ "#" ++ hypSrcNameUrl name
+
+hypSrcModuleLineUrl :: Module -> Int -> String
+hypSrcModuleLineUrl mdl line = hypSrcModuleUrl mdl ++ "#" ++ hypSrcLineUrl line
+
+hypSrcModuleUrlFormat :: String
+hypSrcModuleUrlFormat = hypSrcDir </> moduleFormat
+
+hypSrcModuleNameUrlFormat :: String
+hypSrcModuleNameUrlFormat = hypSrcModuleUrlFormat ++ "#" ++ nameFormat
+
+hypSrcModuleLineUrlFormat :: String
+hypSrcModuleLineUrlFormat = hypSrcModuleUrlFormat ++ "#" ++ lineFormat
+
+moduleFormat :: String
+moduleFormat = "%{MODULE}.html"
+
+nameFormat :: String
+nameFormat = "%{NAME}"
+
+lineFormat :: String
+lineFormat = "line-%{LINE}"
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index c9262c7e..ab6bb41c 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -1,4 +1,5 @@
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+{-# LANGUAGE RecordWildCards #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Haddock.Backends.LaTeX
@@ -212,9 +213,9 @@ processExports (e : es) =
 
 
 isSimpleSig :: ExportItem DocName -> Maybe ([DocName], HsType DocName)
-isSimpleSig ExportDecl { expItemDecl = L _ (SigD (TypeSig lnames (L _ t) _))
+isSimpleSig ExportDecl { expItemDecl = L _ (SigD (TypeSig lnames t))
                        , expItemMbDoc = (Documentation Nothing Nothing, argDocs) }
-  | Map.null argDocs = Just (map unLoc lnames, t)
+  | Map.null argDocs = Just (map unLoc lnames, unLoc (hsSigWcType t))
 isSimpleSig _ = Nothing
 
 
@@ -249,8 +250,8 @@ ppDocGroup lev doc = sec lev <> braces doc
 declNames :: LHsDecl DocName -> [DocName]
 declNames (L _ decl) = case decl of
   TyClD d  -> [tcdName d]
-  SigD (TypeSig lnames _ _) -> map unLoc lnames
-  SigD (PatSynSig lname _ _ _ _) -> [unLoc lname]
+  SigD (TypeSig lnames _ ) -> map unLoc lnames
+  SigD (PatSynSig lname _) -> [unLoc lname]
   ForD (ForeignImport (L _ n) _ _ _) -> [n]
   ForD (ForeignExport (L _ n) _ _ _) -> [n]
   _ -> error "declaration not supported by declNames"
@@ -292,10 +293,11 @@ ppDecl (L loc decl) (doc, fnArgsDoc) instances subdocs _fixities = case decl of
 --  TyClD d@(TySynonym {})
 --    | Just _  <- tcdTyPats d    -> ppTyInst False loc doc d unicode
 -- Family instances happen via FamInst now
-  TyClD d@(ClassDecl {})         -> ppClassDecl instances loc doc subdocs d unicode
-  SigD (TypeSig lnames (L _ t) _) -> ppFunSig loc (doc, fnArgsDoc) (map unLoc lnames) t unicode
-  SigD (PatSynSig lname qtvs prov req ty) ->
-      ppLPatSig loc (doc, fnArgsDoc) lname qtvs prov req ty unicode
+  TyClD d@(ClassDecl {})    -> ppClassDecl instances loc doc subdocs d unicode
+  SigD (TypeSig lnames t)   -> ppFunSig loc (doc, fnArgsDoc) (map unLoc lnames)
+                                        (hsSigWcType t) unicode
+  SigD (PatSynSig lname ty) ->
+      ppLPatSig loc (doc, fnArgsDoc) lname ty unicode
   ForD d                         -> ppFor loc (doc, fnArgsDoc) d unicode
   InstD _                        -> empty
   _                              -> error "declaration not supported by ppDecl"
@@ -310,8 +312,8 @@ ppTyFam _ _ _ _ _ =
 
 
 ppFor :: SrcSpan -> DocForDecl DocName -> ForeignDecl DocName -> Bool -> LaTeX
-ppFor loc doc (ForeignImport (L _ name) (L _ typ) _ _) unicode =
-  ppFunSig loc doc [name] typ unicode
+ppFor loc doc (ForeignImport (L _ name) typ _ _) unicode =
+  ppFunSig loc doc [name] (hsSigType typ) unicode
 ppFor _ _ _ _ = error "ppFor error in Haddock.Backends.LaTeX"
 --  error "foreign declarations are currently not supported by --latex"
 
@@ -328,7 +330,9 @@ ppTySyn loc doc (SynDecl { tcdLName = L _ name, tcdTyVars = ltyvars
                          , tcdRhs = ltype }) unicode
   = ppTypeOrFunSig loc [name] (unLoc ltype) doc (full, hdr, char '=') unicode
   where
-    hdr  = hsep (keyword "type" : ppDocBinder name : ppTyVars ltyvars)
+    hdr  = hsep (keyword "type"
+                 : ppDocBinder name
+                 : map ppSymName (tyvarNames ltyvars))
     full = hdr <+> char '=' <+> ppLType unicode ltype
 
 ppTySyn _ _ _ _ = error "declaration not supported by ppTySyn"
@@ -339,9 +343,9 @@ ppTySyn _ _ _ _ = error "declaration not supported by ppTySyn"
 -------------------------------------------------------------------------------
 
 
-ppFunSig :: SrcSpan -> DocForDecl DocName -> [DocName] -> HsType DocName
+ppFunSig :: SrcSpan -> DocForDecl DocName -> [DocName] -> LHsType DocName
          -> Bool -> LaTeX
-ppFunSig loc doc docnames typ unicode =
+ppFunSig loc doc docnames (L _ typ) unicode =
   ppTypeOrFunSig loc docnames typ doc
     ( ppTypeSig names typ False
     , hsep . punctuate comma $ map ppSymName names
@@ -351,29 +355,17 @@ ppFunSig loc doc docnames typ unicode =
    names = map getName docnames
 
 ppLPatSig :: SrcSpan -> DocForDecl DocName -> Located DocName
-          -> (HsExplicitFlag, LHsTyVarBndrs DocName)
-          -> LHsContext DocName -> LHsContext DocName
-          -> LHsType DocName
+          -> LHsSigType DocName
           -> Bool -> LaTeX
-ppLPatSig _loc (doc, _argDocs) (L _ name) (expl, qtvs) lprov lreq (L _ ty) unicode
+ppLPatSig _loc (doc, _argDocs) (L _ name) ty unicode
   = declWithDoc pref1 (documentationToLaTeX doc)
   where
     pref1 = hsep [ keyword "pattern"
                  , ppDocBinder name
                  , dcolon unicode
-                 , ppLTyVarBndrs expl qtvs unicode
-                 , ctx
-                 , ppType unicode ty
+                 , ppLType unicode (hsSigType ty)
                  ]
 
-    ctx = case (ppLContextMaybe lprov unicode, ppLContextMaybe lreq unicode) of
-        (Nothing,   Nothing)  -> empty
-        (Nothing,   Just req) -> parens empty <+> darr <+> req <+> darr
-        (Just prov, Nothing)  -> prov <+> darr
-        (Just prov, Just req) -> prov <+> darr <+> req <+> darr
-
-    darr = darrow unicode
-
 ppTypeOrFunSig :: SrcSpan -> [DocName] -> HsType DocName
                -> DocForDecl DocName -> (LaTeX, LaTeX, LaTeX)
                -> Bool -> LaTeX
@@ -392,23 +384,15 @@ ppTypeOrFunSig _ _ typ (doc, argDocs) (pref1, pref2, sep0)
 
      arg_doc n = rDoc . fmap _doc $ Map.lookup n argDocs
 
-     do_args :: Int -> LaTeX -> (HsType DocName) -> LaTeX
-     do_args n leader (HsForAllTy Explicit _ tvs lctxt ltype)
-       = decltt leader <->
-             decltt (hsep (forallSymbol unicode : ppTyVars tvs ++ [dot]) <+>
-                ppLContextNoArrow lctxt unicode) <+> nl $$
-         do_largs n (darrow unicode) ltype
-
-     do_args n leader (HsForAllTy Qualified e a lctxt ltype)
-       = do_args n leader (HsForAllTy Implicit e a lctxt ltype)
-     do_args n leader (HsForAllTy Implicit _ _ lctxt ltype)
-       | not (null (unLoc lctxt))
-       = decltt leader <-> decltt (ppLContextNoArrow lctxt unicode) <+> nl $$
-         do_largs n (darrow unicode) ltype
-         -- if we're not showing any 'forall' or class constraints or
-         -- anything, skip having an empty line for the context.
-       | otherwise
-       = do_largs n leader ltype
+     do_args :: Int -> LaTeX -> HsType DocName -> LaTeX
+     do_args _n leader (HsForAllTy tvs ltype)
+       = decltt leader
+         <-> decltt (hsep (forallSymbol unicode : ppTyVars tvs ++ [dot]))
+         <+> ppLType unicode ltype
+     do_args n leader (HsQualTy lctxt ltype)
+       = decltt leader
+         <-> ppLContextNoArrow lctxt unicode <+> nl $$
+             do_largs n (darrow unicode) ltype
      do_args n leader (HsFunTy lt r)
        = decltt leader <-> decltt (ppLFunLhType unicode lt) <-> arg_doc n <+> nl $$
          do_largs (n+1) (arrow unicode) r
@@ -423,12 +407,12 @@ ppTypeSig nms ty unicode =
     <+> ppType unicode ty
 
 
-ppTyVars :: LHsTyVarBndrs DocName -> [LaTeX]
-ppTyVars tvs = map ppSymName (tyvarNames tvs)
+ppTyVars :: [LHsTyVarBndr DocName] -> [LaTeX]
+ppTyVars = map (ppSymName . getName . hsLTyVarName)
 
 
-tyvarNames :: LHsTyVarBndrs DocName -> [Name]
-tyvarNames = map getName . hsLTyVarNames
+tyvarNames :: LHsQTyVars DocName -> [Name]
+tyvarNames = map (getName . hsLTyVarName) . hsQTvExplicit
 
 
 declWithDoc :: LaTeX -> Maybe LaTeX -> LaTeX
@@ -477,12 +461,12 @@ rDoc = maybeDoc . fmap latexStripTrailingWhitespace
 
 
 ppClassHdr :: Bool -> Located [LHsType DocName] -> DocName
-           -> LHsTyVarBndrs DocName -> [Located ([Located DocName], [Located DocName])]
+           -> LHsQTyVars DocName -> [Located ([Located DocName], [Located DocName])]
            -> Bool -> LaTeX
 ppClassHdr summ lctxt n tvs fds unicode =
   keyword "class"
   <+> (if not . null . unLoc $ lctxt then ppLContext lctxt unicode else empty)
-  <+> ppAppDocNameNames summ n (tyvarNames $ tvs)
+  <+> ppAppDocNameNames summ n (tyvarNames tvs)
   <+> ppFds fds unicode
 
 
@@ -520,8 +504,8 @@ ppClassDecl instances loc doc subdocs
 
     methodTable =
       text "\\haddockpremethods{}\\textbf{Methods}" $$
-      vcat  [ ppFunSig loc doc names typ unicode
-            | L _ (TypeSig lnames (L _ typ) _) <- lsigs
+      vcat  [ ppFunSig loc doc names (hsSigWcType typ) unicode
+            | L _ (TypeSig lnames typ) <- lsigs
             , let doc = lookupAnySubdoc (head names) subdocs
                   names = map unLoc lnames ]
               -- FIXME: is taking just the first name ok? Is it possible that
@@ -544,14 +528,14 @@ ppDocInstances unicode (i : rest)
     (is, rest') = spanWith isUndocdInstance rest
 
 isUndocdInstance :: DocInstance a -> Maybe (InstHead a)
-isUndocdInstance (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 (instHead, doc) =
+ppDocInstance unicode (instHead, doc, _) =
   declWithDoc (ppInstDecl unicode instHead) (fmap docToLaTeX $ fmap _doc doc)
 
 
@@ -560,12 +544,13 @@ ppInstDecl unicode instHead = keyword "instance" <+> ppInstHead unicode instHead
 
 
 ppInstHead :: Bool -> InstHead DocName -> LaTeX
-ppInstHead unicode (n, ks, ts, ClassInst ctx) = ppContextNoLocs ctx unicode <+> ppAppNameTypes n ks ts unicode
-ppInstHead unicode (n, ks, ts, TypeInst rhs) = keyword "type"
-  <+> ppAppNameTypes n ks ts unicode
-  <+> maybe empty (\t -> equals <+> ppType unicode t) rhs
-ppInstHead _unicode (_n, _ks, _ts, DataInst _dd) =
-  error "data instances not supported by --latex yet"
+ppInstHead unicode (InstHead {..}) = case ihdInstType of
+    ClassInst ctx _ _ _ -> ppContextNoLocs ctx unicode <+> typ
+    TypeInst rhs -> keyword "type" <+> typ <+> tibody rhs
+    DataInst _ -> error "data instances not supported by --latex yet"
+  where
+    typ = ppAppNameTypes ihdClsName ihdKinds ihdTypes unicode
+    tibody = maybe empty (\t -> equals <+> ppType unicode t)
 
 lookupAnySubdoc :: (Eq name1) =>
                    name1 -> [(name1, DocForDecl name2)] -> DocForDecl name2
@@ -591,14 +576,14 @@ ppDataDecl instances subdocs _loc doc dataDecl unicode
 
   where
     cons      = dd_cons (tcdDataDefn dataDecl)
-    resTy     = (con_res . unLoc . head) cons
+    resTy     = (unLoc . head) cons
 
     body = catMaybes [constrBit, doc >>= documentationToLaTeX]
 
     (whereBit, leaders)
       | null cons = (empty,[])
       | otherwise = case resTy of
-        ResTyGADT _ _ -> (decltt (keyword "where"), repeat empty)
+        ConDeclGADT{} -> (decltt (keyword "where"), repeat empty)
         _             -> (empty, (decltt (text "=") : repeat (decltt (text "|"))))
 
     constrBit
@@ -612,21 +597,85 @@ ppDataDecl instances subdocs _loc doc dataDecl unicode
 
 
 -- ppConstrHdr is for (non-GADT) existentials constructors' syntax
-ppConstrHdr :: HsExplicitFlag -> [Name] -> HsContext DocName -> Bool -> LaTeX
+ppConstrHdr :: Bool -> [Name] -> HsContext DocName -> Bool -> LaTeX
 ppConstrHdr forall tvs ctxt unicode
  = (if null tvs then empty else ppForall)
    <+>
    (if null ctxt then empty else ppContextNoArrow ctxt unicode <+> darrow unicode <+> text " ")
   where
     ppForall = case forall of
-      Explicit -> forallSymbol unicode <+> hsep (map ppName tvs) <+> text ". "
-      Qualified -> empty
-      Implicit -> empty
+      True  -> forallSymbol unicode <+> hsep (map ppName tvs) <+> text ". "
+      False -> empty
+
+
+ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> Bool -> LaTeX
+                   -> LConDecl DocName -> LaTeX
+ppSideBySideConstr subdocs unicode leader (L _ con@(ConDeclH98 {})) =
+  leader <->
+  case con_details con of
+
+    PrefixCon args ->
+      decltt (hsep ((header_ unicode <+> ppOcc) :
+                 map (ppLParendType unicode) args))
+      <-> rDoc mbDoc <+> nl
+
+    RecCon (L _ fields) ->
+      (decltt (header_ unicode <+> ppOcc)
+        <-> rDoc mbDoc <+> nl)
+      $$
+      doRecordFields fields
+
+    InfixCon arg1 arg2 ->
+      decltt (hsep [ header_ unicode <+> ppLParendType unicode arg1,
+                 ppOcc,
+                 ppLParendType unicode arg2 ])
+      <-> rDoc mbDoc <+> nl
+
+ where
+    doRecordFields fields =
+        vcat (map (ppSideBySideField subdocs unicode) (map unLoc fields))
+
+
+    header_ = ppConstrHdr False tyVars context
+    occ     = map (nameOccName . getName . unLoc) $ getConNames con
+    ppOcc   = case occ of
+      [one] -> ppBinder one
+      _     -> cat (punctuate comma (map ppBinder occ))
+    tyVars  = tyvarNames (fromMaybe (HsQTvs PlaceHolder []) (con_qvars con))
+    context = unLoc (fromMaybe (noLoc []) (con_cxt con))
+
+    -- don't use "con_doc con", in case it's reconstructed from a .hi file,
+    -- or also because we want Haddock to do the doc-parsing, not GHC.
+    mbDoc = case getConNames con of
+              [] -> panic "empty con_names"
+              (cn:_) -> lookup (unLoc cn) subdocs >>=
+                        fmap _doc . combineDocumentation . fst
+
+ppSideBySideConstr subdocs unicode leader (L _ con@(ConDeclGADT {})) =
+  leader <->
+  doGADTCon (hsib_body $ con_type con)
+
+ where
+    doGADTCon resTy = decltt (ppOcc <+> dcolon unicode <+>
+                               ppLType unicode resTy
+                            ) <-> rDoc mbDoc
+
+    occ     = map (nameOccName . getName . unLoc) $ getConNames con
+    ppOcc   = case occ of
+      [one] -> ppBinder one
+      _     -> cat (punctuate comma (map ppBinder occ))
 
+    -- don't use "con_doc con", in case it's reconstructed from a .hi file,
+    -- or also because we want Haddock to do the doc-parsing, not GHC.
+    mbDoc = case getConNames con of
+              [] -> panic "empty con_names"
+              (cn:_) -> lookup (unLoc cn) subdocs >>=
+                        fmap _doc . combineDocumentation . fst
+{- old
 
 ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> Bool -> LaTeX
                    -> LConDecl DocName -> LaTeX
-ppSideBySideConstr subdocs unicode leader (L _ con) =
+ppSideBySideConstr subdocs unicode leader (L loc con) =
   leader <->
   case con_res con of
   ResTyH98 -> case con_details con of
@@ -660,13 +709,13 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =
     doRecordFields fields =
         vcat (map (ppSideBySideField subdocs unicode) (map unLoc fields))
 
-    doGADTCon args resTy = decltt (ppOcc <+> dcolon unicode <+> hsep [
-                               ppForAll forall ltvs (con_cxt con) unicode,
-                               ppLType unicode (foldr mkFunTy resTy args) ]
+    doGADTCon args resTy = decltt (ppOcc <+> dcolon unicode <+>
+                               ppLType unicode (mk_forall $ mk_phi $
+                                                foldr mkFunTy resTy args)
                             ) <-> rDoc mbDoc
 
 
-    header_ = ppConstrHdr forall tyVars context
+    header_ = ppConstrHdr (con_explicit con) tyVars context
     occ     = map (nameOccName . getName . unLoc) $ con_names con
     ppOcc   = case occ of
       [one] -> ppBinder one
@@ -674,7 +723,12 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =
     ltvs    = con_qvars con
     tyVars  = tyvarNames (con_qvars con)
     context = unLoc (con_cxt con)
-    forall  = con_explicit con
+
+    mk_forall ty | con_explicit con = L loc (HsForAllTy (hsQTvExplicit ltvs) ty)
+                 | otherwise        = ty
+    mk_phi ty | null context = ty
+              | otherwise    = L loc (HsQualTy (con_cxt con) ty)
+
     -- don't use "con_doc con", in case it's reconstructed from a .hi file,
     -- or also because we want Haddock to do the doc-parsing, not GHC.
     mbDoc = case con_names con of
@@ -682,16 +736,16 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =
               (cn:_) -> lookup (unLoc cn) subdocs >>=
                         fmap _doc . combineDocumentation . fst
     mkFunTy a b = noLoc (HsFunTy a b)
-
+-}
 
 ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Bool -> ConDeclField DocName ->  LaTeX
 ppSideBySideField subdocs unicode (ConDeclField names ltype _) =
-  decltt (cat (punctuate comma (map (ppBinder . nameOccName . getName . unL) names))
+  decltt (cat (punctuate comma (map (ppBinder . rdrNameOcc . rdrNameFieldOcc . unLoc) names))
     <+> dcolon unicode <+> ppLType unicode ltype) <-> rDoc mbDoc
   where
     -- don't use cd_fld_doc for same reason we don't use con_doc above
     -- Where there is more than one name, they all have the same documentation
-    mbDoc = lookup (unL $ head names) subdocs >>= fmap _doc . combineDocumentation . fst
+    mbDoc = lookup (selectorFieldOcc $ unLoc $ head names) subdocs >>= fmap _doc . combineDocumentation . fst
 
 -- {-
 -- ppHsFullConstr :: HsConDecl -> LaTeX
@@ -790,9 +844,6 @@ ppLContext, ppLContextNoArrow :: Located (HsContext DocName) -> Bool -> LaTeX
 ppLContext        = ppContext        . unLoc
 ppLContextNoArrow = ppContextNoArrow . unLoc
 
-ppLContextMaybe :: Located (HsContext DocName) -> Bool -> Maybe LaTeX
-ppLContextMaybe = ppContextNoLocsMaybe . map unLoc . unLoc
-
 ppContextNoLocsMaybe :: [HsType DocName] -> Bool -> Maybe LaTeX
 ppContextNoLocsMaybe [] _ = Nothing
 ppContextNoLocsMaybe cxt unicode = Just $ pp_hs_context cxt unicode
@@ -822,9 +873,10 @@ pp_hs_context cxt unicode = parenList (map (ppType unicode) cxt)
 -------------------------------------------------------------------------------
 
 
-ppBang :: HsBang -> LaTeX
-ppBang HsNoBang = empty
-ppBang _        = char '!' -- Unpacked args is an implementation detail,
+ppBang :: HsSrcBang -> LaTeX
+ppBang (HsSrcBang _ _ SrcStrict) = char '!'
+ppBang (HsSrcBang _ _ SrcLazy)   = char '~'
+ppBang _                         = empty
 
 
 tupleParens :: HsTupleSort -> [LaTeX] -> LaTeX
@@ -877,33 +929,22 @@ ppKind unicode ki = ppr_mono_ty pREC_TOP ki unicode
 -- Drop top-level for-all type variables in user style
 -- since they are implicit in Haskell
 
-ppForAll :: HsExplicitFlag -> LHsTyVarBndrs DocName
-         -> Located (HsContext DocName) -> Bool -> LaTeX
-ppForAll expl tvs cxt unicode = ppLTyVarBndrs expl tvs unicode <+> ppLContext cxt unicode
-
-ppLTyVarBndrs :: HsExplicitFlag -> LHsTyVarBndrs DocName
-              -> Bool -> LaTeX
-ppLTyVarBndrs expl tvs unicode
-  | show_forall = hsep (forallSymbol unicode : ppTyVars tvs) <> dot
-  | otherwise   = empty
-  where
-    show_forall = not (null (hsQTvBndrs tvs)) && is_explicit
-    is_explicit = case expl of {Explicit -> True; Implicit -> False; Qualified -> False}
-
 ppr_mono_lty :: Int -> LHsType DocName -> Bool -> LaTeX
 ppr_mono_lty ctxt_prec ty unicode = ppr_mono_ty ctxt_prec (unLoc ty) unicode
 
 
 ppr_mono_ty :: Int -> HsType DocName -> Bool -> LaTeX
-ppr_mono_ty ctxt_prec (HsForAllTy expl extra tvs ctxt ty) unicode
+ppr_mono_ty ctxt_prec (HsForAllTy tvs ty) unicode
   = maybeParen ctxt_prec pREC_FUN $
-    hsep [ppForAll expl tvs ctxt' unicode, ppr_mono_lty pREC_TOP ty unicode]
- where ctxt' = case extra of
-                 Just loc -> (++ [L loc HsWildcardTy]) `fmap` ctxt
-                 Nothing  -> ctxt
+    sep [ hsep (forallSymbol unicode : ppTyVars tvs) <> dot
+        , ppr_mono_lty pREC_TOP ty unicode ]
+ppr_mono_ty ctxt_prec (HsQualTy ctxt ty) unicode
+  = maybeParen ctxt_prec pREC_FUN $
+    sep [ ppLContext ctxt unicode
+        , ppr_mono_lty pREC_TOP ty unicode ]
 
 ppr_mono_ty _         (HsBangTy b ty)     u = ppBang b <> ppLParendType u ty
-ppr_mono_ty _         (HsTyVar name)      _ = ppDocName name
+ppr_mono_ty _         (HsTyVar (L _ name)) _ = ppDocName name
 ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   u = ppr_fun_ty ctxt_prec ty1 ty2 u
 ppr_mono_ty _         (HsTupleTy con tys) u = tupleParens con (map (ppLType u) tys)
 ppr_mono_ty _         (HsKindSig ty kind) u = parens (ppr_mono_lty pREC_TOP ty u <+> dcolon u <+> ppLKind u kind)
@@ -915,7 +956,6 @@ ppr_mono_ty _         (HsRecTy {})        _ = error "ppr_mono_ty HsRecTy"
 ppr_mono_ty _         (HsCoreTy {})       _ = error "ppr_mono_ty HsCoreTy"
 ppr_mono_ty _         (HsExplicitListTy _ tys) u = Pretty.quote $ brackets $ hsep $ punctuate comma $ map (ppLType u) tys
 ppr_mono_ty _         (HsExplicitTupleTy _ tys) u = Pretty.quote $ parenList $ map (ppLType u) tys
-ppr_mono_ty _         (HsWrapTy {})       _ = error "ppr_mono_ty HsWrapTy"
 
 ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode
   = maybeParen ctxt_prec pREC_OP $
@@ -925,7 +965,7 @@ ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode
   = maybeParen ctxt_prec pREC_CON $
     hsep [ppr_mono_lty pREC_FUN fun_ty unicode, ppr_mono_lty pREC_CON arg_ty unicode]
 
-ppr_mono_ty ctxt_prec (HsOpTy ty1 (_, op) ty2) unicode
+ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) unicode
   = maybeParen ctxt_prec pREC_FUN $
     ppr_mono_lty pREC_OP ty1 unicode <+> ppr_op <+> ppr_mono_lty pREC_OP ty2 unicode
   where
@@ -939,12 +979,14 @@ ppr_mono_ty ctxt_prec (HsParTy ty) unicode
 ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode
   = ppr_mono_lty ctxt_prec ty unicode
 
-ppr_mono_ty _ HsWildcardTy _ = char '_'
+ppr_mono_ty _ (HsWildCardTy (AnonWildCard _)) _ = char '_'
 
-ppr_mono_ty _ (HsNamedWildcardTy name) _ = ppDocName name
+ppr_mono_ty _ (HsWildCardTy (NamedWildCard (L _ name))) _ = ppDocName name
 
 ppr_mono_ty _ (HsTyLit t) u = ppr_tylit t u
 
+ppr_mono_ty _ (HsAppsTy {}) _ = panic "ppr_mono_ty:HsAppsTy"
+
 
 ppr_tylit :: HsTyLit -> Bool -> LaTeX
 ppr_tylit (HsNumTy _ n) _ = integer n
diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index 6ef1e863..1554a33c 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -36,7 +36,6 @@ import Haddock.GhcUtils
 
 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 ( (</>) )
@@ -305,7 +304,7 @@ mkNode qual ss p (Node s leaf pkg srcPkg short ts) =
 
     htmlModule = thespan ! modAttrs << (cBtn +++
       if leaf
-        then ppModule (mkModule (stringToPackageKey (fromMaybe "" pkg))
+        then ppModule (mkModule (stringToUnitId (fromMaybe "" pkg))
                                        (mkModuleName mdl))
         else toHtml s
       )
@@ -547,7 +546,7 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode qual
     synopsis
       | no_doc_at_all = noHtml
       | otherwise
-      = divSynposis $
+      = divSynopsis $
             paragraph ! collapseControl "syn" False "caption" << "Synopsis" +++
             shortDeclList (
                 mapMaybe (processExport True linksInfo unicode qual) exports
@@ -584,7 +583,7 @@ processForMiniSynopsis mdl unicode qual ExportDecl { expItemDecl = L _loc decl0
         (DataDecl{})   -> [keyword "data" <+> b]
         (SynDecl{})    -> [keyword "type" <+> b]
         (ClassDecl {}) -> [keyword "class" <+> b]
-    SigD (TypeSig lnames (L _ _) _) ->
+    SigD (TypeSig lnames _) ->
       map (ppNameMini Prefix mdl . nameOccName . getName . unLoc) lnames
     _ -> []
 processForMiniSynopsis _ _ qual (ExportGroup lvl _id txt) =
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 88aa966c..49149b8c 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -1,4 +1,6 @@
 {-# LANGUAGE TransformListComp #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE Rank2Types #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Haddock.Backends.Html.Decl
@@ -18,7 +20,6 @@ module Haddock.Backends.Xhtml.Decl (
   tyvarNames
 ) where
 
-
 import Haddock.Backends.Xhtml.DocMarkup
 import Haddock.Backends.Xhtml.Layout
 import Haddock.Backends.Xhtml.Names
@@ -28,7 +29,6 @@ import Haddock.GhcUtils
 import Haddock.Types
 import Haddock.Doc (combineDocumentation)
 
-import           Control.Applicative
 import           Data.List             ( intersperse, sort )
 import qualified Data.Map as Map
 import           Data.Maybe
@@ -38,18 +38,20 @@ import GHC
 import GHC.Exts
 import Name
 import BooleanFormula
+import RdrName ( rdrNameOcc )
 
 ppDecl :: Bool -> LinksInfo -> LHsDecl DocName
        -> DocForDecl DocName -> [DocInstance DocName] -> [(DocName, Fixity)]
        -> [(DocName, DocForDecl DocName)] -> Splice -> Unicode -> Qualification -> Html
 ppDecl summ links (L loc decl) (mbDoc, fnArgsDoc) instances fixities subdocs splice unicode qual = case decl of
-  TyClD (FamDecl d)           -> ppTyFam summ False links instances fixities loc mbDoc d splice unicode qual
-  TyClD d@(DataDecl {})       -> ppDataDecl summ links instances fixities subdocs loc mbDoc d splice unicode qual
-  TyClD d@(SynDecl {})        -> ppTySyn summ links fixities loc (mbDoc, fnArgsDoc) d splice unicode qual
-  TyClD d@(ClassDecl {})      -> ppClassDecl summ links instances fixities loc mbDoc subdocs d splice unicode qual
-  SigD (TypeSig lnames lty _) -> ppLFunSig summ links loc (mbDoc, fnArgsDoc) lnames lty fixities splice unicode qual
-  SigD (PatSynSig lname qtvs prov req ty) ->
-      ppLPatSig summ links loc (mbDoc, fnArgsDoc) lname qtvs prov req ty fixities splice unicode qual
+  TyClD (FamDecl d)         -> ppTyFam summ False links instances fixities loc mbDoc d splice unicode qual
+  TyClD d@(DataDecl {})     -> ppDataDecl summ links instances fixities subdocs loc mbDoc d splice unicode qual
+  TyClD d@(SynDecl {})      -> ppTySyn summ links fixities loc (mbDoc, fnArgsDoc) d splice unicode qual
+  TyClD d@(ClassDecl {})    -> ppClassDecl summ links instances fixities loc mbDoc subdocs d splice unicode qual
+  SigD (TypeSig lnames lty) -> ppLFunSig summ links loc (mbDoc, fnArgsDoc) lnames
+                                         (hsSigWcType lty) fixities splice unicode qual
+  SigD (PatSynSig lname ty) -> ppLPatSig summ links loc (mbDoc, fnArgsDoc) lname
+                                         ty fixities splice unicode qual
   ForD d                         -> ppFor summ links loc (mbDoc, fnArgsDoc) d fixities splice unicode qual
   InstD _                        -> noHtml
   _                              -> error "declaration not supported by ppDecl"
@@ -59,26 +61,23 @@ ppLFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
              [Located DocName] -> LHsType DocName -> [(DocName, Fixity)] ->
              Splice -> Unicode -> Qualification -> Html
 ppLFunSig summary links loc doc lnames lty fixities splice unicode qual =
-  ppFunSig summary links loc doc (map unLoc lnames) (unLoc lty) fixities
+  ppFunSig summary links loc doc (map unLoc lnames) lty fixities
            splice unicode qual
 
 ppFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
-            [DocName] -> HsType DocName -> [(DocName, Fixity)] ->
+            [DocName] -> LHsType DocName -> [(DocName, Fixity)] ->
             Splice -> Unicode -> Qualification -> Html
 ppFunSig summary links loc doc docnames typ fixities splice unicode qual =
-  ppSigLike summary links loc mempty doc docnames fixities (typ, pp_typ)
+  ppSigLike summary links loc mempty doc docnames fixities (unLoc typ, pp_typ)
             splice unicode qual
   where
-    pp_typ = ppType unicode qual typ
+    pp_typ = ppLType unicode qual typ
 
 ppLPatSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
-             Located DocName ->
-             (HsExplicitFlag, LHsTyVarBndrs DocName) ->
-             LHsContext DocName -> LHsContext DocName ->
-             LHsType DocName ->
+             Located DocName -> LHsSigType DocName ->
              [(DocName, Fixity)] ->
              Splice -> Unicode -> Qualification -> Html
-ppLPatSig summary links loc (doc, _argDocs) (L _ name) (expl, qtvs) lprov lreq typ fixities splice unicode qual
+ppLPatSig summary links loc (doc, _argDocs) (L _ name) typ fixities splice unicode qual
   | summary = pref1
   | otherwise = topDeclElem links loc splice [name] (pref1 <+> ppFixities fixities qual)
                 +++ docSection Nothing qual doc
@@ -86,18 +85,9 @@ ppLPatSig summary links loc (doc, _argDocs) (L _ name) (expl, qtvs) lprov lreq t
     pref1 = hsep [ keyword "pattern"
                  , ppBinder summary occname
                  , dcolon unicode
-                 , ppLTyVarBndrs expl qtvs unicode qual
-                 , cxt
-                 , ppLType unicode qual typ
+                 , ppLType unicode qual (hsSigType typ)
                  ]
 
-    cxt = case (ppLContextMaybe lprov unicode qual, ppLContextMaybe lreq unicode qual) of
-        (Nothing,   Nothing)  -> noHtml
-        (Nothing,   Just req) -> parens noHtml <+> darr <+> req <+> darr
-        (Just prov, Nothing)  -> prov <+> darr
-        (Just prov, Just req) -> prov <+> darr <+> req <+> darr
-
-    darr = darrow unicode
     occname = nameOccName . getName $ name
 
 ppSigLike :: Bool -> LinksInfo -> SrcSpan -> Html -> DocForDecl DocName ->
@@ -131,22 +121,29 @@ ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep)
     argDoc n = Map.lookup n argDocs
 
     do_largs n leader (L _ t) = do_args n leader t
+
     do_args :: Int -> Html -> HsType DocName -> [SubDecl]
-    do_args n leader (HsForAllTy _ _ tvs lctxt ltype)
-      = case unLoc lctxt of
-        [] -> do_largs n leader' ltype
-        _  -> (leader' <+> ppLContextNoArrow lctxt unicode qual, Nothing, [])
-              : do_largs n (darrow unicode) ltype
-      where leader' = leader <+> ppForAll tvs unicode qual
+    do_args n leader (HsForAllTy tvs ltype)
+      = do_largs n leader' ltype
+      where
+        leader' = leader <+> ppForAll tvs unicode qual
+
+    do_args n leader (HsQualTy lctxt ltype)
+      | null (unLoc lctxt)
+      = do_largs n leader ltype
+      | otherwise
+      = (leader <+> ppLContextNoArrow lctxt unicode qual, Nothing, [])
+        : do_largs n (darrow unicode) ltype
+
     do_args n leader (HsFunTy lt r)
       = (leader <+> ppLFunLhType unicode qual lt, argDoc n, [])
         : do_largs (n+1) (arrow unicode) r
     do_args n leader t
       = [(leader <+> ppType unicode qual t, argDoc n, [])]
 
-ppForAll :: LHsTyVarBndrs DocName -> Unicode -> Qualification -> Html
+ppForAll :: [LHsTyVarBndr DocName] -> Unicode -> Qualification -> Html
 ppForAll tvs unicode qual =
-  case [ppKTv n k | L _ (KindedTyVar (L _ n) k) <- hsQTvBndrs tvs] of
+  case [ppKTv n k | L _ (KindedTyVar (L _ n) k) <- tvs] of
     [] -> noHtml
     ts -> forallSymbol unicode <+> hsep ts +++ dot
   where ppKTv n k = parens $
@@ -174,20 +171,19 @@ ppFixities fs qual = foldr1 (+++) (map ppFix uniq_fs) +++ rightEdge
     rightEdge = thespan ! [theclass "rightedge"] << noHtml
 
 
-ppTyVars :: LHsTyVarBndrs DocName -> [Html]
-ppTyVars tvs = map ppTyName (tyvarNames tvs)
-
+ppTyVars :: [LHsTyVarBndr DocName] -> [Html]
+ppTyVars tvs = map (ppTyName . getName . hsLTyVarName) tvs
 
-tyvarNames :: LHsTyVarBndrs DocName -> [Name]
-tyvarNames = map getName . hsLTyVarNames
+tyvarNames :: LHsQTyVars DocName -> [Name]
+tyvarNames = map (getName . hsLTyVarName) . hsQTvExplicit
 
 
 ppFor :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName
       -> ForeignDecl DocName -> [(DocName, Fixity)]
       -> Splice -> Unicode -> Qualification -> Html
-ppFor summary links loc doc (ForeignImport (L _ name) (L _ typ) _ _) fixities
+ppFor summary links loc doc (ForeignImport (L _ name) typ _ _) fixities
       splice unicode qual
-  = ppFunSig summary links loc doc [name] typ fixities splice unicode qual
+  = ppFunSig summary links loc doc [name] (hsSigType typ) fixities splice unicode qual
 ppFor _ _ _ _ _ _ _ _ _ = error "ppFor"
 
 
@@ -202,7 +198,8 @@ ppTySyn summary links fixities loc doc (SynDecl { tcdLName = L _ name, tcdTyVars
                    (full <+> fixs, hdr <+> fixs, spaceHtml +++ equals)
                    splice unicode qual
   where
-    hdr  = hsep ([keyword "type", ppBinder summary occ] ++ ppTyVars ltyvars)
+    hdr  = hsep ([keyword "type", ppBinder summary occ]
+                 ++ ppTyVars (hsQTvExplicit ltyvars))
     full = hdr <+> equals <+> ppLType unicode qual ltype
     occ  = nameOccName . getName $ name
     fixs
@@ -222,15 +219,37 @@ ppTyName :: Name -> Html
 ppTyName = ppName Prefix
 
 
+ppSimpleSig :: LinksInfo -> Splice -> Unicode -> Qualification -> SrcSpan
+            -> [DocName] -> HsType DocName
+            -> Html
+ppSimpleSig links splice unicode qual loc names typ =
+    topDeclElem' names $ ppTypeSig True occNames ppTyp unicode
+  where
+    topDeclElem' = topDeclElem links loc splice
+    ppTyp = ppType unicode qual typ
+    occNames = map getOccName names
+
+
 --------------------------------------------------------------------------------
 -- * Type families
 --------------------------------------------------------------------------------
 
 
+ppFamilyInfo :: Bool -> FamilyInfo DocName -> Html
+ppFamilyInfo assoc OpenTypeFamily
+    | assoc = keyword "type"
+    | otherwise = keyword "type family"
+ppFamilyInfo assoc DataFamily
+    | assoc = keyword "data"
+    | otherwise = keyword "data family"
+ppFamilyInfo _ (ClosedTypeFamily _) = keyword "type family"
+
+
 ppTyFamHeader :: Bool -> Bool -> FamilyDecl DocName
               -> Unicode -> Qualification -> Html
 ppTyFamHeader summary associated d@(FamilyDecl { fdInfo = info
-                                               , fdKindSig = mkind })
+                                             , fdResultSig = L _ result
+                                             , fdInjectivityAnn = injectivity })
               unicode qual =
   (case info of
      OpenTypeFamily
@@ -244,12 +263,32 @@ ppTyFamHeader summary associated d@(FamilyDecl { fdInfo = info
   ) <+>
 
   ppFamDeclBinderWithVars summary d <+>
+  ppResultSig result unicode qual <+>
 
-  (case mkind of
-    Just kind -> dcolon unicode  <+> ppLKind unicode qual kind
-    Nothing   -> noHtml
+  (case injectivity of
+     Nothing                   -> noHtml
+     Just (L _ injectivityAnn) -> ppInjectivityAnn unicode qual injectivityAnn
   )
 
+ppResultSig :: FamilyResultSig DocName -> Unicode -> Qualification -> Html
+ppResultSig result unicode qual = case result of
+    NoSig               -> noHtml
+    KindSig kind        -> dcolon unicode  <+> ppLKind unicode qual kind
+    TyVarSig (L _ bndr) -> equals <+> ppHsTyVarBndr unicode qual bndr
+
+ppPseudoFamilyHeader :: Unicode -> Qualification -> PseudoFamilyDecl DocName
+                     -> Html
+ppPseudoFamilyHeader unicode qual (PseudoFamilyDecl { .. }) =
+    ppFamilyInfo True pfdInfo <+>
+    ppAppNameTypes (unLoc pfdLName) [] (map unLoc pfdTyVars) unicode qual <+>
+    ppResultSig (unLoc pfdKindSig) unicode qual
+
+ppInjectivityAnn :: Bool -> Qualification -> InjectivityAnn DocName -> Html
+ppInjectivityAnn unicode qual (InjectivityAnn lhs rhs) =
+    char '|' <+> ppLDocName qual Raw lhs <+> arrow unicode <+>
+    hsep (map (ppLDocName qual Raw) rhs)
+
+
 ppTyFam :: Bool -> Bool -> LinksInfo -> [DocInstance DocName] ->
            [(DocName, Fixity)] -> SrcSpan -> Documentation DocName ->
            FamilyDecl DocName -> Splice -> Unicode -> Qualification -> Html
@@ -270,15 +309,27 @@ ppTyFam summary associated links instances fixities loc doc decl splice unicode
       = subEquations qual $ map (ppTyFamEqn . unLoc) $ fromMaybe [] mb_eqns
 
       | otherwise
-      = ppInstances instances docname unicode qual
+      = ppInstances links (OriginFamily docname) instances splice unicode qual
 
     -- Individual equation of a closed type family
     ppTyFamEqn TyFamEqn { tfe_tycon = n, tfe_rhs = rhs
-                        , tfe_pats = HsWB { hswb_cts = ts }}
+                        , tfe_pats = HsIB { hsib_body = ts }}
       = ( ppAppNameTypes (unLoc n) [] (map unLoc ts) unicode qual
           <+> equals <+> ppType unicode qual (unLoc rhs)
         , Nothing, [] )
 
+
+
+ppPseudoFamilyDecl :: LinksInfo -> Splice -> Unicode -> Qualification
+                   -> PseudoFamilyDecl DocName
+                   -> Html
+ppPseudoFamilyDecl links splice unicode qual
+                   decl@(PseudoFamilyDecl { pfdLName = L loc name, .. }) =
+    wrapper $ ppPseudoFamilyHeader unicode qual decl
+  where
+    wrapper = topDeclElem links loc splice [name]
+
+
 --------------------------------------------------------------------------------
 -- * Associated Types
 --------------------------------------------------------------------------------
@@ -347,10 +398,6 @@ ppLContext, ppLContextNoArrow :: Located (HsContext DocName) -> Unicode
 ppLContext        = ppContext        . unLoc
 ppLContextNoArrow = ppContextNoArrow . unLoc
 
-
-ppLContextMaybe :: Located (HsContext DocName) -> Unicode -> Qualification -> Maybe Html
-ppLContextMaybe = ppContextNoLocsMaybe . map unLoc . unLoc
-
 ppContextNoArrow :: HsContext DocName -> Unicode -> Qualification -> Html
 ppContextNoArrow cxt unicode qual = fromMaybe noHtml $
                                     ppContextNoLocsMaybe (map unLoc cxt) unicode qual
@@ -381,7 +428,7 @@ ppHsContext cxt unicode qual = parenList (map (ppType unicode qual) cxt)
 
 
 ppClassHdr :: Bool -> Located [LHsType DocName] -> DocName
-           -> LHsTyVarBndrs DocName -> [Located ([Located DocName], [Located DocName])]
+           -> LHsQTyVars DocName -> [Located ([Located DocName], [Located DocName])]
            -> Unicode -> Qualification -> Html
 ppClassHdr summ lctxt n tvs fds unicode qual =
   keyword "class"
@@ -404,7 +451,7 @@ ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocName -> SrcSpan
 ppShortClassDecl summary links (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, tcdTyVars = tvs
                                           , tcdFDs = fds, tcdSigs = sigs, tcdATs = ats }) loc
     subdocs splice unicode qual =
-  if not (any isVanillaLSig sigs) && null ats
+  if not (any isUserLSig sigs) && null ats
     then (if summary then id else topDeclElem links loc splice [nm]) hdr
     else (if summary then id else topDeclElem links loc splice [nm]) (hdr <+> keyword "where")
       +++ shortSubDecls False
@@ -414,8 +461,9 @@ ppShortClassDecl summary links (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, t
 
                 -- ToDo: add associated type defaults
 
-            [ ppFunSig summary links loc doc names typ [] splice unicode qual
-              | L _ (TypeSig lnames (L _ typ) _) <- sigs
+            [ ppFunSig summary links loc doc names (hsSigWcType typ)
+                       [] splice unicode qual
+              | L _ (TypeSig lnames typ) <- sigs
               , let doc = lookupAnySubdoc (head names) subdocs
                     names = map unLoc lnames ]
               -- FIXME: is taking just the first name ok? Is it possible that
@@ -441,8 +489,10 @@ ppClassDecl summary links instances fixities loc d subdocs
   | otherwise = classheader +++ docSection Nothing qual d
                   +++ minimalBit +++ atBit +++ methodBit +++ instancesBit
   where
+    sigs = map unLoc lsigs
+
     classheader
-      | any isVanillaLSig lsigs = topDeclElem links loc splice [nm] (hdr unicode qual <+> keyword "where" <+> fixs)
+      | any isUserLSig lsigs = topDeclElem links loc splice [nm] (hdr unicode qual <+> keyword "where" <+> fixs)
       | otherwise = topDeclElem links loc splice [nm] (hdr unicode qual <+> fixs)
 
     -- Only the fixity relevant to the class header
@@ -459,8 +509,9 @@ ppClassDecl summary links instances fixities loc d subdocs
                             doc = lookupAnySubdoc (unL $ fdLName $ unL at) subdocs
                             subfixs = [ f | f@(n',_) <- fixities, n == n' ] ]
 
-    methodBit = subMethods [ ppFunSig summary links loc doc names typ subfixs splice unicode qual
-                           | L _ (TypeSig lnames (L _ typ) _) <- lsigs
+    methodBit = subMethods [ ppFunSig summary links loc doc names (hsSigType typ)
+                                      subfixs splice unicode qual
+                           | L _ (ClassOpSig _ lnames typ) <- lsigs
                            , let doc = lookupAnySubdoc (head names) subdocs
                                  subfixs = [ f | n <- names
                                                , f@(n',_) <- fixities
@@ -470,15 +521,15 @@ ppClassDecl summary links instances fixities loc d subdocs
                            -- there are different subdocs for different names in a single
                            -- type signature?
 
-    minimalBit = case [ s | L _ (MinimalSig _ s) <- lsigs ] of
+    minimalBit = case [ s | MinimalSig _ (L _ s) <- sigs ] of
       -- Miminal complete definition = every shown method
-      And xs : _ | sort [getName n | Var (L _ n) <- xs] ==
-                   sort [getName n | L _ (TypeSig ns _ _) <- lsigs, L _ n <- ns]
+      And xs : _ | sort [getName n | L _ (Var (L _ n)) <- xs] ==
+                   sort [getName n | TypeSig ns _ <- sigs, L _ n <- ns]
         -> noHtml
 
       -- Minimal complete definition = the only shown method
       Var (L _ n) : _ | [getName n] ==
-                        [getName n' | L _ (TypeSig ns _ _) <- lsigs, L _ n' <- ns]
+                        [getName n' | L _ (TypeSig ns _) <- lsigs, L _ n' <- ns]
         -> noHtml
 
       -- Minimal complete definition = nothing
@@ -488,35 +539,98 @@ ppClassDecl summary links instances fixities loc d subdocs
       _ -> noHtml
 
     ppMinimal _ (Var (L _ n)) = ppDocName qual Prefix True n
-    ppMinimal _ (And fs) = foldr1 (\a b -> a+++", "+++b) $ map (ppMinimal True) fs
-    ppMinimal p (Or fs) = wrap $ foldr1 (\a b -> a+++" | "+++b) $ map (ppMinimal False) fs
+    ppMinimal _ (And fs) = foldr1 (\a b -> a+++", "+++b) $ map (ppMinimal True . unLoc) fs
+    ppMinimal p (Or fs) = wrap $ foldr1 (\a b -> a+++" | "+++b) $ map (ppMinimal False . unLoc) fs
       where wrap | p = parens | otherwise = id
+    ppMinimal p (Parens x) = ppMinimal p (unLoc x)
 
-    instancesBit = ppInstances instances nm unicode qual
+    instancesBit = ppInstances links (OriginClass nm) instances
+        splice unicode qual
 
 ppClassDecl _ _ _ _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl"
 
 
-ppInstances :: [DocInstance DocName] -> DocName -> Unicode -> Qualification -> Html
-ppInstances instances baseName unicode qual
-  = subInstances qual instName (map instDecl instances)
+ppInstances :: LinksInfo
+            -> InstOrigin DocName -> [DocInstance DocName]
+            -> Splice -> Unicode -> Qualification
+            -> Html
+ppInstances links origin instances splice unicode qual
+  = subInstances qual instName links True (zipWith instDecl [1..] instances)
+  -- force Splice = True to use line URLs
   where
-    instName = getOccString $ getName baseName
-    instDecl :: DocInstance DocName -> SubDecl
-    instDecl (inst, maybeDoc) = (instHead inst, maybeDoc, [])
-    instHead (n, ks, ts, ClassInst cs) = ppContextNoLocs cs unicode qual
-        <+> ppAppNameTypes n ks ts unicode qual
-    instHead (n, ks, ts, TypeInst rhs) = keyword "type"
-        <+> ppAppNameTypes n ks ts unicode qual
-        <+> maybe noHtml (\t -> equals <+> ppType unicode qual t) rhs
-    instHead (n, ks, ts, DataInst dd) = keyword "data"
-        <+> ppAppNameTypes n ks ts unicode qual
-        <+> ppShortDataDecl False True dd unicode qual
+    instName = getOccString origin
+    instDecl :: Int -> DocInstance DocName -> (SubDecl,Located DocName)
+    instDecl no (inst, mdoc, loc) =
+        ((ppInstHead links splice unicode qual mdoc origin no inst), loc)
+
+
+ppInstHead :: LinksInfo -> Splice -> Unicode -> Qualification
+           -> Maybe (MDoc DocName)
+           -> InstOrigin DocName -> Int -> InstHead DocName
+           -> SubDecl
+ppInstHead links splice unicode qual mdoc origin no ihd@(InstHead {..}) =
+    case ihdInstType of
+        ClassInst { .. } ->
+            ( subInstHead iid $ ppContextNoLocs clsiCtx unicode qual <+> typ
+            , mdoc
+            , [subInstDetails iid ats sigs]
+            )
+          where
+            iid = instanceId origin no ihd
+            sigs = ppInstanceSigs links splice unicode qual clsiSigs
+            ats = ppInstanceAssocTys links splice unicode qual clsiAssocTys
+        TypeInst rhs ->
+            (ptype, mdoc, [])
+          where
+            ptype = keyword "type" <+> typ <+> prhs
+            prhs = maybe noHtml (\t -> equals <+> ppType unicode qual t) rhs
+        DataInst dd ->
+            (pdata, mdoc, [])
+          where
+            pdata = keyword "data" <+> typ <+> pdecl
+            pdecl = ppShortDataDecl False True dd unicode qual
+  where
+    typ = ppAppNameTypes ihdClsName ihdKinds ihdTypes unicode qual
+
+
+ppInstanceAssocTys :: LinksInfo -> Splice -> Unicode -> Qualification
+                   -> [PseudoFamilyDecl DocName]
+                   -> [Html]
+ppInstanceAssocTys links splice unicode qual =
+    map ppFamilyDecl'
+  where
+    ppFamilyDecl' = ppPseudoFamilyDecl links splice unicode qual
+
+
+ppInstanceSigs :: LinksInfo -> Splice -> Unicode -> Qualification
+              -> [Sig DocName]
+              -> [Html]
+ppInstanceSigs links splice unicode qual sigs = do
+    TypeSig lnames typ <- sigs
+    let names = map unLoc lnames
+        L loc rtyp = get_type typ
+    return $ ppSimpleSig links splice unicode qual loc names rtyp
+    where
+      get_type = hswc_body . hsib_body
+
 
 lookupAnySubdoc :: Eq id1 => id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2
 lookupAnySubdoc n = fromMaybe noDocForDecl . lookup n
 
 
+instanceId :: InstOrigin DocName -> Int -> InstHead DocName -> String
+instanceId origin no ihd = concat
+    [ qual origin
+    , ":" ++ getOccString origin
+    , ":" ++ (occNameString . getOccName . ihdClsName) ihd
+    , ":" ++ show no
+    ]
+  where
+    qual (OriginClass _) = "ic"
+    qual (OriginData _) = "id"
+    qual (OriginFamily _) = "if"
+
+
 -------------------------------------------------------------------------------
 -- * Data & newtype declarations
 -------------------------------------------------------------------------------
@@ -528,11 +642,11 @@ ppShortDataDecl summary dataInst dataDecl unicode qual
 
   | [] <- cons = dataHeader
 
-  | [lcon] <- cons, ResTyH98 <- resTy,
+  | [lcon] <- cons, isH98,
     (cHead,cBody,cFoot) <- ppShortConstrParts summary dataInst (unLoc lcon) unicode qual
        = (dataHeader <+> equals <+> cHead) +++ cBody +++ cFoot
 
-  | ResTyH98 <- resTy = dataHeader
+  | isH98 = dataHeader
       +++ shortSubDecls dataInst (zipWith doConstr ('=':repeat '|') cons)
 
   | otherwise = (dataHeader <+> keyword "where")
@@ -546,7 +660,9 @@ ppShortDataDecl summary dataInst dataDecl unicode qual
     doGADTConstr con = ppShortConstr summary (unLoc con) unicode qual
 
     cons      = dd_cons (tcdDataDefn dataDecl)
-    resTy     = (con_res . unLoc . head) cons
+    isH98     = case unLoc (head cons) of
+                  ConDeclH98 {} -> True
+                  ConDeclGADT{} -> False
 
 
 ppDataDecl :: Bool -> LinksInfo -> [DocInstance DocName] -> [(DocName, Fixity)] ->
@@ -562,7 +678,9 @@ ppDataDecl summary links instances fixities subdocs loc doc dataDecl
   where
     docname   = tcdName dataDecl
     cons      = dd_cons (tcdDataDefn dataDecl)
-    resTy     = (con_res . unLoc . head) cons
+    isH98     = case unLoc (head cons) of
+                  ConDeclH98 {} -> True
+                  ConDeclGADT{} -> False
 
     header_ = topDeclElem links loc splice [docname] $
              ppDataHeader summary dataDecl unicode qual <+> whereBit <+> fix
@@ -571,18 +689,17 @@ ppDataDecl summary links instances fixities subdocs loc doc dataDecl
 
     whereBit
       | null cons = noHtml
-      | otherwise = case resTy of
-        ResTyGADT _ _ -> keyword "where"
-        _ -> noHtml
+      | otherwise = if isH98 then noHtml else keyword "where"
 
     constrBit = subConstructors qual
       [ ppSideBySideConstr subdocs subfixs unicode qual c
       | c <- cons
       , let subfixs = filter (\(n,_) -> any (\cn -> cn == n)
-                                     (map unLoc (con_names (unLoc c)))) fixities
+                                     (map unLoc (getConNames (unLoc c)))) fixities
       ]
 
-    instancesBit = ppInstances instances docname unicode qual
+    instancesBit = ppInstances links (OriginData docname) instances
+        splice unicode qual
 
 
 
@@ -595,8 +712,8 @@ ppShortConstr summary con unicode qual = cHead <+> cBody <+> cFoot
 -- returns three pieces: header, body, footer so that header & footer can be
 -- incorporated into the declaration
 ppShortConstrParts :: Bool -> Bool -> ConDecl DocName -> Unicode -> Qualification -> (Html, Html, Html)
-ppShortConstrParts summary dataInst con unicode qual = case con_res con of
-  ResTyH98 -> case con_details con of
+ppShortConstrParts summary dataInst con unicode qual = case con of
+  ConDeclH98{} -> case con_details con of
     PrefixCon args ->
       (header_ unicode qual +++ hsep (ppOcc
             : map (ppLParendType unicode qual) args), noHtml, noHtml)
@@ -609,28 +726,15 @@ ppShortConstrParts summary dataInst con unicode qual = case con_res con of
             ppOccInfix, ppLParendType unicode qual arg2],
        noHtml, noHtml)
 
-  ResTyGADT _ resTy -> case con_details con of
-    -- prefix & infix could use hsConDeclArgTys if it seemed to
-    -- simplify the code.
-    PrefixCon args -> (doGADTCon args resTy, noHtml, noHtml)
-    -- display GADT records with the new syntax,
-    -- Constr :: (Context) => { field :: a, field2 :: b } -> Ty (a, b)
-    -- (except each field gets its own line in docs, to match
-    -- non-GADT records)
-    RecCon (L _ fields) -> (ppOcc <+> dcolon unicode <+>
-                            ppForAllCon forall_ ltvs lcontext unicode qual <+> char '{',
-                            doRecordFields fields,
-                            char '}' <+> arrow unicode <+> ppLType unicode qual resTy)
-    InfixCon arg1 arg2 -> (doGADTCon [arg1, arg2] resTy, noHtml, noHtml)
+  ConDeclGADT {} -> (ppOcc <+> dcolon unicode <+> ppLType unicode qual resTy,noHtml,noHtml)
 
   where
+    resTy = hsib_body (con_type con)
+
     doRecordFields fields = shortSubDecls dataInst (map (ppShortField summary unicode qual) (map unLoc fields))
-    doGADTCon args resTy = ppOcc <+> dcolon unicode <+> hsep [
-                             ppForAllCon forall_ ltvs lcontext unicode qual,
-                             ppLType unicode qual (foldr mkFunTy resTy args) ]
 
     header_  = ppConstrHdr forall_ tyVars context
-    occ        = map (nameOccName . getName . unLoc) $ con_names con
+    occ        = map (nameOccName . getName . unLoc) $ getConNames con
 
     ppOcc      = case occ of
       [one] -> ppBinder summary one
@@ -640,35 +744,34 @@ ppShortConstrParts summary dataInst con unicode qual = case con_res con of
       [one] -> ppBinderInfix summary one
       _     -> hsep (punctuate comma (map (ppBinderInfix summary) occ))
 
-    ltvs     = con_qvars con
+    ltvs     = fromMaybe (HsQTvs PlaceHolder []) (con_qvars con)
     tyVars   = tyvarNames ltvs
-    lcontext = con_cxt con
-    context  = unLoc (con_cxt con)
-    forall_  = con_explicit con
-    mkFunTy a b = noLoc (HsFunTy a b)
+    lcontext = fromMaybe (noLoc []) (con_cxt con)
+    context  = unLoc lcontext
+    forall_  = False
 
 
 -- ppConstrHdr is for (non-GADT) existentials constructors' syntax
-ppConstrHdr :: HsExplicitFlag -> [Name] -> HsContext DocName -> Unicode
+ppConstrHdr :: Bool -> [Name] -> HsContext DocName -> Unicode
             -> Qualification -> Html
 ppConstrHdr forall_ tvs ctxt unicode qual
  = (if null tvs then noHtml else ppForall)
    +++
-   (if null ctxt then noHtml else ppContextNoArrow ctxt unicode qual
-        <+> darrow unicode +++ toHtml " ")
+   (if null ctxt then noHtml
+    else ppContextNoArrow ctxt unicode qual
+         <+> darrow unicode +++ toHtml " ")
   where
-    ppForall = case forall_ of
-      Explicit -> forallSymbol unicode <+> hsep (map (ppName Prefix) tvs) <+> toHtml ". "
-      Qualified -> noHtml
-      Implicit -> noHtml
-
+    ppForall | forall_   = forallSymbol unicode <+> hsep (map (ppName Prefix) tvs)
+                           <+> toHtml ". "
+             | otherwise = noHtml
 
 ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> [(DocName, Fixity)]
                    -> Unicode -> Qualification -> LConDecl DocName -> SubDecl
-ppSideBySideConstr subdocs fixities unicode qual (L _ con) = (decl, mbDoc, fieldPart)
+ppSideBySideConstr subdocs fixities unicode qual (L _ con)
+ = (decl, mbDoc, fieldPart)
  where
-    decl = case con_res con of
-      ResTyH98 -> case con_details con of
+    decl = case con of
+      ConDeclH98{} -> case con_details con of
         PrefixCon args ->
           hsep ((header_ +++ ppOcc)
             : map (ppLParendType unicode qual) args)
@@ -682,28 +785,26 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con) = (decl, mbDoc, field
             ppLParendType unicode qual arg2]
           <+> fixity
 
-      ResTyGADT _ resTy -> case con_details con of
-        -- prefix & infix could also use hsConDeclArgTys if it seemed to
-        -- simplify the code.
-        PrefixCon args -> doGADTCon args resTy
-        cd@(RecCon _) -> doGADTCon (hsConDeclArgTys cd) resTy
-        InfixCon arg1 arg2 -> doGADTCon [arg1, arg2] resTy
+      ConDeclGADT{} -> doGADTCon resTy
+
+    resTy = hsib_body (con_type con)
 
-    fieldPart = case con_details con of
+    fieldPart = case getConDetails con of
         RecCon (L _ fields) -> [doRecordFields fields]
         _ -> []
 
     doRecordFields fields = subFields qual
       (map (ppSideBySideField subdocs unicode qual) (map unLoc fields))
-    doGADTCon :: [LHsType DocName] -> Located (HsType DocName) -> Html
-    doGADTCon args resTy = ppOcc <+> dcolon unicode
-        <+> hsep [ppForAllCon forall_ ltvs (con_cxt con) unicode qual,
-                  ppLType unicode qual (foldr mkFunTy resTy args) ]
+
+    doGADTCon :: Located (HsType DocName) -> Html
+    doGADTCon ty = ppOcc <+> dcolon unicode
+        -- ++AZ++ make this prepend "{..}" when it is a record style GADT
+        <+> ppLType unicode qual ty
         <+> fixity
 
     fixity  = ppFixities fixities qual
     header_ = ppConstrHdr forall_ tyVars context unicode qual
-    occ       = map (nameOccName . getName . unLoc) $ con_names con
+    occ       = map (nameOccName . getName . unLoc) $ getConNames con
 
     ppOcc     = case occ of
       [one] -> ppBinder False one
@@ -713,32 +814,30 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con) = (decl, mbDoc, field
       [one] -> ppBinderInfix False one
       _     -> hsep (punctuate comma (map (ppBinderInfix False) occ))
 
-    ltvs    = con_qvars con
-    tyVars  = tyvarNames (con_qvars con)
-    context = unLoc (con_cxt con)
-    forall_ = con_explicit con
+    tyVars  = tyvarNames (fromMaybe (HsQTvs PlaceHolder []) (con_qvars con))
+    context = unLoc (fromMaybe (noLoc []) (con_cxt con))
+    forall_ = False
     -- don't use "con_doc con", in case it's reconstructed from a .hi file,
     -- or also because we want Haddock to do the doc-parsing, not GHC.
-    mbDoc = lookup (unLoc $ head $ con_names con) subdocs >>=
+    mbDoc = lookup (unLoc $ head $ getConNames con) subdocs >>=
             combineDocumentation . fst
-    mkFunTy a b = noLoc (HsFunTy a b)
 
 
 ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Unicode -> Qualification
                   -> ConDeclField DocName -> SubDecl
 ppSideBySideField subdocs unicode qual (ConDeclField names ltype _) =
-  (hsep (punctuate comma (map ((ppBinder False) . nameOccName . getName . unL) names)) <+> dcolon unicode <+> ppLType unicode qual ltype,
+  (hsep (punctuate comma (map ((ppBinder False) . rdrNameOcc . rdrNameFieldOcc . unLoc) names)) <+> dcolon unicode <+> ppLType unicode qual ltype,
     mbDoc,
     [])
   where
     -- don't use cd_fld_doc for same reason we don't use con_doc above
     -- Where there is more than one name, they all have the same documentation
-    mbDoc = lookup (unL $ head names) subdocs >>= combineDocumentation . fst
+    mbDoc = lookup (selectorFieldOcc $ unLoc $ head names) subdocs >>= combineDocumentation . fst
 
 
 ppShortField :: Bool -> Unicode -> Qualification -> ConDeclField DocName -> Html
 ppShortField summary unicode qual (ConDeclField names ltype _)
-  = hsep (punctuate comma (map ((ppBinder summary) . nameOccName . getName . unL) names))
+  = hsep (punctuate comma (map ((ppBinder summary) . rdrNameOcc . rdrNameFieldOcc . unLoc) names))
     <+> dcolon unicode <+> ppLType unicode qual ltype
 
 
@@ -768,10 +867,10 @@ ppDataHeader _ _ _ _ = error "ppDataHeader: illegal argument"
 --------------------------------------------------------------------------------
 
 
-ppBang :: HsBang -> Html
-ppBang HsNoBang = noHtml
-ppBang _        = toHtml "!" -- Unpacked args is an implementation detail,
-                             -- so we just show the strictness annotation
+ppBang :: HsSrcBang -> Html
+ppBang (HsSrcBang _ _ SrcStrict) = toHtml "!"
+ppBang (HsSrcBang _ _ SrcLazy)   = toHtml "~"
+ppBang _                         = noHtml
 
 
 tupleParens :: HsTupleSort -> [Html] -> Html
@@ -817,52 +916,42 @@ ppCtxType    unicode qual ty = ppr_mono_ty pREC_CTX ty unicode qual
 ppParendType unicode qual ty = ppr_mono_ty pREC_CON ty unicode qual
 ppFunLhType  unicode qual ty = ppr_mono_ty pREC_FUN ty unicode qual
 
+ppHsTyVarBndr :: Unicode -> Qualification -> HsTyVarBndr DocName -> Html
+ppHsTyVarBndr _       qual (UserTyVar (L _ name)) =
+    ppDocName qual Raw False name
+ppHsTyVarBndr unicode qual (KindedTyVar name kind) =
+    parens (ppDocName qual Raw False (unLoc name) <+> dcolon unicode <+>
+            ppLKind unicode qual kind)
+
 ppLKind :: Unicode -> Qualification -> LHsKind DocName -> Html
 ppLKind unicode qual y = ppKind unicode qual (unLoc y)
 
 ppKind :: Unicode -> Qualification -> HsKind DocName -> Html
 ppKind unicode qual ki = ppr_mono_ty pREC_TOP ki unicode qual
 
--- Drop top-level for-all type variables in user style
--- since they are implicit in Haskell
-
-ppForAllCon :: HsExplicitFlag -> LHsTyVarBndrs DocName
-         -> Located (HsContext DocName) -> Unicode -> Qualification -> Html
-ppForAllCon expl tvs cxt unicode qual =
-  forall_part <+> ppLContext cxt unicode qual
-  where
-    forall_part = ppLTyVarBndrs expl tvs unicode qual
-
-ppLTyVarBndrs :: HsExplicitFlag -> LHsTyVarBndrs DocName
-              -> Unicode -> Qualification
-              -> Html
-ppLTyVarBndrs expl tvs unicode _qual
-  | show_forall = hsep (forallSymbol unicode : ppTyVars tvs) +++ dot
-  | otherwise   = noHtml
-  where
-    show_forall = not (null (hsQTvBndrs tvs)) && is_explicit
-    is_explicit = case expl of {Explicit -> True; Implicit -> False; Qualified -> False}
-
+ppForAllPart :: [LHsTyVarBndr DocName] -> Unicode -> Html
+ppForAllPart tvs unicode = hsep (forallSymbol unicode : ppTyVars tvs) +++ dot
 
 ppr_mono_lty :: Int -> LHsType DocName -> Unicode -> Qualification -> Html
 ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
 
 
 ppr_mono_ty :: Int -> HsType DocName -> Unicode -> Qualification -> Html
-ppr_mono_ty ctxt_prec (HsForAllTy expl extra tvs ctxt ty) unicode qual
-  = maybeParen ctxt_prec pREC_FUN $ ppForAllCon expl tvs ctxt' unicode qual
-                                    <+> ppr_mono_lty pREC_TOP ty unicode qual
- where ctxt' = case extra of
-                 Just loc -> (++ [L loc HsWildcardTy]) `fmap` ctxt
-                 Nothing  -> ctxt
+ppr_mono_ty ctxt_prec (HsForAllTy tvs ty) unicode qual
+  = maybeParen ctxt_prec pREC_FUN $
+    ppForAllPart tvs unicode <+> ppr_mono_lty pREC_TOP ty unicode qual
+
+ppr_mono_ty ctxt_prec (HsQualTy ctxt ty) unicode qual
+  = maybeParen ctxt_prec pREC_FUN $
+    ppLContext ctxt unicode qual <+> ppr_mono_lty pREC_TOP ty unicode qual
 
 -- UnicodeSyntax alternatives
-ppr_mono_ty _ (HsTyVar name) True _
+ppr_mono_ty _ (HsTyVar (L _ name)) True _
   | getOccString (getName name) == "*"    = toHtml "★"
   | getOccString (getName name) == "(->)" = toHtml "(→)"
 
 ppr_mono_ty _         (HsBangTy b ty)     u q = ppBang b +++ ppLParendType u q ty
-ppr_mono_ty _         (HsTyVar name)      _ q = ppDocName q Prefix True name
+ppr_mono_ty _         (HsTyVar (L _ name)) _ q = ppDocName q Prefix True name
 ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   u q = ppr_fun_ty ctxt_prec ty1 ty2 u q
 ppr_mono_ty _         (HsTupleTy con tys) u q = tupleParens con (map (ppLType u q) tys)
 ppr_mono_ty _         (HsKindSig ty kind) u q =
@@ -872,11 +961,14 @@ ppr_mono_ty _         (HsPArrTy ty)       u q = pabrackets (ppr_mono_lty pREC_TO
 ppr_mono_ty ctxt_prec (HsIParamTy n ty)   u q =
     maybeParen ctxt_prec pREC_CTX $ ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q
 ppr_mono_ty _         (HsSpliceTy {})     _ _ = error "ppr_mono_ty HsSpliceTy"
-ppr_mono_ty _         (HsRecTy {})        _ _ = error "ppr_mono_ty HsRecTy"
+ppr_mono_ty _         (HsRecTy {})        _ _ = toHtml "{..}"
+       -- Can now legally occur in ConDeclGADT, the output here is to provide a
+       -- placeholder in the signature, which is followed by the field
+       -- declarations.
 ppr_mono_ty _         (HsCoreTy {})       _ _ = error "ppr_mono_ty HsCoreTy"
-ppr_mono_ty _         (HsExplicitListTy _ tys) u q = quote $ brackets $ hsep $ punctuate comma $ map (ppLType u q) tys
-ppr_mono_ty _         (HsExplicitTupleTy _ tys) u q = quote $ parenList $ map (ppLType u q) tys
-ppr_mono_ty _         (HsWrapTy {})       _ _ = error "ppr_mono_ty HsWrapTy"
+ppr_mono_ty _         (HsExplicitListTy _ tys) u q = promoQuote $ brackets $ hsep $ punctuate comma $ map (ppLType u q) tys
+ppr_mono_ty _         (HsExplicitTupleTy _ tys) u q = promoQuote $ parenList $ map (ppLType u q) tys
+ppr_mono_ty _         (HsAppsTy {})       _ _ = error "ppr_mono_ty HsAppsTy"
 
 ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode qual
   = maybeParen ctxt_prec pREC_CTX $
@@ -886,11 +978,16 @@ ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode qual
   = maybeParen ctxt_prec pREC_CON $
     hsep [ppr_mono_lty pREC_FUN fun_ty unicode qual, ppr_mono_lty pREC_CON arg_ty unicode qual]
 
-ppr_mono_ty ctxt_prec (HsOpTy ty1 (_, op) ty2) unicode qual
+ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) unicode qual
   = maybeParen ctxt_prec pREC_FUN $
     ppr_mono_lty pREC_OP ty1 unicode qual <+> ppr_op <+> ppr_mono_lty pREC_OP ty2 unicode qual
   where
-    ppr_op = ppLDocName qual Infix op
+    -- `(:)` is valid in type signature only as constructor to promoted list
+    -- and needs to be quoted in code so we explicitly quote it here too.
+    ppr_op
+        | (getOccString . getName . unLoc) op == ":" = promoQuote ppr_op'
+        | otherwise = ppr_op'
+    ppr_op' = ppLDocName qual Infix op
 
 ppr_mono_ty ctxt_prec (HsParTy ty) unicode qual
 --  = parens (ppr_mono_lty pREC_TOP ty)
@@ -899,9 +996,9 @@ ppr_mono_ty ctxt_prec (HsParTy ty) unicode qual
 ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode qual
   = ppr_mono_lty ctxt_prec ty unicode qual
 
-ppr_mono_ty _ HsWildcardTy _ _ = char '_'
+ppr_mono_ty _ (HsWildCardTy (AnonWildCard _)) _ _ = char '_'
 
-ppr_mono_ty _ (HsNamedWildcardTy name) _ q = ppDocName q Prefix True name
+ppr_mono_ty _ (HsWildCardTy (NamedWildCard (L _ name))) _ q = ppDocName q Prefix True name
 
 ppr_mono_ty _ (HsTyLit n) _ _ = ppr_tylit n
 
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
index 96d734eb..3fe74a82 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
@@ -19,8 +19,6 @@ module Haddock.Backends.Xhtml.DocMarkup (
   docElement, docSection, docSection_,
 ) where
 
-import Control.Applicative ((<$>))
-
 import Data.List
 import Haddock.Backends.Xhtml.Names
 import Haddock.Backends.Xhtml.Utils
@@ -64,7 +62,10 @@ parHtmlMarkup qual insertAnchors ppId = Markup {
                                   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,
@@ -160,8 +161,9 @@ hackMarkup fmt' h' =
       UntouchedDoc d -> (markup fmt $ _doc d, [_meta d])
       CollapsingHeader (Header lvl titl) par n nm ->
         let id_ = makeAnchorId $ "ch:" ++ fromMaybe "noid:" nm ++ show n
-            col' = collapseControl id_ True "caption"
-            instTable = (thediv ! collapseSection id_ False [] <<)
+            expanded = False
+            col' = collapseControl id_ expanded "caption"
+            instTable = (thediv ! collapseSection id_ expanded [] <<)
             lvs = zip [1 .. ] [h1, h2, h3, h4, h5, h6]
             getHeader = fromMaybe caption (lookup lvl lvs)
             subCaption = getHeader ! col' << markup fmt titl
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index b2c60534..d24ed9c4 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -14,7 +14,7 @@ module Haddock.Backends.Xhtml.Layout (
   miniBody,
 
   divPackageHeader, divContent, divModuleHeader, divFooter,
-  divTableOfContents, divDescription, divSynposis, divInterface,
+  divTableOfContents, divDescription, divSynopsis, divInterface,
   divIndex, divAlphabet, divModuleList,
 
   sectionName,
@@ -31,7 +31,7 @@ module Haddock.Backends.Xhtml.Layout (
   subConstructors,
   subEquations,
   subFields,
-  subInstances,
+  subInstances, subInstHead, subInstDetails,
   subMethods,
   subMinimal,
 
@@ -44,7 +44,6 @@ import Haddock.Backends.Xhtml.Types
 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 )
 
@@ -77,7 +76,7 @@ nonEmptySectionName c
 
 
 divPackageHeader, divContent, divModuleHeader, divFooter,
-  divTableOfContents, divDescription, divSynposis, divInterface,
+  divTableOfContents, divDescription, divSynopsis, divInterface,
   divIndex, divAlphabet, divModuleList
     :: Html -> Html
 
@@ -87,7 +86,7 @@ divModuleHeader     = sectionDiv "module-header"
 divFooter           = sectionDiv "footer"
 divTableOfContents  = sectionDiv "table-of-contents"
 divDescription      = sectionDiv "description"
-divSynposis         = sectionDiv "synopsis"
+divSynopsis         = sectionDiv "synopsis"
 divInterface        = sectionDiv "interface"
 divIndex            = sectionDiv "index"
 divAlphabet         = sectionDiv "alphabet"
@@ -128,14 +127,12 @@ divSubDecls cssClass captionName = maybe noHtml wrap
 
 subDlist :: Qualification -> [SubDecl] -> Maybe Html
 subDlist _ [] = Nothing
-subDlist qual decls = Just $ dlist << map subEntry decls +++ clearDiv
+subDlist qual decls = Just $ ulist << map subEntry decls
   where
     subEntry (decl, mdoc, subs) =
-      dterm ! [theclass "src"] << decl
-      +++
-      docElement ddef << (fmap (docToHtml Nothing qual) mdoc +++ subs)
-
-    clearDiv = thediv ! [ theclass "clear" ] << noHtml
+      li <<
+        (define ! [theclass "src"] << decl +++
+         docElement thediv << (fmap (docToHtml Nothing qual) mdoc +++ subs))
 
 
 subTable :: Qualification -> [SubDecl] -> Maybe Html
@@ -149,6 +146,22 @@ subTable qual decls = Just $ table << aboves (concatMap subRow decls)
       : map (cell . (td <<)) subs
 
 
+-- | Sub table with source information (optional).
+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),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 _) dn = links lnks loc splice dn
+    linkHtml _ _ = noHtml
+
 subBlock :: [Html] -> Maybe Html
 subBlock [] = Nothing
 subBlock hs = Just $ toHtml hs
@@ -174,17 +187,43 @@ subEquations :: Qualification -> [SubDecl] -> Html
 subEquations qual = divSubDecls "equations" "Equations" . subTable qual
 
 
+-- | Generate sub table for instance declarations, with source
 subInstances :: Qualification
              -> String -- ^ Class name, used for anchor generation
-             -> [SubDecl] -> Html
-subInstances qual nm = 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 [] <<) . subTable qual
+    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
 
+ 
+subInstHead :: String -- ^ Instance unique id (for anchor generation)
+            -> Html -- ^ Header content (instance name and type)
+            -> Html
+subInstHead iid hdr =
+    expander noHtml <+> hdr
+  where
+    expander = thespan ! collapseControl (instAnchorId iid) False "instance"
+
+
+subInstDetails :: String -- ^ Instance unique id (for anchor generation)
+               -> [Html] -- ^ Associated type contents
+               -> [Html] -- ^ Method contents (pretty-printed signatures)
+               -> Html
+subInstDetails iid ats mets =
+    section << (subAssociatedTypes ats <+> subMethods mets)
+  where
+    section = thediv ! collapseSection (instAnchorId iid) False "inst-details"
+
+
+instAnchorId :: String -> String
+instAnchorId iid = makeAnchorId $ "i:" ++ iid
+
+
 subMethods :: [Html] -> Html
 subMethods = divSubDecls "methods" "Methods" . subBlock
 
@@ -200,12 +239,19 @@ declElem = paragraph ! [theclass "src"]
 -- a box for top level documented names
 -- it adds a source and wiki link at the right hand side of the box
 topDeclElem :: LinksInfo -> SrcSpan -> Bool -> [DocName] -> Html -> Html
-topDeclElem ((_,_,sourceMap,lineMap), (_,_,maybe_wiki_url)) loc splice names html =
-    declElem << (html <+> srcLink <+> wikiLink)
+topDeclElem lnks loc splice names html =
+    declElem << (html <+> (links lnks loc splice $ head names))
+        -- FIXME: is it ok to simply take the first name?
+
+-- | Adds a source and wiki link at the right hand side of the box.
+-- Name must be documented, otherwise we wouldn't get here.
+links :: LinksInfo -> SrcSpan -> Bool -> DocName -> Html
+links ((_,_,sourceMap,lineMap), (_,_,maybe_wiki_url)) loc splice (Documented n mdl) =
+   (srcLink <+> wikiLink)
   where srcLink = let nameUrl = Map.lookup origPkg sourceMap
                       lineUrl = Map.lookup origPkg lineMap
                       mUrl | splice    = lineUrl
-                                         -- Use the lineUrl as a backup
+                                        -- Use the lineUrl as a backup
                            | otherwise = maybe lineUrl Just nameUrl in
           case mUrl of
             Nothing  -> noHtml
@@ -225,12 +271,9 @@ topDeclElem ((_,_,sourceMap,lineMap), (_,_,maybe_wiki_url)) loc splice names htm
         -- TODO: do something about type instances. They will point to
         -- the module defining the type family, which is wrong.
         origMod = nameModule n
-        origPkg = modulePackageKey origMod
-
-        -- Name must be documented, otherwise we wouldn't get here
-        Documented n mdl = head names
-        -- FIXME: is it ok to simply take the first name?
+        origPkg = moduleUnitId origMod
 
         fname = case loc of
-                RealSrcSpan l -> unpackFS (srcSpanFile l)
-                UnhelpfulSpan _ -> error "topDeclElem UnhelpfulSpan"
+          RealSrcSpan l -> unpackFS (srcSpanFile l)
+          UnhelpfulSpan _ -> error "links: UnhelpfulSpan"
+links _ _ _ _ = noHtml
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Names.hs b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs
index cf12da40..c69710d1 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Names.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs
@@ -110,16 +110,21 @@ ppName notation name = wrapInfix notation (getOccName name) $ toHtml (getOccStri
 
 
 ppBinder :: Bool -> OccName -> Html
--- The Bool indicates whether we are generating the summary, in which case
--- the binder will be a link to the full definition.
-ppBinder True n = linkedAnchor (nameAnchorId n) << ppBinder' Prefix n
-ppBinder False n = namedAnchor (nameAnchorId n) ! [theclass "def"]
-                        << ppBinder' Prefix n
+ppBinder = ppBinderWith Prefix
 
 ppBinderInfix :: Bool -> OccName -> Html
-ppBinderInfix True n = linkedAnchor (nameAnchorId n) << ppBinder' Infix n
-ppBinderInfix False n = namedAnchor (nameAnchorId n) ! [theclass "def"]
-                             << ppBinder' Infix n
+ppBinderInfix = ppBinderWith Infix
+
+ppBinderWith :: Notation -> Bool -> OccName -> Html
+-- 'isRef' indicates whether this is merely a reference from another part of
+-- the documentation or is the actual definition; in the latter case, we also
+-- set the 'id' and 'class' attributes.
+ppBinderWith notation isRef n =
+  linkedAnchor name ! attributes << ppBinder' notation n
+  where
+    name = nameAnchorId n
+    attributes | isRef     = []
+               | otherwise = [identifier name, theclass "def"]
 
 ppBinder' :: Notation -> OccName -> Html
 ppBinder' notation n = wrapInfix notation n $ ppOccName n
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Themes.hs b/haddock-api/src/Haddock/Backends/Xhtml/Themes.hs
index 79b093ec..10d6ab10 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Themes.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Themes.hs
@@ -18,7 +18,6 @@ module Haddock.Backends.Xhtml.Themes (
 
 import Haddock.Options
 
-import Control.Applicative
 import Control.Monad (liftM)
 import Data.Char (toLower)
 import Data.Either (lefts, rights)
@@ -206,4 +205,3 @@ liftEither f = either Left (Right . f)
 
 concatEither :: [Either a [b]] -> Either a [b]
 concatEither = liftEither concat . sequenceEither
-
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Types.hs b/haddock-api/src/Haddock/Backends/Xhtml/Types.hs
index 3d1db887..d1561791 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Types.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Types.hs
@@ -23,7 +23,7 @@ import GHC
 
 
 -- the base, module and entity URLs for the source code and wiki links.
-type SourceURLs = (Maybe FilePath, Maybe FilePath, Map PackageKey FilePath, Map PackageKey FilePath)
+type SourceURLs = (Maybe FilePath, Maybe FilePath, Map UnitId FilePath, Map UnitId FilePath)
 type WikiURLs = (Maybe FilePath, Maybe FilePath, Maybe FilePath)
 
 
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
index cbcbbd6d..98ff4007 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
@@ -14,14 +14,14 @@ module Haddock.Backends.Xhtml.Utils (
   renderToString,
 
   namedAnchor, linkedAnchor,
-  spliceURL,
+  spliceURL, spliceURL',
   groupId,
 
   (<+>), (<=>), char,
   keyword, punctuate,
 
   braces, brackets, pabrackets, parens, parenList, ubxParenList,
-  arrow, comma, dcolon, dot, darrow, equals, forallSymbol, quote,
+  arrow, comma, dcolon, dot, darrow, equals, forallSymbol, quote, promoQuote,
 
   hsep, vcat,
 
@@ -29,7 +29,6 @@ module Haddock.Backends.Xhtml.Utils (
 ) where
 
 
-import Haddock.GhcUtils
 import Haddock.Utils
 
 import Data.Maybe
@@ -38,18 +37,31 @@ import Text.XHtml hiding ( name, title, p, quote )
 import qualified Text.XHtml as XHtml
 
 import GHC      ( SrcSpan(..), srcSpanStartLine, Name )
-import Module   ( Module )
+import Module   ( Module, ModuleName, moduleName, moduleNameString )
 import Name     ( getOccString, nameOccName, isValOcc )
 
 
+-- | Replace placeholder string elements with provided values.
+--
+-- Used to generate URL for customized external paths, usually provided with
+-- @--source-module@, @--source-entity@ and related command-line arguments.
+--
+-- >>> spliceURL Nothing mmod mname Nothing "output/%{MODULE}.hs#%{NAME}"
+-- "output/Foo.hs#foo"
 spliceURL :: Maybe FilePath -> Maybe Module -> Maybe GHC.Name ->
              Maybe SrcSpan -> String -> String
-spliceURL maybe_file maybe_mod maybe_name maybe_loc = run
+spliceURL mfile mmod = spliceURL' mfile (moduleName <$> mmod)
+
+
+-- | Same as 'spliceURL' but takes 'ModuleName' instead of 'Module'.
+spliceURL' :: Maybe FilePath -> Maybe ModuleName -> Maybe GHC.Name ->
+              Maybe SrcSpan -> String -> String
+spliceURL' maybe_file maybe_mod maybe_name maybe_loc = run
  where
   file = fromMaybe "" maybe_file
   mdl = case maybe_mod of
           Nothing           -> ""
-          Just m -> moduleString m
+          Just m -> moduleNameString m
 
   (name, kind) =
     case maybe_name of
@@ -138,6 +150,11 @@ quote :: Html -> Html
 quote h = char '`' +++ h +++ '`'
 
 
+-- | Promoted type quote (e.g. @'[a, b]@, @'(a, b, c)@).
+promoQuote :: Html -> Html
+promoQuote h = char '\'' +++ h
+
+
 parens, brackets, pabrackets, braces :: Html -> Html
 parens h        = char '(' +++ h +++ char ')'
 brackets h      = char '[' +++ h +++ char ']'
@@ -203,7 +220,7 @@ collapseSection id_ state classes = [ identifier sid, theclass cs ]
 collapseToggle :: String -> [HtmlAttr]
 collapseToggle id_ = [ strAttr "onclick" js ]
   where js = "toggleSection('" ++ id_ ++ "')";
-  
+
 -- | Attributes for an area that toggles a collapsed area,
 -- and displays a control.
 collapseControl :: String -> Bool -> String -> [HtmlAttr]