--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Jungle.hs	Tue Mar 26 16:24:20 2013 +0900
@@ -0,0 +1,124 @@
+module Jungle 
+( Jungle
+, Tree
+, Node
+, Children
+, Attributes
+, createJungle
+, createTree
+, getTreeByName
+, getRootNode
+, getChildren
+, getAttributes
+, at
+, get
+, addNewChildAt
+, deleteChildAt
+, putAttribute
+, deleteAttribute
+) where
+
+import qualified Data.Map as Map
+import qualified Data.ByteString as B
+
+data Children   = Children (Map.Map Int Node) deriving (Show)
+data Attributes = Attributes (Map.Map String B.ByteString) deriving (Show)
+
+data Node = Empty
+          | Node
+          { children   :: Children
+          , attributes :: Attributes
+          } deriving (Show)
+
+data Tree = Tree
+          { rootNode :: Node
+          } deriving (Show)
+
+data Jungle = Jungle (Map.Map String Tree) deriving (Show)
+
+type Path = [Int]
+
+createJungle :: Jungle
+createJungle = Jungle Map.empty
+
+createTree :: Jungle -> String -> Jungle
+createTree (Jungle map) tree_name = Jungle (Map.insert tree_name emptyTree map)
+ where
+   emptyTree = Tree Empty
+
+getTreeByName :: Jungle -> String -> Tree
+getTreeByName (Jungle map) tree_name = Map.findWithDefault emptyTree tree_name map
+  where 
+    emptyTree = Tree Empty
+
+getRootNode :: Tree -> Node
+getRootNode tree = rootNode tree
+
+getChildren :: Node -> Children
+getChildren node = children node
+
+getAttributes :: Node -> Attributes
+getAttributes node = attributes node
+
+at :: Children -> Int -> Node
+at (Children map) pos = Map.findWithDefault Empty pos map
+
+get :: Attributes -> String -> B.ByteString
+get (Attributes map) key = Map.findWithDefault B.empty key map
+
+addNewChildAt :: Tree -> Path -> Int -> Node -> Tree
+addNewChildAt tree path pos node = Tree $ addNewChildAt' (getRootNode tree) path pos node
+
+addNewChildAt' :: Node -> Path -> Int -> Node -> Node
+addNewChildAt' parent []     pos new_child = addChild parent pos new_child
+addNewChildAt' parent (x:xs) pos new_child = addChild parent x (addNewChildAt' (child x) xs pos new_child)
+  where 
+    child = at (getChildren parent)
+
+-- RootNodeの子が消せない
+-- addNewChildAtが下に付け加えることしかできないから
+-- RootNodeのこの場合例外処理すればいけるけどスマートな書き方ないか考える
+deleteChildAt :: Tree -> Path -> Int -> Tree
+deleteChildAt tree path pos = editTree tree path (deleteChild target pos)
+  where
+    root = getRootNode tree
+    target = getNode root path
+
+addChild :: Node -> Int -> Node -> Node
+addChild Empty pos child = addChild (Node (Children Map.empty) (Attributes Map.empty)) pos child
+addChild (Node (Children map) attributes) pos child = Node (Children (Map.insert pos child map)) attributes
+
+getNode :: Node -> Path -> Node
+getNode node []     = node
+getNode node (x:xs) = getNode (child x) xs
+  where
+    child = at (getChildren node)
+
+deleteChild :: Node -> Int -> Node
+deleteChild Empty _ = Empty
+deleteChild (Node (Children map) attributes) pos = Node (Children (Map.delete pos map)) attributes
+
+putAttribute :: Tree -> Path -> String -> B.ByteString -> Tree
+putAttribute tree path key value = editTree tree path (putAttribute' target key value)
+  where
+    root = getRootNode tree
+    target = getNode root path
+
+deleteAttribute :: Tree -> Path -> String -> Tree
+deleteAttribute tree path key = editTree tree path (deleteAttribute' target key)
+  where
+    root = getRootNode tree
+    target = getNode root path
+
+putAttribute' :: Node -> String -> B.ByteString -> Node
+putAttribute' Empty key value = putAttribute' (Node (Children Map.empty) (Attributes Map.empty)) key value
+putAttribute' (Node children (Attributes map)) key value = Node children (Attributes (Map.insert key value map))
+
+deleteAttribute' :: Node -> String -> Node
+deleteAttribute' Empty _ = Empty
+deleteAttribute' (Node children (Attributes map)) key = Node children (Attributes (Map.delete key map))
+
+editTree :: Tree -> Path -> Node -> Tree
+editTree _    []   node = Tree node
+editTree tree path node = addNewChildAt tree (init path) (last path) node
+