Monadic variants of optics from Haskell lens library

monadic-lens.md

Monadic lens

So much has been written about lens and other optics in Haskell that these ideas are likely not very original. However, I'll try.

Initial problem

Let's say we have some recursive data type:

type Record = Map String Value
data Value = I Int | R Record
  deriving (Generic, Show)

Using standard optics we can easily focus on specific element deep down the tree structure:

field, p1 :: Traversal' Value Value
field name = #_R . ix name
p1 = field "foo" . field "bar"

If the path exist in structure we can get the value or update it using this prism. If it doesn't, viewing will return Nothing and update silently won't change anything. And that's enough in many cases. Imagine, however, that we've got this path from the user and want to point at the exact place, where prism match failed, for example by one of these errors:

data Err
  = NotRecord Value
  | NoField String [String]

NotRecord v should be returned if we are trying to get field of Int value v, NoField f fs if we are trying to access to a field f of record, which has only fields fs and f is not one of them. So our computation will run in some error monad, say Either Err. In this situation p1 can not help us. We need an optic, that will be run in our monad. First of all we could try to define them like SomeOptic' Value (Either Err Value). However, I failed to get something general and elegant on this way.

Let's look at the problem from another perspective. First of all, imagine we have here the optic we need. What optic's kind it should be? Before we had traversals (affine traversals to be more precise), because they could fail to view the value. Now we separate all errors in Left branch of our monad, so if we get (Right) result, the optics surely shouldn't fail. So we come to monadic lens:

data LensM' m s a = LensM'
  { viewM :: s -> m a
  , setM :: a -> s -> m s
  }

We can easily define composition of such lenses (assuming that m is monad) and use them in our task. Of course, for non-trivial m these lens don't satisfy standard lens laws. However for m = Identity they do and moreover, they are isomorphic to standard lens. Initial problem can be solved using this types. However, what can we do in more complex situations? Is there a more general solution here? Of course it is.

van Laarhoven representation of monadic lens

Recall standard type from lens package:

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

There are two obvious way how we can try to make it monadic:

type LensMF m s t a b = forall f. Functor f => (a -> m (f b)) -> (s -> m (f t))
type LensFM m s t a b = forall f. Functor f => (a -> f (m b)) -> (s -> f (m t))

If you try them, you'll soon realize, that the second is completely wrong. For the first we can easily lift standard definitions of view and over using Const and Identity Functor respectively:

viewM :: Monad m => LensMF m s s a a -> s -> m a
viewM l s = getConst <$> l (pure . Const) s
overM :: Monad m => LensMF m s t a b -> (a -> m b) -> s -> m t
overM l g s = runIdentity <$> l (fmap Identity . g) s

However, you'll get into a trouble, if you try to define constructor:

lensM :: Monad m => (s -> m a) -> (s -> b -> m t) -> LensMF m s t a b

The reason is that you need to interchange m and f. More specifically you need a method:

??? :: (Functor f, Monad m) => (b -> m t) -> m (f b) -> m (f t)

which obviously can't be provided in general (consider m = Maybe and f = IO, for example: we are not able to know if it's Just value or Nothing outside of IO action).

However, our task is much easier: for using lens we actually need only two Functors: Identity and Const. And for them we can provide this method. So all we need is to create a special type class, let's call it FunctorM:

class Functor f => FunctorM f where
  fmapM :: forall m b t. Monad m => (b -> m t) -> m (f b) -> m (f t)

and provide instances

instance FunctorM (Const a) where
  fmapM _ c = Const . getConst <$> c
instance FunctorM Identity where
  fmapM bmt mb = Identity <$> (mb >>= (bmt . runIdentity))

Then we can restrict f type in the definition of LensMF:

type LensMF m s t a b = forall f. FunctorM f => (a -> m (f b)) -> (s -> m (f t))

and complete the constructor

lensM :: Monad m => (s -> m a) -> (s -> b -> m t) -> LensMF m s t a b
lensM getter setter f s = setter s `fmapM` (f =<< getter s)

Compare it with standard lens:

lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
lens getter setter f s = setter s `fmap` f (getter s)

We could stop here, but there's one more point to improve our monadic lens. It's obvious that every non effectful lens can be lifted to LensMF. In fact everything is even better: we can make LensM to be a subtype of LensMF by using Data.Functor.Compose:

