diff --git a/compdata-param.cabal b/compdata-param.cabal
--- a/compdata-param.cabal
+++ b/compdata-param.cabal
@@ -1,5 +1,5 @@
 Name:			compdata-param
-Version:		0.9
+Version:		0.9.1
 Synopsis:            	Parametric Compositional Data Types
 Description:
 
@@ -79,6 +79,7 @@
                         Data.Comp.Param.Derive.SmartAConstructors
                         Data.Comp.Param.Derive.Injections
                         Data.Comp.Param.Derive.Projections
+                        Data.Comp.Param.Derive.Utils
 
                         Data.Comp.Param.Multi.Derive.HDifunctor
                         Data.Comp.Param.Multi.Derive.Equality
@@ -89,7 +90,7 @@
                         Data.Comp.Param.Multi.Derive.Injections
                         Data.Comp.Param.Multi.Derive.Projections
 
-  Build-Depends:	base >= 4.7, base < 5, template-haskell, mtl, transformers, compdata >= 0.10 && < 0.11
+  Build-Depends:	base >= 4.7, base < 5, template-haskell, mtl, transformers, compdata >= 0.10.1 && < 0.11
   hs-source-dirs:	src
   ghc-options:          -W
 
@@ -98,7 +99,7 @@
   Type:                 exitcode-stdio-1.0
   Main-is:		Tests.hs
   hs-source-dirs:	testsuite/tests examples
-  Build-Depends:        base >= 4.7, base < 5, template-haskell, mtl, transformers, compdata >= 0.10 && < 0.11, HUnit,
+  Build-Depends:        base >= 4.7, base < 5, template-haskell, mtl, transformers, compdata >= 0.10.1 && < 0.11, HUnit,
                         test-framework, test-framework-hunit, containers, compdata-param
 
 source-repository head
diff --git a/src/Data/Comp/Param/Derive/Difunctor.hs b/src/Data/Comp/Param/Derive/Difunctor.hs
--- a/src/Data/Comp/Param/Derive/Difunctor.hs
+++ b/src/Data/Comp/Param/Derive/Difunctor.hs
@@ -19,6 +19,7 @@
     ) where
 
 import Data.Comp.Derive.Utils
+import Data.Comp.Param.Derive.Utils
 import Data.Comp.Param.Difunctor
 import Language.Haskell.TH
 
@@ -29,11 +30,11 @@
   -- Comments below apply to the example where name = T, args = [a,b,c], and
   -- constrs = [(X,[c]), (Y,[a,c]), (Z,[b -> c])], i.e. the data type
   -- declaration: T a b c = X c | Y a c | Z (b -> c)
-  TyConI (DataD _ name args constrs _) <- abstractNewtypeQ $ reify fname
+  Just (DataInfo _ name args constrs _) <- abstractNewtypeQ $ reify fname
   -- coArg = c (covariant difunctor argument)
-  let coArg :: Name = tyVarBndrName $ last args
+  let coArg :: Type = VarT $ tyVarBndrName $ last args
   -- conArg = b (contravariant difunctor argument)
-  let conArg :: Name = tyVarBndrName $ last $ init args
+  let conArg :: Type = VarT $ tyVarBndrName $ last $ init args
   -- argNames = [a]
   let argNames = map (VarT . tyVarBndrName) (init $ init args)
   -- compType = T a
@@ -41,11 +42,11 @@
   -- classType = Difunctor (T a)
   let classType = AppT (ConT ''Difunctor) complType
   -- constrs' = [(X,[c]), (Y,[a,c]), (Z,[b -> c])]
-  constrs' :: [(Name,[Type])] <- mapM normalConExp constrs
+  constrs' :: [(Name,[Type], Maybe Type)] <- mapM normalConExp constrs
   dimapDecl <- funD 'dimap (map (dimapClause conArg coArg) constrs')
-  return [InstanceD [] classType [dimapDecl]]
-      where dimapClause :: Name -> Name -> (Name,[Type]) -> ClauseQ
-            dimapClause conArg coArg (constr, args) = do
+  return [mkInstanceD [] classType [dimapDecl]]
+      where dimapClause :: Type -> Type -> (Name,[Type], Maybe Type) -> ClauseQ
+            dimapClause conArg' coArg' (constr, args, gadtTy) = do
               fn <- newName "_f"
               gn <- newName "_g"
               varNs <- newNames (length args) "x"
@@ -55,9 +56,10 @@
               let gp = VarP gn
               -- Pattern for the constructor
               let pat = ConP constr $ map VarP varNs
+              let (conArg, coArg) = getBinaryFArgs conArg' coArg' gadtTy
               body <- dimapArgs conArg coArg f g (zip varNs args) (conE constr)
               return $ Clause [fp, gp, pat] (NormalB body) []
-            dimapArgs :: Name -> Name -> ExpQ -> ExpQ
+            dimapArgs :: Type -> Type -> ExpQ -> ExpQ
                       -> [(Name, Type)] -> ExpQ -> ExpQ
             dimapArgs _ _ _ _ [] acc =
                 acc
@@ -69,14 +71,14 @@
             -- to the parameter of the given type.
             -- Example: dimapArg a b (a -> b) f g yields the expression
             -- [|\x -> g . x . f|]
-            dimapArg :: Name -> Name -> Type -> ExpQ -> ExpQ -> ExpQ
+            dimapArg :: Type -> Type -> Type -> ExpQ -> ExpQ -> ExpQ
             dimapArg conArg coArg tp f g
