Can I make a Lens with a Monad constraint?

Question

Context: This question is specifically in reference to Control.Lens (version 3.9.1 at the time of this writing)

I've been using the lens library and it is very nice to be able to read and write to a piece (or pieces for traversals) of a structure. I then had a though about whether a lens could be used against an external database. Of course, I would then need to execute in the IO Monad. So to generalize:

Question:

Given a getter, (s -> m a) and an setter (b -> s -> m t) where m is a Monad, is possible to construct Lens s t a b where the Functor of the lens is now contained to also be a Monad? Would it still be possible to compose these with (.) with other "purely functional" lenses?

Example:

Could I make Lens (MVar a) (MVar b) a b using readMVar and withMVar?

Alternative:

Is there an equivalent to Control.Lens for containers in the IO monad such as MVar or IORef (or STDIN)?

Answer 1

I've been thinking about this idea for some time, which I'd call mutable lenses. So far, I haven't made it into a package, let me know, if you'd benefit from it.

First let's recall the generalized van Laarhoven Lenses (after some imports we'll need later):

{-# LANGUAGE RankNTypes #-}
import qualified Data.ByteString as BS
import           Data.Functor.Constant
import           Data.Functor.Identity
import           Data.Traversable (Traversable)
import qualified Data.Traversable as T
import           Control.Monad
import           Control.Monad.STM
import           Control.Concurrent.STM.TVar

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

we can create such a lens from a "getter" and a "setter" as

mkLens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
mkLens g s  f x = fmap (s x) (f (g x))

and get a "getter"/"setter" from a lens back as

get :: Lens s t a b -> (s -> a)
get l = getConstant . l Constant

set :: Lens s t a b -> (s -> b -> t)
set l x v = runIdentity $ l (const $ Identity v) x

as an example, the following lens accesses the first element of a pair:

_1 :: Lens' (a, b) a
_1 = mkLens fst (\(x, y) x' -> (x', y))
-- or directly: _1 f (a,c) = (\b -> (b,c)) `fmap` f a

Now how a mutable lens should work? Getting some container's content involves a monadic action. And setting a value doesn't change the container, it remains the same, just as a mutable piece of memory does. So the result of a mutable lens will have to be monadic, and instead of the return type container t we'll have just (). Moreover, the Functor constraint isn't enough, since we need to interleave it with monadic computations. Therefore, we'll need Traversable:

type MutableLensM  m s  a b
    = forall f . (Traversable f) => (a -> f b) -> (s -> m (f ()))
type MutableLensM' m s  a
    = MutableLensM m s a a

(Traversable is to monadic computations what Functor is to pure computations).

Again, we create helper functions

mkLensM :: (Monad m) => (s -> m a) -> (s -> b -> m ())
        -> MutableLensM m s a b
mkLensM g s  f x = g x >>= T.mapM (s x) . f


mget :: (Monad m) => MutableLensM m s a b -> s -> m a
mget l s = liftM getConstant $ l Constant s

mset :: (Monad m) => MutableLensM m s a b -> s -> b -> m ()
mset l s v = liftM runIdentity $ l (const $ Identity v) s

As an example, let's create a mutable lens from a TVar within STM:

alterTVar :: MutableLensM' STM (TVar a) a
alterTVar = mkLensM readTVar writeTVar

These lenses are one-sidedly directly composable with Lens, for example

alterTVar . _1 :: MutableLensM' STM (TVar (a, b)) a

---

Notes:

• Mutable lenses could be made more powerful if we allow that the modifying function to include effects:

  type MutableLensM2  m s  a b
      = (Traversable f) => (a -> m (f b)) -> (s -> m (f ()))
  type MutableLensM2' m s  a
      = MutableLensM2 m s a a
  
  mkLensM2 :: (Monad m) => (s -> m a) -> (s -> b -> m ())
           -> MutableLensM2 m s a b
  mkLensM2 g s  f x = g x >>= f >>= T.mapM (s x)
  

  However, it has two major drawbacks:

  1. It isn't composable with pure Lens.
  2. Since the inner action is arbitrary, it allows you to shoot yourself in the foot by mutating this (or other) lens during the mutating operation itself.

• There are other possibilities for monadic lenses. For example, we can create a monadic copy-on-write lens that preserves the original container (just as Lens does), but where the operation involves some monadic action:

  type LensCOW m s t a b
      = forall f . (Traversable f) => (a -> f b) -> (s -> m (f t))
  

• I've made jLens - a Java library for mutable lenses, but the API is of course far from being as nice as Haskell lenses.

Answer 2

No, you can not constrain the "Functor of the lens" to also be a Monad. The type for a Lens requires that it be compatible with all Functors:

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

This reads in English something like: A Lens is a function, which, for all types f where f is a Functor, takes an (a -> f b) and returns an s -> f t. The key part of that is that it must provide such a function for every Functor f, not just some subset of them that happen to be Monads.

---

Edit:

You could make a Lens (MVar a) (MVar b) a b, since none of s t a, or b are constrained. What would the types on the getter and setter needed to construct it be then? The type of the getter would be (MVar a -> a), which I believe could only be implemented as \_ -> undefined, since there's nothing that extracts the value from an MVar except as IO a. The setter would be (MVar a -> b -> MVar b), which we also can't define since there's nothing that makes an MVar except as IO (MVar b).

