orCond :: Condition -> Condition -> Condition
orCond c1 c2 tc
= case c1 tc of
- Nothing -> Nothing -- c1 succeeds
- Just x -> case c2 tc of -- c1 fails
+ Nothing -> Nothing -- c1 succeeds
+ Just x -> case c2 tc of -- c1 fails
Nothing -> Nothing
Just y -> Just (x $$ ptext (sLit " and") $$ y)
- -- Both fail
+ -- Both fail
andCond :: Condition -> Condition -> Condition
andCond c1 c2 tc = case c1 tc of
cond_stdOK (Just _) _
= Nothing -- Don't check these conservative conditions for
-- standalone deriving; just generate the code
+ -- and let the typechecker handle the result
cond_stdOK Nothing (_, rep_tc)
- | null data_cons = Just (no_cons_why $$ suggestion)
+ | null data_cons = Just (no_cons_why rep_tc $$ suggestion)
| not (null con_whys) = Just (vcat con_whys $$ suggestion)
| otherwise = Nothing
where
suggestion = ptext (sLit "Possible fix: use a standalone deriving declaration instead")
data_cons = tyConDataCons rep_tc
- no_cons_why = quotes (pprSourceTyCon rep_tc) <+>
- ptext (sLit "has no data constructors")
-
con_whys = mapCatMaybes check_con data_cons
check_con :: DataCon -> Maybe SDoc
, all isTauTy (dataConOrigArgTys con) = Nothing
| otherwise = Just (badCon con (ptext (sLit "does not have a Haskell-98 type")))
+no_cons_why :: TyCon -> SDoc
+no_cons_why rep_tc = quotes (pprSourceTyCon rep_tc) <+>
+ ptext (sLit "has no data constructors")
+
cond_enumOrProduct :: Condition
cond_enumOrProduct = cond_isEnumeration `orCond`
(cond_isProduct `andCond` cond_noUnliftedArgs)
cond_isEnumeration :: Condition
cond_isEnumeration (_, rep_tc)
- | isEnumerationTyCon rep_tc = Nothing
- | otherwise = Just why
+ | 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)
| otherwise = Just why
where
why = quotes (pprSourceTyCon rep_tc) <+>
- ptext (sLit "has more than one constructor")
+ ptext (sLit "does not have precisely one constructor")
cond_typeableOK :: Condition
-- OK for Typeable class