-                | not (containsType tp (VarT conArg)) &&
-                  not (containsType tp (VarT coArg)) = [| id |]
+                | not (containsType tp conArg) &&
+                  not (containsType tp coArg) = [| id |]
                 | otherwise =
                     case tp of
-                      VarT a | a == conArg -> f
-                             | a == coArg -> g
+                      a | a == conArg -> f
+                        | a == coArg -> g
                       AppT (AppT ArrowT tp1) tp2 -> do
                           xn <- newName "x"
                           let ftp1 = dimapArg conArg coArg tp1 f g
@@ -90,7 +92,7 @@
                       SigT tp' _ ->
                           dimapArg conArg coArg tp' f g
                       _ ->
-                          if containsType tp (VarT conArg) then
+                          if containsType tp conArg then
                               [| dimap $f $g |]
                           else
                               [| fmap $g |]
diff --git a/src/Data/Comp/Param/Derive/Ditraversable.hs b/src/Data/Comp/Param/Derive/Ditraversable.hs
--- a/src/Data/Comp/Param/Derive/Ditraversable.hs
+++ b/src/Data/Comp/Param/Derive/Ditraversable.hs
@@ -19,6 +19,7 @@
     ) where
 
 import Data.Comp.Derive.Utils
+import Data.Comp.Param.Derive.Utils
 import Data.Comp.Param.Ditraversable
 import Data.Traversable (mapM)
 import Language.Haskell.TH
@@ -38,20 +39,21 @@
   first-order kind taking at least one argument. -}
 makeDitraversable :: Name -> Q [Dec]
 makeDitraversable 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
       aArg = VarT . tyVarBndrName $ last (init args)
-      funTy = foldl AppT ArrowT [aArg,fArg]
       argNames = map (VarT . tyVarBndrName) (init $ init args)
       complType = foldl AppT (ConT name) argNames
       classType = foldl1 AppT [ConT ''Ditraversable, complType]
   normConstrs <- mapM normalConExp constrs
-  constrs' <- mapM (mkPatAndVars . isFarg fArg funTy) normConstrs
+  constrs' <- mapM (mkPatAndVars . isFarg aArg fArg) normConstrs
   mapMDecl <- funD 'dimapM (map mapMClause constrs')
   sequenceDecl <- funD 'disequence (map sequenceClause constrs')
-  return [InstanceD [] classType [mapMDecl,sequenceDecl]]
-      where isFarg fArg funTy (constr, args) =
-                (constr, map (\t -> (t `containsType'` fArg, t `containsType'` funTy)) args)
+  return [mkInstanceD [] classType [mapMDecl,sequenceDecl]]
+      where isFarg aArg' fArg' (constr, args, gadtTy) =
+              let (aArg, fArg) = getBinaryFArgs aArg' fArg' gadtTy
+                  funTy = foldl AppT ArrowT [aArg,fArg]
+              in (constr, map (\t -> (t `containsType'` fArg, t `containsType'` funTy)) args)
             filterVar _ _ nonFarg ([],[]) x  = nonFarg x
             filterVar farg _ _ ([depth],[]) x = farg depth x
             filterVar _ aarg _ ([_],[depth]) x = aarg depth x
diff --git a/src/Data/Comp/Param/Derive/Equality.hs b/src/Data/Comp/Param/Derive/Equality.hs
--- a/src/Data/Comp/Param/Derive/Equality.hs
+++ b/src/Data/Comp/Param/Derive/Equality.hs
@@ -19,6 +19,7 @@
     ) where
 
 import Data.Comp.Derive.Utils
+import Data.Comp.Param.Derive.Utils
 import Data.Comp.Param.FreshM hiding (Name)
 import Data.Comp.Param.Equality
 import Control.Monad
@@ -31,11 +32,11 @@
   -- Comments below apply to the example where name = T, args = [a,b,c], and
   -- constrs = [(X,[c]), (Y,[a,c]), (Z,[b -> c])], i.e. the data type
   -- declaration: T a b c = X c | Y a c | Z (b -> c)
-  TyConI (DataD _ name args constrs _) <- abstractNewtypeQ $ reify fname
+  Just (DataInfo _ name args constrs _) <- abstractNewtypeQ $ reify fname
   -- coArg = c (covariant difunctor argument)
-  let coArg :: Name = tyVarBndrName $ last args
+  let coArg :: Type = VarT $ tyVarBndrName $ last args
   -- conArg = b (contravariant difunctor argument)
-  let conArg :: Name = tyVarBndrName $ last $ init args
+  let conArg :: Type = VarT $ tyVarBndrName $ last $ init args
   -- argNames = [a]
   let argNames = map (VarT . tyVarBndrName) (init $ init args)
   -- compType = T a
@@ -43,42 +44,43 @@
   -- classType = Difunctor (T a)
   let classType = AppT (ConT ''EqD) complType
   -- constrs' = [(X,[c]), (Y,[a,c]), (Z,[b -> c])]
-  constrs' :: [(Name,[Type])] <- mapM normalConExp constrs
+  constrs' :: [(Name,[Type],Maybe Type)] <- mapM normalConExp constrs
   let defC = if length constrs < 2 then
                  []
              else
                  [clause [wildP,wildP] (normalB [|return False|]) []]
   eqDDecl <- funD 'eqD (map (eqDClause conArg coArg) constrs' ++ defC)
   let context = map (\arg -> mkClassP ''Eq [arg]) argNames
