类型补全计画
从上一篇我们可以看出，Lens 就是整合在一起的 Getter 和 Setter ，借助 set , over , view 这三个函数，我们可以分别使用 Lens 的 Getter 和 Setter 。但是我们目前的 Lens 类型定义并不是完整的，因此我们首先对 Lens 的类型进行补全。
type Lens s a = Functor f => (a -> f a) -> (s -> f s)
首先让我们看这样一个例子：
set _1 ((1,2),3) 3
set _1 ((1,2),3) True
在我们目前的类型定义上面的代码第一行可以正常工作，而第二行则不可以。但是第二行确实是合乎逻辑的，我们的确有时候需要讲一个原本是数字的地方设置为布尔值或是其他的什么东西。
让我们将原先的 Lens 类型定义进行简单的改变，这样就可以在通过 Lens 对数据操作时改变数据的类型。
type Lens s t a b = Functor f => (a -> f b) -> (s -> f t)
我们可以可以直观地解读这个新的类型定义的含义，对 s 类型的量的一个 a 类型的域进行某种操作，之后该域变为 b ，相应的 s 变为 t 。当然这里的 s 与 t 的关系并不是随意的，而是依赖于 a 和 b 的关系。
现在我们之前使用的 Lens 类型将定义如下：
type Lens' s a = Lens s s a a
-- Or
{-# LANGUAGE LiberalTypeSynonyms #-}
type Simple f a b = f a a b b
type Lens' = Simple Lens
在这个定义下我们可以定义出由 getter 与 setter 构建 Lens 的函数
lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
lens getter setter f s = setter s <$> f (getter s)
下面让我们来回忆一下 over 与 view 的定义
over lens f = runIdentity . lens (Identity . f)
view lens b = getConst $ lens Const b
我们发现在 f 分别取 Identity 与 Const 的时候，Lens 就分别表现出了 Setter 与 Getter 的特性。对于 view 与 over 而言，他们只需要使用单一的 Functor ，因此我们可以专门定义 Getter 与 Setter 的类型。
type Getting r s a = (a -> Const r a) -> s -> Const r s
type Setter s t a b = (a -> Identity b) -> s -> Identity t
type Setting = Simple Setter
在有了这个定义之后，我们就可以修改之前三个常用函数的类型签名：
view :: Getting a s a -> s -> a
over :: Setter s t a b -> (a -> b) -> s -> t
set :: Setter s t a b -> b -> s -> t
这样的改变看似没有什么作用，但通过这样的改变，三个常用函数不再以 Lens 为作用对象，而是更加聚焦于一类更加通用的类型。
作为概念积类型的类型与作为概念的值
通过之前的例子，我们可以看到我们用 Lens 来操作一个 积类型(Product Type) ，例如元组、Record ；于此相对，Lens 不能用来操作 和类型(Sum Type) 。我们可以用 Lens 改变或是读取积类型的某个 部分(Component) 的值。但是实际上，我们不需要一个 实在的 积类型，也不需要一个实在的部分，只需要概念上的积类型与概念上的部分即可。这样的表述显得非常抽象，让我们来看几个例子。
第一个例子是列表，我们将要操作的不是列表的元素这些实在的部分，而是抽象的部分， 列表的长度 。
让我们定义这个玄乎的 _length Lens ：
_length :: Lens' [a] Int
_length f l = const l <$> f (length l)
可以看出，它可以从一个列表中提取出它的长度，但是不会改变它的长度
view (_1._length) ("hello", 3)
--> 5
set (_1._length) 9 ("world", 3)
--> ("world",3)
在这个例子中，长度并不是列表的一个实在的部分，我们操作的积类型也不是一个实在的积类型，而是概念中的某种包含长度的积类型。
再看第二个例子，我们操作一个数字的绝对值。
_abs :: (Num a, Ord a) => Lens' a a
_abs f i = setabs <$> f (abs i)
where sgn x
| x >= 0 = 1
| x < 0 = -1
setabs x
| x >= 0 = x*sgn i
| x < 0 = error "Abs must be non-negative"
view _abs -123
--> 123
set _abs 13 -99
--> -13
可以看出，概念上，数字确实含有“绝对值”这一部分的值，但是数字与绝对值的关系同样也不是“元组与每个元素”之间的关系，也不是“记录与它的域”的关系。同时，数字本身，并不明显是那种积类型，这里我们同样是将其看作了概念上的积类型。
引入这两个例子的目的是说明，Lens 是某种更加抽象与普遍化的工具，它不仅仅用来处理具体的数据结构与数据结构内部的值，也可以用来处理各种各样的情况；Lens 聚焦于某个数据结构（实在的或是概念上的）的某个值上，这无关乎这个值是实在地存在于这个数据结构里，还是抽象地、概念上地存在于这个数据上，这为我们以后利用 Lens 完成语义的表达提供了可行性。
多焦点数据操作
Lens 在工作的过程中，对某个数据结构内某个值应用了一个 a -> f b 的函数，并最终得到一个 f t 类型的新数据结构。假设现在我们想要操作某个列表 [a] 中的所有元素，那么我们期望对列表中的每个元素应用 a -> f b 的函数，并且最终得到一个 f [b] 。
对于应用某个函数于列表中的每个元素这一任务，我们有非常熟悉的解决方案 map 。
map (f::a->f b) (xs::[a]) :: [f b]
但是我们期望得到的类型是 f [b] 而不是 [f b] ，我们需要一个将函子的列表转换为列表的函子的函数，而实际上，函子没有足够的约束来支持这样的操作，最简单的例子就是，一个空函子的列表我们没法直接找到对应的空列表的函子；此外更一般的场合我们需要将 f a 合并至 f [a] 得到一个新的 f [a] 的函数，其类型为 f a -> f [a] -> f [a] ，而我们有的列表拼接函数的类型为 a -> [a] -> [a] ，这也不是函子的升格可以直接完成的。而应用函子恰巧有我们需要的 pure 函数处理第一种情况，又有可以对双参数函数升格的 liftA2 。由此看来，我们需要的是使用应用函子代替函子完成我们的需要。
有了这些分析，我们不难写出将函子的列表提取为列表的函子的函数。
(<:>) :: Applicative f => f a -> f [a] -> f [a],
(<:>) = liftA2 (:)
sequenceA :: (Applicative f) => [f a] -> f [a]
sequenceA [] = pure []
sequenceA (x:xs) = x <:> sequenceA xs
接下来我们需要的操作列表中全部元素的 Lens 的实现也可以容易给出，因为我们先前已经通过 map 实现了 (a -> f b) -> [a] -> [f b] ，只需再对结果应用刚实现的 sequenceA 就可以恰好得到我们需要的 Lens 类型。
_every :: Applicative f => (a -> f b) -> [a] -> f [b]
_every f xs = sequenceA $ map f xs
over _every (+1) [2,3,4]
--> [3,4,5]
由于应用函子是特殊的函子，所以 _every 是特殊的 Lens， 我们将这类 Lens 命名为 Traversal。
type Traversal s t a b = Applicative f => (a -> f b) -> s -> f t
type Traversal' s a = Traversal s s a a
取这个名字的原因是，在标准库 Data.Traversal 中实际上恰好有一个函数 traverse 符合我们的要求， 这个函数并非为 Lens 专门设计，但它的类型恰好与我们先前的 _every 相同，不仅如此这个函数不仅可以在列表上工作，也可以在所有 Traversable 类型上工作。由于这类 Lens 操作均依赖于 traverse ， 所以取名为 Traversal 。
让我们简单地看一下 Traversal 是如何与 over 一通工作的：
traverse :: Applicative f => (a -> f b) -> t a -> f (t b)
over traverse (+1) [2,3,4]
runIdentity . traverse (Identity . (+1)) [2,3,4]
runIdentity $ sequenceA $ map (Identity . (+1)) [2,3,4]
runIdentity $ sequenceA [Identity 3, Identity 4, Identity 5]
runIdentity $ Identity 3 <:> Identity 4 <:> Identity 5 <:> Identity []
runIdentity $ Identity [3, 4, 5]
--> [3,4,5]
但是，现在我们的 Traversal 不能正确与 view 工作。 例如，对于下面的代码
view traverse ["1","2","3"]
view traverse ['1','2','3']
我们期望的结果是这样的，我们只需要它原封不动地返回即可
["1","2","3"]
[1,2,3]
而实际上，我们得到了看似匪夷所思的结果
"123"
-- error: No instance for (Monoid Char) arising from a use of ‘traverse’
让我们展开 Traversal 与 view 工作的过程
view traverse ["1","2","3"]
getConst $ traverse (Const b) ["1","2","3"]
getConst $ sequenceA $ map (Const b) ["1","2","3"]
getConst $ sequenceA [Const "1", Const "2", Const "3"]
getConst $ sequenceA $ Const "1" <:> Const "2" <:> Const "3" <:> pure []
我们实际上清楚 Const a 本身并非应用函子, Monoid a => Const a 才是 ，这个 a 类型的值不是“容器”内的值，而是“容器”的一部分，容器内并不存在值。于是，将应用函子范畴上的值应用到应用函子范畴上的函数时，内部并无操作，有的只是“容器”的合并。
instance Monoid a => Applicative (Const a) where
pure _ = Const empty
(Const x) <*> (Const y) = Const (x <> y)
列表的默认 mappend 操作是列表合并，所以我们就可以将上面的计算继续写下去了
getConst $ sequenceA Const "1" <:> Const "2" <:> Const "3" <:> pure []
getConst $ sequenceA Const "1" <:> Const "2" <:> Const "3" <:> Const ""
getConst $ sequenceA Const "1" <:> Const "2" <:> Const "3"
getConst $ sequenceA Const "1" <:> Const "23"
getConst $ sequenceA Const "123"
"123"
可以看出，这并不是匪夷所思的结果，而是在这些定义下的合理结果。实际上，从 view 类型上我们也可以看出它的确做了它应当的工作。
view :: Getting a s a -> s -> a
view traverse ["1","2","3"]
-- view :: Getting String [String] String -> [String] -> String
它最终确实给了我们一个字符串。
所以，我们需要构建专用于 Traversal 的 view 函数。考虑之前 view 的定义
view :: Getting a b a -> b -> a
view lens = getConst . lens Const
这里他将原来的值不加改变地喂给了 getConst ， 我们可以讲原始值套在一个 Monoid 里完成我们需要的效果。这里，我们需要的就是最终得到一个列表，因此只需要再套一层列表的 Monoid 即可，外面套的这层 Monoid 会互相合并，最终只剩下一个列表，里面排满了原来的元素。
toListOf :: Getting [a] s a -> s -> [a]
toListOf lens = getConst . lens (\x -> Const [x])
toListOf traverse ["1","2","3"]
--> ["1","2","3"]
toListOf traverse ['1','2','3']
--> ['1','2','3']
这个函数似乎没有多大用处，它原封不动地返回了原本的列表。但是，我们可以依托于 traverse 构建更多更有用的 Traversal。
例如聚焦于一个列表中全部满足某个条件的 Traversal
_all :: (a -> Bool) -> Traversal' [a] a
_all st f s = traverse update s
where
update old = if st old then f old else pure old
toListOf (_all (/=0)) [1,2,0,3,4,0,5]
--> [1,2,3,4,5]
同时，我们描述过 Traversal 是一种特殊的 Lens， 所以它具有 Lens 各种有用的性质，例如通过互相复合来处理嵌套的列表。
toListOf (traverse.traverse) [[1,2],[1,2,3,4]]
--> [1,2,1,2,3,4]
xs = [[1,2],[1,2,3,4],[4,5,6],[23,4,5,5,4],[1],[2,3]]
over (_all (\x-> length x <= 3 ) .traverse) (+1) xs
-- >[[2,3],[1,2,3,4],[5,6,7],[23,4,5,5,4],[2],[3,4]]
或者与普通的 Lens 复合，来完成复杂的操作。
toListOf (traverse._1) [(1,2),(3,4),(5,6)]
--> [1,3,5]
需要注意的是，Traversal 是特殊的 Lens，也就是说在 Lens 上多出一些特定的限制，因此 Traversal 与普通 Lens 的复合将会仍然继承这些限制，即 Traversal 与 Lens 的复合仍是 Traversal。
使用更多 Monoid 来获得多种效果
在上面我们使用了 [] 这一 Monoid 来实现了合成列表的效果，实际上，我们还可以使用其他Monoid。下面让我们看几个例子。
第一个例子是将包装过的 Maybe 作为一个 Monoid，并取名为 First 。从名字我们也可以看出来，它的作用就是取出列表的首个元素。
newtype First a = First (Maybe a)
instance Monoid (First a) where
mempty = First Nothing
mappend (First Nothing) y = y
mappend x _ = x
preview :: Getting (First a) s a -> s -> Maybe a
preview lens = getFirst . getConst . lens (Const . First . Just)
preview (_all (/=0)) [3, 2, 1, 0]
--> Just 3
preview (_all (/=0)) [0,0,0]
--> Nothing
同样，修改 mappend 的定义我们可以得到 Last ，这里不再具体给出。
第二个例子是包装过的 Bool ，我们可以用它来判断一个列表中是否含有某个元素
newtype Any = Any { getAny :: Bool }
instance Monoid Any where
mempty = Any False
Any x `mappend` Any y = Any (x || y)
has :: Getting Any s a -> s -> Bool
has l = getAny . getConst . l (const $ Const (Any True))
has (_all (==0)) [3, 2, 1, 0]
--> True
我们发现，由于 Traversal 具有良好的抽象能力，我们仅仅选用不同的 Monoid 就实现了多种多用的效果，这无疑是非常令人振奋的。
来自：https://zhuanlan.zhihu.com/p/31328798
- 本文固定链接: https://zxbcw.cn/post/5863/
- 转载请注明：必须在正文中标注并保留原文链接
- QQ群： PHP高手阵营官方总群(344148542)
- QQ群： Yii2.0开发(304864863)