diff options
| -rw-r--r-- | src/Haddock/Backends/Html.hs | 16 |
1 files changed, 15 insertions, 1 deletions
diff --git a/src/Haddock/Backends/Html.hs b/src/Haddock/Backends/Html.hs index 0aa6d85e..a7204d1a 100644 --- a/src/Haddock/Backends/Html.hs +++ b/src/Haddock/Backends/Html.hs @@ -750,6 +750,9 @@ ppTyName name ppTyNames = map ppTyName +ppLTypes = hsep . map ppLType + + -------------------------------------------------------------------------------- -- Contexts -------------------------------------------------------------------------------- @@ -774,12 +777,23 @@ pp_hs_context cxt = parenList (map ppPred cxt) ppLPred = ppPred . unLoc -ppPred (HsClassP n ts) = ppDocName n <+> hsep (map ppLType ts) + +ppPred (HsClassP n ts) + | classOp, length ts > 2 = firstApp <+> ppLTypes rest + | classOp = firstApp + | otherwise = ppDocName n <+> ppLTypes ts + where + classOp = isNameConSym . getName $ n + t1:t2:rest = ts + firstApp = ppLType t1 <+> ppDocName n <+> ppLType t2 + + -- TODO: find out what happened to the Dupable/Linear distinction ppPred (HsEqualP t1 t2) = ppLType t1 <+> toHtml "~" <+> ppLType t2 ppPred (HsIParam (IPName n) t) = toHtml "?" +++ ppDocName n <+> dcolon <+> ppLType t + -- ----------------------------------------------------------------------------- -- Class declarations |