serialport 0.1.0.2 → 0.2.0
raw patch · 6 files changed
+136/−189 lines, 6 files
Files
- README +9/−2
- System/Hardware/Serialport.hs +8/−4
- System/Hardware/Serialport/Posix.hs +39/−41
- System/Hardware/Serialport/Windows.hs +48/−54
- System/Win32/Comm.hsc +30/−86
- serialport.cabal +2/−2
README view
@@ -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/
System/Hardware/Serialport.hs view
@@ -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.
System/Hardware/Serialport/Posix.hs view
@@ -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
System/Hardware/Serialport/Windows.hs view
@@ -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
System/Win32/Comm.hsc view
@@ -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 ()
serialport.cabal view
@@ -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