⬑

简易仿Lens库

#Haskell

看了一点Haskell里面lens的实现原理，决定试一下自己手搓一个简易版作为练习。不过因为对Rank-N Type一知半解，搓出来的东西好像跟正版不太一样。

看运行结果似乎是能用的，虽然没有什么实用价值，不过算是有所收获的练习。

代码不长：

-- The Library

accessor getter setter f x = (setter newVal x, getter x) where newVal = f (getter x)

view accessor obj = snd $ accessor id obj

over accessor f obj = fst $ accessor f obj

set accessor x obj = over accessor (const x) obj

composeAccessors ac1 ac2 modifier obj =
    (newObj, value)
    where
        newObj = over ac1 (over ac2 modifier) obj
        value = view ac2 (view ac1 obj)

composeFunctorAccesors ac1 ac2 modifier obj =
    (newObj, value)
    where
        newObj = over ac1 (fmap $ over ac2 modifier) obj
        value = fmap (view ac2) (view ac1 obj)

infixr 5 #. 
(#.) = composeAccessors

infixr 5 ##. 
(##.) :: (Functor f1, Functor f0) =>
            ((f1 a1 -> f1 a1) -> t -> (a2, f0 a1))
            -> ((a3 -> a3) -> a1 -> (a1, b)) ->
            (a3 -> a3) -> t -> (a2, f0 b)
(##.) = composeFunctorAccesors

self = accessor id (\n x -> n)

listAccessor idx =
    accessor
        (head . drop idx)
        (\n lst ->
            (take idx lst) ++ [n] ++ (drop (idx + 1) lst))

_0 = listAccessor 0
_1 = listAccessor 1
_2 = listAccessor 2
_3 = listAccessor 3
_4 = listAccessor 4
_5 = listAccessor 5
_6 = listAccessor 6
_7 = listAccessor 7
_8 = listAccessor 8
_9 = listAccessor 9

-- =====================

data Person = Person 
    { _name :: String
    , _address :: Maybe Address
    } deriving (Show)
name = accessor _name (\n x -> x {_name = n})
address = accessor _address (\n x -> x {_address = n})

data Address = Address
    { _city :: String
    , _zipInfos :: [Maybe ZipInfo]
    } deriving (Show)
city = accessor _city (\n x -> x {_city = n})
zipInfos = accessor _zipInfos (\n x -> x {_zipInfos = n})

data ZipInfo = ZipInfo
    { _code :: String
    , _extraInfo :: Maybe String
    } deriving (Show)
code = accessor _code (\n x -> x {_code = n})
extraInfo = accessor _extraInfo (\n x -> x {_extraInfo = n})


alice = Person
    { _name = "Alice"
    , _address = Just Address
        { _city = "Shanghai"
        , _zipInfos =
            [ Just ZipInfo
                { _code = "200000"
                , _extraInfo = Nothing
                }
            , Just ZipInfo
                { _code = "200002"
                , _extraInfo = Nothing
                }
            ]
        }
    }


setList =
    over (_1 #. _1) (const 5) [[1,2],[3,4]]

main = do
    putStrLn . show $ setList
    putStrLn . show $ alice
    -- 单个字段
    putStrLn . show $ view (name) alice
    -- 嵌套字段
    putStrLn . show $ view (address ##. city) alice
    -- 两层functor，每次"##."会进行一次fmap，需要两次fmap
    putStrLn . show $ view (address ##. zipInfos ##. self ##. code) alice
    -- 测试set
    putStrLn . show $ over (address ##. zipInfos ##. self ##. code) (++ "uwu") alice
    putStrLn . show $ over (self##.self) succ [1,2,3]