haskell - Control.Lens.Traversal 的partsOf、holesOf 和singular 的简单定义是什么？

Question

我正在尝试了解有关镜头库的更多信息。我已经了解 lens-family 中的镜头包及其派生，也掌握了Store、Pretext 和Bazaar 的两个类型参数版本，但我在理解时遇到了麻烦Control.Lens.Traversal的 partsOf , holesOf 和 singular 函数，定义了复杂的类型和许多辅助函数。这些函数是否也可以用更简单的方式来表达以进行学习？

Answer 1

这是一个相当大而棘手的问题。我承认我自己并不完全了解如何holesOf和 partsOf工作，我不明白如何singular直到几分钟前才工作，但我想写下一个可能对您有帮助的答案。

我想解决一个更普遍的问题:如何阅读 lens源代码。因为如果你记住几个简化的假设，你通常可以简化疯狂的定义，比如

singular :: (Conjoined p, Functor f)
         => Traversing p f s t a a
         -> Over p f s t a a
singular l = conjoined
  (\afb s -> let b = l sell s in case ins b of
    (w:ws) -> unsafeOuts b . (:ws) <$> afb w
    []     -> unsafeOuts b . return <$> afb (error "singular: empty traversal"))
  (\pafb s -> let b = l sell s in case pins b of
    (w:ws) -> unsafeOuts b . (:Prelude.map extract ws) <$> cosieve pafb w
    []     -> unsafeOuts b . return                    <$> cosieve pafb (error "singular: empty traversal"))

unsafeOuts :: (Bizarre p w, Corepresentable p) => w a b t -> [b] -> t
unsafeOuts = evalState `rmap` bazaar (cotabulate (\_ -> state (unconsWithDefault fakeVal)))
  where fakeVal = error "unsafePartsOf': not enough elements were supplied"

ins :: Bizarre (->) w => w a b t -> [a]
ins = toListOf (getting bazaar)

unconsWithDefault :: a -> [a] -> (a,[a])
unconsWithDefault d []     = (d,[])
unconsWithDefault _ (x:xs) = (x,xs)

但我走在了自己的前面

这些是我在阅读 lens 时尝试应用的规则。源代码:

达博光学

光学普遍遵循 s-t-a-b整个库中的表单，它允许您修改“目标”的类型(充其量是一个重载的词)。但是许多光学器件只需 s 即可实现和 a ，并且通常没有必要跟踪 t s 和 b s 当您只是想阅读定义时。

例如，当我尝试逆向工程时 singular ，我在我的临时文件中使用了这些类型:

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE NoImplicitPrelude #-}

import BasePrelude hiding (fold)

type Lens big small =
  forall f. (Functor f) => (small -> f small) -> (big -> f big)

type Traversal big small =
  forall ap. (Applicative ap) => (small -> ap small) -> (big -> ap big)

makeLens :: (big -> small) -> (big -> small -> big) -> Lens big small
makeLens getter setter =
  \liftSmall big -> setter big <$> liftSmall (getter big)

组合器看起来像这样:

set :: ((small -> Identity small) -> big -> Identity big) -> small -> big -> big
set setter new big =
  runIdentity (setter (\_ -> Identity new) big)

view :: ((small -> Const small small) -> big -> Const small big) -> big -> small
view getter big =
  getConst (getter Const big)

离开这里，索引和棱镜

棱镜和索引光学作为镜头的消费者非常有用，但它们负责一些更引人注目的代码片段。为了统一棱镜和索引光学， lens开发者使用 profunctors (例如 Choice 和 Conjoined )及其伴随的辅助函数( dimap ， rmap )。

阅读时 lens代码我发现几乎总是假设 p ~ (->) 很有帮助(函数类型)每当我看到一个 profunctor 变量。这让我可以删除 Representable , Conjoined , Bizarre , 和 Over来自上述代码片段中签名的类型类。

很多类型孔

有了这个和 GHC 类型孔的帮助，我们可以开始尝试构建我们自己的 singular在我们更简单、更笨的类型之上。

singular :: Traversal big small -> Lens big small
singular = _

一般策略，如 alluded to briefly on this comonad.com's blog post , 是遍历 big使用 [small] 获取小列表( Const )的值然后把它们放回我们使用 State 得到的地方.

遍历获取列表可以通过我们重新实现 toListOf 来完成。 :

toListOf :: Traversal big small -> big -> [small]
toListOf traversal = foldrOf traversal (:) []

-- | foldMapOf with mappend/mzero inlined
foldrOf :: Traversal big small -> (small -> r -> r) -> r -> big -> r
foldrOf traversal fold zero =
  \big -> appEndo (foldMapOf traversal (Endo . fold) big) zero

