diff --git a/compdata.cabal b/compdata.cabal
--- a/compdata.cabal
+++ b/compdata.cabal
@@ -1,5 +1,5 @@
 Name:			compdata
-Version:		0.10
+Version:		0.10.1
 Synopsis:            	Compositional Data Types
 Description:
 
@@ -187,7 +187,7 @@
                         Data.Comp.Multi.Derive.SmartConstructors
                         Data.Comp.Multi.Derive.SmartAConstructors
 
-  Build-Depends:	base >= 4.7, base < 5, template-haskell, containers, mtl >= 2.2.1, QuickCheck >= 2 && < 2.8, derive,
+  Build-Depends:	base >= 4.7, base < 5, template-haskell, containers, mtl >= 2.2.1, QuickCheck >= 2 && < 2.9, derive,
                         deepseq, th-expand-syns, transformers, tree-view
   Extensions:           FlexibleContexts
   hs-source-dirs:	src
@@ -198,7 +198,7 @@
   Type:                 exitcode-stdio-1.0
   Main-is:		Data_Test.hs
   hs-source-dirs:	testsuite/tests examples src
-  Build-Depends:        base >= 4.7, base < 5, template-haskell, containers, mtl >= 2.2.1, QuickCheck >= 2 && < 2.8, 
+  Build-Depends:        base >= 4.7, base < 5, template-haskell, containers, mtl >= 2.2.1, QuickCheck >= 2 && < 2.9, 
                         HUnit, test-framework, test-framework-hunit, test-framework-quickcheck2 >= 0.3, derive,
                         th-expand-syns, deepseq, transformers
 
@@ -209,7 +209,7 @@
   ghc-options:          -W -O2
   -- Disable short-cut fusion rules in order to compare optimised and unoptimised code.
   cpp-options:          -DNO_RULES
-  Build-Depends:        base >= 4.7, base < 5, template-haskell, containers, mtl >= 2.2.1, QuickCheck >= 2 && < 2.8, derive, deepseq, criterion, random, uniplate, th-expand-syns, transformers
+  Build-Depends:        base >= 4.7, base < 5, template-haskell, containers, mtl >= 2.2.1, QuickCheck >= 2 && < 2.9, derive, deepseq, criterion, random, uniplate, th-expand-syns, transformers
 
 
 source-repository head
diff --git a/src/Data/Comp/Algebra.hs b/src/Data/Comp/Algebra.hs
--- a/src/Data/Comp/Algebra.hs
+++ b/src/Data/Comp/Algebra.hs
@@ -454,12 +454,12 @@
 
 -- | Shortcut fusion variant of 'ana'.
 ana' :: forall a f . Functor f => Coalg f a -> a -> Term f
-ana' f t = build $ run t
+ana' f t = build (run t)
     where run :: forall b . a -> Alg f b -> b
           run t con = run' t where
               run' :: a ->  b
               run' t = con $ fmap run' (f t)
