--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/test/ParWrite.hs	Wed Jan 22 12:46:34 2014 +0900
@@ -0,0 +1,84 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import Control.Parallel
+import Control.Parallel.Strategies
+import Text.Printf
+import Jungle
+import Data.Maybe
+import Data.List
+import Data.Time.Clock
+import qualified Data.ByteString.Lazy.Char8 as B
+import Control.Exception
+import System.Environment
+
+treeId :: String
+treeId = "test_tree"
+
+treeId2 :: String
+treeId2 = "hoge_tree"
+
+treeDepth :: Int
+treeDepth = 5
+
+lastPos :: [Int]
+lastPos = last $ concatMap permutations .  subsequences $ [0..treeDepth]
+
+writeCount :: Int
+writeCount = 100000
+
+main = do
+  jungle <- createTree createJungle treeId
+  jungle <- createTree jungle treeId2
+
+  node   <- getRootNode jungle treeId
+  let
+    miniTree = testTree node treeDepth
+
+  updateRootNode jungle treeId miniTree
+
+  putStrLn $ show $ size miniTree
+
+  t0 <- getCurrentTime
+  printTimeSince t0
+
+  sequence_ $ runEval $ dualWrite jungle
+  tree1 <- getRootNode jungle treeId
+  tree2 <- getRootNode jungle treeId2
+
+  print $ fromJust (getAttributes tree1 lastPos (show (writeCount-1)))
+  print $ fromJust (getAttributes tree2 lastPos (show (writeCount-1)))
+
+  printTimeSince t0
+
+-- parallel write for two trees by singleWrite
+dualWrite jungle = do
+    x <- rpar (mapM runEval (singleWrite jungle writeCount treeId))
+    y <- rpar (mapM runEval (singleWrite jungle writeCount treeId2))
+    return [x, y]
+
+-- paralell write for single tree
+singleWrite :: Jungle -> Int ->  String -> [Eval (IO ())]
+singleWrite jungle writeCount treeId = zipWith parApply (writeFunctions writeCount) (repeat jungle)
+  where
+    parApply f jungle = (rseq.runEval.rpar) (updateRootNodeWith f jungle treeId)
+
+-- generate functions to node update
+writeFunctions :: Int -> [(Node -> Node)]
+writeFunctions writeCount = map apply  [0..writeCount]
+  where
+      apply x node = putAttribute node lastPos (show x) (B.pack . show $ x)
+
+
+-- utils from ParRead
+
+testTree node h = foldl' (add h) node (concatMap permutations . subsequences $ [0..h])
+  where
+    add w node h = addc node h w
+
+addc node h w = foldl' (add h) node [0..w]
+  where
+    add h node pos = addNewChildAt node h pos
+
+printTimeSince t0 = do
+  t1 <- getCurrentTime
+  printf "time: %.2fs\n" (realToFrac (diffUTCTime t1 t0) :: Double)