From dff1f746186dd9ae22adae38a87227e84057cc1f Mon Sep 17 00:00:00 2001
From: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Sat, 2 Nov 2019 09:59:43 -0400
Subject: [PATCH] Follow-up to #406

There was one place where #406 forgot to check for higher-rank types:
the types of data constructors. Easily fixed.
---
 src/Data/Singletons/Single/Data.hs             |  5 +++--
 tests/SingletonsTestSuite.hs                   |  1 +
 tests/compile-and-dump/Singletons/T401b.golden | 13 +++++++++++++
 tests/compile-and-dump/Singletons/T401b.hs     |  8 ++++++++
 4 files changed, 25 insertions(+), 2 deletions(-)
 create mode 100644 tests/compile-and-dump/Singletons/T401b.golden
 create mode 100644 tests/compile-and-dump/Singletons/T401b.hs

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
+  |])