Ready for replacement of Either with bespoke data type for compo trees

src/Dodge/Tree/GenerateStructure.hs

@@ -0,0 +1,46 @@
+{-
+Procedural generation of tree structures.
+
+A /trunk/ refers to the successive first nodes in lists of children.
+-}
+module Dodge.Tree.GenerateStructure
+    where
+import Dodge.RandomHelp
+
+import Data.Tree
+import Control.Monad.State
+import System.Random
+{- Single branched tree (a trunk).  -}
+treePath :: Int -> Tree ()
+treePath 0 = Node () []
+treePath x = Node () [treePath (x-1)]
+{- Adds a branch at a certain point down a trunk.  -}
+addBranchAt 
+    :: Int      -- ^ Depth to add branch at
+    -> Tree ()  -- ^ Branch to add
+    -> Tree ()  -- ^ Starting tree
+    -> Tree ()
+addBranchAt 0 b (Node () xs) = Node () (xs ++ [b])
+addBranchAt i b (Node () (x:xs))
+    = Node () (addBranchAt (i-1) b x : xs)
+addBranchAt _ _ _ = error "Trying to add a branch too far along a tree"
+{- Randomly generate a tree containing a maximum of three nodes.  -}
+smallBranch :: RandomGen g => State g (Tree ())
+smallBranch = takeOne
+    [ treePath 0
+    , treePath 1
+    , treePath 2
+    , addBranchAt 0 (treePath 0) (treePath 1)
+    ]
+
+{-
+Randomly generate a small tree.
+-}
+aTreeStrut :: RandomGen g => State g (Tree ())
+aTreeStrut = do
+    d <- state $ randomR (9,11:: Int)
+    nbs <- state $ randomR (2,4)
+    bds <- takeN nbs [1 .. d - 1]
+    bs  <- replicateM nbs smallBranch
+    let trunk = treePath d
+    return $ foldr (uncurry addBranchAt) trunk $ zip bds bs