Merge ../../../haddock

Conflicts:
	src/Haddock/InterfaceFile.hs

13 files changed, 383 insertions, 353 deletions

diff --git a/haddock.cabal b/haddock.cabal
index 63ed5cd8..195778e4 100644
--- a/haddock.cabal
+++ b/haddock.cabal
@@ -112,7 +112,6 @@ executable haddock
     Haddock.Interface
     Haddock.Interface.Rename
     Haddock.Interface.Create
-    Haddock.Interface.ExtractFnArgDocs
     Haddock.Interface.AttachInstances
     Haddock.Interface.LexParseRn
     Haddock.Interface.ParseModuleHeader
@@ -178,7 +177,6 @@ library
     Haddock.Interface
     Haddock.Interface.Rename
     Haddock.Interface.Create
-    Haddock.Interface.ExtractFnArgDocs
     Haddock.Interface.AttachInstances
     Haddock.Interface.LexParseRn
     Haddock.Interface.ParseModuleHeader
diff --git a/src/Documentation/Haddock.hs b/src/Documentation/Haddock.hs
index 96198494..052f1044 100644
--- a/src/Documentation/Haddock.hs
+++ b/src/Documentation/Haddock.hs
@@ -22,7 +22,6 @@ module Documentation.Haddock (
   -- * Export items & declarations
   ExportItem(..),
   Decl,
-  DeclInfo,
   DocForDecl,
   FnArgsDoc,
 
diff --git a/src/Haddock/GhcUtils.hs b/src/Haddock/GhcUtils.hs
index 2fb8c8a3..fc04351b 100644
--- a/src/Haddock/GhcUtils.hs
+++ b/src/Haddock/GhcUtils.hs
@@ -20,6 +20,7 @@ import Data.Version
 import Control.Applicative  ( (<$>) )
 import Control.Arrow
 import Data.Foldable hiding (concatMap)
+import Data.Function
 import Data.Traversable
 import Distribution.Compat.ReadP
 import Distribution.Text
@@ -77,7 +78,7 @@ isVarSym = isLexVarSym . occNameFS
 
 
 getMainDeclBinder :: HsDecl name -> [name]
-getMainDeclBinder (TyClD d) = [tcdName d]
+getMainDeclBinder (TyClD d) | not (isFamInstDecl d) = [tcdName d]
 getMainDeclBinder (ValD d) =
   case collectHsBindBinders d of
     []       -> []
@@ -141,6 +142,11 @@ isInstD (TyClD d) = isFamInstDecl d
 isInstD _ = False
 
 
+isValD :: HsDecl a -> Bool
+isValD (ValD _) = True
+isValD _ = False
+
+
 declATs :: HsDecl a -> [a]
 declATs (TyClD d) | isClassDecl d = map (tcdName . unL) $ tcdATs d
 declATs _ = []
@@ -167,6 +173,10 @@ reL :: a -> Located a
 reL = L undefined
 
 
+before :: Located a -> Located a -> Bool
+before = (<) `on` getLoc
+
+
 instance Foldable (GenLocated l) where
   foldMap f (L _ x) = f x
 
@@ -253,7 +263,7 @@ modifySessionDynFlags f = do
 -- | A variant of 'gbracket' where the return value from the first computation
 -- is not required.
 gbracket_ :: ExceptionMonad m => m a -> m b -> m c -> m c
-gbracket_ before after thing = gbracket before (const after) (const thing)
+gbracket_ before_ after thing = gbracket before_ (const after) (const thing)
 
 
 -------------------------------------------------------------------------------
diff --git a/src/Haddock/Interface/AttachInstances.hs b/src/Haddock/Interface/AttachInstances.hs
index 5b7771ec..c012f2e0 100644
--- a/src/Haddock/Interface/AttachInstances.hs
+++ b/src/Haddock/Interface/AttachInstances.hs
@@ -73,20 +73,17 @@ lookupInstDoc :: Name -> Interface -> IfaceMap -> InstIfaceMap -> Maybe (Doc Nam
 -- TODO: capture this pattern in a function (when we have streamlined the
 -- handling of instances)
 lookupInstDoc name iface ifaceMap instIfaceMap =
-  case Map.lookup name (ifaceInstanceDocMap iface) of
+  case Map.lookup name (ifaceDocMap iface) of
     Just doc -> Just doc
     Nothing ->
       case Map.lookup modName ifaceMap of
         Just iface2 ->
-          case Map.lookup name (ifaceInstanceDocMap iface2) of
+          case Map.lookup name (ifaceDocMap iface2) of
             Just doc -> Just doc
             Nothing -> Nothing
         Nothing ->
           case Map.lookup modName instIfaceMap of
-            Just instIface ->
-              case Map.lookup name (instDocMap instIface) of
-                Just (doc, _) -> doc
-                Nothing -> Nothing
+            Just instIface -> Map.lookup name (instDocMap instIface)
             Nothing -> Nothing
   where
     modName = nameModule name
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index 155cd938..a9f6c2ed 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TupleSections #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Haddock.Interface.Create
@@ -18,13 +19,15 @@ import Haddock.GhcUtils
 import Haddock.Utils
 import Haddock.Convert
 import Haddock.Interface.LexParseRn
-import Haddock.Interface.ExtractFnArgDocs
 
 import qualified Data.Map as Map
+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.Monad
 import qualified Data.Traversable as Traversable
 
@@ -61,22 +64,20 @@ createInterface tm flags modMap instIfaceMap = do
         | otherwise = opts0
 
   (info, mbDoc)    <- liftErrMsg $ lexParseRnHaddockModHeader dflags gre optDocHeader
-  decls0           <- liftErrMsg $ declInfos dflags gre (topDecls group_)
 
-  let localInsts     = filter (nameIsLocalOrFrom mdl . getName) instances
-      declDocs       = [ (decl, doc) | (L _ decl, (Just doc, _), _) <- decls0 ]
-      instanceDocMap = mkInstanceDocMap localInsts declDocs
+  let declsWithDocs = topDecls group_
+      (decls, _) = unzip declsWithDocs
+      localInsts = filter (nameIsLocalOrFrom mdl . getName) instances
+  (docMap, argMap, subMap, declMap) <- liftErrMsg $ maps dflags gre localInsts exportedNames declsWithDocs
 
-      decls         = filterOutInstances decls0
-      declMap       = mkDeclMap decls
-      exports0      = fmap (reverse . map unLoc) optExports
-      exports
+  let  exports0      = fmap (reverse . map unLoc) optExports
+       exports
         | OptIgnoreExports `elem` opts = Nothing
         | otherwise = exports0
 
-  liftErrMsg $ warnAboutFilteredDecls mdl decls0
+  liftErrMsg $ warnAboutFilteredDecls mdl decls
 
-  exportItems <- mkExportItems modMap mdl gre exportedNames decls declMap
+  exportItems <- mkExportItems modMap mdl gre exportedNames decls docMap argMap subMap declMap
                                exports instances instIfaceMap dflags
 
   let visibleNames = mkVisibleNames exportItems opts
@@ -102,15 +103,17 @@ createInterface tm flags modMap instIfaceMap = do
     ifaceDoc             = mbDoc,
     ifaceRnDoc           = Nothing,
     ifaceOptions         = opts,
+    ifaceDocMap          = docMap,
+    ifaceArgMap          = argMap,
     ifaceRnDocMap        = Map.empty,
+    ifaceRnArgMap        = Map.empty,
     ifaceExportItems     = prunedExportItems,
     ifaceRnExportItems   = [],
     ifaceExports         = exportedNames,
     ifaceVisibleExports  = visibleNames,
     ifaceDeclMap         = declMap,
-    ifaceSubMap          = mkSubMap declMap exportedNames,
+    ifaceSubMap          = subMap,
     ifaceInstances       = instances,
-    ifaceInstanceDocMap  = instanceDocMap,
     ifaceHaddockCoverage = coverage
   }
 
@@ -147,94 +150,68 @@ parseOption other = tell ["Unrecognised option: " ++ other] >> return Nothing
 --------------------------------------------------------------------------------
 
 
-mkInstanceDocMap :: [Instance] -> [(HsDecl name, doc)] -> Map Name doc
-mkInstanceDocMap instances decls =
-  -- We relate Instances 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 Instances) to comments (associated
-  -- with InstDecls).
-  let docMap = Map.fromList [ (loc, doc)
-                            | (InstD (InstDecl (L loc _) _ _ _), doc) <- decls ]
+type Maps = (DocMap Name, ArgMap Name, SubMap, DeclMap)
 
