diff --git a/CHANGES.md b/CHANGES.md
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,3 +1,8 @@
+Version 1.3.0
+-------------
+* Update to work with `type Pred = Type` in GHC 7.9. This changed the
+`DPred` type for all GHC versions, though.
+
 Version 1.2.0
 -------------
 * Generalized interface to allow any member of the `Qausi` class, instead of
diff --git a/Language/Haskell/TH/Desugar/Core.hs b/Language/Haskell/TH/Desugar/Core.hs
--- a/Language/Haskell/TH/Desugar/Core.hs
+++ b/Language/Haskell/TH/Desugar/Core.hs
@@ -48,12 +48,12 @@
              deriving (Show, Typeable, Data)
 
 -- | Corresponds to TH's @Pat@ type.
-data DPat = DLitP Lit
-          | DVarP Name
-          | DConP Name [DPat]
-          | DTildeP DPat
-          | DBangP DPat
-          | DWildP
+data DPat = DLitPa Lit
+          | DVarPa Name
+          | DConPa Name [DPat]
+          | DTildePa DPat
+          | DBangPa DPat
+          | DWildPa
           deriving (Show, Typeable, Data)
 
 -- | Corresponds to TH's @Type@ type.
@@ -79,8 +79,10 @@
 type DCxt = [DPred]
 
 -- | Corresponds to TH's @Pred@
-data DPred = DClassP Name [DType]
-           | DEqualP DType DType
+data DPred = DAppPr DPred DType
+           | DSigPr DPred DKind
+           | DVarPr Name
+           | DConPr Name
            deriving (Show, Typeable, Data)
 
 -- | Corresponds to TH's @TyVarBndr@. Note that @PlainTV x@ and @KindedTV x StarT@ are
@@ -129,7 +131,7 @@
   e1' <- dsExp e1
   e2' <- dsExp e2
   e3' <- dsExp e3
