pprTyThingInContext,
pprTyThingLoc,
pprTyThingInContextLoc,
+ pprTyThingHdr
) where
#include "HsVersions.h"
pprTyThingInContext exts (ADataCon dataCon) = pprDataCon exts dataCon
pprTyThingInContext exts (ATyCon tyCon) = pprTyCon exts tyCon
pprTyThingInContext exts (AClass cls) = pprClass exts cls
+
+-- | Pretty-prints the 'TyThing' header. For functions and data constructors
+-- the function is equivalent to 'pprTyThing' but for type constructors
+-- and classes it prints only the header part of the declaration.
+pprTyThingHdr :: Bool -> TyThing -> SDoc
+pprTyThingHdr exts (AnId id) = pprId exts id
+pprTyThingHdr exts (ADataCon dataCon) = pprDataConSig exts dataCon
+pprTyThingHdr exts (ATyCon tyCon) = pprTyConHdr exts tyCon
+pprTyThingHdr exts (AClass cls) = pprClassHdr exts cls
pprTyConHdr exts tyCon =
ptext keyword <+> ppr_bndr tyCon <+> hsep (map ppr vars)
where
- vars = GHC.tyConTyVars tyCon
-
+ vars | GHC.isPrimTyCon tyCon ||
+ GHC.isFunTyCon tyCon = take (GHC.tyConArity tyCon) GHC.alphaTyVars
+ | otherwise = GHC.tyConTyVars tyCon
+
keyword | GHC.isSynTyCon tyCon = SLIT("type")
| GHC.isNewTyCon tyCon = SLIT("newtype")
| otherwise = SLIT("data")
pprTyCon exts tyCon
| GHC.isSynTyCon tyCon
- = let (_,rhs_type) = GHC.getSynTyConDefn tyCon
+ = let rhs_type = GHC.synTyConRhs tyCon
in hang (pprTyConHdr exts tyCon <+> equals) 2 (pprType exts rhs_type)
| otherwise
= pprAlgTyCon exts tyCon (const True) (const True)