Commit 88e7faf1 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

Suggest -XGeneralizedNewtypeDeriving (fix Trac #3888)

If we can't derive a type, but it's a reasonable possibility that
newtype deriving would do the job, suggest it. 

A little refactoring too, moving non_iso_class to top level,
and putting it with std_class_via_iso.
parent 6d0b77ef
......@@ -965,13 +965,25 @@ checkFlag flag (dflags, _)
other -> pprPanic "checkFlag" (ppr other)
std_class_via_iso :: Class -> Bool
std_class_via_iso clas -- These standard classes can be derived for a newtype
-- using the isomorphism trick *even if no -fglasgow-exts*
-- These standard classes can be derived for a newtype
-- using the isomorphism trick *even if no -XGeneralizedNewtypeDeriving
-- because giving so gives the same results as generating the boilerplate
std_class_via_iso clas
= classKey clas `elem` [eqClassKey, ordClassKey, ixClassKey, boundedClassKey]
-- Not Read/Show because they respect the type
-- Not Enum, because newtypes are never in Enum
non_iso_class :: Class -> Bool
-- *Never* derive Read,Show,Typeable,Data by isomorphism,
-- even with -XGeneralizedNewtypeDeriving
non_iso_class cls
= classKey cls `elem` ([readClassKey, showClassKey, dataClassKey] ++
typeableClassKeys)
typeableClassKeys :: [Unique]
typeableClassKeys = map getUnique typeableClassNames
new_dfun_name :: Class -> TyCon -> TcM Name
new_dfun_name clas tycon -- Just a simple wrapper
= do { loc <- getSrcSpanM -- The location of the instance decl, not of the tycon
......@@ -1038,17 +1050,20 @@ mkNewTypeEqn orig dflags tvs
| otherwise
= case checkSideConditions dflags mtheta cls cls_tys rep_tycon of
CanDerive -> go_for_it -- Use the standard H98 method
DerivableClassError msg -> bale_out msg -- Error with standard class
DerivableClassError msg -- Error with standard class
| can_derive_via_isomorphism -> bale_out (msg $$ suggest_nd)
| otherwise -> bale_out msg
NonDerivableClass -- Must use newtype deriving
| newtype_deriving -> bale_out cant_derive_err -- Too hard, even with newtype deriving
| otherwise -> bale_out non_std_err -- Try newtype deriving!
| 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
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)
non_std_err = nonStdErr cls $$
ptext (sLit "Try -XGeneralizedNewtypeDeriving for GHC's newtype-deriving extension")
non_std = nonStdErr cls
suggest_nd = ptext (sLit "Try -XGeneralizedNewtypeDeriving for GHC's newtype-deriving extension")
-- Here is the plan for newtype derivings. We see
-- newtype T a1...an = MkT (t ak+1...an) deriving (.., C s1 .. sm, ...)
......@@ -1132,10 +1147,6 @@ mkNewTypeEqn orig dflags tvs
&& ats_ok
-- && not (isRecursiveTyCon tycon) -- Note [Recursive newtypes]
-- Never derive Read,Show,Typeable,Data by isomorphism
non_iso_class cls = className cls `elem` ([readClassName, showClassName, dataClassName] ++
typeableClassNames)
arity_ok = length cls_tys + 1 == classArity cls
-- Well kinded; eg not: newtype T ... deriving( ST )
-- because ST needs *2* type params
......
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