Start to implement lock and key system

src/Dodge/Layout/Tree/Polymorphic.hs

@@ -1,3 +1,12 @@
+{-
+Helpers for the manipulation of rose trees.
+Throughout, the _trunk_ refers to successive first children in the tree.
+For example, in the tree 
+
+>   Node a [ Node b [], Node c [Node d []] ]
+
+the nodes in the trunk are [a,b] (note that d is not the first child of b).
+ -}
 module Dodge.Layout.Tree.Polymorphic
     where
 import Dodge.RandomHelp
@@ -10,20 +19,20 @@ import System.Random
 Creates a linear tree.
 Safe.
 -}
-treePost :: [a] -> a -> Tree a
-treePost []     y = Node y []
-treePost (x:xs) y = Node x [treePost xs y]
+treeFromPost :: [a] -> a -> Tree a
+treeFromPost []     y = Node y []
+treeFromPost (x:xs) y = Node x [treeFromPost xs y]
 
 {-
 Creates a tree with one trunk branch, 
 input as a list, that ends in another tree.
 -}
-treeTrunk 
+treeFromTrunk 
     :: [a]      -- ^ The trunk
     -> Tree a   -- ^ The end of the tree
     -> Tree a
-treeTrunk [] t     = t
-treeTrunk (x:xs) t = Node x [treeTrunk xs t]
+treeFromTrunk [] t     = t
+treeFromTrunk (x:xs) t = Node x [treeFromTrunk xs t]
 
 {-
 Applies a function to the root of a tree.
@@ -43,6 +52,15 @@ applyToNode (i:is) f (Node x xs) = Node x (ys ++ [applyToNode is f z] ++ zs)
   where
     (ys, z:zs) = splitAt i xs
 
+{-
+Applies a function to the first node along a trunk that satisfies a given property.
+-}
+applyToSubTrunkBy :: (a -> Bool) -> (Tree a -> Tree a) -> Tree a -> Tree a
+applyToSubTrunkBy cond f (Node x (t:ts))
+    | cond x    = f (Node x (t:ts))
+    | otherwise = Node x (applyToSubTrunkBy cond f t : ts)
+applyToSubTrunkBy _ _ t = t
+
 zipTree :: Tree a -> Tree b -> Tree (a,b)
 zipTree (Node x xs) (Node y ys) = Node (x,y) $ zipWith zipTree xs ys
 
@@ -79,7 +97,7 @@ applyToRandomNode f t = do
     return $ applyToNode p f t
 
 {-
-Add a forest to the end of a tree.
+Add a forest to the end of a tree (along the trunk).
 -}
 addToTrunk :: Tree a -> [Tree a] -> Tree a
 addToTrunk (Node x []) f = Node x f