Обход и добавление элементов в Data.Tree с использованием линз в Haskell

Question

Я начинаю использовать линзы, и до сих пор я не мог использовать их в конкретной части кодовой базы, которую я пишу. Моя цель - обновить структуру розового дерева, такую ​​как Data.Tree добавив новый узел внутри одного из существующих. Для этого я подумал, что имеет смысл идентифицировать каждый узел с уникальным идентификатором, поэтому это будет выглядеть так:

type MyTree = Tree Id
type Path = [Id]

addToTree :: MyTree -> MyTree -> Path -> MyTree
addToTree originalTree newNode path = undefined

Функция addToTree придется пересечь originalTree следуя пути идентификаторов и добавьте newNode на этом уровне, возвращая все обновленное дерево. У меня не было проблем, чтобы сделать геттер для этого, но я не могу найти подходящий объектив для выполнения операции.

Вот что у меня есть до сих пор:

import           Control.Lens
import           Data.Tree
import           Data.Tree.Lens

addToTree :: MyTree -> Path -> MyTree -> MyTree
addToTree tree path branch = tree & (traversalPath path) . branches %~ (branch:)

traversalPath :: (Foldable t, Applicative f, Contravariant f) => t Id -> (MyTree -> f MyTree) -> MyTree -> f MyTree
traversalPath = foldl (\acc id-> acc . childTraversal id) id

childTraversal :: (Indexable Int p, Applicative f) => Id -> p MyTree (f MyTree) -> MyTree -> f MyTree
childTraversal id = branches . traversed . withId id

withId :: (Choice p, Applicative f) => Id -> Optic' p f MyTree MyTree
withId id = filtered (\x -> rootLabel x == id)

Но он не компилируется с:

• No instance for (Contravariant Identity)
    arising from a use of ‘traversalPath’
• In the first argument of ‘(.)’, namely ‘(traversalPath path)’
  In the first argument of ‘(%~)’, namely
    ‘(traversalPath path) . branches’
  In the second argument of ‘(&)’, namely
    ‘(traversalPath path) . branches %~ (branch :)’

Спасибо!

Answer 1

Это не особенно элегантно, но должно сработать:

import Control.Lens
import Data.Monoid (Endo(..)) -- A tidier idiom for 'foldr (.) id'.
import Data.List.NonEmpty (NonEmpty(..)) -- You don't want an empty path.
import qualified Data.List.NonEmpty as N
import Data.Tree
import Data.Tree.Lens -- That's where I got 'branches' from.

addToTree :: Eq a => NonEmpty a -> Tree a -> Tree a -> Tree a
addToTree path newNode oldTree = head $ over pathForests (newNode :) [oldTree]
    where
    pathForests = appEndo $ foldMap (Endo . goDown) path 
    goDown x = traverse . filtered ((x ==) . rootLabel) . branches

(В частности, я никогда не люблю использовать head даже в таких случаях, когда это невозможно. Не стесняйтесь заменить его на ваш любимый обход.)

Демо-версия:

GHCi> addToTree (1 :| []) (Node 2 []) (Node 1 [])
Node {rootLabel = 1, subForest = [Node {rootLabel = 2, subForest = []}]}
GHCi> addToTree (4 :| []) (Node 2 []) (Node 1 [])
Node {rootLabel = 1, subForest = []}
GHCi> addToTree (1 :| [5]) (Node 2 []) (Node 1 [Node 5 [], Node 6 []])
Node {rootLabel = 1, subForest = [Node {rootLabel = 5, subForest = [Node {rootLabel = 2, subForest = []}]},Node {rootLabel = 6, subForest = []}]}
GHCi> addToTree (1 :| [7]) (Node 2 []) (Node 1 [Node 5 [], Node 6 []])
Node {rootLabel = 1, subForest = [Node {rootLabel = 5, subForest = []},Node {rootLabel = 6, subForest = []}]}
GHCi> addToTree (1 :| [5,3]) (Node 2 []) (Node 1 [Node 5 [], Node 6 []])
Node {rootLabel = 1, subForest = [Node {rootLabel = 5, subForest = []},Node {rootLabel = 6, subForest = []}]}

Обратите внимание, что мы имеем дело с обходами, а не с линзами - нет никаких гарантий или ожиданий, что цель пути существует или является уникальной.

Вот более стилизованный вариант, без head и используя alaf обращаться с Endo упаковка.

addToTree :: Eq a => NonEmpty a -> Tree a -> Tree a -> Tree a
addToTree (desiredRoot :| path) newNode oldTree@(Node x ts)
    | x == desiredRoot = Node x (over pathForests (newNode :) ts)
    | otherwise = oldTree
    where
    pathForests = alaf Endo foldMap goDown path 
    goDown x = traverse . filtered ((x ==) . rootLabel) . branches