From 357bc99bb13c68ffb6e1b10f6739fe5f753b9fe3 Mon Sep 17 00:00:00 2001
From: davve <davve@dtek.chalmers.se>
Date: Sun, 4 Feb 2007 17:37:08 +0000
Subject: Insert spaces around infix function names

---
 src/HaddockHtml.hs | 15 ++++++++-------
 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
-- 
cgit v1.2.3