How to make the product of two lenses?

If I have two lenses:

foo :: Lens' X Foo
bar :: Lens' X Bar

Is there a way to construct a product lens:

foobar :: Lens' X (Foo, Bar)
foobar = ... foo bar

or is it impossible?

回答1:

In general case, this is impossible. Probably the most common case when you have lenses to different fields of the record, the lenses are disjoint, so you can make a lawful lens. But in general it's not true. This is why the combinator is not provided in the libraries, even it would be easy to write.

Assume lensProd exists. It's enough to take the same lens twice:

_1 :: Lens' (a, b) a -- Simpler type

badLens :: Lens' (a, b) (a, a)
badLens = lensProd _1 _1

Then the "You get back what you put in" law doesn't hold. It should be:

view badLens (set badLens (1, 2) (3, 4)) ≡ (1, 2)

But it cannot be true, as view badLens pair returns some value twice: (x, x) for all pairs.

@dfeuer gives an example how to define lensProd.

Interestingly the dual is also broken. In general you cannot have lawful sum of prism:

{-# LANGUAGE RankNTypes #-}

import Control.Applicative
import Control.Lens

-- |
-- >>> :t sumPrism _Just _Nothing :: Prism' (Maybe a) (Either a ())
-- sumPrism _Just _Nothing :: Prism' (Maybe a) (Either a ())
--  :: (Applicative f, Choice p) =>
--     p (Either a ()) (f (Either a ())) -> p (Maybe a) (f (Maybe a))
--
sumPrism :: Prism' a b -> Prism' a c -> Prism' a (Either b c)
sumPrism ab ac = prism' build match where
    build (Left b)  = ab # b
    build (Right c) = ac # c

    match x = Left <$> x ^? ab <|> Right <$>  x ^? ac

-- The law
--
-- @
-- preview l (review l b) ≡ Just b
-- @
--
-- breaks with
--
-- >>> preview badPrism (review badPrism (Right 'x'))
-- Just (Left 'x')
-- 
badPrism :: Prism' a (Either a a)
badPrism = sumPrism id id

As you can see, we put in Right, but get out Left.

回答2:

As phadej explained, there's no law-abiding way to do this in general. However, you can do it anyway and warn your users that they'd better be careful only to apply it to orthogonal lenses.

import Control.Lens
import Control.Arrow ((&&&))

fakeIt :: Lens' s x -> Lens' s y -> Lens' s (x,y)
fakeIt l1 l2 =
  lens (view l1 &&& view l2)
       (\s (x,y) -> set l1 x . set l2 y $ s)

For example:

Prelude Control.Lens A> set (fakeIt _1 _2) (7,8) (1,2,3)
(7,8,3)
Prelude Control.Lens A> view (fakeIt _1 _2) (1,2,3)
(1,2)