pipes-fluid 0.4.0.0 → 0.5.0.0

raw patch · 5 files changed

+66/−66 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• pipes-fluid.cabal +2/−2
• src/Pipes/Fluid.hs +2/−2
• src/Pipes/Fluid/Simultaneous.hs +57/−0
• src/Pipes/Fluid/Sync.hs +0/−57
• test/Spec.hs +5/−5

@@ -1,5 +1,5 @@ name:                pipes-fluid-version:             0.4.0.0+version:             0.5.0.0 synopsis:            Reactively combines Producers so that a value is yielded as soon as possible. description:         Please see README.md homepage:            https://github.com/louispan/pipes-fluid#readme@@ -19,7 +19,7 @@                        Pipes.Fluid.Merge                        Pipes.Fluid.Impulse                        Pipes.Fluid.ImpulseIO-                       Pipes.Fluid.Sync+                       Pipes.Fluid.Simultaneous   build-depends:       base >= 4.7 && < 5                      , constraints >= 0.4 && < 1                      , lens >= 4 && < 5

@@ -2,10 +2,10 @@     ( module Pipes.Fluid.Merge     , module Pipes.Fluid.Impulse     , module Pipes.Fluid.ImpulseIO-    , module Pipes.Fluid.Sync+    , module Pipes.Fluid.Simultaneous     ) where  import Pipes.Fluid.Merge import Pipes.Fluid.Impulse import Pipes.Fluid.ImpulseIO-import Pipes.Fluid.Sync+import Pipes.Fluid.Simultaneous

@@ -0,0 +1,57 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE BangPatterns #-}++module Pipes.Fluid.Simultaneous+    ( Simultaneous(..)+    ) where++import Control.Lens+import Control.Monad+import Control.Monad.Trans.Class+import qualified Pipes as P+import qualified Pipes.Prelude as PP++-- | The applicative instance of this combines multiple Producers synchronously+-- ie, yields a value only when both of the input producers yields a value.+-- Ends as soon as any of the input producer is ended.+newtype Simultaneous m a = Simultaneous+    { simultaneously :: P.Producer a m ()+    }++makeWrapped ''Simultaneous++instance Monad m => Functor (Simultaneous m) where+    fmap f (Simultaneous as) = Simultaneous $ as P.>-> PP.map f++instance Monad m => Applicative (Simultaneous m) where+    pure = Simultaneous . forever . P.yield+    Simultaneous xs <*> Simultaneous ys = Simultaneous $ go xs ys++go :: Monad m => P.Producer (t -> a) m r -> P.Producer t m r -> P.Proxy x' x () a m ()+go fs as = do+    rf <- lift $ P.next fs+    ra <- lift $ P.next as+    case (rf, ra) of+        (Left _, _) -> pure ()+        (_, Left _) -> pure ()+        (Right (f, fs'), Right (a, as')) -> do+            P.yield $ f a+            go fs' as'++instance Monad m => Monad (Simultaneous m) where+    Simultaneous as >>= f = Simultaneous $ do+        ra <- lift $ P.next as+        case ra of+            Left _ -> pure ()+            Right (a, as') -> do+                rb <- lift . P.next . simultaneously $ f a+                case rb of+                    Left _ -> pure ()+                    Right (b, _) -> do+                        P.yield b+                        simultaneously $ Simultaneous as' >>= f

@@ -1,57 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE BangPatterns #-}--module Pipes.Fluid.Sync-    ( Sync(..)-    ) where--import Control.Lens-import Control.Monad-import Control.Monad.Trans.Class-import qualified Pipes as P-import qualified Pipes.Prelude as PP---- | The applicative instance of this combines multiple Producers synchronously--- ie, yields a value only when both of the input producers yields a value.--- Ends as soon as any of the input producer is ended.-newtype Sync m a = Sync-    { synchronously :: P.Producer a m ()-    }--makeWrapped ''Sync--instance Monad m => Functor (Sync m) where-    fmap f (Sync as) = Sync $ as P.>-> PP.map f--instance Monad m => Applicative (Sync m) where-    pure = Sync . forever . P.yield-    Sync xs <*> Sync ys = Sync $ go xs ys--go :: Monad m => P.Producer (t -> a) m r -> P.Producer t m r -> P.Proxy x' x () a m ()-go fs as = do-    rf <- lift $ P.next fs-    ra <- lift $ P.next as-    case (rf, ra) of-        (Left _, _) -> pure ()-        (_, Left _) -> pure ()-        (Right (f, fs'), Right (a, as')) -> do-            P.yield $ f a-            go fs' as'--instance Monad m => Monad (Sync m) where-    Sync as >>= f = Sync $ do-        ra <- lift $ P.next as-        case ra of-            Left _ -> pure ()-            Right (a, as') -> do-                rb <- lift . P.next . synchronously $ f a-                case rb of-                    Left _ -> pure ()-                    Right (b, _) -> do-                        P.yield b-                        synchronously $ Sync as' >>= f

@@ -21,7 +21,7 @@ import qualified Pipes.Concurrent as PC import qualified Pipes.Fluid.Impulse as PF import qualified Pipes.Fluid.ImpulseIO as PF-import qualified Pipes.Fluid.Sync as PF+import qualified Pipes.Fluid.Simultaneous as PF import qualified Pipes.Misc.Concurrent as PM import qualified Pipes.Misc.State.Strict as PM import qualified Pipes.Prelude as PP@@ -51,7 +51,7 @@   lift $ threadDelay i   P.yield a --- | For the Sync tests, not all the input will be consumed+-- | For the Simultaneous tests, not all the input will be consumed -- so quitEarly will close the mailbox when an of the feeders -- have finished feeding. testSig' :: Bool -> (P.Producer Int STM () -> P.Producer Int STM () -> IO a) -> IO a@@ -92,14 +92,14 @@ main :: IO () main = do     hspec $ do-        describe "Sync" $ do+        describe "Simultaneous" $ do             it "only yield a value when both producers yields a value" $ do                 xs <-                     testSig' True $ \as bs ->                         PP.toListM $                         hoist atomically $-                        PF.synchronously $-                        (\a b -> (a, b, a + b)) <$> PF.Sync as <*> PF.Sync bs+                        PF.simultaneously $+                        (\a b -> (a, b, a + b)) <$> PF.Simultaneous as <*> PF.Simultaneous bs                 xs `shouldBe` (\(a, b) -> (a, b, a + b)) <$> zip data1 data2         describe "Impulse" $ do             it "Impulse STM: yield a value whenever any producer yields a value" $ do