-pprOutPat sty (WildPat ty) = ppChar '_'
-pprOutPat sty (VarPat var) = pprNonSym sty var
-pprOutPat sty (LazyPat pat) = ppBesides [ppChar '~', ppr sty pat]
-pprOutPat sty (AsPat name pat)
- = ppBesides [ppLparen, ppr sty name, ppChar '@', ppr sty pat, ppRparen]
-
-pprOutPat sty (ConPat name ty [])
- = ppBeside (ppr sty name)
- (ifPprShowAll sty (pprConPatTy sty ty))
-
-pprOutPat sty (ConPat name ty pats)
- = ppBesides [ppLparen, ppr sty name, ppSP,
- interppSP sty pats, ppRparen,
- ifPprShowAll sty (pprConPatTy sty ty) ]
-
-pprOutPat sty (ConOpPat pat1 op pat2 ty)
- = ppBesides [ppLparen, ppr sty pat1, ppSP, pprSym sty op, ppSP, ppr sty pat2, ppRparen]
-
-pprOutPat sty (ListPat ty pats)
- = ppBesides [ppLbrack, interpp'SP sty pats, ppRbrack]
-pprOutPat sty (TuplePat pats)
- = ppParens (interpp'SP sty pats)
-
-pprOutPat sty (RecPat con ty rpats)
- = ppBesides [ppr sty con, ppChar '{', ppInterleave ppComma (map (pp_rpat sty) rpats), ppChar '}']
+pprOutPat (WildPat ty) = char '_'
+pprOutPat (VarPat var) = ppr var
+pprOutPat (LazyPat pat) = hcat [char '~', ppr pat]
+pprOutPat (AsPat name pat)
+ = parens (hcat [ppr name, char '@', ppr pat])
+
+pprOutPat (ConPat name ty [] [] [])
+ = ppr name
+
+-- Kludge to get infix constructors to come out right
+-- when ppr'ing desugar warnings.
+pprOutPat (ConPat name ty tyvars dicts pats)
+ = getPprStyle $ \ sty ->
+ parens $
+ case pats of
+ [p1,p2]
+ | userStyle sty && isDataSymOcc (getOccName name) ->
+ hsep [ppr p1, ppr name, ppr p2]
+ _ -> hsep [ppr name, interppSP tyvars, interppSP dicts, interppSP pats]
+
+pprOutPat (ListPat ty pats) = brackets (interpp'SP pats)
+pprOutPat (TuplePat pats boxity) = tupleParens boxity (interpp'SP pats)
+
+pprOutPat (RecPat con ty tvs dicts rpats)
+ = hsep [ppr con, interppSP tvs, interppSP dicts, braces (hsep (punctuate comma (map (pp_rpat) rpats)))]