手动计算(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. linq to sql 项目移植后,数据库实体类需要重新创建?

    项目中,使用LINQ to SQL 访问数据库,代码移植到其他机器上,每次需要重新生成dbml文件,有无方法只要更改app.config呢? 经过试验是可行的: 1.引用system.configur ...

  2. CentOS7.1下生产环境Keepalived+Nginx配置

    CentOS7.1下生产环境Keepalived+Nginx配置 [日期:2015-07-20] 来源:Linux社区  作者:soulful [字体:大 中 小]   注:下文涉及到配置的,如无特别 ...

  3. VS2005的depends工具 (分析EXE)

    忙乎了近两个月,程序开始打包供外部调用了,连同其所需的dll文件,这就需要使用VC自带的Depends软件,在VS2005中其路径为:D:\Program Files\Microsoft Visual ...

  4. bzoj1212 L语言

    Description 标点符号的出现晚于文字的出现,所以以前的语言都是没有标点的.现在你要处理的就是一段没有标点的文章. 一段文章T是由若干小写字母构成.一个单词W也是由若干小写字母构成.一个字典D ...

  5. 杂项-Java:jar 包与 war 包介绍与区别

    ylbtech-杂项-Java:jar 包与 war 包介绍与区别 1.返回顶部 1. 做Java开发,jar包和war包接触的挺多的,有必要对它们做一个深入的了解,特总结整理如下: 1.jar包的介 ...

  6. TOM带你玩充电 篇三:15款5号电池横评及选购建议——南孚金霸王小米宜家耐时品胜一个都逃不了

    双鹿电池的几个版本 理论上来说性价比:绿骑士>金骑士>黑骑士>蓝骑士 绿骑士和金骑士都很不错.哪个便宜买哪个. 小米性价比虽然最高,但是超市买不到. 蓝骑士是普通碳性电池,黑骑士是高 ...

  7. iframe引入百度地图显示企业位置

    步骤一:打开下面这个地址:http://api.map.baidu.com/lbsapi/creatmap/index.html     步骤二:定位中心点     在打开的页面左侧,输入企业的详细地 ...

  8. [UE4]FString常用API

    转自:http://aigo.iteye.com/blog/2279808 将int或float转换为string: 将FString转换为char*: 将string转换为int或者float: 字 ...

  9. linux&android PPP 相关知识

    Linux&Android PPP相关FAQ   目录 Linux&Android PPP相关FAQ.. 1 一.         文档说明... 3 二.         常见调试技 ...

  10. centos6性能监控软件

    常用软件在此下载 http://rpm.pbone.net/ http://pkgs.org/ collectl 显示cpu\disk\network的实时信息http://dl.fedoraproj ...