packages feed

machinecell 1.0.0 → 1.0.1

raw patch · 6 files changed

+97/−32 lines, 6 filesdep ~basedep ~free

Dependency ranges changed: base, free

Files

+ CHANGELOG.md view
@@ -0,0 +1,9 @@+1.0,1+------------+* Fix some bugs of core part.+* Added `onEnd`.+* Added `sample`.++1.0.0+-------------+* First release.
machinecell.cabal view
@@ -2,9 +2,9 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                machinecell-version:             1.0.0+version:             1.0.1 synopsis:            Arrow based stream transducers-description:         Stream processing library similar to pipe, couduit, machines. With support of arrow combinatins, or the arrow notation. AFRP-like utilities are also available.+description:         Stream processing library similar to pipes, couduit, machines. With support of arrow combinatins, or the arrow notation. AFRP-like utilities are also available. license:             BSD3 license-file:        LICENSE author:              Hidenori Azuma@@ -12,14 +12,14 @@ copyright:           Copyright (c) 2014 Hidenori Azuma category:            Control build-type:          Simple-extra-source-files:  README.md+extra-source-files:  README.md, CHANGELOG.md cabal-version:       >=1.10  library   exposed-modules:     Control.Arrow.Machine, Control.Arrow.Machine.Event, Control.Arrow.Machine.Plan, Control.Arrow.Machine.Types, Control.Arrow.Machine.Utils, Control.Arrow.Machine.Running, Control.Arrow.Machine.ArrowUtil -- other-modules:          other-extensions:    FlexibleInstances, Arrows, RankNTypes, TypeSynonymInstances, MultiParamTypeClasses, GADTs, FlexibleContexts, NoMonomorphismRestriction, RecursiveDo-  build-depends:       base >=4.0 && < 5.0, mtl >=2.0, haddock >= 0.6, free >=4.0 && <= 4.7.1, profunctors >=4.0+  build-depends:       base >=4.0 && < 5.0, mtl >=2.0, haddock >= 0.6, free >=4.0 && < 5.0, profunctors >=4.0   hs-source-dirs:      src   default-language:    Haskell2010 @@ -29,7 +29,7 @@   hs-source-dirs:      test   main-is:             spec.hs   other-modules:       RandomProc-  Build-depends:       base >=4.0, mtl >=2.0, profunctors >=4.0, QuickCheck >=2.0, hspec >=1.0, machinecell+  Build-depends:       base >=4.0 && < 5.0, mtl >=2.0, profunctors >=4.0, QuickCheck >=2.0, hspec >=1.0, machinecell  source-repository head   type:		git@@ -39,4 +39,4 @@ source-repository this   type:		git   location:	https://github.com/as-capabl/machinecell.git-  tag:		release-1.0.0-1+  tag:		release-1.0.1
src/Control/Arrow/Machine/Plan.hs view
@@ -88,10 +88,19 @@  constructT fit pl = ProcessA $ proc (ph, evx) ->   do-    ff <- fit (F.runFreeT pl) -< ()-    go ph ff -<< evx+    probe ph pl -<< evx+        where+    probe Suspend pl = proc _ ->+        returnA -< (Suspend, NoEvent, constructT fit pl)+        +    probe ph pl = proc evx ->+      do+        pfr <- fit (F.runFreeT pl) -< ()+        go ph pfr -<< evx++     go Feed (F.Free (AwaitPF f)) = proc evx ->       do         (| hEv'@@ -103,8 +112,9 @@             (returnA -< (Feed, End, stopped))            |) evx -    go ph pfr = proc evx ->        -        oneYieldPF fit ph pfr -<< ()+    go ph pfr = proc evx ->+        oneYieldPF fit ph pfr -< ()+  oneYieldPF :: (Monad m, ArrowApply a) =>                (forall b. m b -> a () b) ->
src/Control/Arrow/Machine/Types.hs view
@@ -112,16 +112,16 @@               compositeStep' Sweep f g = proc (_, x) ->   do-    (ph1, r1, _) <- f -< (Suspend, x)+    (ph1, r1, pa') <- f -< (Suspend, x)     (ph2, r2, pb') <- g -<< (Sweep, r1)-    cont ph2 x -<< (ph2, r2, ProcessA f >>> pb')+    cont ph2 x -<< (r2, pa', pb')   where-    cont Feed x = returnA-    cont Sweep x = returnA-    cont Suspend x = proc _ ->+    cont Feed x = arr $ \(r, pa, pb) -> (Feed, r, pa >>> pb)+    cont Sweep x = arr $ \(r, pa, pb) -> (Sweep, r, pa >>> pb)+    cont Suspend x = proc (_, pa, pb) ->       do-        (ph1, r1, pa') <- f -< (Sweep, x)-        (ph2, r2, pb') <- g -< (ph1, r1)+        (ph1, r1, pa') <- step pa -<< (Sweep, x)+        (ph2, r2, pb') <- step pb -<< (ph1, r1)         returnA -< (ph2, r2, pa' >>> pb')  compositeStep' ph f g = proc (_, x) ->
src/Control/Arrow/Machine/Utils.hs view
@@ -33,8 +33,7 @@         -- * Other utility arrows         tee,         gather,-        -- sampleR,-        -- sampleL,+        sample,         source,         fork,         filter,@@ -42,6 +41,7 @@         anytime,         par,         parB,+        onEnd        ) where @@ -378,24 +378,17 @@         evMaybe (return ()) (Pl.yield . Left) evx         evMaybe (return ()) (Pl.yield . Right) evy -{---- Problem with the last output.-sampleR ::++sample ::     ArrowApply a =>-    ProcessA a (Event b1, Event b2) (Event (b1, [b2]))-sampleR = join >>> Pl.construct (go id)+    ProcessA a (Event b1, Event b2) [b1]+sample = join >>> Pl.construct (go id) >>> hold []   where     go l =        do         (evx, evy) <- Pl.await-        let l2 = evMaybe l (\y -> l . (y:)) evy-        evMaybe (go l2) (\x -> Pl.yield (x, l2 []) >> go id) evx--sampleL ::-    ArrowApply a =>-    ProcessA a (Event b1, Event b2) (Event ([b1], b2))-sampleL = arr swap >>> sampleR >>> evMap swap--}+        let l2 = evMaybe l (\x -> l . (x:)) evx+        evMaybe (go l2) (\_ -> Pl.yield (l2 []) >> go id) evy  gather ::     (ArrowApply a, Fd.Foldable f) =>@@ -462,3 +455,20 @@ echo = filter (arr (const True))  +onEnd ::+    (ArrowApply a, Occasional b) =>+    ProcessA a b (Event ())+{-+onEnd = dSwitch (arr go) id+  where+    go ev+        | isEnd ev = (undefined, Event Pl.stopped)+        | otherwise = noEvent+-}+onEnd = ProcessA $ proc (ph, ev) ->+  do+    returnA -< go ph ev+  where+    go ph ev +        | isEnd ev = (Feed, Event (), Pl.stopped)+        | otherwise = (ph `mappend` Suspend, noEvent, onEnd)
test/spec.hs view
@@ -338,6 +338,42 @@             run (arr (\x->(x,x)) >>> first delay >>> arr fst) [0, 1, 2] `shouldBe` [0, 1, 2]
             run (arr (\x->(x,x)) >>> first delay >>> arr snd) [0, 1, 2] `shouldBe` [0, 1, 2]
 
+    describe "onEnd" $
+      do
+        it "fires only once at the end of a stream." $
+          do
+            let 
+                pa = proc evx ->
+                  do
+                    x <- hold 0 -< evx
+                    ed <- onEnd -< evx
+                    returnA -< x <$ ed
+            run pa [1..4] `shouldBe` [4]
+
+    describe "sample" $
+      do
+        it "samples events in terms of the 2nd input." $
+          do
+            pendingWith "now many utilities behave incorrectly at the end of stream."
+{-
+            let
+                pa = proc evx ->
+                  do
+                    evy <- fork -< (\x -> [x, x]) <$> evx
+                    ys <- sample -< (evy, evx)
+                    ed <- onEnd -< evx
+                    outEv <- gather -< [() <$ evx, ed]
+                    returnA -< ys <$ outEv
+            Control.Monad.join (run pa [1..2]) `shouldBe` [1, 1, 2, 2]
+-}
+        it "correctly pushes simultaneous events into the same time." $
+          do
+            let 
+                pa = proc evx ->
+                  do
+                    l <- sample -< (evx, evx)
+                    returnA -< l <$ evx
+            run pa [1..3] `shouldBe` [[1], [2], [3]]
 
 switches =
   do