Merge remote-tracking branch 'origin/master' into ghc-head

29 files changed, 1038 insertions, 884 deletions

diff --git a/haddock-api/CHANGES.md b/haddock-api/CHANGES.md
new file mode 100644
index 00000000..70d575ec
--- /dev/null
+++ b/haddock-api/CHANGES.md
@@ -0,0 +1 @@
+See [`haddock`'s changelog](https://hackage.haskell.org/package/haddock/changelog).
diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index 6a3ef944..d86c1c69 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -1,19 +1,21 @@
 name:                 haddock-api
-version:              2.17.3
+version:              2.18.2
 synopsis:             A documentation-generation tool for Haskell libraries
 description:          Haddock is a documentation-generation tool for Haskell
                       libraries
 license:              BSD3
 license-file:         LICENSE
 author:               Simon Marlow, David Waern
-maintainer:           Simon Hengel <sol@typeful.net>, Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>
+maintainer:           Alex Biehl <alexbiehl@gmail.com>, Simon Hengel <sol@typeful.net>, Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>
 homepage:             http://www.haskell.org/haddock/
 bug-reports:          https://github.com/haskell/haddock/issues
 copyright:            (c) Simon Marlow, David Waern
 category:             Documentation
 build-type:           Simple
-cabal-version:        >= 1.10
-stability:            experimental
+cabal-version:        >= 2.0
+
+extra-source-files:
+  CHANGES.md
 
 data-dir:
   resources
@@ -33,30 +35,34 @@ data-files:
   latex/haddock.sty
 
 library
-  default-language:
-      Haskell2010
+  default-language: Haskell2010
 
-  build-depends:
-      base >= 4.3 && < 4.11
-    , bytestring
-    , filepath
-    , directory
-    , containers
-    , transformers
-    , deepseq
-    , array
-    , xhtml >= 3000.2 && < 3000.3
-    , Cabal >= 1.10
-    , ghc-boot
-    , ghc >= 8.3 && < 8.4
+  -- this package typically supports only single major versions
+  build-depends: base            >= 4.10.0
+               , Cabal           ^>= 2.0.0
+               , ghc             ^>= 8.3
+               , ghc-paths       ^>= 0.1.0.9
+               , haddock-library ^>= 1.4.6
+               , xhtml           ^>= 3000.2.2
 
-    , ghc-paths
-    , haddock-library == 1.4.*
+  -- Versions for the dependencies below are transitively pinned by
+  -- the non-reinstallable `ghc` package and hence need no version
+  -- bounds
+  build-depends: array
+               , bytestring
+               , containers
+               , deepseq
+               , directory
+               , filepath
+               , ghc-boot
+               , transformers
 
-  hs-source-dirs:
-      src
+  hs-source-dirs: src
 
   ghc-options: -funbox-strict-fields -Wall -fwarn-tabs -O2
+  ghc-options: -Wall
+  if impl(ghc >= 8.0)
+    ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances
 
   exposed-modules:
     Documentation.Haddock
@@ -67,6 +73,7 @@ library
     Haddock.Interface.Rename
     Haddock.Interface.Create
     Haddock.Interface.AttachInstances
+    Haddock.Interface.Json
     Haddock.Interface.LexParseRn
     Haddock.Interface.ParseModuleHeader
     Haddock.Interface.Specialize
@@ -100,6 +107,9 @@ library
     Haddock.Convert
     Paths_haddock_api
 
+  autogen-modules:
+    Paths_haddock_api
+
 test-suite spec
   type:             exitcode-stdio-1.0
   default-language: Haskell2010
@@ -110,16 +120,29 @@ test-suite spec
       test
     , src
 
+  -- NB: We only use a small subset of lib:haddock-api here, which
+  --     explains why this component has a smaller build-depends set
   other-modules:
     Haddock.Backends.Hyperlinker.ParserSpec
+    Haddock.Backends.Hyperlinker.Parser
+    Haddock.Backends.Hyperlinker.Types
 
   build-depends:
+      ghc         ^>= 8.2
+    , hspec       ^>= 2.4.4
+    , QuickCheck  ^>= 2.10
+
+  -- Versions for the dependencies below are transitively pinned by
+  -- the non-reinstallable `ghc` package and hence need no version
+  -- bounds
+  build-depends:
       base
     , containers
-    , ghc
-    , hspec
-    , QuickCheck == 2.*
+
+  build-tool-depends:
+    hspec-discover:hspec-discover ^>= 2.4.4
 
 source-repository head
   type:     git
+  subdir:   haddock-api
   location: https://github.com/haskell/haddock.git
diff --git a/haddock-api/resources/html/Classic.theme/xhaddock.css b/haddock-api/resources/html/Classic.theme/xhaddock.css
index 19dc28ec..1bf668e9 100644
--- a/haddock-api/resources/html/Classic.theme/xhaddock.css
+++ b/haddock-api/resources/html/Classic.theme/xhaddock.css
@@ -285,6 +285,7 @@ div.top h5 {
 	padding: 0 8px 2px 5px;
 	margin-right: -3px;
 	background-color: #f0f0f0;
+	-moz-user-select: none;
 }
 
 div.subs {
diff --git a/haddock-api/resources/html/Ocean.std-theme/ocean.css b/haddock-api/resources/html/Ocean.std-theme/ocean.css
index 29af691b..8d3f91a9 100644
--- a/haddock-api/resources/html/Ocean.std-theme/ocean.css
+++ b/haddock-api/resources/html/Ocean.std-theme/ocean.css
@@ -327,10 +327,6 @@ div#style-menu-holder {
 }
 
 #synopsis {
-  display: none;
-}
-
-.no-frame #synopsis {
   display: block;
   position: fixed;
   right: 0;
@@ -398,6 +394,7 @@ div#style-menu-holder {
   background: #f0f0f0;
   padding: 0 0.5em 0.2em;
   margin: 0 -0.5em 0 0;
+  -moz-user-select: none;
 }
 #interface .src .selflink {
   border-left: 1px solid #919191;
@@ -614,4 +611,8 @@ div#style-menu-holder {
   float: right;
 }
 
+:target {
+  background-color: #ffff00;
+}
+
 /* @end */
diff --git a/haddock-api/resources/html/haddock-util.js b/haddock-api/resources/html/haddock-util.js
index 92d07d2a..967e2026 100644
--- a/haddock-api/resources/html/haddock-util.js
+++ b/haddock-api/resources/html/haddock-util.js
@@ -1,7 +1,7 @@
 // Haddock JavaScript utilities
 
 var rspace = /\s\s+/g,
-	  rtrim = /^\s+|\s+$/g;
+    rtrim = /^\s+|\s+$/g;
 
 function spaced(s) { return (" " + s + " ").replace(rspace, " "); }
 function trim(s)   { return s.replace(rtrim, ""); }
@@ -52,17 +52,17 @@ function toggleSection(id)
 {
   var b = toggleShow(document.getElementById("section." + id));
   toggleCollapser(document.getElementById("control." + id), b);
-  rememberCollapsed(id, b);
+  rememberCollapsed(id);
   return b;
 }
 
 var collapsed = {};
