{-# LANGUAGE PatternSignatures   #-}

import IO
import Control.Concurrent
import Control.Concurrent.STM

import GHC.Conc


import Join.Base
import Join.Join

numberPat i status = method "Number" (i,status)
sumAllPat n status = method "Sum" (n,status)

number :: Join -> Int -> TVar Int -> IO ()
number join i status = call join "Number" (i,status)

sumAll :: Join -> Int -> Sync Int -> IO ()
sumAll join n status = call join "Sum" (n,status)


readVarSTM x = unsafeIOToSTM $ do v <- readVar x
                                  return v


sumRules output join activeMethod = do
   x <- newVar :: IO (VAR Int)
   n <- newVar :: IO (VAR Int)
   s1 <- newVar:: IO (VAR (TVar Int))
   s2 <- newVar :: IO (VAR (Sync Int))
   n' <- newVar :: IO (VAR Int)
   s2' <- newVar :: IO (VAR (Sync Int))

   let prog = translateJoinDefinitions
        [

          ([numberPat x s1] .\. [sumAllPat n s2]) 
               `whenAtomic` (do tv <- readVarSTM s1
                                v <- readTVar tv
                                if v == 0 then do
                                    writeTVar tv 1
                                    return True
                                 else return False)

             .->. do v_x <- readVar x
                     v_n <- readVar n
                     v_s <- readVar s2
                     sumAll join (v_x+v_n) v_s

{-
        , [sumAllPat n s2]

             .->. do v_n <- readVar n
                     s2 .=. (1::Int)  -- unblock
                     writeChan output $ 
                          "Sum1: " ++ show v_n ++ "\n"
-}

        , [sumAllPat n s2, sumAllPat n' s2']

             .->. do v_n <- readVar n
                     v_n' <- readVar n'
                     s2 .=. (1::Int)  -- unblock
                     s2' .=. (1::Int)  -- unblock
                     writeChan output $ 
                          "Sum1: " ++ show v_n ++ "\n" ++
                          "Sum2: " ++ show v_n' ++ "\n" ++
                          "Sum: " ++ show (v_n + v_n')

        ]
                      
   res <- runJoinOnGoal (store join) activeMethod prog
   case res of
         Just action -> action
         Nothing -> return ()      
   
-- testing

printOutput o = do
   b <- isEmptyChan o
   if b then return ()
    else do w <- readChan o
            putStrLn w
            printOutput o

test1 :: IO ()
test1 = do

  let no = 20

  output <- newChan
  wait <- atomically $ newTVar 0

  jStore <- newJoinStore 

  let join = Join {store = jStore, rules = sumRules output}

  mapM (\n -> do s <- atomically $ newTVar 0
                 number join n s)
       [1..no]

  let threads = 2

  mapM (\_ ->
       forkIO $ do 
             s <- newSync
             sumAll join 0 s
             v <- waitSync s
             atomically $ do x <- readTVar wait
                             writeTVar wait (x+1)
             return ())
     [1..threads]


  atomically $ do
      x <- readTVar wait
      if x == threads then return ()
       else retry

  printOutput output
  putStrLn "Done"