Add functions for composing trees

src/TreeHelp.hs

@@ -21,6 +21,7 @@ module TreeHelp
     , updateSingleNodes
     , updateRandNode
     , safeUpdateSingleNode
+    , msafeUpdateSingleNode
     ) where
 import RandomHelp
 
@@ -88,13 +89,26 @@ updateSingleNodes f update t@(Node x ts)
   where
     updateChildren = map (Node x) (subMap (updateSingleNodes f update) ts)
 
+mupdateSingleNodes :: Monad m => (a -> Bool) -> (Tree a -> m (Tree a)) -> Tree a -> [m (Tree a)]
+mupdateSingleNodes f update t@(Node x ts)
+    | f x       = update t : updateChildren
+    | otherwise = updateChildren
+  where
+    updateChildren = map (fmap $ Node x) (msubMap (mupdateSingleNodes f update) ts) 
+
 updateRandNode :: RandomGen g => (a -> Bool) -> (Tree a -> Tree a) -> Tree a -> State g (Tree a)
 updateRandNode t f = takeOne . updateSingleNodes t f
 
-
 safeUpdateSingleNode :: (a -> Bool) -> (Tree a -> Tree a) -> Tree a -> Tree a
 safeUpdateSingleNode f g t = fromMaybe t $ listToMaybe $ updateSingleNodes f g t
 
+msafeUpdateSingleNode :: Monoid b => (a -> Bool) -> (Tree a -> (b, Tree a)) -> Tree a -> (b,Tree a)
+msafeUpdateSingleNode f g t = fromMaybe (mempty,t) $ listToMaybe $ mupdateSingleNodes f g t
+
+msubMap :: Functor m => (a -> [m a]) -> [a] -> [m [a]]
+msubMap f (x:xs) = (f x <&> fmap (: xs))  ++ ( (fmap (x :)) <$> msubMap f xs ) 
+msubMap _ [] = []
+
 subMap :: (a -> [a]) -> [a] -> [[a]]
 subMap f (x:xs) = (f x <&> (: xs)) ++ ( (x :) <$> subMap f xs ) 
 subMap _ [] = []