module Main where

#if ! MIN_VERSION_base(4,6,0)
import Prelude hiding (catch)
#endif
import Control.Monad (forever)
import Control.Concurrent.MVar
  ( newEmptyMVar
  , putMVar
  , takeMVar
  , withMVar
  )
import qualified Network.Transport as NT (Transport)
import Network.Transport.TCP()
import Control.Distributed.Process.Platform.Time
import Control.Distributed.Process
import Control.Distributed.Process.Node
import Control.Distributed.Process.Serializable()
import Control.Distributed.Process.Platform.Timer

import Test.Framework (Test, testGroup)
import Test.Framework.Providers.HUnit (testCase)

import Control.Distributed.Process.Platform.Test
import TestUtils

testSendAfter :: TestResult Bool -> Process ()
testSendAfter result =
  let delay = seconds 1 in do
  sleep $ seconds 10
  pid <- getSelfPid
  _ <- sendAfter delay pid Ping
  hdInbox <- receiveTimeout (asTimeout (seconds 2)) [
                      match (\m@(Ping) -> return m)
                    ]
  case hdInbox of
      Just Ping -> stash result True
      Nothing   -> stash result False

testRunAfter :: TestResult Bool -> Process ()
testRunAfter result =
  let delay = seconds 2 in do

  parentPid <- getSelfPid
  _ <- spawnLocal $ do
    _ <- runAfter delay $ send parentPid Ping
    return ()

  msg <- expectTimeout ((asTimeout delay) * 4)
  case msg of
      Just Ping -> stash result True
      Nothing   -> stash result False
  return ()

testCancelTimer :: TestResult Bool -> Process ()
testCancelTimer result = do
  let delay = milliSeconds 50
  pid <- periodically delay noop
  ref <- monitor pid

  sleep $ seconds 1
  cancelTimer pid

  _ <- receiveWait [
          match (\(ProcessMonitorNotification ref' pid' _) ->
                  stash result $ ref == ref' && pid == pid')
        ]

  return ()

testPeriodicSend :: TestResult Bool -> Process ()
testPeriodicSend result = do
  let delay = milliSeconds 100
  self <- getSelfPid
  ref <- ticker delay self
  listener 0 ref
  liftIO $ putMVar result True
  where listener :: Int -> TimerRef -> Process ()
        listener n tRef | n > 10    = cancelTimer tRef
                        | otherwise = waitOne >> listener (n + 1) tRef
        -- get a single tick, blocking indefinitely
        waitOne :: Process ()
        waitOne = do
            Tick <- expect
            return ()

testTimerReset :: TestResult Int -> Process ()
testTimerReset result = do
  let delay = seconds 10
  counter <- liftIO $ newEmptyMVar

  listenerPid <- spawnLocal $ do
      stash counter 0
      -- we continually listen for 'ticks' and increment counter for each
      forever $ do
        Tick <- expect
        liftIO $ withMVar counter (\n -> (return (n + 1)))

  -- this ticker will 'fire' every 10 seconds
  ref <- ticker delay listenerPid

  sleep $ seconds 2
  resetTimer ref

  -- at this point, the timer should be back to roughly a 5 second count down
  -- so our few remaining cycles no ticks ought to make it to the listener
  -- therefore we kill off the timer and the listener now and take the count
  cancelTimer ref
  kill listenerPid "stop!"

  -- how many 'ticks' did the listener observer? (hopefully none!)
  count <- liftIO $ takeMVar counter
  liftIO $ putMVar result count

testTimerFlush :: TestResult Bool -> Process ()
testTimerFlush result = do
  let delay = seconds 1
  self <- getSelfPid
  ref  <- ticker delay self

  -- sleep so we *should* have a message in our 'mailbox'
  sleep $ milliSeconds 2

  -- flush it out if it's there
  flushTimer ref Tick (Delay $ seconds 3)

  m <- expectTimeout 10
  case m of
      Nothing   -> stash result True
      Just Tick -> stash result False

testSleep :: TestResult Bool -> Process ()
testSleep r = do
  sleep $ seconds 20
  stash r True

--------------------------------------------------------------------------------
-- Utilities and Plumbing                                                     --
--------------------------------------------------------------------------------

tests :: LocalNode  -> [Test]
tests localNode = [
    testGroup "Timer Tests" [
        testCase "testSendAfter"
                 (delayedAssertion
                  "expected Ping within 1 second"
                  localNode True testSendAfter)
      , testCase "testRunAfter"
                 (delayedAssertion
                  "expecting run (which pings parent) within 2 seconds"
                  localNode True testRunAfter)
      , testCase "testCancelTimer"
                 (delayedAssertion
                  "expected cancelTimer to exit the timer process normally"
                  localNode True testCancelTimer)
      , testCase "testPeriodicSend"
                 (delayedAssertion
                  "expected ten Ticks to have been sent before exiting"
                  localNode True testPeriodicSend)
      , testCase "testTimerReset"
                 (delayedAssertion
                  "expected no Ticks to have been sent before resetting"
                  localNode 0 testTimerReset)
      , testCase "testTimerFlush"
                 (delayedAssertion
                  "expected all Ticks to have been flushed"
                  localNode True testTimerFlush)
      , testCase "testSleep"
                 (delayedAssertion
                  "why am I not seeing a delay!?"
                  localNode True testTimerFlush)
      ]
  ]

timerTests :: NT.Transport -> IO [Test]
timerTests transport = do
  localNode <- newLocalNode transport initRemoteTable
  let testData = tests localNode
  return testData

main :: IO ()
main = testMain $ timerTests