diff options
Diffstat (limited to 'haddock-api/src/Haddock')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 12 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Interface/Create.hs | 26 | 
2 files changed, 7 insertions, 31 deletions
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  | 
