extend 'deriving' heuristic a little

If an argument of a data constructor has a type variable head, it is
irreducible and the same type class can be copied into the constraint.
(Formerly we just did this for type variable arguments.)

1 files changed, 8 insertions, 6 deletions

diff --git a/src/Main.hs b/src/Main.hs
index c78836f9..b2ea7709 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -659,19 +659,21 @@ derivedInstances mdl decl = case decl of
  where
   derived srcloc ctxt n tvs cons drv =
      [HsInstDecl srcloc
-		 (ctxt ++ [(cls,[v]) | v <- simple_tvars] ++ extra_constraint)
+		 (ctxt ++ [(cls,[t]) | t <- simple_args] ++ extra_constraint)
 		 (cls,[lhs]) [] |
 	cls <- drv]
    where
      targs = map stripDocs (targsConstrs cons)
-     -- a type variable is simple if it occurs as a data constructor argument
-     simple_tvars = map HsTyVar $ Set.elems $ Set.fromList $ [tv | HsTyVar tv <- targs]
+     -- an argument of a data constructor is simple if it has a variable head
+     simple_args = nub $ filter varHead targs
      -- a type variable is complex if it occurs inside a data constructor
      -- argument, except where the argument is identical to the lhs.
      complex_tvars = map HsTyVar $ Set.elems $ Set.unions $ map tvarsType $
-			filter (/= lhs) $ filter (not . isVar) targs
-     isVar (HsTyVar _) = True
-     isVar _ = False
+			filter (/= lhs) $ filter (not . varHead) targs
+     varHead (HsTyVar _) = True
+     varHead (HsTyApp t _) = varHead t
+     varHead (HsTyDoc t _) = varHead t
+     varHead _ = False
      extra_constraint
  	| null complex_tvars = []
  	| otherwise = [(unknownConstraint,complex_tvars)]