packages feed

theatre-dev 0.1.1.1 → 0.2

raw patch · 21 files changed

+603/−960 lines, 21 filesdep −unagi-chandep ~async

Dependencies removed: unagi-chan

Dependency ranges changed: async

Files

hspec/Main.hs view
@@ -1,11 +1,10 @@ module Main (main) where  import Test.Hspec-import TheatreDev.StmBasedSpec qualified+import TheatreDevSpec qualified import Prelude  main :: IO () main =   hspec do-    describe "TheatreDev" do-      describe "StmBased" TheatreDev.StmBasedSpec.spec+    describe "TheatreDev" TheatreDevSpec.spec
− hspec/TheatreDev/StmBasedSpec.hs 
@@ -1,164 +0,0 @@-{-# OPTIONS_GHC -Wno-unused-local-binds -Wno-unused-binds #-}--module TheatreDev.StmBasedSpec (spec) where--import Control.Concurrent.Async-import Data.IntMap.Strict qualified as IntMap-import Data.IntSet qualified as IntSet-import Test.Hspec-import Test.Hspec.QuickCheck-import Test.QuickCheck-import TheatreDev.StmBased qualified as Actor-import TheatreDev.StmBasedSpec.IO qualified as IO-import TheatreDev.StmBasedSpec.Preferences qualified as Preferences-import Prelude--spec :: Spec-spec =-  do-    describe "kill" do-      describe "When full" do-        it "Does not" pending--    describe "kill" do-      describe "When full" do-        it "Blocks until a slot is freed up" pending--    describe "spawnStatefulBatched" do-      let spawnIntUpdater step = Actor.spawnStatefulBatched @Int 0 (const (return ())) step-      let spawnUnit step = Actor.spawnStatefulBatched () (const (return ())) step--      it "Works in batches" do-        acc <- newIORef []-        actorLock <- newEmptyMVar-        emitterLock <- newEmptyMVar-        actor <- spawnUnit $ \_ messages ->-          do-            modifyIORef' acc (messages :)-            putMVar emitterLock ()-            takeMVar actorLock--        Actor.tell actor 1--        takeMVar emitterLock-        Actor.tell actor 2-        Actor.tell actor 3-        putMVar actorLock ()--        takeMVar emitterLock-        Actor.tell actor 4-        putMVar actorLock ()--        takeMVar emitterLock-        Actor.kill actor--        collectedBatches <- reverse . fmap toList <$> readIORef acc-        shouldBe collectedBatches [[1], [2, 3], [4]]--      it "Threads the state" do-        let input = [0 .. 9]-            inputLength = length input--        resultsVar <- newTVarIO []-        actor <- Actor.spawnStatefulBatched [] (const (return ())) $ \state msgs -> do-          let !newState = foldl' (flip (:)) state msgs-          atomically $ writeTVar resultsVar newState-          return newState-        traverse_ (Actor.tell actor) input--        results <- atomically $ do-          results <- readTVar resultsVar-          if length results < inputLength-            then retry-            else return results--        shouldBe (reverse results) input--      it "Kill and wait" do-        let input = [0 .. 9]-            inputLength = length input--        resultVar <- newEmptyMVar-        actor <--          Actor.spawnStatefulBatched-            []-            ( \state -> do-                threadDelay 1000-                putMVar resultVar state-            )-            ( \state msgs -> return $ foldl' (flip (:)) state msgs-            )-        traverse_ (Actor.tell actor) input--        Actor.kill actor-        Actor.wait actor--        result <- takeMVar resultVar-        shouldBe result $ reverse input--    describe "allOf" . modifyMaxSuccess (max 1000) $ do-      it "Passes 1" do-        let emittersNum = 2-            messagesNum = 10-            actorsNum = 3-            messages = [0 .. messagesNum - 1]-        results <- fmap (fmap sort) (IO.simulateReduction actorsNum emittersNum Actor.allOf messages)-        shouldBe results (replicate actorsNum (sort (concat (replicate emittersNum messages))))-        shouldBe (getSum (foldMap (Sum . length) results)) (actorsNum * emittersNum * messagesNum)-      prop "" $ forAll (chooseInt (0, 99)) $ \size -> forAll arbitrary $ \(messages :: [Int]) ->-        idempotentIOProperty do-          results <- sort . concat <$> IO.simulateReduction Preferences.concurrency size Actor.allOf messages-          return-            $ conjoin-              [ length results === length messages * size * Preferences.concurrency,-                results === sort (concat (replicate (size * Preferences.concurrency) messages))-              ]--    describe "oneOf" . modifyMaxSuccess (max 1000) $ do-      prop "Dispatches correctly" $ forAll (chooseInt (0, 99)) $ \size -> forAll arbitrary $ \(messages :: [Int]) ->-        idempotentIOProperty do-          results <- sort . concat <$> IO.simulateReduction Preferences.concurrency size Actor.oneOf messages-          return-            $ conjoin-              [ length results === length messages * size,-                results-                  === sort (concat (replicate (size) messages))-              ]--    describe "byKeyHash" . modifyMaxSuccess (max Preferences.largePropertyMaxSuccess) $ do-      prop "Dispatches individually" $ forAll (chooseInt (0, 99)) $ \size -> forAll arbitrary $ \(messages :: [Int]) -> idempotentIOProperty $ do-        resultsVar <- newTVarIO []-        actor <--          fmap (Actor.byKeyHash id)-            $ replicateM size-            $ Actor.spawnStatefulIndividual-              IntMap.empty-              ( \state ->-                  atomically-                    $ modifyTVar' resultsVar-                    $ (:) state-              )-              ( \state msg ->-                  return $ IntMap.alter (Just . maybe 1 succ) msg state-              )--        mapConcurrently id-          $ replicate Preferences.concurrency-          $ for_ messages-          $ Actor.tell actor--        Actor.kill actor-        Actor.wait actor--        results <- readTVarIO resultsVar--        let allKeys = results >>= IntMap.keys-            nubbedKeys = nub allKeys--        return-          $ conjoin-            [ allKeys === nubbedKeys,-              if size == 0-                then nubbedKeys === []-                else IntSet.fromList nubbedKeys === IntSet.fromList messages-            ]
− hspec/TheatreDev/StmBasedSpec/IO.hs 
@@ -1,34 +0,0 @@-module TheatreDev.StmBasedSpec.IO where--import Control.Concurrent.Async-import TheatreDev.StmBased (Actor)-import TheatreDev.StmBased qualified as Actor-import Prelude--simulateReduction :: Int -> Int -> ([Actor a] -> Actor a) -> [a] -> IO [[a]]-simulateReduction actorsNum generatorsNum reducer messages =-  do-    resultsVar <- newTVarIO []--    actor <--      fmap reducer-        $ replicateM actorsNum-        $ Actor.spawnStatefulIndividual-          []-          ( \state ->-              atomically-                $ modifyTVar' resultsVar (reverse state :)-          )-          ( \state msg ->-              return $ msg : state-          )--    mapConcurrently id-      $ replicate generatorsNum-      $ for_ messages-      $ Actor.tell actor--    Actor.kill actor-    Actor.wait actor--    readTVarIO resultsVar
− hspec/TheatreDev/StmBasedSpec/Preferences.hs 
@@ -1,9 +0,0 @@-module TheatreDev.StmBasedSpec.Preferences where--import Prelude--concurrency :: Int-concurrency = 7--largePropertyMaxSuccess :: Int-largePropertyMaxSuccess = 10000
+ hspec/TheatreDevSpec.hs view
@@ -0,0 +1,166 @@+{-# OPTIONS_GHC -Wno-unused-local-binds -Wno-unused-binds #-}++module TheatreDevSpec (spec) where++import Control.Concurrent.Async+import Data.IntMap.Strict qualified as IntMap+import Data.IntSet qualified as IntSet+import Test.Hspec+import Test.Hspec.QuickCheck+import Test.QuickCheck+import TheatreDev qualified as Actor+import TheatreDevSpec.IO qualified as IO+import TheatreDevSpec.Preferences qualified as Preferences+import Prelude++spec :: Spec+spec =+  do+    describe "kill" do+      describe "When full" do+        it "Does not block" pending+        it "Lets all messages scheduled before be processed" pending+        it "Makes all messages scheduled after be ignored" pending++    describe "wait" do+      describe "When full" do+        it "Blocks until all messages are processed" pending++    describe "spawnStatefulBatched" do+      let spawnIntUpdater step = Actor.spawnStatefulBatched @Int 0 (const (return ())) step+      let spawnUnit step = Actor.spawnStatefulBatched () (const (return ())) step++      it "Works in batches" do+        acc <- newIORef []+        actorLock <- newEmptyMVar+        emitterLock <- newEmptyMVar+        actor <- spawnUnit $ \_ messages ->+          do+            modifyIORef' acc (messages :)+            putMVar emitterLock ()+            takeMVar actorLock++        Actor.tell actor 1++        takeMVar emitterLock+        Actor.tell actor 2+        Actor.tell actor 3+        putMVar actorLock ()++        takeMVar emitterLock+        Actor.tell actor 4+        putMVar actorLock ()++        takeMVar emitterLock+        Actor.kill actor++        collectedBatches <- reverse . fmap toList <$> readIORef acc+        shouldBe collectedBatches [[1], [2, 3], [4]]++      it "Threads the state" do+        let input = [0 .. 9]+            inputLength = length input++        resultsVar <- newTVarIO []+        actor <- Actor.spawnStatefulBatched [] (const (return ())) $ \state msgs -> do+          let !newState = foldl' (flip (:)) state msgs+          atomically $ writeTVar resultsVar newState+          return newState+        traverse_ (Actor.tell actor) input++        results <- atomically $ do+          results <- readTVar resultsVar+          if length results < inputLength+            then retry+            else return results++        shouldBe (reverse results) input++      it "Kill and wait" do+        let input = [0 .. 9]+            inputLength = length input++        resultVar <- newEmptyMVar+        actor <-+          Actor.spawnStatefulBatched+            []+            ( \state -> do+                threadDelay 1000+                putMVar resultVar state+            )+            ( \state msgs -> return $ foldl' (flip (:)) state msgs+            )+        traverse_ (Actor.tell actor) input++        Actor.kill actor+        Actor.wait actor++        result <- takeMVar resultVar+        shouldBe result $ reverse input++    describe "allOf" . modifyMaxSuccess (max 1000) $ do+      it "Passes 1" do+        let emittersNum = 2+            messagesNum = 10+            actorsNum = 3+            messages = [0 .. messagesNum - 1]+        results <- fmap (fmap sort) (IO.simulateReduction actorsNum emittersNum Actor.allOf messages)+        shouldBe results (replicate actorsNum (sort (concat (replicate emittersNum messages))))+        shouldBe (getSum (foldMap (Sum . length) results)) (actorsNum * emittersNum * messagesNum)+      prop "" $ forAll (chooseInt (0, 99)) $ \size -> forAll arbitrary $ \(messages :: [Int]) ->+        idempotentIOProperty do+          results <- sort . concat <$> IO.simulateReduction Preferences.concurrency size Actor.allOf messages+          return+            $ conjoin+              [ length results === length messages * size * Preferences.concurrency,+                results === sort (concat (replicate (size * Preferences.concurrency) messages))+              ]++    describe "oneOf" . modifyMaxSuccess (max 1000) $ do+      prop "Dispatches correctly" $ forAll (chooseInt (0, 99)) $ \size -> forAll arbitrary $ \(messages :: [Int]) ->+        idempotentIOProperty do+          results <- sort . concat <$> IO.simulateReduction Preferences.concurrency size Actor.oneOf messages+          return+            $ conjoin+              [ length results === length messages * size,+                results+                  === sort (concat (replicate (size) messages))+              ]++    describe "byKeyHash" . modifyMaxSuccess (max Preferences.largePropertyMaxSuccess) $ do+      prop "Dispatches individually" $ forAll (chooseInt (0, 99)) $ \size -> forAll arbitrary $ \(messages :: [Int]) -> idempotentIOProperty $ do+        resultsVar <- newTVarIO []+        actor <-+          fmap (Actor.byKeyHash id)+            $ replicateM size+            $ Actor.spawnStatefulIndividual+              IntMap.empty+              ( \state ->+                  atomically+                    $ modifyTVar' resultsVar+                    $ (:) state+              )+              ( \state msg ->+                  return $ IntMap.alter (Just . maybe 1 succ) msg state+              )++        mapConcurrently id+          $ replicate Preferences.concurrency+          $ for_ messages+          $ Actor.tell actor++        Actor.kill actor+        Actor.wait actor++        results <- readTVarIO resultsVar++        let allKeys = results >>= IntMap.keys+            nubbedKeys = nub allKeys++        return+          $ conjoin+            [ allKeys === nubbedKeys,+              if size == 0+                then nubbedKeys === []+                else IntSet.fromList nubbedKeys === IntSet.fromList messages+            ]
+ hspec/TheatreDevSpec/IO.hs view
@@ -0,0 +1,34 @@+module TheatreDevSpec.IO where++import Control.Concurrent.Async+import TheatreDev (Actor)+import TheatreDev qualified as Actor+import Prelude++simulateReduction :: Int -> Int -> ([Actor a] -> Actor a) -> [a] -> IO [[a]]+simulateReduction actorsNum generatorsNum reducer messages =+  do+    resultsVar <- newTVarIO []++    actor <-+      fmap reducer+        $ replicateM actorsNum+        $ Actor.spawnStatefulIndividual+          []+          ( \state ->+              atomically+                $ modifyTVar' resultsVar (reverse state :)+          )+          ( \state msg ->+              return $ msg : state+          )++    mapConcurrently id+      $ replicate generatorsNum+      $ for_ messages+      $ Actor.tell actor++    Actor.kill actor+    Actor.wait actor++    readTVarIO resultsVar
+ hspec/TheatreDevSpec/Preferences.hs view
@@ -0,0 +1,9 @@+module TheatreDevSpec.Preferences where++import Prelude++concurrency :: Int+concurrency = 7++largePropertyMaxSuccess :: Int+largePropertyMaxSuccess = 10000
+ library/TheatreDev.hs view
@@ -0,0 +1,234 @@+module TheatreDev+  ( Actor,++    -- * Acquisition+    spawnStatefulIndividual,+    spawnStatefulBatched,+    spawnStatelessIndividual,+    spawnStatelessBatched,++    -- * Control+    tell,+    kill,+    wait,++    -- * Composition+    oneOf,+    allOf,+    byKeyHash,+  )+where++import TheatreDev.Prelude+import TheatreDev.StmStructures.Runner (Runner)+import TheatreDev.StmStructures.Runner qualified as Runner+import TheatreDev.Tell (Tell)+import TheatreDev.Tell qualified as Tell+import TheatreDev.Wait qualified as Wait++-- |+-- Controls of an actor, which processes the messages of type @message@.+-- The processing runs on a dedicated green thread.+--+-- Provides abstraction over the message channel, thread-forking and killing.+--+-- Monoid instance is not provided for the same reason it is not provided for numbers.+-- This type supports both sum and product composition. See 'allOf' and 'oneOf'.+data Actor message = Actor+  { -- | Send a message to the actor.+    tell :: message -> STM (),+    -- | Kill the actor.+    kill :: STM (),+    -- | Wait for the actor to die due to error or being killed.+    wait :: STM (Maybe SomeException),+    -- | IDs of the constituent actors.+    -- Useful for debugging.+    ids :: [UUID]+  }++instance Contravariant Actor where+  contramap fn (Actor tell kill wait ids) =+    Actor (tell . fn) kill wait ids++instance Divisible Actor where+  conquer =+    Actor (const (return ())) (return ()) (return Nothing) []+  divide divisor (Actor lTell lKill lWait lIds) (Actor rTell rKill rWait rIds) =+    Actor+      { tell = \msg -> case divisor msg of (lMsg, rMsg) -> lTell lMsg >> rTell rMsg,+        kill = lKill >> rKill,+        wait = Wait.both lWait rWait,+        ids = lIds <> rIds+      }++instance Decidable Actor where+  lose fn =+    Actor (const (return ()) . absurd . fn) (return ()) (return Nothing) []+  choose choice (Actor lTell lKill lWait lIds) (Actor rTell rKill rWait rIds) =+    Actor+      { tell = either lTell rTell . choice,+        kill = lKill >> rKill,+        wait = Wait.both lWait rWait,+        ids = lIds <> rIds+      }++-- * Composition++fromRunner :: Runner a -> Actor a+fromRunner runner =+  Actor+    { tell = Runner.tell runner,+      kill = Runner.kill runner,+      wait = Runner.wait runner,+      ids = [Runner.getId runner]+    }++-- | Distribute the message stream across actors.+-- The message gets delivered to the first available one.+--+-- E.g., using this combinator in combination with 'replicateM'+-- you can construct pools:+--+-- > spawnPool :: Int -> IO (Actor message) -> IO (Actor message)+-- > spawnPool size spawn =+-- >   oneOf <$> replicateM size spawn+--+-- You can consider this being an interface to the Sum monoid.+oneOf :: [Actor message] -> Actor message+oneOf = tellComposition Tell.one++-- | Distribute the message stream to all provided actors.+--+-- You can consider this being an interface to the Product monoid.+allOf :: [Actor message] -> Actor message+allOf = tellComposition Tell.all++-- |+-- Dispatch the message across actors based on a key hash.+--+-- This lets you ensure of a property that messages with+-- the same key will arrive to the same actor,+-- letting you maintain a local associated state in the actors.+--+-- The implementation applies a modulo equal to the amount+-- of actors to the hash and thus determines the index+-- of the actor to dispatch the message to.+-- This is inspired by how partitioning is done in Kafka.+byKeyHash ::+  -- | Function extracting the key from the message and hashing it.+  (message -> Int) ->+  -- | Pool of actors.+  [Actor message] ->+  Actor message+byKeyHash = tellComposition . Tell.byKeyHash++tellComposition :: ([Tell message] -> Tell message) -> [Actor message] -> Actor message+tellComposition tellReducer actors =+  Actor+    { tell = tellReducer (fmap (.tell) actors),+      kill = traverse_ (.kill) actors,+      wait = Wait.all (fmap (.wait) actors),+      ids = foldMap (.ids) actors+    }++-- * Acquisition++-- | Spawn an actor which processes messages in isolated executions.+spawnStatelessIndividual ::+  -- | Clean up when killed or exception is thrown.+  IO () ->+  -- | Interpret a message.+  (message -> IO ()) ->+  -- | Fork a thread to run the handler loop on and produce a handle to control it.+  IO (Actor message)+spawnStatelessIndividual cleaner interpreter =+  -- TODO: Optimize by reimplementing directly.+  spawnStatefulIndividual () (const cleaner) (const interpreter)++-- | Spawn an actor which processes all available messages in one execution.+spawnStatelessBatched ::+  -- | Clean up when killed or exception is thrown.+  IO () ->+  -- | Interpret a batch of messages.+  (NonEmpty message -> IO ()) ->+  -- | Fork a thread to run the handler loop on and produce a handle to control it.+  IO (Actor message)+spawnStatelessBatched cleaner interpreter =+  -- TODO: Optimize by reimplementing directly.+  spawnStatefulBatched () (const cleaner) (const interpreter)++-- | Spawn an actor which processes messages in isolated executions+-- and threads state.+spawnStatefulIndividual ::+  -- | Initial state.+  state ->+  -- | Clean up when killed or exception is thrown.+  (state -> IO ()) ->+  -- | Process a message and update state.+  (state -> message -> IO state) ->+  -- | Fork a thread to run the handler loop on and produce a handle to control it.+  IO (Actor message)+spawnStatefulIndividual zero finalizer step =+  spawnStatefulBatched zero finalizer $ foldM step++-- | Spawn an actor which processes all available messages in one execution+-- and threads state.+spawnStatefulBatched ::+  -- | Initial state.+  state ->+  -- | Clean up when killed or exception is thrown.+  (state -> IO ()) ->+  -- | Process a batch of messages and update state.+  (state -> NonEmpty message -> IO state) ->+  -- | Fork a thread to run the handler loop on and produce a handle to control it.+  IO (Actor message)+spawnStatefulBatched zero finalizer step =+  do+    runner <- Runner.start+    forkIOWithUnmask $ \unmask ->+      let loop !state =+            do+              messages <- atomically $ Runner.receiveMultiple runner+              case messages of+                Just nonEmptyMessages ->+                  do+                    result <- try $ unmask $ step state nonEmptyMessages+                    case result of+                      Right newState ->+                        loop newState+                      Left exception ->+                        finally (finalizer state)+                          $ atomically+                          $ Runner.releaseWithException runner exception+                -- Empty batch means that the runner is finished.+                Nothing ->+                  finally (finalizer state)+                    $ atomically+                    $ Runner.releaseNormally runner+       in loop zero+    return $ fromRunner runner++-- * Control++-- | Add a message to the end of the queue of the+-- messages to be processed by the provided actor.+tell :: Actor message -> message -> IO ()+tell actor =+  atomically . actor.tell++-- | Command the actor to stop registering new messages,+-- process all the registered ones and execute the clean up action.+--+-- This action executes immediately.+-- If you want to block waiting for the actor to actually die,+-- after 'kill' you can run 'wait'.+kill :: Actor message -> IO ()+kill actor =+  atomically actor.kill++-- | Block waiting for the actor to die either due to getting killed+-- or due to its interpreter action throwing an exception.+-- The exception will get rethrown here.+wait :: Actor message -> IO ()+wait actor =+  atomically actor.wait >>= maybe (pure ()) throwIO
library/TheatreDev/ExtrasFor/TBQueue.hs view
@@ -6,20 +6,20 @@ flushNonEmptyTBQueue :: TBQueue a -> STM (NonEmpty a) flushNonEmptyTBQueue x = do   head <- readTBQueue x-  tail <- simplerFlushTBQueue x+  tail <- correctFlushTBQueue x   return (head :| tail)  -- | Get a list of all entries in the queue without removing them. inspectTBQueue :: TBQueue a -> STM [a] inspectTBQueue queue = do-  list <- simplerFlushTBQueue queue+  list <- correctFlushTBQueue queue   forM_ list $ writeTBQueue queue   return list  -- | Starting from \"stm\" 2.5.2.0 "flushTBQueue" is broken. -- We're fixing it here.-simplerFlushTBQueue :: TBQueue a -> STM [a]-simplerFlushTBQueue queue =+correctFlushTBQueue :: TBQueue a -> STM [a]+correctFlushTBQueue queue =   go []   where     go !acc = do
− library/TheatreDev/Perpetual.hs 
@@ -1,108 +0,0 @@--- |--- Exploration of perpetual actors.--- I.e., those that exist for the whole duration of the app.------ This limitation provides for simpler API and most apps--- are expected not to need more.-module TheatreDev.Perpetual-  ( Actor,-    spawnStateless,-    spawnStateful,-    tell,-  )-where--import Control.Concurrent.Chan.Unagi qualified as Unagi-import TheatreDev.Prelude---- |--- Actor, which processes the messages of type @msg@.------ Provides abstraction over the communication channel and threads.-newtype Actor msg-  = Actor (msg -> IO ())---- |--- Distributes the message across the merged actors.-instance Semigroup (Actor msg) where-  Actor lTell <> Actor rTell =-    Actor $ \msg -> lTell msg >> rTell msg-  sconcat actors = Actor $ \msg -> forM_ actors $ \(Actor tell) -> tell msg-  stimes n (Actor tell) = Actor $ \msg -> replicateM_ (fromIntegral n) $ tell msg---- |--- Provides an identity for merging the actors,--- which does nothing.-instance Monoid (Actor msg) where-  mempty = Actor (const (return ()))-  mconcat actors = Actor $ \msg -> forM_ actors $ \(Actor tell) -> tell msg---- |--- Maps the input message to a different type.-instance Contravariant Actor where-  contramap fn (Actor tell) =-    Actor (tell . fn)---- |--- Splits the message between actors.-instance Divisible Actor where-  conquer =-    mempty-  divide divisor (Actor lTell) (Actor rTell) =-    Actor $ \msg -> case divisor msg of-      (lMsg, rMsg) -> lTell lMsg >> rTell rMsg---- |--- Provides a choice between alternative actors to process the message.-instance Decidable Actor where-  lose _ =-    Actor $ const $ return ()-  choose decider (Actor lTell) (Actor rTell) =-    Actor $ either lTell rTell . decider--spawnStateless ::-  -- |-  -- Process the next message.-  -- Must not throw any exceptions.-  (msg -> IO ()) ->-  -- |-  -- Action forking a thread to run the actor loop and-  -- producing a handle for sending messages to it.-  IO (Actor msg)-spawnStateless process = do-  (inChan, outChan) <- Unagi.newChan-  forkIO-    $ let loop = do-            msg <- Unagi.readChan outChan-            process msg-            loop-       in loop-  return $ Actor $ Unagi.writeChan inChan--spawnStateful ::-  -- |-  -- Initial state.-  state ->-  -- |-  -- Process the next message updating the state.-  -- The IO action must not throw any exceptions.-  (state -> msg -> IO state) ->-  -- |-  -- Action forking a thread to run the actor loop and-  -- producing a handle for sending messages to it.-  IO (Actor msg)-spawnStateful state process = do-  (inChan, outChan) <- Unagi.newChan-  forkIO-    $ let loop !state = do-            msg <- Unagi.readChan outChan-            state <- process state msg-            loop state-       in loop state-  return $ Actor $ Unagi.writeChan inChan---- |--- Schedule a message for the actor to process--- after the ones already scheduled.-tell :: Actor msg -> msg -> IO ()-tell = coerce
library/TheatreDev/Prelude.hs view
@@ -7,7 +7,6 @@ import Control.Arrow as Exports hiding (first, second) import Control.Category as Exports import Control.Concurrent as Exports-import Control.Concurrent.Async as Exports (Concurrently (..)) import Control.Concurrent.STM as Exports import Control.Exception as Exports import Control.Monad as Exports hiding (fail, forM, forM_, mapM, mapM_, msum, sequence, sequence_)
− library/TheatreDev/StmBased.hs 
@@ -1,237 +0,0 @@-{-# LANGUAGE OverloadedRecordDot #-}-{-# LANGUAGE NoFieldSelectors #-}--module TheatreDev.StmBased-  ( Actor,--    -- * Acquisition-    spawnStatefulIndividual,-    spawnStatefulBatched,-    spawnStatelessIndividual,-    spawnStatelessBatched,--    -- * Control-    tell,-    kill,-    wait,--    -- * Composition-    oneOf,-    allOf,-    byKeyHash,-  )-where--import TheatreDev.Prelude-import TheatreDev.StmBased.StmStructures.Runner (Runner)-import TheatreDev.StmBased.StmStructures.Runner qualified as Runner-import TheatreDev.StmBased.Tell (Tell)-import TheatreDev.StmBased.Tell qualified as Tell-import TheatreDev.StmBased.Wait qualified as Wait---- |--- Controls of an actor, which processes the messages of type @message@.--- The processing runs on a dedicated green thread.------ Provides abstraction over the message channel, thread-forking and killing.------ Monoid instance is not provided for the same reason it is not provided for numbers.--- This type supports both sum and product composition. See 'allOf' and 'oneOf'.-data Actor message = Actor-  { -- | Send a message to the actor.-    tell :: message -> STM (),-    -- | Kill the actor.-    kill :: STM (),-    -- | Wait for the actor to die due to error or being killed.-    wait :: STM (Maybe SomeException),-    -- | IDs of the constituent actors.-    -- Useful for debugging.-    ids :: [UUID]-  }--instance Contravariant Actor where-  contramap fn (Actor tell kill wait ids) =-    Actor (tell . fn) kill wait ids--instance Divisible Actor where-  conquer =-    Actor (const (return ())) (return ()) (return Nothing) []-  divide divisor (Actor lTell lKill lWait lIds) (Actor rTell rKill rWait rIds) =-    Actor-      { tell = \msg -> case divisor msg of (lMsg, rMsg) -> lTell lMsg >> rTell rMsg,-        kill = lKill >> rKill,-        wait = Wait.both lWait rWait,-        ids = lIds <> rIds-      }--instance Decidable Actor where-  lose fn =-    Actor (const (return ()) . absurd . fn) (return ()) (return Nothing) []-  choose choice (Actor lTell lKill lWait lIds) (Actor rTell rKill rWait rIds) =-    Actor-      { tell = either lTell rTell . choice,-        kill = lKill >> rKill,-        wait = Wait.both lWait rWait,-        ids = lIds <> rIds-      }---- * Composition--fromRunner :: Runner a -> Actor a-fromRunner runner =-  Actor-    { tell = Runner.tell runner,-      kill = Runner.kill runner,-      wait = Runner.wait runner,-      ids = [Runner.getId runner]-    }---- | Distribute the message stream across actors.--- The message gets delivered to the first available one.------ E.g., using this combinator in combination with 'replicateM'--- you can construct pools:------ > spawnPool :: Int -> IO (Actor message) -> IO (Actor message)--- > spawnPool size spawn =--- >   oneOf <$> replicateM size spawn------ You can consider this being an interface to the Sum monoid.-oneOf :: [Actor message] -> Actor message-oneOf = tellComposition Tell.one---- | Distribute the message stream to all provided actors.------ You can consider this being an interface to the Product monoid.-allOf :: [Actor message] -> Actor message-allOf = tellComposition Tell.all---- |--- Dispatch the message across actors based on a key hash.------ This lets you ensure of a property that messages with--- the same key will arrive to the same actor,--- letting you maintain a local associated state in the actors.------ The implementation applies a modulo equal to the amount--- of actors to the hash and thus determines the index--- of the actor to dispatch the message to.--- This is inspired by how partitioning is done in Kafka.-byKeyHash ::-  -- | Function extracting the key from the message and hashing it.-  (message -> Int) ->-  -- | Pool of actors.-  [Actor message] ->-  Actor message-byKeyHash = tellComposition . Tell.byKeyHash--tellComposition :: ([Tell message] -> Tell message) -> [Actor message] -> Actor message-tellComposition tellReducer actors =-  Actor-    { tell = tellReducer (fmap (.tell) actors),-      kill = traverse_ (.kill) actors,-      wait = Wait.all (fmap (.wait) actors),-      ids = foldMap (.ids) actors-    }---- * Acquisition---- | Spawn an actor which processes messages in isolated executions.-spawnStatelessIndividual ::-  -- | Clean up when killed or exception is thrown.-  IO () ->-  -- | Interpret a message.-  (message -> IO ()) ->-  -- | Fork a thread to run the handler loop on and produce a handle to control it.-  IO (Actor message)-spawnStatelessIndividual cleaner interpreter =-  -- TODO: Optimize by reimplementing directly.-  spawnStatefulIndividual () (const cleaner) (const interpreter)---- | Spawn an actor which processes all available messages in one execution.-spawnStatelessBatched ::-  -- | Clean up when killed or exception is thrown.-  IO () ->-  -- | Interpret a batch of messages.-  (NonEmpty message -> IO ()) ->-  -- | Fork a thread to run the handler loop on and produce a handle to control it.-  IO (Actor message)-spawnStatelessBatched cleaner interpreter =-  -- TODO: Optimize by reimplementing directly.-  spawnStatefulBatched () (const cleaner) (const interpreter)---- | Spawn an actor which processes messages in isolated executions--- and threads state.-spawnStatefulIndividual ::-  -- | Initial state.-  state ->-  -- | Clean up when killed or exception is thrown.-  (state -> IO ()) ->-  -- | Process a message and update state.-  (state -> message -> IO state) ->-  -- | Fork a thread to run the handler loop on and produce a handle to control it.-  IO (Actor message)-spawnStatefulIndividual zero finalizer step =-  spawnStatefulBatched zero finalizer $ foldM step---- | Spawn an actor which processes all available messages in one execution--- and threads state.-spawnStatefulBatched ::-  -- | Initial state.-  state ->-  -- | Clean up when killed or exception is thrown.-  (state -> IO ()) ->-  -- | Process a batch of messages and update state.-  (state -> NonEmpty message -> IO state) ->-  -- | Fork a thread to run the handler loop on and produce a handle to control it.-  IO (Actor message)-spawnStatefulBatched zero finalizer step =-  do-    runner <- Runner.start-    forkIOWithUnmask $ \unmask ->-      let loop !state =-            do-              messages <- atomically $ Runner.receiveMultiple runner-              case messages of-                Just nonEmptyMessages ->-                  do-                    result <- try $ unmask $ step state nonEmptyMessages-                    case result of-                      Right newState ->-                        loop newState-                      Left exception ->-                        finally (finalizer state)-                          $ atomically-                          $ Runner.releaseWithException runner exception-                -- Empty batch means that the runner is finished.-                Nothing ->-                  finally (finalizer state)-                    $ atomically-                    $ Runner.releaseNormally runner-       in loop zero-    return $ fromRunner runner---- * Control---- | Add a message to the end of the queue of the--- messages to be processed by the provided actor.-tell :: Actor message -> message -> IO ()-tell actor =-  atomically . actor.tell---- | Command the actor to stop registering new messages,--- process all the registered ones and execute the clean up action.------ This action executes immediately.--- If you want to block waiting for the actor to actually die,--- after 'kill' you can run 'wait'.-kill :: Actor message -> IO ()-kill actor =-  atomically actor.kill---- | Block waiting for the actor to die either due to getting killed--- or due to its interpreter action throwing an exception.--- The exception will get rethrown here.-wait :: Actor message -> IO ()-wait actor =-  atomically actor.wait >>= maybe (pure ()) throwIO
− library/TheatreDev/StmBased/StmStructures/Runner.hs 
@@ -1,99 +0,0 @@-{-# LANGUAGE OverloadedRecordDot #-}-{-# LANGUAGE NoFieldSelectors #-}--module TheatreDev.StmBased.StmStructures.Runner-  ( Runner,-    start,-    tell,-    kill,-    wait,-    receiveSingle,-    receiveMultiple,-    releaseWithException,-    releaseNormally,--    -- * Inspection-    getId,-  )-where--import Control.Concurrent.STM.TBQueue-import Control.Concurrent.STM.TMVar-import Data.UUID.V4 qualified as UuidV4-import TheatreDev.ExtrasFor.List qualified as List-import TheatreDev.ExtrasFor.TBQueue-import TheatreDev.Prelude--data Runner a = Runner-  { queue :: TBQueue a,-    aliveVar :: TVar Bool,-    resVar :: TMVar (Maybe SomeException),-    id :: UUID-  }--getId :: Runner a -> UUID-getId = (.id)--start :: IO (Runner a)-start =-  do-    queue <- newTBQueueIO 1000-    aliveVar <- newTVarIO True-    resVar <- newEmptyTMVarIO-    id <- UuidV4.nextRandom-    return Runner {..}--tell :: Runner a -> a -> STM ()-tell Runner {..} message =-  do-    alive <- readTVar aliveVar-    when alive do-      writeTBQueue queue message--kill :: Runner a -> STM ()-kill Runner {..} =-  writeTVar aliveVar False--wait :: Runner a -> STM (Maybe SomeException)-wait Runner {..} = do-  isAlive <- readTVar aliveVar-  when isAlive retry-  queueIsEmpty <- isEmptyTBQueue queue-  unless queueIsEmpty retry-  readTMVar resVar--receiveSingle ::-  Runner a ->-  -- | Action producing a message or nothing, after it's killed.-  STM (Maybe a)-receiveSingle Runner {..} =-  do-    alive <- readTVar aliveVar-    if alive-      then Just <$> readTBQueue queue-      else return Nothing--receiveMultiple ::-  Runner a ->-  STM (Maybe (NonEmpty a))-receiveMultiple Runner {..} =-  do-    messages <- simplerFlushTBQueue queue-    case messages of-      [] -> do-        alive <- readTVar aliveVar-        if alive-          then retry-          else return Nothing-      messagesHead : messagesTail ->-        return $ Just $ messagesHead :| messagesTail--releaseWithException :: Runner a -> SomeException -> STM ()-releaseWithException Runner {..} exception =-  do-    simplerFlushTBQueue queue-    putTMVar resVar (Just exception)--releaseNormally :: Runner a -> STM ()-releaseNormally Runner {..} =-  putTMVar resVar Nothing <|> pure ()
− library/TheatreDev/StmBased/Tell.hs 
@@ -1,33 +0,0 @@-module TheatreDev.StmBased.Tell where--import Data.Vector qualified as Vector-import TheatreDev.Prelude--type Tell a = a -> STM ()--either :: Tell a -> Tell a -> Tell a-either lTell rTell msg =-  lTell msg <|> rTell msg--both :: Tell a -> Tell a -> Tell a-both lTell rTell msg =-  lTell msg >> rTell msg--one :: [Tell a] -> Tell a-one tells msg =-  asum $ fmap (\tell -> tell msg) tells--all :: [Tell a] -> Tell a-all tells msg =-  traverse_ (\tell -> tell msg) tells--byKeyHash :: (a -> Int) -> [Tell a] -> Tell a-byKeyHash proj tells =-  let vector = Vector.fromList tells-      vectorLength = Vector.length vector-   in case vectorLength of-        0 -> const (pure ())-        _ -> \msg ->-          let index = mod (proj msg) vectorLength-              tellAtIndex = Vector.unsafeIndex vector index-           in tellAtIndex msg
− library/TheatreDev/StmBased/Wait.hs 
@@ -1,13 +0,0 @@-module TheatreDev.StmBased.Wait where--import TheatreDev.Prelude--type Wait = STM (Maybe SomeException)--both :: Wait -> Wait -> Wait-both left right =-  liftA2 (<|>) left right--all :: [Wait] -> Wait-all waits =-  asum <$> sequence waits
+ library/TheatreDev/StmStructures/Runner.hs view
@@ -0,0 +1,98 @@+module TheatreDev.StmStructures.Runner+  ( Runner,+    start,+    tell,+    kill,+    wait,+    receiveSingle,+    receiveMultiple,+    releaseWithException,+    releaseNormally,++    -- * Inspection+    getId,+  )+where++import Control.Concurrent.STM.TBQueue+import Control.Concurrent.STM.TMVar+import Data.UUID.V4 qualified as UuidV4+import TheatreDev.ExtrasFor.TBQueue+import TheatreDev.Prelude++data Runner a = Runner+  { queue :: TBQueue a,+    receivesVar :: TVar Bool,+    resVar :: TMVar (Maybe SomeException),+    id :: UUID+  }++getId :: Runner a -> UUID+getId = (.id)++start :: IO (Runner a)+start =+  do+    queue <- newTBQueueIO 1000+    receivesVar <- newTVarIO True+    resVar <- newEmptyTMVarIO+    id <- UuidV4.nextRandom+    return Runner {..}++tell :: Runner a -> a -> STM ()+tell Runner {..} message =+  do+    receives <- readTVar receivesVar+    when receives do+      writeTBQueue queue message++kill :: Runner a -> STM ()+kill Runner {..} =+  writeTVar receivesVar False++wait :: Runner a -> STM (Maybe SomeException)+wait Runner {..} = do+  readTMVar resVar++receiveSingle ::+  Runner a ->+  -- | Action producing a message or nothing, after it's killed.+  STM (Maybe a)+receiveSingle Runner {..} =+  do+    readResult <- tryReadTBQueue queue+    case readResult of+      Nothing -> do+        receives <- readTVar receivesVar+        if receives+          then retry+          else return Nothing+      Just message ->+        return (Just message)++receiveMultiple ::+  Runner a ->+  STM (Maybe (NonEmpty a))+receiveMultiple Runner {..} =+  do+    messages <- correctFlushTBQueue queue+    case messages of+      [] -> do+        receives <- readTVar receivesVar+        if receives+          then retry+          else return Nothing+      messagesHead : messagesTail ->+        return $ Just $ messagesHead :| messagesTail++releaseWithException :: Runner a -> SomeException -> STM ()+releaseWithException Runner {..} exception =+  do+    correctFlushTBQueue queue+    writeTVar receivesVar False+    putTMVar resVar (Just exception)++releaseNormally :: Runner a -> STM ()+releaseNormally Runner {..} = do+  writeTVar receivesVar False+  putTMVar resVar Nothing <|> pure ()
+ library/TheatreDev/Tell.hs view
@@ -0,0 +1,33 @@+module TheatreDev.Tell where++import Data.Vector qualified as Vector+import TheatreDev.Prelude++type Tell a = a -> STM ()++either :: Tell a -> Tell a -> Tell a+either lTell rTell msg =+  lTell msg <|> rTell msg++both :: Tell a -> Tell a -> Tell a+both lTell rTell msg =+  lTell msg >> rTell msg++one :: [Tell a] -> Tell a+one tells msg =+  asum $ fmap (\tell -> tell msg) tells++all :: [Tell a] -> Tell a+all tells msg =+  traverse_ (\tell -> tell msg) tells++byKeyHash :: (a -> Int) -> [Tell a] -> Tell a+byKeyHash proj tells =+  let vector = Vector.fromList tells+      vectorLength = Vector.length vector+   in case vectorLength of+        0 -> const (pure ())+        _ -> \msg ->+          let index = mod (proj msg) vectorLength+              tellAtIndex = Vector.unsafeIndex vector index+           in tellAtIndex msg
− library/TheatreDev/Terminal/Actor.hs 
@@ -1,200 +0,0 @@-module TheatreDev.Terminal.Actor-  ( Actor,--    -- * Manipulation-    adaptToList,--    -- * Acquisition-    spawnStatelessGranular,-    spawnStatefulGranular,-    spawnStatefulBatched,--    -- * Control-    tell,-    kill,-    wait,-  )-where--import Control.Concurrent.Chan.Unagi qualified as E-import Control.Concurrent.STM.TBQueue-import Control.Concurrent.STM.TMVar-import TheatreDev.ExtrasFor.List qualified as List-import TheatreDev.ExtrasFor.TBQueue-import TheatreDev.Prelude---- |--- Controls of an actor, which processes the messages of type @message@.------ Abstraction over the message channel, thread-forking and killing.-data Actor message = Actor-  { -- | Send a message to the actor.-    tell :: message -> IO (),-    -- | Kill the actor.-    kill :: IO (),-    -- | Wait for the actor to die due to error or being killed.-    wait :: IO ()-  }--instance Semigroup (Actor message) where-  (<>) (Actor lTell lKill lWait) (Actor rTell rKill rWait) =-    Actor tell kill wait-    where-      tell msg = lTell msg >> rTell msg-      kill = lKill >> rKill-      wait = lWait >> rWait--instance Monoid (Actor message) where-  mempty =-    Actor (const (return ())) (return ()) (return ())--instance Contravariant Actor where-  contramap fn (Actor tell kill wait) =-    Actor (tell . fn) kill wait--instance Divisible Actor where-  conquer =-    mempty-  divide divisor (Actor lTell lKill lWait) (Actor rTell rKill rWait) =-    Actor tell kill wait-    where-      tell msg = case divisor msg of (lMsg, rMsg) -> lTell lMsg >> rTell rMsg-      kill = lKill >> rKill-      wait = lWait >> rWait--instance Decidable Actor where-  lose fn =-    Actor (const (return ()) . absurd . fn) (return ()) (return ())-  choose choice (Actor lTell lKill lWait) (Actor rTell rKill rWait) =-    Actor tell kill wait-    where-      tell = either lTell rTell . choice-      kill = lKill >> rKill-      wait = lWait >> rWait---- |--- Adapt the actor to be able to receive lists of messages.-adaptToList :: Actor message -> Actor [message]-adaptToList Actor {..} =-  case traverse_ tell of-    tell -> Actor {..}---- |--- Given an interpreter of messages,--- fork a thread to run the handler daemon on and--- produce a handle to control that actor.------ Killing that actor will make it process all the messages in the queue first.--- All the messages sent to it after killing won't be processed.-spawnStatelessGranular ::-  -- | Interpreter of a message.-  (message -> IO ()) ->-  -- | Clean up when killed.-  IO () ->-  -- | Fork a thread to run the handler daemon on and-  -- produce a handle to control it.-  IO (Actor message)-spawnStatelessGranular interpretMessage cleanUp =-  do-    (inChan, outChan) <- E.newChan-    lock <- newEmptyMVar-    spawningThreadId <- myThreadId-    forkIO-      $ let loop =-              {-# SCC "spawnStatelessGranular/loop" #-}-              do-                message <- E.readChan outChan-                case message of-                  Just payload ->-                    do-                      res <- try @SomeException $ interpretMessage payload-                      case res of-                        Right () -> loop-                        Left exc ->-                          do-                            cleanUp-                            putMVar lock ()-                            throwTo spawningThreadId exc-                  Nothing ->-                    do-                      cleanUp-                      putMVar lock ()-         in loop-    return-      ( Actor-          (E.writeChan inChan . Just)-          (E.writeChan inChan Nothing)-          (takeMVar lock)-      )---- |--- Actor with memory.------ Threads a persistent state thru its iterations.------ Given an interpreter of messages and initial state generator,--- forks a thread to run the computation on and--- produces a handle to address that actor.------ Killing that actor will make it process all the messages in the queue first.--- All the messages sent to it after killing won't be processed.-spawnStatefulGranular :: state -> (state -> message -> IO state) -> (state -> IO ()) -> IO (Actor message)-spawnStatefulGranular zero step finalizer =-  spawnStatefulBatched zero newStep finalizer-  where-    newStep =-      foldM step--spawnStatefulBatched :: state -> (state -> NonEmpty message -> IO state) -> (state -> IO ()) -> IO (Actor message)-spawnStatefulBatched zero step finalizer =-  do-    queue <- newTBQueueIO 1000-    aliveVar <- newTVarIO True-    resVar <- newEmptyTMVarIO @(Maybe SomeException)-    forkIOWithUnmask $ \unmask ->-      let loop !state =-            join $ atomically $ do-              flushing <- flushNonEmptyTBQueue queue-              let (messages, flushingTail) = List.splitWhileJust (toList flushing)-              case messages of-                -- Automatically means that the tail is not empty.-                [] -> do-                  writeTVar aliveVar False-                  putTMVar resVar Nothing-                  return $ do-                    finalizer state-                messagesHead : messagesTail ->-                  return $ do-                    result <- try @SomeException $ unmask $ step state (messagesHead :| messagesTail)-                    case result of-                      Right newState ->-                        case flushingTail of-                          [] -> loop newState-                          _ -> do-                            atomically $ do-                              writeTVar aliveVar False-                              putTMVar resVar Nothing-                            finalizer state-                      Left exception -> do-                        atomically $ do-                          writeTVar aliveVar False-                          putTMVar resVar Nothing-                        finalizer state-       in loop zero-    return-      Actor-        { tell = \message -> atomically $ do-            alive <- readTVar aliveVar-            when alive-              $ writeTBQueue queue-              $ Just message,-          kill = atomically $ do-            alive <- readTVar aliveVar-            when alive-              $ writeTBQueue queue Nothing,-          wait = do-            res <- atomically $ takeTMVar resVar-            case res of-              Nothing -> return ()-              Just exception -> throwIO exception-        }
− library/TheatreDev/Terminal/StatefulActorSpec.hs 
@@ -1,39 +0,0 @@-module TheatreDev.Terminal.StatefulActorSpec where--import TheatreDev.Prelude--data StatefulActorSpec message = forall state.-  StatefulActorSpec-  { enter :: Concurrently state,-    step :: state -> NonEmpty message -> Concurrently state,-    exit :: state -> Concurrently ()-  }--instance Semigroup (StatefulActorSpec message) where-  StatefulActorSpec leftEnter leftStep leftExit <> StatefulActorSpec rightEnter rightStep rightExit =-    StatefulActorSpec-      { enter =-          (,) <$> leftEnter <*> rightEnter,-        step = \(leftState, rightState) messages ->-          (,)-            <$> leftStep leftState messages-            <*> rightStep rightState messages,-        exit = \(leftState, rightState) ->-          leftExit leftState *> rightExit rightState-      }--instance Monoid (StatefulActorSpec message) where-  mempty =-    StatefulActorSpec-      { enter = pure (),-        step = const $ const $ pure (),-        exit = const $ pure ()-      }--individual :: IO state -> (state -> message -> IO state) -> (state -> IO ()) -> StatefulActorSpec message-individual enter step exit =-  StatefulActorSpec-    { enter = Concurrently enter,-      step = \state messages -> Concurrently (foldM step state messages),-      exit = \state -> Concurrently (exit state)-    }
+ library/TheatreDev/Wait.hs view
@@ -0,0 +1,13 @@+module TheatreDev.Wait where++import TheatreDev.Prelude++type Wait = STM (Maybe SomeException)++both :: Wait -> Wait -> Wait+both left right =+  liftA2 (<|>) left right++all :: [Wait] -> Wait+all waits =+  asum <$> sequence waits
theatre-dev.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name:          theatre-dev-version:       0.1.1.1+version:       0.2 category:      Concurrency, Actors synopsis:      Minimalistic actor library experiments description:@@ -8,7 +8,6 @@   Don\'t expect this lib to maintain a stable API.   Once clearly useful abstractions emerge, they'll be moved to the   \"theatre\" lib.-  The namespace "TheatreDev.*" implies the name of an experimental API.  stability:     experimental homepage:      https://github.com/nikita-volkov/theatre-dev@@ -26,6 +25,7 @@ common base   default-language:   Haskell2010   default-extensions:+    NoFieldSelectors     NoImplicitPrelude     NoMonomorphismRestriction     ApplicativeDo@@ -54,6 +54,7 @@     MultiWayIf     NamedFieldPuns     OverloadedRecordDot+    OverloadedRecordDot     OverloadedStrings     ParallelListComp     PatternGuards@@ -81,26 +82,19 @@ library   import:          base   hs-source-dirs:  library-  exposed-modules:-    TheatreDev.Perpetual-    TheatreDev.StmBased-    TheatreDev.Terminal.Actor-+  exposed-modules: TheatreDev   other-modules:     TheatreDev.ExtrasFor.List     TheatreDev.ExtrasFor.TBQueue     TheatreDev.Prelude-    TheatreDev.StmBased.StmStructures.Runner-    TheatreDev.StmBased.Tell-    TheatreDev.StmBased.Wait-    TheatreDev.Terminal.StatefulActorSpec+    TheatreDev.StmStructures.Runner+    TheatreDev.Tell+    TheatreDev.Wait    build-depends:-    , async >=2.2 && <3     , base >=4.16 && <5     , contravariant >=1.3 && <2     , stm >=2.5 && <2.5.2 || >=2.5.2.2 && <3-    , unagi-chan >=0.4.1.4 && <0.5     , uuid >=1.3.15 && <2     , vector >=0.13 && <0.14 @@ -110,9 +104,9 @@   hs-source-dirs: hspec   main-is:        Main.hs   other-modules:-    TheatreDev.StmBasedSpec-    TheatreDev.StmBasedSpec.IO-    TheatreDev.StmBasedSpec.Preferences+    TheatreDevSpec+    TheatreDevSpec.IO+    TheatreDevSpec.Preferences    build-depends:     , async