Fix #11357.
authorRichard Eisenberg <eir@cis.upenn.edu>
Tue, 15 Mar 2016 17:49:15 +0000 (13:49 -0400)
committerRichard Eisenberg <eir@cis.upenn.edu>
Tue, 15 Mar 2016 17:49:15 +0000 (13:49 -0400)
We were looking at a data instance tycon for visibility info,
which is the wrong place to look. Look at the data family tycon
instead.

Also improved the pretty-printing near there to suppress kind
arguments when appropriate.

compiler/typecheck/TcDeriv.hs
compiler/typecheck/TcGenGenerics.hs
testsuite/tests/deriving/should_compile/T11357.hs [new file with mode: 0644]
testsuite/tests/deriving/should_compile/all.T

index e98ca88..90d9816 100644 (file)
@@ -1240,10 +1240,10 @@ no_cons_why rep_tc = quotes (pprSourceTyCon rep_tc) <+>
                      text "must have at least one data constructor"
 
 cond_RepresentableOk :: Condition
-cond_RepresentableOk (_, tc, tc_args) = canDoGenerics tc tc_args
+cond_RepresentableOk (dflags, tc, tc_args) = canDoGenerics dflags tc tc_args
 
 cond_Representable1Ok :: Condition
-cond_Representable1Ok (_, tc, tc_args) = canDoGenerics1 tc tc_args
+cond_Representable1Ok (dflags, tc, tc_args) = canDoGenerics1 dflags tc tc_args
 
 cond_enumOrProduct :: Class -> Condition
 cond_enumOrProduct cls = cond_isEnumeration `orCond`
index 08b3c9a..0477767 100644 (file)
@@ -18,6 +18,7 @@ import Type
 import TcType
 import TcGenDeriv
 import DataCon
+import DynFlags    ( DynFlags, GeneralFlag(Opt_PrintExplicitKinds), gopt )
 import TyCon
 import FamInstEnv       ( FamInst, FamFlavor(..), mkSingleCoAxiom )
 import FamInst
@@ -128,7 +129,7 @@ following constraints are satisfied.
 
 -}
 
-canDoGenerics :: TyCon -> [Type] -> Validity
+canDoGenerics :: DynFlags -> TyCon -> [Type] -> Validity
 -- canDoGenerics rep_tc tc_args determines if Generic/Rep can be derived for a
 -- type expression (rep_tc tc_arg0 tc_arg1 ... tc_argn).
 --
@@ -136,7 +137,7 @@ canDoGenerics :: TyCon -> [Type] -> Validity
 -- care of because canDoGenerics is applied to rep tycons.
 --
 -- It returns Nothing if deriving is possible. It returns (Just reason) if not.
-canDoGenerics tc tc_args
+canDoGenerics dflags tc tc_args
   = mergeErrors (
           -- Check (c) from Note [Requirements for deriving Generic and Rep].
               (if (not (null (tyConStupidTheta tc)))
@@ -146,7 +147,12 @@ canDoGenerics tc tc_args
           --
           -- Data family indices can be instantiated; the `tc_args` here are
           -- the representation tycon args
-              (if (all isTyVarTy (filterOutInvisibleTypes tc tc_args))
+          --
+          -- NB: Use user_tc here. In the case of a data *instance*, the
+          -- user_tc is the family tc, which has the right visibility settings.
+          -- (For a normal datatype, user_tc == tc.) Getting this wrong
+          -- led to #11357.
+              (if (all isTyVarTy (filterOutInvisibleTypes user_tc tc_args))
                 then IsValid
                 else NotValid (tc_name <+> text "must not be instantiated;" <+>
                                text "try deriving `" <> tc_name <+> tc_tys <>
@@ -156,9 +162,14 @@ canDoGenerics tc tc_args
   where
     -- The tc can be a representation tycon. When we want to display it to the
     -- user (in an error message) we should print its parent
-    (tc_name, tc_tys) = case tyConFamInst_maybe tc of
-        Just (ptc, tys) -> (ppr ptc, hsep (map ppr (tys ++ drop (length tys) tc_args)))
-        _               -> (ppr tc, hsep (map ppr (tyConTyVars tc)))
+    (user_tc, tc_name, tc_tys) = case tyConFamInst_maybe tc of
+        Just (ptc, tys) -> (ptc, ppr ptc, hsep (map ppr (filter_kinds $ tys ++ drop (length tys) tc_args)))
+        _               -> (tc, ppr tc, hsep (map ppr (filter_kinds $ mkTyVarTys $ tyConTyVars tc)))
+
+    filter_kinds | gopt Opt_PrintExplicitKinds dflags
+                 = id
+                 | otherwise
+                 = filterOutInvisibleTypes user_tc
 
         -- Check (d) from Note [Requirements for deriving Generic and Rep].
         --
@@ -228,9 +239,9 @@ explicitly, even though foldDataConArgs is also doing this internally.
 -- are taken care of by the call to canDoGenerics.
 --
 -- It returns Nothing if deriving is possible. It returns (Just reason) if not.
-canDoGenerics1 :: TyCon -> [Type] -> Validity
-canDoGenerics1 rep_tc tc_args =
-  canDoGenerics rep_tc tc_args `andValid` additionalChecks
+canDoGenerics1 :: DynFlags -> TyCon -> [Type] -> Validity
+canDoGenerics1 dflags rep_tc tc_args =
+  canDoGenerics dflags rep_tc tc_args `andValid` additionalChecks
   where
     additionalChecks
         -- check (f) from Note [Requirements for deriving Generic and Rep]
diff --git a/testsuite/tests/deriving/should_compile/T11357.hs b/testsuite/tests/deriving/should_compile/T11357.hs
new file mode 100644 (file)
index 0000000..f3dc715
--- /dev/null
@@ -0,0 +1,10 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+module T11357 where
+
+import GHC.Generics (Generic1)
+
+data family   ProxyFam (a :: k)
+data instance ProxyFam (a :: k) = ProxyCon deriving Generic1
index ad235d6..e62c50c 100644 (file)
@@ -64,3 +64,4 @@ test('T9968', normal, compile, [''])
 test('T11174', normal, compile, [''])
 test('T11416', normal, compile, [''])
 test('T11396', normal, compile, [''])
+test('T11357', normal, compile, [''])