-  return [InstanceD context classType [eqDDecl]]
-      where eqDClause :: Name -> Name -> (Name,[Type]) -> ClauseQ
-            eqDClause conArg coArg (constr, args) = do
+  return [mkInstanceD context classType [eqDDecl]]
+      where eqDClause :: Type -> Type -> (Name,[Type], Maybe Type) -> ClauseQ
+            eqDClause conArg' coArg' (constr, args, gadtTy) = do
               varXs <- newNames (length args) "x"
               varYs <- newNames (length args) "y"
               -- Patterns for the constructors
               let patx = ConP constr $ map VarP varXs
               let paty = ConP constr $ map VarP varYs
+              let (conArg, coArg) = getBinaryFArgs conArg' coArg' gadtTy
               body <- eqDBody conArg coArg (zip3 varXs varYs args)
               return $ Clause [patx,paty] (NormalB body) []
-            eqDBody :: Name -> Name -> [(Name, Name, Type)] -> ExpQ
+            eqDBody :: Type -> Type -> [(Name, Name, Type)] -> ExpQ
             eqDBody conArg coArg x =
                 [|liftM and (sequence $(listE $ map (eqDB conArg coArg) x))|]
-            eqDB :: Name -> Name -> (Name, Name, Type) -> ExpQ
+            eqDB :: Type -> Type -> (Name, Name, Type) -> ExpQ
             eqDB conArg coArg (x, y, tp)
-                | not (containsType tp (VarT conArg)) &&
-                  not (containsType tp (VarT coArg)) =
+                | not (containsType tp conArg) &&
+                  not (containsType tp coArg) =
                     [| return $ $(varE x) == $(varE y) |]
                 | otherwise =
                     case tp of
-                      VarT a
+                      a
                           | a == coArg -> [| peq $(varE x) $(varE y) |]
-                      AppT (AppT ArrowT (VarT a)) _
+                      AppT (AppT ArrowT a) _
                           | a == conArg ->
                               [| withName (\v -> peq ($(varE x) v) ($(varE y) v)) |]
                       SigT tp' _ ->
                           eqDB conArg coArg (x, y, tp')
                       _ ->
-                          if containsType tp (VarT conArg) then
+                          if containsType tp conArg then
                               [| eqD $(varE x) $(varE y) |]
                           else
                               [| peq $(varE x) $(varE y) |]
diff --git a/src/Data/Comp/Param/Derive/Ordering.hs b/src/Data/Comp/Param/Derive/Ordering.hs
--- a/src/Data/Comp/Param/Derive/Ordering.hs
+++ b/src/Data/Comp/Param/Derive/Ordering.hs
@@ -21,6 +21,7 @@
 import Data.Comp.Param.FreshM hiding (Name)
 import Data.Comp.Param.Ordering
 import Data.Comp.Derive.Utils
+import Data.Comp.Param.Derive.Utils
 import Language.Haskell.TH hiding (Cxt)
 import Control.Monad (liftM)
 
@@ -31,11 +32,11 @@
   -- Comments below apply to the example where name = T, args = [a,b,c], and
   -- constrs = [(X,[c]), (Y,[a,c]), (Z,[b -> c])], i.e. the data type
   -- declaration: T a b c = X c | Y a c | Z (b -> c)
-  TyConI (DataD _ name args constrs _) <- abstractNewtypeQ $ reify fname
+  Just (DataInfo _ name args constrs _) <- abstractNewtypeQ $ reify fname
   -- coArg = c (covariant difunctor argument)
-  let coArg :: Name = tyVarBndrName $ last args
+  let coArg :: Type = VarT $ tyVarBndrName $ last args
   -- conArg = b (contravariant difunctor argument)
-  let conArg :: Name = tyVarBndrName $ last $ init args
+  let conArg :: Type = VarT $ tyVarBndrName $ last $ init args
   -- argNames = [a]
   let argNames = map (VarT . tyVarBndrName) (init $ init args)
   -- compType = T a
@@ -43,11 +44,11 @@
   -- classType = Difunctor (T a)
   let classType = AppT (ConT ''OrdD) complType
   -- constrs' = [(X,[c]), (Y,[a,c]), (Z,[b -> c])]
-  constrs' :: [(Name,[Type])] <- mapM normalConExp constrs
+  constrs' :: [(Name,[Type], Maybe Type)] <- mapM normalConExp constrs
   compareDDecl <- funD 'compareD (compareDClauses conArg coArg constrs')
   let context = map (\arg -> mkClassP ''Ord [arg]) argNames
-  return [InstanceD context classType [compareDDecl]]
-      where compareDClauses :: Name -> Name -> [(Name,[Type])] -> [ClauseQ]
+  return [mkInstanceD context classType [compareDDecl]]
+      where compareDClauses :: Type -> Type -> [(Name,[Type], Maybe Type)] -> [ClauseQ]
             compareDClauses _ _ [] = []
             compareDClauses conArg coArg constrs = 
                 let constrs' = constrs `zip` [1..]
@@ -57,37 +58,38 @@
                 | n == m = genEqClause conArg coArg c
                 | n < m = genLtClause c d
                 | otherwise = genGtClause c d
-            genEqClause :: Name -> Name -> (Name,[Type]) -> ClauseQ
-            genEqClause conArg coArg (constr, args) = do 
+            genEqClause :: Type -> Type -> (Name,[Type], Maybe Type) -> ClauseQ
+            genEqClause conArg' 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
+              let (conArg, coArg) = getBinaryFArgs conArg' coArg' gadtTy
               body <- eqDBody conArg coArg (zip3 varXs varYs args)
               return $ Clause [patX, patY] (NormalB body) []
