diff options
| author | David Waern <davve@dtek.chalmers.se> | 2007-12-08 16:45:06 +0000 |
|---|---|---|
| committer | David Waern <davve@dtek.chalmers.se> | 2007-12-08 16:45:06 +0000 |
| commit | bef29ab118174e4b172495bcfd2171a1cb7eb7e4 (patch) | |
| tree | 337e18d1135fc3c6a142bb4866164d25f52150f3 | |
| parent | dbaf61e7fe3de11aa10e8dd62341888e497f0b39 (diff) | |
Fix rendering of instance heads to handle infix operators
This is also a refactoring to share this code for rendering predicates.
| -rw-r--r-- | src/Haddock/Backends/Html.hs | 35 |
1 files changed, 22 insertions, 13 deletions
diff --git a/src/Haddock/Backends/Html.hs b/src/Haddock/Backends/Html.hs index f00a8f04..4d377995 100644 --- a/src/Haddock/Backends/Html.hs +++ b/src/Haddock/Backends/Html.hs @@ -750,6 +750,22 @@ ppTyNames = map ppTyName -------------------------------------------------------------------------------- +-- Type applications +-- Ocurring in contexts and instance heads +-------------------------------------------------------------------------------- + + +ppTypeApp n ts@(t1:t2:rest) + | operator, not . null $ rest = parens opApp <+> ppParendTypes rest + | operator = opApp + where + operator = isNameSym . getName $ n + opApp = ppParendType t1 <+> ppDocName n <+> ppParendType t2 + +ppTypeApp n ts = ppDocName n <+> ppParendTypes ts + + +-------------------------------------------------------------------------------- -- Contexts -------------------------------------------------------------------------------- @@ -774,16 +790,7 @@ pp_hs_context cxt = parenList (map ppPred cxt) ppLPred = ppPred . unLoc -ppPred (HsClassP n ts) - | classOp, length ts > 2 = firstApp <+> ppLParendTypes rest - | classOp = firstApp - | otherwise = ppDocName n <+> ppLParendTypes ts - where - classOp = isNameConSym . getName $ n - t1:t2:rest = ts - firstApp = ppLParendType t1 <+> ppDocName n <+> ppLParendType t2 - - +ppPred (HsClassP n ts) = ppTypeApp n (map unLoc ts) -- TODO: find out what happened to the Dupable/Linear distinction ppPred (HsEqualP t1 t2) = ppLType t1 <+> toHtml "~" <+> ppLType t2 ppPred (HsIParam (IPName n) t) @@ -878,10 +885,9 @@ ppClassDecl summary links instances orig_c loc mbDoc docMap )) ppInstHead :: InstHead DocName -> Html -ppInstHead ([], n, ts) = ppAsst n ts -ppInstHead (ctxt, n, ts) = ppContextNoLocs ctxt <+> ppAsst n ts +ppInstHead ([], n, ts) = ppTypeApp n ts +ppInstHead (ctxt, n, ts) = ppContextNoLocs ctxt <+> ppTypeApp n ts -ppAsst n ts = ppDocName n <+> hsep (map ppParendType ts) -- ----------------------------------------------------------------------------- -- Data & newtype declarations @@ -1230,6 +1236,9 @@ ppLTypes = hsep . map ppLType ppLParendTypes = hsep . map ppLParendType +ppParendTypes = hsep . map ppParendType + + ppLType = ppType . unLoc ppLParendType = ppParendType . unLoc |