# HG changeset patch
# User Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
# Date 1390490131 -32400
# Node ID 824543aea6fca1bc3c073ff4528ae6be1943679c
# Parent  8d4e37c1a86aebdbb7335d0675d5b69bf37c055e
delete Children and Attributes

diff -r 8d4e37c1a86a -r 824543aea6fc Jungle.hs
--- a/Jungle.hs	Wed Jan 22 16:08:13 2014 +0900
+++ b/Jungle.hs	Fri Jan 24 00:15:31 2014 +0900
@@ -13,6 +13,10 @@
 , putAttribute
 , deleteAttribute
 , getAttributes
+, getChildren
+, assocs
+, numOfChild
+, currentChild
 , drawNode
 , printAttributes
 , size
@@ -28,18 +32,11 @@
 
 data Tree = Tree
           { rootNode :: (TVar Node)
-          , treeName :: String
-          }
+          , treeName :: String }
 
 data Node = Node
-          { children   :: Children
-          , attributes :: Attributes
-          } deriving (Show)
-
--- Mapのkeyやvalueの型は固定しているが、
--- jungle作成時、もしくは木作成時に与えるように変更することも容易
-newtype Children   = Children   { getChildrenMap :: (M.Map Int Node) } deriving (Show)
-newtype Attributes = Attributes { getAttributesMap :: (M.Map String B.ByteString) } deriving (Show)
+          { children   :: (M.Map Int Node)
+          , attributes :: (M.Map String B.ByteString) }
 
 type Path = [Int]
 type Position = Int
@@ -60,7 +57,7 @@
     return (Tree node tree_name)
 
 emptyNode :: Node
-emptyNode = Node (Children M.empty) (Attributes M.empty)
+emptyNode = Node (M.empty) (M.empty)
 
 -- getRootNodeやupdateRootNodeをJungleとTree名を取るようにしたため不要
 getTreeByName :: Jungle -> String -> Maybe Tree
@@ -90,11 +87,12 @@
 
 -- 新しい木構造を作成し、最新のルートノードとなるNodeを返す
 -- Pathの位置にNodeが存在しない場合どうするか？
-addNewChildAt :: Node -> Path -> Position -> Node
-addNewChildAt parent []     pos = addChild parent pos emptyNode
-addNewChildAt parent (x:xs) pos = addChild parent x $ addNewChildAt x_node xs pos
+-- 1 -> 2 -> 3と勝手にPositionをインクリメントしながら追加する
+addNewChildAt :: Node -> Path -> Node
+addNewChildAt parent []     = addChild' parent emptyNode
+addNewChildAt parent (x:xs) = addChild parent x $ addNewChildAt x_node xs
   where
-    map = getChildrenMap $ children parent
+    map = children parent
     x_node = case M.lookup x map of
                Just x -> x
 
@@ -104,26 +102,33 @@
 addChild :: Node -> Position -> Node -> Node
 addChild node pos child = Node new_child attr
   where
-    map = getChildrenMap $ children node
-    new_child = Children (M.insert pos child map)
+    map = children node
+    new_child = M.insert pos child map
+    attr = attributes node
+
+-- 自動でPositionをincrementして追加してくれるaddChild
+addChild' :: Node -> Node -> Node
+addChild' node child = Node new_child attr
+  where
+    map = children node
+    pos = (M.size map) + 1
+    new_child = M.insert pos child map
     attr = attributes node
 
 -- 子を削除した新しいNodeを追加するのに等しい
--- addNewChildAtのコピペ、一般化して関数に抽出したい
--- Nodeを操作してNodeを返す関数を渡せばいけそう
 deleteChildAt :: Node -> Path -> Position -> Node
 deleteChildAt parent []     pos = deleteChild parent pos
 deleteChildAt parent (x:xs) pos = addChild parent x $ deleteChildAt x_node xs pos
   where
-    map = getChildrenMap $ children parent
+    map = children parent
     x_node = case M.lookup x map of
                Just x -> x
 
 deleteChild :: Node -> Position -> Node
 deleteChild node pos = Node new_child attr
   where
-    map = getChildrenMap $ children node
-    new_child = Children (M.delete pos map)
+    map = children node
+    new_child = M.delete pos map
     attr = attributes node
 
 -- attribute関連はaddNewChildAtを利用する
@@ -132,30 +137,30 @@
 putAttribute parent []     key value = putAttr parent key value
 putAttribute parent (x:xs) key value = addChild parent x $ putAttribute x_node xs key value
   where
-    map = getChildrenMap $ children parent
+    map = children parent
     x_node = case M.lookup x map of
                Just x -> x
 
 putAttr :: Node -> String -> B.ByteString -> Node
 putAttr node key value = Node child attr
   where
-    map = getAttributesMap $ attributes node
-    attr = Attributes (M.insert key value map)
+    map = attributes node
+    attr = M.insert key value map
     child = children node
 
 deleteAttribute :: Node -> Path -> String -> Node
 deleteAttribute parent []     key = deleteAttr parent key
 deleteAttribute parent (x:xs) key = addChild parent x $ deleteAttribute x_node xs key
   where
-    map = getChildrenMap $ children parent
+    map = children parent
     x_node = case M.lookup x map of
                Just x -> x
     
 deleteAttr :: Node -> String -> Node
 deleteAttr node key = Node child attr
   where
-    map = getAttributesMap $ attributes node
-    attr = Attributes (M.delete key map)
+    map = attributes node
+    attr = M.delete key map
     child = children node
 
 -- データを取り出す関連の関数
@@ -165,7 +170,7 @@
 getNode node []     = node
 getNode node (x:xs) = getNode child xs
   where
-    map = getChildrenMap $ children node
+    map = children node
     child = case M.lookup x map of
               Just x -> x
 
