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