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,
      stepWireM,

      -- * Testing wires
      testWire,
      testWireM,
      -- ** Utility functions
      printInt,
      printRes,
      showRes,
      succMod
    )
    where

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


-- | Print a wire result on one line at regular intervals (first
-- argument).  The second argument is the interval counter.

printInt :: (Num a, Ord a) => a -> a -> String -> IO a
printInt int n' str = do
    when (n' == 0) (printRes str)
    return (succMod int n')


-- | Print a wire result on one line.

printRes :: String -> IO ()
printRes str = do
    putStr "\r\027[K"
    putStr str
    hFlush stdout


-- | Turn a wire result into a string for printing.

showRes :: Show e => Either e String -> String
showRes = either (("Inhibited: " ++) . show) id


-- | Performs an instant of the given wire.

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


-- | Performs an instant of the given monad-based wire.

stepWireM ::
    Monad m
    => Wire e (Kleisli m) a b  -- ^ Wire to step.
    -> a                       -- ^ Input signal.
    -> m (Either e b, Wire e (Kleisli m) a b)
stepWireM = toGenM


-- | Increments.  Results in 0, if the result is greater than or equal
-- to the first argument.

succMod :: (Num a, Ord a) => a -> a -> a
succMod int n =
    let nn = n + 1 in
    if nn >= int then 0 else nn


-- | Test a wire.  This function runs the given wire continuously
-- printing its output on a single line.
--
-- The first argument specifies how often the wire's result is printed.
-- If you specify 100 here, then the output is printed at every 100th
-- frame.

testWire ::
    forall a e m (>~). (ArrowApply (>~), ArrowKleisli m (>~), MonadIO m, Show e, WireToGen (>~))
    => Int        -- ^ Frames per output.  Speed/accuracy tradeoff.
    -> (() >~ a)  -- ^ Input generator.
    -> (Wire e (>~) a String >~ ())
testWire int getInput =
    proc w' -> loop -< (0, 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)


-- | Test a monad-based wire.  This function runs the given wire
-- continuously printing its output on a single line.
--
-- The first argument specifies how often the wire's result is printed.
-- If you specify 100 here, then the output is printed at every 100th
-- frame.

testWireM ::
    forall a e m. (Show e, MonadIO m)
    => Int        -- ^ Frames per output.  FPS/accuracy tradeoff.
    -> m a        -- ^ Input generator.
    -> Wire e (Kleisli m) a String
    -> m ()
testWireM int getInput = loop 0
    where
    loop :: Int -> Wire e (Kleisli m) a String -> m ()
    loop n' w' = do
        (mstr, w) <- stepWireM w' =<< getInput
        n <- liftIO . printInt int n' . showRes $ mstr
        loop n w