Mercurial > hg > Members > toma > Jungle-haskell

comparison Jungle.hs @ 10:29d0f605efa9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
add updateRootNodeWith
author Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
date Tue, 21 Jan 2014 15:51:34 +0900
parents 947c5cfa4149
children 7360fbfc7e62
comparison
equal deleted inserted replaced
9:947c5cfa4149 10:29d0f605efa9
5 , Position 5 , Position
6 , createJungle 6 , createJungle
7 , createTree 7 , createTree
8 , getRootNode 8 , getRootNode
9 , updateRootNode 9 , updateRootNode
10 , updateRootNodeWith
10 , addNewChildAt 11 , addNewChildAt
11 , deleteChildAt 12 , deleteChildAt
12 , putAttribute 13 , putAttribute
13 , deleteAttribute 14 , deleteAttribute
14 , getAttributes 15 , getAttributes
63 -- getRootNodeやupdateRootNodeをJungleとTree名を取るようにしたため不要 64 -- getRootNodeやupdateRootNodeをJungleとTree名を取るようにしたため不要
64 getTreeByName :: Jungle -> String -> Maybe Tree 65 getTreeByName :: Jungle -> String -> Maybe Tree
65 getTreeByName (Jungle map) tree_name = M.lookup tree_name map 66 getTreeByName (Jungle map) tree_name = M.lookup tree_name map
66 67
67 getRootNode :: Jungle -> String -> IO Node 68 getRootNode :: Jungle -> String -> IO Node
68 getRootNode (Jungle map) tree_name = atomically $ readTVar (rootNode tree) 69 getRootNode (Jungle map) tree_name = atomically $ readTVar root_node
69 where 70 where
70 tree = case M.lookup tree_name map of 71 root_node = case M.lookup tree_name map of
71 Just x -> x 72 Just x -> rootNode x
72 73
73 -- ルートノードを更新する 74 -- ルートノードを更新する
74 updateRootNode :: Jungle -> String -> Node -> IO () 75 updateRootNode :: Jungle -> String -> Node -> IO ()
75 updateRootNode (Jungle map) tree_name node = atomically $ writeTVar (rootNode tree) node 76 updateRootNode (Jungle map) tree_name node = atomically $ writeTVar root_node node
76 where 77 where
77 tree = case M.lookup tree_name map of 78 root_node = case M.lookup tree_name map of
78 Just x -> x 79 Just x -> rootNode x
80
81 updateRootNodeWith :: (Node -> Node) -> Jungle -> String -> IO ()
82 updateRootNodeWith f (Jungle map) tree_name =
83 atomically $ do
84 n <- readTVar root_node
85 writeTVar root_node (f n)
86 where
87 root_node = case M.lookup tree_name map of
88 Just x -> rootNode x
79 89
80 -- 新しい木構造を作成し、最新のルートノードとなるNodeを返す 90 -- 新しい木構造を作成し、最新のルートノードとなるNodeを返す
81 -- Pathの位置にNodeが存在しない場合どうするか？ 91 -- Pathの位置にNodeが存在しない場合どうするか？
82 addNewChildAt :: Node -> Path -> Position -> Node 92 addNewChildAt :: Node -> Path -> Position -> Node
83 addNewChildAt parent [] pos = addChild parent pos emptyNode 93 addNewChildAt parent [] pos = addChild parent pos emptyNode