TH: revert changes to GadtC & RecGadtC

Commit 3f374399 included a breaking-change to the template-haskell
library when it made the GadtC and RecGadtC constructors take non-empty
lists of names. As this has the potential to break many users' packages,
we decided to revert these changes for now.

4 files changed, 22 insertions, 24 deletions

diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
index 542f1e16b6..8d0cf5adde 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
@@ -23,7 +23,7 @@ import qualified Language.Haskell.TH.Syntax as TH
 import Control.Applicative(liftA, Applicative(..))
 import qualified Data.Kind as Kind (Type)
 import Data.Word( Word8 )
-import Data.List.NonEmpty ( NonEmpty(..), toList )
+import Data.List.NonEmpty ( NonEmpty(..) )
 import GHC.Exts (TYPE)
 import Prelude hiding (Applicative(..))
 
@@ -680,10 +680,10 @@ forallC ns ctxt con = do
   con'  <- con
   pure $ ForallC ns' ctxt' con'
 
-gadtC :: Quote m => NonEmpty Name -> [m StrictType] -> m Type -> m Con
+gadtC :: Quote m => [Name] -> [m StrictType] -> m Type -> m Con
 gadtC cons strtys ty = liftA2 (GadtC cons) (sequenceA strtys) ty
 
-recGadtC :: Quote m => NonEmpty Name -> [m VarStrictType] -> m Type -> m Con
+recGadtC :: Quote m => [Name] -> [m VarStrictType] -> m Type -> m Con
 recGadtC cons varstrtys ty = liftA2 (RecGadtC cons) (sequenceA varstrtys) ty
 
 -------------------------------------------------------------------------------
@@ -1177,7 +1177,7 @@ docCons :: (Q Con, Maybe String, [Maybe String]) -> Q ()
 docCons (c, md, arg_docs) = do
   c' <- c
   -- Attach docs to the constructors
