Mercurial > hg > Members > toma > Jungle-haskell

comparison Jungle.hs @ 1:98e1a35e4ab0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Rewrite almost and Modularization
author Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
date Tue, 26 Mar 2013 16:24:20 +0900
parents tree.hs@329f462d5dad
children 392c3f30c076
comparison
equal deleted inserted replaced
0:329f462d5dad 1:98e1a35e4ab0
1 module Jungle
2 ( Jungle
3 , Tree
4 , Node
5 , Children
6 , Attributes
7 , createJungle
8 , createTree
9 , getTreeByName
10 , getRootNode
11 , getChildren
12 , getAttributes
13 , at
14 , get
15 , addNewChildAt
16 , deleteChildAt
17 , putAttribute
18 , deleteAttribute
19 ) where
20
21 import qualified Data.Map as Map
22 import qualified Data.ByteString as B
23
24 data Children = Children (Map.Map Int Node) deriving (Show)
25 data Attributes = Attributes (Map.Map String B.ByteString) deriving (Show)
26
27 data Node = Empty
28 | Node
29 { children :: Children
30 , attributes :: Attributes
31 } deriving (Show)
32
33 data Tree = Tree
34 { rootNode :: Node
35 } deriving (Show)
36
37 data Jungle = Jungle (Map.Map String Tree) deriving (Show)
38
39 type Path = [Int]
40
41 createJungle :: Jungle
42 createJungle = Jungle Map.empty
43
44 createTree :: Jungle -> String -> Jungle
45 createTree (Jungle map) tree_name = Jungle (Map.insert tree_name emptyTree map)
46 where
47 emptyTree = Tree Empty
48
49 getTreeByName :: Jungle -> String -> Tree
50 getTreeByName (Jungle map) tree_name = Map.findWithDefault emptyTree tree_name map
51 where
52 emptyTree = Tree Empty
53
54 getRootNode :: Tree -> Node
55 getRootNode tree = rootNode tree
56
57 getChildren :: Node -> Children
58 getChildren node = children node
59
60 getAttributes :: Node -> Attributes
61 getAttributes node = attributes node
62
63 at :: Children -> Int -> Node
64 at (Children map) pos = Map.findWithDefault Empty pos map
65
66 get :: Attributes -> String -> B.ByteString
67 get (Attributes map) key = Map.findWithDefault B.empty key map
68
69 addNewChildAt :: Tree -> Path -> Int -> Node -> Tree
70 addNewChildAt tree path pos node = Tree $ addNewChildAt' (getRootNode tree) path pos node
71
72 addNewChildAt' :: Node -> Path -> Int -> Node -> Node
73 addNewChildAt' parent [] pos new_child = addChild parent pos new_child
74 addNewChildAt' parent (x:xs) pos new_child = addChild parent x (addNewChildAt' (child x) xs pos new_child)
75 where
76 child = at (getChildren parent)
77
78 -- RootNodeの子が消せない
79 -- addNewChildAtが下に付け加えることしかできないから
80 -- RootNodeのこの場合例外処理すればいけるけどスマートな書き方ないか考える
81 deleteChildAt :: Tree -> Path -> Int -> Tree
82 deleteChildAt tree path pos = editTree tree path (deleteChild target pos)
83 where
84 root = getRootNode tree
85 target = getNode root path
86
87 addChild :: Node -> Int -> Node -> Node
88 addChild Empty pos child = addChild (Node (Children Map.empty) (Attributes Map.empty)) pos child
89 addChild (Node (Children map) attributes) pos child = Node (Children (Map.insert pos child map)) attributes
90
91 getNode :: Node -> Path -> Node
92 getNode node [] = node
93 getNode node (x:xs) = getNode (child x) xs
94 where
95 child = at (getChildren node)
96
97 deleteChild :: Node -> Int -> Node
98 deleteChild Empty _ = Empty
99 deleteChild (Node (Children map) attributes) pos = Node (Children (Map.delete pos map)) attributes
100
101 putAttribute :: Tree -> Path -> String -> B.ByteString -> Tree
102 putAttribute tree path key value = editTree tree path (putAttribute' target key value)
103 where
104 root = getRootNode tree
105 target = getNode root path
106
107 deleteAttribute :: Tree -> Path -> String -> Tree
108 deleteAttribute tree path key = editTree tree path (deleteAttribute' target key)
109 where
110 root = getRootNode tree
111 target = getNode root path
112
113 putAttribute' :: Node -> String -> B.ByteString -> Node
114 putAttribute' Empty key value = putAttribute' (Node (Children Map.empty) (Attributes Map.empty)) key value
115 putAttribute' (Node children (Attributes map)) key value = Node children (Attributes (Map.insert key value map))
116
117 deleteAttribute' :: Node -> String -> Node
118 deleteAttribute' Empty _ = Empty
119 deleteAttribute' (Node children (Attributes map)) key = Node children (Attributes (Map.delete key map))
120
121 editTree :: Tree -> Path -> Node -> Tree
122 editTree _ [] node = Tree node
123 editTree tree path node = addNewChildAt tree (init path) (last path) node
124