Функциональное обновление произвольно вложенных структур данных с линзами

Ваше описание «Bag of Holding» было неточным, но я думаю, что оно близко к тому, что вы имели в виду. Основная идея состоит в том, чтобы перейти в дочернюю сумку, используя [Int] (аналогично экземпляру Ixed для Tree), и использовать экземпляр At для Map для редактирования элементов.

{-# 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]
     ]
  ]

Итак, теперь, если мы хотим удалить элемент "FOO" из сумки [1,1]:

> 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 вместо ix. Таким образом, определение subBag, вероятно, будет понятнее.

На самом деле вам не нужно писать какие-либо новые функции, потому что экземпляр Ixed для Tree такой же, как subBag is . root, поэтому редактирование можно выполнить следующим образом:

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

Предположим, что тип данных 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 моноид работает.)

Теперь мы можем определить обходы от Bag до Bag во время выполнения, используя списки:

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< /a> для Bag, что позволило бы нам делать такие вещи, как перечисление всех сумок в иерархии или выполнять параморфизмы на сумках. "Багаморфизм", если хотите.