diff --git a/README b/README --- a/README +++ b/README @@ -41,4 +41,7 @@ - Python serial library http://pyserial.sourceforge.net/ - http://www.easysw.com/~mike/serial/serial.html - Ruby serial port library http://ruby-serialport.rubyforge.org/ + - C++ libraries + - Common cpp: http://www.gnu.org/software/commoncpp/ + - Boost asio serial: http://www.boost.org/ diff --git a/System/Hardware/Serialport.hs b/System/Hardware/Serialport.hs --- a/System/Hardware/Serialport.hs +++ b/System/Hardware/Serialport.hs @@ -2,8 +2,12 @@ -- | Example usage: -- --- > s <- openSerial "/dev/ttyUSB0" B9600 8 One NoParity NoFlowControl +-- > import System.Hardware.Serialport -- > +-- > s <- openSerial "/dev/ttyUSB0" defaultSerialSettings +-- > -- or a little different +-- > s <- openSerial "/dev/ttyUSB0" defaultSerialSettings { baudRate = B2400 } +-- > -- > -- Sending -- > forM_ "AT\r" $ sendChar s -- > @@ -17,18 +21,16 @@ module System.Hardware.Serialport ( -- * Types - StopBits(..) + BaudRate(..) + ,StopBits(..) ,Parity(..) ,FlowControl(..) - ,BaudRate(..) ,SerialPort -#if defined(linux_HOST_OS) - -- * Simple, non-portable. - -- - -- | In an perfect world this would be portable but a System.IO.hWaitForInput on Windows is blocking! - ,hOpenSerial -#endif - -- * Portable methods. + -- * Configure port + -- | You don't need the get or set functions, they are used by openSerial + ,SerialPortSettings(..) + ,defaultSerialSettings + -- * Serial methods ,openSerial ,sendChar ,recvChar @@ -37,8 +39,8 @@ #if defined(mingw32_HOST_OS) import System.Hardware.Serialport.Windows -import System.Win32.Comm #elif defined(linux_HOST_OS) import System.Hardware.Serialport.Posix import System.Posix.Terminal #endif +import System.Hardware.Serialport.Types diff --git a/System/Hardware/Serialport/Posix.hs b/System/Hardware/Serialport/Posix.hs --- a/System/Hardware/Serialport/Posix.hs +++ b/System/Hardware/Serialport/Posix.hs @@ -1,51 +1,26 @@ module System.Hardware.Serialport.Posix where import System.IO -import System.Posix.Terminal import System.Posix.IO -import Data.Word - - -data StopBits = One | Two -data Parity = Even | Odd | NoParity -data FlowControl = Software | NoFlowControl -data SerialPort = SerialPort { handle :: Handle, - timeout :: Int } - - --- |Open and configure a serial port and return a Handle -hOpenSerial :: String -- ^ The filename of the serial port, such as @\/dev\/ttyS0@ or @\/dev\/ttyUSB0@ - -> BaudRate - -> Word8 -- ^ The number of bits per word, typically 8 - -> StopBits -- ^ Almost always @One@ unless you're talking to a printer - -> Parity -- ^ Error checking - -> FlowControl - -> IO Handle -hOpenSerial dev baud bPerB stopBits parity flow = - do setSerial dev baud bPerB stopBits parity flow - h <- openBinaryFile dev ReadWriteMode - hSetBuffering h NoBuffering - return h +import System.Posix.Terminal +import System.Hardware.Serialport.Types -- |Open and configure a serial port -openSerial :: String -- ^ The filename of the serial port, such as @\/dev\/ttyS0@ or @\/dev\/ttyUSB0@ - -> BaudRate - -> Word8 -- ^ The number of bits per word, typically 8 - -> StopBits -- ^ Almost always @One@ unless you're talking to a printer - -> Parity - -> FlowControl - -> Int -- ^ Receive timeout in milliseconds +openSerial :: FilePath -- ^ The filename of the serial port, such as @\/dev\/ttyS0@ or @\/dev\/ttyUSB0@ + -> SerialPortSettings -> IO SerialPort -openSerial dev baud bPerB stopBits parity flow time_ms = - do h <- hOpenSerial dev baud bPerB stopBits parity flow - return $ SerialPort h time_ms +openSerial dev settings = + do setSerialSettings dev settings + h <- openBinaryFile dev ReadWriteMode + hSetBuffering h NoBuffering + return $ SerialPort h settings -- |Possibly receive a character unless the timeout given in openSerial is exceeded. recvChar :: SerialPort -> IO (Maybe Char) -recvChar (SerialPort h time_ms) = - do have_input <- hWaitForInput h time_ms +recvChar (SerialPort h settings) = + do have_input <- hWaitForInput h ((timeout settings) * 100) if have_input then do c <- hGetChar h return $ Just c @@ -54,44 +29,38 @@ -- |Send a character sendChar :: SerialPort -> Char -> IO () -sendChar (SerialPort h _) = - hPutChar h +sendChar (SerialPort h _ ) c = + hPutChar h c >> return () -- |Close the serial port closeSerial :: SerialPort -> IO () -closeSerial (SerialPort h _) = +closeSerial (SerialPort h _ ) = hClose h - -setSerial :: String - -> BaudRate - -> Word8 - -> StopBits - -> Parity - -> FlowControl - -> IO () -setSerial dev baud bPerB stopBits parity flow = do - fd <- openFd dev ReadWrite Nothing - OpenFileFlags { append = True, - exclusive = True, - noctty = True, - nonBlock = True, - trunc = False } - termOpts <- getTerminalAttributes fd - let termOpts' = configureSettings termOpts baud bPerB stopBits parity flow - setTerminalAttributes fd termOpts' Immediately - closeFd fd +setSerialSettings :: FilePath -> SerialPortSettings -> IO () +setSerialSettings dev settings = + do fd <- openFd dev ReadWrite Nothing + OpenFileFlags { append = True, + exclusive = True, + noctty = True, + nonBlock = False, + trunc = False } + termOpts <- getTerminalAttributes fd + let termOpts' = configureSettings termOpts settings + setTerminalAttributes fd termOpts' Immediately + closeFd fd withParity :: TerminalAttributes -> Parity -> TerminalAttributes withParity termOpts Even = termOpts `withMode` EnableParity - `withoutMode` OddParity + `withoutMode` OddParity withParity termOpts Odd = termOpts `withMode` EnableParity - `withMode` OddParity + `withMode` OddParity withParity termOpts NoParity = termOpts `withoutMode` EnableParity + withFlowControl :: TerminalAttributes -> FlowControl -> TerminalAttributes withFlowControl termOpts NoFlowControl = termOpts `withoutMode` StartStopInput @@ -100,19 +69,20 @@ `withMode` StartStopInput `withMode` StartStopOutput + withStopBits :: TerminalAttributes -> StopBits -> TerminalAttributes withStopBits termOpts One = termOpts `withoutMode` TwoStopBits withStopBits termOpts Two = termOpts `withMode` TwoStopBits -configureSettings :: TerminalAttributes -> BaudRate -> Word8 -> StopBits -> Parity -> FlowControl -> TerminalAttributes -configureSettings termOpts baud bPerB stopBits parity flow = - termOpts `withInputSpeed` baud - `withOutputSpeed` baud - `withBits` (fromIntegral bPerB :: Int) - `withStopBits` stopBits - `withParity` parity - `withFlowControl` flow +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 diff --git a/System/Hardware/Serialport/Types.hs b/System/Hardware/Serialport/Types.hs new file mode 100644 --- /dev/null +++ b/System/Hardware/Serialport/Types.hs @@ -0,0 +1,140 @@ +{-# LANGUAGE CPP #-} +module System.Hardware.Serialport.Types where + +import Data.Word +#if defined(linux_HOST_OS) +import System.Posix.Terminal +import System.IO +#elif 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 +#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 + handle :: Handle, +#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 @@ -1,8 +1,7 @@ module System.Hardware.Serialport.Windows where -import Data.Word import Data.Bits -import System.Win32.Comm +import qualified System.Win32.Comm as Comm import System.Win32.Types import System.Win32.File import Foreign.C.Types @@ -10,24 +9,17 @@ import Foreign.Marshal.Utils import Foreign.Marshal.Alloc import Foreign.Storable +import System.Hardware.Serialport.Types -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 + -> SerialPortSettings -> IO SerialPort -openSerial dev baud bPerB stopb par flow time_ms = +openSerial dev settings = 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 + setSerialSettings h settings + return $ SerialPort h settings where access_mode = gENERIC_READ .|. gENERIC_WRITE share_mode = fILE_SHARE_NONE @@ -67,30 +59,23 @@ 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 +setSerialSettings :: HANDLE -> SerialPortSettings -> IO () +setSerialSettings h settings = + do let ct = Comm.COMMTIMEOUTS { + Comm.readIntervalTimeout = maxBound :: DWORD, + Comm.readTotalTimeoutMultiplier = maxBound :: DWORD, + Comm.readTotalTimeoutConstant = fromIntegral (timeout settings) * 100, + Comm.writeTotalTimeoutMultiplier = 0, + Comm.writeTotalTimeoutConstant = 0 } + Comm.setCommTimeouts h ct - let dcb' = DCB { - baudRate = baud, - parity = parit, - stopBits = stopb, - flowControl = flow, - byteSize = bPerB } - setCommState h dcb' + 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 return () diff --git a/System/Win32/Comm.hsc b/System/Win32/Comm.hsc --- a/System/Win32/Comm.hsc +++ b/System/Win32/Comm.hsc @@ -4,137 +4,82 @@ 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 #include -data BaudRate - = B0 - | B50 - | B75 - | B110 - | B134 - | B150 - | B200 - | B300 - | B600 - | B1200 - | B1800 - | B2400 - | B4800 - | B9600 - | B19200 - | B38400 - | B57600 - | B115200 - deriving Show -data StopBits = One | Two deriving Show -data Parity = Even | Odd | NoParity deriving Show -data FlowControl = Software | NoFlowControl deriving Show - - type LPDCB = Ptr DCB data DCB = DCB - { baudRate :: BaudRate, - parity :: Parity, - stopBits :: StopBits, - flowControl :: FlowControl, - byteSize :: Word8 - } deriving Show + { 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 +-- | If this member is TRUE, parity checking is performed and errors are reported. +fParity :: DWORD +fParity = 0x0000000000000010 + + instance Storable DCB where sizeOf = const #size DCB alignment = sizeOf poke buf dcb = do (#poke DCB, DCBlength) buf (sizeOf dcb) - (#poke DCB, BaudRate) buf (case (baudRate dcb) 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 :: DWORD) - pokeByteOff buf 8 (fBinary :: DWORD) + (#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 - NoParity -> 0 - Odd -> 1 - Even -> 2 :: BYTE) + STypes.NoParity -> 0 + STypes.Odd -> 1 + STypes.Even -> 2 :: BYTE) (#poke DCB, StopBits) buf (case (stopBits dcb) of - One -> 0 - Two -> 2 + STypes.One -> 0 + STypes.Two -> 2 :: 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 - case _baud of - 0 -> return B0 - 50 -> return B50 - 75 -> return B75 - 110 -> return B110 - 134 -> return B134 - 150 -> return B150 - 200 -> return B200 - 300 -> return B300 - 600 -> return B600 - 1200 -> return B1200 - 1800 -> return B1800 - 2400 -> return B2400 - 4800 -> return B4800 - 9600 -> return B9600 - 19200 -> return B19200 - 38400 -> return B38400 - 57600 -> return B57600 - 115200 -> return B115200 - _ -> fail "incorrect baudrate" + 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 - 0 -> return NoParity - 1 -> return Odd - 2 -> return Even - --3 -> markparity - --4 -> spaceparity - _ -> fail $ "incorrect parity" ++ (show _par) + 0 -> return STypes.NoParity + 1 -> return STypes.Odd + 2 -> return STypes.Even + 3 -> fail $ "unsupported markparity" + 4 -> fail $ "unsupported spaceparity" + _ -> fail $ "unsupported parity" ++ (show _par) _stopBits <- do _stopb <- (#peek DCB, StopBits) buf :: IO BYTE case _stopb of - 0 -> return One - -- 1 -> one5stopbits - 2 -> return Two + 0 -> return STypes.One + 1 -> fail $ "unsupported one5stopbits" + 2 -> 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 = NoFlowControl, + flowControl = STypes.NoFlowControl, byteSize = _byteSize } @@ -156,8 +101,7 @@ setCommState :: HANDLE -> DCB -> IO () setCommState h dcb = - do with dcb (c_SetCommState h) - return () + failIfFalse_ "setCommState" ( with dcb (c_SetCommState h)) --BOOL WINAPI SetCommState( @@ -171,7 +115,15 @@ - +-- | +-- 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. +-- +-- * If there are no bytes in the input buffer, ReadFile waits until a byte arrives and then returns immediately. +-- +-- * If no bytes arrive within the time specified by ReadTotalTimeoutConstant, ReadFile times out. +-- type LPCOMMTIMEOUTS = Ptr COMMTIMEOUTS data COMMTIMEOUTS = COMMTIMEOUTS { readIntervalTimeout :: DWORD, -- in milliseconds @@ -217,10 +169,14 @@ c_GetCommTimeouts :: HANDLE -> LPCOMMTIMEOUTS -> IO BOOL + +-- | +-- +-- On success it returns nonzero. On failure, the return value is zero and the GetLastError should be called. +-- setCommTimeouts :: HANDLE -> COMMTIMEOUTS -> IO () setCommTimeouts h ct = - do with ct (c_SetCommTimeouts h) - return () + failIfFalse_ "setCommTimeouts" ( with ct (c_SetCommTimeouts h) ) -- setcommtimeouts diff --git a/serialport.cabal b/serialport.cabal --- a/serialport.cabal +++ b/serialport.cabal @@ -1,5 +1,5 @@ Name: serialport -Version: 0.2.0 +Version: 0.3.0 Cabal-Version: >= 1.2 Build-Type: Simple license: BSD3 @@ -23,6 +23,7 @@ Library Exposed-Modules: System.Hardware.Serialport + System.Hardware.Serialport.Types Build-Depends: base >= 4, base < 5 ghc-options: -Wall