Control.Lens.Traversal 的 partsOf、holesOf 和 singular 的简单定义是什么?
What are simple definitions for Control.Lens.Traversal's partsOf, holesOf and singular?
我正在尝试了解有关镜头库的更多信息。 lens-family package and their derivation and also grasp the two type parameter versions of Store, Pretext and Bazaar, but I'm having trouble understanding Control.Lens.Traversal
's partsOf
, holesOf
and singular
函数中的镜头我已经看懂了,里面定义了复杂的类型和很多辅助函数。这些功能是否也可以用更简单的方式来表达,以供学习?
这是一个相当大和棘手的问题。我自称我自己并不完全理解 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
形式,它允许您修改 "target" 的类型(充其量是一个重载词)。但是许多光学器件可以仅使用 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
代码时,我发现只要看到 profunctor 变量,几乎总是假设 p ~ (->)
(函数类型)很有帮助。这让我可以从上面代码片段的签名中删除 Representable
、Conjoined
、Bizarre
和 Over
类型类。
很多打字孔
有了这个和 GHC 类型漏洞的帮助,我们可以开始尝试在我们更简单、更笨的类型之上构建我们自己的 singular
。
singular :: Traversal big small -> Lens big small
singular = _
一般的策略,如alluded to briefly on this comonad.com's blog post,是遍历[=51=]值得到一个smalls列表([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
s 和 Const
s 的列表。
现在我们有:
singular :: Traversal big small -> Lens big small
singular traversal liftSmall big = do
case toListOf traversal big of
(x:xs) -> _
[] -> _
将值放回有点费脑筋。我们一直避免谈论这种疯狂的功能:
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
集市。我发现这种表示形式更有助于直观地了解正在发生的事情。
Dat 状态 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
的 "deferred" 版本。)
无论如何
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
执行此操作,使用 Sellable (->) (Bazaar (->))
实例中的 sell
。如果您内联该定义,您应该得到相同的结果。
在 x:xs
的情况下,x
是我们想要操作的值。它是我们给出的遍历的第一个目标值,现在成为我们 return 镜头的第一个目标值。我们调用 liftSmall x
来为某个函子 f
得到一个 f small
;然后我们在仿函数中追加 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
正如预期的那样,它对设置器没有任何作用(因为遍历已经是设置器):
λ> 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)
集市,然后 "puts the values back where it found it."
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,我不完全确定它们是如何联系在一起的。它值得进一步探索!
我正在尝试了解有关镜头库的更多信息。 lens-family package and their derivation and also grasp the two type parameter versions of Store, Pretext and Bazaar, but I'm having trouble understanding Control.Lens.Traversal
's partsOf
, holesOf
and singular
函数中的镜头我已经看懂了,里面定义了复杂的类型和很多辅助函数。这些功能是否也可以用更简单的方式来表达,以供学习?
这是一个相当大和棘手的问题。我自称我自己并不完全理解 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
形式,它允许您修改 "target" 的类型(充其量是一个重载词)。但是许多光学器件可以仅使用 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
代码时,我发现只要看到 profunctor 变量,几乎总是假设 p ~ (->)
(函数类型)很有帮助。这让我可以从上面代码片段的签名中删除 Representable
、Conjoined
、Bizarre
和 Over
类型类。
很多打字孔
有了这个和 GHC 类型漏洞的帮助,我们可以开始尝试在我们更简单、更笨的类型之上构建我们自己的 singular
。
singular :: Traversal big small -> Lens big small
singular = _
一般的策略,如alluded to briefly on this comonad.com's blog post,是遍历[=51=]值得到一个smalls列表([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
s 和 Const
s 的列表。
现在我们有:
singular :: Traversal big small -> Lens big small
singular traversal liftSmall big = do
case toListOf traversal big of
(x:xs) -> _
[] -> _
将值放回有点费脑筋。我们一直避免谈论这种疯狂的功能:
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
集市。我发现这种表示形式更有助于直观地了解正在发生的事情。
Dat 状态 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
的 "deferred" 版本。)
无论如何
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
执行此操作,使用 Sellable (->) (Bazaar (->))
实例中的 sell
。如果您内联该定义,您应该得到相同的结果。
在 x:xs
的情况下,x
是我们想要操作的值。它是我们给出的遍历的第一个目标值,现在成为我们 return 镜头的第一个目标值。我们调用 liftSmall x
来为某个函子 f
得到一个 f small
;然后我们在仿函数中追加 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
正如预期的那样,它对设置器没有任何作用(因为遍历已经是设置器):
λ> 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)
集市,然后 "puts the values back where it found it."
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,我不完全确定它们是如何联系在一起的。它值得进一步探索!