From 6d62c5b79d0f3ce975c087b5176ee53d62122d86 Mon Sep 17 00:00:00 2001
From: alexbiehl <alex.biehl@gmail.com>
Date: Mon, 19 Feb 2018 05:56:54 +0100
Subject: Teach the HTML backend how to render methods with multiple names

---
 haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 12 ++++++------
 haddock-api/src/Haddock/Interface/Create.hs    | 26 +-------------------------
 2 files changed, 7 insertions(+), 31 deletions(-)

(limited to 'haddock-api')

diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 3b85f96c..6e733373 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -516,14 +516,14 @@ ppClassDecl summary links instances fixities loc d subdocs
                             doc = lookupAnySubdoc (unL $ fdLName $ unL at) subdocs
                             subfixs = [ f | f@(n',_) <- fixities, n == n' ] ]
 
-    methodBit = subMethods [ ppFunSig summary links loc doc names (hsSigType typ)
+    methodBit = subMethods [ ppFunSig summary links loc doc [name] (hsSigType typ)
                                       subfixs splice unicode qual
                            | L _ (ClassOpSig _ lnames typ) <- lsigs
-                           , let doc = lookupAnySubdoc (head names) subdocs
-                                 subfixs = [ f | n <- names
-                                               , f@(n',_) <- fixities
-                                               , n == n' ]
-                                 names = map unLoc lnames ]
+                           , name <- map unLoc lnames
+                           , let doc = lookupAnySubdoc name subdocs
+                                 subfixs = [ f | f@(n',_) <- fixities
+                                               , name == n' ]
+                           ]
                            -- N.B. taking just the first name is ok. Signatures with multiple names
                            -- are expanded so that each name gets its own signature.
 
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index f218853b..a885b298 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -392,7 +392,7 @@ mkMaps dflags gre instances decls = do
           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
-          cm = [ (n, expandSigDecls [ldecl]) | n <- ns ++ subNs ]
+          cm = [ (n, [ldecl]) | n <- ns ++ subNs ]
 
       seqList ns `seq`
         seqList subNs `seq`
@@ -559,30 +559,6 @@ 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)]
 filterClasses decls = [ if isClassD d then (L loc (filterClass d), doc) else x
-- 
cgit v1.2.3