Mercurial > hg > Members > toma > Jungle-haskell

annotate 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
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
1 module Jungle
1
98e1a35e4ab0 Rewrite almost and Modularization
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
2 ( Jungle
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
3 , Node
4
48ed16468aaa add Treename
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 3
diff changeset
4 , Path
9
947c5cfa4149 Change function related to Tree, Tree is not visiable from outside.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 8
diff changeset
5 , Position
1
98e1a35e4ab0 Rewrite almost and Modularization
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
6 , createJungle
98e1a35e4ab0 Rewrite almost and Modularization
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
7 , createTree
98e1a35e4ab0 Rewrite almost and Modularization
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
8 , getRootNode
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
9 , updateRootNode
10
29d0f605efa9 add updateRootNodeWith
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 9
diff changeset
10 , updateRootNodeWith
1
98e1a35e4ab0 Rewrite almost and Modularization
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
11 , addNewChildAt
98e1a35e4ab0 Rewrite almost and Modularization
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
12 , deleteChildAt
98e1a35e4ab0 Rewrite almost and Modularization
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
13 , putAttribute
98e1a35e4ab0 Rewrite almost and Modularization
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
14 , deleteAttribute
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
15 , getAttributes
8
f03876c8236a add ParRead
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 7
diff changeset
16 , drawNode
7
644e1345ee83 add debugging function
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
17 , printAttributes
8
f03876c8236a add ParRead
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 7
diff changeset
18 , size
1
98e1a35e4ab0 Rewrite almost and Modularization
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
19 ) where
0
329f462d5dad add nondestructive tree structure.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
20
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
21 import qualified Data.Map as M
5
afdd87f73f17 fix API
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 4
diff changeset
22 import qualified Data.ByteString.Lazy.Char8 as B
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
23 import Control.Concurrent.STM
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
24 import Data.Maybe (fromJust)
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
25
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
26 data Jungle = Jungle { getJungleMap :: (M.Map String Tree) }
1
98e1a35e4ab0 Rewrite almost and Modularization
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
27
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
28 data Tree = Tree
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
29 { rootNode :: (TVar Node)
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
30 , treeName :: String
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
31 }
0
329f462d5dad add nondestructive tree structure.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
32
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
33 data Node = Node
1
98e1a35e4ab0 Rewrite almost and Modularization
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
34 { children :: Children
98e1a35e4ab0 Rewrite almost and Modularization
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
35 , attributes :: Attributes
98e1a35e4ab0 Rewrite almost and Modularization
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
36 } deriving (Show)
0
329f462d5dad add nondestructive tree structure.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
37
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
38 -- Mapのkeyやvalueの型は固定しているが、
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
39 -- jungle作成時、もしくは木作成時に与えるように変更することも容易
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
40 newtype Children = Children { getChildrenMap :: (M.Map Int Node) } deriving (Show)
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
41 newtype Attributes = Attributes { getAttributesMap :: (M.Map String B.ByteString) } deriving (Show)
1
98e1a35e4ab0 Rewrite almost and Modularization
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
42
98e1a35e4ab0 Rewrite almost and Modularization
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
43 type Path = [Int]
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
44 type Position = Int
0
329f462d5dad add nondestructive tree structure.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
45
1
98e1a35e4ab0 Rewrite almost and Modularization
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
46 createJungle :: Jungle
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
47 createJungle = Jungle M.empty
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
48
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
49 -- 同じ名前のTreeが存在する場合、上書きする
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
50 -- Eitherなどで失敗させるほうがいいかもしれない
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
51 createTree :: Jungle -> String -> IO Jungle
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
52 createTree (Jungle map) tree_name = atomically $ do
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
53 tree <- emptyTree tree_name
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
54 return (Jungle (M.insert tree_name tree map))
0
329f462d5dad add nondestructive tree structure.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
55
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
56 emptyTree :: String -> STM Tree
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
57 emptyTree tree_name = do
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
58 node <- newTVar emptyNode
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
59 return (Tree node tree_name)
5
afdd87f73f17 fix API
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 4
diff changeset
60
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
61 emptyNode :: Node
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
62 emptyNode = Node (Children M.empty) (Attributes M.empty)
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
63
9
947c5cfa4149 Change function related to Tree, Tree is not visiable from outside.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 8
diff changeset
64 -- getRootNodeやupdateRootNodeをJungleとTree名を取るようにしたため不要
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
65 getTreeByName :: Jungle -> String -> Maybe Tree
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
66 getTreeByName (Jungle map) tree_name = M.lookup tree_name map
4
48ed16468aaa add Treename
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 3
diff changeset
67
9
947c5cfa4149 Change function related to Tree, Tree is not visiable from outside.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 8
diff changeset
68 getRootNode :: Jungle -> String -> IO Node
10
29d0f605efa9 add updateRootNodeWith
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 9
diff changeset
69 getRootNode (Jungle map) tree_name = atomically $ readTVar root_node
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
70 where
10
29d0f605efa9 add updateRootNodeWith
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 9
diff changeset
71 root_node = case M.lookup tree_name map of
29d0f605efa9 add updateRootNodeWith
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 9
diff changeset
72 Just x -> rootNode x
1
98e1a35e4ab0 Rewrite almost and Modularization
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
73
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
74 -- ルートノードを更新する
9
947c5cfa4149 Change function related to Tree, Tree is not visiable from outside.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 8
diff changeset
75 updateRootNode :: Jungle -> String -> Node -> IO ()
10
29d0f605efa9 add updateRootNodeWith
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 9
diff changeset
76 updateRootNode (Jungle map) tree_name node = atomically $ writeTVar root_node node
9
947c5cfa4149 Change function related to Tree, Tree is not visiable from outside.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 8
diff changeset
77 where
10
29d0f605efa9 add updateRootNodeWith
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 9
diff changeset
78 root_node = case M.lookup tree_name map of
29d0f605efa9 add updateRootNodeWith
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 9
diff changeset
79 Just x -> rootNode x
29d0f605efa9 add updateRootNodeWith
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 9
diff changeset
80
29d0f605efa9 add updateRootNodeWith
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 9
diff changeset
81 updateRootNodeWith :: (Node -> Node) -> Jungle -> String -> IO ()
29d0f605efa9 add updateRootNodeWith
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 9
diff changeset
82 updateRootNodeWith f (Jungle map) tree_name =
29d0f605efa9 add updateRootNodeWith
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 9
diff changeset
83 atomically $ do
29d0f605efa9 add updateRootNodeWith
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 9
diff changeset
84 n <- readTVar root_node
29d0f605efa9 add updateRootNodeWith
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 9
diff changeset
85 writeTVar root_node (f n)
29d0f605efa9 add updateRootNodeWith
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 9
diff changeset
86 where
29d0f605efa9 add updateRootNodeWith
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 9
diff changeset
87 root_node = case M.lookup tree_name map of
29d0f605efa9 add updateRootNodeWith
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 9
diff changeset
88 Just x -> rootNode x
1
98e1a35e4ab0 Rewrite almost and Modularization
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
89
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
90 -- 新しい木構造を作成し、最新のルートノードとなるNodeを返す
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
91 -- Pathの位置にNodeが存在しない場合どうするか？
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
92 addNewChildAt :: Node -> Path -> Position -> Node
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
93 addNewChildAt parent [] pos = addChild parent pos emptyNode
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
94 addNewChildAt parent (x:xs) pos = addChild parent x $ addNewChildAt x_node xs pos
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
95 where
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
96 map = getChildrenMap $ children parent
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
97 x_node = case M.lookup x map of
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
98 Just x -> x
5
afdd87f73f17 fix API
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 4
diff changeset
99
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
100 -- 子を追加したNodeを新しく作成して返す
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
101 -- 同じ位置に既に子がある場合は？
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
102 -- 現在はinsertでそのまま上書き
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
103 addChild :: Node -> Position -> Node -> Node
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
104 addChild node pos child = Node new_child attr
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
105 where
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
106 map = getChildrenMap $ children node
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
107 new_child = Children (M.insert pos child map)
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
108 attr = attributes node
0
329f462d5dad add nondestructive tree structure.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
109
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
110 -- 子を削除した新しいNodeを追加するのに等しい
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
111 -- addNewChildAtのコピペ、一般化して関数に抽出したい
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
112 -- Nodeを操作してNodeを返す関数を渡せばいけそう
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
113 deleteChildAt :: Node -> Path -> Position -> Node
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
114 deleteChildAt parent [] pos = deleteChild parent pos
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
115 deleteChildAt parent (x:xs) pos = addChild parent x $ deleteChildAt x_node xs pos
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
116 where
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
117 map = getChildrenMap $ children parent
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
118 x_node = case M.lookup x map of
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
119 Just x -> x
1
98e1a35e4ab0 Rewrite almost and Modularization
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
120
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
121 deleteChild :: Node -> Position -> Node
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
122 deleteChild node pos = Node new_child attr
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
123 where
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
124 map = getChildrenMap $ children node
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
125 new_child = Children (M.delete pos map)
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
126 attr = attributes node
0
329f462d5dad add nondestructive tree structure.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
127
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
128 -- attribute関連はaddNewChildAtを利用する
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
129 -- 現在はコピペ、関数に抽出したい
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
130 putAttribute :: Node -> Path -> String -> B.ByteString -> Node
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
131 putAttribute parent [] key value = putAttr parent key value
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
132 putAttribute parent (x:xs) key value = addChild parent x $ putAttribute x_node xs key value
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
133 where
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
134 map = getChildrenMap $ children parent
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
135 x_node = case M.lookup x map of
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
136 Just x -> x
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
137
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
138 putAttr :: Node -> String -> B.ByteString -> Node
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
139 putAttr node key value = Node child attr
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
140 where
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
141 map = getAttributesMap $ attributes node
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
142 attr = Attributes (M.insert key value map)
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
143 child = children node
0
329f462d5dad add nondestructive tree structure.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
144
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
145 deleteAttribute :: Node -> Path -> String -> Node
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
146 deleteAttribute parent [] key = deleteAttr parent key
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
147 deleteAttribute parent (x:xs) key = addChild parent x $ deleteAttribute x_node xs key
1
98e1a35e4ab0 Rewrite almost and Modularization
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
148 where
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
149 map = getChildrenMap $ children parent
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
150 x_node = case M.lookup x map of
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
151 Just x -> x
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
152
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
153 deleteAttr :: Node -> String -> Node
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
154 deleteAttr node key = Node child attr
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
155 where
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
156 map = getAttributesMap $ attributes node
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
157 attr = Attributes (M.delete key map)
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
158 child = children node
1
98e1a35e4ab0 Rewrite almost and Modularization
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
159
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
160 -- データを取り出す関連の関数
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
161 -- getNodeとgetchild, getattributeなど？
1
98e1a35e4ab0 Rewrite almost and Modularization
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
162
98e1a35e4ab0 Rewrite almost and Modularization
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
163 getNode :: Node -> Path -> Node
98e1a35e4ab0 Rewrite almost and Modularization
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
164 getNode node [] = node
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
165 getNode node (x:xs) = getNode child xs
1
98e1a35e4ab0 Rewrite almost and Modularization
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
166 where
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
167 map = getChildrenMap $ children node
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
168 child = case M.lookup x map of
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
169 Just x -> x
0
329f462d5dad add nondestructive tree structure.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
170
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
171 getAttributes :: Node -> Path -> String -> Maybe B.ByteString
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
172 getAttributes node path key = M.lookup key map
1
98e1a35e4ab0 Rewrite almost and Modularization
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
173 where
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
174 target = getNode node path
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
175 map = getAttributesMap $ attributes target
0
329f462d5dad add nondestructive tree structure.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
176
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
177 -- デバッグ用表示関数
8
f03876c8236a add ParRead
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 7
diff changeset
178
7
644e1345ee83 add debugging function
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
179 -- 現在の木構造を整形して表示
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
180 drawNode :: Node -> String
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
181 drawNode node = unlines $ draw "root" node
0
329f462d5dad add nondestructive tree structure.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
182
7
644e1345ee83 add debugging function
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
183 draw :: String -> Node -> [String]
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
184 draw string node = string : drawSubTrees keys
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
185 where
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
186 map = getChildrenMap $ children node
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
187 keys = M.keys map
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
188 drawSubTrees [] = []
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
189 drawSubTrees [t] =
7
644e1345ee83 add debugging function
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
190 "|" : shift "`- " " " (draw (show t) (fromJust $ M.lookup t map))
644e1345ee83 add debugging function
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
191 drawSubTrees (t:ts) =
6
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
192 "|" : shift "+- " "| " (draw (show t) (fromJust $ M.lookup t map )) ++ drawSubTrees ts
8bba94ec8c63 add STM to the root node.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
193 shift first other = zipWith (++) (first : repeat other)
0
329f462d5dad add nondestructive tree structure.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
194
9
947c5cfa4149 Change function related to Tree, Tree is not visiable from outside.
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 8
diff changeset
195 -- Attributesを全て表示
7
644e1345ee83 add debugging function
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
196 printAttributes :: Node -> String
644e1345ee83 add debugging function
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
197 printAttributes node = unlines $ printAttr "root" node
644e1345ee83 add debugging function
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
198
644e1345ee83 add debugging function
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
199 printAttr :: String -> Node -> [String]
644e1345ee83 add debugging function
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
200 printAttr string node =
8
f03876c8236a add ParRead
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 7
diff changeset
201 if not $ M.null attr_map
f03876c8236a add ParRead
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 7
diff changeset
202 then ("Node: " ++ string) : (" " ++ attr) : printSubTrees keys
f03876c8236a add ParRead
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 7
diff changeset
203 else printSubTrees keys
7
644e1345ee83 add debugging function
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
204 where
644e1345ee83 add debugging function
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
205 attr_map = getAttributesMap $ attributes node
644e1345ee83 add debugging function
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
206 show_attr [] = []
644e1345ee83 add debugging function
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
207 show_attr [x] = fst x ++ ": " ++ (B.unpack $ snd x)
644e1345ee83 add debugging function
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
208 show_attr (x:xs) = fst x ++ ": " ++ (B.unpack $ snd x) ++ "\n " ++ show_attr xs
644e1345ee83 add debugging function
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
209 attr = show_attr $ M.assocs attr_map
644e1345ee83 add debugging function
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
210 map = getChildrenMap $ children node
644e1345ee83 add debugging function
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
211 keys = M.keys map
644e1345ee83 add debugging function
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
212 printSubTrees [] = []
644e1345ee83 add debugging function
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
213 printSubTrees (x:xs) = printAttr (string ++ "-" ++ (show x)) (fromJust $ M.lookup x map) ++ printSubTrees xs
644e1345ee83 add debugging function
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
214
8
f03876c8236a add ParRead
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 7
diff changeset
215 -- ルートノードの下にいくつの子があるか数える
f03876c8236a add ParRead
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 7
diff changeset
216 size :: Node -> Int
f03876c8236a add ParRead
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 7
diff changeset
217 size node = M.size map + subTreesSize keys
f03876c8236a add ParRead
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 7
diff changeset
218 where
f03876c8236a add ParRead
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 7
diff changeset
219 map = getChildrenMap $ children node
f03876c8236a add ParRead
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 7
diff changeset
220 keys = M.keys map
f03876c8236a add ParRead
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 7
diff changeset
221 subTreesSize [] = 0
f03876c8236a add ParRead
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 7
diff changeset
222 subTreesSize (x:xs) = size (getNode x) + subTreesSize xs
f03876c8236a add ParRead
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 7
diff changeset
223 getNode x = fromJust $ M.lookup x map
f03876c8236a add ParRead
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents: 7
diff changeset
224