Session.hs

-- |
-- Module:     Control.Wire.Session
-- Copyright:  (c) 2011 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>
--
-- Wire sessions, i.e. running and/or testing wires.

module Control.Wire.Session
    ( -- * Running wires
      stepWire,

      -- * Testing wires
      testWire
    )
    where

import Control.Arrow
import Control.Monad
import Control.Wire.Classes
import Control.Wire.Types
import System.IO


-- | Performs an instant of the given wire.

stepWire ::
    Arrow (>~)
    => Wire e (>~) a b  -- ^ Wire to step.
    -> (a >~ (Either e b, Wire e (>~) a b))
stepWire = toGen


-- | Test a wire.  This function runs the given wire continuously
-- printing its output on a single line.

testWire ::
    forall a e (>~). (ArrowApply (>~), ArrowIO (>~), Show e)
    => Int        -- ^ Frames per output.  FPS/accuracy tradeoff.
    -> (() >~ a)  -- ^ Input generator.
    -> (Wire e (>~) a String >~ ())
testWire int getInput =
    proc w' -> loop -< (int, w')

    where
    loop :: (Int, Wire e (>~) a String) >~ ()
    loop =
        proc (n', w') -> do
            let n = let nn = succ n' in if nn >= int then 0 else nn

            inp <- getInput -< ()
            (mstr, w) <- stepWire w' -<< inp

            arrIO -<
                when (n' == 0) $ do
                    putStr "\r\027[K"
                    putStr (either (("Inhibited: " ++) . show) id mstr)
                    hFlush stdout

            loop -< (n, w)