Mercurial > hg > Members > toma > Jungle-haskell
view Jungle.hs @ 5:afdd87f73f17
fix API
author | Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 17 Jun 2013 18:09:37 +0900 |
parents | 48ed16468aaa |
children | 8bba94ec8c63 |
line wrap: on
line source
module Jungle ( Jungle , Tree (Tree) , Node (Empty) , Children , Attributes , Path , createJungle , createTree , createNode , updateTree , getTreeByName , getRootNode , getChildren , getMap , getAttributes , at , get , addNewChildAt , deleteChildAt , putAttribute , deleteAttribute ) where import qualified Data.Map as Map import qualified Data.ByteString.Lazy.Char8 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 , treeName :: String } 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 createNode tree_name createNode :: Node createNode = Node (Children Map.empty) (Attributes Map.empty) updateTree :: Jungle -> Tree -> Jungle updateTree (Jungle map) tree@(Tree node name) = Jungle (Map.insert name tree map) getTreeByName :: Jungle -> String -> Tree getTreeByName (Jungle map) tree_name = Map.findWithDefault emptyTree tree_name map where emptyTree = Tree createNode tree_name getRootNode :: Tree -> Node getRootNode tree = rootNode tree getChildren :: Node -> Children getChildren node = children node getMap :: Children -> Map.Map Int Node getMap (Children map) = map 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@(Tree root name) path pos node = Tree (addNewChildAt' (getRootNode tree) path pos node) name 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) 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 (Tree root name) [] node = Tree node name editTree tree path node = addNewChildAt tree (init path) (last path) node