-- | This is a largely drop-in replacement for "System.Serial.Manager" which sends and receives one command at a time from the port, and so is garuanteed to send the write information back to the right function. It may be necessary when working with devices that have ambiguous returns, such as a single acknowledgement character for all successful commands. See the analagous functions in "System.Serial.Manager" for the full documentation. The notes here only point out the differences. 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 -- | The blocking 'serialManager' function takes one additional argument, the timeout (since it cannot continue executing commands in parallel while one command freezes). serialManager :: Handle -> Int -- ^ timeout (in ms) -> 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 -- | Wrapping commands is identical to the non-blocking version except that there is no predicate to recognize return values. wrapCommand :: String -- ^ The end of line character for this port -> String -- ^ The command to send -> BlockingSerialManager -- ^ The serial port to access -> IO (Maybe String) -- ^ 'Nothing' if there was a timeout, other 'Just' and the response string wrapCommand eol cmd mgr = do mv <- newEmptyMVar putMVar mgr (cmd ++ eol, mv) takeMVar mv -- | Sometimes we don't want the current thread to block, but we still -- want some action when the a command returns from the serial port. To -- that end, 'wrapCommandWithCallback' lets us pass a function of type -- 'Maybe String -> IO ()' to be executed when a response is recognized -- by the predicate. wrapCommandWithCallback :: String -- ^ The end of line character for this port -> String -- ^ The command to send -> (Maybe String -> IO ()) -- ^ The callback to run when the command returns -> BlockingSerialManager -- ^ The serial port to access -> IO ThreadId -- ^ The thread id in which the command is being run wrapCommandWithCallback eol cmd callback mgr = do forkIO $ wrapCommand eol cmd mgr >>= callback