polysemy-conc 0.13.0.1 → 0.14.0.0

raw patch · 49 files changed

+248/−1446 lines, 49 filesdep −containersdep −unixdep ~asyncdep ~basedep ~hedgehogPVP ok

version bump matches the API change (PVP)

Dependencies removed: containers, unix

Dependency ranges changed: async, base, hedgehog, incipit-core, polysemy, polysemy-plugin, polysemy-resume, polysemy-test, polysemy-time, stm, stm-chans, tasty, tasty-hedgehog, time, unagi-chan

API changes (from Hackage documentation)

Files

• changelog.md +7/−0
• lib/Polysemy/Conc.hs +1/−81
• lib/Polysemy/Conc/Async.hs +9/−9
• lib/Polysemy/Conc/AtomicState.hs +2/−2
• lib/Polysemy/Conc/Data/QueueResult.hs +5/−5
• lib/Polysemy/Conc/Effect/Critical.hs +6/−6
• lib/Polysemy/Conc/Effect/Events.hs +6/−6
• lib/Polysemy/Conc/Effect/Gate.hs +4/−4
• lib/Polysemy/Conc/Effect/Interrupt.hs +0/−44
• lib/Polysemy/Conc/Effect/Lock.hs +8/−8
• lib/Polysemy/Conc/Effect/Mask.hs +8/−8
• lib/Polysemy/Conc/Effect/Monitor.hs +9/−9
• lib/Polysemy/Conc/Effect/Queue.hs +12/−12
• lib/Polysemy/Conc/Effect/Race.hs +6/−6
• lib/Polysemy/Conc/Effect/Scoped.hs +0/−155
• lib/Polysemy/Conc/Effect/Semaphore.hs +6/−6
• lib/Polysemy/Conc/Effect/Sync.hs +13/−13
• lib/Polysemy/Conc/Effect/SyncRead.hs +6/−6
• lib/Polysemy/Conc/Events.hs +17/−17
• lib/Polysemy/Conc/Gate.hs +1/−1
• lib/Polysemy/Conc/Interpreter/Critical.hs +3/−3
• lib/Polysemy/Conc/Interpreter/Events.hs +5/−5
• lib/Polysemy/Conc/Interpreter/Gate.hs +3/−3
• lib/Polysemy/Conc/Interpreter/Interrupt.hs +0/−244
• lib/Polysemy/Conc/Interpreter/Lock.hs +4/−4
• lib/Polysemy/Conc/Interpreter/Mask.hs +5/−5
• lib/Polysemy/Conc/Interpreter/Monitor.hs +3/−3
• lib/Polysemy/Conc/Interpreter/Queue/Pure.hs +5/−5
• lib/Polysemy/Conc/Interpreter/Queue/TB.hs +4/−4
• lib/Polysemy/Conc/Interpreter/Queue/TBM.hs +4/−4
• lib/Polysemy/Conc/Interpreter/Race.hs +2/−2
• lib/Polysemy/Conc/Interpreter/Scoped.hs +0/−640
• lib/Polysemy/Conc/Interpreter/Semaphore.hs +5/−5
• lib/Polysemy/Conc/Interpreter/Stack.hs +3/−3
• lib/Polysemy/Conc/Interpreter/Sync.hs +6/−6
• lib/Polysemy/Conc/Interpreter/SyncRead.hs +2/−2
• lib/Polysemy/Conc/Monitor.hs +4/−4
• lib/Polysemy/Conc/Queue.hs +5/−5
• lib/Polysemy/Conc/Queue/Result.hs +1/−1
• lib/Polysemy/Conc/Queue/Timeout.hs +2/−2
• lib/Polysemy/Conc/Race.hs +8/−8
• lib/Polysemy/Conc/Retry.hs +7/−7
• lib/Polysemy/Conc/Semaphore.hs +1/−1
• lib/Polysemy/Conc/Sync.hs +12/−12
• lib/Polysemy/Conc/SyncRead.hs +3/−3
• polysemy-conc.cabal +24/−31
• readme.md +1/−1
• test/Main.hs +0/−4
• test/Polysemy/Conc/Test/InterruptTest.hs +0/−31

@@ -1,3 +1,10 @@+# 0.14.0.0++## Breaking++* Move `Interrupt` to `polysemy-process` to avoid the dependency on `unix`.+* Remove deprecated `Scoped`.+ # 0.12.0.0  ## Breaking

@@ -1,4 +1,4 @@--- |Description: Polysemy Effects for Concurrency+-- | Description: Polysemy Effects for Concurrency module Polysemy.Conc (   -- * Introduction   -- $intro@@ -79,15 +79,6 @@   -- ** Interpreters   interpretRace, -  -- * Signal Handling-  -- $signal-  Interrupt,--  -- ** Interpreters-  interpretInterrupt,-  interpretInterruptOnce,-  interpretInterruptNull,-   -- * Event Channels   Events,   Consume,@@ -136,42 +127,6 @@   interpretMaskPure,   interpretUninterruptibleMaskPure, -  -- * Scoped Effects-  Scoped,-  Scoped_,-  scoped,-  scoped_,-  rescope,--  -- ** Interpreters-  interpretScoped,-  interpretScopedH,-  interpretScopedH',-  interpretScopedAs,-  interpretScopedWith,-  interpretScopedWithH,-  interpretScopedWith_,-  runScoped,-  runScopedAs,-  interpretScopedResumable,-  interpretScopedResumableH,-  interpretScopedResumable_,-  interpretScopedResumableWith,-  interpretScopedResumableWithH,-  interpretScopedResumableWith_,-  interpretResumableScoped,-  interpretResumableScopedH,-  interpretResumableScoped_,-  interpretResumableScopedWith,-  interpretResumableScopedWithH,-  interpretResumableScopedWith_,-  interpretScopedR,-  interpretScopedRH,-  interpretScopedR_,-  interpretScopedRWith,-  interpretScopedRWithH,-  interpretScopedRWith_,-   -- * Monitoring   Monitor,   monitor,@@ -232,13 +187,11 @@ import Polysemy.Conc.Effect.Critical (Critical) import Polysemy.Conc.Effect.Events (Consume, Events, consume, publish, subscribe) import Polysemy.Conc.Effect.Gate (Gate, Gates)-import Polysemy.Conc.Effect.Interrupt (Interrupt) import Polysemy.Conc.Effect.Lock (Lock, lock, lockOr, lockOrSkip, lockOrSkip_) import Polysemy.Conc.Effect.Mask (Mask, Restoration, UninterruptibleMask, mask, restore, uninterruptibleMask) import Polysemy.Conc.Effect.Monitor (Monitor, Restart, RestartingMonitor, ScopedMonitor, monitor, restart, withMonitor) import Polysemy.Conc.Effect.Queue (Queue) import Polysemy.Conc.Effect.Race (Race, race, timeout)-import Polysemy.Conc.Effect.Scoped (Scoped, Scoped_, rescope, scoped, scoped_) import Polysemy.Conc.Effect.Semaphore (Semaphore) import Polysemy.Conc.Effect.Sync (ScopedSync, Sync) import Polysemy.Conc.Effect.SyncRead (SyncRead)@@ -263,7 +216,6 @@ import Polysemy.Conc.Interpreter.Critical (interpretCritical, interpretCriticalNull) import Polysemy.Conc.Interpreter.Events (EventConsumer, interpretEventsChan) import Polysemy.Conc.Interpreter.Gate (interpretGate, interpretGates)-import Polysemy.Conc.Interpreter.Interrupt (interpretInterrupt, interpretInterruptNull, interpretInterruptOnce) import Polysemy.Conc.Interpreter.Lock (interpretLockPermissive, interpretLockReentrant) import Polysemy.Conc.Interpreter.Mask (   interpretMaskFinal,@@ -281,35 +233,6 @@ import Polysemy.Conc.Interpreter.Queue.TB (interpretQueueTB) import Polysemy.Conc.Interpreter.Queue.TBM (interpretQueueTBM) import Polysemy.Conc.Interpreter.Race (interpretRace)-import Polysemy.Conc.Interpreter.Scoped (-  interpretResumableScoped,-  interpretResumableScopedH,-  interpretResumableScopedWith,-  interpretResumableScopedWithH,-  interpretResumableScopedWith_,-  interpretResumableScoped_,-  interpretScoped,-  interpretScopedAs,-  interpretScopedH,-  interpretScopedH',-  interpretScopedR,-  interpretScopedRH,-  interpretScopedRWith,-  interpretScopedRWithH,-  interpretScopedRWith_,-  interpretScopedR_,-  interpretScopedResumable,-  interpretScopedResumableH,-  interpretScopedResumableWith,-  interpretScopedResumableWithH,-  interpretScopedResumableWith_,-  interpretScopedResumable_,-  interpretScopedWith,-  interpretScopedWithH,-  interpretScopedWith_,-  runScoped,-  runScopedAs,-  ) import Polysemy.Conc.Interpreter.Semaphore (interpretSemaphoreQ, interpretSemaphoreT) import Polysemy.Conc.Interpreter.Stack (ConcStack, runConc) import Polysemy.Conc.Interpreter.Sync (interpretScopedSync, interpretScopedSyncAs, interpretSync, interpretSyncAs)@@ -349,9 +272,6 @@ -- @ -- -- When the first thunk finishes, the other will be killed.---- $signal--- #signal#  -- $mask -- #mask#

@@ -1,4 +1,4 @@--- |Description: Async Combinators+-- | Description: Async Combinators module Polysemy.Conc.Async where  import qualified Control.Concurrent.Async as Base@@ -12,7 +12,7 @@ import qualified Polysemy.Conc.Race as Race import Polysemy.Conc.Sync (withSync) --- |Run the first action asynchronously while the second action executes, then cancel the first action.+-- | Run the first action asynchronously while the second action executes, then cancel the first action. -- Passes the handle into the action to allow it to await its result. -- -- When cancelling, this variant will wait indefinitely for the thread to be gone.@@ -25,7 +25,7 @@   handle <- async mb   finally (use handle) (cancel handle) --- |Run the first action asynchronously while the second action executes, then cancel the first action.+-- | Run the first action asynchronously while the second action executes, then cancel the first action. -- Passes the handle into the sync action to allow it to await the async action's result. -- -- When cancelling, this variant will wait for the specified interval for the thread to be gone.@@ -40,7 +40,7 @@   handle <- async mb   finally (use handle) (Race.timeoutU interval (cancel handle)) --- |Run the first action asynchronously while the second action executes, then cancel the first action.+-- | Run the first action asynchronously while the second action executes, then cancel the first action. -- Passes the handle into the sync action to allow it to await the async action's result. -- -- When cancelling, this variant will wait for 500ms for the thread to be gone.@@ -52,7 +52,7 @@ withAsync =   withAsyncWait (MilliSeconds 500) --- |Run the first action asynchronously while the second action executes, then cancel the first action.+-- | Run the first action asynchronously while the second action executes, then cancel the first action. -- Discards the handle, expecting the async action to either terminate or be cancelled. -- -- When cancelling, this variant will wait for 500ms for the thread to be gone.@@ -64,7 +64,7 @@ withAsync_ mb =   withAsync mb . const --- |Run an action with 'async', but don't start it right away, so the thread handle can be processed before the action+-- | Run an action with 'async', but don't start it right away, so the thread handle can be processed before the action -- executes. -- -- Takes a callback function that is invoked after spawning the thread.@@ -93,7 +93,7 @@       raise mb     f h (Sync.putBlock ()) --- |Variant of 'scheduleAsync' that directly interprets the 'Control.Concurrent.MVar' used for signalling.+-- | Variant of 'scheduleAsync' that directly interprets the 'Control.Concurrent.MVar' used for signalling. scheduleAsyncIO ::   ∀ b r a .   Members [Resource, Async, Race, Embed IO] r =>@@ -107,7 +107,7 @@       raise mb     f h (Sync.putBlock ()) --- |Run the first action asynchronously while the second action executes, then cancel the first action.+-- | Run the first action asynchronously while the second action executes, then cancel the first action. -- -- The second action will only start when the first action calls 'Polysemy.Conc.Gate.signal'. --@@ -125,7 +125,7 @@     gate     raise (use h) --- |Run the first action asynchronously while the second action executes, then cancel the first action.+-- | Run the first action asynchronously while the second action executes, then cancel the first action. -- -- The second action will only start when the first action calls 'Polysemy.Conc.Gate.signal'. --

@@ -1,9 +1,9 @@--- |Description: AtomicState Interpreters+-- | Description: AtomicState Interpreters module Polysemy.Conc.AtomicState where  import Control.Concurrent.STM (newTVarIO) --- |Convenience wrapper around 'runAtomicStateTVar' that creates a new 'Control.Concurrent.STM.TVar'.+-- | Convenience wrapper around 'runAtomicStateTVar' that creates a new 'Control.Concurrent.STM.TVar'. interpretAtomic ::   ∀ a r .   Member (Embed IO) r =>

@@ -1,7 +1,7 @@--- |Description: Queue result ADT+-- | Description: Queue result ADT module Polysemy.Conc.Data.QueueResult where --- |Encodes failure reasons for queues.+-- | Encodes failure reasons for queues. -- -- For documentation on the constructors, see the module "Polysemy.Conc.Data.QueueResult". --@@ -9,13 +9,13 @@ -- import qualified Polysemy.Conc.Data.QueueResult as QueueResult -- @ data QueueResult d =-  -- |The operation was successful.+  -- | The operation was successful.   Success d   |-  -- |The queue is either full and cannot be added to, or empty and cannot be read from.+  -- | The queue is either full and cannot be added to, or empty and cannot be read from.   NotAvailable   |-  -- |The queue was closed by the user.+  -- | The queue was closed by the user.   Closed   deriving stock (Eq, Show, Ord, Functor, Generic) 

