Generic LensLike like mapped and traverse

Question

Suppose I wanted to create an "optic" for the contents of MaybeT m a:

maybeTContents = _Wrapped .something. _Just

Is there such a something?

maybeTContents would for example be a Traversal when m is [], but only a Setter when m is (->) Int.

Example usage:

> MaybeT [Just 1, Nothing, Just 2] ^.. maybeTContents
[1, 2]
> runMaybeT (MaybeT (Just . ('e':)) & maybeTContents %~ ('H':)) "llo"
Just "Hello"

Answer 1

One way to do this is to make your own class that gives the right optic for the type your using:

{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE RankNTypes             #-}

class Ocular f t where
  optic :: LensLike f (t a) (t b) a b

instance Settable f => Ocular f ((->) a) where
  optic = mapped

instance Functor f => Ocular f Identity where
  optic = _Wrapped

instance Applicative f => Ocular f [] where
  optic = traversed

instance Applicative f => Ocular f Maybe where
  optic = _Just

This will give a setter for (->) s and a traversal for [] etc.

> let maybeTContents = _Wrapped . optic . _Just
> MaybeT [Just 1, Nothing, Just 2] ^.. maybeTContents
[1,2]
> runMaybeT (MaybeT (Just . ('e':)) & maybeTContents %~ ('H':)) "llo"
Just "Hello"

You can also write an instance for MaybeT and ReaderT:

instance (Applicative f, Ocular f m) => Ocular f (MaybeT m) where
  optic = _Wrapped . optic . _Just


instance (Ocular f m, Settable f) => Ocular f (ReaderT r m) where
  optic = _Wrapped . mapped . optic

> MaybeT [Just 1, Nothing, Just 2] ^.. optic
[1,2]
> runReaderT (ReaderT (\r -> [r,r+1]) & optic *~ 2) 1
[2,4]

Note that the Identity case is only a Lens, not an Iso. For that you need to include the Profuctor in the Ocular class. You can also write a version that allows indexed lens and traversals this way.