Test of lock and key system

src/Dodge/Tree/Polymorphic.hs

@@ -15,6 +15,7 @@ module Dodge.Tree.Polymorphic
     , applyToRandomNode
     , addToTrunk
     , inorderNumberTree
+    , updateSingleNode
     )
     where
 import Dodge.RandomHelp
@@ -22,6 +23,7 @@ import Dodge.RandomHelp
 import Data.Tree
 import Control.Monad.State
 import System.Random
+import Control.Lens
 
 {- |
 Creates a linear tree.
@@ -73,6 +75,22 @@ applyToNode (i:is) f (Node x xs) = Node x (ys ++ [applyToNode is f z] ++ zs)
 --    | otherwise = Node x (applyToSubTrunkBy cond f t : ts)
 --applyToSubTrunkBy _ _ t = t
 
+-- gives the list of all updates to a single node
+updateSingleNode :: (a -> Bool) -> (Tree a -> Tree a) -> Tree a -> [Tree a]
+updateSingleNode f update t@(Node x ts)
+    | f x       = update t : updateChildren
+    | otherwise = updateChildren
+  where
+    updateChildren = map (Node x) (subMap (updateSingleNode f update) ts)
+
+subMap :: (a -> [a]) -> [a] -> [[a]]
+subMap f (x:xs) = (f x <&> (: xs)) ++ ( (x :) <$> (subMap f xs) )
+subMap _ [] = []
+
+--subMap' :: Monad m => (a -> m a) -> [a] -> m [a]
+--subMap' f (x:xs) = (f x <&> (: xs)) ++ ( (x :) <$> (subMap f xs) )
+--subMap' f [] = 
+
 -- find use for?
 --zipTree :: Tree a -> Tree b -> Tree (a,b)
 --zipTree (Node x xs) (Node y ys) = Node (x,y) $ zipWith zipTree xs ys