@@ -1,21 +1,21 @@ {-# options_haddock prune #-} --- |Description: Critical effect+-- | Description: Critical effect module Polysemy.Conc.Effect.Critical where  import Prelude hiding (catch) --- |An effect that catches exceptions.+-- | An effect that catches exceptions. -- -- Provides the exact functionality of `Polysemy.Error.fromExceptionSem`, but pushes the dependency on @Final IO@ to the -- interpreter, and makes it optional. data Critical :: Effect where-  -- |Catch all exceptions of type @e@ in this computation.+  -- | Catch all exceptions of type @e@ in this computation.   Catch :: Exception e => m a -> Critical m (Either e a)  makeSem ''Critical --- |Catch exceptions of type @e@ and return a fallback value.+-- | Catch exceptions of type @e@ and return a fallback value. catchAs ::   ∀ e a r .   Exception e =>@@ -26,7 +26,7 @@ catchAs a =   fmap (fromRight a) . catch @_ @e --- |Convenience overload for 'SomeException'.+-- | Convenience overload for 'SomeException'. run ::   Member Critical r =>   Sem r a ->@@ -34,7 +34,7 @@ run =   catch --- |Convenience overload for 'SomeException'.+-- | Convenience overload for 'SomeException'. runAs ::   Member Critical r =>   a ->

@@ -1,34 +1,34 @@ {-# options_haddock prune #-} --- |Description: Events/Consume Effects, Internal+-- | Description: Events/Consume Effects, Internal module Polysemy.Conc.Effect.Events where --- |An event publisher that can be consumed from multiple threads.+-- | An event publisher that can be consumed from multiple threads. data Events (e :: Type) :: Effect where   Publish :: e -> Events e m ()  makeSem_ ''Events --- |Publish one event.+-- | Publish one event. publish ::   ∀ e r .   Member (Events e) r =>   e ->   Sem r () --- |Consume events emitted by 'Events'.+-- | Consume events emitted by 'Events'. data Consume (e :: Type) :: Effect where   Consume :: Consume e m e  makeSem_ ''Consume --- |Consume one event emitted by 'Events'.+-- | Consume one event emitted by 'Events'. consume ::   ∀ e r .   Member (Consume e) r =>   Sem r e --- |Create a new scope for 'Events', causing the nested program to get its own copy of the event stream.+-- | Create a new scope for 'Events', causing the nested program to get its own copy of the event stream. -- To be used with 'Polysemy.Conc.interpretEventsChan'. subscribe ::   ∀ e r .

@@ -1,9 +1,9 @@ {-# options_haddock prune #-} --- |Description: Gate effect, Internal+-- | Description: Gate effect, Internal module Polysemy.Conc.Effect.Gate where --- |A single-use synchronization point that blocks all consumers who called 'gate' until 'signal' is called.+-- | A single-use synchronization point that blocks all consumers who called 'gate' until 'signal' is called. -- -- The constructors are exported from [Polysemy.Conc.Gate]("Polysemy.Conc.Gate"). data Gate :: Effect where@@ -12,11 +12,11 @@  makeSem ''Gate --- |Convenience alias for scoped 'Gate'.+-- | Convenience alias for scoped 'Gate'. type Gates =   Scoped_ Gate --- |Run an action with a locally scoped 'Gate' effect.+-- | Run an action with a locally scoped 'Gate' effect. -- -- This avoids a dependency on @'Embed' 'IO'@ in application logic while still allowing the effect to be scoped. withGate ::

@@ -1,44 +0,0 @@-{-# options_haddock prune #-}--- |Description: Interrupt effect-module Polysemy.Conc.Effect.Interrupt where---- |The interrupt handler effect allows three kinds of interaction for interrupt signals:------ - Execute a callback when a signal is received--- - Block a thread until a signal is received--- - Kill a thread when a signal is received------ For documentation on the constructors, see the module "Polysemy.Conc.Effect.Interrupt".------ @--- import qualified Polysemy.Conc.Effect.Interrupt as Interrupt------ prog = do---   Interrupt.register "task 1" (putStrLn "interrupted")---   Interrupt.killOnQuit $ forever do---    doSomeWork--- @-data Interrupt :: Effect where-  -- |Add a computation to be executed on interrupt, using the first argument as a key.-  Register :: Text -> IO () -> Interrupt m ()-  -- |Remove the previously added handler with the given key.-  Unregister :: Text -> Interrupt m ()-  -- |Manually trigger the interrupt.-  Quit :: Interrupt m ()-  -- |Block until an interrupt is triggered.-  WaitQuit :: Interrupt m ()-  -- |Indicate whether an interrupt was triggered.-  Interrupted :: Interrupt m Bool-  -- |Execute a computation, waiting for it to finish, killing its thread on interrupt.-  KillOnQuit :: Text -> m a -> Interrupt m (Maybe a)--makeSem ''Interrupt---- |Variant of 'killOnQuit' that returns @()@.-killOnQuit_ ::-  Member Interrupt r =>-  Text ->-  Sem r a ->-  Sem r ()-killOnQuit_ desc ma =-  void (killOnQuit desc ma)

@@ -1,23 +1,23 @@--- |Lock effect, Internal+-- | Lock effect, Internal module Polysemy.Conc.Effect.Lock where --- |An exclusive lock or mutex, protecting a region from concurrent access.+-- | An exclusive lock or mutex, protecting a region from concurrent access. data Lock :: Effect where-  -- |Run an action if the lock is available, block otherwise.+  -- | Run an action if the lock is available, block otherwise.   Lock :: m a -> Lock m a-  -- |Run the second action if the lock is available, or the first action otherwise.+  -- | Run the second action if the lock is available, or the first action otherwise.   LockOr :: m a -> m a -> Lock m a  makeSem_ ''Lock --- |Run an action if the lock is available, block otherwise.+-- | Run an action if the lock is available, block otherwise. lock ::   ∀ r a .   Member Lock r =>   Sem r a ->   Sem r a --- |Run an action if the lock is available, block otherwise.+-- | Run an action if the lock is available, block otherwise. lockOr ::   ∀ r a .   Member Lock r =>@@ -25,7 +25,7 @@   Sem r a ->   Sem r a --- |Run an action if the lock is available, skip and return 'Nothing' otherwise.+-- | Run an action if the lock is available, skip and return 'Nothing' otherwise. lockOrSkip ::   ∀ r a .   Member Lock r =>@@ -35,7 +35,7 @@   lockOr (pure Nothing) (Just <$> ma) {-# inline lockOrSkip #-} --- |Run an action if the lock is available, skip otherwise.+-- | Run an action if the lock is available, skip otherwise. -- Return @()@. lockOrSkip_ ::   ∀ r a .

@@ -1,15 +1,15 @@ {-# options_haddock prune #-} --- |Description: Mask Effect, Internal+-- | Description: Mask Effect, Internal module Polysemy.Conc.Effect.Mask where --- |Part of an effect abstracting 'Control.Exception.mask'.+-- | Part of an effect abstracting 'Control.Exception.mask'. data RestoreMask :: Effect where   Restore :: m a -> RestoreMask m a  makeSem_ ''RestoreMask --- |Restore the previous masking state.+-- | Restore the previous masking state. -- Can only be called inside of an action passed to 'mask' or 'uninterruptibleMask'. restore ::   ∀ r a .@@ -17,19 +17,19 @@   Sem r a ->   Sem r a --- |Resource type for the scoped 'Mask' effect, wrapping the @restore@ callback passed in by 'Base.mask'.+-- | Resource type for the scoped 'Mask' effect, wrapping the @restore@ callback passed in by 'Base.mask'. newtype Restoration =   Restoration { unRestoration :: ∀ a . IO a -> IO a } --- |The scoped masking effect.+-- | The scoped masking effect. type Mask =   Scoped_ RestoreMask --- |The scoped uninterruptible masking effect.+-- | The scoped uninterruptible masking effect. type UninterruptibleMask =   Scoped_ RestoreMask --- |Mark a region as masked.+-- | Mark a region as masked. -- Uses the 'Scoped_' pattern. mask ::   Member Mask r =>@@ -37,7 +37,7 @@ mask =   scoped_ --- |Mark a region as uninterruptibly masked.+-- | Mark a region as uninterruptibly masked. -- Uses the 'Scoped_' pattern. uninterruptibleMask ::   Member UninterruptibleMask r =>

@@ -1,16 +1,16 @@ {-# options_haddock prune #-} --- |Description: Monitor Effect, Internal+-- | Description: Monitor Effect, Internal module Polysemy.Conc.Effect.Monitor where  import Polysemy.Time (NanoSeconds) --- |Marker type for the restarting action for 'Monitor'.+-- | Marker type for the restarting action for 'Monitor'. data Restart =   Restart   deriving stock (Eq, Show) --- |Mark a region as being subject to intervention by a monitoring program.+-- | Mark a region as being subject to intervention by a monitoring program. -- This can mean that a thread is repeatedly checking a condition and cancelling this region when it is unmet. -- A use case could be checking whether a remote service is available, or whether the system was suspended and resumed. -- This should be used in a 'Scoped_' context, like 'withMonitor'.@@ -19,22 +19,22 @@  makeSem_ ''Monitor --- |Mark a region as being subject to intervention by a monitoring program.+-- | Mark a region as being subject to intervention by a monitoring program. monitor ::   ∀ action r a .   Member (Monitor action) r =>   Sem r a ->   Sem r a --- |Convenience alias for a 'Scoped_' 'Monitor'.+-- | Convenience alias for a 'Scoped_' 'Monitor'. type ScopedMonitor (action :: Type) =   Scoped_ (Monitor action) --- |'Monitor' specialized to the 'Restart' action.+-- | 'Monitor' specialized to the 'Restart' action. type RestartingMonitor =   ScopedMonitor Restart --- |Resources for a 'Scoped_' 'Monitor'.+-- | Resources for a 'Scoped_' 'Monitor'. data MonitorCheck r =   MonitorCheck {     interval :: NanoSeconds,@@ -49,7 +49,7 @@ hoistMonitorCheck f MonitorCheck {..} =   MonitorCheck {check = f . check, ..} --- |Start a region that can contain monitor-intervention regions.+-- | Start a region that can contain monitor-intervention regions. withMonitor ::   ∀ action r .   Member (ScopedMonitor action) r =>@@ -57,7 +57,7 @@ withMonitor =   scoped_ --- |Variant of 'withMonitor' that uses the 'Restart' strategy.+-- | Variant of 'withMonitor' that uses the 'Restart' strategy. restart ::   Member (ScopedMonitor Restart) r =>   InterpreterFor (Monitor Restart) r

@@ -1,11 +1,11 @@ {-# options_haddock prune #-}--- |Description: Queue effect+-- | Description: Queue effect module Polysemy.Conc.Effect.Queue where  import Polysemy.Time (TimeUnit) import Polysemy.Conc.Data.QueueResult (QueueResult) --- |Abstracts queues like 'Control.Concurrent.STM.TBQueue'.+-- | Abstracts queues like 'Control.Concurrent.STM.TBQueue'. -- -- For documentation on the constructors, see the module "Polysemy.Conc.Data.Queue". --@@ -22,25 +22,25 @@ --     r -> pure r -- @ data Queue d :: Effect where-  -- |Read an element from the queue, blocking until one is available.+  -- | Read an element from the queue, blocking until one is available.   Read :: Queue d m (QueueResult d)-  -- |Read an element from the queue, immediately returning if none is available.+  -- | Read an element from the queue, immediately returning if none is available.   TryRead :: Queue d m (QueueResult d)-  -- |Read an element from the queue, blocking until one is available or the timeout expires.+  -- | Read an element from the queue, blocking until one is available or the timeout expires.   ReadTimeout :: TimeUnit t => t -> Queue d m (QueueResult d)-  -- |Read an element, leaving it in the queue, blocking until one is available.+  -- | Read an element, leaving it in the queue, blocking until one is available.   Peek :: Queue d m (QueueResult d)-  -- |Read an element, leaving it in the queue, immediately returning if none is available.+  -- | Read an element, leaving it in the queue, immediately returning if none is available.   TryPeek :: Queue d m (QueueResult d)-  -- |Write an element to the queue, blocking until a slot is available.+  -- | Write an element to the queue, blocking until a slot is available.   Write :: d -> Queue d m ()-  -- |Write an element to the queue, immediately returning if no slot is available.+  -- | Write an element to the queue, immediately returning if no slot is available.   TryWrite :: d -> Queue d m (QueueResult ())-  -- |Write an element to the queue, blocking until a slot is available or the timeout expires.+  -- | Write an element to the queue, blocking until a slot is available or the timeout expires.   WriteTimeout :: TimeUnit t => t -> d -> Queue d m (QueueResult ())-  -- |Indicate whether the queue is closed.+  -- | Indicate whether the queue is closed.   Closed :: Queue d m Bool-  -- |Close the queue.+  -- | Close the queue.   Close :: Queue d m ()  makeSem ''Queue

@@ -1,21 +1,21 @@ {-# options_haddock prune #-} --- |Description: Race effect+-- | Description: Race effect module Polysemy.Conc.Effect.Race where  import Polysemy.Time (TimeUnit) --- |Abstract the concept of running two programs concurrently, aborting the other when one terminates.+-- | Abstract the concept of running two programs concurrently, aborting the other when one terminates. -- 'Timeout' is a simpler variant, where one thread just sleeps for a given interval. data Race :: Effect where-  -- |Run both programs concurrently, returning the result of the faster one.+  -- | Run both programs concurrently, returning the result of the faster one.   Race :: m a -> m b -> Race m (Either a b)-  -- |Run the first action if the second action doesn't finish within the specified interval.+  -- | Run the first action if the second action doesn't finish within the specified interval.   Timeout :: TimeUnit u => m a -> u -> m b -> Race m (Either a b)  makeSem_ ''Race --- |Run both programs concurrently, returning the result of the faster one.+-- | Run both programs concurrently, returning the result of the faster one. race ::   ∀ a b r .   Member Race r =>@@ -23,7 +23,7 @@   Sem r b ->   Sem r (Either a b) --- |Run the fallback action if the given program doesn't finish within the specified interval.+-- | Run the fallback action if the given program doesn't finish within the specified interval. timeout ::   ∀ a b u r .   TimeUnit u =>

@@ -1,155 +0,0 @@-{-# options_haddock prune #-}---- |Description: Scoped Effect, Internal-module Polysemy.Conc.Effect.Scoped where--import Prelude hiding (Scoped, Scoped_, scoped)---- | @Scoped@ transforms a program so that an interpreter for @effect@ may--- perform arbitrary actions, like resource management, before and after the--- computation wrapped by a call to 'scoped' is executed.------ /Note/: This effect has been merged to Polysemy and will be released there soon.------ An application for this is @Polysemy.Conc.Events@ from--- <https://hackage.haskell.org/package/polysemy-conc>, in which each program--- using the effect @Polysemy.Conc.Consume@ is interpreted with its own copy of--- the event channel; or a database transaction, in which a transaction handle--- is created for the wrapped program and passed to the interpreter for the--- database effect.------ For a longer exposition, see <https://www.tweag.io/blog/2022-01-05-polysemy-scoped/>.--- Note that the interface has changed since the blog post was published: The--- @resource@ parameter no longer exists.------ Resource allocation is performed by a function passed to--- 'Polysemy.Scoped.interpretScoped'.------ The constructors are not intended to be used directly; the smart constructor--- 'scoped' is used like a local interpreter for @effect@. 'scoped' takes an--- argument of type @param@, which will be passed through to the interpreter, to--- be used by the resource allocation function.------ As an example, imagine an effect for writing lines to a file:------ > data Write :: Effect where--- >   Write :: Text -> Write m ()--- > makeSem ''Write------ If we now have the following requirements:------ 1. The file should be opened and closed right before and after the part of---    the program in which we write lines--- 2. The file name should be specifiable at the point in the program where---    writing begins--- 3. We don't want to commit to IO, lines should be stored in memory when---    running tests------ Then we can take advantage of 'Scoped' to write this program:------ > prog :: Member (Scoped FilePath Write) r => Sem r ()--- > prog = do--- >   scoped "file1.txt" do--- >     write "line 1"--- >     write "line 2"--- >   scoped "file2.txt" do--- >     write "line 1"--- >     write "line 2"------ Here 'scoped' creates a prompt for an interpreter to start allocating a--- resource for @"file1.txt"@ and handling @Write@ actions using that resource.--- When the 'scoped' block ends, the resource should be freed.------ The interpreter may look like this:------ > interpretWriteFile :: Members '[Resource, Embed IO] => InterpreterFor (Scoped FilePath Write) r--- > interpretWriteFile =--- >   interpretScoped allocator handler--- >   where--- >     allocator name use = bracket (openFile name WriteMode) hClose use--- >     handler fileHandle (Write line) = embed (Text.hPutStrLn fileHandle line)------ Essentially, the @bracket@ is executed at the point where @scoped@ was--- called, wrapping the following block. When the second @scoped@ is executed,--- another call to @bracket@ is performed.------ The effect of this is that the operation that uses @Embed IO@ was moved from--- the call site to the interpreter, while the interpreter may be executed at--- the outermost layer of the app.------ This makes it possible to use a pure interpreter for testing:------ > interpretWriteOutput :: Member (Output (FilePath, Text)) r => InterpreterFor (Scoped FilePath Write) r--- > interpretWriteOutput =--- >   interpretScoped (\ name use -> use name) \ name -> \case--- >     Write line -> output (name, line)------ Here we simply pass the name to the interpreter in the resource allocation--- function.------ Now imagine that we drop requirement 2 from the initial list – we still want--- the file to be opened and closed as late/early as possible, but the file name--- is globally fixed. For this case, the @param@ type is unused, and the API--- provides some convenience aliases to make your code more concise:------ > prog :: Member (Scoped_ Write) r => Sem r ()--- > prog = do--- >   scoped_ do--- >     write "line 1"--- >     write "line 2"--- >   scoped_ do--- >     write "line 1"--- >     write "line 2"------ The type 'Scoped_' and the constructor 'scoped_' simply fix @param@ to @()@.-data Scoped (param :: Type) (effect :: Effect) :: Effect where-  Run :: ∀ param effect m a . effect m a -> Scoped param effect m a-  InScope :: ∀ param effect m a . param -> m a -> Scoped param effect m a--{-# deprecated Scoped "Scoped has been moved to Polysemy.Scoped" #-}---- |A convenience alias for a scope without parameters.-type Scoped_ effect =-  Scoped () effect---- | Constructor for 'Scoped', taking a nested program and transforming all--- instances of @effect@ to @'Scoped' param effect@.------ Please consult the documentation of 'Scoped' for details and examples.-scoped ::-  ∀ param effect r .-  Member (Scoped param effect) r =>-  param ->-  InterpreterFor effect r-scoped param main =-  send $ InScope @param @effect param do-    transform @effect (Run @param) main-{-# inline scoped #-}---- | Constructor for 'Scoped_', taking a nested program and transforming all--- instances of @effect@ to @'Scoped_' effect@.------ Please consult the documentation of 'Scoped' for details and examples.-scoped_ ::-  ∀ effect r .-  Member (Scoped_ effect) r =>-  InterpreterFor effect r-scoped_ = scoped ()-{-# inline scoped_ #-}---- | Transform the parameters of a 'Scoped' program.------ This allows incremental additions to the data passed to the interpreter, for--- example to create an API that permits different ways of running an effect--- with some fundamental parameters being supplied at scope creation and some--- optional or specific parameters being selected by the user downstream.-rescope ::-  ∀ param0 param1 effect r .-  Member (Scoped param1 effect) r =>-  (param0 -> param1) ->-  InterpreterFor (Scoped param0 effect) r-rescope fp =-  transform \case-    Run e          -> Run @param1 e-    InScope p main -> InScope (fp p) main-{-# inline rescope #-}

@@ -1,23 +1,23 @@--- |Semaphore effect, Internal.+-- | Semaphore effect, Internal. module Polysemy.Conc.Effect.Semaphore where --- |This effect abstracts over the concept of a quantity semaphore, a concurrency primitive that contains a number of+-- | This effect abstracts over the concept of a quantity semaphore, a concurrency primitive that contains a number of -- slots that can be acquired and released. data Semaphore :: Effect where-  -- |Wait until a slot is available, then acquire it.+  -- | Wait until a slot is available, then acquire it.   Wait :: Semaphore m ()-  -- |Release a slot.+  -- | Release a slot.   Signal :: Semaphore m ()  makeSem_ ''Semaphore --- |Wait until a slot is available, then acquire it.+-- | Wait until a slot is available, then acquire it. wait ::   ∀ r .   Member Semaphore r =>   Sem r () --- |Release a slot.+-- | Release a slot. signal ::   ∀ r .   Member Semaphore r =>

@@ -1,12 +1,12 @@ {-# options_haddock prune #-} --- |Description: Sync effect, Internal.+-- | Description: Sync effect, Internal. module Polysemy.Conc.Effect.Sync where  import Polysemy.Time (TimeUnit) import Prelude hiding (empty, try) --- |Abstracts an 'Control.Concurrent.MVar'.+-- | Abstracts an 'Control.Concurrent.MVar'. -- -- For documentation on the constructors, see the module "Polysemy.Conc.Effect.Sync". --@@ -20,29 +20,29 @@ --   Sync.takeBlock -- @ data Sync d :: Effect where-  -- |Read the variable, waiting until a value is available.+  -- | Read the variable, waiting until a value is available.   Block :: Sync d m d-  -- |Read the variable, waiting until a value is available or the timeout has expired.+  -- | Read the variable, waiting until a value is available or the timeout has expired.   Wait :: TimeUnit u => u -> Sync d m (Maybe d)-  -- |Read the variable, returning 'Nothing' immmediately if no value was available.+  -- | Read the variable, returning 'Nothing' immmediately if no value was available.   Try :: Sync d m (Maybe d)-  -- |Take the variable, waiting until a value is available.+  -- | Take the variable, waiting until a value is available.   TakeBlock :: Sync d m d-  -- |Take the variable, waiting until a value is available or the timeout has expired.+  -- | Take the variable, waiting until a value is available or the timeout has expired.   TakeWait :: TimeUnit u => u -> Sync d m (Maybe d)-  -- |Take the variable, returning 'Nothing' immmediately if no value was available.+  -- | Take the variable, returning 'Nothing' immmediately if no value was available.   TakeTry :: Sync d m (Maybe d)-  -- |Write the variable, waiting until it is writable.+  -- | Write the variable, waiting until it is writable.   PutBlock :: d -> Sync d m ()-  -- |Write the variable, waiting until it is writable or the timeout has expired.+  -- | Write the variable, waiting until it is writable or the timeout has expired.   PutWait :: TimeUnit u => u -> d -> Sync d m Bool-  -- |Write the variable, returning 'False' immmediately if a value was available.+  -- | Write the variable, returning 'False' immmediately if a value was available.   PutTry :: d -> Sync d m Bool-  -- |Indicate whether the variable is empty.+  -- | Indicate whether the variable is empty.   Empty :: Sync d m Bool  makeSem ''Sync --- |Convenience alias.+-- | Convenience alias. type ScopedSync a =   Scoped_ (Sync a)

@@ -1,20 +1,20 @@ {-# options_haddock prune #-} --- |The effect 'SyncRead' is equivalent to 'Polysemy.Conc.Sync' without the write actions.+-- | The effect 'SyncRead' is equivalent to 'Polysemy.Conc.Sync' without the write actions. module Polysemy.Conc.Effect.SyncRead where  import Polysemy.Time (TimeUnit) import Prelude hiding (empty, try) --- |An interface to a shared variable ('MVar') that can only be read.+-- | An interface to a shared variable ('MVar') that can only be read. data SyncRead (d :: Type) :: Effect where-  -- |Read the variable, waiting until a value is available.+  -- | Read the variable, waiting until a value is available.   Block :: SyncRead d m d-  -- |Read the variable, waiting until a value is available or the timeout has expired.+  -- | Read the variable, waiting until a value is available or the timeout has expired.   Wait :: TimeUnit u => u -> SyncRead d m (Maybe d)-  -- |Read the variable, returning 'Nothing' immmediately if no value was available.+  -- | Read the variable, returning 'Nothing' immmediately if no value was available.   Try :: SyncRead d m (Maybe d)-  -- |Indicate whether the variable is empty.+  -- | Indicate whether the variable is empty.   Empty :: SyncRead d m Bool  makeSem ''SyncRead

@@ -1,4 +1,4 @@--- |Description: Events Combinators+-- | Description: Events Combinators module Polysemy.Conc.Events where  import Polysemy.Conc.Async (withAsync_)@@ -8,7 +8,7 @@ import Polysemy.Conc.Effect.Race (Race) import Polysemy.Conc.Interpreter.Events (EventConsumer) --- |Create a new scope for 'Polysemy.Conc.Events', causing the nested program to get its own copy of the event stream.+-- | Create a new scope for 'Polysemy.Conc.Events', causing the nested program to get its own copy of the event stream. -- -- Calls 'signal' before running the argument to ensure that 'Events.subscribe' has finished creating a channel, for use -- with asynchronous execution.@@ -21,7 +21,7 @@     signal     action --- |Create a new scope for 'Polysemy.Conc.Events', causing the nested program to get its own copy of the event stream.+-- | Create a new scope for 'Polysemy.Conc.Events', causing the nested program to get its own copy of the event stream. -- -- Executes in a new thread, ensuring that the main thread blocks until 'Events.subscribe' has finished creating a -- channel.@@ -36,7 +36,7 @@     gate     raise @Gate ma --- |Pull repeatedly from 'Polysemy.Conc.Consume', passing the event to the supplied callback.+-- | Pull repeatedly from 'Polysemy.Conc.Consume', passing the event to the supplied callback. -- Stop when the action returns @False@. consumeWhile ::   Member (Consume e) r =>@@ -48,7 +48,7 @@     spin =       whenM (action =<< Events.consume) spin --- |Pull repeatedly from the 'Polysemy.Conc.Events' channel, passing the event to the supplied callback.+-- | Pull repeatedly from the 'Polysemy.Conc.Events' channel, passing the event to the supplied callback. -- Stop when the action returns @False@. subscribeWhile ::   ∀ e r .@@ -58,7 +58,7 @@ subscribeWhile action =   Events.subscribe @e (consumeWhile (raise . action)) --- |Pull repeatedly from the 'Polysemy.Conc.Events' channel, passing the event to the supplied callback.+-- | Pull repeatedly from the 'Polysemy.Conc.Events' channel, passing the event to the supplied callback. -- Stop when the action returns @False@. -- -- Signals the caller that the channel was successfully subscribed to using the 'Gate' effect.@@ -71,7 +71,7 @@   subscribeGated @e do     consumeWhile (raise . action) --- |Start a new thread that pulls repeatedly from the 'Polysemy.Conc.Events' channel, passing the event to the supplied+-- | Start a new thread that pulls repeatedly from the 'Polysemy.Conc.Events' channel, passing the event to the supplied -- callback and stops when the action returns @False@. subscribeWhileAsync ::   ∀ e r a .@@ -82,7 +82,7 @@ subscribeWhileAsync action =   subscribeAsync @e (consumeWhile action) --- |Pull repeatedly from 'Polysemy.Conc.Consume', passing the event to the supplied callback.+-- | Pull repeatedly from 'Polysemy.Conc.Consume', passing the event to the supplied callback. consumeLoop ::   Member (Consume e) r =>   (e -> Sem r ()) ->@@ -90,7 +90,7 @@ consumeLoop action =   forever (action =<< Events.consume) --- |Pull repeatedly from the 'Polysemy.Conc.Events' channel, passing the event to the supplied callback.+-- | Pull repeatedly from the 'Polysemy.Conc.Events' channel, passing the event to the supplied callback. subscribeLoop ::   ∀ e r .   Member (EventConsumer e) r =>@@ -99,7 +99,7 @@ subscribeLoop action =   Events.subscribe @e (consumeLoop (raise . action)) --- |Pull repeatedly from the 'Polysemy.Conc.Events' channel, passing the event to the supplied callback.+-- | Pull repeatedly from the 'Polysemy.Conc.Events' channel, passing the event to the supplied callback. -- -- Signals the caller that the channel was successfully subscribed to using the 'Gate' effect. subscribeLoopGated ::@@ -111,7 +111,7 @@   subscribeGated @e do     consumeLoop (raise . action) --- |Start a new thread that pulls repeatedly from the 'Polysemy.Conc.Events' channel, passing the event to the supplied+-- | Start a new thread that pulls repeatedly from the 'Polysemy.Conc.Events' channel, passing the event to the supplied -- callback. subscribeLoopAsync ::   ∀ e r a .@@ -122,7 +122,7 @@ subscribeLoopAsync action =   subscribeAsync @e (consumeLoop action) --- |Block until a value matching the predicate has been returned by 'Polysemy.Conc.Consume'.+-- | Block until a value matching the predicate has been returned by 'Polysemy.Conc.Consume'. consumeFind ::   ∀ e r .   Member (Consume e) r =>@@ -135,7 +135,7 @@       e <- Events.consume       ifM (f e) (pure e) spin --- |Block until a value matching the predicate has been published to the 'Polysemy.Conc.Events' channel.+-- | Block until a value matching the predicate has been published to the 'Polysemy.Conc.Events' channel. subscribeFind ::   ∀ e r .   Member (EventConsumer e) r =>@@ -144,7 +144,7 @@ subscribeFind f =   Events.subscribe @e (consumeFind f) --- |Return the first value returned by 'Polysemy.Conc.Consume' for which the function produces 'Just'.+-- | Return the first value returned by 'Polysemy.Conc.Consume' for which the function produces 'Just'. consumeFirstJust ::   ∀ e a r .   Member (Consume e) r =>@@ -157,7 +157,7 @@       e <- Events.consume       maybe spin pure =<< f e --- |Return the first value published to the 'Polysemy.Conc.Events' channel for which the function produces 'Just'.+-- | Return the first value published to the 'Polysemy.Conc.Events' channel for which the function produces 'Just'. subscribeFirstJust ::   ∀ e a r .   Member (EventConsumer e) r =>@@ -166,7 +166,7 @@ subscribeFirstJust f =   Events.subscribe @e (consumeFirstJust f) --- |Block until the specified value has been returned by 'Polysemy.Conc.Consume'.+-- | Block until the specified value has been returned by 'Polysemy.Conc.Consume'. consumeElem ::   ∀ e r .   Eq e =>@@ -176,7 +176,7 @@ consumeElem target =   void (consumeFind (pure . (target ==))) --- |Block until the specified value has been published to the 'Polysemy.Conc.Events' channel.+-- | Block until the specified value has been published to the 'Polysemy.Conc.Events' channel. subscribeElem ::   ∀ e r .   Eq e =>

@@ -1,6 +1,6 @@ {-# options_haddock prune #-} --- |Description: API for the 'Gate' effect+-- | Description: API for the 'Gate' effect module Polysemy.Conc.Gate (   module Polysemy.Conc.Effect.Gate,   module Polysemy.Conc.Interpreter.Gate,

@@ -1,4 +1,4 @@--- |Description: Critical interpreters+-- | Description: Critical interpreters module Polysemy.Conc.Interpreter.Critical where  import qualified Control.Exception as Exception@@ -6,7 +6,7 @@  import Polysemy.Conc.Effect.Critical (Critical (..)) --- |Interpret 'Critical' in terms of 'Final' 'IO'.+-- | Interpret 'Critical' in terms of 'Final' 'IO'. interpretCritical ::   Member (Final IO) r =>   InterpreterFor Critical r@@ -21,7 +21,7 @@           Exception.catch (fmap Right <$> ma') \ se -> pure (Left se <$ s) {-# inline interpretCritical #-} --- |Interpret 'Critical' by doing nothing.+-- | Interpret 'Critical' by doing nothing. interpretCriticalNull ::   InterpreterFor Critical r interpretCriticalNull =

@@ -1,6 +1,6 @@ {-# options_haddock prune #-} --- |Description: Events/Consume Interpreters, Internal+-- | Description: Events/Consume Interpreters, Internal module Polysemy.Conc.Interpreter.Events where  import Control.Concurrent.Chan.Unagi.Bounded (InChan, OutChan, dupChan, newChan, readChan, tryWriteChan)@@ -10,11 +10,11 @@ import Polysemy.Conc.Effect.Events (Consume, Events) import Polysemy.Conc.Effect.Race (Race) --- |Convenience alias for the consumer effect.+-- | Convenience alias for the consumer effect. type EventConsumer e =   Scoped_ (Consume e) --- |Interpret 'Consume' by reading from an 'OutChan'.+-- | Interpret 'Consume' by reading from an 'OutChan'. -- Used internally by 'interpretEventsChan', not safe to use directly. interpretConsumeChan ::   ∀ e r .@@ -26,7 +26,7 @@     Events.Consume ->       embed (readChan chan) --- |Interpret 'Events' by writing to an 'InChan'.+-- | Interpret 'Events' by writing to an 'InChan'. -- Used internally by 'interpretEventsChan', not safe to use directly. -- When the channel queue is full, this silently discards events. interpretEventsInChan ::@@ -39,7 +39,7 @@     Events.Publish e ->       void (embed (tryWriteChan inChan e)) --- |Interpret 'Events' and 'Consume' together by connecting them to the two ends of an unagi channel.+-- | Interpret 'Events' and 'Consume' together by connecting them to the two ends of an unagi channel. -- 'Consume' is only interpreted in a 'Polysemy.Conc.Scoped' manner, ensuring that a new duplicate of the channel is -- created so that all consumers see all events (from the moment they are connected). --

@@ -1,9 +1,9 @@--- |Gate interpreters, Internal+-- | Gate interpreters, Internal module Polysemy.Conc.Interpreter.Gate where  import Polysemy.Conc.Effect.Gate (Gate (Gate, Signal)) --- |Interpret 'Gate' with an 'MVar'.+-- | Interpret 'Gate' with an 'MVar'. interpretGate ::   ∀ r .   Member (Embed IO) r =>@@ -20,7 +20,7 @@         Gate ->           embed (readMVar mv) --- |Interpret @'Scoped_' 'Gate'@ with an @'MVar' ()@.+-- | Interpret @'Scoped_' 'Gate'@ with an @'MVar' ()@. interpretGates ::   Member (Embed IO) r =>   InterpreterFor (Scoped_ Gate) r

@@ -1,244 +0,0 @@-{-# options_haddock prune #-}-{-# language FieldSelectors #-}---- |Description: Interrupt interpreters-module Polysemy.Conc.Interpreter.Interrupt where--import qualified Control.Concurrent.Async as A-import Control.Concurrent.Async (AsyncCancelled)-import Control.Concurrent.STM (TVar, newTVarIO)-import qualified Data.Map.Strict as Map-import qualified Data.Set as Set-import qualified Data.Text.IO as Text-import Polysemy.Internal.Tactics (liftT)-import Polysemy.Time (Seconds (Seconds))-import System.IO (stderr)-import System.Posix.Signals (-  Handler (Catch, CatchInfo, CatchInfoOnce, CatchOnce),-  SignalInfo,-  installHandler,-  keyboardSignal,-  )--import qualified Polysemy.Conc.Effect.Critical as Critical-import Polysemy.Conc.Effect.Critical (Critical)-import Polysemy.Conc.Effect.Interrupt (Interrupt (..))-import Polysemy.Conc.Effect.Race (Race)-import qualified Polysemy.Conc.Effect.Sync as Sync-import Polysemy.Conc.Interpreter.Sync (interpretSync)-import Polysemy.Conc.Race (race_)--putErr ::-  Member (Embed IO) r =>-  Text ->-  Sem r ()-putErr =-  embed . Text.hPutStrLn stderr--data InterruptState =-  InterruptState {-    quit :: !(MVar ()),-    finished :: !(MVar ()),-    listeners :: !(Set Text),-    original :: !(SignalInfo -> IO ()),-    handlers :: !(Map Text (IO ()))-  }--modListeners :: (Set Text -> Set Text) -> InterruptState -> InterruptState-modListeners f s@InterruptState {listeners} =-  s {listeners = f listeners}--modHandlers :: (Map Text (IO ()) -> Map Text (IO ())) -> InterruptState -> InterruptState-modHandlers f s@InterruptState {handlers} =-  s {handlers = f handlers}--waitQuit ::-  Members [AtomicState InterruptState, Embed IO] r =>-  Sem r ()-waitQuit = do-  mv <- atomicGets quit-  embed (readMVar mv)--checkListeners ::-  Members [AtomicState InterruptState, Embed IO] r =>-  Sem r ()-checkListeners =-  whenM (atomicGets (Set.null . listeners)) do-    fin <- atomicGets finished-    void (embed (tryPutMVar fin ()))--onQuit ::-  Members [AtomicState InterruptState, Embed IO] r =>-  Text ->-  Sem r a ->-  Sem r a-onQuit name ma = do-  atomicModify' (modListeners (Set.insert name))-  waitQuit-  a <- ma-  atomicModify' (modListeners (Set.delete name))-  checkListeners-  pure a--processHandler ::-  Member (Embed IO) r =>-  Text ->-  IO () ->-  Sem r ()-processHandler name thunk = do-  putErr ("processing interrupt handler: " <> name)-  embed thunk--execInterrupt ::-  Members [AtomicState InterruptState, Embed IO] r =>-  Sem r (SignalInfo -> Sem r ())-execInterrupt = do-  InterruptState quitSignal finishSignal _ orig _ <- atomicGet-  whenM (embed (tryPutMVar quitSignal ())) do-    traverse_ (uncurry processHandler) . Map.toList =<< atomicGets handlers-    checkListeners-    embed (takeMVar finishSignal)-  embed . orig <$ putErr "interrupt handlers finished"--registerHandler ::-  Member (AtomicState InterruptState) r =>-  Text ->-  IO () ->-  Sem r ()-registerHandler name handler =-  atomicModify' (modHandlers (Map.insert name handler))--awaitOrKill ::-  Members [AtomicState InterruptState, Critical, Race, Async, Embed IO] r =>-  Text ->-  A.Async (Maybe a) ->-  Sem r (Maybe a)-awaitOrKill desc handle = do-  interpretSync @() do-    race_ (catchCritical (await handle)) kill-  where-    catchCritical =-      maybe waitKill (pure . Just) <=< Critical.catchAs @AsyncCancelled Nothing-    waitKill =-      Nothing <$ Sync.wait @() (Seconds 1)-    kill = do-      onQuit desc do-        putErr ("killing " <> desc)-        cancel handle-        putErr ("killed " <> desc)-        Sync.putBlock ()-        pure Nothing--interpretInterruptState ::-  Members [AtomicState InterruptState, Critical, Race, Async, Embed IO] r =>-  InterpreterFor Interrupt r-interpretInterruptState =-  interpretH \case-    Register name handler ->-      liftT (registerHandler name handler)-    Unregister name ->-      liftT $ atomicModify' \ s@InterruptState {handlers} -> s {handlers = Map.delete name handlers}-    WaitQuit ->-      liftT waitQuit-    Quit ->-      liftT do-        putErr "manual interrupt"-        void execInterrupt-    Interrupted ->-      liftT . fmap isJust . embed . tryReadMVar =<< atomicGets quit-    KillOnQuit desc ma -> do-      maT <- runT ma-      ins <- getInspectorT-      handle <- raise (interpretInterruptState (async maT))-      result <- liftT (awaitOrKill desc handle)-      pure (join . fmap (inspect ins) <$> result)-{-# inline interpretInterruptState #-}--broadcastInterrupt ::-  Members [AtomicState InterruptState, Embed IO] r =>-  SignalInfo ->-  Sem r ()-broadcastInterrupt sig = do-  putErr "caught interrupt signal"-  orig <- execInterrupt-  orig sig---- The original handler is either the default handler that kills all threads or a handler installed by an environment--- like ghcid.--- In the latter case, not calling it results in ghcid misbehaving.--- To distinguish the two cases, the constructor used by the default is 'Catch', while a custom handler should usually--- use 'CatchOnce', since you don't want to catch repeated occurences of SIGINT, as it will surely cause problems.-originalHandler :: Handler -> (SignalInfo -> IO ())-originalHandler (CatchOnce thunk) =-  (const thunk)-originalHandler (CatchInfoOnce thunk) =-  thunk-originalHandler (Catch thunk) =-  (const thunk)-originalHandler (CatchInfo thunk) =-  thunk-originalHandler _ =-  const unit-{-# inline originalHandler #-}--installSignalHandler ::-  TVar InterruptState ->-  ((SignalInfo -> IO ()) -> Handler) ->-  IO Handler-installSignalHandler state consHandler =-  installHandler keyboardSignal (consHandler handler) Nothing-  where-    handler sig =-      runFinal $ embedToFinal @IO $ runAtomicStateTVar state (broadcastInterrupt sig)---- |Interpret 'Interrupt' by installing a signal handler.------ Takes a constructor for 'Handler'.-interpretInterruptWith ::-  Members [Critical, Race, Async, Embed IO] r =>-  ((SignalInfo -> IO ()) -> Handler) ->-  InterpreterFor Interrupt r-interpretInterruptWith consHandler sem = do-  quitMVar <- embed newEmptyMVar-  finishMVar <- embed newEmptyMVar-  state <- embed (newTVarIO (InterruptState quitMVar finishMVar Set.empty (const unit) Map.empty))-  orig <- embed $ installSignalHandler state consHandler-  runAtomicStateTVar state do-    atomicModify' \ s -> s {original = originalHandler orig}-    interpretInterruptState $ raiseUnder sem---- |Interpret 'Interrupt' by installing a signal handler.------ Catches repeat invocations of SIGINT.-interpretInterrupt ::-  Members [Critical, Race, Async, Embed IO] r =>-  InterpreterFor Interrupt r-interpretInterrupt =-  interpretInterruptWith CatchInfo---- |Interpret 'Interrupt' by installing a signal handler.------ Catches only the first invocation of SIGINT.-interpretInterruptOnce ::-  Members [Critical, Race, Async, Embed IO] r =>-  InterpreterFor Interrupt r-interpretInterruptOnce =-  interpretInterruptWith CatchInfoOnce---- |Eliminate 'Interrupt' without interpreting.-interpretInterruptNull ::-  InterpreterFor Interrupt r-interpretInterruptNull =-  interpretH \case-    Register _ _ ->-      pureT ()-    Unregister _ ->-      pureT ()-    WaitQuit ->-      pureT ()-    Quit ->-      pureT ()-    Interrupted ->-      pureT False-    KillOnQuit _ _ ->-      pureT Nothing

@@ -1,6 +1,6 @@ {-# options_haddock prune #-} --- |Lock interpreters, Internal+-- | Lock interpreters, Internal module Polysemy.Conc.Interpreter.Lock where  import Control.Concurrent (ThreadId, myThreadId)@@ -18,7 +18,7 @@ currentThread =   embed myThreadId --- |Interpret 'Lock' by executing all actions unconditionally.+-- | Interpret 'Lock' by executing all actions unconditionally. interpretLockPermissive ::   InterpreterFor Lock r interpretLockPermissive =@@ -84,7 +84,7 @@         restore (raise alt) {-# inline lockAlt #-} --- |Subinterpreter for 'interpretLockReentrant' that checks whether the current thread is equal to the lock-acquiring+-- | Subinterpreter for 'interpretLockReentrant' that checks whether the current thread is equal to the lock-acquiring -- thread to allow reentry into the lock. interpretLockReentrantEntered ::   Members [Sync (), Resource, Race, Mask, Embed IO] r =>@@ -99,7 +99,7 @@       lockOnDifferentThread lockThread maI (lockAlt alt) {-# inline interpretLockReentrantEntered #-} --- |Interpret 'Lock' as a reentrant lock, allowing nested calls to 'Polysemy.Conc.lock' unless called from a different+-- | Interpret 'Lock' as a reentrant lock, allowing nested calls to 'Polysemy.Conc.lock' unless called from a different -- thread (as in, @async@ was called in a higher-order action passed to 'Polysemy.Conc.lock'.) interpretLockReentrant ::   Members [Resource, Race, Mask, Embed IO] r =>

@@ -1,6 +1,6 @@ {-# options_haddock prune #-} --- |Description: Mask Interpreters, Internal+-- | Description: Mask Interpreters, Internal module Polysemy.Conc.Interpreter.Mask where  import qualified Control.Exception as Base@@ -39,26 +39,26 @@     Restore ma ->       withStrategicToFinal (restore <$> runS (runTSimple ma)) --- |Interpret 'Mask' by sequencing the action without masking.+-- | Interpret 'Mask' by sequencing the action without masking. interpretMaskPure :: InterpreterFor Mask r interpretMaskPure =   interpretScopedH (const ($ ())) \ () -> \case     Restore ma -> runTSimple ma --- |Interpret 'Mask' in 'IO'.+-- | Interpret 'Mask' in 'IO'. interpretMaskFinal ::   Member (Final IO) r =>   InterpreterFor Mask r interpretMaskFinal =   runScoped (const mask) \ r -> interpretRestoreMask r --- |Interpret 'UninterruptibleMask' by sequencing the action without masking.+-- | Interpret 'UninterruptibleMask' by sequencing the action without masking. interpretUninterruptibleMaskPure :: InterpreterFor UninterruptibleMask r interpretUninterruptibleMaskPure =   interpretScopedH (const ($ ())) \ () -> \case     Restore ma -> runTSimple ma --- |Interpret 'UninterruptibleMask' in 'IO'.+-- | Interpret 'UninterruptibleMask' in 'IO'. interpretUninterruptibleMaskFinal ::   Member (Final IO) r =>   InterpreterFor UninterruptibleMask r

@@ -1,6 +1,6 @@ {-# options_haddock prune #-} --- |Description: Monitor Interpreters, Internal+-- | Description: Monitor Interpreters, Internal module Polysemy.Conc.Interpreter.Monitor where  import qualified Control.Exception as Base@@ -41,7 +41,7 @@       void (embedFinal @IO (tryTakeMVar sig))       either (const (spin sig)) pure =<< errorToIOFinal @MonitorCancel (fromExceptionSem @MonitorCancel (raise (use res))) --- |Interpret @'Polysemy.Conc.Scoped' 'Monitor'@ with the 'Polysemy.Conc.Restart' strategy.+-- | Interpret @'Polysemy.Conc.Scoped' 'Monitor'@ with the 'Polysemy.Conc.Restart' strategy. -- This takes a check action that may put an 'MVar' when the scoped region should be restarted. -- The check is executed in a loop, with an interval given in 'MonitorCheck'. interpretMonitorRestart ::@@ -60,7 +60,7 @@     Monitor ma ->       runTSimple ma --- |Run 'Monitor' as a no-op.+-- | Run 'Monitor' as a no-op. interpretMonitorPure :: InterpreterFor (ScopedMonitor action) r interpretMonitorPure =   runScopedAs (const unit) interpretMonitorPure'

@@ -1,4 +1,4 @@--- |Description: Pure Queue Interpreters+-- | Description: Pure Queue Interpreters module Polysemy.Conc.Interpreter.Queue.Pure where  import Polysemy.Conc.AtomicState (interpretAtomic)@@ -7,7 +7,7 @@ import qualified Polysemy.Conc.Effect.Queue as Queue import Polysemy.Conc.Effect.Queue (Queue) --- |Reinterpret 'Queue' as 'AtomicState' with a list that cannot be written to.+-- | Reinterpret 'Queue' as 'AtomicState' with a list that cannot be written to. -- Useful for testing. interpretQueueListReadOnlyAtomicWith ::   ∀ d r .@@ -48,7 +48,7 @@         h : _ -> QueueResult.Success h {-# inline interpretQueueListReadOnlyAtomicWith #-} --- |Variant of 'interpretQueueListReadOnlyAtomicWith' that interprets the 'AtomicState'.+-- | Variant of 'interpretQueueListReadOnlyAtomicWith' that interprets the 'AtomicState'. interpretQueueListReadOnlyAtomic ::   ∀ d r .   Member (Embed IO) r =>@@ -58,7 +58,7 @@   interpretAtomic ds (interpretQueueListReadOnlyAtomicWith (raiseUnder sem)) {-# inline interpretQueueListReadOnlyAtomic #-} --- |Reinterpret 'Queue' as 'State' with a list that cannot be written to.+-- | Reinterpret 'Queue' as 'State' with a list that cannot be written to. -- Useful for testing. interpretQueueListReadOnlyStateWith ::   ∀ d r .@@ -99,7 +99,7 @@         h : _ -> QueueResult.Success h {-# inline interpretQueueListReadOnlyStateWith #-} --- |Variant of 'interpretQueueListReadOnlyAtomicWith' that interprets the 'State'.+-- | Variant of 'interpretQueueListReadOnlyAtomicWith' that interprets the 'State'. interpretQueueListReadOnlyState ::   ∀ d r .   [d] ->

@@ -1,4 +1,4 @@--- |Description: Queue Interpreters for 'TBQueue'+-- | Description: Queue Interpreters for 'TBQueue' module Polysemy.Conc.Interpreter.Queue.TB where  import Control.Concurrent.STM (@@ -20,7 +20,7 @@ import Polysemy.Conc.Queue.Result (naResult) import Polysemy.Conc.Queue.Timeout (withTimeout) --- |Interpret 'Queue' with a 'TBQueue'.+-- | Interpret 'Queue' with a 'TBQueue'. -- -- This variant expects an allocated queue as an argument. interpretQueueTBWith ::@@ -53,11 +53,11 @@       unit {-# inline interpretQueueTBWith #-} --- |Interpret 'Queue' with a 'TBQueue'.+-- | Interpret 'Queue' with a 'TBQueue'. interpretQueueTB ::   ∀ d r .   Members [Race, Embed IO] r =>-  -- |Buffer size+  -- | Buffer size   Natural ->   InterpreterFor (Queue d) r interpretQueueTB maxQueued sem = do

@@ -1,6 +1,6 @@ {-# options_haddock prune #-} --- |Description: Queue Interpreters for 'TBMQueue'+-- | Description: Queue Interpreters for 'TBMQueue' module Polysemy.Conc.Interpreter.Queue.TBM where  import Control.Concurrent.STM (atomically)@@ -23,7 +23,7 @@ import Polysemy.Conc.Queue.Result (closedBoolResult, closedNaResult, closedResult) import Polysemy.Conc.Queue.Timeout (withTimeout) --- |Interpret 'Queue' with a 'TBMQueue'.+-- | Interpret 'Queue' with a 'TBMQueue'. -- -- This variant expects an allocated queue as an argument. interpretQueueTBMWith ::@@ -65,11 +65,11 @@ withTBMQueue maxQueued =   bracket (embed (newTBMQueueIO maxQueued)) (embed . atomically . closeTBMQueue) --- |Interpret 'Queue' with a 'TBMQueue'.+-- | Interpret 'Queue' with a 'TBMQueue'. interpretQueueTBM ::   ∀ d r .   Members [Resource, Race, Embed IO] r =>-  -- |Buffer size+  -- | Buffer size   Int ->   InterpreterFor (Queue d) r interpretQueueTBM maxQueued sem = do

@@ -1,5 +1,5 @@ {-# options_haddock prune #-}--- |Description: Race Interpreters+-- | Description: Race Interpreters module Polysemy.Conc.Interpreter.Race where  import qualified Control.Concurrent.Async as Async@@ -19,7 +19,7 @@   either (fmap Left) (fmap Right) {-# inline biseqEither #-} --- |Interpret 'Race' in terms of 'Async.race' and 'System.timeout'.+-- | Interpret 'Race' in terms of 'Async.race' and 'System.timeout'. -- Since this has to pass higher-order thunks as 'IO' arguments, it is interpreted in terms of 'Final IO'. interpretRace ::   Member (Final IO) r =>

@@ -1,640 +0,0 @@-{-# options_haddock prune #-}---- |Description: Scoped Interpreters, Internal-module Polysemy.Conc.Interpreter.Scoped where--import GHC.Err (errorWithoutStackTrace)-import Polysemy.Internal (Sem (Sem), hoistSem, liftSem, runSem)-import Polysemy.Internal.Sing (KnownList (singList))-import Polysemy.Internal.Tactics (liftT)-import Polysemy.Internal.Union (-  Union (Union),-  Weaving (Weaving),-  decomp,-  extendMembershipLeft,-  hoist,-  injWeaving,-  injectMembership,-  weave,-  )-import Polysemy.Membership (ElemOf)-import Polysemy.Resume (Stop, interpretResumableH, runStop, type (!!))-import Polysemy.Resume.Effect.Resumable (Resumable (Resumable))-import Prelude hiding (Scoped, interpretScoped, interpretScopedH, interpretScopedWithH, runScoped)--import Polysemy.Conc.Effect.Scoped (Scoped (InScope, Run))--interpretWeaving ::-  ∀ e r .-  (∀ x . Weaving e (Sem (e : r)) x -> Sem r x) ->-  InterpreterFor e r-interpretWeaving h (Sem m) =-  Sem \ k -> m $ decomp >>> \case-    Right wav -> runSem (h wav) k-    Left g -> k (hoist (interpretWeaving h) g)--restack :: (∀ e . ElemOf e r -> ElemOf e r')-        -> Sem r a-        -> Sem r' a-restack n =-  hoistSem $ \ (Union pr wav) -> hoist (restack n) (Union (n pr) wav)-{-# inline restack #-}--exResumable ::-  Functor f =>-  f () ->-  (f (Either err a) -> x) ->-  (f' a' -> a) ->-  Sem r (Either err (f (f' a'))) ->-  Sem r x-exResumable s ex ex' =-  fmap $ ex . \case-    Right a -> Right . ex' <$> a-    Left err -> Left err <$ s-{-# inline exResumable #-}---- | Construct an interpreter for a higher-order effect wrapped in a 'Scoped',--- given a resource allocation function and a parameterized handler for the--- plain effect.------ This combinator is analogous to 'interpretH' in that it allows the handler to--- use the 'Tactical' environment and transforms the effect into other effects--- on the stack.-interpretScopedH ::-  ∀ resource param effect r .-  -- | A callback function that allows the user to acquire a resource for each-  -- computation wrapped by 'Polysemy.Conc.scoped' using other effects, with an additional-  -- argument that contains the call site parameter passed to 'Polysemy.Conc.scoped'.-  (∀ x . param -> (resource -> Sem r x) -> Sem r x) ->-  -- | A handler like the one expected by 'interpretH' with an additional-  -- parameter that contains the @resource@ allocated by the first argument.-  (∀ r0 x . resource -> effect (Sem r0) x -> Tactical effect (Sem r0) r x) ->-  InterpreterFor (Scoped param effect) r-interpretScopedH withResource scopedHandler =-  interpretWeaving $ \(Weaving effect s wv ex _) -> case effect of-    Run _ -> errorWithoutStackTrace "top level run"-    InScope param main -> withResource param \ resource ->-          ex-      <$> interpretH (scopedHandler resource) (go $ raiseUnder $ wv (main <$ s))-  where-    -- TODO investigate whether loopbreaker optimization is effective here-    go :: InterpreterFor (Scoped param effect) (effect : r)-    go =-      interpretWeaving \ (Weaving effect s wv ex ins) -> case effect of-        Run act -> liftSem $ injWeaving $ Weaving act s (go . wv) ex ins-        InScope param main -> raise $ withResource param \ resource ->-          ex <$> interpretH (scopedHandler resource) (go $ wv (main <$ s))-{-# inline interpretScopedH #-}---- | Variant of 'interpretScopedH' that allows the resource acquisition function--- to use 'Tactical'.-interpretScopedH' ::-  ∀ resource param effect r .-  (∀ e r0 x . param -> (resource -> Tactical e (Sem r0) r x) ->-    Tactical e (Sem r0) r x) ->-  (∀ r0 x .-    resource -> effect (Sem r0) x ->-    Tactical (Scoped param effect) (Sem r0) r x) ->-  InterpreterFor (Scoped param effect) r-interpretScopedH' withResource scopedHandler =-  go (errorWithoutStackTrace "top level run")-  where-    go :: resource -> InterpreterFor (Scoped param effect) r-    go resource =-      interpretH \case-        Run act ->-          scopedHandler resource act-        InScope param main ->-          withResource param \ resource' ->-            raise . go resource' =<< runT main-{-# inline interpretScopedH' #-}---- | First-order variant of 'interpretScopedH'.-interpretScoped ::-  ∀ resource param effect r .-  (∀ x . param -> (resource -> Sem r x) -> Sem r x) ->-  (∀ m x . resource -> effect m x -> Sem r x) ->-  InterpreterFor (Scoped param effect) r-interpretScoped withResource scopedHandler =-  interpretScopedH withResource \ r e -> liftT (scopedHandler r e)-{-# inline interpretScoped #-}---- | Variant of 'interpretScoped' in which the resource allocator is a plain--- action.-interpretScopedAs ::-  ∀ resource param effect r .-  (param -> Sem r resource) ->-  (∀ m x . resource -> effect m x -> Sem r x) ->-  InterpreterFor (Scoped param effect) r-interpretScopedAs resource =-  interpretScoped \ p use -> use =<< resource p-{-# inline interpretScopedAs #-}---- | Higher-order interpreter for 'Scoped' that allows the handler to use--- additional effects that are interpreted by the resource allocator.------ /Note/: It is necessary to specify the list of local interpreters with a type--- application; GHC won't be able to figure them out from the type of--- @withResource@.------ As an example for a higher order effect, consider a mutexed concurrent state--- effect, where an effectful function may lock write access to the state while--- making it still possible to read it:------ > data MState s :: Effect where--- >   MState :: (s -> m (s, a)) -> MState s m a--- >   MRead :: MState s m s--- >--- > makeSem ''MState------ We can now use an 'Polysemy.AtomicState.AtomicState' to store the current--- value and lock write access with an @MVar@. Since the state callback is--- effectful, we need a higher order interpreter:------ > withResource ::--- >   Member (Embed IO) r =>--- >   s ->--- >   (MVar () -> Sem (AtomicState s : r) a) ->--- >   Sem r a--- > withResource initial use = do--- >   tv <- embed (newTVarIO initial)--- >   lock <- embed (newMVar ())--- >   runAtomicStateTVar tv $ use lock--- >--- > interpretMState ::--- >   ∀ s r .--- >   Members [Resource, Embed IO] r =>--- >   InterpreterFor (Scoped s (MState s)) r--- > interpretMState =--- >   interpretScopedWithH @'[AtomicState s] withResource \ lock -> \case--- >     MState f ->--- >       bracket_ (embed (takeMVar lock)) (embed (tryPutMVar lock ())) do--- >         s0 <- atomicGet--- >         res <- runTSimple (f s0)--- >         Inspector ins <- getInspectorT--- >         for_ (ins res) \ (s, _) -> atomicPut s--- >         pure (snd <$> res)--- >     MRead ->--- >       liftT atomicGet-interpretScopedWithH ::-  ∀ extra resource param effect r r1 .-  KnownList extra =>-  r1 ~ (extra ++ r) =>-  (∀ x . param -> (resource -> Sem r1 x) -> Sem r x) ->-  (∀ r0 x . resource -> effect (Sem r0) x -> Tactical effect (Sem r0) r1 x) ->-  InterpreterFor (Scoped param effect) r-interpretScopedWithH withResource scopedHandler =-  interpretWeaving \case-    Weaving (InScope param main) s wv ex _ ->-      ex <$> withResource param \ resource ->-        interpretH (scopedHandler resource) $ inScope $-          restack-            (injectMembership-             (singList @'[Scoped param effect])-             (singList @(effect : extra))) $ wv (main <$ s)-    _ ->-      errorWithoutStackTrace "top level Run"-  where-    inScope :: InterpreterFor (Scoped param effect) (effect : r1)-    inScope =-      interpretWeaving \case-        Weaving (InScope param main) s wv ex _ ->-          restack-            (extendMembershipLeft (singList @(effect : extra)))-            (ex <$> withResource param \resource ->-                interpretH (scopedHandler resource) $ inScope $ wv (main <$ s))-        Weaving (Run act) s wv ex ins ->-          liftSem $ injWeaving $ Weaving act s (inScope . wv) ex ins-{-# inline interpretScopedWithH #-}---- | First-order variant of 'interpretScopedWithH'.------ /Note/: It is necessary to specify the list of local interpreters with a type--- application; GHC won't be able to figure them out from the type of--- @withResource@:------ > data SomeAction :: Effect where--- >   SomeAction :: SomeAction m ()--- >--- > foo :: InterpreterFor (Scoped () SomeAction) r--- > foo =--- >   interpretScopedWith @[Reader Int, State Bool] localEffects \ () -> \case--- >     SomeAction -> put . (> 0) =<< ask @Int--- >   where--- >     localEffects () use = evalState False (runReader 5 (use ()))-interpretScopedWith ::-  ∀ extra param resource effect r r1 .-  r1 ~ (extra ++ r) =>-  KnownList extra =>-  (∀ x . param -> (resource -> Sem r1 x) -> Sem r x) ->-  (∀ m x . resource -> effect m x -> Sem r1 x) ->-  InterpreterFor (Scoped param effect) r-interpretScopedWith withResource scopedHandler =-  interpretScopedWithH @extra withResource \ r e -> liftT (scopedHandler r e)-{-# inline interpretScopedWith #-}---- | Variant of 'interpretScopedWith' in which no resource is used and the--- resource allocator is a plain interpreter.--- This is useful for scopes that only need local effects, but no resources in--- the handler.------ See the /Note/ on 'interpretScopedWithH'.-interpretScopedWith_ ::-  ∀ extra param effect r r1 .-  r1 ~ (extra ++ r) =>-  KnownList extra =>-  (∀ x . param -> Sem r1 x -> Sem r x) ->-  (∀ m x . effect m x -> Sem r1 x) ->-  InterpreterFor (Scoped param effect) r-interpretScopedWith_ withResource scopedHandler =-  interpretScopedWithH @extra (\ p f -> withResource p (f ())) \ () e -> liftT (scopedHandler e)-{-# inline interpretScopedWith_ #-}---- | Variant of 'interpretScoped' that uses another interpreter instead of a--- handler.------ This is mostly useful if you want to reuse an interpreter that you cannot--- easily rewrite (like from another library). If you have full control over the--- implementation, 'interpretScoped' should be preferred.------ /Note/: In previous versions of Polysemy, the wrapped interpreter was--- executed fully, including the initializing code surrounding its handler,--- for each action in the program. However, new and continuing discoveries--- regarding 'Scoped' has allowed the improvement of having the interpreter be--- used only once per use of 'scoped', and have it cover the same scope of--- actions that @withResource@ does.------ This renders @withResource@ practically redundant; for the moment, the API--- surrounding 'Scoped' remains the same, but work is in progress to revamp the--- entire API of 'Scoped'.-runScoped ::-  ∀ resource param effect r .-  (∀ x . param -> (resource -> Sem r x) -> Sem r x) ->-  (resource -> InterpreterFor effect r) ->-  InterpreterFor (Scoped param effect) r-runScoped withResource scopedInterpreter =-  interpretWeaving \(Weaving effect s wv ex _) -> case effect of-    Run _ -> errorWithoutStackTrace "top level run"-    InScope param main -> withResource param \ resource ->-      ex <$> scopedInterpreter resource (go (raiseUnder $ wv (main <$ s)))-  where-    go :: InterpreterFor (Scoped param effect) (effect : r)-    go =-      interpretWeaving \ (Weaving effect s wv ex ins) -> case effect of-        Run act -> liftSem $ injWeaving $ Weaving act s (go . wv) ex ins-        InScope param main ->-          raise $ withResource param \ resource ->-            ex <$> scopedInterpreter resource (go (wv (main <$ s)))-{-# inline runScoped #-}---- | Variant of 'runScoped' in which the resource allocator returns the resource--- rather tnen calling a continuation.-runScopedAs ::-  ∀ resource param effect r .-  (param -> Sem r resource) ->-  (resource -> InterpreterFor effect r) ->-  InterpreterFor (Scoped param effect) r-runScopedAs resource = runScoped \ p use -> use =<< resource p-{-# inline runScopedAs #-}---- |Combined higher-order interpreter for 'Scoped' and 'Resumable'.--- This allows 'Stop' to be sent from within the resource allocator so that the consumer receives it, terminating the--- entire scope.-interpretScopedResumableH ::-  ∀ param resource effect err r .-  (∀ x . param -> (resource -> Sem (Stop err : r) x) -> Sem (Stop err : r) x) ->-  (∀ r0 x . resource -> effect (Sem r0) x -> Tactical effect (Sem r0) (Stop err : r) x) ->-  InterpreterFor (Scoped param effect !! err) r-interpretScopedResumableH withResource scopedHandler =-  interpretWeaving \case-    Weaving (Resumable (Weaving (InScope param main) s' wv' ex' _)) s wv ex _ -> do-      exResumable s ex ex' $ runStop $ withResource param \ resource ->-        interpretH (scopedHandler resource) (raiseUnder (go $ raiseUnder $ wv ((wv' (main <$ s')) <$ s)))-    _ ->-      errorWithoutStackTrace "top level run"-  where-    go :: InterpreterFor (Scoped param effect !! err) (effect : r)-    go =-      interpretWeaving \ (Weaving (Resumable (Weaving effect s' wv' ex' ins')) s wv ex ins) -> case effect of-        Run act ->-          ex . fmap Right <$> liftSem (weave s (go . wv) ins (injWeaving (Weaving act s' wv' ex' ins')))-        InScope param main -> do-          exResumable s ex ex' $ raise $ runStop $ withResource param \ resource ->-            interpretH (scopedHandler resource) (raiseUnder (go $ wv (wv' (main <$ s') <$ s)))---- |Combined interpreter for 'Scoped' and 'Resumable'.--- This allows 'Stop' to be sent from within the resource allocator so that the consumer receives it, terminating the--- entire scope.-interpretScopedResumable ::-  ∀ param resource effect err r .-  (∀ x . param -> (resource -> Sem (Stop err : r) x) -> Sem (Stop err : r) x) ->-  (∀ r0 x . resource -> effect (Sem r0) x -> Sem (Stop err : r) x) ->-  InterpreterFor (Scoped param effect !! err) r-interpretScopedResumable withResource scopedHandler =-  interpretScopedResumableH withResource \ r e -> liftT (scopedHandler r e)---- |Combined interpreter for 'Scoped' and 'Resumable'.--- This allows 'Stop' to be sent from within the resource allocator so that the consumer receives it, terminating the--- entire scope.--- In this variant, the resource allocator is a plain action.-interpretScopedResumable_ ::-  ∀ param resource effect err r .-  (param -> Sem (Stop err : r) resource) ->-  (∀ r0 x . resource -> effect (Sem r0) x -> Sem (Stop err : r) x) ->-  InterpreterFor (Scoped param effect !! err) r-interpretScopedResumable_ resource =-  interpretScopedResumable \ p use -> use =<< resource p---- |Combined higher-order interpreter for 'Scoped' and 'Resumable' that allows the handler to use additional effects--- that are interpreted by the resource allocator.--- This allows 'Stop' to be sent from within the resource allocator so that the consumer receives it, terminating the--- entire scope.-interpretScopedResumableWithH ::-  ∀ extra param resource effect err r r1 extraerr .-  extraerr ~ (extra ++ '[Stop err]) =>-  r1 ~ (extraerr ++ r) =>-  KnownList (extra ++ '[Stop err]) =>-  (∀ x . param -> (resource -> Sem r1 x) -> Sem (Stop err : r) x) ->-  (∀ r0 x . resource -> effect (Sem r0) x -> Tactical effect (Sem r0) r1 x) ->-  InterpreterFor (Scoped param effect !! err) r-interpretScopedResumableWithH withResource scopedHandler =-  interpretWeaving \case-    Weaving (Resumable (Weaving (InScope param main) s' wv' ex' _)) s wv ex _ -> do-      exResumable s ex ex' $ runStop $ withResource param \ resource ->-        interpretH (scopedHandler resource) $ inScope $-          restack-            (injectMembership-             (singList @'[Scoped param effect !! err])-             (singList @(effect : extraerr))) $ wv (wv' (main <$ s') <$ s)-    _ ->-      errorWithoutStackTrace "top level Run"-  where-    inScope :: InterpreterFor (Scoped param effect !! err) (effect : r1)-    inScope =-      interpretWeaving \ (Weaving (Resumable (Weaving effect s' wv' ex' ins')) s wv ex ins) -> case effect of-        InScope param main ->-          restack-            (extendMembershipLeft (singList @(effect : extraerr))) $-            exResumable s ex ex' $ runStop $ withResource param \ resource ->-              interpretH (scopedHandler resource) (inScope $ wv (wv' (main <$ s') <$ s))-        Run act ->-          ex . fmap Right <$> liftSem (weave s (inScope . wv) ins (injWeaving (Weaving act s' wv' ex' ins')))---- |Combined interpreter for 'Scoped' and 'Resumable' that allows the handler to use additional effects that are--- interpreted by the resource allocator.--- This allows 'Stop' to be sent from within the resource allocator so that the consumer receives it, terminating the--- entire scope.-interpretScopedResumableWith ::-  ∀ extra param resource effect err r r1 .-  r1 ~ ((extra ++ '[Stop err]) ++ r) =>-  KnownList (extra ++ '[Stop err]) =>-  (∀ x . param -> (resource -> Sem r1 x) -> Sem (Stop err : r) x) ->-  (∀ r0 x . resource -> effect (Sem r0) x -> Sem r1 x) ->-  InterpreterFor (Scoped param effect !! err) r-interpretScopedResumableWith withResource scopedHandler =-  interpretScopedResumableWithH @extra withResource \ r e -> liftT (scopedHandler r e)---- |Combined interpreter for 'Scoped' and 'Resumable' that allows the handler to use additional effects that are--- interpreted by the resource allocator.--- This allows 'Stop' to be sent from within the resource allocator so that the consumer receives it, terminating the--- entire scope.--- In this variant, no resource is used and the allocator is a plain interpreter.-interpretScopedResumableWith_ ::-  ∀ extra param effect err r r1 .-  r1 ~ ((extra ++ '[Stop err]) ++ r) =>-  KnownList (extra ++ '[Stop err]) =>-  (∀ x . param -> Sem r1 x -> Sem (Stop err : r) x) ->-  (∀ r0 x . effect (Sem r0) x -> Sem r1 x) ->-  InterpreterFor (Scoped param effect !! err) r-interpretScopedResumableWith_ extra scopedHandler =-  interpretScopedResumableWith @extra (\ p f -> extra p (f ())) (const scopedHandler)---- |Combined higher-order interpreter for 'Resumable' and 'Scoped'.--- In this variant, only the handler may send 'Stop', but this allows resumption to happen on each action inside of the--- scope.-interpretResumableScopedH ::-  ∀ param resource effect err r .-  (∀ x . param -> (resource -> Sem r x) -> Sem r x) ->-  (∀ r0 x . resource -> effect (Sem r0) x -> Tactical (effect !! err) (Sem r0) (Stop err : r) x) ->-  InterpreterFor (Scoped param (effect !! err)) r-interpretResumableScopedH withResource scopedHandler =-  interpretWeaving $ \(Weaving effect s wv ex _) -> case effect of-    Run _ -> errorWithoutStackTrace "top level run"-    InScope param main -> withResource param \ resource ->-      ex <$> interpretResumableH (scopedHandler resource) (inScope $ raiseUnder $ wv (main <$ s))-  where-    inScope :: InterpreterFor (Scoped param (effect !! err)) (effect !! err : r)-    inScope =-      interpretWeaving \ (Weaving effect s wv ex ins) -> case effect of-        Run act -> liftSem $ injWeaving $ Weaving act s (inScope . wv) ex ins-        InScope param main -> raise $ withResource param \ resource ->-          ex <$> interpretResumableH (scopedHandler resource) (inScope $ wv (main <$ s))---- |Combined interpreter for 'Resumable' and 'Scoped'.--- In this variant, only the handler may send 'Stop', but this allows resumption to happen on each action inside of the--- scope.-interpretResumableScoped ::-  ∀ param resource effect err r .-  (∀ x . param -> (resource -> Sem r x) -> Sem r x) ->-  (∀ r0 x . resource -> effect (Sem r0) x -> Sem (Stop err : r) x) ->-  InterpreterFor (Scoped param (effect !! err)) r-interpretResumableScoped withResource scopedHandler =-  interpretResumableScopedH withResource \ r e -> liftT (scopedHandler r e)---- |Combined interpreter for 'Resumable' and 'Scoped'.--- In this variant:--- - Only the handler may send 'Stop', but this allows resumption to happen on each action inside of the scope.--- - The resource allocator is a plain action.-interpretResumableScoped_ ::-  ∀ param resource effect err r .-  (param -> Sem r resource) ->-  (∀ r0 x . resource -> effect (Sem r0) x -> Sem (Stop err : r) x) ->-  InterpreterFor (Scoped param (effect !! err)) r-interpretResumableScoped_ resource =-  interpretResumableScoped \ p use -> use =<< resource p---- |Combined higher-order interpreter for 'Resumable' and 'Scoped' that allows the handler to use additional effects--- that are interpreted by the resource allocator.--- In this variant, only the handler may send 'Stop', but this allows resumption to happen on each action inside of the--- scope.-interpretResumableScopedWithH ::-  ∀ extra param resource effect err r r1 .-  r1 ~ (extra ++ r) =>-  KnownList extra =>-  (∀ x . param -> (resource -> Sem r1 x) -> Sem r x) ->-  (∀ r0 x . resource -> effect (Sem r0) x -> Tactical (effect !! err) (Sem r0) (Stop err : r1) x) ->-  InterpreterFor (Scoped param (effect !! err)) r-interpretResumableScopedWithH withResource scopedHandler =-  interpretWeaving \case-    Weaving (InScope param main) s wv ex _ ->-      ex <$> withResource param \ resource ->-        interpretResumableH (scopedHandler resource) $ inScope $-          restack-            (injectMembership-             (singList @'[Scoped param (effect !! err)])-             (singList @(effect !! err : extra))) $ wv (main <$ s)-    _ ->-      errorWithoutStackTrace "top level Run"-  where-    inScope :: InterpreterFor (Scoped param (effect !! err)) (effect !! err : r1)-    inScope =-      interpretWeaving \case-        Weaving (InScope param main) s wv ex _ ->-          restack-            (extendMembershipLeft (singList @(effect !! err : extra)))-            (ex <$> withResource param \resource ->-                interpretResumableH (scopedHandler resource) $ inScope $ wv (main <$ s))-        Weaving (Run act) s wv ex ins ->-          liftSem $ injWeaving $ Weaving act s (inScope . wv) ex ins---- |Combined interpreter for 'Resumable' and 'Scoped' that allows the handler to use additional effects that are--- interpreted by the resource allocator.--- In this variant, only the handler may send 'Stop', but this allows resumption to happen on each action inside of the--- scope.-interpretResumableScopedWith ::-  ∀ extra param resource effect err r r1 .-  r1 ~ (extra ++ r) =>-  KnownList extra =>-  (∀ x . param -> (resource -> Sem r1 x) -> Sem r x) ->-  (∀ r0 x . resource -> effect (Sem r0) x -> Sem (Stop err : r1) x) ->-  InterpreterFor (Scoped param (effect !! err)) r-interpretResumableScopedWith withResource scopedHandler =-  interpretResumableScopedWithH @extra withResource \ r e -> liftT (scopedHandler r e)---- |Combined interpreter for 'Resumable' and 'Scoped' that allows the handler to use additional effects that are--- interpreted by the resource allocator.--- In this variant:--- - Only the handler may send 'Stop', but this allows resumption to happen on each action inside of the scope.--- - No resource is used and the allocator is a plain interpreter.-interpretResumableScopedWith_ ::-  ∀ extra param effect err r r1 .-  r1 ~ (extra ++ r) =>-  KnownList extra =>-  (∀ x . param -> Sem r1 x -> Sem r x) ->-  (∀ r0 x . effect (Sem r0) x -> Sem (Stop err : r1) x) ->-  InterpreterFor (Scoped param (effect !! err)) r-interpretResumableScopedWith_ extra scopedHandler =-  interpretResumableScopedWith @extra @param @() @effect @err @r @r1 (\ p f -> extra p (f ())) (const scopedHandler)---- |Combined higher-order interpreter for 'Resumable' and 'Scoped'.--- In this variant, both the handler and the scope may send different errors via 'Stop', encoding the concept that the--- resource allocation may fail to prevent the scope from being executed, and each individual scoped action may fail,--- continuing the scope execution on resumption.-interpretScopedRH ::-  ∀ param resource effect eo ei r .-  (∀ x . param -> (resource -> Sem (Stop eo : r) x) -> Sem (Stop eo : r) x) ->-  (∀ r0 x . resource -> effect (Sem r0) x -> Tactical (effect !! ei) (Sem r0) (Stop ei : Stop eo : r) x) ->-  InterpreterFor (Scoped param (effect !! ei) !! eo) r-interpretScopedRH withResource scopedHandler =-  interpretWeaving \case-    Weaving (Resumable (Weaving (InScope param main) s' wv' ex' _)) s wv ex _ -> do-      exResumable s ex ex' $ runStop $ withResource param \ resource ->-        interpretResumableH (scopedHandler resource) (raiseUnder (inScope $ raiseUnder $ wv (wv' (main <$ s') <$ s)))-    _ ->-      errorWithoutStackTrace "top level run"-  where-    inScope :: InterpreterFor (Scoped param (effect !! ei) !! eo) (effect !! ei : r)-    inScope =-      interpretWeaving \ (Weaving (Resumable (Weaving effect s' wv' ex' ins')) s wv ex ins) -> case effect of-        Run act ->-          ex . fmap Right <$> liftSem (weave s (inScope . wv) ins (injWeaving (Weaving act s' wv' ex' ins')))-        InScope param main -> do-          exResumable s ex ex' $ raise $ runStop $ withResource param \ resource ->-            interpretResumableH (scopedHandler resource) (raiseUnder (inScope $ wv (wv' (main <$ s') <$ s)))---- |Combined interpreter for 'Scoped' and 'Resumable'.--- In this variant, both the handler and the scope may send different errors via 'Stop', encoding the concept that the--- resource allocation may fail to prevent the scope from being executed, and each individual scoped action may fail,--- continuing the scope execution on resumption.-interpretScopedR ::-  ∀ param resource effect eo ei r .-  (∀ x . param -> (resource -> Sem (Stop eo : r) x) -> Sem (Stop eo : r) x) ->-  (∀ r0 x . resource -> effect (Sem r0) x -> Sem (Stop ei : Stop eo : r) x) ->-  InterpreterFor (Scoped param (effect !! ei) !! eo) r-interpretScopedR withResource scopedHandler =-  interpretScopedRH withResource \ r e -> liftT (scopedHandler r e)---- |Combined interpreter for 'Scoped' and 'Resumable'.--- In this variant:--- - Both the handler and the scope may send different errors via 'Stop', encoding the concept that the---   resource allocation may fail to prevent the scope from being executed, and each individual scoped action may fail,---   continuing the scope execution on resumption.--- - The resource allocator is a plain action.-interpretScopedR_ ::-  ∀ param resource effect eo ei r .-  (param -> Sem (Stop eo : r) resource) ->-  (∀ r0 x . resource -> effect (Sem r0) x -> Sem (Stop ei : Stop eo : r) x) ->-  InterpreterFor (Scoped param (effect !! ei) !! eo) r-interpretScopedR_ resource =-  interpretScopedR \ p use -> use =<< resource p---- |Combined higher-order interpreter for 'Scoped' and 'Resumable' that allows the handler to use additional effects--- that are interpreted by the resource allocator.--- In this variant, both the handler and the scope may send different errors via 'Stop', encoding the concept that the--- resource allocation may fail to prevent the scope from being executed, and each individual scoped action may fail,--- continuing the scope execution on resumption.-interpretScopedRWithH ::-  ∀ extra param resource effect eo ei r r1 extraerr .-  extraerr ~ (extra ++ '[Stop eo]) =>-  r1 ~ (extra ++ Stop eo : r) =>-  r1 ~ ((extra ++ '[Stop eo]) ++ r) =>-  KnownList (extra ++ '[Stop eo]) =>-  (∀ x . param -> (resource -> Sem (extra ++ Stop eo : r) x) -> Sem (Stop eo : r) x) ->-  (∀ r0 x . resource -> effect (Sem r0) x -> Tactical (effect !! ei) (Sem r0) (Stop ei : r1) x) ->-  InterpreterFor (Scoped param (effect !! ei) !! eo) r-interpretScopedRWithH withResource scopedHandler =-  interpretWeaving \case-    Weaving (Resumable (Weaving (InScope param main) s' wv' ex' _)) s wv ex _ -> do-      exResumable s ex ex' $ runStop $ withResource param \ resource ->-        interpretResumableH (scopedHandler resource) $ inScope $-          restack-            (injectMembership-             (singList @'[Scoped param (effect !! ei) !! eo])-             (singList @(effect !! ei : extraerr))) $ wv (wv' (main <$ s') <$ s)-    _ ->-      errorWithoutStackTrace "top level Run"-  where-    inScope :: InterpreterFor (Scoped param (effect !! ei) !! eo) (effect !! ei : r1)-    inScope =-      interpretWeaving \ (Weaving (Resumable (Weaving effect s' wv' ex' ins')) s wv ex ins) -> case effect of-        InScope param main ->-          exResumable s ex ex' $-          restack (extendMembershipLeft (singList @(effect !! ei : extraerr))) $-          runStop $-          withResource param \ resource ->-            interpretResumableH (scopedHandler resource) (inScope $ wv (wv' (main <$ s') <$ s))-        Run act ->-          ex . fmap Right <$> liftSem (weave s (inScope . wv) ins (injWeaving (Weaving act s' wv' ex' ins')))---- |Combined interpreter for 'Scoped' and 'Resumable' that allows the handler to use additional effects that are--- interpreted by the resource allocator.--- In this variant, both the handler and the scope may send different errors via 'Stop', encoding the concept that the--- resource allocation may fail to prevent the scope from being executed, and each individual scoped action may fail,--- continuing the scope execution on resumption.-interpretScopedRWith ::-  ∀ extra param resource effect eo ei r r1 .-  r1 ~ (extra ++ Stop eo : r) =>-  r1 ~ ((extra ++ '[Stop eo]) ++ r) =>-  KnownList (extra ++ '[Stop eo]) =>-  (∀ x . param -> (resource -> Sem r1 x) -> Sem (Stop eo : r) x) ->-  (∀ r0 x . resource -> effect (Sem r0) x -> Sem (Stop ei : r1) x) ->-  InterpreterFor (Scoped param (effect !! ei) !! eo) r-interpretScopedRWith withResource scopedHandler =-  interpretScopedRWithH @extra withResource \ r e -> liftT (scopedHandler r e)---- |Combined interpreter for 'Scoped' and 'Resumable' that allows the handler to use additional effects that are--- interpreted by the resource allocator.--- - Both the handler and the scope may send different errors via 'Stop', encoding the concept that the---   resource allocation may fail to prevent the scope from being executed, and each individual scoped action may fail,---   continuing the scope execution on resumption.--- - The resource allocator is a plain action.-interpretScopedRWith_ ::-  ∀ extra param effect eo ei r r1 .-  r1 ~ (extra ++ Stop eo : r) =>-  r1 ~ ((extra ++ '[Stop eo]) ++ r) =>-  KnownList (extra ++ '[Stop eo]) =>-  (∀ x . param -> Sem r1 x -> Sem (Stop eo : r) x) ->-  (∀ r0 x . effect (Sem r0) x -> Sem (Stop ei : r1) x) ->-  InterpreterFor (Scoped param (effect !! ei) !! eo) r-interpretScopedRWith_ extra scopedHandler =-  interpretScopedRWith @extra (\ p f -> extra p (f ())) (const scopedHandler)

@@ -1,4 +1,4 @@--- |Semaphore interpreters, Internal.+-- | Semaphore interpreters, Internal. module Polysemy.Conc.Interpreter.Semaphore where  import Control.Concurrent (QSem, newQSem, signalQSem, waitQSem)@@ -8,7 +8,7 @@ import qualified Polysemy.Conc.Effect.Semaphore as Semaphore import Polysemy.Conc.Effect.Semaphore (Semaphore) --- |Interpret 'Semaphore' using the supplied 'QSem'.+-- | Interpret 'Semaphore' using the supplied 'QSem'. interpretSemaphoreQWith ::   Member (Embed IO) r =>   QSem ->@@ -21,7 +21,7 @@       embed (signalQSem qsem) {-# inline interpretSemaphoreQWith #-} --- |Interpret 'Semaphore' as a 'QSem'.+-- | Interpret 'Semaphore' as a 'QSem'. interpretSemaphoreQ ::   Member (Embed IO) r =>   Int ->@@ -31,7 +31,7 @@   interpretSemaphoreQWith qsem sem {-# inline interpretSemaphoreQ #-} --- |Interpret 'Semaphore' using the supplied 'TSem'.+-- | Interpret 'Semaphore' using the supplied 'TSem'. interpretSemaphoreTWith ::   Member (Embed IO) r =>   TSem ->@@ -44,7 +44,7 @@       embed (atomically (signalTSem qsem)) {-# inline interpretSemaphoreTWith #-} --- |Interpret 'Semaphore' as a 'TSem'.+-- | Interpret 'Semaphore' as a 'TSem'. interpretSemaphoreT ::   Member (Embed IO) r =>   Integer ->

@@ -1,6 +1,6 @@ {-# options_haddock prune #-} --- |Description: Convenience Interpreters for all Conc Effects, Internal+-- | Description: Convenience Interpreters for all Conc Effects, Internal module Polysemy.Conc.Interpreter.Stack where  import Polysemy.Conc.Effect.Gate (Gates)@@ -10,7 +10,7 @@ import Polysemy.Conc.Interpreter.Mask (interpretMaskFinal, interpretUninterruptibleMaskFinal) import Polysemy.Conc.Interpreter.Race (interpretRace) --- |A default basic stack with 'Final' for _polysemy-conc_.+-- | A default basic stack with 'Final' for _polysemy-conc_. type ConcStack =   [     UninterruptibleMask,@@ -23,7 +23,7 @@     Final IO   ] --- |Interprets 'UninterruptibleMask', 'Mask' and 'Race' in terms of @'Final' 'IO'@ and runs the entire rest of the+-- | Interprets 'UninterruptibleMask', 'Mask' and 'Race' in terms of @'Final' 'IO'@ and runs the entire rest of the -- stack. runConc ::   Sem ConcStack a ->

@@ -1,4 +1,4 @@--- |Description: Sync Interpreters+-- | Description: Sync Interpreters module Polysemy.Conc.Interpreter.Sync where  import Polysemy.Conc.Effect.Race (Race)@@ -6,7 +6,7 @@ import Polysemy.Conc.Effect.Sync (Sync) import qualified Polysemy.Conc.Race as Race --- |Interpret 'Sync' with the provided 'MVar'.+-- | Interpret 'Sync' with the provided 'MVar'. interpretSyncWith ::   ∀ d r .   Members [Race, Embed IO] r =>@@ -35,7 +35,7 @@     Sync.Empty ->       embed (isEmptyMVar var) --- |Interpret 'Sync' with an empty 'MVar'.+-- | Interpret 'Sync' with an empty 'MVar'. interpretSync ::   ∀ d r .   Members [Race, Embed IO] r =>@@ -44,7 +44,7 @@   var <- embed newEmptyMVar   interpretSyncWith var sem --- |Interpret 'Sync' with an 'MVar' containing the specified value.+-- | Interpret 'Sync' with an 'MVar' containing the specified value. interpretSyncAs ::   ∀ d r .   Members [Race, Embed IO] r =>@@ -54,7 +54,7 @@   var <- embed (newMVar d)   interpretSyncWith var sem --- |Interpret 'Sync' for locally scoped use with an empty 'MVar'.+-- | Interpret 'Sync' for locally scoped use with an empty 'MVar'. interpretScopedSync ::   ∀ d r .   Members [Resource, Race, Embed IO] r =>@@ -62,7 +62,7 @@ interpretScopedSync =   runScopedAs (const (embed newEmptyMVar)) \ r -> interpretSyncWith r --- |Interpret 'Sync' for locally scoped use with an 'MVar' containing the specified value.+-- | Interpret 'Sync' for locally scoped use with an 'MVar' containing the specified value. interpretScopedSyncAs ::   ∀ d r .   Members [Resource, Race, Embed IO] r =>

@@ -1,4 +1,4 @@--- |Description: Interpreter for 'SyncRead' that reinterprets to 'Sync'.+-- | Description: Interpreter for 'SyncRead' that reinterprets to 'Sync'. module Polysemy.Conc.Interpreter.SyncRead where  import qualified Polysemy.Conc.Effect.Sync as Sync@@ -6,7 +6,7 @@ import qualified Polysemy.Conc.Effect.SyncRead as SyncRead import Polysemy.Conc.Effect.SyncRead (SyncRead) --- |Run 'SyncRead' in terms of 'Sync'.+-- | Run 'SyncRead' in terms of 'Sync'. syncRead ::   ∀ d r .   Member (Sync d) r =>

@@ -1,6 +1,6 @@ {-# options_haddock prune #-} --- |Description: Monitor Implementations, Internal+-- | Description: Monitor Implementations, Internal module Polysemy.Conc.Monitor where  import qualified Polysemy.Time as Time@@ -9,7 +9,7 @@  import Polysemy.Conc.Effect.Monitor (MonitorCheck (MonitorCheck)) --- |Config for 'monitorClockSkew'.+-- | Config for 'monitorClockSkew'. data ClockSkewConfig =   ClockSkewConfig {     interval :: NanoSeconds,@@ -17,7 +17,7 @@   }   deriving stock (Eq, Show) --- |Smart constructor for 'ClockSkewConfig' that takes arbitrary 'TimeUnit's.+-- | Smart constructor for 'ClockSkewConfig' that takes arbitrary 'TimeUnit's. clockSkewConfig ::   TimeUnit u1 =>   TimeUnit u2 =>@@ -31,7 +31,7 @@   def =     clockSkewConfig (Minutes 1) (Seconds 5) --- |Check for 'Polysemy.Conc.Effect.Monitor' that checks every @interval@ whether the difference between the current+-- | Check for 'Polysemy.Conc.Effect.Monitor' that checks every @interval@ whether the difference between the current -- time and the time at the last check is larger than @interval@ + @tolerance@. -- Can be used to detect that the operating system suspended and resumed. monitorClockSkew ::

@@ -1,5 +1,5 @@ {-# options_haddock prune #-}--- |Description: Queue Combinators+-- | Description: Queue Combinators module Polysemy.Conc.Queue (   module Polysemy.Conc.Queue,   module Polysemy.Conc.Effect.Queue,@@ -24,7 +24,7 @@   ) import Polysemy.Conc.Queue.Result (resultToMaybe) --- |Read from a 'Queue' repeatedly until it is closed.+-- | Read from a 'Queue' repeatedly until it is closed. -- -- When an element is received, call @action@ and recurse if it returns 'True'. -- When no element is available, evaluate @na@ and recurse if it returns 'True'.@@ -42,7 +42,7 @@         QueueResult.NotAvailable -> whenM na spin         QueueResult.Closed -> unit --- |Read from a 'Queue' repeatedly until it is closed.+-- | Read from a 'Queue' repeatedly until it is closed. -- -- When an element is received, call @action@ and recurse. loop ::@@ -52,7 +52,7 @@ loop action =   loopOr (pure True) \ d -> True <$ action d --- |Read from a 'Queue' and convert the result to 'Maybe', returning 'Nothing' if the queue has been closed, and+-- | Read from a 'Queue' and convert the result to 'Maybe', returning 'Nothing' if the queue has been closed, and -- blocking until an element is available. readMaybe ::   Member (Queue d) r =>@@ -60,7 +60,7 @@ readMaybe =   resultToMaybe <$> read --- |Read from a 'Queue' and convert the result to 'Maybe', returning 'Nothing' if there is no element available or the+-- | Read from a 'Queue' and convert the result to 'Maybe', returning 'Nothing' if there is no element available or the -- queue has been closed. tryReadMaybe ::   Member (Queue d) r =>

@@ -38,7 +38,7 @@   Just True -> QueueResult.Success () {-# inline closedBoolResult #-} --- |Turn a 'QueueResult.Success' into 'Just'.+-- | Turn a 'QueueResult.Success' into 'Just'. resultToMaybe :: QueueResult d -> Maybe d resultToMaybe = \case   QueueResult.Success d -> Just d

@@ -1,4 +1,4 @@--- |Description: Timeout Helper+-- | Description: Timeout Helper module Polysemy.Conc.Queue.Timeout where  import Control.Concurrent.STM (STM, atomically)@@ -9,7 +9,7 @@ import Polysemy.Conc.Effect.Race (Race) import qualified Polysemy.Conc.Race as Race --- |Run an 'STM' action atomically with a time limit+-- | Run an 'STM' action atomically with a time limit withTimeout ::   TimeUnit t =>   Members [Race, Embed IO] r =>

@@ -1,4 +1,4 @@--- |Description: Race Combinators+-- | Description: Race Combinators module Polysemy.Conc.Race where  import Polysemy.Time (TimeUnit)@@ -7,7 +7,7 @@ import Polysemy.Conc.Effect.Race (Race) import Polysemy.Resume (Stop, stop) --- |Specialization of 'Race.race' for the case where both actions return the same type, obviating the need for 'Either'.+-- | Specialization of 'Race.race' for the case where both actions return the same type, obviating the need for 'Either'. race_ ::   Member Race r =>   Sem r a ->@@ -17,7 +17,7 @@   unify <$> Race.race ml mr {-# inline race_ #-} --- |Specialization of 'Race.timeout' for the case where the main action returns the same type as the fallback, obviating+-- | Specialization of 'Race.timeout' for the case where the main action returns the same type as the fallback, obviating -- the need for 'Either'. timeout_ ::   TimeUnit u =>@@ -30,7 +30,7 @@   unify <$> Race.timeout err interval ma {-# inline timeout_ #-} --- |Version of `Race.timeout` that takes a pure fallback value.+-- | Version of `Race.timeout` that takes a pure fallback value. timeoutAs ::   TimeUnit u =>   Member Race r =>@@ -42,7 +42,7 @@   Race.timeout (pure err) {-# inline timeoutAs #-} --- |Specialization of 'timeoutAs' for the case where the main action return the same type as the fallback, obviating the+-- | Specialization of 'timeoutAs' for the case where the main action return the same type as the fallback, obviating the -- need for 'Either'. timeoutAs_ ::   TimeUnit u =>@@ -55,7 +55,7 @@   timeout_ (pure err) {-# inline timeoutAs_ #-} --- |Specialization of 'Race.timeout' for unit actions.+-- | Specialization of 'Race.timeout' for unit actions. timeoutU ::   TimeUnit u =>   Member Race r =>@@ -66,7 +66,7 @@   timeout_ unit {-# inline timeoutU #-} --- |Variant of 'Race.timeout' that returns 'Maybe'.+-- | Variant of 'Race.timeout' that returns 'Maybe'. timeoutMaybe ::   TimeUnit u =>   Member Race r =>@@ -77,7 +77,7 @@   timeoutAs_ Nothing u (Just <$> ma) {-# inline timeoutMaybe #-} --- |Variant of 'Race.timeout' that calls 'Stop' with the supplied error when the action times out.+-- | Variant of 'Race.timeout' that calls 'Stop' with the supplied error when the action times out. timeoutStop ::   TimeUnit u =>   Members [Race, Stop err] r =>

@@ -1,4 +1,4 @@--- |Description: Action Retrying+-- | Description: Action Retrying module Polysemy.Conc.Retry where  import qualified Polysemy.Time as Time@@ -9,15 +9,15 @@ import Polysemy.Conc.Interpreter.Sync (interpretSync) import qualified Polysemy.Conc.Race as Race --- |Run an action repeatedly until it returns 'Right' or the timout has been exceeded.+-- | Run an action repeatedly until it returns 'Right' or the timout has been exceeded. retrying ::   ∀ e w u t d r a .   TimeUnit w =>   TimeUnit u =>   Members [Race, Time t d] r =>-  -- |The timeout after which the attempt is abandoned.+  -- | The timeout after which the attempt is abandoned.   w ->-  -- |The waiting interval between two tries.+  -- | The waiting interval between two tries.   u ->   Sem r (Either e a) ->   Sem r (Maybe a)@@ -32,7 +32,7 @@           Time.sleep @t @d interval           spin --- |Run an action repeatedly until it returns 'Right' or the timout has been exceeded.+-- | Run an action repeatedly until it returns 'Right' or the timout has been exceeded. -- -- If the action failed at least once, the last error will be returned in case of timeout. retryingWithError ::@@ -40,9 +40,9 @@   TimeUnit w =>   TimeUnit u =>   Members [Race, Time t d, Embed IO] r =>-  -- |The timeout after which the attempt is abandoned.+  -- | The timeout after which the attempt is abandoned.   w ->-  -- |The waiting interval between two tries.+  -- | The waiting interval between two tries.   u ->   Sem r (Either e a) ->   Sem r (Maybe (Either e a))

@@ -1,4 +1,4 @@--- |A quantity semaphore effect.+-- | A quantity semaphore effect. module Polysemy.Conc.Semaphore (   Semaphore,   interpretSemaphoreQ,

@@ -1,6 +1,6 @@ {-# options_haddock prune #-} --- |Description: Sync Combinators+-- | Description: Sync Combinators module Polysemy.Conc.Sync (   module Polysemy.Conc.Sync,   module Polysemy.Conc.Effect.Sync,@@ -13,7 +13,7 @@ import qualified Polysemy.Conc.Effect.Sync as Sync import Polysemy.Conc.Effect.Sync --- |Run an action repeatedly until the 'Sync' variable is available.+-- | Run an action repeatedly until the 'Sync' variable is available. whileEmpty ::   ∀ a r .   Member (Sync a) r =>@@ -26,7 +26,7 @@       action       whenM (not <$> Sync.empty @a) spin --- |Run an action repeatedly until the 'Sync' variable is available, waiting for the specified time between executions.+-- | Run an action repeatedly until the 'Sync' variable is available, waiting for the specified time between executions. whileEmptyInterval ::   ∀ a u t d r .   TimeUnit u =>@@ -41,7 +41,7 @@       action       whenM (not <$> Sync.empty @a) (Time.sleep @t @d interval *> spin) --- |Run an action with a locally scoped 'Sync' variable.+-- | Run an action with a locally scoped 'Sync' variable. -- -- This avoids a dependency on @'Embed' 'IO'@ in application logic while still allowing the variable to be scoped. withSync ::@@ -51,7 +51,7 @@ withSync =   scoped_ --- |Run the action @ma@ with an exclusive lock (mutex).+-- | Run the action @ma@ with an exclusive lock (mutex). -- When multiple threads call the action concurrently, only one is allowed to execute it at a time. -- The value @l@ is used to disambiguate the 'Sync' from other uses of the combinator. -- You can pass in something like @Proxy @"db-write"@.@@ -67,7 +67,7 @@   finally (takeBlock @l *> ma) (putTry l) {-# inline lock #-} --- |Remove the content of the 'Sync' variable if it is present.+-- | Remove the content of the 'Sync' variable if it is present. clear ::   ∀ a r .   Member (Sync a) r =>@@ -76,7 +76,7 @@   void (takeTry @a) {-# inline clear #-} --- |Modify a 'Sync' variable with async exceptions masked for the 'Sync' operations, but not the action.+-- | Modify a 'Sync' variable with async exceptions masked for the 'Sync' operations, but not the action. -- Allows a value to be returned. -- Equivalent to 'Control.Concurrent.MVar.modifyMVar'. modify ::@@ -91,7 +91,7 @@     b <$ putBlock a' {-# inline modify #-} --- |Modify a 'Sync' variable with async exceptions masked for the 'Sync' operations, but not the action.+-- | Modify a 'Sync' variable with async exceptions masked for the 'Sync' operations, but not the action. -- Does not allow a value to be returned. -- Equivalent to 'Control.Concurrent.MVar.modifyMVar_'. modify_ ::@@ -106,7 +106,7 @@     putBlock a' {-# inline modify_ #-} --- |Modify a 'Sync' variable with async exceptions masked for the entire procedure.+-- | Modify a 'Sync' variable with async exceptions masked for the entire procedure. -- Allows a value to be returned. -- Equivalent to 'Control.Concurrent.MVar.modifyMVarMasked'. modifyMasked ::@@ -121,7 +121,7 @@     b <$ putBlock a' {-# inline modifyMasked #-} --- |Modify a 'Sync' variable with async exceptions masked for the entire procedure.+-- | Modify a 'Sync' variable with async exceptions masked for the entire procedure. -- Does not allow a value to be returned. -- Equivalent to 'Control.Concurrent.MVar.modifyMVarMasked_'. modifyMasked_ ::@@ -136,7 +136,7 @@     putBlock a' {-# inline modifyMasked_ #-} --- |Run an action with the current value of the 'Sync' variable with async exceptions masked for the 'Sync' operations,+-- | Run an action with the current value of the 'Sync' variable with async exceptions masked for the 'Sync' operations, -- but not the action. -- Equivalent to 'Control.Concurrent.MVar.withMVar'. use ::@@ -150,7 +150,7 @@     finally (restore (raise (m a))) (putBlock a) {-# inline use #-} --- |Run an action with the current value of the 'Sync' variable with async exceptions masked for the entire procedure.+-- | Run an action with the current value of the 'Sync' variable with async exceptions masked for the entire procedure. -- Equivalent to 'Control.Concurrent.MVar.withMVarMasked'. useMasked ::   ∀ a b r .

@@ -1,6 +1,6 @@ {-# options_haddock prune #-} --- |Description: API and combinators for 'SyncRead'.+-- | Description: API and combinators for 'SyncRead'. module Polysemy.Conc.SyncRead (   module Polysemy.Conc.SyncRead,   module Polysemy.Conc.Effect.SyncRead,@@ -12,7 +12,7 @@ import qualified Polysemy.Conc.Effect.SyncRead as SyncRead import Polysemy.Conc.Effect.SyncRead (SyncRead, block, empty, try, wait) --- |Run an action repeatedly until the 'SyncRead' variable is available.+-- | Run an action repeatedly until the 'SyncRead' variable is available. whileEmpty ::   ∀ a r .   Member (SyncRead a) r =>@@ -25,7 +25,7 @@       action       whenM (not <$> SyncRead.empty @a) spin --- |Run an action repeatedly until the 'SyncRead' variable is available, waiting for the specified time between executions.+-- | Run an action repeatedly until the 'SyncRead' variable is available, waiting for the specified time between executions. whileEmptyInterval ::   ∀ a u t d r .   TimeUnit u =>

@@ -1,11 +1,11 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.35.2.+-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack  name:           polysemy-conc-version:        0.13.0.1+version:        0.14.0.0 synopsis:       Polysemy effects for concurrency description:    See https://hackage.haskell.org/package/polysemy-conc/docs/Polysemy-Conc.html category:       Concurrency@@ -34,13 +34,11 @@       Polysemy.Conc.Effect.Critical       Polysemy.Conc.Effect.Events       Polysemy.Conc.Effect.Gate-      Polysemy.Conc.Effect.Interrupt       Polysemy.Conc.Effect.Lock       Polysemy.Conc.Effect.Mask       Polysemy.Conc.Effect.Monitor       Polysemy.Conc.Effect.Queue       Polysemy.Conc.Effect.Race-      Polysemy.Conc.Effect.Scoped       Polysemy.Conc.Effect.Semaphore       Polysemy.Conc.Effect.Sync       Polysemy.Conc.Effect.SyncRead@@ -49,7 +47,6 @@       Polysemy.Conc.Interpreter.Critical       Polysemy.Conc.Interpreter.Events       Polysemy.Conc.Interpreter.Gate-      Polysemy.Conc.Interpreter.Interrupt       Polysemy.Conc.Interpreter.Lock       Polysemy.Conc.Interpreter.Mask       Polysemy.Conc.Interpreter.Monitor@@ -57,7 +54,6 @@       Polysemy.Conc.Interpreter.Queue.TB       Polysemy.Conc.Interpreter.Queue.TBM       Polysemy.Conc.Interpreter.Race-      Polysemy.Conc.Interpreter.Scoped       Polysemy.Conc.Interpreter.Semaphore       Polysemy.Conc.Interpreter.Stack       Polysemy.Conc.Interpreter.Sync@@ -88,6 +84,7 @@       GADTs       LambdaCase       LiberalTypeSynonyms+      MonadComprehensions       MultiWayIf       OverloadedLabels       OverloadedLists@@ -110,18 +107,16 @@       NoFieldSelectors   ghc-options: -Wall -Widentities -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wredundant-constraints -Wunused-type-patterns -Wunused-packages   build-depends:-      async-    , base ==4.*-    , containers-    , incipit-core ==0.5.*-    , polysemy ==1.9.*-    , polysemy-resume >=0.7 && <0.9-    , polysemy-time ==0.6.*-    , stm-    , stm-chans >=3 && <3.1+      async >=2.2.4 && <2.3+    , base >=4.17.2.1 && <4.20+    , incipit-core >=0.4.1.0 && <0.7+    , polysemy >=1.9.0.0 && <1.10+    , polysemy-resume >=0.5.0.0 && <0.10+    , polysemy-time >=0.5.1.0 && <0.8+    , stm >=2.5.1.0 && <2.6+    , stm-chans >=2.0.0 && <3.1     , torsor ==0.1.*-    , unagi-chan ==0.4.*-    , unix+    , unagi-chan >=0.4.1.3 && <0.5   mixins:       base hiding (Prelude)     , incipit-core (IncipitCore as Prelude)@@ -133,7 +128,6 @@   main-is: Main.hs   other-modules:       Polysemy.Conc.Test.EventsTest-      Polysemy.Conc.Test.InterruptTest       Polysemy.Conc.Test.LockTest       Polysemy.Conc.Test.MaskTest       Polysemy.Conc.Test.MonitorTest@@ -156,6 +150,7 @@       GADTs       LambdaCase       LiberalTypeSynonyms+      MonadComprehensions       MultiWayIf       OverloadedLabels       OverloadedLists@@ -178,20 +173,18 @@       NoFieldSelectors   ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Widentities -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wredundant-constraints -Wunused-type-patterns -Wunused-packages   build-depends:-      async-    , base ==4.*-    , hedgehog >=1.1 && <1.3-    , incipit-core ==0.5.*-    , polysemy ==1.9.*+      async >=2.2.4 && <2.3+    , base >=4.17.2.1 && <4.20+    , hedgehog >=1.1.2 && <1.5+    , incipit-core >=0.4.1.0 && <0.7+    , polysemy >=1.9.0.0 && <1.10     , polysemy-conc-    , polysemy-plugin >=0.4.4 && <0.5-    , polysemy-test >=0.6 && <0.10-    , polysemy-time ==0.6.*-    , stm-    , tasty ==1.4.*-    , tasty-hedgehog >=1.3 && <1.5-    , time-    , unix+    , polysemy-plugin >=0.4.4.0 && <0.5+    , polysemy-test >=0.3.1.6 && <0.11+    , polysemy-time >=0.5.1.0 && <0.8+    , tasty >=1.4.2 && <1.5+    , tasty-hedgehog >=1.3.0.0 && <1.5+    , time >=1.12.2 && <1.13   mixins:       base hiding (Prelude)     , incipit-core (IncipitCore as Prelude)

@@ -1,6 +1,6 @@ # About -This library provides [Polysemy] effects for using STM queues, MVars, signal handling and racing.+This library provides [Polysemy] effects for using STM queues, MVars and racing.  Please visit [Hackage] for documentation. 

@@ -2,7 +2,6 @@  import Hedgehog (property, test, withTests) import Polysemy.Conc.Test.EventsTest (test_events)-import Polysemy.Conc.Test.InterruptTest (test_interrupt) import Polysemy.Conc.Test.LockTest (test_lock) import Polysemy.Conc.Test.MaskTest (test_mask) import Polysemy.Conc.Test.MonitorTest (test_monitorBasic, test_monitorClockSkew)@@ -38,9 +37,6 @@       unitTest "lock" test_syncLock     ],     test_lock,-    testGroup "interrupt" [-      unitTest "interrupt" test_interrupt-    ],     testGroup "mask" [       unitTest "mask" test_mask     ],

@@ -1,31 +0,0 @@-module Polysemy.Conc.Test.InterruptTest where--import Control.Concurrent.STM (TVar, atomically, modifyTVar, newTVarIO, readTVarIO)-import Polysemy.Test (UnitTest, assertEq, runTestAuto)-import System.Posix (Handler (CatchInfoOnce), SignalInfo, installHandler, keyboardSignal, raiseSignal)--import qualified Polysemy.Conc.Effect.Interrupt as Interrupt-import Polysemy.Conc.Interpreter.Critical (interpretCritical)-import Polysemy.Conc.Interpreter.Interrupt (interpretInterrupt)-import Polysemy.Conc.Interpreter.Race (interpretRace)--handler :: MVar () -> TVar Int -> SignalInfo -> IO ()-handler mv tv _ = do-  atomically (modifyTVar tv (5 +))-  putMVar mv ()--test_interrupt :: UnitTest-test_interrupt = do-  runTestAuto do-    tv <- embed (newTVarIO 0)-    mv <- embed newEmptyMVar-    embed (installHandler keyboardSignal (CatchInfoOnce (handler mv tv)) Nothing)-    asyncToIOFinal $ interpretCritical $ interpretRace $ interpretInterrupt do-      Interrupt.register "test 1" do-        atomically (modifyTVar tv (3 +))-      Interrupt.register "test 2" do-        atomically (modifyTVar tv (9 +))-      embed (raiseSignal keyboardSignal)-    embed (takeMVar mv)-    result <- embed (readTVarIO tv)-    assertEq @_ @IO 17 result