Inconsistent validity checks between DataD and NewtypeD
Template Haskell's DataD
data constructor has various invariants that must be upheld when inserting it into a TH splice. One such invariant is that it is only permitted to have an explicit kind signature if its data constructors are all GADT constructors. That is to say, DataD
's Maybe Kind
field is only permitted to be Just
when all of its Con
s are GadtC
or RecGadtC
. The following program demonstrates what happens when that invariant is not upheld:
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -ddump-splices #-}
module Foo where
import Language.Haskell.TH
$(pure [DataD
[] (mkName "D") [] (Just StarT)
[NormalC (mkName "MkD")
[( Bang NoSourceUnpackedness NoSourceStrictness
, ConT ''Int
)]]
[]])
GHC will reject this program with an error message, as it should:
$ ghc-9.4.3 Foo.hs
[1 of 1] Compiling Foo ( Foo.hs, Foo.o )
Foo.hs:8:2: error:
Kind signatures are only allowed on GADTs
When splicing a TH declaration: data D :: * = MkD GHC.Types.Int
|
8 | $(pure [DataD
| ^^^^^^^^^^^^...
Where things get odd is if you replace DataD
with NewtypeD
:
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -ddump-splices #-}
module Foo where
import Language.Haskell.TH
$(pure [NewtypeD
[] (mkName "D") [] (Just StarT)
(NormalC (mkName "MkD")
[( Bang NoSourceUnpackedness NoSourceStrictness
, ConT ''Int
)])
[]])
GHC ought to reject this program as well, since newtype D :: * = MkD Int
is also malformed. Surprisingly, GHC actually accepts this program, however:
$ ghc-9.4.3 Foo.hs
[1 of 1] Compiling Foo ( Foo.hs, Foo.o )
Foo.hs:(8,2)-(14,13): Splicing declarations
pure
[NewtypeD
[] (mkName "D") [] (Just StarT)
(NormalC
(mkName "MkD")
[(Bang NoSourceUnpackedness NoSourceStrictness, ConT ''Int)])
[]]
======>
newtype D :: GHC.Types.Type = MkD Int
This seems inconsistent: if GHC rejects the DataD
program, it ought to reject the NewtypeD
program as well. The culprit can be found in GHC's cvtDec
function. Compare the case for DataD
, which implements validity checks:
cvtDec (DataD ctxt tc tvs ksig constrs derivs)
= do { let isGadtCon (GadtC _ _ _) = True
isGadtCon (RecGadtC _ _ _) = True
isGadtCon (ForallC _ _ c) = isGadtCon c
isGadtCon _ = False
isGadtDecl = all isGadtCon constrs
isH98Decl = all (not . isGadtCon) constrs
; unless (isGadtDecl || isH98Decl)
(failWith CannotMixGADTConsWith98Cons)
; unless (isNothing ksig || isGadtDecl)
(failWith KindSigsOnlyAllowedOnGADTs)
; (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs
; ksig' <- cvtKind `traverse` ksig
; cons' <- mapM cvtConstr constrs
; derivs' <- cvtDerivs derivs
; let defn = HsDataDefn { dd_ext = noExtField
, dd_cType = Nothing
, dd_ctxt = mkHsContextMaybe ctxt'
, dd_kindSig = ksig'
, dd_cons = DataTypeCons False cons'
, dd_derivs = derivs' }
; returnJustLA $ TyClD noExtField $
DataDecl { tcdDExt = noAnn
, tcdLName = tc', tcdTyVars = tvs'
, tcdFixity = Prefix
, tcdDataDefn = defn } }
To the case for NewtypeD
, which does not implement any validity checks:
cvtDec (NewtypeD ctxt tc tvs ksig constr derivs)
= do { (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs
; ksig' <- cvtKind `traverse` ksig
; con' <- cvtConstr constr
; derivs' <- cvtDerivs derivs
; let defn = HsDataDefn { dd_ext = noExtField
, dd_cType = Nothing
, dd_ctxt = mkHsContextMaybe ctxt'
, dd_kindSig = ksig'
, dd_cons = NewTypeCon con'
, dd_derivs = derivs' }
; returnJustLA $ TyClD noExtField $
DataDecl { tcdDExt = noAnn
, tcdLName = tc', tcdTyVars = tvs'
, tcdFixity = Prefix
, tcdDataDefn = defn } }
A natural way to fix this issue, then, would be to factor out the code for the DataD
case and reuse it for the NewtypeD
case, taking care to ensure that dd_cons
is set to the correct value for each case. This will likely be easier to accomplish after !9408 (merged) lands, as that does some preliminary work in factoring out the code for the DataD
case.