{-# 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)