diff --git a/ChangeLog.md b/ChangeLog.md
index 4f66241..90e0c6b 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,5 +1,10 @@
 # Revision history for aeson-gadt-th
 
+## 0.2.2
+
+* Do a better job determining which variables are rigid when looking for instances
+* Unify discovered instance head with argument type and make the same substitution in the context that constrains the instance we're writing
+
 ## 0.2.1.2
 
 * Add version bounds to cabal file
diff --git a/README.md b/README.md
index 0c25341..9d51b22 100644
--- a/README.md
+++ b/README.md
@@ -14,20 +14,21 @@ Example Usage:
 > {-# LANGUAGE FlexibleInstances #-}
 > {-# LANGUAGE UndecidableInstances #-}
 > {-# LANGUAGE MultiParamTypeClasses #-}
-> 
+> {-# OPTIONS_GHC -ddump-splices #-}
+>
 > import Data.Aeson
 > import Data.Aeson.GADT.TH
-> 
+>
 > import Data.Dependent.Map (DMap, Some(..))
 > import Data.Dependent.Sum (DSum)
 > import Data.Functor.Identity
 > import Data.GADT.Compare
 > import Data.GADT.Show.TH
-> 
+>
 > data A :: * -> * where
 >   A_a :: A a
 >   A_b :: Int -> A ()
-> 
+>
 > deriveJSONGADT ''A
 > deriveGShow ''A
 >
@@ -36,14 +37,26 @@ Example Usage:
 >   B_x :: B c a
 >
 > deriveJSONGADT ''B
-> 
+>
 > data C t :: * -> * where
 >   C_t :: t -> C t t
-> 
+>
 > deriveJSONGADT ''C
-> 
+>
+> data D t x :: * -> * where
+>   D_t :: t -> D t x t
+>   D_x :: x -> D t x x
+>   D_i :: Int -> D t x Int
+>
+> deriveJSONGADT ''D
+>
+> data Auth token a where
+>   Auth_Login :: String -> String -> Auth token (Either String token)
+>
+> deriveJSONGADT ''Auth
+>
 > -- Some real-world-ish examples.
-> 
+>
 > -- | Edit operations for `LabelledGraph`
 > data LabelledGraphEdit v vm em :: * -> * where
 >   LabelledGraphEdit_ClearAll :: LabelledGraphEdit v vm em ()
@@ -51,7 +64,7 @@ Example Usage:
 >   LabelledGraphEdit_AddEdge :: v -> v -> em -> LabelledGraphEdit v vm em ()
 >   LabelledGraphEdit_SetVertexProperties :: v -> vm -> LabelledGraphEdit v vm em ()
 >   LabelledGraphEdit_SetEdgeProperties :: v -> v -> em -> LabelledGraphEdit v vm em ()
-> 
+>
 > -- | PropertyGraphEdit operatios for `PropertyGraph`
 > data PropertyGraphEdit v vp ep r where
 >   PropertyGraphEdit_ClearAll :: PropertyGraphEdit v vp ep ()
@@ -59,17 +72,17 @@ Example Usage:
 >   PropertyGraphEdit_AddEdge :: v -> v -> (DMap ep Identity) -> PropertyGraphEdit v vp ep ()
 >   PropertyGraphEdit_SetVertexProperty :: GCompare vp => v -> DSum vp Identity -> PropertyGraphEdit v vp ep ()
 >   PropertyGraphEdit_SetEdgeProperty :: GCompare ep => v -> v -> DSum ep Identity -> PropertyGraphEdit v vp ep ()
-> 
+>
 > -- | View operations for `LabelledGraph`
 > data LabelledGraphView v vm em :: * -> * where
 >   LabelledGraphView_All :: LabelledGraphView v vm em ()
 >   LabelledGraphView_GetVertexProperties :: v -> LabelledGraphView v vm em vm
 >   LabelledGraphView_GetEdgeProperties :: v -> v -> LabelledGraphView v vm em em
-> 
+>
 > deriveJSONGADT ''LabelledGraphEdit
 > deriveJSONGADT ''PropertyGraphEdit
 > deriveJSONGADT ''LabelledGraphView
-> 
+>
 > main :: IO ()
 > main = do
 >   putStrLn $ unlines
@@ -91,7 +104,7 @@ Example Usage:
 >     , show $ encode (B_a 'a' (A_b 1))
 >     , "Decoding of encoded (B_a 'a' (A_b 1)):"
 >     , case (decode $ encode (B_a 'a' (A_b 1)) :: Maybe (Some (B Char))) of
->         Just (This (B_a 'a' (A_b 1))) -> "Succeeded"
+>         Just (Some (B_a 'a' (A_b 1))) -> "Succeeded"
 >         _-> "Failed"
 >     ]
 ```
diff --git a/aeson-gadt-th.cabal b/aeson-gadt-th.cabal
index 8ae73ec..bdb8156 100644
--- a/aeson-gadt-th.cabal
+++ b/aeson-gadt-th.cabal
@@ -1,6 +1,6 @@
 cabal-version: 2.0
 name: aeson-gadt-th
-version: 0.2.1.2
+version: 0.2.2
 synopsis: Derivation of Aeson instances for GADTs
 category: JSON
 description: Template Haskell for generating ToJSON and FromJSON instances for GADTs. See <https://github.com/obsidiansystems/aeson-gadt-th/blob/master/README.md README.md> for examples.
@@ -23,9 +23,11 @@ library
   build-depends: base >= 4.8 && < 4.13
                , aeson >= 1.4 && < 1.5
                , containers >= 0.5 && < 0.7
-               , dependent-sum >= 0.6.2 && < 0.7
+               , dependent-sum >= 0.6.1 && < 0.7
                , transformers >= 0.5 && < 0.6
                , template-haskell >= 2.11.0 && < 2.15
+               , th-abstraction >= 0.3.1.0 && < 0.4
+               , th-extras >= 0.0.0.4 && < 0.1
   hs-source-dirs: src
   default-language: Haskell2010
 
diff --git a/src/Data/Aeson/GADT/TH.hs b/src/Data/Aeson/GADT/TH.hs
index 938b586..7549c07 100644
--- a/src/Data/Aeson/GADT/TH.hs
+++ b/src/Data/Aeson/GADT/TH.hs
@@ -15,6 +15,8 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE PolyKinds #-}
+
 
 module Data.Aeson.GADT.TH
   ( deriveJSONGADT
@@ -35,10 +37,52 @@ import Control.Monad.Trans.Class
 import Control.Monad.Trans.Writer
 import Data.Aeson
 import Data.List
+import Data.Map (Map)
+import qualified Data.Map as Map
 import Data.Maybe
 import qualified Data.Set as Set
 import Data.Some (Some (..))
 import Language.Haskell.TH hiding (cxt)
+import Language.Haskell.TH.Extras (nameOfBinder)
+import Data.Set (Set)
+import qualified Data.Set as Set
+
+import Language.Haskell.TH.Datatype
+
+import System.IO (hFlush, stdout)
+
+-- Do not export this type family, it must remain empty. It's used as a way to trick GHC into not unifying certain type variables.
+type family Skolem :: k -> k
+
+tyVarBndrName :: TyVarBndr -> Name
+tyVarBndrName = \case
+  PlainTV n -> n
+  KindedTV n _ -> n
+
+skolemize :: Set Name -> Type -> Type
+skolemize rigids t = case t of
+  ForallT bndrs cxt t' -> ForallT bndrs cxt (skolemize (Set.difference rigids (Set.fromList (map tyVarBndrName bndrs))) t')
+  AppT t1 t2 -> AppT (skolemize rigids t1) (skolemize rigids t2)
+  SigT t k -> SigT (skolemize rigids t) k
+  VarT v -> if Set.member v rigids
+    then AppT (ConT ''Skolem) (VarT v)
+    else t
+  InfixT t1 n t2 -> InfixT (skolemize rigids t1) n (skolemize rigids t2)
+  UInfixT t1 n t2 -> UInfixT (skolemize rigids t1) n (skolemize rigids t2)
+  ParensT t -> ParensT (skolemize rigids t)
+  _ -> t
+
+reifyInstancesWithRigids :: Set Name -> Name -> [Type] -> Q [InstanceDec]
+reifyInstancesWithRigids rigids cls tys = reifyInstances cls (map (skolemize rigids) tys)
+
+-- | Determine the type variables which occur freely in a type.
+freeTypeVariables :: Type -> Set Name
+freeTypeVariables t = case t of
+  ForallT bndrs _ t' -> Set.difference (freeTypeVariables t') (Set.fromList (map nameOfBinder bndrs))
+  AppT t1 t2 -> Set.union (freeTypeVariables t1) (freeTypeVariables t2)
+  SigT t _ -> freeTypeVariables t
+  VarT n -> Set.singleton n
+  _ -> Set.empty
 
 newtype JSONGADTOptions = JSONGADTOptions
   { gadtConstructorModifier :: String -> String }
@@ -62,13 +106,12 @@ deriveToJSONGADT = deriveToJSONGADTWithOptions defaultJSONGADTOptions
 
 deriveToJSONGADTWithOptions :: JSONGADTOptions -> Name -> DecsQ
 deriveToJSONGADTWithOptions opts n = do
-  x <- reify n
-  let cons = case x of
-       TyConI d -> decCons d
-       _ -> error $ "deriveToJSONGADT: Name `" ++ show n ++ "' does not appear to be the name of a type constructor."
+  info <- reifyDatatype n
+  let cons = datatypeCons info
   topVars <- makeTopVars n
   let n' = foldl (\c v -> AppT c (VarT v)) (ConT n) topVars
-  (matches, constraints') <- runWriterT (mapM (fmap pure . conMatchesToJSON opts (init topVars)) cons)
+  (matches, constraints') <- runWriterT (mapM (fmap pure . conMatchesToJSON opts topVars) cons)
+  m <- sequence matches
   let constraints = map head . group . sort $ constraints' -- This 'head' is safe because 'group' returns a list of non-empty lists
   impl <- funD (mkName "toJSON")
     [ clause [] (normalB $ lamCaseE matches) []
@@ -86,22 +129,20 @@ deriveFromJSONGADT = deriveFromJSONGADTWithOptions defaultJSONGADTOptions
 
 deriveFromJSONGADTWithOptions :: JSONGADTOptions -> Name -> DecsQ
 deriveFromJSONGADTWithOptions opts n = do
-  x <- reify n
-  let decl = case x of
-        TyConI d -> d
-        _ -> error $ "deriveFromJSONGADT: Name `" ++ show n ++ "' does not appear to be the name of a type constructor."
-      cons = decCons decl
+  info <- reifyDatatype n
+
+  let cons = datatypeCons info
       allConNames =
         intercalate ", " $
-          map (gadtConstructorModifier opts . nameBase . conName) cons
+          map (gadtConstructorModifier opts . nameBase . constructorName) cons
   wildName <- newName "s"
   let wild = match (varP wildName) (normalB [e|
         fail $
           "Expected tag to be one of [" ++ allConNames ++ "] but got: "
           ++ $(varE wildName)
         |]) []
-  topVars <- init <$> makeTopVars n
-  let n' = foldl (\c v -> AppT c (VarT v)) (ConT n) topVars
+  topVars <- makeTopVars n
+  let n' = foldl (\c v -> AppT c (VarT v)) (ConT n) $ init topVars
   (matches, constraints') <- runWriterT $ mapM (conMatchesParseJSON opts topVars [|_v'|]) cons
   let constraints = map head . group . sort $ constraints' -- This 'head' is safe because 'group' returns a list of non-empty lists
   v <- newName "v"
@@ -113,116 +154,111 @@ deriveFromJSONGADTWithOptions opts n = do
     ]
   return [ InstanceD Nothing constraints (AppT (ConT ''FromJSON) (AppT (ConT ''Some) n')) [parser] ]
 
+splitTopVars :: [Name] -> (Set Name, Name)
+splitTopVars allTopVars = case reverse allTopVars of
+  (x:xs) -> (Set.fromList xs, x)
+  _ -> error "splitTopVars: Empty set of variables"
+
 -- | Implementation of 'toJSON'
-conMatchesToJSON :: JSONGADTOptions -> [Name] -> Con -> WriterT [Type] Q Match
-conMatchesToJSON opts topVars c = do
-  let name = conName c
+conMatchesToJSON :: JSONGADTOptions -> [Name] -> ConstructorInfo -> WriterT [Type] Q Match
+conMatchesToJSON opts allTopVars c = do
+  let (topVars, lastVar) = splitTopVars allTopVars
+      name = constructorName c
       base = gadtConstructorModifier opts $ nameBase name
       toJSONExp e = [| toJSON $(e) |]
-  vars <- lift $ replicateM (conArity c) (newName "x")
+  vars <- lift . forM (constructorFields c) $ \_ -> newName "x"
   let body = toJSONExp $ tupE [ [| base :: String |] , tupE $ map (toJSONExp . varE) vars ]
-  _ <- conMatches (AppT (ConT ''ToJSON)) topVars c
+  _ <- conMatches ''ToJSON topVars lastVar c
   lift $ match (conP name (map varP vars)) (normalB body) []
 
 -- | Implementation of 'parseJSON'
-conMatchesParseJSON :: JSONGADTOptions -> [Name] -> ExpQ -> Con -> WriterT [Type] Q Match
-conMatchesParseJSON opts topVars e c = do
-  (pat, conApp) <- conMatches (AppT (ConT ''FromJSON))  topVars c
-  let match' = match (litP (StringL (gadtConstructorModifier opts $ nameBase (conName c))))
+conMatchesParseJSON :: JSONGADTOptions -> [Name] -> ExpQ -> ConstructorInfo -> WriterT [Type] Q Match
+conMatchesParseJSON opts allTopVars e c = do
+  let (topVars, lastVar) = splitTopVars allTopVars
+  (pat, conApp) <- conMatches ''FromJSON topVars lastVar c
+  let match' = match (litP (StringL (gadtConstructorModifier opts $ nameBase (constructorName c))))
       body = doE [ bindS (return pat) [| parseJSON $e |]
-                 , noBindS [| return (This $(return conApp)) |]
+                 , noBindS [| return (Some $(return conApp)) |]
                  ]
   lift $ match' (normalB body) []
 
 conMatches
-  :: (Type -> Type) -- ^ Function to apply to form instance constraints
-  -> [Name] -- Names of variables used in the instance head in argument order
-  -> Con
+  :: Name -- ^ Name of class (''ToJSON or ''FromJSON)
+  -> Set Name -- Names of variables used in the instance head in argument order
+  -> Name -- Final type variable (the index type)
+  -> ConstructorInfo
   -> WriterT [Type] Q (Pat, Exp)
-conMatches mkConstraint topVars c = do
-  let name = conName c
-      forTypes types resultType = do
-        vars <- forM types $ \typ -> do
-          x <- lift $ newName "x"
-          case typ of
-            AppT (ConT tn) (VarT _) -> do
-              -- This may be a nested GADT, so check for special FromJSON instance
-              idec <- lift $ reifyInstances ''FromJSON [AppT (ConT ''Some) (ConT tn)]
-              case idec of
-                [] -> do
-                  tell [mkConstraint (substVarsWith topVars resultType typ)]
-                  return (VarP x, VarE x)
-                _ -> return $ (ConP 'This [VarP x], VarE x) -- If a FromJSON instance is found for Some f, then we use it.
-            _ -> do
-              tell [mkConstraint (substVarsWith topVars resultType typ)]
-              return (VarP x, VarE x)
-        let pat = TupP (map fst vars)
-            conApp = foldl AppE (ConE name) (map snd vars)
-        return (pat, conApp)
-  case c of
-    ForallC _ cxt (GadtC _ tys t) -> do
-      tell (map (substVarsWith topVars t) cxt)
-      forTypes (map snd tys) t
-    GadtC _ tys t -> forTypes (map snd tys) t
-    --NormalC _ tys -> forTypes (map snd tys) -- nb: If this comes up in a GADT-style declaration, please open an issue on the github repo with an example.
-    _ -> error "conMatches: Unmatched constructor type"
+conMatches clsName topVars ixVar c = do
+  let mkConstraint = AppT (ConT clsName)
+      name = constructorName c
+      types = constructorFields c
+      (constraints, equalities') = flip partition (constructorContext c) $ \case
+        AppT (AppT EqualityT _) _ -> False
+        _ -> True
+      equalities = concat [ [(a, b), (b, a)] | AppT (AppT EqualityT a) b <- equalities' ]
+  unifiedEqualities :: [Map Name Type] <- lift $ forM equalities $ \(a, b) -> unifyTypes [a, b]
+  let rigidImplications :: Map Name (Set Name)
+      rigidImplications = Map.unionsWith Set.union $ fmap freeTypeVariables <$> unifiedEqualities
+  let expandRigids :: Set Name -> Set Name
+      expandRigids rigids = Set.union rigids $ Set.unions $ Map.elems $
+        restrictKeys rigidImplications rigids
+      expandRigidsFully rigids =
+        let rigids' = expandRigids rigids
+        in if rigids' == rigids then rigids else expandRigidsFully rigids'
+      rigidVars = expandRigidsFully topVars
+      ixSpecialization :: Map Name Type
+      ixSpecialization = restrictKeys (Map.unions unifiedEqualities) $ Set.singleton ixVar
+      -- We filter out constraints which don't mention variables from the instance head mostly to avoid warnings,
+      -- but a good deal more of these occur than one might expect due to the normalisation done by reifyDatatype.
+      tellCxt cs = do
+        tell [c | c <- applySubstitution ixSpecialization cs ]
+  tellCxt constraints
+  vars <- forM types $ \typ -> do
+    x <- lift $ newName "x"
+    let demandInstanceIfNecessary = do
+          insts <- lift $ reifyInstancesWithRigids rigidVars clsName [typ]
+          case insts of
+            [] -> tellCxt [AppT (ConT clsName) typ]
+            [InstanceD _ cxt (AppT _className ityp) _] -> do
+              sub <- lift $ unifyTypes [ityp, typ]
+              tellCxt $ applySubstitution sub cxt
+
+            _ -> error $ "The following instances of " ++ show clsName ++ " for " ++ show typ ++ " exist (rigids: " ++ unwords (map show $ Set.toList rigidVars) ++ "), and I don't know which to pick:\n" ++ unlines (map (show . ppr) insts)
+    case typ of
+      AppT tn (VarT _) -> do
+        -- This may be a nested GADT, so check for special FromJSON instance
+        insts <- lift $ reifyInstancesWithRigids rigidVars clsName [AppT (ConT ''Some) tn]
+        case insts of
+          [] -> do
+            -- No special instance, try to check the type for a straightforward one, since if we don't have one, we need to demand it.
+            demandInstanceIfNecessary
+            return (VarP x, VarE x)
+          [InstanceD _ cxt (AppT _className (AppT (ConT _some) ityp)) _] -> do
+            sub <- lift $ unifyTypes [ityp, tn]
+            tellCxt $ applySubstitution sub cxt
+            return (ConP 'Some [VarP x], VarE x)
+          _ -> error $ "The following instances of " ++ show clsName ++ " for " ++ show (ppr [AppT (ConT ''Some) tn]) ++ " exist (rigids: " ++ unwords (map show $ Set.toList rigidVars) ++ "), and I don't know which to pick:\n" ++ unlines (map (show . ppr) insts)
+      _ -> do
+        demandInstanceIfNecessary  
+        return (VarP x, VarE x)
+  let pat = TupP (map fst vars)
+      conApp = foldl AppE (ConE name) (map snd vars)
+  return (pat, conApp)
 
 -----------------------------------------------------------------------------------------------------
 
--- | Assuming that we're building an instance of the form C (T v_1 ... v_(n-1)) for some GADT T, this function
--- takes a list of the variables v_1 ... v_(n-1) used in the instance head, as well as the result type of some data
--- constructor, say T x_1 ... x_(n-1) x_n, as well as the type t of some argument to it, and substitutes any of
--- x_i (1 <= i <= n-1) occurring in t for the corresponding v_i, taking care to avoid name capture by foralls in t.
-substVarsWith
-  :: [Name] -- Names of variables used in the instance head in argument order
-  -> Type -- Result type of constructor
-  -> Type -- Type of argument to the constructor
-  -> Type -- Type of argument with variables substituted for instance head variables.
-substVarsWith topVars resultType argType = subst Set.empty argType
-  where
-    topVars' = reverse topVars
-    AppT resultType' _indexType = resultType
-    subst bs = \case
-      ForallT bndrs cxt t ->
-        let bs' = Set.union bs (Set.fromList (map tyVarBndrName bndrs))
-        in ForallT bndrs (map (subst bs') cxt) (subst bs' t)
-      AppT f x -> AppT (subst bs f) (subst bs x)
-      SigT t k -> SigT (subst bs t) k
-      VarT v -> if Set.member v bs
-        then VarT v
-        else VarT (findVar v topVars' resultType')
-      InfixT t1 x t2 -> InfixT (subst bs t1) x (subst bs t2)
-      UInfixT t1 x t2 -> UInfixT (subst bs t1) x (subst bs t2)
-      ParensT t -> ParensT (subst bs t)
-      -- The following cases could all be covered by an "x -> x" case, but I'd rather know if new cases
-      -- need to be handled specially in future versions of Template Haskell.
-      PromotedT n -> PromotedT n
-      ConT n -> ConT n
-      TupleT k -> TupleT k
-      UnboxedTupleT k -> UnboxedTupleT k
-#if MIN_VERSION_template_haskell(2,12,0)
-      UnboxedSumT k -> UnboxedSumT k
-#endif
-      ArrowT -> ArrowT
-      EqualityT -> EqualityT
-      ListT -> ListT
-      PromotedTupleT k -> PromotedTupleT k
-      PromotedNilT -> PromotedNilT
-      PromotedConsT -> PromotedConsT
-      StarT -> StarT
-      ConstraintT -> ConstraintT
-      LitT l -> LitT l
-      WildCardT -> WildCardT
-    findVar v (tv:_) (AppT _ (VarT v')) | v == v' = tv
-    findVar v (_:tvs) (AppT t (VarT _)) = findVar v tvs t
-    findVar v _ _ = error $ "substVarsWith: couldn't look up variable substitution for " ++ show v
-      ++ " with topVars: " ++ show topVars ++ " resultType: " ++ show resultType ++ " argType: " ++ show argType
-
--- | Determine the 'Name' being bound by a 'TyVarBndr'.
-tyVarBndrName :: TyVarBndr -> Name
-tyVarBndrName = \case
-  PlainTV n -> n
-  KindedTV n _ -> n
+-- | Determines the name of a data constructor. It's an error if the 'Con' binds more than one name (which
+-- happens in the case where you use GADT syntax, and give multiple data constructor names separated by commas
+-- in a type signature in the where clause).
+conName :: Con -> Name
+conName c = case c of
+  NormalC n _ -> n
+  RecC n _ -> n
+  InfixC _ n _ -> n
+  ForallC _ _ c' -> conName c'
+  GadtC [n] _ _ -> n
+  RecGadtC [n] _ _ -> n
+  _ -> error "conName: GADT constructors with multiple names not yet supported"
 
 -- | Determine the arity of a kind.
 kindArity :: Kind -> Int
@@ -233,12 +269,6 @@ kindArity = \case
   ParensT t -> kindArity t
   _ -> 0
 
--- | Given the name of a type constructor, determine its full arity
-tyConArity :: Name -> Q Int
-tyConArity n = do
-  (ts, ka) <- tyConArity' n
-  return (length ts + ka)
-
 -- | Given the name of a type constructor, determine a list of type variables bound as parameters by
 -- its declaration, and the arity of the kind of type being defined (i.e. how many more arguments would
 -- need to be supplied in addition to the bound parameters in order to obtain an ordinary type of kind *).
@@ -249,33 +279,13 @@ tyConArity' n = reify n >>= return . \case
   TyConI (NewtypeD _ _ ts mk _ _) -> (ts, fromMaybe 0 (fmap kindArity mk))
   _ -> error $ "tyConArity': Supplied name reified to something other than a data declaration: " ++ show n
 
--- | Determine the constructors bound by a data or newtype declaration. Errors out if supplied with another
--- sort of declaration.
-decCons :: Dec -> [Con]
-decCons = \case
-  DataD _ _ _ _ cs _ -> cs
-  NewtypeD _ _ _ _ c _ -> [c]
-  _ -> error "decCons: Declaration found was not a data or newtype declaration."
 
--- | Determines the name of a data constructor. It's an error if the 'Con' binds more than one name (which
--- happens in the case where you use GADT syntax, and give multiple data constructor names separated by commas
--- in a type signature in the where clause).
-conName :: Con -> Name
-conName c = case c of
-  NormalC n _ -> n
-  RecC n _ -> n
-  InfixC _ n _ -> n
-  ForallC _ _ c' -> conName c'
-  GadtC [n] _ _ -> n
-  RecGadtC [n] _ _ -> n
-  _ -> error "conName: GADT constructors with multiple names not yet supported"
+-----------------------------------------------------------------------------------------------------
 
--- | Determine the arity of a data constructor.
-conArity :: Con -> Int
-conArity c = case c of
-  NormalC _ ts -> length ts
-  RecC _ ts -> length ts
-  InfixC _ _ _ -> 2
-  ForallC _ _ c' -> conArity c'
-  GadtC _ ts _ -> length ts
-  RecGadtC _ ts _ -> length ts
+restrictKeys :: Ord k => Map k v -> Set k -> Map k v
+restrictKeys m s =
+#if MIN_VERSION_containers(0,5,8)
+  Map.restrictKeys m s
+#else
+  Map.intersection m $ Map.fromSet (const ()) s
+#endif
diff --git a/test/Test.hs b/test/Test.hs
index f97e9ca..ebdbe39 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -23,9 +23,9 @@ main = hspec $ do
       toJSON (Baz 1.2) `shouldBe` [aesonQQ| ["Baz", 1.2] |]
     it "should generate an expected FromJSON Some instance" $ do
       fromJSON [aesonQQ| ["Bar", "a"] |]
-        `shouldMatchPattern_` (\case Success (This (Bar 'a')) -> ())
+        `shouldMatchPattern_` (\case Success (Some (Bar 'a')) -> ())
       fromJSON [aesonQQ| ["Baz", 1.2] |]
-        `shouldMatchPattern_` (\case Success (This (Baz 1.2)) -> ())
+        `shouldMatchPattern_` (\case Success (Some (Baz 1.2)) -> ())
       (fromJSON [aesonQQ| ["bad", "input"] |] :: Result (Some Foo))
         `shouldMatchPattern_` (\case Error "Expected tag to be one of [Bar, Baz] but got: bad" -> ())
 
@@ -34,9 +34,9 @@ main = hspec $ do
       toJSON (Spam'Life 1.2) `shouldBe` [aesonQQ| ["Life", 1.2] |]
     it "should generate an expected FromJSON Some instance with options" $ do
       fromJSON [aesonQQ| ["Eggs", "a"] |]
-        `shouldMatchPattern_` (\case Success (This (Spam'Eggs 'a')) -> ())
+        `shouldMatchPattern_` (\case Success (Some (Spam'Eggs 'a')) -> ())
       fromJSON [aesonQQ| ["Life", 1.2] |]
-        `shouldMatchPattern_` (\case Success (This (Spam'Life 1.2)) -> ())
+        `shouldMatchPattern_` (\case Success (Some (Spam'Life 1.2)) -> ())
       (fromJSON [aesonQQ| ["bad", "input"] |] :: Result (Some Spam))
         `shouldMatchPattern_` (\case Error "Expected tag to be one of [Eggs, Life] but got: bad" -> ())