module System.Serial.BlockingManager (serialManager, wrapCommand, BlockingSerialManager, BlockingSerialCommand) where
import System.IO
import Control.Concurrent
import Control.Concurrent.MVar
import Control.Monad
type BlockingSerialCommand = (String, MVar (Maybe String))
type BlockingSerialManager = MVar BlockingSerialCommand
serialManager :: Handle
-> Int
-> IO BlockingSerialManager
serialManager h timeout = do mv <- newEmptyMVar
forkIO $ process h mv timeout
return mv
process :: Handle
-> MVar (String, MVar (Maybe [Char]))
-> Int
-> IO ()
process h mv timeout = do (cmd,resVar) <- takeMVar mv
hPutStr h cmd
r <- hWaitForInput h timeout
if not r then putMVar resVar Nothing
else do
let loop = do st <- hReady h
if st then do l <- hGetLine h
q <- loop
return (l ++ q)
else return ""
res <- loop
putMVar resVar (Just res)
process h mv timeout
wrapCommand :: String
-> String
-> BlockingSerialManager
-> IO (Maybe String)
wrapCommand eol cmd mgr = do
mv <- newEmptyMVar
putMVar mgr (cmd ++ eol, mv)
takeMVar mv