[commit: packages/template-haskell] master: Make Pred a type synonym of Type (issue #7021) (57b662c)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/template-haskell

On branch  : master
Link       : http://git.haskell.org/packages/template-haskell.git/commitdiff/57b662c3efd8579595c8642fce2d4cd60ba4ec0b

>---------------------------------------------------------------

commit 57b662c3efd8579595c8642fce2d4cd60ba4ec0b
Author: YoEight <yo.eight at gmail.com>
Date:   Fri Jan 10 21:42:01 2014 +0100

    Make Pred a type synonym of Type (issue #7021)
    
    In order to make any type as a Predicate in Template Haskell, as allowed by ConstraintKinds
    
    Signed-off-by: Richard Eisenberg <eir at cis.upenn.edu>


>---------------------------------------------------------------

57b662c3efd8579595c8642fce2d4cd60ba4ec0b
 Language/Haskell/TH.hs        |    7 +++----
 Language/Haskell/TH/Lib.hs    |   21 ++++++++-------------
 Language/Haskell/TH/Ppr.hs    |    8 ++------
 Language/Haskell/TH/Syntax.hs |    6 ++----
 4 files changed, 15 insertions(+), 27 deletions(-)

diff --git a/Language/Haskell/TH.hs b/Language/Haskell/TH.hs
index 2ab19bd..e9765a9 100644
--- a/Language/Haskell/TH.hs
+++ b/Language/Haskell/TH.hs
@@ -68,7 +68,7 @@ module Language.Haskell.TH(
     -- ** Patterns
         Pat(..), FieldExp, FieldPat,
     -- ** Types
-        Type(..), TyVarBndr(..), TyLit(..), Kind, Cxt, Pred(..), Syntax.Role(..),
+        Type(..), TyVarBndr(..), TyLit(..), Kind, Cxt, Pred, Syntax.Role(..),
 
     -- * Library functions
     -- ** Abbreviations
@@ -105,14 +105,14 @@ module Language.Haskell.TH(
     bindS, letS, noBindS, parS,
 
     -- *** Types
-	forallT, varT, conT, appT, arrowT, listT, tupleT, sigT, litT,
+	forallT, varT, conT, appT, arrowT, equalityT, listT, tupleT, sigT, litT,
     promotedT, promotedTupleT, promotedNilT, promotedConsT,
     -- **** Type literals
     numTyLit, strTyLit,
     -- **** Strictness
 	isStrict, notStrict, strictType, varStrictType,
     -- **** Class Contexts
-    cxt, classP, equalP, normalC, recC, infixC, forallC,
+    cxt, normalC, recC, infixC, forallC,
 
     -- *** Kinds
   varK, conK, tupleK, arrowK, listK, appK, starK, constraintK,
@@ -146,4 +146,3 @@ module Language.Haskell.TH(
 import Language.Haskell.TH.Syntax as Syntax
 import Language.Haskell.TH.Lib
 import Language.Haskell.TH.Ppr
-
diff --git a/Language/Haskell/TH/Lib.hs b/Language/Haskell/TH/Lib.hs
index b7a88d6..17e794b 100644
--- a/Language/Haskell/TH/Lib.hs
+++ b/Language/Haskell/TH/Lib.hs
@@ -466,19 +466,6 @@ tySynEqn lhs rhs =
 cxt :: [PredQ] -> CxtQ
 cxt = sequence
 
-classP :: Name -> [TypeQ] -> PredQ
-classP cla tys
-  = do
-      tys1 <- sequence tys
-      return (ClassP cla tys1)
-
-equalP :: TypeQ -> TypeQ -> PredQ
-equalP tleft tright
-  = do
-      tleft1  <- tleft
-      tright1 <- tright
-      return (EqualP tleft1 tright1)
-
 normalC :: Name -> [StrictTypeQ] -> ConQ
 normalC con strtys = liftM (NormalC con) $ sequence strtys
 
@@ -536,6 +523,14 @@ sigT t k
       t' <- t
       return $ SigT t' k
 
+equalityT :: TypeQ -> TypeQ -> TypeQ
+equalityT tleft tright
+  = do
+      tleft1  <- tleft
+      tright1 <- tright
+      let typ = AppT (AppT EqualityT tleft1) tright1
+      return typ
+
 promotedT :: Name -> TypeQ
 promotedT = return . PromotedT
 
diff --git a/Language/Haskell/TH/Ppr.hs b/Language/Haskell/TH/Ppr.hs
index 2023f3a..e237066 100644
--- a/Language/Haskell/TH/Ppr.hs
+++ b/Language/Haskell/TH/Ppr.hs
@@ -496,6 +496,8 @@ instance Ppr Type where
 
 pprTyApp :: (Type, [Type]) -> Doc
 pprTyApp (ArrowT, [arg1,arg2]) = sep [pprFunArgType arg1 <+> text "->", ppr arg2]
+pprTyApp (EqualityT, [arg1, arg2]) =
+    sep [pprFunArgType arg1 <+> text "~", ppr arg2]
 pprTyApp (ListT, [arg]) = brackets (ppr arg)
 pprTyApp (TupleT n, args)
  | length args == n = parens (sep (punctuate comma (map ppr args)))
@@ -540,11 +542,6 @@ pprCxt [t] = ppr t <+> text "=>"
 pprCxt ts = parens (sep $ punctuate comma $ map ppr ts) <+> text "=>"
 
 ------------------------------
-instance Ppr Pred where
-  ppr (ClassP cla tys) = ppr cla <+> sep (map pprParendType tys)
-  ppr (EqualP ty1 ty2) = pprFunArgType ty1 <+> char '~' <+> pprFunArgType ty2
-
-------------------------------
 instance Ppr Range where
     ppr = brackets . pprRange
         where pprRange :: Range -> Doc
@@ -569,4 +566,3 @@ hashParens d = text "(# " <> d <> text " #)"
 
 quoteParens :: Doc -> Doc
 quoteParens d = text "'(" <> d <> text ")"
-
diff --git a/Language/Haskell/TH/Syntax.hs b/Language/Haskell/TH/Syntax.hs
index 3606f9d..17bb065 100644
--- a/Language/Haskell/TH/Syntax.hs
+++ b/Language/Haskell/TH/Syntax.hs
@@ -1346,9 +1346,7 @@ data AnnTarget = ModuleAnnotation
 
 type Cxt = [Pred]                 -- ^ @(Eq a, Ord b)@
 
-data Pred = ClassP Name [Type]    -- ^ @Eq (Int, a)@
-          | EqualP Type Type      -- ^ @F a ~ Bool@
-          deriving( Show, Eq, Data, Typeable )
+type Pred = Type
 
 data Strict = IsStrict | NotStrict | Unpacked
          deriving( Show, Eq, Data, Typeable )
@@ -1373,6 +1371,7 @@ data Type = ForallT [TyVarBndr] Cxt Type  -- ^ @forall \<vars\>. \<ctxt\> -> \<t
           | TupleT Int                    -- ^ @(,), (,,), etc.@
           | UnboxedTupleT Int             -- ^ @(#,#), (#,,#), etc.@
           | ArrowT                        -- ^ @->@
+          | EqualityT                     -- ^ @~@
           | ListT                         -- ^ @[]@
           | PromotedTupleT Int            -- ^ @'(), '(,), '(,,), etc.@
           | PromotedNilT                  -- ^ @'[]@
@@ -1453,4 +1452,3 @@ cmpEq _  = False
 thenCmp :: Ordering -> Ordering -> Ordering
 thenCmp EQ o2 = o2
 thenCmp o1 _  = o1
-