diff --git a/Data/Aeson/TH.hs b/Data/Aeson/TH.hs
--- a/Data/Aeson/TH.hs
+++ b/Data/Aeson/TH.hs
@@ -159,21 +159,22 @@
 import Data.Aeson.Types ( Value(..), Parser )
 -- from base:
 import Control.Applicative ( pure, (<$>), (<*>) )
-import Control.Monad       ( return, mapM, liftM2, fail )
+import Control.Monad       ( return, mapM, liftM2, fail, (>>=) )
 import Data.Bool           ( otherwise )
 import Data.Eq             ( (==) )
-import Data.Function       ( ($), (.), id )
+import Data.Function       ( ($), (.), id, fix )
 import Data.Functor        ( fmap )
 import Data.List           ( (++), foldl, foldl', intercalate
                            , length, map, zip, genericLength
                            )
+import qualified Data.Set as Set
 import Data.Maybe          ( Maybe(Nothing, Just) )
-import Prelude             ( String, (-), Integer, fromIntegral, error )
+import Prelude             ( String, (-), Integer, fromIntegral, error, snd )
 import Text.Printf         ( printf )
 import Text.Show           ( show )
 #if __GLASGOW_HASKELL__ < 700
 import Control.Monad       ( (>>=) )
-import Prelude             ( fromInteger )
+import Prelude             ( fromInteger, snd )
 #endif
 -- from unordered-containers:
 import qualified Data.HashMap.Strict as H ( lookup, toList, size )
@@ -262,9 +263,32 @@
                   ]
       where
         classType = conT ''ToJSON
-        typeNames = map tvbName tvbs
-        instanceType = foldl' appT (conT name) $ map varT typeNames
+        lhsTypNames = map tvbName tvbs
+        rhsTypNames = getTypVarNames cons
+        typeNames = Set.toList $ Set.intersection
+                    (Set.fromList lhsTypNames)
+                    (Set.fromList rhsTypNames)
+        instanceType = foldl' appT (conT name) $ map varT lhsTypNames
 
+-- gets all type variable names from the constructors
+getTypVarNames :: [Con] -> [Name]
+getTypVarNames cons
+    = types >>= fix (\f t -> case t of
+                          ForallT _ _ ty -> f ty
+                          VarT v         -> [v]
+                          AppT ty1 ty2   -> f ty1 ++ f ty2
+                          SigT ty _      -> f ty
+                          _              -> []
+                    )
+  where
+    types = cons >>= conTyps
+    conTyps :: Con -> [Type]
+    conTyps (NormalC _ stys) = map snd stys
+    conTyps (RecC _ vstys) = map (\(_, _, ty) -> ty) vstys
+    conTyps (InfixC (_, ty1) _ (_, ty2)) = [ty1, ty2]
+    conTyps (ForallC _ _ c) = conTyps c -- quantified typ vars will be taken care of by intersection with lhs type vars
+                                 
+                    
 -- | Generates a lambda expression which encodes the given data type as JSON.
 --
 -- Example:
@@ -435,8 +459,12 @@
                   ]
       where
         classType = conT ''FromJSON
-        typeNames = map tvbName tvbs
-        instanceType = foldl' appT (conT name) $ map varT typeNames
+        lhsTypNames = map tvbName tvbs
+        rhsTypNames = getTypVarNames cons
+        typeNames = Set.toList $ Set.intersection
+                    (Set.fromList lhsTypNames)
+                    (Set.fromList rhsTypNames)
+        instanceType = foldl' appT (conT name) $ map varT lhsTypNames
 
 -- | Generates a lambda expression which parses the JSON encoding of the given
 -- data type.
diff --git a/aeson.cabal b/aeson.cabal
--- a/aeson.cabal
+++ b/aeson.cabal
@@ -1,5 +1,5 @@
 name:            aeson
-version:         0.6.0.0
+version:         0.6.0.1
 license:         BSD3
 license-file:    LICENSE
 category:        Text, Web, JSON
diff --git a/release-notes.markdown b/release-notes.markdown
--- a/release-notes.markdown
+++ b/release-notes.markdown
@@ -1,3 +1,6 @@
+# 0.6.0.1
+No more constraints on phantom types
+
 # 0.5 to 0.6
 
 This release introduces a slightly obscure, but