手动计算(view, over, set, to, _1)

view l = getConst . l Const

over l f = runIdentity . l (Identity . f)

set l b = runIdentity . l (\_ -> Identity b)

to k = dimap k (contramap k)

instance Field1 (a,b) (a',b) a a' where
_1 k ~(a,b) = k a <&> \a' -> (a',b)
view _1 (1,2)
= getConst . _1 Const $ (1,2)
= getConst $ _1 Const (1,2)
= getConst $ Const 1 <&> \a' -> (a',2)
= getConst $ Const 1
= 1 over _1 (+1) (1,2)
= runIdentity . _1 (Identity . (+1)) $ (1,2)
= runIdentity $ _1 (Identity . (+1)) (1,2)
= runIdentity $ (Identity . (+1)) 1 <&> \a' -> (a',2)
= runIdentity $ Identity 2 <&> \a' -> (a',2)
= runIdentity $ Identity (2,2)
= (2,2) set _1 3 (1,2)
= runIdentity . _1 (\_ -> Identity 3) $ (1,2)
= runIdentity $ _1 (\_ -> Identity 3) (1,2)
= runIdentity $ (\_ -> Identity 3) 1 <&> \a' -> (a',2)
= runIdentity $ Identity 3 <&> \a' -> (a',2)
= runIdentity $ Identity (3,2)
= (3,2) view (_1 . to abs) (-1,2)
= getConst $ (_1 . to abs) Const (-1,2)
= getConst $ _1 (to abs Const) (-1,2)
= getConst $ (to abs Const) (-1) <&> \a' -> (a',2)
= getConst $ (dimap abs (contramap abs) (\a -> Const a)) (-1) <&> \a' -> (a',2)
= getConst $ ((contramap abs) . (\a -> Const a) . abs $ (-1)) <&> \a' -> (a',2)
= getConst $ ((contramap abs) . (\a -> Const a) $ 1) <&> \a' -> (a',2)
= getConst $ ((contramap abs) $ Const 1) <&> \a' -> (a',2)
= getConst $ Const 1 <&> \a' -> (a',2)
= getConst $ Const 1
= 1

参考内容:

Const a 是 Functor,也是 Contravariant

newtype Const a b = Const { getConst :: a }

instance Functor (Const m) where
fmap _ (Const v) = Const v instance Contravariant (Const a) where
contramap _ (Const a) = Const a

(->) 是 Profunctor

instance Profunctor (->) where
dimap ab cd bc = cd . bc . ab

Identity 是 Functor

newtype Identity a = Identity { runIdentity :: a }

instance Functor Identity where
fmap f m = Identity (f (runIdentity m))

手动计算 preview _Left (Left 5)

Prelude Control.Lens> preview _Left (Left 5)
Just 5
_Left = prism Left $ either Right (Left . Right)

prism bt seta = dimap seta (either pure (fmap bt)) . right'

