-instance (Outputable name) => Outputable (InPat name) where
- ppr = pprInPat
-
-pprInPat :: (Outputable name) => InPat name -> SDoc
-
-pprInPat (WildPatIn) = char '_'
-pprInPat (VarPatIn var) = ppr var
-pprInPat (LitPatIn s) = ppr s
-pprInPat (SigPatIn pat ty) = ppr pat <+> dcolon <+> ppr ty
-pprInPat (LazyPatIn pat) = char '~' <> ppr pat
-pprInPat (AsPatIn name pat) = parens (hcat [ppr name, char '@', ppr pat])
-pprInPat (ParPatIn pat) = parens (pprInPat pat)
-pprInPat (ListPatIn pats) = brackets (interpp'SP pats)
-pprInPat (PArrPatIn pats) = pabrackets (interpp'SP pats)
-pprInPat (TuplePatIn pats bx) = tupleParens bx (interpp'SP pats)
-pprInPat (NPlusKPatIn n k _) = parens (hcat [ppr n, char '+', ppr k])
-pprInPat (NPatIn l _) = ppr l
-
-pprInPat (ConPatIn c pats)
- | null pats = ppr c
- | otherwise = hsep [ppr c, interppSP pats] -- inner ParPats supply the necessary parens.
-
-pprInPat (ConOpPatIn pat1 op fixity pat2)
- = hsep [ppr pat1, ppr op, ppr pat2] -- ParPats put in parens
-
- -- ToDo: use pprSym to print op (but this involves fiddling various
- -- contexts & I'm lazy...); *PatIns are *rarely* printed anyway... (WDP)
-
-pprInPat (RecPatIn con rpats)
- = hsep [ppr con, braces (hsep (punctuate comma (map (pp_rpat) rpats)))]
- where
- pp_rpat (v, _, True) = ppr v
- pp_rpat (v, p, _) = hsep [ppr v, char '=', ppr p]
+instance (OutputableBndr name) => Outputable (Pat name) where
+ ppr = pprPat
+
+pprPatBndr :: OutputableBndr name => name -> SDoc
+pprPatBndr var -- Print with type info if -dppr-debug is on
+ = getPprStyle $ \ sty ->
+ if debugStyle sty then
+ parens (pprBndr LambdaBind var) -- Could pass the site to pprPat
+ -- but is it worth it?
+ else
+ ppr var
+
+pprPat :: (OutputableBndr name) => Pat name -> SDoc
+
+pprPat (VarPat var) = pprPatBndr var
+pprPat (VarPatOut var bs) = parens (pprPatBndr var <+> braces (ppr bs))
+pprPat (WildPat _) = char '_'
+pprPat (LazyPat pat) = char '~' <> ppr pat
+pprPat (AsPat name pat) = parens (hcat [ppr name, char '@', ppr pat])
+pprPat (ParPat pat) = parens (ppr pat)
+
+pprPat (ListPat pats _) = brackets (interpp'SP pats)
+pprPat (PArrPat pats _) = pabrackets (interpp'SP pats)
+pprPat (TuplePat pats bx) = tupleParens bx (interpp'SP pats)
+
+pprPat (ConPatIn con details) = pprUserCon con details
+pprPat (ConPatOut con tvs dicts binds details _)
+ = getPprStyle $ \ sty -> -- Tiresome; in TcBinds.tcRhs we print out a
+ if debugStyle sty then -- typechecked Pat in an error message,
+ -- and we want to make sure it prints nicely
+ ppr con <+> sep [ hsep (map pprPatBndr tvs) <+> hsep (map pprPatBndr dicts),
+ pprLHsBinds binds, pprConArgs details]
+ else pprUserCon con details
+
+pprPat (LitPat s) = ppr s
+pprPat (NPat l Nothing _ _) = ppr l
+pprPat (NPat l (Just _) _ _) = char '-' <> ppr l
+pprPat (NPlusKPat n k _ _) = hcat [ppr n, char '+', ppr k]
+pprPat (TypePat ty) = ptext SLIT("{|") <> ppr ty <> ptext SLIT("|}")
+pprPat (SigPatIn pat ty) = ppr pat <+> dcolon <+> ppr ty
+pprPat (SigPatOut pat ty) = ppr pat <+> dcolon <+> ppr ty
+pprPat (DictPat ds ms) = parens (sep [ptext SLIT("{-dict-}"),
+ brackets (interpp'SP ds),
+ brackets (interpp'SP ms)])
+
+pprUserCon c (InfixCon p1 p2) = ppr p1 <+> ppr c <+> ppr p2
+pprUserCon c details = ppr c <+> pprConArgs details
+
+pprConArgs (PrefixCon pats) = interppSP pats
+pprConArgs (InfixCon p1 p2) = interppSP [p1,p2]
+pprConArgs (RecCon rpats) = braces (hsep (punctuate comma (map (pp_rpat) rpats)))
+ where
+ pp_rpat (v, p) = hsep [ppr v, char '=', ppr p]