Access a possibly missing field via some optic - Haskell

data SomeType

data Thing
  = A {x :: SomeType}
  | B {x :: SomeType}
  | C

f :: Thing -> Maybe SomeType
f = _

(+*) :: Traversal s t a b -> Traversal s' t' a' b' -> Traversal (s × s') (t × t') (a + a') (b × b')
(+*) t1 t2 f (s, s') = liftA2 (,) l r
  where
  l = t1 (fmap fst . f . Left ) s
  r = t2 (fmap snd . f . Right) s'

unit :: Traversal () () Void ()
unit _ _ = pure ()

mappendO :: Semigroup t => Traversal s t a b -> Traversal s t a b -> Traversal s t a b
mappendO t1 t2 = dimapO dup (uncurry (<>)) $ dimapO' dup merge $ t1 +* t2

memptyO :: Monoid t => Traversal s t a b
memptyO = dimapO discard (const mempty) $ dimapO' discard absurd $ unitO

type LOptic f s t a b = (a -> f b) -> s -> f t

lmapO :: (s' -> s) -> LOptic f s t a b -> LOptic f s' t a b
lmapO f o = (. f) . o

rmapO :: Functor f => (t -> t') -> LOptic f s t a b -> LOptic f s t' a b
rmapO f o = (fmap f .) . o

dimapO :: Functor f => (s' -> s) -> (t -> t') -> LOptic f s t a b -> LOptic f s' t' a b
dimapO f g = lmapO f . rmapO g

lmapO' :: Functor f => (b' -> b) -> LOptic f s t a b -> LOptic f s t a b'
lmapO' f o = o . (fmap f .)

rmapO' :: (a -> a') -> LOptic f s t a b -> LOptic f s t a' b
rmapO' f o = o . (. f)

dimapO' :: Functor f => (b' -> b) -> (a -> a') -> LOptic f s t a b -> LOptic f s t a' b'
dimapO' f g = lmapO' f . rmapO' g

dup :: x -> x × x
dup x = (x, x)

merge :: x + x -> x
merge = either id id

discard :: x -> ()
discard = const ()

absurd :: Void -> x
absurd = \case {}

data Thing
  = A {x :: SomeType}
  | B {x :: SomeType}
  | C

_A, _B :: Traversal Thing Thing SomeType SomeType

data Foo = A Int | B Int | C String

_A, _B :: Traversal' Foo Int

_AB :: Traversal Foo () Int Int
_AB = rmapO discard _A `mappendO` rmapO discard _B

whatyouwant :: Foo -> Maybe Int
whatyouwant f = f ^? _AB