[commit: packages/template-haskell] master: Improve pretty printing for Template Haskell operators (ec6d5a7)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/template-haskell

On branch  : master
Link       : http://git.haskell.org/?p=packages/template-haskell.git;a=commit;h=ec6d5a7c9b0c9e2fb1ce10d776cff74548e17981

>---------------------------------------------------------------

commit ec6d5a7c9b0c9e2fb1ce10d776cff74548e17981
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed Aug 28 16:43:00 2013 +0100

    Improve pretty printing for Template Haskell operators
    
    Fixes Trac #8187, #8188.
    
    Thanks to Yoshikuni Jujo for pointing this out and doing the first draft.


>---------------------------------------------------------------

ec6d5a7c9b0c9e2fb1ce10d776cff74548e17981
 Language/Haskell/TH/Ppr.hs |   25 +++++++++++++++++++++----
 1 file changed, 21 insertions(+), 4 deletions(-)

diff --git a/Language/Haskell/TH/Ppr.hs b/Language/Haskell/TH/Ppr.hs
index 4096d9e..415f171 100644
--- a/Language/Haskell/TH/Ppr.hs
+++ b/Language/Haskell/TH/Ppr.hs
@@ -10,8 +10,9 @@ import Text.PrettyPrint (render)
 import Language.Haskell.TH.PprLib
 import Language.Haskell.TH.Syntax
 import Data.Word ( Word8 )
-import Data.Char ( toLower, chr )
+import Data.Char ( toLower, chr, ord, isSymbol )
 import GHC.Show  ( showMultiLineString )
+import Data.Ratio ( numerator, denominator )
 
 nestDepth :: Int
 nestDepth = 4
@@ -81,6 +82,20 @@ pprFixity v (Fixity i d) = ppr_fix d <+> int i <+> ppr v
 instance Ppr Exp where
     ppr = pprExp noPrec
 
+pprPrefixOcc :: Name -> Doc
+-- Print operators with parens around them
+pprPrefixOcc n = parensIf (isSymOcc n) (ppr n)
+
+isSymOcc :: Name -> Bool
+isSymOcc n
+  = case nameBase n of 
+      []    -> True  -- Empty name; weird
+      (c:_) -> isSymbolASCII c || (ord c > 0x7f && isSymbol c) 
+                   -- c.f. OccName.startsVarSym in GHC itself
+
+isSymbolASCII :: Char -> Bool
+isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"
+
 pprInfixExp :: Exp -> Doc
 pprInfixExp (VarE v) = pprName' Infix v
 pprInfixExp (ConE v) = pprName' Infix v
@@ -189,7 +204,9 @@ pprLit i (IntegerL x)    = parensIf (i > noPrec && x < 0) (integer x)
 pprLit _ (CharL c)       = text (show c)
 pprLit _ (StringL s)     = pprString s
 pprLit _ (StringPrimL s) = pprString (bytesToString s) <> char '#'
-pprLit i (RationalL rat) = parensIf (i > noPrec) $ rational rat
+pprLit i (RationalL rat) = parensIf (i > noPrec) $
+                           integer (numerator rat) <+> char '/' 
+                              <+> integer (denominator rat)
 
 bytesToString :: [Word8] -> String
 bytesToString = map (chr . fromIntegral)
@@ -239,7 +256,7 @@ instance Ppr Dec where
 ppr_dec :: Bool     -- declaration on the toplevel?
         -> Dec 
         -> Doc
-ppr_dec _ (FunD f cs)   = vcat $ map (\c -> ppr f <+> ppr c) cs
+ppr_dec _ (FunD f cs)   = vcat $ map (\c -> pprPrefixOcc f <+> ppr c) cs
 ppr_dec _ (ValD p r ds) = ppr p <+> pprBody True r
                           $$ where_clause ds
 ppr_dec _ (TySynD t xs rhs) 
@@ -253,7 +270,7 @@ ppr_dec _  (ClassD ctxt c xs fds ds)
     $$ where_clause ds
 ppr_dec _ (InstanceD ctxt i ds) = text "instance" <+> pprCxt ctxt <+> ppr i
                                   $$ where_clause ds
-ppr_dec _ (SigD f t)    = ppr f <+> text "::" <+> ppr t
+ppr_dec _ (SigD f t)    = pprPrefixOcc f <+> text "::" <+> ppr t
 ppr_dec _ (ForeignD f)  = ppr f
 ppr_dec _ (InfixD fx n) = pprFixity n fx
 ppr_dec _ (PragmaD p)   = ppr p