Mercurial > hg > Members > toma > Jungle-haskell

comparison Jungle.hs @ 2:392c3f30c076

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
change to String from ByteString
author Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
date Tue, 26 Mar 2013 17:30:20 +0900
parents 98e1a35e4ab0
children 090bdde20e9f
comparison
equal deleted inserted replaced
1:98e1a35e4ab0 2:392c3f30c076
17 , putAttribute 17 , putAttribute
18 , deleteAttribute 18 , deleteAttribute
19 ) where 19 ) where
20 20
21 import qualified Data.Map as Map 21 import qualified Data.Map as Map
22 import qualified Data.ByteString as B
23 22
24 data Children = Children (Map.Map Int Node) deriving (Show) 23 data Children = Children (Map.Map Int Node) deriving (Show)
25 data Attributes = Attributes (Map.Map String B.ByteString) deriving (Show) 24 data Attributes = Attributes (Map.Map String String) deriving (Show)
26 25
27 data Node = Empty 26 data Node = Empty
28 | Node 27 | Node
29 { children :: Children 28 { children :: Children
30 , attributes :: Attributes 29 , attributes :: Attributes
61 getAttributes node = attributes node 60 getAttributes node = attributes node
62 61
63 at :: Children -> Int -> Node 62 at :: Children -> Int -> Node
64 at (Children map) pos = Map.findWithDefault Empty pos map 63 at (Children map) pos = Map.findWithDefault Empty pos map
65 64
66 get :: Attributes -> String -> B.ByteString 65 get :: Attributes -> String -> String
67 get (Attributes map) key = Map.findWithDefault B.empty key map 66 get (Attributes map) key = Map.findWithDefault "" key map
68 67
69 addNewChildAt :: Tree -> Path -> Int -> Node -> Tree 68 addNewChildAt :: Tree -> Path -> Int -> Node -> Tree
70 addNewChildAt tree path pos node = Tree $ addNewChildAt' (getRootNode tree) path pos node 69 addNewChildAt tree path pos node = Tree $ addNewChildAt' (getRootNode tree) path pos node
71 70
72 addNewChildAt' :: Node -> Path -> Int -> Node -> Node 71 addNewChildAt' :: Node -> Path -> Int -> Node -> Node
73 addNewChildAt' parent [] pos new_child = addChild parent pos new_child 72 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) 73 addNewChildAt' parent (x:xs) pos new_child = addChild parent x (addNewChildAt' (child x) xs pos new_child)
75 where 74 where
76 child = at (getChildren parent) 75 child = at (getChildren parent)
77 76
78 -- RootNodeの子が消せない
79 -- addNewChildAtが下に付け加えることしかできないから
80 -- RootNodeのこの場合例外処理すればいけるけどスマートな書き方ないか考える
81 deleteChildAt :: Tree -> Path -> Int -> Tree 77 deleteChildAt :: Tree -> Path -> Int -> Tree
82 deleteChildAt tree path pos = editTree tree path (deleteChild target pos) 78 deleteChildAt tree path pos = editTree tree path (deleteChild target pos)
83 where 79 where
84 root = getRootNode tree 80 root = getRootNode tree
85 target = getNode root path 81 target = getNode root path
96 92
97 deleteChild :: Node -> Int -> Node 93 deleteChild :: Node -> Int -> Node
98 deleteChild Empty _ = Empty 94 deleteChild Empty _ = Empty
99 deleteChild (Node (Children map) attributes) pos = Node (Children (Map.delete pos map)) attributes 95 deleteChild (Node (Children map) attributes) pos = Node (Children (Map.delete pos map)) attributes
100 96
101 putAttribute :: Tree -> Path -> String -> B.ByteString -> Tree 97 putAttribute :: Tree -> Path -> String -> String -> Tree
102 putAttribute tree path key value = editTree tree path (putAttribute' target key value) 98 putAttribute tree path key value = editTree tree path (putAttribute' target key value)
103 where 99 where
104 root = getRootNode tree 100 root = getRootNode tree
105 target = getNode root path 101 target = getNode root path
106 102
108 deleteAttribute tree path key = editTree tree path (deleteAttribute' target key) 104 deleteAttribute tree path key = editTree tree path (deleteAttribute' target key)
109 where 105 where
110 root = getRootNode tree 106 root = getRootNode tree
111 target = getNode root path 107 target = getNode root path
112 108
113 putAttribute' :: Node -> String -> B.ByteString -> Node 109 putAttribute' :: Node -> String -> String -> Node
114 putAttribute' Empty key value = putAttribute' (Node (Children Map.empty) (Attributes Map.empty)) key value 110 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)) 111 putAttribute' (Node children (Attributes map)) key value = Node children (Attributes (Map.insert key value map))
116 112
117 deleteAttribute' :: Node -> String -> Node 113 deleteAttribute' :: Node -> String -> Node
118 deleteAttribute' Empty _ = Empty 114 deleteAttribute' Empty _ = Empty