{-# OPTIONS_GHC -F -pgmF ixdopp #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

import Control.Concurrent.FullSession.UChan
import Control.Concurrent.FullSession.Misc
import Control.Concurrent.FullSession.Types
import Control.Concurrent.FullSession.Session


test0 = new >>>= \k -> forkIO (send k 1) >>> ireturn k
test1 = test0 >>>= \k -> recv k
runTest1 = runS test1

test2 = test0 >>>= \k -> new >>>= \k' -> forkIO (send k' "abc")  >>> recv k' >>> recv k
runTest2 = runS test2

-- forkIO_ can be nested
test3 = new >>>= \k -> new >>>= \k' -> forkIO_ (forkIO_ (forkIO_ (send k "abc" >>> send k' True))) >>>= \_ -> ireturn (k,k')
runTest3 = runS $ test3 >>>= \(k,k') -> recv k >>>= \str -> recv k' >>>= \b -> io (putStrLn $ str ++ show b)

-- GHC hangs for 1 minutes
-- test3 = new >>>= \k -> new >>>= \k' -> forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ $ forkIO_ (forkIO_ (forkIO_ (send k "abc" >>> send k' True)))


testrec0 = new >>>= \k -> let p k' = send k' 1 >>> zero k' >>> recur p k'; in forkIO (enter k >>> p k) >>> ireturn k
testrec0' = testrec0 >>>= \k -> let p k' = recv k' >>>= \x -> io (print x) >>> zero k' >>> recur p k in enter k >>> p k

runTestrec0 = runS testrec0'

testrec1 = new >>>= \k -> forkIO (send k 1) >>> recv k >>> testrec0'
runTestrec1 = runS testrec1

-- can this correctly inferred??
test4 = new >>>= \k -> new >>>= \k' -> forkIO (forkIO (send k' 123) >>> sendS k k') >>> ireturn k
test5 = test4 >>>= \k -> recvS k >>>= \k'' -> recv k''
runTest5 = runS test5

testrec2 = let p k = new >>>= \k' -> forkIO (send k' True) >>> sendS k k' >>> zero k >>> recur p k in new >>>= \k -> forkIO (enter k >>> p k)
testrec3 = let p k = sendS_new k >>>= \k' -> send k' True >>> zero k >>> recur p k in new >>>= \k -> forkIO (enter k >>> p k) >>> ireturn k
testrec3' = 
  let p k = ixdo  
        k' <- sendS_new k
        send k' True
        zero k
        recur p k
  in ixdo
       k <- new
       forkIO (ixdo enter k; p k)
       ireturn k

runTestrec3 = runS $ testrec3 >>>= \k ->
  let q k = recvS k >>>= \k' -> recv k' >>>= \b -> io (print b) >>> zero k >>> recur q k in enter k >>> q k


proc1 = ixdo
  k <- new
  forkIO (ixdo send k (12345::Int); str <- recv k; io (putStrLn str))
  i <- recv k
  send k (show i)

proc2 = ixdo
  k <- new
  forkIO (send k (123::Int))
  ireturn k

proc2' k = recv k >>>= \i -> io (print (i::Int))

proc3 = ixdo
  k <- proc2
  k' <- proc2
  k'' <- proc2
  proc2' k
  proc2' k'
  proc2' k''
  ireturn ()

serverS i listen = ixdo
  conn <- recvS listen
  forkIO $ ixdo
    io (putStrLn $ "connection established. "++show i)
    server conn
    io (putStrLn "disconnect.")
  zero listen
  recur (serverS (i+1)) listen

server conn = ixdo
    x <- recv conn
    y <- recv conn
    if y==0 
      then ixdo
        sel1 conn
        send conn "division by 0!!"
      else ixdo
        sel2 conn
        send conn (x `div` y::Int)
    () <- recv conn
    ireturn ()


clientS chan = ixdo
  conn <- sendS_new chan
  client conn

client conn = ixdo
    x <- io (do putStr "x:"; readLn)
    y <- io (do putStr "y:"; readLn)
    send conn (x::Int)
    send conn (y::Int)
    offer conn 
        (ixdo
        err <- recv conn
        io (putStrLn $ "server returned an error : "++err)
        send conn ()
      ) (ixdo
        ans <- recv conn
        io (putStrLn $ "result: "++(show (ans::Int)))
        send conn ()
      )

divSystem = ixdo
  conn <- new
  forkIO $ server conn
  client conn

runDivSystem = runS divSystem

divSystemS = ixdo
  k <- new
  forkIO $ ixdo enter k; serverS 0 k
  let client_rec k = ixdo clientS k; zero k; recur client_rec k
  enter k
  client_rec k

runDivSystemS = runS divSystemS