Move sources under haddock-api/src

5 files changed, 1890 insertions, 0 deletions

diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs
new file mode 100644
index 00000000..a0bac8fc
--- /dev/null
+++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs
@@ -0,0 +1,221 @@
+{-# LANGUAGE CPP, MagicHash #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.Interface.AttachInstances
+-- Copyright   :  (c) Simon Marlow 2006,
+--                    David Waern  2006-2009,
+--                    Isaac Dupree 2009
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+-----------------------------------------------------------------------------
+module Haddock.Interface.AttachInstances (attachInstances) where
+
+
+import Haddock.Types
+import Haddock.Convert
+import Haddock.GhcUtils
+
+import Control.Arrow
+import Data.List
+import Data.Ord (comparing)
+import Data.Function (on)
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+import Class
+import FamInstEnv
+import FastString
+import GHC
+import GhcMonad (withSession)
+import Id
+import InstEnv
+import MonadUtils (liftIO)
+import Name
+import PrelNames
+import TcRnDriver (tcRnGetInfo)
+import TcType (tcSplitSigmaTy)
+import TyCon
+import TypeRep
+import TysPrim( funTyCon )
+import Var hiding (varName)
+#define FSLIT(x) (mkFastString# (x#))
+
+type ExportedNames = Set.Set Name
+type Modules = Set.Set Module
+type ExportInfo = (ExportedNames, Modules)
+
+-- Also attaches fixities
+attachInstances :: ExportInfo -> [Interface] -> InstIfaceMap -> Ghc [Interface]
+attachInstances expInfo ifaces instIfaceMap = mapM attach ifaces
+  where
+    -- TODO: take an IfaceMap as input
+    ifaceMap = Map.fromList [ (ifaceMod i, i) | i <- ifaces ]
+
+    attach iface = do
+      newItems <- mapM (attachToExportItem expInfo iface ifaceMap instIfaceMap)
+                       (ifaceExportItems iface)
+      return $ iface { ifaceExportItems = newItems }
+
+
+attachToExportItem :: ExportInfo -> Interface -> IfaceMap -> InstIfaceMap -> ExportItem Name -> Ghc (ExportItem Name)
+attachToExportItem expInfo iface ifaceMap instIfaceMap export =
+  case attachFixities export of
+    e@ExportDecl { expItemDecl = L _ (TyClD d) } -> do
+      mb_info <- getAllInfo (tcdName d)
+      let export' =
+            e {
+              expItemInstances =
+                case mb_info of
+                  Just (_, _, cls_instances, fam_instances) ->
+                    let fam_insts = [ (synifyFamInst i opaque, n)
+                                    | i <- sortBy (comparing instFam) fam_instances
+                                    , let n = instLookup instDocMap (getName i) iface ifaceMap instIfaceMap
+                                    , not $ isNameHidden expInfo (fi_fam i)
+                                    , not $ any (isTypeHidden expInfo) (fi_tys i)
+                                    , let opaque = isTypeHidden expInfo (fi_rhs i)
+                                    ]
+                        cls_insts = [ (synifyInstHead i, instLookup instDocMap n iface ifaceMap instIfaceMap)
+                                    | let is = [ (instanceHead' i, getName i) | i <- cls_instances ]
+                                    , (i@(_,_,cls,tys), n) <- sortBy (comparing $ first instHead) is
+                                    , not $ isInstanceHidden expInfo cls tys
+                                    ]
+                    in cls_insts ++ fam_insts
+                  Nothing -> []
+            }
+      return export'
+    e -> return e
+  where
+    attachFixities e@ExportDecl{ expItemDecl = L _ d } = e { expItemFixities =
+      nubBy ((==) `on` fst) $ expItemFixities e ++
+      [ (n',f) | n <- getMainDeclBinder d
+              , Just subs <- [instLookup instSubMap n iface ifaceMap instIfaceMap]
+              , n' <- n : subs
+              , Just f <- [instLookup instFixMap n' iface ifaceMap instIfaceMap]
+      ] }
+
+    attachFixities e = e
+
+
+instLookup :: (InstalledInterface -> Map.Map Name a) -> Name
+            -> Interface -> IfaceMap -> InstIfaceMap -> Maybe a
+instLookup f name iface ifaceMap instIfaceMap =
+  case Map.lookup name (f $ toInstalledIface iface) of
+    res@(Just _) -> res
+    Nothing -> do
+      let ifaceMaps = Map.union (fmap toInstalledIface ifaceMap) instIfaceMap
+      iface' <- Map.lookup (nameModule name) ifaceMaps
+      Map.lookup name (f iface')
+
+-- | Like GHC's 'instanceHead' but drops "silent" arguments.
+instanceHead' :: ClsInst -> ([TyVar], ThetaType, Class, [Type])
+instanceHead' ispec = (tvs, dropSilentArgs dfun theta, cls, tys)
+  where
+    dfun = is_dfun ispec
+    (tvs, cls, tys) = instanceHead ispec
+    (_, theta, _) = tcSplitSigmaTy (idType dfun)
+
+-- | Drop "silent" arguments. See GHC Note [Silent superclass
+-- arguments].
+dropSilentArgs :: DFunId -> ThetaType -> ThetaType
+dropSilentArgs dfun theta = drop (dfunNSilent dfun) theta
+
+
+-- | Like GHC's getInfo but doesn't cut things out depending on the
+-- interative context, which we don't set sufficiently anyway.
+getAllInfo :: GhcMonad m => Name -> m (Maybe (TyThing,Fixity,[ClsInst],[FamInst]))
+getAllInfo name = withSession $ \hsc_env -> do 
+   (_msgs, r) <- liftIO $ tcRnGetInfo hsc_env name
+   return r
+
+
+--------------------------------------------------------------------------------
+-- Collecting and sorting instances
+--------------------------------------------------------------------------------
+
+
+-- | Simplified type for sorting types, ignoring qualification (not visible
+-- in Haddock output) and unifying special tycons with normal ones.
+-- For the benefit of the user (looks nice and predictable) and the
+-- tests (which prefer output to be deterministic).
+data SimpleType = SimpleType Name [SimpleType]
+                | SimpleTyLit TyLit
+                  deriving (Eq,Ord)
+
+
+instHead :: ([TyVar], [PredType], Class, [Type]) -> ([Int], Name, [SimpleType])
+instHead (_, _, cls, args)
+  = (map argCount args, className cls, map simplify args)
+
+argCount :: Type -> Int
+argCount (AppTy t _) = argCount t + 1
+argCount (TyConApp _ ts) = length ts
+argCount (FunTy _ _ ) = 2
+argCount (ForAllTy _ t) = argCount t
+argCount _ = 0
+
+simplify :: Type -> SimpleType
+simplify (ForAllTy _ t) = simplify t
+simplify (FunTy t1 t2) = SimpleType funTyConName [simplify t1, simplify t2]
+simplify (AppTy t1 t2) = SimpleType s (ts ++ [simplify t2])
+  where (SimpleType s ts) = simplify t1
+simplify (TyVarTy v) = SimpleType (tyVarName v) []
+simplify (TyConApp tc ts) = SimpleType (tyConName tc) (map simplify ts)
+simplify (LitTy l) = SimpleTyLit l
+
+-- Used for sorting
+instFam :: FamInst -> ([Int], Name, [SimpleType], Int, SimpleType)
+instFam FamInst { fi_fam = n, fi_tys = ts, fi_rhs = t }
+  = (map argCount ts, n, map simplify ts, argCount t, simplify t)
+
+
+funTyConName :: Name
+funTyConName = mkWiredInName gHC_PRIM
+                        (mkOccNameFS tcName FSLIT("(->)"))
+                        funTyConKey
+                        (ATyCon funTyCon)       -- Relevant TyCon
+                        BuiltInSyntax
+
+--------------------------------------------------------------------------------
+-- Filtering hidden instances
+--------------------------------------------------------------------------------
+
+-- | A class or data type is hidden iff
+--
+-- * it is defined in one of the modules that are being processed
+--
+-- * and it is not exported by any non-hidden module
+isNameHidden :: ExportInfo -> Name -> Bool
+isNameHidden (names, modules) name =
+  nameModule name `Set.member` modules &&
+  not (name `Set.member` names)
+
+-- | We say that an instance is «hidden» iff its class or any (part)
+-- of its type(s) is hidden.
+isInstanceHidden :: ExportInfo -> Class -> [Type] -> Bool
+isInstanceHidden expInfo cls tys =
+    instClassHidden || instTypeHidden
+  where
+    instClassHidden :: Bool
+    instClassHidden = isNameHidden expInfo $ getName cls
+
+    instTypeHidden :: Bool
+    instTypeHidden = any (isTypeHidden expInfo) tys
+
+isTypeHidden :: ExportInfo -> Type -> Bool
+isTypeHidden expInfo = typeHidden
+  where
+    typeHidden :: Type -> Bool
+    typeHidden t =
+      case t of
+        TyVarTy {} -> False
+        AppTy t1 t2 -> typeHidden t1 || typeHidden t2
+        TyConApp tcon args -> nameHidden (getName tcon) || any typeHidden args
+        FunTy t1 t2 -> typeHidden t1 || typeHidden t2
+        ForAllTy _ ty -> typeHidden ty
+        LitTy _ -> False
+
+    nameHidden :: Name -> Bool
+    nameHidden = isNameHidden expInfo
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
new file mode 100644
index 00000000..b66773ae
--- /dev/null
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -0,0 +1,867 @@
+{-# LANGUAGE CPP, TupleSections, BangPatterns, LambdaCase #-}
+{-# OPTIONS_GHC -Wwarn #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.Interface.Create
+-- Copyright   :  (c) Simon Marlow      2003-2006,
+--                    David Waern       2006-2009,
+--                    Mateusz Kowalczyk 2013
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+-----------------------------------------------------------------------------
+module Haddock.Interface.Create (createInterface) where
+
+import Documentation.Haddock.Doc (docAppend)
+import Haddock.Types
+import Haddock.Options
+import Haddock.GhcUtils
+import Haddock.Utils
+import Haddock.Convert
+import Haddock.Interface.LexParseRn
+
+import qualified Data.Map as M
+import Data.Map (Map)
+import Data.List
+import Data.Maybe
+import Data.Monoid
+import Data.Ord
+import Control.Applicative
+import Control.Arrow (second)
+import Control.DeepSeq
+import Control.Monad
+import Data.Function (on)
+import qualified Data.Foldable as F
+
+import qualified Packages
+import qualified Module
+import qualified SrcLoc
+import GHC
+import HscTypes
+import Name
+import Bag
+import RdrName
+import TcRnTypes
+import FastString (concatFS)
+
+
+-- | Use a 'TypecheckedModule' to produce an 'Interface'.
+-- To do this, we need access to already processed modules in the topological
+-- sort. That's what's in the 'IfaceMap'.
+createInterface :: TypecheckedModule -> [Flag] -> IfaceMap -> InstIfaceMap -> ErrMsgGhc Interface
+createInterface tm flags modMap instIfaceMap = do
+
+  let ms             = pm_mod_summary . tm_parsed_module $ tm
+      mi             = moduleInfo tm
+      L _ hsm        = parsedSource tm
+      !safety        = modInfoSafe mi
+      mdl            = ms_mod ms
+      dflags         = ms_hspp_opts ms
+      !instances     = modInfoInstances mi
+      !fam_instances = md_fam_insts md
+      !exportedNames = modInfoExports mi
+
+      (TcGblEnv {tcg_rdr_env = gre, tcg_warns = warnings}, md) = tm_internals_ tm
+
+  -- The renamed source should always be available to us, but it's best
+  -- to be on the safe side.
+  (group_, mayExports, mayDocHeader) <-
+    case renamedSource tm of
+      Nothing -> do
+        liftErrMsg $ tell [ "Warning: Renamed source is not available." ]
+        return (emptyRnGroup, Nothing, Nothing)
+      Just (x, _, y, z) -> return (x, y, z)
+
+  opts0 <- liftErrMsg $ mkDocOpts (haddockOptions dflags) flags mdl
+  let opts
+        | Flag_IgnoreAllExports `elem` flags = OptIgnoreExports : opts0
+        | otherwise = opts0
+
+  (!info, mbDoc) <- liftErrMsg $ processModuleHeader dflags gre safety mayDocHeader
+
+  let declsWithDocs = topDecls group_
+      fixMap = mkFixMap group_
+      (decls, _) = unzip declsWithDocs
+      localInsts = filter (nameIsLocalOrFrom mdl) $  map getName instances
+                                                  ++ map getName fam_instances
+      -- Locations of all TH splices
+      splices = [ l | L l (SpliceD _) <- hsmodDecls hsm ]
+
+      maps@(!docMap, !argMap, !subMap, !declMap, _) =
+        mkMaps dflags gre localInsts declsWithDocs
+
+  let exports0 = fmap (reverse . map unLoc) mayExports
+      exports
+        | OptIgnoreExports `elem` opts = Nothing
+        | otherwise = exports0
+      warningMap = mkWarningMap dflags warnings gre exportedNames
+
+  let allWarnings = M.unions (warningMap : map ifaceWarningMap (M.elems modMap))
+
+  exportItems <- mkExportItems modMap mdl allWarnings gre exportedNames decls
+                   maps fixMap splices exports instIfaceMap dflags
+
+  let !visibleNames = mkVisibleNames maps exportItems opts
+
+  -- Measure haddock documentation coverage.
+  let prunedExportItems0 = pruneExportItems exportItems
+      !haddockable = 1 + length exportItems -- module + exports
+      !haddocked = (if isJust mbDoc then 1 else 0) + length prunedExportItems0
+      !coverage = (haddockable, haddocked)
+
+  -- Prune the export list to just those declarations that have
+  -- documentation, if the 'prune' option is on.
+  let prunedExportItems'
+        | OptPrune `elem` opts = prunedExportItems0
+        | otherwise = exportItems
+      !prunedExportItems = seqList prunedExportItems' `seq` prunedExportItems'
+
+  let !aliases =
+        mkAliasMap dflags $ tm_renamed_source tm
+      modWarn = moduleWarning dflags gre warnings
+
+  return $! Interface {
+    ifaceMod             = mdl
+  , ifaceOrigFilename    = msHsFilePath ms
+  , ifaceInfo            = info
+  , ifaceDoc             = Documentation mbDoc modWarn
+  , ifaceRnDoc           = Documentation Nothing Nothing
+  , ifaceOptions         = opts
+  , ifaceDocMap          = docMap
+  , ifaceArgMap          = argMap
+  , ifaceRnDocMap        = M.empty
+  , ifaceRnArgMap        = M.empty
+  , ifaceExportItems     = prunedExportItems
+  , ifaceRnExportItems   = []
+  , ifaceExports         = exportedNames
+  , ifaceVisibleExports  = visibleNames
+  , ifaceDeclMap         = declMap
+  , ifaceSubMap          = subMap
+  , ifaceFixMap          = fixMap
+  , ifaceModuleAliases   = aliases
+  , ifaceInstances       = instances
+  , ifaceFamInstances    = fam_instances
+  , ifaceHaddockCoverage = coverage
+  , ifaceWarningMap      = warningMap
+  }
+
+mkAliasMap :: DynFlags -> Maybe RenamedSource -> M.Map Module ModuleName
+mkAliasMap dflags mRenamedSource =
+  case mRenamedSource of
+    Nothing -> M.empty
+    Just (_,impDecls,_,_) ->
+      M.fromList $
+      mapMaybe (\(SrcLoc.L _ impDecl) -> do
+        alias <- ideclAs impDecl
+        return $
+          (lookupModuleDyn dflags
+             (fmap Module.fsToPackageId $
+              ideclPkgQual impDecl)
+             (case ideclName impDecl of SrcLoc.L _ name -> name),
+           alias))
+        impDecls
+
+-- similar to GHC.lookupModule
+lookupModuleDyn ::
+  DynFlags -> Maybe PackageId -> ModuleName -> Module
+lookupModuleDyn _ (Just pkgId) mdlName =
+  Module.mkModule pkgId mdlName
+lookupModuleDyn dflags Nothing mdlName =
+  flip Module.mkModule mdlName $
+  case filter snd $
+       Packages.lookupModuleInAllPackages dflags mdlName of
+    (pkgId,_):_ -> Packages.packageConfigId pkgId
+    [] -> Module.mainPackageId
+
+
+-------------------------------------------------------------------------------
+-- Warnings
+-------------------------------------------------------------------------------
+
+mkWarningMap :: DynFlags -> Warnings -> GlobalRdrEnv -> [Name] -> WarningMap
+mkWarningMap dflags warnings gre exps = case warnings of
+  NoWarnings  -> M.empty
+  WarnAll _   -> M.empty
+  WarnSome ws ->
+    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'
+
+moduleWarning :: DynFlags -> GlobalRdrEnv -> Warnings -> Maybe (Doc Name)
+moduleWarning _ _ NoWarnings = Nothing
+moduleWarning _ _ (WarnSome _) = 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
+  DeprecatedTxt msg -> format "Deprecated: " (concatFS msg)
+  WarningTxt    msg -> format "Warning: "    (concatFS msg)
+  where
+    format x xs = DocWarning . DocParagraph . DocAppend (DocString x)
+                  . processDocString dflags gre $ HsDocString xs
+
+
+-------------------------------------------------------------------------------
+-- Doc options
+--
+-- Haddock options that are embedded in the source file
+-------------------------------------------------------------------------------
+
+
+mkDocOpts :: Maybe String -> [Flag] -> Module -> ErrMsgM [DocOption]
+mkDocOpts mbOpts flags mdl = do
+  opts <- case mbOpts of
+    Just opts -> case words $ replace ',' ' ' opts of
+      [] -> tell ["No option supplied to DOC_OPTION/doc_option"] >> return []
+      xs -> liftM catMaybes (mapM parseOption xs)
+    Nothing -> return []
+  hm <- if Flag_HideModule (moduleString mdl) `elem` flags
+        then return $ OptHide : opts
+        else return opts
+  if Flag_ShowExtensions (moduleString mdl) `elem` flags
+    then return $ OptShowExtensions : hm
+    else return hm
+
+
+parseOption :: String -> ErrMsgM (Maybe DocOption)
+parseOption "hide"            = return (Just OptHide)
+parseOption "prune"           = return (Just OptPrune)
+parseOption "ignore-exports"  = return (Just OptIgnoreExports)
+parseOption "not-home"        = return (Just OptNotHome)
+parseOption "show-extensions" = return (Just OptShowExtensions)
+parseOption other = tell ["Unrecognised option: " ++ other] >> return Nothing
+
+
+--------------------------------------------------------------------------------
+-- Maps
+--------------------------------------------------------------------------------
+
+
+type Maps = (DocMap Name, ArgMap Name, SubMap, DeclMap, InstMap)
+
+-- | Create 'Maps' by looping through the declarations. For each declaration,
+-- find its names, its subordinates, and its doc strings. Process doc strings
+-- into 'Doc's.
+mkMaps :: DynFlags
+       -> GlobalRdrEnv
+       -> [Name]
+       -> [(LHsDecl Name, [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)
+  where
+    f :: (Ord a, Monoid b) => [[(a, b)]] -> Map a b
+    f = M.fromListWith (<>) . concat
+
+    f' :: [[(Name, Doc Name)]] -> Map Name (Doc Name)
+    f' = M.fromListWith docAppend . concat
+
+    mappings :: (LHsDecl Name, [HsDocString])
+             -> ( [(Name, Doc Name)]
+                , [(Name, Map Int (Doc Name))]
+                , [(Name, [Name])]
+                , [(Name,  [LHsDecl Name])]
+                )
+    mappings (ldecl, docStrs) =
+      let L l decl = ldecl
+          declDoc :: [HsDocString] -> Map Int HsDocString
+                  -> (Maybe (Doc Name), Map Int (Doc 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)
+          subs :: [(Name, [HsDocString], Map Int HsDocString)]
+          subs = subordinates instanceMap decl
+          (subDocs, subArgs) = unzip $ map (\(_, strs, m) -> declDoc strs m) subs
+          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)
+
+    instanceMap :: Map SrcSpan Name
+    instanceMap = M.fromList [ (getSrcSpan n, n) | n <- instances ]
+
+    names :: SrcSpan -> HsDecl Name -> [Name]
+    names l (InstD d) = maybeToList (M.lookup loc instanceMap) -- See note [2].
+      where loc = case d of
+              TyFamInstD _ -> l -- The CoAx's loc is the whole line, but only for TFs
+              _ -> getInstLoc d
+    names _ decl = getMainDeclBinder decl
+
+-- Note [2]:
+------------
+-- We relate ClsInsts to InstDecls using the SrcSpans buried inside them.
+-- That should work for normal user-written instances (from looking at GHC
+-- sources). We can assume that commented instances are user-written.
+-- This lets us relate Names (from ClsInsts) to comments (associated
+-- with InstDecls).
+
+
+--------------------------------------------------------------------------------
+-- Declarations
+--------------------------------------------------------------------------------
+
+
+-- | Get all subordinate declarations inside a declaration, and their docs.
+subordinates :: InstMap -> HsDecl Name -> [(Name, [HsDocString], Map Int HsDocString)]
+subordinates instMap decl = case decl of
+  InstD (ClsInstD d) -> do
+    DataFamInstDecl { dfid_tycon = L l _
+                    , dfid_defn = def    } <- unLoc <$> cid_datafam_insts d
+    [ (n, [], M.empty) | Just n <- [M.lookup l instMap] ] ++ dataSubs def
+
+  InstD (DataFamInstD d)  -> dataSubs (dfid_defn d)
+  TyClD d | isClassDecl d -> classSubs d
+          | isDataDecl  d -> dataSubs (tcdDataDefn d)
+  _ -> []
+  where
+    classSubs dd = [ (name, doc, typeDocs d) | (L _ d, doc) <- classDecls dd
+                   , name <- getMainDeclBinder d, not (isValD d)
+                   ]
+    dataSubs dd = constrs ++ fields
+      where
+        cons = map unL $ (dd_cons dd)
+        constrs = [ (unL $ con_name c, maybeToList $ fmap unL $ con_doc c, M.empty)
+                  | c <- cons ]
+        fields  = [ (unL n, maybeToList $ fmap unL doc, M.empty)
+                  | RecCon flds <- map con_details cons
+                  , ConDeclField n _ doc <- flds ]
+
+-- | Extract function argument docs from inside types.
+typeDocs :: HsDecl Name -> Map Int HsDocString
+typeDocs d =
+  let docs = go 0 in
+  case d of
+    SigD (TypeSig _ ty) -> docs (unLoc ty)
+    SigD (PatSynSig _ arg_tys ty req prov) ->
+        let allTys = ty : concat [ F.toList arg_tys, unLoc req, unLoc prov ]
+        in F.foldMap (docs . unLoc) allTys
+    ForD (ForeignImport _ ty _ _) -> docs (unLoc ty)
+    TyClD (SynDecl { tcdRhs = ty }) -> docs (unLoc ty)
+    _ -> M.empty
+  where
+    go n (HsForAllTy _ _ _ ty) = go n (unLoc ty)
+    go n (HsFunTy (L _ (HsDocTy _ (L _ x))) (L _ ty)) = M.insert n x $ go (n+1) ty
+    go n (HsFunTy _ ty) = go (n+1) (unLoc ty)
+    go n (HsDocTy _ (L _ doc)) = M.singleton n doc
+    go _ _ = M.empty
+
+
+-- | All the sub declarations of a class (that we handle), ordered by
+-- source location, with documentation attached if it exists.
+classDecls :: TyClDecl Name -> [(LHsDecl Name, [HsDocString])]
+classDecls class_ = filterDecls . collectDocs . sortByLoc $ decls
+  where
+    decls = docs ++ defs ++ sigs ++ ats
+    docs  = mkDecls tcdDocs DocD class_
+#if MIN_VERSION_ghc(7,8,3)
+    defs  = mkDecls (bagToList . tcdMeths) ValD class_
+#else
+    defs  = mkDecls (map snd . bagToList . tcdMeths) ValD class_
+#endif
+    sigs  = mkDecls tcdSigs SigD class_
+    ats   = mkDecls tcdATs (TyClD . FamDecl) class_
+
+
+-- | The top-level declarations of a module that we care about,
+-- ordered by source location, with documentation attached if it exists.
+topDecls :: HsGroup Name -> [(LHsDecl Name, [HsDocString])]
+topDecls = filterClasses . filterDecls . collectDocs . sortByLoc . ungroup
+
+-- | Extract a map of fixity declarations only
+mkFixMap :: HsGroup Name -> FixMap
+mkFixMap group_ = M.fromList [ (n,f)
+                             | L _ (FixitySig (L _ n) f) <- hs_fixds group_ ]
+
+
+-- | Take all declarations except pragmas, infix decls, rules from an 'HsGroup'.
+ungroup :: HsGroup Name -> [LHsDecl Name]
+ungroup group_ =
+  mkDecls (tyClGroupConcat . hs_tyclds) TyClD  group_ ++
+  mkDecls hs_derivds             DerivD group_ ++
+  mkDecls hs_defds               DefD   group_ ++
+  mkDecls hs_fords               ForD   group_ ++
+  mkDecls hs_docs                DocD   group_ ++
+  mkDecls hs_instds              InstD  group_ ++
+  mkDecls (typesigs . hs_valds)  SigD   group_ ++
+#if MIN_VERSION_ghc(7,8,3)
+  mkDecls (valbinds . hs_valds)  ValD   group_
+#else
+  mkDecls (map snd . valbinds . hs_valds)  ValD   group_
+#endif
+  where
+    typesigs (ValBindsOut _ sigs) = filter isVanillaLSig sigs
+    typesigs _ = error "expected ValBindsOut"
+
+    valbinds (ValBindsOut binds _) = concatMap bagToList . snd . unzip $ binds
+    valbinds _ = error "expected ValBindsOut"
+
+
+-- | Take a field of declarations from a data structure and create HsDecls
+-- using the given constructor
+mkDecls :: (a -> [Located b]) -> (b -> c) -> a -> [Located c]
+mkDecls field con struct = [ L loc (con decl) | L loc decl <- field struct ]
+
+
+-- | Sort by source location
+sortByLoc :: [Located a] -> [Located a]
+sortByLoc = sortBy (comparing getLoc)
+
+
+--------------------------------------------------------------------------------
+-- Filtering of declarations
+--
+-- We filter out declarations that we don't intend to handle later.
+--------------------------------------------------------------------------------
+
+
+-- | Filter out declarations that we don't handle in Haddock
+filterDecls :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
+filterDecls = filter (isHandled . unL . fst)
+  where
+    isHandled (ForD (ForeignImport {})) = True
+    isHandled (TyClD {}) = True
+    isHandled (InstD {}) = True
+    isHandled (SigD d) = isVanillaLSig (reL d)
+    isHandled (ValD _) = True
+    -- we keep doc declarations to be able to get at named docs
+    isHandled (DocD _) = True
+    isHandled _ = False
+
+
+-- | Go through all class declarations and filter their sub-declarations
+filterClasses :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
+filterClasses decls = [ if isClassD d then (L loc (filterClass d), doc) else x
+                      | x@(L loc d, doc) <- decls ]
+  where
+    filterClass (TyClD c) =
+      TyClD $ c { tcdSigs = filter (liftA2 (||) isVanillaLSig isMinimalLSig) $ tcdSigs c }
+    filterClass _ = error "expected TyClD"
+
+
+--------------------------------------------------------------------------------
+-- Collect docs
+--
+-- To be able to attach the right Haddock comment to the right declaration,
+-- we sort the declarations by their SrcLoc and "collect" the docs for each
+-- declaration.
+--------------------------------------------------------------------------------
+
+
+-- | Collect docs and attach them to the right declarations.
+collectDocs :: [LHsDecl a] -> [(LHsDecl a, [HsDocString])]
+collectDocs = go Nothing []
+  where
+    go Nothing _ [] = []
+    go (Just prev) docs [] = finished prev docs []
+    go prev docs (L _ (DocD (DocCommentNext str)) : ds)
+      | Nothing <- prev = go Nothing (str:docs) ds
+      | Just decl <- prev = finished decl docs (go Nothing [str] ds)
+    go prev docs (L _ (DocD (DocCommentPrev str)) : ds) = go prev (str:docs) ds
+    go Nothing docs (d:ds) = go (Just d) docs ds
+    go (Just prev) docs (d:ds) = finished prev docs (go (Just d) [] ds)
+
+    finished decl docs rest = (decl, reverse docs) : rest
+
+
+-- | Build the list of items that will become the documentation, from the
+-- export list.  At this point, the list of ExportItems is in terms of
+-- original names.
+--
+-- We create the export items even if the module is hidden, since they
+-- might be useful when creating the export items for other modules.
+mkExportItems
+  :: IfaceMap
+  -> Module             -- this module
+  -> WarningMap
+  -> GlobalRdrEnv
+  -> [Name]             -- exported names (orig)
+  -> [LHsDecl Name]
+  -> Maps
+  -> FixMap
+  -> [SrcSpan]          -- splice locations
+  -> Maybe [IE Name]
+  -> InstIfaceMap
+  -> DynFlags
+  -> ErrMsgGhc [ExportItem Name]
+mkExportItems
+  modMap thisMod warnings gre exportedNames decls
+  maps@(docMap, argMap, subMap, declMap, instMap) 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 x)             = declWith x
+    lookupExport (IEThingAbs t)        = declWith t
+    lookupExport (IEThingAll t)        = declWith t
+    lookupExport (IEThingWith t _)     = declWith t
+    lookupExport (IEModuleContents m)  =
+      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 (IEDoc docStr)        = return $
+      return . ExportDoc $ processDocStringParas dflags gre docStr
+
+    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 Name ]
+    declWith t =
+      case findDecl t of
+        ([L l (ValD _)], (doc, _)) -> do
+          -- Top-level binding without type signature
+          export <- hiValExportItem dflags t doc (l `elem` splices) $ M.lookup t fixMap
+          return [export]
+        (ds, docs_) | decl : _ <- filter (not . isValD . unLoc) ds ->
+          let declNames = getMainDeclBinder (unL decl)
+          in case () of
+            _
+              -- temp hack: we filter out separately exported ATs, since we haven't decided how
+              -- to handle them yet. We should really give an warning message also, and filter the
+              -- name out in mkVisibleNames...
+              | t `elem` declATs (unL decl)        -> return []
+
+              -- We should not show a subordinate by itself if any of its
+              -- parents is also exported. See note [1].
+              | t `notElem` declNames,
+                Just p <- find isExported (parents t $ unL decl) ->
+                do liftErrMsg $ tell [
+                     "Warning: " ++ moduleString thisMod ++ ": " ++
+                     pretty dflags (nameOccName t) ++ " is exported separately but " ++
+                     "will be documented under " ++ pretty dflags (nameOccName p) ++
+                     ". Consider exporting it together with its parent(s)" ++
+                     " for code clarity." ]
+                   return []
+
+              -- normal case
+              | otherwise -> case decl of
+                  -- A single signature might refer to many names, but we
+                  -- create an export item for a single name only.  So we
+                  -- modify the signature to contain only that single name.
+                  L loc (SigD sig) ->
+                    -- 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_ ]
+
+                  L loc (TyClD cl@ClassDecl{}) -> do
+                    mdef <- liftGhcToErrMsgGhc $ minimalDef t
+                    let sig = maybeToList $ fmap (noLoc . MinimalSig . fmap noLoc) mdef
+                    return [ mkExportDecl t
+                      (L loc $ TyClD cl { tcdSigs = sig ++ tcdSigs cl }) docs_ ]
+
+                  _ -> return [ mkExportDecl t decl docs_ ]
+
+        -- Declaration from another package
+        ([], _) -> do
+          mayDecl <- hiDecl dflags t
+          case mayDecl of
+            Nothing -> return [ ExportNoDecl t [] ]
+            Just decl ->
+              -- We try to get the subs and docs
+              -- from the installed .haddock file for that package.
+              case M.lookup (nameModule t) instIfaceMap of
+                Nothing -> do
+                   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_) ]
+                Just iface ->
+                   return [ mkExportDecl t decl (lookupDocs t warnings (instDocMap iface) (instArgMap iface) (instSubMap iface)) ]
+
+        _ -> return []
+
+
+    mkExportDecl :: Name -> LHsDecl Name -> (DocForDecl Name, [(Name, DocForDecl Name)]) -> ExportItem Name
+    mkExportDecl name decl (doc, subs) = decl'
+      where
+        decl' = ExportDecl (restrictTo sub_names (extractDecl name mdl decl)) doc subs' [] fixities False
+        mdl = nameModule name
+        subs' = filter (isExported . fst) subs
+        sub_names = map fst subs'
+        fixities = [ (n, f) | n <- name:sub_names, Just f <- [M.lookup n fixMap] ]
+
+
+    isExported = (`elem` exportedNames)
+
+
+    findDecl :: Name -> ([LHsDecl Name], (DocForDecl Name, [(Name, DocForDecl Name)]))
+    findDecl n
+      | m == thisMod, Just ds <- M.lookup n declMap =
+          (ds, lookupDocs n warnings docMap argMap subMap)
+      | Just iface <- M.lookup m modMap, Just ds <- M.lookup n (ifaceDeclMap iface) =
+          (ds, lookupDocs n warnings (ifaceDocMap iface) (ifaceArgMap iface) (ifaceSubMap iface))
+      | otherwise = ([], (noDocForDecl, []))
+      where
+        m = nameModule n
+
+
+hiDecl :: DynFlags -> Name -> ErrMsgGhc (Maybe (LHsDecl Name))
+hiDecl dflags t = do
+  mayTyThing <- liftGhcToErrMsgGhc $ lookupName t
+  case mayTyThing of
+    Nothing -> do
+      liftErrMsg $ tell ["Warning: Not found in environment: " ++ pretty dflags t]
+      return Nothing
+    Just x -> return (Just (tyThingToLHsDecl x))
+
+
+hiValExportItem :: DynFlags -> Name -> DocForDecl Name -> Bool -> Maybe Fixity -> ErrMsgGhc (ExportItem Name)
+hiValExportItem dflags name doc splice fixity = do
+  mayDecl <- hiDecl dflags name
+  case mayDecl of
+    Nothing -> return (ExportNoDecl name [])
+    Just decl -> return (ExportDecl decl doc [] [] fixities splice)
+  where
+    fixities = case fixity of
+      Just f  -> [(name, f)]
+      Nothing -> []
+
+
+-- | Lookup docs for a declaration from maps.
+lookupDocs :: Name -> WarningMap -> DocMap Name -> ArgMap Name -> SubMap -> (DocForDecl Name, [(Name, DocForDecl Name)])
+lookupDocs n warnings docMap argMap subMap =
+  let lookupArgDoc x = M.findWithDefault M.empty x argMap in
+  let doc = (lookupDoc n, lookupArgDoc n) in
+  let subs = M.findWithDefault [] n subMap in
+  let subDocs = [ (s, (lookupDoc s, lookupArgDoc s)) | s <- subs ] in
+  (doc, subDocs)
+  where
+    lookupDoc name = Documentation (M.lookup name docMap) (M.lookup name warnings)
+
+
+-- | Return all export items produced by an exported module. That is, we're
+-- interested in the exports produced by \"module B\" in such a scenario:
+--
+-- > module A (module B) where
+-- > import B (...) hiding (...)
+--
+-- There are three different cases to consider:
+--
+-- 1) B is hidden, in which case we return all its exports that are in scope in A.
+-- 2) B is visible, but not all its exports are in scope in A, in which case we
+--    only return those that are.
+-- 3) B is visible and all its exports are in scope, in which case we return
+--    a single 'ExportModule' item.
+moduleExports :: Module           -- ^ Module A
+              -> ModuleName       -- ^ The real name of B, the exported module
+              -> DynFlags         -- ^ The flags used when typechecking A
+              -> WarningMap
+              -> GlobalRdrEnv     -- ^ The renaming environment used for A
+              -> [Name]           -- ^ All the exports of A
+              -> [LHsDecl Name]   -- ^ All the declarations in A
+              -> IfaceMap         -- ^ Already created interfaces
+              -> InstIfaceMap     -- ^ Interfaces in other packages
+              -> Maps
+              -> FixMap
+              -> [SrcSpan]        -- ^ Locations of all TH splices
+              -> ErrMsgGhc [ExportItem Name] -- ^ Resulting export items
+moduleExports thisMod expMod dflags warnings gre _exports decls ifaceMap instIfaceMap maps fixMap splices
+  | m == thisMod = fullModuleContents dflags warnings gre maps fixMap splices decls
+  | otherwise =
+    case M.lookup m ifaceMap of
+      Just iface
+        | OptHide `elem` ifaceOptions iface -> return (ifaceExportItems iface)
+        | otherwise -> return [ ExportModule m ]
+
+      Nothing -> -- We have to try to find it in the installed interfaces
+                 -- (external packages).
+        case M.lookup expMod (M.mapKeys moduleName instIfaceMap) of
+          Just iface -> return [ ExportModule (instMod iface) ]
+          Nothing -> do
+            liftErrMsg $
+              tell ["Warning: " ++ pretty dflags thisMod ++ ": Could not find " ++
+                    "documentation for exported module: " ++ pretty dflags expMod]
+            return []
+  where
+    m = mkModule packageId expMod
+    packageId = modulePackageId thisMod
+
+
+-- Note [1]:
+------------
+-- It is unnecessary to document a subordinate by itself at the top level if
+-- any of its parents is also documented. Furthermore, if the subordinate is a
+-- record field or a class method, documenting it under its parent
+-- indicates its special status.
+--
+-- A user might expect that it should show up separately, so we issue a
+-- warning. It's a fine opportunity to also tell the user she might want to
+-- export the subordinate through the parent export item for clarity.
+--
+-- The code removes top-level subordinates also when the parent is exported
+-- through a 'module' export. I think that is fine.
+--
+-- (For more information, see Trac #69)
+
+
+fullModuleContents :: DynFlags -> WarningMap -> GlobalRdrEnv -> Maps -> FixMap -> [SrcSpan]
+                   -> [LHsDecl Name] -> ErrMsgGhc [ExportItem Name]
+fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap) fixMap splices decls =
+  liftM catMaybes $ mapM mkExportItem (expandSig 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 []
+      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 (GenericSig names t)))          xs = foldr (\n acc -> L l (SigD (GenericSig [n] t))          : acc) xs names
+        f x xs = x : xs
+
+    mkExportItem :: LHsDecl Name -> ErrMsgGhc (Maybe (ExportItem Name))
+    mkExportItem (L _ (DocD (DocGroup lev docStr))) = do
+      return . Just . ExportGroup lev "" $ processDocString dflags gre docStr
+    mkExportItem (L _ (DocD (DocCommentNamed _ docStr))) = do
+      return . Just . ExportDoc $ processDocStringParas dflags gre docStr
+    mkExportItem (L l (ValD d))
+      | name:_ <- collectHsBindBinders d, Just [L _ (ValD _)] <- M.lookup name declMap =
+          -- Top-level binding without type signature.
+          let (doc, _) = lookupDocs name warnings docMap argMap subMap in
+          fmap Just (hiValExportItem dflags name doc (l `elem` splices) $ M.lookup name fixMap)
+      | otherwise = return Nothing
+    mkExportItem decl@(L l (InstD d))
+      | Just name <- M.lookup (getInstLoc d) instMap =
+        let (doc, subs) = lookupDocs name warnings docMap argMap subMap in
+        return $ Just (ExportDecl decl doc subs [] (fixities name subs) (l `elem` splices))
+    mkExportItem (L l (TyClD cl@ClassDecl{ tcdLName = L _ name, tcdSigs = sigs })) = do
+      mdef <- liftGhcToErrMsgGhc $ minimalDef name
+      let sig = maybeToList $ fmap (noLoc . MinimalSig . fmap noLoc) mdef
+      expDecl (L l (TyClD cl { tcdSigs = sig ++ sigs })) l name
+    mkExportItem decl@(L l d)
+      | name:_ <- getMainDeclBinder d = expDecl decl l name
+      | otherwise = return Nothing
+
+    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))
+      where (doc, subs) = lookupDocs name warnings docMap argMap subMap
+
+
+-- | Sometimes the declaration we want to export is not the "main" declaration:
+-- it might be an individual record selector or a class method.  In these
+-- cases we have to extract the required declaration (and somehow cobble
+-- together a type signature for it...).
+extractDecl :: Name -> Module -> LHsDecl Name -> LHsDecl Name
+extractDecl name mdl decl
+  | name `elem` getMainDeclBinder (unLoc decl) = decl
+  | otherwise  =
+    case unLoc decl of
+      TyClD d@ClassDecl {} ->
+        let matches = [ sig | sig <- tcdSigs d, name `elem` sigName sig,
+                        isVanillaLSig sig ] -- TODO: document fixity
+        in case matches of
+          [s0] -> let (n, tyvar_names) = (tcdName d, getTyVars d)
+                      L pos sig = extractClassDecl n tyvar_names s0
+                  in L pos (SigD sig)
+          _ -> error "internal: extractDecl (ClassDecl)"
+      TyClD d@DataDecl {} ->
+        let (n, tyvar_names) = (tcdName d, map toTypeNoLoc $ getTyVars d)
+        in SigD <$> extractRecSel name mdl n tyvar_names (dd_cons (tcdDataDefn d))
+      InstD (DataFamInstD DataFamInstDecl { dfid_tycon = L _ n
+                                          , dfid_pats = HsWB { hswb_cts = tys }
+                                          , dfid_defn = defn }) ->
+        SigD <$> extractRecSel name mdl n tys (dd_cons defn)
+      InstD (ClsInstD ClsInstDecl { cid_datafam_insts = insts }) ->
+        let matches = [ d | L _ d <- insts
+                          , L _ ConDecl { con_details = RecCon rec } <- dd_cons (dfid_defn d)
+                          , ConDeclField { cd_fld_name = L _ n } <- rec
+                          , n == name
+                      ]
+        in case matches of
+          [d0] -> extractDecl name mdl (noLoc . InstD $ DataFamInstD d0)
+          _ -> error "internal: extractDecl (ClsInstD)"
+      _ -> error "internal: extractDecl"
+  where
+    getTyVars = hsLTyVarLocNames . tyClDeclTyVars
+
+
+toTypeNoLoc :: Located Name -> LHsType Name
+toTypeNoLoc = noLoc . HsTyVar . unLoc
+
+
+extractClassDecl :: Name -> [Located Name] -> LSig Name -> LSig Name
+extractClassDecl c tvs0 (L pos (TypeSig lname ltype)) = case ltype of
+  L _ (HsForAllTy expl tvs (L _ preds) ty) ->
+    L pos (TypeSig lname (noLoc (HsForAllTy expl tvs (lctxt preds) ty)))
+  _ -> L pos (TypeSig lname (noLoc (HsForAllTy Implicit emptyHsQTvs (lctxt []) ltype)))
+  where
+    lctxt = noLoc . ctxt
+    ctxt preds = nlHsTyConApp c (map toTypeNoLoc tvs0) : preds
+extractClassDecl _ _ _ = error "extractClassDecl: unexpected decl"
+
+
+extractRecSel :: Name -> Module -> Name -> [LHsType Name] -> [LConDecl Name]
+              -> LSig Name
+extractRecSel _ _ _ _ [] = error "extractRecSel: selector not found"
+
+extractRecSel nm mdl t tvs (L _ con : rest) =
+  case con_details con of
+    RecCon fields | (ConDeclField n ty _ : _) <- matching_fields fields ->
+      L (getLoc n) (TypeSig [noLoc nm] (noLoc (HsFunTy data_ty (getBangType ty))))
+    _ -> extractRecSel nm mdl t tvs rest
+ where
+  matching_fields flds = [ f | f@(ConDeclField n _ _) <- flds, unLoc n == nm ]
+  data_ty
+    | ResTyGADT ty <- con_res con = ty
+    | otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar t)) tvs
+
+
+-- | Keep export items with docs.
+pruneExportItems :: [ExportItem Name] -> [ExportItem Name]
+pruneExportItems = filter hasDoc
+  where
+    hasDoc (ExportDecl{expItemMbDoc = (Documentation d _, _)}) = isJust d
+    hasDoc _ = True
+
+
+mkVisibleNames :: Maps -> [ExportItem Name] -> [DocOption] -> [Name]
+mkVisibleNames (_, _, _, _, instMap) exports opts
+  | OptHide `elem` opts = []
+  | otherwise = let ns = concatMap exportName exports
+                in seqList ns `seq` ns
+  where
+    exportName e@ExportDecl {} = name ++ subs
+      where subs = map fst (expItemSubDocs e)
+            name = case unLoc $ expItemDecl e of
+              InstD d -> maybeToList $ M.lookup (getInstLoc d) instMap
+              decl    -> getMainDeclBinder decl
+    exportName ExportNoDecl {} = [] -- we don't count these as visible, since
+                                    -- we don't want links to go to them.
+    exportName _ = []
+
+seqList :: [a] -> ()
+seqList [] = ()
+seqList (x : xs) = x `seq` seqList xs
+
+-- | Find a stand-alone documentation comment by its name.
+findNamedDoc :: String -> [HsDecl Name] -> ErrMsgM (Maybe HsDocString)
+findNamedDoc name = search
+  where
+    search [] = do
+      tell ["Cannot find documentation for: $" ++ name]
+      return Nothing
+    search (DocD (DocCommentNamed name' doc) : rest)
+      | name == name' = return (Just doc)
+      | otherwise = search rest
+    search (_other_decl : rest) = search rest
diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs
new file mode 100644
index 00000000..f1021436
--- /dev/null
+++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs
@@ -0,0 +1,146 @@
+{-# OPTIONS_GHC -Wwarn #-}
+{-# LANGUAGE BangPatterns #-}
+  -----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.Interface.LexParseRn
+-- Copyright   :  (c) Isaac Dupree 2009,
+--                    Mateusz Kowalczyk 2013
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+-----------------------------------------------------------------------------
+module Haddock.Interface.LexParseRn
+  ( processDocString
+  , processDocStringParas
+  , processDocStrings
+  , processModuleHeader
+  ) where
+
+import Control.Applicative
+import Data.IntSet (toList)
+import Data.List
+import Documentation.Haddock.Doc (docConcat)
+import DynFlags (ExtensionFlag(..), languageExtensions)
+import FastString
+import GHC
+import Haddock.Interface.ParseModuleHeader
+import Haddock.Parser
+import Haddock.Types
+import Name
+import Outputable (showPpr)
+import RdrName
+
+processDocStrings :: DynFlags -> GlobalRdrEnv -> [HsDocString] -> Maybe (Doc Name)
+processDocStrings dflags gre strs =
+  case docConcat $ map (processDocStringParas dflags gre) strs of
+    DocEmpty -> Nothing
+    x -> Just x
+
+
+processDocStringParas :: DynFlags -> GlobalRdrEnv -> HsDocString -> Doc Name
+processDocStringParas = process parseParas
+
+
+processDocString :: DynFlags -> GlobalRdrEnv -> HsDocString -> Doc Name
+processDocString = process parseString
+
+process :: (DynFlags -> String -> Doc RdrName)
+        -> DynFlags
+        -> GlobalRdrEnv
+        -> HsDocString
+        -> Doc Name
+process parse dflags gre (HsDocString fs) =
+  rename dflags gre $ parse dflags (unpackFS fs)
+
+
+processModuleHeader :: DynFlags -> GlobalRdrEnv -> SafeHaskellMode -> Maybe LHsDocString
+                    -> ErrMsgM (HaddockModInfo Name, Maybe (Doc Name))
+processModuleHeader dflags gre safety mayStr = do
+  (hmi, doc) <-
+    case mayStr of
+      Nothing -> return failure
+      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' = rename dflags gre doc
+        return (hmi', Just doc')
+
+  let flags :: [ExtensionFlag]
+      -- We remove the flags implied by the language setting and we display the language instead
+      flags = map toEnum (toList $ extensionFlags dflags) \\ languageExtensions (language dflags)
+  return (hmi { hmi_safety = Just $ showPpr dflags safety
+              , hmi_language = language dflags
+              , hmi_extensions = flags
+              } , doc)
+  where
+    failure = (emptyHaddockModInfo, Nothing)
+
+
+rename :: DynFlags -> GlobalRdrEnv -> Doc RdrName -> 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)
+      DocIdentifier x -> do
+        let choices = dataTcOccs' x
+        let names = concatMap (\c -> map gre_name (lookupGRE_RdrName c gre)) choices
+        case names of
+          [] ->
+            case choices of
+              [] -> DocMonospaced (DocString (showPpr dflags x))
+              [a] -> outOfScope dflags a
+              a:b:_ | isRdrTc a -> outOfScope dflags a
+                    | otherwise -> outOfScope dflags b
+          [a] -> DocIdentifier a
+          a:b:_ | isTyConName a -> DocIdentifier a | otherwise -> DocIdentifier b
+              -- If an id can refer to multiple things, we give precedence to type
+              -- constructors.
+
+      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
+      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)
+
+dataTcOccs' :: RdrName -> [RdrName]
+-- If the input is a data constructor, return both it and a type
+-- constructor.  This is useful when we aren't sure which we are
+-- looking at.
+--
+-- We use this definition instead of the GHC's to provide proper linking to
+-- functions accross modules. See ticket #253 on Haddock Trac.
+dataTcOccs' rdr_name
+  | isDataOcc occ             = [rdr_name, rdr_name_tc]
+  | otherwise                 = [rdr_name]
+  where
+    occ = rdrNameOcc rdr_name
+    rdr_name_tc = setRdrNameSpace rdr_name tcName
+
+
+outOfScope :: DynFlags -> RdrName -> Doc a
+outOfScope dflags x =
+  case x of
+    Unqual occ -> monospaced occ
+    Qual mdl occ -> DocIdentifierUnchecked (mdl, occ)
+    Orig _ occ -> monospaced occ
+    Exact name -> monospaced name  -- Shouldn't happen since x is out of scope
+  where
+    monospaced a = DocMonospaced (DocString (showPpr dflags a))
diff --git a/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs b/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs
new file mode 100644
index 00000000..6848dc63
--- /dev/null
+++ b/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs
@@ -0,0 +1,150 @@
+{-# OPTIONS_GHC -Wwarn #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.Interface.ParseModuleHeader
+-- Copyright   :  (c) Simon Marlow 2006, Isaac Dupree 2009
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+-----------------------------------------------------------------------------
+module Haddock.Interface.ParseModuleHeader (parseModuleHeader) where
+
+import Control.Applicative ((<$>))
+import Control.Monad (mplus)
+import Data.Char
+import DynFlags
+import Haddock.Parser
+import Haddock.Types
+import RdrName
+
+-- -----------------------------------------------------------------------------
+-- Parsing module headers
+
+-- NB.  The headers must be given in the order Module, Description,
+-- Copyright, License, Maintainer, Stability, Portability, except that
+-- any or all may be omitted.
+parseModuleHeader :: DynFlags -> String -> (HaddockModInfo RdrName, Doc RdrName)
+parseModuleHeader dflags str0 =
+   let
+      getKey :: String -> String -> (Maybe String,String)
+      getKey key str = case parseKey key str of
+         Nothing -> (Nothing,str)
+         Just (value,rest) -> (Just value,rest)
+
+      (_moduleOpt,str1) = getKey "Module" str0
+      (descriptionOpt,str2) = getKey "Description" str1
+      (copyrightOpt,str3) = getKey "Copyright" str2
+      (licenseOpt,str4) = getKey "License" str3
+      (licenceOpt,str5) = getKey "Licence" str4
+      (maintainerOpt,str6) = getKey "Maintainer" str5
+      (stabilityOpt,str7) = getKey "Stability" str6
+      (portabilityOpt,str8) = getKey "Portability" str7
+
+   in (HaddockModInfo {
+          hmi_description = parseString dflags <$> descriptionOpt,
+          hmi_copyright = copyrightOpt,
+          hmi_license = licenseOpt `mplus` licenceOpt,
+          hmi_maintainer = maintainerOpt,
+          hmi_stability = stabilityOpt,
+          hmi_portability = portabilityOpt,
+          hmi_safety = Nothing,
+          hmi_language = Nothing, -- set in LexParseRn
+          hmi_extensions = [] -- also set in LexParseRn
+          }, parseParas dflags str8)
+
+-- | This function is how we read keys.
+--
+-- all fields in the header are optional and have the form
+--
+-- [spaces1][field name][spaces] ":"
+--    [text]"\n" ([spaces2][space][text]"\n" | [spaces]"\n")*
+-- where each [spaces2] should have [spaces1] as a prefix.
+--
+-- Thus for the key "Description",
+--
+-- > Description : this is a
+-- >    rather long
+-- >
+-- >    description
+-- >
+-- > The module comment starts here
+--
+-- the value will be "this is a .. description" and the rest will begin
+-- at "The module comment".
+parseKey :: String -> String -> Maybe (String,String)
+parseKey key toParse0 =
+   do
+      let
+         (spaces0,toParse1) = extractLeadingSpaces toParse0
+
+         indentation = spaces0
+      afterKey0 <- extractPrefix key toParse1
+      let
+         afterKey1 = extractLeadingSpaces afterKey0
+      afterColon0 <- case snd afterKey1 of
+         ':':afterColon -> return afterColon
+         _ -> Nothing
+      let
+         (_,afterColon1) = extractLeadingSpaces afterColon0
+
+      return (scanKey True indentation afterColon1)
+   where
+      scanKey :: Bool -> String -> String -> (String,String)
+      scanKey _       _           [] = ([],[])
+      scanKey isFirst indentation str =
+         let
+            (nextLine,rest1) = extractNextLine str
+
+            accept = isFirst || sufficientIndentation || allSpaces
+
+            sufficientIndentation = case extractPrefix indentation nextLine of
+               Just (c:_) | isSpace c -> True
+               _ -> False
+
+            allSpaces = case extractLeadingSpaces nextLine of
+               (_,[]) -> True
+               _ -> False
+         in
+            if accept
+               then
+                  let
+                     (scanned1,rest2) = scanKey False indentation rest1
+
+                     scanned2 = case scanned1 of
+                        "" -> if allSpaces then "" else nextLine
+                        _ -> nextLine ++ "\n" ++ scanned1
+                  in
+                     (scanned2,rest2)
+               else
+                  ([],str)
+
+      extractLeadingSpaces :: String -> (String,String)
+      extractLeadingSpaces [] = ([],[])
+      extractLeadingSpaces (s@(c:cs))
+         | isSpace c =
+            let
+               (spaces1,cs1) = extractLeadingSpaces cs
+            in
+               (c:spaces1,cs1)
+         | otherwise = ([],s)
+
+      extractNextLine :: String -> (String,String)
+      extractNextLine [] = ([],[])
+      extractNextLine (c:cs)
+         | c == '\n' =
+            ([],cs)
+         | otherwise =
+            let
+               (line,rest) = extractNextLine cs
+            in
+               (c:line,rest)
+
+      -- comparison is case-insensitive.
+      extractPrefix :: String -> String -> Maybe String
+      extractPrefix [] s = Just s
+      extractPrefix _ [] = Nothing
+      extractPrefix (c1:cs1) (c2:cs2)
+         | toUpper c1 == toUpper c2 = extractPrefix cs1 cs2
+         | otherwise = Nothing
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
new file mode 100644
index 00000000..748e0210
--- /dev/null
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -0,0 +1,506 @@
+----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.Interface.Rename
+-- Copyright   :  (c) Simon Marlow 2003-2006,
+--                    David Waern  2006-2009
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+-----------------------------------------------------------------------------
+module Haddock.Interface.Rename (renameInterface) where
+
+
+import Data.Traversable (traverse)
+
+import Haddock.GhcUtils
+import Haddock.Types
+
+import Bag (emptyBag)
+import GHC hiding (NoLink)
+import Name
+
+import Control.Applicative
+import Control.Monad hiding (mapM)
+import Data.List
+import qualified Data.Map as Map hiding ( Map )
+import Data.Traversable (mapM)
+import Prelude hiding (mapM)
+
+
+renameInterface :: DynFlags -> LinkEnv -> Bool -> Interface -> ErrMsgM Interface
+renameInterface dflags renamingEnv warnings iface =
+
+  -- first create the local env, where every name exported by this module
+  -- is mapped to itself, and everything else comes from the global renaming
+  -- env
+  let localEnv = foldl fn renamingEnv (ifaceVisibleExports iface)
+        where fn env name = Map.insert name (ifaceMod iface) env
+
+      -- rename names in the exported declarations to point to things that
+      -- are closer to, or maybe even exported by, the current module.
+      (renamedExportItems, missingNames1)
+        = runRnFM localEnv (renameExportItems (ifaceExportItems iface))
+
+      (rnDocMap, missingNames2) = runRnFM localEnv (mapM renameDoc (ifaceDocMap iface))
+
+      (rnArgMap, missingNames3) = runRnFM localEnv (mapM (mapM renameDoc) (ifaceArgMap iface))
+
+      (finalModuleDoc, missingNames4)
+        = runRnFM localEnv (renameDocumentation (ifaceDoc iface))
+
+      -- combine the missing names and filter out the built-ins, which would
+      -- otherwise allways be missing.
+      missingNames = nub $ filter isExternalName  -- XXX: isExternalName filters out too much
+                    (missingNames1 ++ missingNames2 ++ missingNames3 ++ missingNames4)
+
+      -- filter out certain built in type constructors using their string
+      -- representation. TODO: use the Name constants from the GHC API.
+--      strings = filter (`notElem` ["()", "[]", "(->)"])
+--                (map pretty missingNames)
+      strings = map (pretty dflags) . filter (\n -> not (isSystemName n || isBuiltInSyntax n)) $ missingNames
+
+  in do
+    -- report things that we couldn't link to. Only do this for non-hidden
+    -- modules.
+    unless (OptHide `elem` ifaceOptions iface || null strings || not warnings) $
+      tell ["Warning: " ++ moduleString (ifaceMod iface) ++
+            ": could not find link destinations for:\n"++
+            unwords ("   " : strings) ]
+
+    return $ iface { ifaceRnDoc         = finalModuleDoc,
+                     ifaceRnDocMap      = rnDocMap,
+                     ifaceRnArgMap      = rnArgMap,
+                     ifaceRnExportItems = renamedExportItems }
+
+
+--------------------------------------------------------------------------------
+-- Monad for renaming
+--
+-- The monad does two things for us: it passes around the environment for
+-- renaming, and it returns a list of names which couldn't be found in
+-- the environment.
+--------------------------------------------------------------------------------
+
+
+newtype RnM a =
+  RnM { unRn :: (Name -> (Bool, DocName))  -- name lookup function
+             -> (a,[Name])
+      }
+
+instance Monad RnM where
+  (>>=) = thenRn
+  return = returnRn
+
+instance Functor RnM where
+  fmap f x = do a <- x; return (f a)
+
+instance Applicative RnM where
+  pure = return
+  (<*>) = ap
+
+returnRn :: a -> RnM a
+returnRn a   = RnM (const (a,[]))
+thenRn :: RnM a -> (a -> RnM b) -> RnM b
+m `thenRn` k = RnM (\lkp -> case unRn m lkp of
+  (a,out1) -> case unRn (k a) lkp of
+    (b,out2) -> (b,out1++out2))
+
+getLookupRn :: RnM (Name -> (Bool, DocName))
+getLookupRn = RnM (\lkp -> (lkp,[]))
+
+outRn :: Name -> RnM ()
+outRn name = RnM (const ((),[name]))
+
+lookupRn :: Name -> RnM DocName
+lookupRn name = do
+  lkp <- getLookupRn
+  case lkp name of
+    (False,maps_to) -> do outRn name; return maps_to
+    (True, maps_to) -> return maps_to
+
+
+runRnFM :: LinkEnv -> RnM a -> (a,[Name])
+runRnFM env rn = unRn rn lkp
+  where
+    lkp n = case Map.lookup n env of
+      Nothing  -> (False, Undocumented n)
+      Just mdl -> (True,  Documented n mdl)
+
+
+--------------------------------------------------------------------------------
+-- Renaming
+--------------------------------------------------------------------------------
+
+
+rename :: Name -> RnM DocName
+rename = lookupRn
+
+
+renameL :: Located Name -> RnM (Located DocName)
+renameL = mapM rename
+
+
+renameExportItems :: [ExportItem Name] -> RnM [ExportItem DocName]
+renameExportItems = mapM renameExportItem
+
+
+renameDocForDecl :: DocForDecl Name -> RnM (DocForDecl DocName)
+renameDocForDecl (doc, fnArgsDoc) =
+  (,) <$> renameDocumentation doc <*> renameFnArgsDoc fnArgsDoc
+
+
+renameDocumentation :: Documentation Name -> RnM (Documentation DocName)
+renameDocumentation (Documentation mDoc mWarning) =
+  Documentation <$> mapM renameDoc mDoc <*> mapM renameDoc mWarning
+
+
+renameLDocHsSyn :: LHsDocString -> RnM LHsDocString
+renameLDocHsSyn = return
+
+
+renameDoc :: Doc Name -> RnM (Doc DocName)
+renameDoc = traverse rename
+
+
+renameFnArgsDoc :: FnArgsDoc Name -> RnM (FnArgsDoc DocName)
+renameFnArgsDoc = mapM renameDoc
+
+
+renameLType :: LHsType Name -> RnM (LHsType DocName)
+renameLType = mapM renameType
+
+renameLKind :: LHsKind Name -> RnM (LHsKind DocName)
+renameLKind = renameLType
+
+renameMaybeLKind :: Maybe (LHsKind Name) -> RnM (Maybe (LHsKind DocName))
+renameMaybeLKind = traverse renameLKind
+
+renameType :: HsType Name -> RnM (HsType DocName)
+renameType t = case t of
+  HsForAllTy expl tyvars lcontext ltype -> do
+    tyvars'   <- renameLTyVarBndrs tyvars
+    lcontext' <- renameLContext lcontext
+    ltype'    <- renameLType ltype
+    return (HsForAllTy expl tyvars' lcontext' ltype')
+
+  HsTyVar n -> return . HsTyVar =<< rename n
+  HsBangTy b ltype -> return . HsBangTy b =<< renameLType ltype
+
+  HsAppTy a b -> do
+    a' <- renameLType a
+    b' <- renameLType b
+    return (HsAppTy a' b')
+
+  HsFunTy a b -> do
+    a' <- renameLType a
+    b' <- renameLType b
+    return (HsFunTy a' b')
+
+  HsListTy ty -> return . HsListTy =<< renameLType ty
+  HsPArrTy ty -> return . HsPArrTy =<< renameLType ty
+  HsIParamTy n ty -> liftM (HsIParamTy n) (renameLType ty)
+  HsEqTy ty1 ty2 -> liftM2 HsEqTy (renameLType ty1) (renameLType ty2)
+
+  HsTupleTy b ts -> return . HsTupleTy b =<< mapM renameLType ts
+
+  HsOpTy a (w, L loc op) b -> do
+    op' <- rename op
+    a'  <- renameLType a
+    b'  <- renameLType b
+    return (HsOpTy a' (w, L loc op') b')
+
+  HsParTy ty -> return . HsParTy =<< renameLType ty
+
+  HsKindSig ty k -> do
+    ty' <- renameLType ty
+    k' <- renameLKind k
+    return (HsKindSig ty' k')
+
+  HsDocTy ty doc -> do
+    ty' <- renameLType ty
+    doc' <- renameLDocHsSyn doc
+    return (HsDocTy ty' doc')
+
+  HsTyLit x -> return (HsTyLit x)
+
+  HsWrapTy a b            -> HsWrapTy a <$> renameType b
+  HsRecTy a               -> HsRecTy <$> mapM renameConDeclFieldField a
+  HsCoreTy a              -> pure (HsCoreTy a)
+  HsExplicitListTy  a b   -> HsExplicitListTy  a <$> mapM renameLType b
+  HsExplicitTupleTy a b   -> HsExplicitTupleTy a <$> mapM renameLType b
+  HsQuasiQuoteTy a        -> HsQuasiQuoteTy <$> renameHsQuasiQuote a
+  HsSpliceTy _ _          -> error "renameType: HsSpliceTy"
+
+renameHsQuasiQuote :: HsQuasiQuote Name -> RnM (HsQuasiQuote DocName)
+renameHsQuasiQuote (HsQuasiQuote a b c) = HsQuasiQuote <$> rename a <*> pure b <*> pure c
+
+renameLTyVarBndrs :: LHsTyVarBndrs Name -> RnM (LHsTyVarBndrs DocName)
+renameLTyVarBndrs (HsQTvs { hsq_kvs = _, hsq_tvs = tvs })
+  = do { tvs' <- mapM renameLTyVarBndr tvs
+       ; return (HsQTvs { hsq_kvs = error "haddock:renameLTyVarBndrs", hsq_tvs = tvs' }) }
+                -- This is rather bogus, but I'm not sure what else to do
+
+renameLTyVarBndr :: LHsTyVarBndr Name -> RnM (LHsTyVarBndr DocName)
+renameLTyVarBndr (L loc (UserTyVar n))
+  = do { n' <- rename n
+       ; return (L loc (UserTyVar n')) }
+renameLTyVarBndr (L loc (KindedTyVar n kind))
+  = do { n' <- rename n
+       ; kind' <- renameLKind kind
+       ; return (L loc (KindedTyVar n' kind')) }
+
+renameLContext :: Located [LHsType Name] -> RnM (Located [LHsType DocName])
+renameLContext (L loc context) = do
+  context' <- mapM renameLType context
+  return (L loc context')
+
+
+renameInstHead :: InstHead Name -> RnM (InstHead DocName)
+renameInstHead (className, k, types, rest) = do
+  className' <- rename className
+  k' <- mapM renameType k
+  types' <- mapM renameType types
+  rest' <- case rest of
+    ClassInst cs -> ClassInst <$> mapM renameType cs
+    TypeInst  ts -> TypeInst  <$> traverse renameType ts
+    DataInst  dd -> DataInst  <$> renameTyClD dd
+  return (className', k', types', rest')
+
+
+renameLDecl :: LHsDecl Name -> RnM (LHsDecl DocName)
+renameLDecl (L loc d) = return . L loc =<< renameDecl d
+
+
+renameDecl :: HsDecl Name -> RnM (HsDecl DocName)
+renameDecl decl = case decl of
+  TyClD d -> do
+    d' <- renameTyClD d
+    return (TyClD d')
+  SigD s -> do
+    s' <- renameSig s
+    return (SigD s')
+  ForD d -> do
+    d' <- renameForD d
+    return (ForD d')
+  InstD d -> do
+    d' <- renameInstD d
+    return (InstD d')
+  _ -> error "renameDecl"
+
+renameLThing :: (a Name -> RnM (a DocName)) -> Located (a Name) -> RnM (Located (a DocName))
+renameLThing fn (L loc x) = return . L loc =<< fn x
+
+renameTyClD :: TyClDecl Name -> RnM (TyClDecl DocName)
+renameTyClD d = case d of
+  ForeignType lname b -> do
+    lname' <- renameL lname
+    return (ForeignType lname' b)
+
+--  TyFamily flav lname ltyvars kind tckind -> do
+  FamDecl { tcdFam = decl } -> do
+    decl' <- renameFamilyDecl decl
+    return (FamDecl { tcdFam = decl' })
+
+  SynDecl { tcdLName = lname, tcdTyVars = tyvars, tcdRhs = rhs, tcdFVs = fvs } -> do
+    lname'    <- renameL lname
+    tyvars'   <- renameLTyVarBndrs tyvars
+    rhs'     <- renameLType rhs
+    return (SynDecl { tcdLName = lname', tcdTyVars = tyvars', tcdRhs = rhs', tcdFVs = fvs })
+
+  DataDecl { tcdLName = lname, tcdTyVars = tyvars, tcdDataDefn = defn, tcdFVs = fvs } -> do
+    lname'    <- renameL lname
+    tyvars'   <- renameLTyVarBndrs tyvars
+    defn'     <- renameDataDefn defn
+    return (DataDecl { tcdLName = lname', tcdTyVars = tyvars', tcdDataDefn = defn', tcdFVs = fvs })
+
+  ClassDecl { tcdCtxt = lcontext, tcdLName = lname, tcdTyVars = ltyvars
+            , tcdFDs = lfundeps, tcdSigs = lsigs, tcdATs = ats, tcdATDefs = at_defs } -> do
+    lcontext' <- renameLContext lcontext
+    lname'    <- renameL lname
+    ltyvars'  <- renameLTyVarBndrs ltyvars
+    lfundeps' <- mapM renameLFunDep lfundeps
+    lsigs'    <- mapM renameLSig lsigs
+    ats'      <- mapM (renameLThing renameFamilyDecl) ats
+    at_defs'  <- mapM (mapM renameTyFamInstD) at_defs
+    -- we don't need the default methods or the already collected doc entities
+    return (ClassDecl { tcdCtxt = lcontext', tcdLName = lname', tcdTyVars = ltyvars'
+                      , tcdFDs = lfundeps', tcdSigs = lsigs', tcdMeths= emptyBag
+                      , tcdATs = ats', tcdATDefs = at_defs', tcdDocs = [], tcdFVs = placeHolderNames })
+
+  where
+    renameLFunDep (L loc (xs, ys)) = do
+      xs' <- mapM rename xs
+      ys' <- mapM rename ys
+      return (L loc (xs', ys'))
+
+    renameLSig (L loc sig) = return . L loc =<< renameSig sig
+
+renameFamilyDecl :: FamilyDecl Name -> RnM (FamilyDecl DocName)
+renameFamilyDecl (FamilyDecl { fdInfo = info, fdLName = lname
+                             , fdTyVars = ltyvars, fdKindSig = tckind }) = do
+    info'    <- renameFamilyInfo info
+    lname'   <- renameL lname
+    ltyvars' <- renameLTyVarBndrs ltyvars
+    tckind'  <- renameMaybeLKind tckind
+    return (FamilyDecl { fdInfo = info', fdLName = lname'
+                       , fdTyVars = ltyvars', fdKindSig = tckind' })
+
+renameFamilyInfo :: FamilyInfo Name -> RnM (FamilyInfo DocName)
+renameFamilyInfo DataFamily     = return DataFamily
+renameFamilyInfo OpenTypeFamily = return OpenTypeFamily
+renameFamilyInfo (ClosedTypeFamily eqns)
+  = do { eqns' <- mapM (renameLThing renameTyFamInstEqn) eqns
+       ; return $ ClosedTypeFamily eqns' }
+
+renameDataDefn :: HsDataDefn Name -> RnM (HsDataDefn DocName)
+renameDataDefn (HsDataDefn { dd_ND = nd, dd_ctxt = lcontext, dd_cType = cType
+                           , dd_kindSig = k, dd_cons = cons }) = do
+    lcontext' <- renameLContext lcontext
+    k'        <- renameMaybeLKind k
+    cons'     <- mapM (mapM renameCon) cons
+    -- I don't think we need the derivings, so we return Nothing
+    return (HsDataDefn { dd_ND = nd, dd_ctxt = lcontext', dd_cType = cType
+                       , dd_kindSig = k', dd_cons = cons', dd_derivs = Nothing })
+
+renameCon :: ConDecl Name -> RnM (ConDecl DocName)
+renameCon decl@(ConDecl { con_name = lname, con_qvars = ltyvars
+                        , con_cxt = lcontext, con_details = details
+                        , con_res = restype, con_doc = mbldoc }) = do
+      lname'    <- renameL lname
+      ltyvars'  <- renameLTyVarBndrs ltyvars
+      lcontext' <- renameLContext lcontext
+      details'  <- renameDetails details
+      restype'  <- renameResType restype
+      mbldoc'   <- mapM renameLDocHsSyn mbldoc
+      return (decl { con_name = lname', con_qvars = ltyvars', con_cxt = lcontext'
+                   , con_details = details', con_res = restype', con_doc = mbldoc' })
+  where
+    renameDetails (RecCon fields) = return . RecCon =<< mapM renameConDeclFieldField fields
+    renameDetails (PrefixCon ps) = return . PrefixCon =<< mapM renameLType ps
+    renameDetails (InfixCon a b) = do
+      a' <- renameLType a
+      b' <- renameLType b
+      return (InfixCon a' b')
+
+    renameResType (ResTyH98) = return ResTyH98
+    renameResType (ResTyGADT t) = return . ResTyGADT =<< renameLType t
+
+
+renameConDeclFieldField :: ConDeclField Name -> RnM (ConDeclField DocName)
+renameConDeclFieldField (ConDeclField name t doc) = do
+  name' <- renameL name
+  t'   <- renameLType t
+  doc' <- mapM renameLDocHsSyn doc
+  return (ConDeclField name' t' doc')
+
+
+renameSig :: Sig Name -> RnM (Sig DocName)
+renameSig sig = case sig of
+  TypeSig lnames ltype -> do
+    lnames' <- mapM renameL lnames
+    ltype' <- renameLType ltype
+    return (TypeSig lnames' ltype')
+  PatSynSig lname args ltype lreq lprov -> do
+    lname' <- renameL lname
+    args' <- case args of
+        PrefixPatSyn largs -> PrefixPatSyn <$> mapM renameLType largs
+        InfixPatSyn lleft lright -> InfixPatSyn <$> renameLType lleft <*> renameLType lright
+    ltype' <- renameLType ltype
+    lreq' <- renameLContext lreq
+    lprov' <- renameLContext lprov
+    return $ PatSynSig lname' args' ltype' lreq' lprov'
+  FixSig (FixitySig lname fixity) -> do
+    lname' <- renameL lname
+    return $ FixSig (FixitySig lname' fixity)
+  MinimalSig s -> MinimalSig <$> traverse renameL s
+  -- we have filtered out all other kinds of signatures in Interface.Create
+  _ -> error "expected TypeSig"
+
+
+renameForD :: ForeignDecl Name -> RnM (ForeignDecl DocName)
+renameForD (ForeignImport lname ltype co x) = do
+  lname' <- renameL lname
+  ltype' <- renameLType ltype
+  return (ForeignImport lname' ltype' co x)
+renameForD (ForeignExport lname ltype co x) = do
+  lname' <- renameL lname
+  ltype' <- renameLType ltype
+  return (ForeignExport lname' ltype' co x)
+
+
+renameInstD :: InstDecl Name -> RnM (InstDecl DocName)
+renameInstD (ClsInstD { cid_inst = d }) = do
+  d' <- renameClsInstD d
+  return (ClsInstD { cid_inst = d' })
+renameInstD (TyFamInstD { tfid_inst = d }) = do
+  d' <- renameTyFamInstD d
+  return (TyFamInstD { tfid_inst = d' })
+renameInstD (DataFamInstD { dfid_inst = d }) = do
+  d' <- renameDataFamInstD d
+  return (DataFamInstD { dfid_inst = d' })
+
+renameClsInstD :: ClsInstDecl Name -> RnM (ClsInstDecl DocName)
+renameClsInstD (ClsInstDecl { cid_poly_ty =ltype, cid_tyfam_insts = lATs, cid_datafam_insts = lADTs }) = do
+  ltype' <- renameLType ltype
+  lATs'  <- mapM (mapM renameTyFamInstD) lATs
+  lADTs' <- mapM (mapM renameDataFamInstD) lADTs
+  return (ClsInstDecl { cid_poly_ty = ltype', cid_binds = emptyBag, cid_sigs = []
+                      , cid_tyfam_insts = lATs', cid_datafam_insts = lADTs' })
+
+
+renameTyFamInstD :: TyFamInstDecl Name -> RnM (TyFamInstDecl DocName)
+renameTyFamInstD (TyFamInstDecl { tfid_eqn = eqn })
+  = do { eqn' <- renameLThing renameTyFamInstEqn eqn
+       ; return (TyFamInstDecl { tfid_eqn = eqn'
+                               , tfid_fvs = placeHolderNames }) }
+
+renameTyFamInstEqn :: TyFamInstEqn Name -> RnM (TyFamInstEqn DocName)
+renameTyFamInstEqn (TyFamInstEqn { tfie_tycon = tc, tfie_pats = pats_w_bndrs, tfie_rhs = rhs })
+  = do { tc' <- renameL tc
+       ; pats' <- mapM renameLType (hswb_cts pats_w_bndrs)
+       ; rhs' <- renameLType rhs
+       ; return (TyFamInstEqn { tfie_tycon = tc', tfie_pats = pats_w_bndrs { hswb_cts = pats' }
+                              , tfie_rhs = rhs' }) }
+
+renameDataFamInstD :: DataFamInstDecl Name -> RnM (DataFamInstDecl DocName)
+renameDataFamInstD (DataFamInstDecl { dfid_tycon = tc, dfid_pats = pats_w_bndrs, dfid_defn = defn })
+  = do { tc' <- renameL tc
+       ; pats' <- mapM renameLType (hswb_cts pats_w_bndrs)
+       ; defn' <- renameDataDefn defn
+       ; return (DataFamInstDecl { dfid_tycon = tc', dfid_pats = pats_w_bndrs { hswb_cts = pats' }
+                                 , dfid_defn = defn', dfid_fvs = placeHolderNames }) }
+
+renameExportItem :: ExportItem Name -> RnM (ExportItem DocName)
+renameExportItem item = case item of
+  ExportModule mdl -> return (ExportModule mdl)
+  ExportGroup lev id_ doc -> do
+    doc' <- renameDoc doc
+    return (ExportGroup lev id_ doc')
+  ExportDecl decl doc subs instances fixities splice -> do
+    decl' <- renameLDecl decl
+    doc'  <- renameDocForDecl doc
+    subs' <- mapM renameSub subs
+    instances' <- forM instances $ \(inst, idoc) -> do
+      inst' <- renameInstHead inst
+      idoc' <- mapM renameDoc idoc
+      return (inst', idoc')
+    fixities' <- forM fixities $ \(name, fixity) -> do
+      name' <- lookupRn name
+      return (name', fixity)
+    return (ExportDecl decl' doc' subs' instances' fixities' splice)
+  ExportNoDecl x subs -> do
+    x'    <- lookupRn x
+    subs' <- mapM lookupRn subs
+    return (ExportNoDecl x' subs')
+  ExportDoc doc -> do
+    doc' <- renameDoc doc
+    return (ExportDoc doc')
+
+
+renameSub :: (Name, DocForDecl Name) -> RnM (DocName, DocForDecl DocName)
+renameSub (n,doc) = do
+  n' <- rename n
+  doc' <- renameDocForDecl doc
+  return (n', doc')