changeset 1:98e1a35e4ab0

Rewrite almost and Modularization
author Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
date Tue, 26 Mar 2013 16:24:20 +0900
parents 329f462d5dad
children 392c3f30c076
files Jungle.hs tree.hs
diffstat 2 files changed, 124 insertions(+), 71 deletions(-) [+]
line wrap: on
line diff
--- /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
+
--- a/tree.hs	Tue Mar 12 18:00:51 2013 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,71 +0,0 @@
-import qualified Data.Map as Map
-import Data.Maybe (isNothing, fromJust)
-
-type Attribute = Map.Map String String
-type Children  = Map.Map Int Node
-
-data Node = Empty
-          | Node { attribute :: Attribute
-                 , children  :: Children
-                 } deriving (Show, Eq)
-
-addChild :: Node -> Node -> Int -> Node
-addChild node child pos = Node (attribute node) (Map.insert pos child (children node))
-
-getChild :: Node -> Int -> Maybe Node
-getChild node pos = Map.lookup pos (children node)
-
-putAttribute :: Node -> String -> String -> Node
-putAttribute node key value = Node (Map.insert key value (attribute node)) (children node)
-
-getAttribute :: Node -> String -> Maybe String
-getAttribute node key = Map.lookup key (attribute node)
-
-getNode :: [Int] -> Node -> Maybe Node
-getNode path node = if null path
-                    then Just node
-                    else (getChild node (head path)) >>= getNode (tail path)
-
-editNode :: [Int] -> Node -> String -> String -> Maybe Node
-editNode path node key value = if isNothing (getNode path node)
-                               then Nothing
-                               else _editNode path node Empty 0 key value
-
-_editNode :: [Int] -> Node -> Node -> Int -> String -> String -> Maybe Node
-_editNode [] node newnode pos _ _ = Just (addChild (fromJust (getNode [] node)) newnode pos)
-_editNode (xs) node newnode pos key value  = if newnode == Empty
-                                             then _editNode (init xs) node (putAttribute (fromJust (getNode xs node)) key value ) (last xs) [] []
-                                             else _editNode (init xs) node (addChild (fromJust (getNode xs node)) newnode pos) (last xs) [] []
-
-addChildAt :: [Int] -> Node -> Node -> Int -> Maybe Node
-addChildAt path node child pos = if isNothing (getNode (init path) node)
-                                 then Nothing
-                                 else _addChildAt path node child pos
-
-_addChildAt :: [Int] -> Node -> Node -> Int -> Maybe Node
-_addChildAt [] node child pos = Just (addChild (fromJust (getNode [] node)) child pos)
-_addChildAt (xs) node child pos = _addChildAt (init xs) node (addChild (fromJust (getNode xs node)) child pos) (last xs)
-
--- test 用
-a = Node Map.empty Map.empty
-b = Node Map.empty Map.empty
-c = Node Map.empty Map.empty
-d = Node Map.empty Map.empty
-e = Node Map.empty Map.empty
-f = Node Map.empty Map.empty
-g = Node Map.empty Map.empty
-
-a2 = putAttribute a "node" "a"
-b2 = putAttribute b "node" "b"
-c2 = putAttribute c "node" "c"
-d2 = putAttribute d "node" "d"
-e2 = putAttribute e "node" "e"
-f2 = putAttribute f "node" "f"
-g2 = putAttribute g "node" "g"
-
-b3 = addChild (addChild b2 d2 0) e2 1
-c3 = addChild c2 f2 0
-node = addChild g2 (addChild (addChild a2 b3 0) c3 1) 0
-
-new = editNode [0,1,0] node "node" "x"
-new1 = addChildAt [0,1,0] (fromJust new) z1 5