diff --git a/System/Hardware/Serialport.hs b/System/Hardware/Serialport.hs --- a/System/Hardware/Serialport.hs +++ b/System/Hardware/Serialport.hs @@ -1,9 +1,17 @@ {-# LANGUAGE CPP #-} +-- |This module provides the serial port interface. +-- +-- > import System.Hardware.Serialport +-- > s <- openSerial "/dev/ttyUSB0" defaultSerialSettings +-- > sendChar s 'A' +-- > Just resp <- recvChar s +-- > closeSerial s +-- module System.Hardware.Serialport ( -- * Types - BaudRate(..) + CommSpeed(..) ,StopBits(..) ,Parity(..) ,FlowControl(..) @@ -19,12 +27,13 @@ ,closeSerial ,setDTR ,setRTS + ,setSerialSettings + ,getSerialSettings ) where #if defined(mingw32_HOST_OS) import System.Hardware.Serialport.Windows #else import System.Hardware.Serialport.Posix -import System.Posix.Terminal #endif import System.Hardware.Serialport.Types diff --git a/System/Hardware/Serialport/Posix.hsc b/System/Hardware/Serialport/Posix.hsc --- a/System/Hardware/Serialport/Posix.hsc +++ b/System/Hardware/Serialport/Posix.hsc @@ -11,22 +11,22 @@ -- |Open and configure a serial port -openSerial :: FilePath -- ^ The filename of the serial port, such as @\/dev\/ttyS0@ or @\/dev\/ttyUSB0@ +openSerial :: FilePath -- ^ The filename of the serial port, such as @\/dev\/ttyS0@ or @\/dev\/ttyUSB0@ -> SerialPortSettings -> IO SerialPort -openSerial dev settings = - do fd' <- openFd dev ReadWrite Nothing defaultFileFlags { noctty = True } - setSerialSettings fd' settings - return $ SerialPort fd' settings +openSerial dev settings = do + fd' <- openFd dev ReadWrite Nothing defaultFileFlags { noctty = True } + let serial_port = (SerialPort fd' defaultSerialSettings) + return =<< setSerialSettings serial_port settings -- |Possibly receive a character unless the timeout given in openSerial is exceeded. recvChar :: SerialPort -> IO (Maybe Char) -recvChar (SerialPort fd' _) = - do result <- try $ fdRead fd' 1 - case result of - Right (str, _) -> return $ Just $ head str - Left _ -> return Nothing +recvChar (SerialPort fd' _) = do + result <- try $ fdRead fd' 1 + case result of + Right (str, _) -> return $ Just $ head str + Left _ -> return Nothing -- |Send a character @@ -53,81 +53,112 @@ getTIOCM :: Fd -> IO Int getTIOCM fd' = - alloca $ \p -> cIoctl' fd' (#const TIOCMGET) p >> peek p + alloca $ \p -> cIoctl' fd' #{const TIOCMGET} p >> peek p setTIOCM :: Fd -> Int -> IO () setTIOCM fd' val = - with val $ cIoctl' fd' (#const TIOCMSET) + with val $ cIoctl' fd' #{const TIOCMSET} -- |Set the Data Terminal Ready level setDTR :: SerialPort -> Bool -> IO () -setDTR (SerialPort fd' _) set = - do current <- getTIOCM fd' - setTIOCM fd' $ if set - then current .|. (#const TIOCM_DTR) - else current .&. (complement (#const TIOCM_DTR)) +setDTR (SerialPort fd' _) set = do + current <- getTIOCM fd' + setTIOCM fd' $ if set + then current .|. #{const TIOCM_DTR} + else current .&. complement #{const TIOCM_DTR} -- |Set the Ready to send level setRTS :: SerialPort -> Bool -> IO () -setRTS (SerialPort fd' _) set = - do current <- getTIOCM fd' - setTIOCM fd' $ if set - then current .|. (#const TIOCM_RTS) - else current .&. (complement (#const TIOCM_RTS)) +setRTS (SerialPort fd' _) set = do + current <- getTIOCM fd' + setTIOCM fd' $ if set + then current .|. #{const TIOCM_RTS} + else current .&. complement #{const TIOCM_RTS} -setSerialSettings :: Fd -> SerialPortSettings -> IO () -setSerialSettings fd' settings = - do termOpts <- getTerminalAttributes fd' - let termOpts' = configureSettings termOpts settings - setTerminalAttributes fd' termOpts' Immediately +-- |Configure the serial port +setSerialSettings :: SerialPort -- ^ The currently opened serial port + -> SerialPortSettings -- ^ The new settings + -> IO SerialPort -- ^ New serial port +setSerialSettings (SerialPort fd' _) new_settings = do + termOpts <- getTerminalAttributes fd' + let termOpts' = configureSettings termOpts new_settings + setTerminalAttributes fd' termOpts' Immediately + return (SerialPort fd' new_settings) +-- |Get configuration from serial port +getSerialSettings :: SerialPort -> SerialPortSettings +getSerialSettings (SerialPort _ settings) = settings + + withParity :: TerminalAttributes -> Parity -> TerminalAttributes -withParity termOpts Even = termOpts `withMode` EnableParity - `withoutMode` OddParity -withParity termOpts Odd = termOpts `withMode` EnableParity - `withMode` OddParity -withParity termOpts NoParity = termOpts `withoutMode` EnableParity +withParity termOpts Even = + termOpts `withMode` EnableParity + `withoutMode` OddParity +withParity termOpts Odd = + termOpts `withMode` EnableParity + `withMode` OddParity +withParity termOpts NoParity = + termOpts `withoutMode` EnableParity withFlowControl :: TerminalAttributes -> FlowControl -> TerminalAttributes -withFlowControl termOpts NoFlowControl = termOpts - `withoutMode` StartStopInput - `withoutMode` StartStopOutput -withFlowControl termOpts Software = termOpts - `withMode` StartStopInput - `withMode` StartStopOutput +withFlowControl termOpts NoFlowControl = + termOpts `withoutMode` StartStopInput + `withoutMode` StartStopOutput +withFlowControl termOpts Software = + termOpts `withMode` StartStopInput + `withMode` StartStopOutput withStopBits :: TerminalAttributes -> StopBits -> TerminalAttributes -withStopBits termOpts One = termOpts `withoutMode` TwoStopBits -withStopBits termOpts Two = termOpts `withMode` TwoStopBits +withStopBits termOpts One = + termOpts `withoutMode` TwoStopBits +withStopBits termOpts Two = + termOpts `withMode` TwoStopBits configureSettings :: TerminalAttributes -> SerialPortSettings -> TerminalAttributes configureSettings termOpts settings = - termOpts `withInputSpeed` (baudRate settings) - `withOutputSpeed` (baudRate settings) - `withBits` (fromIntegral (bitsPerWord settings)) - `withStopBits` (stopb settings) - `withParity` (parity settings) - `withFlowControl` (flowControl settings) - `withoutMode` EnableEcho - `withoutMode` EchoErase - `withoutMode` EchoKill - `withoutMode` ProcessInput - `withoutMode` ProcessOutput - `withoutMode` MapCRtoLF - `withoutMode` EchoLF - `withoutMode` HangupOnClose - `withoutMode` KeyboardInterrupts - `withoutMode` ExtendedFunctions - `withMode` LocalMode - `withMode` ReadEnable - `withTime` (timeout settings) - `withMinInput` 0 + termOpts `withInputSpeed` (commSpeedToBaudRate (commSpeed settings)) + `withOutputSpeed` (commSpeedToBaudRate (commSpeed settings)) + `withBits` fromIntegral (bitsPerWord settings) + `withStopBits` stopb settings + `withParity` parity settings + `withFlowControl` flowControl settings + `withoutMode` EnableEcho + `withoutMode` EchoErase + `withoutMode` EchoKill + `withoutMode` ProcessInput + `withoutMode` ProcessOutput + `withoutMode` MapCRtoLF + `withoutMode` EchoLF + `withoutMode` HangupOnClose + `withoutMode` KeyboardInterrupts + `withoutMode` ExtendedFunctions + `withMode` LocalMode + `withMode` ReadEnable + `withTime` timeout settings + `withMinInput` 0 + + +commSpeedToBaudRate :: CommSpeed -> BaudRate +commSpeedToBaudRate speed = + case speed of + CS110 -> B110 + CS300 -> B300 + CS600 -> B600 + CS1200 -> B1200 + CS2400 -> B2400 + CS4800 -> B4800 + CS9600 -> B9600 + CS19200 -> B19200 + CS38400 -> B38400 + CS57600 -> B57600 + CS115200 -> B115200 + diff --git a/System/Hardware/Serialport/Types.hs b/System/Hardware/Serialport/Types.hs deleted file mode 100644 --- a/System/Hardware/Serialport/Types.hs +++ /dev/null @@ -1,141 +0,0 @@ -{-# LANGUAGE CPP #-} -module System.Hardware.Serialport.Types where - -import Data.Word -#if defined(mingw32_HOST_OS) -import System.Win32.Types - --- | Same as System.Posix.Terminal -data BaudRate - = B0 - | B50 - | B75 - | B110 - | B134 - | B150 - | B200 - | B300 - | B600 - | B1200 - | B1800 - | B2400 - | B4800 - | B9600 - | B19200 - | B38400 - | B57600 - | B115200 - -#else -import System.Posix.Terminal -import System.Posix.Types -#endif - -fromBaudToInt :: BaudRate -> Int -fromBaudToInt b = - case b of - B0 -> 0 - B50 -> 50 - B75 -> 75 - B110 -> 110 - B134 -> 134 - B150 -> 150 - B200 -> 200 - B300 -> 300 - B600 -> 600 - B1200 -> 1200 - B1800 -> 1800 - B2400 -> 2400 - B4800 -> 4800 - B9600 -> 9600 - B19200 -> 19200 - B38400 -> 38400 - B57600 -> 57600 - B115200 -> 115200 - - -fromIntToBaud :: Int -> BaudRate -fromIntToBaud i = - case i of - 0 -> B0 - 50 -> B50 - 75 -> B75 - 110 -> B110 - 134 -> B134 - 150 -> B150 - 200 -> B200 - 300 -> B300 - 600 -> B600 - 1200 -> B1200 - 1800 -> B1800 - 2400 -> B2400 - 4800 -> B4800 - 9600 -> B9600 - 19200 -> B19200 - 38400 -> B38400 - 57600 -> B57600 - 115200 -> B115200 - _ -> error $ "unsupported baudrate " ++ show i - - - -data StopBits = One | Two -data Parity = Even | Odd | NoParity -data FlowControl = Software | NoFlowControl - -data SerialPortSettings = SerialPortSettings { - baudRate :: BaudRate, -- ^ baudrate - bitsPerWord :: Word8, -- ^ Number of bits in a word - stopb :: StopBits, -- ^ Number of stop bits - parity :: Parity, -- ^ Type of parity - flowControl :: FlowControl, -- ^ Type of flowcontrol - timeout :: Int -- ^ Timeout when receiving a char in tenth of seconds - } - - -instance Show SerialPortSettings where - show settings = baudrate ++ "/" ++ bits ++ "-" ++ par ++ "-" ++ stopbits ++ " (" ++ flow ++ ", " ++ wait ++ ")" - where - baudrate = show $ fromBaudToInt $ baudRate settings - bits = show $ bitsPerWord settings - par = case parity settings of - Even -> "E" - Odd -> "O" - NoParity -> "N" - stopbits = case stopb settings of - One -> "1" - Two -> "2" - flow = case flowControl settings of - NoFlowControl -> "no flow control" - Software -> "software flow control" - wait = "timeout:" ++ show ((timeout settings) * 100) - - -data SerialPort = SerialPort { -#if defined(mingw32_HOST_OS) - handle :: HANDLE, -#else - fd :: Fd, -#endif - newSettings :: SerialPortSettings - } - - --- | Most commonly used configuration --- --- - 9600 baud --- --- - 8 data bits --- --- - 1 stop bit --- --- - no parity --- --- - no flow control --- --- - 0.1 millisecond receive timeout --- -defaultSerialSettings :: SerialPortSettings -defaultSerialSettings = - SerialPortSettings B9600 8 One NoParity NoFlowControl 1 - diff --git a/System/Hardware/Serialport/Windows.hs b/System/Hardware/Serialport/Windows.hs --- a/System/Hardware/Serialport/Windows.hs +++ b/System/Hardware/Serialport/Windows.hs @@ -16,82 +16,79 @@ openSerial :: String -- ^ The filename of the serial port, such as @COM5@ or @\/\/.\/CNCA0@ -> SerialPortSettings -> IO SerialPort -openSerial dev settings = - do h <- createFile dev access_mode share_mode security_attr create_mode file_attr template_file - setSerialSettings h settings - return $ SerialPort h settings - 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 +openSerial dev settings = do + h <- createFile dev access_mode share_mode security_attr create_mode file_attr template_file + let serial_port = SerialPort h defaultSerialSettings + return =<< setSerialSettings serial_port settings + 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 + 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 + 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 + closeHandle h -- |Set the Data Terminal Ready level setDTR :: SerialPort -> Bool -> IO () -setDTR (SerialPort h _ ) set = - Comm.escapeCommFunction h $ if set - then Comm.setDTR - else Comm.clrDTR +setDTR (SerialPort h _ ) True = Comm.escapeCommFunction h Comm.setDTR +setDTR (SerialPort h _ ) False = Comm.escapeCommFunction h Comm.clrDTR -- |Set the Ready to send level setRTS :: SerialPort -> Bool -> IO () -setRTS (SerialPort h _ ) set = - Comm.escapeCommFunction h $ if set - then Comm.setRTS - else Comm.clrRTS +setRTS (SerialPort h _ ) True = Comm.escapeCommFunction h Comm.setRTS +setRTS (SerialPort h _ ) False = Comm.escapeCommFunction h Comm.clrRTS -setSerialSettings :: HANDLE -> SerialPortSettings -> IO () -setSerialSettings h settings = - do let ct = Comm.COMMTIMEOUTS { +-- |Configure the serial port +setSerialSettings :: SerialPort -- ^ The currently opened serial port + -> SerialPortSettings -- ^ The new settings + -> IO SerialPort -- ^ New serial port +setSerialSettings (SerialPort h _) new_settings = do + let ct = Comm.COMMTIMEOUTS { Comm.readIntervalTimeout = maxBound :: DWORD, Comm.readTotalTimeoutMultiplier = maxBound :: DWORD, - Comm.readTotalTimeoutConstant = fromIntegral (timeout settings) * 100, - Comm.writeTotalTimeoutMultiplier = 0, + Comm.readTotalTimeoutConstant = fromIntegral (timeout new_settings) * 100, + Comm.writeTotalTimeoutMultiplier = 0, Comm.writeTotalTimeoutConstant = 0 } - Comm.setCommTimeouts h ct + Comm.setCommTimeouts h ct - let dcb = Comm.DCB { - Comm.baudRate = (baudRate settings), - Comm.parity = (parity settings), - Comm.stopBits = (stopb settings), - Comm.flowControl = (flowControl settings), - Comm.byteSize = (bitsPerWord settings) } - Comm.setCommState h dcb + Comm.setCommState h new_settings - return () + return (SerialPort h new_settings) + +-- |Get configuration from serial port +getSerialSettings :: SerialPort -> SerialPortSettings +getSerialSettings (SerialPort _ settings) = settings diff --git a/System/Win32/Comm.hsc b/System/Win32/Comm.hsc --- a/System/Win32/Comm.hsc +++ b/System/Win32/Comm.hsc @@ -1,95 +1,96 @@ {-# LANGUAGE ForeignFunctionInterface #-} module System.Win32.Comm where -import System.IO import System.Win32.Types -import Data.Word import Data.Bits import Foreign.Storable import Foreign.Ptr import Foreign.Marshal.Alloc import Foreign.Marshal.Utils -import qualified System.Hardware.Serialport.Types as STypes +import System.Hardware.Serialport.Types #include -type LPDCB = Ptr DCB -data DCB = DCB - { baudRate :: STypes.BaudRate, - parity :: STypes.Parity, - stopBits :: STypes.StopBits, - byteSize :: Word8, - flowControl :: STypes.FlowControl - } - - --- | If this member is TRUE, binary mode is enabled. Windows does not support nonbinary mode transfers, so this member must be TRUE. +-- | If this member is TRUE, binary mode is enabled. Windows does not support nonbinary mode transfers, +-- so this member must be TRUE. fBinary :: DWORD -fBinary = 0x0000000000000001 +fBinary = 0x00000001 -- | If this member is TRUE, parity checking is performed and errors are reported. fParity :: DWORD -fParity = 0x0000000000000010 +fParity = 0x00000002 -instance Storable DCB where - sizeOf = const #size DCB - alignment = sizeOf - poke buf dcb = do - (#poke DCB, DCBlength) buf (sizeOf dcb) - (#poke DCB, BaudRate) buf (fromIntegral (STypes.fromBaudToInt (baudRate dcb)) :: DWORD) - pokeByteOff buf 8 (fBinary .|. fParity :: DWORD) - (#poke DCB, wReserved) buf (0 :: WORD) - (#poke DCB, XonLim) buf (2048 :: WORD) - (#poke DCB, XoffLim) buf (512 :: WORD) - (#poke DCB, ByteSize) buf (byteSize dcb :: BYTE) - (#poke DCB, Parity) buf (case (parity dcb) of - STypes.NoParity -> (#const NOPARITY) - STypes.Odd -> (#const ODDPARITY) - STypes.Even -> (#const EVENPARITY) - :: BYTE) - (#poke DCB, StopBits) buf (case (stopBits dcb) of - STypes.One -> (#const ONESTOPBIT) - STypes.Two -> (#const TWOSTOPBITS) - :: BYTE) - (#poke DCB, wReserved1) buf (0 :: WORD) - peek buf = do - _dCBlength <- (#peek DCB, DCBlength) buf :: IO DWORD - _baudRate <- do _baud <- (#peek DCB, BaudRate) buf :: IO DWORD - return $ STypes.fromIntToBaud (fromIntegral _baud :: Int) - _fsettings <- peekByteOff buf 8 :: IO DWORD - _byteSize <- (#peek DCB, ByteSize) buf :: IO BYTE - _parity <- do _par <- (#peek DCB, Parity) buf :: IO BYTE - case _par of - (#const NOPARITY) -> return STypes.NoParity - (#const ODDPARITY) -> return STypes.Odd - (#const EVENPARITY) -> return STypes.Even - (#const MARKPARITY) -> fail $ "unsupported markparity" - (#const SPACEPARITY) -> fail $ "unsupported spaceparity" - _ -> fail $ "unsupported parity" ++ (show _par) - _stopBits <- do _stopb <- (#peek DCB, StopBits) buf :: IO BYTE - case _stopb of - (#const ONESTOPBIT) -> return STypes.One - (#const ONE5STOPBITS) -> fail $ "unsupported one5stopbits" - (#const TWOSTOPBITS) -> return STypes.Two - _ -> fail "unexpected stop bit count" - _XonLim <- (#peek DCB, XonLim) buf :: IO WORD - _XoffLim <- (#peek DCB, XoffLim) buf :: IO WORD - return DCB { baudRate = _baudRate, - parity = _parity, - stopBits = _stopBits, - flowControl = STypes.NoFlowControl, - byteSize = _byteSize - } +-- Preceding bits: (fBinary)1 + (fParity)1 + (fOutxCtrFlow)1 + (fOutxDsrFlow)1 +fDtrEnable :: DWORD +fDtrEnable = (#const DTR_CONTROL_ENABLE) `shift` 4 -getCommState :: HANDLE -> IO DCB +-- Preciding bits:(fBinary)1 + (fParity)1 + (fOutxCtrFlow)1 + (fOutxDsrFlow)1 + (fDtrControl)2 + (fDsrSensitivity)1 + +-- (fTXContinueOnXoff)1 + (fOutX)1 + (fInx)1 + (fErrorChar)1 + (fNull)1 +fRtsEnable :: DWORD +fRtsEnable = (#const RTS_CONTROL_ENABLE) `shift` 12 + + +instance Storable SerialPortSettings where + sizeOf _ = #{size DCB} + alignment = sizeOf + poke buf settings = do + #{poke DCB, DCBlength} buf (sizeOf settings) + #{poke DCB, BaudRate} buf (fromIntegral (commSpeedToBaudRate (commSpeed settings)) :: DWORD) + pokeByteOff buf 8 (fBinary .|. fDtrEnable .|. fRtsEnable ) + #{poke DCB, wReserved} buf (0 :: WORD) + #{poke DCB, XonLim} buf (2048 :: WORD) + #{poke DCB, XoffLim} buf (512 :: WORD) + #{poke DCB, ByteSize} buf (bitsPerWord settings :: BYTE) + #{poke DCB, Parity} buf (case (parity settings) of + NoParity -> #const NOPARITY + Odd -> #const ODDPARITY + Even -> #const EVENPARITY + :: BYTE) + #{poke DCB, StopBits} buf (case (stopb settings) of + One -> #const ONESTOPBIT + Two -> #const TWOSTOPBITS + :: BYTE) + #{poke DCB, wReserved1} buf (0 :: WORD) + peek buf = do + _dCBlength <- #{peek DCB, DCBlength} buf :: IO DWORD + _commSpeed <- do _baud <- #{peek DCB, BaudRate} buf :: IO DWORD + return $ baudRateToCommSpeed (fromIntegral _baud) + _fsettings <- peekByteOff buf 8 :: IO DWORD + _byteSize <- #{peek DCB, ByteSize} buf :: IO BYTE + _parity <- do _par <- #{peek DCB, Parity} buf :: IO BYTE + case _par of + #{const NOPARITY} -> return NoParity + #{const ODDPARITY} -> return Odd + #{const EVENPARITY} -> return Even + #{const MARKPARITY} -> fail "unsupported markparity" + #{const SPACEPARITY} -> fail "unsupported spaceparity" + _ -> fail $ "unsupported parity" ++ show _par + _stopBits <- do _stopb <- #{peek DCB, StopBits} buf :: IO BYTE + case _stopb of + #{const ONESTOPBIT} -> return One + #{const ONE5STOPBITS} -> fail "unsupported one5stopbits" + #{const TWOSTOPBITS} -> return Two + _ -> fail "unexpected stop bit count" + _XonLim <- #{peek DCB, XonLim} buf :: IO WORD + _XoffLim <- #{peek DCB, XoffLim} buf :: IO WORD + return SerialPortSettings { + commSpeed = _commSpeed, + bitsPerWord = _byteSize, + stopb = _stopBits, + parity = _parity, + flowControl = NoFlowControl, + timeout = 0 + } + + +getCommState :: HANDLE -> IO SerialPortSettings getCommState h = - alloca (\dcbp -> - do c_GetCommState h dcbp - peek dcbp ) + alloca (\dcbp -> do _ <- c_GetCommState h dcbp + peek dcbp ) --BOOL WINAPI GetCommState( @@ -97,12 +98,12 @@ -- __inout LPDCB lpDCB --); foreign import stdcall unsafe "winbase.h GetCommState" - c_GetCommState :: HANDLE -> LPDCB -> IO BOOL + c_GetCommState :: HANDLE -> Ptr SerialPortSettings -> IO BOOL -setCommState :: HANDLE -> DCB -> IO () -setCommState h dcb = - failIfFalse_ "setCommState" ( with dcb (c_SetCommState h)) +setCommState :: HANDLE -> SerialPortSettings -> IO () +setCommState h settings = + failIfFalse_ "setCommState" ( with settings (c_SetCommState h)) --BOOL WINAPI SetCommState( @@ -110,14 +111,13 @@ -- __in LPDCB lpDCB --); foreign import stdcall unsafe "winbase.h SetCommState" - c_SetCommState :: HANDLE -> LPDCB -> IO BOOL - - + c_SetCommState :: HANDLE -> Ptr SerialPortSettings -> IO BOOL --- | --- If an application sets ReadIntervalTimeout and ReadTotalTimeoutMultiplier to MAXDWORD and sets ReadTotalTimeoutConstant to a value greater than zero and less than MAXDWORD, one of the following occurs when the ReadFile function is called: +-- If an application sets ReadIntervalTimeout and ReadTotalTimeoutMultiplier to MAXDWORD and +-- sets ReadTotalTimeoutConstant to a value greater than zero and less than MAXDWORD, one of +-- the following occurs when the ReadFile function is called: -- -- * If there are any bytes in the input buffer, ReadFile returns immediately with the bytes in the buffer. -- @@ -136,38 +136,37 @@ instance Storable COMMTIMEOUTS where - sizeOf = const #size COMMTIMEOUTS - alignment = sizeOf - poke buf ct = do - (#poke COMMTIMEOUTS, ReadIntervalTimeout) buf (readIntervalTimeout ct) - (#poke COMMTIMEOUTS, ReadTotalTimeoutMultiplier) buf ( readTotalTimeoutMultiplier ct) - (#poke COMMTIMEOUTS, ReadTotalTimeoutConstant) buf ( readTotalTimeoutConstant ct) - (#poke COMMTIMEOUTS, WriteTotalTimeoutMultiplier) buf ( writeTotalTimeoutMultiplier ct) - (#poke COMMTIMEOUTS, WriteTotalTimeoutConstant) buf ( writeTotalTimeoutConstant ct) - peek buf = do - _readIntervalTimeout <- (#peek COMMTIMEOUTS, ReadIntervalTimeout) buf - _readTotalTimeoutMultiplier <- (#peek COMMTIMEOUTS, ReadTotalTimeoutMultiplier ) buf - _readTotalTimeoutConstant <- (#peek COMMTIMEOUTS, ReadTotalTimeoutConstant ) buf - _writeTotalTimeoutMultiplier <- (#peek COMMTIMEOUTS, WriteTotalTimeoutMultiplier ) buf - _writeTotalTimeoutConstant <- (#peek COMMTIMEOUTS, WriteTotalTimeoutConstant ) buf - return COMMTIMEOUTS { readIntervalTimeout = _readIntervalTimeout, - readTotalTimeoutMultiplier = _readTotalTimeoutMultiplier, - readTotalTimeoutConstant = _readTotalTimeoutConstant, - writeTotalTimeoutMultiplier = _writeTotalTimeoutMultiplier, - writeTotalTimeoutConstant = _writeTotalTimeoutConstant } + sizeOf _ = #{size COMMTIMEOUTS} + alignment = sizeOf + poke buf ct = do + #{poke COMMTIMEOUTS, ReadIntervalTimeout} buf (readIntervalTimeout ct) + #{poke COMMTIMEOUTS, ReadTotalTimeoutMultiplier} buf ( readTotalTimeoutMultiplier ct) + #{poke COMMTIMEOUTS, ReadTotalTimeoutConstant} buf ( readTotalTimeoutConstant ct) + #{poke COMMTIMEOUTS, WriteTotalTimeoutMultiplier} buf ( writeTotalTimeoutMultiplier ct) + #{poke COMMTIMEOUTS, WriteTotalTimeoutConstant} buf ( writeTotalTimeoutConstant ct) + peek buf = do + _readIntervalTimeout <- #{peek COMMTIMEOUTS, ReadIntervalTimeout} buf + _readTotalTimeoutMultiplier <- #{peek COMMTIMEOUTS, ReadTotalTimeoutMultiplier } buf + _readTotalTimeoutConstant <- #{peek COMMTIMEOUTS, ReadTotalTimeoutConstant } buf + _writeTotalTimeoutMultiplier <- #{peek COMMTIMEOUTS, WriteTotalTimeoutMultiplier } buf + _writeTotalTimeoutConstant <- #{peek COMMTIMEOUTS, WriteTotalTimeoutConstant } buf + return COMMTIMEOUTS { readIntervalTimeout = _readIntervalTimeout, + readTotalTimeoutMultiplier = _readTotalTimeoutMultiplier, + readTotalTimeoutConstant = _readTotalTimeoutConstant, + writeTotalTimeoutMultiplier = _writeTotalTimeoutMultiplier, + writeTotalTimeoutConstant = _writeTotalTimeoutConstant } getCommTimeouts :: HANDLE -> IO COMMTIMEOUTS getCommTimeouts h = - alloca (\c -> - do c_GetCommTimeouts h c - peek c ) + alloca (\c -> do _ <- c_GetCommTimeouts h c + peek c ) -- getcommtimeouts -- winbase.h -> BOOL WINAPI GetCommTimeouts(HANDLE, LPCOMMTIMEOUTS); foreign import stdcall unsafe "winbase.h GetCommTimeouts" - c_GetCommTimeouts :: HANDLE -> LPCOMMTIMEOUTS -> IO BOOL + c_GetCommTimeouts :: HANDLE -> LPCOMMTIMEOUTS -> IO BOOL @@ -177,13 +176,13 @@ -- setCommTimeouts :: HANDLE -> COMMTIMEOUTS -> IO () setCommTimeouts h ct = - failIfFalse_ "setCommTimeouts" ( with ct (c_SetCommTimeouts h) ) + failIfFalse_ "setCommTimeouts" ( with ct (c_SetCommTimeouts h) ) -- setcommtimeouts -- winbase.h -> BOOL WINAPI SetCommTimeouts(HANDLE, LPCOMMTIMEOUTS); foreign import stdcall unsafe "winbase.h SetCommTimeouts" - c_SetCommTimeouts :: HANDLE -> LPCOMMTIMEOUTS -> IO BOOL + c_SetCommTimeouts :: HANDLE -> LPCOMMTIMEOUTS -> IO BOOL clrDTR :: DWORD @@ -201,10 +200,32 @@ -- -- foreign import stdcall unsafe "winbase.h EscapeCommFunction" - c_EscapeCommFunction :: HANDLE -> DWORD -> IO BOOL + c_EscapeCommFunction :: HANDLE -> DWORD -> IO BOOL escapeCommFunction :: HANDLE -> DWORD -> IO () escapeCommFunction h t = - failIfFalse_ "excapeCommFunction" ( c_EscapeCommFunction h t ) + failIfFalse_ "excapeCommFunction" ( c_EscapeCommFunction h t ) + +baudRateToCommSpeed :: Int -> CommSpeed +baudRateToCommSpeed baud = + case baud of + (#const CBR_110) -> CS110 + _ -> CS9600 + + +commSpeedToBaudRate :: CommSpeed -> Int +commSpeedToBaudRate cs = + case cs of + CS110 -> (#const CBR_110) + CS300 -> (#const CBR_300) + CS600 -> (#const CBR_600) + CS1200 -> (#const CBR_1200) + CS2400 -> (#const CBR_2400) + CS4800 -> (#const CBR_4800) + CS9600 -> (#const CBR_9600) + CS19200 -> (#const CBR_19200) + CS38400 -> (#const CBR_38400) + CS57600 -> (#const CBR_57600) + CS115200 -> (#const CBR_115200) diff --git a/serialport.cabal b/serialport.cabal --- a/serialport.cabal +++ b/serialport.cabal @@ -1,20 +1,24 @@ Name: serialport -Version: 0.3.3 -Cabal-Version: >= 1.2 -Build-Type: Simple +Version: 0.4.0 +Cabal-Version: >= 1.6 +Build-Type: Custom license: BSD3 license-file: LICENSE copyright: (c) 2009 Joris Putcuyps author: Joris Putcuyps maintainer: Joris.Putcuyps@gmail.com -homepage: http://users.skynet.be/jputcu/projects/haskell-serialport/index.html -bug-reports: mailto:Joris.Putcuyps@gmail.com -synopsis: Cross platform serial port library. +homepage: https://github.com/jputcu/serialport +bug-reports: https://github.com/jputcu/serialport/issues +synopsis: Cross platform serial port library. +description: Cross platform haskell library for using the serial port. category: Hardware +source-repository head + type: git + location: git://github.com/jputcu/serialport.git + Library Exposed-Modules: System.Hardware.Serialport - System.Hardware.Serialport.Types Build-Depends: base >= 4, base < 5 ghc-options: -Wall