-mk_edges (TyD (TyData ctxt name _ condecls _ _ _))
- = (getItsUnique name, set_to_bag (get_ctxt ctxt `unionUniqSets` get_cons condecls))
-mk_edges (TyD (TyNew ctxt name _ condecl _ _ _))
- = (getItsUnique name, set_to_bag (get_ctxt ctxt `unionUniqSets` get_cons condecl))
-mk_edges (TyD (TySynonym name _ rhs _))
- = (getItsUnique name, set_to_bag (get_ty rhs))
-mk_edges (ClD (ClassDecl ctxt name _ sigs _ _ _))
- = (getItsUnique name, set_to_bag (get_ctxt ctxt `unionUniqSets` get_sigs sigs))
-
-get_ctxt ctxt
- = unionManyUniqSets (map (set_name.fst) ctxt)
-
-get_cons cons
- = unionManyUniqSets (map get_con cons)
- where
- get_con (ConDecl _ btys _)
- = unionManyUniqSets (map get_bty btys)
- get_con (ConOpDecl bty1 _ bty2 _)
- = unionUniqSets (get_bty bty1) (get_bty bty2)
- get_con (NewConDecl _ ty _)
- = get_ty ty
- get_con (RecConDecl _ nbtys _)
- = unionManyUniqSets (map (get_bty.snd) nbtys)
-
- get_bty (Banged ty) = get_ty ty
- get_bty (Unbanged ty) = get_ty ty
-
-get_ty (MonoTyVar tv)
- = emptyUniqSet
-get_ty (MonoTyApp name tys)
- = (if isTyConName name then set_name name else emptyUniqSet)
- `unionUniqSets` get_tys tys
+-- mk_cls_edges looks only at the context of class decls
+-- Its used when we are figuring out if there's a cycle in the
+-- superclass hierarchy
+
+mk_cls_edges :: RenamedHsDecl -> Maybe (RenamedHsDecl, Unique, [Unique])
+
+mk_cls_edges decl@(ClD (ClassDecl ctxt name _ _ _ _ _ _ _))
+ = Just (decl, getUnique name, map (getUnique . fst) ctxt)
+mk_cls_edges other_decl
+ = Nothing
+
+
+mk_edges :: RenamedHsDecl -> Maybe (RenamedHsDecl, Unique, [Unique])
+
+mk_edges decl@(TyD (TyData _ ctxt name _ condecls derivs _ _))
+ = Just (decl, getUnique name, uniqSetToList (get_ctxt ctxt `unionUniqSets`
+ get_cons condecls `unionUniqSets`
+ get_deriv derivs))
+
+mk_edges decl@(TyD (TySynonym name _ rhs _))
+ = Just (decl, getUnique name, uniqSetToList (get_ty rhs))
+
+mk_edges decl@(ClD (ClassDecl ctxt name _ sigs _ _ _ _ _))
+ = Just (decl, getUnique name, uniqSetToList (get_ctxt ctxt `unionUniqSets`
+ get_sigs sigs))
+
+mk_edges other_decl = Nothing
+
+get_ctxt ctxt = unionManyUniqSets (map (set_name.fst) ctxt)
+
+get_deriv Nothing = emptyUniqSet
+get_deriv (Just clss) = unionManyUniqSets (map set_name clss)
+
+get_cons cons = unionManyUniqSets (map get_con cons)
+
+get_con (ConDecl _ _ ctxt details _)
+ = get_ctxt ctxt `unionUniqSets` get_con_details details
+
+get_con_details (VanillaCon btys) = unionManyUniqSets (map get_bty btys)
+get_con_details (InfixCon bty1 bty2) = unionUniqSets (get_bty bty1) (get_bty bty2)
+get_con_details (NewCon ty) = get_ty ty
+get_con_details (RecCon nbtys) = unionManyUniqSets (map (get_bty.snd) nbtys)
+
+get_bty (Banged ty) = get_ty ty
+get_bty (Unbanged ty) = get_ty ty
+
+get_ty (MonoTyVar name)
+ = if isTvOcc (nameOccName name) then emptyUniqSet else set_name name
+get_ty (MonoTyApp ty1 ty2)
+ = unionUniqSets (get_ty ty1) (get_ty ty2)