61 lines
1.9 KiB
Haskell
61 lines
1.9 KiB
Haskell
|
module Test.Main where
|
||
|
|
|
||
|
|
import Prelude
|
||
|
|
|
||
|
|
import Control.Monad.Error.Class (try)
|
||
|
|
import Control.Monad.State.Async (AsyncStateT, asyncModify, asyncPut, asyncRead, runAsyncState)
|
||
|
|
import Control.Monad.Trans.Class (lift)
|
||
|
|
import Control.Parallel (parallel, sequential)
|
||
|
|
import Data.Async.Class (class AsyncState)
|
||
|
|
import Data.Async.Mutex (Mutex)
|
||
|
|
import Data.Async.RwLock (RwLock)
|
||
|
|
import Data.Either (isLeft)
|
||
|
|
import Data.Identity (Identity)
|
||
|
|
import Data.Newtype (wrap)
|
||
|
|
import Effect (Effect)
|
||
|
|
import Effect.Aff (Aff, delay, launchAff_)
|
||
|
|
import Test.Spec (SpecT, describe, it)
|
||
|
|
import Test.Spec.Assertions (shouldEqual, shouldSatisfy)
|
||
|
|
import Test.Spec.Reporter (consoleReporter)
|
||
|
|
import Test.Spec.Runner (runSpec)
|
||
|
|
|
||
|
|
common :: forall @w wl rl. AsyncState w wl rl => SpecT Aff Unit Identity Unit
|
||
|
|
common = do
|
||
|
|
it "does not throw" $ runAsyncState unit (pure @(AsyncStateT w Unit Aff) unit)
|
||
|
|
it "supports single-threaded state manipulation" do
|
||
|
|
runAsyncState 0 do
|
||
|
|
pure @(AsyncStateT w Int Aff) unit
|
||
|
|
flip shouldSatisfy isLeft =<< try (asyncRead $ shouldEqual 1)
|
||
|
|
asyncPut 1
|
||
|
|
asyncRead $ shouldEqual 1
|
||
|
|
asyncModify $ \n -> pure $ n + 2
|
||
|
|
asyncRead $ shouldEqual 3
|
||
|
|
it "supports concurrent state manipulation" do
|
||
|
|
let
|
||
|
|
t1 = parallel do
|
||
|
|
lift $ delay $ wrap 50.0
|
||
|
|
asyncModify
|
||
|
|
( \s -> do
|
||
|
|
delay $ wrap 100.0
|
||
|
|
pure $ s <> "john"
|
||
|
|
)
|
||
|
|
pure unit
|
||
|
|
t2 = parallel do
|
||
|
|
asyncPut "hello, "
|
||
|
|
lift $ delay $ wrap 60.0
|
||
|
|
asyncModify (pure <<< (_ <> "!"))
|
||
|
|
pure unit
|
||
|
|
|
||
|
|
runAsyncState "" do
|
||
|
|
pure @(AsyncStateT w String Aff) unit
|
||
|
|
sequential (pure (\_ _ -> unit) <*> t1 <*> t2)
|
||
|
|
asyncRead (shouldEqual "hello, john!")
|
||
|
|
|
||
|
|
main :: Effect Unit
|
||
|
|
main = launchAff_ $ runSpec [ consoleReporter ] do
|
||
|
|
describe "AsyncStateT" do
|
||
|
|
describe "MutexStateT" do
|
||
|
|
common @Mutex
|
||
|
|
describe "RwLockStateT" do
|
||
|
|
common @RwLock
|