Fix bug in annotations

src/Dodge/Tree/Compose.hs

@@ -167,23 +167,23 @@ logMT mt = case mt of
     MTree str _ brs -> Node ("M:"++str) $ map logMB brs
     BTree str _ brs -> Node str $ map logMT brs
 
-composeAndSubLog :: MetaTree a -> IO (Tree a)
-composeAndSubLog mt = case mt of
-    MTree{} -> composeAndLog mt
+composeAndSubLog :: Monad m => (String -> m ()) -> MetaTree a -> m (Tree a)
+composeAndSubLog dolog mt = case mt of
+    MTree{} -> composeAndLog dolog mt
     bt -> do
-        brs <- mapM composeAndSubLog $ _btBranches bt
+        brs <- mapM (composeAndSubLog dolog) (_btBranches bt)
         return $ Node (_btValue bt) brs
 
-composeAndLog :: MetaTree a -> IO (Tree a)
-composeAndLog mt = case mt of
+composeAndLog :: Monad m => (String -> m ()) -> MetaTree a -> m (Tree a)
+composeAndLog dolog mt = case mt of
     MTree{} -> do
-        putStrLn $ drawTree $ logMT mt
-        rt <- composeAndLog $ _mtTree mt
-        brs <- mapM (\mb -> (_mbAttach mb,) <$> composeAndSubLog (_mbTree mb)) $ _mtBranches mt
+        dolog $ drawTree $ logMT mt
+        rt <- composeAndLog dolog $ _mtTree mt
+        brs <- mapM (\mb -> (_mbAttach mb,) <$> (composeAndSubLog dolog) (_mbTree mb)) $ _mtBranches mt
         return $ attachList rt $ map pure brs
     BTree{} -> do
-        putStrLn $ drawTree $ logMT mt
-        brs <- mapM composeAndSubLog $ _btBranches mt
+        dolog $ drawTree $ logMT mt
+        brs <- mapM (composeAndSubLog dolog) $ _btBranches mt
         return $ Node (_btValue mt) brs
 
 cmpToMT :: Tree (a-> Maybe (b,a), Tree a) -> MetaTree a