nqe 0.1.0.1 → 0.2.0.0

raw patch · 6 files changed

+46/−61 lines, 6 filesdep +unliftiodep −asyncdep −lifted-asyncdep −lifted-basePVP ok

version bump matches the API change (PVP)

Dependencies added: unliftio

Dependencies removed: async, lifted-async, lifted-base, monad-control, transformers-base

API changes (from Hackage documentation)

Files

• nqe.cabal +6/−10
• src/Control/Concurrent/NQE.hs +0/−4
• src/Control/Concurrent/NQE/Network.hs +5/−7
• src/Control/Concurrent/NQE/Process.hs +3/−6
• src/Control/Concurrent/NQE/Supervisor.hs +9/−13
• test/Spec.hs +23/−21

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 8e3fef9a7a4c6b1d175f3c2667594ea27d1a60884fcc25429d83e0f5a27c0616+-- hash: 19f64f288f8fa8f0b4739515e746d714754ce23701b7de65011a179d52826f16  name:           nqe-version:        0.1.0.1+version:        0.2.0.0 synopsis:       Concurrency library in the style of Erlang/OTP description:    Minimalistic actor library inspired by Erlang/OTP with support for supervisor hierarchies and asynchronous messages, as well as abstractions for synchronous communication and easy management of TCP connections. category:       Control@@ -29,17 +29,13 @@   hs-source-dirs:       src   build-depends:-      async-    , base >=4.7 && <5+      base >=4.7 && <5     , bytestring     , conduit     , conduit-extra     , containers-    , lifted-async-    , lifted-base-    , monad-control     , stm-    , transformers-base+    , unliftio   exposed-modules:       Control.Concurrent.NQE   other-modules:@@ -56,8 +52,7 @@       test   ghc-options: -threaded -rtsopts -with-rtsopts=-N   build-depends:-      async-    , base >=4.7 && <5+      base >=4.7 && <5     , bytestring     , conduit     , conduit-extra@@ -67,6 +62,7 @@     , stm     , stm-conduit     , text+    , unliftio   other-modules:       Paths_nqe   default-language: Haskell2010

@@ -2,12 +2,8 @@     ( module Control.Concurrent.NQE.Process     , module Control.Concurrent.NQE.Network     , module Control.Concurrent.NQE.Supervisor-    , module Control.Concurrent.STM-    , module Control.Concurrent.Async.Lifted.Safe     ) where -import           Control.Concurrent.Async.Lifted.Safe import           Control.Concurrent.NQE.Network import           Control.Concurrent.NQE.Process import           Control.Concurrent.NQE.Supervisor-import           Control.Concurrent.STM

@@ -6,22 +6,20 @@     , withSource     ) where -import           Control.Concurrent.Async.Lifted.Safe import           Control.Concurrent.NQE.Process-import           Control.Monad.IO.Class-import           Control.Monad.Trans.Control import           Data.Conduit+import           UnliftIO  fromSource ::        (MonadIO m, Mailbox mbox)-    => Source m msg+    => ConduitT () msg m ()     -> mbox msg -- ^ will receive all messages     -> m ()-fromSource src mbox = src $$ awaitForever (`send` mbox)+fromSource src mbox = runConduit $ src .| awaitForever (`send` mbox)  withSource ::-       (MonadIO m, MonadBaseControl IO m, Forall (Pure m), Mailbox mbox)-    => Source m msg+       (MonadUnliftIO m, Mailbox mbox)+    => ConduitT () msg m ()     -> mbox msg     -> (Async () -> m a)     -> m a

