Access a possibly missing field via some optic - Haskell

Welcome to the Functional Programming Zulip Chat Archive. You can join the chat here.

Georgi Lyubenov // googleson78
data SomeType

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

f :: Thing -> Maybe SomeType
f = _

Can I implement f easily with some optic usage? (with generic-lens)

Fintan Halpenny

You should be able to do it with a Prism

Asad Saeeduddin

@Fintan Halpenny I think the problem with a prism is that having a prism assumes there's a single unambiguous case that would be constructed by the injection of the prism

Asad Saeeduddin

whereas here we have two cases containing a SomeType

Asad Saeeduddin

I think we can take two traversals p, q :: Traversal s t a b and obtain a traversal p \/ q :: Traversal s t (a + a) (b + b), but I need to try that out. Assuming that works, view (_A \/ _B) should give us what we want

Asad Saeeduddin

ok, so I was wrong, it's not b + b, but rather b × b. specifically, we can write this:

(+*) :: 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
  l = t1 (fmap fst . f . Left ) s
  r = t2 (fmap snd . f . Right) s'

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

when there is a full moon and all the types align, this transforms into a monoid:

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
Asad Saeeduddin


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 {}
Fintan Halpenny

Ah good point, I didn't cop they both had SomeType

Asad Saeeduddin

Now in your case what we have is:

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

_A, _B :: Traversal Thing Thing SomeType SomeType

Ideally we'd just be able to mappend these and get the result as myThing ^? _A <> _B. Unfortunately we don't have a semigroup on the large Thing structure. so we can't discharge the Semigroup t constraint.

Fortunately however, we only want to view, and not make modifications. So we can just throw away the t and get the trivial semigroup (). Here's the overall result:

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
Fintan Halpenny

With generic-lens there's a Traversal which focuses on the type you want

Georgi Lyubenov // googleson78

@Asad Saeeduddin thanks, I'll check it out!
@Fintan Halpenny what/where is it? I guess types would work in this case, but I only want to get values from "one level of structure" and only for fields named x