-  in Map.fromList [ (name, doc) | inst <- instances
-                  , let name = getName inst
-                  , Just doc <- [ Map.lookup (getSrcSpan name) docMap ] ]
 
-
--- | Make a sub map from a declaration map. Make sure we only include exported
--- names.
-mkSubMap :: Map Name DeclInfo -> [Name] -> Map Name [Name]
-mkSubMap declMap exports =
-  Map.filterWithKey (\k _ -> k `elem` exports) (Map.map filterSubs declMap)
-  where
-    filterSubs (_, _, subs) = [ sub  | (sub, _) <- subs, sub `elem` exports ]
-
-
--- Make a map from names to 'DeclInfo's. Exclude declarations that don't have
--- names (e.g. instances and stand-alone documentation comments). Include
--- subordinate names, but map them to their parent declarations.
-mkDeclMap :: [DeclInfo] -> Map Name DeclInfo
-mkDeclMap decls = Map.fromList . concat $
-  [ decls_ ++ subDecls
-  | (parent@(L _ d), doc, subs) <- decls
-  , let decls_ = [ (name, (parent, doc, subs)) | name <- getMainDeclBinder d ]
-        subDecls = [ (n, (parent, doc', [])) | (n, doc') <- subs ]
-  , not (isDocD d), not (isInstD d) ]
-
-
-declInfos :: DynFlags -> GlobalRdrEnv -> [(Decl, MaybeDocStrings)] -> ErrMsgM [DeclInfo]
-declInfos dflags gre decls =
-  forM decls $ \(parent@(L _ d), mbDocString) -> do
-            mbDoc <- lexParseRnHaddockCommentList dflags NormalHaddockComment
-                       gre mbDocString
-            fnArgsDoc <- fmap (Map.mapMaybe id) $
-                Traversable.forM (getDeclFnArgDocs d) $
-                \doc -> lexParseRnHaddockComment dflags NormalHaddockComment gre doc
-
-            let subs_ = subordinates d
-            subs <- forM subs_ $ \(subName, mbSubDocStr, subFnArgsDocStr) -> do
-                mbSubDoc <- lexParseRnHaddockCommentList dflags NormalHaddockComment
-                              gre mbSubDocStr
-                subFnArgsDoc <- fmap (Map.mapMaybe id) $
-                  Traversable.forM subFnArgsDocStr $
-                  \doc -> lexParseRnHaddockComment dflags NormalHaddockComment gre doc
-                return (subName, (mbSubDoc, subFnArgsDoc))
-
-            return (parent, (mbDoc, fnArgsDoc), subs)
-
-
--- | If you know the HsDecl can't contain any docs
--- (e.g., it was loaded from a .hi file and you don't have a .haddock file
--- to help you find out about the subs or docs)
--- then you can use this to get its subs.
-subordinatesWithNoDocs :: HsDecl Name -> [(Name, DocForDecl Name)]
-subordinatesWithNoDocs decl = map noDocs (subordinates decl)
+maps :: DynFlags -> GlobalRdrEnv -> [Instance] -> [Name] -> [(Decl, MaybeDocStrings)] -> ErrMsgM Maps
+maps dflags gre instances exports decls = do
+  maps_ <- mapM f decls
+  let mergeMaps (a,b,c,d) (x,y,z,w) =
+        (M.unionWith mappend a x, M.unionWith mappend b y,
+         M.unionWith mappend c z, M.unionWith mappend d w)
+  let emptyMaps = (M.empty, M.empty, M.empty, M.empty)
+  return (foldl' mergeMaps emptyMaps maps_)
   where
-    -- check the condition... or shouldn't we be checking?
-    noDocs (n, doc1, doc2) | null doc1, Map.null doc2
-        = (n, noDocForDecl)
-    noDocs _ = error ("no-docs thing has docs! " ++ pretty decl)
+    instanceMap = M.fromList [ (getSrcSpan n, n) | i <- instances, let n = getName i ]
 
+    f :: (Decl, MaybeDocStrings) -> ErrMsgM Maps
+    f (decl@(L _ d), docs) = do
+      mayDoc <- lexParseRnHaddockCommentList dflags NormalHaddockComment gre docs
+      argDocs <- fmap (Map.mapMaybe id) $ Traversable.forM (typeDocs d) $
+          \doc -> lexParseRnHaddockComment dflags NormalHaddockComment gre doc
 
-subordinates :: HsDecl Name -> [(Name, MaybeDocStrings, Map Int HsDocString)]
-subordinates (TyClD d) = classDataSubs d
-subordinates _ = []
+      let subs_ = subordinates d
+      let subs_' = filter (\(name, _, _) -> name `elem` exports) subs_
+
+      (subDocs, subArgMap) <- unzip <$> (forM subs_' $ \(name, mbSubDocStr, subFnArgsDocStr) -> do
+        mbSubDoc <- lexParseRnHaddockCommentList dflags NormalHaddockComment gre mbSubDocStr
+        subFnArgsDoc <- fmap (Map.mapMaybe id) $ Traversable.forM subFnArgsDocStr $
+          \doc -> lexParseRnHaddockComment dflags NormalHaddockComment gre doc
+        return ((name, mbSubDoc), (name, subFnArgsDoc)))
+
+      let subNames = map fst subDocs
+
+      let names = case d of
+            InstD (InstDecl (L l _) _ _ _) -> maybeToList (M.lookup l instanceMap)  -- See note [2].
+            _ -> filter (`elem` exports) (getMainDeclBinder d)
+
+      let docMap' = M.fromList (mapMaybe (\(n,doc) -> fmap (n,) doc) ([ (n, mayDoc) | n <- names ] ++ subDocs))
+      let argMap' = M.fromList [ (n, argDocs) | n <- names ] `mappend` M.fromList subArgMap
+      let subMap' = M.fromList [ (n, subNames) | n <- names ]
+      let dclMap' = M.fromList [ (n, [decl]) | n <- names ++ subNames ]
+      return (docMap', argMap', subMap', dclMap')
 
 
-classDataSubs :: TyClDecl Name -> [(Name, MaybeDocStrings, Map Int HsDocString)]
-classDataSubs decl
+-- Note [2]:
+------------
+-- We relate Instances 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 Instances) to comments (associated
+-- with InstDecls).
+
+
+subordinates :: HsDecl Name -> [(Name, MaybeDocStrings, Map Int HsDocString)]
+subordinates (TyClD decl)
   | isClassDecl decl = classSubs
   | isDataDecl  decl = dataSubs
-  | otherwise        = []
   where
-    classSubs = [ (name, doc, fnArgsDoc)
-                | (L _ d, doc) <- classDecls decl
-                , name <- getMainDeclBinder d
-                , let fnArgsDoc = getDeclFnArgDocs d ]
-    dataSubs  = constrs ++ fields
+    classSubs = [ (name, doc, typeDocs d) | (L _ d, doc) <- classDecls decl
+                , name <- getMainDeclBinder d, not (isValD d)
+                ]
+    dataSubs = constrs ++ fields
       where
-        cons    = map unL $ tcdCons decl
+        cons = map unL $ tcdCons decl
         -- should we use the type-signature of the constructor
         -- and the docs of the fields to produce fnArgsDoc for the constr,
         -- just in case someone exports it without exporting the type
@@ -244,48 +221,62 @@ classDataSubs decl
         fields  = [ (unL n, maybeToList $ fmap unL doc, Map.empty)
                   | RecCon flds <- map con_details cons
                   , ConDeclField n _ doc <- flds ]
+subordinates _ = []
 
 
--- All the sub declarations of a class (that we handle), ordered by
--- source location, with documentation attached if it exists.
-classDecls :: TyClDecl Name -> [(Decl, MaybeDocStrings)]
-classDecls = filterDecls . collectDocs . sortByLoc . declsFromClass
+-- | 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)
+    ForD (ForeignImport _ ty _ _) -> docs (unLoc ty)
+    TyClD (TySynonym {tcdSynRhs = ty}) -> docs (unLoc ty)
+    _ -> Map.empty
+  where
+    go n (HsForAllTy _ _ _ ty) = go n (unLoc ty)
+    go n (HsFunTy (L _ (HsDocTy _ (L _ x))) (L _ ty)) = Map.insert n x $ go (n+1) ty
+    go n (HsFunTy _ ty) = go (n+1) (unLoc ty)
+    go n (HsDocTy _ (L _ doc)) = Map.singleton n doc
+    go _ _ = Map.empty
 
 
-declsFromClass :: TyClDecl a -> [Located (HsDecl a)]
-declsFromClass class_ = docs ++ defs ++ sigs ++ ats
+-- | All the sub declarations of a class (that we handle), ordered by
+-- source location, with documentation attached if it exists.
+classDecls :: TyClDecl Name -> [(Decl, MaybeDocStrings)]
+classDecls class_ = filterDecls . collectDocs . sortByLoc $ decls
   where
