-- | 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.
-- 
-- This module is abandoned for the moment!  If you need it, you should
-- really read the source code for "System.Serial.Manager" and bring
-- it up to date.
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)
              -> String -- ^ Input terminator
              -> 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