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