This suggests that instead we could instead make the type Lens (MVar a) (IO (MVar b)) (IO a) b. This would be an interesting avenue to pursue further with some actual code and a compiler, which I don't have right now. To combine that with other "purely functional" lenses, we'd probably want some sort of lift to lift the lens into a monad, something like liftLM :: (Monad m) => Lens s t a b -> Lens s (m t) (m a) b.

---

Code that compiles (2nd edit):

In order to be able to use the Lens s t a b as a Getter s a we must have s ~ t and a ~ b. This limits our type of useful lenses lifted over some Monad to the widest type for s and t and the widest type for a and b. If we substitute b ~ a into out possible type we would have Lens (MVar a) (IO (MVar a)) (IO a) a, but we still need MVar a ~ IO (MVar a) and IO a ~ a. We take the wides of each of these types, and choose Lens (IO (MVar a)) (IO (MVar a)) (IO a) (IO a), which Control.Lens.Lens lets us write as Lens' (IO (MVar a)) (IO a). Following this line of reasoning, we can make a complete system for combining "purely functional" lenses with lenses on monadic values. The operation to lift a "purely function" lens, liftLensM, then has the type (Monad m) => Lens' s a -> LensF' m s a, where LensF' f s a ~ Lens' (f s) (f a).

{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}

module Main (
    main
) where

import Control.Lens
import Control.Concurrent.MVar

main = do
    -- Using MVar
    putStrLn "Ordinary MVar"
    var <- newMVar 1
    output var
    swapMVar var 2
    output var

    -- Using mvarLens
    putStrLn ""
    putStrLn "MVar accessed through a LensF' IO"
    value <- (return var) ^. mvarLens
    putStrLn $ show value 
    set mvarLens (return 3) (return var)
    output var

    -- Debugging lens
    putStrLn ""
    putStrLn "MVar accessed through a LensF' IO that also debugs"
    value <- readM (debug mvarLens) var
    putStrLn $ show value 
    setM (debug mvarLens) 4 var
    output var 

    -- Debugging crazy box lens
    putStrLn ""
    putStrLn "MVar accessed through a LensF' IO that also debugs through a Box that's been lifted to LensF' IO that also debugs"
    value <- readM ((debug mvarLens) . (debug (liftLensM boxLens))) var
    putStrLn $ show value 
    setM ((debug mvarLens) . (debug (liftLensM boxLens))) (Box 5) var
    output var 

    where
        output = \v -> (readMVar v) >>= (putStrLn . show)

-- Types to write higher lenses easily

type LensF f s t a b = Lens (f s) (f t) (f a) (f b)

type LensF' f s a = Lens' (f s) (f a)

type GetterF f s a = Getter (f s) (f a)

type SetterF f s t a b = Setter (f s) (f t) (f a) (f b) 

-- Lenses for MVars

setMVar :: IO (MVar a) -> IO a -> IO (MVar a)
setMVar ioVar ioValue = do
    var <- ioVar
    value <- ioValue
    swapMVar var value
    return var

getMVar :: IO (MVar a) -> IO a
getMVar ioVar = do
    var <- ioVar
    readMVar var
-- (flip (>>=)) readMVar 

mvarLens :: LensF' IO (MVar a) a
mvarLens = lens getMVar setMVar       

-- Lift a Lens' to a Lens' on monadic values           

liftLensM :: (Monad m) => Lens' s a -> LensF' m s a
liftLensM pureLens = lens getM setM
    where
        getM mS = do
            s <- mS
            return (s^.pureLens)
        setM mS mValue = do
            s <- mS
            value <- mValue
            return (set pureLens value s)


-- Output when a Lens' is used in IO 

debug :: (Show a) => LensF' IO s a -> LensF' IO s a 
debug l = lens debugGet debugSet
    where
        debugGet ioS = do
            value <- ioS^.l
            putStrLn $ show $ "Getting " ++ (show value)
            return value
        debugSet ioS ioValue = do
            value <- ioValue
            putStrLn $ show $ "Setting " ++ (show value)
            set l (return value) ioS

-- Easier way to use lenses in a monad (if you don't like writing return for each argument)

readM :: (Monad m) => GetterF m s a -> s -> m a
readM l s = (return s) ^. l

setM :: (Monad m) => SetterF m s t a b -> b -> s -> m t
setM l b s = set l (return b) (return s)

-- Another example lens

newtype Boxed a = Box {
    unBox :: a
} deriving Show

boxLens :: Lens' a (Boxed a) 
boxLens = lens Box (\_ -> unBox)

This code produces the following output:

Ordinary MVar
1
2

MVar accessed through a LensF' IO
2
3

MVar accessed through a LensF' IO that also debugs
"Getting 3"
3
"Setting 4"
4

MVar accessed through a LensF' IO that also debugs through a Box that's been lifted to LensF' IO that also debugs
"Getting 4"
"Getting Box {unBox = 4}"
Box {unBox = 4}
"Setting Box {unBox = 5}"
"Getting 4"
"Setting 5"
5

There's probably a better way to write liftLensM without resorting to using lens, (^.), set and do notation. Something seems wrong about building lenses by extracting the getter and setter and calling lens on a new getter and setter.

I wasn't able to figure out how to reuse a lens as both a getter and a setter. readM (debug mvarLens) and setM (debug mvarLens) both work just fine, but any construct like 'let debugMVarLens = debug mvarLens' loses either the fact it works as a Getter, the fact it works as a Setter, or the knowledge that Int is an instance of show so it can me used for debug. I'd love to see a better way of writing this part.