Commit 1eefedf7 authored by eir@cis.upenn.edu's avatar eir@cis.upenn.edu
Browse files

Fix #11357.

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.
parent 857e9b02
......@@ -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`
......
......@@ -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]
......
{-# 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
......@@ -64,3 +64,4 @@ test('T9968', normal, compile, [''])
test('T11174', normal, compile, [''])
test('T11416', normal, compile, [''])
test('T11396', normal, compile, [''])
test('T11357', normal, compile, [''])
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