# HG changeset patch # User Daichi TOMA # Date 1389581021 -32400 # Node ID 644e1345ee83c456ed47a08f94902494d2154803 # Parent 8bba94ec8c63ceb7694a37f2ac20b6ce8c32037b add debugging function diff -r 8bba94ec8c63 -r 644e1345ee83 Jungle.hs --- a/Jungle.hs Mon Jan 13 09:02:37 2014 +0900 +++ b/Jungle.hs Mon Jan 13 11:43:41 2014 +0900 @@ -14,6 +14,7 @@ , deleteAttribute , getAttributes , drawNode -- デバッグ用 +, printAttributes ) where import qualified Data.Map as M @@ -163,17 +164,39 @@ map = getAttributesMap $ attributes target -- デバッグ用表示関数 +-- 現在の木構造を整形して表示 drawNode :: Node -> String drawNode node = unlines $ draw "root" node +draw :: String -> Node -> [String] draw string node = string : drawSubTrees keys where map = getChildrenMap $ children node keys = M.keys map drawSubTrees [] = [] drawSubTrees [t] = - "|" : shift "`-" " " (draw (show t) (fromJust $ M.lookup t map)) - drawSubTrees (t:ts) = + "|" : shift "`- " " " (draw (show t) (fromJust $ M.lookup t map)) + drawSubTrees (t:ts) = "|" : shift "+- " "| " (draw (show t) (fromJust $ M.lookup t map )) ++ drawSubTrees ts shift first other = zipWith (++) (first : repeat other) +-- Attributesを持つNodeを全て表示 +printAttributes :: Node -> String +printAttributes node = unlines $ printAttr "root" node + +printAttr :: String -> Node -> [String] +printAttr string node = + if M.null attr_map + then printSubTrees keys + else ("Node: " ++ string) : (" " ++ attr) : printSubTrees keys + where + attr_map = getAttributesMap $ attributes node + show_attr [] = [] + show_attr [x] = fst x ++ ": " ++ (B.unpack $ snd x) + show_attr (x:xs) = fst x ++ ": " ++ (B.unpack $ snd x) ++ "\n " ++ show_attr xs + attr = show_attr $ M.assocs attr_map + map = getChildrenMap $ children node + keys = M.keys map + printSubTrees [] = [] + printSubTrees (x:xs) = printAttr (string ++ "-" ++ (show x)) (fromJust $ M.lookup x map) ++ printSubTrees xs + diff -r 8bba94ec8c63 -r 644e1345ee83 test.hs --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test.hs Mon Jan 13 11:43:41 2014 +0900 @@ -0,0 +1,36 @@ +{-# LANGUAGE OverloadedStrings #-} + +import Jungle +import Data.Maybe +import qualified Data.ByteString.Lazy.Char8 as B + +jungle = createJungle + +tree = do + a <- createTree jungle "test" + let + t = fromJust $ getTreeByName a "test" + node <- getRootNode t + return (add node) + +addc path pos node = addNewChildAt node path pos + +addchild = + (addc [3] 2) . (addc [] 3) . (addc [1,1] 2) . (addc [1,1] 1). (addc [2] 2) . (addc [1] 2) . + (addc [2] 1) . (addc [] 2). (addc [1] 1) . (addc [] 1) + +adda path key value node = putAttribute node path key value + +addattr = + (adda [1,1] "key" "value") . (adda [1,1] "test" "test2") . + (adda [] "root" "node") . (adda [1] "tes" "abc") . + (adda [3,2] "test" "3-2") . (adda [2,2] "test" "2-2") + +add = addattr . addchild + +{- +ghci> :l test.hs +ghci> y <- tree +ghci> putStrLn $ printAttributes y +ghci> putStrLn $ drawNode y +-}