如何在Map-like容器中将镜头定义为sum-type？

Question

我可以手动定义所需的Lens'：

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

它的工作原理如下：

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)]

我确认该定义合法：

-- 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

问题：可以使用at和_Left定义ll吗？

也许使用某种prismToLens :: Prism' a b -> Lens' (Maybe a) (Maybe b)，你可以at k . prismToLens _Left。但我不确定prismToLens是否有意义？ Hoogle对lens有帮助:(

编辑似乎第三定律并不总是如此。如果您将Key更改为Bool，则很容易找到反例。然而在我的应用程序中，Map实际上是依赖的，即sum分支取决于密钥，因此Lens法则应该成立（如果我访问foo，我知道它应该是{{} 1}}或根本不存在。

Answer 1

现在我选择：

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

所以我可以定义ll，如：

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

对于问题中定义的“镜头”而言，对于这个第二部法律并不成立：

-- 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:
-- 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

---

如问题所述，因为我已经依赖地图，这没关系。访问某个密钥k时，如果我希望Right，则不应该有Left值。将此记入帐户，使用prismToLens实际上更好。仍然在寻找一个更好的名字。

---

在记住non之后，我改变了使用的答案：

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`!

类似于mapping。法律属性与prismToLens的行为相同。这引发了新的问题：哪个更好或更差，prismToIso或prismToLens。为什么？

---

完整的可运行示例：

{-# 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