polysemy-conc 0.6.0.1 → 0.6.1.0

raw patch · 21 files changed

+122/−49 lines, 21 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• changelog.md +8/−0
• lib/Polysemy/Conc.hs +4/−0
• lib/Polysemy/Conc/Async.hs +8/−6
• lib/Polysemy/Conc/Effect/Critical.hs +1/−1
• lib/Polysemy/Conc/Effect/Monitor.hs +0/−1
• lib/Polysemy/Conc/Effect/Sync.hs +1/−6
• lib/Polysemy/Conc/Effect/SyncRead.hs +19/−0
• lib/Polysemy/Conc/Interpreter/Critical.hs +0/−1
• lib/Polysemy/Conc/Interpreter/Interrupt.hs +0/−2
• lib/Polysemy/Conc/Interpreter/Monitor.hs +0/−1
• lib/Polysemy/Conc/Interpreter/Scoped.hs +0/−1
• lib/Polysemy/Conc/Interpreter/Sync.hs +0/−19
• lib/Polysemy/Conc/Interpreter/SyncRead.hs +24/−0
• lib/Polysemy/Conc/Monitor.hs +0/−1
• lib/Polysemy/Conc/Sync.hs +11/−4
• lib/Polysemy/Conc/SyncRead.hs +41/−0
• polysemy-conc.cabal +4/−1
• test/Polysemy/Conc/Test/InterruptTest.hs +0/−1
• test/Polysemy/Conc/Test/MonitorTest.hs +0/−1
• test/Polysemy/Conc/Test/QueueTest.hs +1/−2
• test/Polysemy/Conc/Test/SyncTest.hs +0/−1

@@ -1,5 +1,13 @@ # Unreleased +# 0.6.1.0++* Add `SyncRead`, a read-only variant of `Sync`.+* Change `withAsync` to use `finally` instead of `bracket`, since the latter causes `AsyncCancelled` to be masked,+  preventing the action from being cancelled unless it runs an interruptible action.++# 0.6.0.0+ * Add `Resumable` support for `Scoped`. * Add `Scoped` interpreters that allow the allocator to interpret additional effects used by the handler. 

@@ -24,6 +24,7 @@   -- * MVars   -- $mvar   Sync,+  SyncRead,   ScopedSync,    -- ** Interpreters@@ -33,6 +34,7 @@   lock,   interpretScopedSync,   interpretScopedSyncAs,+  syncRead,    -- * Racing   -- $race@@ -194,6 +196,8 @@ import Polysemy.Conc.Race (race_, timeoutAs, timeoutAs_, timeoutMaybe, timeoutU, timeout_) import Polysemy.Conc.Retry (retrying, retryingWithError) import Polysemy.Conc.Sync (lock, withSync)+import Polysemy.Conc.Effect.SyncRead (SyncRead)+import Polysemy.Conc.Interpreter.SyncRead (syncRead)  -- $intro -- This library provides an assortment of tools for concurrency-related tasks:

@@ -20,8 +20,9 @@   Sem r b ->   (Base.Async (Maybe b) -> Sem r a) ->   Sem r a-withAsyncBlock mb =-  bracket (async mb) cancel+withAsyncBlock mb use = do+  handle <- async mb+  finally (use handle) (cancel handle)  -- |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.@@ -34,8 +35,9 @@   Sem r b ->   (Base.Async (Maybe b) -> Sem r a) ->   Sem r a-withAsyncWait interval mb =-  bracket (async mb) (Race.timeoutU interval . cancel)+withAsyncWait interval mb use = do+  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. -- Passes the handle into the action to allow it to await its result.@@ -86,7 +88,7 @@ scheduleAsync mb f =   withSync @() @res do     h <- async do-      Sync.readBlock @()+      Sync.block @()       raise mb     f h (Sync.putBlock ()) @@ -100,6 +102,6 @@ scheduleAsyncIO mb f =   interpretSync @() do     h <- async do-      Sync.readBlock @()+      Sync.block @()       raise mb     f h (Sync.putBlock ())

@@ -3,7 +3,7 @@ -- |Description: Critical effect module Polysemy.Conc.Effect.Critical where -import Prelude hiding (catch, run)+import Prelude hiding (catch)  -- |An effect that catches exceptions. --

@@ -3,7 +3,6 @@ -- |Description: Monitor Effect, Internal module Polysemy.Conc.Effect.Monitor where -import Control.Concurrent (MVar) import Polysemy.Time (NanoSeconds)  import Polysemy.Conc.Effect.Scoped (Scoped, scoped)

