diff options
| author | davve <davve@dtek.chalmers.se> | 2007-02-04 16:59:08 +0000 |
|---|---|---|
| committer | davve <davve@dtek.chalmers.se> | 2007-02-04 16:59:08 +0000 |
| commit | e93d48aff9e9b13f393e168e01b10de0bfd290f2 (patch) | |
| tree | ca882232dedd88897511310a5a004d8e85c1f02a | |
| parent | da89db72eeab2a8c4cc7e7a237350e758ef14cc5 (diff) | |
Render infix type constructors properly
| -rw-r--r-- | src/HaddockHtml.hs | 6 | ||||
| -rw-r--r-- | src/HaddockUtil.hs | 4 |
2 files changed, 8 insertions, 2 deletions
diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs index 2af6922d..59ca8501 100644 --- a/src/HaddockHtml.hs +++ b/src/HaddockHtml.hs @@ -1078,7 +1078,11 @@ expandField (HsFieldDecl ns ty doc) = [ HsFieldDecl [n] ty doc | n <- ns ] ppDataHeader :: Bool -> NewOrData -> Name -> [Name] -> Html ppDataHeader summary newOrData name tyvars = (if newOrData == NewType then keyword "newtype" else keyword "data") <+> - ppBinder summary name <+> hsep (map ppName tyvars) + (if infixConstr then ppName (tyvars!!0) <+> ppBinder summary name <+> ppName (tyvars!!1) + else ppBinder summary name <+> hsep (map ppName tyvars)) + where + -- there should be a better way to check this using the GHC API + infixConstr = (head (nameOccString name) == ':') && (length tyvars == 2) -- ---------------------------------------------------------------------------- -- Types and contexts diff --git a/src/HaddockUtil.hs b/src/HaddockUtil.hs index b80e8a1b..4d67f0d7 100644 --- a/src/HaddockUtil.hs +++ b/src/HaddockUtil.hs @@ -20,7 +20,7 @@ module HaddockUtil ( -- * Miscellaneous utilities getProgramName, bye, die, dieMsg, noDieMsg, mapSnd, mapMaybeM, escapeStr, - moduleString, mkModuleNoPkg, + nameOccString, moduleString, mkModuleNoPkg, -- * HTML cross reference mapping html_xrefs_ref, @@ -231,6 +231,8 @@ escapeStr = flip escapeString unreserved escapeStr = escapeURIString isUnreserved #endif +nameOccString = occNameString . nameOccName + moduleString :: Module -> String moduleString = moduleNameString . moduleName |