我觉得应该有一个更简单的方法，我不是很自豪的名字，但这里有一个方法来做到这一点：

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeFamilies #-}

import Data.WorldPeace
import Data.Functor.Identity
import Data.Proxy
import Data.Type.Equality
import Data.Kind

class MaybeIsMember a as where
  maybeIsMember :: a -> Maybe (OpenUnion as)

class MaybeIsMember' eq a b bs where
  maybeIsMember' :: Proxy eq -> a -> Maybe (OpenUnion (b : bs))

instance MaybeIsMember' 'False a b '[] where
  maybeIsMember' _ _ = Nothing
instance MaybeIsMember' (a == b') a b' bs => MaybeIsMember' 'False a b (b' : bs) where
  maybeIsMember' _ x = That <$> maybeIsMember' (Proxy @(a == b')) x
instance MaybeIsMember' 'True a a bs where
  maybeIsMember' _ x = Just (This (Identity x))

instance forall a b bs. MaybeIsMember' (a == b) a b bs => MaybeIsMember a (b : bs) where
  maybeIsMember = maybeIsMember' (Proxy @(a == b))
instance MaybeIsMember a '[] where
  maybeIsMember _ = Nothing

type MaybeContains :: [Type] -> [Type] -> Constraint
type family MaybeContains as bs where
  MaybeContains '[] _ = ()
  MaybeContains (x : xs) ys = (MaybeIsMember x ys, MaybeContains xs ys)

-- Data.WorldPeace.openUnion is a bit too restrictive, so here's a better version
openUnion' :: (forall a as. (bs ~ (a : as)) => Either a (OpenUnion as) -> c) -> OpenUnion bs -> c
openUnion' f (This (Identity x)) = f (Left x)
openUnion' f (That x) = f (Right x)

unionShrink :: MaybeContains as bs => OpenUnion as -> Maybe (OpenUnion bs)
unionShrink = openUnion' (either maybeIsMember unionShrink)

它适用于简单的单态例子：

ghci> let int = 3 :: Int
ghci> let o = openUnionLift int :: OpenUnion '[String, Int]
ghci> unionShrink o :: Maybe (OpenUnion '[Int])
Just (Identity 3)

但我怀疑当涉及到多态性时，它是否会工作得很好。