-            eqDBody :: Name -> Name -> [(Name, Name, Type)] -> ExpQ
+            eqDBody :: Type -> Type -> [(Name, Name, Type)] -> ExpQ
             eqDBody conArg coArg x =
                 [|liftM compList (sequence $(listE $ map (eqDB conArg coArg) x))|]
-            eqDB :: Name -> Name -> (Name, Name, Type) -> ExpQ
+            eqDB :: Type -> Type -> (Name, Name, Type) -> ExpQ
             eqDB conArg coArg (x, y, tp)
-                | not (containsType tp (VarT conArg)) &&
-                  not (containsType tp (VarT coArg)) =
+                | not (containsType tp conArg) &&
+                  not (containsType tp coArg) =
                     [| return $ compare $(varE x) $(varE y) |]
                 | otherwise =
                     case tp of
-                      VarT a
+                      a
                           | a == coArg -> [| pcompare $(varE x) $(varE y) |]
-                      AppT (AppT ArrowT (VarT a)) _
+                      AppT (AppT ArrowT a) _
                           | a == conArg ->
                               [| withName (\v -> pcompare ($(varE x) v) ($(varE y) v)) |]
                       SigT tp' _ ->
                           eqDB conArg coArg (x, y, tp')
                       _ ->
-                          if containsType tp (VarT conArg) then
+                          if containsType tp conArg then
                               [| compareD $(varE x) $(varE y) |]
                           else
                               [| pcompare $(varE x) $(varE y) |]
-            genLtClause (c, _) (d, _) =
+            genLtClause (c, _, _) (d, _, _) =
                 clause [recP c [], recP d []] (normalB [| return LT |]) []
-            genGtClause (c, _) (d, _) =
+            genGtClause (c, _, _) (d, _, _) =
                 clause [recP c [], recP d []] (normalB [| return GT |]) []
diff --git a/src/Data/Comp/Param/Derive/Show.hs b/src/Data/Comp/Param/Derive/Show.hs
--- a/src/Data/Comp/Param/Derive/Show.hs
+++ b/src/Data/Comp/Param/Derive/Show.hs
@@ -19,6 +19,7 @@
     ) where
 
 import Data.Comp.Derive.Utils
+import Data.Comp.Param.Derive.Utils
 import Data.Comp.Param.FreshM hiding (Name)
 import qualified Data.Comp.Param.FreshM as FreshM
 import Control.Monad
@@ -42,11 +43,11 @@
   -- Comments below apply to the example where name = T, args = [a,b,c], and
   -- constrs = [(X,[c]), (Y,[a,c]), (Z,[b -> c])], i.e. the data type
   -- declaration: T a b c = X c | Y a c | Z (b -> c)
-  TyConI (DataD _ name args constrs _) <- abstractNewtypeQ $ reify fname
+  Just (DataInfo _ name args constrs _) <- abstractNewtypeQ $ reify fname
   -- coArg = c (covariant difunctor argument)
-  let coArg :: Name = tyVarBndrName $ last args
+  let coArg :: Type = VarT $ tyVarBndrName $ last args
   -- conArg = b (contravariant difunctor argument)
-  let conArg :: Name = tyVarBndrName $ last $ init args
+  let conArg :: Type = VarT $ tyVarBndrName $ last $ init args
   -- argNames = [a]
   let argNames = map (VarT . tyVarBndrName) (init $ init args)
   -- compType = T a
@@ -54,39 +55,40 @@
   -- classType = Difunctor (T a)
   let classType = AppT (ConT ''ShowD) complType
   -- constrs' = [(X,[c]), (Y,[a,c]), (Z,[b -> c])]
-  constrs' :: [(Name,[Type])] <- mapM normalConExp constrs
+  constrs' :: [(Name,[Type], Maybe Type)] <- mapM normalConExp constrs
   showDDecl <- funD 'showD (map (showDClause conArg coArg) constrs')
   let context = map (\arg -> mkClassP ''Show [arg]) argNames
-  return [InstanceD context classType [showDDecl]]
-      where showDClause :: Name -> Name -> (Name,[Type]) -> ClauseQ
-            showDClause conArg coArg (constr, args) = do
+  return [mkInstanceD context classType [showDDecl]]
+      where showDClause :: Type -> Type -> (Name,[Type], Maybe Type) -> ClauseQ
+            showDClause conArg' coArg' (constr, args, gadtTy) = do
               varXs <- newNames (length args) "x"
               -- Pattern for the constructor
               let patx = ConP constr $ map VarP varXs
+              let (conArg, coArg) = getBinaryFArgs conArg' coArg' gadtTy
               body <- showDBody (nameBase constr) conArg coArg (zip varXs args)
               return $ Clause [patx] (NormalB body) []
-            showDBody :: String -> Name -> Name -> [(Name, Type)] -> ExpQ
+            showDBody :: String -> Type -> Type -> [(Name, Type)] -> ExpQ
             showDBody constr conArg coArg x =
                 [|liftM (unwords . (constr :) .
                          map (\x -> if elem ' ' x then "(" ++ x ++ ")" else x))
                         (sequence $(listE $ map (showDB conArg coArg) x))|]
