# HG changeset patch # User Daichi TOMA # Date 1363078851 -32400 # Node ID 329f462d5dadcfc8515b4a62b873979eba7e4056 add nondestructive tree structure. diff -r 000000000000 -r 329f462d5dad tree.hs --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tree.hs Tue Mar 12 18:00:51 2013 +0900 @@ -0,0 +1,71 @@ +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