diff --git a/constraints-extras.cabal b/constraints-extras.cabal
--- a/constraints-extras.cabal
+++ b/constraints-extras.cabal
@@ -1,5 +1,5 @@
 name: constraints-extras
-version: 0.2.1.0
+version: 0.2.2.0
 synopsis: Utility package for constraints
 license: BSD3
 license-file: LICENSE
diff --git a/src/Data/Constraint/Extras/TH.hs b/src/Data/Constraint/Extras/TH.hs
--- a/src/Data/Constraint/Extras/TH.hs
+++ b/src/Data/Constraint/Extras/TH.hs
@@ -6,16 +6,22 @@
 import Data.Constraint.Extras
 import Control.Monad
 import Data.Constraint
-import Data.Semigroup
+import Data.Maybe
 import Language.Haskell.TH
 
+import Data.Either
+
 deriveArgDict :: Name -> Q [Dec]
 deriveArgDict n = do
   ts <- gadtIndices n
   c <- newName "c"
   g <- newName "g"
-  let xs = map (AppT (VarT c)) ts
-      xs' = map (AppT (VarT c) . AppT (VarT g)) ts
+  let xs = flip map ts $ \case
+        Left t -> AppT (AppT (ConT ''ConstraintsFor) t) (VarT c)
+        Right t -> (AppT (VarT c) t)
+      xs' = flip map ts $ \case
+        Left t -> AppT (AppT (AppT (ConT ''ConstraintsFor') t) (VarT c)) (VarT g)
+        Right t -> AppT (VarT c) (AppT (VarT g) t)
       l = length xs
       constraints = foldl AppT (TupleT l) xs
       constraints' = foldl AppT (TupleT l) xs'
@@ -35,7 +41,9 @@
   vs <- gadtIndices n
   c <- newName "c"
   g <- newName "g"
-  let xs = map (\v -> AppT (VarT c) $ AppT v (VarT g)) vs
+  let xs = flip map vs $ \case
+        Left t -> AppT (AppT (AppT (ConT ''ConstraintsForV) t) (VarT c)) (VarT g)
+        Right v -> AppT (VarT c) $ AppT v (VarT g)
       l = length xs
       constraints = foldl AppT (TupleT l) xs
   {-
@@ -53,27 +61,45 @@
 matches n argDictName = do
   x <- newName "x"
   reify n >>= \case
-    TyConI (DataD _ _ _ _ cons _) -> pure $ concat $ flip map cons $ \case
-      GadtC [name] _ (AppT (ConT _) (VarT _)) ->
+    TyConI (DataD _ _ _ _ cons _) -> fmap concat $ forM cons $ \case
+      GadtC [name] _ (AppT (ConT _) (VarT _)) -> return $
         [Match (ConP name [VarP x]) (NormalB $ AppE (VarE argDictName) (VarE x)) []]
-      GadtC [name] _ _ ->
+      GadtC [name] _ _ -> return $
         [Match (RecP name []) (NormalB $ ConE 'Dict) []]
-      ForallC _ _ (GadtC [name] _ (AppT (ConT _) (VarT _))) ->
-        [Match (ConP name [VarP x]) (NormalB $ AppE (VarE argDictName) (VarE x)) []]
-      ForallC _ _ (GadtC [name] _ _) ->
+      ForallC _ _ (GadtC [name] bts (AppT (ConT _) (VarT b))) -> do
+        ps <- forM bts $ \case
+          (_, AppT (ConT a) (VarT b')) | b == b' -> do
+            hasArgDictInstance <- not . null <$> reifyInstances ''ArgDict [(ConT a)]
+            return $ if hasArgDictInstance
+              then Just x
+              else Nothing
+          _ -> return Nothing
+        return $ case catMaybes ps of
+          [] -> [Match (RecP name []) (NormalB $ ConE 'Dict) []]
+          (v:_) ->
+            let patf = \v' rest done -> if done
+                  then WildP : rest done
+                  else case v' of
+                    Nothing -> WildP : rest done
+                    Just _ -> VarP v : rest True
+                pat = foldr patf (const []) ps False
+            in [Match (ConP name pat) (NormalB $ AppE (VarE argDictName) (VarE v)) []]
+      ForallC _ _ (GadtC [name] _ _) -> return $
         [Match (RecP name []) (NormalB $ ConE 'Dict) []]
-      NormalC name [(_, AppT (ConT _) (VarT _))] ->
-        [Match (ConP name [VarP x]) (NormalB $ AppE (VarE argDictName) (VarE x)) []]
       a -> error $ "deriveArgDict matches: Unmatched 'Dec': " <> show a
     a -> error $ "deriveArgDict matches: Unmatched 'Info': " <> show a
 
-gadtIndices :: Name -> Q [Type]
+gadtIndices :: Name -> Q [Either Type Type]
 gadtIndices n = do
   reify n >>= \case
-    TyConI (DataD _ _ _ _ cons _) -> fmap concat $ forM cons $ \case
+    TyConI (DataD _ _ _ _ cons _) -> fmap concat $ forM cons $ \x -> case x of
       GadtC _ _ (AppT (ConT _) (VarT _)) -> return []
-      GadtC _ _ (AppT _ typ) -> return [typ]
-      ForallC _ _ (GadtC _ _ (AppT (ConT _) (VarT _))) -> return []
-      ForallC _ _ (GadtC _ _ (AppT _ typ)) -> return [typ]
+      GadtC _ _ (AppT _ typ) -> return [Right typ]
+      ForallC _ _ (GadtC _ bts (AppT (ConT _) (VarT _))) -> fmap concat $ forM bts $ \case
+        (_, AppT (ConT a) (VarT _)) -> do
+          hasArgDictInstance <- fmap (not . null) $ reifyInstances ''ArgDict [(ConT a)]
+          return $ if hasArgDictInstance then [Left (ConT a)] else []
+        _ -> return []
+      ForallC _ _ (GadtC _ _ (AppT _ typ)) -> return [Right typ]
       _ -> return []
     a -> error $ "gadtResults: Unmatched 'Info': " <> show a