polysemy-conc 0.1.0.0 → 0.1.0.1

raw patch · 5 files changed

+134/−6 lines, 5 filesdep ~polysemyPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: polysemy

API changes (from Hackage documentation)

Files

• lib/Polysemy/Conc.hs +12/−0
• lib/Polysemy/Conc/Queue.hs +113/−0
• lib/Polysemy/Conc/Queue/Result.hs +1/−0
• lib/Polysemy/Conc/Queue/TBM.hs +4/−3
• polysemy-conc.cabal +4/−3

@@ -7,10 +7,15 @@   -- $queue   Queue,   QueueResult,+  resultToMaybe,    -- ** Interpreters   interpretQueueTBM,   interpretQueueTB,+  interpretQueueListReadOnlyAtomic,+  interpretQueueListReadOnlyAtomicWith,+  interpretQueueListReadOnlyState,+  interpretQueueListReadOnlyStateWith,    -- * MVars   -- $mvar@@ -44,6 +49,13 @@ import Polysemy.Conc.Data.Race (Race, race, timeout) import Polysemy.Conc.Data.Sync (Sync) import Polysemy.Conc.Interrupt (interpretInterrupt)+import Polysemy.Conc.Queue (+  interpretQueueListReadOnlyAtomic,+  interpretQueueListReadOnlyAtomicWith,+  interpretQueueListReadOnlyState,+  interpretQueueListReadOnlyStateWith,+  )+import Polysemy.Conc.Queue.Result (resultToMaybe) import Polysemy.Conc.Queue.TB (interpretQueueTB) import Polysemy.Conc.Queue.TBM (interpretQueueTBM) import Polysemy.Conc.Race (interpretRace, race_, timeout_)