-- | Traverses a value of type big, accumulating the result in monoid mon
foldMapOf :: Monoid mon => Traversal big small -> (small -> mon) -> big -> mon
foldMapOf traversal fold =
  getConst . traversal (Const . fold)

这里是幺半群的嵌套娃娃:来自 Endo 的列表来自 Const s。

现在我们有:

singular :: Traversal big small -> Lens big small
singular traversal liftSmall big = do
  case toListOf traversal big of
    (x:xs) -> _
    [] -> _

把值(value)观放回去有点费脑筋。我们一直避免谈论这种疯狂的功能:

unsafeOuts :: (Bizarre p w, Corepresentable p) => w a b t -> [b] -> t
unsafeOuts = evalState `rmap` bazaar (cotabulate (\_ -> state (unconsWithDefault fakeVal)))
  where fakeVal = error "unsafePartsOf': not enough elements were supplied"

在我们简化的宇宙中，它变成了

newtype Bazaar' small small' big =
  Bazaar { unBazaar :: forall ap. Applicative ap => (small -> ap small') -> ap big }
  deriving Functor

instance Applicative (Bazaar' small small') where
  pure big =
    Bazaar (\_ -> pure big)
  Bazaar lhs <*> Bazaar rhs =
    Bazaar (\liftSmall -> lhs liftSmall <*> rhs liftSmall)

type Bazaar small big = Bazaar' small small big

gobble :: StateT Identity [a] a
gobble = state (unconsWithDefault (error "empty!"))

unsafeOuts :: Bazaar small big -> [small] -> big
unsafeOuts (Bazaar bazaar) smalls =
  evalState (bazaar (\_ -> gobble)) smalls

这里我们内联了 rmap = (.)和 cotabulate f = f . Identity ，我们能够这样做是因为我们假设了 p ~ (->) .

半心半意地试图迷惑集市

集市很奇怪，关于它们的文章似乎很少。 lens文档提到它就像一个已经应用于结构的遍历。如果您乘坐 Traversal，确实会得到一个集市。键入并将其应用于 big你已经拥有的值(value)。

它也有点像 fancy free applicative ，但我不知道这是否有帮助或伤害。

关于 last comment of this blog post about a seeming unrelated FunList datatype ，用户 Zemyla 计算出之间的等价关系

data FunList a b t
    = Done t
    | More a (FunList a b (b -> t))

instance Functor (FunList a b) where ...
instance Applicative (FunList a b) where ...
instance Profunctor (FunList a) where ...

-- example values:
-- * Done (x :: t)
-- * More (a1 :: a) (Done (x :: a -> t))
-- * More (a1 :: a) (More (a2 :: a) (Done (x :: a -> a -> t))

和 lens市场。我发现这种表示对于直观了解正在发生的事情更有帮助。

数据状态单子(monad)

这里的 gem 是 gobble ，每次运行时都会从状态中弹出列表的头部。我们的 bazaar可以升级 gobble :: StateT Identity [small] small值变成 bazaar (\_ -> gobble) :: StateT Identity [small] big .与遍历非常相似，我们能够对小值的一部分采取有效的行动，并将其升级为对整个值起作用的行动。这一切都发生得很快，而且代码似乎不够；它有点让我头晕目眩。

(可能有帮助的事情是使用这个辅助函数在 GHCi 中玩集市:

bazaarOf :: Traversal big small -> big -> Bazaar small big
bazaarOf traversal =
  traversal (\small -> Bazaar (\liftSmall -> liftSmall small))

-- See below for `ix`.

λ> unBazaar (bazaarOf (ix 3) [1,2,3,4]) Right
Right [1,2,3,4]

λ> unBazaar (bazaarOf (ix 3) [1,2,3,4]) (\_ -> Right 10)
Right [1,2,3,100]

λ> unBazaar (bazaarOf (ix 1) [1,2,3,4]) Left
Left 2

在简单的情况下，它似乎是 traverse 的“延迟”版本。 .)

任何状况之下
unsafeOuts给了我们一种方法来检索第二个 big给定列表的值 small值(value)观和从第一个 big 构建的集市值(value)。现在我们需要根据传入的原始遍历构建一个集市:

singular :: Traversal big small -> Lens big small
singular traversal liftSmall big = do
  let bazaar = traversal (\small -> Bazaar ($ small)) big
  case toListOf traversal big of
    (x:xs) -> _
    [] -> _

这里我们做两件事:

首先，我们为自己类型转换一个 Bazaar small small .由于我们计划遍历 big ，我们可以拿每个x :: small我们得到并构造一个 Bazaar (\f -> f x) :: Bazaar small small 的值.这就够了!

遍历类型然后顺利升级我们的Bazaar small small成bazaar :: Bazaar small big .

原版 lens代码使用 b = traversal sell big 执行此操作, 使用 sell来自 Sellable (->) (Bazaar (->))实例。如果您内联该定义，您应该最终得到相同的结果。

在 x:xs案例 x是我们想要采取行动的值(value)。它是我们给定的遍历目标的第一个值，现在它成为我们返回的镜头的第一个目标值。我们调用 liftSmall x获得 f small对于一些仿函数 f ;然后我们附加 xs在仿函数里面得到一个 f [small] ;然后我们打电话 unsafeOuts bazaar在仿函数里面转 f [small]回到 f big :

singular :: Traversal big small -> Lens big small
singular traversal liftSmall big = do
  let bazaar = traversal (\small -> Bazaar ($ small)) big
  case toListOf traversal big of
    (x:xs) -> fmap (\y -> unsafeOuts bazaar (y:xs)) <$> liftSmall x
    [] -> _

在列表为空的情况下，我们以相同的方式行事，除了我们在以下内容中填充底部值:

singular :: Traversal big small -> Lens big small
singular traversal liftSmall big = do
  let bazaar = traversal (\small -> Bazaar ($ small)) big
  case toListOf traversal big of
    (x:xs) -> fmap (\y -> unsafeOuts bazaar (y:xs)) <$> liftSmall x
    [] -> fmap (\y -> unsafeOuts bazaar [y]) <$> liftSmall (error "singularity")

让我们定义一些基本的光学，以便我们可以使用我们的定义:

-- | Constructs a Traversal that targets zero or one
makePrism :: (small -> big) -> (big -> Either big small) -> Traversal big small
makePrism constructor getter =
  \liftSmall big -> case (fmap liftSmall . getter) big of
    Left big' -> pure big'
    Right fsmall -> fmap constructor fsmall

_Cons :: Traversal [a] (a, [a])
_Cons = makePrism (uncurry (:)) (\case (x:xs) -> Right (x, xs); [] -> Left [])

_1 :: Lens (a, b) a
_1 = makeLens fst (\(_, b) a' -> (a', b))

_head :: Traversal [a] a
_head = _Cons . _1

ix :: Int -> Traversal [a] a
ix k liftSmall big =
  if k < 0 then pure big else go big k
  where
    go [] _ = pure []
    go (x:xs) 0 = (:xs) <$> liftSmall x
    go (x:xs) i = (x:) <$> go xs (i - 1)

这些都是从 lens偷来的图书馆。

正如预期的那样，它可以帮助我们解决烦人的问题 Monoid类型类离开:

λ> :t view _head
view _head :: Monoid a => [a] -> a
λ> :t view (singular _head)
view (singular _head) :: [small] -> small

λ> view _head [1,2,3,4]
    [snip]
    • Ambiguous type variable ‘a0’ arising from a use of ‘print’
      prevents the constraint ‘(Show a0)’ from being solved.
    [snip]
λ> view (singular _head) [1,2,3,4]
1

正如预期的那样，它对 setter 没有任何作用(因为遍历已经是 setter):

λ> set (ix 100) 50 [1,2,3]
[1,2,3]
λ> set (singular (ix 100)) 50 [1,2,3]
[1,2,3]
λ> set _head 50 [1,2,3,4]
[50,2,3,4]
λ> set (singular _head) 50 [1,2,3,4]
[50,2,3,4]

partsOf和 holesOf

-- | A type-restricted version of 'partsOf' that can only be used with a 'Traversal'.
partsOf' :: ATraversal s t a a -> Lens s t [a] [a]
partsOf' l f s = outs b <$> f (ins b) where b = l sell s

纯猜想如下:据我所知， partsOf与 singular 极其相似因为它首先构建了一个集市 b , 调用 f (ins b)在集市上，然后“将值(value)放回它找到的地方”。

holesOf :: forall p s t a. Conjoined p => Over p (Bazaar p a a) s t a a -> s -> [Pretext p a a t]
holesOf l s = unTagged
  ( conjoined
     (Tagged $ let
        f [] _ = []
        f (x:xs) g = Pretext (\xfy -> g . (:xs) <$> xfy x) : f xs (g . (x:))
      in f (ins b) (unsafeOuts b))
     (Tagged $ let
        f [] _ = []
        f (wx:xs) g = Pretext (\wxfy -> g . (:Prelude.map extract xs) <$> cosieve wxfy wx) : f xs (g . (extract wx:))
      in f (pins b) (unsafeOuts b))
    :: Tagged (p a b) [Pretext p a a t]
  ) where b = l sell s

holesOf也在做集市( l sell s 第三次!))并再次患上结膜炎:假设 p ~ (->)您可以删除 conjoined 的第二个分支.但是接下来你会留下一堆 Pretext s 和 comonads，我不完全确定它们是如何结合在一起的。值得进一步探索!

Here is a gist of all the code I had in my scratch file at the time I hit Submit on this wall of text.