Fix withTyCon

Author: Martoon-00

beam-migrate/Database/Beam/Migrate/Checks.hs

@@ -20,7 +20,7 @@ import Data.Aeson.Types (Parser, Value)
 import Data.Hashable (Hashable (..))
 import Data.Proxy (Proxy (..))
 import Data.Text (Text)
-import Data.Typeable (Typeable, cast, typeOf, typeRep, typeRepTyCon)
+import Data.Typeable (Typeable, cast, splitTyConApp, typeOf, typeRep)
 #if !MIN_VERSION_base(4, 11, 0)
 import Data.Semigroup
 #endif
@@ -167,12 +167,15 @@ instance DatabasePredicate TableHasIndex where
 -- | Match a given item's type against a type-level application with the given
 -- type constructor. Applies the given function and returns 'Just' its result on match,
 -- 'Nothing' otherwise.
+-- Unlike 'cast', this function does not require @a@ type to be instance of 'Typeable'.
 withTyCon
     :: forall (con :: * -> *) (item :: *) r.
        (Typeable con, Typeable item)
     => (forall a. con a -> r) -> item -> Maybe r
 withTyCon f x = do
-    guard (typeRepTyCon (typeRep (Proxy @item)) == typeRepTyCon (typeOf x))
+    (itemTyCon, itemTyArgs@(_ : _)) <- pure $ splitTyConApp (typeOf x)
+    (conTyCon, conTyArgs) <- pure $ splitTyConApp (typeRep (Proxy @con))
+    guard (itemTyCon == conTyCon && init itemTyArgs == conTyArgs)
     return (f $ unsafeCoerce x)
 
 -- | Convert gathered indices into checks.