Mercurial > hg > Members > toma > Jungle-haskell
changeset 10:29d0f605efa9
add updateRootNodeWith
| author | Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> |
|---|---|
| date | Tue, 21 Jan 2014 15:51:34 +0900 |
| parents | 947c5cfa4149 |
| children | a30ec665df9d |
| files | Jungle.hs test/test.hs |
| diffstat | 2 files changed, 21 insertions(+), 6 deletions(-) [+] |
line wrap: on
line diff
--- 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が存在しない場合どうするか？
--- 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