-- | -- Module: Control.Wire.Session -- Copyright: (c) 2011 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez -- -- 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