zoukankan      html  css  js  c++  java
  • Haskell语言学习笔记(64)Lens(4)

    安装 lens-tutorial

    Control.Lens.Tutorial

    $ cabal install lens-tutorial
    Installed lens-tutorial-1.0.3
    Prelude> :m +Control.Lens.Tutorial
    Prelude Control.Lens.Tutorial> 
    
    {-# LANGUAGE TemplateHaskell   #-}
    {-# LANGUAGE DeriveFoldable    #-}
    {-# LANGUAGE DeriveFunctor     #-}
    {-# LANGUAGE DeriveTraversable #-}
     
    import Control.Applicative (Applicative)
    import Control.Lens hiding (element)
    import Data.Foldable (Foldable)
    import Data.Monoid (Monoid)
     
    data Atom = Atom { _element :: String, _point :: Point } deriving (Show)
    data Point = Point { _x :: Double, _y :: Double } deriving (Show)
    data Molecule = Molecule { _atoms :: [Atom] } deriving (Show)
    data Pair a = Pair a a deriving (Functor, Foldable, Traversable)
    makeLenses ''Atom
    makeLenses ''Point
    makeLenses ''Molecule
    
    shiftAtomX :: Atom -> Atom
    shiftAtomX = over (point . x) (+ 1)
    
    shiftMoleculeX :: Molecule -> Molecule
    shiftMoleculeX = over (atoms . traverse . point . x) (+ 1)
    
    shift :: ASetter' a Double -> a -> a
    shift lens = over lens (+ 1)
    

    Lens 的类型

    type Lens' a b = forall f . Functor f => (b -> f b) -> (a -> f a)
    type ASetter' a b   = (b -> Identity b) -> (a -> Identity a)
    -- ... equivalent to: (b ->          b) -> (a ->          a)
    type Getting b a b  = (b -> Const b b) -> (a -> Const b a)
    -- ... equivalent to: (b ->       b  ) -> (a ->       b  )
    --                                        (a ->       b  )
    
    --    +-- Bigger type
    --    |
    --    v
    Lens' bigger smaller
    --           ^
    --           |
    --           +--  Smaller type within the bigger type
    element :: Lens' Atom String
    point   :: Lens' Atom Point
    x       :: Lens' Point Double
    y       :: Lens' Point Double
    
    -- lens :: (a -> b) -> (a -> b -> a) -> Lens' a b
    point2 :: Lens' Atom Point
    point2 = lens _point (atom newPoint -> atom { _point = newPoint })
    
    -- point3 :: Lens' Atom Point
    point3 :: Functor f => (Point -> f Point) -> Atom -> f Atom
    point3 k atom = fmap (
    ewPoint -> atom { _point = newPoint }) (k (_point atom))
    
    (.) :: Lens' a b -> Lens' b c -> Lens' a c
    type Lens' a b = forall f . Functor f => (b -> f b) -> (a -> f a)
    (.) :: Functor f
        => ((b -> f b) -> (a -> f a))
        -> ((c -> f c) -> (b -> f b))
        -> ((c -> f c) -> (a -> f a))
    point     :: Lens' Atom Point
    x         :: Lens' Point Double
    point . x :: Lens' Atom Double
    
    view (point . x) :: Atom -> Double
    over (point . x) :: (Double -> Double) -> (Atom -> Atom)
    view :: Lens' a b -> a -> b
    over :: Lens' a b -> (b -> b) -> a -> a
    set  :: Lens' a b ->       b  -> a -> a
    set lens b = over lens (\_ -> b)
    
    view (lens1 . lens2) = (view lens2) . (view lens1)
    view id = id
    over (lens1 . lens2) = (over lens1) . (over lens2)
    over id = id
    
    type Traversal' a b = forall f . Applicative f => (b -> f b) -> (a -> f a)
    type Lens'      a b = forall f . Functor     f => (b -> f b) -> (a -> f a)
    
    atoms   :: Traversal' Molecule [Atom]
    element :: Traversal' Atom     String
    point   :: Traversal' Atom     Point
    x       :: Traversal' Point    Double
    y       :: Traversal' Point    Double
    
    traverse :: Traversable t => Traversal' (t a) a
    traverse :: (Applicative f, Traversable t) => (a -> f a) -> t a -> f (t a)
    traverse :: Traversal' [a] a
    
    traverse :: Traversal' (Pair a) a
    over traverse :: (a -> a) -> (Pair a -> Pair a)
    over traverse (+ 1) (Pair 3 4) = Pair 4 5
    
    (.) :: Traversal' a b -> Traversal' b c -> Traversal' a c
    (.) :: Applicative f
        => ((b -> f b) -> (a -> f a))
        -> ((c -> f c) -> (b -> f b))
        -> ((c -> f c) -> (a -> f a))
    
    -- Remember that `atoms`, `point`, and `x` are also `Traversal'`s
    atoms                        :: Traversal' Molecule [Atom]
    traverse                     :: Traversal' [Atom]   Atom
    point                        :: Traversal' Atom     Point
    x                            :: Traversal' Point    Double
    
    -- Now compose them
    atoms                        :: Traversal' Molecule [Atom]
    atoms . traverse             :: Traversal' Molecule Atom
    atoms . traverse . point     :: Traversal' Molecule Point
    atoms . traverse . point . x :: Traversal' Molecule Double
    
    over (atoms . traverse . point . x)
        :: (Double -> Double) -> (Molecule -> Molecule)
    toListOf (atoms . traverse . point . x)
        :: Molecule -> [Double]
    
    toListOf :: Traversal' a b -> a -> [b]
    over :: Traversal' a b -> (b -> b) -> a -> a
    set  :: Traversal' a b ->       b  -> a -> a
    set traversal b = over traversal (\_ -> b)
    
    toListOf (traversal1 . traversal2) = (toListOf traversal1) >=> (toListOf traversal2)
    toListOf id = return
    

    参考链接

    Taking a Close look at Lenses

  • 相关阅读:
    gc buffer busy/gcs log flush sync与log file sync
    给Oracle年轻的初学者的几点建议
    Android 编程下帧动画在 Activity 启动时自动运行的几种方式
    Android 编程下 Touch 事件的分发和消费机制
    Java 编程下 static 关键字
    Java 编程下 final 关键字
    Android 编程下模拟 HOME 键效果
    Why Are Thread.stop, Thread.suspend, Thread.resume and Runtime.runFinalizersOnExit Deprecated ?
    Extjs4 大型项目目录结构重构
    [转]SQLServer 2008 允许远程连接的配置方法
  • 原文地址:https://www.cnblogs.com/zwvista/p/8035209.html
Copyright © 2011-2022 走看看