diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2014, as_capabl
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of as_capabl nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,13 @@
+machinecell
+===========
+
+Arrow based stream transducer.
+
+Description
+---------------
+Coroutine-style stream processing library with support of arrow combinatins.
+AFRP-like utilities are also available.
+
+Usage
+---------------
+See example of test/Main.hs
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/machinecell.cabal b/machinecell.cabal
new file mode 100644
--- /dev/null
+++ b/machinecell.cabal
@@ -0,0 +1,42 @@
+-- Initial machinecell.cabal generated by cabal init.  For further 
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+name:                machinecell
+version:             1.0.0
+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.
+license:             BSD3
+license-file:        LICENSE
+author:              Hidenori Azuma
+maintainer:          Hidenori Azuma <as.capabl@gmail.com>
+copyright:           Copyright (c) 2014 Hidenori Azuma
+category:            Control
+build-type:          Simple
+extra-source-files:  README.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
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+
+Test-suite spec
+  type:                exitcode-stdio-1.0
+  default-language:    Haskell2010
+  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
+
+source-repository head
+  type:		git
+  location:	https://github.com/as-capabl/machinecell.git
+  branch:	master
+
+source-repository this
+  type:		git
+  location:	https://github.com/as-capabl/machinecell.git
+  tag:		release-1.0.0-1
diff --git a/src/Control/Arrow/Machine.hs b/src/Control/Arrow/Machine.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Arrow/Machine.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE Arrows #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE GADTs #-}
+module
+    Control.Arrow.Machine
+      (
+        -- * Modules
+        module Control.Arrow.Machine.Event, 
+        module Control.Arrow.Machine.Utils,
+        module Control.Arrow.Machine.Plan,
+        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.Running
+import Control.Arrow.Machine.ArrowUtil
+
+
+import Control.Arrow.Machine.Types
diff --git a/src/Control/Arrow/Machine/ArrowUtil.hs b/src/Control/Arrow/Machine/ArrowUtil.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Arrow/Machine/ArrowUtil.hs
@@ -0,0 +1,34 @@
+
+module
+    Control.Arrow.Machine.ArrowUtil (
+        kleisli,
+        kleisli0,
+        kleisli2,
+        kleisli3,
+        kleisli4,
+        kleisli5
+    )
+where
+
+import Control.Arrow
+
+
+kleisli :: Monad m => (a->m b) -> Kleisli m a b
+kleisli = Kleisli
+
+kleisli0 :: Monad m => m b -> Kleisli m () b
+kleisli0 = Kleisli . const
+
+kleisli2 :: Monad m => (a1 -> a2 -> m b) -> Kleisli m (a1, a2) b
+kleisli2 fmx = Kleisli $ \(x1, x2) -> fmx x1 x2
+
+kleisli3 :: Monad m => (a1 -> a2 -> a3 -> m b) -> Kleisli m (a1, a2, a3) b
+kleisli3 fmx = Kleisli $ \(x1, x2, x3) -> fmx x1 x2 x3
+
+kleisli4 :: Monad m => (a1 -> a2 -> a3 -> a4 -> m b) -> Kleisli m (a1, a2, a3, a4) b
+kleisli4 fmx = Kleisli $ \(x1, x2, x3, x4) -> fmx x1 x2 x3 x4
+
+kleisli5 :: Monad m => (a1 -> a2 -> a3 -> a4 -> a5 -> m b) -> Kleisli m (a1, a2, a3, a4, a5) b
+kleisli5 fmx = Kleisli $ \(x1, x2, x3, x4, x5) -> fmx x1 x2 x3 x4 x5
+
+
diff --git a/src/Control/Arrow/Machine/Event.hs b/src/Control/Arrow/Machine/Event.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Arrow/Machine/Event.hs
@@ -0,0 +1,208 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE Arrows #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE GADTs #-}
+module
+    Control.Arrow.Machine.Event 
+      (
+        Occasional (..),
+        Event (..), 
+        hEv, 
+        hEv', 
+        evMaybe,
+        fromEvent,
+        evMap,
+        split,
+        join,
+        split2,
+        join2
+      )
+where
+
+
+import Control.Monad (liftM, MonadPlus(..))
+import Control.Arrow
+import Control.Applicative (Applicative(..), Alternative(..), (<$>))
+import Data.Foldable (Foldable(..))
+import Data.Traversable (Traversable(..))
+import Data.Monoid (mempty)
+
+
+class 
+    Occasional a
+  where
+    noEvent :: a
+    end :: a
+    isNoEvent :: a -> Bool
+    isEnd :: a -> Bool
+    isOccasion :: a -> Bool
+    isOccasion x = not (isNoEvent x) && not (isEnd x)
+
+instance
+    (Occasional a, Occasional b) => Occasional (a, b)
+  where
+    noEvent = (noEvent, noEvent)
+    end = (end, end)
+    isOccasion xy@(x, y) = 
+        (isOccasion x || isOccasion y) && not (isEnd xy)
+    isNoEvent xy = 
+        not (isOccasion xy) && not (isEnd xy)
+    isEnd (x, y) = isEnd x && isEnd y
+
+
+data Event a = Event a | NoEvent | End deriving (Eq, Show)
+
+instance 
+    Occasional (Event a)
+  where
+    noEvent = NoEvent
+    end = End
+    isNoEvent NoEvent = True
+    isNoEvent _ = False
+    isEnd End = True
+    isEnd _ = False
+
+hEv :: ArrowApply a => a (e,b) c -> a e c -> a (e, Event b) c
+hEv f1 f2 = proc (e, ev) ->
+    helper ev -<< e
+  where
+    helper (Event x) = proc e -> f1 -< (e, x)
+    helper NoEvent = f2
+    helper End = f2
+
+hEv' :: ArrowApply a => a (e,b) c -> a e c -> a e c -> a (e, Event b) c
+hEv' f1 f2 f3 = proc (e, ev) ->
+    helper ev -<< e
+  where
+    helper (Event x) = proc e -> f1 -< (e, x)
+    helper NoEvent = f2
+    helper End = f3
+
+
+instance 
+    Functor Event 
+  where
+    fmap f NoEvent = NoEvent
+    fmap f End = End
+    fmap f (Event x) = Event (f x)
+
+
+instance 
+    Applicative Event 
+  where
+    pure = Event
+
+    (Event f) <*> (Event x) = Event $ f x
+    End <*> _ = End
+    _ <*> End = End
+    _ <*> _ = NoEvent
+
+
+instance
+    Foldable Event
+  where
+    foldMap f (Event x) = f x
+    foldMap _ NoEvent = mempty
+    foldMap _ End = mempty
+
+
+instance
+    Traversable Event
+  where
+    traverse f (Event x) = Event <$> f x
+    traverse f NoEvent = pure NoEvent
+    traverse f End = pure End
+
+
+instance
+    Alternative Event
+  where
+    empty = NoEvent
+    End <|> _ = End
+    _ <|> End = End
+    Event x <|> _ = Event x
+    NoEvent <|> r = r
+
+
+instance
+    Monad Event
+  where
+    return = Event
+
+    Event x >>= f = f x
+    NoEvent >>= _ = NoEvent
+    End >>= _ = End
+
+    _ >> End = End
+    l >> r = l >>= const r
+    
+    fail _ = End
+
+
+instance
+    MonadPlus Event
+  where
+    mzero = End
+
+    Event x `mplus` _ = Event x
+    _ `mplus` Event x = Event x
+    End `mplus` r = r
+    l `mplus` End = l
+    _ `mplus` _ = NoEvent
+
+
+evMaybe :: Arrow a => c -> (b->c) -> a (Event b) c
+evMaybe r f = arr (go r f)
+  where
+    go _ f (Event x) = f x
+    go r _ NoEvent = r
+    go r _ End = r
+
+
+fromEvent :: Arrow a => b -> a (Event b) b
+fromEvent x = evMaybe x id
+
+
+-- TODO: テスト
+condEvent :: Bool -> Event a -> Event a
+condEvent _ End = End
+condEvent True ev = ev
+condEvent False ev = NoEvent
+
+
+-- TODO: テスト
+filterEvent :: (a -> Bool) -> Event a -> Event a
+filterEvent cond ev@(Event x) = condEvent (cond x) ev
+filterEvent _ ev = ev
+
+
+evMap ::  Arrow a => (b->c) -> a (Event b) (Event c)
+evMap = arr . fmap
+
+
+-- TODO: テスト
+split :: (Arrow a, Occasional b) => a (Event b) b
+split = arr go
+  where
+    go (Event x) = x
+    go NoEvent = noEvent
+    go End = end
+
+
+join :: (Arrow a, Occasional b) => a b (Event b)
+join = arr go
+  where
+    go x 
+       | isEnd x = End
+       | isNoEvent x = NoEvent
+       | otherwise = Event x
+
+
+split2 :: Event (Event a, Event b) -> (Event a, Event b)
+split2 = split
+
+
+join2 :: (Event a, Event b) -> Event (Event a, Event b)
+join2 = join
diff --git a/src/Control/Arrow/Machine/Plan.hs b/src/Control/Arrow/Machine/Plan.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Arrow/Machine/Plan.hs
@@ -0,0 +1,158 @@
+{-# LANGUAGE Arrows #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+{-|
+A coroutine monad, inspired by machines library.
+-}
+module
+    Control.Arrow.Machine.Plan
+      (
+        -- * Types and Primitives
+        PlanT,
+        Plan,
+
+        await,
+        yield,
+        stop,
+
+        stopped,
+
+        -- * Constructing machines
+        constructT,
+        repeatedlyT,
+
+        construct,
+        repeatedly
+       )
+where
+
+import qualified Control.Category as Cat
+import qualified Control.Monad.Trans.Free as F
+
+import Data.Monoid (mappend)
+import Control.Monad
+import Control.Arrow
+import Control.Applicative
+import Control.Monad.Trans
+import Debug.Trace
+
+import Control.Arrow.Machine.Types
+import Control.Arrow.Machine.Event
+
+
+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
+
+
+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
+
+stop :: Plan i o ()
+stop = F.liftF $ StopPF ()
+
+
+
+
+
+constructT :: (Monad m, ArrowApply a) => 
+              (forall b. m b -> a () b) ->
+              PlanT i o m r -> 
+              ProcessA a (Event i) (Event o)
+
+constructT fit pl = ProcessA $ proc (ph, evx) ->
+  do
+    ff <- fit (F.runFreeT pl) -< ()
+    go ph ff -<< evx
+
+  where
+    go Feed (F.Free (AwaitPF f)) = proc evx ->
+      do
+        (| hEv'
+            (\x -> 
+              do
+                ff2 <- fit (F.runFreeT (f x)) -<< ()
+                oneYieldPF fit Feed ff2 -<< ())
+            (returnA -< (Feed, NoEvent, constructT fit (await_ f)))
+            (returnA -< (Feed, End, stopped))
+           |) evx
+
+    go ph pfr = proc evx ->        
+        oneYieldPF fit ph pfr -<< ()
+
+oneYieldPF :: (Monad m, ArrowApply a) => 
+              (forall b. m b -> a () b) ->
+              Phase -> 
+              F.FreeF (PlanF i o) r (PlanT i o m r) -> 
+              a () (Phase, 
+                    Event o, 
+                    ProcessA a (Event i) (Event o))
+
+oneYieldPF f Suspend pfr = proc _ ->
+    returnA -< (Suspend, NoEvent, constructT f $ F.FreeT $ return pfr)
+
+oneYieldPF f ph (F.Free (YieldPF x cont)) = proc _ ->
+    returnA -< (Feed, Event x, constructT f cont)
+
+oneYieldPF f ph (F.Free (StopPF cont)) = proc _ ->
+    returnA -< (ph `mappend` Suspend, End, stopped)
+
+oneYieldPF f ph (F.Free pf) = proc _ ->
+    returnA -< (ph `mappend` Suspend, 
+                NoEvent, 
+                constructT f $ F.FreeT $ return $ F.Free pf)
+
+oneYieldPF f ph (F.Pure x) = proc _ ->
+    returnA -< (ph `mappend` Suspend, End, stopped)
+
+
+repeatedlyT :: (Monad m, ArrowApply a) => 
+              (forall b. m b -> a () b) ->
+              PlanT i o m r -> 
+              ProcessA a (Event i) (Event o)
+
+repeatedlyT f pl = constructT f $ forever pl
+
+
+-- for pure
+construct :: ArrowApply a =>
+             Plan i o t -> 
+             ProcessA a (Event i) (Event o)
+construct pl = constructT kleisli pl
+  where
+    kleisli (ArrowMonad a) = a
+{-
+    unKleisli (Kleisli f) = proc x -> 
+        case f x of {ArrowMonad af -> af} -<< ()
+-}    
+
+repeatedly :: ArrowApply a =>
+              Plan i o t -> 
+              ProcessA a (Event i) (Event o)
+repeatedly pl = construct $ forever pl
diff --git a/src/Control/Arrow/Machine/Running.hs b/src/Control/Arrow/Machine/Running.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Arrow/Machine/Running.hs
@@ -0,0 +1,138 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE Arrows #-}
+{-# LANGUAGE RankNTypes #-}
+
+module
+    Control.Arrow.Machine.Running
+      (
+        -- * Run at once.
+        run,
+        -- * Run step-by-step.
+        ExecInfo(..),
+        stepRun,
+        stepYield
+      )
+where
+
+import Control.Arrow
+import Control.Applicative (Alternative (..))
+import Data.Monoid (Monoid (..))
+
+import Control.Arrow.Machine.Types
+import Control.Arrow.Machine.Event
+
+
+adv Feed = Sweep
+adv Suspend = Feed
+
+
+handle f1 f2 f3 = proc (e, (ph, ev)) ->
+    handleImpl ph ev -<< e
+  where
+    handleImpl Feed (Event x) = proc e -> f1 -< (e, x)
+    handleImpl Suspend _ = f3
+    handleImpl _ End = f3
+    handleImpl _ _ = f2
+
+
+run :: ArrowApply a => ProcessA a (Event b) (Event c) -> a [b] [c]
+run pa = proc xs -> 
+  do
+    ys <- go Sweep pa xs id -<< ()
+    returnA -< ys []
+  where
+    go Sweep pa [] ys = proc _ ->
+      do
+        (ph', y, pa') <- step pa -< (Sweep, End)
+        react y ph' pa' [] ys -<< ()
+
+    go Feed pa [] ys = arr $ const ys
+
+    go ph pa (x:xs) ys = proc _ ->
+      do
+        let (evx, xs') = if ph == Feed then (Event x, xs) else (NoEvent, x:xs)
+        (ph', y, pa') <- step pa -< (ph, evx)
+        react y ph' pa' xs' ys -<< ()
+    
+    react End ph pa xs ys =
+      do
+        go (adv ph) pa [] ys
+
+    react (Event y) ph pa xs ys =
+        go (adv ph) pa xs (\cont -> ys (y:cont))
+
+    react NoEvent ph pa xs ys =
+        go (adv ph) pa xs ys
+
+
+-- | Represents return values and informations of step executions.
+data ExecInfo fa =
+    ExecInfo
+      {
+        yields :: fa, -- [a] or Maybe a
+        hasConsumed :: Bool,
+        hasStopped :: Bool
+      }
+    deriving (Eq, Show)
+
+instance
+    Alternative f => Monoid (ExecInfo (f a))
+  where
+    mempty = ExecInfo empty False False
+    ExecInfo y1 c1 s1 `mappend` ExecInfo y2 c2 s2 = 
+        ExecInfo (y1 <|> y2) (c1 || c2) (s1 || s2)
+
+stepRun :: 
+    ArrowApply a =>
+    ProcessA a (Event b) (Event c) ->
+    a b (ExecInfo [c], ProcessA a (Event b) (Event c))
+
+
+
+stepRun pa = proc x ->
+  do
+    (ys1, pa', _) <- go pa id -<< (Sweep, NoEvent)
+    (ys2, pa'', hsS) <- go pa' ys1 -<< (Feed, (Event x))
+    returnA -< (ExecInfo { yields = ys2 [], hasConsumed = True, hasStopped = hsS } , pa'')
+
+  where
+    go pa ys = step pa >>> proc (ph', evy, pa') ->
+      do
+        (| handle
+            (\y -> go pa' (\cont -> ys (y:cont)) -<< (adv ph', NoEvent))
+            (go pa' ys -<< (adv ph', NoEvent))
+            (returnA -< (ys, pa', case evy of {End->True; _->False}))
+         |)
+            (ph', evy)
+
+                     
+stepYield :: 
+    ArrowApply a =>
+    ProcessA a (Event b) (Event c) ->
+    a b (ExecInfo (Maybe c), ProcessA a (Event b) (Event c))
+
+stepYield pa = proc x ->
+  do
+    (my, pa', hsS) <- go pa -<< (Sweep, NoEvent)
+    (| handle2 
+        (returnA -< (ExecInfo { yields = my, hasConsumed = False, hasStopped = hsS}, pa'))
+        (do
+            (my2, pa'', hsS) <- go pa' -<< (Feed, (Event x))
+            returnA -< (ExecInfo { yields = my2, hasConsumed = True, hasStopped = hsS}, pa''))
+     |)
+        my
+
+  where
+    go pa = step pa >>> proc (ph', evy, pa') ->
+      do
+        (| handle
+            (\y -> returnA -<< (Just y, pa', False))
+            (go pa' -<< (adv ph', NoEvent))
+            (returnA -< (Nothing, pa', case evy of {End->True; _->False}))
+         |)
+            (ph', evy)
+
+
+    handle2 f1 f2 = proc (e, mx) ->
+        maybe f2 (const f1) mx -<< e
+
diff --git a/src/Control/Arrow/Machine/Types.hs b/src/Control/Arrow/Machine/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Arrow/Machine/Types.hs
@@ -0,0 +1,179 @@
+{-# LANGUAGE Arrows #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE GADTs #-}
+module
+    Control.Arrow.Machine.Types
+    -- This file includes internals. Export definitions is at ../Machine.hs
+where
+
+import qualified Control.Category as Cat
+import Data.Monoid (Monoid(..))
+import Data.Profunctor (Profunctor, dimap)
+import Control.Arrow
+
+
+-- | To get multiple outputs by one input, the `Phase` parameter is introduced.
+--
+-- Once a value `Feed`ed, the machine is `Sweep`ed until it `Suspend`s.
+data Phase = Feed | Sweep | Suspend deriving (Eq, Show)
+
+instance 
+    Monoid Phase 
+  where
+    mempty = Sweep
+
+    mappend Feed _ = Feed
+    mappend _ Feed = Feed
+    mappend Suspend _ = Suspend
+    mappend _ Suspend = Suspend
+    mappend Sweep Sweep = Sweep
+
+
+type StepType a b c = a (Phase, b) (Phase, c, ProcessA a b c) 
+
+-- | The stream transducer arrow.
+--
+-- To construct `ProcessA` instances, use `Control.Arrow.Machine.Plan.Plan`,
+-- `arr`, functions declared in `Control.Arrow.Machine.Utils`,
+-- or arrow combinations of them.
+data ProcessA a b c = ProcessA { 
+      step :: StepType a b c
+    }
+
+fit :: (Arrow a, Arrow a') => 
+       (forall p q. a p q -> a' p q) -> 
+       ProcessA a b c -> ProcessA a' b c
+fit f (ProcessA af) = ProcessA $ f af >>> arr mod
+  where
+    mod (ph, y, next) = (ph, y, fit f next)
+
+
+instance
+    Arrow a => Profunctor (ProcessA a)
+  where
+    dimap f g pa = ProcessA $ dimapStep f g (step pa)
+    {-# INLINE dimap #-}
+
+dimapStep :: Arrow a => 
+             (b->c)->(d->e)->
+             StepType a c d -> StepType a b e
+dimapStep f g stp = proc (ph, x) ->
+  do
+    (ph', y, pa') <- stp -< (ph, f x)
+    returnA -< (ph', g y, dimap f g pa')
+{-# INLINE [1] dimapStep #-}
+
+
+instance
+    ArrowApply a => Cat.Category (ProcessA a)
+  where
+    id = ProcessA (arrStep id)
+    {-# INLINE id #-}
+    g . f = ProcessA $ compositeStep (step f) (step g)
+    {-# INLINE (.) #-}
+
+
+instance 
+    ArrowApply a => Arrow (ProcessA a)
+  where
+    arr = ProcessA . arrStep
+    {-# INLINE arr #-}
+
+    first pa = ProcessA $ proc (ph, (x, d)) ->
+      do
+        (ph', y, pa') <- step pa -< (ph, x)
+        returnA -< (ph' `mappend` Suspend, (y, d), first pa')
+    {-# INLINE first #-}
+
+    pa *** pb = ProcessA $ parStep (step pa) (step pb)
+    {-# INLINE (***) #-}
+
+
+parStep f g = proc (ph, (x1, x2)) ->
+  do
+    (ph1, y1, pa') <- f -< (ph, x1)
+    (ph2, y2, pb') <- g -< (ph, x2)
+    returnA -< (ph1 `mappend` ph2, (y1, y2), pa' *** pb')
+{-# INLINE [1] parStep #-}
+
+arrStep :: ArrowApply a => (b->c) -> StepType a b c
+arrStep f = proc (ph, x) ->
+    returnA -< (ph `mappend` Suspend, f x, ProcessA $ arrStep f)
+{-# INLINE [1] arrStep #-}
+
+compositeStep :: ArrowApply a => 
+              StepType a b d -> StepType a d c -> StepType a b c
+compositeStep f g = proc (ph, x) -> compositeStep' ph f g -<< (ph, x)
+{-# INLINE [1] compositeStep #-}
+
+compositeStep' :: ArrowApply a => 
+              Phase -> 
+              StepType a b d -> StepType a d c -> StepType a b c
+             
+compositeStep' Sweep f g = proc (_, x) ->
+  do
+    (ph1, r1, _) <- f -< (Suspend, x)
+    (ph2, r2, pb') <- g -<< (Sweep, r1)
+    cont ph2 x -<< (ph2, r2, ProcessA f >>> pb')
+  where
+    cont Feed x = returnA
+    cont Sweep x = returnA
+    cont Suspend x = proc _ ->
+      do
+        (ph1, r1, pa') <- f -< (Sweep, x)
+        (ph2, r2, pb') <- g -< (ph1, r1)
+        returnA -< (ph2, r2, pa' >>> pb')
+
+compositeStep' ph f g = proc (_, x) ->
+  do
+    (ph1, r1, pa') <- f -< (ph, x)
+    (ph2, r2, pb') <- g -<< (ph1, r1)
+    returnA -< (ph2, r2, pa' >>> pb')
+
+-- rules
+{-# RULES
+"ProcessA: concat/concat" 
+    forall f g h. compositeStep (compositeStep f g) h = compositeStep f (compositeStep g h)
+"ProcessA: arr/arr"
+    forall f g. compositeStep (arrStep f) (arrStep g) = arrStep (g . f)
+"ProcessA: arr/*"
+    forall f g. compositeStep (arrStep f) g = dimapStep f id g
+"ProcessA: */arr"
+    forall f g. compositeStep f (arrStep g) = dimapStep id g f
+"ProcessA: dimap/dimap"
+    forall f g h i j. dimapStep f j (dimapStep g i h)  = dimapStep (g . f) (j . i) h
+"ProcessA: dimap/arr"
+    forall f g h. dimapStep f h (arrStep g) = arrStep (h . g . f)
+"ProcessA: par/par"
+    forall f1 f2 g1 g2 h. compositeStep (parStep f1 f2) (compositeStep (parStep g1 g2) h) =
+        compositeStep (parStep (compositeStep f1 g1) (compositeStep f2 g2)) h
+"ProcessA: par/par-2"
+    forall f1 f2 g1 g2. compositeStep (parStep f1 f2) (parStep g1 g2) =
+        parStep (compositeStep f1 g1) (compositeStep f2 g2)
+  #-}
+
+
+
+instance
+    ArrowApply a => ArrowChoice (ProcessA a)
+  where
+    left pa@(ProcessA a) = ProcessA $ proc (ph, eth) -> go ph eth -<< ()
+      where
+        go ph (Left x) = proc _ -> 
+          do
+            (ph', y, pa') <- a -< (ph, x)
+            returnA -< (ph', Left y, left pa')
+        go ph (Right d) = proc _ -> 
+            returnA -< (ph `mappend` Suspend, Right d, left pa)
+
+instance
+    (ArrowApply a, ArrowLoop a) => ArrowLoop (ProcessA a)
+  where
+    loop pa = ProcessA $ proc (ph, x) -> loop $ go ph -<< x
+      where
+        go ph = proc (x, d) ->
+          do 
+            (ph', (y, d'), pa') <- step pa -< (ph, (x, d))
+            returnA -< ((ph', y, loop pa'), d')
+
+
diff --git a/src/Control/Arrow/Machine/Utils.hs b/src/Control/Arrow/Machine/Utils.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Arrow/Machine/Utils.hs
@@ -0,0 +1,464 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE Arrows #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE GADTs #-}
+module
+    Control.Arrow.Machine.Utils
+      (
+        -- * AFRP-like utilities
+        delay,
+        hold,
+        accum,
+        edge,
+        passRecent,
+        withRecent,
+
+        -- * Switches
+        -- | Switches inspired by Yampa library.
+        -- Signature is almost same, but collection requirement is  not only 'Functor', 
+        -- but 'Tv.Traversable'. This is because of side effects.
+        switch,
+        dSwitch,
+        rSwitch,
+        drSwitch,
+        kSwitch,
+        dkSwitch,
+        pSwitch,
+        pSwitchB,
+        rpSwitch,
+        rpSwitchB,
+
+        -- * Other utility arrows
+        tee,
+        gather,
+        -- sampleR,
+        -- sampleL,
+        source,
+        fork,
+        filter,
+        echo,
+        anytime,
+        par,
+        parB,
+       )
+where
+
+import Prelude hiding (filter)
+
+import Data.Monoid (mappend, mconcat)
+import Data.Tuple (swap)
+import qualified Data.Foldable as Fd
+import qualified Data.Traversable as Tv
+import qualified Control.Category as Cat
+import Control.Monad (liftM, forever)
+import Control.Monad.Trans
+import Control.Arrow
+import Control.Applicative
+import Debug.Trace
+
+import Control.Arrow.Machine.Types
+import Control.Arrow.Machine.Event
+
+import qualified Control.Arrow.Machine.Plan as Pl
+
+
+
+
+
+delay :: 
+    (ArrowApply a, Occasional b) => ProcessA a b b
+delay = join >>> delayImpl >>> split
+  where
+    delayImpl = Pl.repeatedly $
+      do
+        x <- Pl.await
+        Pl.yield noEvent
+        Pl.yield x
+
+hold :: 
+    ArrowApply a => b -> ProcessA a (Event b) b
+{-
+hold old = ProcessA $ proc (ph, evx) ->
+  do
+    let new = fromEvent old evx
+    returnA -< (ph `mappend` Suspend, new, hold new)
+-}
+hold old = proc evx -> 
+  do
+    rSwitch (arr $ const old) -< ((), arr . const <$> evx)
+
+accum ::
+    ArrowApply a => b -> ProcessA a (Event (b->b)) b
+accum old = proc evf ->
+  do
+    rSwitch (arr $ const old) -< ((), arr . const <$> (evf <*> pure old))
+
+edge :: 
+    (ArrowApply a, Eq b) =>
+    ProcessA a b (Event b)
+
+edge = ProcessA $ impl Nothing 
+  where
+    impl mvx = proc (ph, x) -> 
+      do
+        let equals = maybe False (==x) mvx
+            isActive = not $ ph == Suspend
+        returnA -< if (not equals) && isActive
+          then 
+            (Feed, Event x, ProcessA $ impl (Just x))
+          else
+            (ph `mappend` Suspend, NoEvent, ProcessA $ impl mvx)
+
+
+infixr 9 `passRecent`
+
+passRecent :: 
+    (ArrowApply a, Occasional o) =>
+    ProcessA a e (Event b) ->
+    ProcessA a (e, b) o ->
+    ProcessA a e o
+
+passRecent af ag = proc e ->
+  do
+    evx <- af -< e
+    mvx <- hold Nothing -< Just <$> evx
+    case mvx of
+      Just x -> ag -< (e, x)
+      _ -> returnA -< noEvent
+
+withRecent :: 
+    (ArrowApply a, Occasional o) =>
+    ProcessA a (e, b) o ->
+    ProcessA a (e, Event b) o
+withRecent af = proc (e, evb) ->
+    (returnA -< evb) `passRecent` (\b -> af -< (e, b))
+
+
+--
+-- Switches
+--
+hEvPh :: ArrowApply a => a (e,b) c -> a e c -> a (e, (Phase, Event b)) c
+hEvPh f1 f2 = proc (e, (ph, ev)) ->
+    helper ph ev -<< e
+  where
+    helper Feed (Event x) = proc e -> f1 -< (e, x)
+    helper _ _ = f2
+
+
+hEvPh' :: ArrowApply a => a (e,b) c -> a e c -> a e c -> a (e, (Phase, Event b)) c
+hEvPh' f1 f2 f3 = proc (e, (ph, ev)) ->
+    helper ph ev -<< e
+  where
+    helper Feed (Event x) = proc e -> f1 -< (e, x)
+    helper Feed End = f3
+    helper _ _ = f2
+
+switch :: 
+    ArrowApply a => 
+    ProcessA a b (c, Event t) -> 
+    (t -> ProcessA a b c) ->
+    ProcessA a b c
+
+switch cur cont = ProcessA $ proc (ph, x) ->
+  do
+    (ph', (y, evt), new) <- step cur -< (ph, x)
+    (| hEvPh
+        (\t -> step (cont t) -<< (ph, x))
+        (returnA -< (ph', y, switch new cont))
+      |) 
+        (ph', evt)
+
+
+dSwitch :: 
+    ArrowApply a => 
+    ProcessA a b (c, Event t) -> 
+    (t -> ProcessA a b c) ->
+    ProcessA a b c
+
+dSwitch cur cont = ProcessA $ proc (ph, x) ->
+  do
+    (ph', (y, evt), new) <- step cur -< (ph, x)
+    
+    returnA -< (ph', y, next new evt)
+  where
+    next _ (Event t) = cont t
+    next new _ = dSwitch new cont
+
+
+rSwitch :: 
+    ArrowApply a => ProcessA a b c -> 
+    ProcessA a (b, Event (ProcessA a b c)) c
+
+rSwitch cur = ProcessA $ proc (ph, (x, eva)) -> 
+  do
+    (ph', y, new) <- 
+        (| hEvPh
+            (\af -> step af -<< (ph, x))
+            (step cur -< (ph, x))
+         |)
+            (ph, eva)
+    returnA -< (ph', y, rSwitch new)
+
+
+drSwitch :: 
+    ArrowApply a => ProcessA a b c -> 
+    ProcessA a (b, Event (ProcessA a b c)) c
+
+drSwitch cur = ProcessA $ proc (ph, (x, eva)) -> 
+  do
+    (ph', y, new) <- step cur -< (ph, x)
+    
+    returnA -< (ph', y, next new eva)
+
+  where
+    next _ (Event af) = drSwitch af
+    next af _ = drSwitch af
+
+
+kSwitch ::
+    ArrowApply a => 
+    ProcessA a b c ->
+    ProcessA a (b, c) (Event t) ->
+    (ProcessA a b c -> t -> ProcessA a b c) ->
+    ProcessA a b c
+
+kSwitch sf test k = ProcessA $ proc (ph, x) ->
+  do
+    (ph', y, sf') <- step sf -< (ph, x)
+    (phT, evt, test') <- step test -< (ph', (x, y))
+    (| hEvPh
+        (\t -> step $ k sf' t -<< (phT, x))
+        (returnA -< (phT, y, kSwitch sf' test' k))
+     |) 
+        (phT, evt)
+
+
+dkSwitch ::
+    ArrowApply a => 
+    ProcessA a b c ->
+    ProcessA a (b, c) (Event t) ->
+    (ProcessA a b c -> t -> ProcessA a b c) ->
+    ProcessA a b c
+
+dkSwitch sf test k = ProcessA $ proc (ph, x) ->
+  do
+    (ph', y, sf') <- step sf -< (ph, x)
+    (phT, evt, test') <- step test -< (ph', (x, y))
+    
+    let
+        nextA t = k sf' t
+        nextB = dkSwitch sf' test' k
+
+    returnA -< (phT, y, evMaybe nextB nextA evt)
+
+
+broadcast :: 
+    Functor col =>
+    b -> col sf -> col (b, sf)
+
+broadcast x sfs = fmap (\sf -> (x, sf)) sfs
+
+
+par ::
+    (ArrowApply a, Tv.Traversable col) =>
+    (forall sf. (b -> col sf -> col (ext, sf))) ->
+    col (ProcessA a ext c) ->
+    ProcessA a b (col c)
+
+par r sfs = ProcessA $ parCore r sfs >>> arr cont
+  where
+    cont (ph, ys, sfs') = (ph, ys, par r sfs')
+
+parB ::
+    (ArrowApply a, Tv.Traversable col) =>
+    col (ProcessA a b c) ->
+    ProcessA a b (col c)
+
+parB = par broadcast
+
+parCore ::
+    (ArrowApply a, Tv.Traversable col) =>
+    (forall sf. (b -> col sf -> col (ext, sf))) ->
+    col (ProcessA a ext c) ->
+    a (Phase, b) (Phase, col c, col (ProcessA a ext c))
+
+parCore r sfs = proc (ph, x) ->
+  do
+    let input = r x sfs
+
+    ret <- unwrapArrow (Tv.sequenceA (fmap (WrapArrow . appPh) input)) -<< ph
+
+    let ph' = Fd.foldMap getPh ret
+        zs = fmap getZ ret
+        sfs' = fmap getSf ret
+
+    returnA -< (ph', zs, sfs')
+
+  where
+    appPh (y, sf) = proc ph -> step sf -< (ph, y)
+
+    getPh (ph, _, _) = ph
+    getZ (_, z, _) = z
+    getSf (_, _, sf) = sf
+
+
+pSwitch ::
+    (ArrowApply a, Tv.Traversable col) =>
+    (forall sf. (b -> col sf -> col (ext, sf))) ->
+    col (ProcessA a ext c) ->
+    ProcessA a (b, col c) (Event mng) ->
+    (col (ProcessA a ext c) -> mng -> ProcessA a b (col c)) ->
+    ProcessA a b (col c)
+
+pSwitch r sfs test k = ProcessA $ proc (ph, x) ->
+  do
+    (ph', zs, sfs') <- parCore r sfs -<< (ph, x)
+    (phT, evt, test') <- step test -< (ph', (x, zs))
+
+    (| hEvPh
+       (\t -> step $ k sfs' t -<< (ph, x))
+       (returnA -< (ph' `mappend` phT, zs, pSwitch r sfs' test' k))
+     |) 
+       (phT, evt)
+
+
+pSwitchB ::
+    (ArrowApply a, Tv.Traversable col) =>
+    col (ProcessA a b c) ->
+    ProcessA a (b, col c) (Event mng) ->
+    (col (ProcessA a b c) -> mng -> ProcessA a b (col c)) ->
+    ProcessA a b (col c)
+
+pSwitchB = pSwitch broadcast
+
+
+rpSwitch ::
+    (ArrowApply a, Tv.Traversable col) =>
+    (forall sf. (b -> col sf -> col (ext, sf))) ->
+    col (ProcessA a ext c) ->
+    ProcessA a (b, Event (col (ProcessA a ext c) -> col (ProcessA a ext c)))
+        (col c)
+
+rpSwitch r sfs = ProcessA $ proc (ph, (x, evCont)) ->
+  do
+    (ph', zs, sfs') <- parCore r sfs -<< (ph, x)
+
+    (| hEvPh
+       (\cont -> 
+         do
+           (ph'', ws, sfs'') <- parCore r (cont sfs') -<< (ph, x)
+           returnA -< (ph'' `mappend` Suspend, ws, rpSwitch r sfs'')
+         )
+       (returnA -< (ph' `mappend` Suspend, zs, rpSwitch r sfs'))
+     |) 
+       (ph', evCont)
+
+
+rpSwitchB ::
+    (ArrowApply a, Tv.Traversable col) =>
+    col (ProcessA a b c) ->
+    ProcessA a (b, Event (col (ProcessA a b c) -> col (ProcessA a b c)))
+        (col c)
+
+rpSwitchB = rpSwitch broadcast
+
+
+--
+-- other utility arrow
+--
+tee ::
+    ArrowApply a => ProcessA a (Event b1, Event b2) (Event (Either b1 b2))
+tee = join >>> go
+  where
+    go = Pl.repeatedly $ 
+      do
+        (evx, evy) <- Pl.await
+        evMaybe (return ()) (Pl.yield . Left) evx
+        evMaybe (return ()) (Pl.yield . Right) evy
+
+{-
+-- Problem with the last output.
+sampleR ::
+    ArrowApply a =>
+    ProcessA a (Event b1, Event b2) (Event (b1, [b2]))
+sampleR = join >>> Pl.construct (go id)
+  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
+-}
+
+gather ::
+    (ArrowApply a, Fd.Foldable f) =>
+    ProcessA a (f (Event b)) (Event b)
+gather = arr Event >>> 
+    Pl.repeatedly 
+        (Pl.await >>= Fd.mapM_ (evMaybe (return ()) Pl.yield))
+
+-- |It's also possible that source is defined without any await.
+-- 
+-- But awaits are useful to synchronize other inputs.
+source ::
+    ArrowApply a =>
+    [c] -> ProcessA a (Event b) (Event c)
+source l = Pl.construct $ mapM_ yd l
+  where
+    yd x = Pl.await >> Pl.yield x
+
+fork :: 
+    (ArrowApply a, Fd.Foldable f) =>
+    ProcessA a (Event (f b)) (Event b)
+
+fork = Pl.repeatedly $ 
+    Pl.await >>= Fd.mapM_ Pl.yield
+
+
+anytime :: 
+    ArrowApply a =>
+    a b c ->
+    ProcessA a (Event b) (Event c)
+
+anytime action = Pl.repeatedlyT arrow $
+  do
+    x <- Pl.await
+    ret <- lift $ (ArrowMonad $ arr (const x) >>> action)
+    Pl.yield ret
+  where
+    arrow (ArrowMonad af) = af
+
+{-
+asNeeded action = ProcessA $ snd action >>> arr post
+  where
+    post (ph, y) = (ph `mconcat` Suspend, y, asNeeded action)
+
+asNeeded :: 
+    ArrowApply a =>
+    a b Bool ->
+    ProcessA a (Event b) (Event b)
+-}
+
+filter cond = Pl.repeatedlyT arrow $
+  do
+    x <- Pl.await
+    b <- lift $ (ArrowMonad $ arr (const x) >>> cond)
+    if b then Pl.yield x else return ()
+  where
+    arrow (ArrowMonad af) = af
+
+
+echo :: 
+    ArrowApply a =>
+    ProcessA a (Event b) (Event b)
+
+echo = filter (arr (const True))
+
+
diff --git a/test/RandomProc.hs b/test/RandomProc.hs
new file mode 100644
--- /dev/null
+++ b/test/RandomProc.hs
@@ -0,0 +1,221 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE Arrows #-}
+
+module
+    RandomProc
+where
+
+import Prelude
+import Control.Arrow.Machine as P
+import Control.Arrow
+import qualified Control.Category as Cat
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Trans
+import Control.Monad.State
+import Test.QuickCheck (Arbitrary, arbitrary, oneof, frequency, sized)
+import Data.Maybe (fromJust)
+
+
+data ProcJoin = PjFst ProcGen | PjSnd ProcGen | PjSum ProcGen
+              deriving Show
+
+data ProcGen = PgNop | 
+               PgStop |
+               PgPush ProcGen |
+               PgPop (ProcGen, ProcGen) ProcJoin |
+               PgOdd ProcGen |
+               PgDouble ProcGen |
+               PgIncl ProcGen |
+               PgHarf ProcGen
+             deriving Show
+
+instance
+    Arbitrary ProcJoin
+  where
+    arbitrary = oneof [liftM PjFst arbitrary,
+                      liftM PjSnd arbitrary,
+                      liftM PjSum arbitrary]
+
+instance 
+    Arbitrary ProcGen
+  where
+    arbitrary = sized $ \i ->
+                frequency [(40, rest), (40 + i, content)]
+      where
+        rest = return PgNop
+        content = oneof [
+                   return PgNop, 
+                   return PgStop, 
+                   liftM PgPush arbitrary,
+                   liftM2 PgPop arbitrary arbitrary,
+                   liftM PgOdd arbitrary,
+                   liftM PgDouble arbitrary,
+                   liftM PgIncl arbitrary,
+                   liftM PgHarf arbitrary
+                  ]
+type MyProcT = ProcessA (Kleisli (State [Int]))
+
+mkProc :: ProcGen 
+       -> MyProcT (Event Int) (Event Int)
+
+
+mkProc PgNop = Cat.id
+
+mkProc (PgPush next) = mc >>> mkProc next
+  where
+    mc = repeatedlyT kleisli0 $
+       do
+         x <- await
+         lift $ modify (\xs -> x:xs)
+         yield x
+
+mkProc (PgPop (fx, fy) fz) =
+    mc >>> P.split >>> (mkProc fx *** mkProc fy) >>> mkProcJ fz
+  where
+    mc = repeatedlyT kleisli0 $
+       do
+         x <- await
+         ys <- lift $ get
+         case ys 
+           of
+             [] -> 
+                 yield (Event x, NoEvent)
+             (y:yss) -> 
+               do 
+                 lift $ put yss
+                 yield (Event x, Event y)
+
+mkProc (PgOdd next) = P.filter (arr cond) >>> mkProc next
+  where
+    cond x = x `mod` 2 == 1
+
+mkProc (PgDouble next) = arr (fmap $ \x -> [x, x]) >>> fork >>> mkProc next
+
+mkProc (PgIncl next) = arr (fmap (+1)) >>> mkProc next
+
+mkProc (PgHarf next) = arr (fmap (`div`2)) >>> mkProc next
+
+mkProc (PgStop) = stopped
+
+mkProcJ :: ProcJoin -> MyProcT (Event Int, Event Int) (Event Int)
+
+mkProcJ (PjFst pg) = arr fst
+mkProcJ (PjSnd pg) = arr snd
+mkProcJ (PjSum pg) = arr go
+  where
+    go (evx, evy) = (+) <$> evx <*> evy
+
+
+stateProc :: MyProcT (Event a) (Event b) -> [a] -> ([b], [Int])
+stateProc a i = 
+    runState mx []
+{-
+    unsafePerformIO $ 
+      do
+        x <- timeout 10000 $
+          do
+            let x = runState mx []
+            deepseq x $ return x
+        return (fromJust x)
+-}
+  where
+    mx = runKleisli (run a) i
+
+class 
+    TestIn a
+  where
+    input :: MyProcT (Event Int) a
+
+class
+    TestOut a
+  where
+    output :: MyProcT a (Event Int)
+
+instance
+    TestIn (Event Int)
+  where
+    input = Cat.id
+
+instance
+    TestOut (Event Int)
+  where
+    output = Cat.id
+
+instance
+    (TestIn a, TestIn b) => TestIn (a, b)
+  where
+    input = mc >>> P.split >>> input *** input
+      where
+        mc = repeatedly $
+          do
+            x <- await
+            y <- await
+            yield (Event x, Event y)
+
+instance
+    (TestOut a, TestOut b) => TestOut (a, b)
+  where
+    output = output *** output >>> P.join >>> mc >>> P.split
+      where
+        mc = repeatedly $
+          do
+            (x, y) <- await
+            yield x
+            yield y
+
+instance
+    (TestIn a, TestIn b) => 
+        TestIn (Either a b)
+  where
+    input = proc evx ->
+      do
+        -- 一個前の値で分岐してみる
+        b <- hold True <<< delay -< 
+               (\x -> x `mod` 2 == 0) <$> evx
+
+        if b
+          then
+            arr Left <<< input -< evx
+          else
+            arr Right <<< input -< evx
+
+
+instance
+    (TestOut a, TestOut b) => TestOut (Either a b)
+  where
+    output = output ||| output
+
+type MyTestT a b = MyProcT a b -> MyProcT a b -> Bool
+
+mkEquivTest :: (TestIn a, TestOut b) =>
+               (Maybe (ProcGen, ProcJoin), ProcGen, ProcGen, [Int]) ->
+               MyTestT a b
+mkEquivTest (Nothing, pre, post, l) pa pb =
+    let
+        preA = mkProc pre
+        postA = mkProc post
+        mkCompared p = preA >>> input >>> p >>> output >>> postA
+        x = stateProc (mkCompared pa) l
+        y = stateProc (mkCompared pb) l
+      in
+        x == y
+
+mkEquivTest (Just (par, j), pre, post, l) pa pb =
+    let
+        preA = mkProc pre
+        postA = mkProc post
+        parA = mkProc par
+        joinA = mkProcJ j
+        mkCompared p = preA >>> input >>> p >>> output >>> postA
+        x = stateProc (mkCompared pa) l
+        y = stateProc (mkCompared pb) l
+      in
+        x == y
+
+mkEquivTest2 ::(Maybe (ProcGen, ProcJoin), ProcGen, ProcGen, [Int]) ->
+               MyProcT (Event Int, Event Int) (Event Int, Event Int) -> 
+               MyProcT (Event Int, Event Int) (Event Int, Event Int) ->
+               Bool
+mkEquivTest2 = mkEquivTest
diff --git a/test/spec.hs b/test/spec.hs
new file mode 100644
--- /dev/null
+++ b/test/spec.hs
@@ -0,0 +1,443 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE Arrows #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+module
+    Main
+where
+
+import Data.Maybe (fromMaybe)
+import Control.Arrow.Machine as P
+import Control.Applicative ((<$>), (<*>), (<$))
+import qualified Control.Category as Cat
+import Control.Arrow
+import Control.Monad.State
+import Control.Monad
+import Control.Monad.Trans
+import Control.Monad.Identity (Identity, runIdentity)
+import Debug.Trace
+import Test.Hspec
+import Test.Hspec.QuickCheck (prop)
+import Test.QuickCheck (Arbitrary, arbitrary, oneof, frequency, sized)
+import RandomProc
+
+runKI a x = runIdentity (runKleisli a x)
+
+
+
+
+main = hspec $ do {basics; rules; loops; choice; plans; utility; switches; execution}
+
+
+basics =
+  do
+    describe "ProcessA" $
+      do
+        it "is stream transducer." $
+          do
+            let
+              process = repeatedly $
+                do
+                  x <- await
+                  yield x
+                  yield (x + 1)
+
+              resultA = run process [1,2,4]
+
+            resultA `shouldBe` [1, 2, 2, 3, 4, 5]
+
+        let
+            -- 入力1度につき同じ値を2回出力する
+            doubler = repeatedly $ 
+                      do {x <- await; yield x; yield x}
+            -- 入力値をStateのリストの先頭にPushする副作用を行い、同じ値を出力する
+            pusher = repeatedlyT (Kleisli . const) $
+                     do {x <- await; lift $ modify (x:); yield x}
+
+        it "has stop state" $
+          let
+              -- 一度だけ入力をそのまま出力し、すぐに停止する
+              onlyOnce = construct $ await >>= yield
+
+              x = stateProc (doubler >>> pusher >>> onlyOnce) [3, 3]
+            in
+              -- 最後尾のMachineが停止した時点で処理を停止するが、
+              -- 既にa2が出力した値の副作用は処理する
+              x `shouldBe` ([3], [3, 3])
+
+        it "has side-effect" $
+          let
+              incl = arr $ fmap (+1)
+
+              -- doublerで信号が2つに分岐する。
+              -- このとき、副作用は1つ目の信号について末尾まで
+              -- -> 二つ目の信号について分岐点から末尾まで ...
+              -- の順で処理される。
+              a = pusher >>> doubler >>> incl >>> pusher >>> incl >>> pusher
+
+              x = stateProc a [1000]
+            in
+              x `shouldBe` ([1002, 1002], reverse [1000,1001,1002,1001,1002])
+
+        it "never spoils any FEED" $
+          let
+              counter = construct $ counterDo 1
+              counterDo n = 
+                do
+                  x <- await
+                  yield $ n * 100 + x
+                  counterDo (n+1)
+              x = stateProc (doubler >>> doubler >>> counter) [1,2]
+            in
+              fst x `shouldBe` [101, 201, 301, 401, 502, 602, 702, 802]
+
+        prop "each path can have independent number of events" $ \l ->
+          let
+              split2' (Event (x, y)) = (Event x, Event y)
+              split2' NoEvent = (NoEvent, NoEvent)
+              split2' End = (End, End)
+              gen = arr (fmap $ \x -> [x, x]) >>> fork >>> arr split2'
+              r1 = runKI (run (gen >>> arr fst)) (l::[(Int, [Int])])
+              r2 = runKI (run (gen >>> second (fork >>> echo) >>> arr fst)) 
+                   (l::[(Int, [Int])])
+            in
+              r1 == r2
+
+
+rules =
+  do
+    describe "ProcessA as Category" $
+      do        
+        prop "has asocciative composition" $ \fx gx hx cond ->
+          let
+              f = mkProc fx
+              g = mkProc gx
+              h = mkProc hx
+              equiv = mkEquivTest cond
+            in
+              ((f >>> g) >>> h) `equiv` (f >>> (g >>> h))
+
+        prop "has identity" $ \fx gx cond ->
+          let
+              f = mkProc fx
+              g = mkProc gx
+              equiv = mkEquivTest cond
+            in
+              (f >>> g) `equiv` (f >>> Cat.id >>> g)
+
+    describe "ProcessA as Arrow" $
+      do        
+        it "can be made from pure function(arr)" $
+          do
+            (run . arr . fmap $ (+ 2)) [1, 2, 3]
+              `shouldBe` [3, 4, 5]
+
+        prop "arr id is identity" $ \fx gx cond ->
+          let
+              f = mkProc fx
+              g = mkProc gx
+              equiv = mkEquivTest cond
+            in
+              (f >>> g) `equiv` (f >>> arr id >>> g)
+
+        it "can be parallelized" $
+          let
+            in
+          do
+            let 
+                myProc2 = repeatedlyT (Kleisli . const) $
+                  do
+                    x <- await
+                    lift $ modify (++ [x])
+                    yield `mapM` (take x $ repeat x)
+
+                toN (Event x) = Just x
+                toN NoEvent = Nothing
+                toN End = Nothing
+                en (ex, ey) = Event (toN ex, toN ey)
+                de evxy = (fst <$> evxy, snd <$> evxy)
+
+                l = map (\x->(x,x)) [1,2,3]
+
+                (result, state) =
+                    stateProc (arr de >>> first myProc2 >>> arr en) l
+                                  
+            (result >>= maybe mzero return . fst) 
+                `shouldBe` [1,2,2,3,3,3]
+            (result >>= maybe mzero return . snd) 
+                `shouldBe` [1,2,3]
+            state `shouldBe` [1,2,3]
+
+        prop "first and composition." $ \fx gx cond ->
+          let
+              f = mkProc fx
+              g = mkProc gx
+              equiv = mkEquivTest2 cond
+            in
+              (first (f >>> g)) `equiv` (first f >>> first g)
+
+        prop "first-second commutes" $  \fx cond ->
+          let
+              f = first $ mkProc fx
+              g = second (arr $ fmap (+2))
+              
+              equiv = mkEquivTest2 cond
+            in
+              (f >>> g) `equiv` (g >>> f)
+
+        prop "first-fst commutes" $  \fx cond ->
+          let
+              f = mkProc fx
+              equiv = mkEquivTest cond
+                    ::(MyTestT (Event Int, Event Int) (Event Int))
+            in
+              (first f >>> arr fst) `equiv` (arr fst >>> f)
+
+        prop "assoc relation" $ \fx cond ->
+          let
+              f = mkProc fx
+              assoc ((a,b),c) = (a,(b,c))
+
+              equiv = mkEquivTest cond
+                    ::(MyTestT ((Event Int, Event Int), Event Int)
+                               (Event Int, (Event Int, Event Int)))
+            in
+              (first (first f) >>> arr assoc) `equiv` (arr assoc >>> first f)
+
+loops =
+  do
+    describe "ProcessA as ArrowLoop" $
+      do
+        it "can be used with rec statement(pure)" $
+          let
+              a = proc x ->
+                do
+                  rec l <- returnA -< evMaybe [] (:l) x
+                  returnA -< l <$ x
+              result = fst $ stateProc a [2, 5]
+            in
+              take 3 (result!!1) `shouldBe` [5, 5, 5]
+
+        it "can be used with rec statement(macninery)" $
+          let
+              mc = anytime Cat.id
+              a = proc x ->
+                do
+                  rec l <- mc -< (:l') <$> x
+                      l' <- returnA -< fromEvent [] l
+                  returnA -< l
+              result = fst $ stateProc a [2, 5]
+            in
+              take 3 (result!!1) `shouldBe` [5, 5, 5]
+
+        it "the last value is valid." $
+          do
+            let
+                mc = repeatedly $
+                  do
+                    x <- await
+                    yield x
+                    yield (x*2)
+                pa = proc x ->
+                  do
+                    rec y <- mc -< (+z) <$> x
+                        z <- hold 0 <<< delay -< y
+                    returnA -< y
+            run pa [1, 10] `shouldBe` [1, 2, 12, 24]
+
+    describe "Rules for ArrowLoop" $
+      do
+        let
+            fixcore f y = if y `mod` 5 == 0 then y else y + f (y-1)
+            pure (evx, f) = (f <$> evx, fixcore f)
+            apure = arr pure
+
+        prop "left tightening" $ \fx cond ->
+          let
+              f = mkProc fx
+
+              equiv = mkEquivTest cond
+            in
+              (loop (first f >>> apure)) `equiv` (f >>> loop apure)
+
+        it "right tigntening"
+           pending
+{-
+        prop "right tightening" $ \fx cond ->
+          let
+              f = mkProc fx
+
+              equiv = mkEquivTest cond
+            in
+              (loop (apure >>> first f)) `equiv` (loop apure >>> f)
+-}
+
+choice =
+  do
+    describe "ProcessA as ArrowChoice" $
+      do
+        it "temp1" $
+         do
+           let
+                af = mkProc $ PgStop
+                ag = mkProc $ PgOdd PgNop
+                aj1 = arr Right
+                aj2 = arr $ either id id
+                l = [1]
+                r1 = stateProc 
+                       (aj1 >>> left af >>> aj2) 
+                       l
+              in
+                r1 `shouldBe` ([1],[])
+
+        prop "left (f >>> g) = left f >>> left g" $ \fx gx cond ->
+            let
+                f = mkProc fx
+                g = mkProc gx
+                
+                equiv = mkEquivTest cond
+                    ::(MyTestT (Either (Event Int) (Event Int))
+                               (Either (Event Int) (Event Int)))
+              in
+                (left (f >>> g)) `equiv` (left f >>> left g)
+
+
+plans = describe "Plan" $
+  do
+    let pl = 
+          do
+            x <- await
+            yield x
+            yield (x+1)
+            x <- await
+            yield x
+            yield (x+1)
+        l = [2, 5, 10, 20, 100]
+
+    it "can be constructed into ProcessA" $
+      do
+        let 
+            result = run (construct pl) l
+        result `shouldBe` [2, 3, 5, 6]
+
+    it "can be repeatedly constructed into ProcessA" $
+      do
+        let
+            result = run (repeatedly pl) l
+        result `shouldBe` [2, 3, 5, 6, 10, 11, 20, 21, 100, 101]
+
+
+utility =
+  do
+    describe "delay" $
+      do
+        it "delays input" $
+          do
+            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]
+
+
+switches =
+  do
+    describe "switch" $
+      do
+        it "switches once" $
+          do
+            let 
+                before = proc evx -> 
+                  do
+                    ch <- P.filter (arr $ (\x -> x `mod` 2 == 0)) -< evx
+                    returnA -< (NoEvent, ch)
+
+                after t = proc evx -> returnA -< (t*) <$> evx
+
+                l = [1,3,4,1,3,2]
+
+                -- 最初に偶数が与えられるまでは、入力を無視(NoEvent)し、
+                -- それ以降は最初に与えられた偶数 * 入力値を返す
+                ret = run (switch before after) l
+
+                -- dが付くと次回からの切り替えとなる
+                retD = run (dSwitch before after) l
+
+            ret `shouldBe` [16, 4, 12, 8]
+            retD `shouldBe` [4, 12, 8]
+
+    describe "rSwitch" $
+      do
+        it "switches any times" $
+          do
+            let
+               theArrow sw = proc evtp ->
+                 do
+                   (evx, evarr) <- P.split -< evtp
+                   sw (arr $ fmap (+2)) -< (evx, evarr)
+
+               l = [(Event 5, NoEvent),
+                    (Event 1, Event (arr $ fmap (*2))),
+                    (Event 2, NoEvent)]
+               ret = run (theArrow rSwitch) l
+               retD = run (theArrow drSwitch) l
+
+            ret `shouldBe` [7, 2, 4]
+            retD `shouldBe` [7, 3, 4]
+
+execution = describe "Execution of ProcessA" $
+    do
+      let
+          pl = 
+            do
+              x <- await
+              yield x
+              yield (x+1)
+              x <- await
+              yield x
+              yield (x+1)
+              yield (x+5)
+          init = construct pl
+
+      it "supports step execution" $
+        do
+          let
+              (ret, now) = stepRun init 1
+          yields ret `shouldBe` [1, 2]
+          hasStopped ret `shouldBe` False
+
+          let
+              (ret, now2) = stepRun now 1
+          yields ret `shouldBe` [1, 2, 6]
+          hasStopped ret `shouldBe` True
+
+          let
+              (ret, _) = stepRun now2 1
+          yields ret `shouldBe` ([]::[Int])
+          hasStopped ret `shouldBe` True
+
+      it "supports yield-driven step" $
+        do
+          let
+              init = construct $ 
+                do
+                  yield (-1)
+                  x <- await
+                  mapM yield (iterate (+1) x) -- infinite
+
+              (ret, now) = stepYield init 5
+          yields ret `shouldBe` Just (-1)
+          hasConsumed ret `shouldBe` False
+          hasStopped ret `shouldBe` False
+
+          let
+              (ret, now2) = stepYield now 10
+          yields ret `shouldBe` Just 10
+          hasConsumed ret `shouldBe` True
+          hasStopped ret `shouldBe` False
+
+          let
+              (ret, now3) = stepYield now2 10
+          yields ret `shouldBe` Just 11
+          hasConsumed ret `shouldBe` False
+          hasStopped ret `shouldBe` False
+