Commit 9b9f197b authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Improve HsSyn pretty-printing of instance declarations (fixes Trac #7532)

parent 4496fda2
......@@ -755,8 +755,8 @@ pp_data_defn :: OutputableBndr name
-> HsDataDefn name
-> SDoc
pp_data_defn pp_hdr (HsDataDefn { dd_ND = new_or_data, dd_ctxt = L _ context
, dd_kindSig = mb_sig
, dd_cons = condecls, dd_derivs = derivings })
, dd_kindSig = mb_sig
, dd_cons = condecls, dd_derivs = derivings })
| null condecls
= ppr new_or_data <+> pp_hdr context <+> pp_sig
......@@ -921,13 +921,19 @@ It is not possible for this list to have 0 elements --
\begin{code}
instance (OutputableBndr name) => Outputable (TyFamInstDecl name) where
ppr (TyFamInstDecl { tfid_group = False, tfid_eqns = [lEqn] })
= let eqn = unLoc lEqn in
ptext (sLit "type instance") <+> (ppr eqn)
ppr (TyFamInstDecl { tfid_eqns = eqns })
= hang (ptext (sLit "type instance where"))
ppr = pprTyFamInstDecl TopLevel
pprTyFamInstDecl :: OutputableBndr name => TopLevelFlag -> TyFamInstDecl name -> SDoc
pprTyFamInstDecl top_lvl (TyFamInstDecl { tfid_group = False, tfid_eqns = [eqn] })
= ptext (sLit "type") <+> ppr_instance_keyword top_lvl <+> (ppr eqn)
pprTyFamInstDecl top_lvl (TyFamInstDecl { tfid_eqns = eqns })
= hang (ptext (sLit "type") <+> ppr_instance_keyword top_lvl <+> ptext (sLit "where"))
2 (vcat (map ppr eqns))
ppr_instance_keyword :: TopLevelFlag -> SDoc
ppr_instance_keyword TopLevel = ptext (sLit "instance")
ppr_instance_keyword NotTopLevel = empty
instance (OutputableBndr name) => Outputable (TyFamInstEqn name) where
ppr (TyFamInstEqn { tfie_tycon = tycon
, tfie_pats = pats
......@@ -935,10 +941,15 @@ instance (OutputableBndr name) => Outputable (TyFamInstEqn name) where
= (pp_fam_inst_lhs tycon pats []) <+> equals <+> (ppr rhs)
instance (OutputableBndr name) => Outputable (DataFamInstDecl name) where
ppr (DataFamInstDecl { dfid_tycon = tycon
, dfid_pats = pats
, dfid_defn = defn })
= pp_data_defn ((ptext (sLit "instance") <+>) . (pp_fam_inst_lhs tycon pats)) defn
ppr = pprDataFamInstDecl TopLevel
pprDataFamInstDecl :: OutputableBndr name => TopLevelFlag -> DataFamInstDecl name -> SDoc
pprDataFamInstDecl top_lvl (DataFamInstDecl { dfid_tycon = tycon
, dfid_pats = pats
, dfid_defn = defn })
= pp_data_defn pp_hdr defn
where
pp_hdr ctxt = ppr_instance_keyword top_lvl <+> pp_fam_inst_lhs tycon pats ctxt
pprDataFamInstFlavour :: DataFamInstDecl name -> SDoc
pprDataFamInstFlavour (DataFamInstDecl { dfid_defn = (HsDataDefn { dd_ND = nd }) })
......@@ -948,14 +959,15 @@ instance (OutputableBndr name) => Outputable (ClsInstDecl name) where
ppr (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = binds
, cid_sigs = sigs, cid_tyfam_insts = ats
, cid_datafam_insts = adts })
| null sigs && null ats && isEmptyBag binds -- No "where" part
| null sigs, null ats, null adts, isEmptyBag binds -- No "where" part
= top_matter
| otherwise -- Laid out
= vcat [ top_matter <+> ptext (sLit "where")
, nest 2 $ pprDeclList (map ppr ats ++
map ppr adts ++
pprLHsBindsForUser binds sigs) ]
, nest 2 $ pprDeclList $
map (pprTyFamInstDecl NotTopLevel . unLoc) ats ++
map (pprDataFamInstDecl NotTopLevel . unLoc) adts ++
pprLHsBindsForUser binds sigs ]
where
top_matter = ptext (sLit "instance") <+> ppr inst_ty
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment