{-# 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
  node2  <- getRootNode jungle treeId
  let
    miniTree  = testTree node treeDepth
    miniTree2 = testTree node2 treeDepth

  updateRootNode jungle treeId miniTree
  updateRootNode jungle treeId2 miniTree2

  putStrLn $ show $ size miniTree
  putStrLn $ show $ size miniTree2

  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 (updateRootNodeWith (writeFunctions writeCount) jungle treeId)
    y <- rseq (updateRootNodeWith (writeFunctions writeCount) jungle treeId2)
    rseq x
    return [x, y]

-- generate functions to node update
writeFunctions :: Int -> Node -> Node
writeFunctions writeCount node = foldl' apply node [0..writeCount] 
  where
      apply node x = 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)