-    docs = mkDecls tcdDocs DocD class_
-    defs = mkDecls (bagToList . tcdMeths) ValD class_
-    sigs = mkDecls tcdSigs SigD class_
-    ats  = mkDecls tcdATs TyClD class_
+    decls = docs ++ defs ++ sigs ++ ats
+    docs  = mkDecls tcdDocs DocD class_
+    defs  = mkDecls (bagToList . tcdMeths) ValD class_
+    sigs  = mkDecls tcdSigs SigD class_
+    ats   = mkDecls tcdATs TyClD 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 -> [(Decl, MaybeDocStrings)]
-topDecls = filterClasses . filterDecls . collectDocs . sortByLoc . declsFromGroup
-
-
-filterOutInstances :: [(Located (HsDecl a), b, c)] -> [(Located (HsDecl a), b, c)]
-filterOutInstances = filter (\(L _ d, _, _) -> not (isInstD d))
-
-
--- | Take all declarations except pragmas, infix decls, rules and value
--- bindings from an 'HsGroup'.
-declsFromGroup :: HsGroup Name -> [Decl]
-declsFromGroup group_ =
-  mkDecls (concat . 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_
+topDecls = filterClasses . filterDecls . collectDocs . sortByLoc . ungroup
+
+
+-- | Take all declarations except pragmas, infix decls, rules from an 'HsGroup'.
+ungroup :: HsGroup Name -> [Decl]
+ungroup group_ =
+  mkDecls (concat   . 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_ ++
+  mkDecls (valbinds . hs_valds)  ValD   group_
   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
@@ -298,11 +289,11 @@ sortByLoc :: [Located a] -> [Located a]
 sortByLoc = sortBy (comparing getLoc)
 
 
-warnAboutFilteredDecls :: Module -> [(LHsDecl Name, b, c)] -> ErrMsgM ()
+warnAboutFilteredDecls :: Module -> [LHsDecl Name] -> ErrMsgM ()
 warnAboutFilteredDecls mdl decls = do
   let modStr = moduleString mdl
   let typeInstances =
-        nub [ tcdName d | (L _ (TyClD d), _, _) <- decls, isFamInstDecl d ]
+        nub [ tcdName d | L _ (TyClD d) <- decls, isFamInstDecl d ]
 
   unless (null typeInstances) $
     tell [
@@ -311,7 +302,7 @@ warnAboutFilteredDecls mdl decls = do
       ++ "will be filtered out:\n  " ++ concat (intersperse ", "
       $ map (occNameString . nameOccName) typeInstances) ]
 
-  let instances = nub [ pretty i | (L _ (InstD (InstDecl i _ _ ats)), _, _) <- decls
+  let instances = nub [ pretty i | L _ (InstD (InstDecl i _ _ ats)) <- decls
                                  , not (null ats) ]
 
   unless (null instances) $
@@ -335,6 +326,7 @@ filterDecls decls = filter (isHandled . unL . fst) decls
     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
@@ -432,19 +424,24 @@ mkExportItems
   -> Module             -- this module
   -> GlobalRdrEnv
   -> [Name]             -- exported names (orig)
-  -> [DeclInfo]
-  -> Map Name DeclInfo  -- maps local names to declarations
+  -> [LHsDecl Name]
+  -> DocMap Name
+  -> ArgMap Name
+  -> SubMap
+  -> DeclMap  -- maps local names to declarations
   -> Maybe [IE Name]
   -> [Instance]
   -> InstIfaceMap
   -> DynFlags
   -> ErrMsgGhc [ExportItem Name]
-mkExportItems modMap thisMod gre exportedNames decls declMap
+mkExportItems modMap thisMod gre exportedNames decls0 docMap argMap subMap declMap
               optExports _ instIfaceMap dflags =
   case optExports of
-    Nothing      -> liftErrMsg $ fullContentsOfThisModule dflags gre decls
+    Nothing      -> liftErrMsg $ fullContentsOfThisModule dflags gre docMap argMap subMap decls
     Just exports -> liftM (nubBy commaDeclared . concat) $ mapM lookupExport exports
   where
+    decls = filter (\(L _ d) -> not (isInstD d || isValD d)) decls0
+
     -- A type signature can have multiple names, like:
     --   foo, bar :: Types..
     -- When going throug the exported names we have to take care to detect such
@@ -459,7 +456,7 @@ mkExportItems modMap thisMod gre exportedNames decls declMap
     lookupExport (IEThingAll t)        = declWith t
     lookupExport (IEThingWith t _)     = declWith t
     lookupExport (IEModuleContents m)  =
-      moduleExports thisMod m dflags gre exportedNames decls modMap instIfaceMap
+      moduleExports thisMod m dflags gre exportedNames decls modMap instIfaceMap docMap argMap subMap
     lookupExport (IEGroup lev docStr)  = liftErrMsg $
       ifDoc (lexParseRnHaddockComment dflags DocSectionComment gre docStr)
             (\doc -> return [ ExportGroup lev "" doc ])
@@ -467,7 +464,7 @@ mkExportItems modMap thisMod gre exportedNames decls declMap
       ifDoc (lexParseRnHaddockComment dflags NormalHaddockComment gre docStr)
             (\doc -> return [ ExportDoc doc ])
     lookupExport (IEDocNamed str)      = liftErrMsg $
-      ifDoc (findNamedDoc str [ unL d | (d,_,_) <- decls ])
+      ifDoc (findNamedDoc str [ unL d | d <- decls ])
             (\docStr ->
             ifDoc (lexParseRnHaddockComment dflags NormalHaddockComment gre docStr)
                   (\doc -> return [ ExportDoc doc ]))
@@ -481,8 +478,16 @@ mkExportItems modMap thisMod gre exportedNames decls declMap
 
     declWith :: Name -> ErrMsgGhc [ ExportItem Name ]
     declWith t =
+      let doc = (Map.lookup t docMap, maybe Map.empty id (Map.lookup t argMap)) in
       case findDecl t of
-        Just (decl, doc, subs) ->
+        [L _ (ValD _)] -> do
+          -- Top-level binding without type signature
+          mayDecl <- ifaceDecl t
+          case mayDecl of
+            Nothing -> return [ ExportNoDecl t [] ]
+            Just decl -> return [ ExportDecl decl doc [] [] ]
+
+        ds | decl : _ <- filter (not . isValD . unLoc) ds ->
           let declNames = getMainDeclBinder (unL decl)
           in case () of
             _
@@ -504,7 +509,7 @@ mkExportItems modMap thisMod gre exportedNames decls declMap
                    return []
 
               -- normal case
-              | otherwise -> return [ mkExportDecl t (newDecl, doc, subs) ]
+              | otherwise -> return [ mkExportDecl t newDecl (exportDecl t newDecl docMap argMap subMap) ]
                   where
                     -- Since a single signature might refer to many names, we
                     -- need to filter the ones that are actually exported. This
@@ -516,118 +521,29 @@ mkExportItems modMap thisMod gre exportedNames decls declMap
                         -- fromJust is safe since we already checked in guards
                         -- that 't' is a name declared in this declaration.
                       _                  -> decl
-        Nothing -> do
-          -- If we can't find the declaration, it must belong to
-          -- another package
-          mbTyThing <- liftGhcToErrMsgGhc $ lookupName t
-          -- show the name as exported as well as the name's
-          -- defining module (because the latter is where we
-          -- looked for the .hi/.haddock).  It's to help people
-          -- debugging after all, so good to show more info.
-          let exportInfoString =
-                         moduleString thisMod ++ "." ++ getOccString t
-                      ++ ": "
-                      ++ pretty (nameModule t) ++ "." ++ getOccString t
-
-          case mbTyThing of
-            Nothing -> do
-              liftErrMsg $ tell
-                 ["Warning: Couldn't find TyThing for exported "
-                 ++ exportInfoString ++ "; not documenting."]
-              -- Is getting to here a bug in Haddock?
-              -- Aren't the .hi files always present?
-              return [ ExportNoDecl t [] ]
-            Just tyThing -> do
-              let hsdecl = tyThingToLHsDecl tyThing
-              -- This is not the ideal way to implement haddockumentation
-              -- for functions/values without explicit type signatures.
-              --
-              -- However I didn't find an easy way to implement it properly,
-              -- and as long as we're using lookupName it is going to find
-              -- the types of local inferenced binds.  If we don't check for
-              -- this at all, then we'll get the "warning: couldn't find
-              -- .haddock" which is wrong.
-              --
-              -- The reason this is not an ideal implementation
-              -- (besides that we take a trip to desugared syntax and back
-              -- unnecessarily)
-              -- is that Haddock won't be able to detect doc-strings being
-              -- attached to such a function, such as,
-              --
-              -- > -- | this is an identity function
-              -- > id a = a
-              --
-              -- . It's more difficult to say what it ought to mean in cases
-              -- where multiple exports are bound at once, like
-              --
-              -- > -- | comment...
-              -- > (a, b) = ...
-              --
-              -- especially since in the export-list they might not even
-              -- be next to each other.  But a proper implementation would
-              -- really need to find the type of *all* exports as well as
-              -- addressing all these issues.  This implementation works
-              -- adequately.  Do you see a way to improve the situation?
-              -- Please go ahead!  I got stuck trying to figure out how to
-              -- get the 'PostTcType's that we want for all the bindings
-              -- of an HsBind (you get 'LHsBinds' from 'GHC.typecheckedSource'
-              -- for example).
-              --
-              -- But I might be missing something obvious.  What's important
-              -- /here/ is that we behave reasonably when we run into one of
-              -- those exported type-inferenced values.
-              isLocalAndTypeInferenced <- liftGhcToErrMsgGhc $ do
-                    let mdl = nameModule t
-                    if modulePackageId mdl == thisPackage dflags then
-                      isLoaded (moduleName mdl)
-                    else return False
-
-              if isLocalAndTypeInferenced then do
-                -- I don't think there can be any subs in this case,
-                -- currently?  But better not to rely on it.
-                let subs = subordinatesWithNoDocs (unLoc hsdecl)
-                return [ mkExportDecl t (hsdecl, noDocForDecl, subs) ]
-              else
-                -- We try to get the subs and docs
-                -- from the installed interface of that package.
-                case Map.lookup (nameModule t) instIfaceMap of
-                  -- It's Nothing in the cases where I thought
-                  -- Haddock has already warned the user: "Warning: The
-                  -- documentation for the following packages are not
-                  -- installed. No links will be generated to these packages:
-                  -- ..."
-                  -- But I guess it was Cabal creating that warning. Anyway,
-                  -- this is more serious than links: it's exported decls where
-                  -- we don't have the docs that they deserve!
-
-                  -- We could use 'subordinates' to find the Names of the subs
-                  -- (with no docs). Is that necessary? Yes it is, otherwise
-                  -- e.g. classes will be shown without their exported subs.
-                  Nothing -> do
-                     liftErrMsg $ tell
-                        ["Warning: Couldn't find .haddock for exported "
-                        ++ exportInfoString]
-                     let subs = subordinatesWithNoDocs (unLoc hsdecl)
-                     return [ mkExportDecl t (hsdecl, noDocForDecl, subs) ]
-                  Just iface -> do
-                     let subs = case Map.lookup t (instSubMap iface) of
-                             Nothing -> []
-                             Just x -> x
-                     return [ mkExportDecl t
-                       ( hsdecl
-                       , fromMaybe noDocForDecl $
-                            Map.lookup t (instDocMap iface)
-                       , map (\subt ->
-                                ( subt ,
-                                  fromMaybe noDocForDecl $
-                                     Map.lookup subt (instDocMap iface)
-                                )
-                             ) subs
-                       )]
-
-
-    mkExportDecl :: Name -> DeclInfo -> ExportItem Name
-    mkExportDecl n (decl, doc, subs) = decl'
+
+        -- Declaration from another package
+        [] -> do
+          mayDecl <- ifaceDecl t
+          case mayDecl of
+            Nothing -> return [ ExportNoDecl t [] ]
+            Just decl -> do
+              -- We try to get the subs and docs
+              -- from the installed .haddock file for that package.
+              case Map.lookup (nameModule t) instIfaceMap of
+                Nothing -> do
+                   liftErrMsg $ tell
+                      ["Warning: Couldn't find .haddock for export " ++ pretty t]
+                   let subs = [ (n, noDocForDecl) | (n, _, _) <- subordinates (unLoc decl) ]
+                   return [ mkExportDecl t decl (noDocForDecl, subs) ]
+                Just iface -> do
+                   return [ mkExportDecl t decl (exportDecl t decl (instDocMap iface) (instArgMap iface) (instSubMap iface)) ]
+
+        _ -> return []
+
+
+    mkExportDecl :: Name -> Decl -> (DocForDecl Name, [(Name, DocForDecl Name)]) -> ExportItem Name
+    mkExportDecl n decl (doc, subs) = decl'
       where
         decl' = ExportDecl (restrictTo sub_names (extractDecl n mdl decl)) doc subs' []
         mdl = nameModule n
@@ -638,16 +554,34 @@ mkExportItems modMap thisMod gre exportedNames decls declMap
     isExported = (`elem` exportedNames)
 
 
-    findDecl :: Name -> Maybe DeclInfo
+    findDecl :: Name -> [Decl]
     findDecl n
-      | m == thisMod = Map.lookup n declMap
+      | m == thisMod = maybe [] id (Map.lookup n declMap)
       | otherwise = case Map.lookup m modMap of
-                      Just iface -> Map.lookup n (ifaceDeclMap iface)
-                      Nothing -> Nothing
+                      Just iface -> maybe [] id (Map.lookup n (ifaceDeclMap iface))
+                      Nothing -> []
       where
         m = nameModule n
 
 
+ifaceDecl :: Name -> ErrMsgGhc (Maybe (LHsDecl Name))
+ifaceDecl t = do
+  mayTyThing <- liftGhcToErrMsgGhc $ lookupName t
+  case mayTyThing of
+    Nothing -> do
+      liftErrMsg $ tell ["Warning: Not found in environment: " ++ pretty t]
+      return Nothing
+    Just x -> return (Just (tyThingToLHsDecl x))
+
+
+exportDecl :: Name -> Decl -> DocMap Name -> ArgMap Name -> SubMap -> (DocForDecl Name, [(Name, DocForDecl Name)])
+exportDecl name _ docMap argMap subMap =
+  let lookupArgMap x = maybe M.empty id (M.lookup x argMap) in
+  let doc = (M.lookup name docMap, lookupArgMap name) in
+  let subs = [ (sub, (M.lookup sub docMap, lookupArgMap sub)) | sub <- maybe [] id (M.lookup name subMap) ] in
+  (doc, subs)
+
+
 -- | 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:
 --
@@ -666,12 +600,15 @@ moduleExports :: Module           -- ^ Module A
               -> DynFlags         -- ^ The flag used when typechecking A
               -> GlobalRdrEnv     -- ^ The renaming environment used for A
               -> [Name]           -- ^ All the exports of A
-              -> [DeclInfo]       -- ^ All the declarations in A
+              -> [Decl]       -- ^ All the declarations in A
               -> IfaceMap         -- ^ Already created interfaces
               -> InstIfaceMap     -- ^ Interfaces in other packages
+              -> DocMap Name
+              -> ArgMap Name
+              -> SubMap
               -> ErrMsgGhc [ExportItem Name] -- ^ Resulting export items
-moduleExports thisMod expMod dflags gre _exports decls ifaceMap instIfaceMap
-  | m == thisMod = liftErrMsg $ fullContentsOfThisModule dflags gre decls
+moduleExports thisMod expMod dflags gre _exports decls ifaceMap instIfaceMap docMap argMap subMap
+  | m == thisMod = liftErrMsg $ fullContentsOfThisModule dflags gre docMap argMap subMap decls
   | otherwise =
     case Map.lookup m ifaceMap of
       Just iface
@@ -709,17 +646,20 @@ moduleExports thisMod expMod dflags gre _exports decls ifaceMap instIfaceMap
 -- (For more information, see Trac #69)
 
 
-fullContentsOfThisModule :: DynFlags -> GlobalRdrEnv -> [DeclInfo] -> ErrMsgM [ExportItem Name]
-fullContentsOfThisModule dflags gre decls = liftM catMaybes $ mapM mkExportItem decls
+fullContentsOfThisModule :: DynFlags -> GlobalRdrEnv -> DocMap Name -> ArgMap Name -> SubMap -> [Decl] -> ErrMsgM [ExportItem Name]
+fullContentsOfThisModule dflags gre docMap argMap subMap decls = liftM catMaybes $ mapM mkExportItem decls
   where
-    mkExportItem (L _ (DocD (DocGroup lev docStr)), _, _) = do
-        mbDoc <- lexParseRnHaddockComment dflags DocSectionComment gre docStr
-        return $ fmap (ExportGroup lev "") mbDoc
-    mkExportItem (L _ (DocD (DocCommentNamed _ docStr)), _, _) = do
-        mbDoc <- lexParseRnHaddockComment dflags NormalHaddockComment gre docStr
-        return $ fmap ExportDoc mbDoc
-    mkExportItem (decl, doc, subs) = return $ Just $ ExportDecl decl doc subs []
-
+    mkExportItem (L _ (DocD (DocGroup lev docStr))) = do
+      mbDoc <- lexParseRnHaddockComment dflags DocSectionComment gre docStr
+      return $ fmap (ExportGroup lev "") mbDoc
+    mkExportItem (L _ (DocD (DocCommentNamed _ docStr))) = do
+      mbDoc <- lexParseRnHaddockComment dflags NormalHaddockComment gre docStr
+      return $ fmap ExportDoc mbDoc
+    mkExportItem decl
+      | name : _ <- getMainDeclBinder (unLoc decl) =
+        let (doc, subs) = exportDecl name decl docMap argMap subMap in
+        return $ Just (ExportDecl decl doc subs [])
+      | otherwise = return Nothing
 
 -- | 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
diff --git a/src/Haddock/Interface/ExtractFnArgDocs.hs b/src/Haddock/Interface/ExtractFnArgDocs.hs
deleted file mode 100644
index a9f8a807..00000000
--- a/src/Haddock/Interface/ExtractFnArgDocs.hs
+++ /dev/null
@@ -1,49 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Haddock.Interface.ExtractFnArgDocs
--- Copyright   :  (c) Isaac Dupree 2009,
--- License     :  BSD-like
---
--- Maintainer  :  haddock@projects.haskell.org
--- Stability   :  experimental
--- Portability :  portable
------------------------------------------------------------------------------
-module Haddock.Interface.ExtractFnArgDocs (
-  getDeclFnArgDocs, getSigFnArgDocs, getTypeFnArgDocs
-) where
-
-import Haddock.Types
-
-import qualified Data.Map as Map
-import Data.Map (Map)
-
-import GHC
-
--- the type of Name doesn't matter, except in 6.10 where
--- HsDocString = HsDoc Name, so we can't just say "HsDecl name" yet.
-
-getDeclFnArgDocs :: HsDecl Name -> Map Int HsDocString
-getDeclFnArgDocs (SigD (TypeSig _ ty)) = getTypeFnArgDocs ty
-getDeclFnArgDocs (ForD (ForeignImport _ ty _ _)) = getTypeFnArgDocs ty
-getDeclFnArgDocs (TyClD (TySynonym {tcdSynRhs = ty})) = getTypeFnArgDocs ty
-getDeclFnArgDocs _ = Map.empty
-
-getSigFnArgDocs :: Sig Name -> Map Int HsDocString
-getSigFnArgDocs (TypeSig _ ty) = getTypeFnArgDocs ty
-getSigFnArgDocs _ = Map.empty
-
-getTypeFnArgDocs :: LHsType Name -> Map Int HsDocString
-getTypeFnArgDocs ty = getLTypeDocs 0 ty
-
-
-getLTypeDocs :: Int -> LHsType Name -> Map Int HsDocString
-getLTypeDocs n (L _ ty) = getTypeDocs n ty
-
-getTypeDocs :: Int -> HsType Name -> Map Int HsDocString
-getTypeDocs n (HsForAllTy _ _ _ ty) = getLTypeDocs n ty
-getTypeDocs n (HsFunTy (L _ (HsDocTy _arg_type (L _ doc))) res_type) =
-      Map.insert n doc $ getLTypeDocs (n+1) res_type
-getTypeDocs n (HsFunTy _ res_type) = getLTypeDocs (n+1) res_type
-getTypeDocs n (HsDocTy _res_type (L _ doc)) = Map.singleton n doc
-getTypeDocs _ _res_type = Map.empty
-
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index 35ff8542..691dafbc 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -36,30 +36,22 @@ renameInterface renamingEnv warnings iface =
   let localEnv = foldl fn renamingEnv (ifaceVisibleExports iface)
         where fn env name = Map.insert name (ifaceMod iface) env
 
-      docMap   = Map.map (\(_,x,_) -> x) (ifaceDeclMap iface)
-
-      -- make instance docs into 'docForDecls'
-      instDocs = [ (name, (Just doc, Map.empty))
-                 | (name, doc) <- Map.toList (ifaceInstanceDocMap iface) ]
-
-      docs     = Map.toList docMap ++ instDocs
-      renameMapElem (k,d) = do d' <- renameDocForDecl d; return (k, d')
-
       -- 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 (liftM Map.fromList (mapM renameMapElem docs))
+      (rnDocMap, missingNames2) = runRnFM localEnv (mapM renameDoc (ifaceDocMap iface))
+
+      (rnArgMap, missingNames3) = runRnFM localEnv (mapM (mapM renameDoc) (ifaceArgMap iface))
 
-      (finalModuleDoc, missingNames3)
+      (finalModuleDoc, missingNames4)
         = runRnFM localEnv (renameMaybeDoc (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)
+                    (missingNames1 ++ missingNames2 ++ missingNames3 ++ missingNames4)
 
       -- filter out certain built in type constructors using their string
       -- representation. TODO: use the Name constants from the GHC API.
@@ -77,6 +69,7 @@ renameInterface renamingEnv warnings iface =
 
     return $ iface { ifaceRnDoc         = finalModuleDoc,
                      ifaceRnDocMap      = rnDocMap,
+                     ifaceRnArgMap      = rnArgMap,
                      ifaceRnExportItems = renamedExportItems }
 
 
diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs
index 52f04f1a..fcf7fe65 100644
--- a/src/Haddock/InterfaceFile.hs
+++ b/src/Haddock/InterfaceFile.hs
@@ -65,13 +65,13 @@ binaryInterfaceMagic = 0xD0Cface
 -- we version our interface files accordingly.
 binaryInterfaceVersion :: Word16
 #if __GLASGOW_HASKELL__ == 702
-binaryInterfaceVersion = 18
+binaryInterfaceVersion = 19
 #elif __GLASGOW_HASKELL__ == 703
-binaryInterfaceVersion = 18
+binaryInterfaceVersion = 19
 #elif __GLASGOW_HASKELL__ == 704
-binaryInterfaceVersion = 18
+binaryInterfaceVersion = 19
 #elif __GLASGOW_HASKELL__ == 705
-binaryInterfaceVersion = 18
+binaryInterfaceVersion = 19
 #else
 #error Unknown GHC version
 #endif
@@ -359,10 +359,11 @@ instance Binary InterfaceFile where
 
 
 instance Binary InstalledInterface where
-  put_ bh (InstalledInterface modu info docMap exps visExps opts subMap) = do
+  put_ bh (InstalledInterface modu info docMap argMap exps visExps opts subMap) = do
     put_ bh modu
     put_ bh info
     put_ bh docMap
+    put_  bh argMap
     put_ bh exps
     put_ bh visExps
     put_ bh opts
@@ -372,12 +373,13 @@ instance Binary InstalledInterface where
     modu    <- get bh
     info    <- get bh
     docMap  <- get bh
+    argMap  <- get bh
     exps    <- get bh
     visExps <- get bh
     opts    <- get bh
     subMap  <- get bh
 
-    return (InstalledInterface modu info docMap
+    return (InstalledInterface modu info docMap argMap
             exps visExps opts subMap)
 
 
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index fbaf89c5..3baa4a94 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -25,6 +25,7 @@ import Control.Arrow
 import Data.Typeable
 import Data.Map (Map)
 import qualified Data.Map as Map
+import Data.Monoid
 import GHC hiding (NoLink)
 import OccName
 
@@ -35,8 +36,11 @@ import OccName
 
 
 type IfaceMap      = Map Module Interface
-type InstIfaceMap  = Map Module InstalledInterface
-type DocMap        = Map Name (Doc DocName)
+type InstIfaceMap  = Map Module InstalledInterface  -- TODO: rename
+type DocMap a      = Map Name (Doc a)
+type ArgMap a      = Map Name (Map Int (Doc a))
+type SubMap        = Map Name [Name]
+type DeclMap       = Map Name [Decl]
 type SrcMap        = Map PackageId FilePath
 type Decl          = LHsDecl Name
 type GhcDocHdr     = Maybe LHsDocString
@@ -76,11 +80,17 @@ data Interface = Interface
     -- | Declarations originating from the module. Excludes declarations without
     -- names (instances and stand-alone documentation comments). Includes
     -- names of subordinate declarations mapped to their parent declarations.
-  , ifaceDeclMap         :: Map Name DeclInfo
+  , ifaceDeclMap         :: Map Name [Decl]
 
     -- | Documentation of declarations originating from the module (including
     -- subordinates).
-  , ifaceRnDocMap        :: Map Name (DocForDecl DocName)
+  , ifaceDocMap          :: DocMap Name
+  , ifaceArgMap          :: ArgMap Name
+
+    -- | Documentation of declarations originating from the module (including
+    -- subordinates).
+  , ifaceRnDocMap        :: DocMap DocName
+  , ifaceRnArgMap        :: ArgMap DocName
 
   , ifaceSubMap          :: Map Name [Name]
 
@@ -98,9 +108,6 @@ data Interface = Interface
     -- | Instances exported by the module.
   , ifaceInstances       :: ![Instance]
 
-    -- | Documentation of instances defined in the module.
-  , ifaceInstanceDocMap  :: Map Name (Doc Name)
-
     -- | The number of haddockable and haddocked items in the module, as a
     -- tuple. Haddockable items are the exports and the module itself.
   , ifaceHaddockCoverage  :: (Int,Int)
@@ -119,7 +126,9 @@ data InstalledInterface = InstalledInterface
 
     -- | Documentation of declarations originating from the module (including
     -- subordinates).
-  , instDocMap         :: Map Name (DocForDecl Name)
+  , instDocMap         :: DocMap Name
+
+  , instArgMap         :: ArgMap Name
 
     -- | All names exported by this module.
   , instExports        :: [Name]
@@ -141,7 +150,8 @@ toInstalledIface :: Interface -> InstalledInterface
 toInstalledIface interface = InstalledInterface
   { instMod            = ifaceMod            interface
   , instInfo           = ifaceInfo           interface
-  , instDocMap         = fmap unrenameDocForDecl $ ifaceRnDocMap interface
+  , instDocMap         = ifaceDocMap         interface
+  , instArgMap         = ifaceArgMap         interface
   , instExports        = ifaceExports        interface
   , instVisibleExports = ifaceVisibleExports interface
   , instOptions        = ifaceOptions        interface
@@ -203,11 +213,6 @@ data ExportItem name
   | ExportModule Module
 
 
--- | A declaration that may have documentation, including its subordinates,
--- which may also have documentation.
-type DeclInfo = (Decl, DocForDecl Name, [(Name, DocForDecl Name)])
-
-
 -- | Arguments and result are indexed by Int, zero-based from the left,
 -- because that's the easiest to use when recursing over types.
 type FnArgsDoc name = Map Int (Doc name)
@@ -289,7 +294,12 @@ data Doc id
   | DocPic String
   | DocAName String
   | DocExamples [Example]
-  deriving (Eq, Functor)
+  deriving (Functor)
+
+
+instance Monoid (Doc id) where
+  mempty  = DocEmpty
+  mappend = DocAppend
 
 
 unrenameDoc :: Doc DocName -> Doc Name
diff --git a/tests/html-tests/tests/Test.hs b/tests/html-tests/tests/Test.hs
index d7a0a716..d352f029 100644
--- a/tests/html-tests/tests/Test.hs
+++ b/tests/html-tests/tests/Test.hs
@@ -96,7 +96,9 @@ module Test (
  $ a non /literal/ line $
 -}
 
-	f'
+	f',
+
+  withType, withoutType
    ) where
 
 import Hidden
@@ -402,6 +404,12 @@ newp = undefined
 -- but f' doesn't get link'd 'f\''
 f' :: Int
 
+-- | Comment on a definition without type signature
+withoutType = undefined
+
+-- | Comment on a definition with type signature
+withType :: Int
+withType = 1
 
 -- Add some definitions here so that this file can be compiled with GHC
 
diff --git a/tests/html-tests/tests/Test.html.ref b/tests/html-tests/tests/Test.html.ref
index e46f96b5..b9afa1e2 100644
--- a/tests/html-tests/tests/Test.html.ref
+++ b/tests/html-tests/tests/Test.html.ref
@@ -665,6 +665,16 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");};
 	    > :: <a href=""
 	    >Int</a
 	    ></li
+	  ><li class="src short"
+	  ><a href=""
+	    >withType</a
+	    > :: <a href=""
+	    >Int</a
+	    ></li
+	  ><li class="src short"
+	  ><a href=""
+	    >withoutType</a
+	    > ::  a</li
 	  ></ul
 	></div
       ><div id="interface"
@@ -2230,6 +2240,30 @@ test2
 </p
 	    ></div
 	  ></div
+	><div class="top"
+	><p class="src"
+	  ><a name="v:withType" class="def"
+	    >withType</a
+	    > :: <a href=""
+	    >Int</a
+	    ></p
+	  ><div class="doc"
+	  ><p
+	    >Comment on a definition with type signature
+</p
+	    ></div
+	  ></div
+	><div class="top"
+	><p class="src"
+	  ><a name="v:withoutType" class="def"
+	    >withoutType</a
+	    > ::  a</p
+	  ><div class="doc"
+	  ><p
+	    >Comment on a definition without type signature
+</p
+	    ></div
+	  ></div
 	></div
       ></div
     ><div id="footer"
diff --git a/tests/html-tests/tests/Unicode.hs b/tests/html-tests/tests/Unicode.hs
new file mode 100644
index 00000000..d5bbf445
--- /dev/null
+++ b/tests/html-tests/tests/Unicode.hs
@@ -0,0 +1,6 @@
+module Unicode where
+
+-- | γλώσσα
+x :: Int
+x = 1
+
diff --git a/tests/html-tests/tests/Unicode.html.ref b/tests/html-tests/tests/Unicode.html.ref
new file mode 100644
index 00000000..29990e59
--- /dev/null
+++ b/tests/html-tests/tests/Unicode.html.ref
@@ -0,0 +1,82 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml"
+><head
+  ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"
+     /><title
+    >Unicode</title
+    ><link href="ocean.css" rel="stylesheet" type="text/css" title="Ocean"
+     /><script src="haddock-util.js" type="text/javascript"
+    ></script
+    ><script type="text/javascript"
+    >//<![CDATA[
+window.onload = function () {pageLoad();setSynopsis("mini_Unicode.html");};
+//]]>
+</script
+    ></head
+  ><body
+  ><div id="package-header"
+    ><ul class="links" id="page-menu"
+      ><li
+	><a href=""
+	  >Contents</a
+	  ></li
+	><li
+	><a href=""
+	  >Index</a
+	  ></li
+	></ul
+      ><p class="caption" class="empty"
+      >&nbsp;</p
+      ></div
+    ><div id="content"
+    ><div id="module-header"
+      ><table class="info"
+	><tr
+	  ><th
+	    >Safe Haskell</th
+	    ><td
+	    >None</td
+	    ></tr
+	  ></table
+	><p class="caption"
+	>Unicode</p
+	></div
+      ><div id="synopsis"
+      ><p id="control.syn" class="caption expander" onclick="toggleSection('syn')"
+	>Synopsis</p
+	><ul id="section.syn" class="hide" onclick="toggleSection('syn')"
+	><li class="src short"
+	  ><a href=""
+	    >x</a
+	    > :: <a href=""
+	    >Int</a
+	    ></li
+	  ></ul
+	></div
+      ><div id="interface"
+      ><h1
+	>Documentation</h1
+	><div class="top"
+	><p class="src"
+	  ><a name="v:x" class="def"
+	    >x</a
+	    > :: <a href=""
+	    >Int</a
+	    ></p
+	  ><div class="doc"
+	  ><p
+	    >&#947;&#955;&#974;&#963;&#963;&#945;
+</p
+	    ></div
+	  ></div
+	></div
+      ></div
+    ><div id="footer"
+    ><p
+      >Produced by <a href=""
+	>Haddock</a
+	> version 2.9.4</p
+      ></div
+    ></body
+  ></html
+>