-  return $ DCaseE e1' [DMatch (DConP 'True []) e2', DMatch (DConP 'False []) e3']
+  return $ DCaseE e1' [DMatch (DConPa 'True []) e2', DMatch (DConPa 'False []) e3']
 dsExp (MultiIfE guarded_exps) =
   let failure = DAppE (DVarE 'error) (DLitE (StringL "None-exhaustive guards in multi-way if")) in
   dsGuards guarded_exps failure
@@ -138,7 +140,7 @@
   scrutinee <- qNewName "scrutinee"
   exp' <- dsExp exp
   matches' <- dsMatches scrutinee matches
-  return $ DLetE [DValD (DVarP scrutinee) exp'] $
+  return $ DLetE [DValD (DVarPa scrutinee) exp'] $
            DCaseE (DVarE scrutinee) matches'
 dsExp (DoE stmts) = dsDoStmts stmts
 dsExp (CompE stmts) = dsComp stmts
@@ -200,12 +202,12 @@
     con_to_dmatch (RecC con_name args) = do
       let con_field_names = map fst_of_3 args
       field_var_names <- mapM (qNewName . nameBase) con_field_names
-      DMatch (DConP con_name (map DVarP field_var_names)) <$>
+      DMatch (DConPa con_name (map DVarPa field_var_names)) <$>
              (foldl DAppE (DConE con_name) <$>
                     (reorderFields args field_exps (map DVarE field_var_names)))
     con_to_dmatch _ = impossible "Internal error within th-desugar."
 
-    error_match = DMatch DWildP (DAppE (DVarE 'error)
+    error_match = DMatch DWildPa (DAppE (DVarE 'error)
                     (DLitE (StringL "Non-exhaustive patterns in record update")))
 
     fst_of_3 (x, _, _) = x
@@ -283,7 +285,7 @@
   success' <- dsGuardStmts rest success failure
   (pat', success'') <- dsPatOverExp pat success'
   exp' <- dsExp exp
-  return $ DCaseE exp' [DMatch pat' success'', DMatch DWildP failure]
+  return $ DCaseE exp' [DMatch pat' success'', DMatch DWildPa failure]
 dsGuardStmts (LetS decs : rest) success failure = do
   decs' <- dsLetDecs decs
   success' <- dsGuardStmts rest success failure
@@ -291,8 +293,8 @@
 dsGuardStmts (NoBindS exp : rest) success failure = do
   exp' <- dsExp exp
   success' <- dsGuardStmts rest success failure
-  return $ DCaseE exp' [ DMatch (DConP 'True []) success'
-                       , DMatch (DConP 'False []) failure ]
+  return $ DCaseE exp' [ DMatch (DConPa 'True []) success'
+                       , DMatch (DConPa 'False []) failure ]
 dsGuardStmts (ParS _ : _) _ _ = impossible "Parallel comprehension in a pattern guard."
 
 -- | Desugar the @Stmt@s in a @do@ expression
@@ -359,14 +361,14 @@
 dsPatOverExp :: Quasi q => Pat -> DExp -> q (DPat, DExp)
 dsPatOverExp pat exp = do
   (pat', vars) <- runWriterT $ dsPat pat
-  let name_decs = uncurry (zipWith (DValD . DVarP)) $ unzip vars
+  let name_decs = uncurry (zipWith (DValD . DVarPa)) $ unzip vars
   return (pat', maybeDLetE name_decs exp)
 
 -- | Desugar multiple patterns. Like 'dsPatOverExp'.
 dsPatsOverExp :: Quasi q => [Pat] -> DExp -> q ([DPat], DExp)
 dsPatsOverExp pats exp = do
   (pats', vars) <- runWriterT $ mapM dsPat pats
-  let name_decs = uncurry (zipWith (DValD . DVarP)) $ unzip vars
+  let name_decs = uncurry (zipWith (DValD . DVarPa)) $ unzip vars
   return (pats', maybeDLetE name_decs exp)
 
 -- | Desugar a pattern, returning a list of (Name, DExp) pairs of extra
@@ -381,37 +383,37 @@
 
 -- | Desugar a pattern.
 dsPat :: Quasi q => Pat -> PatM q DPat
-dsPat (LitP lit) = return $ DLitP lit
-dsPat (VarP n) = return $ DVarP n
-dsPat (TupP pats) = DConP (tupleDataName (length pats)) <$> mapM dsPat pats
-dsPat (UnboxedTupP pats) = DConP (unboxedTupleDataName (length pats)) <$>
+dsPat (LitP lit) = return $ DLitPa lit
+dsPat (VarP n) = return $ DVarPa n
+dsPat (TupP pats) = DConPa (tupleDataName (length pats)) <$> mapM dsPat pats
+dsPat (UnboxedTupP pats) = DConPa (unboxedTupleDataName (length pats)) <$>
                            mapM dsPat pats
-dsPat (ConP name pats) = DConP name <$> mapM dsPat pats
-dsPat (InfixP p1 name p2) = DConP name <$> mapM dsPat [p1, p2]
+dsPat (ConP name pats) = DConPa name <$> mapM dsPat pats
+dsPat (InfixP p1 name p2) = DConPa name <$> mapM dsPat [p1, p2]
 dsPat (UInfixP _ _ _) =
   fail "Cannot desugar unresolved infix operators."
 dsPat (ParensP pat) = dsPat pat
-dsPat (TildeP pat) = DTildeP <$> dsPat pat
-dsPat (BangP pat) = DBangP <$> dsPat pat
+dsPat (TildeP pat) = DTildePa <$> dsPat pat
+dsPat (BangP pat) = DBangPa <$> dsPat pat
 dsPat (AsP name pat) = do
   pat' <- dsPat pat
   pat'' <- lift $ removeWilds pat'
   tell [(name, dPatToDExp pat'')]
   return pat''
-dsPat WildP = return DWildP
+dsPat WildP = return DWildPa
 dsPat (RecP con_name field_pats) = do
   con <- lift $ dataConNameToCon con_name
   reordered <- case con of
     RecC _name fields -> reorderFieldsPat fields field_pats
     _ -> lift $ impossible $ "Record syntax used with non-record constructor "
                              ++ (show con_name) ++ "."
-  return $ DConP con_name reordered
+  return $ DConPa con_name reordered
 dsPat (ListP pats) = go pats
-  where go [] = return $ DConP '[] []
+  where go [] = return $ DConPa '[] []
         go (h : t) = do
           h' <- dsPat h
           t' <- go t
-          return $ DConP '(:) [h', t']
+          return $ DConPa '(:) [h', t']
 dsPat (SigP _ _) =
   lift $ impossible
              ("At last check (Aug 2013), type patterns in signatures are not\n" ++
@@ -421,22 +423,22 @@
 
 -- | Convert a 'DPat' to a 'DExp'. Fails on 'DWildP'.
 dPatToDExp :: DPat -> DExp
-dPatToDExp (DLitP lit) = DLitE lit
-dPatToDExp (DVarP name) = DVarE name
-dPatToDExp (DConP name pats) = foldl DAppE (DConE name) (map dPatToDExp pats)
-dPatToDExp (DTildeP pat) = dPatToDExp pat
-dPatToDExp (DBangP pat) = dPatToDExp pat
-dPatToDExp DWildP = error "Internal error in th-desugar: wildcard in rhs of as-pattern"
+dPatToDExp (DLitPa lit) = DLitE lit
+dPatToDExp (DVarPa name) = DVarE name
+dPatToDExp (DConPa name pats) = foldl DAppE (DConE name) (map dPatToDExp pats)
+dPatToDExp (DTildePa pat) = dPatToDExp pat
+dPatToDExp (DBangPa pat) = dPatToDExp pat
+dPatToDExp DWildPa = error "Internal error in th-desugar: wildcard in rhs of as-pattern"
 
 -- | Remove all wildcards from a pattern, replacing any wildcard with a fresh
 --   variable
 removeWilds :: Quasi q => DPat -> q DPat
-removeWilds p@(DLitP _) = return p
-removeWilds p@(DVarP _) = return p
-removeWilds (DConP con_name pats) = DConP con_name <$> mapM removeWilds pats
-removeWilds (DTildeP pat) = DTildeP <$> removeWilds pat
-removeWilds (DBangP pat) = DBangP <$> removeWilds pat
-removeWilds DWildP = DVarP <$> qNewName "wild"
+removeWilds p@(DLitPa _) = return p
+removeWilds p@(DVarPa _) = return p
+removeWilds (DConPa con_name pats) = DConPa con_name <$> mapM removeWilds pats
+removeWilds (DTildePa pat) = DTildePa <$> removeWilds pat
+removeWilds (DBangPa pat) = DBangPa <$> removeWilds pat
+removeWilds DWildPa = DVarPa <$> qNewName "wild"
 
 -- | Desugar @Dec@s that can appear in a let expression
 dsLetDecs :: Quasi q => [Dec] -> q [DLetDec]
@@ -450,7 +452,7 @@
 dsLetDec (ValD pat body where_decs) = do
   (pat', vars) <- dsPatX pat
   body' <- dsBody body where_decs error_exp
-  let extras = uncurry (zipWith (DValD . DVarP)) $ unzip vars
+  let extras = uncurry (zipWith (DValD . DVarPa)) $ unzip vars
   return $ DValD pat' body' : extras
   where
     error_exp = DAppE (DVarE 'error) (DLitE
@@ -478,7 +480,7 @@
 dsClauses n clauses@(Clause outer_pats _ _ : _) = do
   arg_names <- replicateM (length outer_pats) (qNewName "arg")
   let scrutinee = mkTupleDExp (map DVarE arg_names)
-  clause <- DClause (map DVarP arg_names) <$>
+  clause <- DClause (map DVarPa arg_names) <$>
               (DCaseE scrutinee <$> foldrM (clause_to_dmatch scrutinee) [] clauses)
   return [clause]
   where
@@ -492,7 +494,7 @@
                                   scrutinee failure_matches
 -- | Desugar a type
 dsType :: Quasi q => Type -> q DType
-dsType (ForallT tvbs preds ty) = DForallT <$> mapM dsTvb tvbs <*> mapM dsPred preds <*> dsType ty
+dsType (ForallT tvbs preds ty) = DForallT <$> mapM dsTvb tvbs <*> concatMapM dsPred preds <*> dsType ty
 dsType (AppT t1 t2) = DAppT <$> dsType t1 <*> dsType t2
 dsType (SigT ty ki) = DSigT <$> dsType ty <*> dsKind ki
 dsType (VarT name) = return $ DVarT name
@@ -512,16 +514,59 @@
 dsType StarT = impossible "The kind * seen in a type."
 dsType ConstraintT = impossible "The kind `Constraint' seen in a type."
 dsType (LitT lit) = return $ DLitT lit
+#if __GLASGOW_HASKELL__ >= 709
+dsType EqualityT = return $ DConT ''(~)
+#endif
 
 -- | Desugar a @TyVarBndr@
 dsTvb :: Quasi q => TyVarBndr -> q DTyVarBndr
 dsTvb (PlainTV n) = return $ DPlainTV n
 dsTvb (KindedTV n k) = DKindedTV n <$> dsKind k
 
--- | Desugar a @Pred@
-dsPred :: Quasi q => Pred -> q DPred
-dsPred (ClassP n tys) = DClassP n <$> mapM dsType tys
-dsPred (EqualP t1 t2) = DEqualP <$> dsType t1 <*> dsType t2
+-- | Desugar a @Pred@, flattening any internal tuples
+dsPred :: Quasi q => Pred -> q DCxt
+#if __GLASGOW_HASKELL__ < 709
+dsPred (ClassP n tys) = do
+  ts' <- mapM dsType tys
+  return [foldl DAppPr (DConPr n) ts']
+dsPred (EqualP t1 t2) = do
+  ts' <- mapM dsType [t1, t2]
+  return [foldl DAppPr (DConPr ''(~)) ts']
+#else
+dsPred t
+  | Just ts <- splitTuple_maybe t
+  = concatMapM dsPred ts
+dsPred t@(ForallT _ _ _) = impossible $ "Forall seen in constraint: " ++ show t
+dsPred (AppT t1 t2) = do
+  [p1] <- dsPred t1   -- tuples can't be applied!
+  (:[]) <$> DAppPr p1 <$> dsType t2
+dsPred (SigT ty ki) = do
+  preds <- dsPred ty
+  case preds of
+    [p]   -> (:[]) <$> DSigPr p <$> dsKind ki
+    other -> return other   -- just drop the kind signature on a tuple.
+dsPred (VarT n) = return [DVarPr n]
+dsPred (ConT n) = return [DConPr n]
+dsPred t@(PromotedT _) =
+  impossible $ "Promoted type seen as head of constraint: " ++ show t
+dsPred (TupleT 0) = return [DConPr (tupleTypeName 0)]
+dsPred (TupleT _) =
+  impossible "Internal error in th-desugar in detecting tuple constraints."
+dsPred t@(UnboxedTupleT _) =
+  impossible $ "Unboxed tuple seen as head of constraint: " ++ show t
+dsPred ArrowT = impossible "Arrow seen as head of constraint."
+dsPred ListT  = impossible "List seen as head of constraint."
+dsPred (PromotedTupleT _) =
+  impossible "Promoted tuple seen as head of constraint."
+dsPred PromotedNilT  = impossible "Promoted nil seen as head of constraint."
+dsPred PromotedConsT = impossible "Promoted cons seen as head of constraint."
+dsPred StarT         = impossible "* seen as head of constraint."
+dsPred ConstraintT =
+  impossible "The kind `Constraint' seen as head of constraint."
+dsPred t@(LitT _) =
+  impossible $ "Type literal seen as head of constraint: " ++ show t
+dsPred EqualityT = return [DConPr ''(~)]
+#endif
 
 -- | Desugar a kind
 dsKind :: Quasi q => Kind -> q DKind
@@ -554,6 +599,9 @@
 dsKind StarT = return DStarK
 dsKind ConstraintT = return $ DConK ''Constraint []
 dsKind (LitT _) = impossible "Literal used in a kind."
+#if __GLASGOW_HASKELL__ >= 709
+dsKind EqualityT = impossible "(~) used in a kind."
+#endif
                        
 -- create a list of expressions in the same order as the fields in the first argument
 -- but with the values as given in the second argument
@@ -564,7 +612,7 @@
 
 reorderFieldsPat :: Quasi q => [VarStrictType] -> [FieldPat] -> PatM q [DPat]
 reorderFieldsPat field_decs field_pats =
-  reorderFields' dsPat field_decs field_pats (repeat DWildP)
+  reorderFields' dsPat field_decs field_pats (repeat DWildPa)
 
 reorderFields' :: (Applicative m, Monad m)
                => (a -> m da)
@@ -592,7 +640,7 @@
 -- | Make a tuple 'DPat' from a list of 'DPat's. Avoids using a 1-tuple.
 mkTupleDPat :: [DPat] -> DPat
 mkTupleDPat [pat] = pat
-mkTupleDPat pats = DConP (tupleDataName (length pats)) pats
+mkTupleDPat pats = DConPa (tupleDataName (length pats)) pats
 
 -- | Make a tuple 'Pat' from a list of 'Pat's. Avoids using a 1-tuple.
 mkTuplePat :: [Pat] -> Pat
diff --git a/Language/Haskell/TH/Desugar/Expand.hs b/Language/Haskell/TH/Desugar/Expand.hs
--- a/Language/Haskell/TH/Desugar/Expand.hs
+++ b/Language/Haskell/TH/Desugar/Expand.hs
@@ -15,6 +15,7 @@
   ) where
 
 import qualified Data.Map as M
+import Control.Monad
 import Control.Applicative
 import Language.Haskell.TH hiding (cxt)
 import Language.Haskell.TH.Syntax ( Quasi(..) )
@@ -38,20 +39,42 @@
     go args (DSigT ty ki) = do
       ty' <- go [] ty
       return $ foldl DAppT (DSigT ty' ki) args
-    go args (DConT n) = do
-      info <- reifyWithWarning n
-      case info of
-        TyConI (TySynD _n tvbs rhs)
-          | length args >= length tvbs -> do
-          let (syn_args, rest_args) = splitAtList tvbs args
-          rhs' <- dsType rhs
-          rhs'' <- expandType rhs'
-          tvbs' <- mapM dsTvb tvbs
-          ty <- substTy (M.fromList $ zip (map extractDTvbName tvbs') syn_args) rhs''
-          return $ foldl DAppT ty rest_args
-        _ -> return $ foldl DAppT (DConT n) args
+    go args (DConT n) = expandCon n args
     go args ty = return $ foldl DAppT ty args
 
+-- | Expands all type synonyms in a desugared predicate.
+expandPred :: Quasi q => DPred -> q DPred
+expandPred = go []
+  where
+    go args (DAppPr p t) = do
+      t' <- expandType t
+      go (t' : args) p
+    go args (DSigPr p k) = do
+      p' <- go [] p
+      return $ foldl DAppPr (DSigPr p' k) args
+    go args (DConPr n) = do
+      ty <- expandCon n args
+      dTypeToDPred ty
+    go args p = return $ foldl DAppPr p args
+
+-- | Expand a constructor with given arguments
+expandCon :: Quasi q
+          => Name     -- ^ Tycon name
+          -> [DType]  -- ^ Arguments
+          -> q DType  -- ^ Expanded type
+expandCon n args = do
+  info <- reifyWithWarning n
+  case info of
+    TyConI (TySynD _n tvbs rhs)
+      | length args >= length tvbs -> do
+        let (syn_args, rest_args) = splitAtList tvbs args
+        rhs' <- dsType rhs
+        rhs'' <- expandType rhs'
+        tvbs' <- mapM dsTvb tvbs
+        ty <- substTy (M.fromList $ zip (map extractDTvbName tvbs') syn_args) rhs''
+        return $ foldl DAppT ty rest_args
+    _ -> return $ foldl DAppT (DConT n) args
+
 -- | Capture-avoiding substitution on types
 substTy :: Quasi q => M.Map Name DType -> DType -> q DType
 substTy vars (DForallT tvbs cxt ty) =
@@ -89,12 +112,27 @@
 extractDTvbName (DKindedTV n _) = n
 
 substPred :: Quasi q => M.Map Name DType -> DPred -> q DPred
-substPred vars (DClassP name tys) =
-  DClassP name <$> mapM (substTy vars) tys
-substPred vars (DEqualP t1 t2) =
-  DEqualP <$> substTy vars t1 <*> substTy vars t2
+substPred vars (DAppPr p t) = DAppPr <$> substPred vars p <*> substTy vars t
+substPred vars (DSigPr p k) = DSigPr <$> substPred vars p <*> pure k
+substPred vars (DVarPr n)
+  | Just ty <- M.lookup n vars
+  = dTypeToDPred ty
+  | otherwise
+  = return $ DVarPr n
+substPred _ p = return p
 
+-- | Convert a 'DType' to a 'DPred'
+dTypeToDPred :: Quasi q => DType -> q DPred
+dTypeToDPred (DForallT _ _ _) = impossible "Forall-type used as constraint"
+dTypeToDPred (DAppT t1 t2)   = DAppPr <$> dTypeToDPred t1 <*> pure t2
+dTypeToDPred (DSigT ty ki)   = DSigPr <$> dTypeToDPred ty <*> pure ki
+dTypeToDPred (DVarT n)       = return $ DVarPr n
+dTypeToDPred (DConT n)       = return $ DConPr n
+dTypeToDPred DArrowT         = impossible "Arrow used as head of constraint"
+dTypeToDPred (DLitT _)       = impossible "Type literal used as head of constraint"
+
+
 -- | Expand all type synonyms in the desugared abstract syntax tree provided.
 -- Normally, the first parameter should have a type like 'DExp' or 'DLetDec'.
 expand :: (Quasi q, Data a) => a -> q a
-expand = everywhereM (mkM expandType)
+expand = everywhereM (mkM expandType >=> mkM expandPred)
diff --git a/Language/Haskell/TH/Desugar/Sweeten.hs b/Language/Haskell/TH/Desugar/Sweeten.hs
--- a/Language/Haskell/TH/Desugar/Sweeten.hs
+++ b/Language/Haskell/TH/Desugar/Sweeten.hs
@@ -32,12 +32,12 @@
 matchToTH (DMatch pat exp) = Match (patToTH pat) (NormalB (expToTH exp)) []
 
 patToTH :: DPat -> Pat
-patToTH (DLitP lit)    = LitP lit
-patToTH (DVarP n)      = VarP n
-patToTH (DConP n pats) = ConP n (map patToTH pats)
-patToTH (DTildeP pat)  = TildeP (patToTH pat)
-patToTH (DBangP pat)   = BangP (patToTH pat)
-patToTH DWildP         = WildP
+patToTH (DLitPa lit)    = LitP lit
+patToTH (DVarPa n)      = VarP n
+patToTH (DConPa n pats) = ConP n (map patToTH pats)
+patToTH (DTildePa pat)  = TildeP (patToTH pat)
+patToTH (DBangPa pat)   = BangP (patToTH pat)
+patToTH DWildPa         = WildP
 
 letDecToTH :: DLetDec -> Dec
 letDecToTH (DFunD name clauses) = FunD name (map clauseToTH clauses)
@@ -62,8 +62,25 @@
 tvbToTH (DKindedTV n k)        = KindedTV n (kindToTH k)
 
 predToTH :: DPred -> Pred
-predToTH (DClassP n tys) = ClassP n (map typeToTH tys)
-predToTH (DEqualP t1 t2) = EqualP (typeToTH t1) (typeToTH t2)
+#if __GLASGOW_HASKELL__ < 709
+predToTH = go []
+  where
+    go acc (DAppPr p t) = go (typeToTH t : acc) p
+    go acc (DSigPr p _) = go acc                p  -- this shouldn't happen.
+    go _   (DVarPr _)
+      = error "Template Haskell in GHC <= 7.8 does not support variable constraints."
+    go acc (DConPr n) 
+      | nameBase n == "(~)"
+      , [t1, t2] <- acc
+      = EqualP t1 t2
+      | otherwise
+      = ClassP n acc
+#else
+predToTH (DAppPr p t) = AppT (predToTH p) (typeToTH t)
+predToTH (DSigPr p k) = SigT (predToTH p) (kindToTH k)
+predToTH (DVarPr n)   = VarT n
+predToTH (DConPr n)   = ConT n
+#endif
 
 kindToTH :: DKind -> Kind
 kindToTH (DForallK names ki) = ForallT (map PlainTV names) [] (kindToTH ki)
diff --git a/Language/Haskell/TH/Desugar/Util.hs b/Language/Haskell/TH/Desugar/Util.hs
--- a/Language/Haskell/TH/Desugar/Util.hs
+++ b/Language/Haskell/TH/Desugar/Util.hs
@@ -128,4 +128,32 @@
 splitAtList (_ : t) (x : xs) =
   let (as, bs) = splitAtList t xs in
   (x : as, bs)
-splitAtList (_ : _) [] = ([], [])      
+splitAtList (_ : _) [] = ([], [])
+
+-- | If a type is a fully-applied tuple type, break it down into a list
+-- of its constituents. Otherwise, return Nothing.
+splitTuple_maybe :: Type -> Maybe [Type]
+splitTuple_maybe = go []
+  where
+    go acc (AppT left right) = go (right:acc) left
+    go acc (SigT ty _)       = go acc ty
+    go acc (TupleT n)
+      | n == length acc = Just acc
+    go acc (ConT name)
+      | Just n <- tupleNameDegree_maybe name
+      , n == length acc = Just acc
+    go _ _ = Nothing
+
+-- | Extract the degree of a tuple, if the argument is a tuple
+tupleDegree_maybe :: String -> Maybe Int
+tupleDegree_maybe s = do
+  '(' : s1 <- return s
+  (commas, ")") <- return $ span (== ',') s1
+  let degree
+        | "" <- commas = 0
+        | otherwise    = length commas + 1
+  return degree
+
+-- | Extract the degree of a tuple name, if the argument is a tuple name
+tupleNameDegree_maybe :: Name -> Maybe Int
+tupleNameDegree_maybe = tupleDegree_maybe . nameBase
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,6 +1,8 @@
 `th-desugar` Package
 ====================
 
+[![Build Status](https://travis-ci.org/goldfirere/th-desugar.png?branch=master)](https://travis-ci.org/goldfirere/th-desugar)
+
 This package provides the `Language.Haskell.TH.Desugar` module, which desugars
 Template Haskell's rich encoding of Haskell syntax into a simpler encoding.
 This desugaring discards surface syntax information (such as the use of infix
diff --git a/Test/Run.hs b/Test/Run.hs
new file mode 100644
--- /dev/null
+++ b/Test/Run.hs
@@ -0,0 +1,89 @@
+{- Tests for the th-desugar package
+
+(c) Richard Eisenberg 2013
+eir@cis.upenn.edu
+-}
+
+{-# LANGUAGE TemplateHaskell, UnboxedTuples, ParallelListComp, CPP,
+             RankNTypes, ImpredicativeTypes, TypeFamilies,
+             DataKinds, ConstraintKinds #-}
+{-# OPTIONS -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns
+            -fno-warn-unused-matches -fno-warn-type-defaults
+            -fno-warn-missing-signatures -fno-warn-unused-do-bind #-}
+
+module Test.Run where
+
+import Test.HUnit
+import Test.Hspec
+import Test.Hspec.HUnit
+
+import Test.Splices
+import Language.Haskell.TH.Desugar
+import Language.Haskell.TH.Desugar.Expand
+import Language.Haskell.TH.Desugar.Sweeten
+
+tests :: Test
+tests = test [ "sections" ~: $test1_sections  @=? $(dsSplice test1_sections)
+             , "lampats"  ~: $test2_lampats   @=? $(dsSplice test2_lampats)
+             , "lamcase"  ~: $test3_lamcase   @=? $(dsSplice test3_lamcase)
+-- Must fix nested pattern-matching for this to work. Argh.
+--           , "tuples"   ~: $test4_tuples    @=? $(dsSplice test4_tuples)
+             , "ifs"      ~: $test5_ifs       @=? $(dsSplice test5_ifs)
+             , "ifs2"     ~: $test6_ifs2      @=? $(dsSplice test6_ifs2)
+             , "let"      ~: $test7_let       @=? $(dsSplice test7_let)
+             , "case"     ~: $test8_case      @=? $(dsSplice test8_case)
+             , "do"       ~: $test9_do        @=? $(dsSplice test9_do)
+             , "comp"     ~: $test10_comp     @=? $(dsSplice test10_comp)
+#if __GLASGOW_HASKELL__ >= 707
+             , "parcomp"  ~: $test11_parcomp  @=? $(dsSplice test11_parcomp)
+             , "parcomp2" ~: $test12_parcomp2 @=? $(dsSplice test12_parcomp2)
+#endif
+             , "sig"      ~: $test13_sig      @=? $(dsSplice test13_sig)
+             , "record"   ~: $test14_record   @=? $(dsSplice test14_record)
+             , "litp"     ~: $test15_litp     @=? $(dsSplice test15_litp)
+             , "tupp"     ~: $test16_tupp     @=? $(dsSplice test16_tupp)
+             , "infixp"   ~: $test17_infixp   @=? $(dsSplice test17_infixp)
+             , "tildep"   ~: $test18_tildep   @=? $(dsSplice test18_tildep)
+             , "bangp"    ~: $test19_bangp    @=? $(dsSplice test19_bangp)
+             , "asp"      ~: $test20_asp      @=? $(dsSplice test20_asp)
+             , "wildp"    ~: $test21_wildp    @=? $(dsSplice test21_wildp)
+             , "listp"    ~: $test22_listp    @=? $(dsSplice test22_listp)
+-- type signatures in patterns not yet handled by Template Haskell
+--           , "sigp"     ~: $test23_sigp     @=? $(dsSplice test23_sigp)
+             , "fun"      ~: $test24_fun      @=? $(dsSplice test24_fun)
+             , "fun2"     ~: $test25_fun2     @=? $(dsSplice test25_fun2)
+             , "forall"   ~: $test26_forall   @=? $(dsSplice test26_forall)
+             , "kisig"    ~: $test27_kisig    @=? $(dsSplice test27_kisig)
+             , "tupt"     ~: $test28_tupt     @=? $(dsSplice test28_tupt)
+             , "listt"    ~: $test29_listt    @=? $(dsSplice test29_listt)
+             , "promoted" ~: $test30_promoted @=? $(dsSplice test30_promoted)
+             , "constraint" ~: $test31_constraint @=? $(dsSplice test31_constraint)
+             , "tylit"    ~: $test32_tylit    @=? $(dsSplice test32_tylit)
+             , "tvbs"     ~: $test33_tvbs     @=? $(dsSplice test33_tvbs)
+             , "let_as"   ~: $test34_let_as   @=? $(dsSplice test34_let_as)
+#if __GLASGOW_HASKELL__ >= 709
+             , "pred"     ~: $test37_pred     @=? $(dsSplice test37_pred)
+             , "pred2"    ~: $test38_pred2    @=? $(dsSplice test38_pred2)
+             , "eq"       ~: $test39_eq       @=? $(dsSplice test39_eq)
+#endif
+             ]
+
+test35a = $test35_expand
+test35b = $(test35_expand >>= dsExp >>= expand >>= return . expToTH)
+test36a = $test36_expand
+test36b = $(test36_expand >>= dsExp >>= expand >>= return . expToTH)
+
+hasSameType :: a -> a -> Bool
+hasSameType _ _ = True
+
+test_expand :: Bool
+test_expand = and [ hasSameType test35a test35b
+                  , hasSameType test36a test36b]
+
+main :: IO ()
+main = hspec $ do
+  describe "th-desugar library" $ do
+    it "compiles" $ True
+    it "expands"  $ test_expand
+
+    fromHUnitTest tests
diff --git a/th-desugar.cabal b/th-desugar.cabal
--- a/th-desugar.cabal
+++ b/th-desugar.cabal
@@ -1,5 +1,5 @@
 name:           th-desugar
-version:        1.2.1
+version:        1.3.0
 cabal-version:  >= 1.10
 synopsis:       Functions to desugar Template Haskell
 homepage:       http://www.cis.upenn.edu/~eir/packages/th-desugar
@@ -26,7 +26,7 @@
 source-repository this
   type:     git
   location: https://github.com/goldfirere/th-desugar.git
-  tag:      v1.2.1
+  tag:      v1.3.0
 
 library
   build-depends:      
@@ -41,18 +41,18 @@
   other-modules:      Language.Haskell.TH.Desugar.Core, Language.Haskell.TH.Desugar.Util
   default-language:   Haskell2010
 
- -- This DOES NOT WORK with GHC HEAD, so commenting it out for now.
- -- test-suite spec
- --  type:               exitcode-stdio-1.0
- --  ghc-options:        -Wall -Werror -main-is Test.Run
- --  default-language:   Haskell2010
- --  main-is:            Test/Run.hs
 
- --  build-depends:
- --      base >= 4 && < 5,
- --      template-haskell,
- --      containers >= 0.5,
- --      mtl >= 2.1,
- --      syb >= 0.4,
- --      HUnit >= 1.2,
- --      hspec >= 1.3
+test-suite spec
+  type:               exitcode-stdio-1.0
+  ghc-options:        -Wall -Werror -main-is Test.Run
+  default-language:   Haskell2010
+  main-is:            Test/Run.hs
+
+  build-depends:
+      base >= 4 && < 5,
+      template-haskell,
+      containers >= 0.5,
+      mtl >= 2.1,
+      syb >= 0.4,
+      HUnit >= 1.2,
+      hspec >= 1.3