packages feed

machinecell 1.1.1 → 1.2.0

raw patch · 12 files changed

+388/−86 lines, 12 filesdep +arrowsPVP ok

version bump matches the API change (PVP)

Dependencies added: arrows

API changes (from Hackage documentation)

- Control.Arrow.Machine.Plan: instance [overlap ok] Functor (PlanF i o)
- Control.Arrow.Machine.Plan: instance [overlap ok] Monad m => MonadPlus (FreeT (PlanF i o) m)
+ Control.Arrow.Machine.ArrowUtil: elimR :: ArrowAddReader r a a' => a (AS e) b -> a' (e, AS r) b
+ Control.Arrow.Machine.ArrowUtil: fromAS :: AS e -> e
+ Control.Arrow.Machine.ArrowUtil: reading :: (Monad m, Arrow a) => (forall p q. (p -> m q) -> a p q) -> (b -> ReaderT r m c) -> ReaderArrow r a b c
+ Control.Arrow.Machine.ArrowUtil: toAS :: e -> AS e
+ Control.Arrow.Machine.ArrowUtil: type AS e = e
+ Control.Arrow.Machine.Core: data ProcessA a b c
+ Control.Arrow.Machine.Core: fit :: (Arrow a, Arrow a') => (forall p q. a p q -> a' p q) -> ProcessA a b c -> ProcessA a' b c
+ Control.Arrow.Machine.Exception: bracket :: Monad m => PlanT i o m a -> (a -> PlanT i o m b) -> (a -> PlanT i o m c) -> PlanT i o m c
+ Control.Arrow.Machine.Exception: bracketOnError :: Monad m => PlanT i o m a -> (a -> PlanT i o m b) -> (a -> PlanT i o m c) -> PlanT i o m c
+ Control.Arrow.Machine.Exception: bracket_ :: Monad m => PlanT i o m a -> PlanT i o m b -> PlanT i o m c -> PlanT i o m c
+ Control.Arrow.Machine.Exception: catch :: Monad m => PlanT i o m a -> PlanT i o m a -> PlanT i o m a
+ Control.Arrow.Machine.Exception: finally :: Monad m => PlanT i o m a -> PlanT i o m b -> PlanT i o m a
+ Control.Arrow.Machine.Exception: handle :: Monad m => PlanT i o m a -> PlanT i o m a -> PlanT i o m a
+ Control.Arrow.Machine.Exception: onException :: Monad m => PlanT i o m a -> PlanT i o m b -> PlanT i o m a
+ Control.Arrow.Machine.Types: instance (ArrowApply a, ArrowApply a', ArrowAddReader r a a') => ArrowAddReader r (ProcessA a) (ProcessA a')
+ Control.Arrow.Machine.Types: instance (ArrowApply a, ArrowReader r a) => ArrowReader r (ProcessA a)
- Control.Arrow.Machine.Plan: stop :: Plan i o ()
+ Control.Arrow.Machine.Plan: stop :: Plan i o a
- Control.Arrow.Machine.Types: parStep :: (Arrow t, Arrow a, Monoid t4) => t (t2, t1) (t4, t5, a b c) -> t (t2, t3) (t4, t6, a b' c') -> t (t2, (t1, t3)) (t4, (t5, t6), a (b, b') (c, c'))
+ Control.Arrow.Machine.Types: parStep :: (Monoid t4, Arrow t, Arrow a) => t (t2, t1) (t4, t5, a b c) -> t (t2, t3) (t4, t6, a b' c') -> t (t2, (t1, t3)) (t4, (t5, t6), a (b, b') (c, c'))
- Control.Arrow.Machine.Utils: feedback :: (ArrowApply a, Occasional d) => ProcessA a (e, d) b -> ProcessA a (e, b) (c, d) -> ProcessA a e c
+ Control.Arrow.Machine.Utils: feedback :: (ArrowApply a, Occasional d) => ProcessA a (e, AS d) b -> ProcessA a (e, AS b) (c, d) -> ProcessA a (AS e) c
- Control.Arrow.Machine.Utils: feedback1 :: (ArrowApply a, Occasional d) => ProcessA a (e, d) (c, d) -> ProcessA a e c
+ Control.Arrow.Machine.Utils: feedback1 :: (ArrowApply a, Occasional d) => ProcessA a (e, AS d) (c, d) -> ProcessA a (AS e) c
- Control.Arrow.Machine.Utils: passRecent :: (ArrowApply a, Occasional o) => ProcessA a e (Event b) -> ProcessA a (e, b) o -> ProcessA a e o
+ Control.Arrow.Machine.Utils: passRecent :: (ArrowApply a, Occasional o) => ProcessA a (AS e) (Event b) -> ProcessA a (e, AS b) o -> ProcessA a (AS e) o
- Control.Arrow.Machine.Utils: withRecent :: (ArrowApply a, Occasional o) => ProcessA a (e, b) o -> ProcessA a (e, Event b) o
+ Control.Arrow.Machine.Utils: withRecent :: (ArrowApply a, Occasional o) => ProcessA a (e, AS b) o -> ProcessA a (e, AS (Event b)) o

Files

CHANGELOG.md view
@@ -1,3 +1,10 @@+1.2.0+------------+* Support of `ArrowReader`.+* Added await fail handling.+* Improved performance by church-encoded free monads.+* Arrow stack of newest GHC support for some utilities.+ 1.1.1 ------------ * Eliminated banana brackets to support newest GHC.
machinecell.cabal view
@@ -1,5 +1,5 @@ name:                machinecell-version:             1.1.1+version:             1.2.0 synopsis:            Arrow based stream transducers license:             BSD3 license-file:        LICENSE@@ -21,10 +21,10 @@ 	AFRP-like utilities are also available.  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:         Control.Arrow.Machine.Event.Internal+  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, Control.Arrow.Machine.Exception, Control.Arrow.Machine.Core+  other-modules:         Control.Arrow.Machine.Event.Internal, Control.Arrow.Machine.Plan.Internal   other-extensions:    FlexibleInstances, Arrows, RankNTypes, TypeSynonymInstances, MultiParamTypeClasses, GADTs, FlexibleContexts, NoMonomorphismRestriction, RecursiveDo-  build-depends:       base >=4.0 && < 5.0, mtl >=2.0, free >=3.0 && < 5.0, profunctors >=3.0+  build-depends:       base >=4.0 && < 5.0, mtl >=2.0, free >=3.0 && < 5.0, profunctors >=3.0, arrows >= 0.4   hs-source-dirs:      src   default-language:    Haskell2010 @@ -44,4 +44,4 @@ source-repository this   type:		git   location:	https://github.com/as-capabl/machinecell.git-  tag:		release-1.1.1+  tag:		release-1.2.0
src/Control/Arrow/Machine.hs view
@@ -11,6 +11,7 @@         module Control.Arrow.Machine.Event, 
         module Control.Arrow.Machine.Utils,
         module Control.Arrow.Machine.Plan,
+        module Control.Arrow.Machine.Exception,
         module Control.Arrow.Machine.Running,
         module Control.Arrow.Machine.ArrowUtil,
 
@@ -23,6 +24,7 @@ import Control.Arrow.Machine.Event
 import Control.Arrow.Machine.Utils
 import Control.Arrow.Machine.Plan
+import Control.Arrow.Machine.Exception
 import Control.Arrow.Machine.Running
 import Control.Arrow.Machine.ArrowUtil
 
src/Control/Arrow/Machine/ArrowUtil.hs view
@@ -1,18 +1,58 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE Arrows #-} ++-- | Arrow utilities not related to machinecell library. module     Control.Arrow.Machine.ArrowUtil (+        -- * Arrow construction helper         kleisli,         kleisli0,         kleisli2,         kleisli3,         kleisli4,-        kleisli5+        kleisli5,++        reading,++        -- * To absorve arrow stack signature difference bettween ghc 7.8 and older.+        AS,+        toAS,+        fromAS,++        elimR     ) where  import Control.Arrow+import Control.Arrow.Operations (readState)+import Control.Arrow.Transformer.Reader+import Control.Monad.Reader (ReaderT, runReaderT) +#if __GLASGOW_HASKELL__ >= 708 +type AS e = (e, ())++toAS :: e -> AS e+toAS e = (e, ())++fromAS :: AS e -> e+fromAS = fst++#else++type AS e = e++toAS :: e -> AS e+toAS = id++fromAS :: AS e -> e+fromAS = id++#endif++ kleisli :: Monad m => (a->m b) -> Kleisli m a b kleisli = Kleisli @@ -32,3 +72,18 @@ kleisli5 fmx = Kleisli $ \(x1, x2, x3, x4, x5) -> fmx x1 x2 x3 x4 x5  +reading :: +    (Monad m, Arrow a) => +    (forall p q. (p->m q)->a p q) -> +    (b -> ReaderT r m c) -> ReaderArrow r a b c+reading f mr = proc x ->+  do+    r <- readState -< ()+    liftReader (f $ \(x, r) -> runReaderT (mr x) r) -< (x, r)++-- |Alternate for `elimReader` that can be used with both ghc 7.8 and older.+elimR ::+    ArrowAddReader r a a' =>+    a (AS e) b -> a' (e, AS r) b+elimR f =+    second (arr $ fromAS) >>> elimReader (arr toAS >>> f)
+ src/Control/Arrow/Machine/Core.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE Arrows #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE GADTs #-}+++{-|+Extracted stuff to be used unqualified from ../Machine.hs.+-}+module+    Control.Arrow.Machine.Core+      (+        -- * Modules+        module Control.Arrow.Machine.Event, +--        module Control.Arrow.Machine.Utils,+        module Control.Arrow.Machine.Plan,+--        module Control.Arrow.Machine.Exception,+        module Control.Arrow.Machine.Running,+--        module Control.Arrow.Machine.ArrowUtil,++        -- * The transducer arrow+        ProcessA(), +        fit,+       )+where++import Control.Arrow.Machine.Event+-- import Control.Arrow.Machine.Utils+import Control.Arrow.Machine.Plan+-- import Control.Arrow.Machine.Exception+import Control.Arrow.Machine.Running+import qualified Control.Arrow.Machine.Running as Running+-- import Control.Arrow.Machine.ArrowUtil++import Control.Arrow.Machine.Types+import Control.Arrow++
src/Control/Arrow/Machine/Event.hs view
@@ -14,6 +14,9 @@         evMaybe,         fromEvent,         evMap,++        -- * Deprecated+        -- | To be renamed.         split,         join,         split2,
+ src/Control/Arrow/Machine/Exception.hs view
@@ -0,0 +1,98 @@+++module+    Control.Arrow.Machine.Exception+      (+        catch,+        handle,+        bracket,+        bracket_,+        bracketOnError,+        finally,+        onException+       )+where++import qualified Control.Monad.Trans.Free as F+import qualified Control.Monad.Trans.Free.Church as F++import Data.Functor ((<$>))++import Control.Arrow.Machine.Types+import Control.Arrow.Machine.Event+import Control.Arrow.Machine.Event.Internal (Event(..))++import Control.Arrow.Machine.Plan.Internal+import Control.Arrow.Machine.Plan++import Debug.Trace+++catch :: Monad m =>+    PlanT i o m a -> PlanT i o m a -> PlanT i o m a++catch pl cont = +    F.toFT $ catch' (F.fromFT pl) (F.fromFT cont)++catch' (F.FreeT mf) cont@(F.FreeT mcont) = +    F.FreeT $ mf >>= go+  where+    go (F.Pure a) = return $ F.Pure a+    go (F.Free StopPF) = mcont+    go (F.Free (AwaitPF f ff)) = +        return $ F.Free $ +        AwaitPF (\i -> f i `catch'` cont) (ff `catch'` cont)+    go (F.Free fft) = +        return $ F.Free $ (`catch'` cont) <$> fft++handle :: Monad m =>+    PlanT i o m a -> PlanT i o m a -> PlanT i o m a++handle = flip catch+++bracket :: Monad m =>+    PlanT i o m a -> (a -> PlanT i o m b)-> (a -> PlanT i o m c) -> PlanT i o m c+bracket before after thing =+  do+    a <- before+    r <- thing a `catch` (after a >> stop)+    _ <- after a+    return r+++bracket_ :: Monad m =>+    PlanT i o m a -> PlanT i o m b-> PlanT i o m c -> PlanT i o m c+bracket_ before after thing =+  do+    before+    r <- thing `catch` (after >> stop)+    _ <- after+    return r+++bracketOnError :: Monad m =>+    PlanT i o m a -> (a -> PlanT i o m b)-> (a -> PlanT i o m c) -> PlanT i o m c+bracketOnError before after thing =+  do+    a <- before+    r <- thing a `catch` (after a >> stop)+    return r+++finally :: Monad m =>+    PlanT i o m a -> PlanT i o m b-> PlanT i o m a+finally thing after =+  do+    r <- thing `catch` (after >> stop)+    _ <- after+    return r+++onException :: Monad m =>+    PlanT i o m a -> PlanT i o m b-> PlanT i o m a+onException thing after =+  do+    thing `catch` (after >> stop)+    +
src/Control/Arrow/Machine/Plan.hs view
@@ -3,7 +3,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverlappingInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}  {-|@@ -33,6 +32,7 @@  import qualified Control.Category as Cat import qualified Control.Monad.Trans.Free as F+import qualified Control.Monad.Trans.Free.Church as F  import Data.Monoid (mappend) import Data.Functor ((<$>))@@ -45,48 +45,24 @@ import Control.Arrow.Machine.Event import Control.Arrow.Machine.Event.Internal (Event(..)) +import Control.Arrow.Machine.Plan.Internal+ stopped ::      (ArrowApply a, Occasional c) => ProcessA a b c stopped = arr (const end)   -data PlanF i o a where-  AwaitPF :: (i->a) -> PlanF i o a-  YieldPF :: o -> a -> PlanF i o a-  StopPF :: a -> PlanF i o a -instance (Functor (PlanF i o)) where-  fmap g (AwaitPF f) = AwaitPF (g . f)-  fmap g (YieldPF x r) = YieldPF x (g r)-  fmap g (StopPF r) = StopPF (g r) --type PlanT i o m a = F.FreeT (PlanF i o) m a-type Plan i o a = forall m. Monad m => PlanT i o m a--instance -    Monad m => MonadPlus (F.FreeT (PlanF i o) m)-  where-    mzero = stop >> return undefined-    (F.FreeT mf) `mplus` cont@(F.FreeT mcont) = -        F.FreeT $ mf >>= go-      where-        go (F.Pure a) = mcont >>= return-        go (F.Free (StopPF ft)) = mcont >>= return-        go (F.Free fft) = return $ F.Free $ (`mplus` cont) <$> fft- yield :: o -> Plan i o () yield x = F.liftF $ YieldPF x () -await_ :: Monad m => (i->PlanT i o m a) -> PlanT i o m a-await_ f = F.FreeT $ return $ F.Free $ AwaitPF f- await :: Plan i o i-await = await_ return+await = F.FT $ \pure free -> free (AwaitPF pure (free StopPF)) -stop :: Plan i o ()-stop = F.liftF $ StopPF ()+stop :: Plan i o a+stop = F.liftF $ StopPF   @@ -98,16 +74,60 @@               PlanT i o m r ->                ProcessA a (Event i) (Event o) -constructT fit pl = ProcessA $ proc (ph, evx) ->+constructT fit pl = ProcessA $ fit' $ F.runFT pl pure free+  where+    fit' ma = proc arg -> do { (evx, pa) <- fit ma -< (); modFit evx pa -<< arg }+    +    modFit :: ArrowApply a => Event c -> StepType a b (Event c) -> StepType a b (Event c)+    modFit (Event x) stp = retArrow Feed (Event x) (ProcessA stp)+    modFit _ stp = stp++    retArrow ph' evx cont = arr $ \(ph, _) -> +        case ph of+          Suspend -> +              (ph `mappend` Suspend, NoEvent, ProcessA $ retArrow ph' evx cont)+          _ -> +              (ph `mappend` ph', evx, cont)++    pure _ = return $ (End, retArrow Suspend End stopped)++    free (AwaitPF f ff) =+      do+        return $ (NoEvent, arr (uncurry (awaitIt f ff)) >>> proc pc -> pc -<< ())++    free (YieldPF y fc) = return $ (Event y, fit' fc)++    free StopPF = return $ (End, retArrow Suspend End stopped)+++    awaitIt f _ Feed (Event x) = proc _ ->+      do+        (evy, stp) <- fit (f x) -< ()+        returnA -< (Feed, evy, ProcessA stp)++    awaitIt _ ff Feed End = proc _ ->+      do+        (evy, stp) <- fit ff -< ()+        returnA -< (Feed, evy, ProcessA stp)++    awaitIt _ ff Sweep End = proc _ ->+      do+        (evy, stp) <- fit ff -< ()+        returnA -< (if isOccasion evy then Feed else Suspend, evy, ProcessA stp)++    awaitIt f ff ph evx = proc _ ->+        returnA -< (ph `mappend` Suspend, NoEvent, +                    ProcessA $ arr (uncurry (awaitIt f ff)) >>> proc pc -> pc -<< ())++{-+ProcessA $ proc (ph, evx) ->   do     probe ph pl -<< evx     -   where--    feedTo f = proc x ->+    runAndYield fx = proc _ ->       do-        ff2 <- fit (F.runFreeT (f x)) -<< ()+        ff2 <- fit (F.runFreeT fx) -<< ()         oneYieldPF fit Feed ff2 -<< ()      probe Suspend pl = proc _ ->@@ -118,11 +138,16 @@         pfr <- fit (F.runFreeT pl) -< ()         go ph pfr -<< evx -    go Feed (F.Free (AwaitPF f)) = arr (\evx -> ((), evx)) >>>-        hEv' (arr snd >>> feedTo f) (arr $ const (Feed, NoEvent, constructT fit (await_ f))) (arr $ const (Feed, End, stopped))+    go Feed (F.Free (AwaitPF f ff)) = arr (\evx -> ((), evx)) >>>+        hEv' (proc (_, x) -> runAndYield (f x) -<< ()) +             (arr $ const (Feed, NoEvent, constructT fit (await_ f))) +             (proc _ -> runAndYield ff -<< ())      go ph pfr = proc evx ->-        oneYieldPF fit ph pfr -< ()+      do+        let action = case (evx, pfr) of {(End, F.Free (AwaitPF _ ff)) -> ff; _ -> F.FreeT $ return pfr}+        pfr' <- fit (F.runFreeT action) -<< ()+        oneYieldPF fit ph pfr' -<< ()   oneYieldPF :: (Monad m, ArrowApply a) => @@ -139,7 +164,7 @@ oneYieldPF f ph (F.Free (YieldPF x cont)) = proc _ ->     returnA -< (Feed, Event x, constructT f cont) -oneYieldPF f ph (F.Free (StopPF cont)) = proc _ ->+oneYieldPF f ph (F.Free StopPF) = proc _ ->     returnA -< (ph `mappend` Suspend, End, stopped)  oneYieldPF f ph (F.Free pf) = proc _ ->@@ -149,7 +174,7 @@  oneYieldPF f ph (F.Pure x) = proc _ ->     returnA -< (ph `mappend` Suspend, End, stopped)-+-}  repeatedlyT :: (Monad m, ArrowApply a) =>                (forall b. m b -> a () b) ->
+ src/Control/Arrow/Machine/Plan/Internal.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GADTs #-}++module+    Control.Arrow.Machine.Plan.Internal+where++import qualified Control.Monad.Trans.Free as F+import qualified Control.Monad.Trans.Free.Church as F++data PlanF i o a where+  AwaitPF :: (i->a) -> a -> PlanF i o a+  YieldPF :: o -> a -> PlanF i o a+  StopPF :: PlanF i o a++instance (Functor (PlanF i o)) where+  fmap g (AwaitPF f ff) = AwaitPF (g . f) (g ff)+  fmap g (YieldPF x r) = YieldPF x (g r)+  fmap g StopPF = StopPF+++type PlanT i o m a = F.FT (PlanF i o) m a+type Plan i o a = forall m. Monad m => PlanT i o m a
src/Control/Arrow/Machine/Types.hs view
@@ -1,6 +1,10 @@ {-# LANGUAGE Arrows #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+ module     Control.Arrow.Machine.Types     -- This file includes internals. Export definitions is at ../Machine.hs@@ -9,6 +13,8 @@ import qualified Control.Category as Cat import Data.Monoid (Monoid(..)) import Data.Profunctor (Profunctor, dimap)+import Control.Arrow.Operations (ArrowReader(..))+import Control.Arrow.Transformer.Reader (ReaderArrow, runReader, ArrowAddReader(..)) import Control.Arrow  @@ -183,3 +189,37 @@             returnA -< ((ph', y, loop pa'), d')  +instance+    (ArrowApply a, ArrowReader r a) => +    ArrowReader r (ProcessA a)+  where+    readState = ProcessA $ proc (ph, dm) ->+      do+        r <- readState -< dm+        returnA -< (ph `mappend` Suspend, r, readState)++    newReader pa = ProcessA $ proc (ph, (e, r)) ->+      do+        (ph', y, pa') <- newReader (step pa) -< ((ph, e), r)+        returnA -< (ph', y, newReader pa')++instance+    (ArrowApply a, ArrowApply a', ArrowAddReader r a a') =>+    ArrowAddReader r (ProcessA a) (ProcessA a')+  where+    liftReader pa = ProcessA $ proc (ph, x) ->+      do+        (ph', y, pa') <- (| liftReader (step pa -< (ph, x)) |)+        returnA -< (ph', y, liftReader pa)++    elimReader pra = +        ProcessA $ arr pre >>> elimReader (step pra) >>> arr post+      where+        pre (ph, (x, r)) = ((ph, x), r)+        post (ph, x, pra') = (ph, x, elimReader pra')+{-+    elimReader pra = ProcessA $ proc (ph, (x, r)) ->+      do+        (ph', y, pra') <- (| elimReader (step pra -< (ph, x)) |) r+        returnA -< (ph', y, elimReader pra')+-}
src/Control/Arrow/Machine/Utils.hs view
@@ -3,7 +3,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE GADTs #-}+ module     Control.Arrow.Machine.Utils       (@@ -57,28 +57,32 @@ import Control.Monad (liftM, forever) import Control.Monad.Trans import Control.Arrow+import Control.Arrow.Transformer.Reader (ReaderArrow, runReader) import Control.Applicative import Debug.Trace  import Control.Arrow.Machine.Types import Control.Arrow.Machine.Event import Control.Arrow.Machine.Event.Internal (Event(..))+import Control.Arrow.Machine.ArrowUtil  import qualified Control.Arrow.Machine.Plan as Pl-+import Control.Arrow.Machine.Exception    delay ::     (ArrowApply a, Occasional b) => ProcessA a b b+ delay = join >>> delayImpl >>> split   where     delayImpl = Pl.repeatedly $       do-        x <- Pl.await+        mx <- liftM Just Pl.await `catch` return Nothing         Pl.yield noEvent-        Pl.yield x+        maybe Pl.stop Pl.yield mx + hold ::      ArrowApply a => b -> ProcessA a (Event b) b {-@@ -120,28 +124,27 @@  passRecent ::      (ArrowApply a, Occasional o) =>-    ProcessA a e (Event b) ->-    ProcessA a (e, b) o ->-    ProcessA a e o+    ProcessA a (AS e) (Event b) ->+    ProcessA a (e, AS b) o ->+    ProcessA a (AS e) o -passRecent af ag = proc e ->+passRecent af ag = proc ase ->   do-    evx <- af -< e+    evx <- af -< ase     mvx <- hold Nothing -< Just <$> evx     case mvx of-      Just x -> ag -< (e, x)+      Just x -> ag -< (fromAS ase, toAS x)       _ -> returnA -< noEvent --- No use for banana brackets since ghc 7.8.1 withRecent ::      (ArrowApply a, Occasional o) =>-    ProcessA a (e, b) o ->-    ProcessA a (e, Event b) o-withRecent af = proc (e, evx) ->+    ProcessA a (e, AS b) o ->+    ProcessA a (e, AS (Event b)) o+withRecent af = proc (e, asevx) ->   do-    mvx <- hold Nothing -< Just <$> evx+    mvx <- hold Nothing -< Just <$> fromAS asevx     case mvx of-      Just x -> af -< (e, x)+      Just x -> af -< (e, toAS x)       _ -> returnA -< noEvent  @@ -151,15 +154,15 @@ -- So be careful to make an infinite loop. feedback1 ::     (ArrowApply a, Occasional d) =>-    ProcessA a (e, d) (c, d) ->-    ProcessA a e c-feedback1 pa = ProcessA $ proc (ph, e) ->+    ProcessA a (e, AS d) (c, d) ->+    ProcessA a (AS e) c+feedback1 pa = ProcessA $ proc (ph, ase) ->   do-    (ph', (y, d), pa') <- step pa -< (ph, (e, noEvent))+    (ph', (y, d), pa') <- step pa -< (ph, (fromAS ase, toAS noEvent))     returnA -< (ph', y, cont ph' d pa')   where     cont phPrev d paC -        | isOccasion d = ProcessA $ proc (ph, e) ->+        | isOccasion d = ProcessA $ proc (ph, ase) ->           do             let                (dIn, dOut, phPv2, phCur) = @@ -169,13 +172,13 @@                   else                     (d, id, id, ph `mappend` Feed) -            (ph', (y, d'), pa') <- step paC -< (phCur, (e, dIn))+            (ph', (y, d'), pa') <- step paC -< (phCur, (fromAS ase, toAS dIn))             returnA -< (ph', y, cont (phPv2 ph') (dOut d') pa') -        | isEnd d && phPrev == Feed = ProcessA $ proc (ph, e) ->+        | isEnd d && phPrev == Feed = ProcessA $ proc (ph, ase) ->           do-            (ph', (y, _), pa') <- step pa -< (ph, (e, end))-            returnA -< (ph', y, proc x -> arr fst <<< pa' -< (x, end))+            (ph', (y, _), pa') <- step paC -< (ph, (fromAS ase, toAS end))+            returnA -< (ph', y, proc asx -> arr fst <<< pa' -< (fromAS asx, toAS end))          | otherwise = feedback1 paC @@ -184,14 +187,14 @@ -- rather than banana brackets. feedback ::     (ArrowApply a, Occasional d) =>-    ProcessA a (e, d) b ->-    ProcessA a (e, b) (c, d) ->-    ProcessA a e c+    ProcessA a (e, AS d) b ->+    ProcessA a (e, AS b) (c, d) ->+    ProcessA a (AS e) c feedback pa pb = -    feedback1 $ proc (e, x) -> +    feedback1 $ proc (ase, x) ->        do -        y <- pa -< (e, x)-        pb -< (e, y)+        y <- pa -< (ase, x)+        pb -< (ase, toAS y)   --@@ -389,7 +392,6 @@         (col c)  rpSwitchB = rpSwitch broadcast-  -- -- other utility arrow
test/spec.hs view
@@ -324,7 +324,19 @@             result = run (repeatedly pl) l
         result `shouldBe` [2, 3, 5, 6, 10, 11, 20, 21, 100, 101]
 
+    it "can handle the end with catch." $
+      do
+        let pl2 =
+              do
+                x <- await `catch` (yield 1 >> stop)
+                yield x
+                y <- await 
+                yield y
 
+        run (construct pl2) [] `shouldBe` [1]
+        run (construct pl2) [3] `shouldBe` [3]
+        run (construct pl2) [3, 2] `shouldBe` [3, 2]
+
 utility =
   do
     describe "delay" $
@@ -438,8 +450,6 @@       do
         it "acts like local variable with hold." $
           do
-            pendingWith "Arrow statement with argument broken."
-{-
             let 
                 pa = proc evx ->
                   do
@@ -448,19 +458,16 @@                       do
                         returnA -< ((+y) <$> evx, (y+1) <$ evx)
             run pa [1, 2, 3] `shouldBe` [11, 13, 15]
--}
+
         it "correctly handles stream end." $
           do
-            pendingWith "Arrow statement with argument broken."
-{-
             let 
                 pa = proc x -> 
-                    (\x -> returnA -< x)
+                    (\asx -> returnA -< asx)
                   `feedback` 
-                    (\y -> returnA -< (y::Event Int, x))
+                    (\asy -> returnA -< (asy::Event Int, x))
                 comp = mkProc (PgPush PgStop) >>> pa
             stateProc comp [0, 0] `shouldBe` ([], [0])
--}
 
         it "correctly handles stream end.(2)" $
           do