packages feed

unliftio-messagebox 1.0.2 → 2.0.0

raw patch · 19 files changed

+147/−113 lines, 19 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- UnliftIO.MessageBox: CatchAllFactory :: cfg -> CatchAllFactory cfg
- UnliftIO.MessageBox: class (IsMessageBox (MessageBox cfg), IsInput (Input (MessageBox cfg))) => IsMessageBoxFactory cfg where {
- UnliftIO.MessageBox: newtype CatchAllFactory cfg
- UnliftIO.MessageBox.CatchAll: CatchAllFactory :: cfg -> CatchAllFactory cfg
- UnliftIO.MessageBox.CatchAll: instance GHC.Classes.Eq cfg => GHC.Classes.Eq (UnliftIO.MessageBox.CatchAll.CatchAllFactory cfg)
- UnliftIO.MessageBox.CatchAll: instance GHC.Classes.Ord cfg => GHC.Classes.Ord (UnliftIO.MessageBox.CatchAll.CatchAllFactory cfg)
- UnliftIO.MessageBox.CatchAll: instance GHC.Show.Show cfg => GHC.Show.Show (UnliftIO.MessageBox.CatchAll.CatchAllFactory cfg)
- UnliftIO.MessageBox.CatchAll: instance UnliftIO.MessageBox.Class.IsMessageBoxFactory cfg => UnliftIO.MessageBox.Class.IsMessageBoxFactory (UnliftIO.MessageBox.CatchAll.CatchAllFactory cfg)
- UnliftIO.MessageBox.CatchAll: newtype CatchAllFactory cfg
- UnliftIO.MessageBox.Class: class (IsMessageBox (MessageBox cfg), IsInput (Input (MessageBox cfg))) => IsMessageBoxFactory cfg where {
- UnliftIO.MessageBox.Limited: instance UnliftIO.MessageBox.Class.IsMessageBoxFactory UnliftIO.MessageBox.Limited.BlockingBoxLimit
- UnliftIO.MessageBox.Limited: instance UnliftIO.MessageBox.Class.IsMessageBoxFactory UnliftIO.MessageBox.Limited.NonBlockingBoxLimit
- UnliftIO.MessageBox.Limited: instance UnliftIO.MessageBox.Class.IsMessageBoxFactory UnliftIO.MessageBox.Limited.WaitingBoxLimit
- UnliftIO.MessageBox.Unlimited: instance UnliftIO.MessageBox.Class.IsMessageBoxFactory UnliftIO.MessageBox.Unlimited.BlockingUnlimited
+ UnliftIO.MessageBox: CatchAllArg :: cfg -> CatchAllArg cfg
+ UnliftIO.MessageBox: class (IsMessageBox (MessageBox argument), IsInput (Input (MessageBox argument))) => IsMessageBoxArg argument where {
+ UnliftIO.MessageBox: deliver_ :: (IsInput input, MonadUnliftIO m) => input a -> a -> m ()
+ UnliftIO.MessageBox: newtype CatchAllArg cfg
+ UnliftIO.MessageBox.CatchAll: CatchAllArg :: cfg -> CatchAllArg cfg
+ UnliftIO.MessageBox.CatchAll: instance GHC.Classes.Eq cfg => GHC.Classes.Eq (UnliftIO.MessageBox.CatchAll.CatchAllArg cfg)
+ UnliftIO.MessageBox.CatchAll: instance GHC.Classes.Ord cfg => GHC.Classes.Ord (UnliftIO.MessageBox.CatchAll.CatchAllArg cfg)
+ UnliftIO.MessageBox.CatchAll: instance GHC.Show.Show cfg => GHC.Show.Show (UnliftIO.MessageBox.CatchAll.CatchAllArg cfg)
+ UnliftIO.MessageBox.CatchAll: instance UnliftIO.MessageBox.Class.IsMessageBoxArg cfg => UnliftIO.MessageBox.Class.IsMessageBoxArg (UnliftIO.MessageBox.CatchAll.CatchAllArg cfg)
+ UnliftIO.MessageBox.CatchAll: newtype CatchAllArg cfg
+ UnliftIO.MessageBox.Class: class (IsMessageBox (MessageBox argument), IsInput (Input (MessageBox argument))) => IsMessageBoxArg argument where {
+ UnliftIO.MessageBox.Class: deliver_ :: (IsInput input, MonadUnliftIO m) => input a -> a -> m ()
+ UnliftIO.MessageBox.Limited: instance UnliftIO.MessageBox.Class.IsMessageBoxArg UnliftIO.MessageBox.Limited.BlockingBoxLimit
+ UnliftIO.MessageBox.Limited: instance UnliftIO.MessageBox.Class.IsMessageBoxArg UnliftIO.MessageBox.Limited.NonBlockingBoxLimit
+ UnliftIO.MessageBox.Limited: instance UnliftIO.MessageBox.Class.IsMessageBoxArg UnliftIO.MessageBox.Limited.WaitingBoxLimit
+ UnliftIO.MessageBox.Unlimited: instance UnliftIO.MessageBox.Class.IsMessageBoxArg UnliftIO.MessageBox.Unlimited.BlockingUnlimited
- UnliftIO.MessageBox: -- | Type of the corresponding input
+ UnliftIO.MessageBox: -- | The message box that can be created from the message box argument
- UnliftIO.MessageBox: class IsInput (Input msgBox) => IsMessageBox msgBox where {
+ UnliftIO.MessageBox: class IsInput (Input box) => IsMessageBox box where {
- UnliftIO.MessageBox: getConfiguredMessageLimit :: IsMessageBoxFactory cfg => cfg -> Maybe Int
+ UnliftIO.MessageBox: getConfiguredMessageLimit :: IsMessageBoxArg argument => argument -> Maybe Int
- UnliftIO.MessageBox: handleMessage :: (MonadUnliftIO m, IsMessageBox msgBox) => msgBox message -> (message -> m b) -> m (Maybe b)
+ UnliftIO.MessageBox: handleMessage :: (MonadUnliftIO m, IsMessageBox box) => box message -> (message -> m b) -> m (Maybe b)
- UnliftIO.MessageBox: newInput :: (IsMessageBox msgBox, MonadUnliftIO m) => msgBox a -> m (Input msgBox a)
+ UnliftIO.MessageBox: newInput :: (IsMessageBox box, MonadUnliftIO m) => box a -> m (Input box a)
- UnliftIO.MessageBox: newMessageBox :: (IsMessageBoxFactory cfg, MonadUnliftIO m) => cfg -> m (MessageBox cfg a)
+ UnliftIO.MessageBox: newMessageBox :: (IsMessageBoxArg argument, MonadUnliftIO m) => argument -> m (MessageBox argument a)
- UnliftIO.MessageBox: receive :: (IsMessageBox msgBox, MonadUnliftIO m) => msgBox a -> m (Maybe a)
+ UnliftIO.MessageBox: receive :: (IsMessageBox box, MonadUnliftIO m) => box a -> m (Maybe a)
- UnliftIO.MessageBox: receiveAfter :: (IsMessageBox msgBox, MonadUnliftIO m) => msgBox a -> Int -> m (Maybe a)
+ UnliftIO.MessageBox: receiveAfter :: (IsMessageBox box, MonadUnliftIO m) => box a -> Int -> m (Maybe a)
- UnliftIO.MessageBox: tryReceive :: (IsMessageBox msgBox, MonadUnliftIO m) => msgBox a -> m (Future a)
+ UnliftIO.MessageBox: tryReceive :: (IsMessageBox box, MonadUnliftIO m) => box a -> m (Future a)
- UnliftIO.MessageBox: type family MessageBox cfg :: Type -> Type;
+ UnliftIO.MessageBox: type family MessageBox argument :: Type -> Type;
- UnliftIO.MessageBox.Class: class IsInput (Input msgBox) => IsMessageBox msgBox where {
+ UnliftIO.MessageBox.Class: class IsInput (Input box) => IsMessageBox box where {
- UnliftIO.MessageBox.Class: getConfiguredMessageLimit :: IsMessageBoxFactory cfg => cfg -> Maybe Int
+ UnliftIO.MessageBox.Class: getConfiguredMessageLimit :: IsMessageBoxArg argument => argument -> Maybe Int
- UnliftIO.MessageBox.Class: handleMessage :: (MonadUnliftIO m, IsMessageBox msgBox) => msgBox message -> (message -> m b) -> m (Maybe b)
+ UnliftIO.MessageBox.Class: handleMessage :: (MonadUnliftIO m, IsMessageBox box) => box message -> (message -> m b) -> m (Maybe b)
- UnliftIO.MessageBox.Class: newInput :: (IsMessageBox msgBox, MonadUnliftIO m) => msgBox a -> m (Input msgBox a)
+ UnliftIO.MessageBox.Class: newInput :: (IsMessageBox box, MonadUnliftIO m) => box a -> m (Input box a)
- UnliftIO.MessageBox.Class: newMessageBox :: (IsMessageBoxFactory cfg, MonadUnliftIO m) => cfg -> m (MessageBox cfg a)
+ UnliftIO.MessageBox.Class: newMessageBox :: (IsMessageBoxArg argument, MonadUnliftIO m) => argument -> m (MessageBox argument a)
- UnliftIO.MessageBox.Class: receive :: (IsMessageBox msgBox, MonadUnliftIO m) => msgBox a -> m (Maybe a)
+ UnliftIO.MessageBox.Class: receive :: (IsMessageBox box, MonadUnliftIO m) => box a -> m (Maybe a)
- UnliftIO.MessageBox.Class: receiveAfter :: (IsMessageBox msgBox, MonadUnliftIO m) => msgBox a -> Int -> m (Maybe a)
+ UnliftIO.MessageBox.Class: receiveAfter :: (IsMessageBox box, MonadUnliftIO m) => box a -> Int -> m (Maybe a)
- UnliftIO.MessageBox.Class: tryReceive :: (IsMessageBox msgBox, MonadUnliftIO m) => msgBox a -> m (Future a)
+ UnliftIO.MessageBox.Class: tryReceive :: (IsMessageBox box, MonadUnliftIO m) => box a -> m (Future a)
- UnliftIO.MessageBox.Class: type family Input msgBox :: Type -> Type;
+ UnliftIO.MessageBox.Class: type family Input box :: Type -> Type;

Files

README.md view
@@ -1,6 +1,11 @@+[![main Build Results](https://github.com/sheyll/unliftio-messagebox/workflows/.github/workflows/test.yml/badge.svg?branch=main)](https://github.com/sheyll/unliftio-messagebox/actions)+[![Latest Build Results](https://github.com/sheyll/unliftio-messagebox/workflows/.github/workflows/test.yml/badge.svg)](https://github.com/sheyll/unliftio-messagebox/actions)+ # Fast and Robust Message Queues for Concurrent Processes -**NOTE:** To be able to fully view this README, use the [web page](https://sheyll.github.io/unliftio-messagebox/).+**NOTE:** To be able to fully view this README, use the [GitHub Pages Version](https://sheyll.github.io/unliftio-messagebox/).+* [API docs](./generated-reports/haddock-report/unliftio-messagebox)+* [API docs on Hackage](http://hackage.haskell.org/package/unliftio-messagebox)  A thin wrapper around a subset of `unagi-chan` based on `unliftio`. @@ -14,7 +19,6 @@ thread starvation, as well as acceptable performance  even in massively concurrent programs. -Additionally in  ## Module Structure  The library is contained in modules with names starting with @@ -47,7 +51,7 @@  [Test Profiling Report](./generated-reports/test-profiling-report/unliftio-messagebox-test.prof) -## Memory Leak Test +## Memory Leak Tests  This is a small application with a 1002 processes, each performing a fix amount of  work.@@ -55,19 +59,19 @@ When the work is done, all processes synchronise before starting a new iteration. After each iteration, the memory usage is queried from the GHC runtime  statistics.-There are 100 iterations like that. +There are 10 iterations like that.   After that all processes are shutdown, and the process-starts all over again, 30 times.+starts all over again, 5 times. -In total 3000 iterations.+In total 50 iterations.  If memory is leaked it should become visible. -The test program is executated with the `+RTS -M400m` option that instructs-the runtime to limit the available heap to 400MB, so when there is a memory+The test program is executed with the `+RTS -Mxxxm` option that instructs+the runtime to limit the available heap to `xxx` MB, so if there is a memory leak, the program would at some point crash with a heap exhaustion error. -![Memleak Test Heap Profiling Report](./generated-reports/memleak-test-report/unliftio-messagebox-memleak-test.svg)+![Memleak Test Heap Profiling Report](./generated-reports/messagebox-memleak-test-report/unliftio-messagebox-memleak-test.svg) -The output is printed into [this log file](./generated-reports/memleak-test-report/test.log).+The output is printed into [this log file](./generated-reports/messagebox-memleak-test-report/test.log).
src-benchmark/BookStoreBenchmark.hs view
@@ -50,7 +50,7 @@   ) import UnliftIO.MessageBox.Class     ( IsMessageBox(newInput, receive),-      IsMessageBoxFactory(newMessageBox),+      IsMessageBoxArg(newMessageBox),       handleMessage ) import UnliftIO   ( MonadIO (liftIO),@@ -98,7 +98,7 @@   getCallIdCounter MkBookStoreEnv {_fresh} = _fresh  onlyCasts ::-  (MonadUnliftIO m, IsMessageBoxFactory cfg) =>+  (MonadUnliftIO m, IsMessageBoxArg cfg) =>   (Int -> Book) ->   cfg ->   (Int, Int, Int) ->@@ -140,7 +140,7 @@     runConc (producers <> consumers)  castsAndCalls ::-  (MonadUnliftIO m, IsMessageBoxFactory cfg) =>+  (MonadUnliftIO m, IsMessageBoxArg cfg) =>   (Int -> Book) ->   cfg ->   ((Int, Int), Int, (Int, Int)) ->@@ -213,7 +213,7 @@       let donors = mconcat (donor bookStoresInputes <$> [0 .. nDonors - 1])       runConc (donors <> customers <> mconcat bookStoresConc) -benchmark :: IsMessageBoxFactory cfg => cfg -> Benchmark+benchmark :: IsMessageBoxArg cfg => cfg -> Benchmark benchmark cfg =   bgroup     "BookStore"
src-benchmark/CommandBenchmark.hs view
@@ -28,10 +28,10 @@   ) import qualified MediaBenchmark import UnliftIO.MessageBox.CatchAll-  ( CatchAllFactory (CatchAllFactory),+  ( CatchAllArg (CatchAllArg),   ) import UnliftIO.MessageBox.Class-  ( IsMessageBoxFactory (..),+  ( IsMessageBoxArg (..),   ) import qualified UnliftIO.MessageBox.Limited as L import qualified UnliftIO.MessageBox.Unlimited as U@@ -49,11 +49,11 @@     go :: SomeBench -> [Benchmark]     go (SomeBench b) =       [ (\x -> bgroup "Unlimited" [b x]) U.BlockingUnlimited,-        (\x -> bgroup "CatchUnlimited" [b x]) (CatchAllFactory U.BlockingUnlimited),+        (\x -> bgroup "CatchUnlimited" [b x]) (CatchAllArg U.BlockingUnlimited),         -- (\x -> bgroup (show x) [b x]) (L.BlockingBoxLimit L.MessageLimit_256),         -- (\x -> bgroup (show x) [b x]) (L.WaitingBoxLimit Nothing 5_000_000 L.MessageLimit_256),         (\x -> bgroup "Waiting256" [b x]) (L.WaitingBoxLimit (Just 60_000_000) 5_000_000 L.MessageLimit_256)       ]  newtype SomeBench = SomeBench-  {_fromSomeBench :: forall cfg. (Show cfg, IsMessageBoxFactory cfg) => (cfg -> Benchmark)}+  {_fromSomeBench :: forall cfg. (Show cfg, IsMessageBoxArg cfg) => (cfg -> Benchmark)}
src-benchmark/Main.hs view
@@ -31,12 +31,12 @@   ) import Data.Semigroup (Semigroup (stimes)) import UnliftIO.MessageBox.CatchAll-  ( CatchAllFactory (..),+  ( CatchAllArg (..),   ) import UnliftIO.MessageBox.Class   ( IsInput (..),     IsMessageBox (..),-    IsMessageBoxFactory (..),+    IsMessageBoxArg (..),     deliver,     newInput,     receive,@@ -66,7 +66,7 @@             (isNonBlocking, mboxImplTitle, impl) <-               [ let x = U.BlockingUnlimited                  in (False, "Unlimited", unidirectionalMessagePassing mkTestMessage x),-                let x = CatchAllFactory U.BlockingUnlimited+                let x = CatchAllArg U.BlockingUnlimited                  in (False, "CatchUnlimited", unidirectionalMessagePassing mkTestMessage x),                 -- let x = L.BlockingBoxLimit L.MessageLimit_1                 --  in (False, show x, unidirectionalMessagePassing mkTestMessage x),@@ -91,7 +91,7 @@                 --  in (False, show x, unidirectionalMessagePassing mkTestMessage x),                 let x = L.WaitingBoxLimit (Just 60_000_000) 5_000_000 L.MessageLimit_256                  in (True, "Waiting256", unidirectionalMessagePassing mkTestMessage x)-                -- let x = CatchAllFactory (L.BlockingBoxLimit L.MessageLimit_128)+                -- let x = CatchAllArg (L.BlockingBoxLimit L.MessageLimit_128)                 --  in (False, show x, unidirectionalMessagePassing mkTestMessage x)               ],             (senderNo, receiverNo) <-@@ -121,7 +121,7 @@   deriving newtype (Show)  unidirectionalMessagePassing ::-  (MonadUnliftIO m, IsMessageBoxFactory cfg) =>+  (MonadUnliftIO m, IsMessageBoxArg cfg) =>   (Int -> TestMessage) ->   cfg ->   (Int, Int, Int) ->
src-benchmark/MediaBenchmark.hs view
@@ -69,7 +69,7 @@ import UnliftIO.MessageBox.Class   ( IsInput (..),     IsMessageBox (..),-    IsMessageBoxFactory (..),+    IsMessageBoxArg (..),     handleMessage,     newInput,     receiveAfter,@@ -83,7 +83,7 @@   ) import UnliftIO.Concurrent (forkIO) -benchmark :: (IsMessageBoxFactory cfg) => cfg -> Benchmark+benchmark :: (IsMessageBoxArg cfg) => cfg -> Benchmark benchmark cfg =   bgroup     "Media"@@ -134,7 +134,7 @@ -- and wait for every process to finish. mediaAppBenchmark ::   forall cfg.-  (HasCallStack, IsMessageBoxFactory cfg) =>+  (HasCallStack, IsMessageBoxArg cfg) =>   cfg ->   Param ->   IO ()
src-memleak-test/MediaBenchmark.hs view
@@ -100,7 +100,7 @@ -- and wait for every process to finish. mediaAppBenchmark ::   forall cfg.-  (HasCallStack, IsMessageBoxFactory cfg) =>+  (HasCallStack, IsMessageBoxArg cfg) =>   cfg ->   Param ->   IO ()
src-test/CatchAllTest.hs view
@@ -17,7 +17,7 @@     "CatchAll"     [ testProperty         "Derived Classes Coverage"-        (allEqOrdShowMethodsImplemented (Proxy @(CatchAllFactory Int))),+        (allEqOrdShowMethodsImplemented (Proxy @(CatchAllArg Int))),       testCase         "when the wrapped receive throws an exception,\         \ CatchAlls receive returns Nothing"
src-test/CommandTest.hs view
@@ -33,7 +33,7 @@ import UnliftIO.MessageBox.Util.Fresh (CounterVar, fresh, newCounterVar) import UnliftIO.MessageBox.Class   ( IsMessageBox (..),-    IsMessageBoxFactory (..),+    IsMessageBoxArg (..),     handleMessage,   ) import UnliftIO.MessageBox.Limited
src-test/CornerCaseTests.hs view
@@ -27,7 +27,7 @@   ( Input,     IsInput (deliver),     IsMessageBox (newInput, receive),-    IsMessageBoxFactory (..),+    IsMessageBoxArg (..),     handleMessage,     receiveAfter,   )@@ -113,7 +113,7 @@   deriving stock (Show, Eq)  waitForMessageFromDeadProcess ::-  (HasCallStack, IsMessageBoxFactory cfg) =>+  (HasCallStack, IsMessageBoxArg cfg) =>   cfg ->   IO WaitForMessageFromDeadProcessResult waitForMessageFromDeadProcess outputCfg =@@ -147,7 +147,7 @@   deriving stock (Show, Eq)  sendMessagesToDeadProcess ::-  (HasCallStack, IsMessageBoxFactory cfg) =>+  (HasCallStack, IsMessageBoxArg cfg) =>   cfg ->   IO SendMessageToDeadProcessResult sendMessagesToDeadProcess outputCfg =@@ -197,7 +197,7 @@   deriving stock (Show, Eq)  waitForCallReplyFromDeadServer ::-  (IsMessageBoxFactory cfg) =>+  (IsMessageBoxArg cfg) =>   cfg ->   IO WaitForCallReplyFromDeadServerResult waitForCallReplyFromDeadServer outputCfg =@@ -223,7 +223,7 @@       (const (return WaitForCallReplyFromDeadServerResult))  waitForCallReplyFromDeadServerServer ::-  (IsMessageBoxFactory cfg) =>+  (IsMessageBoxArg cfg) =>   cfg ->   MVar (Input (MessageBox cfg) (Message TestServer)) ->   IO ()
src-test/LimitedMessageBoxTest.hs view
@@ -19,7 +19,7 @@ import UnliftIO.MessageBox.Class   ( IsInput (deliver),     IsMessageBox (newInput, receive, tryReceive),-    IsMessageBoxFactory (MessageBox, newMessageBox),+    IsMessageBoxArg (MessageBox, newMessageBox),     receiveAfter,   ) import UnliftIO.MessageBox.Limited@@ -65,7 +65,7 @@  testCommon ::   forall boxCfg cfg.-  ( IsMessageBoxFactory boxCfg,+  ( IsMessageBoxArg boxCfg,     Show boxCfg,     cfg ~ MessageBox boxCfg   ) =>
src-test/MessageBoxClassTest.hs view
@@ -18,12 +18,12 @@   ) import UnliftIO.Concurrent (threadDelay) import UnliftIO.MessageBox.CatchAll-  ( CatchAllFactory (CatchAllFactory),+  ( CatchAllArg (CatchAllArg),   ) import UnliftIO.MessageBox.Class   ( IsInput (..),     IsMessageBox (..),-    IsMessageBoxFactory (..),+    IsMessageBoxArg (..),     deliver,     handleMessage,     newInput,@@ -44,9 +44,9 @@     "UnliftIO.MessageBox.Class"     [ utilTest,       testWith U.BlockingUnlimited,-      testWith $ CatchAllFactory U.BlockingUnlimited,+      testWith $ CatchAllArg U.BlockingUnlimited,       testWith (B.BlockingBoxLimit B.MessageLimit_256),-      testWith $ CatchAllFactory (B.BlockingBoxLimit B.MessageLimit_256),+      testWith $ CatchAllArg (B.BlockingBoxLimit B.MessageLimit_256),       testWith (B.BlockingBoxLimit B.MessageLimit_1),       testWith (B.BlockingBoxLimit B.MessageLimit_2),       testWith (B.NonBlockingBoxLimit B.MessageLimit_1),@@ -73,7 +73,7 @@     ]  testWith ::-  (IsMessageBoxFactory cfg, Show cfg) =>+  (IsMessageBoxArg cfg, Show cfg) =>   cfg ->   TestTree testWith arg =@@ -84,7 +84,7 @@  -- standard tests commonFunctionality ::-  (IsMessageBoxFactory cfg) =>+  (IsMessageBoxArg cfg) =>   cfg ->   TestTree commonFunctionality arg =
src-test/QCOrphans.hs view
@@ -4,7 +4,7 @@ module QCOrphans () where  import UnliftIO.MessageBox.Util.CallId-import UnliftIO.MessageBox.CatchAll (CatchAllFactory (..))+import UnliftIO.MessageBox.CatchAll (CatchAllArg (..)) import qualified UnliftIO.MessageBox.Limited as Limited import Test.QuickCheck (Arbitrary (arbitrary), elements) @@ -23,8 +23,8 @@       <*> arbitrary       <*> arbitrary -instance Arbitrary a => Arbitrary (CatchAllFactory a) where-  arbitrary = CatchAllFactory <$> arbitrary+instance Arbitrary a => Arbitrary (CatchAllArg a) where+  arbitrary = CatchAllArg <$> arbitrary  instance Arbitrary CallId where   arbitrary = MkCallId <$> arbitrary
src-test/Utils.hs view
@@ -11,7 +11,9 @@     withCallIds,     allEqOrdShowMethodsImplemented,     allEnumMethodsImplemented,-    NoOpFactory (..),+    MockBoxInit(..),+    MockBox(..),+    NoOpArg (..),     NoOpBox (..),     NoOpInput (..),   )@@ -26,7 +28,7 @@ import UnliftIO.MessageBox.Class   ( IsInput (..),     IsMessageBox (Input, newInput, receive, tryReceive),-    IsMessageBoxFactory (..),+    IsMessageBoxArg (..),   ) import Test.QuickCheck   ( Arbitrary,@@ -140,10 +142,37 @@                        === enumFromTo x y                    ) --- message box dummy implementation+-- message box implementation+-- NOTE: Because of parametricity and the existential quantification+-- of the message payload, the receive and deliver methods+-- are only capable of throwing exceptions or bottoming out -data NoOpFactory-  = NoOpFactory+data MockBoxInit msgBox = MkMockBoxInit +  { mockBoxNew :: forall m a. MonadUnliftIO m => m (msgBox a)+  , mockBoxLimit :: !(Maybe Int)+  }++instance IsMessageBox msgBox => IsMessageBoxArg (MockBoxInit msgBox) where +  type MessageBox (MockBoxInit msgBox) = msgBox+  getConfiguredMessageLimit = mockBoxLimit+  newMessageBox b = mockBoxNew b++data MockBox input a = MkMockBox +  { mockBoxNewInput :: forall m . MonadUnliftIO m => m (input a)+  , mockBoxReceive :: forall m . MonadUnliftIO m => m (Maybe a)+  , mockBoxTryReceive :: forall m . MonadUnliftIO m => m (Future a)+  }++instance IsInput input => IsMessageBox (MockBox input) where+  type Input (MockBox input) = input+  newInput m = mockBoxNewInput m +  receive m = mockBoxReceive m+  tryReceive m = mockBoxTryReceive m++++data NoOpArg+  = NoOpArg   deriving stock (Show)  newtype NoOpInput a@@ -153,9 +182,9 @@   = OnReceive (Maybe Int) (Maybe a)   deriving stock (Show) -instance IsMessageBoxFactory NoOpFactory where-  type MessageBox NoOpFactory = NoOpBox-  newMessageBox NoOpFactory = return (OnReceive Nothing Nothing)+instance IsMessageBoxArg NoOpArg where+  type MessageBox NoOpArg = NoOpBox+  newMessageBox NoOpArg = return (OnReceive Nothing Nothing)   getConfiguredMessageLimit _ = Nothing  instance IsMessageBox NoOpBox where
src/UnliftIO/MessageBox.hs view
@@ -27,14 +27,14 @@ where  import UnliftIO.MessageBox.CatchAll-  ( CatchAllBox (..),-    CatchAllFactory (..),+  ( CatchAllArg (..),+    CatchAllBox (..),     CatchAllInput (..),   ) import UnliftIO.MessageBox.Class   ( IsInput (..),     IsMessageBox (..),-    IsMessageBoxFactory (..),+    IsMessageBoxArg (..),     handleMessage,   ) import UnliftIO.MessageBox.Command
src/UnliftIO/MessageBox/CatchAll.hs view
@@ -5,7 +5,7 @@ -- This provides a wrapper around "UnliftIO.MessageBox.Class" instances -- to catch 'SomeException' in all methods like 'deliver' and 'receive'. module UnliftIO.MessageBox.CatchAll-  ( CatchAllFactory (..),+  ( CatchAllArg (..),     CatchAllBox (..),     CatchAllInput (..),   )@@ -15,16 +15,16 @@ import UnliftIO.MessageBox.Class   ( IsInput (..),     IsMessageBox (..),-    IsMessageBoxFactory (..),+    IsMessageBoxArg (..),   ) import UnliftIO (SomeException, liftIO, try) import UnliftIO.Concurrent (threadDelay)  -- | A wrapper around values that are instances--- of 'IsMessageBoxFactory'. The factory wraps+-- of 'IsMessageBoxArg'. The factory wraps -- the result of the delegated 'newMessageBox' -- invocation into a 'CatchAllBox'.-newtype CatchAllFactory cfg = CatchAllFactory cfg+newtype CatchAllArg cfg = CatchAllArg cfg   deriving stock (Eq, Ord, Show)  -- | A wrapper around values that are instances@@ -38,11 +38,11 @@ -- of 'IsInput'. newtype CatchAllInput i a = CatchAllInput (i a) -instance IsMessageBoxFactory cfg => IsMessageBoxFactory (CatchAllFactory cfg) where-  type MessageBox (CatchAllFactory cfg) = CatchAllBox (MessageBox cfg)+instance IsMessageBoxArg cfg => IsMessageBoxArg (CatchAllArg cfg) where+  type MessageBox (CatchAllArg cfg) = CatchAllBox (MessageBox cfg)   {-# INLINE newMessageBox #-}-  newMessageBox (CatchAllFactory !cfg) = CatchAllBox <$> newMessageBox cfg-  getConfiguredMessageLimit (CatchAllFactory !cfg) =+  newMessageBox (CatchAllArg !cfg) = CatchAllBox <$> newMessageBox cfg+  getConfiguredMessageLimit (CatchAllArg !cfg) =     getConfiguredMessageLimit cfg  instance IsMessageBox box => IsMessageBox (CatchAllBox box) where
src/UnliftIO/MessageBox/Class.hs view
@@ -2,7 +2,7 @@ -- describes exchangable operations on messages -- boxes. module UnliftIO.MessageBox.Class-  ( IsMessageBoxFactory (..),+  ( IsMessageBoxArg (..),     IsMessageBox (..),     IsInput (..),     handleMessage,@@ -12,17 +12,22 @@ import Data.Kind (Type) import UnliftIO.MessageBox.Util.Future (Future, awaitFuture) import UnliftIO (MonadUnliftIO, timeout)+import Control.Monad (void) --- | Create 'IsMessageBox' instances from a parameter.+-- | Types that configure and allow the creation of a 'MessageBox'.+--+-- Create 'IsMessageBox' instances from a parameter. -- Types that determine 'MessageBox' values. -- -- For a limited message box this might be the limit of -- the message queue. class-  (IsMessageBox (MessageBox cfg), IsInput (Input (MessageBox cfg))) =>-  IsMessageBoxFactory cfg+  (IsMessageBox (MessageBox argument), IsInput (Input (MessageBox argument))) =>+  IsMessageBoxArg argument   where-  type MessageBox cfg :: Type -> Type+  -- | The message box that can be created from the+  -- message box argument+  type MessageBox argument :: Type -> Type    -- | Return a message limit.   --@@ -32,18 +37,18 @@   -- Also note that the naming follows the rule:   -- Reserve short names for entities that are   -- used often.-  getConfiguredMessageLimit :: cfg -> Maybe Int+  getConfiguredMessageLimit :: argument -> Maybe Int -  -- | Create a new @msgBox@.+  -- | Create a new @msgBox@ according to the @argument@.   -- This is required to receive a message.   -- NOTE: Only one process may receive on an msgBox.-  newMessageBox :: MonadUnliftIO m => cfg -> m (MessageBox cfg a)+  newMessageBox :: MonadUnliftIO m => argument -> m (MessageBox argument a)  -- | A type class for msgBox types. -- A common interface for receiving messages.-class IsInput (Input msgBox) => IsMessageBox msgBox where+class IsInput (Input box) => IsMessageBox box where   -- | Type of the corresponding input-  type Input msgBox :: Type -> Type+  type Input box :: Type -> Type    -- | Receive a message. Take whatever time it takes.   -- Return 'Just' the value or 'Nothing' when an error@@ -53,14 +58,14 @@   -- when there is a lot of load, so please make sure to    -- build your application in such a way, that it    -- anticipates failure.-  receive :: MonadUnliftIO m => msgBox a -> m (Maybe a)+  receive :: MonadUnliftIO m => box a -> m (Maybe a)    -- | Return a 'Future' that can be used to wait for the   -- arrival of the next message.   -- NOTE: Each future value represents the next slot in the queue   -- so one future corresponds to exactly that message (should it arrive)   -- and if that future value is dropped, that message will be lost!-  tryReceive :: MonadUnliftIO m => msgBox a -> m (Future a)+  tryReceive :: MonadUnliftIO m => box a -> m (Future a)    -- | Wait for an incoming message or return Nothing.   --@@ -77,7 +82,7 @@   receiveAfter ::     MonadUnliftIO m =>     -- | Message box-    msgBox a ->+    box a ->     -- | Time in micro seconds to wait until the     -- action is invoked.     Int ->@@ -86,8 +91,8 @@     tryReceive mbox >>= timeout t . awaitFuture    -- | Create a new @input@ that enqueus messages,-  -- which are received by the @msgBox@-  newInput :: MonadUnliftIO m => msgBox a -> m (Input msgBox a)+  -- which are received by the @box@+  newInput :: MonadUnliftIO m => box a -> m (Input box a)  -- | A type class for input types. -- A common interface for delivering messages.@@ -102,17 +107,21 @@   -- build your application in such a way, that it    -- anticipates failure.   deliver :: MonadUnliftIO m => input a -> a -> m Bool+  -- | See 'deliver' but with @()@ as return value.+  --   If 'deliver' fails, it fails silently.+  deliver_ :: MonadUnliftIO m => input a -> a -> m ()+  deliver_ i a = void (deliver i a)  -- ** Utility Functions for Receiving Messages  -- | Receive a message and apply a function to it. handleMessage ::-  (MonadUnliftIO m, IsMessageBox msgBox) =>-  msgBox message ->+  (MonadUnliftIO m, IsMessageBox box) =>+  box message ->   (message -> m b) ->   m (Maybe b)-handleMessage !msgBox !onMessage = do-  !maybeMessage <- receive msgBox+handleMessage !box !onMessage = do+  !maybeMessage <- receive box   case maybeMessage of     Nothing -> pure Nothing     Just !message -> do
src/UnliftIO/MessageBox/Limited.hs view
@@ -84,7 +84,7 @@     MessageLimit_2048 -> 2048     MessageLimit_4096 -> 4096 --- * 'Class.IsMessageBoxFactory' instances+-- * 'Class.IsMessageBoxArg' instances  -- ** Blocking @@ -116,7 +116,7 @@ --   The 'Input' is the counter part of a 'BlockingBox'. newtype BlockingInput a = MkBlockingInput (Unagi.InChan a) -instance Class.IsMessageBoxFactory BlockingBoxLimit where+instance Class.IsMessageBoxArg BlockingBoxLimit where   type MessageBox BlockingBoxLimit = BlockingBox   {-# INLINE newMessageBox #-}   newMessageBox (BlockingBoxLimit !limit) = create limit@@ -148,7 +148,7 @@  --  ** A wrapper around 'BlockingBox' for Non-Blocking Input (NBI) --- | A 'BlockingBoxLimit' wrapper for non-blocking 'Class.IsMessageBoxFactory' instances.+-- | A 'BlockingBoxLimit' wrapper for non-blocking 'Class.IsMessageBoxArg' instances. newtype NonBlockingBoxLimit = NonBlockingBoxLimit MessageLimit   deriving stock (Eq, Ord) @@ -156,7 +156,7 @@   showsPrec _ (NonBlockingBoxLimit !l) =     showString "NonBlocking" . showsPrec 9 (messageLimitToInt l) -instance Class.IsMessageBoxFactory NonBlockingBoxLimit where+instance Class.IsMessageBoxArg NonBlockingBoxLimit where   type MessageBox NonBlockingBoxLimit = NonBlockingBox   {-# INLINE newMessageBox #-}   newMessageBox (NonBlockingBoxLimit !l) =@@ -198,7 +198,7 @@  --  ** 'BlockingBox' Wrapper with Timeout --- | A 'Class.IsMessageBoxFactory' instance wrapping the 'BlockingBox'+-- | A 'Class.IsMessageBoxArg' instance wrapping the 'BlockingBox' --  with independently configurable timeouts for 'receive' and 'deliver'. data WaitingBoxLimit   = WaitingBoxLimit@@ -218,7 +218,7 @@       . showChar '_'       . showsPrec 9 (messageLimitToInt l) -instance Class.IsMessageBoxFactory WaitingBoxLimit where+instance Class.IsMessageBoxArg WaitingBoxLimit where   type MessageBox WaitingBoxLimit = WaitingBox   {-# INLINE newMessageBox #-}   newMessageBox l@(WaitingBoxLimit _ _ !c) =
src/UnliftIO/MessageBox/Unlimited.hs view
@@ -48,13 +48,13 @@ newtype UnlimitedBoxInput a = MkUnlimitedBoxInput (Unagi.InChan a)  -- | The (empty) configuration for creating--- 'UnlimitedBox'es using the 'Class.IsMessageBoxFactory' methods.+-- 'UnlimitedBox'es using the 'Class.IsMessageBoxArg' methods. data BlockingUnlimited = BlockingUnlimited  instance Show BlockingUnlimited where   showsPrec _ _ = showString "Unlimited" -instance Class.IsMessageBoxFactory BlockingUnlimited where+instance Class.IsMessageBoxArg BlockingUnlimited where   type MessageBox BlockingUnlimited = UnlimitedBox   {-# INLINE newMessageBox #-}   newMessageBox BlockingUnlimited = create
unliftio-messagebox.cabal view
@@ -1,6 +1,6 @@ cabal-version:  3.0 name:           unliftio-messagebox-version:        1.0.2+version:        2.0.0 description:    Please see the README on GitHub at <https://github.com/sheyll/unliftio-messagebox#readme> synopsis:       Fast and robust message queues for concurrent processes homepage:       https://github.com/sheyll/unliftio-messagebox#readme@@ -8,7 +8,7 @@ author:         Sven Heyll maintainer:     sven.heyll@gmail.com category:       Concurrency-tested-with:    GHC==8.10.2,GHC==8.10.3+tested-with:    GHC==8.10.2,GHC==8.10.3,GHC==8.10.4 copyright:      Copyright Sven Heyll license:        BSD-2-Clause license-file:   LICENSE@@ -27,14 +27,6 @@   default: False   manual: True   -common executable-flags-  ghc-options:-    -threaded-    "-with-rtsopts=-T -N -qa"-  if flag(development)-    ghc-prof-options: -      "-with-rtsopts=-T -xt -xc -Pa -hc -L256"-   common compiler-flags   ghc-options:     -Wall@@ -47,10 +39,10 @@     -Wpartial-fields     -Wmissing-deriving-strategies     -funbox-strict-fields-    -Wno-missing-signatures     +    -Wno-missing-signatures+    -fno-full-laziness   if flag(development)     ghc-options:-      -O2       -Werror     ghc-prof-options:       -fprof-auto @@ -111,7 +103,16 @@     UnboxedTuples,     UndecidableInstances,     UnliftedFFITypes-  ++common executable-flags+  ghc-options:+    -threaded+    -rtsopts+    "-with-rtsopts=-T -N -qa"+  if flag(development)+    ghc-prof-options: +      "-with-rtsopts=-T -xt -xc -Pa -hc -L256"+     common deps   build-depends:       atomic-primops,@@ -148,16 +149,7 @@   other-modules:     MediaBenchmark   hs-source-dirs: src-memleak-test  -  ghc-options:-    -O2-    -threaded-    -rtsopts-    "-with-rtsopts=-T -N"   ghc-prof-options: -    -O2-    -threaded-    -rtsopts-    -fprof-auto      "-with-rtsopts=-T -hy -pa -L256 -xt -N"   build-depends:     unliftio-messagebox