What is the appropriate abstraction for a lens which can fail as a setter?

Question

I would like to define something like a lens, but which can fail when trying to set. See fooLens in the following example.

{-# LANGUAGE RankNTypes #-}

import Data.Char (toUpper)
import Data.Functor.Const (Const(..))
import Data.Functor.Identity (Identity(..))

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

view :: Getting a s t a -> s -> a
view l = getConst . l Const

over :: Lens s t a b -> (a -> b) -> s -> t
over l f = runIdentity . l (Identity . f)

data Foo a = Foo a deriving (Show)

fooLens :: Lens (Foo a) (Either String (Foo a)) a a
fooLens f (Foo a) = Right . Foo <$> f a

main = do
    let foo = Foo "test"
    print foo
    print $ view fooLens foo
    print $ over fooLens (map toUpper) foo

The output of this is what you would expect

Foo "test"
"test"
Right (Foo "TEST")

I have generalised the definition of Getting here to make this work. The first thing to make clear is that fooLens is not a lens: it doesn't satisfy the lens laws. Instead, it is the composition of a lens and something like a prism.

This seems to work, but the fact that it's not supported by any of the lens libraries I've checked suggests that there may be a better way to go about this problem. Is there a way to refactor fooLens so that it:

1. Acts as a getter, i.e. it can always retrieve a value.
2. Can act as a setter with the possibility of failing, for example it returns an Either.

Answer 1

Your specific formulation doesn't work very well within the lens ecosystem. The most important thing lens does is provide composition of optics of different types. To demonstrate, let's start with a slightly embellished version of your code:

{-# LANGUAGE RankNTypes #-}

import Data.Char (toUpper)
import Data.Functor.Const (Const(..))
import Data.Functor.Identity (Identity(..))

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

view :: Getting a s t a -> s -> a
view l = getConst . l Const

over :: Lens s t a b -> (a -> b) -> s -> t
over l f = runIdentity . l (Identity . f)

data Foo a = Foo a
    deriving (Show, Eq, Ord)

fooLens :: Lens (Foo [a]) (Either String (Foo [a])) [a] [a]
fooLens f (Foo a) = update <$> f a
  where
    update x | null x = Left "Cannot be empty"
             | otherwise = Right (Foo x)

main = do
    let foo = Foo "test"
    print foo
    print $ view fooLens foo
    print $ over fooLens (map toUpper) foo
    print $ over fooLens (const "") foo

The output is:

Foo "test"
"test"
Right (Foo "TEST")
Left "Cannot be empty"

I modified fooLens a bit to take full advantage of its type, validating data on update. This helps to illustrate the goal with this formulation.

Then I decided to test out how well this composes, and added the following:

data Bar = Bar (Foo String)
    deriving (Show, Eq, Ord)

barLens :: Lens Bar Bar (Foo String) (Foo String)
barLens f (Bar x) = Bar <$> f x

And then adding the following to main:

    print $ view (barLens . fooLens) (Bar foo)

It just doesn't compose:

error:
    • Couldn't match type ‘Either String (Foo [Char])’
                     with ‘Foo String’
      Expected type: ([Char] -> Const [Char] [Char])
                     -> Foo String -> Const [Char] (Foo String)
        Actual type: ([Char] -> Const [Char] [Char])
                     -> Foo [Char] -> Const [Char] (Either String (Foo [Char]))
    • In the second argument of ‘(.)’, namely ‘fooLens’
      In the first argument of ‘view’, namely ‘(barLens . fooLens)’
      In the second argument of ‘($)’, namely
        ‘view (barLens . fooLens) (Bar foo)’
   |
37 |     print $ view (barLens . fooLens) (Bar foo)
   |                             ^^^^^^^

This alone is enough to prevent using this formulation in lens. It doesn't fit within the goals of the library.

Let's try something different. This isn't exactly what you're looking for, but it's an observation.

import Control.Lens

data Foo a = Foo a
    deriving (Show, Eq, Ord)

fooLens :: Lens (Foo [a]) (Foo [a]) [a] [a]
fooLens f (Foo a) = update <$> f a
  where
    update x | null x = Foo a
             | otherwise = Foo x

main :: IO ()
main = do
    let foos = map Foo $ words "go fly a kite"
    print foos
    print $ toListOf (traverse . fooLens) foos
    print $ over (traverse . fooLens) tail foos
    print =<< (traverse . fooLens) (\x -> tail x <$ print x) foos

Output:

[Foo "go",Foo "fly",Foo "a",Foo "kite"]
["go","fly","a","kite"]
[Foo "o",Foo "ly",Foo "a",Foo "ite"]
"go"
"fly"
"a"
"kite"
[Foo "o",Foo "ly",Foo "a",Foo "ite"]

Obviously that's not a true lens and should probably have a different name, as it doesn't obey the set-view law. It's a bit awkward that it can be written with the same type, but there's precedent for that with things like filtered.

But there's a further complication, as evidenced by the last test - filtering on the result of an update still requires running the update's effects, even when the update is rejected. That's not how skipping an element, with filtered for instance, in a Traversal works. That seems like it's impossible to avoid with the van Laarhoven representation. But maybe that's not so bad. It isn't an issue when setting or viewing - only when doing much less common operations.

In any case, it doesn't report the failure to set, so it's not exactly what you're looking for. But with enough rejiggering, it can be a starting point.

{-# LANGUAGE
        MultiParamTypeClasses,
        FlexibleInstances,
        TypeFamilies,
        UndecidableInstances,
        FlexibleContexts #-}

import Data.Functor.Identity
import Control.Applicative
import Control.Monad

import Control.Lens



class Functor f => Reportable f e where
    report :: a -> f (Either e a) -> f a

instance Reportable (Const r) e where
    report _ (Const x) = Const x

instance Reportable Identity e where
    report a (Identity i) = Identity $ either (const a) id i

instance (e ~ a) => Reportable (Either a) e where
    report _ = join

overWithReport
    :: ((a -> Either e b) -> s -> Either e t)
    -> (a -> b)
    -> s
    -> Either e t
overWithReport l f s = l (pure . f) s



data Foo a = Foo a
    deriving (Show, Eq, Ord)

fooLens
    :: (Reportable f String)
    => ([a] -> f [a])
    -> Foo [a]
    -> f (Foo [a])
fooLens f (Foo a) = report (Foo a) $ update <$> f a
  where
    update x | null x = Left "Cannot be empty"
             | otherwise = Right $ Foo x



main :: IO ()
main = do
    let foos = [Foo [1], Foo [2, 3]]
    print foos

    putStrLn "\n  Use as a normal lens:"
    print $ toListOf (traverse . fooLens . traverse) foos
    print $ over (traverse . fooLens . traverse) (+ 10) foos
    print $ over (traverse . fooLens) tail foos

    putStrLn "\n  Special use:"
    print $ overWithReport (traverse . fooLens . traverse) (+ 10) foos
    print $ overWithReport (traverse . fooLens) (0 :) foos
    print $ overWithReport (traverse . fooLens) tail foos

And here's the output from running it:

[Foo [1],Foo [2,3]]

  Use as a normal lens:
[1,2,3]
[Foo [11],Foo [12,13]]
[Foo [1],Foo [3]]

  Special use:
Right [Foo [11],Foo [12,13]]
Right [Foo [0,1],Foo [0,2,3]]
Left "Cannot be empty"

This formulation integrates with normal lens stuff. It works, at the expense of requiring a variation on over to get the error reporting. It maintains compatibility with a lot of lens functions, at the cost of a bit of non-lawful behavior in one case. It's not perfect, but it's probably as close as you can get within the constraints of maintaining compatibility with the rest of the lens library.

As for why something along these lines isn't in the library, it's probably because it requires a custom constraint on the f type alias, which is a real hassle for working with combinators like (%%~). The instances I provided for Identity and Const take care of most uses from lens itself, but there's a more people might choose to do with it.

The lens library's open design allows for a huge amount of external customization. This is a possible approach that probably works for a lot of cases. But it works for a lot less than the full breadth of what lens allows, and I think that's why nothing like this is currently present.

Answer 2

I think it's because there's an unstated type-level law for profunctor optics. A s t a b optic type needs to satisfy the type-level law: a ~ b implies s ~ t.

As a result, Getting isn't generalized because its type has a ~ b which implies s ~ t. Similarly, fooLens isn't a known optic because it violates this law, so it's kind of a non-starter.

As I say, I've never seen this type-level law made explicit, but I think it's implied.