extensible-effects-concurrent-0.12.0: test/SingleThreadedScheduler.hs

module SingleThreadedScheduler where

import           Control.Eff.Loop
import           Control.Eff.Concurrent.Process
import           Control.Eff.Concurrent.Process.SingleThreadedScheduler
                                               as Scheduler
import           Control.Monad
import           Test.Tasty
import           Test.Tasty.HUnit
import           Data.Dynamic
import           Common

test_pureScheduler :: TestTree
test_pureScheduler = setTravisTestOptions $ testGroup
    "Pure Scheduler"
    [ testCase "two processes, each calculate and report back to main process"
      $   Right (42 :: Int)
      @=? Scheduler.schedulePure
              (do
                  adderChild <- spawn $ do
                      (from, arg1, arg2) <- receiveMessage SP
                      sendMessage SP from ((arg1 + arg2) :: Int)
                      foreverCheap $ void $ receiveAnyMessage SP

                  multChild <- spawn $ do
                      (from, arg1, arg2) <- receiveMessage SP
                      sendMessage SP from ((arg1 * arg2) :: Int)

                  me <- self SP
                  sendMessage SP adderChild (me, 3 :: Int, 4 :: Int)
                  x <- receiveMessage @Int SP
                  sendMessage SP multChild (me, x, 6 :: Int)
                  receiveMessage @Int SP
              )
    ]


test_mainProcessSpawnsAChildAndExitsNormally :: TestTree
test_mainProcessSpawnsAChildAndExitsNormally = setTravisTestOptions
    (testCase
        "spawn a child and exit normally"
        (Scheduler.defaultMainSingleThreaded
            (do
                void
                    (spawn (void (receiveAnyMessage singleThreadedIoScheduler)))
                void (exitNormally singleThreadedIoScheduler)
                fail "This should not happen!!"
            )
        )
    )


test_mainProcessSpawnsAChildBothExitNormally :: TestTree
test_mainProcessSpawnsAChildBothExitNormally = setTravisTestOptions
    (testCase
        "spawn a child and let it exit and exit"
        (Scheduler.defaultMainSingleThreaded
            (do
                child <- spawn
                    (do
                        void (receiveMessage @String singleThreadedIoScheduler)
                        void (exitNormally singleThreadedIoScheduler)
                        error "This should not happen (child)!!"
                    )
                sendMessage singleThreadedIoScheduler child (toDyn "test")
                void (exitNormally singleThreadedIoScheduler)
                error "This should not happen!!"
            )
        )
    )