fix: bug???

test/Test.Main.purs

@@ -2,18 +2,27 @@ 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.Error.Class (throwError, try)
+import Control.Monad.Rec.Class (Step(..), forever, tailRecM, untilJust)
+import Control.Monad.State.Async (AsyncStateT, asyncModify, asyncPut, asyncRead, asyncWrite, runAsyncState, runMutexState)
 import Control.Monad.Trans.Class (lift)
-import Control.Parallel (parallel, sequential)
+import Control.Parallel (parOneOf, parSequence_, parallel, sequential)
+import Data.Array as Array
 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.Maybe (Maybe(..))
 import Data.Newtype (wrap)
+import Data.Traversable (for_)
+import Data.Tuple.Nested ((/\))
 import Effect (Effect)
 import Effect.Aff (Aff, delay, launchAff_)
+import Effect.Aff.Class (liftAff)
+import Effect.Class (liftEffect)
+import Effect.Exception (error)
+import Effect.Random (randomBool)
 import Test.Spec (SpecT, describe, it)
 import Test.Spec.Assertions (shouldEqual, shouldSatisfy)
 import Test.Spec.Reporter (consoleReporter)
@@ -50,6 +59,58 @@ common = do
       pure @(AsyncStateT w String Aff) unit
       sequential (pure (\_ _ -> unit) <*> t1 <*> t2)
       asyncRead (shouldEqual "hello, john!")
+  it "supports concurrent state manipulation 2" do
+    let
+      t = do
+        _ <- asyncRead pure
+        asyncWrite (pure <<< (unit /\ _) <<< (_ <> "a"))
+        pure unit
+
+    runAsyncState "" do
+      pure @(AsyncStateT w String Aff) unit
+      parSequence_ $ Array.replicate 10 t
+      asyncRead (shouldEqual "aaaaaaaaaa")
+  it "supports parallel delay in monadrec" do
+    let
+      done = liftAff $ delay $ wrap 5000.0
+      go 0 = pure $ Done unit
+      go n = do
+        liftAff $ delay $ wrap 2.0
+        _ <- asyncRead pure
+        _ <- asyncModify pure
+        pure $ Loop (n - 1)
+
+    runAsyncState "" do
+      pure @(AsyncStateT w String Aff) unit
+      parOneOf
+        [ done
+        , tailRecM go 100
+        , tailRecM go 100
+        , tailRecM go 100
+        , tailRecM go 100
+        ]
+  it "setting the state to a value unblocks MonadRec" do
+    let
+      delayThenDone = do
+        liftAff $ delay $ wrap 100.0
+        asyncPut true
+      wait = untilJust do
+        done <- asyncRead pure
+        pure $ if done then Just unit else Nothing
+    runMutexState false $ parSequence_ [ delayThenDone, wait ]
+  it "throwing with lock does not block other threads" do
+    let
+      t = do
+        readThrows <- liftEffect randomBool
+        writeThrows <- liftEffect randomBool
+        void $ try $ asyncRead (const $ if readThrows then throwError $ error "fail" else pure unit)
+        void $ try $ asyncModify (\s -> if writeThrows then throwError $ error "fail" else pure s)
+        pure unit
+
+    for_ (Array.replicate 100 unit) \_ -> do
+      runAsyncState "" do
+        pure @(AsyncStateT w String Aff) unit
+        parSequence_ $ Array.replicate 100 t
 
 main :: Effect Unit
 main = launchAff_ $ runSpec [ consoleReporter ] do