-            showDB :: Name -> Name -> (Name, Type) -> ExpQ
+            showDB :: Type -> Type -> (Name, Type) -> ExpQ
             showDB conArg coArg (x, tp)
-                | not (containsType tp (VarT conArg)) &&
-                  not (containsType tp (VarT coArg)) =
+                | not (containsType tp conArg) &&
+                  not (containsType tp coArg) =
                     [| return $ show $(varE x) |]
                 | otherwise =
                     case tp of
-                      VarT a
+                      a
                           | a == coArg -> [| $(varE x) |]
-                      AppT (AppT ArrowT (VarT a)) _
+                      AppT (AppT ArrowT a) _
                           | a == conArg ->
                               [| withName (\v -> do body <- $(varE x) v;
                                                     return $ "\\" ++ show v ++ " -> " ++ body) |]
                       SigT tp' _ ->
                           showDB conArg coArg (x, tp')
                       _ ->
-                          if containsType tp (VarT conArg) then
+                          if containsType tp conArg then
                               [| showD $(varE x) |]
                           else
                               [| liftM show $ T.mapM (liftM Dummy) $(varE x) |]
diff --git a/src/Data/Comp/Param/Derive/SmartAConstructors.hs b/src/Data/Comp/Param/Derive/SmartAConstructors.hs
--- a/src/Data/Comp/Param/Derive/SmartAConstructors.hs
+++ b/src/Data/Comp/Param/Derive/SmartAConstructors.hs
@@ -30,7 +30,7 @@
  'injectA . dimap Var id' is automatically 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/Param/Derive/SmartConstructors.hs b/src/Data/Comp/Param/Derive/SmartConstructors.hs
--- a/src/Data/Comp/Param/Derive/SmartConstructors.hs
+++ b/src/Data/Comp/Param/Derive/SmartConstructors.hs
@@ -29,7 +29,7 @@
  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/Param/Derive/Utils.hs b/src/Data/Comp/Param/Derive/Utils.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Comp/Param/Derive/Utils.hs
@@ -0,0 +1,34 @@
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Comp.Param.Derive.Utils
+-- Copyright   :  (c) 2016 Patrick Bahr
+-- License     :  BSD3
+-- Maintainer  :  Patrick Bahr <paba@diku.dk>
+-- Stability   :  experimental
+-- Portability :  non-portable (GHC Extensions)
+--
+-- This module defines some utility functions for deriving instances
+-- for functor based type classes.
+--
+--------------------------------------------------------------------------------
+module Data.Comp.Param.Derive.Utils where
+
+import Language.Haskell.TH
+
+-- | Auxiliary function to extract the first and second argument of a
+-- binary type application (the third argument of this function). If
+-- the second argument is @Nothing@ or not of the right shape, the
+-- first two arguments are returned as a default.
+
+getBinaryFArgs :: Type -> Type -> Maybe Type -> (Type,Type)
+getBinaryFArgs _ _ (Just (AppT (AppT _ t1)  t2)) = (t1, t2)
+getBinaryFArgs t1 t2 _ = (t1, t2)
+
+-- | Auxiliary function to extract the first and second argument of a
+-- ternary type application (the third argument of this function). If
+-- the second argument is @Nothing@ or not of the right shape, the
+-- first two arguments are returned as a default.
+
+getTernaryFArgs :: Type -> Type -> Maybe Type -> (Type,Type)
+getTernaryFArgs _ _ (Just (AppT (AppT (AppT _ t1)  t2) _) ) = (t1, t2)
+getTernaryFArgs t1 t2 _ = (t1, t2)
diff --git a/src/Data/Comp/Param/Multi/Derive/Equality.hs b/src/Data/Comp/Param/Multi/Derive/Equality.hs
--- a/src/Data/Comp/Param/Multi/Derive/Equality.hs
+++ b/src/Data/Comp/Param/Multi/Derive/Equality.hs
@@ -19,6 +19,7 @@
     ) where
 
 import Data.Comp.Derive.Utils
+import Data.Comp.Param.Derive.Utils
 import Data.Comp.Param.Multi.FreshM hiding (Name)
 import Data.Comp.Param.Multi.Equality
 import Control.Monad
@@ -28,51 +29,52 @@
   kind taking at least three arguments. -}
 makeEqHD :: Name -> Q [Dec]
 makeEqHD 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'
   -- contravariant argument
-  let conArg :: Name = tyVarBndrName $ last $ init args'
+  let conArg :: Type = VarT $ tyVarBndrName $ last $ init args'
   let argNames = map (VarT . tyVarBndrName) (init $ init args')
   let complType = foldl AppT (ConT name) argNames
   let classType = AppT (ConT ''EqHD) complType
-  constrs' :: [(Name,[Type])] <- mapM normalConExp constrs
+  constrs' :: [(Name,[Type], Maybe Type)] <- mapM normalConExp constrs
   let defC = if length constrs < 2 then
                  []
              else
                  [clause [wildP,wildP] (normalB [|return False|]) []]
   eqHDDecl <- funD 'eqHD (map (eqHDClause conArg coArg) constrs' ++ defC)
   let context = map (\arg -> mkClassP ''Eq [arg]) argNames
