Mercurial > hg > Members > toma > Jungle-haskell

changeset 9:947c5cfa4149

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Change function related to Tree, Tree is not visiable from outside.
author Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
date Tue, 21 Jan 2014 13:17:02 +0900
parents f03876c8236a
children 29d0f605efa9
files Jungle.hs test/ParRead.hs test/test.hs
diffstat 3 files changed, 16 insertions(+), 20 deletions(-) [+]
line wrap: on
line diff
--- a/Jungle.hs	Tue Jan 14 18:09:51 2014 +0900
+++ b/Jungle.hs	Tue Jan 21 13:17:02 2014 +0900
@@ -1,11 +1,10 @@
 module Jungle
 ( Jungle
-, Tree
 , Node
 , Path
+, Position
 , createJungle
 , createTree
-, getTreeByName
 , getRootNode
 , updateRootNode
 , addNewChildAt
@@ -61,21 +60,22 @@
 emptyNode :: Node
 emptyNode = Node (Children M.empty) (Attributes M.empty)
 
+-- getRootNodeやupdateRootNodeをJungleとTree名を取るようにしたため不要
 getTreeByName :: Jungle -> String -> Maybe Tree
 getTreeByName (Jungle map) tree_name = M.lookup tree_name map
 
-updateTree :: Jungle -> Tree -> Jungle
-updateTree jungle tree = Jungle (M.insert tree_name tree map)
+getRootNode :: Jungle -> String -> IO Node
+getRootNode (Jungle map) tree_name = atomically $ readTVar (rootNode tree)
   where
-    map = getJungleMap jungle
-    tree_name = treeName tree 
-
-getRootNode :: Tree -> IO Node
-getRootNode tree = atomically $ readTVar (rootNode tree)
+    tree = case M.lookup tree_name map of
+             Just x -> x
 
 -- ルートノードを更新する
-updateRootNode :: Tree -> Node -> IO ()
-updateRootNode tree node = atomically $ writeTVar (rootNode tree) node
+updateRootNode :: Jungle -> String -> Node -> IO ()
+updateRootNode (Jungle map) tree_name node = atomically $ writeTVar (rootNode tree) node
+  where
+    tree = case M.lookup tree_name map of
+             Just x -> x
 
 -- 新しい木構造を作成し、最新のルートノードとなるNodeを返す
 -- Pathの位置にNodeが存在しない場合どうするか？
@@ -182,7 +182,7 @@
       "|" : shift "+- " "|  " (draw (show t) (fromJust $ M.lookup t map )) ++ drawSubTrees ts
     shift first other = zipWith (++) (first : repeat other)
 
--- Attributesを持つNodeを全て表示
+-- Attributesを全て表示
 printAttributes :: Node -> String
 printAttributes node = unlines $ printAttr "root" node
 
--- a/test/ParRead.hs	Tue Jan 14 18:09:51 2014 +0900
+++ b/test/ParRead.hs	Tue Jan 21 13:17:02 2014 +0900
@@ -16,14 +16,12 @@
   let
     jungle = createJungle
   new_jungle <- createTree jungle "test_tree"
-  let
-    tree = fromJust $ getTreeByName new_jungle "test_tree"
-  node <- getRootNode tree
+  node <- getRootNode new_jungle "test_tree"
   let
     x = testTree node 7
   putStrLn $ show $ size x
-  updateRootNode tree x
-  node2 <- getRootNode tree
+  updateRootNode new_jungle "test_tree" x
+  node2 <- getRootNode new_jungle "test_tree"
   t0 <- getCurrentTime
   printTimeSince t0
   r <- evaluate (runEval $ test node2)
--- a/test/test.hs	Tue Jan 14 18:09:51 2014 +0900
+++ b/test/test.hs	Tue Jan 21 13:17:02 2014 +0900
@@ -8,9 +8,7 @@
 
 tree = do
     a <- createTree jungle "test"
-    let
-      t = fromJust $ getTreeByName a "test"
-    node <- getRootNode t
+    node <- getRootNode a "test"
     return (add node)
 
 addc path pos node = addNewChildAt node path pos