diff --git a/README b/README --- a/README +++ b/README @@ -12,10 +12,14 @@ Tested on the following platforms: - - Linux (Arch) - - Windows XP 32-bit + - Linux (Arch, Fedora 11, OpenSuse 11.1) + - Windows XP 32-bit +This library is far from finished and is currently in a "Eureka, I can talk to a +raw serial device on Linux and Windows" state. I released it because some people were looking +for something like this. Especially on Windows it was a challenge. + Install ------- @@ -34,4 +38,7 @@ References ---------- - Frederick Ross with his serial package: http://hackage.haskell.org/package/serial + - Python serial library http://pyserial.sourceforge.net/ + - http://www.easysw.com/~mike/serial/serial.html + - Ruby serial port library http://ruby-serialport.rubyforge.org/ diff --git a/System/Hardware/Serialport.hs b/System/Hardware/Serialport.hs --- a/System/Hardware/Serialport.hs +++ b/System/Hardware/Serialport.hs @@ -1,11 +1,13 @@ {-# LANGUAGE CPP #-} --- | --- > s <- openSerial \"\/dev\/ttyUSB0\" B9600 8 One NoParity NoFlowControl +-- | Example usage: +-- +-- > s <- openSerial "/dev/ttyUSB0" B9600 8 One NoParity NoFlowControl -- > --- > forM_ \"AT\\r\" $ sendChar s +-- > -- Sending +-- > forM_ "AT\r" $ sendChar s -- > --- > -- from Control.Monad.Loops +-- > -- Receiving, using unfoldM from Control.Monad.Loops -- > response <- unfoldM (recvChar s) -- > -- > print response @@ -22,6 +24,8 @@ ,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. 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,6 +1,5 @@ module System.Hardware.Serialport.Posix where - import System.IO import System.Posix.Terminal import System.Posix.IO @@ -10,43 +9,62 @@ data StopBits = One | Two data Parity = Even | Odd | NoParity data FlowControl = Software | NoFlowControl -data SerialPort = SerialPort Handle - - -{- | - Open and configure a serial port and return a Handle - +data SerialPort = SerialPort { handle :: Handle, + timeout :: Int } --} -hOpenSerial :: String -- ^ The filename of the serial port, such as @/dev/ttyS0@ or @/dev/ttyUSB0@ +-- |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 + -> 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 + do setSerial dev baud bPerB stopBits parity flow + h <- openBinaryFile dev ReadWriteMode + hSetBuffering h NoBuffering + return h -openSerial :: String -- ^ The filename of the serial port, such as @/dev/ttyS0@ +-- |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 + -> 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 -> IO SerialPort -openSerial dev baud bPerB stopBits parity flow = - do h <- hOpenSerial dev baud bPerB stopBits parity flow - return $ SerialPort h +openSerial dev baud bPerB stopBits parity flow time_ms = + do h <- hOpenSerial dev baud bPerB stopBits parity flow + return $ SerialPort h time_ms +-- |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 + if have_input + then do c <- hGetChar h + return $ Just c + else return Nothing + +-- |Send a character +sendChar :: SerialPort -> Char -> IO () +sendChar (SerialPort h _) = + hPutChar h + + +-- |Close the serial port +closeSerial :: SerialPort -> IO () +closeSerial (SerialPort h _) = + hClose h + + + setSerial :: String -> BaudRate -> Word8 @@ -62,8 +80,7 @@ nonBlock = True, trunc = False } termOpts <- getTerminalAttributes fd - let termOpts' = configureSettings termOpts baud - bPerB stopBits parity flow + let termOpts' = configureSettings termOpts baud bPerB stopBits parity flow setTerminalAttributes fd termOpts' Immediately closeFd fd @@ -109,22 +126,3 @@ `withMode` LocalMode `withMode` ReadEnable - - -recvChar :: SerialPort -> IO (Maybe Char) -recvChar (SerialPort h) = - do have_input <- hWaitForInput h 100 - if have_input - then do c <- hGetChar h - return $ Just c - else return Nothing - - -sendChar :: SerialPort -> Char -> IO () -sendChar (SerialPort h) c = - hPutChar h c - - -closeSerial :: SerialPort -> IO () -closeSerial (SerialPort h) = - hClose h 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,33 +1,33 @@ module System.Hardware.Serialport.Windows where -import System.IO -import System.Win32.File -import System.Win32.Types -import Data.Bits import Data.Word -import Control.Concurrent +import Data.Bits import System.Win32.Comm -import Foreign.Marshal.Alloc -import Foreign.Marshal.Utils -import Foreign.Storable -import Foreign.Ptr +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 +data SerialPort = SerialPort { handle :: HANDLE, + timeout :: Int } -openSerial :: String -- ^ The filename of the serial port, such as @COM5@ or @//./CNCA0@ +-- | 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 stopBits parity flow = +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 stopBits parity flow - return $ SerialPort h + 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 @@ -37,66 +37,60 @@ 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 = - do -- set timeouts - let ct = COMMTIMEOUTS { +setSerial h baud bPerB stopb parit flow time_ms = + do let ct = COMMTIMEOUTS { readIntervalTimeout = 0, - readTotalTimeoutMultiplier = 100, + readTotalTimeoutMultiplier = fromIntegral time_ms, readTotalTimeoutConstant = 0, writeTotalTimeoutMultiplier = 0, writeTotalTimeoutConstant = 0 } setCommTimeouts h ct - --print $ show ct - -- configure DCB structure - dcb <- getCommState h - --print $ show dcb - let dcb' = DCB { baudRate = baud, parity = parit, stopBits = stopb, flowControl = flow, byteSize = bPerB } - --print $ show dcb' setCommState h dcb' - dcb_check <- getCommState h - --print $ show dcb_check - return () - - -sendChar :: SerialPort -> Char -> IO () -sendChar (SerialPort h) s = - do with s (\ p_s -> do win32_WriteFile h p_s count overlapped - return () ) - where - count = 1 - overlapped = Nothing - - -recvChar :: SerialPort -> IO (Maybe Char) -recvChar (SerialPort h) = - do 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 - - -closeSerial :: SerialPort -> IO () -closeSerial (SerialPort h) = - closeHandle h diff --git a/System/Win32/Comm.hsc b/System/Win32/Comm.hsc --- a/System/Win32/Comm.hsc +++ b/System/Win32/Comm.hsc @@ -2,14 +2,10 @@ module System.Win32.Comm where import System.IO -import System.Win32.File import System.Win32.Types -import Data.Bits import Data.Word import Foreign.Storable import Foreign.Ptr -import Foreign.C.Types -import Foreign.C.String import Foreign.Marshal.Alloc import Foreign.Marshal.Utils @@ -40,36 +36,6 @@ data Parity = Even | Odd | NoParity deriving Show data FlowControl = Software | NoFlowControl deriving Show ---typedef struct _DCB { --- DWORD DCBlength; --- DWORD BaudRate; --- DWORD fBinary :1; If this member is TRUE, binary mode is enabled. Windows does not support nonbinary mode transfers, so this member must be TRUE --- DWORD fParity :1; If this member is TRUE, parity checking is performed and errors are reported --- DWORD fOutxCtsFlow :1; --- DWORD fOutxDsrFlow :1; --- DWORD fDtrControl :2; --- DWORD fDsrSensitivity :1; --- DWORD fTXContinueOnXoff :1; --- DWORD fOutX :1; --- DWORD fInX :1; --- DWORD fErrorChar :1; --- DWORD fNull :1; --- DWORD fRtsControl :2; --- DWORD fAbortOnError :1; --- DWORD fDummy2 :17; Reserved; do not use. --- WORD wReserved; Reserved; must be zero. --- WORD XonLim; --- WORD XoffLim; --- BYTE ByteSize; --- BYTE Parity; --- BYTE StopBits; --- char XonChar; The value of the XON character for both transmission and reception. --- char XoffChar; The value of the XOFF character for both transmission and reception. --- char ErrorChar; The value of the character used to replace bytes received with a parity error. --- char EofChar; The value of the character used to signal the end of data. --- char EvtChar; The value of the character used to signal an event. --- WORD wReserved1; Reserved; do not use. ---}DCB, *LPDCB; type LPDCB = Ptr DCB data DCB = DCB @@ -81,12 +47,17 @@ } deriving Show +-- 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 + + 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 + (#poke DCB, BaudRate) buf (case (baudRate dcb) of B0 -> 0 B50 -> 50 B75 -> 75 @@ -104,8 +75,8 @@ B19200 -> 19200 B38400 -> 38400 B57600 -> 57600 - B115200 -> 115200) :: DWORD) - pokeByteOff buf 8 (0x0000000000000001 :: DWORD) + B115200 -> 115200 :: DWORD) + pokeByteOff buf 8 (fBinary :: DWORD) (#poke DCB, wReserved) buf (0 :: WORD) (#poke DCB, XonLim) buf (2048 :: WORD) (#poke DCB, XoffLim) buf (512 :: WORD) @@ -121,7 +92,6 @@ (#poke DCB, wReserved1) buf (0 :: WORD) peek buf = do _dCBlength <- (#peek DCB, DCBlength) buf :: IO DWORD - --print $ "dcblenth=" ++ (show _dCBlength) _baudRate <- do _baud <- (#peek DCB, BaudRate) buf :: IO DWORD case _baud of 0 -> return B0 @@ -143,35 +113,15 @@ 57600 -> return B57600 115200 -> return B115200 _ -> fail "incorrect baudrate" - _fsettings <- peekByteOff buf 8 :: IO DWORD -- TODO: use this bitmask - --print $ "fsettings:" ++ (show _fsettings ) - --print $ "bit 0:" ++ (show (testBit _fsettings 0)) - --print $ "bit 1:" ++ (show (testBit _fsettings 1)) - --print $ "bit 2:" ++ (show (testBit _fsettings 2)) - --print $ "bit 3:" ++ (show (testBit _fsettings 3)) - --print $ "bit 4:" ++ (show (testBit _fsettings 4)) - --print $ "bit 5:" ++ (show (testBit _fsettings 5)) - --print $ "bit 6:" ++ (show (testBit _fsettings 6)) - --print $ "bit 7:" ++ (show (testBit _fsettings 7)) - --print $ "bit 8:" ++ (show (testBit _fsettings 8)) - --print $ "bit 9:" ++ (show (testBit _fsettings 9)) - --print $ "bit 10:" ++ (show (testBit _fsettings 10)) - --print $ "bit 11:" ++ (show (testBit _fsettings 11)) - --print $ "bit 12:" ++ (show (testBit _fsettings 12)) - --print $ "bit 31:" ++ (show (testBit _fsettings 31)) + _fsettings <- peekByteOff buf 8 :: IO DWORD _byteSize <- (#peek DCB, ByteSize) buf :: IO BYTE _parity <- do _par <- (#peek DCB, Parity) buf :: IO BYTE - -- noparity = 0 - -- oddparity = 1 - -- evenparity = 2 - -- markparity = 3 - -- spaceparity = 4 case _par of 0 -> return NoParity 1 -> return Odd 2 -> return Even - --3 -> - --4 -> + --3 -> markparity + --4 -> spaceparity _ -> fail $ "incorrect parity" ++ (show _par) _stopBits <- do _stopb <- (#peek DCB, StopBits) buf :: IO BYTE case _stopb of @@ -180,24 +130,20 @@ 2 -> return Two _ -> fail "unexpected stop bit count" _XonLim <- (#peek DCB, XonLim) buf :: IO WORD - --print $ show _XonLim _XoffLim <- (#peek DCB, XoffLim) buf :: IO WORD - --print $ show _XoffLim - return $ DCB { baudRate = _baudRate, - parity = _parity, - stopBits = _stopBits, - flowControl = NoFlowControl, - byteSize = _byteSize - } + return DCB { baudRate = _baudRate, + parity = _parity, + stopBits = _stopBits, + flowControl = NoFlowControl, + byteSize = _byteSize + } getCommState :: HANDLE -> IO DCB getCommState h = - do dcb <- alloca (\dcbp -> - do c_GetCommState h dcbp - dcb <- peek dcbp - return dcb ) - return dcb + alloca (\dcbp -> + do c_GetCommState h dcbp + peek dcbp ) --BOOL WINAPI GetCommState( @@ -210,7 +156,7 @@ setCommState :: HANDLE -> DCB -> IO () setCommState h dcb = - do with dcb (\ pdcb -> c_SetCommState h pdcb ) + do with dcb (c_SetCommState h) return () @@ -251,20 +197,18 @@ _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 } + return COMMTIMEOUTS { readIntervalTimeout = _readIntervalTimeout, + readTotalTimeoutMultiplier = _readTotalTimeoutMultiplier, + readTotalTimeoutConstant = _readTotalTimeoutConstant, + writeTotalTimeoutMultiplier = _writeTotalTimeoutMultiplier, + writeTotalTimeoutConstant = _writeTotalTimeoutConstant } getCommTimeouts :: HANDLE -> IO COMMTIMEOUTS getCommTimeouts h = - do comm_timeouts <- alloca (\c -> - do c_GetCommTimeouts h c - ct <- peek c - return ct ) - return comm_timeouts + alloca (\c -> + do c_GetCommTimeouts h c + peek c ) -- getcommtimeouts @@ -275,7 +219,7 @@ setCommTimeouts :: HANDLE -> COMMTIMEOUTS -> IO () setCommTimeouts h ct = - do with ct (\ pct -> c_SetCommTimeouts h pct ) + do with ct (c_SetCommTimeouts h) return () diff --git a/serialport.cabal b/serialport.cabal --- a/serialport.cabal +++ b/serialport.cabal @@ -1,5 +1,5 @@ Name: serialport -Version: 0.1.0.2 +Version: 0.2.0 Cabal-Version: >= 1.2 Build-Type: Simple license: BSD3 @@ -24,7 +24,7 @@ Library Exposed-Modules: System.Hardware.Serialport Build-Depends: base >= 4, base < 5 - Extensions: CPP + ghc-options: -Wall if !os(windows) Build-Depends: unix