changeset 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
files Jungle.hs test.hs
diffstat 2 files changed, 61 insertions(+), 2 deletions(-) [+]
line wrap: on
line diff
--- 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
+
--- /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
+-}