rm_dups [] $ concat deriv_aux_binds
aux_val_binds = ValBindsIn (listToBag aux_binds) aux_sigs
; rn_aux_lhs <- rnTopBindsLHS emptyFsEnv aux_val_binds
- ; let aux_names = collectHsValBinders rn_aux_lhs
-
- ; bindLocalNames aux_names $
- do { (rn_aux, dus_aux) <- rnTopBindsRHS (mkNameSet aux_names) rn_aux_lhs
+ ; bindLocalNames (collectHsValBinders rn_aux_lhs) $
+ do { (rn_aux, dus_aux) <- rnTopBindsRHS rn_aux_lhs
; (rn_inst_infos, fvs_insts) <- mapAndUnzipM rn_inst_info inst_infos
; return (rn_inst_infos, rn_aux `plusHsValBinds` rn_gen,
dus_gen `plusDU` dus_aux `plusDU` usesOnly (plusFVs fvs_insts)) } }
orCond :: Condition -> Condition -> Condition
orCond c1 c2 tc
= case c1 tc of
- Nothing -> Nothing -- c1 succeeds
- Just {} -> c2 tc -- c1 fails, try c2
--- orCond produced just one error message, namely from c2
--- Getting two can be confusing. For a zero-constructor
--- type with a standalone isntance decl, we previously got:
--- Can't make a derived instance of `Bounded (Test a)':
--- `Test' has no data constructors
--- and
--- `Test' does not have precisely one constructor
+ Nothing -> Nothing -- c1 succeeds
+ Just x -> case c2 tc of -- c1 fails
+ Nothing -> Nothing
+ Just y -> Just (x $$ ptext (sLit " and") $$ y)
+ -- Both fail
andCond :: Condition -> Condition -> Condition
andCond c1 c2 tc = case c1 tc of
cond_isEnumeration :: Condition
cond_isEnumeration (_, rep_tc)
- | null (tyConDataCons rep_tc) = Just (no_cons_why rep_tc)
| isEnumerationTyCon rep_tc = Nothing
| otherwise = Just why
where
- why = quotes (pprSourceTyCon rep_tc) <+>
- ptext (sLit "has non-nullary constructors")
+ why = sep [ quotes (pprSourceTyCon rep_tc) <+>
+ ptext (sLit "is not an enumeration type")
+ , nest 2 $ ptext (sLit "(an enumeration consists of one or more nullary constructors)") ]
+ -- See Note [Enumeration types] in TyCon
cond_isProduct :: Condition
cond_isProduct (_, rep_tc)
-- (d) optionally: don't use function types
-- (e) no "stupid context" on data type
cond_functorOK allowFunctions (dflags, rep_tc)
- | not (dopt Opt_DeriveFunctor dflags)
+ | not (xopt Opt_DeriveFunctor dflags)
= Just (ptext (sLit "You need -XDeriveFunctor to derive an instance for this class"))
| null tc_tvs
checkFlag :: ExtensionFlag -> Condition
checkFlag flag (dflags, _)
- | dopt flag dflags = Nothing
+ | xopt flag dflags = Nothing
| otherwise = Just why
where
why = ptext (sLit "You need -X") <> text flag_str
| can_derive_via_isomorphism -> bale_out (non_std $$ suggest_nd) -- Try newtype deriving!
| otherwise -> bale_out non_std
where
- newtype_deriving = dopt Opt_GeneralizedNewtypeDeriving dflags
+ newtype_deriving = xopt Opt_GeneralizedNewtypeDeriving dflags
go_for_it = mk_data_eqn orig tvs cls tycon tc_args rep_tycon rep_tc_args mtheta
bale_out msg = failWithTc (derivingThingErr newtype_deriving cls cls_tys inst_ty msg)