machinecell-3.0.0: test/LoopUtil.hs

{-# LANGUAGE Arrows #-}

module
    LoopUtil
where

import Data.Functor
import Control.Arrow
import Test.Hspec

import Control.Category ((>>>))

import Control.Arrow.Machine as P
import Control.Monad.Trans (liftIO)
import qualified Control.Arrow.Machine.Misc.Pump as Pump

import Data.Monoid (Endo(Endo), mappend, appEndo)

newtype Duct a = Duct (Endo [a])

doubler = arr (fmap $ \x -> [x, x]) >>> P.fork

loopUtil =
  do
    describe "loop" $
      do
        it "is possible that value by `dHold` or `dAccum` can refer at upstream." $
          do
            let 
                pa :: ProcessA (Kleisli IO) (Event Int) (Event Int)
                pa = proc evx ->
                  do
                    rec
                        anytime (Kleisli print) -< y <$ evx
                        anytime (Kleisli putStr) -< "" <$ evx -- side effect
                        evx2 <- doubler -< evx
                        y <- P.dAccum 0 -< (+) <$> evx2
                    returnA -< y <$ evx
            ret <- liftIO $ runKleisli (P.run pa) [1, 2, 3]
            ret `shouldBe` [0, 1+1, 1+1+2+2]
  
    describe "Pump" $
      do
        it "pumps up an event stream." $
          do
            let
                pa :: ProcessA (Kleisli IO) (Event Int) (Event Int)
                pa = proc evx ->
                  do
                    rec
                        evOut <- Pump.outlet -< (dct, () <$ evx)
                        anytime (Kleisli putStr) -< "" <$ evx -- side effect
                        so <- doubler -< evx
                        dct <- Pump.intake -< (so, () <$ evx)
                    returnA -< evOut

            ret <- liftIO $ runKleisli (P.run pa) [4, 5, 6]
            ret `shouldBe` [4, 4, 5, 5, 6, 6]