# HG changeset patch
# User Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
# Date 1390287094 -32400
# Node ID 29d0f605efa95a4ca703986bf880eb89ef8df973
# Parent  947c5cfa414986dff8131ab94bb5618ccf30030a
add updateRootNodeWith

diff -r 947c5cfa4149 -r 29d0f605efa9 Jungle.hs
--- a/Jungle.hs	Tue Jan 21 13:17:02 2014 +0900
+++ b/Jungle.hs	Tue Jan 21 15:51:34 2014 +0900
@@ -7,6 +7,7 @@
 , createTree
 , getRootNode
 , updateRootNode
+, updateRootNodeWith
 , addNewChildAt
 , deleteChildAt
 , putAttribute
@@ -65,17 +66,26 @@
 getTreeByName (Jungle map) tree_name = M.lookup tree_name map
 
 getRootNode :: Jungle -> String -> IO Node
-getRootNode (Jungle map) tree_name = atomically $ readTVar (rootNode tree)
+getRootNode (Jungle map) tree_name = atomically $ readTVar root_node
   where
-    tree = case M.lookup tree_name map of
-             Just x -> x
+    root_node = case M.lookup tree_name map of
+             Just x -> rootNode x
 
 -- ルートノードを更新する
 updateRootNode :: Jungle -> String -> Node -> IO ()
-updateRootNode (Jungle map) tree_name node = atomically $ writeTVar (rootNode tree) node
+updateRootNode (Jungle map) tree_name node = atomically $ writeTVar root_node node
   where
-    tree = case M.lookup tree_name map of
-             Just x -> x
+    root_node = case M.lookup tree_name map of
+             Just x -> rootNode x
+
+updateRootNodeWith :: (Node -> Node) -> Jungle -> String -> IO ()
+updateRootNodeWith f (Jungle map) tree_name = 
+  atomically $ do
+    n <- readTVar root_node
+    writeTVar root_node (f n)
+  where
+    root_node = case M.lookup tree_name map of
+             Just x -> rootNode x
 
 -- 新しい木構造を作成し、最新のルートノードとなるNodeを返す
 -- Pathの位置にNodeが存在しない場合どうするか？
diff -r 947c5cfa4149 -r 29d0f605efa9 test/test.hs
--- a/test/test.hs	Tue Jan 21 13:17:02 2014 +0900
+++ b/test/test.hs	Tue Jan 21 15:51:34 2014 +0900
@@ -24,8 +24,13 @@
     (adda [] "root" "node") . (adda [1] "tes" "abc") .
     (adda [3,2] "test" "3-2") . (adda [2,2] "test" "2-2")
 
+add :: Node -> Node
 add = addattr . addchild
 
+putNode = putStrLn . drawNode
+putAttr = putStrLn . printAttributes 
+
+
 {-
 ghci> :l test.hs
 ghci> y <- tree