diff options
| -rw-r--r-- | src/HaddockHtml.hs | 15 | ||||
| -rw-r--r-- | src/HaddockUtil.hs | 9 |
2 files changed, 15 insertions, 9 deletions
diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs index 59ca8501..2ade78b9 100644 --- a/src/HaddockHtml.hs +++ b/src/HaddockHtml.hs @@ -1077,12 +1077,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") <+> - (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) + (if newOrData == NewType then keyword "newtype" else keyword "data") + <+> + (if isConSym name + then ppName (tyvars!!0) <+> ppBinder summary name <+> ppName (tyvars!!1) + else ppBinder summary name <+> hsep (map ppName tyvars)) -- ---------------------------------------------------------------------------- -- Types and contexts @@ -1224,7 +1223,9 @@ ppBinder True nm = linkedAnchor (anchorNameStr nm) << ppBinder' nm ppBinder False nm = linkTarget nm +++ bold << ppBinder' nm ppBinder' :: Name -> Html -ppBinder' name = toHtml (getOccString name) +ppBinder' name + | isVarSym name = parens $ toHtml (getOccString name) + | otherwise = toHtml (getOccString name) linkId :: Module -> Maybe Name -> Html -> Html linkId mod mbName = anchor ! [href hr] diff --git a/src/HaddockUtil.hs b/src/HaddockUtil.hs index 4d67f0d7..1d962c82 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, - nameOccString, moduleString, mkModuleNoPkg, + isConSym, isVarSym, nameOccString, moduleString, mkModuleNoPkg, -- * HTML cross reference mapping html_xrefs_ref, @@ -46,7 +46,7 @@ import Module import PackageConfig ( stringToPackageId ) import Control.Monad ( liftM, MonadPlus(..) ) -import Data.Char ( isAlpha, isSpace, toUpper, ord ) +import Data.Char import Data.IORef ( IORef, newIORef, readIORef ) import Data.List ( intersect, isSuffixOf, intersperse ) import Data.Maybe ( maybeToList, fromMaybe, isJust, fromJust ) @@ -231,6 +231,11 @@ escapeStr = flip escapeString unreserved escapeStr = escapeURIString isUnreserved #endif +-- there should be a better way to check this using the GHC API +isConSym n = head (nameOccString n) == ':' +isVarSym n = fstChar /= '_' && not (isConSym n) && (not . isLetter) fstChar + where fstChar = head (nameOccString n) + nameOccString = occNameString . nameOccName moduleString :: Module -> String |