Is there a van Laarhoven optic based on the Monad typeclass?

Question

As I understand it, each van Laarhoven optic type can be defined by a constraint on a type constructor:

type Lens      s t a b = forall f. Functor f     => (a -> f b) -> s -> f t
type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t
-- etc.

If we choose Monad as the constraint, does it form some kind of "optic" in a meaningful way?

type Something s t a b = forall f. Monad f => (a -> f b) -> s -> f t

My intuition is that the Monad constraint might be too restrictive to get any value out of a structure like this: since the Const functor is not a Monad, we can't do the trick of specializing f to Const in order to derive a view-like function. Still, we can do some things with this Something type; it's just not clear to me if we can do anything particularly useful with it.

The reason I'm curious is because the type of a van Laarhoven optic is suspiciously similar to the type of a function that modifies a "mutable reference" type like IORef. For example, we can easily implement

modifyIORefM :: MonadIO m => IORef a -> (a -> m a) -> () -> m ()

which, when partially-applied to an IORef, has the shape

type SomethingIO s t a b = forall f. MonadIO f => (a -> f b) -> s -> f t

where a = b and s = t = (). I'm not sure whether this is a meaningful or meaningless coincidence.

Answer 1

Practically speaking, such an optic is a slightly inconvenient Traversal.

That's because, practically speaking, we use a Traversal:

type Traversal s t a b = forall f. (Applicative f) => (a -> f b) -> (s -> f t)

for two things. Getting a list of as from an s, which we can do with the Const functor:

toListOf :: Traversal s t a b -> s -> [a]
toListOf t = getConst . t (Const . (:[]))

and replacing the as with bs to turn the s into a t. One method is to use the State functor, and ignoring issues with matching the counts of as and bs, we have:

setListOf :: Traversal s t a b -> [b] -> s -> t
setListOf t bs s = evalState (t (\a -> state (\(b:bs) -> (b, bs))) s) bs

If we instead have an optic using a Monad constraint:

type TraversalM s t a b = forall f. (Monad f) => (a -> f b) -> (s -> f t)

we can still perform these two operations. Since State is a monad, the setListOf operation can use the same implementation:

setListOfM :: Traversal s t a b -> [b] -> s -> t
setListOfM t bs s = evalState (t (\a -> state (\(b:bs) -> (b, bs))) s) bs

For toListOf, there's no Monad instance for Const [a], but we can use a Writer monad to extract the a values, as long as we have a dummy b value to make the type checker happy:

toListOfM :: TraversalM s t a b -> b -> s -> [a]
toListOfM t dummy_b s = execWriter (t (\a -> tell [a] >> pure dummy_b) s)

or, since Haskell has bottom:

toListOfM' :: TraversalM s t a b -> s -> [a]
toListOfM' t s = execWriter (t (\a -> tell [a] >> pure undefined) s)

Self-contained code:

import Data.Functor.Const
import Control.Monad.State
import Control.Monad.Writer

type Traversal s t a b = forall f. (Applicative f) => (a -> f b) -> (s -> f t)

toListOf :: Traversal s t a b -> s -> [a]
toListOf t = getConst . t (Const . (:[]))

setListOf :: Traversal s t a b -> [b] -> s -> t
setListOf t bs s = evalState (t (\a -> state (\(b:bs) -> (b, bs))) s) bs

type TraversalM s t a b = forall f. (Monad f) => (a -> f b) -> (s -> f t)

toListOfM :: TraversalM s t a b -> b -> s -> [a]
toListOfM t dummy_b s = execWriter (t (\a -> tell [a] >> pure dummy_b) s)

toListOfM' :: TraversalM s t a b -> s -> [a]
toListOfM' t s = execWriter (t (\a -> tell [a] >> pure undefined) s)

setListOfM :: TraversalM s t a b -> [b] -> s -> t
setListOfM t bs s = evalState (t (\a -> state (\(b:bs) -> (b, bs))) s) bs

listItems :: Traversal [a] [b] a b
listItems = traverse

listItemsM :: TraversalM [a] [b] a b
listItemsM = mapM

main = do
  -- as a getter
  print $ toListOf listItems [1,2,3]
  print $ toListOfM listItemsM 99 [1,2,3]  -- dummy value
  print $ toListOfM' listItemsM [1,2,3]    -- use undefined
  -- as a setter
  print $ setListOf listItems [4,5,6] [1,2,3]
  print $ setListOfM listItemsM [4,5,6] [1,2,3]