-function rememberCollapsed(id, b)
+function rememberCollapsed(id)
 {
-  if(b)
+  if(collapsed[id])
     delete collapsed[id]
   else
-    collapsed[id] = null;
+    collapsed[id] = true;
 
   var sections = [];
   for(var i in collapsed)
@@ -109,136 +109,6 @@ function getCookie(name) {
   return null;
 }
 
-
-
-var max_results = 75; // 50 is not enough to search for map in the base libraries
-var shown_range = null;
-var last_search = null;
-
-function quick_search()
-{
-    perform_search(false);
-}
-
-function full_search()
-{
-    perform_search(true);
-}
-
-
-function perform_search(full)
-{
-    var text = document.getElementById("searchbox").value.toLowerCase();
-    if (text == last_search && !full) return;
-    last_search = text;
-
-    var table = document.getElementById("indexlist");
-    var status = document.getElementById("searchmsg");
-    var children = table.firstChild.childNodes;
-
-    // first figure out the first node with the prefix
-    var first = bisect(-1);
-    var last = (first == -1 ? -1 : bisect(1));
-
-    if (first == -1)
-    {
-        table.className = "";
-        status.innerHTML = "No results found, displaying all";
-    }
-    else if (first == 0 && last == children.length - 1)
-    {
-        table.className = "";
-        status.innerHTML = "";
-    }
-    else if (last - first >= max_results && !full)
-    {
-        table.className = "";
-        status.innerHTML = "More than " + max_results + ", press Search to display";
-    }
-    else
-    {
-        // decide what you need to clear/show
-        if (shown_range)
-            setclass(shown_range[0], shown_range[1], "indexrow");
-        setclass(first, last, "indexshow");
-        shown_range = [first, last];
-        table.className = "indexsearch";
-        status.innerHTML = "";
-    }
-
-
-    function setclass(first, last, status)
-    {
-        for (var i = first; i <= last; i++)
-        {
-            children[i].className = status;
-        }
-    }
-
-
-    // do a binary search, treating 0 as ...
-    // return either -1 (no 0's found) or location of most far match
-    function bisect(dir)
-    {
-        var first = 0, finish = children.length - 1;
-        var mid, success = false;
-
-        while (finish - first > 3)
-        {
-            mid = Math.floor((finish + first) / 2);
-
-            var i = checkitem(mid);
-            if (i == 0) i = dir;
-            if (i == -1)
-                finish = mid;
-            else
-                first = mid;
-        }
-        var a = (dir == 1 ? first : finish);
-        var b = (dir == 1 ? finish : first);
-        for (var i = b; i != a - dir; i -= dir)
-        {
-            if (checkitem(i) == 0) return i;
-        }
-        return -1;
-    }
-
-
-    // from an index, decide what the result is
-    // 0 = match, -1 is lower, 1 is higher
-    function checkitem(i)
-    {
-        var s = getitem(i).toLowerCase().substr(0, text.length);
-        if (s == text) return 0;
-        else return (s > text ? -1 : 1);
-    }
-
-
-    // from an index, get its string
-    // this abstracts over alternates
-    function getitem(i)
-    {
-        for ( ; i >= 0; i--)
-        {
-            var s = children[i].firstChild.firstChild.data;
-            if (s.indexOf(' ') == -1)
-                return s;
-        }
-        return ""; // should never be reached
-    }
-}
-
-function setSynopsis(filename) {
-    if (parent.window.synopsis && parent.window.synopsis.location) {
-        if (parent.window.synopsis.location.replace) {
-            // In Firefox this avoids adding the change to the history.
-            parent.window.synopsis.location.replace(filename);
-        } else {
-            parent.window.synopsis.location = filename;
-        }
-    }
-}
-
 function addMenuItem(html) {
   var menu = document.getElementById("page-menu");
   if (menu) {
diff --git a/haddock-api/src/Documentation/Haddock.hs b/haddock-api/src/Documentation/Haddock.hs
index 1ff5cf75..10d6849a 100644
--- a/haddock-api/src/Documentation/Haddock.hs
+++ b/haddock-api/src/Documentation/Haddock.hs
@@ -16,6 +16,7 @@ module Documentation.Haddock (
   -- * Interface
   Interface(..),
   InstalledInterface(..),
+  toInstalledIface,
   createInterfaces,
   processModules,
 
@@ -34,10 +35,12 @@ module Documentation.Haddock (
 
   -- * Documentation comments
   Doc,
+  MDoc,
   DocH(..),
   Example(..),
   Hyperlink(..),
-  DocMarkup(..),
+  DocMarkup,
+  DocMarkupH(..),
   Documentation(..),
   ArgMap,
   AliasMap,
@@ -67,12 +70,11 @@ module Documentation.Haddock (
   withGhc
 ) where
 
-
+import Documentation.Haddock.Markup (markup)
 import Haddock.InterfaceFile
 import Haddock.Interface
 import Haddock.Types
 import Haddock.Options
-import Haddock.Utils
 import Haddock
 
 
diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index 080ff926..44dfb7b2 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -32,6 +32,7 @@ import Haddock.Backends.LaTeX
 import Haddock.Backends.Hoogle
 import Haddock.Backends.Hyperlinker
 import Haddock.Interface
+import Haddock.Interface.Json
 import Haddock.Parser
 import Haddock.Types
 import Haddock.Version
@@ -68,12 +69,11 @@ import System.Directory (doesDirectoryExist)
 import GHC hiding (verbosity)
 import Config
 import DynFlags hiding (projectVersion, verbosity)
+import ErrUtils
 import Packages
 import Panic (handleGhcException)
 import Module
 import FastString
-import HscTypes
-import GhcMonad
 
 --------------------------------------------------------------------------------
 -- * Exception handling
@@ -165,6 +165,11 @@ haddockWithGhc ghc args = handleTopExceptions $ do
   ghc flags' $ do
     dflags <- getDynFlags
 
+    forM_ (optShowInterfaceFile flags) $ \path -> liftIO $ do
+      mIfaceFile <- readInterfaceFiles freshNameCache [(("", Nothing), path)]
+      forM_ mIfaceFile $ \(_, ifaceFile) -> do
+        putMsg dflags (renderJson (jsonInterfaceFile ifaceFile))
+
     if not (null files) then do
       (packages, ifaces, homeLinks) <- readPackagesAndProcessModules flags files
 
@@ -403,12 +408,11 @@ withGhc' libDir flags ghcActs = runGhc (Just libDir) $ do
   let dynflags'' = unsetPatternMatchWarnings $
         updOptLevel 0 $
         gopt_unset dynflags' Opt_SplitObjs
-  defaultCleanupHandler dynflags'' $ do
-      -- ignore the following return-value, which is a list of packages
-      -- that may need to be re-linked: Haddock doesn't do any
-      -- dynamic or static linking at all!
-      _ <- setSessionDynFlags dynflags''
-      ghcActs dynflags''
+  -- ignore the following return-value, which is a list of packages
+  -- that may need to be re-linked: Haddock doesn't do any
+  -- dynamic or static linking at all!
+  _ <- setSessionDynFlags dynflags''
+  ghcActs dynflags''
   where
     parseGhcFlags :: MonadIO m => DynFlags -> m DynFlags
     parseGhcFlags dynflags = do
@@ -442,15 +446,22 @@ getHaddockLibDir flags =
 #ifdef IN_GHC_TREE
       getInTreeDir
 #else
-      d <- getDataDir -- provided by Cabal
-      doesDirectoryExist d >>= \exists -> case exists of
-        True -> return d
-        False -> do
-          -- If directory does not exist then we are probably invoking from
-          -- ./dist/build/haddock/haddock so we use ./resources as a fallback.
-          doesDirectoryExist "resources" >>= \exists_ -> case exists_ of
-            True -> return "resources"
-            False -> die ("Haddock's resource directory (" ++ d ++ ") does not exist!\n")
+      -- if data directory does not exist we are probably
+      -- invoking from either ./haddock-api or ./
+      let res_dirs = [ getDataDir -- provided by Cabal
+                     , pure "resources"
+                     , pure "haddock-api/resources"
+                     ]
+
+          check get_path = do
+            p <- get_path
+            exists <- doesDirectoryExist p
+            pure $ if exists then Just p else Nothing
+
+      dirs <- mapM check res_dirs
+      case [p | Just p <- dirs] of
+        (p : _) -> return p
+        _       -> die "Haddock's resource directory does not exist!\n"
 #endif
     fs -> return (last fs)
 
@@ -498,7 +509,7 @@ shortcutFlags flags = do
 
   when ((Flag_GenIndex `elem` flags || Flag_GenContents `elem` flags)
         && Flag_Html `elem` flags) $
-    throwE "-h cannot be used with --gen-index or --gen-contents"
+    throwE "-h/--html cannot be used with --gen-index or --gen-contents"
 
   when ((Flag_GenIndex `elem` flags || Flag_GenContents `elem` flags)
         && Flag_Hoogle `elem` flags) $
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index 02430deb..56f8176c 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -18,10 +18,12 @@ module Haddock.Backends.Hoogle (
 
 import BasicTypes (OverlapFlag(..), OverlapMode(..), SourceText(..))
 import InstEnv (ClsInst(..))
+import Documentation.Haddock.Markup
 import Haddock.GhcUtils
 import Haddock.Types hiding (Version)
 import Haddock.Utils hiding (out)
 
+import HsBinds (emptyLHsBinds)
 import GHC
 import Outputable
 import NameSet
@@ -157,7 +159,9 @@ pp_sig dflags names (L _ typ)  =
 
 -- note: does not yet output documentation for class methods
 ppClass :: DynFlags -> TyClDecl GhcRn -> [(Name, DocForDecl Name)] -> [String]
-ppClass dflags decl subdocs = (out dflags decl{tcdSigs=[]} ++ ppTyFams) :  ppMethods
+ppClass dflags decl subdocs =
+  (out dflags decl{tcdSigs=[], tcdATs=[], tcdATDefs=[], tcdMeths=emptyLHsBinds}
+    ++ ppTyFams) :  ppMethods
     where
 
         ppMethods = concat . map (ppSig' . unLoc . add_ctxt) $ tcdSigs decl
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 1b39e5e8..759a31d4 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -1,21 +1,29 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TypeFamilies #-}
-
+{-# LANGUAGE TypeApplications #-}
 
 module Haddock.Backends.Hyperlinker.Ast (enrich) where
 
 
-import Haddock.Syb
+import qualified Haddock.Syb as Syb
 import Haddock.Backends.Hyperlinker.Types
 
 import qualified GHC
 
 import Control.Applicative
+import Control.Monad (guard)
 import Data.Data
+import qualified Data.Map.Strict as Map
 import Data.Maybe
 
+import Prelude hiding (span)
+
+everythingInRenamedSource :: (Alternative f, Data x)
+  => (forall a. Data a => a -> f r) -> x -> f r
+everythingInRenamedSource f = Syb.everythingButType @GHC.Name (<|>) f
 
 -- | Add more detailed information to token stream using GHC API.
 enrich :: GHC.RenamedSource -> [Token] -> [RichToken]
@@ -25,25 +33,45 @@ enrich src =
         , rtkDetails = enrichToken token detailsMap
         }
   where
-    detailsMap = concatMap ($ src)
-        [ variables
-        , types
-        , decls
-        , binds
-        , imports
-        ]
+    detailsMap =
+      mkDetailsMap (concatMap ($ src)
+                     [ variables
+                     , types
+                     , decls
+                     , binds
+                     , imports
+                     ])
+
+type LTokenDetails = [(GHC.SrcSpan, TokenDetails)]
 
 -- | 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)]
+type DetailsMap = Map.Map Position (Span, TokenDetails)
+
+mkDetailsMap :: [(GHC.SrcSpan, TokenDetails)] -> DetailsMap
+mkDetailsMap xs =
+  Map.fromListWith select_details [ (start, (token_span, token_details))
+                                  | (ghc_span, token_details) <- xs
+                                  , Just !token_span <- [ghcSrcSpanToSpan ghc_span]
+                                  , let start = spStart token_span
+                                  ]
+  where
+    -- favour token details which appear earlier in the list
+    select_details _new old = old
 
 lookupBySpan :: Span -> DetailsMap -> Maybe TokenDetails
-lookupBySpan tspan = listToMaybe . map snd . filter (matches tspan . fst)
+lookupBySpan span details = do
+  (_, (tok_span, tok_details)) <- Map.lookupLE (spStart span) details
+  guard (tok_span `containsSpan` span )
+  return tok_details
+
+ghcSrcSpanToSpan :: GHC.SrcSpan -> Maybe Span
+ghcSrcSpanToSpan (GHC.RealSrcSpan span) =
+  Just (Span { spStart = Position (GHC.srcSpanStartLine span) (GHC.srcSpanStartCol span)
+             , spEnd   = Position (GHC.srcSpanEndLine span) (GHC.srcSpanEndCol span)
+             })
+ghcSrcSpanToSpan _ = Nothing
 
 enrichToken :: Token -> DetailsMap -> Maybe TokenDetails
 enrichToken (Token typ _ spn) dm
@@ -51,9 +79,9 @@ enrichToken (Token typ _ spn) dm
 enrichToken _ _ = Nothing
 
 -- | Obtain details map for variables ("normally" used identifiers).
-variables :: GHC.RenamedSource -> DetailsMap
+variables :: GHC.RenamedSource -> LTokenDetails
 variables =
-    everything (<|>) (var `combine` rec)
+    everythingInRenamedSource (var `Syb.combine` rec)
   where
     var term = case cast term of
         (Just ((GHC.L sspan (GHC.HsVar name)) :: GHC.LHsExpr GHC.GhcRn)) ->
@@ -67,9 +95,8 @@ variables =
         _ -> empty
 
 -- | Obtain details map for types.
-types :: GHC.RenamedSource -> DetailsMap
-types =
-    everything (<|>) ty
+types :: GHC.RenamedSource -> LTokenDetails
+types = everythingInRenamedSource ty
   where
     ty term = case cast term of
         (Just ((GHC.L sspan (GHC.HsTyVar _ name)) :: GHC.LHsType GHC.GhcRn)) ->
@@ -81,9 +108,10 @@ types =
 -- 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)
+
+binds :: GHC.RenamedSource -> LTokenDetails
+binds = everythingInRenamedSource
+      (fun `Syb.combine` pat `Syb.combine` tvar)
   where
     fun term = case cast term of
         (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.GhcRn)) ->
@@ -93,7 +121,7 @@ binds =
         (Just ((GHC.L sspan (GHC.VarPat name)) :: GHC.LPat GHC.GhcRn)) ->
             pure (sspan, RtkBind (GHC.unLoc name))
         (Just (GHC.L _ (GHC.ConPatIn (GHC.L sspan name) recs))) ->
-            [(sspan, RtkVar name)] ++ everything (<|>) rec recs
+            [(sspan, RtkVar name)] ++ everythingInRenamedSource rec recs
         (Just (GHC.L _ (GHC.AsPat (GHC.L sspan name) _))) ->
             pure (sspan, RtkBind name)
         _ -> empty
@@ -109,11 +137,11 @@ binds =
         _ -> empty
 
 -- | Obtain details map for top-level declarations.
-decls :: GHC.RenamedSource -> DetailsMap
+decls :: GHC.RenamedSource -> LTokenDetails
 decls (group, _, _, _) = concatMap ($ group)
     [ concat . map typ . concat . map GHC.group_tyclds . GHC.hs_tyclds
-    , everything (<|>) fun . GHC.hs_valds
-    , everything (<|>) (con `combine` ins)
+    , everythingInRenamedSource fun . GHC.hs_valds
+    , everythingInRenamedSource (con `Syb.combine` ins)
     ]
   where
     typ (GHC.L _ t) = case t of
@@ -127,7 +155,8 @@ decls (group, _, _, _) = concatMap ($ group)
         _ -> empty
     con term = case cast term of
         (Just (cdcl :: GHC.ConDecl GHC.GhcRn)) ->
-            map decl (GHC.getConNames cdcl) ++ everything (<|>) fld cdcl
+            map decl (GHC.getConNames cdcl)
+              ++ everythingInRenamedSource fld cdcl
         Nothing -> empty
     ins term = case cast term of
         (Just ((GHC.DataFamInstD inst) :: GHC.InstDecl GHC.GhcRn))
@@ -148,9 +177,9 @@ decls (group, _, _, _) = concatMap ($ group)
 --
 -- This map also includes type and variable details for items in export and
 -- import lists.
-imports :: GHC.RenamedSource -> DetailsMap
+imports :: GHC.RenamedSource -> LTokenDetails
 imports src@(_, imps, _, _) =
-    everything (<|>) ie src ++ mapMaybe (imp . GHC.unLoc) imps
+    everythingInRenamedSource ie src ++ mapMaybe (imp . GHC.unLoc) imps
   where
     ie term = case cast term of
         (Just ((GHC.IEVar v) :: GHC.IE GHC.GhcRn)) -> pure $ var $ GHC.ieLWrappedName v
@@ -165,22 +194,3 @@ imports src@(_, imps, _, _) =
         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/Types.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs
index b27ec4d8..d8ae89e4 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs
@@ -10,7 +10,7 @@ import qualified Data.Map as Map
 data Token = Token
     { tkType :: TokenType
     , tkValue :: String
-    , tkSpan :: Span
+    , tkSpan :: {-# UNPACK #-} !Span
     }
     deriving (Show)
 
@@ -18,14 +18,20 @@ data Position = Position
     { posRow :: !Int
     , posCol :: !Int
     }
-    deriving (Show)
+    deriving (Eq, Ord, Show)
 
 data Span = Span
-    { spStart :: Position
-    , spEnd :: Position
+    { spStart :: !Position
+    , spEnd   :: !Position
     }
     deriving (Show)
 
+-- | Tests whether the first span "contains" the other span, meaning
+-- that it covers at least as much source code. True where spans are equal.
+containsSpan :: Span -> Span -> Bool
+containsSpan s1 s2 =
+  spStart s1 <= spStart s2 && spEnd s1 >= spEnd s2
+
 data TokenType
     = TkIdentifier
     | TkKeyword
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 8ca9075b..d4a3012e 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -16,6 +16,7 @@ module Haddock.Backends.LaTeX (
 ) where
 
 
+import Documentation.Haddock.Markup
 import Haddock.Types
 import Haddock.Utils
 import Haddock.GhcUtils
@@ -227,8 +228,8 @@ isExportModule _ = Nothing
 processExport :: ExportItem DocNameI -> LaTeX
 processExport (ExportGroup lev _id0 doc)
   = ppDocGroup lev (docToLaTeX doc)
-processExport (ExportDecl decl doc subdocs insts fixities _splice)
-  = ppDecl decl doc insts subdocs fixities
+processExport (ExportDecl decl pats doc subdocs insts fixities _splice)
+  = ppDecl decl pats doc insts subdocs fixities
 processExport (ExportNoDecl y [])
   = ppDocName y
 processExport (ExportNoDecl y subs)
@@ -278,16 +279,17 @@ moduleBasename mdl = map (\c -> if c == '.' then '-' else c)
 
 
 ppDecl :: LHsDecl DocNameI
+       -> [(HsDecl DocNameI, DocForDecl DocName)]
        -> DocForDecl DocName
        -> [DocInstance DocNameI]
        -> [(DocName, DocForDecl DocName)]
        -> [(DocName, Fixity)]
        -> LaTeX
 
-ppDecl (L loc decl) (doc, fnArgsDoc) instances subdocs _fixities = case decl of
+ppDecl (L loc decl) pats (doc, fnArgsDoc) instances subdocs _fixities = case decl of
   TyClD d@(FamDecl {})          -> ppTyFam False loc doc d unicode
   TyClD d@(DataDecl {})
-                                -> ppDataDecl instances subdocs loc (Just doc) d unicode
+                                -> ppDataDecl pats instances subdocs loc (Just doc) d unicode
   TyClD d@(SynDecl {})          -> ppTySyn loc (doc, fnArgsDoc) d unicode
 -- Family instances happen via FamInst now
 --  TyClD d@(TySynonym {})
@@ -565,11 +567,11 @@ lookupAnySubdoc n subdocs = case lookup n subdocs of
 -------------------------------------------------------------------------------
 
 
-ppDataDecl :: [DocInstance DocNameI] ->
+ppDataDecl :: [(HsDecl DocNameI, DocForDecl DocName)] -> [DocInstance DocNameI] ->
               [(DocName, DocForDecl DocName)] -> SrcSpan ->
               Maybe (Documentation DocName) -> TyClDecl DocNameI -> Bool ->
               LaTeX
-ppDataDecl instances subdocs _loc doc dataDecl unicode
+ppDataDecl pats instances subdocs _loc doc dataDecl unicode
 
    =  declWithDoc (ppDataHeader dataDecl unicode <+> whereBit)
                   (if null body then Nothing else Just (vcat body))
@@ -579,10 +581,12 @@ ppDataDecl instances subdocs _loc doc dataDecl unicode
     cons      = dd_cons (tcdDataDefn dataDecl)
     resTy     = (unLoc . head) cons
 
-    body = catMaybes [constrBit, doc >>= documentationToLaTeX]
+    body = catMaybes [constrBit,patternBit, doc >>= documentationToLaTeX]
 
     (whereBit, leaders)
-      | null cons = (empty,[])
+      | null cons
+      , null pats = (empty,[])
+      | null cons = (decltt (keyword "where"), repeat empty)
       | otherwise = case resTy of
         ConDeclGADT{} -> (decltt (keyword "where"), repeat empty)
         _             -> (empty, (decltt (text "=") : repeat (decltt (text "|"))))
@@ -594,6 +598,19 @@ ppDataDecl instances subdocs _loc doc dataDecl unicode
           vcat (zipWith (ppSideBySideConstr subdocs unicode) leaders cons) $$
           text "\\end{tabulary}\\par"
 
+    patternBit
+      | null cons = Nothing
+      | otherwise = Just $
+          text "\\haddockbeginconstrs" $$
+          vcat [ hsep [ keyword "pattern"
+                      , hsep $ punctuate comma $ map (ppDocBinder . unLoc) lnames
+                      , dcolon unicode
+                      , ppLType unicode (hsSigType ty)
+                      ] <-> rDoc (fmap _doc . combineDocumentation . fst $ d)
+               | (SigD (PatSynSig lnames ty),d) <- pats
+               ] $$
+          text "\\end{tabulary}\\par"
+
     instancesBit = ppDocInstances unicode instances
 
 
diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index 4a3562ae..7fbf9bb4 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -109,8 +109,8 @@ copyHtmlBits odir libdir themes = do
   return ()
 
 
-headHtml :: String -> Maybe String -> Themes -> Maybe String -> Html
-headHtml docTitle miniPage themes mathjax_url =
+headHtml :: String -> Themes -> Maybe String -> Html
+headHtml docTitle themes mathjax_url =
   header << [
     meta ! [httpequiv "Content-Type", content "text/html; charset=UTF-8"],
     thetitle << docTitle,
@@ -119,15 +119,12 @@ headHtml docTitle miniPage themes mathjax_url =
     script ! [src mjUrl, thetype "text/javascript"] << noHtml,
     script ! [thetype "text/javascript"]
         -- NB: Within XHTML, the content of script tags needs to be
-        -- a <![CDATA[ section. Will break if the miniPage name could
-        -- have "]]>" in it!
-      << primHtml (
-          "//<![CDATA[\nwindow.onload = function () {pageLoad();"
-          ++ setSynopsis ++ "};\n//]]>\n")
+        -- a <![CDATA[ section.
+      << primHtml
+          "//<![CDATA[\nwindow.onload = function () {pageLoad();};\n//]]>\n"
     ]
   where
-    setSynopsis = maybe "" (\p -> "setSynopsis(\"" ++ p ++ "\");") miniPage
-    mjUrl = maybe "https://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML" id mathjax_url
+    mjUrl = maybe "https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" id mathjax_url
 
 
 srcButton :: SourceURLs -> Maybe Interface -> Maybe Html
@@ -272,7 +269,7 @@ ppHtmlContents dflags odir doctitle _maybe_package
          | iface <- ifaces
          , instIsSig iface]
       html =
-        headHtml doctitle Nothing themes mathjax_url +++
+        headHtml doctitle themes mathjax_url +++
         bodyHtml doctitle Nothing
           maybe_source_url maybe_wiki_url
           Nothing maybe_index_url << [
@@ -373,7 +370,7 @@ ppHtmlIndex odir doctitle _maybe_package themes
 
   where
     indexPage showLetters ch items =
-      headHtml (doctitle ++ " (" ++ indexName ch ++ ")") Nothing themes maybe_mathjax_url +++
+      headHtml (doctitle ++ " (" ++ indexName ch ++ ")") themes maybe_mathjax_url +++
       bodyHtml doctitle Nothing
         maybe_source_url maybe_wiki_url
         maybe_contents_url Nothing << [
@@ -495,7 +492,7 @@ ppHtmlModule odir doctitle themes
         = toHtml mdl_str
       real_qual = makeModuleQual qual aliases mdl
       html =
-        headHtml mdl_str_annot (Just $ "mini_" ++ moduleHtmlFile mdl) themes maybe_mathjax_url +++
+        headHtml mdl_str_annot themes maybe_mathjax_url +++
         bodyHtml doctitle (Just iface)
           maybe_source_url maybe_wiki_url
           maybe_contents_url maybe_index_url << [
@@ -505,23 +502,10 @@ ppHtmlModule odir doctitle themes
 
   createDirectoryIfMissing True odir
   writeFile (joinPath [odir, moduleHtmlFile mdl]) (renderToString debug html)
-  ppHtmlModuleMiniSynopsis odir doctitle themes maybe_mathjax_url iface unicode real_qual debug
 
 signatureDocURL :: String
 signatureDocURL = "https://wiki.haskell.org/Module_signature"
 
-ppHtmlModuleMiniSynopsis :: FilePath -> String -> Themes
-  -> Maybe String -> Interface -> Bool -> Qualification -> Bool -> IO ()
-ppHtmlModuleMiniSynopsis odir _doctitle themes maybe_mathjax_url iface unicode qual debug = do
-  let mdl = ifaceMod iface
-      html =
-        headHtml (moduleString mdl) Nothing themes maybe_mathjax_url +++
-        miniBody <<
-          (divModuleHeader << sectionName << moduleString mdl +++
-           miniSynopsis mdl iface unicode qual)
-  createDirectoryIfMissing True odir
-  writeFile (joinPath [odir, "mini_" ++ moduleHtmlFile mdl]) (renderToString debug html)
-
 
 ifaceToHtml :: SourceURLs -> WikiURLs -> Interface -> Bool -> Qualification -> Html
 ifaceToHtml maybe_source_url maybe_wiki_url iface unicode qual
@@ -573,43 +557,6 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode qual
     linksInfo = (maybe_source_url, maybe_wiki_url)
 
 
-miniSynopsis :: Module -> Interface -> Bool -> Qualification -> Html
-miniSynopsis mdl iface unicode qual =
-    divInterface << concatMap (processForMiniSynopsis mdl unicode qual) exports
-  where
-    exports = numberSectionHeadings (ifaceRnExportItems iface)
-
-
-processForMiniSynopsis :: Module -> Bool -> Qualification -> ExportItem DocNameI
-                       -> [Html]
-processForMiniSynopsis mdl unicode qual ExportDecl { expItemDecl = L _loc decl0 } =
-  ((divTopDecl <<).(declElem <<)) <$> case decl0 of
-    TyClD d -> let b = ppTyClBinderWithVarsMini mdl d in case d of
-        (FamDecl decl)    -> [ppTyFamHeader True False decl unicode qual]
-        (DataDecl{})   -> [keyword "data" <+> b]
-        (SynDecl{})    -> [keyword "type" <+> b]
-        (ClassDecl {}) -> [keyword "class" <+> b]
-    SigD (TypeSig lnames _) ->
-      map (ppNameMini Prefix mdl . nameOccName . getName . unLoc) lnames
-    _ -> []
-processForMiniSynopsis _ _ qual (ExportGroup lvl _id txt) =
-  [groupTag lvl << docToHtml Nothing qual (mkMeta txt)]
-processForMiniSynopsis _ _ _ _ = []
-
-
-ppNameMini :: Notation -> Module -> OccName -> Html
-ppNameMini notation mdl nm =
-    anchor ! [ href (moduleNameUrl mdl nm)
-             , target mainFrameName ]
-      << ppBinder' notation nm
-
-
-ppTyClBinderWithVarsMini :: Module -> TyClDecl DocNameI -> Html
-ppTyClBinderWithVarsMini mdl decl =
-  let n = tcdName decl
-      ns = tyvarNames $ tcdTyVars decl -- it's safe to use tcdTyVars, see code above
-  in ppTypeApp n [] ns (\is_infix -> ppNameMini is_infix mdl . nameOccName . getName) ppTyName
-
 ppModuleContents :: Qualification
                  -> [ExportItem DocNameI]
                  -> Bool -- ^ Orphans sections
@@ -659,8 +606,8 @@ processExport :: Bool -> LinksInfo -> Bool -> Qualification
 processExport _ _ _ _ ExportDecl { expItemDecl = L _ (InstD _) } = Nothing -- Hide empty instances
 processExport summary _ _ qual (ExportGroup lev id0 doc)
   = nothingIf summary $ groupHeading lev id0 << docToHtml (Just id0) qual (mkMeta doc)
-processExport summary links unicode qual (ExportDecl decl doc subdocs insts fixities splice)
-  = processDecl summary $ ppDecl summary links decl doc insts fixities subdocs splice unicode qual
+processExport summary links unicode qual (ExportDecl decl pats doc subdocs insts fixities splice)
+  = processDecl summary $ ppDecl summary links decl pats doc insts fixities subdocs splice unicode qual
 processExport summary _ _ qual (ExportNoDecl y [])
   = processDeclOneLiner summary $ ppDocName qual Prefix True y
 processExport summary _ _ qual (ExportNoDecl y subs)
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 2d9d7392..59ad41e4 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -41,11 +41,12 @@ import BooleanFormula
 import RdrName ( rdrNameOcc )
 
 ppDecl :: Bool -> LinksInfo -> LHsDecl DocNameI
-       -> DocForDecl DocName -> [DocInstance DocNameI] -> [(DocName, Fixity)]
+       -> [(HsDecl DocNameI, DocForDecl DocName)]
+       -> DocForDecl DocName ->  [DocInstance DocNameI] -> [(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
+ppDecl summ links (L loc decl) pats (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@(DataDecl {})        -> ppDataDecl summ links instances fixities subdocs loc mbDoc d pats 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
@@ -70,9 +71,9 @@ ppFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
             Splice -> Unicode -> Qualification -> Html
 ppFunSig summary links loc doc docnames typ fixities splice unicode qual =
   ppSigLike summary links loc mempty doc docnames fixities (unLoc typ, pp_typ)
-            splice unicode qual
+            splice unicode qual HideEmptyContexts
   where
-    pp_typ = ppLType unicode qual typ
+    pp_typ = ppLType unicode qual HideEmptyContexts typ
 
 ppLPatSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
              [Located DocName] -> LHsSigType DocNameI ->
@@ -86,20 +87,20 @@ ppLPatSig summary links loc (doc, _argDocs) docnames typ fixities splice unicode
     pref1 = hsep [ keyword "pattern"
                  , hsep $ punctuate comma $ map (ppBinder summary . getOccName) docnames
                  , dcolon unicode
-                 , ppLType unicode qual (hsSigType typ)
+                 , ppPatSigType unicode qual (hsSigType typ)
                  ]
 
 ppSigLike :: Bool -> LinksInfo -> SrcSpan -> Html -> DocForDecl DocName ->
              [DocName] -> [(DocName, Fixity)] -> (HsType DocNameI, Html) ->
-             Splice -> Unicode -> Qualification -> Html
+             Splice -> Unicode -> Qualification -> HideEmptyContexts -> Html
 ppSigLike summary links loc leader doc docnames fixities (typ, pp_typ)
-          splice unicode qual =
+          splice unicode qual emptyCtxts =
   ppTypeOrFunSig summary links loc docnames typ doc
     ( addFixities $ leader <+> ppTypeSig summary occnames pp_typ unicode
     , addFixities . concatHtml . punctuate comma $ map (ppBinder False) occnames
     , dcolon unicode
     )
-    splice unicode qual
+    splice unicode qual emptyCtxts
   where
     occnames = map (nameOccName . getName) docnames
     addFixities html
@@ -109,8 +110,8 @@ ppSigLike summary links loc leader doc docnames fixities (typ, pp_typ)
 
 ppTypeOrFunSig :: Bool -> LinksInfo -> SrcSpan -> [DocName] -> HsType DocNameI
                -> DocForDecl DocName -> (Html, Html, Html)
-               -> Splice -> Unicode -> Qualification -> Html
-ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep) splice unicode qual
+               -> Splice -> Unicode -> Qualification -> HideEmptyContexts -> Html
+ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep) splice unicode qual emptyCtxts
   | summary = pref1
   | Map.null argDocs = topDeclElem links loc splice docnames pref1 +++ docSection curName qual doc
   | otherwise = topDeclElem links loc splice docnames pref2 +++
@@ -131,14 +132,14 @@ ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep)
       | null (unLoc lctxt)
       = do_largs n leader ltype
       | otherwise
-      = (leader <+> ppLContextNoArrow lctxt unicode qual, Nothing, [])
+      = (leader <+> ppLContextNoArrow lctxt unicode qual emptyCtxts, Nothing, [])
         : do_largs n (darrow unicode) ltype
 
     do_args n leader (HsFunTy lt r)
-      = (leader <+> ppLFunLhType unicode qual lt, argDoc n, [])
+      = (leader <+> ppLFunLhType unicode qual emptyCtxts lt, argDoc n, [])
         : do_largs (n+1) (arrow unicode) r
     do_args n leader t
-      = [(leader <+> ppType unicode qual t, argDoc n, [])]
+      = [(leader <+> ppType unicode qual emptyCtxts t, argDoc n, [])]
 
 ppForAll :: [LHsTyVarBndr DocNameI] -> Unicode -> Qualification -> Html
 ppForAll tvs unicode qual =
@@ -171,8 +172,8 @@ ppFixities fs qual = foldr1 (+++) (map ppFix uniq_fs) +++ rightEdge
 
 
 -- | Pretty-print type variables.
-ppTyVars :: [LHsTyVarBndr DocNameI] -> [Html]
-ppTyVars tvs = map (ppTyName . getName . hsLTyVarName) tvs
+ppTyVars :: Unicode -> Qualification -> [LHsTyVarBndr DocNameI] -> [Html]
+ppTyVars unicode qual tvs = map (ppHsTyVarBndr unicode qual . unLoc) tvs
 
 tyvarNames :: LHsQTyVars DocNameI -> [Name]
 tyvarNames = map (getName . hsLTyVarName) . hsQTvExplicit
@@ -196,11 +197,11 @@ ppTySyn summary links fixities loc doc (SynDecl { tcdLName = L _ name, tcdTyVars
         splice unicode qual
   = ppTypeOrFunSig summary links loc [name] (unLoc ltype) doc
                    (full <+> fixs, hdr <+> fixs, spaceHtml +++ equals)
-                   splice unicode qual
+                   splice unicode qual ShowEmptyToplevelContexts
   where
     hdr  = hsep ([keyword "type", ppBinder summary occ]
-                 ++ ppTyVars (hsQTvExplicit ltyvars))
-    full = hdr <+> equals <+> ppLType unicode qual ltype
+                 ++ ppTyVars unicode qual (hsQTvExplicit ltyvars))
+    full = hdr <+> equals <+> ppPatSigType unicode qual ltype
     occ  = nameOccName . getName $ name
     fixs
       | summary   = noHtml
@@ -219,14 +220,14 @@ ppTyName :: Name -> Html
 ppTyName = ppName Prefix
 
 
-ppSimpleSig :: LinksInfo -> Splice -> Unicode -> Qualification -> SrcSpan
+ppSimpleSig :: LinksInfo -> Splice -> Unicode -> Qualification -> HideEmptyContexts -> SrcSpan
             -> [DocName] -> HsType DocNameI
             -> Html
-ppSimpleSig links splice unicode qual loc names typ =
+ppSimpleSig links splice unicode qual emptyCtxts loc names typ =
     topDeclElem' names $ ppTypeSig True occNames ppTyp unicode
   where
     topDeclElem' = topDeclElem links loc splice
-    ppTyp = ppType unicode qual typ
+    ppTyp = ppType unicode qual emptyCtxts typ
     occNames = map getOccName names
 
 
@@ -320,7 +321,7 @@ ppTyFam summary associated links instances fixities loc doc decl splice unicode
     ppTyFamEqn TyFamEqn { tfe_tycon = n, tfe_rhs = rhs
                         , tfe_pats = HsIB { hsib_body = ts }}
       = ( ppAppNameTypes (unLoc n) [] (map unLoc ts) unicode qual
-          <+> equals <+> ppType unicode qual (unLoc rhs)
+          <+> equals <+> ppType unicode qual HideEmptyContexts (unLoc rhs)
         , Nothing, [] )
 
 
@@ -353,20 +354,20 @@ ppAssocType summ links doc (L loc decl) fixities splice unicode qual =
 -- | Print a type family and its variables
 ppFamDeclBinderWithVars :: Bool -> Unicode -> Qualification -> FamilyDecl DocNameI -> Html
 ppFamDeclBinderWithVars summ unicode qual (FamilyDecl { fdLName = lname, fdTyVars = tvs }) =
-  ppAppDocNameTyVarBndrs summ unicode qual (unLoc lname) (map unLoc $ hsq_explicit tvs)
+  ppAppDocNameTyVarBndrs summ unicode qual (unLoc lname) (hsq_explicit tvs)
 
 -- | Print a newtype / data binder and its variables
-ppDataBinderWithVars :: Bool -> TyClDecl DocNameI -> Html
-ppDataBinderWithVars summ decl =
-  ppAppDocNameNames summ (tcdName decl) (tyvarNames $ tcdTyVars decl)
+ppDataBinderWithVars :: Bool -> Unicode -> Qualification -> TyClDecl DocNameI -> Html
+ppDataBinderWithVars summ unicode qual decl =
+  ppAppDocNameTyVarBndrs summ unicode qual (tcdName decl) (hsQTvExplicit $ tcdTyVars decl)
 
 --------------------------------------------------------------------------------
 -- * Type applications
 --------------------------------------------------------------------------------
 
-ppAppDocNameTyVarBndrs :: Bool -> Unicode -> Qualification -> DocName -> [HsTyVarBndr DocNameI] -> Html
+ppAppDocNameTyVarBndrs :: Bool -> Unicode -> Qualification -> DocName -> [LHsTyVarBndr DocNameI] -> Html
 ppAppDocNameTyVarBndrs summ unicode qual n vs =
-    ppTypeApp n [] vs ppDN (ppHsTyVarBndr unicode qual)
+    ppTypeApp n [] vs ppDN (ppHsTyVarBndr unicode qual . unLoc)
   where
     ppDN notation = ppBinderFixity notation summ . nameOccName . getName
     ppBinderFixity Infix = ppBinderInfix
@@ -376,18 +377,9 @@ ppAppDocNameTyVarBndrs summ unicode qual n vs =
 ppAppNameTypes :: DocName -> [HsType DocNameI] -> [HsType DocNameI]
                -> Unicode -> Qualification -> Html
 ppAppNameTypes n ks ts unicode qual =
-    ppTypeApp n ks ts (\p -> ppDocName qual p True) (ppParendType unicode qual)
+    ppTypeApp n ks ts (\p -> ppDocName qual p True) (ppParendType unicode qual HideEmptyContexts)
 
 
--- | Print an application of a 'DocName' and a list of 'Names'
-ppAppDocNameNames :: Bool -> DocName -> [Name] -> Html
-ppAppDocNameNames summ n ns =
-    ppTypeApp n [] ns ppDN ppTyName
-  where
-    ppDN notation = ppBinderFixity notation summ . nameOccName . getName
-    ppBinderFixity Infix = ppBinderInfix
-    ppBinderFixity _ = ppBinder
-
 -- | General printing of type applications
 ppTypeApp :: DocName -> [a] -> [a] -> (Notation -> DocName -> Html) -> (a -> Html) -> Html
 ppTypeApp n [] (t1:t2:rest) ppDN ppT
@@ -406,32 +398,35 @@ ppTypeApp n ks ts ppDN ppT = ppDN Prefix n <+> hsep (map ppT $ ks ++ ts)
 
 
 ppLContext, ppLContextNoArrow :: Located (HsContext DocNameI) -> Unicode
-                              -> Qualification -> Html
+                              -> Qualification -> HideEmptyContexts -> Html
 ppLContext        = ppContext        . unLoc
 ppLContextNoArrow = ppContextNoArrow . unLoc
 
-ppContextNoArrow :: HsContext DocNameI -> Unicode -> Qualification -> Html
-ppContextNoArrow cxt unicode qual = fromMaybe noHtml $
-                                    ppContextNoLocsMaybe (map unLoc cxt) unicode qual
+ppContextNoArrow :: HsContext DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html
+ppContextNoArrow cxt unicode qual emptyCtxts = fromMaybe noHtml $
+                                               ppContextNoLocsMaybe (map unLoc cxt) unicode qual emptyCtxts
 
 
-ppContextNoLocs :: [HsType DocNameI] -> Unicode -> Qualification -> Html
-ppContextNoLocs cxt unicode qual = maybe noHtml (<+> darrow unicode) $
-                                   ppContextNoLocsMaybe cxt unicode qual
+ppContextNoLocs :: [HsType DocNameI] -> Unicode -> Qualification -> HideEmptyContexts -> Html
+ppContextNoLocs cxt unicode qual emptyCtxts = maybe noHtml (<+> darrow unicode) $
+                                              ppContextNoLocsMaybe cxt unicode qual emptyCtxts
 
 
-ppContextNoLocsMaybe :: [HsType DocNameI] -> Unicode -> Qualification -> Maybe Html
-ppContextNoLocsMaybe []  _       _    = Nothing
-ppContextNoLocsMaybe cxt unicode qual = Just $ ppHsContext cxt unicode qual
+ppContextNoLocsMaybe :: [HsType DocNameI] -> Unicode -> Qualification -> HideEmptyContexts -> Maybe Html
+ppContextNoLocsMaybe [] _ _ emptyCtxts =
+  case emptyCtxts of
+    HideEmptyContexts -> Nothing
+    ShowEmptyToplevelContexts -> Just (toHtml "()")
+ppContextNoLocsMaybe cxt unicode qual _ = Just $ ppHsContext cxt unicode qual
 
-ppContext :: HsContext DocNameI -> Unicode -> Qualification -> Html
-ppContext cxt unicode qual = ppContextNoLocs (map unLoc cxt) unicode qual
+ppContext :: HsContext DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html
+ppContext cxt unicode qual emptyCtxts = ppContextNoLocs (map unLoc cxt) unicode qual emptyCtxts
 
 
-ppHsContext :: [HsType DocNameI] -> Unicode -> Qualification-> Html
-ppHsContext []  _       _     = noHtml
+ppHsContext :: [HsType DocNameI] -> Unicode -> Qualification -> Html
+ppHsContext []  _       _    = noHtml
 ppHsContext [p] unicode qual = ppCtxType unicode qual p
-ppHsContext cxt unicode qual = parenList (map (ppType unicode qual) cxt)
+ppHsContext cxt unicode qual = parenList (map (ppType unicode qual HideEmptyContexts) cxt)
 
 
 -------------------------------------------------------------------------------
@@ -444,8 +439,8 @@ ppClassHdr :: Bool -> Located [LHsType DocNameI] -> DocName
            -> Unicode -> Qualification -> Html
 ppClassHdr summ lctxt n tvs fds unicode qual =
   keyword "class"
-  <+> (if not . null . unLoc $ lctxt then ppLContext lctxt unicode qual else noHtml)
-  <+> ppAppDocNameNames summ n (tyvarNames tvs)
+  <+> (if not . null . unLoc $ lctxt then ppLContext lctxt unicode qual HideEmptyContexts else noHtml)
+  <+> ppAppDocNameTyVarBndrs summ unicode qual n (hsQTvExplicit tvs)
   <+> ppFds fds unicode qual
 
 
@@ -529,9 +524,8 @@ ppClassDecl summary links instances fixities loc d subdocs
                                                , f@(n',_) <- fixities
                                                , n == n' ]
                                  names = map unLoc lnames ]
-                           -- FIXME: is taking just the first name ok? Is it possible that
-                           -- there are different subdocs for different names in a single
-                           -- type signature?
+                           -- N.B. taking just the first name is ok. Signatures with multiple names
+                           -- are expanded so that each name gets its own signature.
 
     minimalBit = case [ s | MinimalSig _ (L _ s) <- sigs ] of
       -- Miminal complete definition = every shown method
@@ -601,7 +595,7 @@ ppInstHead :: LinksInfo -> Splice -> Unicode -> Qualification
 ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) =
     case ihdInstType of
         ClassInst { .. } ->
-            ( subInstHead iid $ ppContextNoLocs clsiCtx unicode qual <+> typ
+            ( subInstHead iid $ ppContextNoLocs clsiCtx unicode qual HideEmptyContexts <+> typ
             , mdoc
             , [subInstDetails iid ats sigs]
             )
@@ -616,14 +610,14 @@ ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) =
           where
             ptype = keyword "type" <+> typ
             prhs = ptype <+> maybe noHtml
-                                   (\t -> equals <+> ppType unicode qual t) rhs
+                                   (\t -> equals <+> ppType unicode qual HideEmptyContexts t) rhs
         DataInst dd ->
             ( subInstHead iid pdata
             , mdoc
             , [subFamInstDetails iid pdecl])
           where
             pdata = keyword "data" <+> typ
-            pdecl = pdata <+> ppShortDataDecl False True dd unicode qual
+            pdecl = pdata <+> ppShortDataDecl False True dd [] unicode qual
   where
     iid = instanceId origin no orphan ihd
     typ = ppAppNameTypes ihdClsName ihdKinds ihdTypes unicode qual
@@ -644,8 +638,10 @@ ppInstanceSigs :: LinksInfo -> Splice -> Unicode -> Qualification
 ppInstanceSigs links splice unicode qual sigs = do
     TypeSig lnames typ <- sigs
     let names = map unLoc lnames
-        L loc rtyp = hsSigWcType typ
-    return $ ppSimpleSig links splice unicode qual loc names rtyp
+        L _ rtyp = hsSigWcType typ
+    -- Instance methods signatures are synified and thus don't have a useful
+    -- SrcSpan value. Use the methods name location instead.
+    return $ ppSimpleSig links splice unicode qual HideEmptyContexts (getLoc $ head $ lnames) names rtyp
 
 
 lookupAnySubdoc :: Eq id1 => id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2
@@ -672,20 +668,23 @@ instanceId origin no orphan ihd = concat $
 
 
 -- TODO: print contexts
-ppShortDataDecl :: Bool -> Bool -> TyClDecl DocNameI -> Unicode -> Qualification -> Html
-ppShortDataDecl summary dataInst dataDecl unicode qual
+ppShortDataDecl :: Bool -> Bool -> TyClDecl DocNameI
+                -> [(HsDecl DocNameI, DocForDecl DocName)]
+                -> Unicode -> Qualification -> Html
+ppShortDataDecl summary dataInst dataDecl pats unicode qual
 
-  | [] <- cons = dataHeader
+  | [] <- cons
+  , [] <- pats = dataHeader
 
-  | [lcon] <- cons, isH98,
+  | [lcon] <- cons, [] <- pats, isH98,
     (cHead,cBody,cFoot) <- ppShortConstrParts summary dataInst (unLoc lcon) unicode qual
        = (dataHeader <+> equals <+> cHead) +++ cBody +++ cFoot
 
-  | isH98 = dataHeader
-      +++ shortSubDecls dataInst (zipWith doConstr ('=':repeat '|') cons)
+  | [] <- pats, isH98 = dataHeader
+      +++ shortSubDecls dataInst (zipWith doConstr ('=':repeat '|') cons ++ pats1)
 
   | otherwise = (dataHeader <+> keyword "where")
-      +++ shortSubDecls dataInst (map doGADTConstr cons)
+      +++ shortSubDecls dataInst (map doGADTConstr cons ++ pats1)
 
   where
     dataHeader
@@ -699,16 +698,25 @@ ppShortDataDecl summary dataInst dataDecl unicode qual
                   ConDeclH98 {} -> True
                   ConDeclGADT{} -> False
 
+    pats1 = [ hsep [ keyword "pattern"
+                   , hsep $ punctuate comma $ map (ppBinder summary . getOccName) lnames
+                   , dcolon unicode
+                   , ppPatSigType unicode qual (hsSigType typ)
+                   ]
+            | (SigD (PatSynSig lnames typ),_) <- pats
+            ]
+
 
 ppDataDecl :: Bool -> LinksInfo -> [DocInstance DocNameI] -> [(DocName, Fixity)] ->
               [(DocName, DocForDecl DocName)] ->
               SrcSpan -> Documentation DocName -> TyClDecl DocNameI ->
+              [(HsDecl DocNameI, DocForDecl DocName)] ->
               Splice -> Unicode -> Qualification -> Html
-ppDataDecl summary links instances fixities subdocs loc doc dataDecl
+ppDataDecl summary links instances fixities subdocs loc doc dataDecl pats
            splice unicode qual
 
-  | summary   = ppShortDataDecl summary False dataDecl unicode qual
-  | otherwise = header_ +++ docSection Nothing qual doc +++ constrBit +++ instancesBit
+  | summary   = ppShortDataDecl summary False dataDecl pats unicode qual
+  | otherwise = header_ +++ docSection Nothing qual doc +++ constrBit +++ patternBit +++ instancesBit
 
   where
     docname   = tcdName dataDecl
@@ -723,7 +731,9 @@ ppDataDecl summary links instances fixities subdocs loc doc dataDecl
     fix = ppFixities (filter (\(n,_) -> n == docname) fixities) qual
 
     whereBit
-      | null cons = noHtml
+      | null cons
+      , null pats = noHtml
+      | null cons = keyword "where"
       | otherwise = if isH98 then noHtml else keyword "where"
 
     constrBit = subConstructors qual
@@ -733,6 +743,17 @@ ppDataDecl summary links instances fixities subdocs loc doc dataDecl
                                      (map unLoc (getConNames (unLoc c)))) fixities
       ]
 
+    patternBit = subPatterns qual
+      [ (hsep [ keyword "pattern"
+              , hsep $ punctuate comma $ map (ppBinder summary . getOccName) lnames
+              , dcolon unicode
+              , ppPatSigType unicode qual (hsSigType typ)
+              ] <+> ppFixities subfixs qual
+        ,combineDocumentation (fst d), [])
+      | (SigD (PatSynSig lnames typ),d) <- pats
+      , let subfixs = filter (\(n,_) -> any (\cn -> cn == n) (map unLoc lnames)) fixities
+      ]
+
     instancesBit = ppInstances links (OriginData docname) instances
         splice unicode qual
 
@@ -751,17 +772,17 @@ 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)
+            : map (ppLParendType unicode qual HideEmptyContexts) args), noHtml, noHtml)
     RecCon (L _ fields) ->
       (header_ unicode qual +++ ppOcc <+> char '{',
        doRecordFields fields,
        char '}')
     InfixCon arg1 arg2 ->
-      (header_ unicode qual +++ hsep [ppLParendType unicode qual arg1,
-            ppOccInfix, ppLParendType unicode qual arg2],
+      (header_ unicode qual +++ hsep [ppLParendType unicode qual HideEmptyContexts arg1,
+            ppOccInfix, ppLParendType unicode qual HideEmptyContexts arg2],
        noHtml, noHtml)
 
-  ConDeclGADT {} -> (ppOcc <+> dcolon unicode <+> ppLType unicode qual resTy,noHtml,noHtml)
+  ConDeclGADT {} -> (ppOcc <+> dcolon unicode <+> ppLType unicode qual HideEmptyContexts resTy,noHtml,noHtml)
 
   where
     resTy = hsib_body (con_type con)
@@ -793,7 +814,7 @@ ppConstrHdr forall_ tvs ctxt unicode qual
  = (if null tvs then noHtml else ppForall)
    +++
    (if null ctxt then noHtml
-    else ppContextNoArrow ctxt unicode qual
+    else ppContextNoArrow ctxt unicode qual HideEmptyContexts
          <+> darrow unicode +++ toHtml " ")
   where
     ppForall | forall_   = forallSymbol unicode <+> hsep (map (ppName Prefix) tvs)
@@ -809,15 +830,15 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con)
       ConDeclH98{} -> case con_details con of
         PrefixCon args ->
           hsep ((header_ +++ ppOcc)
-            : map (ppLParendType unicode qual) args)
+            : map (ppLParendType unicode qual HideEmptyContexts) args)
           <+> fixity
 
         RecCon _ -> header_ +++ ppOcc <+> fixity
 
         InfixCon arg1 arg2 ->
-          hsep [header_ +++ ppLParendType unicode qual arg1,
+          hsep [header_ +++ ppLParendType unicode qual HideEmptyContexts arg1,
             ppOccInfix,
-            ppLParendType unicode qual arg2]
+            ppLParendType unicode qual HideEmptyContexts arg2]
           <+> fixity
 
       ConDeclGADT{} -> doGADTCon resTy
@@ -834,7 +855,7 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con)
     doGADTCon :: Located (HsType DocNameI) -> Html
     doGADTCon ty = ppOcc <+> dcolon unicode
         -- ++AZ++ make this prepend "{..}" when it is a record style GADT
-        <+> ppLType unicode qual ty
+        <+> ppLType unicode qual HideEmptyContexts ty
         <+> fixity
 
     fixity  = ppFixities fixities qual
@@ -861,9 +882,12 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con)
 ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Unicode -> Qualification
                   -> ConDeclField DocNameI -> SubDecl
 ppSideBySideField subdocs unicode qual (ConDeclField names ltype _) =
-  (hsep (punctuate comma (map ((ppBinder False) . rdrNameOcc . unLoc . rdrNameFieldOcc . unLoc) names)) <+> dcolon unicode <+> ppLType unicode qual ltype,
-    mbDoc,
-    [])
+  ( hsep (punctuate comma (map ((ppBinder False) . rdrNameOcc . unLoc . rdrNameFieldOcc . unLoc) names))
+      <+> dcolon unicode
+      <+> ppLType unicode qual HideEmptyContexts 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
@@ -873,7 +897,7 @@ ppSideBySideField subdocs unicode qual (ConDeclField names ltype _) =
 ppShortField :: Bool -> Unicode -> Qualification -> ConDeclField DocNameI -> Html
 ppShortField summary unicode qual (ConDeclField names ltype _)
   = hsep (punctuate comma (map ((ppBinder summary) . rdrNameOcc . unLoc . rdrNameFieldOcc . unLoc) names))
-    <+> dcolon unicode <+> ppLType unicode qual ltype
+    <+> dcolon unicode <+> ppLType unicode qual HideEmptyContexts ltype
 
 
 -- | Print the LHS of a data\/newtype declaration.
@@ -888,9 +912,9 @@ ppDataHeader summary decl@(DataDecl { tcdDataDefn =
     (case nd of { NewType -> keyword "newtype"; DataType -> keyword "data" })
     <+>
     -- context
-    ppLContext ctxt unicode qual <+>
+    ppLContext ctxt unicode qual HideEmptyContexts <+>
     -- T a b c ..., or a :+: b
-    ppDataBinderWithVars summary decl
+    ppDataBinderWithVars summary unicode qual decl
     <+> case ks of
       Nothing -> mempty
       Just (L _ x) -> dcolon unicode <+> ppKind unicode qual x
@@ -940,19 +964,18 @@ maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
                                | otherwise            = p
 
 
-ppLType, ppLParendType, ppLFunLhType :: Unicode -> Qualification
-                                     -> Located (HsType DocNameI) -> Html
-ppLType       unicode qual y = ppType unicode qual (unLoc y)
-ppLParendType unicode qual y = ppParendType unicode qual (unLoc y)
-ppLFunLhType  unicode qual y = ppFunLhType unicode qual (unLoc y)
+ppLType, ppLParendType, ppLFunLhType :: Unicode -> Qualification -> HideEmptyContexts -> Located (HsType DocNameI) -> Html
+ppLType       unicode qual emptyCtxts y = ppType unicode qual emptyCtxts (unLoc y)
+ppLParendType unicode qual emptyCtxts y = ppParendType unicode qual emptyCtxts (unLoc y)
+ppLFunLhType  unicode qual emptyCtxts y = ppFunLhType unicode qual emptyCtxts (unLoc y)
 
+ppCtxType :: Unicode -> Qualification -> HsType DocNameI -> Html
+ppCtxType unicode qual ty = ppr_mono_ty pREC_CTX ty unicode qual HideEmptyContexts
 
-ppType, ppCtxType, ppParendType, ppFunLhType :: Unicode -> Qualification
-                                             -> HsType DocNameI -> Html
-ppType       unicode qual ty = ppr_mono_ty pREC_TOP ty unicode qual
-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
+ppType, ppParendType, ppFunLhType :: Unicode -> Qualification -> HideEmptyContexts -> HsType DocNameI -> Html
+ppType       unicode qual emptyCtxts ty = ppr_mono_ty pREC_TOP ty unicode qual emptyCtxts
+ppParendType unicode qual emptyCtxts ty = ppr_mono_ty pREC_CON ty unicode qual emptyCtxts
+ppFunLhType  unicode qual emptyCtxts ty = ppr_mono_ty pREC_FUN ty unicode qual emptyCtxts
 
 ppHsTyVarBndr :: Unicode -> Qualification -> HsTyVarBndr DocNameI -> Html
 ppHsTyVarBndr _       qual (UserTyVar (L _ name)) =
@@ -965,62 +988,85 @@ ppLKind :: Unicode -> Qualification -> LHsKind DocNameI -> Html
 ppLKind unicode qual y = ppKind unicode qual (unLoc y)
 
 ppKind :: Unicode -> Qualification -> HsKind DocNameI -> Html
-ppKind unicode qual ki = ppr_mono_ty pREC_TOP ki unicode qual
-
-ppForAllPart :: [LHsTyVarBndr DocNameI] -> Unicode -> Html
-ppForAllPart tvs unicode = hsep (forallSymbol unicode : ppTyVars tvs) +++ dot
-
-ppr_mono_lty :: Int -> LHsType DocNameI -> Unicode -> Qualification -> Html
+ppKind unicode qual ki = ppr_mono_ty pREC_TOP ki unicode qual HideEmptyContexts
+
+ppPatSigType :: Unicode -> Qualification -> LHsType DocNameI -> Html
+ppPatSigType unicode qual typ =
+  let emptyCtxts =
+        if hasNonEmptyContext typ && isFirstContextEmpty typ
+          then ShowEmptyToplevelContexts
+          else HideEmptyContexts
+  in ppLType unicode qual emptyCtxts typ
+  where
+    hasNonEmptyContext :: LHsType name -> Bool
+    hasNonEmptyContext t =
+      case unLoc t of
+        HsForAllTy _ s -> hasNonEmptyContext s
+        HsQualTy cxt s -> if null (unLoc cxt) then hasNonEmptyContext s else True
+        HsFunTy _ s -> hasNonEmptyContext s
+        _ -> False
+    isFirstContextEmpty :: LHsType name -> Bool
+    isFirstContextEmpty t =
+      case unLoc t of
+        HsForAllTy _ s -> isFirstContextEmpty s
+        HsQualTy cxt _ -> null (unLoc cxt)
+        HsFunTy _ s -> isFirstContextEmpty s
+        _ -> False
+
+ppForAllPart :: Unicode -> Qualification -> [LHsTyVarBndr DocNameI] -> Html
+ppForAllPart unicode qual tvs = hsep (forallSymbol unicode : ppTyVars unicode qual tvs) +++ dot
+
+ppr_mono_lty :: Int -> LHsType DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html
 ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
 
 
-ppr_mono_ty :: Int -> HsType DocNameI -> Unicode -> Qualification -> Html
-ppr_mono_ty ctxt_prec (HsForAllTy tvs ty) unicode qual
+ppr_mono_ty :: Int -> HsType DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html
+ppr_mono_ty ctxt_prec (HsForAllTy tvs ty) unicode qual emptyCtxts
   = maybeParen ctxt_prec pREC_FUN $
-    ppForAllPart tvs unicode <+> ppr_mono_lty pREC_TOP ty unicode qual
+    ppForAllPart unicode qual tvs <+> ppr_mono_lty pREC_TOP ty unicode qual emptyCtxts
 
-ppr_mono_ty ctxt_prec (HsQualTy ctxt ty) unicode qual
+ppr_mono_ty ctxt_prec (HsQualTy ctxt ty) unicode qual emptyCtxts
   = maybeParen ctxt_prec pREC_FUN $
-    ppLContext ctxt unicode qual <+> ppr_mono_lty pREC_TOP ty unicode qual
+    ppLContext ctxt unicode qual emptyCtxts <+> ppr_mono_lty pREC_TOP ty unicode qual emptyCtxts
 
 -- UnicodeSyntax alternatives
-ppr_mono_ty _ (HsTyVar _ (L _ 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 _ (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 _         (HsSumTy tys) u q = sumParens (map (ppLType u q) tys)
-ppr_mono_ty _         (HsKindSig ty kind) u q =
-    parens (ppr_mono_lty pREC_TOP ty u q <+> dcolon u <+> ppLKind u q kind)
-ppr_mono_ty _         (HsListTy ty)       u q = brackets (ppr_mono_lty pREC_TOP ty u q)
-ppr_mono_ty _         (HsPArrTy ty)       u q = pabrackets (ppr_mono_lty pREC_TOP ty u q)
-ppr_mono_ty ctxt_prec (HsIParamTy (L _ 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 {})        _ _ = toHtml "{..}"
+ppr_mono_ty _         (HsBangTy b ty)     u q _ = ppBang b +++ ppLParendType u q HideEmptyContexts ty
+ppr_mono_ty _         (HsTyVar _ (L _ name)) _ q _ = ppDocName q Prefix True name
+ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   u q e = ppr_fun_ty ctxt_prec ty1 ty2 u q e
+ppr_mono_ty _         (HsTupleTy con tys) u q _ = tupleParens con (map (ppLType u q HideEmptyContexts) tys)
+ppr_mono_ty _         (HsSumTy tys) u q _ = sumParens (map (ppLType u q HideEmptyContexts) tys)
+ppr_mono_ty _         (HsKindSig ty kind) u q e =
+    parens (ppr_mono_lty pREC_TOP ty u q e <+> dcolon u <+> ppLKind u q kind)
+ppr_mono_ty _         (HsListTy ty)       u q _ = brackets (ppr_mono_lty pREC_TOP ty u q HideEmptyContexts)
+ppr_mono_ty _         (HsPArrTy ty)       u q _ = pabrackets (ppr_mono_lty pREC_TOP ty u q HideEmptyContexts)
+ppr_mono_ty ctxt_prec (HsIParamTy (L _ n) ty) u q _ =
+    maybeParen ctxt_prec pREC_CTX $ ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q HideEmptyContexts
+ppr_mono_ty _         (HsSpliceTy {})     _ _ _ = error "ppr_mono_ty HsSpliceTy"
+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 Promoted _ tys) u q = promoQuote $ brackets $ hsep $ punctuate comma $ map (ppLType u q) tys
-ppr_mono_ty _         (HsExplicitListTy NotPromoted _ tys) u q = 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 _         (HsCoreTy {})       _ _ _ = error "ppr_mono_ty HsCoreTy"
+ppr_mono_ty _         (HsExplicitListTy Promoted _ tys) u q _ = promoQuote $ brackets $ hsep $ punctuate comma $ map (ppLType u q HideEmptyContexts) tys
+ppr_mono_ty _         (HsExplicitListTy NotPromoted _ tys) u q _ = brackets $ hsep $ punctuate comma $ map (ppLType u q HideEmptyContexts) tys
+ppr_mono_ty _         (HsExplicitTupleTy _ tys) u q _ = promoQuote $ parenList $ map (ppLType u q HideEmptyContexts) tys
+ppr_mono_ty _         (HsAppsTy {})       _ _ _ = error "ppr_mono_ty HsAppsTy"
 
-ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode qual
+ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode qual _
   = maybeParen ctxt_prec pREC_CTX $
-    ppr_mono_lty pREC_OP ty1 unicode qual <+> char '~' <+> ppr_mono_lty pREC_OP ty2 unicode qual
+    ppr_mono_lty pREC_OP ty1 unicode qual HideEmptyContexts <+> char '~' <+> ppr_mono_lty pREC_OP ty2 unicode qual HideEmptyContexts
 
-ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode qual
+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]
+    hsep [ppr_mono_lty pREC_FUN fun_ty unicode qual HideEmptyContexts, ppr_mono_lty pREC_CON arg_ty unicode qual HideEmptyContexts]
 
-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
+    ppr_mono_lty pREC_OP ty1 unicode qual HideEmptyContexts <+> ppr_op <+> ppr_mono_lty pREC_OP ty2 unicode qual HideEmptyContexts
   where
     -- `(:)` 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.
@@ -1029,25 +1075,24 @@ ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) unicode qual
         | otherwise = ppr_op'
     ppr_op' = ppLDocName qual Infix op
 
-ppr_mono_ty ctxt_prec (HsParTy ty) unicode qual
+ppr_mono_ty ctxt_prec (HsParTy ty) unicode qual emptyCtxts
 --  = parens (ppr_mono_lty pREC_TOP ty)
-  = ppr_mono_lty ctxt_prec ty unicode qual
+  = ppr_mono_lty ctxt_prec ty unicode qual emptyCtxts
 
-ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode qual
-  = ppr_mono_lty ctxt_prec ty unicode qual
+ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode qual emptyCtxts
+  = ppr_mono_lty ctxt_prec ty unicode qual emptyCtxts
 
-ppr_mono_ty _ (HsWildCardTy (AnonWildCard _)) _ _ = char '_'
-ppr_mono_ty _ (HsTyLit n) _ _ = ppr_tylit n
+ppr_mono_ty _ (HsWildCardTy (AnonWildCard _)) _ _ _ = char '_'
+ppr_mono_ty _ (HsTyLit n) _ _ _ = ppr_tylit n
 
 ppr_tylit :: HsTyLit -> Html
 ppr_tylit (HsNumTy _ n) = toHtml (show n)
 ppr_tylit (HsStrTy _ s) = toHtml (show s)
 
-
-ppr_fun_ty :: Int -> LHsType DocNameI -> LHsType DocNameI -> Unicode -> Qualification -> Html
-ppr_fun_ty ctxt_prec ty1 ty2 unicode qual
-  = let p1 = ppr_mono_lty pREC_FUN ty1 unicode qual
-        p2 = ppr_mono_lty pREC_TOP ty2 unicode qual
+ppr_fun_ty :: Int -> LHsType DocNameI -> LHsType DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html
+ppr_fun_ty ctxt_prec ty1 ty2 unicode qual emptyCtxts
+  = let p1 = ppr_mono_lty pREC_FUN ty1 unicode qual HideEmptyContexts
+        p2 = ppr_mono_lty pREC_TOP ty2 unicode qual emptyCtxts
     in
     maybeParen ctxt_prec pREC_FUN $
     hsep [p1, arrow unicode <+> p2]
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
index e36f9528..18c8a0ff 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
@@ -20,6 +20,7 @@ module Haddock.Backends.Xhtml.DocMarkup (
 ) where
 
 import Data.List
+import Documentation.Haddock.Markup
 import Haddock.Backends.Xhtml.Names
 import Haddock.Backends.Xhtml.Utils
 import Haddock.Types
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index 41457f72..6993c7f6 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -29,6 +29,7 @@ module Haddock.Backends.Xhtml.Layout (
   subArguments,
   subAssociatedTypes,
   subConstructors,
+  subPatterns,
   subEquations,
   subFields,
   subInstances, subOrphanInstances,
@@ -180,6 +181,9 @@ subAssociatedTypes = divSubDecls "associated-types" "Associated Types" . subBloc
 subConstructors :: Qualification -> [SubDecl] -> Html
 subConstructors qual = divSubDecls "constructors" "Constructors" . subTable qual
 
+subPatterns :: Qualification -> [SubDecl] -> Html
+subPatterns qual = divSubDecls "bundled-patterns" "Bundled Patterns" . subTable qual
+
 subFields :: Qualification -> [SubDecl] -> Html
 subFields qual = divSubDecls "fields" "Fields" . subDlist qual
 
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index 2b25174c..36efb3e4 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -30,7 +30,7 @@ import Name
 import NameSet ( emptyNameSet )
 import RdrName ( mkVarUnqual )
 import PatSyn
-import SrcLoc ( Located, noLoc, unLoc )
+import SrcLoc ( Located, noLoc, unLoc, GenLocated(..), srcLocSpan )
 import TcType ( tcSplitSigmaTy )
 import TyCon
 import Type
@@ -319,7 +319,7 @@ synifyDataCon use_gadt_syntax dc =
                          , con_doc =  Nothing }
 
 synifyName :: NamedThing n => n -> Located Name
-synifyName = noLoc . getName
+synifyName n = L (srcLocSpan (getSrcLoc n)) (getName n)
 
 
 synifyIdSig :: SynifyTypeState -> Id -> Sig GhcRn
diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs
index 83e4dbd8..561c126f 100644
--- a/haddock-api/src/Haddock/GhcUtils.hs
+++ b/haddock-api/src/Haddock/GhcUtils.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleInstances, ViewPatterns #-}
+{-# LANGUAGE BangPatterns, FlexibleInstances, ViewPatterns #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# OPTIONS_HADDOCK hide #-}
 -----------------------------------------------------------------------------
@@ -17,17 +17,14 @@ module Haddock.GhcUtils where
 
 
 import Control.Arrow
-import Data.Function
 
 import Exception
 import Outputable
 import Name
+import NameSet
 import Lexeme
 import Module
-import RdrName (GlobalRdrEnv)
-import GhcMonad (withSession)
 import HscTypes
-import UniqFM
 import GHC
 import Class
 
@@ -92,6 +89,10 @@ filterSigNames p (ClassOpSig is_default ns ty) =
   case filter (p . unLoc) ns of
     []       -> Nothing
     filtered -> Just (ClassOpSig is_default filtered ty)
+filterSigNames p (PatSynSig ns ty) =
+  case filter (p . unLoc) ns of
+    []       -> Nothing
+    filtered -> Just (PatSynSig filtered ty)
 filterSigNames _ _                           = Nothing
 
 ifTrueJust :: Bool -> name -> Maybe name
@@ -114,6 +115,7 @@ sigNameNoLoc _                         = []
 isUserLSig :: LSig name -> Bool
 isUserLSig (L _(TypeSig {}))    = True
 isUserLSig (L _(ClassOpSig {})) = True
+isUserLSig (L _(PatSynSig {}))  = True
 isUserLSig _                    = False
 
 
@@ -134,6 +136,17 @@ declATs _ = []
 pretty :: Outputable a => DynFlags -> a -> String
 pretty = showPpr
 
+nubByName :: (a -> Name) -> [a] -> [a]
+nubByName f ns = go emptyNameSet ns
+  where
+    go !_ [] = []
+    go !s (x:xs)
+      | y `elemNameSet` s = go s xs
+      | otherwise         = let !s' = extendNameSet s y
+                            in x : go s' xs
+      where
+        y = f x
+
 -------------------------------------------------------------------------------
 -- * Located
 -------------------------------------------------------------------------------
diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs
index 31991e25..4c7b70d7 100644
--- a/haddock-api/src/Haddock/Interface.hs
+++ b/haddock-api/src/Haddock/Interface.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Haddock.Interface
@@ -56,6 +57,13 @@ import Exception
 import GHC hiding (verbosity)
 import HscTypes
 import FastString (unpackFS)
+import MonadUtils (liftIO)
+
+#if defined(mingw32_HOST_OS)
+import System.IO
+import GHC.IO.Encoding.CodePage (mkLocaleEncoding)
+import GHC.IO.Encoding.Failure (CodingFailureMode(TransliterateCodingFailure))
+#endif
 
 -- | Create 'Interface's and a link environment by typechecking the list of
 -- modules using the GHC API and processing the resulting syntax trees.
@@ -68,6 +76,10 @@ processModules
   -> Ghc ([Interface], LinkEnv) -- ^ Resulting list of interfaces and renaming
                                 -- environment
 processModules verbosity modules flags extIfaces = do
+#if defined(mingw32_HOST_OS)
+  -- Avoid internal error: <stderr>: hPutChar: invalid argument (invalid character)' non UTF-8 Windows
+  liftIO $ hSetEncoding stderr $ mkLocaleEncoding TransliterateCodingFailure
+#endif
 
   out verbosity verbose "Creating interfaces..."
   let instIfaceMap =  Map.fromList [ (instMod iface, iface) | ext <- extIfaces
diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs
index 1eb227b9..0e5811b1 100644
--- a/haddock-api/src/Haddock/Interface/AttachInstances.hs
+++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs
@@ -19,14 +19,13 @@ import Haddock.Types
 import Haddock.Convert
 import Haddock.GhcUtils
 
+import Control.Applicative
 import Control.Arrow hiding ((<+>))
 import Data.List
 import Data.Ord (comparing)
-import Data.Function (on)
 import Data.Maybe ( maybeToList, mapMaybe, fromMaybe )
 import qualified Data.Map as Map
 import qualified Data.Set as Set
-import Control.Monad
 
 import Class
 import DynFlags
@@ -35,7 +34,6 @@ import ErrUtils
 import FamInstEnv
 import FastString
 import GHC
-import GhcMonad (withSession)
 import InstEnv
 import MonadUtils (liftIO)
 import Name
@@ -118,13 +116,17 @@ attachToExportItem index expInfo iface ifaceMap instIfaceMap export =
       return $ e { expItemInstances = insts }
     e -> return e
   where
-    attachFixities e@ExportDecl{ expItemDecl = L _ d } = e { expItemFixities =
-      nubBy ((==) `on` fst) $ expItemFixities e ++
+    attachFixities e@ExportDecl{ expItemDecl = L _ d
+                               , expItemPats = patsyns
+                               } = e { expItemFixities =
+      nubByName fst $ expItemFixities e ++
       [ (n',f) | n <- getMainDeclBinder d
-              , Just subs <- [instLookup instSubMap n iface ifaceMap instIfaceMap]
-              , n' <- n : subs
+              , Just subs <- [instLookup instSubMap n iface ifaceMap instIfaceMap <|> Just []]
+              , n' <- n : (subs ++ patsyn_names)
               , Just f <- [instLookup instFixMap n' iface ifaceMap instIfaceMap]
       ] }
+      where
+        patsyn_names = concatMap (getMainDeclBinder . fst) patsyns
 
     attachFixities e = e
     -- spanName: attach the location to the name that is the same file as the instance location
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 2b352d90..292680a7 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -20,6 +20,7 @@
 module Haddock.Interface.Create (createInterface) where
 
 import Documentation.Haddock.Doc (metaDocAppend)
+import Documentation.Haddock.Utf8 as Utf8
 import Haddock.Types
 import Haddock.Options
 import Haddock.GhcUtils
@@ -30,6 +31,8 @@ import Haddock.Backends.Hyperlinker.Types
 import Haddock.Backends.Hyperlinker.Ast as Hyperlinker
 import Haddock.Backends.Hyperlinker.Parser as Hyperlinker
 
+import Data.Bitraversable
+import qualified Data.ByteString as BS
 import qualified Data.Map as M
 import Data.Map (Map)
 import Data.List
@@ -37,10 +40,9 @@ import Data.Maybe
 import Data.Monoid
 import Data.Ord
 import Control.Applicative
-import Control.Arrow (second)
-import Control.DeepSeq
+import Control.Exception (evaluate)
 import Control.Monad
-import Data.Function (on)
+import Data.Traversable
 
 import qualified Packages
 import qualified Module
@@ -48,6 +50,7 @@ import qualified SrcLoc
 import GHC
 import HscTypes
 import Name
+import NameSet
 import Bag
 import RdrName
 import TcRnTypes
@@ -76,9 +79,12 @@ createInterface tm flags modMap instIfaceMap = do
       dflags         = ms_hspp_opts ms
       !instances     = modInfoInstances mi
       !fam_instances = md_fam_insts md
-      !exportedNames = modInfoExports mi
+      !exportedNames = modInfoExportsWithSelectors mi
 
-      (TcGblEnv {tcg_rdr_env = gre, tcg_warns = warnings}, md) = tm_internals_ tm
+      (TcGblEnv { tcg_rdr_env = gre
+                , tcg_warns   = warnings
+                , tcg_patsyns = patsyns
+                }, md) = tm_internals_ tm
 
   -- The renamed source should always be available to us, but it's best
   -- to be on the safe side.
@@ -98,6 +104,27 @@ createInterface tm flags modMap instIfaceMap = do
   (!info, mbDoc) <- liftErrMsg $ processModuleHeader dflags gre safety mayDocHeader
 
   let declsWithDocs = topDecls group_
+
+      exports0 = fmap (reverse . map unLoc) mayExports
+      exports
+        | OptIgnoreExports `elem` opts = Nothing
+        | otherwise = exports0
+
+      localBundledPatSyns :: Map Name [Name]
+      localBundledPatSyns =
+        case exports of
+          Nothing  -> M.empty
+          Just ies ->
+            M.map (nubByName id) $
+            M.fromListWith (++) [ (ieWrappedName ty_name, bundled_patsyns)
+                                | IEThingWith (L _ ty_name) _ exported _ <- ies
+                                , let bundled_patsyns =
+                                        filter is_patsyn (map (ieWrappedName . unLoc) exported)
+                                , not (null bundled_patsyns)
+                                ]
+        where
+          is_patsyn name = elemNameSet name (mkNameSet (map getName patsyns))
+
       fixMap = mkFixMap group_
       (decls, _) = unzip declsWithDocs
       localInsts = filter (nameIsLocalOrFrom sem_mdl)
@@ -106,21 +133,17 @@ createInterface tm flags modMap instIfaceMap = do
       -- Locations of all TH splices
       splices = [ l | L l (SpliceD _) <- hsmodDecls hsm ]
 
-      maps@(!docMap, !argMap, !subMap, !declMap, _) =
-        mkMaps dflags gre localInsts declsWithDocs
+  warningMap <- liftErrMsg (mkWarningMap dflags warnings gre exportedNames)
 
-  let exports0 = fmap (reverse . map unLoc) mayExports
-      exports
-        | OptIgnoreExports `elem` opts = Nothing
-        | otherwise = exports0
-      warningMap = mkWarningMap dflags warnings gre exportedNames
+  maps@(!docMap, !argMap, !subMap, !declMap, _) <-
+    liftErrMsg (mkMaps dflags gre localInsts declsWithDocs)
 
   let allWarnings = M.unions (warningMap : map ifaceWarningMap (M.elems modMap))
 
   -- The MAIN functionality: compute the export items which will
   -- each be the actual documentation of this module.
   exportItems <- mkExportItems is_sig modMap mdl sem_mdl allWarnings gre exportedNames decls
-                   maps fixMap splices exports instIfaceMap dflags
+                   maps localBundledPatSyns fixMap splices exports instIfaceMap dflags
 
   let !visibleNames = mkVisibleNames maps exportItems opts
 
@@ -139,37 +162,39 @@ createInterface tm flags modMap instIfaceMap = do
 
   let !aliases =
         mkAliasMap dflags $ tm_renamed_source tm
-      modWarn = moduleWarning dflags gre warnings
+
+  modWarn <- liftErrMsg (moduleWarning dflags gre warnings)
 
   tokenizedSrc <- mkMaybeTokenizedSrc flags tm
 
   return $! Interface {
-    ifaceMod             = mdl
-  , ifaceIsSig           = is_sig
-  , ifaceOrigFilename    = msHsFilePath ms
-  , ifaceInfo            = info
-  , ifaceDoc             = Documentation mbDoc modWarn
-  , ifaceRnDoc           = Documentation Nothing Nothing
-  , ifaceOptions         = opts
-  , ifaceDocMap          = docMap
-  , ifaceArgMap          = argMap
-  , ifaceRnDocMap        = M.empty
-  , ifaceRnArgMap        = M.empty
-  , ifaceExportItems     = prunedExportItems
-  , ifaceRnExportItems   = []
-  , ifaceExports         = exportedNames
-  , ifaceVisibleExports  = visibleNames
-  , ifaceDeclMap         = declMap
-  , ifaceSubMap          = subMap
-  , ifaceFixMap          = fixMap
-  , ifaceModuleAliases   = aliases
-  , ifaceInstances       = instances
-  , ifaceFamInstances    = fam_instances
+    ifaceMod               = mdl
+  , ifaceIsSig             = is_sig
+  , ifaceOrigFilename      = msHsFilePath ms
+  , ifaceInfo              = info
+  , ifaceDoc               = Documentation mbDoc modWarn
+  , ifaceRnDoc             = Documentation Nothing Nothing
+  , ifaceOptions           = opts
+  , ifaceDocMap            = docMap
+  , ifaceArgMap            = argMap
+  , ifaceRnDocMap          = M.empty
+  , ifaceRnArgMap          = M.empty
+  , ifaceExportItems       = prunedExportItems
+  , ifaceRnExportItems     = []
+  , ifaceExports           = exportedNames
+  , ifaceVisibleExports    = visibleNames
+  , ifaceDeclMap           = declMap
+  , ifaceBundledPatSynMap  = localBundledPatSyns
+  , ifaceSubMap            = subMap
+  , ifaceFixMap            = fixMap
+  , ifaceModuleAliases     = aliases
+  , ifaceInstances         = instances
+  , ifaceFamInstances      = fam_instances
   , ifaceOrphanInstances   = [] -- Filled in `attachInstances`
   , ifaceRnOrphanInstances = [] -- Filled in `renameInterface`
-  , ifaceHaddockCoverage = coverage
-  , ifaceWarningMap      = warningMap
-  , ifaceTokenizedSrc    = tokenizedSrc
+  , ifaceHaddockCoverage   = coverage
+  , ifaceWarningMap        = warningMap
+  , ifaceTokenizedSrc      = tokenizedSrc
   }
 
 -- | Given all of the @import M as N@ declarations in a package,
@@ -222,27 +247,29 @@ lookupModuleDyn dflags Nothing mdlName =
 -- Warnings
 -------------------------------------------------------------------------------
 
-mkWarningMap :: DynFlags -> Warnings -> GlobalRdrEnv -> [Name] -> WarningMap
+mkWarningMap :: DynFlags -> Warnings -> GlobalRdrEnv -> [Name] -> ErrMsgM WarningMap
 mkWarningMap dflags warnings gre exps = case warnings of
-  NoWarnings  -> M.empty
-  WarnAll _   -> M.empty
+  NoWarnings  -> pure M.empty
+  WarnAll _   -> pure M.empty
   WarnSome ws ->
-    let ws' = [ (n, w) | (occ, w) <- ws, elt <- lookupGlobalRdrEnv gre occ
+    let ws' = [ (n, w)
+              | (occ, w) <- ws
+              , elt <- lookupGlobalRdrEnv gre occ
               , let n = gre_name elt, n `elem` exps ]
-    in M.fromList $ map (second $ parseWarning dflags gre) ws'
+    in M.fromList <$> traverse (bitraverse pure (parseWarning dflags gre)) ws'
 
-moduleWarning :: DynFlags -> GlobalRdrEnv -> Warnings -> Maybe (Doc Name)
-moduleWarning _ _ NoWarnings = Nothing
-moduleWarning _ _ (WarnSome _) = Nothing
-moduleWarning dflags gre (WarnAll w) = Just $ parseWarning dflags gre w
+moduleWarning :: DynFlags -> GlobalRdrEnv -> Warnings -> ErrMsgM (Maybe (Doc Name))
+moduleWarning _ _ NoWarnings = pure Nothing
+moduleWarning _ _ (WarnSome _) = pure Nothing
+moduleWarning dflags gre (WarnAll w) = Just <$> parseWarning dflags gre w
 
-parseWarning :: DynFlags -> GlobalRdrEnv -> WarningTxt -> Doc Name
-parseWarning dflags gre w = force $ case w of
+parseWarning :: DynFlags -> GlobalRdrEnv -> WarningTxt -> ErrMsgM (Doc Name)
+parseWarning dflags gre w = case w of
   DeprecatedTxt _ msg -> format "Deprecated: " (concatFS $ map (sl_fs . unLoc) msg)
   WarningTxt    _ msg -> format "Warning: "    (concatFS $ map (sl_fs . unLoc) msg)
   where
     format x xs = DocWarning . DocParagraph . DocAppend (DocString x)
-                  . processDocString dflags gre $ HsDocString xs
+                  <$> processDocString dflags gre (HsDocString xs)
 
 
 -------------------------------------------------------------------------------
@@ -290,10 +317,15 @@ mkMaps :: DynFlags
        -> GlobalRdrEnv
        -> [Name]
        -> [(LHsDecl GhcRn, [HsDocString])]
-       -> Maps
-mkMaps dflags gre instances decls =
-  let (a, b, c, d) = unzip4 $ map mappings decls
-  in (f' $ map (nubBy ((==) `on` fst)) a , f b, f c, f d, instanceMap)
+       -> ErrMsgM Maps
+mkMaps dflags gre instances decls = do
+  (a, b, c, d) <- unzip4 <$> traverse mappings decls
+  pure ( f' (map (nubByName fst) a)
+       , f  (filterMapping (not . M.null) b)
+       , f  (filterMapping (not . null) c)
+       , f  (filterMapping (not . null) d)
+       , instanceMap
+       )
   where
     f :: (Ord a, Monoid b) => [[(a, b)]] -> Map a b
     f = M.fromListWith (<>) . concat
@@ -301,36 +333,46 @@ mkMaps dflags gre instances decls =
     f' :: [[(Name, MDoc Name)]] -> Map Name (MDoc Name)
     f' = M.fromListWith metaDocAppend . concat
 
+    filterMapping :: (b -> Bool) ->  [[(a, b)]] -> [[(a, b)]]
+    filterMapping p = map (filter (p . snd))
+
     mappings :: (LHsDecl GhcRn, [HsDocString])
-             -> ( [(Name, MDoc Name)]
-                , [(Name, Map Int (MDoc Name))]
-                , [(Name, [Name])]
-                , [(Name,  [LHsDecl GhcRn])]
-                )
-    mappings (ldecl, docStrs) =
+             -> ErrMsgM ( [(Name, MDoc Name)]
+                        , [(Name, Map Int (MDoc Name))]
+                        , [(Name, [Name])]
+                        , [(Name,  [LHsDecl GhcRn])]
+                        )
+    mappings (ldecl, docStrs) = do
       let L l decl = ldecl
           declDoc :: [HsDocString] -> Map Int HsDocString
-                  -> (Maybe (MDoc Name), Map Int (MDoc Name))
-          declDoc strs m =
-            let doc' = processDocStrings dflags gre strs
-                m' = M.map (processDocStringParas dflags gre) m
-            in (doc', m')
-          (doc, args) = declDoc docStrs (typeDocs decl)
+                  -> ErrMsgM (Maybe (MDoc Name), Map Int (MDoc Name))
+          declDoc strs m = do
+            doc' <- processDocStrings dflags gre strs
+            m'   <- traverse (processDocStringParas dflags gre) m
+            pure (doc', m')
+
+      (doc, args) <- declDoc docStrs (typeDocs decl)
+
+      let
           subs :: [(Name, [HsDocString], Map Int HsDocString)]
           subs = subordinates instanceMap decl
-          (subDocs, subArgs) = unzip $ map (\(_, strs, m) -> declDoc strs m) subs
+
+      (subDocs, subArgs) <- unzip <$> traverse (\(_, strs, m) -> declDoc strs m) subs
+
+      let
           ns = names l decl
           subNs = [ n | (n, _, _) <- subs ]
           dm = [ (n, d) | (n, Just d) <- zip ns (repeat doc) ++ zip subNs subDocs ]
           am = [ (n, args) | n <- ns ] ++ zip subNs subArgs
           sm = [ (n, subNs) | n <- ns ]
           cm = [ (n, [ldecl]) | n <- ns ++ subNs ]
-      in seqList ns `seq`
-          seqList subNs `seq`
-          doc `seq`
-          seqList subDocs `seq`
-          seqList subArgs `seq`
-          (dm, am, sm, cm)
+
+      seqList ns `seq`
+        seqList subNs `seq`
+        doc `seq`
+        seqList subDocs `seq`
+        seqList subArgs `seq`
+        pure (dm, am, sm, cm)
 
     instanceMap :: Map SrcSpan Name
     instanceMap = M.fromList [ (getSrcSpan n, n) | n <- instances ]
@@ -359,7 +401,9 @@ mkMaps dflags gre instances decls =
 -- | Get all subordinate declarations inside a declaration, and their docs.
 -- A subordinate declaration is something like the associate type or data
 -- family of a type class.
-subordinates :: InstMap -> HsDecl GhcRn -> [(Name, [HsDocString], Map Int HsDocString)]
+subordinates :: InstMap
+             -> HsDecl GhcRn
+             -> [(Name, [HsDocString], Map Int HsDocString)]
 subordinates instMap decl = case decl of
   InstD (ClsInstD d) -> do
     DataFamInstDecl { dfid_tycon = L l _
@@ -395,8 +439,9 @@ typeDocs :: HsDecl GhcRn -> Map Int HsDocString
 typeDocs d =
   let docs = go 0 in
   case d of
-    SigD (TypeSig _ ty)   -> docs (unLoc (hsSigWcType ty))
-    SigD (PatSynSig _ ty) -> docs (unLoc (hsSigType ty))
+    SigD (TypeSig _ ty)      -> docs (unLoc (hsSigWcType ty))
+    SigD (ClassOpSig _ _ ty) -> docs (unLoc (hsSigType ty))
+    SigD (PatSynSig _ ty)    -> docs (unLoc (hsSigType ty))
     ForD (ForeignImport _ ty _ _)   -> docs (unLoc (hsSigType ty))
     TyClD (SynDecl { tcdRhs = ty }) -> docs (unLoc ty)
     _ -> M.empty
@@ -536,6 +581,7 @@ mkExportItems
   -> [Name]             -- exported names (orig)
   -> [LHsDecl GhcRn]     -- renamed source declarations
   -> Maps
+  -> Map Name [Name]
   -> FixMap
   -> [SrcSpan]          -- splice locations
   -> Maybe [IE GhcRn]
@@ -544,15 +590,21 @@ mkExportItems
   -> ErrMsgGhc [ExportItem GhcRn]
 mkExportItems
   is_sig modMap thisMod semMod warnings gre exportedNames decls
-  maps@(docMap, argMap, subMap, declMap, instMap) fixMap splices optExports instIfaceMap dflags =
+  maps@(docMap, argMap, subMap, declMap, instMap) patSynMap fixMap splices optExports instIfaceMap dflags =
   case optExports of
     Nothing -> fullModuleContents dflags warnings gre maps fixMap splices decls
     Just exports -> liftM concat $ mapM lookupExport exports
   where
-    lookupExport (IEVar (L _ x))         = declWith $ ieWrappedName x
-    lookupExport (IEThingAbs (L _ t))    = declWith $ ieWrappedName t
-    lookupExport (IEThingAll (L _ t))    = declWith $ ieWrappedName t
-    lookupExport (IEThingWith (L _ t) _ _ _) = declWith $ ieWrappedName t
+    lookupExport (IEVar (L _ x))         = declWith [] $ ieWrappedName x
+    lookupExport (IEThingAbs (L _ t))    = declWith [] $ ieWrappedName t
+    lookupExport (IEThingAll (L _ t))    = do
+      let name     = ieWrappedName t
+      pats <- findBundledPatterns name
+      declWith pats name
+    lookupExport (IEThingWith (L _ t) _ _ _) = do
+      let name     = ieWrappedName t
+      pats <- findBundledPatterns name
+      declWith pats name
     lookupExport (IEModuleContents (L _ m)) =
       -- TODO: We could get more accurate reporting here if IEModuleContents
       -- also recorded the actual names that are exported here.  We CAN
@@ -560,19 +612,23 @@ mkExportItems
       -- do so.
       -- NB: Pass in identity module, so we can look it up in index correctly
       moduleExports thisMod m dflags warnings gre exportedNames decls modMap instIfaceMap maps fixMap splices
-    lookupExport (IEGroup lev docStr)  = return $
-      return . ExportGroup lev "" $ processDocString dflags gre docStr
+    lookupExport (IEGroup lev docStr)  = liftErrMsg $ do
+      doc <- processDocString dflags gre docStr
+      return [ExportGroup lev "" doc]
 
-    lookupExport (IEDoc docStr)        = return $
-      return . ExportDoc $ processDocStringParas dflags gre docStr
+    lookupExport (IEDoc docStr)        = liftErrMsg $ do
+      doc <- processDocStringParas dflags gre docStr
+      return [ExportDoc doc]
 
     lookupExport (IEDocNamed str)      = liftErrMsg $
-      findNamedDoc str [ unL d | d <- decls ] >>= return . \case
-        Nothing -> []
-        Just doc -> return . ExportDoc $ processDocStringParas dflags gre doc
-
-    declWith :: Name -> ErrMsgGhc [ ExportItem GhcRn ]
-    declWith t = do
+      findNamedDoc str [ unL d | d <- decls ] >>= \case
+        Nothing -> return  []
+        Just docStr -> do
+          doc <- processDocStringParas dflags gre docStr
+          return [ExportDoc doc]
+
+    declWith :: [(HsDecl GhcRn, DocForDecl Name)] -> Name -> ErrMsgGhc [ ExportItem GhcRn ]
+    declWith pats t = do
       r <- findDecl t
       case r of
         ([L l (ValD _)], (doc, _)) -> do
@@ -609,15 +665,15 @@ mkExportItems
                     -- fromJust is safe since we already checked in guards
                     -- that 't' is a name declared in this declaration.
                     let newDecl = L loc . SigD . fromJust $ filterSigNames (== t) sig
-                    in return [ mkExportDecl t newDecl docs_ ]
+                    in return [ mkExportDecl t newDecl pats docs_ ]
 
                   L loc (TyClD cl@ClassDecl{}) -> do
                     mdef <- liftGhcToErrMsgGhc $ minimalDef t
                     let sig = maybeToList $ fmap (noLoc . MinimalSig NoSourceText . noLoc . fmap noLoc) mdef
                     return [ mkExportDecl t
-                      (L loc $ TyClD cl { tcdSigs = sig ++ tcdSigs cl }) docs_ ]
+                      (L loc $ TyClD cl { tcdSigs = sig ++ tcdSigs cl }) pats docs_ ]
 
-                  _ -> return [ mkExportDecl t decl docs_ ]
+                  _ -> return [ mkExportDecl t decl pats docs_ ]
 
         -- Declaration from another package
         ([], _) -> do
@@ -634,24 +690,27 @@ mkExportItems
                    liftErrMsg $ tell
                       ["Warning: Couldn't find .haddock for export " ++ pretty dflags t]
                    let subs_ = [ (n, noDocForDecl) | (n, _, _) <- subordinates instMap (unLoc decl) ]
-                   return [ mkExportDecl t decl (noDocForDecl, subs_) ]
+                   return [ mkExportDecl t decl pats (noDocForDecl, subs_) ]
                 Just iface ->
-                   return [ mkExportDecl t decl (lookupDocs t warnings (instDocMap iface) (instArgMap iface) (instSubMap iface)) ]
+                   return [ mkExportDecl t decl pats (lookupDocs t warnings (instDocMap iface) (instArgMap iface) (instSubMap iface)) ]
 
         _ -> return []
 
 
-    mkExportDecl :: Name -> LHsDecl GhcRn -> (DocForDecl Name, [(Name, DocForDecl Name)]) -> ExportItem GhcRn
-    mkExportDecl name decl (doc, subs) = decl'
+    mkExportDecl :: Name -> LHsDecl GhcRn -> [(HsDecl GhcRn, DocForDecl Name)]
+                 -> (DocForDecl Name, [(Name, DocForDecl Name)]) -> ExportItem GhcRn
+    mkExportDecl name decl pats (doc, subs) = decl'
       where
-        decl' = ExportDecl (restrictTo sub_names (extractDecl name decl)) doc subs' [] fixities False
+        decl' = ExportDecl (restrictTo sub_names (extractDecl name decl)) pats' doc subs' [] fixities False
         subs' = filter (isExported . fst) subs
+        pats' = [ d | d@(patsyn_decl, _) <- pats
+                    , all isExported (getMainDeclBinder patsyn_decl) ]
         sub_names = map fst subs'
-        fixities = [ (n, f) | n <- name:sub_names, Just f <- [M.lookup n fixMap] ]
-
-
-    isExported = (`elem` exportedNames)
+        pat_names = [ n | (patsyn_decl, _) <- pats', n <- getMainDeclBinder patsyn_decl]
+        fixities = [ (n, f) | n <- name:sub_names++pat_names, Just f <- [M.lookup n fixMap] ]
 
+    exportedNameSet = mkNameSet exportedNames
+    isExported n = elemNameSet n exportedNameSet
 
     findDecl :: Name -> ErrMsgGhc ([LHsDecl GhcRn], (DocForDecl Name, [(Name, DocForDecl Name)]))
     findDecl n
@@ -682,6 +741,40 @@ mkExportItems
       where
         m = nameModule n
 
+    findBundledPatterns :: Name -> ErrMsgGhc [(HsDecl GhcRn, DocForDecl Name)]
+    findBundledPatterns t =
+      let
+        m = nameModule t
+
+        local_bundled_patsyns =
+          M.findWithDefault [] t patSynMap
+
+        iface_bundled_patsyns
+          | Just iface <- M.lookup (semToIdMod (moduleUnitId thisMod) m) modMap
+          , Just patsyns <- M.lookup t (ifaceBundledPatSynMap iface)
+          = patsyns
+
+          | Just iface <- M.lookup m instIfaceMap
+          , Just patsyns <- M.lookup t (instBundledPatSynMap iface)
+          = patsyns
+
+          | otherwise
+          = []
+
+        patsyn_decls = do
+          for (local_bundled_patsyns ++ iface_bundled_patsyns) $ \patsyn_name -> do
+            -- call declWith here so we don't have to prepare the pattern synonym for
+            -- showing ourselves.
+            export_items <- declWith [] patsyn_name
+            pure [ (unLoc patsyn_decl, patsyn_doc)
+                 | ExportDecl {
+                       expItemDecl  = patsyn_decl
+                     , expItemMbDoc = patsyn_doc
+                     } <- export_items
+                 ]
+
+      in concat <$> patsyn_decls
+
 -- | Given a 'Module' from a 'Name', convert it into a 'Module' that
 -- we can actually find in the 'IfaceMap'.
 semToIdMod :: UnitId -> Module -> Module
@@ -716,7 +809,7 @@ hiValExportItem dflags name nLoc doc splice fixity = do
   mayDecl <- hiDecl dflags name
   case mayDecl of
     Nothing -> return (ExportNoDecl name [])
-    Just decl -> return (ExportDecl (fixSpan decl) doc [] [] fixities splice)
+    Just decl -> return (ExportDecl (fixSpan decl) [] doc [] [] fixities splice)
   where
     fixSpan (L l t) = L (SrcLoc.combineSrcSpans l nLoc) t
     fixities = case fixity of
@@ -817,26 +910,39 @@ fullModuleContents :: DynFlags
                    -> [LHsDecl GhcRn]    -- ^ All the renamed declarations
                    -> ErrMsgGhc [ExportItem GhcRn]
 fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap) fixMap splices decls =
-  liftM catMaybes $ mapM mkExportItem (expandSig decls)
+  liftM catMaybes $ mapM mkExportItem (expandSigDecls decls)
   where
     -- A type signature can have multiple names, like:
     --   foo, bar :: Types..
     --
     -- We go through the list of declarations and expand type signatures, so
     -- that every type signature has exactly one name!
-    expandSig :: [LHsDecl name] -> [LHsDecl name]
-    expandSig = foldr f []
+    expandSigDecls :: [LHsDecl name] -> [LHsDecl name]
+    expandSigDecls = concatMap f
       where
-        f :: LHsDecl name -> [LHsDecl name] -> [LHsDecl name]
-        f (L l (SigD (TypeSig    names t)))   xs = foldr (\n acc -> L l (SigD (TypeSig      [n] t)) : acc) xs names
-        f (L l (SigD (ClassOpSig b names t))) xs = foldr (\n acc -> L l (SigD (ClassOpSig b [n] t)) : acc) xs names
-        f x xs = x : xs
+        f (L l (SigD sig))              = [ L l (SigD s) | s <- expandSig sig ]
+
+        -- also expand type signatures for class methods
+        f (L l (TyClD cls@ClassDecl{})) =
+          [ L l (TyClD cls { tcdSigs = concatMap expandLSig (tcdSigs cls) }) ]
+        f x = [x]
+
+    expandLSig :: LSig name -> [LSig name]
+    expandLSig (L l sig) = [ L l s | s <- expandSig sig ]
+
+    expandSig :: Sig name -> [Sig name]
+    expandSig (TypeSig names t)      = [ TypeSig [n] t      | n <- names ]
+    expandSig (ClassOpSig b names t) = [ ClassOpSig b [n] t | n <- names ]
+    expandSig (PatSynSig names t)    = [ PatSynSig [n] t    | n <- names ]
+    expandSig x                      = [x]
 
     mkExportItem :: LHsDecl GhcRn -> ErrMsgGhc (Maybe (ExportItem GhcRn))
     mkExportItem (L _ (DocD (DocGroup lev docStr))) = do
-      return . Just . ExportGroup lev "" $ processDocString dflags gre docStr
+      doc <- liftErrMsg (processDocString dflags gre docStr)
+      return . Just . ExportGroup lev "" $ doc
     mkExportItem (L _ (DocD (DocCommentNamed _ docStr))) = do
-      return . Just . ExportDoc $ processDocStringParas dflags gre docStr
+      doc <- liftErrMsg (processDocStringParas dflags gre docStr)
+      return . Just . ExportDoc $ doc
     mkExportItem (L l (ValD d))
       | name:_ <- collectHsBindBinders d, Just [L _ (ValD _)] <- M.lookup name declMap =
           -- Top-level binding without type signature.
@@ -860,12 +966,12 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap
     fixities name subs = [ (n,f) | n <- name : map fst subs
                                  , Just f <- [M.lookup n fixMap] ]
 
-    expDecl decl l name = return $ Just (ExportDecl decl doc subs [] (fixities name subs) (l `elem` splices))
+    expDecl decl l name = return $ Just (ExportDecl decl [] doc subs [] (fixities name subs) (l `elem` splices))
       where (doc, subs) = lookupDocs name warnings docMap argMap subMap
 
     expInst decl l name =
         let (doc, subs) = lookupDocs name warnings docMap argMap subMap in
-        return $ Just (ExportDecl decl doc subs [] (fixities name subs) (l `elem` splices))
+        return $ Just (ExportDecl decl [] doc subs [] (fixities name subs) (l `elem` splices))
 
 
 -- | Sometimes the declaration we want to export is not the "main" declaration:
@@ -895,7 +1001,9 @@ extractDecl name decl
                                          O.$$ O.nest 4 (O.ppr matches))
       TyClD d@DataDecl {} ->
         let (n, tyvar_tys) = (tcdName d, lHsQTyVarsToTypes (tyClDeclTyVars d))
-        in SigD <$> extractRecSel name n tyvar_tys (dd_cons (tcdDataDefn d))
+        in if isDataConName name
+           then SigD <$> extractPatternSyn name n tyvar_tys (dd_cons (tcdDataDefn d))
+           else SigD <$> extractRecSel name n tyvar_tys (dd_cons (tcdDataDefn d))
       InstD (DataFamInstD DataFamInstDecl { dfid_tycon = L _ n
                                           , dfid_pats = HsIB { hsib_body = tys }
                                           , dfid_defn = defn }) ->
@@ -913,6 +1021,36 @@ extractDecl name decl
           _ -> error "internal: extractDecl (ClsInstD)"
       _ -> error "internal: extractDecl"
 
+extractPatternSyn :: Name -> Name -> [LHsType GhcRn] -> [LConDecl GhcRn] -> LSig GhcRn
+extractPatternSyn nm t tvs cons =
+  case filter matches cons of
+    [] -> error "extractPatternSyn: constructor pattern not found"
+    con:_ -> extract <$> con
+ where
+  matches :: LConDecl GhcRn -> Bool
+  matches (L _ con) = nm `elem` (unLoc <$> getConNames con)
+  extract :: ConDecl GhcRn -> Sig GhcRn
+  extract con =
+    let args =
+          case getConDetails con of
+            PrefixCon args' -> args'
+            RecCon (L _ fields) -> cd_fld_type . unLoc <$> fields
+            InfixCon arg1 arg2 -> [arg1, arg2]
+        typ = longArrow args (data_ty con)
+        typ' =
+          case con of
+            ConDeclH98 { con_cxt = Just cxt } -> noLoc (HsQualTy cxt typ)
+            _ -> typ
+        typ'' = noLoc (HsQualTy (noLoc []) typ')
+    in PatSynSig [noLoc nm] (mkEmptyImplicitBndrs typ'')
+
+  longArrow :: [LHsType name] -> LHsType name -> LHsType name
+  longArrow inputs output = foldr (\x y -> noLoc (HsFunTy x y)) output inputs
+
+  data_ty con
+    | ConDeclGADT{} <- con = hsib_body $ con_type con
+    | otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar NotPromoted (noLoc t))) tvs
+
 extractRecSel :: Name -> Name -> [LHsType GhcRn] -> [LConDecl GhcRn]
               -> LSig GhcRn
 extractRecSel _ _ _ [] = error "extractRecSel: selector not found"
@@ -945,8 +1083,9 @@ mkVisibleNames (_, _, _, _, instMap) exports opts
   | otherwise = let ns = concatMap exportName exports
                 in seqList ns `seq` ns
   where
-    exportName e@ExportDecl {} = name ++ subs
-      where subs = map fst (expItemSubDocs e)
+    exportName e@ExportDecl {} = name ++ subs ++ patsyns
+      where subs    = map fst (expItemSubDocs e)
+            patsyns = concatMap (getMainDeclBinder . fst) (expItemPats e)
             name = case unLoc $ expItemDecl e of
               InstD d -> maybeToList $ M.lookup (getInstLoc d) instMap
               decl    -> getMainDeclBinder decl
@@ -977,10 +1116,11 @@ mkMaybeTokenizedSrc flags tm
     summary = pm_mod_summary . tm_parsed_module $ tm
 
 mkTokenizedSrc :: ModSummary -> RenamedSource -> IO [RichToken]
-mkTokenizedSrc ms src =
-    Hyperlinker.enrich src . Hyperlinker.parse <$> rawSrc
-  where
-    rawSrc = readFile $ msHsFilePath ms
+mkTokenizedSrc ms src = do
+  -- make sure to read the whole file at once otherwise
+  -- we run out of file descriptors (see #495)
+  rawSrc <- BS.readFile (msHsFilePath ms) >>= evaluate
+  return $ Hyperlinker.enrich src (Hyperlinker.parse (decodeUtf8 rawSrc))
 
 -- | Find a stand-alone documentation comment by its name.
 findNamedDoc :: String -> [HsDecl GhcRn] -> ErrMsgM (Maybe HsDocString)
diff --git a/haddock-api/src/Haddock/Interface/Json.hs b/haddock-api/src/Haddock/Interface/Json.hs
new file mode 100644
index 00000000..9a569204
--- /dev/null
+++ b/haddock-api/src/Haddock/Interface/Json.hs
@@ -0,0 +1,109 @@
+{-# LANGUAGE RecordWildCards #-}
+module Haddock.Interface.Json (
+    jsonInstalledInterface
+  , jsonInterfaceFile
+  , renderJson
+  ) where
+
+import BasicTypes
+import Json
+import Module
+import Name
+import Outputable
+
+import Control.Arrow
+import Data.Map (Map)
+import Data.Bifunctor
+import qualified Data.Map as Map
+
+import Haddock.Types
+import Haddock.InterfaceFile
+
+jsonInterfaceFile :: InterfaceFile -> JsonDoc
+jsonInterfaceFile InterfaceFile{..} =
+  jsonObject [ ("link_env" , jsonMap nameStableString (jsonString . moduleNameString . moduleName) ifLinkEnv)
+             , ("inst_ifaces", jsonArray (map jsonInstalledInterface ifInstalledIfaces))
+             ]
+
+jsonInstalledInterface :: InstalledInterface -> JsonDoc
+jsonInstalledInterface InstalledInterface{..} = jsonObject properties
+  where
+    properties =
+      [ ("module"          , jsonModule instMod)
+      , ("is_sig"          , jsonBool instIsSig)
+      , ("info"            , jsonHaddockModInfo instInfo)
+      , ("doc_map"         , jsonMap nameStableString jsonMDoc instDocMap)
+      , ("arg_map"         , jsonMap nameStableString (jsonMap show jsonMDoc) instArgMap)
+      , ("exports"         , jsonArray (map jsonName instExports))
+      , ("visible_exports" , jsonArray (map jsonName instVisibleExports))
+      , ("options"         , jsonArray (map (jsonString . show) instOptions))
+      , ("sub_map"         , jsonMap nameStableString (jsonArray . map jsonName) instSubMap)
+      , ("bundled_patsyns" , jsonMap nameStableString (jsonArray . map jsonName) instBundledPatSynMap)
+      , ("fix_map"         , jsonMap nameStableString jsonFixity instFixMap)
+      ]
+
+jsonHaddockModInfo :: HaddockModInfo Name -> JsonDoc
+jsonHaddockModInfo HaddockModInfo{..} =
+  jsonObject [ ("description" , jsonMaybe jsonDoc hmi_description)
+             , ("copyright"   , jsonMaybe jsonString hmi_copyright)
+             , ("maintainer"  , jsonMaybe jsonString hmi_maintainer)
+             , ("stability"   , jsonMaybe jsonString hmi_stability)
+             , ("protability" , jsonMaybe jsonString hmi_portability)
+             , ("safety"      , jsonMaybe jsonString hmi_safety)
+             , ("language"    , jsonMaybe (jsonString . show) hmi_language)
+             , ("extensions"  , jsonArray (map (jsonString . show) hmi_extensions))
+             ]
+
+jsonMap :: (a -> String) -> (b -> JsonDoc) -> Map a b -> JsonDoc
+jsonMap f g = jsonObject . map (f *** g) . Map.toList
+
+jsonMDoc :: MDoc Name -> JsonDoc
+jsonMDoc MetaDoc{..} =
+  jsonObject [ ("meta", jsonObject [("version", jsonMaybe (jsonString . show) (_version _meta))])
+             , ("doc",  jsonDoc _doc)
+             ]
+
+jsonDoc :: Doc Name -> JsonDoc
+jsonDoc doc = jsonString (show (bimap (moduleNameString . fst) nameStableString doc))
+
+jsonModule :: Module -> JsonDoc
+jsonModule = JSString . moduleStableString
+
+jsonName :: Name -> JsonDoc
+jsonName = JSString . nameStableString
+
+jsonFixity :: Fixity -> JsonDoc
+jsonFixity (Fixity _ prec dir) =
+  jsonObject [ ("prec"      , jsonInt prec)
+             , ("direction" , jsonFixityDirection dir)
+             ]
+
+jsonFixityDirection :: FixityDirection -> JsonDoc
+jsonFixityDirection InfixL = jsonString "infixl"
+jsonFixityDirection InfixR = jsonString "infixr"
+jsonFixityDirection InfixN = jsonString "infix"
+
+renderJson :: JsonDoc -> SDoc
+renderJson = renderJSON
+
+jsonMaybe :: (a -> JsonDoc) -> Maybe a -> JsonDoc
+jsonMaybe = maybe jsonNull
+
+jsonString :: String -> JsonDoc
+jsonString = JSString
+
+jsonObject :: [(String, JsonDoc)] -> JsonDoc
+jsonObject = JSObject
+
+jsonArray :: [JsonDoc] -> JsonDoc
+jsonArray = JSArray
+
+jsonNull :: JsonDoc
+jsonNull = JSNull
+
+jsonInt :: Int -> JsonDoc
+jsonInt = JSInt
+
+jsonBool :: Bool -> JsonDoc
+jsonBool = JSBool
+
diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs
index 608344ad..75b2f223 100644
--- a/haddock-api/src/Haddock/Interface/LexParseRn.hs
+++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs
@@ -35,20 +35,21 @@ import EnumSet
 import RnEnv (dataTcOccs)
 
 processDocStrings :: DynFlags -> GlobalRdrEnv -> [HsDocString]
-                  -> Maybe (MDoc Name)
-processDocStrings dflags gre strs =
-  case metaDocConcat $ map (processDocStringParas dflags gre) strs of
+                  -> ErrMsgM (Maybe (MDoc Name))
+processDocStrings dflags gre strs = do
+  mdoc <- metaDocConcat <$> traverse (processDocStringParas dflags gre) strs
+  case mdoc of
     -- We check that we don't have any version info to render instead
     -- of just checking if there is no comment: there may not be a
     -- comment but we still want to pass through any meta data.
-    MetaDoc { _meta = Meta { _version = Nothing }, _doc = DocEmpty } -> Nothing
-    x -> Just x
+    MetaDoc { _meta = Meta { _version = Nothing }, _doc = DocEmpty } -> pure Nothing
+    x -> pure (Just x)
 
-processDocStringParas :: DynFlags -> GlobalRdrEnv -> HsDocString -> MDoc Name
+processDocStringParas :: DynFlags -> GlobalRdrEnv -> HsDocString -> ErrMsgM (MDoc Name)
 processDocStringParas dflags gre (HsDocString fs) =
-  overDoc (rename dflags gre) $ parseParas dflags (unpackFS fs)
+  overDocF (rename dflags gre) $ parseParas dflags (unpackFS fs)
 
-processDocString :: DynFlags -> GlobalRdrEnv -> HsDocString -> Doc Name
+processDocString :: DynFlags -> GlobalRdrEnv -> HsDocString -> ErrMsgM (Doc Name)
 processDocString dflags gre (HsDocString fs) =
   rename dflags gre $ parseString dflags (unpackFS fs)
 
@@ -61,9 +62,11 @@ processModuleHeader dflags gre safety mayStr = do
       Just (L _ (HsDocString fs)) -> do
         let str = unpackFS fs
             (hmi, doc) = parseModuleHeader dflags str
-            !descr = rename dflags gre <$> hmi_description hmi
-            hmi' = hmi { hmi_description = descr }
-            doc' = overDoc (rename dflags gre) doc
+        !descr <- case hmi_description hmi of
+                    Just hmi_descr -> Just <$> rename dflags gre hmi_descr
+                    Nothing        -> pure Nothing
+        let hmi' = hmi { hmi_description = descr }
+        doc'  <- overDocF (rename dflags gre) doc
         return (hmi', Just doc')
 
   let flags :: [LangExt.Extension]
@@ -83,12 +86,12 @@ processModuleHeader dflags gre safety mayStr = do
 -- fallbacks in case we can't locate the identifiers.
 --
 -- See the comments in the source for implementation commentary.
-rename :: DynFlags -> GlobalRdrEnv -> Doc RdrName -> Doc Name
+rename :: DynFlags -> GlobalRdrEnv -> Doc RdrName -> ErrMsgM (Doc Name)
 rename dflags gre = rn
   where
     rn d = case d of
-      DocAppend a b -> DocAppend (rn a) (rn b)
-      DocParagraph doc -> DocParagraph (rn doc)
+      DocAppend a b -> DocAppend <$> rn a <*> rn b
+      DocParagraph doc -> DocParagraph <$> rn doc
       DocIdentifier x -> do
         -- Generate the choices for the possible kind of thing this
         -- is.
@@ -101,7 +104,7 @@ rename dflags gre = rn
           -- We found no names in the env so we start guessing.
           [] ->
             case choices of
-              [] -> DocMonospaced (DocString (showPpr dflags x))
+              [] -> pure (DocMonospaced (DocString (showPpr dflags x)))
               -- There was nothing in the environment so we need to
               -- pick some default from what's available to us. We
               -- diverge here from the old way where we would default
@@ -110,37 +113,37 @@ rename dflags gre = rn
               -- type constructor names (such as in #253). So now we
               -- only get type constructor links if they are actually
               -- in scope.
-              a:_ -> outOfScope dflags a
+              a:_ -> pure (outOfScope dflags a)
 
           -- There is only one name in the environment that matches so
           -- use it.
-          [a] -> DocIdentifier a
+          [a] -> pure (DocIdentifier a)
           -- But when there are multiple names available, default to
           -- type constructors: somewhat awfully GHC returns the
           -- values in the list positionally.
-          a:b:_ | isTyConName a -> DocIdentifier a
-                | otherwise -> DocIdentifier b
+          a:b:_ | isTyConName a -> pure (DocIdentifier a)
+                | otherwise -> pure (DocIdentifier b)
 
-      DocWarning doc -> DocWarning (rn doc)
-      DocEmphasis doc -> DocEmphasis (rn doc)
-      DocBold doc -> DocBold (rn doc)
-      DocMonospaced doc -> DocMonospaced (rn doc)
-      DocUnorderedList docs -> DocUnorderedList (map rn docs)
-      DocOrderedList docs -> DocOrderedList (map rn docs)
-      DocDefList list -> DocDefList [ (rn a, rn b) | (a, b) <- list ]
-      DocCodeBlock doc -> DocCodeBlock (rn doc)
-      DocIdentifierUnchecked x -> DocIdentifierUnchecked x
-      DocModule str -> DocModule str
-      DocHyperlink l -> DocHyperlink l
-      DocPic str -> DocPic str
-      DocMathInline str -> DocMathInline str
-      DocMathDisplay str -> DocMathDisplay str
-      DocAName str -> DocAName str
-      DocProperty p -> DocProperty p
-      DocExamples e -> DocExamples e
-      DocEmpty -> DocEmpty
-      DocString str -> DocString str
-      DocHeader (Header l t) -> DocHeader $ Header l (rn t)
+      DocWarning doc -> DocWarning <$> rn doc
+      DocEmphasis doc -> DocEmphasis <$> rn doc
+      DocBold doc -> DocBold <$> rn doc
+      DocMonospaced doc -> DocMonospaced <$> rn doc
+      DocUnorderedList docs -> DocUnorderedList <$> traverse rn docs
+      DocOrderedList docs -> DocOrderedList <$> traverse rn docs
+      DocDefList list -> DocDefList <$> traverse (\(a, b) -> (,) <$> rn a <*> rn b) list
+      DocCodeBlock doc -> DocCodeBlock <$> rn doc
+      DocIdentifierUnchecked x -> pure (DocIdentifierUnchecked x)
+      DocModule str -> pure (DocModule str)
+      DocHyperlink l -> pure (DocHyperlink l)
+      DocPic str -> pure (DocPic str)
+      DocMathInline str -> pure (DocMathInline str)
+      DocMathDisplay str -> pure (DocMathDisplay str)
+      DocAName str -> pure (DocAName str)
+      DocProperty p -> pure (DocProperty p)
+      DocExamples e -> pure (DocExamples e)
+      DocEmpty -> pure (DocEmpty)
+      DocString str -> pure (DocString str)
+      DocHeader (Header l t) -> DocHeader . Header l <$> rn t
 
 -- | Wrap an identifier that's out of scope (i.e. wasn't found in
 -- 'GlobalReaderEnv' during 'rename') in an appropriate doc. Currently
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 70846b31..2e9a311a 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -55,7 +55,7 @@ renameInterface dflags renamingEnv warnings iface =
 
       -- combine the missing names and filter out the built-ins, which would
       -- otherwise always be missing.
-      missingNames = nub $ filter isExternalName  -- XXX: isExternalName filters out too much
+      missingNames = nubByName id $ filter isExternalName  -- XXX: isExternalName filters out too much
                     (missingNames1 ++ missingNames2 ++ missingNames3
                      ++ missingNames4 ++ missingNames5)
 
@@ -314,6 +314,11 @@ renameInstHead InstHead {..} = do
 renameLDecl :: LHsDecl GhcRn -> RnM (LHsDecl DocNameI)
 renameLDecl (L loc d) = return . L loc =<< renameDecl d
 
+renamePats :: [(HsDecl GhcRn, DocForDecl Name)] -> RnM [(HsDecl DocNameI, DocForDecl DocName)]
+renamePats = mapM
+  (\(d,doc) -> do { d'   <- renameDecl d
+                  ; doc' <- renameDocForDecl doc
+                  ; return (d',doc')})
 
 renameDecl :: HsDecl GhcRn -> RnM (HsDecl DocNameI)
 renameDecl decl = case decl of
@@ -601,15 +606,16 @@ renameExportItem item = case item of
   ExportGroup lev id_ doc -> do
     doc' <- renameDoc doc
     return (ExportGroup lev id_ doc')
-  ExportDecl decl doc subs instances fixities splice -> do
+  ExportDecl decl pats doc subs instances fixities splice -> do
     decl' <- renameLDecl decl
+    pats' <- renamePats pats
     doc'  <- renameDocForDecl doc
     subs' <- mapM renameSub subs
     instances' <- forM instances renameDocInstance
     fixities' <- forM fixities $ \(name, fixity) -> do
       name' <- lookupRn name
       return (name', fixity)
-    return (ExportDecl decl' doc' subs' instances' fixities' splice)
+    return (ExportDecl decl' pats' doc' subs' instances' fixities' splice)
   ExportNoDecl x subs -> do
     x'    <- lookupRn x
     subs' <- mapM lookupRn subs
diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs
index d8bdecec..0c8e89c2 100644
--- a/haddock-api/src/Haddock/Interface/Specialize.hs
+++ b/haddock-api/src/Haddock/Interface/Specialize.hs
@@ -1,9 +1,9 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE RecordWildCards #-}
 
-
 module Haddock.Interface.Specialize
     ( specializeInstHead
     ) where
@@ -17,7 +17,6 @@ import Name
 import FastString
 
 import Control.Monad
-import Control.Monad.Trans.Reader
 import Control.Monad.Trans.State
 
 import Data.Data
@@ -28,72 +27,64 @@ import qualified Data.Map as Map
 import Data.Set (Set)
 import qualified Data.Set as Set
 
-
--- | Instantiate all occurrences of given name with particular type.
-specialize :: (Eq (IdP name), Typeable name)
-           => Data a
-           => IdP name -> HsType name -> a -> a
-specialize name details =
-    everywhere $ mkT step
-  where
-    step (HsTyVar _ (L _ name')) | name == name' = details
-    step typ = typ
-
-
 -- | Instantiate all occurrences of given names with corresponding types.
---
--- It is just a convenience function wrapping 'specialize' that supports more
--- that one specialization.
-specialize' :: (Eq (IdP name), Typeable name)
+specialize :: forall name a. (Ord (IdP name), DataId name, NamedThing (IdP name))
             => Data a
             => [(IdP name, HsType name)] -> a -> a
-specialize' = flip $ foldr (uncurry specialize)
+specialize specs = go
+  where
+    go :: forall x. Data x => x -> x
+    go = everywhereButType @name $ mkT $ sugar . specialize_ty_var
+    specialize_ty_var (HsTyVar _ (L _ name'))
+      | Just t <- Map.lookup name' spec_map = t
+    specialize_ty_var typ = typ
+    -- This is a tricky recursive definition that is guaranteed to terminate
+    -- because a type binder cannot be instantiated with a type that depends
+    -- on that binder. i.e. @a -> Maybe a@ is invalid
+    spec_map = Map.fromList [ (n, go t) | (n, t) <- specs]
 
 
 -- | Instantiate given binders with corresponding types.
 --
 -- Again, it is just a convenience function around 'specialize'. Note that
 -- length of type list should be the same as the number of binders.
-specializeTyVarBndrs :: (Eq (IdP name), DataId name)
+specializeTyVarBndrs :: (Ord (IdP name), DataId name, NamedThing (IdP name))
                      => Data a
                      => LHsQTyVars name -> [HsType name]
                      -> a -> a
 specializeTyVarBndrs bndrs typs =
-    specialize' $ zip bndrs' typs
+    specialize $ zip bndrs' typs
   where
     bndrs' = map (bname . unLoc) . hsq_explicit $ bndrs
     bname (UserTyVar (L _ name)) = name
     bname (KindedTyVar (L _ name) _) = name
 
 
-specializePseudoFamilyDecl :: (Eq (IdP name), DataId name)
+specializePseudoFamilyDecl :: (Ord (IdP name), DataId name, NamedThing (IdP name))
                            => LHsQTyVars name -> [HsType name]
                            -> PseudoFamilyDecl name
                            -> PseudoFamilyDecl name
 specializePseudoFamilyDecl bndrs typs decl =
-    decl { pfdTyVars = map specializeTyVars (pfdTyVars decl) }
-  where
-    specializeTyVars = specializeTyVarBndrs bndrs typs
-
+  decl {pfdTyVars = map (specializeTyVarBndrs bndrs typs) (pfdTyVars decl)}
 
-specializeSig :: forall name . (Eq (IdP name), DataId name, SetName (IdP name))
+specializeSig :: forall name . (Ord (IdP name), DataId name, SetName (IdP name), NamedThing (IdP name))
               => LHsQTyVars name -> [HsType name]
               -> Sig name
               -> Sig name
 specializeSig bndrs typs (TypeSig lnames typ) =
-    TypeSig lnames (typ { hswc_body = (hswc_body typ) { hsib_body = noLoc typ'}})
+  TypeSig lnames (typ {hswc_body = (hswc_body typ) {hsib_body = noLoc typ'}})
   where
     true_type :: HsType name
     true_type = unLoc (hsSigWcType typ)
     typ' :: HsType name
-    typ' = rename fv . sugar $ specializeTyVarBndrs bndrs typs true_type
+    typ' = rename fv $ specializeTyVarBndrs bndrs typs true_type
     fv = foldr Set.union Set.empty . map freeVariables $ typs
 specializeSig _ _ sig = sig
 
 
 -- | Make all details of instance head (signatures, associated types)
 -- specialized to that particular instance type.
-specializeInstHead :: (Eq (IdP name), DataId name, SetName (IdP name))
+specializeInstHead :: (Ord (IdP name), DataId name, SetName (IdP name), NamedThing (IdP name))
                    => InstHead name -> InstHead name
 specializeInstHead ihd@InstHead { ihdInstType = clsi@ClassInst { .. }, .. } =
     ihd { ihdInstType = instType' }
@@ -115,12 +106,7 @@ specializeInstHead ihd = ihd
 -- and @(a, b, c)@.
 sugar :: forall name. (NamedThing (IdP name), DataId name)
       => HsType name -> HsType name
-sugar =
-    everywhere $ mkT step
-  where
-    step :: HsType name -> HsType name
-    step = sugarOperators . sugarTuples . sugarLists
-
+sugar = sugarOperators . sugarTuples . sugarLists
 
 sugarLists :: NamedThing (IdP name) => HsType name -> HsType name
 sugarLists (HsAppTy (L _ (HsTyVar _ (L _ name))) ltyp)
@@ -217,7 +203,7 @@ setInternalOccName occ name =
 
 -- | Compute set of free variables of given type.
 freeVariables :: forall name. (NamedThing (IdP name), DataId name)
-              => HsType name -> Set NameRep
+              => HsType name -> Set Name
 freeVariables =
     everythingWithState Set.empty Set.union query
   where
@@ -226,7 +212,7 @@ freeVariables =
             (Set.empty, Set.union ctx (bndrsNames bndrs))
         Just (HsTyVar _ (L _ name))
             | getName name `Set.member` ctx -> (Set.empty, ctx)
-            | otherwise -> (Set.singleton $ getNameRep name, ctx)
+            | otherwise -> (Set.singleton $ getName name, ctx)
         _ -> (Set.empty, ctx)
     bndrsNames = Set.fromList . map (getName . tyVarName . unLoc)
 
@@ -238,33 +224,36 @@ freeVariables =
 -- @(a -> b)@ we get @(a -> b) -> b@ where first occurrence of @b@ refers to
 -- different type variable than latter one. Applying 'rename' function
 -- will fix that type to be visually unambiguous again (making it something
--- like @(a -> c) -> b@).
-rename :: SetName (IdP name) => Set NameRep -> HsType name -> HsType name
-rename fv typ = runReader (renameType typ) $ RenameEnv
-    { rneFV = fv
-    , rneCtx = Map.empty
-    }
-
+-- like @(a -> b0) -> b@).
+rename :: (Eq (IdP name), DataId name, SetName (IdP name))
+       => Set Name-> HsType name -> HsType name
+rename fv typ = evalState (renameType typ) env
+  where
+    env = RenameEnv
+      { rneHeadFVs = Map.fromList . map mkPair . Set.toList $ fv
+      , rneSigFVs = Set.map getNameRep $ freeVariables typ
+      , rneCtx = Map.empty
+      }
+    mkPair name = (getNameRep name, name)
 
 -- | Renaming monad.
-type Rename name = Reader (RenameEnv name)
-
--- | Binding generation monad.
-type Rebind name = State (RenameEnv name)
+type Rename name = State (RenameEnv name)
 
 data RenameEnv name = RenameEnv
-    { rneFV :: Set NameRep
-    , rneCtx :: Map Name name
-    }
+  { rneHeadFVs :: Map NameRep Name
+  , rneSigFVs :: Set NameRep
+  , rneCtx :: Map Name name
+  }
 
 
-renameType :: SetName (IdP name) => HsType name -> Rename (IdP name) (HsType name)
-renameType (HsForAllTy bndrs lt) = rebind bndrs $ \bndrs' ->
+renameType :: (Eq (IdP name), SetName (IdP name))
+           => HsType name -> Rename (IdP name) (HsType name)
+renameType (HsForAllTy bndrs lt) =
     HsForAllTy
-        <$> pure bndrs'
+        <$> mapM (located renameBinder) bndrs
         <*> renameLType lt
 renameType (HsQualTy lctxt lt) =
-  HsQualTy
+    HsQualTy
         <$> located renameContext lctxt
         <*> renameLType lt
 renameType (HsTyVar ip name) = HsTyVar ip <$> located renameName name
@@ -294,85 +283,58 @@ renameType (HsWildCardTy wc) = pure (HsWildCardTy wc)
 renameType (HsAppsTy _) = error "HsAppsTy: Only used before renaming"
 
 
-renameLType :: SetName (IdP name) => LHsType name -> Rename (IdP name) (LHsType name)
+renameLType :: (Eq (IdP name), SetName (IdP name))
+            => LHsType name -> Rename (IdP name) (LHsType name)
 renameLType = located renameType
 
 
-renameLTypes :: SetName (IdP name) => [LHsType name] -> Rename (IdP name) [LHsType name]
+renameLTypes :: (Eq (IdP name), SetName (IdP name))
+             => [LHsType name] -> Rename (IdP name) [LHsType name]
 renameLTypes = mapM renameLType
 
 
-renameContext :: SetName (IdP name) => HsContext name -> Rename (IdP name) (HsContext name)
+renameContext :: (Eq (IdP name), SetName (IdP name))
+              => HsContext name -> Rename (IdP name) (HsContext name)
 renameContext = renameLTypes
 
-{-
-renameLTyOp :: SetName (IdP name) => LHsTyOp name -> Rename name (LHsTyOp name)
-renameLTyOp (wrap, lname) = (,) wrap <$> located renameName lname
--}
+renameBinder :: (Eq (IdP name), SetName (IdP name))
+             => HsTyVarBndr name -> Rename (IdP name) (HsTyVarBndr name)
+renameBinder (UserTyVar lname) = UserTyVar <$> located renameName lname
+renameBinder (KindedTyVar lname lkind) =
+  KindedTyVar <$> located renameName lname <*> located renameType lkind
 
 
-renameName :: SetName name => name -> Rename name name
+-- | Core renaming logic.
+renameName :: (Eq name, SetName name) => name -> Rename name name
 renameName name = do
-    RenameEnv { rneCtx = ctx } <- ask
-    pure $ fromMaybe name (Map.lookup (getName name) ctx)
-
-
-rebind :: SetName (IdP name)
-       => [LHsTyVarBndr name] -> ([LHsTyVarBndr name] -> Rename (IdP name) a)
-       -> Rename (IdP name) a
-rebind lbndrs action = do
-    (lbndrs', env') <- runState (rebindLTyVarBndrs lbndrs) <$> ask
-    local (const env') (action lbndrs')
-
-
-rebindLTyVarBndrs :: SetName (IdP name)
-                  => [LHsTyVarBndr name] -> Rebind (IdP name) [LHsTyVarBndr name]
-rebindLTyVarBndrs lbndrs = mapM (located rebindTyVarBndr) lbndrs
-
-
-rebindTyVarBndr :: SetName (IdP name)
-                => HsTyVarBndr name -> Rebind (IdP name) (HsTyVarBndr name)
-rebindTyVarBndr (UserTyVar (L l name)) =
-    UserTyVar . L l <$> rebindName name
-rebindTyVarBndr (KindedTyVar name kinds) =
-    KindedTyVar <$> located rebindName name <*> pure kinds
-
-
-rebindName :: SetName name => name -> Rebind name name
-rebindName name = do
     RenameEnv { .. } <- get
-    taken <- takenNames
     case Map.lookup (getName name) rneCtx of
-        Just name' -> pure name'
-        Nothing | getNameRep name `Set.member` taken -> freshName name
-        Nothing -> reuseName name
+      Nothing
+        | Just headTv <- Map.lookup (getNameRep name) rneHeadFVs
+        , headTv /= getName name -> freshName name
+      Just name' -> return name'
+      _ -> return name
 
 
 -- | Generate fresh occurrence name, put it into context and return.
-freshName :: SetName name => name -> Rebind name name
+freshName :: SetName name => name -> Rename name name
 freshName name = do
-    env@RenameEnv { .. } <- get
     taken <- takenNames
     let name' = setInternalNameRep (findFreshName taken rep) name
-    put $ env { rneCtx = Map.insert nname name' rneCtx }
+    modify $ \rne -> rne
+      { rneCtx = Map.insert (getName name) name' (rneCtx rne) }
     return name'
   where
     nname = getName name
     rep = getNameRep nname
 
 
-reuseName :: SetName name => name -> Rebind name name
-reuseName name = do
-    env@RenameEnv { .. } <- get
-    put $ env { rneCtx = Map.insert (getName name) name rneCtx }
-    return name
-
-
-takenNames :: NamedThing name => Rebind name (Set NameRep)
+takenNames :: NamedThing name => Rename name (Set NameRep)
 takenNames = do
     RenameEnv { .. } <- get
-    return $ Set.union rneFV (ctxElems rneCtx)
+    return $ Set.unions [headReps rneHeadFVs, rneSigFVs, ctxElems rneCtx]
   where
+    headReps = Set.fromList . Map.keys
     ctxElems = Set.fromList . map getNameRep . Map.elems
 
 
@@ -384,15 +346,7 @@ findFreshName taken =
 
 
 alternativeNames :: NameRep -> [NameRep]
-alternativeNames name
-    | [_] <- nameRepString name = letterNames ++ alternativeNames' name
-  where
-    letterNames = map (stringNameRep . pure) ['a'..'z']
-alternativeNames name = alternativeNames' name
-
-
-alternativeNames' :: NameRep -> [NameRep]
-alternativeNames' name =
+alternativeNames name =
     [ stringNameRep $ str ++ show i | i :: Int <- [0..] ]
   where
     str = nameRepString name
diff --git a/haddock-api/src/Haddock/InterfaceFile.hs b/haddock-api/src/Haddock/InterfaceFile.hs
index 796a7ce6..dd1358d8 100644
--- a/haddock-api/src/Haddock/InterfaceFile.hs
+++ b/haddock-api/src/Haddock/InterfaceFile.hs
@@ -83,7 +83,7 @@ binaryInterfaceMagic = 0xD0Cface
 --
 binaryInterfaceVersion :: Word16
 #if (__GLASGOW_HASKELL__ >= 803) && (__GLASGOW_HASKELL__ < 805)
-binaryInterfaceVersion = 29
+binaryInterfaceVersion = 32
 
 binaryInterfaceVersionCompatibility :: [Word16]
 binaryInterfaceVersionCompatibility = [binaryInterfaceVersion]
@@ -373,32 +373,32 @@ instance Binary InterfaceFile where
 
 instance Binary InstalledInterface where
   put_ bh (InstalledInterface modu is_sig info docMap argMap
-           exps visExps opts subMap fixMap) = do
+           exps visExps opts subMap patSynMap fixMap) = do
     put_ bh modu
     put_ bh is_sig
     put_ bh info
-    put_ bh docMap
-    put_ bh argMap
+    lazyPut bh (docMap, argMap)
     put_ bh exps
     put_ bh visExps
     put_ bh opts
     put_ bh subMap
+    put_ bh patSynMap
     put_ bh fixMap
 
   get bh = do
     modu    <- get bh
     is_sig  <- get bh
     info    <- get bh
-    docMap  <- get bh
-    argMap  <- get bh
+    ~(docMap, argMap) <- lazyGet bh
     exps    <- get bh
     visExps <- get bh
     opts    <- get bh
     subMap  <- get bh
+    patSynMap <- get bh
     fixMap  <- get bh
 
     return (InstalledInterface modu is_sig info docMap argMap
-            exps visExps opts subMap fixMap)
+            exps visExps opts subMap patSynMap fixMap)
 
 
 instance Binary DocOption where
diff --git a/haddock-api/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs
index 0449c829..d73d1a79 100644
--- a/haddock-api/src/Haddock/Options.hs
+++ b/haddock-api/src/Haddock/Options.hs
@@ -25,6 +25,7 @@ module Haddock.Options (
   sourceUrls,
   wikiUrls,
   optDumpInterfaceFile,
+  optShowInterfaceFile,
   optLaTeXStyle,
   optMathjax,
   qualification,
@@ -53,6 +54,7 @@ data Flag
 --  | Flag_DocBook
   | Flag_ReadInterface String
   | Flag_DumpInterface String
+  | Flag_ShowInterface String
   | Flag_Heading String
   | Flag_Html
   | Flag_Hoogle
@@ -112,6 +114,8 @@ options backwardsCompat =
       "read an interface from FILE",
     Option ['D']  ["dump-interface"] (ReqArg Flag_DumpInterface "FILE")
       "write the resulting interface to FILE",
+    Option []     ["show-interface"] (ReqArg Flag_ShowInterface "FILE")
+      "print the interface in a human readable form",
 --    Option ['S']  ["docbook"]  (NoArg Flag_DocBook)
 --  "output in DocBook XML",
     Option ['h']  ["html"]     (NoArg Flag_Html)
@@ -270,6 +274,8 @@ wikiUrls flags =
 optDumpInterfaceFile :: [Flag] -> Maybe FilePath
 optDumpInterfaceFile flags = optLast [ str | Flag_DumpInterface str <- flags ]
 
+optShowInterfaceFile :: [Flag] -> Maybe FilePath
+optShowInterfaceFile flags = optLast [ str | Flag_ShowInterface str <- flags ]
 
 optLaTeXStyle :: [Flag] -> Maybe String
 optLaTeXStyle flags = optLast [ str | Flag_LaTeXStyle str <- flags ]
diff --git a/haddock-api/src/Haddock/Syb.hs b/haddock-api/src/Haddock/Syb.hs
index 4847e486..7e34ae8c 100644
--- a/haddock-api/src/Haddock/Syb.hs
+++ b/haddock-api/src/Haddock/Syb.hs
@@ -1,8 +1,11 @@
 {-# LANGUAGE Rank2Types #-}
-
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Haddock.Syb
-    ( everything, everythingWithState, everywhere
+    ( everything, everythingButType, everythingWithState
+    , everywhere, everywhereButType
     , mkT
     , combine
     ) where
@@ -10,16 +13,41 @@ module Haddock.Syb
 
 import Data.Data
 import Control.Applicative
+import Data.Maybe
+import Data.Foldable
 
+-- | Returns true if a == t.
+-- requires AllowAmbiguousTypes
+isType :: forall a b. (Typeable a, Typeable b) => b -> Bool
+isType _ = isJust $ eqT @a @b
 
 -- | Perform a query on each level of a tree.
 --
 -- This is stolen directly from SYB package and copied here to not introduce
 -- additional dependencies.
-everything :: (r -> r -> r) -> (forall a. Data a => a -> r)
+everything :: (r -> r -> r)
+           -> (forall a. Data a => a -> r)
            -> (forall a. Data a => a -> r)
-everything k f x = foldl k (f x) (gmapQ (everything k f) x)
+everything k f x = foldl' k (f x) (gmapQ (everything k f) x)
+
+-- | Variation of "everything" with an added stop condition
+-- Just like 'everything', this is stolen from SYB package.
+everythingBut :: (r -> r -> r)
+              -> (forall a. Data a => a -> (r, Bool))
+              -> (forall a. Data a => a -> r)
+everythingBut k f x = let (v, stop) = f x
+                      in if stop
+                           then v
+                           else foldl' k v (gmapQ (everythingBut k f) x)
 
+-- | Variation of "everything" that does not recurse into children of type t
+-- requires AllowAmbiguousTypes
+everythingButType ::
+  forall t r. (Typeable t)
+  => (r -> r -> r)
+  -> (forall a. Data a => a -> r)
+  -> (forall a. Data a => a -> r)
+everythingButType k f = everythingBut k $ (,) <$> f <*> isType @t
 
 -- | Perform a query with state on each level of a tree.
 --
@@ -31,8 +59,7 @@ everythingWithState :: s -> (r -> r -> r)
                     -> (forall a. Data a => a -> r)
 everythingWithState s k f x =
     let (r, s') = f x s
-    in foldl k r (gmapQ (everythingWithState s' k f) x)
-
+    in foldl' k r (gmapQ (everythingWithState s' k f) x)
 
 -- | Apply transformation on each level of a tree.
 --
@@ -40,6 +67,22 @@ everythingWithState s k f x =
 everywhere :: (forall a. Data a => a -> a) -> (forall a. Data a => a -> a)
 everywhere f = f . gmapT (everywhere f)
 
+-- | Variation on everywhere with an extra stop condition
+-- Just like 'everything', this is stolen from SYB package.
+everywhereBut :: (forall a. Data a => a -> Bool)
+  -> (forall a. Data a => a -> a)
+  -> (forall a. Data a => a -> a)
+everywhereBut q f x
+    | q x       = x
+    | otherwise = f (gmapT (everywhereBut q f) x)
+
+-- | Variation of "everywhere" that does not recurse into children of type t
+-- requires AllowAmbiguousTypes
+everywhereButType :: forall t . (Typeable t)
+  => (forall a. Data a => a -> a)
+  -> (forall a. Data a => a -> a)
+everywhereButType = everywhereBut (isType @t)
+
 -- | Create generic transformation.
 --
 -- Another function stolen from SYB package.
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index cb4a4bcc..3ad90912 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -1,8 +1,8 @@
 {-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable, StandaloneDeriving, TypeFamilies, RecordWildCards #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
-                                      -- in module GHC.PlaceHolder
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Haddock.Types
@@ -101,6 +101,9 @@ data Interface = Interface
     -- names of subordinate declarations mapped to their parent declarations.
   , ifaceDeclMap         :: !(Map Name [LHsDecl GhcRn])
 
+    -- | Bundled pattern synonym declarations for specific types.
+  , ifaceBundledPatSynMap :: !(Map Name [Name])
+
     -- | Documentation of declarations originating from the module (including
     -- subordinates).
   , ifaceDocMap          :: !(DocMap Name)
@@ -156,49 +159,53 @@ type WarningMap = Map Name (Doc Name)
 data InstalledInterface = InstalledInterface
   {
     -- | The module represented by this interface.
-    instMod            :: Module
+    instMod              :: Module
 
     -- | Is this a signature?
-  , instIsSig          :: Bool
+  , instIsSig            :: Bool
 
     -- | Textual information about the module.
-  , instInfo           :: HaddockModInfo Name
+  , instInfo             :: HaddockModInfo Name
 
     -- | Documentation of declarations originating from the module (including
     -- subordinates).
-  , instDocMap         :: DocMap Name
+  , instDocMap           :: DocMap Name
 
-  , instArgMap         :: ArgMap Name
+  , instArgMap           :: ArgMap Name
 
     -- | All names exported by this module.
-  , instExports        :: [Name]
+  , instExports          :: [Name]
 
     -- | All \"visible\" names exported by the module.
     -- A visible name is a name that will show up in the documentation of the
     -- module.
-  , instVisibleExports :: [Name]
+  , instVisibleExports   :: [Name]
 
     -- | Haddock options for this module (prune, ignore-exports, etc).
-  , instOptions        :: [DocOption]
+  , instOptions          :: [DocOption]
+
+  , instSubMap           :: Map Name [Name]
 
-  , instSubMap         :: Map Name [Name]
-  , instFixMap         :: Map Name Fixity
+  , instBundledPatSynMap :: Map Name [Name]
+
+  , instFixMap           :: Map Name Fixity
   }
 
 
 -- | Convert an 'Interface' to an 'InstalledInterface'
 toInstalledIface :: Interface -> InstalledInterface
 toInstalledIface interface = InstalledInterface
-  { instMod            = ifaceMod            interface
-  , instIsSig          = ifaceIsSig          interface
-  , instInfo           = ifaceInfo           interface
-  , instDocMap         = ifaceDocMap         interface
-  , instArgMap         = ifaceArgMap         interface
-  , instExports        = ifaceExports        interface
-  , instVisibleExports = ifaceVisibleExports interface
-  , instOptions        = ifaceOptions        interface
-  , instSubMap         = ifaceSubMap         interface
-  , instFixMap         = ifaceFixMap         interface
+  { instMod              = ifaceMod              interface
+  , instIsSig            = ifaceIsSig            interface
+  , instInfo             = ifaceInfo             interface
+  , instDocMap           = ifaceDocMap           interface
+  , instArgMap           = ifaceArgMap           interface
+  , instExports          = ifaceExports          interface
+  , instVisibleExports   = ifaceVisibleExports   interface
+  , instOptions          = ifaceOptions          interface
+  , instSubMap           = ifaceSubMap           interface
+  , instBundledPatSynMap = ifaceBundledPatSynMap interface
+  , instFixMap           = ifaceFixMap           interface
   }
 
 
@@ -215,6 +222,9 @@ data ExportItem name
         -- | A declaration.
         expItemDecl :: !(LHsDecl name)
 
+        -- | Bundled patterns for a data type declaration
+      , expItemPats :: ![(HsDecl name, DocForDecl (IdP name))]
+
         -- | Maybe a doc comment, and possibly docs for arguments (if this
         -- decl is a function or type-synonym).
       , expItemMbDoc :: !(DocForDecl (IdP name))
@@ -427,6 +437,8 @@ type LDoc id = Located (Doc id)
 type Doc id = DocH (ModuleName, OccName) id
 type MDoc id = MetaDoc (ModuleName, OccName) id
 
+type DocMarkup id a = DocMarkupH (ModuleName, OccName) id a
+
 instance (NFData a, NFData mod)
          => NFData (DocH mod a) where
   rnf doc = case doc of
@@ -454,7 +466,7 @@ instance (NFData a, NFData mod)
     DocExamples a             -> a `deepseq` ()
     DocHeader a               -> a `deepseq` ()
 
-#if !MIN_VERSION_GLASGOW_HASKELL(8,0,1,1)
+#if !MIN_VERSION_ghc(8,0,2)
 -- These were added to GHC itself in 8.0.2
 instance NFData Name where rnf x = seq x ()
 instance NFData OccName where rnf x = seq x ()
@@ -478,34 +490,6 @@ exampleToString :: Example -> String
 exampleToString (Example expression result) =
     ">>> " ++ expression ++ "\n" ++  unlines result
 
-
-data DocMarkup id a = Markup
-  { markupEmpty                :: a
-  , markupString               :: String -> a
-  , markupParagraph            :: a -> a
-  , markupAppend               :: a -> a -> a
-  , markupIdentifier           :: id -> a
-  , markupIdentifierUnchecked  :: (ModuleName, OccName) -> a
-  , markupModule               :: String -> a
-  , markupWarning              :: a -> a
-  , markupEmphasis             :: a -> a
-  , markupBold                 :: a -> a
-  , markupMonospaced           :: a -> a
-  , markupUnorderedList        :: [a] -> a
-  , markupOrderedList          :: [a] -> a
-  , markupDefList              :: [(a,a)] -> a
-  , markupCodeBlock            :: a -> a
-  , markupHyperlink            :: Hyperlink -> a
-  , markupAName                :: String -> a
-  , markupPic                  :: Picture -> a
-  , markupMathInline           :: String -> a
-  , markupMathDisplay          :: String -> a
-  , markupProperty             :: String -> a
-  , markupExample              :: [Example] -> a
-  , markupHeader               :: Header a -> a
-  }
-
-
 data HaddockModInfo name = HaddockModInfo
   { hmi_description :: Maybe (Doc name)
   , hmi_copyright   :: Maybe String
@@ -589,6 +573,12 @@ makeModuleQual qual aliases mdl =
     OptFullQual       -> FullQual
     OptNoQual         -> NoQual
 
+-- | Whether to hide empty contexts
+-- Since pattern synonyms have two contexts with different semantics, it is
+-- important to all of them, even if one of them is empty.
+data HideEmptyContexts
+  = HideEmptyContexts
+  | ShowEmptyToplevelContexts
 
 -----------------------------------------------------------------------------
 -- * Error handling
diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs
index f5c5b743..540774dc 100644
--- a/haddock-api/src/Haddock/Utils.hs
+++ b/haddock-api/src/Haddock/Utils.hs
@@ -37,8 +37,6 @@ module Haddock.Utils (
   html_xrefs_ref, html_xrefs_ref',
 
   -- * Doc markup
-  markup,
-  idMarkup,
   mkMeta,
 
   -- * List utilities
@@ -448,71 +446,6 @@ spanWith p xs@(a:as)
   | Just b <- p a = let (bs,cs) = spanWith p as in (b:bs,cs)
   | otherwise     = ([],xs)
 
-
------------------------------------------------------------------------------
--- * Put here temporarily
------------------------------------------------------------------------------
-
-
-markup :: DocMarkup id a -> Doc id -> a
-markup m DocEmpty                    = markupEmpty m
-markup m (DocAppend d1 d2)           = markupAppend m (markup m d1) (markup m d2)
-markup m (DocString s)               = markupString m s
-markup m (DocParagraph d)            = markupParagraph m (markup m d)
-markup m (DocIdentifier x)           = markupIdentifier m x
-markup m (DocIdentifierUnchecked x)  = markupIdentifierUnchecked m x
-markup m (DocModule mod0)            = markupModule m mod0
-markup m (DocWarning d)              = markupWarning m (markup m d)
-markup m (DocEmphasis d)             = markupEmphasis m (markup m d)
-markup m (DocBold d)                 = markupBold m (markup m d)
-markup m (DocMonospaced d)           = markupMonospaced m (markup m d)
-markup m (DocUnorderedList ds)       = markupUnorderedList m (map (markup m) ds)
-markup m (DocOrderedList ds)         = markupOrderedList m (map (markup m) ds)
-markup m (DocDefList ds)             = markupDefList m (map (markupPair m) ds)
-markup m (DocCodeBlock d)            = markupCodeBlock m (markup m d)
-markup m (DocHyperlink l)            = markupHyperlink m l
-markup m (DocAName ref)              = markupAName m ref
-markup m (DocPic img)                = markupPic m img
-markup m (DocMathInline mathjax)     = markupMathInline m mathjax
-markup m (DocMathDisplay mathjax)    = markupMathDisplay m mathjax
-markup m (DocProperty p)             = markupProperty m p
-markup m (DocExamples e)             = markupExample m e
-markup m (DocHeader (Header l t))    = markupHeader m (Header l (markup m t))
-
-
-markupPair :: DocMarkup id a -> (Doc id, Doc id) -> (a, a)
-markupPair m (a,b) = (markup m a, markup m b)
-
-
--- | The identity markup
-idMarkup :: DocMarkup a (Doc a)
-idMarkup = Markup {
-  markupEmpty                = DocEmpty,
-  markupString               = DocString,
-  markupParagraph            = DocParagraph,
-  markupAppend               = DocAppend,
-  markupIdentifier           = DocIdentifier,
-  markupIdentifierUnchecked  = DocIdentifierUnchecked,
-  markupModule               = DocModule,
-  markupWarning              = DocWarning,
-  markupEmphasis             = DocEmphasis,
-  markupBold                 = DocBold,
-  markupMonospaced           = DocMonospaced,
-  markupUnorderedList        = DocUnorderedList,
-  markupOrderedList          = DocOrderedList,
-  markupDefList              = DocDefList,
-  markupCodeBlock            = DocCodeBlock,
-  markupHyperlink            = DocHyperlink,
-  markupAName                = DocAName,
-  markupPic                  = DocPic,
-  markupMathInline           = DocMathInline,
-  markupMathDisplay          = DocMathDisplay,
-  markupProperty             = DocProperty,
-  markupExample              = DocExamples,
-  markupHeader               = DocHeader
-  }
-
-
 -----------------------------------------------------------------------------
 -- * System tools
 -----------------------------------------------------------------------------