@@ -5,12 +5,9 @@ {-# LANGUAGE RankNTypes                #-} module Control.Concurrent.NQE.Process where -import           Control.Concurrent-import           Control.Concurrent.Async.Lifted.Safe-import           Control.Concurrent.STM import           Control.Monad-import           Control.Monad.IO.Class-import           Control.Monad.Trans.Control+import           UnliftIO+import           UnliftIO.Concurrent  type Reply a = a -> STM () type Listen a = a -> STM ()@@ -104,7 +101,7 @@ receiveMatchSTM mbox f = dispatchSTM [f] mbox  timeout ::-       forall m b. (MonadIO m, MonadBaseControl IO m, Forall (Pure m))+       forall m b. (MonadUnliftIO m)     => Int     -> m b     -> m (Maybe b)

@@ -12,14 +12,10 @@     ) where  import           Control.Applicative-import           Control.Concurrent.Async.Lifted.Safe import           Control.Concurrent.NQE.Process-import           Control.Concurrent.STM-import           Control.Exception.Lifted import           Control.Monad-import           Control.Monad.Base-import           Control.Monad.IO.Class-import           Control.Monad.Trans.Control+import           Control.Monad.STM              (catchSTM)+import           UnliftIO  data SupervisorMessage     = AddChild (IO ())@@ -34,7 +30,7 @@     | IgnoreAll  supervisor ::-       (MonadIO m, MonadBaseControl IO m, Forall (Pure m), Mailbox mbox)+       (MonadUnliftIO m, Mailbox mbox)     => Strategy     -> mbox SupervisorMessage     -> [m ()]@@ -64,7 +60,7 @@     waitAnyCatchSTM as  processMessage ::-       (MonadIO m, MonadBaseControl IO m, Forall (Pure m))+       (MonadUnliftIO m)     => TVar [Async ()]     -> SupervisorMessage     -> m Bool@@ -86,7 +82,7 @@     return False  processDead ::-       (MonadIO m, MonadBaseControl IO m)+       (MonadUnliftIO m)     => TVar [Async ()]     -> Strategy     -> (Async (), Either SomeException ())@@ -101,7 +97,7 @@         readTVar state     mapM_ (stopChild state) as     case e of-        Left x   -> throw x+        Left x   -> throwIO x         Right () -> return False  processDead state IgnoreGraceful (a, Right ()) = do@@ -113,7 +109,7 @@         modifyTVar' state (filter (/= a))         readTVar state     mapM_ (stopChild state) as-    throw e+    throwIO e  processDead state (Notify notif) (a, e) = do     x <-@@ -129,7 +125,7 @@             throwIO ex  startChild ::-       (MonadIO m, MonadBaseControl IO m, Forall (Pure m))+       (MonadUnliftIO m)     => TVar [Async ()]     -> m ()     -> m (Async ())@@ -139,7 +135,7 @@     return a  stopChild ::-       (MonadIO m, MonadBase IO m) => TVar [Async ()] -> Async () -> m ()+       (MonadUnliftIO m) => TVar [Async ()] -> Async () -> m () stopChild state a = do     isChild <-         liftIO . atomically $ do

@@ -6,14 +6,15 @@ import           Control.Exception import           Control.Monad import           Control.Monad.Catch-import           Control.Monad.IO.Class import           Data.ByteString        (ByteString)-import           Data.Conduit+import           Conduit import           Data.Conduit.Text      (decode, encode, utf8) import qualified Data.Conduit.Text      as CT import           Data.Conduit.TMChan import           Data.Text              (Text) import           Test.Hspec+import           UnliftIO.Async+import           UnliftIO.STM  data Pong = Pong deriving (Eq, Show) newtype Ping = Ping (Pong -> STM ())@@ -31,17 +32,17 @@         Ping reply <- receive mbox         atomically (reply Pong) -encoder :: MonadThrow m => Conduit Text m ByteString+encoder :: MonadThrow m => ConduitT Text ByteString m () encoder = encode utf8 -decoder :: MonadThrow m => Conduit ByteString m Text-decoder = decode utf8 =$= CT.lines+decoder :: MonadThrow m => ConduitT ByteString Text m ()+decoder = decode utf8 .| CT.lines  conduits ::-       IO ( Source IO ByteString-          , Sink ByteString IO ()-          , Source IO ByteString-          , Sink ByteString IO ())+       IO ( ConduitT () ByteString IO ()+          , ConduitT ByteString Void IO ()+          , ConduitT () ByteString IO ()+          , ConduitT ByteString Void IO ()) conduits = do     inChan <- newTBMChanIO 2048     outChan <- newTBMChanIO 2048@@ -52,25 +53,26 @@            )  pongServer ::-       Source IO ByteString-    -> Sink ByteString IO ()+       ConduitT () ByteString IO ()+    -> ConduitT ByteString Void IO ()     -> (Async () -> IO a)     -> IO a pongServer source sink go = do     mbox <- newTQueueIO     withAsync (action mbox) go   where-    action mbox = withSource src mbox . const $ processor mbox $$ snk-    src = source =$= decoder-    snk = encoder =$= sink+    action mbox =+        withSource src mbox . const . runConduit $ processor mbox .| snk+    src = source .| decoder+    snk = encoder .| sink     processor mbox =         forever $-        liftIO (receive mbox) >>= \case+        receive mbox >>= \case             ("ping" :: Text) -> yield ("pong\n" :: Text)             _ -> return () -pongClient :: Source IO ByteString-           -> Sink ByteString IO ()+pongClient :: ConduitT () ByteString IO ()+           -> ConduitT ByteString Void IO ()            -> IO Text pongClient source sink = do     mbox <- newTQueueIO@@ -79,10 +81,10 @@     action mbox =         withSource src mbox $ const $ processor mbox     go = wait-    src = source =$= decoder-    snk = encoder =$= sink+    src = source .| decoder+    snk = encoder .| sink     processor mbox = do-        yield ("ping\n" :: Text) $$ snk+        runConduit $ yield ("ping\n" :: Text) .| snk         receive mbox  main :: IO ()@@ -161,7 +163,7 @@                                 case fromException x of                                     Just TestError1 -> True                                     Just TestError2 -> True-                                    _ -> False+                                    _               -> False                 snd t1 `shouldSatisfy` er                 snd t2 `shouldSatisfy` er                 stopSupervisor sup