How to define lens into sum-type inside Map-like container?

Question

I can define the needed Lens' manually:

type Key = String
type Val = Int
type Foo  = Map Key (Either Val Bool)

ll :: String -> Lens' Foo (Maybe Int)
ll k f m = f mv <&> \r -> case r of
  Nothing -> maybe m (const (Map.delete k m)) mv
  Just v' -> Map.insert k (Left v') m
  where mv = Map.lookup k m >>= maybeLeft
        maybeLeft (Left v') = Just v'
        maybeLeft (Right _) = Nothing

And it works like:

x, y :: Foo
x = Map.empty
y = Map.fromList [("foo", Right True)]

>>> x ^. ll "foo"
Nothing

>>> x & ll "foo" ?~ 1
fromList [("foo",Left 1)]

>>> (x & ll "foo" ?~ 1) ^. ll "foo"
Just 1

>>> (x & ll "foo" ?~ 1) ^. ll "bar"
Nothing

>>> x & ll "foo" ?~ 1 & ll "foo" .~ Nothing
fromList []

>>> y ^. ll "foo"
Nothing

>>> y & ll "foo" ?~ 1
fromList [("foo",Left 1)]

>>> y & ll "foo" .~ Nothing
fromList [("foo",Right True)]

I verified that definition is lawful:

-- Orphan instance is ok-ish in this case :)
instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map k v) where
  arbitrary = Map.fromList <$> arbitrary

-- 1) You get back what you put in:
lensLaw1 :: Foo -> Key -> Maybe Val -> Property
lensLaw1 s k v = view (ll k) (set (ll k) v s) === v

-- 2) Putting back what you got doesn't change anything:
lensLaw2 :: Foo -> Key -> Property
lensLaw2 s k = set (ll k) (view (ll k) s) s === s

-- 3) Setting twice is the same as setting once:
lensLaw3 :: Foo -> Key -> Maybe Val -> Maybe Val -> Property
lensLaw3 s k v v' = set (ll k) v' (set (ll k) v s) === set (ll k) v' s

So the question: can the ll be defined using at and _Left?