-  return [InstanceD context classType [eqHDDecl]]
-      where eqHDClause :: Name -> Name -> (Name,[Type]) -> ClauseQ
-            eqHDClause conArg coArg (constr, args) = do
+  return [mkInstanceD context classType [eqHDDecl]]
+      where eqHDClause :: Type -> Type -> (Name,[Type], Maybe Type) -> ClauseQ
+            eqHDClause conArg' coArg' (constr, args, gadtTy) = do
               varXs <- newNames (length args) "x"
               varYs <- newNames (length args) "y"
               -- Patterns for the constructors
               let patx = ConP constr $ map VarP varXs
               let paty = ConP constr $ map VarP varYs
+              let (conArg, coArg) = getTernaryFArgs conArg' coArg' gadtTy
               body <- eqHDBody conArg coArg (zip3 varXs varYs args)
               return $ Clause [patx,paty] (NormalB body) []
-            eqHDBody :: Name -> Name -> [(Name, Name, Type)] -> ExpQ
+            eqHDBody :: Type -> Type -> [(Name, Name, Type)] -> ExpQ
             eqHDBody conArg coArg x =
                 [|liftM and (sequence $(listE $ map (eqHDB conArg coArg) x))|]
-            eqHDB :: Name -> Name -> (Name, Name, Type) -> ExpQ
+            eqHDB :: Type -> Type -> (Name, Name, Type) -> ExpQ
             eqHDB conArg coArg (x, y, tp)
-                | not (containsType tp (VarT conArg)) &&
-                  not (containsType tp (VarT coArg)) =
+                | not (containsType tp conArg) &&
+                  not (containsType tp coArg) =
                     [| return $ $(varE x) == $(varE y) |]
                 | otherwise =
                     case tp of
-                      AppT (VarT a) _ 
+                      AppT a _ 
                           | a == coArg -> [| peq $(varE x) $(varE y) |]
-                      AppT (AppT ArrowT (AppT (VarT a) _)) _
+                      AppT (AppT ArrowT (AppT a _)) _
                           | a == conArg ->
                               [| withName (\v -> peq ($(varE x) $ nameCoerce v)                                                      ($(varE y) $ nameCoerce v)) |]
                       SigT tp' _ ->
                           eqHDB conArg coArg (x, y, tp')
                       _ ->
-                          if containsType tp (VarT conArg) then
+                          if containsType tp conArg then
                               [| eqHD $(varE x) $(varE y) |]
                           else
                               [| peq $(varE x) $(varE y) |]
diff --git a/src/Data/Comp/Param/Multi/Derive/HDifunctor.hs b/src/Data/Comp/Param/Multi/Derive/HDifunctor.hs
--- a/src/Data/Comp/Param/Multi/Derive/HDifunctor.hs
+++ b/src/Data/Comp/Param/Multi/Derive/HDifunctor.hs
@@ -19,6 +19,7 @@
     ) where
 
 import Data.Comp.Derive.Utils
+import Data.Comp.Param.Derive.Utils
 import Data.Comp.Param.Multi.HDifunctor
 import Language.Haskell.TH
 
@@ -26,20 +27,20 @@
   kind taking at least three arguments. -}
 makeHDifunctor :: Name -> Q [Dec]
 makeHDifunctor 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'
   -- contravariant argument
-  let conArg :: Name = tyVarBndrName $ last $ init args'
+  let conArg :: Type = VarT $ tyVarBndrName $ last $ init args'
   let argNames = map (VarT . tyVarBndrName) (init $ init args')
   let complType = foldl AppT (ConT name) argNames
   let classType = AppT (ConT ''HDifunctor) complType
-  constrs' :: [(Name,[Type])] <- mapM normalConExp constrs
+  constrs' :: [(Name,[Type], Maybe Type)] <- mapM normalConExp constrs
   hdimapDecl <- funD 'hdimap (map (hdimapClause conArg coArg) constrs')
-  return [InstanceD [] classType [hdimapDecl]]
-      where hdimapClause :: Name -> Name -> (Name,[Type]) -> ClauseQ
-            hdimapClause conArg coArg (constr, args) = do
+  return [mkInstanceD [] classType [hdimapDecl]]
+      where hdimapClause :: Type -> Type -> (Name,[Type], Maybe Type) -> ClauseQ
+            hdimapClause conArg' coArg' (constr, args, gadtTy) = do
               fn <- newName "_f"
               gn <- newName "_g"
               varNs <- newNames (length args) "x"
@@ -49,23 +50,24 @@
               let gp = VarP gn
               -- Pattern for the constructor
               let pat = ConP constr $ map VarP varNs
+              let (conArg, coArg) = getTernaryFArgs conArg' coArg' gadtTy
               body <- hdimapArgs conArg coArg f g (zip varNs args) (conE constr)
               return $ Clause [fp, gp, pat] (NormalB body) []
-            hdimapArgs :: Name -> Name -> ExpQ -> ExpQ
+            hdimapArgs :: Type -> Type -> ExpQ -> ExpQ
                       -> [(Name, Type)] -> ExpQ -> ExpQ
             hdimapArgs _ _ _ _ [] acc =
                 acc
             hdimapArgs conArg coArg f g ((x,tp):tps) acc =
                 hdimapArgs conArg coArg f g tps
                           (acc `appE` (hdimapArg conArg coArg tp f g `appE` varE x))
-            hdimapArg :: Name -> Name -> Type -> ExpQ -> ExpQ -> ExpQ
+            hdimapArg :: Type -> Type -> Type -> ExpQ -> ExpQ -> ExpQ
             hdimapArg conArg coArg tp f g
-                | not (containsType tp (VarT conArg)) &&
-                  not (containsType tp (VarT coArg)) = [| id |]
+                | not (containsType tp conArg) &&
+                  not (containsType tp coArg) = [| id |]
                 | otherwise =
                     case tp of
