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 Cons 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.