使用镜头功能更新任意嵌套的数据结构

Functionally updating arbitrarily nested data structures with lenses

假设我有一个代表袋子的数据结构,它可以容纳多个项目。用户可以在这个袋子里放另一个 Bag of Holding,那个袋子可以包含其他袋子,甚至袋子里有袋子。是否有一个镜头可以在功能上更新任意嵌套的包,例如从袋子里的袋子里取出物品 foo 在袋子里的袋子里?请注意,嵌套级别以及树的总深度是动态的,在编译时是未知的。 this and this 等其他问题似乎只涉及静态已知的嵌套级别。

我正在寻找的东西可以在 Clojure 中使用 update-in function 完成,方法是动态生成访问器向量以传递给该函数。

假设Bag数据类型如下:

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}

import Control.Lens
import Control.Lens.Reified
import Data.Monoid

type Item = Int

data Bag = Bag 
    {
        _items :: [Item]
    ,   _bags :: [Bag]
    } deriving (Show)

$(makeLenses ''Bag)

exampleBag :: Bag
exampleBag = Bag [1,2] [Bag [] [], Bag [] [Bag [3] [Bag [0] []]]]

Control.Lens.Reified中,有ReifiedTraversal新类型用于在容器中存储遍历。我们可以为那些以相同数据类型开始和结束的遍历声明一个 Monoid 实例:

instance Monoid (ReifiedTraversal s s s s) where
    mempty = Traversal id
    mappend (Traversal t1) (Traversal t2) = Traversal (t1 . t2) 

mappend 只是遍历的组合(有点像 Endo 幺半群的工作方式。)

现在我们可以使用列表在 运行 时间定义从 BagBag 的遍历:

lensList :: [ReifiedTraversal' Bag Bag]
lensList = 
    [ Traversal $ bags . ix 1
    , Traversal $ bags . ix 0
    , Traversal $ bags . ix 0
    ] 

并测试它:

main :: IO ()
main = print $ over ((runTraversal $ mconcat lensList) . items . ix 0) succ exampleBag

我们也可以在包上定义一个Plated instance for Bag, that would let us do things like listing all the bags in the hierarchy, or perform paramorphisms。 A "bagamorphism",如果你愿意的话。

您对 "Bag of Holding" 的描述不准确,但我认为这与您的意思很接近。基本思想是使用 [Int] 遍历子包(类似于 TreeIxed 实例)并使用 MapAt 实例来编辑项目。

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedLists   #-}
{-# LANGUAGE RankNTypes        #-}
{-# LANGUAGE TypeFamilies      #-}

import           Control.Lens
import qualified Data.Map     as M

data Bag k a = Bag (M.Map k a) [Bag k a]
  deriving (Show)

-- | Lens onto top level items of a bag.
items :: Lens' (Bag k a) (M.Map k a)
items f (Bag k a) = f k <&> \k' -> Bag k' a

-- | Use 'At' instance for 'M.Map' to edit top level items.
atItem :: Ord k => k -> Lens' (Bag k a) (Maybe a)
atItem k = items . at k

type instance Index (Bag k a)   = [Int]
type instance IxValue (Bag k a) = Bag k a
instance Ixed (Bag k a) where
  ix is0 f = go is0 where
    -- Use the `Ixed` instance for lists to traverse over
    -- item `i` in the list of bags.
    go (i:is) (Bag m bs) = Bag m <$> ix i (go is) bs
    go _      b          = f b
  {-# INLINE ix #-}

mybag :: Bag String Char
mybag =
  Bag [("a1",'a')] -- ix []
   [ Bag [] []     -- ix [0]
   , Bag []        -- ix [1]
     [ Bag [("foo", 'x'), ("bar",'y')] [] -- ix [1,0]
     , Bag [("FOO", 'X'), ("BAR",'Y')] [] -- ix [1,1]
     ]
  ]

所以现在如果我们想从包 [1,1] 中删除 "FOO" 项目:

> mybag & ix [1,1] . atItem "FOO" .~ Nothing
Bag (fromList [("a1",'a')])
  [Bag (fromList []) []
  ,Bag (fromList [])
     [Bag (fromList [("bar",'y'),("foo",'x')]) []
     ,Bag (fromList [("BAR",'Y')]) []]]

或将"foobar"插入包[1,0]:

> mybag & ix [1,0] . atItem "foobar" ?~ 'z'
Bag (fromList [("a1",'a')])
  [Bag (fromList []) []
  ,Bag (fromList [])
    [Bag (fromList [("bar",'y'),("foo",'x'),("foobar",'z')]) []
    ,Bag (fromList [("BAR",'Y'),("FOO",'X')]) []]]

实际上我对 Bag 的定义只是一个特殊的 Tree:

import Data.Tree
import Data.Tree.Lens

type Bag k a = Tree (M.Map k a)

atItem :: Ord k => k -> Lens' (Bag k a) (Maybe a)
atItem k = root . at k

subBag :: [Int] -> Traversal' (Bag k a) (Bag k a)
subBag (i:is) = branches . ix i . subBag is
subBag _      = id

这可以像以前一样使用 subBag 而不是 ixsubBag的定义这样写可能更清楚。

事实上你不需要写任何新函数因为 TreeIxed 实例和 subBag is . root 一样,所以编辑可以通过:

> mybag & ix [1,1] . at "FOO" .~ Nothing