-                      AppT (VarT a) _ | a == conArg -> f
-                                      | a == coArg -> g
+                      AppT a _ | a == conArg -> f
+                               | a == coArg -> g
                       AppT (AppT ArrowT tp1) tp2 -> do
                           xn <- newName "x"
                           let ftp1 = hdimapArg conArg coArg tp1 f g
@@ -79,7 +81,7 @@
                       SigT tp' _ ->
                           hdimapArg conArg coArg tp' f g
                       _ ->
-                          if containsType tp (VarT conArg) then
+                          if containsType tp conArg then
                               [| hdimap $f $g |]
                           else
                               [| fmap $g |]
diff --git a/src/Data/Comp/Param/Multi/Derive/Ordering.hs b/src/Data/Comp/Param/Multi/Derive/Ordering.hs
--- a/src/Data/Comp/Param/Multi/Derive/Ordering.hs
+++ b/src/Data/Comp/Param/Multi/Derive/Ordering.hs
@@ -21,6 +21,7 @@
 import Data.Comp.Param.Multi.FreshM hiding (Name)
 import Data.Comp.Param.Multi.Ordering
 import Data.Comp.Derive.Utils
+import Data.Comp.Param.Derive.Utils
 import Data.Maybe
 import Data.List
 import Language.Haskell.TH hiding (Cxt)
@@ -33,20 +34,20 @@
   kind taking at least three arguments. -}
 makeOrdHD :: Name -> Q [Dec]
 makeOrdHD 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'
   -- contravariant argument
-  let conArg :: Name = tyVarBndrName $ last $ init args'
+  let conArg :: Type = VarT $ tyVarBndrName $ last $ init args'
   let argNames = map (VarT . tyVarBndrName) (init $ init args')
   let complType = foldl AppT (ConT name) argNames
   let classType = AppT (ConT ''OrdHD) complType
-  constrs' :: [(Name,[Type])] <- mapM normalConExp constrs
+  constrs' :: [(Name,[Type], Maybe Type)] <- mapM normalConExp constrs
   compareHDDecl <- funD 'compareHD (compareHDClauses conArg coArg constrs')
   let context = map (\arg -> mkClassP ''Ord [arg]) argNames
-  return [InstanceD context classType [compareHDDecl]]
-      where compareHDClauses :: Name -> Name -> [(Name,[Type])] -> [ClauseQ]
+  return [mkInstanceD context classType [compareHDDecl]]
+      where compareHDClauses :: Type -> Type -> [(Name,[Type], Maybe Type)] -> [ClauseQ]
             compareHDClauses _ _ [] = []
             compareHDClauses conArg coArg constrs = 
                 let constrs' = constrs `zip` [1..]
@@ -56,38 +57,39 @@
                 | n == m = genEqClause conArg coArg c
                 | n < m = genLtClause c d
                 | otherwise = genGtClause c d
-            genEqClause :: Name -> Name -> (Name,[Type]) -> ClauseQ
-            genEqClause conArg coArg (constr, args) = do 
+            genEqClause :: Type -> Type -> (Name,[Type], Maybe Type) -> ClauseQ
+            genEqClause conArg' 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
+              let (conArg, coArg) = getTernaryFArgs conArg' coArg' gadtTy
               body <- eqDBody conArg coArg (zip3 varXs varYs args)
               return $ Clause [patX, patY] (NormalB body) []
-            eqDBody :: Name -> Name -> [(Name, Name, Type)] -> ExpQ
+            eqDBody :: Type -> Type -> [(Name, Name, Type)] -> ExpQ
             eqDBody conArg coArg x =
                 [|liftM compList (sequence $(listE $ map (eqDB conArg coArg) x))|]
-            eqDB :: Name -> Name -> (Name, Name, Type) -> ExpQ
+            eqDB :: Type -> Type -> (Name, Name, Type) -> ExpQ
             eqDB conArg coArg (x, y, tp)
-                | not (containsType tp (VarT conArg)) &&
-                  not (containsType tp (VarT coArg)) =
+                | not (containsType tp conArg) &&
+                  not (containsType tp coArg) =
                     [| return $ compare $(varE x) $(varE y) |]
                 | otherwise =
                     case tp of
-                      AppT (VarT a) _ 
+                      AppT a _ 
                           | a == coArg -> [| pcompare $(varE x) $(varE y) |]
-                      AppT (AppT ArrowT (AppT (VarT a) _)) _
+                      AppT (AppT ArrowT (AppT a _)) _
                           | a == conArg ->
                               [| withName (\v -> pcompare ($(varE x) $ nameCoerce v)
                                                           ($(varE y) $ nameCoerce v)) |]
                       SigT tp' _ ->
                           eqDB conArg coArg (x, y, tp')
                       _ ->
-                          if containsType tp (VarT conArg) then
+                          if containsType tp conArg then
                               [| compareHD $(varE x) $(varE y) |]
                           else
                               [| pcompare $(varE x) $(varE y) |]
-            genLtClause (c, _) (d, _) =
+            genLtClause (c, _, _) (d, _, _) =
                 clause [recP c [], recP d []] (normalB [| return LT |]) []
-            genGtClause (c, _) (d, _) =
+            genGtClause (c, _, _) (d, _, _) =
                 clause [recP c [], recP d []] (normalB [| return GT |]) []
diff --git a/src/Data/Comp/Param/Multi/Derive/Show.hs b/src/Data/Comp/Param/Multi/Derive/Show.hs
--- a/src/Data/Comp/Param/Multi/Derive/Show.hs
+++ b/src/Data/Comp/Param/Multi/Derive/Show.hs
@@ -18,6 +18,7 @@
      makeShowHD
     ) where
 
