Implement roles into Template Haskell.

The biggest change is to the TyVarBndr type, which now can deal
with role annotations.

4 files changed, 31 insertions, 1 deletions

diff --git a/libraries/template-haskell/Language/Haskell/TH.hs b/libraries/template-haskell/Language/Haskell/TH.hs
index 066086e9f9..5064b6aef0 100644
--- a/libraries/template-haskell/Language/Haskell/TH.hs
+++ b/libraries/template-haskell/Language/Haskell/TH.hs
@@ -59,7 +59,7 @@ module Language.Haskell.TH(
     -- ** Patterns
         Pat(..), FieldExp, FieldPat,
     -- ** Types
-        Type(..), TyVarBndr(..), TyLit(..), Kind, Cxt, Pred(..),
+        Type(..), TyVarBndr(..), TyLit(..), Kind, Cxt, Pred(..), Role(..),
 
     -- * Library functions
     -- ** Abbreviations
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib.hs b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
index e29463b9a4..346d87234d 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Lib.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
@@ -566,6 +566,12 @@ plainTV = PlainTV
 kindedTV :: Name -> Kind -> TyVarBndr
 kindedTV = KindedTV
 
+roledTV :: Name -> Role -> TyVarBndr
+roledTV = RoledTV
+
+kindedRoledTV :: Name -> Kind -> Role -> TyVarBndr
+kindedRoledTV = KindedRoledTV
+
 varK :: Name -> Kind
 varK = VarT
 
@@ -591,6 +597,14 @@ constraintK :: Kind
 constraintK = ConstraintT
 
 -------------------------------------------------------------------------------
+-- *   Role
+
+nominal, representational, phantom :: Role
+nominal = Nominal
+representational = Representational
+phantom = Phantom
+
+-------------------------------------------------------------------------------
 -- *   Callconv
 
 cCall, stdCall :: Callconv
diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
index 8bd3b84c5b..4096d9ee1f 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
@@ -485,6 +485,14 @@ instance Ppr TyLit where
 instance Ppr TyVarBndr where
     ppr (PlainTV nm)    = ppr nm
     ppr (KindedTV nm k) = parens (ppr nm <+> text "::" <+> ppr k)
+    ppr (RoledTV nm r)  = ppr nm <> text "@" <> ppr r
+    ppr (KindedRoledTV nm k r)
+      = parens (ppr nm <+> text "::" <+> ppr k) <> text "@" <> ppr r
+
+instance Ppr Role where
+    ppr Nominal          = text "N"
+    ppr Representational = text "R"
+    ppr Phantom          = text "P"
 
 ------------------------------
 pprCxt :: Cxt -> Doc
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index 9d6ae939e6..2995b58791 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -1258,12 +1258,20 @@ data Type = ForallT [TyVarBndr] Cxt Type  -- ^ @forall \<vars\>. \<ctxt\> -> \<t
 
 data TyVarBndr = PlainTV  Name            -- ^ @a@
                | KindedTV Name Kind       -- ^ @(a :: k)@
+               | RoledTV  Name Role       -- ^ @a\@R@
+               | KindedRoledTV Name Kind Role -- ^ @(a :: k)\@R@
       deriving( Show, Eq, Data, Typeable )
 
 data TyLit = NumTyLit Integer             -- ^ @2@
            | StrTyLit String              -- ^ @"Hello"@
   deriving ( Show, Eq, Data, Typeable )
 
+-- | Role annotations
+data Role = Nominal            -- ^ @N@
+          | Representational   -- ^ @R@
+          | Phantom            -- ^ @P@
+  deriving( Show, Eq, Data, Typeable )
+
 -- | To avoid duplication between kinds and types, they
 -- are defined to be the same. Naturally, you would never
 -- have a type be 'StarT' and you would never have a kind