Members/toma/Jungle-haskell: Jungle.hs annotate

annotate Jungle.hs @ 7:644e1345ee83

add debugging function

author	Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
date	Mon, 13 Jan 2014 11:43:41 +0900
parents	8bba94ec8c63
children	f03876c8236a

rev	line source
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	1 module Jungle
1 98e1a35e4ab0 Rewrite almost and Modularization Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 0 diff changeset	2 ( Jungle
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	3 , Tree
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	4 , Node
4 48ed16468aaa add Treename Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 3 diff changeset	5 , Path
1 98e1a35e4ab0 Rewrite almost and Modularization Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 0 diff changeset	6 , createJungle
98e1a35e4ab0 Rewrite almost and Modularization Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 0 diff changeset	7 , createTree
98e1a35e4ab0 Rewrite almost and Modularization Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 0 diff changeset	8 , getTreeByName
98e1a35e4ab0 Rewrite almost and Modularization Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 0 diff changeset	9 , getRootNode
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	10 , updateRootNode
1 98e1a35e4ab0 Rewrite almost and Modularization Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 0 diff changeset	11 , addNewChildAt
98e1a35e4ab0 Rewrite almost and Modularization Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 0 diff changeset	12 , deleteChildAt
98e1a35e4ab0 Rewrite almost and Modularization Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 0 diff changeset	13 , putAttribute
98e1a35e4ab0 Rewrite almost and Modularization Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 0 diff changeset	14 , deleteAttribute
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	15 , getAttributes
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	16 , drawNode -- デバッグ用
7 644e1345ee83 add debugging function Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 6 diff changeset	17 , printAttributes
1 98e1a35e4ab0 Rewrite almost and Modularization Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 0 diff changeset	18 ) where
0 329f462d5dad add nondestructive tree structure. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	19
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	20 import qualified Data.Map as M
5 afdd87f73f17 fix API Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 4 diff changeset	21 import qualified Data.ByteString.Lazy.Char8 as B
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	22 import Control.Concurrent.STM
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	23 import Data.Maybe (fromJust)
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	24
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	25 data Jungle = Jungle { getJungleMap :: (M.Map String Tree) }
1 98e1a35e4ab0 Rewrite almost and Modularization Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 0 diff changeset	26
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	27 data Tree = Tree
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	28 { rootNode :: (TVar Node)
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	29 , treeName :: String
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	30 }
0 329f462d5dad add nondestructive tree structure. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	31
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	32 data Node = Node
1 98e1a35e4ab0 Rewrite almost and Modularization Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 0 diff changeset	33 { children :: Children
98e1a35e4ab0 Rewrite almost and Modularization Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 0 diff changeset	34 , attributes :: Attributes
98e1a35e4ab0 Rewrite almost and Modularization Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 0 diff changeset	35 } deriving (Show)
0 329f462d5dad add nondestructive tree structure. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	36
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	37 -- Mapのkeyやvalueの型は固定しているが、
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	38 -- jungle作成時、もしくは木作成時に与えるように変更することも容易
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	39 newtype Children = Children { getChildrenMap :: (M.Map Int Node) } deriving (Show)
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	40 newtype Attributes = Attributes { getAttributesMap :: (M.Map String B.ByteString) } deriving (Show)
1 98e1a35e4ab0 Rewrite almost and Modularization Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 0 diff changeset	41
98e1a35e4ab0 Rewrite almost and Modularization Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 0 diff changeset	42 type Path = [Int]
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	43 type Position = Int
0 329f462d5dad add nondestructive tree structure. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	44
1 98e1a35e4ab0 Rewrite almost and Modularization Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 0 diff changeset	45 createJungle :: Jungle
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	46 createJungle = Jungle M.empty
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	47
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	48 -- 同じ名前のTreeが存在する場合、上書きする
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	49 -- Eitherなどで失敗させるほうがいいかもしれない
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	50 createTree :: Jungle -> String -> IO Jungle
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	51 createTree (Jungle map) tree_name = atomically $ do
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	52 tree <- emptyTree tree_name
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	53 return (Jungle (M.insert tree_name tree map))
0 329f462d5dad add nondestructive tree structure. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	54
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	55 emptyTree :: String -> STM Tree
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	56 emptyTree tree_name = do
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	57 node <- newTVar emptyNode
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	58 return (Tree node tree_name)
5 afdd87f73f17 fix API Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 4 diff changeset	59
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	60 emptyNode :: Node
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	61 emptyNode = Node (Children M.empty) (Attributes M.empty)
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	62
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	63 getTreeByName :: Jungle -> String -> Maybe Tree
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	64 getTreeByName (Jungle map) tree_name = M.lookup tree_name map
4 48ed16468aaa add Treename Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 3 diff changeset	65
48ed16468aaa add Treename Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 3 diff changeset	66 updateTree :: Jungle -> Tree -> Jungle
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	67 updateTree jungle tree = Jungle (M.insert tree_name tree map)
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	68 where
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	69 map = getJungleMap jungle
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	70 tree_name = treeName tree
0 329f462d5dad add nondestructive tree structure. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	71
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	72 getRootNode :: Tree -> IO Node
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	73 getRootNode tree = atomically $ readTVar (rootNode tree)
1 98e1a35e4ab0 Rewrite almost and Modularization Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 0 diff changeset	74
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	75 -- ルートノードを更新する
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	76 updateRootNode :: Tree -> Node -> IO ()
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	77 updateRootNode tree node = atomically $ writeTVar (rootNode tree) node
1 98e1a35e4ab0 Rewrite almost and Modularization Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 0 diff changeset	78
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	79 -- 新しい木構造を作成し、最新のルートノードとなるNodeを返す
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	80 -- Pathの位置にNodeが存在しない場合どうするか？
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	81 addNewChildAt :: Node -> Path -> Position -> Node
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	82 addNewChildAt parent [] pos = addChild parent pos emptyNode
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	83 addNewChildAt parent (x:xs) pos = addChild parent x $ addNewChildAt x_node xs pos
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	84 where
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	85 map = getChildrenMap $ children parent
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	86 x_node = case M.lookup x map of
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	87 Just x -> x
5 afdd87f73f17 fix API Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 4 diff changeset	88
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	89 -- 子を追加したNodeを新しく作成して返す
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	90 -- 同じ位置に既に子がある場合は？
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	91 -- 現在はinsertでそのまま上書き
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	92 addChild :: Node -> Position -> Node -> Node
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	93 addChild node pos child = Node new_child attr
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	94 where
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	95 map = getChildrenMap $ children node
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	96 new_child = Children (M.insert pos child map)
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	97 attr = attributes node
0 329f462d5dad add nondestructive tree structure. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	98
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	99 -- 子を削除した新しいNodeを追加するのに等しい
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	100 -- addNewChildAtのコピペ、一般化して関数に抽出したい
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	101 -- Nodeを操作してNodeを返す関数を渡せばいけそう
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	102 deleteChildAt :: Node -> Path -> Position -> Node
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	103 deleteChildAt parent [] pos = deleteChild parent pos
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	104 deleteChildAt parent (x:xs) pos = addChild parent x $ deleteChildAt x_node xs pos
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	105 where
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	106 map = getChildrenMap $ children parent
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	107 x_node = case M.lookup x map of
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	108 Just x -> x
1 98e1a35e4ab0 Rewrite almost and Modularization Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 0 diff changeset	109
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	110 deleteChild :: Node -> Position -> Node
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	111 deleteChild node pos = Node new_child attr
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	112 where
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	113 map = getChildrenMap $ children node
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	114 new_child = Children (M.delete pos map)
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	115 attr = attributes node
0 329f462d5dad add nondestructive tree structure. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	116
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	117 -- attribute関連はaddNewChildAtを利用する
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	118 -- 現在はコピペ、関数に抽出したい
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	119 putAttribute :: Node -> Path -> String -> B.ByteString -> Node
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	120 putAttribute parent [] key value = putAttr parent key value
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	121 putAttribute parent (x:xs) key value = addChild parent x $ putAttribute x_node xs key value
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	122 where
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	123 map = getChildrenMap $ children parent
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	124 x_node = case M.lookup x map of
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	125 Just x -> x
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	126
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	127 putAttr :: Node -> String -> B.ByteString -> Node
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	128 putAttr node key value = Node child attr
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	129 where
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	130 map = getAttributesMap $ attributes node
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	131 attr = Attributes (M.insert key value map)
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	132 child = children node
0 329f462d5dad add nondestructive tree structure. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	133
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	134 deleteAttribute :: Node -> Path -> String -> Node
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	135 deleteAttribute parent [] key = deleteAttr parent key
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	136 deleteAttribute parent (x:xs) key = addChild parent x $ deleteAttribute x_node xs key
1 98e1a35e4ab0 Rewrite almost and Modularization Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 0 diff changeset	137 where
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	138 map = getChildrenMap $ children parent
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	139 x_node = case M.lookup x map of
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	140 Just x -> x
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	141
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	142 deleteAttr :: Node -> String -> Node
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	143 deleteAttr node key = Node child attr
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	144 where
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	145 map = getAttributesMap $ attributes node
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	146 attr = Attributes (M.delete key map)
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	147 child = children node
1 98e1a35e4ab0 Rewrite almost and Modularization Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 0 diff changeset	148
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	149 -- データを取り出す関連の関数
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	150 -- getNodeとgetchild, getattributeなど？
1 98e1a35e4ab0 Rewrite almost and Modularization Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 0 diff changeset	151
98e1a35e4ab0 Rewrite almost and Modularization Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 0 diff changeset	152 getNode :: Node -> Path -> Node
98e1a35e4ab0 Rewrite almost and Modularization Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 0 diff changeset	153 getNode node [] = node
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	154 getNode node (x:xs) = getNode child xs
1 98e1a35e4ab0 Rewrite almost and Modularization Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 0 diff changeset	155 where
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	156 map = getChildrenMap $ children node
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	157 child = case M.lookup x map of
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	158 Just x -> x
0 329f462d5dad add nondestructive tree structure. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	159
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	160 getAttributes :: Node -> Path -> String -> Maybe B.ByteString
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	161 getAttributes node path key = M.lookup key map
1 98e1a35e4ab0 Rewrite almost and Modularization Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 0 diff changeset	162 where
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	163 target = getNode node path
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	164 map = getAttributesMap $ attributes target
0 329f462d5dad add nondestructive tree structure. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	165
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	166 -- デバッグ用表示関数
7 644e1345ee83 add debugging function Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 6 diff changeset	167 -- 現在の木構造を整形して表示
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	168 drawNode :: Node -> String
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	169 drawNode node = unlines $ draw "root" node
0 329f462d5dad add nondestructive tree structure. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	170
7 644e1345ee83 add debugging function Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 6 diff changeset	171 draw :: String -> Node -> [String]
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	172 draw string node = string : drawSubTrees keys
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	173 where
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	174 map = getChildrenMap $ children node
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	175 keys = M.keys map
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	176 drawSubTrees [] = []
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	177 drawSubTrees [t] =
7 644e1345ee83 add debugging function Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 6 diff changeset	178 "\|" : shift "`- " " " (draw (show t) (fromJust $ M.lookup t map))
644e1345ee83 add debugging function Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 6 diff changeset	179 drawSubTrees (t:ts) =
6 8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	180 "\|" : shift "+- " "\| " (draw (show t) (fromJust $ M.lookup t map )) ++ drawSubTrees ts
8bba94ec8c63 add STM to the root node. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 5 diff changeset	181 shift first other = zipWith (++) (first : repeat other)
0 329f462d5dad add nondestructive tree structure. Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	182
7 644e1345ee83 add debugging function Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 6 diff changeset	183 -- Attributesを持つNodeを全て表示
644e1345ee83 add debugging function Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 6 diff changeset	184 printAttributes :: Node -> String
644e1345ee83 add debugging function Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 6 diff changeset	185 printAttributes node = unlines $ printAttr "root" node
644e1345ee83 add debugging function Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 6 diff changeset	186
644e1345ee83 add debugging function Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 6 diff changeset	187 printAttr :: String -> Node -> [String]
644e1345ee83 add debugging function Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 6 diff changeset	188 printAttr string node =
644e1345ee83 add debugging function Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 6 diff changeset	189 if M.null attr_map
644e1345ee83 add debugging function Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 6 diff changeset	190 then printSubTrees keys
644e1345ee83 add debugging function Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 6 diff changeset	191 else ("Node: " ++ string) : (" " ++ attr) : printSubTrees keys
644e1345ee83 add debugging function Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 6 diff changeset	192 where
644e1345ee83 add debugging function Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 6 diff changeset	193 attr_map = getAttributesMap $ attributes node
644e1345ee83 add debugging function Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 6 diff changeset	194 show_attr [] = []
644e1345ee83 add debugging function Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 6 diff changeset	195 show_attr [x] = fst x ++ ": " ++ (B.unpack $ snd x)
644e1345ee83 add debugging function Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 6 diff changeset	196 show_attr (x:xs) = fst x ++ ": " ++ (B.unpack $ snd x) ++ "\n " ++ show_attr xs
644e1345ee83 add debugging function Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 6 diff changeset	197 attr = show_attr $ M.assocs attr_map
644e1345ee83 add debugging function Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 6 diff changeset	198 map = getChildrenMap $ children node
644e1345ee83 add debugging function Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 6 diff changeset	199 keys = M.keys map
644e1345ee83 add debugging function Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 6 diff changeset	200 printSubTrees [] = []
644e1345ee83 add debugging function Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 6 diff changeset	201 printSubTrees (x:xs) = printAttr (string ++ "-" ++ (show x)) (fromJust $ M.lookup x map) ++ printSubTrees xs
644e1345ee83 add debugging function Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> parents: 6 diff changeset	202

Mercurial > hg > Members > toma > Jungle-haskell

annotate Jungle.hs @ 7:644e1345ee83