diff options
| author | David Waern <davve@dtek.chalmers.se> | 2007-12-08 15:46:26 +0000 |
|---|---|---|
| committer | David Waern <davve@dtek.chalmers.se> | 2007-12-08 15:46:26 +0000 |
| commit | 96053cafb4530a2459c2644b95c70baf57fd7eb1 (patch) | |
| tree | 71e66741bdd39ee61105dbc17ae102cae6d87cb9 /src/Haddock/Backends | |
| parent | 2833ace46eb35266ebfe1a5bb8629210413b1be1 (diff) | |
Handle class operators correctly when rendering predicates
Diffstat (limited to 'src/Haddock/Backends')
| -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 |