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

最佳答案

这是一个相当棘手的问题。我声称我自己并不完全了解holesOfpartsOf的工作方式,并且直到几分钟前我也不了解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形式,这使您可以修改“目标”的类型(最好是一个重载的单词)。但是,仅使用sa即可实现许多光学功能,并且在您尝试读取定义时,跟踪tb通常没有意义。

例如,当我尝试对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开发人员使用专业版(例如ChoiceConjoined)及其附带的辅助函数(dimaprmap)。

当阅读lens代码时,我发现每当看到一个profunctor变量时,总是假设p ~ (->)(函数类型)会很有帮助。这使我可以从上面的代码片段中的签名中删除RepresentableConjoinedBizarreOver类型类。

很多类型的孔

借助GHC的类型漏洞,我们可以开始尝试在更简单,更笨拙的类型之上构建自己的singular
singular :: Traversal big small -> Lens big small
singular = _

一般的策略称为alluded to briefly on this comonad.com's blog post,它是遍历big值以使用[small]获得小 list (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)

这里是一个嵌套的monoid玩偶:Endo中的Const中的列表。

现在我们有:
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值,那么您将获得集市。

它也类似于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。就像遍历一样,我们能够对小值(value)的一部分采取有效的行动,并将其升级为对整个值(value)起作用的行动。这一切都非常迅速,并且似乎没有足够的代码。有点使我旋转。

(可能有帮助的是使用此帮助器功能在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值构造的集市的情况下,检索第二个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) -> _
    [] -> _

这里我们做两件事:
  • 首先,我们为自己创建一个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实例中的sellSellable (->) (Bazaar (->))一起完成此操作。如果内联该定义,则应该得到相同的结果。

    x:xs情况下,x是我们要作用的值。这是我们得到的遍历的第一个目标值,现在成为我们返回的镜头的第一个目标值。我们调用liftSmall x以获得某些仿函数f smallf;然后我们在仿函数内部附加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]
    
    partsOfholesOf
    -- | 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
    

    纯粹的推测是:据我所知,partsOfsingular极为相似,因为它首先构造了一个集市b,在集市上调用f (ins b),然后“将值放回找到它的位置”。
    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和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.

    关于haskell - Control.Lens.Traversal的partsOf,holesOf和singular的简单定义是什么?,我们在Stack Overflow上找到一个类似的问题:https://stackoverflow.com/questions/44310458/

    10-11 22:33
    查看更多