instance Choice (->) where
right' = fmap preview l = getFirst . foldMapOf l (First . Just) foldMapOf l f = getConst . l (Const . f) instance Profunctor (->) where
dimap ab cd bc = cd . bc . ab instance Functor (Const m) where
fmap _ (Const v) = Const v
preview _Left (Left 5)
= getFirst . foldMapOf _Left (First . Just) $ Left 5
= getFirst $ foldMapOf _Left (First . Just) $ Left 5
= getFirst $ getConst . _Left (Const . (First . Just)) $ Left 5
= getFirst $ getConst $ _Left (Const . (First . Just)) $ Left 5
= getFirst $ getConst $ prism Left (either Right (Left . Right)) (Const . First . Just) (Left 5)
= getFirst $ getConst $ (dimap (either Right (Left . Right)) (either pure (fmap Left)) . right') (Const . First . Just) (Left 5)
= ① (dimap f g . h) x y
= (dimap f g $ h x) y
= g . (h x) . f $ y
= g . (h x) $ f y ①
= getFirst $ getConst $ (either pure (fmap Left)) . (right' (Const . First . Just)) $ (either Right (Left . Right)) (Left 5)
= getFirst $ getConst $ (either pure (fmap Left)) . (right' (Const . First . Just)) $ (Right 5)
= getFirst $ getConst $ (either pure (fmap Left)) $ right' (Const . First . Just) (Right 5)
= getFirst $ getConst $ (either pure (fmap Left)) $ fmap (Const . First . Just) (Right 5)
= getFirst $ getConst $ (either pure (fmap Left)) $ Right (Const . First $ Just 5)
= getFirst $ getConst $ fmap Left (Const . First $ Just 5)
= getFirst $ getConst $ fmap Left (Const . First $ Just 5)
= getFirst $ getConst $ Const . First $ Just 5
= Just 5

手动计算 set mapped 5 [1,2,3]

set l b = runIdentity . l (\_ -> Identity b)
mapped = sets fmap
sets f g = taintedDot (f (untaintedDot g)) instance Settable Identity where
untainted = runIdentity
untaintedDot = (runIdentity #.)
taintedDot = (Identity #.)
set mapped 5 [1,2,3]
= runIdentity . (sets fmap) (\_ -> Identity 5) $ [1,2,3]
= runIdentity $ sets fmap (\_ -> Identity 5) $ [1,2,3]
= runIdentity $ taintedDot (fmap (untaintedDot (\_ -> Identity 5))) $ [1,2,3]
= runIdentity $ (Identity .) (fmap ((runIdentity .) (\_ -> Identity 5))) $ [1,2,3]
= runIdentity $ (Identity .) (fmap (fmap runIdentity (\_ -> Identity 5))) $ [1,2,3]
= runIdentity $ Identity . (fmap (\_ -> 5)) $ [1,2,3]
= runIdentity $ Identity $ fmap (\_ -> 5) [1,2,3]
= runIdentity $ Identity $ [5,5,5]
= [5,5,5]

手动计算 toListOf both (1,2)

toListOf :: Getting (Endo [a]) s a -> s -> [a]
toListOf l = foldrOf l (:) [] foldrOf :: Getting (Endo r) s a -> (a -> r -> r) -> r -> s -> r
foldrOf l f z = flip appEndo z . foldMapOf l (Endo #. f) foldMapOf :: Getting r s a -> (a -> r) -> s -> r
foldMapOf l f = getConst #. l (Const #. f) both :: Bitraversable r => Traversal (r a a) (r b b) a b
both f = bitraverse f f instance Bitraversable (,) where
bitraverse f g ~(a, b) = (,) <$> f a <*> g b instance Functor (Const m) where
fmap _ (Const v) = Const v instance Monoid m => Applicative (Const m) where
pure _ = Const mempty
liftA2 _ (Const x) (Const y) = Const (x `mappend` y)
(<*>) = coerce (mappend :: m -> m -> m)
toListOf both (1,2)
= foldrOf both (:) [] (1,2)
= flip appEndo [] . foldMapOf both (Endo #. (:)) $ (1,2)
= flip appEndo [] . getConst #. both (Const #. (Endo #. (:))) $ (1,2)
= flip appEndo [] . getConst #. bitraverse (Const #. (Endo #. (:))) (Const #. (Endo #. (:))) $ (1,2)
= flip appEndo [] . getConst $ bitraverse (Const #. (Endo #. (:))) (Const #. (Endo #. (:))) (1,2)
= flip appEndo [] . getConst $ (,) <$> (Const #. (Endo #. (:))) 1 <*> (Const #. (Endo #. (:))) 2
= flip appEndo [] . getConst $ (,) <$> (Const . Endo . (:)) 1 <*> (Const . Endo . (:)) 2
= flip appEndo [] . getConst $ (,) <$> (Const . Endo $ (:) 1) <*> (Const . Endo $ (:) 2)
= flip appEndo [] . getConst $ (,) <$> (Const . Endo $ (1:)) <*> (Const . Endo $ (2:))
= flip appEndo [] . getConst $ (,) <$> (Const (Endo (1:))) <*> (Const (Endo (2:)))
= flip appEndo [] . getConst $ (Const (Endo (1:))) <*> (Const (Endo (2:)))
= flip appEndo [] . getConst $ (Const (Endo (1:) <> Endo (2:)))
= flip appEndo [] $ getConst (Const (Endo ((1:) . (2:))))
= flip appEndo [] (Endo ((1:) . (2:)))
= appEndo (Endo ((1:) . (2:))) []
= [1,2]

Haskell语言学习笔记(56)Lens(3)的更多相关文章

  1. Haskell语言学习笔记(88)语言扩展(1)

    ExistentialQuantification {-# LANGUAGE ExistentialQuantification #-} 存在类型专用的语言扩展 Haskell语言学习笔记(73)Ex ...

  2. Haskell语言学习笔记(44)Lens(2)

    自定义 Lens 和 Isos -- Some of the examples in this chapter require a few GHC extensions: -- TemplateHas ...

  3. Haskell语言学习笔记(79)lambda演算

    lambda演算 根据维基百科,lambda演算(英语:lambda calculus,λ-calculus)是一套从数学逻辑中发展,以变量绑定和替换的规则,来研究函数如何抽象化定义.函数如何被应用以 ...

  4. Haskell语言学习笔记(69)Yesod

    Yesod Yesod 是一个使用 Haskell 语言的 Web 框架. 安装 Yesod 首先更新 Haskell Platform 到最新版 (Yesod 依赖的库非常多,版本不一致的话很容易安 ...

  5. Haskell语言学习笔记(20)IORef, STRef

    IORef 一个在IO monad中使用变量的类型. 函数 参数 功能 newIORef 值 新建带初值的引用 readIORef 引用 读取引用的值 writeIORef 引用和值 设置引用的值 m ...

  6. Haskell语言学习笔记(39)Category

    Category class Category cat where id :: cat a a (.) :: cat b c -> cat a b -> cat a c instance ...

  7. Haskell语言学习笔记(38)Lens(1)

    Lens Lens是一个接近语言级别的库,使用它可以方便的读取,设置,修改一个大的数据结构中某一部分的值. view, over, set Prelude> :m +Control.Lens P ...

  8. Haskell语言学习笔记(64)Lens(4)

    安装 lens-tutorial Control.Lens.Tutorial $ cabal install lens-tutorial Installed lens-tutorial-1.0.3 P ...

  9. Haskell语言学习笔记(72)Free Monad

    安装 free 包 $ cabal install free Installed free-5.0.2 Free Monad data Free f a = Pure a | Free (f (Fre ...

随机推荐

  1. 洛谷2530(codevs2098)化工厂装箱员

    题目:https://www.luogu.org/problemnew/show/P2530 dp或搜索. dp做法就是 当前值+1 转移到 当前某一维为0.位置前进了c位 的地方.但没写. 写了搜索 ...

  2. POJ2411骨牌覆盖——状压dp

    题目:http://poj.org/problem?id=2411 状压dp.注意一下代码中标记的地方. #include<iostream> #include<cstdio> ...

  3. WPF中控制窗口显示位置的三种方式

    首先新建一个WPF工程,在主界面添加一个按钮,并给按钮添加点击事件button1_Click,然后新建一个用于测试弹出位置的窗口TestWindow.1.在屏幕中间显示,设置window.Window ...

  4. Dynamics CRM 2011 快速查找 出现异常 QuickFindQueryRecordLimit exceeded. Cannot perform this operation 的解决方法

    一.CRM 2011 快速查找,输入编号的签名几个字母发现查询很慢. 图 1 当然在图1 上右边的出入框输入编号的部分的时候,有时候会发现数据在加载中..,非常慢,通过Crm Trace Log Vi ...

  5. 【Reporting Services 报表开发】— 如何设置报表分页列标题每一页都显示

    一.打开已经开发好的报表ReportTest,选择列组下的高级模式—>选择行组的静态(会关联列标题订单编号),修改下面的属性: 1.Hidden:False 2.FixedData:True 3 ...

  6. php curl_init函数用法(http://blog.sina.com.cn/s/blog_640738130100tsig.html)

    使用PHP的cURL库可以简单和有效地去抓网页.你只需要运行一个脚本,然后分析一下你所抓取的网页,然后就可以以程序的方式得到你想要的数据了.无论是你想从从一个链接上取部分数据,或是取一个XML文件并把 ...

  7. jquery的load()事件和ajax中load()方法的区别

    load事件 当图像加载时,改变 div 元素的文本: $("img").load(function(){ $("div").text("Image ...

  8. 【用jersey构建REST服务】系列文章

    1.用Jersey构建RESTful服务1--HelloWorld http://blog.csdn.NET/kkkloveyou/article/details/21391033 2.用Jersey ...

  9. 关于attr("checked")的输出

    同样的一段代码,在不同的文件输出不同的答案,好神奇. console.log($("#never").attr("checked")); 一个输出checked ...

  10. 1027 Colors in Mars (20 分)

    1027 Colors in Mars (20 分) People in Mars represent the colors in their computers in a similar way a ...