module Control.Wire.Session
(
stepWire,
stepWireM,
testWire,
testWireM,
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
printInt :: (Num a, Ord a) => a -> a -> String -> IO a
printInt int n' str = do
when (n' == 0) (printRes str)
return (succMod int n')
printRes :: String -> IO ()
printRes str = do
putStr "\r\027[K"
putStr str
hFlush stdout
showRes :: Show e => Either e String -> String
showRes = either (("Inhibited: " ++) . show) id
stepWire ::
WireToGen (>~)
=> Wire e (>~) a b
-> (a >~ (Either e b, Wire e (>~) a b))
stepWire = toGen
stepWireM ::
Monad m
=> Wire e (Kleisli m) a b
-> a
-> m (Either e b, Wire e (Kleisli m) a b)
stepWireM = toGenM
succMod :: (Num a, Ord a) => a -> a -> a
succMod int n =
let nn = n + 1 in
if nn >= int then 0 else nn
testWire ::
forall a e m (>~). (ArrowApply (>~), ArrowKleisli m (>~), MonadIO m, Show e, WireToGen (>~))
=> Int
-> (() >~ a)
-> (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)
testWireM ::
forall a e m. (Show e, MonadIO m)
=> Int
-> m a
-> 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