From d73af20636a7f7f9f3022ca19fa5a97e871ddabf Mon Sep 17 00:00:00 2001
From: alexbiehl <alex.biehl@gmail.com>
Date: Tue, 6 Feb 2018 09:02:14 +0100
Subject: Expand SigDs

---
 haddock-api/src/Haddock/Interface/Create.hs | 28 ++++++++++++++++++++++++++--
 1 file changed, 26 insertions(+), 2 deletions(-)

(limited to 'haddock-api')

diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 4309163f..f905f494 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -497,7 +497,8 @@ classDecls class_ = filterDecls . collectDocs . sortByLoc $ decls
 -- | The top-level declarations of a module that we care about,
 -- ordered by source location, with documentation attached if it exists.
 topDecls :: HsGroup GhcRn -> [(LHsDecl GhcRn, [HsDocString])]
-topDecls = filterClasses . filterDecls . collectDocs . sortByLoc . ungroup
+topDecls =
+  filterClasses . filterDecls . collectDocs . sortByLoc . expandSigDecls . ungroup
 
 -- | Extract a map of fixity declarations only
 mkFixMap :: HsGroup GhcRn -> FixMap
@@ -557,6 +558,29 @@ filterDecls = filter (isHandled . unL . fst)
     isHandled (DocD _) = True
     isHandled _ = False
 
+-- | 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!
+expandSigDecls :: [LHsDecl name] -> [LHsDecl name]
+expandSigDecls = concatMap f
+  where
+    f (L l (SigD sig))              = [ L l (SigD s) | s <- expandSig sig ]
+
+    -- also expand type signatures for class methods
+    f (L l (TyClD cls@ClassDecl{})) =
+      [ L l (TyClD cls { tcdSigs = concatMap expandLSig (tcdSigs cls) }) ]
+    f x = [x]
+
+expandLSig :: LSig name -> [LSig name]
+expandLSig (L l sig) = [ L l s | s <- expandSig sig ]
+
+expandSig :: Sig name -> [Sig name]
+expandSig (TypeSig names t)      = [ TypeSig [n] t      | n <- names ]
+expandSig (ClassOpSig b names t) = [ ClassOpSig b [n] t | n <- names ]
+expandSig (PatSynSig names t)    = [ PatSynSig [n] t    | n <- names ]
+expandSig x                      = [x]
 
 -- | Go through all class declarations and filter their sub-declarations
 filterClasses :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
@@ -1155,7 +1179,7 @@ mkMaybeTokenizedSrc dflags flags tm
 
 mkTokenizedSrc :: DynFlags -> ModSummary -> RenamedSource -> IO [RichToken]
 mkTokenizedSrc dflags ms src = do
-  -- make sure to read the whole file at once otherwise 
+  -- make sure to read the whole file at once otherwise
   -- we run out of file descriptors (see #495)
   file <- force <$> readFile (filepath)
   return $ Hyperlinker.enrich src (Hyperlinker.parse dflags filepath file)
-- 
cgit v1.2.3