Haskell语言学习笔记（56）Lens（3）

手动计算（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))