Windows.hs

module System.Hardware.Serialport.Windows where 

import Data.Word
import Data.Bits
import System.Win32.Comm
import System.Win32.Types
import System.Win32.File
import Foreign.C.Types
import Foreign.C.String
import Foreign.Marshal.Utils
import Foreign.Marshal.Alloc
import Foreign.Storable


data SerialPort = SerialPort { handle :: HANDLE,
                               timeout :: Int }

-- | Open and configure a serial port
openSerial :: String      -- ^ The filename of the serial port, such as @COM5@ or @\/\/.\/CNCA0@
           -> BaudRate
           -> Word8
           -> StopBits
           -> Parity
           -> FlowControl
           -> Int         -- ^ Receive timeout in milliseconds
           -> IO SerialPort
openSerial dev baud bPerB stopb par flow time_ms = 
    do h <- createFile dev access_mode share_mode security_attr create_mode file_attr template_file
       setSerial h baud bPerB stopb par flow time_ms
       return $ SerialPort h time_ms
    where 
       access_mode = gENERIC_READ .|. gENERIC_WRITE
       share_mode = fILE_SHARE_NONE
       security_attr = Nothing
       create_mode = oPEN_EXISTING
       file_attr = fILE_ATTRIBUTE_NORMAL -- .|. fILE_FLAG_OVERLAPPED
       template_file = Nothing


-- |Possibly receive a character unless the timeout given in openSerial is exceeded.
recvChar :: SerialPort -> IO (Maybe Char)
recvChar (SerialPort h _) =
    allocaBytes 1 $ \ p_n -> do 
    received <- win32_ReadFile h p_n count overlapped
    if received == 0
       then return Nothing
       else do c <- peek p_n :: IO CChar
               return $ Just $ castCCharToChar c
    where
        count = 1
        overlapped = Nothing


-- |Send a character
sendChar :: SerialPort -> Char -> IO ()
sendChar (SerialPort h _) s =
    with s (\ p_s -> do win32_WriteFile h p_s count overlapped 
                        return () )
    where
        count = 1
        overlapped = Nothing


-- |Close the serial port
closeSerial :: SerialPort -> IO ()
closeSerial (SerialPort h _) =
    closeHandle h


setSerial :: HANDLE
           -> BaudRate     
           -> Word8          
           -> StopBits     
           -> Parity       
           -> FlowControl
           -> Int
           -> IO ()
setSerial h baud bPerB stopb parit flow time_ms = 
    do let ct = COMMTIMEOUTS { 
                    readIntervalTimeout = 0, 
                    readTotalTimeoutMultiplier = fromIntegral time_ms, 
                    readTotalTimeoutConstant = 0, 
                    writeTotalTimeoutMultiplier = 0, 
                    writeTotalTimeoutConstant = 0 }
       setCommTimeouts h ct

       let dcb' = DCB {
                    baudRate = baud,
                    parity = parit,
                    stopBits = stopb,
                    flowControl = flow,
                    byteSize = bPerB }
       setCommState h dcb'

       return ()