+import Data.Comp.Param.Derive.Utils
 import Data.Comp.Derive.Utils
 import Data.Comp.Param.Multi.FreshM hiding (Name)
 import qualified Data.Comp.Param.Multi.FreshM as FreshM
@@ -40,48 +41,49 @@
   kind taking at least three arguments. -}
 makeShowHD :: Name -> Q [Dec]
 makeShowHD 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'
   -- contravariant argument
-  let conArg :: Name = tyVarBndrName $ last $ init args'
+  let conArg :: Type = VarT $ tyVarBndrName $ last $ init args'
   let argNames = map (VarT . tyVarBndrName) (init $ init args')
   let complType = foldl AppT (ConT name) argNames
   let classType = AppT (ConT ''ShowHD) complType
-  constrs' :: [(Name,[Type])] <- mapM normalConExp constrs
+  constrs' :: [(Name,[Type], Maybe Type)] <- mapM normalConExp constrs
   showHDDecl <- funD 'showHD (map (showHDClause conArg coArg) constrs')
   let context = map (\arg -> mkClassP ''Show [arg]) argNames
-  return [InstanceD context classType [showHDDecl]]
-      where showHDClause :: Name -> Name -> (Name,[Type]) -> ClauseQ
-            showHDClause conArg coArg (constr, args) = do
+  return [mkInstanceD context classType [showHDDecl]]
+      where showHDClause :: Type -> Type -> (Name,[Type], Maybe Type) -> ClauseQ
+            showHDClause conArg' coArg' (constr, args, gadtTy) = do
               varXs <- newNames (length args) "x"
               -- Pattern for the constructor
               let patx = ConP constr $ map VarP varXs
+              let (conArg, coArg) = getBinaryFArgs conArg' coArg' gadtTy
               body <- showHDBody (nameBase constr) conArg coArg (zip varXs args)
               return $ Clause [patx] (NormalB body) []
-            showHDBody :: String -> Name -> Name -> [(Name, Type)] -> ExpQ
+            showHDBody :: String -> Type -> Type -> [(Name, Type)] -> ExpQ
             showHDBody constr conArg coArg x =
                 [|liftM (unwords . (constr :) .
                          map (\x -> if elem ' ' x then "(" ++ x ++ ")" else x))
                         (sequence $(listE $ map (showHDB conArg coArg) x))|]
-            showHDB :: Name -> Name -> (Name, Type) -> ExpQ
+            showHDB :: Type -> Type -> (Name, Type) -> ExpQ
             showHDB conArg coArg (x, tp)
-                | not (containsType tp (VarT conArg)) &&
-                  not (containsType tp (VarT coArg)) =
+                | not (containsType tp conArg) &&
+                  not (containsType tp coArg) =
                     [| return $ show $(varE x) |]
                 | otherwise =
                     case tp of
-                      AppT (VarT a) _ 
+                      AppT a _ 
                           | a == coArg -> [| unK $(varE x) |]
-                      AppT (AppT ArrowT (AppT (VarT a) _)) _
+                      AppT (AppT ArrowT (AppT a _)) _
                           | a == conArg ->
                               [| withName (\v -> do body <- (unK . $(varE x)) v
                                                     return $ "\\" ++ show v ++ " -> " ++ body) |]
                       SigT tp' _ ->
                           showHDB conArg coArg (x, tp')
                       _ ->
-                          if containsType tp (VarT conArg) then
+                          if containsType tp conArg then
                               [| showHD $(varE x) |]
                           else
                               [| liftM show $ T.mapM (liftM Dummy . unK) $(varE x) |]
diff --git a/src/Data/Comp/Param/Multi/Derive/SmartAConstructors.hs b/src/Data/Comp/Param/Multi/Derive/SmartAConstructors.hs
--- a/src/Data/Comp/Param/Multi/Derive/SmartAConstructors.hs
+++ b/src/Data/Comp/Param/Multi/Derive/SmartAConstructors.hs
@@ -31,7 +31,7 @@
  'injectA . hdimap Var id' is automatically 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/Param/Multi/Derive/SmartConstructors.hs b/src/Data/Comp/Param/Multi/Derive/SmartConstructors.hs
--- a/src/Data/Comp/Param/Multi/Derive/SmartConstructors.hs
+++ b/src/Data/Comp/Param/Multi/Derive/SmartConstructors.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskell, CPP #-}
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Comp.Param.Multi.Derive.SmartConstructors
@@ -30,14 +30,18 @@
  'inject . hdimap Var id' 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
-        where iTp iVar (ForallC _ cxt _) =
+        where iTp iVar (ForallC _ cxt constr) =
                   -- Check if the GADT phantom type is constrained
                   case [y | Just (x, y) <- map isEqualP cxt, x == VarT iVar] of
-                    [] -> Nothing
+                    [] -> case constr of
+#if __GLASGOW_HASKELL__ >= 800
+                      GadtC _ _ (AppT _ tp) -> Just tp
+#endif
+                      _ -> Nothing
                     tp:_ -> Just tp
               iTp _ _ = Nothing
               genSmartConstr targs tname ((name, args), miTp) = do