@@ -173,7 +178,38 @@
 getAttributes node path key = M.lookup key map
   where
     target = getNode node path
-    map = getAttributesMap $ attributes target
+    map = attributes target
+
+-- 対象のNodeの全ての子を返す
+getChildren :: Node -> Path -> [Node]
+getChildren node path = M.elems map
+  where
+    target = getNode node path
+    map = children target
+
+-- Attributeの連想リストを返す
+assocs :: Node -> Path ->  [(String, B.ByteString)]
+assocs node path = M.assocs map
+  where
+    target = getNode node path
+    map = attributes target
+
+-- 対象のNodeの子供の数を教えてくれる
+numOfChild :: Node -> Path -> Int
+numOfChild node path = M.size map
+  where
+    target = getNode node path
+    map = children target
+
+-- foucus
+-- 対象のpathのノードの最新の子を返す
+-- 編集する際に使うのは無理
+currentChild :: Node -> Path -> Maybe Node
+currentChild node path = M.lookup pos map
+  where
+    target = getNode node path
+    map = children target
+    pos = M.size map
 
 -- デバッグ用表示関数
 
@@ -184,7 +220,7 @@
 draw :: String -> Node -> [String]
 draw string node = string : drawSubTrees keys
   where
-    map = getChildrenMap $ children node
+    map = children node
     keys = M.keys map
     drawSubTrees [] = []
     drawSubTrees [t] = 
@@ -203,12 +239,12 @@
       then ("Node: " ++ string) : ("  " ++ attr) : printSubTrees keys
       else printSubTrees keys
   where
-    attr_map  = getAttributesMap $ attributes node
+    attr_map  = attributes node
     show_attr [] = []
     show_attr [x] = fst x ++ ": " ++ (B.unpack $ snd x)
     show_attr (x:xs) = fst x ++ ": " ++ (B.unpack $ snd x) ++ "\n  " ++ show_attr xs
     attr = show_attr $ M.assocs attr_map
-    map = getChildrenMap $ children node
+    map = children node
     keys = M.keys map
     printSubTrees []     = []
     printSubTrees (x:xs) = printAttr (string ++ "-" ++ (show x)) (fromJust $ M.lookup x map) ++ printSubTrees xs
@@ -217,7 +253,7 @@
 size :: Node -> Int
 size node = M.size map + subTreesSize keys
   where
-    map = getChildrenMap $ children node
+    map = children node
     keys = M.keys map
     subTreesSize [] = 0
     subTreesSize (x:xs) = size (getNode x) + subTreesSize xs
@@ -227,8 +263,8 @@
 attrSize :: Node -> Int
 attrSize node = M.size attr_map + subTreesSize keys
   where
-    attr_map = getAttributesMap $ attributes node
-    map = getChildrenMap $ children node
+    attr_map = attributes node
+    map = children node
     keys = M.keys map
     subTreesSize [] = 0
     subTreesSize (x:xs) = attrSize (getNode x) + subTreesSize xs
diff -r 8d4e37c1a86a -r 824543aea6fc test/ParWrite.hs
--- a/test/ParWrite.hs	Wed Jan 22 16:08:13 2014 +0900
+++ b/test/ParWrite.hs	Fri Jan 24 00:15:31 2014 +0900
@@ -2,6 +2,7 @@
 
 import Control.Parallel
 import Control.Parallel.Strategies
+import Control.Concurrent
 import Text.Printf
 import Jungle
 import Data.Maybe
@@ -46,21 +47,21 @@
   t0 <- getCurrentTime
   printTimeSince t0
 
-  a <- sequence$ runEval $ dualWrite jungle
-  print a
+  forkIO (func jungle treeId)
+  func jungle treeId2
 
   printTimeSince t0
 
 -- parallel write for two trees by singleWrite
 dualWrite jungle = do
-    x <- rpar (test jungle treeId)
-    y <- rpar (test jungle treeId2)
-    return [x, y]
+    x <- rpar (func jungle treeId)
+    y <- rpar (func jungle treeId2)
+    return (x, y)
 
-test jungle id = do
+func jungle id = do
     updateRootNodeWith (writeFunctions writeCount) jungle id
     tree <- getRootNode jungle id
-    return (attrSize tree)
+    liftIO $ print (show $ attrSize tree)
 
 -- generate functions to node update
 writeFunctions :: Int -> Node -> Node
diff -r 8d4e37c1a86a -r 824543aea6fc test/test.hs
--- a/test/test.hs	Wed Jan 22 16:08:13 2014 +0900
+++ b/test/test.hs	Fri Jan 24 00:15:31 2014 +0900
@@ -9,18 +9,18 @@
     node <- getRootNode jungle "test"
     return (add node)
 
-addc path pos node = addNewChildAt node path pos
+addc path node = addNewChildAt node path
 
 addchild = 
-    (addc [3] 2) . (addc [] 3) . (addc [1,1] 2) . (addc [1,1] 1). (addc [2] 2) . (addc [1] 2) . 
-    (addc [2] 1) . (addc [] 2). (addc [1] 1) . (addc [] 1)
+    (addc [3]) . (addc []) . (addc [1,1]) . (addc [1,1]). (addc [2]) . (addc [1]) . 
+    (addc [2]) . (addc []). (addc [1]) . (addc [])
 
 adda path key value node = putAttribute node path key value
 
 addattr = 
     (adda [1,1] "key" "value") . (adda [1,1] "test" "test2") .
     (adda [] "root" "node") . (adda [1] "tes" "abc") .
-    (adda [3,2] "test" "3-2") . (adda [2,2] "test" "2-2")
+    (adda [3,1] "test" "3-1") . (adda [2,2] "test" "2-2")
 
 add :: Node -> Node
 add = addattr . addchild