{-# LANGUAGE OverloadedStrings #-}

import Control.Parallel
import Control.Parallel.Strategies
import Control.Concurrent
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
import Control.Monad.IO.Class

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 <- createJungle
  createTree jungle treeId
  createTree jungle treeId2

  node   <- getRootNode jungle treeId
  node2  <- getRootNode jungle treeId2
  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

  forkIO (func jungle treeId)
  func jungle treeId2

  printTimeSince t0

-- parallel write for two trees by singleWrite
dualWrite jungle = do
    x <- rpar (func jungle treeId)
    y <- rpar (func jungle treeId2)
    return (x, y)

func jungle id = do
    updateRootNodeWith (writeFunctions writeCount) jungle id
    tree <- getRootNode jungle id
    liftIO $ print (show $ attrSize tree)

-- 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-1)) node (concatMap permutations . subsequences $ [1..h])
  where
    add x node h = addc x node h

-- x回addNewChildAtする
addc 0 node h = addNewChildAt node h
addc x node h = addNewChildAt (addc (x-1) node h) h

printTimeSince t0 = do
  t1 <- getCurrentTime
  printf "time: %.2fs\n" (realToFrac (diffUTCTime t1 t0) :: Double)