module Test.IOSpec.Teletype
(
IOTeletype
, Output(..)
, runTT
, getChar
, putChar
)
where
import qualified Data.Stream as Stream
import Prelude hiding (getChar, putChar)
data IOTeletype a =
GetChar (Char -> IOTeletype a)
| PutChar Char (IOTeletype a)
| ReturnTeletype a
instance Functor IOTeletype where
fmap f (GetChar tt) = GetChar (\x -> fmap f (tt x))
fmap f (PutChar c tt) = PutChar c (fmap f tt)
fmap f (ReturnTeletype x) = ReturnTeletype (f x)
instance Monad IOTeletype where
return = ReturnTeletype
(ReturnTeletype a) >>= g = g a
(GetChar f) >>= g = GetChar (\c -> f c >>= g)
(PutChar c a) >>= g = PutChar c (a >>= g)
runTT :: IOTeletype a -> Stream.Stream Char -> Output a
runTT (ReturnTeletype a) cs = Finish a
runTT (GetChar f) cs = runTT (f (Stream.head cs)) (Stream.tail cs)
runTT (PutChar c p) cs = Print c (runTT p cs)
data Output a =
Print Char (Output a)
| Finish a
getChar :: IOTeletype Char
getChar = GetChar ReturnTeletype
putChar :: Char -> IOTeletype ()
putChar c = PutChar c (ReturnTeletype ())