Maybe with some kind of prismToLens :: Prism' a b -> Lens' (Maybe a) (Maybe b), you can do at k . prismToLens _Left. Yet I'm not sure if prismToLens makes sense? Hoogle isn't that helpful with lens :(

EDIT seems that third law doesn't hold always. Easy to find counter-example if you change Key to be Bool. Yet in my application the Map is actually dependent, i.e. the sum branch depends on the key, so the Lens law should hold (if I access foo, I know it should be Left or not exist at all).

Answer 1

For now I go with:

prismToLens :: Prism' a b -> Lens' (Maybe a) (Maybe b)
prismToLens p = lens getter setter
  where getter s = s >>= (^? p)
        setter _ b = (p#) <$> b

so I can define ll like:

ll' :: Key -> Lens' Foo (Maybe Val)
ll' k = at k . prismToLens _Left

Controrary to the "lens" defined in the question, for this one 2nd law doesn't hold:

-- 2) Putting back what you got doesn't change anything:
-- Doesn't hold
-- >>> quickCheck $ lensLaw2' (Map.fromList [(True,Right False)]) True
-- fromList [] /= fromList [(True,Right False)]
lensLaw2' :: Foo -> Key -> Property
lensLaw2' s k = set (ll' k) (view (ll' k) s) s === s

But with original the third law didn't hold:

-- 3) Setting twice is the same as setting once:
-- Doesn't hold
-- >>> quickCheck $ lensLaw3 (Map.fromList [(False, Right False)]) False (Just 0) Nothing
-- fromList [] /= fromList [(True,Right False)]
lensLaw3 :: Foo -> Key -> Maybe Val -> Maybe Val -> Property
lensLaw3 s k v v' = set (ll k) v' (set (ll k) v s) === set (ll k) v' s

---

As said in the question as I have dependend map, this is ok. When accessing some key k, there shouldn't ever be Right value, if I expect there to be Left. Taking this into the account, using prismToLens is actually better. Still searching for a better name though.

---

After remembering non, I altered the answer to use:

prismToIso :: Prism' a b -> Iso' (Maybe a) (Maybe b)
prismToIso p = iso t f
  where t a = a >>=  (^? p)
        f b = (p#) <$> b -- no unused param as in `prismToLens`!

Which resembles mapping. The law properties behaved the same as with prismToLens. This gives rise to the new questio: which one is better or worse, prismToIso or prismToLens. And why?

---

The full runnable example:

{-# LANGUAGE RankNTypes #-}
module Lens where

import Control.Applicative
import Control.Lens
import Data.Map as Map
import Test.QuickCheck

type Key = Bool
type Val = Int
type Foo  = Map Key (Either Val Bool)

ll :: Key -> Lens' Foo (Maybe Val)
ll k f m = f mv <&> \r -> case r of
  Nothing -> maybe m (const (Map.delete k m)) mv
  Just v' -> Map.insert k (Left v') m
  where mv = Map.lookup k m >>= maybeLeft
        maybeLeft (Left v') = Just v'
        maybeLeft (Right _) = Nothing

prismToLens :: Prism' a b -> Lens' (Maybe a) (Maybe b)
prismToLens p = lens getter setter
  where getter s = s >>= (^? p)
        setter _ b = (p#) <$> b

ll' :: Key -> Lens' Foo (Maybe Val)
ll' k = at k . prismToLens _Left

x, y :: Foo
x = Map.empty
y = Map.fromList [(True, Right True)]

{-
>>> x ^. ll "foo"
Nothing

>>> x & ll "foo" ?~ 1
fromList [("foo",Left 1)]

>>> (x & ll "foo" ?~ 1) ^. ll "foo"
Just 1

>>> (x & ll "foo" ?~ 1) ^. ll "bar"
Nothing

>>> x & ll "foo" ?~ 1 & ll "foo" .~ Nothing
fromList []

>>> y ^. ll "foo"
Nothing

>>> y & ll "foo" ?~ 1
fromList [("foo",Left 1)]

>>> y & ll "foo" .~ Nothing
fromList [("foo",Right True)]
-}

-- Orphan instance is ok-ish in this case :)
instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map k v) where
  arbitrary = Map.fromList <$> arbitrary
  shrink = Prelude.map Map.fromList . shrink . Map.toList

-- 1) You get back what you put in:
lensLaw1 :: Foo -> Key -> Maybe Val -> Property
lensLaw1 s k v = view (ll k) (set (ll k) v s) === v

-- 2) Putting back what you got doesn't change anything:
lensLaw2 :: Foo -> Key -> Property
lensLaw2 s k = set (ll k) (view (ll k) s) s === s

-- 3) Setting twice is the same as setting once:
-- Doesn't hold
-- >>> quickCheck $ lensLaw3 (Map.fromList [(False, Right False)]) False (Just 0) Nothing
-- fromList [] /= fromList [(True,Right False)]
lensLaw3 :: Foo -> Key -> Maybe Val -> Maybe Val -> Property
lensLaw3 s k v v' = set (ll k) v' (set (ll k) v s) === set (ll k) v' s

-- Using prismToLens defined "lens"

-- 1) You get back what you put in:
lensLaw1' :: Foo -> Key -> Maybe Val -> Property
lensLaw1' s k v = view (ll' k) (set (ll' k) v s) === v

-- 2) Putting back what you got doesn't change anything:
-- Doesn't hold
-- >>> quickCheck $ lensLaw2' (Map.fromList [(True,Right False)]) True
-- fromList [] /= fromList [(True,Right False)]
lensLaw2' :: Foo -> Key -> Property
lensLaw2' s k = set (ll' k) (view (ll' k) s) s === s

-- 3) Setting twice is the same as setting once:
lensLaw3' :: Foo -> Key -> Maybe Val -> Maybe Val -> Property
lensLaw3' s k v v' = set (ll' k) v' (set (ll' k) v s) === set (ll' k) v' s