diff options
Diffstat (limited to 'src/Haddock/Backends/LaTeX.hs')
| -rw-r--r-- | src/Haddock/Backends/LaTeX.hs | 28 |
1 files changed, 18 insertions, 10 deletions
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs index d3074438..ec3ea8d1 100644 --- a/src/Haddock/Backends/LaTeX.hs +++ b/src/Haddock/Backends/LaTeX.hs @@ -26,6 +26,7 @@ import OccName import Name ( nameOccName ) import RdrName ( rdrNameOcc ) import FastString ( unpackFS, unpackLitString, zString ) +import Outputable ( panic) import qualified Data.Map as Map import System.Directory @@ -631,19 +632,19 @@ ppSideBySideConstr subdocs unicode leader (L _ con) = ResTyH98 -> case con_details con of PrefixCon args -> - decltt (hsep ((header_ unicode <+> ppBinder occ) : + decltt (hsep ((header_ unicode <+> ppOcc) : map (ppLParendType unicode) args)) <-> rDoc mbDoc <+> nl RecCon fields -> - (decltt (header_ unicode <+> ppBinder occ) + (decltt (header_ unicode <+> ppOcc) <-> rDoc mbDoc <+> nl) $$ doRecordFields fields InfixCon arg1 arg2 -> decltt (hsep [ header_ unicode <+> ppLParendType unicode arg1, - ppBinder occ, + ppOcc, ppLParendType unicode arg2 ]) <-> rDoc mbDoc <+> nl @@ -657,33 +658,40 @@ ppSideBySideConstr subdocs unicode leader (L _ con) = where doRecordFields fields = - vcat (map (ppSideBySideField subdocs unicode) fields) + vcat (map (ppSideBySideField subdocs unicode) (map unLoc fields)) - doGADTCon args resTy = decltt (ppBinder occ <+> dcolon unicode <+> hsep [ + doGADTCon args resTy = decltt (ppOcc <+> dcolon unicode <+> hsep [ ppForAll forall ltvs (con_cxt con) unicode, ppLType unicode (foldr mkFunTy resTy args) ] ) <-> rDoc mbDoc header_ = ppConstrHdr forall tyVars context - occ = nameOccName . getName . unLoc . con_name $ con + occ = map (nameOccName . getName . unLoc) $ con_names con + ppOcc = case occ of + [one] -> ppBinder one + _ -> cat (punctuate comma (map ppBinder occ)) ltvs = con_qvars con tyVars = tyvarNames (con_qvars con) context = unLoc (con_cxt con) forall = con_explicit con -- don't use "con_doc con", in case it's reconstructed from a .hi file, -- or also because we want Haddock to do the doc-parsing, not GHC. - mbDoc = lookup (unLoc $ con_name con) subdocs >>= combineDocumentation . fst + mbDoc = case con_names con of + [] -> panic "empty con_names" + (cn:_) -> lookup (unLoc cn) subdocs >>= + combineDocumentation . fst mkFunTy a b = noLoc (HsFunTy a b) ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Bool -> ConDeclField DocName -> LaTeX -ppSideBySideField subdocs unicode (ConDeclField (L _ name) ltype _) = - decltt (ppBinder (nameOccName . getName $ name) +ppSideBySideField subdocs unicode (ConDeclField names ltype _) = + decltt (cat (punctuate comma (map (ppBinder . nameOccName . getName . unL) names)) <+> dcolon unicode <+> ppLType unicode ltype) <-> rDoc mbDoc where -- don't use cd_fld_doc for same reason we don't use con_doc above - mbDoc = lookup name subdocs >>= combineDocumentation . fst + -- Where there is more than one name, they all have the same documentation + mbDoc = lookup (unL $ head names) subdocs >>= combineDocumentation . fst -- {- -- ppHsFullConstr :: HsConDecl -> LaTeX |