Mercurial > hg > Members > toma > Jungle-haskell
annotate Jungle.hs @ 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 | 7360fbfc7e62 |
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 | 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 | 16 , drawNode |
7
644e1345ee83
add debugging function
Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
parents:
6
diff
changeset
|
17 , printAttributes |
8 | 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 | 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 | 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 | 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 | 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 | 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 | 201 if not $ M.null attr_map |
202 then ("Node: " ++ string) : (" " ++ attr) : printSubTrees keys | |
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 | 215 -- ルートノードの下にいくつの子があるか数える |
216 size :: Node -> Int | |
217 size node = M.size map + subTreesSize keys | |
218 where | |
219 map = getChildrenMap $ children node | |
220 keys = M.keys map | |
221 subTreesSize [] = 0 | |
222 subTreesSize (x:xs) = size (getNode x) + subTreesSize xs | |
223 getNode x = fromJust $ M.lookup x map | |
224 |