diff --git a/src/Data/Singletons/Single/Data.hs b/src/Data/Singletons/Single/Data.hs index ec06ea24..c5db20a0 100644 --- a/src/Data/Singletons/Single/Data.hs +++ b/src/Data/Singletons/Single/Data.hs @@ -131,9 +131,10 @@ singCtor dataName (DCon con_tvbs cxt name fields rty) sName = singDataConName name sCon = DConE sName pCon = DConT name + checkVanillaDType $ DForallT ForallInvis con_tvbs $ ravel types rty indexNames <- mapM (const $ qNewName "n") types - kinds <- mapM promoteType types - rty' <- promoteType rty + kinds <- mapM promoteType_NC types + rty' <- promoteType_NC rty let indices = map DVarT indexNames kindedIndices = zipWith DSigT indices kinds args = map (DAppT singFamily) indices diff --git a/tests/SingletonsTestSuite.hs b/tests/SingletonsTestSuite.hs index 7b8acc69..45afe3d1 100644 --- a/tests/SingletonsTestSuite.hs +++ b/tests/SingletonsTestSuite.hs @@ -119,6 +119,7 @@ tests = , compileAndDumpStdTest "T376" , compileAndDumpStdTest "T378a" , compileAndDumpStdTest "T401" + , compileAndDumpStdTest "T401b" , compileAndDumpStdTest "T402" , compileAndDumpStdTest "T410" , compileAndDumpStdTest "T412" diff --git a/tests/compile-and-dump/Singletons/T401b.golden b/tests/compile-and-dump/Singletons/T401b.golden new file mode 100644 index 00000000..c2586a34 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T401b.golden @@ -0,0 +1,13 @@ + +Singletons/T401b.hs:0:0: error: + `singletons` does not support higher-rank `forall`s +In the type: (forall a_0 . a_0) -> T_1 + + | +5 | $(singletons [d| + | ^^^^^^^^^^^^^^... + +Singletons/T401b.hs:0:0: error: Q monad failure + | +5 | $(singletons [d| + | ^^^^^^^^^^^^^^... diff --git a/tests/compile-and-dump/Singletons/T401b.hs b/tests/compile-and-dump/Singletons/T401b.hs new file mode 100644 index 00000000..c7a77b97 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T401b.hs @@ -0,0 +1,8 @@ +module T401b where + +import Data.Singletons.TH + +$(singletons [d| + newtype T where + MkT :: (forall a. a) -> T + |])