-  sequence_ [ putDoc (DeclDoc nm) d | Just d <- [md], nm <- toList $ get_cons_names c' ]
+  sequence_ [ putDoc (DeclDoc nm) d | Just d <- [md], nm <- get_cons_names c' ]
   -- Attach docs to the arguments
   case c' of
     -- Record selector documentation isn't stored in the argument map,
@@ -1188,6 +1188,6 @@ docCons (c, md, arg_docs) = do
                 ]
     _ ->
       sequence_ [ putDoc (ArgDoc nm i) arg_doc
-                    | nm <- toList $ get_cons_names c'
+                    | nm <- get_cons_names c'
                     , (i, Just arg_doc) <- zip [0..] arg_docs
                 ]
diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
index d3101a985b..034d2687b3 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
@@ -11,7 +11,6 @@ module Language.Haskell.TH.Ppr where
 import Text.PrettyPrint (render)
 import Language.Haskell.TH.PprLib
 import Language.Haskell.TH.Syntax
-import qualified Data.List.NonEmpty as NE ( toList )
 import Data.Word ( Word8 )
 import Data.Char ( toLower, chr)
 import GHC.Show  ( showMultiLineString )
@@ -684,21 +683,21 @@ instance Ppr Con where
                          <+> pprBangType st2
 
     ppr (ForallC ns ctxt (GadtC cs sts ty))
-        = commaSepApplied (NE.toList cs) <+> dcolon <+> pprForall ns ctxt
+        = commaSepApplied cs <+> dcolon <+> pprForall ns ctxt
       <+> pprGadtRHS sts ty
 
     ppr (ForallC ns ctxt (RecGadtC cs vsts ty))
-        = commaSepApplied (NE.toList cs) <+> dcolon <+> pprForall ns ctxt
+        = commaSepApplied cs <+> dcolon <+> pprForall ns ctxt
       <+> pprRecFields vsts ty
 
     ppr (ForallC ns ctxt con)
         = pprForall ns ctxt <+> ppr con
 
     ppr (GadtC cs sts ty)
-        = commaSepApplied (NE.toList cs) <+> dcolon <+> pprGadtRHS sts ty
+        = commaSepApplied cs <+> dcolon <+> pprGadtRHS sts ty
 
     ppr (RecGadtC cs vsts ty)
-        = commaSepApplied (NE.toList cs) <+> dcolon <+> pprRecFields vsts ty
+        = commaSepApplied cs <+> dcolon <+> pprRecFields vsts ty
 
 instance Ppr PatSynDir where
   ppr Unidir        = text "<-"
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index 221fd5ca28..6d96d414c6 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -48,7 +48,6 @@ import System.IO        ( hPutStrLn, stderr )
 import Data.Char        ( isAlpha, isAlphaNum, isUpper, ord )
 import Data.Int
 import Data.List.NonEmpty ( NonEmpty(..) )
-import qualified Data.List.NonEmpty as NE ( singleton )
 import Data.Void        ( Void, absurd )
 import Data.Word
 import Data.Ratio
@@ -2732,16 +2731,20 @@ data Con =
   | ForallC [TyVarBndr Specificity] Cxt Con
 
   -- @C :: a -> b -> T b Int@
-  | GadtC (NonEmpty Name)
+  | GadtC [Name]
             -- ^ The list of constructors, corresponding to the GADT constructor
-            -- syntax @C1, C2 :: a -> T b@
+            -- syntax @C1, C2 :: a -> T b@.
+            --
+            -- Invariant: the list must be non-empty.
           [BangType] -- ^ The constructor arguments
           Type -- ^ See Note [GADT return type]
 
   -- | @C :: { v :: Int } -> T b Int@
-  | RecGadtC (NonEmpty Name)
+  | RecGadtC [Name]
              -- ^ The list of constructors, corresponding to the GADT record
-             -- constructor syntax @C1, C2 :: { fld :: a } -> T b@
+             -- constructor syntax @C1, C2 :: { fld :: a } -> T b@.
+             --
+             -- Invariant: the list must be non-empty.
              [VarBangType] -- ^ The constructor arguments
              Type -- ^ See Note [GADT return type]
         deriving (Show, Eq, Ord, Data, Generic)
@@ -2941,14 +2944,14 @@ thenCmp :: Ordering -> Ordering -> Ordering
 thenCmp EQ o2 = o2
 thenCmp o1 _  = o1
 
-get_cons_names :: Con -> NonEmpty Name
-get_cons_names (NormalC n _)     = NE.singleton n
-get_cons_names (RecC n _)        = NE.singleton n
-get_cons_names (InfixC _ n _)    = NE.singleton n
+get_cons_names :: Con -> [Name]
+get_cons_names (NormalC n _)     = [n]
+get_cons_names (RecC n _)        = [n]
+get_cons_names (InfixC _ n _)    = [n]
 get_cons_names (ForallC _ _ con) = get_cons_names con
 -- GadtC can have multiple names, e.g
 -- > data Bar a where
 -- >   MkBar1, MkBar2 :: a -> Bar a
 -- Will have one GadtC with [MkBar1, MkBar2] as names
 get_cons_names (GadtC ns _ _)    = ns
-get_cons_names (RecGadtC ns _ _) = ns
\ No newline at end of file
+get_cons_names (RecGadtC ns _ _) = ns
diff --git a/libraries/template-haskell/changelog.md b/libraries/template-haskell/changelog.md
index 821c776d96..f6ed4d6b5f 100644
--- a/libraries/template-haskell/changelog.md
+++ b/libraries/template-haskell/changelog.md
@@ -2,10 +2,6 @@
 
 ## 2.21.0.0
 
-  * The `GadtC` and `RecGadtC` constructors of the `Con` datatype now take
-    non-empty lists of constructors. This means that the `gadtC` and `recGadtC`
-    smart constructors also expect non-empty lists as arguments.
-
   * Record fields now belong to separate `NameSpace`s, keyed by the parent of
     the record field. This is the name of the first constructor of the parent type,
     even if this constructor does not have the field in question.