type LensM m s t a b = forall f. FunctorM f =>
                            (a -> Compose m f b) -> (s -> Compose m f t)

Since Compose m f is a Functor, we can use standard lens as LensM.

Solution of the initial problem

Let's return to the start of our topic. We had a recursive structure:

type Record = Map String Value
data Value = I Int | R Record

and wanted to traverse it providing useful error messages:

data Err
  = NotRecord Value
  | NoField String [String]

Now we can build monadic lens for this work. Let's begin with a helper function constructing a LensM focusing on the first element of the (standard) traversal and throwing an error if it doesn't exist:

travFirstE :: MonadError e m => Traversal' s a -> (s -> e) -> LensM' m s a
travFirstE l e = lensM getter setter
  where
    getter s = case firstOf l s of
      Nothing -> throwError $ e s
      Just a  -> pure a
    setter s a = case l (const $ Just a) s of
      Nothing -> throwError $ e s
      Just s' -> pure s'

(as usual type LensM' m s a = LensM m s s a a).

Using this utility we can easily build field lens:

field :: LensM (Either Err) Value Value
field = travFirstE #_R NotRecord . travFirstE (ix k) (NoField k . M.keys)

Let's test it at some example tree:

tree :: Value
tree = record [("a", I 1), ("b", record [("x", record []), ("y", record [("v", I 42)])])]
  where record = R . M.fromList

Asking to the existing field works fine:

>>> viewM (field "b" . field "y") tree
Right (R (fromList [("v",I 42)]))

And for non-existing we get our errors:

>>> viewM (field "c" . field "y") tree
Left (NoField "c" ["a","b"])
>>> viewM (field "b" . field "z") tree
Left (NoField "z" ["x","y"])

Updates also work fine:

>>> setM (field "b" . field "y") (pure $ I 42) tree
Right (R (fromList [("a",I 1),("b",R (fromList [("x",R (fromList [])),("y",I 42)]))]))
>>> setM (field "c" . field "y") (pure $ I 42) tree
Left (NoField "c" ["a","b"])
>>> setM (field "b" . field "z") (pure $ I 42) tree
Left (NoField "z" ["x","y"])

But what if we want to insert a new field "z": I 42 into "b" in the last case? We can use standard at Lens:

>>> setM (field "b" . travFirstE #_R NotRecord . at "z") (pure $ I 42) tree
Right (R (fromList [("a",I 1),("b",R (fromList [("x",R (fromList [])),
("y",R (fromList [("v",I 42)])),("z",I 42)]))]))

Conclusion

Of course, there are many other effects, that can be used with our monadic lens. Maybe some of them would be even more useful, then the one provided here. However, even without considering any other use cases, this particular I belief to be enough common to justify the search for its general solution.

I've created a repo where continued investigations of possible monadic optics. For the moment except LensM it includes GetterM and SetterM. For Iso I have some thoughts. In particular, I suppose, that type class

class (Profunctor p, Functor f) => ProfunctorM p f where
  dimapM :: forall m s t a b. Monad m =>
    (s -> m a) -> (b -> m t) -> p a (m (f b)) -> p s (m (f t))

or something like this should be used as a constraint in

type IsoM m s t a b = forall p f. ProfunctorM p f =>
                          p a (Compose m f b) -> p s (Compose m f t)

(in this case IsoM will be subtype of LensM). However, I have a trouble with Prism and so can't check if this is appropriate implementation.

As I mentioned at the beginning, I don't think that these that I'm the only one who tried to implement effectful lenses. So I would be very glad if you sent me a link for previous investigations in this area. All other comments are also very welcome

I've looked into that problem ~5 years ago and came up with a system allowing one to write both

('a', 'b') & _1 .~ 'c'

and

"stuff.txt" & _File .~ "stuff"

with the latter running in IO and putting "stuff" into a file called "stuff.txt".

Described my experiments here.

People rightfully pointed out that there wasn't much chance in coming up with comprehensive laws for such a system. I didn't care, not all abstractions need to have roots in category theory, purely syntactical abstraction can be useful occasionally.

I've never had the time to explore this space further unfortunately. I encourage you do so and I look forward to reading about your experiments!