module Control.Proxy.Prelude.IO (
getLineS,
getLineC,
readLnS,
readLnC,
printB,
printD,
printU,
putStrLnB,
putStrLnD,
putStrLnU,
promptS,
promptC,
hGetLineS,
hGetLineC,
hPrintB,
hPrintD,
hPrintU,
hPutStrLnB,
hPutStrLnD,
hPutStrLnU,
) where
import Control.Monad (forever)
import Control.Monad.Trans.Class (lift)
import Control.Proxy.Prelude.Kleisli (foreverK)
import Control.Proxy.Class (Proxy(request, respond))
import Control.Proxy.Trans.Identity (runIdentityP, runIdentityK)
import Control.Proxy.Synonym (Client, Server, Producer, CoProducer)
import qualified System.IO as IO
getLineS :: (Proxy p) => () -> Producer p String IO r
getLineS () = runIdentityP $ forever $ do
str <- lift getLine
respond str
getLineC :: (Proxy p) => () -> CoProducer p String IO r
getLineC () = runIdentityP $ forever $ do
str <- lift getLine
request str
readLnS :: (Read b, Proxy p) => () -> Producer p b IO r
readLnS () = runIdentityP $ forever $ do
a <- lift readLn
respond a
readLnC :: (Read a', Proxy p) => () -> CoProducer p a' IO r
readLnC () = runIdentityP $ forever $ do
a <- lift readLn
request a
printB :: (Show a', Show a, Proxy p) => a' -> p a' a a' a IO r
printB = runIdentityK $ foreverK $ \a' -> do
lift $ do
putStr "U: "
print a'
a <- request a'
lift $ do
putStr "D: "
print a
respond a
printD :: (Show a, Proxy p) => x -> p x a x a IO r
printD = runIdentityK $ foreverK $ \x -> do
a <- request x
lift $ print a
respond a
printU :: (Show a', Proxy p) => a' -> p a' x a' x IO r
printU = runIdentityK $ foreverK $ \a' -> do
lift $ print a'
x <- request a'
respond x
putStrLnB :: (Proxy p) => String -> p String String String String IO r
putStrLnB = runIdentityK $ foreverK $ \a' -> do
lift $ do
putStr "U: "
putStrLn a'
a <- request a'
lift $ do
putStr "D: "
putStrLn a
respond a
putStrLnD :: (Proxy p) => x -> p x String x String IO r
putStrLnD = runIdentityK $ foreverK $ \x -> do
a <- request x
lift $ putStrLn a
respond a
putStrLnU :: (Proxy p) => String -> p String x String x IO r
putStrLnU = runIdentityK $ foreverK $ \a' -> do
lift $ putStrLn a'
x <- request a'
respond x
promptS :: (Proxy p) => String -> Server p String String IO r
promptS = runIdentityK $ foreverK $ \send -> do
recv <- lift $ do
putStrLn send
getLine
respond recv
promptC :: (Proxy p) => () -> Client p String String IO r
promptC () = runIdentityP $ forever $ do
send <- lift getLine
recv <- request send
lift $ putStrLn recv
hGetLineS :: (Proxy p) => IO.Handle -> () -> Producer p String IO ()
hGetLineS h () = runIdentityP go where
go = do
eof <- lift $ IO.hIsEOF h
if eof
then return ()
else do
str <- lift $ IO.hGetLine h
respond str
go
hGetLineC :: (Proxy p) => IO.Handle -> () -> CoProducer p String IO ()
hGetLineC h () = runIdentityP go where
go = do
eof <- lift $ IO.hIsEOF h
if eof
then return ()
else do
str <- lift $ IO.hGetLine h
request str
go
hPrintB :: (Show a, Show a', Proxy p) => IO.Handle -> a' -> p a' a a' a IO r
hPrintB h = runIdentityK $ foreverK $ \a' -> do
lift $ do
IO.hPutStr h "U: "
IO.hPrint h a'
a <- request a'
lift $ do
IO.hPutStr h "D: "
IO.hPrint h a
respond a
hPrintD :: (Show a, Proxy p) => IO.Handle -> x -> p x a x a IO r
hPrintD h = runIdentityK $ foreverK $ \x -> do
a <- request x
lift $ IO.hPrint h a
respond a
hPrintU :: (Show a', Proxy p) => IO.Handle -> a' -> p a' x a' x IO r
hPrintU h = runIdentityK $ foreverK $ \a' -> do
lift $ IO.hPrint h a'
x <- request a'
respond x
hPutStrLnB
:: (Proxy p) => IO.Handle -> String -> p String String String String IO r
hPutStrLnB h = runIdentityK $ foreverK $ \a' -> do
lift $ do
IO.hPutStr h "U: "
IO.hPutStrLn h a'
a <- request a'
lift $ do
IO.hPutStr h "D: "
IO.hPutStrLn h a
respond a
hPutStrLnD :: (Proxy p) => IO.Handle -> x -> p x String x String IO r
hPutStrLnD h = runIdentityK $ foreverK $ \x -> do
a <- request x
lift $ IO.hPutStrLn h a
respond a
hPutStrLnU :: (Proxy p) => IO.Handle -> String -> p String x String x IO r
hPutStrLnU h = runIdentityK $ foreverK $ \a' -> do
lift $ IO.hPutStrLn h a'
x <- request a'
respond x