-
+{-# INLINE [2] ana' #-}
 build :: (forall a. Alg f a -> a) -> Term f
 {-# INLINE [1] build #-}
 build g = g Term
diff --git a/src/Data/Comp/Derive/Arbitrary.hs b/src/Data/Comp/Derive/Arbitrary.hs
--- a/src/Data/Comp/Derive/Arbitrary.hs
+++ b/src/Data/Comp/Derive/Arbitrary.hs
@@ -46,14 +46,14 @@
   instances of 'Arbitrary'. -}
 makeArbitraryF :: Name -> Q [Dec]
 makeArbitraryF dt = do
-  TyConI (DataD _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify dt
+  Just (DataInfo _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify dt
   let argNames = map (VarT . tyVarBndrName) (tail args)
       complType = foldl AppT (ConT name) argNames
       preCond = map (mkClassP ''Arbitrary . (: [])) argNames
       classType = AppT (ConT ''ArbitraryF) complType
   arbitraryDecl <- generateArbitraryFDecl constrs
   shrinkDecl <- generateShrinkFDecl constrs
-  return [InstanceD preCond classType [arbitraryDecl, shrinkDecl]]
+  return [mkInstanceD preCond classType [arbitraryDecl, shrinkDecl]]
 
 {-|
   This function generates a declaration of the method 'arbitrary' for the given
diff --git a/src/Data/Comp/Derive/DeepSeq.hs b/src/Data/Comp/Derive/DeepSeq.hs
--- a/src/Data/Comp/Derive/DeepSeq.hs
+++ b/src/Data/Comp/Derive/DeepSeq.hs
@@ -32,16 +32,16 @@
   kind taking at least one argument. -}
 makeNFDataF :: Name -> Q [Dec]
 makeNFDataF fname = do
-  TyConI (DataD _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
+  Just (DataInfo _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
   let argNames = map (VarT . tyVarBndrName) (init args)
       complType = foldl AppT (ConT name) argNames
       preCond = map (mkClassP ''NFData . (: [])) argNames
       classType = AppT (ConT ''NFDataF) complType
   constrs' <- mapM normalConExp constrs
   rnfFDecl <- funD 'rnfF (rnfFClauses constrs')
-  return [InstanceD preCond classType [rnfFDecl]]
+  return [mkInstanceD preCond classType [rnfFDecl]]
       where rnfFClauses = map genRnfFClause
-            genRnfFClause (constr, args) = do
+            genRnfFClause (constr, args,_) = do
               let n = length args
               varNs <- newNames n "x"
               let pat = ConP constr $ map VarP varNs
diff --git a/src/Data/Comp/Derive/Equality.hs b/src/Data/Comp/Derive/Equality.hs
--- a/src/Data/Comp/Derive/Equality.hs
+++ b/src/Data/Comp/Derive/Equality.hs
@@ -31,13 +31,13 @@
   taking at least one argument. -}
 makeEqF :: Name -> Q [Dec]
 makeEqF fname = do
-  TyConI (DataD _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
+  Just (DataInfo _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
   let argNames = map (VarT . tyVarBndrName) (init args)
       complType = foldl AppT (ConT name) argNames
       preCond = map (mkClassP ''Eq . (: [])) argNames
       classType = AppT (ConT ''EqF) complType
   eqFDecl <- funD 'eqF  (eqFClauses constrs)
-  return [InstanceD preCond classType [eqFDecl]]
+  return [mkInstanceD preCond classType [eqFDecl]]
       where eqFClauses constrs = map (genEqClause.abstractConType) constrs
                                    ++ defEqClause constrs
             defEqClause constrs
diff --git a/src/Data/Comp/Derive/Foldable.hs b/src/Data/Comp/Derive/Foldable.hs
--- a/src/Data/Comp/Derive/Foldable.hs
+++ b/src/Data/Comp/Derive/Foldable.hs
@@ -39,7 +39,7 @@
   kind taking at least one argument. -}
 makeFoldable :: Name -> Q [Dec]
 makeFoldable fname = do
-  TyConI (DataD _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
+  Just (DataInfo _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
   let fArg = VarT . tyVarBndrName $ last args
       argNames = map (VarT . tyVarBndrName) (init args)
       complType = foldl AppT (ConT name) argNames
@@ -51,8 +51,8 @@
   foldrDecl <- funD 'foldr (map foldrClause constrs')
   foldl1Decl <- funD 'foldl1 (map foldl1Clause constrs')
   foldr1Decl <- funD 'foldr1 (map foldr1Clause constrs')
-  return [InstanceD [] classType [foldDecl,foldMapDecl,foldlDecl,foldrDecl,foldl1Decl,foldr1Decl]]
-      where isFarg fArg (constr, args) = (constr, map (`containsType'` fArg) args)
+  return [mkInstanceD [] classType [foldDecl,foldMapDecl,foldlDecl,foldrDecl,foldl1Decl,foldr1Decl]]
+      where isFarg fArg (constr, args, gadtTy) = (constr, map (`containsType'` (getUnaryFArg fArg gadtTy)) args)
             filterVar [] _ = Nothing
             filterVar [d] x =Just (d, varE x)
             filterVar _ _ =  error "functor variable occurring twice in argument type"
diff --git a/src/Data/Comp/Derive/HaskellStrict.hs b/src/Data/Comp/Derive/HaskellStrict.hs
--- a/src/Data/Comp/Derive/HaskellStrict.hs
+++ b/src/Data/Comp/Derive/HaskellStrict.hs
@@ -57,7 +57,7 @@
   first-order kind taking at least one argument. -}
 makeHaskellStrict :: Name -> Q [Dec]
 makeHaskellStrict fname = do
-  TyConI (DataD _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
+  Just (DataInfo _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
   let fArg = VarT . tyVarBndrName $ last args
       argNames = map (VarT . tyVarBndrName) (init args)
       complType = foldl AppT (ConT name) argNames
@@ -68,7 +68,7 @@
      sequenceDecl <- valD (varP 'thunkSequence) (normalB [|return|]) []
      injectDecl <- valD (varP 'thunkSequenceInject) (normalB [|inject|]) []
      injectDecl' <- valD (varP 'thunkSequenceInject') (normalB [|inject|]) []
-     return [InstanceD [] classType [sequenceDecl, injectDecl, injectDecl']]
+     return [mkInstanceD [] classType [sequenceDecl, injectDecl, injectDecl']]
    else do
      (sc',matchPat,ic') <- liftM unzip3 $ P.mapM mkClauses constrs_
      xn <- newName "x"
@@ -76,13 +76,18 @@
      let sequenceDecl = FunD 'thunkSequence sc'
          injectDecl = FunD 'thunkSequenceInject [Clause [VarP xn] (NormalB (doThunk `AppE` CaseE (VarE xn) matchPat)) []]
          injectDecl' = FunD 'thunkSequenceInject' ic'
-     return [InstanceD [] classType [sequenceDecl, injectDecl, injectDecl']]
-      where isFarg fArg (constr, args) = (constr, map (containsStr fArg) args)
-            containsStr _ (NotStrict,_) = []
+     return [mkInstanceD [] classType [sequenceDecl, injectDecl, injectDecl']]
+      where isFarg fArg (constr, args, gadtTy) = (constr, map (containsStr (getUnaryFArg fArg gadtTy)) args)
+            
+#if __GLASGOW_HASKELL__ < 800
             containsStr fArg (IsStrict,ty) = ty `containsType'` fArg
-#if __GLASGOW_HASKELL__ > 702
             containsStr fArg (Unpacked,ty) = ty `containsType'` fArg
+#else
+            containsStr fArg (Bang _ SourceStrict,ty) = ty `containsType'` fArg
+            containsStr fArg (Bang SourceUnpack _,ty) = ty `containsType'` fArg
 #endif
+            containsStr _ _ = []
+
             filterVar _ nonFarg [] x  = nonFarg x
             filterVar farg _ [depth] x = farg depth x
             filterVar _ _ _ _ = error "functor variable occurring twice in argument type"
diff --git a/src/Data/Comp/Derive/Ordering.hs b/src/Data/Comp/Derive/Ordering.hs
--- a/src/Data/Comp/Derive/Ordering.hs
+++ b/src/Data/Comp/Derive/Ordering.hs
@@ -37,13 +37,13 @@
   taking at least one argument. -}
 makeOrdF :: Name -> Q [Dec]
 makeOrdF fname = do
-  TyConI (DataD _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
+  Just (DataInfo _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
   let argNames = map (VarT . tyVarBndrName) (init args)
       complType = foldl AppT (ConT name) argNames
       preCond = map (mkClassP ''Ord . (: [])) argNames
       classType = AppT (ConT ''OrdF) complType
   eqAlgDecl <- funD 'compareF  (compareFClauses constrs)
-  return [InstanceD preCond classType [eqAlgDecl]]
+  return [mkInstanceD preCond classType [eqAlgDecl]]
       where compareFClauses [] = []
             compareFClauses constrs =
                 let constrs' = map abstractConType constrs `zip` [1..]
diff --git a/src/Data/Comp/Derive/Show.hs b/src/Data/Comp/Derive/Show.hs
--- a/src/Data/Comp/Derive/Show.hs
+++ b/src/Data/Comp/Derive/Show.hs
@@ -36,7 +36,7 @@
   taking at least one argument. -}
 makeShowF :: Name -> Q [Dec]
 makeShowF fname = do
-  TyConI (DataD _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
+  Just (DataInfo _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
   let fArg = VarT . tyVarBndrName $ last args
       argNames = map (VarT . tyVarBndrName) (init args)
       complType = foldl AppT (ConT name) argNames
@@ -44,18 +44,18 @@
       classType = AppT (ConT ''ShowF) complType
   constrs' <- mapM normalConExp constrs
   showFDecl <- funD 'showF (showFClauses fArg constrs')
-  return [InstanceD preCond classType [showFDecl]]
+  return [mkInstanceD preCond classType [showFDecl]]
       where showFClauses fArg = map (genShowFClause fArg)
             filterFarg fArg ty x = (fArg == ty, varE x)
             mkShow :: (Bool, ExpQ) -> ExpQ
             mkShow (isFArg, var)
                 | isFArg = var
                 | otherwise = [| show $var |]
-            genShowFClause fArg (constr, args) = do
+            genShowFClause fArg (constr, args, gadtTy) = do
               let n = length args
               varNs <- newNames n "x"
               let pat = ConP constr $ map VarP varNs
-                  allVars = zipWith (filterFarg fArg) args varNs
+                  allVars = zipWith (filterFarg (getUnaryFArg fArg gadtTy)) args varNs
                   shows = listE $ map mkShow allVars
                   conName = nameBase constr
               body <- [|showCon conName $shows|]
@@ -72,7 +72,7 @@
   taking at least one argument. -}
 makeShowConstr :: Name -> Q [Dec]
 makeShowConstr fname = do
-  TyConI (DataD _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
+  Just (DataInfo _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
   let fArg = VarT . tyVarBndrName $ last args
       argNames = map (VarT . tyVarBndrName) (init args)
       complType = foldl AppT (ConT name) argNames
@@ -80,18 +80,18 @@
       classType = AppT (ConT ''ShowConstr) complType
   constrs' <- mapM normalConExp constrs
   showConstrDecl <- funD 'showConstr (showConstrClauses fArg constrs')
-  return [InstanceD preCond classType [showConstrDecl]]
+  return [mkInstanceD preCond classType [showConstrDecl]]
       where showConstrClauses fArg = map (genShowConstrClause fArg)
             filterFarg fArg ty x = (fArg == ty, varE x)
             mkShow :: (Bool, ExpQ) -> ExpQ
             mkShow (isFArg, var)
                 | isFArg = [| "" |]
                 | otherwise = [| show $var |]
-            genShowConstrClause fArg (constr, args) = do
+            genShowConstrClause fArg (constr, args, gadtTy) = do
               let n = length args
               varNs <- newNames n "x"
               let pat = ConP constr $ map VarP varNs
-                  allVars = zipWith (filterFarg fArg) args varNs
+                  allVars = zipWith (filterFarg (getUnaryFArg fArg gadtTy)) args varNs
                   shows = listE $ map mkShow allVars
                   conName = nameBase constr
               body <- [|showCon' conName $shows|]
diff --git a/src/Data/Comp/Derive/SmartAConstructors.hs b/src/Data/Comp/Derive/SmartAConstructors.hs
--- a/src/Data/Comp/Derive/SmartAConstructors.hs
+++ b/src/Data/Comp/Derive/SmartAConstructors.hs
@@ -30,7 +30,7 @@
   inserted. -}
 smartAConstructors :: Name -> Q [Dec]
 smartAConstructors fname = do
-    TyConI (DataD _cxt _tname _targs constrs _deriving) <- abstractNewtypeQ $ reify fname
+    Just (DataInfo _cxt _tname _targs constrs _deriving) <- abstractNewtypeQ $ reify fname
     let cons = map abstractConType constrs
     liftM concat $ mapM genSmartConstr cons
         where genSmartConstr   (name, args) = do
diff --git a/src/Data/Comp/Derive/SmartConstructors.hs b/src/Data/Comp/Derive/SmartConstructors.hs
--- a/src/Data/Comp/Derive/SmartConstructors.hs
+++ b/src/Data/Comp/Derive/SmartConstructors.hs
@@ -28,7 +28,7 @@
  ordinary constructors, but an 'inject' is automatically inserted. -}
 smartConstructors :: Name -> Q [Dec]
 smartConstructors fname = do
-    TyConI (DataD _cxt tname targs constrs _deriving) <- abstractNewtypeQ $ reify fname
+    Just (DataInfo _cxt tname targs constrs _deriving) <- abstractNewtypeQ $ reify fname
     let cons = map abstractConType constrs
     liftM concat $ mapM (genSmartConstr (map tyVarBndrName targs) tname) cons
         where genSmartConstr targs tname (name, args) = do
diff --git a/src/Data/Comp/Derive/Traversable.hs b/src/Data/Comp/Derive/Traversable.hs
--- a/src/Data/Comp/Derive/Traversable.hs
+++ b/src/Data/Comp/Derive/Traversable.hs
@@ -39,7 +39,7 @@
   first-order kind taking at least one argument. -}
 makeTraversable :: Name -> Q [Dec]
 makeTraversable fname = do
-  TyConI (DataD _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
+  Just (DataInfo _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
   let fArg = VarT . tyVarBndrName $ last args
       argNames = map (VarT . tyVarBndrName) (init args)
       complType = foldl AppT (ConT name) argNames
@@ -49,8 +49,8 @@
   sequenceADecl <- funD 'sequenceA (map sequenceAClause constrs')
   mapMDecl <- funD 'mapM (map mapMClause constrs')
   sequenceDecl <- funD 'sequence (map sequenceClause constrs')
-  return [InstanceD [] classType [traverseDecl, sequenceADecl, mapMDecl,sequenceDecl]]
-      where isFarg fArg (constr, args) = (constr, map (`containsType'` fArg) args)
+  return [mkInstanceD [] classType [traverseDecl, sequenceADecl, mapMDecl,sequenceDecl]]
+      where isFarg fArg (constr, args, gadtTy) = (constr, map (`containsType'` (getUnaryFArg fArg gadtTy)) args)
             filterVar _ nonFarg [] x  = nonFarg x
             filterVar farg _ [depth] x = farg depth x
             filterVar _ _ _ _ = error "functor variable occurring twice in argument type"
diff --git a/src/Data/Comp/Derive/Utils.hs b/src/Data/Comp/Derive/Utils.hs
--- a/src/Data/Comp/Derive/Utils.hs
+++ b/src/Data/Comp/Derive/Utils.hs
@@ -26,50 +26,94 @@
 reportError = report True
 #endif
 
+#if __GLASGOW_HASKELL__ < 800
+data DataInfo = DataInfo Cxt Name [TyVarBndr] [Con] [Name]
+#else
+data DataInfo = DataInfo Cxt Name [TyVarBndr] [Con] Cxt
+#endif
+
 {-|
   This is the @Q@-lifted version of 'abstractNewtype.
 -}
-abstractNewtypeQ :: Q Info -> Q Info
+abstractNewtypeQ :: Q Info -> Q (Maybe DataInfo)
 abstractNewtypeQ = liftM abstractNewtype
 
 {-|
   This function abstracts away @newtype@ declaration, it turns them into
   @data@ declarations.
 -}
-abstractNewtype :: Info -> Info
+abstractNewtype :: Info -> Maybe DataInfo
+#if __GLASGOW_HASKELL__ < 800
 abstractNewtype (TyConI (NewtypeD cxt name args constr derive))
-    = TyConI (DataD cxt name args [constr] derive)
-abstractNewtype owise = owise
+    = Just (DataInfo cxt name args [constr] derive)
+abstractNewtype (TyConI (DataD cxt name args constrs derive))
+    = Just (DataInfo cxt name args constrs derive)
+#else
+abstractNewtype (TyConI (NewtypeD cxt name args _ constr derive))
+    = Just (DataInfo cxt name args [constr] derive)
+abstractNewtype (TyConI (DataD cxt name args _ constrs derive))
+    = Just (DataInfo cxt name args constrs derive)
+#endif
+abstractNewtype _ = Nothing
 
-{-|
-  This function provides the name and the arity of the given data constructor.
+{-| This function provides the name and the arity of the given data
+constructor, and if it is a GADT also its type.
 -}
-normalCon :: Con -> (Name,[StrictType])
-normalCon (NormalC constr args) = (constr, args)
-normalCon (RecC constr args) = (constr, map (\(_,s,t) -> (s,t)) args)
-normalCon (InfixC a constr b) = (constr, [a,b])
+normalCon :: Con -> (Name,[StrictType], Maybe Type)
+normalCon (NormalC constr args) = (constr, args, Nothing)
+normalCon (RecC constr args) = (constr, map (\(_,s,t) -> (s,t)) args, Nothing)
+normalCon (InfixC a constr b) = (constr, [a,b], Nothing)
 normalCon (ForallC _ _ constr) = normalCon constr
+#if __GLASGOW_HASKELL__ >= 800
+normalCon (GadtC (constr:constrs) args typ) = (constr,args,Just typ)
+#endif
 
+normalCon' :: Con -> (Name,[Type], Maybe Type)
+normalCon' con = (n, map snd ts, t)
+  where (n, ts, t) = normalCon con
+      
 
-normalCon' :: Con -> (Name,[Type])
-normalCon' = fmap (map snd) . normalCon
+-- -- | Same as normalCon' but expands type synonyms.
+-- normalConExp :: Con -> Q (Name,[Type])
+-- normalConExp c = do
+--   let (n,ts,t) = normalCon' c
+--   ts' <- mapM expandSyns ts
+--   return (n, ts')
 
 -- | Same as normalCon' but expands type synonyms.
-normalConExp :: Con -> Q (Name,[Type])
+normalConExp :: Con -> Q (Name,[Type], Maybe Type)
 normalConExp c = do
-  let (n,ts) = normalCon' c
+  let (n,ts,t) = normalCon' c
   ts' <- mapM expandSyns ts
-  return (n, ts')
+  return (n, ts',t)
 
 
 -- | Same as normalConExp' but retains strictness annotations.
-normalConStrExp :: Con -> Q (Name,[StrictType])
+normalConStrExp :: Con -> Q (Name,[StrictType], Maybe Type)
 normalConStrExp c = do
-  let (n,ts) = normalCon c
+  let (n,ts,t) = normalCon c
   ts' <- mapM (\ (st,ty) -> do ty' <- expandSyns ty; return (st,ty')) ts
-  return (n, ts')
+  return (n, ts',t)
 
+-- | Auxiliary function to extract the first argument of a binary type
+-- application (the second argument of this function). If the second
+-- argument is @Nothing@ or not of the right shape, the first argument
+-- is returned as a default.
 
+getBinaryFArg :: Type -> Maybe Type -> Type
+getBinaryFArg _ (Just (AppT (AppT _ t)  _)) = t
+getBinaryFArg def _ = def
+
+-- | Auxiliary function to extract the first argument of a type
+-- application (the second argument of this function). If the second
+-- argument is @Nothing@ or not of the right shape, the first argument
+-- is returned as a default.
+getUnaryFArg :: Type -> Maybe Type -> Type
+getUnaryFArg _ (Just (AppT _ t)) = t
+getUnaryFArg def _ = def
+
+
+
 {-|
   This function provides the name and the arity of the given data constructor.
 -}
@@ -78,6 +122,9 @@
 abstractConType (RecC constr args) = (constr, length args)
 abstractConType (InfixC _ constr _) = (constr, 2)
 abstractConType (ForallC _ _ constr) = abstractConType constr
+#if __GLASGOW_HASKELL__ >= 800
+abstractConType (GadtC (constr:_) args typ) = (constr,length args) -- Only first Name
+#endif
 
 {-|
   This function returns the name of a bound type variable
@@ -151,7 +198,15 @@
 isEqualP _ = Nothing
 #endif
 
+mkInstanceD :: Cxt -> Type -> [Dec] -> Dec
+#if __GLASGOW_HASKELL__ < 800
+mkInstanceD cxt ty decs = InstanceD cxt ty decs
+#else
+mkInstanceD cxt ty decs = InstanceD Nothing cxt ty decs
+#endif
 
+
+
 -- | This function lifts type class instances over sums
 -- ofsignatures. To this end it assumes that it contains only methods
 -- with types of the form @f t1 .. tn -> t@ where @f@ is the signature
@@ -186,7 +241,7 @@
       let tp = ((ConT sumName `AppT` f) `AppT` g)
       let complType = foldl AppT (foldl AppT (ConT name) ts1 `AppT` tp) ts2
       decs' <- sequence $ concatMap decl decs
-      return [InstanceD cxt complType decs']
+      return [mkInstanceD cxt complType decs']
         where decl :: Dec -> [DecQ]
               decl (SigD f _) = [funD f [clause f]]
               decl _ = []
diff --git a/src/Data/Comp/Multi/Derive/Equality.hs b/src/Data/Comp/Multi/Derive/Equality.hs
--- a/src/Data/Comp/Multi/Derive/Equality.hs
+++ b/src/Data/Comp/Multi/Derive/Equality.hs
@@ -27,7 +27,7 @@
   kind taking at least two arguments. -}
 makeEqHF :: Name -> Q [Dec]
 makeEqHF fname = do
-  TyConI (DataD _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
+  Just (DataInfo _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
   let args' = init args
       argNames = map (VarT . tyVarBndrName) (init args')
       ftyp = VarT . tyVarBndrName $ last args'
@@ -36,13 +36,13 @@
       classType = AppT (ConT ''EqHF) complType
   constrs' <- mapM normalConExp constrs
   eqFDecl <- funD 'eqHF  (eqFClauses ftyp constrs constrs')
-  return [InstanceD preCond classType [eqFDecl]]
+  return [mkInstanceD preCond classType [eqFDecl]]
       where eqFClauses ftyp constrs constrs' = map (genEqClause ftyp) constrs'
                                    ++ defEqClause constrs
             defEqClause constrs
                 | length constrs  < 2 = []
                 | otherwise = [clause [wildP,wildP] (normalB [|False|]) []]
-            genEqClause ftyp (constr, argts) = do
+            genEqClause ftyp (constr, argts, gadtTy) = do
               let n = length argts
               varNs <- newNames n "x"
               varNs' <- newNames n "y"
@@ -51,7 +51,7 @@
                   vars = map VarE varNs
                   vars' = map VarE varNs'
                   mkEq ty x y = let (x',y') = (return x,return y)
-                                in if containsType ty ftyp
+                                in if containsType ty (getBinaryFArg ftyp gadtTy)
                                    then [| $x' `keq` $y'|]
                                    else [| $x' == $y'|]
                   eqs = listE $ zipWith3 mkEq argts vars vars'
diff --git a/src/Data/Comp/Multi/Derive/HFoldable.hs b/src/Data/Comp/Multi/Derive/HFoldable.hs
--- a/src/Data/Comp/Multi/Derive/HFoldable.hs
+++ b/src/Data/Comp/Multi/Derive/HFoldable.hs
@@ -46,7 +46,7 @@
   kind taking at least two arguments. -}
 makeHFoldable :: Name -> Q [Dec]
 makeHFoldable fname = do
-  TyConI (DataD _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
+  Just (DataInfo _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
   let args' = init args
       fArg = VarT . tyVarBndrName $ last args'
       argNames = map (VarT . tyVarBndrName) (init args')
@@ -57,8 +57,8 @@
   foldMapDecl <- funD 'hfoldMap (map foldMapClause constrs')
   foldlDecl <- funD 'hfoldl (map foldlClause constrs')
   foldrDecl <- funD 'hfoldr (map foldrClause constrs')
-  return [InstanceD [] classType [foldDecl,foldMapDecl,foldlDecl,foldrDecl]]
-      where isFarg fArg (constr, args) = (constr, map (`containsType'` fArg) args)
+  return [mkInstanceD [] classType [foldDecl,foldMapDecl,foldlDecl,foldrDecl]]
+      where isFarg fArg (constr, args, gadtTy) = (constr, map (`containsType'` (getBinaryFArg fArg gadtTy)) args)
             filterVar [] _ = Nothing
             filterVar [d] x =Just (d, varE x)
             filterVar _ _ =  error "functor variable occurring twice in argument type"
diff --git a/src/Data/Comp/Multi/Derive/HFunctor.hs b/src/Data/Comp/Multi/Derive/HFunctor.hs
--- a/src/Data/Comp/Multi/Derive/HFunctor.hs
+++ b/src/Data/Comp/Multi/Derive/HFunctor.hs
@@ -33,7 +33,7 @@
   kind taking at least two arguments. -}
 makeHFunctor :: Name -> Q [Dec]
 makeHFunctor fname = do
-  TyConI (DataD _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
+  Just (DataInfo _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
   let args' = init args
       fArg = VarT . tyVarBndrName $ last args'
       argNames = map (VarT . tyVarBndrName) (init args')
@@ -41,8 +41,8 @@
       classType = AppT (ConT ''HFunctor) complType
   constrs' <- P.mapM (mkPatAndVars . isFarg fArg <=< normalConExp) constrs
   hfmapDecl <- funD 'hfmap (map hfmapClause constrs')
-  return [InstanceD [] classType [hfmapDecl]]
-      where isFarg fArg (constr, args) = (constr, map (`containsType'` fArg) args)
+  return [mkInstanceD [] classType [hfmapDecl]]
+      where isFarg fArg (constr, args, ty) = (constr, map (`containsType'` getBinaryFArg fArg ty) args)
             filterVar _ nonFarg [] x  = nonFarg x
             filterVar farg _ [depth] x = farg depth x
             filterVar _ _ _ _ = error "functor variable occurring twice in argument type"
diff --git a/src/Data/Comp/Multi/Derive/HTraversable.hs b/src/Data/Comp/Multi/Derive/HTraversable.hs
--- a/src/Data/Comp/Multi/Derive/HTraversable.hs
+++ b/src/Data/Comp/Multi/Derive/HTraversable.hs
@@ -37,7 +37,7 @@
   higher-order kind taking at least two arguments. -}
 makeHTraversable :: Name -> Q [Dec]
 makeHTraversable fname = do
-  TyConI (DataD _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
+  Just (DataInfo _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
   let args' = init args
       fArg = VarT . tyVarBndrName $ last args'
       argNames = map (VarT . tyVarBndrName) (init args')
@@ -46,8 +46,8 @@
   constrs' <- P.mapM (mkPatAndVars . isFarg fArg <=< normalConExp) constrs
   traverseDecl <- funD 'htraverse (map traverseClause constrs')
   mapMDecl <- funD 'hmapM (map mapMClause constrs')
-  return [InstanceD [] classType [traverseDecl, mapMDecl]]
-      where isFarg fArg (constr, args) = (constr, map (`containsType'` fArg) args)
+  return [mkInstanceD [] classType [traverseDecl, mapMDecl]]
+      where isFarg fArg (constr, args, gadtTy) = (constr, map (`containsType'` (getBinaryFArg fArg gadtTy)) args)
             filterVar _ nonFarg [] x  = nonFarg x
             filterVar farg _ [depth] x = farg depth x
             filterVar _ _ _ _ = error "functor variable occurring twice in argument type"
diff --git a/src/Data/Comp/Multi/Derive/Ordering.hs b/src/Data/Comp/Multi/Derive/Ordering.hs
--- a/src/Data/Comp/Multi/Derive/Ordering.hs
+++ b/src/Data/Comp/Multi/Derive/Ordering.hs
@@ -32,17 +32,17 @@
   kind taking at least three arguments. -}
 makeOrdHF :: Name -> Q [Dec]
 makeOrdHF fname = do
-  TyConI (DataD _ name args constrs _) <- abstractNewtypeQ $ reify fname
+  Just (DataInfo _ name args constrs _) <- abstractNewtypeQ $ reify fname
   let args' = init args
   -- covariant argument
-  let coArg :: Name = tyVarBndrName $ last args'
+  let coArg :: Type = VarT $ tyVarBndrName $ last args'
   let argNames = map (VarT . tyVarBndrName) (init args')
   let complType = foldl AppT (ConT name) argNames
   let classType = AppT (ConT ''OrdHF) complType
-  constrs' :: [(Name,[Type])] <- mapM normalConExp constrs
+  constrs' :: [(Name,[Type],Maybe Type)] <- mapM normalConExp constrs
   compareHFDecl <- funD 'compareHF (compareHFClauses coArg constrs')
-  return [InstanceD [] classType [compareHFDecl]]
-      where compareHFClauses :: Name -> [(Name,[Type])] -> [ClauseQ]
+  return [mkInstanceD [] classType [compareHFDecl]]
+      where compareHFClauses :: Type -> [(Name,[Type],Maybe Type)] -> [ClauseQ]
             compareHFClauses _ [] = []
             compareHFClauses coArg constrs =
                 let constrs' = constrs `zip` [1..]
@@ -52,24 +52,24 @@
                 | n == m = genEqClause coArg c
                 | n < m = genLtClause c d
                 | otherwise = genGtClause c d
-            genEqClause :: Name -> (Name,[Type]) -> ClauseQ
-            genEqClause coArg (constr, args) = do
+            genEqClause :: Type -> (Name,[Type],Maybe Type) -> ClauseQ
+            genEqClause coArg (constr, args,gadtTy) = do
               varXs <- newNames (length args) "x"
               varYs <- newNames (length args) "y"
               let patX = ConP constr $ map VarP varXs
               let patY = ConP constr $ map VarP varYs
-              body <- eqDBody coArg (zip3 varXs varYs args)
+              body <- eqDBody (getBinaryFArg coArg gadtTy) (zip3 varXs varYs args)
               return $ Clause [patX, patY] (NormalB body) []
-            eqDBody :: Name -> [(Name, Name, Type)] -> ExpQ
+            eqDBody :: Type -> [(Name, Name, Type)] -> ExpQ
             eqDBody coArg x =
                 [|compList $(listE $ map (eqDB coArg) x)|]
-            eqDB :: Name -> (Name, Name, Type) -> ExpQ
+            eqDB :: Type -> (Name, Name, Type) -> ExpQ
             eqDB coArg (x, y, tp)
-                | not (containsType tp (VarT coArg)) =
+                | not (containsType tp coArg) =
                     [| compare $(varE x) $(varE y) |]
                 | otherwise =
                     [| kcompare $(varE x) $(varE y) |]
-            genLtClause (c, _) (d, _) =
+            genLtClause (c, _, _) (d, _, _) =
                 clause [recP c [], recP d []] (normalB [| LT |]) []
-            genGtClause (c, _) (d, _) =
+            genGtClause (c, _, _) (d, _, _) =
                 clause [recP c [], recP d []] (normalB [| GT |]) []
diff --git a/src/Data/Comp/Multi/Derive/Show.hs b/src/Data/Comp/Multi/Derive/Show.hs
--- a/src/Data/Comp/Multi/Derive/Show.hs
+++ b/src/Data/Comp/Multi/Derive/Show.hs
@@ -44,7 +44,7 @@
   kind taking at least two arguments. -}
 makeShowHF :: Name -> Q [Dec]
 makeShowHF fname = do
-  TyConI (DataD _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
+  Just (DataInfo _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
   let args' = init args
       fArg = VarT . tyVarBndrName $ last args'
       argNames = map (VarT . tyVarBndrName) (init args')
@@ -53,17 +53,17 @@
       classType = AppT (ConT ''ShowHF) complType
   constrs' <- mapM normalConExp constrs
   showFDecl <- funD 'showHF (showFClauses fArg constrs')
-  return [InstanceD preCond classType [showFDecl]]
+  return [mkInstanceD preCond classType [showFDecl]]
       where showFClauses fArg = map (genShowFClause fArg)
             filterFarg fArg ty x = (containsType ty fArg, varE x)
             mkShow (isFArg, var)
                 | isFArg = [|unK $var|]
                 | otherwise = [| show $var |]
-            genShowFClause fArg (constr, args) = do
+            genShowFClause fArg (constr, args, ty) = do
               let n = length args
               varNs <- newNames n "x"
               let pat = ConP constr $ map VarP varNs
-                  allVars = zipWith (filterFarg fArg) args varNs
+                  allVars = zipWith (filterFarg (getBinaryFArg fArg ty)) args varNs
                   shows = listE $ map mkShow allVars
                   conName = nameBase constr
               body <- [|K $ showConstr conName $shows|]
diff --git a/src/Data/Comp/Multi/Derive/SmartAConstructors.hs b/src/Data/Comp/Multi/Derive/SmartAConstructors.hs
--- a/src/Data/Comp/Multi/Derive/SmartAConstructors.hs
+++ b/src/Data/Comp/Multi/Derive/SmartAConstructors.hs
@@ -30,7 +30,7 @@
   inserted. -}
 smartAConstructors :: Name -> Q [Dec]
 smartAConstructors fname = do
-    TyConI (DataD _cxt _tname _targs constrs _deriving) <- abstractNewtypeQ $ reify fname
+    Just (DataInfo _cxt _tname _targs constrs _deriving) <- abstractNewtypeQ $ reify fname
     let cons = map abstractConType constrs
     liftM concat $ mapM genSmartConstr cons
         where genSmartConstr (name, args) = do
diff --git a/src/Data/Comp/Multi/Derive/SmartConstructors.hs b/src/Data/Comp/Multi/Derive/SmartConstructors.hs
--- a/src/Data/Comp/Multi/Derive/SmartConstructors.hs
+++ b/src/Data/Comp/Multi/Derive/SmartConstructors.hs
@@ -29,7 +29,7 @@
  ordinary constructors, but an 'inject' is automatically inserted. -}
 smartConstructors :: Name -> Q [Dec]
 smartConstructors fname = do
-    TyConI (DataD _cxt tname targs constrs _deriving) <- abstractNewtypeQ $ reify fname
+    Just (DataInfo _cxt tname targs constrs _deriving) <- abstractNewtypeQ $ reify fname
     let iVar = tyVarBndrName $ last targs
     let cons = map (abstractConType &&& iTp iVar) constrs
     liftM concat $ mapM (genSmartConstr (map tyVarBndrName targs) tname) cons
diff --git a/src/Data/Comp/Multi/Generic.hs b/src/Data/Comp/Multi/Generic.hs
--- a/src/Data/Comp/Multi/Generic.hs
+++ b/src/Data/Comp/Multi/Generic.hs
@@ -38,14 +38,14 @@
 -- term. This function is similar to Uniplate's @universe@ function.
 subterms :: forall f  . HFoldable f => Term f  :=> [E (Term f)]
 subterms t = build (f t)
-    where f :: Term f :=> (E (Term f) -> b -> b) -> b -> b
+    where f :: forall i b. Term f i -> (E (Term f) -> b -> b) -> b -> b
           f t cons nil = E t `cons` hfoldl (\u s -> f s cons u) nil (unTerm t)
 
 -- | This function returns a list of all subterms of the given term
 -- that are constructed from a particular functor.
 subterms' :: forall f g . (HFoldable f, g :<: f) => Term f :=> [E (g (Term f))]
 subterms' (Term t) = build (f t)
-    where f :: f (Term f) :=> (E (g (Term f)) -> b -> b) -> b -> b
+    where f :: forall i b. f (Term f) i -> (E (g (Term f)) -> b -> b) -> b -> b
           f t cons nil = let rest = hfoldl (\u (Term s) -> f s cons u) nil t
                          in case proj t of
                               Just t' -> E t' `cons` rest
diff --git a/src/Data/Comp/Multi/HFoldable.hs b/src/Data/Comp/Multi/HFoldable.hs
--- a/src/Data/Comp/Multi/HFoldable.hs
+++ b/src/Data/Comp/Multi/HFoldable.hs
@@ -41,7 +41,7 @@
     hfoldMap :: Monoid m => (a :=> m) -> h a :=> m
     hfoldMap f = hfoldr (mappend . f) mempty
 
-    hfoldr :: (a :=> b -> b) -> b -> h a :=> b
+    hfoldr :: (a :=> (b->b) ) -> b -> h a :=> b
     hfoldr f z t = appEndo (hfoldMap (Endo . f) t) z
 
     hfoldl :: (b -> a :=> b) -> b -> h a :=> b
@@ -51,7 +51,7 @@
     hfoldr1 :: forall a. (a -> a -> a) -> h (K a) :=> a
     hfoldr1 f xs = fromMaybe (error "hfoldr1: empty structure")
                    (hfoldr mf Nothing xs)
-          where mf :: K a :=> Maybe a -> Maybe a
+          where mf :: K a :=> (Maybe a -> Maybe a)
                 mf (K x) Nothing = Just x
                 mf (K x) (Just y) = Just (f x y)
 
diff --git a/src/Data/Comp/Multi/Term.hs b/src/Data/Comp/Multi/Term.hs
--- a/src/Data/Comp/Multi/Term.hs
+++ b/src/Data/Comp/Multi/Term.hs
@@ -83,9 +83,9 @@
 
 instance (HFoldable f) => HFoldable (Cxt h f) where
     hfoldr = hfoldr' where
-        hfoldr'  :: forall a b. (a :=> b -> b) -> b -> Cxt h f a :=> b
+        hfoldr'  :: forall a b. (a :=> (b -> b)) -> b -> Cxt h f a :=> b
         hfoldr' op c a = run a c where
-              run :: (Cxt h f) a :=> b ->  b
+              run :: (Cxt h f) a :=> (b ->  b)
               run (Hole a) e = a `op` e
               run (Term t) e = hfoldr run e t