@@ -1,4 +1,5 @@ {-# options_haddock prune #-}+ -- |Description: Sync effect module Polysemy.Conc.Effect.Sync where @@ -31,12 +32,6 @@   TakeWait :: TimeUnit u => u -> Sync d m (Maybe d)   -- |Take the variable, returning 'Nothing' immmediately if no value was available.   TakeTry :: Sync d m (Maybe d)-  -- |Read the variable, waiting until a value is available.-  ReadBlock :: Sync d m d-  -- |Read the variable, waiting until a value is available or the timeout has expired.-  ReadWait :: TimeUnit u => u -> Sync d m (Maybe d)-  -- |Read the variable, returning 'Nothing' immmediately if no value was available.-  ReadTry :: Sync d m (Maybe d)   -- |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.

@@ -0,0 +1,19 @@+{-# options_haddock prune #-}++-- |The effect 'SyncRead' is equivalent to 'Polysemy.Conc.Sync' without the write actions.+module Polysemy.Conc.Effect.SyncRead where++import Polysemy.Time (TimeUnit)++-- |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.+  Block :: SyncRead d m d+  -- |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.+  Try :: SyncRead d m (Maybe d)+  -- |Indicate whether the variable is empty.+  Empty :: SyncRead d m Bool++makeSem ''SyncRead

@@ -3,7 +3,6 @@  import qualified Control.Exception as Exception import Polysemy.Final (getInitialStateS, interpretFinal, runS)-import Prelude hiding (Catch)  import Polysemy.Conc.Effect.Critical (Critical (..)) 

@@ -3,7 +3,6 @@ -- |Description: Interrupt interpreters module Polysemy.Conc.Interpreter.Interrupt where -import Control.Concurrent (MVar, newEmptyMVar, readMVar, takeMVar, tryPutMVar, tryReadMVar) import qualified Control.Concurrent.Async as A import Control.Concurrent.Async (AsyncCancelled) import Control.Concurrent.STM (TVar, newTVarIO)@@ -12,7 +11,6 @@ import qualified Data.Text.IO as Text import Polysemy.Internal.Tactics (liftT) import Polysemy.Time (Seconds (Seconds))-import Prelude hiding (Catch) import System.IO (stderr) import System.Posix.Signals (   Handler (Catch, CatchInfo, CatchInfoOnce, CatchOnce),

@@ -3,7 +3,6 @@ -- |Description: Monitor Interpreters, Internal module Polysemy.Conc.Interpreter.Monitor where -import Control.Concurrent (MVar, newEmptyMVar, readMVar, tryTakeMVar) import qualified Control.Exception as Base import qualified Polysemy.Time as Time import Polysemy.Time (Time)

@@ -9,7 +9,6 @@ import Polysemy.Internal.Union (Weaving (Weaving), decomp, hoist, injWeaving) import Polysemy.Resume (Stop, runStop, type (!!)) import Polysemy.Resume.Data.Resumable (Resumable (Resumable))-import Prelude hiding (run)  import Polysemy.Conc.Effect.Scoped (Scoped (InScope, Run)) 

@@ -1,19 +1,6 @@ -- |Description: Sync Interpreters module Polysemy.Conc.Interpreter.Sync where -import Control.Concurrent (-  MVar,-  isEmptyMVar,-  newEmptyMVar,-  newMVar,-  putMVar,-  readMVar,-  takeMVar,-  tryPutMVar,-  tryReadMVar,-  tryTakeMVar,-  )- import Polysemy.Conc.Effect.Race (Race) import Polysemy.Conc.Effect.Scoped (Scoped) import qualified Polysemy.Conc.Effect.Sync as Sync@@ -41,12 +28,6 @@       rightToMaybe <$> Race.timeoutAs () interval (embed (takeMVar var))     Sync.TakeTry ->       embed (tryTakeMVar var)-    Sync.ReadBlock ->-      embed (readMVar var)-    Sync.ReadWait interval ->-      rightToMaybe <$> Race.timeoutAs () interval (embed (readMVar var))-    Sync.ReadTry ->-      embed (tryReadMVar var)     Sync.PutBlock d ->       embed (putMVar var d)     Sync.PutWait interval d ->

@@ -0,0 +1,24 @@+-- |Description: Interpreter for 'SyncRead' that reinterprets to 'Sync'.+module Polysemy.Conc.Interpreter.SyncRead where++import qualified Polysemy.Conc.Effect.Sync as Sync+import Polysemy.Conc.Effect.Sync (Sync)+import qualified Polysemy.Conc.Effect.SyncRead as SyncRead+import Polysemy.Conc.Effect.SyncRead (SyncRead)++-- |Run 'SyncRead' in terms of 'Sync'.+syncRead ::+  ∀ d r .+  Member (Sync d) r =>+  InterpreterFor (SyncRead d) r+syncRead =+  interpret \case+    SyncRead.Block ->+      Sync.block+    SyncRead.Wait u ->+      Sync.wait u+    SyncRead.Try ->+      Sync.try+    SyncRead.Empty ->+      Sync.empty @d+{-# inline syncRead #-}

@@ -3,7 +3,6 @@ -- |Description: Monitor Implementations, Internal module Polysemy.Conc.Monitor where -import Control.Concurrent (tryPutMVar) import qualified Polysemy.Time as Time import Polysemy.Time (Minutes (Minutes), NanoSeconds, Seconds (Seconds), Time, TimeUnit, convert) import Torsor (Torsor, difference, minus)

@@ -1,8 +1,9 @@ {-# options_haddock prune #-}+ -- |Description: Sync Combinators module Polysemy.Conc.Sync (   module Polysemy.Conc.Sync,-  module Polysemy.Conc.Effect.Sync+  module Polysemy.Conc.Effect.Sync, ) where  import qualified Polysemy.Time as Time@@ -19,9 +20,6 @@   putBlock,   putTry,   putWait,-  readBlock,-  readTry,-  readWait,   takeBlock,   takeTry,   takeWait,@@ -58,6 +56,7 @@       whenM (not <$> Sync.empty @a) (Time.sleep @t @d interval *> spin)  -- |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 ::   ∀ d res r .   Member (ScopedSync res d) r =>@@ -79,3 +78,11 @@   Sem r a lock l ma =   finally (takeBlock @l *> ma) (putTry l)++-- |Remove the content of the 'Sync' variable if it is present.+clear ::+  ∀ a r .+  Member (Sync a) r =>+  Sem r ()+clear =+  void (takeTry @a)

@@ -0,0 +1,41 @@+{-# options_haddock prune #-}++-- |Description: API and combinators for 'SyncRead'.+module Polysemy.Conc.SyncRead (+  module Polysemy.Conc.SyncRead,+  module Polysemy.Conc.Effect.SyncRead,+) where++import qualified Polysemy.Time as Time+import Polysemy.Time (Time, TimeUnit)++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.+whileEmpty ::+  ∀ a r .+  Member (SyncRead a) r =>+  Sem r () ->+  Sem r ()+whileEmpty action =+  spin+  where+    spin = do+      action+      whenM (not <$> SyncRead.empty @a) spin++-- |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 =>+  Members [Time t d, SyncRead a] r =>+  u ->+  Sem r () ->+  Sem r ()+whileEmptyInterval interval action =+  spin+  where+    spin = do+      action+      whenM (not <$> SyncRead.empty @a) (Time.sleep @t @d interval *> spin)

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           polysemy-conc-version:        0.6.0.1+version:        0.6.1.0 synopsis:       Polysemy Effects for Concurrency description:    See <https://hackage.haskell.org/package/polysemy-conc/docs/Polysemy-Conc.html> category:       Concurrency@@ -40,6 +40,7 @@       Polysemy.Conc.Effect.Race       Polysemy.Conc.Effect.Scoped       Polysemy.Conc.Effect.Sync+      Polysemy.Conc.Effect.SyncRead       Polysemy.Conc.Events       Polysemy.Conc.Interpreter.Critical       Polysemy.Conc.Interpreter.Events@@ -53,6 +54,7 @@       Polysemy.Conc.Interpreter.Scoped       Polysemy.Conc.Interpreter.Stack       Polysemy.Conc.Interpreter.Sync+      Polysemy.Conc.Interpreter.SyncRead       Polysemy.Conc.Monitor       Polysemy.Conc.Queue       Polysemy.Conc.Queue.Result@@ -60,6 +62,7 @@       Polysemy.Conc.Race       Polysemy.Conc.Retry       Polysemy.Conc.Sync+      Polysemy.Conc.SyncRead   hs-source-dirs:       lib   default-extensions:

@@ -1,6 +1,5 @@ module Polysemy.Conc.Test.InterruptTest where -import Control.Concurrent (MVar, newEmptyMVar, putMVar, takeMVar) import Control.Concurrent.STM (TVar, atomically, modifyTVar, newTVarIO, readTVarIO) import Polysemy.Test (UnitTest, assertEq, runTestAuto) import System.Posix (Handler (CatchInfoOnce), SignalInfo, installHandler, keyboardSignal, raiseSignal)

@@ -2,7 +2,6 @@  module Polysemy.Conc.Test.MonitorTest where -import Control.Concurrent (MVar, putMVar) import Data.Time (UTCTime) import Polysemy.Test (UnitTest, assertEq, assertJust, runTestAuto) import qualified Polysemy.Time as Time

@@ -2,8 +2,7 @@  import Polysemy.Test (UnitTest, assertEq, assertJust, runTestAuto) import Polysemy.Time (MilliSeconds (MilliSeconds), interpretTimeGhc)-import Polysemy.Time.Ghc (GhcTime)-import Prelude hiding (run)+import Polysemy.Time.Interpreter.Ghc (GhcTime)  import qualified Polysemy.Conc.Data.QueueResult as QueueResult import Polysemy.Conc.Data.QueueResult (QueueResult)

@@ -1,7 +1,6 @@ module Polysemy.Conc.Test.SyncTest where  import Polysemy.Test (UnitTest, assertEq, runTestAuto)-import Prelude hiding (run)  import Polysemy.Conc.Effect.Race (Race) import qualified Polysemy.Conc.Effect.Sync as Sync