@@ -0,0 +1,113 @@+-- |Description: Pure Queue interpreters+module Polysemy.Conc.Queue where++import Polysemy.AtomicState (atomicState')+import Polysemy.State (State, evalState, get, gets, put)++import qualified Polysemy.Conc.Data.Queue as Queue+import Polysemy.Conc.Data.Queue (Queue)+import qualified Polysemy.Conc.Data.QueueResult as QueueResult+import Polysemy.Conc.Data.QueueResult (QueueResult)++-- |Reinterpret 'Queue' as 'AtomicState' with a list that cannot be written to.+-- Useful for testing.+interpretQueueListReadOnlyAtomicWith ::+  ∀ d r .+  Member (AtomicState [d]) r =>+  InterpreterFor (Queue d) r+interpretQueueListReadOnlyAtomicWith =+  interpret \case+    Queue.Read ->+      read+    Queue.TryRead ->+      read+    Queue.ReadTimeout _ ->+      read+    Queue.Peek ->+      peek+    Queue.TryPeek ->+      peek+    Queue.Write _ ->+      pass+    Queue.TryWrite _ ->+      pure QueueResult.NotAvailable+    Queue.WriteTimeout _ _ ->+      pure QueueResult.NotAvailable+    Queue.Closed ->+      atomicGets @[d] null+    Queue.Close ->+      atomicPut @[d] []+  where+    read :: Sem r (QueueResult d)+    read =+      atomicState' @[d] \case+        [] -> ([], QueueResult.Closed)+        h : t -> (t, QueueResult.Success h)+    peek :: Sem r (QueueResult d)+    peek =+      atomicGets @[d] \case+        [] -> QueueResult.Closed+        h : _ -> QueueResult.Success h+{-# INLINE interpretQueueListReadOnlyAtomicWith #-}++-- |Variant of 'interpretQueueListReadOnlyAtomicWith' that interprets the 'AtomicState'.+interpretQueueListReadOnlyAtomic ::+  ∀ d r .+  Member (Embed IO) r =>+  [d] ->+  InterpreterFor (Queue d) r+interpretQueueListReadOnlyAtomic ds sem = do+  tv <- newTVarIO ds+  runAtomicStateTVar tv (interpretQueueListReadOnlyAtomicWith (raiseUnder sem))+{-# INLINE interpretQueueListReadOnlyAtomic #-}++-- |Reinterpret 'Queue' as 'State' with a list that cannot be written to.+-- Useful for testing.+interpretQueueListReadOnlyStateWith ::+  ∀ d r .+  Member (State [d]) r =>+  InterpreterFor (Queue d) r+interpretQueueListReadOnlyStateWith =+  interpret \case+    Queue.Read ->+      read+    Queue.TryRead ->+      read+    Queue.ReadTimeout _ ->+      read+    Queue.Peek ->+      peek+    Queue.TryPeek ->+      peek+    Queue.Write _ ->+      pass+    Queue.TryWrite _ ->+      pure QueueResult.NotAvailable+    Queue.WriteTimeout _ _ ->+      pure QueueResult.NotAvailable+    Queue.Closed ->+      gets @[d] null+    Queue.Close ->+      put @[d] []+  where+    read :: Sem r (QueueResult d)+    read =+      get @[d] >>= \case+        [] -> pure QueueResult.Closed+        h : t -> QueueResult.Success h <$ put t+    peek :: Sem r (QueueResult d)+    peek =+      gets @[d] \case+        [] -> QueueResult.Closed+        h : _ -> QueueResult.Success h+{-# INLINE interpretQueueListReadOnlyStateWith #-}++-- |Variant of 'interpretQueueListReadOnlyAtomicWith' that interprets the 'State'.+interpretQueueListReadOnlyState ::+  ∀ d r .+  Member (Embed IO) r =>+  [d] ->+  InterpreterFor (Queue d) r+interpretQueueListReadOnlyState ds sem = do+  evalState ds (interpretQueueListReadOnlyStateWith (raiseUnder sem))+{-# INLINE interpretQueueListReadOnlyState #-}

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

@@ -19,6 +19,7 @@ import Polysemy.Conc.Data.Race (Race) import Polysemy.Conc.Queue.Result (closedBoolResult, closedNaResult, closedResult) import Polysemy.Conc.Queue.Timeout (withTimeout)+import Polysemy.Resource (bracket, Resource)  -- |Interpret 'Queue' with a 'TBMQueue'. --@@ -56,11 +57,11 @@ -- |Interpret 'Queue' with a 'TBMQueue'. interpretQueueTBM ::   ∀ d r .-  Members [Race, Embed IO] r =>+  Members [Resource, Race, Embed IO] r =>   -- |Buffer size   Int ->   InterpreterFor (Queue d) r interpretQueueTBM maxQueued sem = do-  queue <- embed (newTBMQueueIO @d maxQueued)-  interpretQueueTBMWith queue sem+  bracket (embed (newTBMQueueIO @d maxQueued)) (atomically . closeTBMQueue) \ queue ->+    interpretQueueTBMWith queue sem {-# INLINE interpretQueueTBM #-}

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           polysemy-conc-version:        0.1.0.0+version:        0.1.0.1 synopsis:       Polysemy Effects for Concurrency description:    See <https://hackage.haskell.org/package/polysemy-conc/docs/Polysemy-Conc.html> category:       Concurrency@@ -37,6 +37,7 @@       Polysemy.Conc.Data.Sync       Polysemy.Conc.Interrupt       Polysemy.Conc.Prelude+      Polysemy.Conc.Queue       Polysemy.Conc.Queue.Result       Polysemy.Conc.Queue.TB       Polysemy.Conc.Queue.TBM@@ -113,7 +114,7 @@       async     , base ==4.*     , containers-    , polysemy >=1.3 && <1.5+    , polysemy >=1.3 && <1.6     , polysemy-time >=0.1.1.0 && <0.2     , relude >=0.5 && <0.8     , stm@@ -201,7 +202,7 @@     , base ==4.*     , containers     , hedgehog-    , polysemy >=1.3 && <1.5+    , polysemy >=1.3 && <1.6     , polysemy-conc     , polysemy-test     , polysemy-time >=0.1.1.0 && <0.2