hunk ./PPrint.hs 13
+{-
+ - some useful fixities for comparison
+ -
+ - application left 10
+ - infixr 9  .
+ - infixr 8  ^, ^^, **
+ - infixl 7  *  , /, `quot`, `rem`, `div`, `mod`
+ - infixl 6  +, -
+ - infixr 5  :
+ - infix  4  ==, /=, <, <=, >=, >
+ - infixr 3  &&
+ - infixr 2  ||
+ - infixl 1  >>, >>=
+ - infixr 1  =<<
+ - infixr 0  $, $!, `seq`
+ -
+ -}
+
+data Assoc = AssocLeft | AssocRight | AssocNone
+    deriving(Eq,Ord,Show)
hunk ./PPrint.hs 36
-    pprintPrec :: Int -> a -> d
+    pprintAssoc :: Assoc -> Int -> a -> d
hunk ./PPrint.hs 38
-    pprintPrec _ a = pprint a
-    pprint a = pprintPrec 0 a
+    pprintAssoc _ _ a = pprint a
+    pprint a = pprintAssoc AssocNone (-1) a
hunk ./PPrint.hs 48
+pprintPrec n a = pprintAssoc AssocNone n  a
+
hunk ./PPrint.hs 75
+checkAssoc a1 n1 a2 n2 | n2 < n1 = id
+                       | n1 == n2 && a1 == a2 && a1 /= AssocNone = id
+                       | otherwise = parens
+
+checkAssocApp a n p = checkAssoc AssocLeft 10 a n p
+
+pprintBinary a1 n1 a2 n2 x1 b x2 = checkAssoc a1 n1 a2 n2 $ pprintAssoc l n1 x1 <+> b <+> pprintAssoc r n1 x2 where
+    l = if a1 == AssocLeft then AssocLeft else AssocNone
+    r = if a1 == AssocRight then AssocRight else AssocNone
+
hunk ./PPrint.hs 86
-  pprintPrec n (Left x)  | n <= 9  = text "Left" <+> pprintPrec 10 x
-  pprintPrec n (Right x) | n <= 9  = text "Right" <+> pprintPrec 10 x
-  pprintPrec _ x = parens (pprint x)
+  pprintAssoc a n (Left x)  = checkAssocApp a n $ text "Left" <+> pprintPrec 10 x
+  pprintAssoc a n (Right x) = checkAssocApp a n $ text "Right" <+> pprintPrec 10 x